cx89sm - Online Forth Interpreter & Debugging Tool

\ youtube.com/watch?v=Nscxt4MtoHo

: ex1 s" kitten" s" sitting" ;
: ex2 s" rosettacode" s" raisethysword" ;
: last ( au-c) 1- + c@ ;

\ // from mr. bezemer's video above.
: leven1 ( auau-u)
  dup 0= if 2drop nip exit then 2>r
  dup 0= if 2drop 2r> nip exit then
  2dup last 2r@ last = if
       1- 2r> 1- recurse exit then
  2dup 1- 2r@ 1- recurse -rot
  2dup    2r@ 1- recurse -rot
       1- 2r>    recurse
  min min 1+ ;

\ uses the same amount of rstack
\ but pstack use is fixed:
: 1r ( -n) rp@ cell+ cell+ @ ;
: r ( i-n) 1+ cells rp@ + @ ;
: leven2 ( aauu-aau)
  dup 0= if drop exit then
  over 0= if nip exit then >r >r
  over r@ last over 1r last = if
  r>  1- r>  1- recurse exit then
  r@  1- 1r  1- recurse >r
  1r     2 r 1- recurse >r
  2 r 1- 3 r    recurse
  r> r> rdrop rdrop min min 1+ ;
: leven2 ( auau-u) rot swap leven2 nip nip ;

\ uses a separate stack, necessary for
\ a small system with shallow stacks.
999 cells allot  here dup , value q
: >q ( n-) [ -1 cells ]l q +! q @ ! ;
: nqdrop ( u-) cells q +! ;
: 0q ( -n) q @ @ ;
: 1q ( -n) q @ cell+ @ ;
: q ( i-n) cells q @ + @ ;
: leven3 ( aauu-aau)
  dup 0= if drop exit then
  over 0= if nip exit then >q >q
  over 0q last over 1q last = if
  0q  1- 1q  1- 2 nqdrop recurse exit then
  0q  1- 1q  1- recurse >q
  1q     2 q 1- recurse >q
  2 q 1- 3 q    recurse
  0q 1q 4 nqdrop min min 1+ ;
: leven3 ( auau-u) rot swap leven3 nip nip ;

: now ( -u) utime drop ;
: t: ( '-) ' now >r execute now r> - swap . . ;
cr   ex1 t: leven1   ex1 t: leven2   ex1 t: leven3
cr ( ex2 t: leven1 ) ex2 t: leven2 ( ex2 t: leven3 )