Paste: a BF interpreter

USING:
    kernel sequences arrays lists locals assocs
    strings combinators accessors io math math.parser ;
IN: essais

TUPLE: data
  { mem read-only }
  mem-pos
;

TUPLE: program
  { code read-only }
  { jump-table read-only }
  code-pos
;

: jump-table[ ( table stack index -- table stack )
  swons ;

: jump-table] ( table stack index -- table stack )
  swap                                                    ! t i s
  dup nil? [ "too much ] brackets" throw ] when
  unswons
  [| table index stack [pos
   | table stack
     [pos index table set-nth
     index [pos table set-nth
  ] call
;

: jump-table-char ( table stack char index -- table stack )
  swap 1string {
    { "[" [ jump-table[ ] }
    { "]" [ jump-table] ] }
    [ 2drop ]
  } case
;

: <jump-table> ( str -- jump-table )
  dup length f <array>                                    ! str table
  nil                                                     ! str table stack
  rot [ jump-table-char ] each-index                      ! table stack
  nil? not [ "too much [ brackets" throw ] when           ! table
;

: <data> ( -- data )
  512 0 <array> 0 data boa ;

: <program> ( code -- program )
  dup <jump-table> 0 program boa ;

: data-change-mem ( data quot -- data )
  [ dup [ mem-pos>> ] [ mem>> ] bi ] dip change-nth
; inline #! without inline I get an error about 'call'?

: program+ ( d p -- d p )
  [ [ 1 + ] data-change-mem ] dip ;
: program- ( d p -- d p )
  [ [ 1 - ] data-change-mem ] dip ;

: program> ( d p -- d p )
  [ [ 1 + ] change-mem-pos ] dip ;
: program< ( d p -- d p )
  [ [ 1 - ] change-mem-pos ] dip ;

: data-mem-0? ( data -- ? )
  [ mem-pos>> ] [ mem>> ] bi nth 0 = ;

: program-jump-pos ( program -- program )
  dup code-pos>>
  over jump-table>> nth
  >>code-pos
;

: program[ ( data program -- data program )
  over data-mem-0? [ program-jump-pos ] when ;

: program] ( data program -- data program )
  over data-mem-0? not [ program-jump-pos ] when ;

: program, ( d p -- d p )
  "input: " print
  over readln string>number swap                ! d p i d
  [ mem-pos>> ] [ mem>> ] bi set-nth
;

: program. ( d p -- d p )
  over [ mem-pos>> ] [ mem>> ] bi nth number>string print ;

: program-step ( data program -- data program )
  dup [ code-pos>> ] [ code>> ] bi nth                  ! data prog char
  1string {
    { "+" [ program+ ] }
    { "-" [ program- ] }
    { "<" [ program< ] }
    { ">" [ program> ] }
    { "[" [ program[ ] }
    { "]" [ program] ] }
    { "," [ program, ] }
    { "." [ program. ] }
    [ drop ]
  } case
  [ 1 + ] change-code-pos
;

: program-stop? ( program -- ? )
  [ code-pos>> ] [ code>> length ] bi = ;

: program-run ( data program -- data program )
  [ dup program-stop? ] [ program-step ] until ;