Update test programs

tests/binary.shen

@@ -1,24 +1,24 @@
 (datatype binary
 
-  if (element? X [0 1])
-  _____________
-  X : zero-or-one;
+if (element? X [0 1])
+_____________
+X : zero-or-one;
 
-  X : zero-or-one;
-  ________________
-  [X] : binary;
+X : zero-or-one;
+________________
+[X] : binary;
 
-  X : zero-or-one; Y : binary;
-  ____________________________
-  [X | Y] : binary;
+X : zero-or-one; Y : binary;
+____________________________
+[X | Y] : binary;
 
-  X : zero-or-one, [Y | Z] : binary >> P;
-  ________________________________________
-  [X Y | Z] : binary >> P;)
+X : zero-or-one, [Y | Z] : binary >> P;
+________________________________________
+[X Y | Z] : binary >> P;)
 
 (define complement
-  {binary --> binary}
-  [0] -> [1]
-  [1] -> [0]
-  [1 N | X] -> [0 | (complement [N | X])]
-  [0 N | X] -> [1 | (complement [N | X])])
+   {binary --> binary}
+   [0] -> [1]
+   [1] -> [0]
+   [1 N | X] -> [0 | (complement [N | X])]
+   [0 N | X] -> [1 | (complement [N | X])])

tests/bubble version 1.shen

@@ -9,7 +9,20 @@
   [X Y | Z] -> [X | (bubble [Y | Z])])
 
 (define bubble-again-perhaps
-  \* no change as a result of bubbling - then the job is done *\
-  X X -> X
+   \* no change as a result of bubbling - then the job is done *\
+   X X -> X
   \* else bubble again *\
-  X _ -> (bubble-sort X))
+   X _ -> (bubble-sort X))
+
+
+
+
+
+
+
+
+
+
+
+
+

tests/bubble version 2.shen

@@ -6,3 +6,17 @@
   [X] -> [X]
   [X Y | Z] -> [Y | (bubble [X | Z])]   where    (> Y X)
   [X Y | Z] -> [X | (bubble [Y | Z])])
+
+
+
+
+
+
+
+
+
+
+
+
+
+

tests/c-minus.shen

@@ -190,9 +190,11 @@
   ========================================================
   [Type Variable | Parameters] : parameters;)
 
-(define c-minus
-  {string --> program}
-   File -> (compile (fn <program>) (read-file-as-unit-strings File)))
+\\(spy +)
+
+\\(define c-minus
+ \\{string --> program}
+  \\File -> (compile (fn <program>) (read-file-as-unit-strings File)))
 
 (define read-file-as-unit-strings
   {string --> (list string)}
@@ -368,7 +370,7 @@
 
 (defcc <numeric>
   {(list string) ==> string}
-  X := X        where (element? X ["0" "1" "2""3""4""5" "6" "7" "8" "9"]);)
+  X := X        where (element? X ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9"]);)
 
 (define digit
   {string --> integer}

tests/calculator.shen

@@ -1,13 +1,13 @@
 (datatype arith-expr
 
-  X : number;
-  ====================
-  [num X] : arith-expr;
+    X : number;
+    ====================
+    [num X] : arith-expr;
 
-  if (element? Op [+ - * /])
-  X : arith-expr; Y : arith-expr;
-  ===============================
-  [X Op Y] : arith-expr;)
+    if (element? Op [+ - * /])
+    X : arith-expr; Y : arith-expr;
+    ===============================
+    [X Op Y] : arith-expr;)
 
 (define do-calculation
   {arith-expr --> number}
@@ -16,3 +16,6 @@
   [X * Y] -> (* (do-calculation X) (do-calculation Y))
   [X / Y] -> (/ (do-calculation X) (do-calculation Y))
   [num X] -> X)
+
+
+

tests/cartprod.shen

@@ -1,7 +1,23 @@
 (define cartesian-product
-  [] _ -> []
-  [X | Y] Z -> (append (all-pairs-using-X X Z) (cartesian-product Y Z)))
+   [ ] _ -> [ ]
+   [X | Y] Z -> (append (all-pairs-using-X X Z) (cartesian-product Y Z)))
 
 (define all-pairs-using-X
-  _ [] -> []
-  X [Y | Z] -> [[X Y] | (all-pairs-using-X X Z)])
+   _ [ ] -> [ ]
+   X [Y | Z] -> [[X Y] | (all-pairs-using-X X Z)])
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

tests/change.shen

@@ -1,20 +1,25 @@
 (define count-change
-  Amount -> (count-change* Amount 200))
+    Amount -> (count-change* Amount 200))
 
 (define count-change*
-  0 _ -> 1
-  _ 0 -> 0
-  Amount _ -> 0  	where (> 0 Amount)
-  Amount Fst_Denom
-  -> (+ (count-change* (- Amount Fst_Denom) Fst_Denom)
-        (count-change* Amount (next-denom Fst_Denom))))
+    0 _ -> 1
+    _ 0 -> 0
+    Amount _ -> 0  	where (> 0 Amount)
+    Amount Fst_Denom
+    -> (+ (count-change* (- Amount Fst_Denom) Fst_Denom)
+          (count-change* Amount (next-denom Fst_Denom))))
 
 (define next-denom
-  200 -> 100
-  100 -> 50
-  50 -> 20
-  20 -> 10
-  10 -> 5
-  5 -> 2
-  2 -> 1
-  1 -> 0)
+   200 -> 100
+   100 -> 50
+   50 -> 20
+   20 -> 10
+   10 -> 5
+   5 -> 2
+   2 -> 1
+   1 -> 0)
+
+
+
+
+

tests/classes-defaults.shen

@@ -1,59 +1,59 @@
 (datatype class
 
-  Slots : [slot];
-  _______________________________________
-  (defclass Class Slots) : (class Class);
+      Slots : [slot];
+      _______________________________________
+      (defclass Class Slots) : (class Class);
 
-  Attribute : symbol; Type : symbol;
-  ===================================
-  (@p Attribute Type) : slot;
+      Attribute : symbol; Type : symbol;
+      ===================================
+      (@p Attribute Type) : slot;
 
-  Default : Type; Attribute : symbol; Type : symbol;
-  ==================================================
-  (@p Attribute Type Default) : slot;)
+      Default : Type; Attribute : symbol; Type : symbol;
+      ==================================================
+      (@p Attribute Type Default) : slot;)
 
 (define defclass
-  Class ClassDef -> (let Attributes (map fst ClassDef)
-                         Types (record-attribute-types Class ClassDef)
-                         Assoc (map assign-values ClassDef)
-                         NewClassDef [[class | Class] | Assoc]
-                         Store (put-prop Class classdef NewClassDef)
-                         RecordClass (axiom Class Class [class Class])
-                      Class))
+   Class ClassDef -> (let Attributes (map fst ClassDef)
+                          Types (record-attribute-types Class ClassDef)
+                          Assoc (map assign-values ClassDef)
+                          NewClassDef [[class | Class] | Assoc]
+                          Store (put-prop Class classdef NewClassDef)
+                          RecordClass (axiom Class Class [class Class])
+                          Class))
 
 (define assign-values
   (@p Attribute _ Value) -> [Attribute | Value]
   (@p Attribute _) -> [Attribute | fail!])
 
 (define axiom
   DataType X A -> (eval [datatype DataType
-                          ________
-                          X : A;]))
+                                  ________
+                                   X : A;]))
 
 (define record-attribute-types
   _ [] -> []
   Class [(@p Attribute Type _) | ClassDef]
-  -> (let DataTypeName (concat Class Attribute)
-          DataType (axiom DataTypeName Attribute [attribute Class Type])
-       (record-attribute-types Class ClassDef))
+   -> (let DataTypeName (concat Class Attribute)
+           DataType (axiom DataTypeName Attribute [attribute Class Type])
+           (record-attribute-types Class ClassDef))
   Class [(@p Attribute Type) | ClassDef]
-  -> (let DataTypeName (concat Class Attribute)
-          DataType (axiom DataTypeName Attribute [attribute Class Type])
-       (record-attribute-types Class ClassDef)))
+   -> (let DataTypeName (concat Class Attribute)
+           DataType (axiom DataTypeName Attribute [attribute Class Type])
+           (record-attribute-types Class ClassDef)))
 
 (declare make-instance [[class Class] --> [instance Class]])
 
 (define make-instance
-  Class -> (let ClassDef (get-prop Class classdef [])
-             (if (empty? ClassDef)
-                 (error "class ~A does not exist~%" Class)
-                 ClassDef)))
+   Class -> (let ClassDef (get-prop Class classdef [])
+                 (if (empty? ClassDef)
+                     (error "class ~A does not exist~%" Class)
+                     ClassDef)))
 
 (declare get-value [[attribute Class A] --> [instance Class] --> A])
 
 (define get-value
-  Attribute Instance -> (let LookUp (assoc Attribute Instance)
-                          (get-value-test LookUp)))
+   Attribute Instance -> (let LookUp (assoc Attribute Instance)
+                              (get-value-test LookUp)))
 
 (define get-value-test
   [ ] -> (error "no such attribute!~%")
@@ -64,7 +64,7 @@
 
 (define has-value?
   Attribute Instance -> (let LookUp (assoc Attribute Instance)
-                          (has-value-test LookUp)))
+                             (has-value-test LookUp)))
 
 (define has-value-test
   [ ] -> (error "no such attribute!~%")
@@ -75,20 +75,20 @@
 
 (define has-attribute?
   Attribute Instance -> (let LookUp (assoc Attribute Instance)
-                          (not (empty? LookUp))))
+                             (not (empty? LookUp))))
 
 (declare change-value [[instance Class] --> [attribute Class A] --> A --> [instance Class]])
 
 (define change-value
-  _ class _ -> (error "cannot change the class of an instance!~%")
-  [ ] _ _ -> (error "no such attribute!~%")
-  [[Attribute | _] | Instance] Attribute Value
-  -> [[Attribute | Value] | Instance]
-  [Slot | Instance] Attribute Value
-  -> [Slot | (change-value Instance Attribute Value)])
+    _ class _ -> (error "cannot change the class of an instance!~%")
+    [ ] _ _ -> (error "no such attribute!~%")
+    [[Attribute | _] | Instance] Attribute Value
+     -> [[Attribute | Value] | Instance]
+    [Slot | Instance] Attribute Value
+    -> [Slot | (change-value Instance Attribute Value)])
 
 (declare instance-of [[instance Class] --> [class Class]])
 
 (define instance-of
-  [[class | Class] | _] -> Class
-  _ -> (error "not a class instance!"))
+    [[class | Class] | _] -> Class
+    _ -> (error "not a class instance!"))