shen-ruby 0.12.1 → 0.13.0

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

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

@@ -1,46 +1,46 @@
-(define defclass
-   Class Attributes 
-   -> (let Assoc (map (/. Attribute [Attribute | fail]) Attributes)
-           ClassDef [[class | Class] | Assoc]
-           Store (put Class classdef ClassDef)
-           Class))             
-
-(define make-instance
-   Class -> (let ClassDef (trap-error (get Class classdef) (/. E []))
-                 (if (empty? ClassDef)
-                     (error "class ~A does not exist~%" Class)
-                     ClassDef))) 
-
-(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) 
-
-(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) 
-
-(define has-attribute?
-  Attribute Instance -> (let LookUp (assoc Attribute Instance)
-                             (not (empty? LookUp))))
-
-(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)])
-
-(define instance-of
-    [[class | Class] | _] -> Class
-    _ -> (error "not a class instance!"))  
+(define defclass
+   Class Attributes 
+   -> (let Assoc (map (/. Attribute [Attribute | fail]) Attributes)
+           ClassDef [[class | Class] | Assoc]
+           Store (put Class classdef ClassDef)
+           Class))             
+
+(define make-instance
+   Class -> (let ClassDef (trap-error (get Class classdef) (/. E []))
+                 (if (empty? ClassDef)
+                     (error "class ~A does not exist~%" Class)
+                     ClassDef))) 
+
+(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) 
+
+(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) 
+
+(define has-attribute?
+  Attribute Instance -> (let LookUp (assoc Attribute Instance)
+                             (not (empty? LookUp))))
+
+(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)])
+
+(define instance-of
+    [[class | Class] | _] -> Class
+    _ -> (error "not a class instance!"))  

data/shen/release/test_programs/depth_.shen

@@ -1,14 +1,14 @@
-(define depth'
-  {A --> (A --> (list A)) --> (A --> boolean) --> (A --> boolean) --> (list A)}
-  State Successors Goal? Fail? -> (depth-help' [State] Successors Goal? Fail? []))
-
-(define depth-help'
-  {(list A) --> (A --> (list A)) --> (A --> boolean) --> (A --> boolean) --> (list A) --> (list A)}
-  [State | _] _ Goal? _ Path -> (reverse [State | Path]) 	where (Goal? State)
-  [State | _] _ _ Fail? _ -> [] 				where (Fail? State)
-  [State | _] Successors Goal? Fail? Path <- (fail-if empty? 
-                                                      (depth-help' (Successors State) 
-                                                                   Successors Goal? Fail? [State | Path]))
-  [_ | States] Successors Goal? Fail? Path -> (depth-help' States Successors Goal? Fail? Path)
-  _ _ _ _ _ -> []) 
-
+(define depth'
+  {A --> (A --> (list A)) --> (A --> boolean) --> (A --> boolean) --> (list A)}
+  State Successors Goal? Fail? -> (depth-help' [State] Successors Goal? Fail? []))
+
+(define depth-help'
+  {(list A) --> (A --> (list A)) --> (A --> boolean) --> (A --> boolean) --> (list A) --> (list A)}
+  [State | _] _ Goal? _ Path -> (reverse [State | Path]) 	where (Goal? State)
+  [State | _] _ _ Fail? _ -> [] 				where (Fail? State)
+  [State | _] Successors Goal? Fail? Path <- (fail-if empty? 
+                                                      (depth-help' (Successors State) 
+                                                                   Successors Goal? Fail? [State | Path]))
+  [_ | States] Successors Goal? Fail? Path -> (depth-help' States Successors Goal? Fail? Path)
+  _ _ _ _ _ -> []) 
+