shen/release/test_programs/classes-defaults.shen in shen-ruby-0.10.0 vs shen/release/test_programs/classes-defaults.shen in shen-ruby-0.11.0
- old
+ new
@@ -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!"))