Rosetta Code

Constrained genericity: Difference between revisions

Page Discussion

Constrained genericity (view source)

Revision as of 10:22, 8 June 2015

56 bytes removed ,  8 years ago
m
→‎{{header|Forth}}
Line 362:
=={{header|Forth}}==
{{works with|Forth}}
Works with any ANS Forth with one dependency
 
Needs the FMS-SI (single inheritance) library code located here:
Line 369:
include FMS-SILib.f
 
: (where) {( class-xt where-xtdfa -- flag })▼
\ This code uses an implementation dependent word dfa>xt
swap >body { where-dfa class-dfa }
\ which converts a data-field address to an executable token.
 
: dfa>xt ( a-addr -- xt ) \ implementation dependent for VFX Forth
5 - ;
 
▲: (where) { class-xt where-xt -- flag }
begin
class-xtdfa ['] object >body <>
while
class-xtdfa where-xtdfa = if true exit then
class-xt >bodydfa sfa @ dfa>xt to class-xtdfa
repeat false ;
 
: where ( class-xt "classname" -- flag )
' >body state @
if postpone literal postpone (where)
else (where)
Line 401 ⟶ 396:
else ." not an eatable type "
then ;m
:m get ( -- obj ) eatable-types ;m
;class
 
: test ( obj -- ) \ send the eat message to each object in the object-list
begin dup each:
while eat
Line 410 ⟶ 405:
 
FoodBox fb
3 ' Eatable fb fill: \ fill the object-list with 3 objects of class Eatable
fb get test
successful eat
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/90927"