shen-ruby 0.10.0 → 0.11.0

data/shen/release/benchmarks/jnk.shen

@@ -1,194 +1,194 @@
-(define kl-to-lisp
-   Params Param -> Param    where (element? Param Params)
-   Params [type X _] -> (kl-to-lisp Params X)
-   Params [lambda X Y] -> [FUNCTION [LAMBDA [X] (kl-to-lisp [X | Params] Y)]] 
-   Params [let X Y Z] -> [LET [[X (kl-to-lisp Params Y)]] 
-                                 (kl-to-lisp [X | Params] Z)]
-   _ [defun F Params Code] -> [DEFUN F Params (kl-to-lisp Params Code)]
-   Params [cond | Cond] -> [COND | (map (/. C (cond_code Params C)) (insert-default Cond))]  
-   Params [Param | X] -> (higher-order-code Param
-                                (map (/. Y (kl-to-lisp Params Y)) X))
-                                        where (element? Param Params)
-   Params [[X | Y] | Z] -> (higher-order-code (kl-to-lisp Params [X | Y])
-                                               (map (/. W (kl-to-lisp Params W)) Z))   
-   Params [F | X] -> (assemble-application F 
-                                     (map (/. Y (kl-to-lisp Params Y)) X))
-                                 where (symbol? F)
-   _ [] -> []                              
-   _ S -> [QUOTE S]  where (or (symbol? S) (boolean? S))
-   _ X -> X)
-
-(define insert-default
-  [] -> [[true [ERROR "error: cond failure~%"]]]
-  [[true X] | Y] -> [[true X] | Y] 
-  [Case | Cases] -> [Case | (insert-default Cases)])    
-   
-(define higher-order-code 
-   F X -> [let Args [LIST | X]
-            [let NewF [maplispsym F]
-               [trap-error [APPLY NewF Args] 
-                           [lambda E [COND [[arity-error? F Args] 
-                                            [funcall [EVAL [nest-lambda F NewF]] Args]]
-                                           [[EQ NewF [QUOTE or]]
-                                            [funcall [lambda X1 [lambda X2 [or X1 X2]]] Args]]
-                                           [[EQ NewF [QUOTE and]]
-                                            [funcall [lambda X1 [lambda X2 [and X1 X2]]] Args]]
-                                           [[EQ NewF [QUOTE trap-error]]
-                                            [funcall [lambda X1 [lambda X2 [trap-error X1 X2]]] Args]]
-                                           [[bad-lambda-call? NewF Args] 
-                                            [funcall NewF Args]]
-                                           [T [relay-error E]]]]]]])
-                                           
-(define bad-lambda-call?
-  F Args -> (AND (FUNCTIONP F) (NOT (= (LIST-LENGTH Args) 1))))
-                                         
-(define relay-error
-  E -> (ERROR (error-to-string E)))
-                                         
-(define funcall
-  Lambda [] -> Lambda
-  Lambda [X | Y] -> (funcall (FUNCALL Lambda X) Y))   
-  
-(define arity-error?
-   F Args -> (AND (SYMBOLP F)
-                  (> (trap-error (arity F) (/. E -1)) (LIST-LENGTH Args)))       
-   
-(define nest-lambda
-   F NewF -> (nest-lambda-help NewF (trap-error (arity F) (/. E -1))))
-   
-(define nest-lambda-help
-  F -1 -> F
-  F 0 -> F
-  F N -> (let X (gensym (protect Y))
-                 [lambda X (nest-lambda-help (add-p F X) (- N 1))]))
-  
-(define add-p
-  [F | X] Y -> (append [F | X] [Y])
-  F X -> [F X])           
- 
-(define cond_code
-   Params [Test Result] -> [(lisp_test Params Test) 
-                             (kl-to-lisp Params Result)])
-                             
-(define lisp_test
-   _ true -> T
-   Params [and | Tests] -> [AND | (map (/. X (wrap (kl-to-lisp Params X))) Tests)]
-   Params Test -> (wrap (kl-to-lisp Params Test))) 
-   
- (define wrap 
-    [cons? X] -> [CONSP X]
-    [string? X] -> [STRINGP X]
-    [number? X] -> [NUMBERP X]
-    [empty? X] -> [NULL X]
-    [and P Q] -> [AND (wrap P) (wrap Q)]
-    [or P Q] -> [OR (wrap P) (wrap Q)] 
-    [not P] -> [NOT (wrap P)] 
-    [equal? X []] -> [NULL X]
-    [equal? [] X] -> [NULL X]
-    [equal? X [Quote Y]] -> [EQ X [Quote Y]]    
-                              where (and (= (SYMBOLP Y) T) (= Quote QUOTE))
-    [equal? [Quote Y] X] -> [EQ [Quote Y] X]    
-                                where (and (= (SYMBOLP Y) T) (= Quote QUOTE)) 
-    [equal? [fail] X] -> [EQ [fail] X]
-    [equal? X [fail]] -> [EQ X [fail]]
-    [equal? S X] -> [EQUAL S X]  where (string? S)
-    [equal? X S] -> [EQUAL X S]  where (string? S)
-    [equal? X Y] -> [shen-ABSEQUAL X Y]
-    [shen-+string? [tlstr X]] -> [NOT [STRING-EQUAL [tlstr X] ""]]
-    [shen-pvar? X] -> [AND [ARRAYP X] [NOT [STRINGP X]] [EQ [AREF X 0] [QUOTE shen-pvar]]] 
-    [tuple? X] -> [AND [ARRAYP X] [NOT [STRINGP X]] [EQ [AREF X 0] [QUOTE shen-tuple]]]
-    [greater? X Y] -> [> X Y]
-    [greater-than-or-equal-to? X Y] -> [>= X Y]
-    [less? X Y] -> [< X Y]
-    [less-than-or-equal-to? X Y] -> [<= X Y]
-    X -> [wrapper X])
-
- (define wrapper
-   true -> T
-   false -> []
-   X -> (error "boolean expected: not ~S~%" X)) 
-   
- (define assemble-application
-   hd [X] -> (protect [CAR X])
-   tl [X] -> (protect [CDR X])
-   cons [X Y] -> (protect [CONS X Y])
-   append [X Y] -> (protect [APPEND X Y])
-   reverse [X] -> (protect [REVERSE X])
-   if [P Q R] -> (protect [IF (wrap P) Q R])
-   + [1 X] -> [1+ X]
-   + [X 1] -> [1+ X]
-   - [X 1] -> [1- X]
-   value [[Quote X]] -> X  where (= Quote (protect QUOTE))
-   set [[Quote X] [1+ X]] -> [INCF X]  where (= Quote (protect QUOTE))
-   set [[Quote X] [1- X]] -> [DECF X]  where (= Quote (protect QUOTE))
-   F X -> (let NewF (maplispsym F)
-               Arity (trap-error (arity F) (/. E -1))
-               (if (or (= Arity (length X)) (= Arity -1))
-                   [NewF | X]
-                   [funcall (nest-lambda F NewF) [(protect LIST) | X]])))
-                   
-(define maplispsym  
-    = -> equal?
-    > -> greater?
-    < -> less?
-    >= -> greater-than-or-equal-to?
-    <= -> less-than-or-equal-to?
-    + -> add
-    - -> subtract
-    / -> divide
-    * -> multiply
-    F -> F)
-    
- (define factorh
-  [Defun F Params [Cond | Code]] -> [Defun F Params [BLOCK [] (process-tree (tree (map returns Code)))]]
-                                       where (and (= Cond COND) (= Defun DEFUN))
-  Code -> Code)
-  
-(define returns
-  [Test Result] -> [Test [RETURN Result]]) 
-    
-(define process-tree
-   (@p P Q R no-tag) -> [IF P (optimise-selectors P (process-tree Q)) (process-tree R)]
-   (@p P Q R Tag) -> [TAGBODY [IF P (optimise-selectors P (process-tree Q))] Tag (process-tree R)]
-   Q -> Q    where (not (tuple? Q))) 
-   
-(define optimise-selectors 
-  Test Code -> (optimise-selectors-help (selectors-from Test) Code))                       
-
-(define selectors-from
-  [Consp X] -> [[CAR X] [CDR X]]    where (= Consp CONSP)
-  [tuple? X] -> [[fst X] [snd X]]  
-  _ -> [])    
-  
-(define optimise-selectors-help 
-   [] Code -> Code
-   [S1 S2] Code -> (let O1 (occurrences S1 Code)  
-                        O2 (occurrences S2 Code) 
-                        V1 (gensym V)
-                        V2 (gensym V)
-                        (if (and (> O1 1) (> O2 1))
-                            [LET [[V1 S1] [V2 S2]]  
-                                 (subst V1 S1 (subst V2 S2 Code))]
-                            (if (> O1 1)
-                                 [LET [[V1 S1]] (subst V1 S1 Code)] 
-                                 (if (> O2 1)
-                                      [LET [[V2 S2]] (subst V2 S2 Code)]
-                                      Code)))))        
-
-(define tree
-  [[[And P Q] R] | S] ->  (let Tag (gensym tag)
-                                Left (tree (append (branch-by P [[[And P Q] R] | S]) [[T [GO Tag]]]))
-                                Right (tree (branch-by-not P [[[And P Q] R] | S]))                                
-                                (@p P Left Right Tag))     where (= And AND)                 
-  [[True Q] | _] -> Q     where (= True T)                         
-  [[P Q] | R] -> (@p P Q (tree R) no-tag))
-  
-(define branch-by
-  P [[[And P Q] R] | S] -> [[Q R] | (branch-by P S)]   where (= And AND)
-  P [[P R] | S] -> [[T R]]
-  _ Code -> [])
-  
-(define branch-by-not
-  P [[[And P Q] R] | S] -> (branch-by-not P S)  where (= And AND)
-  P [[P R] | S] -> S
+(define kl-to-lisp
+   Params Param -> Param    where (element? Param Params)
+   Params [type X _] -> (kl-to-lisp Params X)
+   Params [lambda X Y] -> [FUNCTION [LAMBDA [X] (kl-to-lisp [X | Params] Y)]] 
+   Params [let X Y Z] -> [LET [[X (kl-to-lisp Params Y)]] 
+                                 (kl-to-lisp [X | Params] Z)]
+   _ [defun F Params Code] -> [DEFUN F Params (kl-to-lisp Params Code)]
+   Params [cond | Cond] -> [COND | (map (/. C (cond_code Params C)) (insert-default Cond))]  
+   Params [Param | X] -> (higher-order-code Param
+                                (map (/. Y (kl-to-lisp Params Y)) X))
+                                        where (element? Param Params)
+   Params [[X | Y] | Z] -> (higher-order-code (kl-to-lisp Params [X | Y])
+                                               (map (/. W (kl-to-lisp Params W)) Z))   
+   Params [F | X] -> (assemble-application F 
+                                     (map (/. Y (kl-to-lisp Params Y)) X))
+                                 where (symbol? F)
+   _ [] -> []                              
+   _ S -> [QUOTE S]  where (or (symbol? S) (boolean? S))
+   _ X -> X)
+
+(define insert-default
+  [] -> [[true [ERROR "error: cond failure~%"]]]
+  [[true X] | Y] -> [[true X] | Y] 
+  [Case | Cases] -> [Case | (insert-default Cases)])    
+   
+(define higher-order-code 
+   F X -> [let Args [LIST | X]
+            [let NewF [maplispsym F]
+               [trap-error [APPLY NewF Args] 
+                           [lambda E [COND [[arity-error? F Args] 
+                                            [funcall [EVAL [nest-lambda F NewF]] Args]]
+                                           [[EQ NewF [QUOTE or]]
+                                            [funcall [lambda X1 [lambda X2 [or X1 X2]]] Args]]
+                                           [[EQ NewF [QUOTE and]]
+                                            [funcall [lambda X1 [lambda X2 [and X1 X2]]] Args]]
+                                           [[EQ NewF [QUOTE trap-error]]
+                                            [funcall [lambda X1 [lambda X2 [trap-error X1 X2]]] Args]]
+                                           [[bad-lambda-call? NewF Args] 
+                                            [funcall NewF Args]]
+                                           [T [relay-error E]]]]]]])
+                                           
+(define bad-lambda-call?
+  F Args -> (AND (FUNCTIONP F) (NOT (= (LIST-LENGTH Args) 1))))
+                                         
+(define relay-error
+  E -> (ERROR (error-to-string E)))
+                                         
+(define funcall
+  Lambda [] -> Lambda
+  Lambda [X | Y] -> (funcall (FUNCALL Lambda X) Y))   
+  
+(define arity-error?
+   F Args -> (AND (SYMBOLP F)
+                  (> (trap-error (arity F) (/. E -1)) (LIST-LENGTH Args)))       
+   
+(define nest-lambda
+   F NewF -> (nest-lambda-help NewF (trap-error (arity F) (/. E -1))))
+   
+(define nest-lambda-help
+  F -1 -> F
+  F 0 -> F
+  F N -> (let X (gensym (protect Y))
+                 [lambda X (nest-lambda-help (add-p F X) (- N 1))]))
+  
+(define add-p
+  [F | X] Y -> (append [F | X] [Y])
+  F X -> [F X])           
+ 
+(define cond_code
+   Params [Test Result] -> [(lisp_test Params Test) 
+                             (kl-to-lisp Params Result)])
+                             
+(define lisp_test
+   _ true -> T
+   Params [and | Tests] -> [AND | (map (/. X (wrap (kl-to-lisp Params X))) Tests)]
+   Params Test -> (wrap (kl-to-lisp Params Test))) 
+   
+ (define wrap 
+    [cons? X] -> [CONSP X]
+    [string? X] -> [STRINGP X]
+    [number? X] -> [NUMBERP X]
+    [empty? X] -> [NULL X]
+    [and P Q] -> [AND (wrap P) (wrap Q)]
+    [or P Q] -> [OR (wrap P) (wrap Q)] 
+    [not P] -> [NOT (wrap P)] 
+    [equal? X []] -> [NULL X]
+    [equal? [] X] -> [NULL X]
+    [equal? X [Quote Y]] -> [EQ X [Quote Y]]    
+                              where (and (= (SYMBOLP Y) T) (= Quote QUOTE))
+    [equal? [Quote Y] X] -> [EQ [Quote Y] X]    
+                                where (and (= (SYMBOLP Y) T) (= Quote QUOTE)) 
+    [equal? [fail] X] -> [EQ [fail] X]
+    [equal? X [fail]] -> [EQ X [fail]]
+    [equal? S X] -> [EQUAL S X]  where (string? S)
+    [equal? X S] -> [EQUAL X S]  where (string? S)
+    [equal? X Y] -> [shen-ABSEQUAL X Y]
+    [shen-+string? [tlstr X]] -> [NOT [STRING-EQUAL [tlstr X] ""]]
+    [shen-pvar? X] -> [AND [ARRAYP X] [NOT [STRINGP X]] [EQ [AREF X 0] [QUOTE shen-pvar]]] 
+    [tuple? X] -> [AND [ARRAYP X] [NOT [STRINGP X]] [EQ [AREF X 0] [QUOTE shen-tuple]]]
+    [greater? X Y] -> [> X Y]
+    [greater-than-or-equal-to? X Y] -> [>= X Y]
+    [less? X Y] -> [< X Y]
+    [less-than-or-equal-to? X Y] -> [<= X Y]
+    X -> [wrapper X])
+
+ (define wrapper
+   true -> T
+   false -> []
+   X -> (error "boolean expected: not ~S~%" X)) 
+   
+ (define assemble-application
+   hd [X] -> (protect [CAR X])
+   tl [X] -> (protect [CDR X])
+   cons [X Y] -> (protect [CONS X Y])
+   append [X Y] -> (protect [APPEND X Y])
+   reverse [X] -> (protect [REVERSE X])
+   if [P Q R] -> (protect [IF (wrap P) Q R])
+   + [1 X] -> [1+ X]
+   + [X 1] -> [1+ X]
+   - [X 1] -> [1- X]
+   value [[Quote X]] -> X  where (= Quote (protect QUOTE))
+   set [[Quote X] [1+ X]] -> [INCF X]  where (= Quote (protect QUOTE))
+   set [[Quote X] [1- X]] -> [DECF X]  where (= Quote (protect QUOTE))
+   F X -> (let NewF (maplispsym F)
+               Arity (trap-error (arity F) (/. E -1))
+               (if (or (= Arity (length X)) (= Arity -1))
+                   [NewF | X]
+                   [funcall (nest-lambda F NewF) [(protect LIST) | X]])))
+                   
+(define maplispsym  
+    = -> equal?
+    > -> greater?
+    < -> less?
+    >= -> greater-than-or-equal-to?
+    <= -> less-than-or-equal-to?
+    + -> add
+    - -> subtract
+    / -> divide
+    * -> multiply
+    F -> F)
+    
+ (define factorh
+  [Defun F Params [Cond | Code]] -> [Defun F Params [BLOCK [] (process-tree (tree (map returns Code)))]]
+                                       where (and (= Cond COND) (= Defun DEFUN))
+  Code -> Code)
+  
+(define returns
+  [Test Result] -> [Test [RETURN Result]]) 
+    
+(define process-tree
+   (@p P Q R no-tag) -> [IF P (optimise-selectors P (process-tree Q)) (process-tree R)]
+   (@p P Q R Tag) -> [TAGBODY [IF P (optimise-selectors P (process-tree Q))] Tag (process-tree R)]
+   Q -> Q    where (not (tuple? Q))) 
+   
+(define optimise-selectors 
+  Test Code -> (optimise-selectors-help (selectors-from Test) Code))                       
+
+(define selectors-from
+  [Consp X] -> [[CAR X] [CDR X]]    where (= Consp CONSP)
+  [tuple? X] -> [[fst X] [snd X]]  
+  _ -> [])    
+  
+(define optimise-selectors-help 
+   [] Code -> Code
+   [S1 S2] Code -> (let O1 (occurrences S1 Code)  
+                        O2 (occurrences S2 Code) 
+                        V1 (gensym V)
+                        V2 (gensym V)
+                        (if (and (> O1 1) (> O2 1))
+                            [LET [[V1 S1] [V2 S2]]  
+                                 (subst V1 S1 (subst V2 S2 Code))]
+                            (if (> O1 1)
+                                 [LET [[V1 S1]] (subst V1 S1 Code)] 
+                                 (if (> O2 1)
+                                      [LET [[V2 S2]] (subst V2 S2 Code)]
+                                      Code)))))        
+
+(define tree
+  [[[And P Q] R] | S] ->  (let Tag (gensym tag)
+                                Left (tree (append (branch-by P [[[And P Q] R] | S]) [[T [GO Tag]]]))
+                                Right (tree (branch-by-not P [[[And P Q] R] | S]))                                
+                                (@p P Left Right Tag))     where (= And AND)                 
+  [[True Q] | _] -> Q     where (= True T)                         
+  [[P Q] | R] -> (@p P Q (tree R) no-tag))
+  
+(define branch-by
+  P [[[And P Q] R] | S] -> [[Q R] | (branch-by P S)]   where (= And AND)
+  P [[P R] | S] -> [[T R]]
+  _ Code -> [])
+  
+(define branch-by-not
+  P [[[And P Q] R] | S] -> (branch-by-not P S)  where (= And AND)
+  P [[P R] | S] -> S
   _ Code -> Code)   

data/shen/release/benchmarks/powerset.shen

@@ -1,10 +1,10 @@
-(define powerset
-   [] -> [[]]
-   [X | Y] -> (let Powerset (powerset Y)
-                (append (cons-X-to-each-set X Powerset) Powerset)))
-
-(define cons-X-to-each-set  
-    _ [ ] -> [ ]  
-    X [Y | Z] -> [[X | Y] | (cons-X-to-each-set X Z)])
-
-
+(define powerset
+   [] -> [[]]
+   [X | Y] -> (let Powerset (powerset Y)
+                (append (cons-X-to-each-set X Powerset) Powerset)))
+
+(define cons-X-to-each-set  
+    _ [ ] -> [ ]  
+    X [Y | Z] -> [[X | Y] | (cons-X-to-each-set X Z)])
+
+

data/shen/release/benchmarks/prime.shen

@@ -1,10 +1,10 @@
-(define prime? 
-  X -> (prime* X (sqrt X) 2))
-
-(define prime*
-  X Max Div -> false	where (integer? (/ X Div))				
-  X Max Div -> true	where (> Div Max)			
-  X Max Div -> (prime* X Max (+ 1 Div)))
-
- 
-
+(define prime? 
+  X -> (prime* X (sqrt X) 2))
+
+(define prime*
+  X Max Div -> false	where (integer? (/ X Div))				
+  X Max Div -> true	where (> Div Max)			
+  X Max Div -> (prime* X Max (+ 1 Div)))
+
+ 
+

data/shen/release/benchmarks/short.shen

@@ -1,129 +1,129 @@
-(define l_interpreter
-  {A --> B}
-  _ -> (read_eval_print_loop (output "~%L interpreter ~%~%~%~%l-interp --> ~A~%" 
-                                     (normal_form (input+ : l_formula)))))
-
-(define read_eval_print_loop
-  {string --> A}
-  _ -> (read_eval_print_loop 
-           (output "l-interp --> ~A~%"
-              (normal_form (input+ : l_formula))))) 
-
-(define normal_form
-  {l_formula --> l_formula}
-   X -> (fix ==> X))                 
-    
-(define ==>
-   {l_formula --> l_formula}
-   [= X Y] -> (let X* (normal_form X) 
-                   (let Y* (normal_form Y) 
-                        (if (or (eval_error? X*) (eval_error? Y*))
-                            "error!"
-                            (if (= X* Y*) true false))))
-   [[/. P X] Y] -> (let Match (match P (normal_form Y))
-                        (if (no_match? Match) 
-                            "no match"
-                            (sub Match X))) 
-   [if X Y Z] -> (let X* (normal_form X)
-                      (if (= X* true)
-                          Y
-                          (if (= X* false)
-                              Z
-                              "error!")))
-   [let X Y Z] -> [[/. X Z] Y]
-   [@p X Y] -> (let X* (normal_form X)
-                    (let Y* (normal_form Y)
-                         (if (or (eval_error? X*) (eval_error? Y*))
-                             "error!"
-                             [@p X* Y*])))
-   [cons X Y] -> (let X* (normal_form X)
-                      (let Y* (normal_form Y)
-                           (if (or (eval_error? X*) (eval_error? Y*))
-                               "error!"
-                               [cons X* Y*])))
-   [++ X] -> (successor (normal_form X))
-   [-- X] -> (predecessor (normal_form X))
-   \*[cases X1 | Xn] -> (let Case1 (normal_form X1)
-                           (if (= Case1 "no match")
-                               [cases | Xn]
-                               Case1))
-   [cases] -> "error!"            
-   [where X Y] -> [if X Y "no match"]
-   [y-combinator [/. X Y]] -> (replace X [y-combinator [/. X Y]] Y)
-   [X Y] -> (let X* (normal_form X)
-               (let Y* (normal_form Y)
-                  (if (or (eval_error? X*) (eval_error? Y*))
-                      "error!"
-                      [X* Y*])))*\
-    X -> X)
-
-(define eval_error?
-  {l_formula --> boolean}
-   "error!" -> true
-   "no match" -> true
-   _ -> false)  
-
-(define successor
-  {A --> l_formula}
-  X -> (+ 1 X) where (number? X)
-  _ -> "error!")
-
-(define predecessor
-  {A --> l_formula}
-  X -> (- X 1) where (number? X)
-  _ -> "error!")
-
-\* (spy +) *\
-
-(define sub
-  {[(pattern * l_formula)] --> l_formula --> l_formula}
-   [] X -> X
-   [(@p Var Val) | Assoc] X -> (sub Assoc (replace Var Val X)))
-
-(define match
-   {pattern --> l_formula --> (list (pattern * l_formula))}
-    P X -> [] where (== P X)
-    P X -> [(@p P X)]      where (variable? P)
-    [cons P1 P2] [cons X Y] -> (let Match1 (match P1 X)
-                                    (if (no_match? Match1)
-                                        Match1
-                                        (let Match2 (match P2 Y)
-                                            (if (no_match? Match2)
-                                                Match2
-						(append Match1 Match2)))))
-    [@p P1 P2] [@p X Y] -> (let Match1 (match P1 X)
-                                    (if (no_match? Match1)
-                                        Match1
-                                        (let Match2 (match P2 Y)
-                                            (if (no_match? Match2)
-                                                Match2
-						(append Match1 Match2)))))
-
-    _ _ -> [(@p no matching)])
-      
-(define no_match?
-  {[(pattern * l_formula)] --> boolean}
-   [(@p no matching)] -> true
-   _ -> false)
-
-(define replace
-   {pattern --> l_formula --> l_formula --> l_formula}
-    V W [let V* X Y] -> [let V* X Y]  where (== V V*)
-    X Y X -> Y
-    V W [= X Y] -> [= (replace V W X) (replace V W Y)]
-    V W [/. P X] -> [/. P (replace V W X)] 		where (free? V P)
-    V W [if X Y Z] -> [if (replace V W X) (replace V W Y) (replace V W Z)]
-    V W [let X Y Z] -> [let X (replace V W Y) (replace V W Z)]
-    V W [@p X Y] -> [@p (replace V W X) (replace V W Y)]
-    \* V W [cons X Y] -> [cons (replace V W X) (replace V W Y)]
-    V W [cases | Xn] -> [cases | (map (/. Xi (replace V W Xi)) Xn)]
-    V W [where X Y] -> [where (replace V W X) (replace V W Y)]
-    V W [X Y] -> [(replace V W X) (replace V W Y)] *\
-    _ _ X -> X) 	
-
-(define free?
-  {pattern --> pattern --> boolean}
-   P P -> false 
-   P [cons P1 P2] -> (and (free? P P1) (free? P P2))
-   P [@p P1 P2] -> (and (free? P P1) (free? P P2))
-   _ _ -> true)
+(define l_interpreter
+  {A --> B}
+  _ -> (read_eval_print_loop (output "~%L interpreter ~%~%~%~%l-interp --> ~A~%" 
+                                     (normal_form (input+ : l_formula)))))
+
+(define read_eval_print_loop
+  {string --> A}
+  _ -> (read_eval_print_loop 
+           (output "l-interp --> ~A~%"
+              (normal_form (input+ : l_formula))))) 
+
+(define normal_form
+  {l_formula --> l_formula}
+   X -> (fix ==> X))                 
+    
+(define ==>
+   {l_formula --> l_formula}
+   [= X Y] -> (let X* (normal_form X) 
+                   (let Y* (normal_form Y) 
+                        (if (or (eval_error? X*) (eval_error? Y*))
+                            "error!"
+                            (if (= X* Y*) true false))))
+   [[/. P X] Y] -> (let Match (match P (normal_form Y))
+                        (if (no_match? Match) 
+                            "no match"
+                            (sub Match X))) 
+   [if X Y Z] -> (let X* (normal_form X)
+                      (if (= X* true)
+                          Y
+                          (if (= X* false)
+                              Z
+                              "error!")))
+   [let X Y Z] -> [[/. X Z] Y]
+   [@p X Y] -> (let X* (normal_form X)
+                    (let Y* (normal_form Y)
+                         (if (or (eval_error? X*) (eval_error? Y*))
+                             "error!"
+                             [@p X* Y*])))
+   [cons X Y] -> (let X* (normal_form X)
+                      (let Y* (normal_form Y)
+                           (if (or (eval_error? X*) (eval_error? Y*))
+                               "error!"
+                               [cons X* Y*])))
+   [++ X] -> (successor (normal_form X))
+   [-- X] -> (predecessor (normal_form X))
+   \*[cases X1 | Xn] -> (let Case1 (normal_form X1)
+                           (if (= Case1 "no match")
+                               [cases | Xn]
+                               Case1))
+   [cases] -> "error!"            
+   [where X Y] -> [if X Y "no match"]
+   [y-combinator [/. X Y]] -> (replace X [y-combinator [/. X Y]] Y)
+   [X Y] -> (let X* (normal_form X)
+               (let Y* (normal_form Y)
+                  (if (or (eval_error? X*) (eval_error? Y*))
+                      "error!"
+                      [X* Y*])))*\
+    X -> X)
+
+(define eval_error?
+  {l_formula --> boolean}
+   "error!" -> true
+   "no match" -> true
+   _ -> false)  
+
+(define successor
+  {A --> l_formula}
+  X -> (+ 1 X) where (number? X)
+  _ -> "error!")
+
+(define predecessor
+  {A --> l_formula}
+  X -> (- X 1) where (number? X)
+  _ -> "error!")
+
+\* (spy +) *\
+
+(define sub
+  {[(pattern * l_formula)] --> l_formula --> l_formula}
+   [] X -> X
+   [(@p Var Val) | Assoc] X -> (sub Assoc (replace Var Val X)))
+
+(define match
+   {pattern --> l_formula --> (list (pattern * l_formula))}
+    P X -> [] where (== P X)
+    P X -> [(@p P X)]      where (variable? P)
+    [cons P1 P2] [cons X Y] -> (let Match1 (match P1 X)
+                                    (if (no_match? Match1)
+                                        Match1
+                                        (let Match2 (match P2 Y)
+                                            (if (no_match? Match2)
+                                                Match2
+						(append Match1 Match2)))))
+    [@p P1 P2] [@p X Y] -> (let Match1 (match P1 X)
+                                    (if (no_match? Match1)
+                                        Match1
+                                        (let Match2 (match P2 Y)
+                                            (if (no_match? Match2)
+                                                Match2
+						(append Match1 Match2)))))
+
+    _ _ -> [(@p no matching)])
+      
+(define no_match?
+  {[(pattern * l_formula)] --> boolean}
+   [(@p no matching)] -> true
+   _ -> false)
+
+(define replace
+   {pattern --> l_formula --> l_formula --> l_formula}
+    V W [let V* X Y] -> [let V* X Y]  where (== V V*)
+    X Y X -> Y
+    V W [= X Y] -> [= (replace V W X) (replace V W Y)]
+    V W [/. P X] -> [/. P (replace V W X)] 		where (free? V P)
+    V W [if X Y Z] -> [if (replace V W X) (replace V W Y) (replace V W Z)]
+    V W [let X Y Z] -> [let X (replace V W Y) (replace V W Z)]
+    V W [@p X Y] -> [@p (replace V W X) (replace V W Y)]
+    \* V W [cons X Y] -> [cons (replace V W X) (replace V W Y)]
+    V W [cases | Xn] -> [cases | (map (/. Xi (replace V W Xi)) Xn)]
+    V W [where X Y] -> [where (replace V W X) (replace V W Y)]
+    V W [X Y] -> [(replace V W X) (replace V W Y)] *\
+    _ _ X -> X) 	
+
+(define free?
+  {pattern --> pattern --> boolean}
+   P P -> false 
+   P [cons P1 P2] -> (and (free? P P1) (free? P P2))
+   P [@p P1 P2] -> (and (free? P P1) (free? P P2))
+   _ _ -> true)