shen-ruby 0.10.0 → 0.11.0

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!"))

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

@@ -1,100 +1,100 @@
-(declare defclass [symbol --> [list [class A]] --> [list [symbol * symbol]] --> symbol])
-
-(datatype subtype
-
-  (subtype B A); X : B;
-  _____________________
-  X : A;)
-
-(define defclass
-   Class SuperClasses ClassDef 
-    -> (let Attributes (map fst ClassDef)
-            Inherited (put-prop Class attributes 
-                        (append Attributes (collect-attributes SuperClasses)))
-            Types (record-attribute-types Class ClassDef)
-            Assoc (map (/. Attribute [Attribute | fail!]) Inherited)
-            ClassDef [[class | Class] | Assoc]
-            Store (put-prop Class classdef ClassDef)
-            RecordClass (axiom Class Class [class Class])
-            SubTypes (record-subtypes Class SuperClasses)
-            Class))
-
-(define record-subtypes
-  _ [] -> _
-  Class SuperClasses -> (eval [datatype (concat Class superclasses)
-                                 | (record-subtypes-help Class SuperClasses)]))
-
-(define record-subtypes-help
-  _ [] -> []
-  Class [SuperClass | SuperClasses] -> [_______________________
-                                        [subtype SuperClass Class]; | 
-                                          (record-subtypes-help Class SuperClasses)])
-                              
-(define collect-attributes
-  [] -> []
-  [SuperClass | SuperClasses] -> (append (get-prop SuperClass attributes [])
-                                         (collect-attributes SuperClasses)))
-
-(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)))         
-                                        
-(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!"))
+(declare defclass [symbol --> [list [class A]] --> [list [symbol * symbol]] --> symbol])
+
+(datatype subtype
+
+  (subtype B A); X : B;
+  _____________________
+  X : A;)
+
+(define defclass
+   Class SuperClasses ClassDef 
+    -> (let Attributes (map fst ClassDef)
+            Inherited (put-prop Class attributes 
+                        (append Attributes (collect-attributes SuperClasses)))
+            Types (record-attribute-types Class ClassDef)
+            Assoc (map (/. Attribute [Attribute | fail!]) Inherited)
+            ClassDef [[class | Class] | Assoc]
+            Store (put-prop Class classdef ClassDef)
+            RecordClass (axiom Class Class [class Class])
+            SubTypes (record-subtypes Class SuperClasses)
+            Class))
+
+(define record-subtypes
+  _ [] -> _
+  Class SuperClasses -> (eval [datatype (concat Class superclasses)
+                                 | (record-subtypes-help Class SuperClasses)]))
+
+(define record-subtypes-help
+  _ [] -> []
+  Class [SuperClass | SuperClasses] -> [_______________________
+                                        [subtype SuperClass Class]; | 
+                                          (record-subtypes-help Class SuperClasses)])
+                              
+(define collect-attributes
+  [] -> []
+  [SuperClass | SuperClasses] -> (append (get-prop SuperClass attributes [])
+                                         (collect-attributes SuperClasses)))
+
+(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)))         
+                                        
+(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!"))

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

@@ -1,74 +1,74 @@
-(declare defclass [symbol --> [list [symbol * symbol]] --> symbol])
-
-(define defclass
-   Class ClassDef -> (let Attributes (map (function fst) ClassDef)
-                          Types (record-attribute-types Class ClassDef)
-                          Assoc (map (/. Attribute [Attribute | fail]) Attributes)
-                          ClassDef [[class | Class] | Assoc]
-                          Store (put Class classdef ClassDef)
-                          RecordClass (axiom Class Class [class Class])
-                          Class))
-
-(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)))         
-                                        
-(declare make-instance [[class Class] --> [instance Class]])
-
-(define make-instance
-   Class -> (let ClassDef (trap-error (get Class classdef) (/. E []))
-                 (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!"))
+(declare defclass [symbol --> [list [symbol * symbol]] --> symbol])
+
+(define defclass
+   Class ClassDef -> (let Attributes (map (function fst) ClassDef)
+                          Types (record-attribute-types Class ClassDef)
+                          Assoc (map (/. Attribute [Attribute | fail]) Attributes)
+                          ClassDef [[class | Class] | Assoc]
+                          Store (put Class classdef ClassDef)
+                          RecordClass (axiom Class Class [class Class])
+                          Class))
+
+(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)))         
+                                        
+(declare make-instance [[class Class] --> [instance Class]])
+
+(define make-instance
+   Class -> (let ClassDef (trap-error (get Class classdef) (/. E []))
+                 (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!"))