shen-ruby 0.12.1 → 0.13.0

data/shen/release/test_programs/binary.shen

@@ -1,24 +1,24 @@
-(datatype binary
-
-if (element? X [0 1])
-_____________
-X : zero-or-one;
-
-X : zero-or-one;
-________________
-[X] : binary;
-
-X : zero-or-one; Y : binary;
-____________________________
-[X | Y] : binary;
-
-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])]) 
+(datatype binary
+
+if (element? X [0 1])
+_____________
+X : zero-or-one;
+
+X : zero-or-one;
+________________
+[X] : binary;
+
+X : zero-or-one; Y : binary;
+____________________________
+[X | Y] : binary;
+
+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])]) 

data/shen/release/test_programs/bubble_version_1.shen

@@ -1,28 +1,28 @@
-(define bubble-sort 
-  \* bubble again if you need to *\  
-  X -> (bubble-again-perhaps (bubble X) X))
-
-(define bubble 
-  [] -> []  
-  [X] -> [X]  
-  [X Y | Z] -> [Y | (bubble [X | Z])]   where    (> Y X)
-  [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  
-  \* else bubble again *\  
-   X _ -> (bubble-sort X))
-
-
-
-
-
-
-
-
-
-
-
- 
-
+(define bubble-sort 
+  \* bubble again if you need to *\  
+  X -> (bubble-again-perhaps (bubble X) X))
+
+(define bubble 
+  [] -> []  
+  [X] -> [X]  
+  [X Y | Z] -> [Y | (bubble [X | Z])]   where    (> Y X)
+  [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  
+  \* else bubble again *\  
+   X _ -> (bubble-sort X))
+
+
+
+
+
+
+
+
+
+
+
+ 
+

data/shen/release/test_programs/bubble_version_2.shen

@@ -1,22 +1,22 @@
-(define bubble-sort 
-  X -> (fix bubble X)) 
-
-(define bubble 
-  [] -> []  
-  [X] -> [X]  
-  [X Y | Z] -> [Y | (bubble [X | Z])]   where    (> Y X)
-  [X Y | Z] -> [X | (bubble [Y | Z])])
-
-
-
-
-
-
-
-
-
-
-
-
- 
-
+(define bubble-sort 
+  X -> (fix bubble X)) 
+
+(define bubble 
+  [] -> []  
+  [X] -> [X]  
+  [X Y | Z] -> [Y | (bubble [X | Z])]   where    (> Y X)
+  [X Y | Z] -> [X | (bubble [Y | Z])])
+
+
+
+
+
+
+
+
+
+
+
+
+ 
+

data/shen/release/test_programs/calculator.shen

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

data/shen/release/test_programs/cartprod.shen

@@ -1,23 +1,23 @@
-(define cartesian-product 
-   [ ] _ -> [ ]  
-   [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)]) 
-   
-
-   
-    
-      
-    
-      
-
-
-
-
-
-
-
- 
-
+(define cartesian-product 
+   [ ] _ -> [ ]  
+   [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)]) 
+   
+
+   
+    
+      
+    
+      
+
+
+
+
+
+
+
+ 
+

data/shen/release/test_programs/change.shen

@@ -1,25 +1,25 @@
-(define count-change 
-    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))))
-
-(define next-denom
-   200 -> 100  
-   100 -> 50  
-   50 -> 20  
-   20 -> 10  
-   10 -> 5  
-   5 -> 2  
-   2 -> 1  
-   1 -> 0)
-
-
-
- 
-
+(define count-change 
+    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))))
+
+(define next-denom
+   200 -> 100  
+   100 -> 50  
+   50 -> 20  
+   20 -> 10  
+   10 -> 5  
+   5 -> 2  
+   2 -> 1  
+   1 -> 0)
+
+
+
+ 
+

data/shen/release/test_programs/classes-defaults.shen

@@ -1,94 +1,94 @@
-(datatype class
-
-      Slots : [slot];
-      _______________________________________
-      (defclass Class Slots) : (class Class);
-
-      Attribute : symbol; Type : symbol;
-      ===================================
-      (@p Attribute Type) : 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))
-
-(define assign-values
-  (@p Attribute _ Value) -> [Attribute | Value]
-  (@p Attribute _) -> [Attribute | fail!])                                
-
-(define axiom
-  DataType X A -> (eval [datatype DataType
-                                  ________
-                                   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))
-  Class [(@p Attribute Type) | 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))) 
-
-(declare get-value [[attribute Class A] --> [instance Class] --> A])
-
-(define get-value
-   Attribute Instance -> (let LookUp (assoc Attribute Instance)
-                              (get-value-test LookUp)))
-
-(define get-value-test
-  [ ] -> (error "no such attribute!~%")
-  [_ | fail!] -> (error "no such value!~%")
-  [_ | Value] -> Value) 
-
-(declare has-value? [[attribute Class A] --> [instance Class] --> boolean])
-
-(define has-value?
-  Attribute Instance -> (let LookUp (assoc Attribute Instance)
-                             (has-value-test LookUp)))
-
-(define has-value-test
-  [ ] -> (error "no such attribute!~%")
-  [_ | fail!] -> false
-  _ -> true) 
-
-(declare has-attribute? [symbol --> [instance Class] --> boolean])
-
-(define has-attribute?
-  Attribute Instance -> (let LookUp (assoc Attribute Instance)
-                             (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)])
-
-(declare instance-of [[instance Class] --> [class Class]])
-
-(define instance-of
-    [[class | Class] | _] -> Class
-    _ -> (error "not a class instance!"))
+(datatype class
+
+      Slots : [slot];
+      _______________________________________
+      (defclass Class Slots) : (class Class);
+
+      Attribute : symbol; Type : symbol;
+      ===================================
+      (@p Attribute Type) : 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))
+
+(define assign-values
+  (@p Attribute _ Value) -> [Attribute | Value]
+  (@p Attribute _) -> [Attribute | fail!])                                
+
+(define axiom
+  DataType X A -> (eval [datatype DataType
+                                  ________
+                                   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))
+  Class [(@p Attribute Type) | 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))) 
+
+(declare get-value [[attribute Class A] --> [instance Class] --> A])
+
+(define get-value
+   Attribute Instance -> (let LookUp (assoc Attribute Instance)
+                              (get-value-test LookUp)))
+
+(define get-value-test
+  [ ] -> (error "no such attribute!~%")
+  [_ | fail!] -> (error "no such value!~%")
+  [_ | Value] -> Value) 
+
+(declare has-value? [[attribute Class A] --> [instance Class] --> boolean])
+
+(define has-value?
+  Attribute Instance -> (let LookUp (assoc Attribute Instance)
+                             (has-value-test LookUp)))
+
+(define has-value-test
+  [ ] -> (error "no such attribute!~%")
+  [_ | fail!] -> false
+  _ -> true) 
+
+(declare has-attribute? [symbol --> [instance Class] --> boolean])
+
+(define has-attribute?
+  Attribute Instance -> (let LookUp (assoc Attribute Instance)
+                             (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)])
+
+(declare instance-of [[instance Class] --> [class Class]])
+
+(define instance-of
+    [[class | Class] | _] -> Class
+    _ -> (error "not a class instance!"))