[REBOL] Re: pseudo-class inheritance at a price ?
From: christian:ensel:gmx at: 7-Oct-2001 12:19
Hello Christian Morency,
some months ago I worked an a similiar project, you can find my code at the
bottom of this mail. It's not very complete, but it may inspire you in a way
or two :)
> As I mentioned in another post earlier, I've been working for the past three
> weeks on a pseudo class inheritance library for Rebol/Core. This would
> enable rebol developers to use class to define object or class inheritance.
>
> Why ? The current implementation of object "inheritance" under rebol is done
> by a way of cloning (ie copying everything) from one object to the other.
>
> Hmm and ? What I've been working on enable small objects (in term of memory
> and method code) to refer big class (with a lot of method code).
>
> But ? However, my implementation would require some diversions from the way
> we actually code objects in rebol ! I would like to ask to those interested
> in such a library if these diversions would be inappropriate to their coding
> style, taste, etc...
I don't believe this to be a big problem. There are other dialects in REBOL
differing from "native" REBOL style and syntax, e.g. the dialects used for
PARSE and VID.
And now for some comments:
> 1. new class would be define like this :
> make-class 'class-name [ ... ]
>
> Inherited class would be define like this :
> make-class/from 'class-name [ ... ] super-class-name
I for a reason decided against a construct using refinements because this
would make reading your code unneccessarily hard: The specification of the
superclass as an argument to a refinement leads to code looking like
make-class/from 'class-name [
;...
;... insert hundreds of line of method code here
;...
] super-class-name
Having a special functions for deriving classes eases reading code a lot,
allowing for having 'class and 'superclass on the same line of code:
make-derived-class 'class-name 'superclass-name [
;...
;... insert hundreds of line of method code here
;...
]
What do you think?
> 2. Object would be instanciated as :
> new-object-name: class-name/new
>
> I'm thinking about adding an automatic initiation method
> that would be call when instanciating an object ! What
> about a destroy method...
Actually, I haven't thought in deep about that, but as long as REBOL has it's
own garbage collector, do we really need constructors and deconstructors?
> 4. Within class declaration, methods would be define like this :
> method-name: func [value !refinement ref-value] [ ... ]
>
> However, during execution, refinement would be use as usual :
> method-name "a value"
> mathod-name/refinement "a value" "a ref-value"
I didn't spend effort to allow for method refinements in my OOP-framework,
but IIRC there was a solution to compose function calls with refinements
on the mailing list some time ago which shouldn't be to hard to implement.
But if your refinement defining syntax differs from FUNC's style why not
rename your FUNC to METHOD, making the difference somewhat more obvious?
Just a thought, so.
> Note : the library has not been tested enough for a public release. also, it
> would requires some testing by people working daily with objects in rebol,
> mainly rebol gurus who could tell me if everything I'm doing is proper or
> not ;) and how it could be better... or if a guru would like to take up the
> project and make it better ! I'm open to suggestion !
Not beeing a REBOL guru in any way you eventually may find some suggestions
in my code :)
Kind regards,
Christian
;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
REBOL [
title: "Classes & Instances"
name: %class-instances.r
author: "Christian 'CHE' Ensel"
date: 23-Aug-2001
]
context
[
;======================================= CLASS instance-spec class-spec ==
; ------------------------------
class: func
[
"Defines a user class object."
instance-spec [block!] "Code per instance"
class-spec [block!] "Code per class"
/local
new-class
]
;.........................................................................
[
new-class: make object! compose [
super-class: none
instance: (
make object! head insert instance-spec compose [class: none]
)
(class-spec)
]
new-class/instance/class: new-class
new-class
]
;-------------------------------------------------------------------------
;=================== DERIVED-CLASS super-class instance-spec class-spec ==
; --------------------------------------------------
derived-class: func
[
"Derives a user class object from an existing class object."
super-class [object!] "Class to inherit from"
instance-spec [block!] "Code per instance"
class-spec [block!] "Code per class"
/local
new-class
]
;.........................................................................
[
new-class: make super-class compose [
super-class: (super-class)
instance: (make super-class/instance instance-spec)
(class-spec)
]
new-class/instance/class: new-class
new-class
]
;-------------------------------------------------------------------------
;========================================= INSTANCE class instance-spec ==
; ----------------------------
instance: func
[
"Returns an instance object of desired class."
class [object!] "Class to belong to"
instance-spec [block!] "Instance-specific code"
/local
new-instance
]
;.........................................................................
[
new-instance: make class/instance instance-spec
]
;-------------------------------------------------------------------------
;==================================== DO-METHOD instance message /SUPER ==
; ---------------------------------
do-method: func
[
[catch]
"Dispatch a class method, throw error for unknown methods."
instance [object!] "Instance"
message [block!] {Block containing method word
and argument words, if any}
/super
"Invoke method of super-class."
/local
method
]
;.........................................................................
[
method: in either super [
instance/class/super-class
][
instance/class
] first message
if none? method [
throw make error! reduce ['script 'unknown-method first message]
]
method: get method
do compose [(:method) (instance) (next message)]
]
;-------------------------------------------------------------------------
;============================== TRY-METHOD instance message /ANY /SUPER ==
; ---------------------------------------
try-method: func
[
"Dispatch a method, do nothing for unknown methods."
instance [object!] "Instance"
message [block!] {Block containing method word
and argument words, if any}
/super
"Invoke method of super-class."
/local
method
]
;.........................................................................
[
method: in either super [
instance/class/super-class
][
instance/class
] first message
either none? method [none] [
method: get method
do compose [(:method) (instance) (next message)]
]
]
;-------------------------------------------------------------------------
;============================================ IS? class instance /EXACT ==
; -------------------------
is?: func
[
"Returns TRUE if instance is (indirect) instance of given class."
class [object!] "Class"
instance [object!] "Instance"
/exact
"Return TRUE only for direct instances of given class."
/local
instance-class
]
;.........................................................................
[
either exact [
equal? instance/class class
][
instance-class: instance/class
forever [
if equal? instance-class class [break/return true]
instance-class: instance-class/super-class
if none? instance-class [break]
]
]
]
;-------------------------------------------------------------------------
;=============================================================== IMPORT ==
; ------
import: func
[
"Expose dialect to global context."
]
;.........................................................................
[
set bind [
class derived-class instance is? do-method try-method
]
in system/words 'context reduce [
:class :derived-class :instance :is? :do-method :try-method
]
return
]
;-------------------------------------------------------------------------
;----------------------------------- SYSTEM/ERROR/SCRIPT/UNKNOWN-METHOD --
;
system/error/script: make system/error/script [
unknown-method: ["Method" :arg1 "not declared"]
]
;-------------------------------------------------------------------------
]
;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
And here's an example demonstrating the use of the above:
;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
REBOL [
title: "Classes & Instances - Example"
name: %class-instances-sample.r
author: "Christian 'CHE' Ensel"
date: 23-Aug-2001
]
do in do %/rebol/scripts/class-instances.r 'import
do sample:
[
human!: class [
name: none
age: none
][
introduce: function [human [object!]] [] [
do-method human [say rejoin ["Hi, I'm " human/name "!"]]
do-method human [say rejoin ["I'm " human/age " years old."]]
do-method human [say "I'm human."]
]
say-to: function [human [object!] whom [object!] what [string!]] [] [
do-method human [
say rejoin [whom/name ", " lowercase/part what 1]
]
]
say: function [human [object!] what [string!]] [] [
print rejoin [human/name {: ^-"} what {"}]
]
]
man!: derived-class human! [] [
introduce: function [man [object!]] [] [
do-method/super man [introduce]
do-method man [say "And I'm a man."]
]
]
woman!: derived-class human! [] [
introduce: function [woman [object!]] [][
do-method/super woman [introduce]
do-method woman [say "And I'm a woman."]
]
bewitch: function [woman [object!] whom [object!]] [][
do-method woman [say-to whom "Eat this!"]
]
]
human: instance human! [name: "Nobody"]
adam: instance man! [name: "Adam" age: 32]
eve: instance woman! [name: "Eve" age: 27]
linda: instance woman! [name: "Linda" age: 28]
do-method adam [say "Hello, I'm Adam."] prin newline
do-method eve [say "Hello, I'm Eve."] prin newline
do-method adam [introduce] prin newline
do-method eve [bewitch adam] prin newline
do-method/super eve [introduce] prin newline
try-method adam [bewitch eve] prin newline
do-method linda [introduce] prin newline
do-method linda [say-to adam "You'd better eat this banana."]
prin newline
do-method/super linda [say-to adam "You'd better eat this banana."]
prin newline
if is? human! adam [print "Adam is a human."]
]
;>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
