Constrained genericity: Difference between revisions

=={{header|Forth}}==

{{works with|Forth}}

Works with any ANS Forth with one dependency

Needs the FMS-SI (single inheritance) library code located here:

http://soton.mpeforth.com/flag/fms/index.html

<lang forth>include FMS-SI.f

include FMS-SILib.f

\ This code uses an implementation dependent word dfa>xt

\ 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-xt ['] object <>

while

class-xt where-xt = if true exit then

class-xt >body sfa @ dfa>xt to class-xt

repeat false ;

:class Eatable

:m eat ;m

;class

\ FoodBox is defined without using eat in any way.

:class FoodBox

object-list eatable-types

:m fill: { n class-xt -- }

class-xt ['] Eatable where

if n 0 do class-xt eatable-types xtadd: loop

else ." not an eatable type "

then ;m

:m test:

begin eatable-types each:

while eat cr ." successful eat"

repeat ;m

;class

FoodBox fb

3 ' Eatable fb fill:

fb test:

successful eat

successful eat

successful eat

FoodBox fb1

5 ' object fb1 fill: \ => not an eatable type

:class apple <super Eatable

;class

:class green-apple <super apple

;class

5 ' green-apple fb1 fill:

fb1 test:

successful eat

successful eat

successful eat

successful eat

successful eat

</lang>