How do I save objects so they inherit on reload
[1/2] from: bobr:dprc at: 22-Jan-2001 17:40
At 08:47 AM 1/21/01 -0800, [jeff--rebol--net] wrote:
> Using parse block, it's pretty easy to make little
> formatting dialects to experiment with. Someone might make
> a dialect that just handles the many numerous ways to FORM,
> MOLD and print dates and times.
in an unrelated (to dates) matter I would like to play with [which ever] things
so that 'save and 'mold do not print object! as the datatype every time.
specifically I would like to modify 'save or 'mold
to be able to inherit from a named type
other than object! on a load.
I thought of doing a 'replace on "object!" after a 'mold but that breaks down
for internal sub- object!(s) .
perhaps I need to make up my own 'mold function (but can I guarantee 'save
will call it?)
And further, what would my own mold function look like?
Would somebody show me how to write my own 'mold which, unless the object
implements a particular /refinement, calls the original system one?
Did I miss a lesson on dialecting?
for those of you wondering if I am gonna grade
the responses to this one the answer is no.
I do want others to know how to grow your own 'mold (pun - ouch!)
that inherits behavior from the system.
I can tell some others here were trying similar things.
I have been writing an internal corporate note on it and was waiting for
somebody
to suggest dialecting.
[2/2] from: jeff:rebol at: 25-Jan-2001 11:32
Why modify mold? Just use delegation inheritance.
REBOL [
Title: "Delegation Object inheritence"
Comment: "Much the way CLOS works"
Author: "Jeff Kreis"
]
make-child: func [
"Make a delegating child"
definition [block!] "Child object definition"
'parnt "Word that refers to parent object"
/local par chl pass parent chld child
parental-responsibilities
][
;-Make sure of parent
if any [not parent: get parnt not object? parent][
make error! reform [
"This is a poor excuse for a parent:" parent
]
]
;-determine what the parent can do
; (what functions)
parental-responsibilities: copy []
par: next first parent
foreach word par [
if any-function? get in parent word [
append parental-responsibilities word
]
]
;-determine what the child can do
chl: copy []
chld: make object! definition
foreach word next first chld [
if any-function? get in chld word [
append chl word
]
]
;- build the child containing
; linkage to unique parent functions
child: copy [parent: none]
foreach word exclude parental-responsibilities chl [
;- build the parent calling mechanism
repend child [to-set-word word 'func args: get-args get in parent word]
append/only child compose [return (to-path reduce ['parent word]) (args)]
]
;- rewrite overloaded child functions
; to pass up to parent on failure
foreach word intersect parental-responsibilities chl [
append child reduce [
to-set-word word 'function args: get-args fun: get in chld word [child result]
;- first class function value
compose/deep [
;- args ;- body
child: func [(first :fun)] [(second :fun)]
either result: child (args) [result][
(to-path reduce ['parent word]) (args)
]
]
]
]
; remake the child with new definition
;- add reference to parent and
child: make chld child
child/parent: get parnt
child
]
get-args: func [
"Get function args up to first refinement"
args [any-function!] /local nargs
][
args: first :args
nargs: copy []
forall args [
either word? args/1 [
append nargs args/1
][if refinement? args/1 [return nargs]]
] nargs
]
;-- Kermit the frog example
frog: make object! [
color: does [0.255.0]
sound: does ["ribbit ribbit"]
skin: does ["slippery"]
species: does ["amphibian"]
food: [
fly yummy
water-bug mmmmm
]
eat: func [thing][
select food thing
]
animals: [
flys loves
goats ignores
bats hates
]
likes: func [animal][
select animals animal
]
]
kermit: make-child [
;- overload what we like
color: does [0.188.12]
sounds: [
"Welcome to the show!"
"It ain't easy being green"
["Today's number is" random 12]
]
sound: func [/what] [
either block? what: pick sounds random 6 [
reform what
][what]
]
skin: does ["foam"]
animals: [
pig loves
puppets loves
humans tolerates
]
likes: func [animal][
select animals animal
]
food: [
hamburger gulp
]
eat: func [thing][
select food thing
]
] frog
;-- Add some more food to parent
append frog/food [grass yuck]
print ["Does kermit eat grass?" kermit/eat 'grass]
;- save kermit the normal way
save %kermit-frog.r kermit
;- see what kermit can do
; then reload kermit and
; see if kermit is still
; the same frog
did: no
loop 2 [
foreach [item][
[kermit/likes 'goats]
[kermit/likes 'puppets]
[kermit/sound]
[kermit/species]
[kermit/skin]
[kermit/color]
[kermit/eat 'fly]
[kermit/eat 'hamburger]
][
prin [form to-block first item #]
if pick item 2 [
prin join form next item "? "
]
print item
]
if not did [
unset 'kermit
print "Reloading fresh kermit"
;- load the normal way
kermit: do load %kermit-frog.r
did: yes
]
]
;-- Does kermit still dislike grass?
print ["Does kermit eat grass?" kermit/eat 'grass]
{ ;-- results in:
Does kermit eat grass? yuck ;-(base method)
kermit likes goats? ignores ; " "
kermit likes puppets? loves
kermit sound ribbit ribbit ; " "
kermit species amphibian ; " "
kermit skin foam
kermit color 0.188.12
kermit eat fly? yummy ; " "
kermit eat hamburger? gulp
Reloading fresh kermit
kermit likes goats? ignores ; " "
kermit likes puppets? loves
kermit sound It ain't easy being green
kermit species amphibian ; " "
kermit skin foam
kermit color 0.188.12
kermit eat fly? yummy ; " "
kermit eat hamburger? gulp
Does kermit eat grass? yuck ; " "
}