How does TclForth handle CREATE DOES> ?

[wejgaard]

Question

TclForth has no CREATE DOES>. How, then, would you implement this Forth example, from (http://rosettacode.org/wiki/One-dimensional_cellular_automata#Forth).

: init ( bits count -- ) 
    0 do dup 1 and c, 2/ loop drop ; 

20 constant size 
    create state $2556e size init 0 c, 

: .state 
    cr size 0 do 
    state i + c@ if ." #" else space  then   
    loop ; 

: ctable create does> + c@ ; 
    ctable rules $68 8 init 

: gen 
    state c@ ( window ) 
   size 0 do 
   2* state i + 1+ c@ or 7 and 
   dup rules state i + c! 
   loop drop ; 

: life1d ( n -- ) 
   .state 1 do gen .state loop ; 

10 life1d 

_###_##_#_#_#_#__#__ 
_#_#####_#_#_#______ 
__##___##_#_#_______ 
__##___###_#________ 
__##___#_##_________ 
__##____###_________ 
__##____#_#_________ 
__##_____#__________ 
__##________________ 
__##________________ 
__##________________ 

(The 'space' in .state changed to ." _")

[wejgaard]

Short Answer

TclForth replaces CREATE DOES> by Objecttypes. Objecttypes let you create data types as objects with private messages and methods.

The objecttypes string and array make use of the native string package and associative arrays of Tcl. And that's handy for this TclForth version.

"_###_##_#_#_#_#__#_____"  string state     

"" string nextstate 

{___ _  __# _  _#_ _  #__ _  _## #  #_# #  ##_ #  ###  _}  array rules 

: gen {} 
     "_" nextstate set 
     20 0 do  I dup 2 + state range rules nextstate append  loop 
     "__" nextstate append  ; 

: life1d { n -- } 
     state print 
     n times  gen  nextstate print  nextstate state set  repeat  ; 

[wejgaard]

Long Answer

INIT

> : init ( bits count -- )
>   0 do dup 1 and c, 2/ loop drop ;
>
> 20 constant size
> create state $2556e size init 0 c,

This builds the initial state at HERE. The hex number contains the (inverse) bit pattern. In TF you could create the pattern directly as a string, which handles its own buffer.

"01110110101010100100" string state

PRINT (and new INIT)

> : .state
>   cr size 0 do
>     state i + c@ if ." #" else ." _" then
>   loop ;
>

In TF this becomes 'state print'. The string is an object with a set of methods including the method print. However, this does not actually replace .state since we want to see the bitpattern as a sequence of "_" and "#". Well, then let's change the definition of state to

"_###_##_#_#_#_#__#__"  string state

We don't need to bother with 0 and 1, we have string functions available for any pattern.

CREATE DOES>

TF uses the ObjectType mechanism to define data types. Create Does> has only one action. The Objecttype has as many actions (methods) as you want. See the definition of Variable in forth.fth.

  > : ctable create does> + c@ ;
  > ctable rules $68 8 init

We could create the word rules as a custom objecttype but the objecttype array already does what we need.

{___ _
__#  _
_#_  _
#__  _
_##  #
#_#  #
##_  #
###  _}  array rules

TclForth arrays are collections of variables (hashed, associative). In the array rules the patterns are the names and the results the values of the array variables. We can write the array in one line.

{___ _  __# _  _#_ _  #__ _  _## #  #_# #  ##_ #  ###  _}  array rules

GET NEXT GENERATION:

> : gen
>   state c@ ( window )
>   size 0 do
>     2*  state i + 1+ c@ or  7 and
>     dup rules state i + c!
>   loop drop ;

gen replaces the state bit by bit in place instead of building the next state in a separate string or buffer. Why not use a second string for the new intermediate state.

"" string nextstate

: gen {}
     "_" nextstate set
     20 0 do I dup 2 + state range rules nextstate append loop
     "__" nextstate append  ;

1-DIMENSIONAL LIFE

> : life1d ( n -- )
>   .state 1 do gen .state loop ;
>
> 10 life1d
>

You can't top this definition, short and to the point -- once you know how gen works. With two state strings the 1d life becomes

: life-1d { n -- }
     state print
     n times gen nextstate print nextstate state set repeat  ;

THE FINAL TF VERSION

"_###_##_#_#_#_#__#_____"  string state     "" string nextstate

{___ _  __# _  _#_ _  #__ _  _## #  #_# #  ##_ #  ###  _}  array rules

: gen {}
     "_" nextstate set
     20 0 do I dup 2 + state range rules nextstate append loop
     "__" nextstate append  ;

: life-1d { n -- }
     state print
     n times gen nextstate print nextstate state set repeat  ;

10 life-1d