From 1bc3b4e2271ed7317933549f80e6e3db39351d99 Mon Sep 17 00:00:00 2001 From: Anton Ertl Date: Sun, 28 Aug 2016 00:03:51 +0200 Subject: [PATCH] split objexamp.fs into a before-save and after-save part --- objex1.fs | 152 +++++++++++++++++++++++++++++++++++++++++++ objex2.fs | 42 ++++++++++++ objexamp.fs | 183 ++-------------------------------------------------- 3 files changed, 198 insertions(+), 179 deletions(-) create mode 100644 objex1.fs create mode 100644 objex2.fs diff --git a/objex1.fs b/objex1.fs new file mode 100644 index 000000000..1b67863e8 --- /dev/null +++ b/objex1.fs @@ -0,0 +1,152 @@ +\ examples and tests for objects.fs +\ test for working across image generation +\ stuff to run before image generation + +\ written by Anton Ertl 1996-1998, 2016 +\ public domain + +object class + +:noname ( object -- ) + drop ." undefined" ; +overrides print +end-class nothing + +nothing dict-new constant undefined + +\ instance variables and this +object class + cell% inst-var n +m: ( object -- ) + 0 n ! ;m +overrides construct +m: ( object -- ) + n @ . ;m +overrides print +m: ( object -- ) + 1 n +! ;m +method inc +end-class counter + +counter dict-new constant counter1 + +\ examples of static binding + +: object-print ( object -- ) + [bind] object print ; + +\ interface + +\ sorry, a meaningful example would be too long + +interface +selector add ( n object -- ) +selector val ( object -- n ) +end-interface foobar + +counter class + foobar implementation + +m: ( object -- ) + this [parent] inc + n @ 10 mod 0= + if + ." xcounter " this object-print ." made another ten" cr + then +;m overrides inc + +m: ( n object -- ) + 0 do + this inc + loop +;m overrides add + +m: ( object -- n ) + n @ +;m overrides val + +end-class xcounter + + +object class + foobar implementation + + cell% inst-var n + +m: ( n object -- ) + n ! +;m overrides construct + +m: ( object -- ) + n @ . +;m overrides print + +m: ( n object -- ) + n +! +;m overrides add + +protected + +create protected1 + +protected + +create protected2 + +cr order + +public + +create public1 + +cr order + +\ we leave val undefined +end-class int + +\ a perhaps more sensible class structure would be to have int as +\ superclass of counter, but that would not exercise interfaces + +xcounter dict-new constant x +create y 3 int dict-new drop \ same as "3 int dict-new constant y" + +cr +int push-order +order cr +words cr +int drop-order +order +cr + +\ test override of inherited interface selector +xcounter class + +m: ( object -- n ) + this [parent] val 2* +;m overrides val + +end-class ycounter + +ycounter dict-new constant z + +\ test inst-value +object class + foobar implementation + + inst-value N + + m: ( n object -- ) + this [parent] construct \ currently does nothing, but who knows + [to-inst] N + ;m overrides construct + + m: ( object -- ) + N . + ;m overrides print + + m: ( object -- n ) + N + ;m overrides val +end-class const-int + +5 const-int dict-new constant five diff --git a/objex2.fs b/objex2.fs new file mode 100644 index 000000000..d1405311c --- /dev/null +++ b/objex2.fs @@ -0,0 +1,42 @@ +\ examples and tests for objects.fs +\ test for working across image generation +\ stuff to run after image generation + +cr object heap-new print + +cr undefined print + +cr +counter1 print +counter1 inc +counter1 print +counter1 inc +counter1 inc +counter1 inc +counter1 print +counter1 print + +\ examples of static binding +cr undefined bind object print + +cr undefined object-print + +cr +y print cr +20 x add +20 y add +x val . +\ y val . \ undefined +y print + +cr +z print cr +z val . cr +z inc +z val . cr +1 z add +z val . cr + +five print +five val 1+ . cr +.s cr diff --git a/objexamp.fs b/objexamp.fs index e4a7aecf1..35b00beb7 100644 --- a/objexamp.fs +++ b/objexamp.fs @@ -3,183 +3,8 @@ \ written by Anton Ertl 1996-1998 \ public domain -cr object heap-new print - -object class - -:noname ( object -- ) - drop ." undefined" ; -overrides print -end-class nothing - -nothing heap-new constant undefined - -cr undefined print - -\ instance variables and this -object class - cell% inst-var n -m: ( object -- ) - 0 n ! ;m -overrides construct -m: ( object -- ) - n @ . ;m -overrides print -m: ( object -- ) - 1 n +! ;m -method inc -end-class counter - -counter heap-new constant counter1 - -cr -counter1 print -counter1 inc -counter1 print -counter1 inc -counter1 inc -counter1 inc -counter1 print -counter1 print - -\ examples of static binding - -cr undefined bind object print -: object-print ( object -- ) - [bind] object print ; - -cr undefined object-print - -\ interface - -\ sorry, a meaningful example would be too long - -interface -selector add ( n object -- ) -selector val ( object -- n ) -end-interface foobar - -counter class - foobar implementation - -m: ( object -- ) - this [parent] inc - n @ 10 mod 0= - if - ." xcounter " this object-print ." made another ten" cr - then -;m overrides inc - -m: ( n object -- ) - 0 do - this inc - loop -;m overrides add - -m: ( object -- n ) - n @ -;m overrides val - -end-class xcounter - - -object class - foobar implementation - - cell% inst-var n - -m: ( n object -- ) - n ! -;m overrides construct - -m: ( object -- ) - n @ . -;m overrides print - -m: ( n object -- ) - n +! -;m overrides add - -protected - -create protected1 - -protected - -create protected2 - -cr order - -public - -create public1 - -cr order - -\ we leave val undefined -end-class int - -\ a perhaps more sensible class structure would be to have int as -\ superclass of counter, but that would not exercise interfaces - -xcounter dict-new constant x -create y 3 int dict-new drop \ same as "3 int dict-new constant y" - -cr -y print cr -20 x add -20 y add -x val . -\ y val . \ undefined -y print -cr -int push-order -order cr -words cr -int drop-order -order -cr - -\ test override of inherited interface selector -xcounter class - -m: ( object -- n ) - this [parent] val 2* -;m overrides val - -end-class ycounter - -ycounter dict-new constant z -cr -z print cr -z val . cr -z inc -z val . cr -1 z add -z val . cr - -\ test inst-value -object class - foobar implementation - - inst-value N - - m: ( n object -- ) - this [parent] construct \ currently does nothing, but who knows - [to-inst] N - ;m overrides construct - - m: ( object -- ) - N . - ;m overrides print - - m: ( object -- n ) - N - ;m overrides val -end-class const-int - -5 const-int heap-new constant five -five print -five val 1+ . cr -.s cr +\ load these files separately for testing persistence across image generation +require objex1.fs +require objex2.fs +\ or load objex1.fs, then save; and when running the new image, load objex2.fs