set prompt C-Kermit> define class { switch \v(argc) { :1, return \v(macro) :2, if define \m(\%1) { END -999999 .... ERROR: class name "\%1" already used } _undefine /matching \%1* *\%1 break :default, break } if define \%2 { if eq inherit: \%2 { if define \m(\%1) { ; END -999999 .... ERROR: cannot redefine class \%1 } local i s ; _undefine /matching \%1* *\%1 asg s \02 for i 3 \v(argc)-1 1 { if not define \m(\&_[i]) { END -999999 ... ERROR: class \&_[i] is not defined } _asg \%1_\02_inherit \m(\%1_\02_inherit)\m(s)\&_[i] asg s \02 ; subsequent separator is '\02' STX ^B } } else if eq singleton \%2 { ; mark singleton _asg \%1_\02_singleton \02\02\02 } else if eq abstract \%2 { ; mark abstract _asg \%1_\02_abstract 1 } else { END -999999 ... ERROR: \v(macro) doesNotUndesrtand \%1 \%2 } } _define \%1 { ; definition of a class if = 1 \v(argc) return \v(macro) ; propagate possible self (this) in \%s & class in \%c local \%s \%c asg \%s \%2 asg \%c \v(macro) ; build msg & argument string for class message local i \%k \%p for i 1 \v(argc) 2 { asg \%k \%k\&_[i] asg \%p \%p {\&_[i+1]} } if eq \%1 new: { if = 2 \v(argc) { END -999999 ... ERROR - \v(macro) missing object name } ; if define \m(\%2) { ; END -999999 ... ERROR: object name "\%2" already used ; } if define \m(\v(macro)_\02_abstract) { ; Allow only superclass to create object part if = \frind(#,\%2) 0 { END -999999 ... ERROR - class \v(macro) is abstract } } if define \m(\v(macro)_\02_singleton) { if eq \m(\v(macro)_\02_singleton) \02\02\02 { _asg \v(macro)_\02_singleton \%2 } else { ; subsequent instance ; _assign \%2 (\m(\v(macro)_\02_singleton) '(\\%*)) _assign \%2 (\m(\v(macro)_\02_singleton) '\\%*) return \%2 } } _asg class_of_\02_\%2 \v(macro) ; save class of this object _define \%2 { ; This macro process a message to an object if = 1 \v(argc) return \v(macro) local z asg z \m(class_of_\02_\v(macro)) ; if eq \%1 class return \m(class_of_\02_\v(macro)) if eq \%1 class return \m(z) ; if eq \%1 superclass return \m(\v(macro)_\02_inherit) if eq \%1 superclass return \m(\m(z)_\02_inherit) if eq \%1 alias { _asg \%2 (\v(macro) '(\\%*)) return \%2 } ; propagate self (this) in \%s & class in \%c local \%s \%c asg \%s \v(macro) asg \%c \m(class_of_\02_\v(macro)) ; build msg & argument string for object message local i \%k \%p for i 1 \v(argc)-1 2 { asg \%k \%k\&_[i] asg \%p \%p {\&_[i+1]} } [~~~resolve_object_message~~~] \v(macro) \%k if success return \fexec(\v(return) \%p) END -999999 } ; CLASS MESSAGE 'new:' OBTAINS: ; 1st arg: class name ; 2nd arg: the message ; 3rd arg: the new object name [~~~resolve_class_message~~~] \v(macro) \%k if success return \fexec(\v(return) \%p) ; Cleanup here to get rid of used definitions if define \m(\v(macro)_\02_singleton) { if eq \m(\v(macro)_\02_singleton) \%2 { _asg \v(macro)_\02_singleton \02\02\02 } } _undefine /matching \%2*>>* _define \%2 END -999999 } else { ; ALL OTHER CLASS MESSAGES: [~~~resolve_class_message~~~] \v(macro) \%k if success return \fexec(\v(return) \%p) END -999999 } } _define \%1>>initialize { END 0 } _define \%1::destroy { END 0 } _define \%1>>destroy { END 0 } _define \%1::new: { return \%s } return \%1 ; return class_name } define [~~~resolve_class_message~~~] { ; \%1 class_name ; \%2 class_message ; return applicable class_message if define \m(\%1::\%2) return \%1::\%2 [~~~search_inheritant_class~~~] \%1 \%2 if success return \v(return) if define \m(class::\%2) return class::\%2 END -999999 ... ERROR: \%1 doesNotUnderstand \%2 } define [~~~search_inheritant_class~~~] { if define \m(\%1_\02_inherit) { local i \&w[] for i 1 \fsplit(\m(\%1_\02_inherit),&w,\02) 1 { if define \m(\&w[i]::\%2) return \&w[i]::\%2 [~~~search_inheritant_class~~~] \&w[i] \%2 if success return \v(return) } } END -999999 } define [~~~resolve_object_message~~~] { ; \%1 object_name ; \%2 object_message ; return applicable object message and applicable object ; 1st: consider message defined for this particular object ; 2nd: consider message defined for this class & superclasses ; 4th: condider message defined for all classes. if define \m(\%1>>\%2) return {\%1>>\%2 \%1} ; 1st [~~~search_inheritant_object~~~] \m(class_of_\02_\%1) \%1 \%2 if success return \v(return) ; 2nd ; if define \m(class>>\%2) return {class>>\%2 class#\%1} if define \m(class>>\%2) return {class>>\%2 \%1} ; 4th END -999999 ... ERROR \%1 doesNotUnderstand \%2 } define [~~~search_inheritant_object~~~] { ; \%1 class ; \%2 object ; \%3 message if define \m(\%1>>\%3) { ; class specific or inheritable if not define \m(\%s) { \%1 new: \%s} if define \m(\%1_\02_singleton) {asg \%2 \m(\%1_\02_singleton)} return {\%1>>\%3 \%2} ; class specific or inheritable } ; Consider message of selected super class ; The message is defined and superclass is part of the message if define \m(\%3) { ; 3rd if == \find(\%1,\%3) 1 { return {\%3 \%2} } } if define \m(\%1_\02_inherit) { local \&w[] i for i 1 \fsplit(\m(\%1_\02_inherit),&w,\02) 1 { ; [~~~search_inheritant_object~~~] \&w[i] \&w[i]\02#\02\%2 \%3 ; To enable virtual function in superclass delegates to implementation ; in subclass [~~~search_inheritant_object~~~] \&w[i] \%2 \%3 if success return \v(return) } } END -999999 }