Lambda fixes - added alien input

contrib/lambda/core.factor

@@ -15,18 +15,21 @@ IN: lambda
     
     0 lfrom 26 swap ltake list>array
     [
-        [ ":" , dup 65 + ch>string , " " , number>string , ] { } make concat
+        [ ":" , 65 + dup ch>string , " " , number>string , ] { } make concat
     ] map append
     
     {
         ":LF 10"
         ":FALSE (t.(f.f))"
         ":TRUE (t.(f.t))"
+        ":AND (p.(q.((p q) FALSE)))"
+        ":OR (p.(q.((p TRUE) q)))"
         ":ISZERO (num.((num (pred. FALSE)) TRUE))"
         ":ADD (num.(other.((num SUCC) other)))"
         ":MULT (num.(other.((num (ADD other)) 0)))"
         ":PRED (n.(f.(x.(((n (g.(h.(h(g f))))) (u. x)) (u.u)))))"
         ":SUBFROM (num.(other.((num PRED) other)))"
+        ":EQUAL (num.(other.((AND (ISZERO ((SUBFROM num) other))) (ISZERO ((SUBFROM other) num)))))"
         ":FACT (fact.(num.(((ISZERO num) 1) ((MULT num) (fact (PRED num))))))"
         ":YCOMBINATOR (func.((y. (func (y y)))(y. (func (y y)))))"
         ":FACTORIAL (YCOMBINATOR FACT)"
@@ -36,13 +39,12 @@ IN: lambda
         ":PCONS (pcons.(num.(cons.(((ISZERO num) (PRINTSPECIAL LF)) ((PRINTCHAR (CAR cons)) ((pcons (PRED num)) (CDR cons)))))))"
         ":PRINTCONS (YCOMBINATOR PCONS)"
         ":NUMTOCHAR (num. ((ADD 48) num))"
-        ":ALPHATOCHAR (num. ((ADD 65) num))"
+        ":PRINTNUM (num.(PRINTCHAR (NUMTOCHAR num)))"
-        ":PRINTNUM (num.([PRINTCHAR] (ALIENNUM (NUMTOCHAR num))))"
+        ":PRINTCHAR (char.([PRINTCHAR] (ALIENNUM char)))"
-        ":PRINTCHAR (char.([PRINTCHAR] (ALIENNUM (ALPHATOCHAR char))))"
         ":PRINTSPECIAL (special.([PRINTCHAR] (ALIENNUM special)))"
         ":ALIEN0 alienbaseonenum"
         ":ALIENNUM (num.((num [ALIENSUCC]) ALIEN0))"
-        ":HELLOCONS ((CONS H) ((CONS E) ((CONS Y) nil)))"
+        ":HELLOCONS ((CONS H) ((CONS E) ((CONS Y) ((CONS 0) nil))))"
         ":HELLO ((PRINTCONS 3) HELLOCONS)"
         "(([HELLO] nil) ([INFO] nil))"
     } append ;
@@ -59,7 +61,18 @@ IN: lambda
 : ALIENSUCC ( node -- node )
     variable-node-var "a" append <variable-node> ;
 
+: ALIENPRED ( node -- node )
+    variable-node-var dup length 1 - swap remove-nth <variable-node> ;
+
+: ALIENISZERO ( node -- node )
+    ;
+
 : PRINTCHAR ( node -- node )
     #! takes a base one num and prints its char equivalent
     variable-node-var length "alienbaseonenum" length - ch>string print-return ;
+
+: READCHAR ( node -- node )
+    #! reads one character of input and stores it as a base one num
+    "alienbaseonenum" read1 [ "a" append ] times <variable-node> ;
+
     

contrib/lambda/lambda.TODO

@@ -3,4 +3,9 @@ Lambda TODO
 Documentation
 Unit tests
 More graceful parse error handling
-Factor out tree traversing into its own lib
+Factor out tree traversing into its own lib
+
+Core
+----
+ISNIL
+READCHAR

contrib/lambda/load.factor

@@ -1,3 +1,4 @@
+REQUIRES: lazy-lists parser-combinators ;
 PROVIDE: lambda {
     "nodes.factor"
     "parser.factor"

contrib/lambda/nodes.factor

@@ -1,13 +1,11 @@
 #! A lambda expression manipulator, by Matthew Willis
-REQUIRES: lazy-lists ;
 USING: lazy-lists strings arrays hashtables 
 sequences namespaces words parser kernel ;
 
-IN: kernel
-: dip swap slip ; inline
-
 IN: lambda
 
+: dip swap slip ; inline
+
 TUPLE: lambda-node expr original canonical ;
 TUPLE: apply-node func arg ;
 TUPLE: variable-node var ;
@@ -29,18 +27,18 @@ GENERIC: (traverse)
     swap second execute ;
     
 #! Traverses the tree while executing pre and post order words
-M: lambda-node (traverse) ( data-array word lambda-node -- node )
+M: lambda-node (traverse) ( data-array words lambda-node -- node )
     (pre)
     [ [ lambda-node-expr (traverse) ] keep set-lambda-node-expr ] 3keep 
     (post) ; 
 
-M: apply-node (traverse) ( data-array word apply-node -- node )
+M: apply-node (traverse) ( data-array words apply-node -- node )
     (pre)
     [ [ apply-node-func (traverse) ] keep set-apply-node-func ] 3keep
     [ [ apply-node-arg (traverse) ] keep set-apply-node-arg ] 3keep
     (post) ;
 
-M: variable-node (traverse) ( data-array word variable-node -- node )
+M: variable-node (traverse) ( data-array words variable-node -- node )
     (pre) (post) ;
 
 M: alien-node (traverse) ( data-array word alien-node -- node ) nip nip ;
@@ -48,13 +46,11 @@ M: alien-node (traverse) ( data-array word alien-node -- node ) nip nip ;
 : traverse ( node data-array {pre,post} -- node )
     rot (traverse) ;
 
-: traverse-nop ( data-array node -- node ) nip ;
-
 : pre-order ( node data-array word -- node )
-    { traverse-nop } curry traverse ;
+    { nip } curry traverse ;
     
 : post-order ( node data-array word -- node )
-    { traverse-nop } swap add traverse ;
+    { nip } swap add traverse ;
 
 GENERIC: (clone-pre)
 M: lambda-node (clone-pre) ( data lambda-node -- node )
@@ -71,9 +67,9 @@ M: lambda-node (clone-post) ( data lambda-node -- node )
     nip [ dup <variable-node> -rot lambda-node-expr substitute  ] keep 
     [ set-lambda-node-expr ] keep ;
     
-M: apply-node (clone-post) ( data apply-node -- node ) traverse-nop ;
+M: apply-node (clone-post) ( data apply-node -- node ) nip ;
 
-M: variable-node (clone-post) ( data variable-node -- node ) traverse-nop ;
+M: variable-node (clone-post) ( data variable-node -- node ) nip ;
 
 : clone-node ( node -- clone )
     f { (clone-pre) (clone-post) } traverse ;

contrib/lambda/parser.factor

@@ -6,8 +6,6 @@
 #! <expr> ::= (<expr> <expr>)
 #! <line> ::= <expr>
 #! <line> ::= <name> : <expr>
-
-REQUIRES: parser-combinators ;
 USING: parser-combinators strings sequences kernel ;
 
 IN: lambda
@@ -69,5 +67,4 @@ DEFER: <expr>
     <|> "." token <name> &> f succeed <&> <|> ;
 
 : lambda-parse
-    #! debug word to parse this <expr> and print the result
     <line> some call ;