Re: OOP packages
- From: Doug Hoffman <glidedog@xxxxxxxxx>
- Date: Tue, 15 May 2012 08:35:06 -0400
On 5/10/12 8:04 PM, hwfwguy@xxxxxxxxx wrote:
> I may have asked the wrong question. It's hard to evaluate the many
> OOPs out there. Maybe what I'm looking for is a sample problem that
> is solved in several dialects of OOP. That would provide some
> metrics.
It helps to know exactly what you want. Everyone seems to have their own definition of what constitutes a minimum set of behaviors for object programming.
> Having spent the day in C#, the object.method syntax is starting to
> grow on me.
> The primary use of OOP seems to be encapsulation, followed by its
> cousin polymorphism. Rather than adopt an OOP with hundreds of LOC, I
> might adopt one with tens of lines.
~40 lines or less? (compiles to 1652 bytes on Carbon MacForth)
-Doug
\ micro-FMS Douglas B. Hoffman 05/15/12 largely untested
\ Full encapsulation of data and methods.
\ Polymorphism with no restrictions on inheritance order.
\ Dynamic (late) binding of methods.
\ Duck typing.
\ Instantiate objects in the dictionary or the heap.
0 value self
0 value ^class
: dfa 1 cells + ;
: sfa 2 cells + ;
: wida 3 cells + ;
4 cells constant classSize
: find-method ( sel class -- xt)
begin @ dup while 2dup cell+ @ = if 2 cells + nip @ exit then
repeat throw ;
: execute-method ( o xt --) self >r swap to self execute r> to self ;
create object classSize here over allot swap erase
: set-search-order ^class >r get-order begin r@ wida @ swap 1+
r> sfa @ >r r@ object = until r> drop set-order ;
: :class ( "name" --) create ;
: <super ( -- wn..w1 n)
here to ^class classSize allot ' >body dup ^class classSize move
^class sfa ! get-order wordlist ^class wida ! set-search-order ;
: ;class ( wn..w1 n --) set-order ;
: send ( o sel --) over 1 cells - @ find-method execute-method ;
: selector ( "name" --) create does> send ;
: getselect ( -- sel) >in @ bl word find
if >body nip else drop >in ! selector here then ;
: :m ( "name" -- a xt) forth-wordlist set-current
getselect align ^class here over @ , swap ! , here 0 , :noname ;
: ;m ( a xt --) postpone ; swap ! ; immediate
: super ( "name" --) ' >body ^class sfa @ find-method compile, ; immediate
: (ivar) ( "name" -- a) create immediate ,
does> @ postpone literal postpone self postpone + ;
: bytes ( n "name" --) align ^class wida @ set-current
^class dfa @ (ivar) ^class dfa +! ;
: pre-obj ( ^class -- n class n+cell) dup dfa @ swap over cell+ ;
: post-obj ( n class o -- o) dup cell+ >r ! r@ swap erase r> ;
defer allotocate ( n+cell -- o)
: makeobj ( class -- o) pre-obj allotocate post-obj ;
: dict-allot ( n+cell -- o) align here swap ( n ) allot ;
: heap-allocate ( n+cell -- o) allocate throw ;
: make ( xt -- o) is allotocate ' >body state @
if postpone literal postpone makeobj else makeobj then ;
: dict> ( class --o) ['] dict-allot make ; immediate
: heap> ( class --o) ['] heap-allocate make ; immediate
: <free ( o --) 1 cells - free throw ;
\ examples
:class var <super object
1 cells bytes data
:m !: ( n -- ) data ! ;m
:m @: ( -- n ) data @ ;m
:m p: self @: . ;m \ print self
:m init: 5 self !: ;m
;class
dict> var value x
x init: ok
x p: 5 ok
heap> var value h
55 h !: ok
h p: 55 ok
h <free ok
:class var2 <super var
1 cells bytes data2
1 cells bytes data3
:m dump: data dup . @ . data2 dup . @ . data3 dup . @ p: ;m
:m init: super init: dict> var data3 ! ;m \ embed object in ivar
:m test: data3 @ p: ;m
;class
dict> var2 value v2
v2 init: ok
v2 dump:
16864328 5 16864332 0 16864336 0 ok
v2 test: 0 ok
.
- Follow-Ups:
- Re: OOP packages
- From: Marcel Hendrix
- Re: OOP packages
- References:
- OOP packages
- From: hwfwguy
- Re: OOP packages
- From: hwfwguy
- OOP packages
- Prev by Date: Re: flashing with mspdebug and launchpad MSP430-2553
- Next by Date: Ebay: 4 (East & West) German Forth Programming Books
- Previous by thread: Re: OOP packages
- Next by thread: Re: OOP packages
- Index(es):
Relevant Pages
|
