shen-ruby 0.10.0 → 0.11.0

data/shen/release/benchmarks/N_queens.shen

@@ -1,45 +1,45 @@
-(define n-queens
-  {number --> symbol}
-  N -> (do (map (/. X (output "~A~%" X)) (n-queens-loop N (initialise N))) ok))
-
-(define initialise
-   {number --> (list number)}
-   0 -> []
-   N -> [1 | (initialise (- N 1))])
- 
-(define n-queens-loop
-  {number --> (list number) --> [(list number)]}
-  N Config -> []    where (all_Ns? N Config)
-  N Config -> [Config | (n-queens-loop N (next_n N Config))] 
-                                       where (and (ok_row? Config) (ok_diag? Config))
-  N Config -> (n-queens-loop N (next_n N Config)))
- 
-(define all_Ns?
-  {number --> (list number) --> boolean}
-   _ [] -> true
-  N [N | Ns] -> (all_Ns? N Ns)
-  _ _ -> false)
- 
-(define next_n
-  {number --> (list number) --> (list number)}
-  N [N | Ns] -> [1 | (next_n N Ns)]
-  _ [N | Ns] -> [(+ 1 N) | Ns])
- 
-(define ok_row?
-  {(list number) --> boolean}
-  [] -> true
-  [N | Ns] -> false     where (element? N Ns)
-  [_ | Ns] -> (ok_row? Ns))
- 
-(define ok_diag?
-  {(list number) --> boolean} 
-  [] -> true
-  [N | Ns] -> (and (ok_diag_N? (+ N 1) (- N 1) Ns) 
-                                (ok_diag? Ns)))
- 
-(define ok_diag_N?
-  {number --> number --> (list number) --> boolean}
-  _ _ [] -> true
-  Up Down [Up | _] -> false
-  Up Down [Down | _] -> false
-  Up Down [_ | Ns] -> (ok_diag_N? (+ 1 Up) (- Down 1) Ns)) 
+(define n-queens
+  {number --> symbol}
+  N -> (do (map (/. X (output "~A~%" X)) (n-queens-loop N (initialise N))) ok))
+
+(define initialise
+   {number --> (list number)}
+   0 -> []
+   N -> [1 | (initialise (- N 1))])
+ 
+(define n-queens-loop
+  {number --> (list number) --> [(list number)]}
+  N Config -> []    where (all_Ns? N Config)
+  N Config -> [Config | (n-queens-loop N (next_n N Config))] 
+                                       where (and (ok_row? Config) (ok_diag? Config))
+  N Config -> (n-queens-loop N (next_n N Config)))
+ 
+(define all_Ns?
+  {number --> (list number) --> boolean}
+   _ [] -> true
+  N [N | Ns] -> (all_Ns? N Ns)
+  _ _ -> false)
+ 
+(define next_n
+  {number --> (list number) --> (list number)}
+  N [N | Ns] -> [1 | (next_n N Ns)]
+  _ [N | Ns] -> [(+ 1 N) | Ns])
+ 
+(define ok_row?
+  {(list number) --> boolean}
+  [] -> true
+  [N | Ns] -> false     where (element? N Ns)
+  [_ | Ns] -> (ok_row? Ns))
+ 
+(define ok_diag?
+  {(list number) --> boolean} 
+  [] -> true
+  [N | Ns] -> (and (ok_diag_N? (+ N 1) (- N 1) Ns) 
+                                (ok_diag? Ns)))
+ 
+(define ok_diag_N?
+  {number --> number --> (list number) --> boolean}
+  _ _ [] -> true
+  Up Down [Up | _] -> false
+  Up Down [Down | _] -> false
+  Up Down [_ | Ns] -> (ok_diag_N? (+ 1 Up) (- Down 1) Ns)) 

data/shen/release/benchmarks/README.shen

@@ -1,14 +1,14 @@
-\* 
-
-This is the benchmark macro for Shen.  Assuming your port to Blub is in the directory Platforms/Blub; do the
-following.
-
-1. (cd "../../Benchmarks")
-2. (load "README.shen")
-3. (load "benchmarks.shen")
-
-  *\
-
-(defmacro benchmark-macro
-  [benchmark Message Benchmark] -> [do [nl] [output Message] [time Benchmark]])
-
+\* 
+
+This is the benchmark macro for Shen.  Assuming your port to Blub is in the directory Platforms/Blub; do the
+following.
+
+1. (cd "../../Benchmarks")
+2. (load "README.shen")
+3. (load "benchmarks.shen")
+
+  *\
+
+(defmacro benchmark-macro
+  [benchmark Message Benchmark] -> [do [nl] [output Message] [time Benchmark]])
+

data/shen/release/benchmarks/benchmarks.shen

@@ -1,52 +1,52 @@
-(benchmark "read a 10K binary file" (read-file-as-bytelist "plato.jpg"))
-
-(benchmark "read a 105K binary file" (read-file-as-bytelist "heatwave.gif"))
-
-(benchmark "parse a 7K Shen file" (read-file "interpreter.shen"))
-
-(benchmark "compile a 130 LOC Qi program" (load "short.shen"))
-
-(benchmark "compile a 27 line Prolog program" (load "einstein.shen"))
-
-(benchmark "solve Einstein's puzzle" (prolog? (einsteins_riddle X) (return X)))
-
-(load "powerset.shen")
-
-(benchmark "powerset of 14 numbers" (powerset [1 2 3 4 5 6 7 8 9 10 11 12 13 14]))
-
-(do (set *str* (hd (read-file "text.txt"))) ok)
-
-(define remstr
-  "" -> 0
-  (@s "er" S) -> (+ 1 (remstr S))
-  (@s _ Ss) -> (remstr Ss))
-
-(benchmark "count 'er' in a string" (remstr (value *str*)))
-
-(define vectorn
-  0 -> <>
-  N -> (@v N (vectorn (- N 1))))
-  
-(define vectorp
-  <> -> <>
-  (@v X Y) -> (@v (+ X 1) (vectorp Y))
-  (@v X Y Z) -> (@v (+ X 1) (+ Y 2) (vectorp Z)))
-    
-(benchmark "vector of 1000 elements" (vectorn 1000))
-
-(define tak
-  X Y Z -> Z   where (not (< Y X))
-  X Y Z -> (tak (tak (- X 1) Y Z)
-                (tak (- Y 1) Z X)
-                (tak (- Z 1) X Y)))
-
-(benchmark "(tak 18 12 6)" (tak 18 12 6))
-
-(tc +)
-
-(benchmark "type checking the N queens" (load "N_queens.shen"))
-
-(benchmark "solving the N queens for N = 6" (n-queens 6))
-
-(benchmark "load and typecheck Qi interpreter" (load "interpreter.shen"))
-  
+(benchmark "read a 10K binary file" (read-file-as-bytelist "plato.jpg"))
+
+(benchmark "read a 105K binary file" (read-file-as-bytelist "heatwave.gif"))
+
+(benchmark "parse a 7K Shen file" (read-file "interpreter.shen"))
+
+(benchmark "compile a 130 LOC Qi program" (load "short.shen"))
+
+(benchmark "compile a 27 line Prolog program" (load "einstein.shen"))
+
+(benchmark "solve Einstein's puzzle" (prolog? (einsteins_riddle X) (return X)))
+
+(load "powerset.shen")
+
+(benchmark "powerset of 14 numbers" (powerset [1 2 3 4 5 6 7 8 9 10 11 12 13 14]))
+
+(do (set *str* (hd (read-file "text.txt"))) ok)
+
+(define remstr
+  "" -> 0
+  (@s "er" S) -> (+ 1 (remstr S))
+  (@s _ Ss) -> (remstr Ss))
+
+(benchmark "count 'er' in a string" (remstr (value *str*)))
+
+(define vectorn
+  0 -> <>
+  N -> (@v N (vectorn (- N 1))))
+  
+(define vectorp
+  <> -> <>
+  (@v X Y) -> (@v (+ X 1) (vectorp Y))
+  (@v X Y Z) -> (@v (+ X 1) (+ Y 2) (vectorp Z)))
+    
+(benchmark "vector of 1000 elements" (vectorn 1000))
+
+(define tak
+  X Y Z -> Z   where (not (< Y X))
+  X Y Z -> (tak (tak (- X 1) Y Z)
+                (tak (- Y 1) Z X)
+                (tak (- Z 1) X Y)))
+
+(benchmark "(tak 18 12 6)" (tak 18 12 6))
+
+(tc +)
+
+(benchmark "type checking the N queens" (load "N_queens.shen"))
+
+(benchmark "solving the N queens for N = 6" (n-queens 6))
+
+(benchmark "load and typecheck Qi interpreter" (load "interpreter.shen"))
+  

data/shen/release/benchmarks/einstein.shen

@@ -1,33 +1,33 @@
-(defprolog einsteins_riddle
-  Fish_Owner <-- (einstein Houses Fish_Owner);)
-
-(defprolog einstein
-   Houses Fish_Owner <-- (unify Houses [[house norwegian _ _ _ _] _ [house _ _ _ milk _] _ _])
-                         (member [house brit _ _ _ red] Houses)
-                         (member [house swede dog _ _ _] Houses)
-                         (member [house dane _ _ tea _] Houses)
-                         (iright [house _ _ _ _ green] [house _ _ _ _ white] Houses)
-                         (member [house _ _ _ coffee green] Houses)
-                         (member [house _ bird pallmall _ _] Houses)
-                         (member [house _ _ dunhill _ yellow] Houses)
-                         (next_to [house _ _ dunhill _ _] [house _ horse _ _ _] Houses)
-                         (member [house _ _ _ milk _] Houses)
-                         (next_to [house _ _ marlboro _ _] [house _ cat _ _ _] Houses)
-                         (next_to [house _ _ marlboro _ _] [house _ _ _ water _] Houses)
-                         (member [house _ _ winfield beer _] Houses)
-                         (member [house german _ rothmans _ _] Houses)
-                         (next_to [house norwegian _ _ _ _] [house _ _ _ _ blue] Houses)
-                         (unify Houses [[house norwegian _ _ _ _] _ [house _ _ _ milk _] _ _])
-                         (member [house Fish_Owner fish _ _ _] Houses);)
-
-(defprolog member
- X [X | _] <--;
- X [_ | Z] <-- (member X Z);)
-
-(defprolog next_to
-  X Y List <-- (iright X Y List);
-  X Y List <-- (iright Y X List);)
-
-(defprolog iright
-  L R [L | [R | _]] <--;
+(defprolog einsteins_riddle
+  Fish_Owner <-- (einstein Houses Fish_Owner);)
+
+(defprolog einstein
+   Houses Fish_Owner <-- (unify Houses [[house norwegian _ _ _ _] _ [house _ _ _ milk _] _ _])
+                         (member [house brit _ _ _ red] Houses)
+                         (member [house swede dog _ _ _] Houses)
+                         (member [house dane _ _ tea _] Houses)
+                         (iright [house _ _ _ _ green] [house _ _ _ _ white] Houses)
+                         (member [house _ _ _ coffee green] Houses)
+                         (member [house _ bird pallmall _ _] Houses)
+                         (member [house _ _ dunhill _ yellow] Houses)
+                         (next_to [house _ _ dunhill _ _] [house _ horse _ _ _] Houses)
+                         (member [house _ _ _ milk _] Houses)
+                         (next_to [house _ _ marlboro _ _] [house _ cat _ _ _] Houses)
+                         (next_to [house _ _ marlboro _ _] [house _ _ _ water _] Houses)
+                         (member [house _ _ winfield beer _] Houses)
+                         (member [house german _ rothmans _ _] Houses)
+                         (next_to [house norwegian _ _ _ _] [house _ _ _ _ blue] Houses)
+                         (unify Houses [[house norwegian _ _ _ _] _ [house _ _ _ milk _] _ _])
+                         (member [house Fish_Owner fish _ _ _] Houses);)
+
+(defprolog member
+ X [X | _] <--;
+ X [_ | Z] <-- (member X Z);)
+
+(defprolog next_to
+  X Y List <-- (iright X Y List);
+  X Y List <-- (iright Y X List);)
+
+(defprolog iright
+  L R [L | [R | _]] <--;
   L R [_ | Rest] <-- (iright L R Rest);)

data/shen/release/benchmarks/interpreter.shen

@@ -1,219 +1,219 @@
-(datatype num
-
- ____________________________________
- (number? X)  : verified >> X : number;)
-
-(datatype primitive_object
-
-      if (variable? X)
-      _______________
-      X : variable;
-
-      X : variable;
-      _____________
-      X : primitive_object;
-     
-      X : symbol;
-      ___________
-      X : primitive_object;
-
-      X : string;
-      ___________
-      X : primitive_object;
-
-      X : boolean;
-      ___________
-      X : primitive_object;
-
-      X : number;
-      ___________
-      X : primitive_object;
-
-      _____________________
-      [] : primitive_object;)
-
-(datatype pattern
-
-   X : primitive_object;
-   ___________
-   X : pattern;
-      
-   P1 : pattern; P2 : pattern;
-   ===========================
-   [cons P1 P2] : pattern;
-    
-   P1 : pattern; P2 : pattern;
-   ===========================
-   [@p P1 P2] : pattern;)
-
-  (datatype l_formula
-
-   X : pattern;
-   _____________
-   X : l_formula;
-      
-   X : l_formula; Y : l_formula; Z : l_formula;
-   =================================
-   [if X Y Z] : l_formula;
-
-   X : variable; Y : l_formula; Z : l_formula;
-   ================================
-   [let X Y Z] : l_formula;
-      
-   X : l_formula; Y : l_formula;
-   ======================
-   [cons X Y] : l_formula;
-      
-   X : l_formula; Y : l_formula;
-   ======================
-   [@p X Y] : l_formula;
-   
-   X : l_formula; Y : l_formula;
-   ======================
-   [where X Y] : l_formula;
-      
-   X : l_formula; Y : l_formula;
-   ======================
-   [= X Y] : l_formula;
-      
-   X : l_formula; Y : l_formula;
-   ======================
-   [X Y] : l_formula;
-      
-   Xn : (list l_formula);
-   ===================
-   [cases | Xn] : l_formula;
-      
-   P : pattern; X : l_formula;
-   ===========================
-   [/. P X] : l_formula;)
-
-(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 (function ==>>) 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)
+(datatype num
+
+ ____________________________________
+ (number? X)  : verified >> X : number;)
+
+(datatype primitive_object
+
+      if (variable? X)
+      _______________
+      X : variable;
+
+      X : variable;
+      _____________
+      X : primitive_object;
+     
+      X : symbol;
+      ___________
+      X : primitive_object;
+
+      X : string;
+      ___________
+      X : primitive_object;
+
+      X : boolean;
+      ___________
+      X : primitive_object;
+
+      X : number;
+      ___________
+      X : primitive_object;
+
+      _____________________
+      [] : primitive_object;)
+
+(datatype pattern
+
+   X : primitive_object;
+   ___________
+   X : pattern;
+      
+   P1 : pattern; P2 : pattern;
+   ===========================
+   [cons P1 P2] : pattern;
+    
+   P1 : pattern; P2 : pattern;
+   ===========================
+   [@p P1 P2] : pattern;)
+
+  (datatype l_formula
+
+   X : pattern;
+   _____________
+   X : l_formula;
+      
+   X : l_formula; Y : l_formula; Z : l_formula;
+   =================================
+   [if X Y Z] : l_formula;
+
+   X : variable; Y : l_formula; Z : l_formula;
+   ================================
+   [let X Y Z] : l_formula;
+      
+   X : l_formula; Y : l_formula;
+   ======================
+   [cons X Y] : l_formula;
+      
+   X : l_formula; Y : l_formula;
+   ======================
+   [@p X Y] : l_formula;
+   
+   X : l_formula; Y : l_formula;
+   ======================
+   [where X Y] : l_formula;
+      
+   X : l_formula; Y : l_formula;
+   ======================
+   [= X Y] : l_formula;
+      
+   X : l_formula; Y : l_formula;
+   ======================
+   [X Y] : l_formula;
+      
+   Xn : (list l_formula);
+   ===================
+   [cases | Xn] : l_formula;
+      
+   P : pattern; X : l_formula;
+   ===========================
+   [/. P X] : l_formula;)
+
+(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 (function ==>>) 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)