gulcii (empty) → 0.2.0.1
raw patch · 27 files changed
+1809/−0 lines, 27 filesdep +basedep +cairodep +containerssetup-changed
Dependencies added: base, cairo, containers, filepath, gtk
Files
- LICENSE +339/−0
- Setup.hs +2/−0
- extra/fudi2midi.pd +59/−0
- gulcii.cabal +84/−0
- lib/bits.gu +10/−0
- lib/bool.gu +6/−0
- lib/either.gu +4/−0
- lib/event.gu +6/−0
- lib/function.gu +9/−0
- lib/list.gu +52/−0
- lib/mars.gu +5/−0
- lib/maybe.gu +8/−0
- lib/midi.gu +7/−0
- lib/natural.gu +11/−0
- lib/pair.gu +9/−0
- lib/prelude.gu +10/−0
- src/Bruijn.hs +76/−0
- src/Command.hs +35/−0
- src/Draw.hs +147/−0
- src/Evaluation.hs +23/−0
- src/Graph.hs +148/−0
- src/Lambda.hs +80/−0
- src/Layout.hs +74/−0
- src/Main.hs +305/−0
- src/Meta.hs +33/−0
- src/Parse.hs +143/−0
- src/Sugar.hs +124/−0
+ LICENSE view
@@ -0,0 +1,339 @@+ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.,+ 51 Franklin Street, 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 Lesser General Public License instead.) You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++ To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have. You must make sure that they, too, receive or can get the+source code. And you must show them these terms so they know their+rights.++ We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++ Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software. If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++ Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary. To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++ The precise terms and conditions for copying, distribution and+modification follow.++ GNU GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License. The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language. (Hereinafter, translation is included without limitation in+the term "modification".) Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++ 1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++ 2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) You must cause the modified files to carry prominent notices+ stating that you changed the files and the date of any change.++ b) You must cause any work that you distribute or publish, that in+ whole or in part contains or is derived from the Program or any+ part thereof, to be licensed as a whole at no charge to all third+ parties under the terms of this License.++ c) If the modified program normally reads commands interactively+ when run, you must cause it, when started running for such+ interactive use in the most ordinary way, to print or display an+ announcement including an appropriate copyright notice and a+ notice that there is no warranty (or else, saying that you provide+ a warranty) and that users may redistribute the program under+ these conditions, and telling the user how to view a copy of this+ License. (Exception: if the Program itself is interactive but+ does not normally print such an announcement, your work based on+ the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++ a) Accompany it with the complete corresponding machine-readable+ source code, which must be distributed under the terms of Sections+ 1 and 2 above on a medium customarily used for software interchange; or,++ b) Accompany it with a written offer, valid for at least three+ years, to give any third party, for a charge no more than your+ cost of physically performing source distribution, a complete+ machine-readable copy of the corresponding source code, to be+ distributed under the terms of Sections 1 and 2 above on a medium+ customarily used for software interchange; or,++ c) Accompany it with the information you received as to the offer+ to distribute corresponding source code. (This alternative is+ allowed only for noncommercial distribution and only if you+ received the program in object code or executable form with such+ an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it. For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable. However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++ 4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License. Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++ 5. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Program or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++ 6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++ 7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all. For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded. In such case, this License incorporates+the limitation as if written in the body of this License.++ 9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number. If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation. If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++ 10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission. For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this. Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++ NO WARRANTY++ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License along+ with this program; if not, write to the Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++ Gnomovision version 69, Copyright (C) year name of author+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the program+ `Gnomovision' (which makes passes at compilers) written by James Hacker.++ <signature of Ty Coon>, 1 April 1989+ Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs. If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library. If this is what you want to do, use the GNU Lesser General+Public License instead of this License.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ extra/fudi2midi.pd view
@@ -0,0 +1,59 @@+#N canvas 0 0 547 342 10;+#X obj 28 2 netreceive 8765;+#X obj 29 172 noteout;+#X msg 29 127 \$2 \$3 \$1;+#X msg 35 148 \$2 0 \$1;+#X obj 109 173 pgmout;+#X msg 109 150 \$2 \$1;+#X obj 176 173 ctlout;+#X msg 177 150 \$3 \$2 \$1;+#X msg 242 150 \$2 \$1;+#X obj 242 171 touchout;+#X msg 315 148 \$3 \$2 \$1;+#X obj 315 169 polytouchout;+#X msg 398 148 \$2 \$1;+#X obj 398 169 bendout;+#X obj 371 84 spigot;+#X obj 404 18 tgl 15 0 empty empty empty 17 7 0 10 -262144 -1 -1 1+1;+#X obj 158 1 print connection;+#X obj 371 105 print unhandled;+#X obj 416 44 spigot;+#X obj 447 16 tgl 15 0 empty empty empty 17 7 0 10 -262144 -1 -1 0+1;+#X obj 418 65 print debug;+#X obj 29 48 route noteon noteoff program control pressure touch bend+rebound;+#X floatatom 116 29 5 0 0 0 - - -;+#X obj 300 12 route rebound;+#X obj 296 36 print midi;+#X obj 297 -7 spigot;+#X obj 342 -5 tgl 15 0 empty empty empty 17 7 0 10 -262144 -1 -1 1+1;+#X connect 0 0 18 0;+#X connect 0 0 21 0;+#X connect 0 0 25 0;+#X connect 0 1 16 0;+#X connect 0 1 22 0;+#X connect 2 0 1 0;+#X connect 3 0 1 0;+#X connect 5 0 4 0;+#X connect 7 0 6 0;+#X connect 8 0 9 0;+#X connect 10 0 11 0;+#X connect 12 0 13 0;+#X connect 14 0 17 0;+#X connect 15 0 14 1;+#X connect 18 0 20 0;+#X connect 19 0 18 1;+#X connect 21 0 2 0;+#X connect 21 1 3 0;+#X connect 21 2 5 0;+#X connect 21 3 7 0;+#X connect 21 4 8 0;+#X connect 21 5 10 0;+#X connect 21 6 12 0;+#X connect 21 8 14 0;+#X connect 23 1 24 0;+#X connect 25 0 23 0;+#X connect 26 0 25 1;
+ gulcii.cabal view
@@ -0,0 +1,84 @@+Name: gulcii+Version: 0.2.0.1+Synopsis: graphical untyped lambda calculus interactive interpreter+Description:+ GULCII is an untyped lambda calculus interpreter supporting interactive+ modification of a running program with graphical display of graph reduction.+ .+ There are three variants of lambda abstraction: lazy, strict, and copy:+ .+ @> \x . f x x -- x is evaluated lazily with sharing@+ @> \x ! f x x -- x is evaluated strictly and shared@+ @> \x ? f x x -- x is copied before any evaluation@+ .+ There is additional syntax sugar for natural numbers and lists, using+ <http://en.wikipedia.org/wiki/Mogensen%E2%80%93Scott_encoding#Scott_encoding>:+ .+ @> [0,1,2,3]@+ .+ There is a small standard library based loosely around the Haskell Prelude,+ with additions geared towards MIDI generation for live-coding music, implemented+ using a mechanism similar to 'Debug.Trace.trace':+ .+ @> \x y . { print : x } y@+ .+ Quick start:+ .+ > gulcii+ > :load mars.gu+ > main+ > :quit+ .+ If you have Pure-data and Timidity, try:+ .+ > timidity -iA -Oj &+ > pd -alsamidi ~/.cabal/share/gulcii-0.2.0.1/extra/fudi2midi.pd &+ > gulcii | pdsend 8765+ .+ See also: live-sequencer which has many more features (but no sharing during+ evaluation).++Homepage: http://gitorious.org/maximus/gulcii+License: GPL-2+License-file: LICENSE+Author: Claude Heiland-Allen+Maintainer: claude@mathr.co.uk+Category: Sound, Music, GUI+Build-type: Simple+Cabal-version: >=1.6+Tested-With: GHC==7.6.2++Data-files: extra/fudi2midi.pd,+ lib/bits.gu,+ lib/bool.gu,+ lib/either.gu,+ lib/event.gu,+ lib/function.gu,+ lib/list.gu,+ lib/maybe.gu,+ lib/midi.gu,+ lib/natural.gu,+ lib/pair.gu,+ lib/prelude.gu,+ lib/mars.gu++Executable gulcii+ HS-source-dirs: src+ Main-is: Main.hs+ Build-depends: base >= 3 && < 6,+ containers >= 0.3 && < 0.6,+ filepath >= 1.1 && < 1.4,+ gtk >= 0.11 && < 0.13,+ cairo >= 0.11 && < 0.13+ Other-modules: Bruijn Command Draw Evaluation Graph Lambda Layout Meta Parse Sugar+ ghc-options: -Wall -threaded -rtsopts+ ghc-prof-options: -prof -auto-all -caf-all++Source-Repository head+ Type: git+ Location: git://gitorious.org/maximus/gulcii.git++Source-Repository this+ Type: git+ Tag: 0.2.0.1+ Location: git://gitorious.org/maximus/gulcii.git
+ lib/bits.gu view
@@ -0,0 +1,10 @@+# Data.Bits(Bits(+# (.&.), (.|.), xor, complement,+# bit, setBit, clearBit, complementBit, testBit,+# shift, shiftL, shiftR, rotate, rotateL, rotateR,+# bitSize, isSigned ))+# bits+bits@and = zipWith and+bits@or = zipWith or+bits@xor = zipWith xor+bits@not = map not
+ lib/bool.gu view
@@ -0,0 +1,6 @@+# boolean+false = \ t f . f+true = \ t f . t+and = \ a b . a b a+or = \ a b . a a b+not = \ a . a false true
+ lib/either.gu view
@@ -0,0 +1,4 @@+# either+left = \ a l r . l a+right = \ b l r . r b+either = \ ac bc e . e ac bc
+ lib/event.gu view
@@ -0,0 +1,6 @@+# event+wait = \n w e . w n+event = \x w e . e x+merge = \al bl . al (\a as . bl (\b bs . a (\aw . b (\bw . lessthan aw bw (cons a (merge as (cons (wait (sub bw aw)) bs))) (cons b (merge (cons (wait (sub aw bw)) as) bs))) (\e . cons b (merge al bs))) (\e . cons a (merge as bl))) al) bl+merges = foldr merge nil+play = \l . l (\x xs . x (\w . { wait : w } (play xs)) (\e . e (play xs))) (error play)
+ lib/function.gu view
@@ -0,0 +1,9 @@+# function+id = \ a . a+const = \ a b . a+compose = \ bc ab a . bc (ab a)+flip = \ abc b a . abc a b+fix = \ f . f (fix f)+undefined = undefined+error = \e . error e+seq = \ a ! \b . b
+ lib/list.gu view
@@ -0,0 +1,52 @@+# module Data.List ( +# (++), head, last, tail, init, null, length, map, reverse, +# intersperse, intercalate, transpose, subsequences, permutations, +# foldl, foldl', foldl1, foldl1', foldr, foldr1, concat, concatMap, +# and, or, any, all, sum, product, maximum, minimum, scanl, scanl1, +# scanr, scanr1, mapAccumL, mapAccumR, iterate, repeat, replicate, +# cycle, unfoldr, take, drop, splitAt, takeWhile, dropWhile, span, +# break, stripPrefix, group, inits, tails, isPrefixOf, isSuffixOf, +# isInfixOf, elem, notElem, lookup, find, filter, partition, (!!), +# elemIndex, elemIndices, findIndex, findIndices, zip, zip3, zip4, +# zip5, zip6, zip7, zipWith, zipWith3, zipWith4, zipWith5, zipWith6, +# zipWith7, unzip, unzip3, unzip4, unzip5, unzip6, unzip7, lines, +# words, unlines, unwords, nub, delete, (\\), union, intersect, sort, +# insert, nubBy, deleteBy, deleteFirstsBy, unionBy, intersectBy, +# groupBy, sortBy, insertBy, maximumBy, minimumBy, genericLength, +# genericTake, genericDrop, genericSplitAt, genericIndex, genericReplicate +# ) where+# list+nil = \ c n . n+cons = \ x xs c n . c x xs+null = \ l . l (\x xs . false) true+head = \ l . l (\x xs . x) (error head)+tail = \ l . l (\x xs . xs) (error tail)+map = \ f l . l (\x xs . cons (f x) (map f xs)) nil+append = \ us vs . us (\x xs . cons x (append xs vs)) vs+filter = \ p l . l (\x xs . p x (cons x) id (filter p xs)) nil+index = \ l n . n (\p . l (\x xs . index xs p) (error index)) (l (\x xs . x) (error index))+reverse = \ l . l (\x xs . append (reverse xs) (cons x nil)) nil+foldr = \ f e l . l (\x xs . f x (foldr f e xs)) e+length = foldr (const succ) zero+ands = foldr and true+ors = foldr or false+concat = foldr append nil+all = \f . compose ands (map f)+any = \f . compose ors (map f)+concatMap = \f . compose concat (map f)+composes = foldr compose id+sum = foldr add zero+product = foldr mul (succ zero)+repeat = \x . cons x (repeat x)+cycle = compose concat repeat+zipWith = \f l r . l (\x xs . r (\y ys . cons (f x y) (zipWith f xs ys)) nil) nil+partition = \p l . l (\x xs . p x first second (cons x) (partition p xs)) (pair nil nil)+partitionEithers = \l . l (\e es . e (compose first cons) (compose second cons) (partitionEithers es)) (pair nil nil)+take = \n l . n (\p . l (\x xs . cons x (take p xs)) nil) nil+drop = \n l . n (\p . l (\x xs . drop p xs) nil) l+transpose = \l . l (\xs xss . xs (\y ys . cons (cons y (concatMap (take 1) xss)) (transpose (cons ys (map (drop 1) xss)))) (transpose xss)) nil+catMaybes = \l . l (\x xs . maybe id cons x (catMaybes xs)) nil+iterate = \f . \x ! cons x (iterate f (f x))+last = \l . l (\x xs . xs (\y ys . last xs) x) (error last)+replicate = \n x . take n (repeat x)+rotate = \n bs . splitAt n bs \xs ys . append ys xs
+ lib/mars.gu view
@@ -0,0 +1,5 @@+:load prelude+main = play (cons (event (program 0 48)) timpanis)+timpanis = append timpani timpanis+timpani = concatMap makeNote [20,20,20,60,60,30,30,60]+makeNote = \d ! note d 0 43 96
+ lib/maybe.gu view
@@ -0,0 +1,8 @@+# module Data.Maybe ( +# Maybe(Nothing, Just), maybe, isJust, isNothing, fromJust, fromMaybe, +# listToMaybe, maybeToList, catMaybes, mapMaybe +# ) where instance Monad Functor MonadPlus Eq Ord Read Show+# maybe+nothing = \ j n . n+just = \ a j n . j a+maybe = \ b ab m . m ab b
+ lib/midi.gu view
@@ -0,0 +1,7 @@+# midi+noteOn = \c n v ! \x . { noteon : [c, n, v] } x+noteOff = \c n v ! \x . { noteoff : [c, n, v] } x+program = \c p ! \x . { program : [c, p] } x+control = \c p v ! \x . { control : [c, p, v] } x+note = \d ! \c n v . [ event (noteOn c n v), wait d, event (noteOff c n v) ]+rest = \d ! [ wait d ]
+ lib/natural.gu view
@@ -0,0 +1,11 @@+# natural+zero = \ s z . z+succ = \ n s z . s n+infinity = succ infinity+even = \n . n odd true+odd = \n . n even false+add = \ m n . m (\p . succ (add n p)) n+mul = \ m n . m (\p . add n (mul n p)) zero+sub = \ m n . m (\p . n (sub p) m) zero+equal = \ m n . m (\mm . n (\nn . equal mm nn) false) (n (\nn . false) true)+lessThan = \x y . x (\xx . y (\yy . lessThan xx yy) false) (y (\yy . true) false)
+ lib/pair.gu view
@@ -0,0 +1,9 @@+# pair+pair = \ a b p . p a b+fst = \ p . p \ a b . a+snd = \ p . p \ a b . b+curry = \ f a b . f (pair a b)+uncurry = \ f p . f (fst p) (snd p)+swap = \p . pair (snd p) (fst p)+first = \f p . pair (f (fst p)) (snd p)+second = \ f p . pair (fst p) (f (snd p))
+ lib/prelude.gu view
@@ -0,0 +1,10 @@+:load bits+:load bool+:load either+:load event+:load function+:load list+:load maybe+:load midi+:load natural+:load pair
+ src/Bruijn.hs view
@@ -0,0 +1,76 @@+{-+ gulcii -- graphical untyped lambda calculus interpreter+ Copyright (C) 2011, 2013 Claude Heiland-Allen++ 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.+-}++module Bruijn (Term(..), bruijn, freeVariablesIn, bind) where++import Data.Maybe (listToMaybe)+import Data.Set (Set, empty, singleton, union)++import qualified Lambda as U+import Evaluation (Strategy)++data Term+ = Free String+ | Bound Integer+ | Lambda Strategy Term+ | Apply Term Term+ | Trace String Term Term+ deriving (Read, Show, Eq, Ord)++bruijn :: U.Term -> Term+bruijn = bruijn' []++bruijn' :: [String] -> U.Term -> Term+bruijn' m (U.Apply s t) = Apply (bruijn' m s) (bruijn' m t)+bruijn' m (U.Lambda k v t) = Lambda k (bruijn' (v : m) t)+bruijn' m (U.Variable v) =+ case genericElemIndex v m of+ Nothing -> Free v+ Just i -> Bound i+bruijn' m (U.Trace k s t) = Trace k (bruijn' m s) (bruijn' m t)++bind :: Strategy -> String -> Term -> Term+bind k v t = Lambda k (bind' 0 v t)++bind' :: Integer -> String -> Term -> Term+bind' i v f@(Free u) = if u == v then Bound i else f+bind' _ _ b@(Bound _) = b+bind' i v (Apply s t) = Apply (bind' i v s) (bind' i v t)+bind' i v (Lambda _ t) = bind' (i + 1) v t+bind' i v (Trace k s t) = Trace k (bind' i v s) (bind' i v t)++freeVariablesIn :: Term -> Set String+freeVariablesIn (Free v) = singleton v+freeVariablesIn (Bound _) = empty+freeVariablesIn (Lambda _ t) = freeVariablesIn t+freeVariablesIn (Apply s t) = freeVariablesIn s `union` freeVariablesIn t+freeVariablesIn (Trace _ s t) = freeVariablesIn s `union` freeVariablesIn t++{-+Generic list functions.+-}++genericElemIndex :: (Eq a, Enum b, Num b) => a -> [a] -> Maybe b+genericElemIndex x = genericFindIndex (x ==)++genericFindIndex :: (Enum b, Num b) => (a -> Bool) -> [a] -> Maybe b+genericFindIndex p = listToMaybe . genericFindIndices p++genericFindIndices :: (Enum b, Num b) => (a -> Bool) -> [a] -> [b]+genericFindIndices p xs = [ i | (x, i) <- zip xs [0 ..], p x]
+ src/Command.hs view
@@ -0,0 +1,35 @@+{-+ gulcii -- graphical untyped lambda calculus interpreter+ Copyright (C) 2011, 2013 Claude Heiland-Allen++ 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.+-}++module Command (Command(..), parse) where++import Control.Applicative ((<$>), (<*>), (<$), (<*), (<|>))++import qualified Sugar as S+import qualified Meta as M+import Parse++data Command = Define String S.Term | Evaluate S.Term | Execute S.Term | Meta M.Meta+ deriving (Read, Show, Eq, Ord)++parse :: Parser String Command+parse = (Define <$> name <* sym "=" <*> S.parse)+ <|> (Evaluate <$> S.parse)+ <|> (Execute <$ sym "~" <*> S.parse)+ <|> (Meta <$ sym ":" <*> M.parse)
+ src/Draw.hs view
@@ -0,0 +1,147 @@+{-+ gulcii -- graphical untyped lambda calculus interpreter+ Copyright (C) 2011, 2013 Claude Heiland-Allen++ 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.+-}++module Draw (draw) where++import Data.List (genericDrop)+import qualified Data.Map.Strict as M+import Data.Map.Strict (Map)++import Graphics.Rendering.Cairo++import qualified Layout as L+import Evaluation (Strategy(..))++type RGB = (Double, Double, Double)++colour :: L.Term -> RGB+colour (L.Free _ _) = (0, 0.5, 1)+colour (L.Bound _ _) = (0.5, 0, 1)+colour (L.Lambda Strict _ _) = (1, 0, 0)+colour (L.Lambda Lazy _ _) = (1, 0, 0.5)+colour (L.Lambda Copy _ _) = (1, 0, 1)+colour (L.Apply _ _ _) = (1, 0.5, 0)+colour (L.RefInst _ _ _) = (0.5, 1, 0)+colour (L.Reference _ _) = (0, 1, 0.5)+colour (L.Trace _ _ _ _) = (1, 1, 0)++circle :: L.Coords -> RGB -> Render ()+circle (x, y) (r, g, b) = do+ save+ translate (fromIntegral x) (fromIntegral y)+ arc 0 0 0.365 0 (2*pi)+ setSourceRGB r g b+ fillPreserve+ setSourceRGB 0 0 0+ stroke+ restore++line :: L.Coords -> L.Coords -> Render ()+line (x, y) (x', y') = do+ save+ moveTo (fromIntegral x ) (fromIntegral y )+ lineTo (fromIntegral x') (fromIntegral y')+ stroke+ restore++draw :: Double -> Double -> L.Layout -> Render ()+draw ww0 hh0 (L.Layout t w h ps) = do+ save+ translate dx dy+ scale s s+ translate 0.5 0.5+ setLineWidth 0.1+ setSourceRGB 0 0 0+ drawLinks ps t+ drawNodes t+ setLineCap LineCapRound+ setSourceRGB 0.5 0.5 0.5+ drawVLinks [] t+ setFontSize (6 / sqrt s)+ translate 0 0.5+ drawNames t+ setSourceRGB 0 0 0+ fillPreserve+ setLineWidth (0.2 / sqrt s)+ setSourceRGB 1 1 1+ stroke+ restore+ where+ s = if fromIntegral w * hh <= fromIntegral h * ww then hh / fromIntegral h else ww / fromIntegral w+ ww = ww0 - 128+ hh = hh0 - 64+ dx = (ww0 - s * fromIntegral w) / 2+ dy = (hh0 - s * fromIntegral h) / 2++drawNames :: L.Term -> Render ()+drawNames (L.Free s (x,y)) = do+ e <- textExtents s+ moveTo (fromIntegral x - textExtentsWidth e / 2) (fromIntegral y)+ textPath s+drawNames (L.Bound _ _) = return ()+drawNames (L.Lambda _ t _) = drawNames t+drawNames (L.Apply a b _) = drawNames a >> drawNames b+drawNames (L.RefInst _ t _) = drawNames t+drawNames (L.Reference _ _) = return ()+drawNames (L.Trace s a b (x,y)) = do+ e <- textExtents s+ moveTo (fromIntegral x - textExtentsWidth e / 2) (fromIntegral y)+ textPath s+ drawNames a+ drawNames b++drawLinks :: Map Integer L.Coords -> L.Term -> Render ()+drawLinks _ (L.Free _ _) = return ()+drawLinks _ (L.Bound _ _) = return ()+drawLinks ps (L.Lambda _ t xy) = let x'y' = L.coordinates t+ in line xy x'y' >> drawLinks ps t+drawLinks ps (L.Apply a b xy) = let axay = L.coordinates a+ bxby = L.coordinates b+ in line xy axay >> line xy bxby >> drawLinks ps a >> drawLinks ps b+drawLinks ps (L.RefInst _ t xy) = let x'y' = L.coordinates t+ in line xy x'y' >> drawLinks ps t+drawLinks ps (L.Reference p xy) = let Just x'y' = M.lookup p ps+ in line xy x'y'+drawLinks ps (L.Trace _ a b xy) =+ let axay = L.coordinates a+ bxby = L.coordinates b+ in line xy axay >> line xy bxby >> drawLinks ps a >> drawLinks ps b++drawVLinks :: [L.Coords] -> L.Term -> Render ()+drawVLinks ls (L.Bound n xy) =+ case genericDrop n ls of+ [] -> return ()+ x'y':_ -> line xy x'y'+drawVLinks ls (L.Lambda _ t xy) = drawVLinks (xy : ls) t+drawVLinks ls (L.Apply s t _) = drawVLinks ls s >> drawVLinks ls t+drawVLinks ls (L.RefInst _ t _) = drawVLinks ls t+drawVLinks ls (L.Trace _ s t _) = drawVLinks ls s >> drawVLinks ls t+drawVLinks _ _ = return ()++drawNodes :: L.Term -> Render ()+drawNodes n@(L.Free _ _) = drawNode n+drawNodes n@(L.Bound _ _) = drawNode n+drawNodes n@(L.Lambda _ t _) = drawNode n >> drawNodes t+drawNodes n@(L.Apply a b _) = drawNode n >> drawNodes a >> drawNodes b+drawNodes n@(L.RefInst _ t _) = drawNode n >> drawNodes t+drawNodes n@(L.Reference _ _) = drawNode n+drawNodes n@(L.Trace _ a b _) = drawNode n >> drawNodes a >> drawNodes b++drawNode :: L.Term -> Render ()+drawNode n = circle (L.coordinates n) (colour n)
+ src/Evaluation.hs view
@@ -0,0 +1,23 @@+{-+ gulcii -- graphical untyped lambda calculus interpreter+ Copyright (C) 2011, 2013 Claude Heiland-Allen++ 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.+-}++module Evaluation (Strategy(..)) where++data Strategy = Lazy | Strict | Copy+ deriving (Read, Show, Eq, Ord)
+ src/Graph.hs view
@@ -0,0 +1,148 @@+{-+ gulcii -- graphical untyped lambda calculus interpreter+ Copyright (C) 2011, 2013 Claude Heiland-Allen++ 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.+-}++module Graph (Term(..), Definitions, References, Reduction(..), graph, reduce, pretty) where++import qualified Data.Map.Strict as M+import Data.Map.Strict (Map)++import qualified Bruijn as B+import Evaluation (Strategy(..))++data Term+ = Free !String+ | Bound !Integer+ | Lambda !Strategy !Term+ | Apply !Term !Term+ | Reference !Integer+ | Trace !String !Term !Term+ deriving (Read, Show, Eq, Ord)++pretty :: Term -> String+pretty = unwords . pretty'++pretty' :: Term -> [String]+pretty' (Free s) = [s]+pretty' (Bound i) = [show i]+pretty' (Reference i) = ['#':show i]+pretty' (Lambda k t) = ["(", "\\", pretty'' k] ++ pretty' t ++ [")"]+pretty' (Apply s t) = ["("] ++ pretty' s ++ pretty' t ++ [")"]+pretty' (Trace k s t) = ["(", "{", k, ":"] ++ pretty' s ++ ["}"] ++ pretty' t ++ [")"]++pretty'' :: Strategy -> String+pretty'' Strict = "!"+pretty'' Lazy = "."+pretty'' Copy = "?"++type Definitions = Map String Term+type References = Map Integer Term++next :: Map Integer a -> Integer+next refs = case M.maxViewWithKey refs of+ Nothing -> 0+ Just ((k,_),_) -> k + 1++graph :: B.Term -> Term+graph (B.Free v) = Free v+graph (B.Bound i) = Bound i+graph (B.Lambda k t) = Lambda k (graph t)+graph (B.Apply s t) = Apply (graph s) (graph t)+graph (B.Trace k s t) = Trace k (graph s) (graph t)++{-+bind :: String -> Term -> Term -> Term+bind v s t@(Free u) = if u == v then s else t+bind _ _ t@(Bound _) = t+bind v s (Lambda k t) = Lambda k (bind v s t)+bind v s (Apply a b) = Apply (bind v s a) (bind v s b)+bind _ _ t@(Reference _) = t+-}++{-+Reduce a graph one step, returning Nothing if it is irreducible.+-}++data Reduction = Reduced Term References | Rebound String Term References | Traced String Term Term References+ deriving (Read, Show, Eq, Ord)++mapR :: (Term -> Term) -> Reduction -> Reduction+mapR f (Reduced t refs) = Reduced (f t) refs+mapR f (Rebound s t refs) = Rebound s (f t) refs+mapR f (Traced k s t refs) = Traced k s (f t) refs++reduce, reduce' :: Definitions -> References -> Term -> Maybe Reduction+reduce _ refs (Trace k s t) = Just (Traced k s t refs)+reduce defs refs term = reduce' defs refs term++-- free variables are replaced with their definition+reduce' defs refs (Free v) = case M.lookup v defs of+ Nothing -> Nothing+ Just t -> let r = next refs in Just (Rebound v (Reference r) (M.insert r t refs))++-- bound variables are irreducible+reduce' _ _ (Bound _) = Nothing++-- non top-level traces are irreducible?+--reduce' _ _ (Trace _ _ _) = Nothing+reduce' _ refs (Trace k s t) = Just (Traced k s t refs)++-- maybe reduce inside lambda+reduce' defs refs (Lambda k t) = mapR (Lambda k) `fmap` reduce' defs refs t++reduce' defs refs (Apply a b) = case a of+ -- beta reduction+ Lambda Strict a' -> case reduce defs refs b of+ Just r -> Just (mapR (a `Apply`) r)+ Nothing -> Just (uncurry Reduced (beta refs a' b))+ Lambda Copy a' -> Just (Reduced (beta' 0 a' b) refs)+ Lambda Lazy a' -> Just (uncurry Reduced (beta refs a' b))+ Reference r -> case M.lookup r refs of+ Just a' -> Just (Reduced (Apply a' b) refs)+ _ -> Nothing+ Free s -> case M.lookup s defs of+ Just a' -> Just (Rebound s (Apply a' b) refs)+ _ -> Nothing+ t@(Apply _ _) -> case reduce defs refs t of+ Just r -> Just (mapR (`Apply` b) r)+ _ -> Nothing+ _ -> Nothing -- Bound, Trace++-- reduce references+reduce' defs refs s@(Reference r) = case M.lookup r refs of+ Nothing -> Nothing+ Just t -> case reduce' defs refs t of+ Just (Reduced t' refs') -> Just (Reduced s (M.insert r t' refs'))+ Just (Rebound v t' refs') -> Just (Rebound v s (M.insert r t' refs'))+ _ -> Just (Reduced t refs)++-- beta reduction+beta :: References -> Term -> Term -> (Term, References)+beta refs a b = (beta' 0 a t, refs')+ where+ r = next refs+ refs' = M.insert r b refs+ t = Reference r++beta' :: Integer -> Term -> Term -> Term+beta' i s@(Bound j) t = if i == j then t else s+beta' i (Lambda k s) t = Lambda k (beta' (i + 1) s t)+beta' i (Apply a b) t = Apply (beta' i a t) (beta' i b t)+beta' _ s@(Free _) _ = s+beta' _ s@(Reference _) _ = s+beta' i (Trace k a b) t = Trace k (beta' i a t) (beta' i b t)
+ src/Lambda.hs view
@@ -0,0 +1,80 @@+{-+ gulcii -- graphical untyped lambda calculus interpreter+ Copyright (C) 2011, 2013 Claude Heiland-Allen++ 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.+-}++module Lambda (Term(..), pretty, isFreeIn, variablesIn, freeVariablesIn) where++import Data.List (nub)++import Evaluation (Strategy(..))++{-+Untyped lambda calculus terms.+-}++data Term+ = Variable String+ | Lambda Strategy String Term+ | Apply Term Term+ | Trace String Term Term+ deriving (Read, Show, Eq, Ord)++{-+Pretty-print a term.+-}++pretty :: Term -> String+pretty = unwords . pretty'++pretty' :: Term -> [String]+pretty' (Variable v) = [v]+pretty' (Lambda k v t) = ["(", "\\", v, pretty'' k] ++ pretty' t ++ [")"]+pretty' (Apply s t) = ["("] ++ pretty' s ++ pretty' t ++ [")"]+pretty' (Trace k s t) = ["(", "{", k, ":"] ++ pretty' s ++ ["}"] ++ pretty' t ++ [")"]++pretty'' :: Strategy -> String+pretty'' Strict = "!"+pretty'' Lazy = "."+pretty'' Copy = "?"++{-+Check if a variable occurs free in a term.+-}++isFreeIn :: String -> Term -> Bool+isFreeIn n (Variable v) = n == v+isFreeIn n (Lambda _ v t) = if n == v then False else n `isFreeIn` t+isFreeIn n (Apply t t') = n `isFreeIn` t || n `isFreeIn` t'+isFreeIn n (Trace _ t t') = n `isFreeIn` t || n `isFreeIn` t'++{-+Get all variable names defined or referenced by a term.+-}++variablesIn :: Term -> [String]+variablesIn (Variable v) = [v]+variablesIn (Lambda _ v t) = nub $ v : variablesIn t+variablesIn (Apply t t') = nub $ variablesIn t ++ variablesIn t'+variablesIn (Trace _ t t') = nub $ variablesIn t ++ variablesIn t'++{-+Get all free variables referenced by a term.+-}++freeVariablesIn :: Term -> [String]+freeVariablesIn t = filter (`isFreeIn` t) (variablesIn t)
+ src/Layout.hs view
@@ -0,0 +1,74 @@+{-+ gulcii -- graphical untyped lambda calculus interpreter+ Copyright (C) 2011, 2013 Claude Heiland-Allen++ 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.+-}++module Layout (Term(..), Coords, Layout(..), layout, coordinates) where++import qualified Data.Map.Strict as M+import Data.Map.Strict (Map)++import qualified Graph as G+import Evaluation (Strategy(..))++type Coords = (Integer, Integer)++data Term+ = Free String Coords+ | Bound Integer Coords+ | Lambda Strategy Term Coords+ | Apply Term Term Coords+ | RefInst Integer Term Coords+ | Reference Integer Coords+ | Trace String Term Term Coords+ deriving (Read, Show, Eq, Ord)++data Layout = Layout Term Integer Integer (Map Integer Coords)+ deriving (Read, Show, Eq, Ord)++coordinates :: Term -> Coords+coordinates (Free _ xy) = xy+coordinates (Bound _ xy) = xy+coordinates (Lambda _ _ xy) = xy+coordinates (Apply _ _ xy) = xy+coordinates (RefInst _ _ xy) = xy+coordinates (Reference _ xy) = xy+coordinates (Trace _ _ _ xy) = xy++layout :: G.Term -> G.References -> Layout+layout = layout' (0, 0) M.empty++layout' :: Coords -> Map Integer Coords -> G.Term -> G.References -> Layout+layout' xy ps (G.Free v) _ = Layout (Free v xy) 1 1 ps+layout' xy ps (G.Bound v) _ = Layout (Bound v xy) 1 1 ps+layout' (x,y) ps (G.Lambda k t) g = let Layout lt w h ps' = layout' (x, y + 1) ps t g+ (px, _) = coordinates lt+ in Layout (Lambda k lt (px, y)) w (h + 1) ps'+layout' (x,y) ps (G.Apply a b) g = let Layout la aw ah psa = layout' (x, y + 1) ps a g+ Layout lb bw bh psb = layout' (x + aw + 1, y + 1) psa b g+ in Layout (Apply la lb (x + aw, y)) (1 + aw + bw) (1 + (ah `max` bh)) psb+layout' xy@(x,y) ps (G.Reference p) g = if p `M.member` ps+ then Layout (Reference p xy) 1 1 ps+ else case M.lookup p g of+ Nothing -> error $ "layout': bad pointer: " ++ show p+ Just t -> let Layout lt w h pst = layout' (x, y + 1) ps t g+ (px, py) = coordinates lt+ in Layout (RefInst p lt (px, y)) w (1 + h) (M.insert p (px, py) pst)+layout' (x,y) ps (G.Trace s a b) g =+ let Layout la aw ah psa = layout' (x, y + 1) ps a g+ Layout lb bw bh psb = layout' (x + aw + 1, y + 1) psa b g+ in Layout (Trace s la lb (x + aw, y)) (1 + aw + bw) (1 + (ah `max` bh)) psb
+ src/Main.hs view
@@ -0,0 +1,305 @@+{-+ gulcii -- graphical untyped lambda calculus interpreter+ Copyright (C) 2011, 2013 Claude Heiland-Allen++ 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.+-}++module Main (main) where++import Control.Applicative ((<$>), (<*>))+import Control.Concurrent (forkIO, killThread, threadDelay, Chan, newChan, readChan, writeChan)+import Control.Monad (forever, when)+import qualified Data.Map.Strict as M+import Data.Map.Strict (Map)+import Data.IORef (IORef, newIORef, readIORef, writeIORef, atomicModifyIORef)+import System.IO (hSetBuffering, BufferMode(LineBuffering), stdout)+import System.IO.Error (catchIOError)+import System.FilePath ((</>), (<.>))+import Graphics.UI.Gtk hiding (Meta)+import Graphics.Rendering.Cairo++import Paths_gulcii (getDataFileName)++import qualified Command as C+import qualified Meta as M+import qualified Sugar as S+import qualified Bruijn as B+import qualified Graph as G+import qualified Layout as L+import qualified Draw as D+import qualified Parse as P++data Interpret = Fail | Skip | Define String G.Term | Pure G.Term | Run G.Term | Meta M.Meta+ deriving (Read, Show, Eq, Ord)++interpret :: String -> Interpret+interpret l =+ case P.unP C.parse `fmap` P.tokenize (P.decomment l) of+ Just ((C.Define d sterm, []):_) ->+ case S.desugar sterm of+ Just term -> Define d . G.graph . B.bruijn $ term+ _ -> Fail+ Just ((C.Evaluate sterm, []):_) ->+ case S.desugar sterm of+ Just term -> Pure . G.graph . B.bruijn $ term+ _ -> Fail+ Just ((C.Execute sterm, []):_) ->+ case S.desugar sterm of+ Just term -> Run . G.graph . B.bruijn $ term+ _ -> Fail+ Just ((C.Meta m, []):_) -> Meta m+ Just [] -> Skip+ _ -> Fail++main :: IO ()+main = do+ _args <- initGUI+ envR <- newIORef M.empty+ lRef <- newIORef Nothing+ evalR <- newIORef Nothing+ outC <- newChan+ _ <- forkIO $ outputter outC+ let out = writeChan outC+ win <- windowNew+ _ <- onDestroy win mainQuit+ windowSetDefaultSize win 1024 720+ vb <- vBoxNew False 0+ hb <- hPanedNew+ tt <- textTagTableNew+ tagInputRem <- textTagNew Nothing+ tagInputDef <- textTagNew Nothing+ tagInputPure <- textTagNew Nothing+ tagInputRun <- textTagNew Nothing+ tagInputMeta <- textTagNew Nothing+ tagOutput <- textTagNew Nothing+ tagOutputMeta <- textTagNew Nothing+ tagError <- textTagNew Nothing+ set tagInputRem [ textTagForeground := "cyan" ]+ set tagInputDef [ textTagForeground := "green" ]+ set tagInputPure [ textTagForeground := "yellow" ]+ set tagInputRun [ textTagForeground := "orange" ]+ set tagInputMeta [ textTagForeground := "blue" ]+ set tagOutput [ textTagForeground := "magenta" ]+ set tagOutputMeta [ textTagForeground := "pink" ]+ set tagError [ textTagForeground := "red" ]+ textTagTableAdd tt tagInputRem+ textTagTableAdd tt tagInputDef+ textTagTableAdd tt tagInputPure+ textTagTableAdd tt tagInputRun+ textTagTableAdd tt tagInputMeta+ textTagTableAdd tt tagOutput+ textTagTableAdd tt tagOutputMeta+ textTagTableAdd tt tagError+ tf <- textBufferNew (Just tt)+ tb <- textBufferNew (Just tt)+ tv <- textViewNewWithBuffer tf+ mk <- textMarkNew Nothing False+ it <- textBufferGetIterAtOffset tf (-1)+ textBufferAddMark tf mk it+ textViewSetEditable tv False+ textViewSetWrapMode tv WrapWord+ da <- drawingAreaNew+ _ <- da `on` exposeEvent $ do+ dw <- eventWindow+ liftIO $ do+ ml <- atomicModifyIORef lRef (\m -> (m, m))+ case ml of+ Nothing -> return ()+ Just l -> do+ (ww, hh) <- drawableGetSize dw+ renderWithDrawable dw $ do+ D.draw (fromIntegral ww) (fromIntegral hh) l+ return True+ en <- entryNew+ entrySetWidthChars en 24+ font <- fontDescriptionFromString "Monospaced 18"+ widgetModifyFont tv (Just font)+ widgetModifyFont en (Just font)+ sw <- scrolledWindowNew Nothing Nothing+ scrolledWindowSetPolicy sw PolicyAutomatic PolicyAlways+ containerAdd sw tv+ al <- alignmentNew 1 0 1 1+ set al [ containerChild := da ]+ boxPackStart vb en PackNatural 0+ boxPackStart vb sw PackGrow 0+ panedPack1 hb vb False True+ panedPack2 hb al True True+ set win [ containerChild := hb ]+ containerSetFocusChain vb [toWidget en]+ let scrollDown = do+ textViewScrollToMark tv mk 0 Nothing+ addText tag txt = do+ start' <- textBufferGetIterAtOffset tb 0+ end' <- textBufferGetIterAtOffset tb (-1)+ textBufferDelete tb start' end'+ textBufferInsert tb start' (unlines [txt])+ start <- textBufferGetIterAtOffset tb 0+ end <- textBufferGetIterAtOffset tb (-1)+ textBufferApplyTag tb tag start end+ pos <- textBufferGetIterAtOffset tf (-1)+ textBufferInsertRange tf pos start end+ textBufferMoveMark tf mk pos+ _ <- en `onEntryActivate` do+ let exec echo txt =+ case interpret txt of+ Fail -> addText tagError txt+ Skip -> when echo $ do+ addText tagInputRem txt+ entrySetText en ""+ Define def term -> do+ when echo $ do+ addText tagInputDef txt+ entrySetText en ""+ atomicModifyIORef envR (\defs -> (M.insert def term defs, ()))+ Pure term -> do+ when echo $ do+ addText tagInputPure txt+ entrySetText en ""+ mtid <- readIORef evalR+ case mtid of+ Nothing -> return ()+ Just tid -> killThread tid+ tid <- forkIO $ evaluator 10000 lRef out envR M.empty term goPure+ writeIORef evalR (Just tid)+ Run term -> do+ when echo $ do+ addText tagInputRun txt+ entrySetText en ""+ mtid <- readIORef evalR+ case mtid of+ Nothing -> return ()+ Just tid -> killThread tid+ tid <- forkIO $ evaluator 10000 lRef out envR M.empty term (goRun (postGUIAsync . addText tagOutput))+ writeIORef evalR (Just tid)+ Meta M.Quit -> do+ _ <- forkIO $ do+ out "quit ;"+ postGUISync mainQuit+ return ()+ Meta M.Clear -> do+ when echo $ do+ addText tagInputMeta txt+ entrySetText en ""+ atomicModifyIORef envR (\_ -> (M.empty, ()))+ Meta M.Browse -> do+ when echo $ do+ addText tagInputMeta txt+ entrySetText en ""+ defs <- readIORef envR+ addText tagOutputMeta(unwords (M.keys defs))+ Meta (M.Load f) -> do+ when echo $ do+ addText tagInputMeta txt+ f' <- getDataFileName ("lib" </> f <.> "gu")+ s <- (fmap Right (readFile f')) `catchIOError` (return . Left . show)+ case s of+ Right t -> do+ when echo $ do+ entrySetText en ""+ mapM_ (exec False) (lines t)+ Left e ->+ addText tagError e+ txt <- entryGetText en+ exec True txt+ scrollDown+ _ <- flip timeoutAdd 100 $ widgetQueueDraw da >> return True+ widgetShowAll win+ mainGUI++type Go = G.References -> G.Term -> IO (G.Term, G.References)++goPure :: Go+goPure refs term = return (term, refs)++goRun :: (String -> IO ()) -> Go+goRun out refs term = do+ out (G.pretty term)+ return (term, refs)++gc :: G.References -> G.Term -> (G.Term, G.References)+gc refs term =+ let keep = reachable refs term M.empty+ (collapse, later) = M.partition (1 ==) keep+ in (compact refs term, M.fromList [ (k, compact refs (refs M.! k)) | k <- M.keys collapse ] `M.union` M.fromList [ (k, refs M.! k) | k <- M.keys later ])++reachable :: G.References -> G.Term -> Map Integer Integer -> Map Integer Integer+reachable r (G.Lambda _ t) m = reachable r t m+reachable r (G.Apply s t) m = reachable r s (reachable r t m)+reachable r (G.Reference p) m = (if p `M.member` m then id else reachable r (r M.! p)) (M.insertWith (+) p 1 m)+reachable r (G.Trace _ s t) m = reachable r s (reachable r t m)+reachable _ _ m = m++compact :: G.References -> G.Term -> G.Term+compact r (G.Reference p) = r M.! p+compact _ t = t++evaluator :: Int -> IORef (Maybe L.Layout) -> (String -> IO ()) -> IORef G.Definitions -> G.References -> G.Term -> Go -> IO ()+evaluator tick layout out defsR refs term go = do+ defs <- readIORef defsR+ let (term1, refs1) = gc refs term+ (term0, refs0) <- go refs1 term1+ case G.reduce defs refs0 term0 of+ Nothing -> threadDelay tick >> evaluator tick layout out defsR refs0 term0 go+ Just (G.Reduced term' refs') -> evaluator tick layout out defsR refs' term' go+ Just (G.Rebound _var' term' refs') -> evaluator tick layout out defsR refs' term' go+ Just (G.Traced k s term' refs') -> do+ atomicModifyIORef layout $ \_ -> (Just $ L.layout term0 refs0, ())+ case k of+ "wait" -> case evalNatural (dereference refs0 s) of+ Just n -> threadDelay (tick * fromInteger n)+ _ -> return ()+ "noteon" -> case evalList evalNatural (dereference refs0 s) of+ Just msg@[_channel, _note, _velocity] ->+ out $ "noteon " ++ unwords (map show msg) ++ " ;"+ _ -> return ()+ "noteoff" -> case evalList evalNatural (dereference refs0 s) of+ Just msg@[_channel, _note, _velocity] ->+ out $ "noteoff " ++ unwords (map show msg) ++ " ;"+ _ -> return ()+ "program" -> case evalList evalNatural (dereference refs0 s) of+ Just msg@[_channel, _program] ->+ out $ "program " ++ unwords (map show msg) ++ " ;"+ _ -> return ()+ "control" -> case evalList evalNatural (dereference refs0 s) of+ Just msg@[_channel, _control, _value] ->+ out $ "control " ++ unwords (map show msg) ++ " ;"+ _ -> return ()+ _ -> print (k, G.pretty (dereference refs0 s))+ evaluator tick layout out defsR refs' term' go++dereference :: G.References -> G.Term -> G.Term+dereference r (G.Reference p) = dereference r (r M.! p)+dereference r (G.Lambda k t) = G.Lambda k (dereference r t)+dereference r (G.Apply a b) = G.Apply (dereference r a) (dereference r b)+dereference r (G.Trace k a b) = G.Trace k (dereference r a) (dereference r b)+dereference _ t = t++evalNatural :: G.Term -> Maybe Integer+evalNatural (G.Lambda _ (G.Lambda _ (G.Bound 0))) = Just 0+evalNatural (G.Lambda _ (G.Lambda _ (G.Apply (G.Bound 1) t))) = (1 +) `fmap` evalNatural t+evalNatural _ = Nothing++evalList :: (G.Term -> Maybe a) -> G.Term -> Maybe [a]+evalList _ (G.Lambda _ (G.Lambda _ (G.Bound 0))) = Just []+evalList f (G.Lambda _ (G.Lambda _ (G.Apply (G.Apply (G.Bound 1) s) t))) = (:) <$> f s <*> evalList f t+evalList _ _ = Nothing++outputter :: Chan String -> IO ()+outputter out = do+ hSetBuffering stdout LineBuffering+ forever $ do+ s <- readChan out+ putStrLn s
+ src/Meta.hs view
@@ -0,0 +1,33 @@+{-+ gulcii -- graphical untyped lambda calculus interpreter+ Copyright (C) 2011, 2013 Claude Heiland-Allen++ 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.+-}++module Meta (Meta(..), parse) where++import Control.Applicative((<|>), (<$), (<*>))++import Parse++data Meta = Quit | Clear | Browse | Load String+ deriving (Read, Show, Eq, Ord)++parse :: Parser String Meta+parse = (Quit <$ sym "quit")+ <|> (Clear <$ sym "clear")+ <|> (Browse <$ sym "browse")+ <|> (Load <$ sym "load" <*> name)
+ src/Parse.hs view
@@ -0,0 +1,143 @@+{-+ gulcii -- graphical untyped lambda calculus interpreter+ Copyright (C) 2011, 2013 Claude Heiland-Allen++ 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.+-}++module Parse where++import Control.Applicative(Applicative, Alternative, pure, empty, (<|>), (<$>), (<*>), (<*))++{-+Strip comments+--------------++A comment is everything from '#' to the end of the line.+-}++decomment :: String -> String+decomment = concatMap (fst . break ('#'==)) . lines++{-+Tokenize+--------+-}++digits :: String+digits = "0123456789"++lowers :: String+lowers = "abcdefghijklmnopqrstuvwxyz"++uppers :: String+uppers = "ABCDEFGHIJKLMNOPQRSTUVWXYZ@"++alpha :: String+alpha = lowers ++ uppers++alphanum :: String+alphanum = alpha ++ digits++symbols :: String+symbols = "\\.!?()[],=~:{}"++spaces :: String+spaces = " "++{-+Split a string into tokens (each itself a string), such that each token+consists of either all digits, all letters, or a single symbol. Use+whitespace to separate tokens.+-}++tokenize :: String -> Maybe [String]+tokenize [] = Just []+tokenize (c:cs)+ | c `elem` digits = let (t,ts) = span (`elem` digits) cs+ in ((c:t):) <$> tokenize ts+ | c `elem` lowers = let (t,ts) = span (`elem` alphanum) cs+ in ((c:t):) <$> tokenize ts+ | c `elem` symbols = ([c]:) <$> tokenize cs+ | c `elem` spaces = tokenize cs+ | otherwise = Nothing++{-+Parsing primitives+------------------++A parser takes a list of tokens to a list of possible partial parses.+-}++newtype Parser s t = P{ unP :: [s] -> [(t, [s])] }++instance Functor (Parser s) where+ fmap f (P p) = P (\q -> [ (f v, s) | (v,s) <- p q ] )++instance Applicative (Parser s) where+ pure f = P (\q -> [(f, q)])+ P p1 <*> P p2 = P (\q -> [ (u v, t) | (u, s) <- p1 q, (v, t) <- p2 s ])++instance Alternative (Parser s) where+ empty = P (\_ -> [])+ P p1 <|> P p2 = P (\q -> p1 q ++ p2 q)++{-+Accept a token that satisfies a predicate.+-}++satisfy :: (s -> Bool) -> Parser s s+satisfy p = P (\q -> case q of+ (x:xs) | p x -> [(x,xs)]+ _ -> [])++{-+Accept a specific token.+-}++sym :: Eq s => s -> Parser s s+sym a = satisfy (== a)++{-+Accept some p's separated by s's.+-}++someSep :: Parser s a -> Parser s t -> Parser s [t]+someSep s p = ((:[]) <$> p) <|> ((:) <$> p <* s <*> someSep s p)++{-+Accept some p's separated by s's, or nothing.+-}++manySep :: Parser s a -> Parser s t -> Parser s [t]+manySep s p = pure [] <|> someSep s p++{-+Accept a name consisting of letters.+-}++name :: Parser String String+name = P (\q -> case q of+ (p@(r:_):ps) | r `elem` lowers -> [(p, ps)]+ _ -> [])++{-+Accept an integer consisting of digits.+-}++integer :: Parser String Integer+integer = P (\q -> case q of+ (p:ps) | all (`elem` digits) p -> [(read p, ps)]+ _ -> [])
+ src/Sugar.hs view
@@ -0,0 +1,124 @@+{-+ gulcii -- graphical untyped lambda calculus interpreter+ Copyright (C) 2011, 2013 Claude Heiland-Allen++ 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 Street, Fifth Floor, Boston, MA 02110-1301 USA.+-}++{-++Sugared term parser+===================++Grammar+-------++T ::= v | '\\' v+ ('.' | '!' | '?') T | T+ | '(' T ')' | n | '[' (T (, T)*)? ']' | '{' v ':' T '}' T++-}++module Sugar(Term(..), parse, desugar) where++import Control.Applicative(Applicative, Alternative, (<|>), (<$>), (<$), (<*>), (<*), some, liftA2)+import Data.List ((\\))++import Parse+import qualified Lambda as U+import Evaluation (Strategy(..))++data Term+ = Variable String+ | Lambda Strategy [String] Term+ | Apply [Term]+ | Group Term+ | Natural Integer+ | List [Term]+ | Trace String Term Term+ deriving (Read, Show, Eq, Ord)++parse :: Parser String Term+parse = Apply <$> some parse'++parse' :: Parser String Term+parse' = (flip Lambda <$ sym "\\" <*> some name <*> strategy <*> parse)+ <|> (Group <$ sym "(" <*> parse <* sym ")")+ <|> (Variable <$> name)+ <|> (Natural <$> integer)+ <|> (List <$ sym "[" <*> manySep (sym ",") parse <* sym "]")+ <|> (Trace <$ sym "{" <*> name <* sym ":" <*> parse <* sym "}" <*> parse)++strategy :: Parser String Strategy+strategy = (Strict <$ sym "!") <|> (Lazy <$ sym ".") <|> (Copy <$ sym "?")++{-+A list of all possible legal variable names, need to generate fresh+variables (ie, names guaranteed to be unused in a given term).+-}++variables :: [String]+variables = [ v:vs | vs <- [] : variables, v <- ['a'..'z'] ]++{-+Desugar according to the following conventions:++ Outermost parentheses are dropped:+ M N means of (M N)++ Applications are left associative:+ M N P means (M N) P++ The body of an abstraction extends as far right as possible+ \x.M N means \x.(M N) and not (\x.M) N++ A sequence of abstractions are contracted:+ \x.\y.\z.N is abbreviated as \x y z.N++Desugar naturals with their Scott-encoding:++ 0 -> \s z . z+ (1+n) -> \s z . s (desugar n)++Desugar lists with their Scott-encoding:++ [] -> \ c n . n+ (x:xs) -> \ c n . c (desugar x) (desugar xs)+-}++desugar :: Term -> Maybe U.Term+desugar (Variable v) = Just $ U.Variable v+desugar (Lambda _ [] _) = Nothing+desugar (Lambda k [v] t) = fmap (U.Lambda k v) $ desugar t+desugar (Lambda k (v:vs) t) = fmap (U.Lambda k v) $ desugar (Lambda k vs t)+desugar (Apply []) = Nothing+desugar (Apply ts) = foldl1 (liftA2 U.Apply) (map desugar ts)+desugar (Group t) = desugar t+desugar (Natural 0) = Just $ lam "s" (lam "z" (U.Variable "z"))+desugar (Natural n) =+ let Just nn = desugar (Natural (n - 1))+ (s:z:_) = variables \\ U.freeVariablesIn nn+ in Just $ lam s (lam z (U.Apply (U.Variable s) nn))+desugar (List []) = Just $ lam "c" (lam "n" (U.Variable "n"))+desugar (List (l:ls)) =+ let t = desugar l+ ts = desugar (List ls)+ in case (t,ts) of+ (Just t', Just ts') ->+ let (c:n:_) = (variables \\ U.freeVariablesIn t') \\ U.freeVariablesIn ts'+ in Just $ lam c (lam n (U.Apply (U.Apply (U.Variable c) t') ts'))+ _ -> Nothing+desugar (Trace k s t) = U.Trace k <$> desugar s <*> desugar t++lam :: String -> U.Term -> U.Term+lam = U.Lambda Lazy