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 ; : ( str -- jump-table ) dup length f ! str table nil ! str table stack rot [ jump-table-char ] each-index ! table stack nil? not [ "too much [ brackets" throw ] when ! table ; : ( -- data ) 512 0 0 data boa ; : ( code -- program ) dup 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 ;