diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. + + + Copyright (C) + + 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. + + , 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. diff --git a/Prelude.bs b/Prelude.bs new file mode 100644 --- /dev/null +++ b/Prelude.bs @@ -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)))); diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/baskell.cabal b/baskell.cabal new file mode 100644 --- /dev/null +++ b/baskell.cabal @@ -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 +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 + diff --git a/examples/Bomb.bs b/examples/Bomb.bs new file mode 100644 --- /dev/null +++ b/examples/Bomb.bs @@ -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; diff --git a/examples/FDotF.bs b/examples/FDotF.bs new file mode 100644 --- /dev/null +++ b/examples/FDotF.bs @@ -0,0 +1,1 @@ +y = \f -> compose f f; diff --git a/examples/Fix.bs b/examples/Fix.bs new file mode 100644 --- /dev/null +++ b/examples/Fix.bs @@ -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); diff --git a/examples/InfiniteNestedList.bs b/examples/InfiniteNestedList.bs new file mode 100644 --- /dev/null +++ b/examples/InfiniteNestedList.bs @@ -0,0 +1,7 @@ +xs = [xs]; + +deep = !n -> !list -> ite (eqI n 0) + True + (ite (null list) + False + (deep (sub n 1) (head list))); diff --git a/examples/MutRec.bs b/examples/MutRec.bs new file mode 100644 --- /dev/null +++ b/examples/MutRec.bs @@ -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))); diff --git a/examples/NameSupply.bs b/examples/NameSupply.bs new file mode 100644 --- /dev/null +++ b/examples/NameSupply.bs @@ -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']; diff --git a/examples/PolyRec.bs b/examples/PolyRec.bs new file mode 100644 --- /dev/null +++ b/examples/PolyRec.bs @@ -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) + ) +); diff --git a/examples/Rec.bs b/examples/Rec.bs new file mode 100644 --- /dev/null +++ b/examples/Rec.bs @@ -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); diff --git a/examples/Sig.bs b/examples/Sig.bs new file mode 100644 --- /dev/null +++ b/examples/Sig.bs @@ -0,0 +1,1 @@ +id : [[a]] -> (a); diff --git a/examples/Simple.bs b/examples/Simple.bs new file mode 100644 --- /dev/null +++ b/examples/Simple.bs @@ -0,0 +1,5 @@ +# simple test case to check type inference of polymorphic functions + +myid = \x -> x; + +f = (myid 'a', myid True); diff --git a/examples/Sort.bs b/examples/Sort.bs new file mode 100644 --- /dev/null +++ b/examples/Sort.bs @@ -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]; diff --git a/examples/SortStrict.bs b/examples/SortStrict.bs new file mode 100644 --- /dev/null +++ b/examples/SortStrict.bs @@ -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]; diff --git a/examples/TupleList.bs b/examples/TupleList.bs new file mode 100644 --- /dev/null +++ b/examples/TupleList.bs @@ -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); diff --git a/src/AST.hs b/src/AST.hs new file mode 100644 --- /dev/null +++ b/src/AST.hs @@ -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 = "" + +-- 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 diff --git a/src/CmdLine.hs b/src/CmdLine.hs new file mode 100644 --- /dev/null +++ b/src/CmdLine.hs @@ -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 diff --git a/src/Depend.hs b/src/Depend.hs new file mode 100644 --- /dev/null +++ b/src/Depend.hs @@ -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 diff --git a/src/Help.hs b/src/Help.hs new file mode 100644 --- /dev/null +++ b/src/Help.hs @@ -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 '' = load a baskell file, quotes are needed around the name (defaults are usually in /usr/share/baskell...)" + putStrLn ":q = quit" + putStrLn ":t = show the type of an expression" + putStrLn " = evaluate an expression" +#ifdef DEBUG + putStrLn ":ast = show the abstract syntax tree" + putStrLn ":depend = show function dependencies" +#endif diff --git a/src/Lexer.hs b/src/Lexer.hs new file mode 100644 --- /dev/null +++ b/src/Lexer.hs @@ -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) diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -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 diff --git a/src/Parser.hs b/src/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Parser.hs @@ -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')] diff --git a/src/ParserUtils.hs b/src/ParserUtils.hs new file mode 100644 --- /dev/null +++ b/src/ParserUtils.hs @@ -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 diff --git a/src/Pretty.hs b/src/Pretty.hs new file mode 100644 --- /dev/null +++ b/src/Pretty.hs @@ -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 diff --git a/src/Primitives.hs b/src/Primitives.hs new file mode 100644 --- /dev/null +++ b/src/Primitives.hs @@ -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)))) diff --git a/src/Reduce.hs b/src/Reduce.hs new file mode 100644 --- /dev/null +++ b/src/Reduce.hs @@ -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 diff --git a/src/Rename.hs b/src/Rename.hs new file mode 100644 --- /dev/null +++ b/src/Rename.hs @@ -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 diff --git a/src/Type.hs b/src/Type.hs new file mode 100644 --- /dev/null +++ b/src/Type.hs @@ -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 + } +