Lambda simplifications

contrib/lambda/lambda.TODO

@@ -0,0 +1,6 @@
+Lambda TODO
+-----------
+Change definition syntax from :<NAME> <EXPR> to <NAME>:<EXPR>
+Documentation
+Unit tests
+Fix evaluation strategy to work with Y combinator

contrib/lambda/lambda.factor

@@ -1,47 +1,33 @@
 #! An interpreter for lambda expressions, by Matthew Willis
 REQUIRES: lazy-lists ;
-USING: lazy-lists io strings hashtables sequences kernel ;
+USING: lazy-lists io strings hashtables sequences namespaces kernel ;
 IN: lambda
 
-#! every expression has a canonical representation of this form
+: bound-vars ( -- lazy-list ) 65 lfrom [ ch>string ] lmap ;
-: bound-variables-list ( -- lazy-list ) 65 lfrom [ ch>string ] lmap ;
 
-TUPLE: linterp names reps ;
+: lambda>string ( expr -- string )
-: (lint>string) ( linterp expr -- linterp )
+    bound-vars swap expr>string ;
-    bound-variables-list swap expr>string over dupd linterp-reps hash 
-    ", " join ":" append swap append "=> " swap append ;
 
-: update-names ( names-hash name expr -- names-hash )
+: matching-names ( names string -- string )
-    swap rot [ set-hash ] keep ;
+    #! this inefficiently finds all names matching the
+    #! canonical representation of string
+    [ \ evaluate , \ lambda>string , , \ = , \ nip , ] [ ] make 
+    hash-subset hash-keys ", " join "=> " swap append ": " append ;
 
-C: linterp ( names-hash )
+: lambda-print ( names expr -- names )
-    #! take a names hash, and generate the reverse lookup hash from it.
+    lambda>string [ matching-names ] 2keep rot swap append print flush ;
-    #! TODO: make this really ugly code cleaner
-    2dup set-linterp-names swap H{ } clone [ swap hash>alist
-    [ [ first ] keep second bound-variables-list swap expr>string rot
-    [ hash ] 2keep rot dup not [ drop rot { } swap add -rot ] 
-    [ >r rot r> swap add -rot ] if set-hash ] each-with ] keep
-    swap [ set-linterp-reps ] keep ;
 
-: lint-read ( -- input )
+: lambda-eval ( names input -- names expr )
-    readln [ "." = ] keep swap ;
+    lambda-parse [ first ] keep second 
+    pick swap replace-names 
+    [ swap rot set-hash ] 3keep evaluate nip ;
 
-: lint-eval ( linterp input -- linterp name expr )
+: lambda-boot ( -- names )
-    lambda-parse [ first ] keep second pick linterp-names swap replace-names
+    #! load the core lambda library
-    evaluate ;
+    H{ } clone ;
 
-: lint>string ( linterp name expr -- linterp  )
+: (lambda) ( names -- names )
-    rot linterp-names -rot [ update-names ] keep [ <linterp> ] dip
+     readln dup "." = [ drop ] [ lambda-eval lambda-print (lambda) ] if ;
-    (lint>string) ;
 
-: lint-print ( linterp name expr -- linterp )
+: lambda ( -- names )
-    lint>string print flush ;
+    lambda-boot (lambda) ;
-
-: lint-boot ( -- initial-names )
-    H{ } clone <linterp> ;
-
-: (lint) ( linterp -- linterp )
-     lint-read [ drop ] [ lint-eval lint-print (lint) ] if ;
-
-: lint ( -- linterp )
-    lint-boot (lint) ;

contrib/lambda/test/lambda.factor

@@ -1,12 +1,11 @@
-USING: lambda parser-combinators test kernel ;
+USING: lambda test hashtables sequences kernel ;
 
-[ "Yuuki" ] [ "Yuuki" <id> some call variable-node-var ] unit-test
+#! test simple parsing
-[ T{ lambda-node f "a" "b" } ] [ "( a. b )" lambda-parse ] unit-test
+[ "(A. A)" ] [ "(b.b)" lambda-parse second bound-vars swap expr>string ] unit-test
 
-[ T{ lambda-node f "a" "c" } ]
+#! test name replacement
-    [ "c" "b" T{ lambda-node f "a" "b" } substitute ] unit-test
+[ "(A. A)" ] [ 
-[ T{ lambda-node f "a" "b" } ]
+                "(b.b)" lambda-parse second "OK" H{ } clone [ set-hash ] keep
-    [ "c" "a" T{ lambda-node f "a" "b" } substitute ] unit-test
+                "OK" lambda-parse second replace-names bound-vars
-
+                swap expr>string 
-[ T{ lambda-node f "b" "b" } ]
+             ] unit-test
-    [ "((a. (c. (b. (b (a c))))) (d. d))" lambda-parse reduce ] unit-test