[jackhill/mal.git] / forth / stepA_mal.fs

require reader.fs
require printer.fs
require core.fs

core MalEnv. constant repl-env

99999999 constant TCO-eval

: read read-str ;
: eval ( env obj )
    begin
        \ ." eval-> " dup pr-str safe-type cr
        mal-eval
        dup TCO-eval =
    while
        drop
    repeat ;
: print
    \ ." Type: " dup mal-type @ type-name safe-type cr
    pr-str ;

MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself

MalKeyword
  extend eval-invoke { env list kw -- val }
    0   kw   env list MalList/start @ cell+ @ eval   get
    ?dup 0= if
        \ compute not-found value
        list MalList/count @ 1 > if
            env  list MalList/start @ 2 cells + @  TCO-eval
        else
            mal-nil
        endif
    endif ;;
  extend invoke { argv argc kw -- val }
    0   kw   argv @   get
    ?dup 0= if
        argc 1 > if
            argv cell+ @
        else
            mal-nil
        endif
    endif ;;
drop

\ eval all but the first item of list
: eval-rest { env list -- argv argc }
    list MalList/start @ cell+ { expr-start }
    list MalList/count @ 1- { argc }
    argc cells allocate throw { target }
    argc 0 ?do
        env expr-start i cells + @ eval
        target i cells + !
    loop
    target argc ;

MalNativeFn
  extend eval-invoke { env list this -- list }
    env list eval-rest ( argv argc )
    this invoke ;;
  extend invoke ( argv argc this -- val )
    MalNativeFn/xt @ execute ;;
drop

SpecialOp
  extend eval-invoke ( env list this -- list )
    SpecialOp/xt @ execute ;;
drop

: install-special ( symbol xt )
    SpecialOp. repl-env env/set ;

: defspecial
    parse-allot-name MalSymbol.
    ['] install-special
    :noname
    ;

: is-pair? ( obj -- bool )
    empty? mal-false = ;

defspecial quote ( env list -- form )
    nip MalList/start @ cell+ @ ;;

s" concat" MalSymbol. constant concat-sym
s" cons" MalSymbol. constant cons-sym

defer quasiquote
: quasiquote0 { ast -- form }
    ast is-pair? 0= if
        here quote-sym , ast , here>MalList
    else
        ast to-list MalList/start @ { ast-start }
        ast-start @ { ast[0] }
        ast[0] unquote-sym m= if
            ast-start cell+ @
        else
            ast[0] is-pair? if
                ast[0] to-list MalList/start @ { ast[0]-start }
                ast[0]-start @ splice-unquote-sym m= if
                    here
                    concat-sym ,
                    ast[0]-start cell+ @ ,
                    ast to-list MalList/rest quasiquote ,
                    here>MalList
                    false
                else true endif
            else true endif
            if
                here
                cons-sym ,
                ast[0] quasiquote ,
                ast to-list MalList/rest quasiquote ,
                here>MalList
            endif
        endif
    endif ;
' quasiquote0 is quasiquote

defspecial quasiquote ( env list )
    MalList/start @ cell+ @ ( ast )
    quasiquote TCO-eval ;;

defspecial def! { env list -- val }
    list MalList/start @ cell+ { arg0 }
    arg0 @ ( key )
    env arg0 cell+ @ eval dup { val } ( key val )
    env env/set val ;;

defspecial defmacro! { env list -- val }
    list MalList/start @ cell+ { arg0 }
    arg0 @ ( key )
    env arg0 cell+ @ eval { val }
    true val MalUserFn/is-macro? !
    val env env/set
    val ;;

defspecial let* { old-env list -- val }
    old-env MalEnv. { env }
    list MalList/start @ cell+ dup { arg0 }
    @ to-list
    dup MalList/start @ { bindings-start } ( list )
    MalList/count @ 0 +do
        bindings-start i cells + dup @ swap cell+ @ ( sym expr )
        env swap eval
        env env/set
    2 +loop
    env arg0 cell+ @ TCO-eval
    \ TODO: dec refcount of env
    ;;

defspecial do { env list -- val }
    list MalList/start @ { start }
    list MalList/count @ dup 1- { last } 1 ?do
        env   start i cells + @
        i last = if
            TCO-eval
        else
            eval drop
        endif
    loop ;;

defspecial if { env list -- val }
    list MalList/start @ cell+ { arg0 }
    env arg0 @ eval ( test-val )
    dup mal-false = if
        drop -1
    else
        mal-nil =
    endif
    if
        \ branch to false
        list MalList/count @ 3 > if
            env arg0 cell+ cell+ @ TCO-eval
        else
            mal-nil
        endif
    else
        \ branch to true
        env arg0 cell+ @ TCO-eval
    endif ;;

s" &" MalSymbol. constant &-sym

: new-user-fn-env { argv argc mal-fn -- env }
    mal-fn MalUserFn/formal-args @ { f-args-list }
    mal-fn MalUserFn/env @ MalEnv. { env }

    f-args-list MalList/start @ { f-args }
    f-args-list MalList/count @ ?dup 0= if else
        \ pass empty list for last arg, unless overridden below
        1- cells f-args + @ MalList new env env/set
    endif
    argc 0 ?do
        f-args i cells + @
        dup &-sym m= if
            drop
            argc i - { c }
            c cells allocate throw { start }
            argv i cells +  start  c cells  cmove
            f-args i 1+ cells + @ ( more-args-symbol )
            start c MalList. env env/set
            leave
        endif
        argv i cells + @
        env env/set
    loop
    env ;

MalUserFn
  extend eval-invoke { call-env list mal-fn -- list }
    mal-fn MalUserFn/is-macro? @ if
        list MalList/start @ cell+  \ argv
        list MalList/count @ 1-     \ argc
        mal-fn new-user-fn-env { env }
        env   mal-fn MalUserFn/body @   eval
        call-env swap TCO-eval
    else
        call-env list eval-rest
        mal-fn invoke
    endif ;;

  extend invoke ( argv argc mal-fn )
    dup { mal-fn } new-user-fn-env { env }
    env   mal-fn MalUserFn/body @   TCO-eval ;;
drop

defspecial fn* { env list -- val }
    list MalList/start @ cell+ { arg0 }
    MalUserFn new
    false over MalUserFn/is-macro? !
    env over MalUserFn/env !
    arg0 @ to-list over MalUserFn/formal-args !
    arg0 cell+ @ over MalUserFn/body ! ;;

defspecial macroexpand ( env list[_,form] -- form )
    MalList/start @ cell+ @ swap over ( form env form )
    MalList/start @ @ ( form env macro-name-expr )
    eval { macro-fn } ( form )
    dup MalList/start @ cell+  swap MalList/count @ 1- macro-fn ( argv argc fn )
    new-user-fn-env ( env )
    macro-fn MalUserFn/body @   TCO-eval ;;

5555555555 constant pre-try

defspecial try* { env list -- val }
    list MalList/start @ cell+ { arg0 }
    pre-try
    env arg0 @ ['] eval catch ?dup 0= if
        nip
    else { errno }
        begin pre-try = until
        errno 1 <> if
            s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc
            to exception-object
        endif
        arg0 cell+ @ ( list[catch*,sym,form] )
        MalList/start @ cell+ { catch0 }
        env MalEnv. { catch-env }
        catch0 @ exception-object catch-env env/set
        catch-env  catch0 cell+ @  TCO-eval
    endif ;;

defspecial . { env coll -- rtn-list }
    depth { old-depth }
    coll to-list dup MalList/count @ swap MalList/start @ { count start }
    count cells start +  start cell+  +do
        env i @ eval as-native
    cell +loop ;;

MalSymbol
  extend mal-eval { env sym -- val }
    sym env env/get-addr
    dup 0= if
        drop
        0 0 s" ' not found" sym pr-str s" '" ...throw-str
    else
        @
    endif ;;
drop

: eval-ast { env list -- list }
    here
    list MalList/start @ { expr-start }
    list MalList/count @ 0 ?do
        env expr-start i cells + @ eval ,
    loop
    here>MalList ;

MalList
  extend mal-eval { env list -- val }
    list MalList/count @ 0= if
        list
    else
        env list MalList/start @ @ eval
        env list rot eval-invoke
    endif ;;
drop

MalVector
  extend mal-eval ( env vector -- vector )
    MalVector/list @ eval-ast
    MalVector new swap over MalVector/list ! ;;
drop

MalMap
  extend mal-eval ( env map -- map )
    MalMap/list @ eval-ast
    MalMap new swap over MalMap/list ! ;;
drop

defcore eval ( argv argc )
  drop @ repl-env swap eval ;;

: rep ( str-addr str-len -- str-addr str-len )
    read
    repl-env swap eval
    print ;

: mk-args-list ( -- )
    here
    begin
        next-arg 2dup 0 0 d<> while
            MalString. ,
    repeat
    2drop here>MalList ;

create buff 128 allot
77777777777 constant stack-leak-detect

: nop ;

defcore swap! { argv argc -- val }
    \ argv is  (atom fn args...)
    argv @ { atom }
    argv cell+ @ { fn }
    argc 1- { call-argc }
    call-argc cells allocate throw { call-argv }
    atom Atom/val   call-argv    1 cells   cmove
    argv cell+ cell+   call-argv cell+   call-argc 1- cells   cmove
    call-argv call-argc fn  invoke
    dup TCO-eval = if drop eval endif { new-val }
    new-val atom Atom/val !
    new-val ;;

defcore map ( argv argc -- list )
    drop dup @ swap cell+ @ to-list { fn list }
    here
    list MalList/start @   list MalList/count @  cells   over + swap   +do
        i 1 fn invoke
        dup TCO-eval = if drop eval endif
        ,
    cell +loop
    here>MalList ;;

defcore readline ( argv argc -- mal-string )
    drop @ unpack-str type stdout flush-file drop
    buff 128 stdin read-line throw
    if buff swap MalString. else drop mal-nil endif ;;

s\" (def! *host-language* \"forth\")" rep 2drop
s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" rep 2drop
s\" (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" rep 2drop
s\" (def! *gensym-counter* (atom 0))" rep 2drop
s\" (def! gensym (fn* [] (symbol (str \"G__\" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))" rep 2drop
s\" (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))" rep 2drop

: repl ( -- )
    s\" (println (str \"Mal [\" *host-language* \"]\"))" rep 2drop
    begin
      ." user> "
      stack-leak-detect
      buff 128 stdin read-line throw
    while ( num-bytes-read )
      buff swap ( str-addr str-len )
      ['] rep
      \ execute ['] nop \ uncomment to see stack traces
      catch ?dup 0= if
          safe-type cr
          stack-leak-detect <> if ." --stack leak--" cr endif
      else { errno }
          begin stack-leak-detect = until
          errno 1 <> if
              s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc
              to exception-object
          endif
          ." Uncaught exception: "
          exception-object pr-str safe-type cr
      endif
    repeat ;

: main ( -- )
    mk-args-list { args-list }
    args-list MalList/count @ 0= if
        s" *ARGV*" MalSymbol. MalList/Empty repl-env env/set
        repl
    else
        args-list MalList/start @ @ { filename }
        s" *ARGV*" MalSymbol. args-list MalList/rest repl-env env/set

        repl-env
        here s" load-file" MalSymbol. , filename , here>MalList
        eval print
    endif ;

main
cr
bye
Commit	Line	Data
6512bd80 C	1	require reader.fs
	2	require printer.fs
	3	require core.fs
	4
	5	core MalEnv. constant repl-env
	6
6512bd80 C	7	99999999 constant TCO-eval
	8
	9	: read read-str ;
	10	: eval ( env obj )
	11	begin
	12	\ ." eval-> " dup pr-str safe-type cr
	13	mal-eval
	14	dup TCO-eval =
	15	while
	16	drop
	17	repeat ;
	18	: print
	19	\ ." Type: " dup mal-type @ type-name safe-type cr
	20	pr-str ;
	21
	22	MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself
	23
	24	MalKeyword
	25	extend eval-invoke { env list kw -- val }
	26	0 kw env list MalList/start @ cell+ @ eval get
	27	?dup 0= if
	28	\ compute not-found value
	29	list MalList/count @ 1 > if
	30	env list MalList/start @ 2 cells + @ TCO-eval
	31	else
	32	mal-nil
	33	endif
	34	endif ;;
	35	extend invoke { argv argc kw -- val }
	36	0 kw argv @ get
	37	?dup 0= if
	38	argc 1 > if
	39	argv cell+ @
	40	else
	41	mal-nil
	42	endif
	43	endif ;;
	44	drop
	45
	46	\ eval all but the first item of list
	47	: eval-rest { env list -- argv argc }
	48	list MalList/start @ cell+ { expr-start }
	49	list MalList/count @ 1- { argc }
	50	argc cells allocate throw { target }
	51	argc 0 ?do
	52	env expr-start i cells + @ eval
	53	target i cells + !
	54	loop
	55	target argc ;
	56
	57	MalNativeFn
	58	extend eval-invoke { env list this -- list }
	59	env list eval-rest ( argv argc )
	60	this invoke ;;
	61	extend invoke ( argv argc this -- val )
	62	MalNativeFn/xt @ execute ;;
	63	drop
	64
	65	SpecialOp
	66	extend eval-invoke ( env list this -- list )
	67	SpecialOp/xt @ execute ;;
	68	drop
	69
	70	: install-special ( symbol xt )
71	SpecialOp. repl-env env/set ;
72
73	: defspecial
74	parse-allot-name MalSymbol.
75	['] install-special
76	:noname
77	;
78
79	: is-pair? ( obj -- bool )
80	empty? mal-false = ;
81
82	defspecial quote ( env list -- form )
83	nip MalList/start @ cell+ @ ;;
84
85	s" concat" MalSymbol. constant concat-sym
86	s" cons" MalSymbol. constant cons-sym
87
88	defer quasiquote
89	: quasiquote0 { ast -- form }
90	ast is-pair? 0= if
91	here quote-sym , ast , here>MalList
92	else
93	ast to-list MalList/start @ { ast-start }
94	ast-start @ { ast[0] }
95	ast[0] unquote-sym m= if
96	ast-start cell+ @
97	else
98	ast[0] is-pair? if
99	ast[0] to-list MalList/start @ { ast[0]-start }
100	ast[0]-start @ splice-unquote-sym m= if
101	here
102	concat-sym ,
103	ast[0]-start cell+ @ ,
104	ast to-list MalList/rest quasiquote ,
105	here>MalList
106	false
107	else true endif
108	else true endif
109	if
110	here
111	cons-sym ,
112	ast[0] quasiquote ,
113	ast to-list MalList/rest quasiquote ,
114	here>MalList
115	endif
116	endif
117	endif ;
118	' quasiquote0 is quasiquote
119
120	defspecial quasiquote ( env list )
121	MalList/start @ cell+ @ ( ast )
122	quasiquote TCO-eval ;;
123
124	defspecial def! { env list -- val }
125	list MalList/start @ cell+ { arg0 }
126	arg0 @ ( key )
127	env arg0 cell+ @ eval dup { val } ( key val )
128	env env/set val ;;
129
130	defspecial defmacro! { env list -- val }
131	list MalList/start @ cell+ { arg0 }
132	arg0 @ ( key )
133	env arg0 cell+ @ eval { val }
134	true val MalUserFn/is-macro? !
135	val env env/set
136	val ;;
137
138	defspecial let* { old-env list -- val }
139	old-env MalEnv. { env }
140	list MalList/start @ cell+ dup { arg0 }
141	@ to-list
142	dup MalList/start @ { bindings-start } ( list )
143	MalList/count @ 0 +do
144	bindings-start i cells + dup @ swap cell+ @ ( sym expr )
145	env swap eval
146	env env/set
147	2 +loop
148	env arg0 cell+ @ TCO-eval
149	\ TODO: dec refcount of env
150	;;
151
152	defspecial do { env list -- val }
153	list MalList/start @ { start }
154	list MalList/count @ dup 1- { last } 1 ?do
155	env start i cells + @
156	i last = if
157	TCO-eval
158	else
159	eval drop
160	endif
161	loop ;;
162
163	defspecial if { env list -- val }
164	list MalList/start @ cell+ { arg0 }
165	env arg0 @ eval ( test-val )
166	dup mal-false = if
167	drop -1
168	else
169	mal-nil =
170	endif
171	if
172	\ branch to false
173	list MalList/count @ 3 > if
174	env arg0 cell+ cell+ @ TCO-eval
175	else
176	mal-nil
177	endif
178	else
179	\ branch to true
180	env arg0 cell+ @ TCO-eval
181	endif ;;
182
183	s" &" MalSymbol. constant &-sym
184
185	: new-user-fn-env { argv argc mal-fn -- env }
186	mal-fn MalUserFn/formal-args @ { f-args-list }
187	mal-fn MalUserFn/env @ MalEnv. { env }
188
189	f-args-list MalList/start @ { f-args }
190	f-args-list MalList/count @ ?dup 0= if else
fe364a97 DM	191	\ pass empty list for last arg, unless overridden below
fe364a97 DM	192	1- cells f-args + @ MalList new env env/set
6512bd80 C	193	endif
	194	argc 0 ?do
	195	f-args i cells + @
	196	dup &-sym m= if
	197	drop
	198	argc i - { c }
	199	c cells allocate throw { start }
	200	argv i cells + start c cells cmove
	201	f-args i 1+ cells + @ ( more-args-symbol )
	202	start c MalList. env env/set
	203	leave
	204	endif
	205	argv i cells + @
	206	env env/set
	207	loop
	208	env ;
	209
	210	MalUserFn
	211	extend eval-invoke { call-env list mal-fn -- list }
	212	mal-fn MalUserFn/is-macro? @ if
	213	list MalList/start @ cell+ \ argv
	214	list MalList/count @ 1- \ argc
	215	mal-fn new-user-fn-env { env }
	216	env mal-fn MalUserFn/body @ eval
	217	call-env swap TCO-eval
	218	else
	219	call-env list eval-rest
	220	mal-fn invoke
	221	endif ;;
	222
	223	extend invoke ( argv argc mal-fn )
	224	dup { mal-fn } new-user-fn-env { env }
	225	env mal-fn MalUserFn/body @ TCO-eval ;;
	226	drop
	227
	228	defspecial fn* { env list -- val }
	229	list MalList/start @ cell+ { arg0 }
	230	MalUserFn new
	231	false over MalUserFn/is-macro? !
	232	env over MalUserFn/env !
	233	arg0 @ to-list over MalUserFn/formal-args !
	234	arg0 cell+ @ over MalUserFn/body ! ;;
	235
	236	defspecial macroexpand ( env list[_,form] -- form )
	237	MalList/start @ cell+ @ swap over ( form env form )
	238	MalList/start @ @ ( form env macro-name-expr )
	239	eval { macro-fn } ( form )
	240	dup MalList/start @ cell+ swap MalList/count @ 1- macro-fn ( argv argc fn )
	241	new-user-fn-env ( env )
	242	macro-fn MalUserFn/body @ TCO-eval ;;
	243
	244	5555555555 constant pre-try
	245
	246	defspecial try* { env list -- val }
	247	list MalList/start @ cell+ { arg0 }
	248	pre-try
	249	env arg0 @ ['] eval catch ?dup 0= if
	250	nip
	251	else { errno }
	252	begin pre-try = until
	253	errno 1 <> if
	254	s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc
	255	to exception-object
	256	endif
257	arg0 cell+ @ ( list[catch*,sym,form] )
258	MalList/start @ cell+ { catch0 }
259	env MalEnv. { catch-env }
260	catch0 @ exception-object catch-env env/set
261	catch-env catch0 cell+ @ TCO-eval
262	endif ;;
263
e46223c2 C	264	defspecial . { env coll -- rtn-list }
	265	depth { old-depth }
	266	coll to-list dup MalList/count @ swap MalList/start @ { count start }
	267	count cells start + start cell+ +do
	268	env i @ eval as-native
	269	cell +loop ;;
	270
6512bd80 C	271	MalSymbol
6512bd80 C	272	extend mal-eval { env sym -- val }
3a17cb96	273	sym env env/get-addr
6512bd80 C	274	dup 0= if
6512bd80 C	275	drop
a631063f	276	0 0 s" ' not found" sym pr-str s" '" ...throw-str
3a17cb96 C	277	else
3a17cb96 C	278	@
6512bd80 C	279	endif ;;
	280	drop
	281
	282	: eval-ast { env list -- list }
	283	here
	284	list MalList/start @ { expr-start }
	285	list MalList/count @ 0 ?do
	286	env expr-start i cells + @ eval ,
	287	loop
	288	here>MalList ;
	289
	290	MalList
	291	extend mal-eval { env list -- val }
4e258d3a DM	292	list MalList/count @ 0= if
	293	list
	294	else
	295	env list MalList/start @ @ eval
	296	env list rot eval-invoke
	297	endif ;;
6512bd80 C	298	drop
	299
	300	MalVector
	301	extend mal-eval ( env vector -- vector )
	302	MalVector/list @ eval-ast
	303	MalVector new swap over MalVector/list ! ;;
	304	drop
	305
	306	MalMap
	307	extend mal-eval ( env map -- map )
	308	MalMap/list @ eval-ast
	309	MalMap new swap over MalMap/list ! ;;
	310	drop
	311
	312	defcore eval ( argv argc )
	313	drop @ repl-env swap eval ;;
	314
45c1894b	315	: rep ( str-addr str-len -- str-addr str-len )
6512bd80 C	316	read
	317	repl-env swap eval
	318	print ;
	319
	320	: mk-args-list ( -- )
	321	here
	322	begin
	323	next-arg 2dup 0 0 d<> while
	324	MalString. ,
	325	repeat
	326	2drop here>MalList ;
	327
	328	create buff 128 allot
	329	77777777777 constant stack-leak-detect
	330
	331	: nop ;
	332
7148ddb6 DM	333	defcore swap! { argv argc -- val }
	334	\ argv is (atom fn args...)
	335	argv @ { atom }
	336	argv cell+ @ { fn }
	337	argc 1- { call-argc }
	338	call-argc cells allocate throw { call-argv }
	339	atom Atom/val call-argv 1 cells cmove
	340	argv cell+ cell+ call-argv cell+ call-argc 1- cells cmove
	341	call-argv call-argc fn invoke
	342	dup TCO-eval = if drop eval endif { new-val }
	343	new-val atom Atom/val !
	344	new-val ;;
	345
6512bd80 C	346	defcore map ( argv argc -- list )
	347	drop dup @ swap cell+ @ to-list { fn list }
	348	here
	349	list MalList/start @ list MalList/count @ cells over + swap +do
	350	i 1 fn invoke
	351	dup TCO-eval = if drop eval endif
	352	,
	353	cell +loop
	354	here>MalList ;;
	355
	356	defcore readline ( argv argc -- mal-string )
	357	drop @ unpack-str type stdout flush-file drop
	358	buff 128 stdin read-line throw
	359	if buff swap MalString. else drop mal-nil endif ;;
	360
45c1894b C	361	s\" (def! host-language \"forth\")" rep 2drop
	362	s\" (def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))" rep 2drop
	363	s\" (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" rep 2drop
166da203 DM	364	s\" (def! gensym-counter (atom 0))" rep 2drop
	365	s\" (def! gensym (fn* [] (symbol (str \"G__\" (swap! gensym-counter (fn* [x] (+ 1 x)))))))" rep 2drop
	366	s\" (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))" rep 2drop
6512bd80 C	367
6512bd80 C	368	: repl ( -- )
45c1894b	369	s\" (println (str \"Mal [\" host-language \"]\"))" rep 2drop
6512bd80 C	370	begin
	371	." user> "
	372	stack-leak-detect
	373	buff 128 stdin read-line throw
	374	while ( num-bytes-read )
	375	buff swap ( str-addr str-len )
	376	['] rep
	377	\ execute ['] nop \ uncomment to see stack traces
	378	catch ?dup 0= if
	379	safe-type cr
	380	stack-leak-detect <> if ." --stack leak--" cr endif
	381	else { errno }
	382	begin stack-leak-detect = until
	383	errno 1 <> if
	384	s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc
	385	to exception-object
	386	endif
45c1894b	387	." Uncaught exception: "
6512bd80 C	388	exception-object pr-str safe-type cr
	389	endif
	390	repeat ;
	391
	392	: main ( -- )
	393	mk-args-list { args-list }
	394	args-list MalList/count @ 0= if
	395	s" ARGV" MalSymbol. MalList/Empty repl-env env/set
	396	repl
	397	else
	398	args-list MalList/start @ @ { filename }
	399	s" ARGV" MalSymbol. args-list MalList/rest repl-env env/set
	400
	401	repl-env
	402	here s" load-file" MalSymbol. , filename , here>MalList
	403	eval print
	404	endif ;
	405
	406	main
	407	cr
	408	bye