[bugfix Adrian Prantl **20081209132205] { hunk ./compiler.fs 32 - \ dup emit s\" peeked\n" type + \ dup emit .\" peeked\n" hunk ./compiler.fs 39 +: expect { addr u c -- addr u } + u 0 <= throw + addr c@ c <> throw + addr chars 1+ u 1- +; + hunk ./compiler.fs 78 - begin + dup 0 <> if begin hunk ./compiler.fs 81 - repeat + repeat endif hunk ./compiler.fs 91 - \ s" TOK: " type addrTok tok_length type cr + \ ." TOK: " addrTok tok_length type cr hunk ./compiler.fs 138 - peek ]? if next-char nil \ nil atom \ s" pushing NIL " type cr + peek ]? if next-char nil \ nil atom \ ." pushing NIL " cr hunk ./compiler.fs 167 - \ 2dup s" searching for " type type cr + \ 2dup ." searching for " type cr hunk ./compiler.fs 173 - \ s" binding " type 2dup type s" to " type 2over . drop cr + \ ." binding " 2dup type ." to " 2over . drop cr hunk ./compiler.fs 180 - execute @ s" set_value X" type . cr + execute @ ." set_value X" . cr hunk ./compiler.fs 183 - s" set_variable X" type lastX . cr + ." set_variable X" lastX . cr hunk ./compiler.fs 187 -: getput ( -- ) cur-mode @ c-mode = if s" get" else s" put" endif type ; +: getput ( -- ) cur-mode @ c-mode = if ." get" else ." put" endif ; hunk ./compiler.fs 191 - execute @ getput s" _value X" type . s" , A" type i . cr + execute @ getput ." _value X" . ." , A" i . cr hunk ./compiler.fs 194 - getput s" _value X" type lastX . s" , A" type i . cr + getput ." _value X" lastX . ." , A" i . cr hunk ./compiler.fs 199 - reg? if s" set_value X" type . drop cr else + reg? if ." set_value X" . drop cr else hunk ./compiler.fs 201 - nil? if 2drop s" set_nil" type cr else + nil? if 2drop ." set_nil" cr else hunk ./compiler.fs 209 - reg? if 3drop ( s" set_value A" type A @ . cr ) else + reg? if 3drop ( ." set_value A" A @ . cr ) else hunk ./compiler.fs 212 - nil? if 2drop getput s" _nil A" type . cr else + nil? if 2drop getput ." _nil A" . cr else hunk ./compiler.fs 239 - nargs addrF uF isList? if getput s" _list " type - else getput s" _structure " type addrF uF type s" /" type nargs . endif + nargs addrF uF isList? if getput ." _list " + else getput ." _structure " addrF uF type ." /" nargs . endif hunk ./compiler.fs 242 - s" , A" type mode 8 rshift . cr + ." , A" mode 8 rshift . cr hunk ./compiler.fs 244 - s" , X" type newX . cr + ." , X" newX . cr hunk ./compiler.fs 252 -: query ( ... ) { mode nargs addrF uF } +: head ( ... ) { mode nargs addrF uF } hunk ./compiler.fs 255 - s" call " type addrF uF type s" /" type nargs . cr +; + +: query ( ... ) { mode nargs addrF uF } + mode nargs addrF uF head + ." call " addrF uF type ." /" nargs . cr hunk ./compiler.fs 279 - \ 2dup s" set_variable " type type cr + \ 2dup ." set_variable " type cr hunk ./compiler.fs 314 - scan-tok 2dup type s" /?: switch_on_term ?,fail" type cr { addrF uF } - s" ?: try_me_else ?" type cr + scan-tok 2dup type ." /?: switch_on_term ?,fail" cr { addrF uF } + ." ?: try_me_else ?" cr hunk ./compiler.fs 319 - addrF uF query + addrF uF head hunk ./compiler.fs 323 - a-mode 0 addrF uF query \ push ATOM + a-mode 0 addrF uF head \ push ATOM hunk ./compiler.fs 326 - s" ?: proceed ?" type cr hunk ./compiler.fs 331 - s" ?: trust_me_else fail" type cr hunk ./compiler.fs 353 - skip-ws Arrow? next-char next-char skip-ws + skip-ws Arrow? not throw next-char next-char skip-ws hunk ./compiler.fs 357 + [Char] . expect + ." ?: proceed ?" cr }