Группа :: Разработка/Прочее
Пакет: ansforth-ext-oof
навигация по пакетам
Главная Изменения Спек Патчи Исходники Загрузить Gear Bugs and FR Repocop
pax_global_header 0000666 0000000 0000000 00000000064 11103442430 0014502 g ustar 00root root 0000000 0000000 52 comment=bb21f55bd65697d7c81fad2541e04edde66767f4
oof/ 0000755 0000000 0000000 00000000000 11103442430 0011627 5 ustar 00root root 0000000 0000000 oof/oof.fs 0000644 0000000 0000000 00000044712 11103442430 0012754 0 ustar 00root root 0000000 0000000 \ oof.fs Object Oriented FORTH
\ This file is (c) 1996 by Bernd Paysan
\ e-mail: paysan@informatik.tu-muenchen.de
\
\ Please copy and share this program, modify it for your system
\ and improve it as you like. But don't remove this notice.
\
\ Thank you.
\
\ The program uses the following words
\ from CORE :
\ decimal : bl word 0= ; = cells Constant Variable ! Create , allot @ IF
\ POSTPONE >r ELSE +! dup + THEN immediate r> * >body cell+ Literal drop
\ align here aligned DOES> execute ['] 2@ recurse swap 1+ over LOOP and
\ EXIT ?dup 0< rot r@ - i negate +LOOP 2drop BEGIN WHILE 2dup REPEAT 1-
\ rshift > / ' move UNTIL or count
\ from CORE-EXT :
\ nip tuck true ?DO compile, false Value erase pick :noname 0<>
\ from BLOCK-EXT :
\ \
\ from EXCEPTION :
\ throw
\ from EXCEPTION-EXT :
\ abort"
\ from FILE :
\ ( S"
\ from FLOAT :
\ faligned
\ from LOCAL :
\ TO
\ from MEMORY :
\ allocate free
\ from SEARCH :
\ find definitions get-order set-order get-current wordlist set-current
\ search-wordlist
\ from SEARCH-EXT :
\ also Forth previous
\ from STRING :
\ /string compare
\ from TOOLS-EXT :
\ [IF] [THEN] [ELSE] state
\ Loadscreen 27dec95py
decimal
: define? ( -- flag )
bl word find nip 0= ;
define? cell [IF]
1 cells Constant cell
[THEN]
define? ?EXIT [IF]
: ?EXIT postpone IF postpone EXIT postpone THEN ; immediate
[THEN]
define? Vocabulary [IF]
: Vocabulary wordlist create ,
DOES> @ >r get-order nip r> swap set-order ;
[THEN]
define? faligned [IF] false [ELSE] 1 faligned 8 = [THEN]
[IF]
: 8aligned ( n1 -- n2 ) faligned ;
[ELSE]
: 8aligned ( n1 -- n2 ) 7 + -8 and ;
[THEN]
Vocabulary Objects also Objects also definitions
Vocabulary types types also
0 cells Constant :wordlist
1 cells Constant :parent
2 cells Constant :child
3 cells Constant :next
4 cells Constant :method#
5 cells Constant :var#
6 cells Constant :newlink
7 cells Constant :iface
8 cells Constant :init
0 cells Constant :inext
1 cells Constant :ilist
2 cells Constant :ilen
3 cells Constant :inum
Variable op
: op! ( o -- ) op ! ;
Forth definitions
Create ostack 0 , 16 cells allot
: ^ ( -- o ) op @ ;
: o@ ( -- o ) op @ @ ;
: >o ( o -- )
state @
IF postpone ^ postpone >r postpone op!
ELSE 1 ostack +! ^ ostack dup @ cells + ! op!
THEN ; immediate
: o> ( -- )
state @
IF postpone r> postpone op!
ELSE ostack dup @ cells + @ op! -1 ostack +!
THEN ; immediate
: o[] ( n -- ) o@ :var# + @ * ^ + op! ;
Objects definitions
\ Coding 27dec95py
0 Constant #static
1 Constant #method
2 Constant #early
3 Constant #var
4 Constant #defer
: exec? ( addr -- flag )
>body cell+ @ #method = ;
: static? ( addr -- flag )
>body cell+ @ #static = ;
: early? ( addr -- flag )
>body cell+ @ #early = ;
: defer? ( addr -- flag )
>body cell+ @ #defer = ;
false Value oset?
: o+, ( addr offset -- )
postpone Literal postpone ^ postpone +
oset? IF postpone op! ELSE postpone >o THEN drop ;
: o*, ( addr offset -- )
postpone Literal postpone * postpone Literal postpone +
oset? IF postpone op! ELSE postpone >o THEN ;
: ^+@ ( offset -- addr ) ^ + @ ;
: o+@, ( addr offset -- )
postpone Literal postpone ^+@ oset? IF postpone op! ELSE postpone >o THEN drop ;
: ^*@ ( offset -- addr ) ^ + @ tuck @ :var# + @ 8aligned * + ;
: o+@*, ( addr offset -- )
postpone Literal postpone ^*@ oset? IF postpone op! ELSE postpone >o THEN drop ;
\ variables / memory allocation 30oct94py
Variable lastob
Variable lastparent 0 lastparent !
Variable vars
Variable methods
Variable decl 0 decl !
Variable 'link
: crash true abort" unbound method" ;
: link, ( addr -- ) align here 'link ! , 0 , 0 , ;
0 link,
\ type declaration 30oct94py
: vallot ( size -- offset ) vars @ >r dup vars +!
'link @ 0=
IF lastparent @ dup IF :newlink + @ THEN link,
THEN
'link @ 2 cells + +! r> ;
: valign ( -- ) vars @ aligned vars ! ;
define? faligned 0= [IF]
: vfalign ( -- ) vars @ faligned vars ! ;
[THEN]
: mallot ( -- offset ) methods @ cell methods +! ;
types definitions
: static ( -- ) \ oof- oof
\G Create a class-wide cell-sized variable.
mallot Create , #static ,
DOES> @ o@ + ;
: method ( -- ) \ oof- oof
\G Create a method selector.
mallot Create , #method ,
DOES> @ o@ + @ execute ;
: early ( -- ) \ oof- oof
\G Create a method selector for early binding.
Create ['] crash , #early ,
DOES> @ execute ;
: var ( size -- ) \ oof- oof
\G Create an instance variable
vallot Create , #var ,
DOES> @ ^ + ;
: defer ( -- ) \ oof- oof
\G Create an instance defer
valign cell vallot Create , #defer ,
DOES> @ ^ + @ execute ;
\ dealing with threads 29oct94py
Objects definitions
: object-order ( wid0 .. widm m addr -- wid0 .. widn n )
dup IF 2@ >r recurse r> swap 1+ ELSE drop THEN ;
: interface-order ( wid0 .. widm m addr -- wid0 .. widn n )
dup IF 2@ >r recurse r> :ilist + @ swap 1+
ELSE drop THEN ;
: add-order ( addr -- n ) dup 0= ?EXIT >r
get-order r> swap >r 0 swap
dup >r object-order r> :iface + @ interface-order
r> over >r + set-order r> ;
: drop-order ( n -- ) 0 ?DO previous LOOP ;
\ object compiling/executing 20feb95py
: o, ( xt early? -- )
over exec? over and IF
drop >body @ o@ + @ compile, EXIT THEN
over static? over and IF
drop >body @ o@ + @ postpone Literal EXIT THEN
drop dup early? IF >body @ THEN compile, ;
: findo ( string -- cfa n )
o@ add-order >r
find
?dup 0= IF drop set-order true abort" method not found!" THEN
r> drop-order ;
false Value method?
: method, ( object early? -- ) true to method?
swap >o >r bl word findo 0< state @ and
IF r> o, ELSE r> drop execute THEN o> false to method? ;
: cmethod, ( object early? -- )
state @ >r state on method, r> state ! ;
: early, ( object -- ) true to oset? true method,
state @ oset? and IF postpone o> THEN false to oset? ;
: late, ( object -- ) true to oset? false method,
state @ oset? and IF postpone o> THEN false to oset? ;
\ new, 29oct94py
previous Objects definitions
Variable alloc
0 Value ohere
: oallot ( n -- ) ohere + to ohere ;
: ((new, ( link -- )
dup @ ?dup IF recurse THEN cell+ 2@ swap ohere + >r
?dup IF ohere >r dup >r :newlink + @ recurse r> r> ! THEN
r> to ohere ;
: (new ( object -- )
ohere >r dup >r :newlink + @ ((new, r> r> ! ;
: init-instance ( pos link -- pos )
dup >r @ ?dup IF recurse THEN r> cell+ 2@
IF drop dup >r ^ +
>o o@ :init + @ execute 0 o@ :newlink + @ recurse o>
r> THEN + ;
: init-object ( object -- size )
>o o@ :init + @ execute 0 o@ :newlink + @ init-instance o> ;
: (new, ( object -- ) ohere dup >r over :var# + @ erase (new
r> init-object drop ;
: size@ ( objc -- size ) :var# + @ 8aligned ;
: (new[], ( n o -- addr ) ohere >r
dup size@ rot over * oallot r@ ohere dup >r 2 pick -
?DO I to ohere >r dup >r (new, r> r> dup negate +LOOP
2drop r> to ohere r> ;
\ new, 29oct94py
Create chunks here 16 cells dup allot erase
: DelFix ( addr root -- ) dup @ 2 pick ! ! ;
: NewFix ( root size # -- addr )
BEGIN 2 pick @ ?dup 0=
WHILE 2dup * allocate throw over 0
?DO dup 4 pick DelFix 2 pick +
LOOP
drop
REPEAT
>r drop r@ @ rot ! r@ swap erase r> ;
: >chunk ( n -- root n' )
1- -8 and dup 3 rshift cells chunks + swap 8 + ;
: Dalloc ( size -- addr )
dup 128 > IF allocate throw EXIT THEN
>chunk 2048 over / NewFix ;
: Salloc ( size -- addr ) align here swap allot ;
: dispose, ( addr size -- )
dup 128 > IF drop free throw EXIT THEN
>chunk drop DelFix ;
: new, ( o -- addr ) dup :var# + @
alloc @ execute dup >r to ohere (new, r> ;
: new[], ( n o -- addr ) dup :var# + @ 8aligned
2 pick * alloc @ execute to ohere (new[], ;
Forth definitions
: dynamic ['] Dalloc alloc ! ; dynamic
: static ['] Salloc alloc ! ;
Objects definitions
\ instance creation 29mar94py
: instance, ( o -- ) alloc @ >r static new, r> alloc ! drop
DOES> state @ IF dup postpone Literal oset? IF postpone op! ELSE postpone >o THEN THEN early, ;
: ptr, ( o -- ) 0 , ,
DOES> state @
IF dup postpone Literal postpone @ oset? IF postpone op! ELSE postpone >o THEN cell+
ELSE @ THEN late, ;
: array, ( n o -- ) alloc @ >r static new[], r> alloc ! drop
DOES> ( n -- ) dup dup @ size@
state @ IF o*, ELSE nip rot * + THEN early, ;
\ class creation 29mar94py
Variable voc#
Variable classlist
Variable old-current
Variable ob-interface
: voc! ( addr -- ) get-current old-current !
add-order 2 + voc# !
get-order wordlist tuck classlist ! 1+ set-order
also types classlist @ set-current ;
: (class ( parent -- )
here lastob ! true decl ! 0 ob-interface !
0 , dup voc! dup lastparent !
dup 0= IF 0 ELSE :method# + 2@ THEN methods ! vars !
DOES> false method, ;
: (is ( addr -- ) bl word findo drop
dup defer? abort" not deferred!"
>body @ state @
IF postpone ^ postpone Literal postpone + postpone !
ELSE ^ + ! THEN ;
: inherit ( -- ) bl word findo drop
dup exec? IF >body @ dup o@ + @ swap lastob @ + ! EXIT THEN
abort" Not a polymorph method!" ;
\ instance variables inside objects 27dec93py
: instvar, ( addr -- ) dup , here 0 , 0 vallot swap !
'link @ 2 cells + @ IF 'link @ link, THEN
'link @ >r dup r@ cell+ ! :var# + @ dup vars +! r> 2 cells + !
DOES> dup 2@ swap state @ IF o+, ELSE ^ + nip nip THEN
early, ;
: instptr> ( -- ) DOES> dup 2@ swap
state @ IF o+@, ELSE ^ + @ nip nip THEN late, ;
: instptr, ( addr -- ) , here 0 , cell vallot swap !
instptr> ;
: (o* ( i addr -- addr' ) dup @ :var# + @ 8aligned rot * + ;
: instarray, ( addr -- ) , here 0 , cell vallot swap !
DOES> dup 2@ swap
state @ IF o+@*, ELSE ^ + @ nip nip (o* THEN
late, ;
\ bind instance pointers 27mar94py
: ((link ( addr -- o addr' ) 2@ swap ^ + ;
: (link ( -- o addr ) bl word findo drop >body state @
IF postpone Literal postpone ((link EXIT THEN ((link ;
: parent? ( class o -- class class' ) @
BEGIN 2dup = ?EXIT dup WHILE :parent + @ REPEAT ;
: (bound ( obj1 obj2 adr2 -- ) >r over parent?
nip 0= abort" not the same class !" r> ! ;
: (bind ( addr -- ) \ <name>
(link state @ IF postpone (bound EXIT THEN (bound ;
: (sbound ( o addr -- ) dup cell+ @ swap (bound ;
Forth definitions
: bind ( o -- ) ' state @
IF postpone Literal postpone >body postpone (sbound EXIT THEN
>body (sbound ; immediate
Objects definitions
\ method implementation 29oct94py
Variable m-name
Variable last-interface 0 last-interface !
: interface, ( -- ) last-interface @
BEGIN dup WHILE dup , @ REPEAT drop ;
: inter, ( iface -- )
align here over :inum + @ lastob @ + !
here over :ilen + @ dup allot move ;
: interfaces, ( -- ) ob-interface @ lastob @ :iface + !
ob-interface @
BEGIN dup WHILE 2@ inter, REPEAT drop ;
: lastob! ( -- ) lastob @ dup
BEGIN nip dup @ here cell+ 2 pick ! dup 0= UNTIL drop
dup , op! o@ lastob ! ;
: thread, ( -- ) classlist @ , ;
: var, ( -- ) methods @ , vars @ , ;
: parent, ( -- o parent )
o@ lastparent @ 2dup dup , 0 ,
dup IF :child + dup @ , ! ELSE , drop THEN ;
: 'link, ( -- )
'link @ ?dup 0=
IF lastparent @ dup IF :newlink + @ THEN THEN , ;
: cells, ( -- )
methods @ :init ?DO ['] crash , cell +LOOP ;
\ method implementation 20feb95py
types definitions
: how: ( -- ) \ oof- oof how-to
\G End declaration, start implementation
decl @ 0= abort" not twice!" 0 decl !
align interface,
lastob! thread, parent, var, 'link, 0 , cells, interfaces,
dup
IF dup :method# + @ >r :init + swap r> :init /string move
ELSE 2drop THEN ;
: class; ( -- ) \ oof- oof end-class
\G End class declaration or implementation
decl @ IF how: THEN 0 'link !
voc# @ drop-order old-current @ set-current ;
: ptr ( -- ) \ oof- oof
\G Create an instance pointer
Create immediate lastob @ here lastob ! instptr, ;
: asptr ( class -- ) \ oof- oof
\G Create an alias to an instance pointer, cast to another class.
cell+ @ Create immediate
lastob @ here lastob ! , , instptr> ;
: Fpostpone postpone postpone ; immediate
: : ( <methodname> -- ) \ oof- oof colon
decl @ abort" HOW: missing! "
bl word findo 0= abort" not found"
dup exec? over early? or over >body cell+ @ 0< or
0= abort" not a method"
m-name ! :noname ;
Forth
: ; ( xt colon-sys -- ) \ oof- oof
postpone ;
m-name @ dup >body swap exec?
IF @ o@ +
ELSE dup cell+ @ 0< IF 2@ swap o@ + @ + THEN
THEN ! ; immediate
Forth definitions
\ object 23mar95py
Create object immediate 0 (class \ do not create as subclass
cell var oblink \ create offset for backlink
static thread \ method/variable wordlist
static parento \ pointer to parent
static childo \ ptr to first child
static nexto \ ptr to next child of parent
static method# \ number of methods (bytes)
static size \ number of variables (bytes)
static newlink \ ptr to allocated space
static ilist \ interface list
method init ( ... -- ) \ object- oof
method dispose ( -- ) \ object- oof
early class ( "name" -- ) \ object- oof
early new ( -- o ) \ object- oof
immediate
early new[] ( n -- o ) \ object- oof new-array
immediate
early : ( "name" -- ) \ object- oof define
early ptr ( "name" -- ) \ object- oof
early asptr ( o "name" -- ) \ object- oof
early [] ( n "name" -- ) \ object- oof array
early :: ( "name" -- ) \ object- oof scope
immediate
early class? ( o -- flag ) \ object- oof class-query
early super ( "name" -- ) \ object- oof
immediate
early self ( -- o ) \ object- oof
early bind ( o "name" -- ) \ object- oof
immediate
early bound ( class addr "name" -- ) \ object- oof
early link ( "name" -- class addr ) \ object- oof
immediate
early is ( xt "name" -- ) \ object- oof
immediate
early send ( xt -- ) \ object- oof
immediate
early with ( o -- ) \ object- oof
immediate
early endwith ( -- ) \ object- oof
immediate
early ' ( "name" -- xt ) \ object- oof tick
immediate
early postpone ( "name" -- ) \ object- oof
immediate
early definitions ( -- ) \ object- oof
\ base object class implementation part 23mar95py
how:
0 parento !
0 childo !
0 nexto !
: class ( -- ) Create immediate o@ (class ;
: : ( -- ) Create immediate o@
decl @ IF instvar, ELSE instance, THEN ;
: ptr ( -- ) Create immediate o@
decl @ IF instptr, ELSE ptr, THEN ;
: asptr ( addr -- )
decl @ 0= abort" only in declaration!"
Create immediate o@ , cell+ @ , instptr> ;
: [] ( n -- ) Create immediate o@
decl @ IF instarray, ELSE array, THEN ;
: new ( -- o ) o@ state @
IF Fpostpone Literal Fpostpone new, ELSE new, THEN ;
: new[] ( n -- o ) o@ state @
IF Fpostpone Literal Fpostpone new[], ELSE new[], THEN ;
: dispose ( -- ) ^ size @ dispose, ;
: bind ( addr -- ) (bind ;
: bound ( o1 o2 addr2 -- ) (bound ;
: link ( -- o addr ) (link ;
: class? ( class -- flag ) ^ parent? nip 0<> ;
: :: ( -- )
state @ IF ^ true method, ELSE inherit THEN ;
: super ( -- ) parento true method, ;
: is ( cfa -- ) (is ;
: self ( -- obj ) ^ ;
: init ( -- ) ;
: ' ( -- xt ) bl word findo 0= abort" not found!"
state @ IF Fpostpone Literal THEN ;
: send ( xt -- ) execute ;
: postpone ( -- ) o@ add-order Fpostpone Fpostpone drop-order ;
: with ( -- )
state @ oset? 0= and IF Fpostpone >o THEN
o@ add-order voc# ! false to oset? ;
: endwith Fpostpone o> voc# @ drop-order ;
: definitions
o@ add-order 1+ voc# ! also types o@ lastob !
false to oset? get-current old-current !
thread @ set-current ;
class; \ object
\ interface 01sep96py
Objects definitions
: implement ( interface -- ) \ oof-interface- oof
align here over , ob-interface @ , ob-interface !
:ilist + @ >r get-order r> swap 1+ set-order 1 voc# +! ;
: inter-method, ( interface -- ) \ oof-interface- oof
:ilist + @ bl word count 2dup s" '" compare
0= dup >r IF 2drop bl word count THEN
rot search-wordlist
dup 0= abort" Not an interface method!"
r> IF drop state @ IF postpone Literal THEN EXIT THEN
0< state @ and IF compile, ELSE execute THEN ;
Variable inter-list
Variable lastif
Variable inter#
Vocabulary interfaces interfaces definitions
: method ( -- ) \ oof-interface- oof
mallot Create , inter# @ ,
DOES> 2@ swap o@ + @ + @ execute ;
: how: ( -- ) \ oof-interface- oof
align
here lastif @ ! 0 decl !
here last-interface @ , last-interface !
inter-list @ , methods @ , inter# @ ,
methods @ :inum cell+ ?DO ['] crash , LOOP ;
: interface; ( -- ) \ oof-interface- oof
old-current @ set-current
previous previous ;
: : ( <methodname> -- ) \ oof-interface- oof colon
decl @ abort" HOW: missing! "
bl word count lastif @ @ :ilist + @
search-wordlist 0= abort" not found"
dup >body cell+ @ 0< 0= abort" not a method"
m-name ! :noname ;
Forth
: ; ( xt colon-sys -- ) \ oof-interface- oof
postpone ;
m-name @ >body @ lastif @ @ + ! ; immediate
Forth definitions
: interface ( -- ) \ oof-interface- oof
Create here lastif ! 0 , get-current old-current !
last-interface @ dup IF :inum @ THEN 1 cells - inter# !
get-order wordlist
dup inter-list ! dup set-current swap 1+ set-order
true decl !
0 vars ! :inum cell+ methods ! also interfaces
DOES> @ decl @ IF implement ELSE inter-method, THEN ;
previous previous
oof/oofsampl.fs 0000644 0000000 0000000 00000011470 11103442430 0014004 0 ustar 00root root 0000000 0000000 \ oof.fs Object Oriented FORTH
\ This file is (c) 1996 by Bernd Paysan
\ e-mail: paysan@informatik.tu-muenchen.de
\
\ Please copy and share this program, modify it for your system
\ and improve it as you like. But don't remove this notice.
\
\ Thank you.
\
\ Data structures: data 28nov93py
: place ( addr1 n addr2 -- )
over >r rot over 1+ r> move c! ;
: i! postpone ! ; immediate
: i@ postpone @ ; immediate
object class data \ abstract data class
cell var ref \ reference counter
method ! method @ method .
method null method atom? method #
how: : atom? ( -- flag ) true ;
: # ( -- n ) 0 ;
: null ( -- addr ) new ;
class;
\ Data structures: int 30apr93py
data class int
cell var value
how: : ! value i! ;
: @ value i@ ;
: . @ 0 .r ;
: init ( data -- ) ! ;
: dispose -1 ref +!
ref i@ 0> 0= IF super dispose THEN ;
: null 0 new ;
class;
\ Data structures: list 17nov93py
0 Value nil
data class lists
data ptr first data ptr next
method empty? method ?
how: : null nil ;
: atom? false ;
class;
lists class nil-class
how: : empty? true ;
: dispose ;
: . ." ()" ;
class;
nil-class : (nil (nil self TO nil
nil (nil bind first nil (nil bind next
\ Data structures: list 12mar94py
lists class linked
how: : empty? false ;
: # next # 1+ ;
: ? first . ;
: @ first @ ;
: ! first ! ;
: init ( first next -- )
dup >o 1 ref +! o> bind next
dup >o 1 ref +! o> bind first ;
: . self >o [char] (
BEGIN emit ? next atom? next self o> >o
IF ." . " data . o> ." )" EXIT THEN bl
empty? UNTIL o> drop ." )" ;
: dispose -1 ref +! ref i@ 0> 0=
IF first dispose next dispose super dispose THEN ;
class;
\ Data structures: string 04dec93py
int class string
how: : ! ( addr count -- )
value i@ over 1+ resize throw value i!
value i@ place ;
: @ ( -- addr count ) value i@ count ;
: . @ type ;
: init ( addr count -- )
dup 1+ allocate throw value i! value i@ place ;
: null S" " new ;
: dispose ref i@ 1- 0> 0=
IF value i@ free throw THEN super dispose ;
class;
\ Data sturctures: pointer 17nov93py
data class pointer
data ptr container
method ptr!
how: : ! container ! ;
: @ container @ ;
: . container . ;
: # container # ;
: init ( data -- ) dup >o 1 ref +! o> bind container ;
: ptr! ( data -- ) container dispose init ;
: dispose -1 ref +! ref i@ 0> 0=
IF container dispose super dispose THEN ;
: null nil new ;
class;
\ Data sturctures: array 30apr93py
data class array
data [] container
cell var range
how: : ! container ! ;
: @ container @ ;
: . [char] [
# 0 ?DO emit I container . [char] , LOOP drop ." ]" ;
: init ( data n -- ) range i! bind container ;
: dispose -1 ref +! ref i@ 0> 0=
IF # 0 ?DO I container dispose LOOP
super dispose THEN ;
: null nil 0 new ;
: # range i@ ;
: atom? false ;
class;
\ Data structure utilities 17nov93py
: cons linked new ;
: list nil cons ;
: car >o lists first self o> ;
: cdr >o lists next self o> ;
: print >o data . o> ;
: ddrop >o data dispose o> ;
: make-string string new ;
: $" state @ IF postpone S" postpone make-string exit THEN
[char] " parse make-string ; immediate
\ Examples
$" This" $" is" $" a" list cons $" example" $" list" list cons list cons cons
cr dup print
cr dup car print
cr dup cdr cdr car print
pointer : list1
cr list1 .
1 2 3 3 int new[] 3 array : lotus
cr lotus .
cr 2 lotus @ .
cr 0 lotus @ .
cr 5 1 lotus ! lotus .
\ Interface test
interface bla
method fasel
method blubber
method Hu
how:
: fasel ." Bla Fasel" Hu ;
: blubber ." urps urps" Hu fasel ;
interface;
object class test
bla
method .
how:
: Hu ." ! " ;
: . fasel ;
class;
test : test1
cr test1 fasel
cr test1 blubber
cr test1 .
cr test1 self >o bla blubber o>
\ This should output the following lines:
\
\ (This (is a) (example list))
\ This
\ (example list)
\ (This (is a) (example list))
\ [1,2,3]
\ 3
\ 1
\ [1,5,3]
\ Bla Fasel!
\ urps urps! Bla Fasel!
\ Bla Fasel!
\ urps urps! Bla Fasel!