baskell (empty) → 0.1
raw patch · 30 files changed
+3317/−0 lines, 30 filesdep +basedep +containersdep +mtlsetup-changed
Dependencies added: base, containers, mtl, parsec, pretty, unix
Files
- LICENSE +340/−0
- Prelude.bs +152/−0
- Setup.hs +2/−0
- baskell.cabal +53/−0
- examples/Bomb.bs +13/−0
- examples/FDotF.bs +1/−0
- examples/Fix.bs +20/−0
- examples/InfiniteNestedList.bs +7/−0
- examples/MutRec.bs +11/−0
- examples/NameSupply.bs +46/−0
- examples/PolyRec.bs +8/−0
- examples/Rec.bs +4/−0
- examples/Sig.bs +1/−0
- examples/Simple.bs +5/−0
- examples/Sort.bs +47/−0
- examples/SortStrict.bs +45/−0
- examples/TupleList.bs +44/−0
- src/AST.hs +241/−0
- src/CmdLine.hs +170/−0
- src/Depend.hs +156/−0
- src/Help.hs +51/−0
- src/Lexer.hs +182/−0
- src/Main.hs +284/−0
- src/Parser.hs +300/−0
- src/ParserUtils.hs +148/−0
- src/Pretty.hs +58/−0
- src/Primitives.hs +423/−0
- src/Reduce.hs +205/−0
- src/Rename.hs +177/−0
- src/Type.hs +123/−0
+ LICENSE view
@@ -0,0 +1,340 @@+ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.+ 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users. This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it. (Some other Free Software Foundation software is covered by+the GNU Library General Public License instead.) You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++ To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have. You must make sure that they, too, receive or can get the+source code. And you must show them these terms so they know their+rights.++ We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++ Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software. If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++ Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary. To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++ The precise terms and conditions for copying, distribution and+modification follow.++ GNU GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License. The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language. (Hereinafter, translation is included without limitation in+the term "modification".) Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++ 1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++ 2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) You must cause the modified files to carry prominent notices+ stating that you changed the files and the date of any change.++ b) You must cause any work that you distribute or publish, that in+ whole or in part contains or is derived from the Program or any+ part thereof, to be licensed as a whole at no charge to all third+ parties under the terms of this License.++ c) If the modified program normally reads commands interactively+ when run, you must cause it, when started running for such+ interactive use in the most ordinary way, to print or display an+ announcement including an appropriate copyright notice and a+ notice that there is no warranty (or else, saying that you provide+ a warranty) and that users may redistribute the program under+ these conditions, and telling the user how to view a copy of this+ License. (Exception: if the Program itself is interactive but+ does not normally print such an announcement, your work based on+ the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++ a) Accompany it with the complete corresponding machine-readable+ source code, which must be distributed under the terms of Sections+ 1 and 2 above on a medium customarily used for software interchange; or,++ b) Accompany it with a written offer, valid for at least three+ years, to give any third party, for a charge no more than your+ cost of physically performing source distribution, a complete+ machine-readable copy of the corresponding source code, to be+ distributed under the terms of Sections 1 and 2 above on a medium+ customarily used for software interchange; or,++ c) Accompany it with the information you received as to the offer+ to distribute corresponding source code. (This alternative is+ allowed only for noncommercial distribution and only if you+ received the program in object code or executable form with such+ an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it. For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable. However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++ 4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License. Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++ 5. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Program or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++ 6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++ 7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all. For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded. In such case, this License incorporates+the limitation as if written in the body of this License.++ 9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number. If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation. If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++ 10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission. For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this. Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++ NO WARRANTY++ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA+++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++ Gnomovision version 69, Copyright (C) year name of author+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the program+ `Gnomovision' (which makes passes at compilers) written by James Hacker.++ <signature of Ty Coon>, 1 April 1989+ Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs. If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library. If this is what you want to do, use the GNU Library General+Public License instead of this License.
+ Prelude.bs view
@@ -0,0 +1,152 @@+# The Baskell Prelude. Modelled off the Haskell Prelude.+#+# Author: Bernie Pope+# Date: 12 October 2004++all = \p -> compose andList (map p);++and = !x -> !y -> ite x (ite y True False) False;++andList = foldr and True;++any = \p -> compose orList (map p);++append + = !list1 -> \list2 -> + ite (null list1) + list2 + (Cons (head list1) (append (tail list1) list2));++apply = !f -> \x -> f x;++compose = !f -> \g -> \x -> f (g x);++concat = foldr append [];++concatMap = \f -> compose concat (map f);++const = !x -> \y -> x;++curry = !f -> \x -> \y -> f (x,y);++cycle = !list -> append list (cycle list);++drop + = !num -> \list -> + ite (lte num 0) + list + (ite (null list) + [] + (drop (sub num 1) (tail list)));++elemI = compose any eqI;++filter + = \p -> !list -> + ite (null list) + [] + (ite (p (head list)) + (Cons (head list) (filter p (tail list))) + (filter p (tail list)));++flip = !f -> \x -> \y -> f y x;++foldl + = \f -> \acc -> !list -> + ite (null list) + acc + (foldl f (f acc (head list)) (tail list));++foldr + = \f -> \base -> !list -> + ite (null list) + base + (f (head list) (foldr f base (tail list)));++gte = !x -> !y -> or (gt x y) (eqI x y);++id :: a -> a;+id = \x -> x;++index + = !list -> !num -> + ite (eqI 0 num) + (head list) + (index (tail list) (sub num 1));++init + = !list -> + ite (singleton list) + [] + (Cons (head list) (init (tail list)));++iterate = \f -> \x -> Cons x (iterate f (f x));++last + = !list -> + ite (singleton list) + (head list) + (last (tail list));++length + = !list -> ite + (null list) + 0 + (plus 1 (length (tail list)));++lte = !x -> !y -> or (lt x y) (eqI x y);++map + = \f -> !list -> + ite (null list) + [] + (Cons (f (head list)) (map f (tail list)));++negate = !x -> sub 0 x;++not = !x -> ite x False True;++notElemI = compose all notEqI;++notEqI = !x -> !y -> not (eqI x y);++or = !x -> \y -> ite x True (ite y True False);++orList = foldr or False;++product = foldr mult 1;++repeat = \x -> Cons x (repeat x);++replicate = !num -> \x -> take num (repeat x);++reverse = foldl (flip Cons) [];++singleton = compose null tail;++sum = foldr plus 0;++take + = !num -> \list -> + ite (lte num 0) + [] + (ite (null list) + [] + (Cons (head list) (take (sub num 1) (tail list))));++uncurry = !f -> \pair -> f (fst pair) (snd pair);++undefined = undefined;++until = !p -> \f -> \x -> ite (p x) x (until p f (f x));++zip = zipWith (\a -> \b -> (a,b));++zipWith + = \f -> !list1 -> \list2 -> + ite (null list1) + [] + (ite (null list2) + [] + (Cons (f (head list1) (head list2)) + (zipWith f (tail list1) (tail list2))));
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ baskell.cabal view
@@ -0,0 +1,53 @@+Name: baskell+Version: 0.1+Copyright: 2004-2005, Bernard Pope+License: GPL+License-File: LICENSE+Author: Bernard Pope+Maintainer: Bernard Pope <bjpop@cs.mu.oz.au>+Homepage: http://www.cs.mu.oz.au/~bjpop/code.html+Category: Compilers/Interpreters+Synopsis: An interpreter for a small functional language+Description:+ Baskell is an interpreter for a small functional+ language. It supports type inference, lazy+ evaluation and strict evaluation.++Build-Depends: base, unix, parsec, containers, pretty, mtl+Build-Type: Simple+Tested-With: GHC==6.8.2+Data-Files: Prelude.bs+ examples/TupleList.bs+ examples/NameSupply.bs+ examples/PolyRec.bs+ examples/Rec.bs+ examples/Sig.bs+ examples/MutRec.bs+ examples/Simple.bs+ examples/Fix.bs+ examples/Sort.bs+ examples/Bomb.bs+ examples/InfiniteNestedList.bs+ examples/FDotF.bs+ examples/SortStrict.bs++Executable: baskell+Extensions: CPP+Main-Is: Main.hs+hs-source-dirs: src+Other-Modules:+ AST,+ Depend,+ Lexer,+ ParserUtils,+ Primitives,+ Rename,+ CmdLine,+ Help,+ Parser,+ Pretty,+ Reduce,+ Type+ghc-options: -O2 -Wall -optl-Wl,-s+ghc-prof-options: -prof -auto-all+
+ examples/Bomb.bs view
@@ -0,0 +1,13 @@+# a type bomb, very small program produces enormous type++t = d id;++d = compose c c;++c = compose b b;++b = compose a a;++a = \x -> p x x;++p = \x -> \y -> \z -> z x y;
+ examples/FDotF.bs view
@@ -0,0 +1,1 @@+y = \f -> compose f f;
+ examples/Fix.bs view
@@ -0,0 +1,20 @@+# The paradoxical fixpoint combinator in Baskell.+# How to implement recursion without using a recursive function.+#+# Author: Bernie Pope+# Date: 10 October 2004++fix = \h -> (\x -> h (x x)) (\x -> h (x x));++# factorial ++fac = fix facNonRec;+facNonRec + = \f -> \n -> + ite (eqI n 0) + 1 + (mult n (f (sub n 1)));++# an infinite list of 1s++ones = fix (\x -> Cons 1 x);
+ examples/InfiniteNestedList.bs view
@@ -0,0 +1,7 @@+xs = [xs];++deep = !n -> !list -> ite (eqI n 0) + True + (ite (null list)+ False+ (deep (sub n 1) (head list)));
+ examples/MutRec.bs view
@@ -0,0 +1,11 @@+even = !x -> ite (eqI x 0) + True+ (ite (eqI x 1)+ False+ (odd (sub x 1)));++odd = !x -> ite (eqI x 1) + True+ (ite (eqI x 0)+ False+ (even (sub x 1)));
+ examples/NameSupply.bs view
@@ -0,0 +1,46 @@+# Generates an infinite list of strings, following this+# sequence:+# +# ["a", "b" ..."z", +# "aa", "ab" ... "az",+# "ba", "bb" ... "bz",+# ...+# "za", "zb" ... "zz",+# "aaa", "aab" ... "aaz",+# "aba", "abb" ... "abz",+# ...+# "zza", "zzb" ... "zzz",+# ...+#+# In Haskell you would define it this way:+#+# ns = [x ++ [y] | x <- []:ns, y <- ['a'..'z']]+#+# Author: Bernie Pope+# Date: 10 October 2004++forallWorker + = !f -> !list1 -> !list2 -> !list3 -> + ite (null list1) + (ite (null list3) + [] + (forallWorker f list2 list2 (tail list3)))+ (ite (null list3) + [] + (Cons (f (head list1) (head list3)) + (forallWorker f (tail list1) list2 list3)));++forall + = !f -> !list1 -> !list2 -> + forallWorker f list1 list1 list2;++ns + = forall (\x -> \y -> append y (single x)) + aToZ + (Cons [] ns);++single = \x -> Cons x [];++aToZ + = ['a','b','c','d','e','f','g','h','i','j','k','l','m',+ 'n','o','p','q','r','s','t','u','v','w','x','y','z'];
+ examples/PolyRec.bs view
@@ -0,0 +1,8 @@+foo = !x -> !y ->+ (ite (eqI x 0)+ 0+ (ite (eqI x 1)+ (foo (sub x 1) 1)+ (foo (sub x 1) False)+ )+);
+ examples/Rec.bs view
@@ -0,0 +1,4 @@+# Simple test case to check type inference on recursive equations++f = \x -> g x;+g = \x -> f (snd x, fst x);
+ examples/Sig.bs view
@@ -0,0 +1,1 @@+id : [[a]] -> (a);
+ examples/Simple.bs view
@@ -0,0 +1,5 @@+# simple test case to check type inference of polymorphic functions++myid = \x -> x;++f = (myid 'a', myid True);
+ examples/Sort.bs view
@@ -0,0 +1,47 @@+# Slow versions of insertion sort and merge sort.+#+# They are slow because they do not use strictness annotations.+# Lazy term reduction causes much duplicated work.+#+# Compare this with SortStrict.bs+#+# Author: Bernie Pope+# Date: 10 October 2004++isort + = \list -> + ite (null list) + list + (insert (head list) (isort (tail list)));++insert + = \x -> \list -> + ite (null list) + [x] + (ite (lte x (head list)) + (Cons x list) + (Cons (head list) (insert x (tail list))));++msort + = \list -> + ite (or (null list) (singleton list)) + list + (merge (msort (topHalf list)) (msort (bottomHalf list)));++topHalf = \list -> take (div (length list) 2) list;++bottomHalf = \list -> drop (div (length list) 2) list;++merge + = \list1 -> \list2 -> + ite (null list1) + list2 + (ite (null list2) + list1 + (ite (lte (head list1) (head list2)) + (Cons (head list1) (merge (tail list1) list2)) + (Cons (head list2) (merge list1 (tail list2)))));++test1 = isort [12,4,18,3,1,2];++test2 = msort [12,4,18,3,1,2];
+ examples/SortStrict.bs view
@@ -0,0 +1,45 @@+# This Baskell module implements insertion sort and merge sort+# for lists of ints.+#+# Author: Bernie Pope+# Date: 12 October 2004++isort + = !list -> + ite (null list) + list + (insert (head list) (isort (tail list)));++insert + = !x -> !list -> + ite (null list) + [x] + (ite (lte x (head list)) + (Cons x list) + (Cons (head list) (insert x (tail list))));++msort + = !list -> + ite (or (null list) (singleton list)) + list + (merge (msort (topHalf list)) (msort (bottomHalf list)));++topHalf + = !list -> take (div (length list) 2) list;++bottomHalf + = !list -> drop (div (length list) 2) list;++merge + = !list1 -> !list2 -> + ite (null list1) + list2 + (ite (null list2) + list1 + (ite (lte (head list1) (head list2)) + (Cons (head list1) (merge (tail list1) list2)) + (Cons (head list2) (merge list1 (tail list2)))));++test1 = isort [12,4,18,3,1,2];++test2 = msort [12,4,18,3,1,2];
+ examples/TupleList.bs view
@@ -0,0 +1,44 @@+# An implementation of lists using tuples (Lisp style).+#+# Of course Hindley Milner type inference has trouble with this!+#+# Relies on a primitive: isTuple :: a -> Bool+#+# Author: Bernie Pope+# Date: 10 October 2004++emptyList = nil;++isEmpty = compose not isTuple;++cons = \x -> \list -> (x, list);++hd = fst;++tl = snd;++fromTupList + = \list -> + ite (isEmpty list) + [] + (Cons (hd list) (fromTupList (tl list)));++toTupList + = \list -> + ite (null list) + emptyList + (head list, toTupList (tail list));++unit = \x -> (x, emptyList);++rev + = !list -> + ite (isEmpty list) + emptyList + (join (rev (tl list)) (unit (hd list)));++join + = !list1 -> !list2 -> + ite (isEmpty list1) + list2 + (hd list1, join (tl list1) list2);
+ src/AST.hs view
@@ -0,0 +1,241 @@+{-------------------------------------------------------------------------------++ Copyright: Bernie Pope 2004++ Module: AST++ Description: Definition of the Abstract Syntax Tree for+ Baskell programs.++ Primary Authors: Bernie Pope++-------------------------------------------------------------------------------}++{-+ This file is part of baskell.++ baskell is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ baskell is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with baskell; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module AST+ ( Ident+ , Exp (..)+ , Lit (..)+ , Decl (..)+ , Program (..)+ , emptyProgram+ , isEmptyProgram+ , (=:)+ , var+ , lam+ , (@@)+ , app+ , litI+ , litC+ , litB+ , list+ , tup+ , prim+ ) where++import Pretty+ ( parensIf+ , char+ , text+ , (<>)+ , comma+ , Doc+ , (<+>)+ , vcat+ , parens+ , cat+ , render+ , punctuate+ , int+ , Pretty (..)+ )++import Data.List (sort)++import Type (Type)++--------------------------------------------------------------------------------++-- identifiers+type Ident = String++-- expressions+data Exp+ = Var Ident+ | Lam Ident Exp+ | LamStrict Ident Exp+ | App Exp Exp+ | Literal Lit+ | Tuple [Exp]+ | Prim String (Exp -> Maybe Exp)+ deriving Show++instance Show (a -> b) where+ show f = "<function>"++-- literals+data Lit+ = LitInt Int+ | LitChar Char+ | LitBool Bool+ | LitCons+ | LitNil+ deriving Show++-- declarations+data Decl+ = Decl Ident Exp+ | Sig Ident Type+ deriving Show++instance Eq Decl where+ (Decl ident1 _body1) == (Decl ident2 _body2) = ident1 == ident2+ (Sig ident1 _ty1) == (Sig ident2 _ty2) = ident1 == ident2++instance Ord Decl where+ compare (Decl ident1 _body1) (Decl ident2 _body2)+ = compare ident1 ident2+ compare (Sig ident1 _ty1) (Sig ident2 _ty2)+ = compare ident1 ident2++-- programs+newtype Program+ = Program [Decl]+ deriving Show++emptyProgram :: Program+emptyProgram = Program []++isEmptyProgram :: Program -> Bool+isEmptyProgram (Program decls)+ = null decls++--------------------------------------------------------------------------------++-- pretty printing of the AST++instance Pretty Exp where+ pretty exp = prettyExp False exp++-- this should be a reader monad+prettyExp :: Bool -> Exp -> Doc+prettyExp _parens (Var ident) = text ident+prettyExp parens (Lam ident exp)+ = parensIf parens+ $ char '\\' <>+ text ident <+>+ text "->" <+>+ pretty exp+prettyExp parens (LamStrict ident exp)+ = parensIf parens+ $ char '!' <>+ text ident <+>+ text "->" <+>+ pretty exp+prettyExp _parens exp@(App (App (Literal LitCons) _hd) _tl)+ = prettyList exp+prettyExp parens exp@(App e1 e2)+ = parensIf parens+ $ prettyExp (not $ isApp e1) e1 <+> prettyExp True e2+ where+ isApp :: Exp -> Bool+ isApp (App _ _) = True+ isApp other = False+prettyExp _parens (Literal lit)+ = pretty lit+prettyExp _parens (Tuple exps)+ = parens $ cat (punctuate comma $ map pretty exps)+prettyExp _parens (Prim name _implementation)+ = text "prim_" <> text name++instance Pretty Lit where+ pretty (LitInt i) = pretty i+ pretty (LitChar c) = text $ show c+ pretty (LitBool b) = text $ show b+ pretty LitCons = text $ "Cons"+ pretty LitNil = text $ "[]"++instance Pretty Decl where+ pretty (Decl name body) = text name <+> text "=" <+> pretty body+ pretty (Sig name ty) = text name <+> text "::" <+> pretty ty++instance Pretty Program where+ pretty (Program decls) = vcat $ map pretty (sort decls)++prettyList :: Exp -> Doc+prettyList (Literal LitNil) = text "[]"+prettyList (App (App (Literal LitCons) x) tail)+ = char '[' <> pretty x <> prettyList' tail+ where+ prettyList' (Literal LitNil) = char ']'+ prettyList' (App (App (Literal LitCons) h) t)+ = comma <> pretty h <> prettyList' t+ prettyList' other = comma <> pretty other+++--------------------------------------------------------------------------------++-- below are some convenience functions that+-- make writing AST values slighlty nicer.++infix 0 =:+(=:) :: Ident -> Exp -> Decl+(=:) = Decl++var :: Ident -> Exp+var = Var++lam :: [Ident] -> Exp -> Exp+lam xs e = foldr Lam e xs++infixl 9 @@+(@@) :: Exp -> Exp -> Exp+e1 @@ e2 = App e1 e2++app :: [Exp] -> Exp+app [] = error "app applied to empty list"+app xs = foldl1 App xs++litI :: Int -> Exp+litI = Literal . LitInt++litC :: Char -> Exp+litC = Literal . LitChar++litB :: Bool -> Exp+litB = Literal . LitBool++litLC :: Exp+litLC = Literal LitCons++litLN :: Exp+litLN = Literal LitNil++list :: [Exp] -> Exp+list = foldr cons litLN++cons :: Exp -> Exp -> Exp+cons hd tl = litLC @@ hd @@ tl++tup :: [Exp] -> Exp+tup = Tuple++prim :: String -> (Exp -> Maybe Exp) -> Exp+prim = Prim
+ src/CmdLine.hs view
@@ -0,0 +1,170 @@+{-# LANGUAGE CPP #-}+{-------------------------------------------------------------------------------++ Copyright: Bernie Pope 2004++ Module: CmdLine++ Description: The Baskell interpreter command line.++ Primary Authors: Bernie Pope++ Notes:++ Will use GNU readline if it is available.++-------------------------------------------------------------------------------}++{-+ This file is part of baskell.++ baskell is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ baskell is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with baskell; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module CmdLine+ (Command (..)+ , getCommand+ , initializeCmdLine+ )+ where++import Parser (expParser)++import AST (Exp)++import Data.Char(isSpace)++import Text.ParserCombinators.Parsec+ (ParseError+ , runParser+ , (<|>)+ , eof+ )++import ParserUtils+ (Parser+ , word+ , singleQuoted+ , colon+ )++#ifdef READLINE+import qualified System.Console.Readline as Readline+ (readline+ , addHistory+ , initialize+ )+#endif++import Lexer+ (lexer)++--------------------------------------------------------------------------------++data Command+ = Load FilePath+ | Quit+ | Browse+ | Eval Exp+ | Type Exp+ | Help+#ifdef DEBUG+ | ShowAST+ | ShowDepend+#endif++-- read some input from the user+-- parse the input and return the corresponding command+getCommand :: IO Command+getCommand+ = do input <- readline "baskell> "+ case input of+ Nothing -> return Quit+ Just line+ -> if all isSpace line+ then getCommand+ else do addHistory line+ case parseCommandLine line of+ Left e -> do putStrLn $ "Parse error: " ++ show e+ putStrLn $ ":h for help, :q to quit"+ getCommand+ Right cmd -> return cmd++parseCommandLine :: String -> Either ParseError Command+parseCommandLine input+ = runParser commandLineParser () src (lexer src input)+ where+ src = "baskell command line"++-- a command line is either a colon-prefixed command+-- or an expression to evaluate+commandLineParser :: Parser Command+commandLineParser+ = do cmd <- colonCommand <|> evalCommand+ eof+ return cmd++colonCommand :: Parser Command+colonCommand+ = do colon+ cmd <- word+ case cmd of+ "q" -> return Quit+ "h" -> return Help+ "b" -> return Browse+ "l" -> do fileName <- singleQuoted+ return $ Load fileName+ "t" -> do exp <- expParser+ return $ Type exp+#ifdef DEBUG+ "ast" -> return ShowAST+ "depend" -> return ShowDepend+#endif+ other -> fail $ "unknown command: " ++ show cmd++evalCommand :: Parser Command+evalCommand+ = do exp <- expParser+ return $ Eval exp++--------------------------------------------------------------------------------++-- optional support for GNU Readline++initializeCmdLine :: IO ()+initializeCmdLine+#ifdef READLINE+ = Readline.initialize+#else+ = return ()+#endif++readline :: String -> IO (Maybe String)+readline prompt+#ifdef READLINE+ = Readline.readline prompt+#else+ = do putStr prompt+ input <- getLine+ return $ Just input+#endif++addHistory :: String -> IO ()+addHistory str+#ifdef READLINE+ = Readline.addHistory str+#else+ = return ()+#endif
+ src/Depend.hs view
@@ -0,0 +1,156 @@+{-------------------------------------------------------------------------------++ Copyright: Bernie Pope 2004++ Module: Depend++ Description: Compute the dependencies between functions+ declared in a module. This information is+ needed by the type checker.++ Primary Authors: Bernie Pope++-------------------------------------------------------------------------------}++{-+ This file is part of baskell.++ baskell is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ baskell is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with baskell; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Depend+ ( depend+ , printDepends+ )+ where++import AST+ ( Ident+ , Exp (..)+ , Decl (..)+ , Program (..)+ )++import qualified Data.Map as Map+ ( Map+ , empty+ , lookup+ , insert+ )++import Data.Graph+ ( scc+ , Vertex+ , Edge+ , Graph+ , buildG+ )++import Data.Tree+ ( flatten )++import Data.Maybe+ ( catMaybes )++--------------------------------------------------------------------------------++-- given a list of declarations compute the list of strongly connected+-- components.+depend :: [Decl] -> [[Decl]]+depend decls+ = convertToDecls $ map flatten $ scc $ dependGraph decls+ where+ convertToDecls :: [[Vertex]] -> [[Decl]]+ convertToDecls vertices+ = map (catMaybes . map (flip Map.lookup vertexMap)) vertices+ (vertexMap, _) = declMaps decls++-- mappings from vertex numbers to decls and vice versa+declMaps :: [Decl] -> (Map.Map Vertex Decl, Map.Map Ident Vertex)+declMaps decls+ = (intToDeclMap 0 decls, declToIntMap 0 decls)+ where+ intToDeclMap :: Vertex -> [Decl] -> Map.Map Vertex Decl+ intToDeclMap count [] = Map.empty+ intToDeclMap count (d:ds)+ = Map.insert count d (intToDeclMap (count + 1) ds)+ declToIntMap :: Vertex -> [Decl] -> Map.Map Ident Vertex+ declToIntMap count [] = Map.empty+ declToIntMap count (Sig {} : ds) =+ declToIntMap count ds+ declToIntMap count (Decl ident _body : ds)+ = Map.insert ident count (declToIntMap (count + 1) ds)++-- edges are immediate dependencies of the dependency graph+-- the dependency graph is computed from this+dependencies :: [Decl] -> [Edge]+dependencies decls+ = getDependencies identMap decls+ where+ (_, identMap) = declMaps decls+ getDependencies :: Map.Map Ident Int -> [Decl] -> [Edge]+ getDependencies identMap [] = []+ getDependencies identMap (Sig {} : decls)+ = getDependencies identMap decls+ getDependencies identMap (Decl ident body : decls)+ = makeEdges identMap ident body ++ getDependencies identMap decls+ makeEdges :: Map.Map Ident Int -> Ident -> Exp -> [Edge]+ makeEdges identMap ident body+ = case Map.lookup ident identMap of+ Nothing -> []+ Just index+ -> [ (index, d) | d <- dependents]+ where+ dependents = catMaybes [ Map.lookup i identMap | i <- freeVarsInExp body ]++-- compute the dependency graph of a list of decls+dependGraph :: [Decl] -> Graph+dependGraph decls+ = buildG bounds $ dependencies decls+ where+ bounds = (0, length decls - 1)++type IdentMap = Map.Map Ident ()++-- find the free variables in an expression+freeVarsInExp :: Exp -> [Ident]+freeVarsInExp exp = freeVars Map.empty Map.empty exp++freeVars :: IdentMap -> IdentMap -> Exp -> [Ident]+freeVars bound free (Var ident)+ = case Map.lookup ident bound of+ Nothing -> case Map.lookup ident free of+ Nothing -> [ident]+ Just () -> []+ Just () -> []+freeVars bound free (Lam ident body)+ = freeVars (Map.insert ident () bound) free body+freeVars bound free (LamStrict ident body)+ = freeVars (Map.insert ident () bound) free body+freeVars bound free (App e1 e2)+ = freeVars bound free e1 ++ freeVars bound free e2+freeVars bound free (Literal _) = []+freeVars bound free (Tuple exps)+ = concatMap (freeVars bound free) exps+freeVars bound free (Prim _name _impl) = []++-- find and print the strongly connected components of a program+printDepends :: Program -> IO ()+printDepends (Program decls)+ = print $ map (map declName) $ depend decls+ where+ declName :: Decl -> String+ declName (Sig i _) = i+ declName (Decl i _) = i
+ src/Help.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE CPP #-}+{-------------------------------------------------------------------------------++ Copyright: Bernie Pope 2004++ Module: Help++ Description: Print a help message regarding the use of+ baskell's command line.++ Primary Authors: Bernie Pope++-------------------------------------------------------------------------------}++{-+ This file is part of baskell.++ baskell is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ baskell is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with baskell; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Help+ ( printHelp )+ where++--------------------------------------------------------------------------------++printHelp :: IO ()+printHelp+ = do putStrLn "Commands available from the prompt:"+ putStrLn ":b = show types of defined functions"+ putStrLn ":h = show this help message"+ putStrLn ":l '<filename>' = load a baskell file, quotes are needed around the name (defaults are usually in /usr/share/baskell...)"+ putStrLn ":q = quit"+ putStrLn ":t <exp> = show the type of an expression"+ putStrLn "<exp> = evaluate an expression"+#ifdef DEBUG+ putStrLn ":ast = show the abstract syntax tree"+ putStrLn ":depend = show function dependencies"+#endif
+ src/Lexer.hs view
@@ -0,0 +1,182 @@+{-------------------------------------------------------------------------------++ Copyright: Bernie Pope 2004++ Module: Lexer++ Description: Lexical analysis for baskell's parser.++ Primary Authors: Bernie Pope++-------------------------------------------------------------------------------}++{-+ This file is part of baskell.++ baskell is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ baskell is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with baskell; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Lexer+ ( Token (..)+ , Symbol (..)+ , lexer+ )+where++import Data.Char+ ( isDigit+ , isAlpha+ , isPrint+ , isLower+ )++import Text.ParserCombinators.Parsec.Pos+ ( newPos+ , setSourceColumn+ , incSourceColumn+ , incSourceLine+ )++import Text.ParserCombinators.Parsec+ ( SourcePos )++--------------------------------------------------------------------------------++newtype Token = Token (SourcePos, Symbol)++instance Show Token where+ show (Token (pos, symbol)) = show symbol++data Symbol+ = Word String+ | SingleQuoted String+ | Num Int+ | Equals+ | LeftRoundBracket+ | RightRoundBracket+ | LeftSquareBracket+ | RightSquareBracket+ | Comma+ | Colon+ | DoubleColon+ | SemiColon+ | BackSlash+ | Exclamation+ | Dash+ | GreaterThan+ | Bad String+ deriving (Eq)++-- slighlty pretty printing of Symbols via Show. The+-- prettiness is due to the fact that the Parsec parser+-- uses show to print Symbols as part of error messages+instance Show Symbol where+ show (Word s) = "word: " ++ s+ show (SingleQuoted s) = "single quoted string: " ++ s+ show (Num n) = "number: " ++ show n+ show Equals = "equals sign: '='"+ show LeftRoundBracket = "bracket: '('"+ show RightRoundBracket = "bracket: ')'"+ show LeftSquareBracket = "bracket: '['"+ show RightSquareBracket = "bracket: ']'"+ show Comma = "comma: ','"+ show Colon = "colon: ':'"+ show DoubleColon = "double colon: '::'"+ show SemiColon = "semi-colon: ';'"+ show BackSlash = "backslash: '\'"+ show Exclamation = "exclamation sign: '!'"+ show Dash = "dash '-'"+ show GreaterThan = "greater than sign: '>'"+ show (Bad str) = str++-- turn a stream of characters into a stream of tokens+lexer :: String -> String -> [Token]+lexer filename input+ = lexWork (newPos filename 1 1) input++lexWork :: SourcePos -> String -> [Token]+lexWork pos [] = []+lexWork pos (x:xs)+ | x == '=' = simpleToken Equals nextCol+ | x == '(' = simpleToken LeftRoundBracket nextCol+ | x == ')' = simpleToken RightRoundBracket nextCol+ | x == '[' = simpleToken LeftSquareBracket nextCol+ | x == ']' = simpleToken RightSquareBracket nextCol+ | x == ',' = simpleToken Comma nextCol+ | x == '\n' = lexWork (nextLine pos) xs+ | x == ':' = lexColon pos xs+ | x == ';' = simpleToken SemiColon nextCol+ | x == '\\' = simpleToken BackSlash nextCol+ | x == '!' = simpleToken Exclamation nextCol+ | x == '-' = simpleToken Dash nextCol+ | x == '>' = simpleToken GreaterThan nextCol+ -- source location does not need to be accurate within a comment+ | x == '#' = lexWork pos (dropWhile (/= '\n') xs)+ | isWhiteSpace x = let nextPos = incSourceColumn pos 1+ in lexWork nextPos xs+ | isDigit x = let (num, rest) = span isDigit (x:xs)+ nextPos = incSourceColumn pos (length num)+ in Token (pos, Num $ read num) : lexWork nextPos rest+ | isAlpha x+ = let (restWord, rest) = span isWordChar xs+ word = x:restWord+ nextPos = incSourceColumn pos (length word)+ in Token (pos, Word word) : lexWork nextPos rest+ -- quoted strings need special care - escaped quotes can appear+ -- within the string, and the string might not be terminated+ -- by a quote in the case of a lexical error+ | x == '\''+ = let (thisString, rest) = lexTailQuotedString xs+ nextPos = incSourceColumn pos (length thisString + 2)+ in if null rest+ then [Token (pos, Bad $ "ill-quoted input: " ++ x:thisString)]+ else Token (pos, SingleQuoted thisString) : lexWork nextPos (tail rest)+ | otherwise = simpleToken (Bad $ "symbol: " ++ show x) nextCol+ where+ simpleToken :: Symbol -> (SourcePos -> SourcePos) -> [Token]+ simpleToken tok srcPosUpdate+ = Token (pos, tok) : lexWork (srcPosUpdate pos) xs+ isWhiteSpace :: Char -> Bool+ isWhiteSpace c = c `elem` " \t\r\f\v\xA0"+ isWordChar :: Char -> Bool+ isWordChar c = isAlpha c || isDigit c++nextLine :: SourcePos -> SourcePos+nextLine pos = incSourceLine (setSourceColumn pos 1) 1++nextCol :: SourcePos -> SourcePos+nextCol pos = incSourceColumn pos 1++lexColon :: SourcePos -> String -> [Token]+lexColon pos [] = [Token (pos, Colon)]+lexColon pos (':':rest) =+ Token (pos, DoubleColon) : lexWork (incSourceColumn pos 2) rest+lexColon pos (other:rest) =+ Token (pos, Colon) : lexWork (nextCol pos) (other:rest)++-- lex the rest of a string following the first quote mark+-- must skip escaped quotes, and escaped backslashes+-- include the final quote mark in the result+lexTailQuotedString :: String -> (String, String)+lexTailQuotedString [] = ([], [])+lexTailQuotedString str@('\'':xs) = ([], str)+-- a backslash then a quote is escaped+lexTailQuotedString ('\\':'\'':xs)+ = let (string, rest) = lexTailQuotedString xs in ('\'':string, rest)+-- a backslash then a backslash is an escaped backslash+lexTailQuotedString ('\\':'\\':xs)+ = let (string, rest) = lexTailQuotedString xs in ('\\':'\\':string, rest)+lexTailQuotedString (x:xs)+ = let (string, rest) = lexTailQuotedString xs in (x:string, rest)
+ src/Main.hs view
@@ -0,0 +1,284 @@+{-# LANGUAGE CPP #-}+{-------------------------------------------------------------------------------++ Copyright: Bernie Pope 2004++ Module: Main++ Description: The top module in baskell. Implements the+ read-eval-print loop of the interpreter.++ Primary Authors: Bernie Pope++-------------------------------------------------------------------------------}++{-+ This file is part of baskell.++ baskell is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ baskell is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with baskell; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Main where++import Pretty+ ( prettyText )++import Parser+ ( parse )++import AST+ ( Program (..)+ , Decl (..)+ , Exp+ , emptyProgram+ , isEmptyProgram+ )++import System.IO+ ( stdout+ , hSetBuffering+ , BufferMode (NoBuffering)+ )++import Reduce+ ( runExp+ , buildEnv+ , Env+ , joinEnv+ )++import Primitives+ ( primDecls+ , primTypes+ )++import Data.Char+ ( isSpace )++import Rename+ ( renameExp+ , renameProgram+ )++import Type+ ( Type )++import TypeCheck+ ( typeCheckExpression+ , typeCheckProgram+ , Constraint+ , renderConstraints+ )++import Control.Monad+ ( when )++import Depend+ ( depend+ , printDepends+ )++import Help+ ( printHelp )++import CmdLine+ ( Command (..)+ , getCommand+ , initializeCmdLine+ )++import Control.Concurrent+ ( myThreadId+ , ThreadId+ )++import System.Posix.Signals+ ( sigINT+ , installHandler+ , Handler (..)+ )++import Control.Exception+ ( try+ , throwTo+ , Exception (..)+ )++--------------------------------------------------------------------------------++-- the state of the interpreter+data State+ = State+ { state_prelude :: Program -- the Prelude functions+ , state_currentProgram :: Program -- the functions of a loaded module+ , state_currentEnv :: Env -- prims + prelude + current+ , state_primEnv :: Env -- primitive functions+ , state_primTypes :: [Constraint] -- types of primitive functions+ , state_preludeTypes :: [Constraint] -- types of Prelude functions+ , state_currentTypes :: [Constraint] -- types of loaded module+ , state_count :: Int -- unique number (for fresh vars)+ }++main :: IO ()+main = do+ catchCtrlC+ hSetBuffering stdout NoBuffering+ initializeCmdLine+ putStrLn "Welcome to Baskell"+ putStrLn "Bernie's Amazing Super-Kool Equational Low-fat Language"+ initState <- initialiseState+ putStrLn "Type :h for help"+ repLoop initState++catchCtrlC :: IO Handler+catchCtrlC+ = do thisThread <- myThreadId+ installHandler sigINT (Catch (hupHandler thisThread)) Nothing+ where+ hupHandler :: ThreadId -> IO ()+ hupHandler theThread+ = throwTo theThread (ErrorCall "Interrupt Signal")++-- initialise the state of the debugger+-- * set up the primitive functions+-- * load the Prelude+initialiseState :: IO State+initialiseState = do+ putStrLn "Loading the Prelude..."+ let (renamedPrims, primCount)+ = renameProgram (Program primDecls) 0+ primEnv = buildEnv renamedPrims+ primState = State+ { state_prelude = emptyProgram+ , state_currentProgram = emptyProgram+ , state_currentEnv = primEnv+ , state_primEnv = primEnv+ , state_primTypes = primTypes+ , state_preludeTypes = []+ , state_currentTypes = []+ , state_count = primCount+ }+ preludeState <- load primState "Prelude.bs"+ return $ preludeState+ { state_prelude = state_currentProgram preludeState+ , state_currentProgram = emptyProgram+ , state_preludeTypes = state_currentTypes preludeState+ , state_currentTypes = []+ }++-- the Read Eval Print Loop of the interpreter+repLoop :: State -> IO ()+repLoop state = do+ command <- getCommand+ case command of+ Load file -> do+ newState <- load state file+ repLoop newState+ Eval exp -> do+ result <- try $ eval state exp+ case result of+ Left e -> putStrLn "Interrupted!"+ Right () -> return ()+ repLoop state+ Type exp -> typeExp state exp >> repLoop state+ Browse -> browse state >> repLoop state+ Quit -> putStrLn "Leaving baskell."+ Help -> printHelp >> repLoop state+#ifdef DEBUG+ ShowAST -> do+ putStrLn "The abstract syntax tree:"+ print $ state_currentProgram state+ repLoop state+ ShowDepend -> do+ putStrLn "Function dependencies:"+ printDepends $ state_currentProgram state+ repLoop state+#endif++-- evaluate an expression from the command line+eval :: State -> Exp -> IO ()+eval state exp+ = do let renamedExp = renameExp exp (state_count state)+ finalForm = runExp (state_currentEnv state) renamedExp+ putStrLn $ prettyText finalForm++-- infer the type of an expression on the command line+typeExp :: State -> Exp -> IO ()+typeExp state exp+ = do let renamedExp = renameExp exp (state_count state)+ assumptions = state_primTypes state +++ state_preludeTypes state +++ state_currentTypes state+ typeCheckExpression assumptions renamedExp++-- load a user defined Baskell module+load :: State -> FilePath -> IO State+load state file = do+ contents <- safeReadFile file+ if null contents+ then return state+ else parseRenameAndType state file contents++-- parse a file, rename identifiers, and type check it+-- if successful update the state of the interpreter+parseRenameAndType :: State -> FilePath -> String -> IO State+parseRenameAndType state file contents+ = do case parse file contents of+ Left e+ -> do putStrLn $ "Parse error: " ++ show e+ putStrLn $ file ++ " not loaded"+ return state+ Right program+ -> do putStrLn $ "Load of " ++ file ++ " successful"+ let oldCount = state_count state+ (renamed, count) = renameProgram program oldCount+ assumptions = state_primTypes state +++ state_preludeTypes state+ programTypes <- typeCheckProgram assumptions renamed+ let primEnv = state_primEnv state+ preludeEnv = buildEnv $ state_prelude state+ thisProgEnv = buildEnv renamed+ currentEnv = primEnv `joinEnv`+ preludeEnv `joinEnv`+ thisProgEnv+ return $+ state+ { state_currentProgram = renamed+ , state_currentEnv = currentEnv+ , state_count = count+ , state_currentTypes = programTypes+ }++-- try to read a file but catch exceptions+safeReadFile :: FilePath -> IO String+safeReadFile file+ = catch (readFile file)+ $ \e -> do putStrLn $ show e+ putStrLn "Program not loaded"+ return []++-- print the types of the primitive functions, Prelude functions+-- and functions from a loaded module if one exists+browse :: State -> IO ()+browse state+ = do display "\n--- Primitive functions ---\n" $ state_primTypes state+ display "\n--- The Prelude ---\n" $ state_preludeTypes state+ display "\n--- The current program ---\n" $ state_currentTypes state+ where+ display :: String -> [Constraint] -> IO ()+ display header types+ = when (not $ null types) $+ do putStrLn header+ putStrLn $ renderConstraints types
+ src/Parser.hs view
@@ -0,0 +1,300 @@+{-------------------------------------------------------------------------------++ Copyright: Bernie Pope 2007++ Module: Parser++ Description: Baskell's parser for programs and expressions.++ Primary Authors: Bernie Pope++-------------------------------------------------------------------------------}++{-+ This file is part of baskell.++ baskell is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ baskell is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with baskell; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Parser+ ( parse+ , expParser+ )+ where++import Text.ParserCombinators.Parsec+ ( ParseError+ , runParser+ , many+ , many1+ , eof+ , sepEndBy1+ , pzero+ , (<|>)+ , between+ , sepBy+ , sepBy1+ )++import Lexer+ ( lexer )++import AST+ ( Ident+ , Exp (..)+ , Lit (..)+ , Decl (..)+ , Program (..)+ , list+ )++import Type+ ( Type (..) )++import ParserUtils+ ( Parser+ , equals+ , rightArrow+ , comma+ , singleQuoted+ , leftRoundBracket+ , rightRoundBracket+ , leftSquareBracket+ , rightSquareBracket+ , backSlash+ , exclamation+ , semiColon+ , doubleColon+ , int+ , word+ )++import Control.Monad+ ( liftM )++import Data.Char+ ( isLower+ , isUpper+ )++--------------------------------------------------------------------------------++parse :: String -> String -> Either ParseError Program+parse filename input+ = runParser programParser () filename $ lexer filename input++-- programs+programParser :: Parser Program+programParser = liftM Program $ many declParser++-- types+typeParser :: Parser Type+typeParser = do+ ts <- sepBy1 type2Parser rightArrow+ return $ foldr1 TFun ts++type2Parser :: Parser Type+type2Parser =+ tyVarConParser <|>+ tupleTyParser <|>+ listTyParser++listTyParser :: Parser Type+listTyParser =+ liftM TList $+ between leftSquareBracket rightSquareBracket typeParser++tupleTyParser :: Parser Type+tupleTyParser = parenParser typeParser TTuple++tyVarConParser :: Parser Type+tyVarConParser = do+ str <- word+ if null str+ then fail "internal error: zero length identifier"+ else case head str of+ firstLetter+ | isLower firstLetter -> return $ TVar 0+ | isUpper firstLetter -> parseCon str+ | otherwise+ -> fail $ "internal error: not ident or constructor: " ++ str+ where+ -- we have only a limited set of valid data constructors+ parseCon :: String -> Parser Type+ parseCon str+ = case str of+ "Int" -> return TInt+ "Bool" -> return TBool+ "Char" -> return TChar+ other -> fail $ "unexpected constructor: " ++ str++-- declarations+-- identifier = expression ;+declParser :: Parser Decl+declParser = do+ identifier <- ident+ parseFunDecl identifier <|> parseTySig identifier++parseTySig :: Ident -> Parser Decl+parseTySig identifier = do+ doubleColon+ t <- typeParser+ semiColon+ return $ Sig identifier t++parseFunDecl :: Ident -> Parser Decl+parseFunDecl identifier = do+ equals+ exp <- expParser+ semiColon+ return $ Decl identifier exp++-- expressions+-- * applications are indicated by juxtaposition, as in Haskell+-- * a non-application expression is something other than an+-- application+-- * an application is a juxtaposition of non-application expressions+-- * non-application expressions may contain sub-expressions which+-- are application expressions, thus the two kinds are+-- mutually recursive+-- * we make the distinction between the two to avoid left-recursion+-- in the grammar++-- an application expression, or just a single non-application expression+expParser :: Parser Exp+expParser = do+ es <- many1 expParserNonApp+ case length es of+ 0 -> pzero+ 1 -> return $ head es+ n -> return $ foldl1 App es++-- non-application expressions+-- * variables+-- * strict and non-strict lambda abstractions+-- * literals+-- * parenthesised expressions (including tuples)+-- * lists+expParserNonApp :: Parser Exp+expParserNonApp+ = varConParser+ <|> lamParser+ <|> lamParserStrict+ <|> litParser+ <|> parenExpParser+ <|> listParser++-- a variable (identifier) must start with a lower case+-- alphabetic letter+ident :: Parser String+ident = do+ str <- word+ if null str+ then fail "internal error: zero length identifier"+ else case head str of+ firstLetter+ | isLower firstLetter -> return str+ | otherwise -> fail $ "invalid identifier: " ++ str++-- parser for variables or constructors+-- distinguised by the case of the first letter+-- as with Haskell, data constuctors start with an uppercase+-- and variables with a lowercase+varConParser :: Parser Exp+varConParser = do+ str <- word+ if null str+ then fail "internal error: zero length identifier"+ else case head str of+ firstLetter+ | isLower firstLetter -> return $ Var str+ | isUpper firstLetter -> parseCon str+ | otherwise+ -> fail $ "internal error: not ident or constructor: " ++ str+ where+ -- we have only a limited set of valid data constructors+ parseCon :: String -> Parser Exp+ parseCon str+ = case str of+ "True" -> return $ Literal $ LitBool True+ "False" -> return $ Literal $ LitBool False+ "Cons" -> return $ Literal LitCons+ other -> fail $ "unexpected constructor: " ++ str++-- non-strict lambdas, start with a backslash+lamParser :: Parser Exp+lamParser = do+ backSlash+ (id, e) <- lamSubstance+ return $ Lam id e++-- strict lambdas, start with an exclamation mark+lamParserStrict :: Parser Exp+lamParserStrict = do+ exclamation+ (id, e) <- lamSubstance+ return $ LamStrict id e++-- the part of lambdas that doesn't change between lazy and strict+lamSubstance :: Parser (Ident, Exp)+lamSubstance = do+ id <- ident+ rightArrow+ e <- expParser+ return (id, e)++-- wrapper for the literal parser+litParser :: Parser Exp+litParser = liftM Literal literalParser++-- lists, uses the square bracket notation of Haskell+-- with comma delimiters+listParser :: Parser Exp+listParser =+ liftM list $ between leftSquareBracket rightSquareBracket $+ sepBy expParser comma++-- could be a parenthesised expression or a tuple+parenExpParser :: Parser Exp+parenExpParser = parenParser expParser Tuple++parenParser :: Parser a -> ([a] -> a) -> Parser a+parenParser p tupler = do+ xs <- between leftRoundBracket rightRoundBracket (sepBy1 p comma)+ if length xs == 1+ then return $ head xs+ else return $ tupler xs++-- literals are ints or chars+literalParser :: Parser Lit+literalParser = litInt <|> litChar++litInt :: Parser Lit+litInt = liftM LitInt int++-- chars are single quoted, if they are more than one character+-- long then must check for validity+litChar :: Parser Lit+litChar+ = do charName <- singleQuoted+ case validateCharName charName of+ Nothing -> fail $ "badly formed character literal: " ++ charName+ Just c -> return $ LitChar c+ where+ validateCharName :: String -> Maybe Char+ validateCharName s+ | length s == 1 = Just $ head s+ -- the only valid mult-char character sequences (escaped chars)+ | otherwise = lookup s [("\\n",'\n'), ("\\t", '\t')]
+ src/ParserUtils.hs view
@@ -0,0 +1,148 @@+{-------------------------------------------------------------------------------++ Copyright: Bernie Pope 2004++ Module: ParserUtils++ Description: Utilities that support Baskell's parser. ++ Primary Authors: Bernie Pope++-------------------------------------------------------------------------------}++{-+ This file is part of baskell.++ baskell is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ baskell is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with baskell; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module ParserUtils+ ( Parser+ , equals+ , rightArrow + , comma+ , semiColon+ , singleQuoted+ , leftRoundBracket+ , rightRoundBracket+ , leftSquareBracket+ , rightSquareBracket+ , backSlash+ , exclamation + , colon+ , doubleColon+ , int+ , word+ )+ where++import Text.ParserCombinators.Parsec+ ( GenParser+ , token+ , skipMany+ , (<|>)+ )++import Lexer+ ( Token (..)+ , Symbol (..)+ ) ++import AST+ ( Ident )++--------------------------------------------------------------------------------++type Parser a = GenParser Token () a++-- basic parser for token symbols. Needed by Parsec.+tokenParser :: (Symbol -> Maybe a) -> Parser a+tokenParser test+ = token showToken posToken testToken+ where+ showToken (Token (pos,tok)) = show tok+ posToken (Token (pos,tok)) = pos+ testToken (Token (pos,tok)) = test tok++-- wrapper for tokenParser+simpleParser :: Symbol -> Parser ()+simpleParser tok+ = tokenParser $ + \next -> if next == tok + then Just () + else Nothing++equals :: Parser ()+equals = simpleParser Equals ++comma :: Parser ()+comma = simpleParser Comma ++semiColon :: Parser ()+semiColon = simpleParser SemiColon ++doubleColon :: Parser ()+doubleColon = simpleParser DoubleColon++colon :: Parser ()+colon = simpleParser Colon ++singleQuoted :: Parser String +singleQuoted + = tokenParser getQuoted+ where+ getQuoted (SingleQuoted s) = Just s+ getQuoted other = Nothing ++leftRoundBracket :: Parser ()+leftRoundBracket = simpleParser LeftRoundBracket++rightRoundBracket :: Parser ()+rightRoundBracket = simpleParser RightRoundBracket++leftSquareBracket :: Parser ()+leftSquareBracket = simpleParser LeftSquareBracket++rightSquareBracket :: Parser ()+rightSquareBracket = simpleParser RightSquareBracket++backSlash :: Parser ()+backSlash = simpleParser BackSlash ++exclamation :: Parser ()+exclamation = simpleParser Exclamation ++dash :: Parser ()+dash = simpleParser Dash ++gt :: Parser ()+gt = simpleParser GreaterThan++int :: Parser Int+int + = tokenParser number + where + number (Num n) = Just n+ number other = Nothing++word :: Parser String +word + = tokenParser getWord+ where+ getWord (Word s) = Just s+ getWord other = Nothing ++rightArrow :: Parser ()+rightArrow = dash >> gt
+ src/Pretty.hs view
@@ -0,0 +1,58 @@+{-------------------------------------------------------------------------------++ Copyright: Bernie Pope 2007++ Module: Pretty++ Description: Utilities that support pretty printing. ++ Primary Authors: Bernie Pope++-------------------------------------------------------------------------------}++{-+ This file is part of baskell.++ baskell is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ baskell is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with baskell; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Pretty+ ( module HughesPJ+ , module Pretty+ )+ where+++import Text.PrettyPrint.HughesPJ as HughesPJ++--------------------------------------------------------------------------------++prettyText :: Pretty a => a -> String+prettyText = render . pretty++class Pretty a where+ pretty :: a -> Doc+ pretty x = text "Pretty not implemented"++instance Pretty Int where+ pretty = int++instance Pretty Char where+ pretty = char ++-- conditionally wrap parentheses around a document+parensIf :: Bool -> Doc -> Doc+parensIf test doc+ = if test then parens doc else doc
+ src/Primitives.hs view
@@ -0,0 +1,423 @@+{-------------------------------------------------------------------------------++ Copyright: Bernie Pope 2004++ Module: Primitives.++ Description: Implementation of Baskell's primitive + functions --- those useful functions that+ cannot be implemented in Baskell syntax+ (either conveniently or at all).++ Examples are integer addition, and if-then-else.++ Also defines a type for each primitive + function.++ Primary Authors: Bernie Pope++-------------------------------------------------------------------------------}++{-+ This file is part of baskell.++ baskell is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ baskell is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with baskell; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Primitives+ ( primDecls + , primTypes+ )+ where++import AST+ ( Decl (..)+ , Exp (..)+ , Lit (..)+ , (=:)+ , var+ , lam+ , (@@)+ , app+ , litI+ , litC+ , litB+ , list+ , tup+ , prim+ ) ++import TypeCheck+ ( Binding (LetBound) + , Constraint + , SolverType (..)+ )+ +--------------------------------------------------------------------------------++-- all the primitive function declarations+primDecls :: [Decl]+primDecls+ = [primHead, primTail, primNull, primPlus, primSub, primMult, primITE,+ primFst, primSnd, primLT, primGT, primEQInt, primDiv, primMod,+ primIsTuple+ ]++-- types of all the primitive functions+primTypes :: [Constraint]+primTypes+ = [primHeadTy, primTailTy, primNullTy, primPlusTy, primSubTy, primMultTy, primITETy,+ primFstTy, primSndTy, primLTTy, primGTTy, primEQIntTy, primDivTy, primModTy,+ primIsTupleTy+ ]++-- helper for making unary prims+unaryPrim :: String -> (Exp -> Maybe Exp) -> Exp +unaryPrim name impl + = lam ["x"] (prim name impl @@ var "x")++-- helper for making binary prims+binaryPrim :: String -> (Exp -> Maybe Exp) -> Exp +binaryPrim name impl+ = lam ["x","y"] (prim name impl @@ var "x" @@ var "y")++-- helper for making ternary prims+ternaryPrim :: String -> (Exp -> Maybe Exp) -> Exp +ternaryPrim name impl+ = lam ["x","y","z"] (prim name impl @@ var "x" @@ var "y" @@ var "z")++-- helper for making types of prims+primType :: String -> SolverType -> Constraint +primType name t + = (TypeOf LetBound name, t)++--------------------------------------------------------------------------------++-- head of a list++headName = "head"++primHead :: Decl+primHead + = headName =: unaryPrim headName thisPrim+ where + thisPrim :: Exp -> Maybe Exp+ thisPrim (App (App (Literal LitCons) hd) _tail) = Just hd+ thisPrim other = Nothing++primHeadTy :: Constraint +primHeadTy = primType headName (TFun (TList (TVar 1)) (TVar 1))++--------------------------------------------------------------------------------++-- tail of a list++tailName = "tail"++primTail :: Decl+primTail+ = tailName =: unaryPrim tailName thisPrim + where+ thisPrim :: Exp -> Maybe Exp+ thisPrim (App (App (Literal LitCons) _hd) tail) = Just tail + thisPrim other = Nothing++primTailTy :: Constraint+primTailTy = primType tailName (TFun (TList (TVar 1)) (TList (TVar 1)))++--------------------------------------------------------------------------------++-- test if a list is empty++nullName = "null"++primNull :: Decl+primNull+ = nullName =: unaryPrim nullName thisPrim + where+ thisPrim :: Exp -> Maybe Exp+ thisPrim (Literal LitNil) = Just $ litB True+ thisPrim (App (App (Literal LitCons) _hd) _tail) = Just $ litB False + thisPrim other = Nothing++primNullTy :: Constraint+primNullTy = primType nullName (TFun (TList (TVar 1)) TBool)++--------------------------------------------------------------------------------++-- first item in a tuple++fstName = "fst"++primFst :: Decl+primFst+ = fstName =: unaryPrim fstName thisPrim+ where+ thisPrim :: Exp -> Maybe Exp+ thisPrim (Tuple [x,_y]) = Just x + thisPrim other = Nothing++primFstTy :: Constraint+primFstTy = primType fstName (TFun (TTuple [TVar 1, TVar 2]) (TVar 1))++--------------------------------------------------------------------------------++-- second item in a tuple++sndName = "snd"++primSnd :: Decl+primSnd+ = sndName =: unaryPrim sndName thisPrim+ where+ thisPrim :: Exp -> Maybe Exp+ thisPrim (Tuple [_x,y]) = Just y + thisPrim other = Nothing++primSndTy :: Constraint+primSndTy = primType sndName (TFun (TTuple [TVar 1, TVar 2]) (TVar 2))++--------------------------------------------------------------------------------++-- test for a tuple +-- note this function has type: a -> Bool+-- this is not available in Haskell, it would normally need some kind+-- of meta-programming facility++isTupleName = "isTuple"++primIsTuple :: Decl+primIsTuple+ = isTupleName =: unaryPrim isTupleName thisPrim+ where+ thisPrim :: Exp -> Maybe Exp+ thisPrim (Tuple _) = Just $ Literal $ LitBool True+ thisPrim other = Just $ Literal $ LitBool False ++primIsTupleTy :: Constraint+primIsTupleTy = primType isTupleName (TFun (TVar 1) TBool)++--------------------------------------------------------------------------------++-- integer addition++plusName = "plus"++primPlus :: Decl+primPlus+ = plusName =: binaryPrim plusName thisPrim+ where+ thisPrim :: Exp -> Maybe Exp+ thisPrim (Literal (LitInt i))+ = Just $ unaryPrim (plusName ++ "_partial(1)") (addition i) + where+ addition :: Int -> Exp -> Maybe Exp+ addition i (Literal (LitInt j))+ = Just $ litI $ i + j + addition i other = Nothing+ thisPrim other = Nothing++primPlusTy :: Constraint+primPlusTy = primType plusName (TFun TInt (TFun TInt TInt)) ++--------------------------------------------------------------------------------++-- integer subtraction++subName = "sub"++primSub :: Decl+primSub+ = subName =: binaryPrim subName thisPrim+ where+ thisPrim :: Exp -> Maybe Exp+ thisPrim (Literal (LitInt i))+ = Just $ unaryPrim (subName ++ "_partial(1)") (subtraction i) + where+ subtraction :: Int -> Exp -> Maybe Exp+ subtraction i (Literal (LitInt j))+ = Just $ litI $ i - j + subtraction i other = Nothing+ thisPrim other = Nothing++primSubTy :: Constraint+primSubTy = primType subName (TFun TInt (TFun TInt TInt)) ++--------------------------------------------------------------------------------++-- integer multiplication++multName = "mult"++primMult :: Decl+primMult+ = multName =: binaryPrim multName thisPrim+ where+ thisPrim :: Exp -> Maybe Exp+ thisPrim (Literal (LitInt i))+ = Just $ unaryPrim (multName ++ "_partial(1)") (mult i)+ where+ mult :: Int -> Exp -> Maybe Exp+ mult i (Literal (LitInt j))+ = Just $ litI $ i * j + mult i other = Nothing+ thisPrim other = Nothing++primMultTy :: Constraint+primMultTy = primType multName (TFun TInt (TFun TInt TInt)) ++--------------------------------------------------------------------------------++-- integer division++divName = "div"++primDiv :: Decl+primDiv+ = divName =: binaryPrim divName thisPrim+ where+ thisPrim :: Exp -> Maybe Exp+ thisPrim (Literal (LitInt i))+ = Just $ unaryPrim (divName ++ "_partial(1)") (divide i)+ where+ divide :: Int -> Exp -> Maybe Exp+ divide i (Literal (LitInt j))+ = Just $ litI $ i `div` j+ divide i other = Nothing+ thisPrim other = Nothing++primDivTy :: Constraint+primDivTy = primType divName (TFun TInt (TFun TInt TInt)) ++--------------------------------------------------------------------------------++-- integer modulus++modName = "mod"++primMod :: Decl+primMod+ = modName =: binaryPrim modName thisPrim+ where+ thisPrim :: Exp -> Maybe Exp+ thisPrim (Literal (LitInt i))+ = Just $ unaryPrim (modName ++ "_partial(1)") (modulus i)+ where + modulus :: Int -> Exp -> Maybe Exp+ modulus i (Literal (LitInt j))+ = Just $ litI $ i `mod` j+ modulus i other = Nothing+ thisPrim other = Nothing++primModTy :: Constraint+primModTy = primType modName (TFun TInt (TFun TInt TInt)) ++--------------------------------------------------------------------------------++-- integer less than++ltName = "lt"++primLT :: Decl+primLT+ = ltName =: binaryPrim ltName thisPrim+ where+ thisPrim :: Exp -> Maybe Exp+ thisPrim (Literal (LitInt i))+ = Just $ unaryPrim (ltName ++ "_partial(1)") (lt i) + where+ lt :: Int -> Exp -> Maybe Exp+ lt i (Literal (LitInt j))+ = Just $ litB $ i < j + lt i other = Nothing+ thisPrim other = Nothing++primLTTy :: Constraint+primLTTy = primType ltName (TFun TInt (TFun TInt TBool)) ++--------------------------------------------------------------------------------++-- integer greater than++gtName = "gt"++primGT :: Decl+primGT+ = gtName =: binaryPrim gtName thisPrim+ where+ thisPrim :: Exp -> Maybe Exp+ thisPrim (Literal (LitInt i))+ = Just $ unaryPrim (gtName ++ "_partial(1)") (gt i)+ where+ gt :: Int -> Exp -> Maybe Exp+ gt i (Literal (LitInt j))+ = Just $ litB $ i > j+ gt i other = Nothing+ thisPrim other = Nothing+++primGTTy :: Constraint+primGTTy = primType gtName (TFun TInt (TFun TInt TBool)) ++--------------------------------------------------------------------------------++-- integer equality++eqIntName = "eqI"++primEQInt :: Decl+primEQInt+ = eqIntName =: binaryPrim eqIntName thisPrim+ where+ thisPrim :: Exp -> Maybe Exp+ thisPrim (Literal (LitInt i))+ = Just $ unaryPrim (eqIntName ++ "_partial(1)") (eq i)+ where+ eq :: Int -> Exp -> Maybe Exp+ eq i (Literal (LitInt j))+ = Just $ litB $ i == j+ eq i other = Nothing+ thisPrim other = Nothing++primEQIntTy :: Constraint+primEQIntTy = primType eqIntName (TFun TInt (TFun TInt TBool)) ++--------------------------------------------------------------------------------++-- if-then-else++iteName = "ite"++primITE :: Decl+primITE+ = iteName =: ternaryPrim iteName thisPrim+ where+ thisPrim :: Exp -> Maybe Exp+ thisPrim (Literal (LitBool b))+ = Just $ binaryPrim (iteName ++ "_partial(2)") (ite b) + where+ ite :: Bool -> Exp -> Maybe Exp+ ite True exp+ = Just $ unaryPrim (iteName ++ "_partial(1)") (trueBranch exp)+ ite False exp+ = Just $ unaryPrim (iteName ++ "_partial(1)") falseBranch + trueBranch :: Exp -> Exp -> Maybe Exp+ trueBranch keep ignore = Just keep+ falseBranch :: Exp -> Maybe Exp+ falseBranch keep = Just keep + thisPrim other = Nothing++primITETy :: Constraint+primITETy = primType iteName (TFun TBool (TFun (TVar 1) (TFun (TVar 1) (TVar 1))))
+ src/Reduce.hs view
@@ -0,0 +1,205 @@+{-------------------------------------------------------------------------------++ Copyright: Bernie Pope 2007++ Module: Reduce++ Description: Evaluation of Baskell expressions. Achieved by+ a term re-writing system. Takes an arbitrary+ Baskell expression and continually applies+ reduction rules on it until no more rules apply.+ In some cases this may be an infinite process.++ Allows non-strict and strict evaluation.++ A top-level evaluator is provided which demands+ the entire final result (ie, unlike a lazy+ evaluator it does not stop when the term+ reaches weak head normal form, but+ continues evaluating inside the term). This is+ needed by the interpreter because we usually+ want this kind of deep evaluation at the top+ level of the read-eval-print loop. However it+ does not evaluate under lambda abstractions+ (in case the top level expression is a+ function).++ If the term is not well typed then the evaluator+ might get stuck. This means evaluation will end+ but the term is not a value (though technically+ it is a normal form).+ Of course, what it means to be well typed+ depends on your type system. Baskell's type+ checker does not reject any program, so it will+ try to reduce absolutely anything, even if it+ does not make sense semantically+ (such as: plus True 3, which will get stuck).++ Primary Authors: Bernie Pope++-------------------------------------------------------------------------------}++{-+ This file is part of baskell.++ baskell is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ baskell is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with baskell; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Reduce+ ( runExp+ , Env+ , buildEnv+ , emptyEnv+ , joinEnv+ )+ where++import AST+ ( Exp (..)+ , Decl (..)+ , Program (..)+ , Ident+ , Lit (..)+ )++import qualified Data.Map as Map+ ( Map+ , empty+ , fromList+ , empty+ , union+ , insert+ , lookup+ )++import Control.Monad.Reader+ ( Reader+ , runReader+ , ask+ )++import Control.Monad+ ( liftM+ , liftM2+ )++--------------------------------------------------------------------------------++-- an environment is a mapping from variables to their values+type Env = Map.Map Ident Exp+type Eval a = Reader Env a++emptyEnv :: Env+emptyEnv = Map.empty++joinEnv :: Env -> Env -> Env+joinEnv = Map.union++buildEnv :: Program -> Env+buildEnv (Program decls)+ = Map.fromList [ (name, body) | Decl name body <- decls ]++-- top level evaluator - evaluates inside lists and tuples+runExp :: Env -> Exp -> Exp+runExp env exp = runReader (evaluate exp) env++evaluate :: Exp -> Eval Exp+evaluate exp = do+ reduct <- reduce exp+ case reduct of+ App (App (Literal LitCons) hd) tl+ -> liftM2 (App . App (Literal LitCons))+ (evaluate hd) (evaluate tl)+ Tuple exps+ -> liftM Tuple $ mapM evaluate exps+ other -> return other++-- reduce an expression to Weak Head Normal Form (WHNF) under a given+-- environment. It is assumed that top-level functions will be+-- in the initial environment.+--+-- * variables that are not in the environment are unbound and+-- they reduce to themselves+-- * an expression is in WHNF if it is a lambda abstraction+-- or if it is an application of a constructor+-- * the arguments of primitive functions are reduced+-- before the application is reduced because primitives+-- are strict in their arguments.++reduce :: Exp -> Eval Exp++reduce exp | isWHNF exp = return exp++reduce exp@(Var i) = do+ env <- ask+ case Map.lookup i env of+ Nothing -> return exp+ Just val -> reduce val++reduce (App (Prim _name prim) arg) = do+ reduct <- reduce arg+ case prim reduct of+ Nothing -> return (App (Prim _name prim) arg)+ Just result -> reduce result++reduce (App (Lam var body) arg) =+ reduce $ substitute var arg body++reduce (App (LamStrict var body) arg) = do+ argReduct <- reduce arg+ seq argReduct $ reduce $ substitute var argReduct body++reduce (App nonLam arg) = do+ funReduct <- reduce nonLam+ if isLambda funReduct -- to avoid infinite loops on ill-typed terms+ then reduce $ App funReduct arg+ else return $ App funReduct arg++reduce other = return other++isLambda :: Exp -> Bool+isLambda (Lam {}) = True+isLambda (LamStrict {}) = True+isLambda other = False++-- XXX fixme+isWHNF :: Exp -> Bool+isWHNF (Lam {}) = True+isWHNF (LamStrict {}) = True+isWHNF (Literal {}) = True+isWHNF (App (Literal LitCons) _hd) = True+isWHNF (App (App (Literal LitCons) _hd) _tl) = True+isWHNF (Tuple {}) = True+isWHNF other = False++-- replace all free occurrences of an identifier+-- with an expression (part of Beta reduction)+substitute :: Ident -> Exp -> Exp -> Exp+substitute ident1 val exp@(Var ident2)+ | ident1 == ident2 = val+ | otherwise = exp+substitute ident1 val exp@(Lam ident2 body)+ | ident1 == ident2 = exp+ | otherwise = Lam ident2 (substitute ident1 val body)+substitute ident1 val exp@(LamStrict ident2 body)+ | ident1 == ident2 = exp+ | otherwise = LamStrict ident2 (substitute ident1 val body)+substitute ident val (App e1 e2)+ = App (substitute ident val e1)+ (substitute ident val e2)+substitute ident val exp@(Literal lit) = exp+substitute ident val (Tuple exps)+ = Tuple $ map (substitute ident val) exps+substitute ident val exp@(Prim _name _implementation) = exp
+ src/Rename.hs view
@@ -0,0 +1,177 @@+{-------------------------------------------------------------------------------++ Copyright: Bernie Pope 2007++ Module: Rename++ Description: Renames all lambda-bound identifiers apart in+ expressions and programs. For example:++ rename (\x -> plus 1 x) might produce+ (\x_12 -> plus 1 x_12), assuming plus is not+ lambda bound.++ This is needed to avoid inadvertant name+ capture during program evaluation. For example:++ (\y -> \id -> (y, id)) id True++ should reduce to:++ (id, True)++ and not:++ (True, True)++ Primary Authors: Bernie Pope++ Notes:++ We don't rename "top-level" identifiers (those defined in a declaration)+ because they are assumed to be unique. Baskell does not have local+ declarations so this does not cause any problems. It is a syntax error+ to have two top-level declarations with the same name, however Baskell+ might not check for this.++-------------------------------------------------------------------------------}++{-+ This file is part of baskell.++ baskell is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ baskell is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with baskell; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Rename+ ( renameExp+ , renameProgram+ )+ where++import AST+ ( Ident+ , Exp (..)+ , Decl (..)+ , Program (..)+ )++import qualified Data.Map as Map+ ( Map+ , empty+ , fromList+ , union+ , insert+ , lookup+ )++import Control.Monad+ ( liftM+ , liftM2+ )++import Control.Monad.State+ ( runStateT+ , evalStateT+ , get+ , put+ , StateT+ , gets+ , modify+ , execStateT+ )++import Control.Monad.Trans+ ( lift+ , liftIO+ )++import Control.Monad.Identity+ ( Identity+ , runIdentity+ )++import Control.Monad.Reader+ ( ReaderT+ , local+ , ask+ , runReaderT+ )++--------------------------------------------------------------------------------++type NameEnv = Map.Map Ident Ident+type RnState = Int+type Rn a = ReaderT NameEnv (StateT RnState Identity) a++renameProgram :: Program -> RnState -> (Program, RnState)+renameProgram prog state =+ runIdentity $ runStateT (runReaderT (renameProgramM prog) Map.empty) state++renameExp :: Exp -> RnState -> Exp+renameExp exp state =+ runIdentity $ evalStateT (runReaderT (renameExpM exp) Map.empty) state++extendEnv :: Ident -> Ident -> Rn a -> Rn a+extendEnv identOld identNew action =+ local (Map.insert identOld identNew) action++lookupIdent :: Ident -> Rn String+lookupIdent oldName = do+ env <- ask+ case Map.lookup oldName env of+ Nothing -> return oldName+ Just newName -> return newName++-- renamed identifiers are appended with an underscore and a number+-- this is safe because underscores are not allowed by the parser+-- so there is no chance we will introduce an inadvertant name+-- clash during renaming+renameIdent :: Ident -> Rn Ident+renameIdent oldName = do+ count <- lift get+ lift $ put (count + 1)+ return $ oldName ++ "_" ++ show count++renameDecl :: Decl -> Rn Decl+renameDecl decl@(Sig {}) = return decl+renameDecl (Decl name body) =+ liftM (Decl name) $ renameExpM body++renameProgramM :: Program -> Rn Program+renameProgramM(Program decls) =+ liftM Program $ mapM renameDecl decls++renameExpM :: Exp -> Rn Exp+renameExpM (Var ident) =+ liftM Var $ lookupIdent ident++renameExpM (Lam ident body) = do+ newIdent <- renameIdent ident+ liftM (Lam newIdent) $ extendEnv ident newIdent $ renameExpM body++renameExpM (LamStrict ident body) = do+ newIdent <- renameIdent ident+ liftM (LamStrict newIdent) $ extendEnv ident newIdent $ renameExpM body++renameExpM (App e1 e2) =+ liftM2 App (renameExpM e1) (renameExpM e2)++renameExpM exp@(Literal lit) = return exp++renameExpM (Tuple exps) =+ liftM Tuple $ mapM renameExpM exps++renameExpM exp@(Prim _name _impl) =+ return exp
+ src/Type.hs view
@@ -0,0 +1,123 @@+{-------------------------------------------------------------------------------++ Copyright: Bernie Pope 2007++ Module: Type++ Description: A representation of types.++ Primary Authors: Bernie Pope++-------------------------------------------------------------------------------}++{-+ This file is part of baskell.++ baskell is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ baskell is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with baskell; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Type (Type (..)) where++import Pretty+ ( parensIf+ , text+ , (<+>)+ , render+ , vcat+ , Doc+ , parens+ , cat+ , (<>)+ , punctuate+ , comma+ , brackets+ , int+ , empty+ , ($$)+ , Pretty (..)+ )++import Utils (nameSupply)++import qualified Data.Map as Map++import Data.List (mapAccumL)++--------------------------------------------------------------------------------++-- types+data Type+ = TVar Int -- type variables, identified by a unique number+ | TInt -- integers+ | TChar -- characters+ | TBool -- booleans+ | TList Type -- lists+ | TFun Type Type -- functions+ | TTuple [Type] -- tuples+ deriving (Eq, Show)++instance Pretty Type where+ pretty ty = prettyType ty++-- pretty printing of types, type variables get nice names+prettyType :: Type -> Doc+prettyType = snd . prettyTypeWorker False initPrettyState++prettyTypeWorker :: Bool -> PrettyState -> Type -> (PrettyState, Doc)+prettyTypeWorker _bracks state (TVar i)+ = case Map.lookup i varMap of+ Nothing -> (newState, text newName)+ Just name -> (state, text name)+ where+ varMap = prettyState_varMap state+ nameSupply = prettyState_nameSupply state+ newName = head nameSupply+ newState+ = PrettyState+ { prettyState_varMap = Map.insert i newName varMap+ , prettyState_nameSupply = tail nameSupply+ }+prettyTypeWorker _bracks state TInt = (state, text "Int")+prettyTypeWorker _bracks state TChar = (state, text "Char")+prettyTypeWorker _bracks state TBool = (state, text "Bool")+prettyTypeWorker _bracks state (TList t)+ = (newState, brackets doc)+ where+ (newState, doc) = prettyTypeWorker False state t+prettyTypeWorker bracks state (TFun t1 t2)+ = (newState, doc)+ where+ (t1State, t1Doc) = prettyTypeWorker True state t1+ (newState, t2Doc) = prettyTypeWorker False t1State t2+ doc = parensIf bracks (t1Doc <+> text "->" <+> t2Doc)+prettyTypeWorker _bracks state (TTuple ts)+ = (newState, doc)+ where+ (newState, tsDoc) = mapAccumL (prettyTypeWorker False) state ts+ doc = parens $ cat $ punctuate comma tsDoc++data PrettyState+ = PrettyState+ { prettyState_varMap :: Map.Map Int String+ , prettyState_nameSupply :: [String]+ }++initPrettyState :: PrettyState+initPrettyState+ = PrettyState+ { prettyState_varMap = Map.empty+ , prettyState_nameSupply = nameSupply+ }+