From 241500c91c48a0ee7ab4576417ddc94750f78d91 Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Mon, 10 Jan 2022 00:05:17 +0100 Subject: [PATCH] Fix wren, improve logo implementation logo: merge eval and eval-ast, fix defmacro, improve efficiency Complete the merge of eval and eval-ast. Prevent defmacro! from mutating functions. Improve the performance: * use native iteration in env_get and env_map * rewrite the reader so that it does not create lots of substsrings of its input * reduce the cost of most list operations The previous implementation was using lots of temporary list constructions (for example, reverse iteration with butlast requires O(n^2) nodes). This commit does not require Dockerfile to change the garbage collection settings anymore. Encapsulate all representation in types.lg and env.lg. Replace some manual iterations with logo control structures. Reduce the diff between steps. --- IMPLS.yml | 2 + impls/logo/core.lg | 392 +++++++++++++-------------------- impls/logo/env.lg | 51 +---- impls/logo/printer.lg | 60 +++-- impls/logo/reader.lg | 275 ++++++++--------------- impls/logo/readline.lg | 6 +- impls/logo/step0_repl.lg | 21 +- impls/logo/step1_read_print.lg | 29 ++- impls/logo/step2_eval.lg | 85 +++---- impls/logo/step3_env.lg | 114 +++++----- impls/logo/step4_if_fn_do.lg | 166 +++++++------- impls/logo/step5_tco.lg | 136 ++++++------ impls/logo/step6_file.lg | 140 ++++++------ impls/logo/step7_quote.lg | 195 ++++++++-------- impls/logo/step8_macros.lg | 233 +++++++++----------- impls/logo/step9_try.lg | 256 ++++++++++----------- impls/logo/stepA_mal.lg | 241 ++++++++++---------- impls/logo/tests/stepA_mal.mal | 2 +- impls/logo/types.lg | 236 +++++++++++--------- impls/wren/step2_eval.wren | 9 +- impls/wren/step3_env.wren | 9 +- impls/wren/step4_if_fn_do.wren | 13 +- impls/wren/step5_tco.wren | 9 +- impls/wren/step6_file.wren | 9 +- impls/wren/step7_quote.wren | 9 +- impls/wren/step8_macros.wren | 16 +- impls/wren/step9_try.wren | 16 +- impls/wren/stepA_mal.wren | 16 +- 28 files changed, 1297 insertions(+), 1449 deletions(-) diff --git a/IMPLS.yml b/IMPLS.yml index 4876b005a7..11d8b48989 100644 --- a/IMPLS.yml +++ b/IMPLS.yml @@ -1,2 +1,4 @@ IMPL: +# - {IMPL: logo, NO_SELF_HOST: 1} # step4 timeout + - {IMPL: logo} - {IMPL: wren} diff --git a/impls/logo/core.lg b/impls/logo/core.lg index 52bd0fbb28..25c1e48854 100644 --- a/impls/logo/core.lg +++ b/impls/logo/core.lg @@ -1,14 +1,28 @@ -load "../logo/types.lg -load "../logo/reader.lg -load "../logo/printer.lg - make "global_exception [] -to bool_to_mal :bool -output ifelse :bool [true_new] [false_new] +to equal_q :a :b +case obj_type :a [ + [[list vector] + if not memberp obj_type :b [list vector] [output "false] + make "a seq_val :a + make "b seq_val :b + if notequalp count :a count :b [output "false] + (foreach :a :b [if not equal_q ?1 ?2 [output "false]]) + output "true + ] + [[map] + if "map <> obj_type :b [output "false] + localmake "ka map_keys :a + localmake "kb map_keys :b + if notequalp count :ka count :kb [output "false] + (foreach :ka map_vals :a [if not equal_q map_get :b ?1 ?2 [output "false]]) + output "true + ] + [else output :a = :b] +] end -to mal_equal_q :a :b +to |mal_=| :a :b output bool_to_mal equal_q :a :b end @@ -17,270 +31,232 @@ make "global_exception :a (throw "error "_mal_exception_) end -to mal_nil_q :a +to mal_nil? :a output bool_to_mal ((obj_type :a) = "nil) end -to mal_true_q :a +to mal_true? :a output bool_to_mal ((obj_type :a) = "true) end -to mal_false_q :a +to mal_false? :a output bool_to_mal ((obj_type :a) = "false) end -to mal_string_q :a +to mal_string? :a output bool_to_mal ((obj_type :a) = "string) end to mal_symbol :a -output symbol_new obj_val :a +output symbol_new string_val :a end -to mal_symbol_q :a +to mal_symbol? :a output bool_to_mal ((obj_type :a) = "symbol) end to mal_keyword :a -output obj_new "keyword obj_val :a +output ifelse "keyword = obj_type :a ":a [keyword_new string_val :a] end -to mal_keyword_q :a +to mal_keyword? :a output bool_to_mal ((obj_type :a) = "keyword) end -to mal_number_q :a +to mal_number? :a output bool_to_mal ((obj_type :a) = "number) end -to mal_fn_q :a -case obj_type :a [ - [[nativefn] output true_new ] - [[fn] output bool_to_mal not fn_is_macro :a] - [else output false_new ] -] +to mal_fn? :a +output bool_to_mal memberp obj_type :a [fn nativefn] end -to mal_macro_q :a -if ((obj_type :a) = "fn) [ output bool_to_mal fn_is_macro :a ] -output false_new +to mal_macro? :a +output bool_to_mal "macro = obj_type :a end -to mal_pr_str [:args] -output obj_new "string pr_seq :args "true " " :space_char +to |mal_pr-str| [:args] +output string_new pr_seq :args "true "| | end to mal_str [:args] -output obj_new "string pr_seq :args "false " " " +output string_new pr_seq :args "false " end to mal_prn [:args] -print pr_seq :args "true " " :space_char +print pr_seq :args "true "| | output nil_new end to mal_println [:args] -print pr_seq :args "false " " :space_char +print pr_seq :args "false "| | output nil_new end -to mal_read_string :str -output read_str obj_val :str +to |mal_read-string| :str +output read_str string_val :str end to mal_readline :prompt -localmake "line readline obj_val :prompt +localmake "line readline string_val :prompt if :line=[] [output nil_new] -output obj_new "string :line +output string_new :line end to mal_slurp :str -openread obj_val :str -setread obj_val :str +localmake "filename string_val :str +openread :filename +setread :filename localmake "content " -while [not eofp] [ +until [eofp] [ make "content word :content readchar ] -close obj_val :str -output obj_new "string :content +close :filename +output string_new :content end -to mal_lt :a :b -output bool_to_mal ((obj_val :a) < (obj_val :b)) +to |mal_<| :a :b +output bool_to_mal lessp number_val :a number_val :b end -to mal_lte :a :b -output bool_to_mal ((obj_val :a) <= (obj_val :b)) +to |mal_<=| :a :b +output bool_to_mal lessequalp number_val :a number_val :b end -to mal_gt :a :b -output bool_to_mal ((obj_val :a) > (obj_val :b)) +to |mal_>| :a :b +output bool_to_mal greaterp number_val :a number_val :b end -to mal_gte :a :b -output bool_to_mal ((obj_val :a) >= (obj_val :b)) +to |mal_>=| :a :b +output bool_to_mal greaterequalp number_val :a number_val :b end -to mal_add :a :b -output obj_new "number ((obj_val :a) + (obj_val :b)) +to |mal_+| :a :b +output number_new sum number_val :a number_val :b end -to mal_sub :a :b -output obj_new "number ((obj_val :a) - (obj_val :b)) +to |mal_-| :a :b +output number_new difference number_val :a number_val :b end -to mal_mul :a :b -output obj_new "number ((obj_val :a) * (obj_val :b)) +to |mal_*| :a :b +output number_new product number_val :a number_val :b end -to mal_div :a :b -output obj_new "number ((obj_val :a) / (obj_val :b)) +to |mal_/| :a :b +output number_new quotient number_val :a number_val :b end -to mal_time_ms +to |mal_time-ms| ; Native function timems is added to coms.c (see Dockerfile) -output obj_new "number timems +output number_new timems end to mal_list [:args] -output obj_new "list :args +output list_new :args end -to mal_list_q :a +to mal_list? :a output bool_to_mal ((obj_type :a) = "list) end to mal_vector [:args] -output obj_new "vector :args +output vector_new :args end -to mal_vector_q :a +to mal_vector? :a output bool_to_mal ((obj_type :a) = "vector) end -to mal_hash_map [:args] -localmake "h [] -localmake "i 1 -while [:i < count :args] [ - make "h hashmap_put :h item :i :args item (:i + 1) :args - make "i (:i + 2) -] -output obj_new "hashmap :h +to |mal_hash-map| [:pairs] +output map_assoc :map_empty :pairs end -to mal_map_q :a -output bool_to_mal ((obj_type :a) = "hashmap) +to mal_map? :a +output bool_to_mal "map = obj_type :a end to mal_assoc :map [:args] -localmake "h obj_val :map -localmake "i 1 -while [:i < count :args] [ - make "h hashmap_put :h item :i :args item (:i + 1) :args - make "i (:i + 2) -] -output obj_new "hashmap :h -end - -to mal_dissoc :map [:args] -localmake "h obj_val :map -foreach :args [make "h hashmap_delete :h ?] -output obj_new "hashmap :h +output map_assoc :map :args end to mal_get :map :key -localmake "val hashmap_get obj_val :map :key -if emptyp :val [output nil_new] +if "nil = obj_type :map [output nil_new] +localmake "val map_get :map :key +if "notfound = obj_type :val [output nil_new] output :val end -to mal_contains_q :map :key -localmake "val hashmap_get obj_val :map :key -output bool_to_mal not emptyp :val +to mal_contains? :m :k +output bool_to_mal "notfound <> obj_type map_get :m :k end to mal_keys :map -localmake "h obj_val :map -localmake "keys [] -localmake "i 1 -while [:i <= count :h] [ - make "keys lput item :i :h :keys - make "i (:i + 2) -] -output obj_new "list :keys +output list_new map_keys :map end to mal_vals :map -localmake "h obj_val :map -localmake "values [] -localmake "i 2 -while [:i <= count :h] [ - make "values lput item :i :h :values - make "i (:i + 2) -] -output obj_new "list :values +output list_new map_vals :map end -to mal_sequential_q :a -output bool_to_mal sequentialp :a +to mal_sequential? :a +output bool_to_mal memberp obj_type :a [list vector] end to mal_cons :a :b -output obj_new "list fput :a obj_val :b +output list_new fput :a seq_val :b end to mal_concat [:args] -output obj_new "list apply "sentence map [obj_val ?] :args +output list_new map.se "seq_val :args end to mal_vec :s -output obj_new "vector obj_val :s +output vector_new seq_val :s end to mal_nth :a :i -if (obj_val :i) >= _count :a [(throw "error [nth: index out of range])] -output nth :a obj_val :i +make "a seq_val :a +make "i number_val :i +if or (:i < 0) (:i >= count :a) [(throw "error [nth: index out of range])] +output item (:i + 1) :a end to mal_first :a -output cond [ - [[(obj_type :a) = "nil] nil_new] - [[(_count :a) = 0] nil_new] - [else first obj_val :a] -] +if "nil = obj_type :a [output nil_new] +make "a seq_val :a +output ifelse emptyp :a "nil_new [first :a] end to mal_rest :a -output obj_new "list cond [ - [[(obj_type :a) = "nil] []] - [[(_count :a) = 0] []] - [else butfirst obj_val :a] -] +if "nil = obj_type :a [output list_new []] +make "a seq_val :a +output list_new ifelse emptyp :a [[]] [butfirst :a] end -to mal_empty_q :a -output bool_to_mal (emptyp obj_val :a) +to mal_empty? :a +output bool_to_mal emptyp seq_val :a end to mal_count :a -output obj_new "number _count :a +output number_new ifelse "nil = obj_type :a 0 [count seq_val :a] end to mal_apply :f [:args] -localmake "callargs obj_new "list sentence butlast :args obj_val last :args +localmake "callargs map.se [ifelse emptyp ?rest [seq_val ?] [(list ?)]] :args output invoke_fn :f :callargs end to mal_map :f :seq -output obj_new "list map [invoke_fn :f obj_new "list (list ?)] obj_val :seq +output list_new map [invoke_fn :f (list ?)] seq_val :seq end to mal_conj :a0 [:rest] case obj_type :a0 [ - [[list] localmake "newlist :a0 - foreach :rest [make "newlist mal_cons ? :newlist] - output :newlist ] - [[vector] output obj_new "vector sentence obj_val :a0 :rest ] + [[list] localmake "newlist seq_val :a0 + foreach :rest [make "newlist fput ? :newlist] + output list_new :newlist] + [[vector] output vector_new sentence seq_val :a0 :rest] [else (throw "error [conj requires list or vector]) ] ] end @@ -288,151 +264,79 @@ end to mal_seq :a case obj_type :a [ [[string] - if (_count :a) = 0 [output nil_new] + make "a string_val :a + if emptyp :a [output nil_new] localmake "chars [] - foreach obj_val :a [ make "chars lput obj_new "string ? :chars ] - output obj_new "list :chars ] + for [i [count :a] 1 -1] [ make "chars fput string_new item :i :a :chars ] + output list_new :chars ] [[list] - if (_count :a) = 0 [output nil_new] + if emptyp seq_val :a [output nil_new] output :a ] [[vector] - if (_count :a) = 0 [output nil_new] - output obj_new "list obj_val :a ] + make "a seq_val :a + if emptyp :a [output nil_new] + output list_new :a ] [[nil] output nil_new ] [else (throw "error [seq requires string or list or vector or nil]) ] ] end -to mal_meta :a -localmake "m obj_meta :a -if emptyp :m [output nil_new] -output :m -end - -to mal_with_meta :a :new_meta -localmake "m ifelse (obj_type :new_meta) = "nil [[]] [:new_meta] -output obj_new_with_meta obj_type :a obj_val :a :m -end - -to mal_atom :a -output obj_new "atom :a -end - -to mal_atom_q :a +to mal_atom? :a output bool_to_mal ((obj_type :a) = "atom) end -to mal_deref :a -output obj_val :a -end - -to mal_reset_bang :a :val -.setfirst butfirst :a :val -output :val -end - to invoke_fn :f :callargs output case obj_type :f [ [[nativefn] - apply obj_val :f obj_val :callargs ] + nativefn_apply :f :callargs ] [[fn] - _eval fn_body :f env_new fn_env :f fn_args :f :callargs ] + fn_apply :f :callargs ] + [[macro] + macro_apply :f :callargs ] [else (throw "error [Wrong type for apply])] ] end -to mal_swap_bang :atom :f [:args] -localmake "callargs obj_new "list fput mal_deref :atom :args -output mal_reset_bang :atom invoke_fn :f :callargs +to mal_swap! :atom :f [:args] +localmake "callargs fput mal_deref :atom :args +output mal_reset! :atom invoke_fn :f :callargs end to logo_to_mal :a output cond [ - [[:a = "true] true_new] - [[:a = "false] false_new] - [[numberp :a] obj_new "number :a] - [[wordp :a] obj_new "string :a] - [[listp :a] obj_new "list map [logo_to_mal ?] :a] + [[memberp :a [true false]] bool_to_mal :a] + [[numberp :a] number_new :a] + [[wordp :a] string_new :a] + [[listp :a] list_new map "logo_to_mal :a] [else nil_new] ] end -to mal_logo_eval :str -localmake "res runresult obj_val :str +to |mal_logo-eval| :str +localmake "res runresult string_val :str if emptyp :res [output nil_new] output logo_to_mal first :res end make "core_ns [ - [[symbol =] [nativefn mal_equal_q]] - [[symbol throw] [nativefn mal_throw]] - - [[symbol nil?] [nativefn mal_nil_q]] - [[symbol true?] [nativefn mal_true_q]] - [[symbol false?] [nativefn mal_false_q]] - [[symbol string?] [nativefn mal_string_q]] - [[symbol symbol] [nativefn mal_symbol]] - [[symbol symbol?] [nativefn mal_symbol_q]] - [[symbol keyword] [nativefn mal_keyword]] - [[symbol keyword?] [nativefn mal_keyword_q]] - [[symbol number?] [nativefn mal_number_q]] - [[symbol fn?] [nativefn mal_fn_q]] - [[symbol macro?] [nativefn mal_macro_q]] - - [[symbol pr-str] [nativefn mal_pr_str]] - [[symbol str] [nativefn mal_str]] - [[symbol prn] [nativefn mal_prn]] - [[symbol println] [nativefn mal_println]] - [[symbol read-string] [nativefn mal_read_string]] - [[symbol readline] [nativefn mal_readline]] - [[symbol slurp] [nativefn mal_slurp]] - - [[symbol <] [nativefn mal_lt]] - [[symbol <=] [nativefn mal_lte]] - [[symbol >] [nativefn mal_gt]] - [[symbol >=] [nativefn mal_gte]] - [[symbol +] [nativefn mal_add]] - [[symbol -] [nativefn mal_sub]] - [[symbol *] [nativefn mal_mul]] - [[symbol /] [nativefn mal_div]] - [[symbol time-ms] [nativefn mal_time_ms]] - - [[symbol list] [nativefn mal_list]] - [[symbol list?] [nativefn mal_list_q]] - [[symbol vector] [nativefn mal_vector]] - [[symbol vector?] [nativefn mal_vector_q]] - [[symbol hash-map] [nativefn mal_hash_map]] - [[symbol map?] [nativefn mal_map_q]] - [[symbol assoc] [nativefn mal_assoc]] - [[symbol dissoc] [nativefn mal_dissoc]] - [[symbol get] [nativefn mal_get]] - [[symbol contains?] [nativefn mal_contains_q]] - [[symbol keys] [nativefn mal_keys]] - [[symbol vals] [nativefn mal_vals]] - - [[symbol sequential?] [nativefn mal_sequential_q]] - [[symbol cons] [nativefn mal_cons]] - [[symbol concat] [nativefn mal_concat]] - [[symbol vec] [nativefn mal_vec]] - [[symbol nth] [nativefn mal_nth]] - [[symbol first] [nativefn mal_first]] - [[symbol rest] [nativefn mal_rest]] - [[symbol empty?] [nativefn mal_empty_q]] - [[symbol count] [nativefn mal_count]] - [[symbol apply] [nativefn mal_apply]] - [[symbol map] [nativefn mal_map]] - - [[symbol conj] [nativefn mal_conj]] - [[symbol seq] [nativefn mal_seq]] - - [[symbol meta] [nativefn mal_meta]] - [[symbol with-meta] [nativefn mal_with_meta]] - [[symbol atom] [nativefn mal_atom]] - [[symbol atom?] [nativefn mal_atom_q]] - [[symbol deref] [nativefn mal_deref]] - [[symbol reset!] [nativefn mal_reset_bang]] - [[symbol swap!] [nativefn mal_swap_bang]] - - [[symbol logo-eval] [nativefn mal_logo_eval]] + = throw + + nil? true? false? string? symbol symbol? keyword keyword? number? + fn? macro? + + pr-str str prn println read-string readline slurp + + < <= > >= + - * / time-ms + + list list? vector vector? hash-map map? assoc dissoc get contains? + keys vals + + sequential? cons concat vec nth first rest empty? count apply map + + conj seq + + meta with-meta atom atom? deref reset! swap! + + logo-eval mal_logo_eval ] diff --git a/impls/logo/env.lg b/impls/logo/env.lg index b3f5b74e89..d23279fcde 100644 --- a/impls/logo/env.lg +++ b/impls/logo/env.lg @@ -1,51 +1,22 @@ -load "../logo/printer.lg -load "../logo/types.lg - to env_new :outer :binds :exprs -localmake "data [] -if not emptyp :binds [ - localmake "i 0 - while [:i < _count :binds] [ - ifelse (nth :binds :i) = [symbol &] [ - localmake "val drop :exprs :i - make "i (:i + 1) - localmake "key nth :binds :i - ] [ - localmake "val nth :exprs :i - localmake "key nth :binds :i - ] - make "data hashmap_put :data :key :val - make "i (:i + 1) - ] -] -output listtoarray list :outer :data -end - -to env_outer :env -output item 1 :env +output listtoarray (list :outer :binds :exprs) end -to env_data :env +to env_keys :env output item 2 :env end -to env_find :env :key -if emptyp :env [output []] -localmake "val hashmap_get env_data :env :key -ifelse emptyp :val [ - output env_find env_outer :env :key -] [ - output :env -] -end - to env_get :env :key -localmake "foundenv env_find :env :key -if emptyp :foundenv [(throw "error sentence (word "' pr_str :key "true "' ) [not found])] -output hashmap_get env_data :foundenv :key +; Start with the quick memberp built-in, and only iterate slowly in +; LOGO once a match is found. +until [memberp :key item 2 :env] [ + make "env item 1 :env + if emptyp :env [output notfound_new] +] +foreach item 2 :env [if ? = :key [output item # item 3 :env]] end to env_set :env :key :val -.setitem 2 :env hashmap_put env_data :env :key :val -output :val +.setitem 2 :env fput :key item 2 :env +.setitem 3 :env fput :val item 3 :env end diff --git a/impls/logo/printer.lg b/impls/logo/printer.lg index efe1339854..ab310bc3be 100644 --- a/impls/logo/printer.lg +++ b/impls/logo/printer.lg @@ -1,54 +1,44 @@ -load "../logo/types.lg - to pr_str :exp :readable -if emptyp :exp [output []] output case obj_type :exp [ [[nil] "nil] [[true] "true] [[false] "false] - [[number] obj_val :exp] - [[symbol] obj_val :exp] - [[keyword] word ": obj_val :exp] - [[string] print_string :exp :readable] - [[list] pr_seq obj_val :exp :readable "\( "\) :space_char] - [[vector] pr_seq obj_val :exp :readable "\[ "\] :space_char] - [[hashmap] pr_seq obj_val :exp :readable "\{ "\} :space_char] - [[atom] (word "\(atom :space_char pr_str obj_val :exp :readable "\) ) ] - [[nativefn] (word "#) ] - [[fn] (word "#) ] + [[number] number_val :exp] + [[symbol] symbol_value :exp] + [[keyword] word ": keyword_val :exp] + [[string] print_string string_val :exp :readable] + [[list] (word "\( pr_seq seq_val :exp :readable "| | "\) ) ] + [[vector] (word "\[ pr_seq seq_val :exp :readable "| | "\] ) ] + [[map] (word "\{ pr_seq (map.se [list ?1 ?2] map_keys :exp + map_vals :exp) :readable "| | "\} ) ] + [[atom] (word "|(atom | pr_str mal_deref :exp "true "\) ) ] + [[nativefn] "#] + [[fn] "# ] + [[macro] "# ] [else (throw "error (sentence [unknown type] obj_type :exp))] ] end to escape_string :s -localmake "i 1 -localmake "res " -while [:i <= count :s] [ - localmake "c item :i :s - make "res word :res cond [ - [[ :c = "\\ ] "\\\\ ] - [[ :c = char 10 ] "\\n ] - [[ :c = "\" ] "\\\" ] - [else :c ] - ] - make "i (:i + 1) -] -output :res +output map [ + case rawascii ? [ + [[34 92] word "\\ ?] + [[10] "\\n] + [else ?] + ] + ] :s end to print_string :exp :readable ifelse :readable [ - output (word "\" escape_string obj_val :exp "\" ) + output (word "\" escape_string :exp "\" ) ] [ - output obj_val :exp + output :exp ] end -to pr_seq :seq :readable :start_char :end_char :delim_char -localmake "res :start_char -foreach :seq [ - if # > 1 [make "res word :res :delim_char] - make "res word :res pr_str ? :readable -] -output word :res :end_char +to pr_seq :seq :readable :delim_char +output apply "word map [ + ifelse # = 1 [pr_str ? :readable] [word :delim_char pr_str ? :readable] +] :seq end diff --git a/impls/logo/reader.lg b/impls/logo/reader.lg index 049428d0c3..50d1836e92 100644 --- a/impls/logo/reader.lg +++ b/impls/logo/reader.lg @@ -1,221 +1,122 @@ -load "../logo/types.lg +; LOGO, variables defined in a procedure are visible from called +; procedures. Use this quirk to pass the current parser status. +; str: the parsed string (constant) +; cnt: its length (constant) +; idx: the currently parsed index, or cnt + 1 -make "open_paren_char char 40 -make "close_paren_char char 41 -make "open_bracket_char char 91 -make "close_bracket_char char 93 -make "open_brace_char char 123 -make "close_brace_char char 125 +make "new_line_char char 10 +make "forbidden_chars (word :new_line_char char 13 "| "(),;[\\]{}|) +make "separator_chars (word :new_line_char "| ,|) -to newlinep :char -output case ascii :char [ - [[10 13] "true] - [else "false] -] -end - -to whitespacep :char -output case ascii :char [ - [[9 10 13 32] "true] - [else "false] -] -end - -to singlechartokenp :char -output case :char [ - [[ ( ) \[ \] \{ \} ' ` \^ @ ] "true] - [else "false] -] -end - -to separatorp :char -output ifelse whitespacep :char [ - "true -] [ - case :char [ - [[ ( ) \[ \] \{ \} ' \" ` , \; ] "true] - [else "false] - ] -] -end - -to read_comment_token :s -localmake "rest :s -while [not emptyp :rest] [ - localmake "c first :rest - ifelse newlinep :c [ - output list " butfirst :rest - ] [ - make "rest butfirst :rest - ] +to read_allowed_chars +localmake "res " +while [:idx <= :cnt] [ + localmake "c item :idx :str + if memberp :c :forbidden_chars [output :res] + make "idx :idx + 1 + make "res word :res :c ] -output list " :rest +output :res end -to read_word_token :s -localmake "w " -localmake "rest :s -while [not emptyp :rest] [ - localmake "c first :rest - ifelse separatorp :c [ - output list :w :rest - ] [ - make "w word :w :c - make "rest butfirst :rest +to skip_separators +while [:idx <= :cnt] [ + localmake "c item :idx :str + cond [ + [[:c = "|;|] + do.until [ + make "idx :idx + 1 + if :cnt < :idx "stop + ] [:new_line_char = item :idx :str] + ] + [[not memberp :c :separator_chars] stop] ] + make "idx :idx + 1 ] -output list :w :rest end -to read_string_token :s -localmake "w first :s -localmake "rest butfirst :s -while [not emptyp :rest] [ - localmake "c first :rest - if :c = "" [ - make "w word :w :c - output list :w butfirst :rest - ] +to read_string +localmake "res " +while [:idx <= :cnt] [ + localmake "c item :idx :str + make "idx :idx + 1 + if :c = "" [output :res] if :c = "\\ [ - make "w word :w :c - make "rest butfirst :rest - make "c first :rest + if :cnt < :idx [(throw "error [unbalananced ""])] + make "c item :idx :str + make "idx :idx + 1 + if :c = "n [make "c :new_line_char] ] - make "w word :w :c - make "rest butfirst :rest + make "res word :res :c ] -(throw "error [Expected closing quotes, not EOF]) +(throw "error [unbalanced ""]) end -to read_next_token :s -localmake "c first :s -localmake "rest butfirst :s +to read_symbol +localmake "token word :c read_allowed_chars output cond [ - [[whitespacep :c] list " :rest] - [[:c = ",] list " :rest] - [[:c = "~] ifelse ((first :rest) = "@) [list "~@ butfirst :rest] [list "~ :rest] ] - [[singlechartokenp :c] list :c :rest] - [[:c = "\;] read_comment_token :s] - [[:c = ""] read_string_token :s] - [else read_word_token :s] + [[:token = "nil] nil_new] + [[memberp :token [false true]] bool_to_mal :token] + [[numberp :token] number_new :token] + [else symbol_new :token] ] -output list first :s butfirst :s end -to tokenize :str -localmake "tokens [] -localmake "s :str -while [not emptyp :s] [ - localmake "res read_next_token :s - localmake "token first :res - make "s last :res - if not emptyp :token [ - make "tokens lput :token :tokens +to read_seq :end_char +localmake "res [] +forever [ + skip_separators + if :cnt < :idx [(throw "error (sentence "EOF, "expected :end_char))] + if :end_char = item :idx :str [ + make "idx :idx + 1 + ; reversing once is more efficient than successive lputs. + output reverse :res ] + make "res fput read_form :res ] -output :tokens -end - -to reader_new :tokens -output listtoarray list :tokens 1 -end - -to reader_peek :reader -localmake "tokens item 1 :reader -localmake "pos item 2 :reader -if :pos > count :tokens [output []] -output item :pos :tokens end -to reader_next :reader -make "token reader_peek :reader -localmake "pos item 2 :reader -setitem 2 :reader (1 + :pos) -output :token +to reader_macro :symbol_name +output list_new list symbol_new :symbol_name read_form end -to unescape_string :token -localmake "s butfirst butlast :token ; remove surrounding double-quotes -localmake "i 1 -localmake "res " -while [:i <= count :s] [ - localmake "c item :i :s - ifelse :c = "\\ [ - make "i (:i + 1) - make "c item :i :s - make "res word :res case :c [ - [[ n ] char 10] - [[ " ] "\" ] - [[ \\ ] "\\ ] - [else :c] - ] - ] [ - make "res word :res :c - ] - make "i (:i + 1) -] -output :res +to with_meta_reader_macro +localmake "meta read_form +output list_new (list symbol_new "with-meta read_form :meta) end -to read_atom :reader -localmake "token reader_next :reader -output cond [ - [[:token = "nil] nil_new] - [[:token = "true] true_new] - [[:token = "false] false_new] - [[numberp :token] obj_new "number :token] - [[(first :token) = ": ] obj_new "keyword butfirst :token] - [[(first :token) = "\" ] obj_new "string unescape_string :token] - [else symbol_new :token] -] -end - -to read_seq :reader :value_type :start_char :end_char -localmake "token reader_next :reader -if :token <> :start_char [(throw "error sentence "expected (word "' :start_char "'))] -localmake "seq [] -make "token reader_peek :reader -while [:token <> :end_char] [ - if emptyp :token [(throw "error (sentence [expected] (word "' :end_char "',) [got EOF]))] - make "seq lput read_form :reader :seq - make "token reader_peek :reader +to read_unquote +ifelse andthen [:idx <= :cnt] ["@ = item :idx :str] [ + make "idx :idx + 1 + output reader_macro "splice-unquote +] [ + output reader_macro "unquote ] -ignore reader_next :reader -output obj_new :value_type :seq -end - -to reader_macro :reader :symbol_name -ignore reader_next :reader -output obj_new "list list symbol_new :symbol_name read_form :reader -end - -to with_meta_reader_macro :reader -ignore reader_next :reader -localmake "meta read_form :reader -output obj_new "list (list symbol_new "with-meta read_form :reader :meta) end -to read_form :reader -output case reader_peek :reader [ - [[ ' ] reader_macro :reader "quote ] - [[ ` ] reader_macro :reader "quasiquote ] - [[ ~ ] reader_macro :reader "unquote ] - [[ ~@ ] reader_macro :reader "splice-unquote ] - [[ \^ ] with_meta_reader_macro :reader ] - [[ @ ] reader_macro :reader "deref ] - [[ ( ] read_seq :reader "list :open_paren_char :close_paren_char ] - [[ ) ] (throw "error sentence [unexpected] (word "' :close_paren_char "')) ] - [[ \[ ] read_seq :reader "vector :open_bracket_char :close_bracket_char ] - [[ \] ] (throw "error sentence [unexpected] (word "' :close_bracket_char "')) ] - [[ \{ ] read_seq :reader "hashmap :open_brace_char :close_brace_char ] - [[ \} ] (throw "error sentence [unexpected] (word "' :close_brace_char "')) ] - [else read_atom :reader] +to read_form +skip_separators +if :cnt < :idx [(throw "error [EOF, expected a form])] +localmake "c item :idx :str +make "idx :idx + 1 +output case :c [ + [' reader_macro "quote ] + [` reader_macro "quasiquote ] + [~ read_unquote ] + [^ with_meta_reader_macro ] + [@ reader_macro "deref ] + [|(| list_new read_seq "|)|] + [|[| vector_new read_seq "|]|] + [|{| map_assoc :map_empty read_seq "|}|] + [|)]}| (throw "error (sentence "unexpected "' :c "'))] + [" string_new read_string] + [: keyword_new read_allowed_chars] + [else read_symbol ] ] end to read_str :str -localmake "tokens tokenize :str -if emptyp :tokens [output []] -localmake "reader reader_new :tokens -output read_form :reader +localmake "idx 1 +localmake "cnt count :str +output read_form end diff --git a/impls/logo/readline.lg b/impls/logo/readline.lg index b015ff397f..59e7766c83 100644 --- a/impls/logo/readline.lg +++ b/impls/logo/readline.lg @@ -1,5 +1,4 @@ make "backspace_char char 8 -make "space_char char 32 to readline :prompt type :prompt @@ -10,13 +9,12 @@ forever [ ifelse emptyp :c [ output [] ] [ - localmake "ascii rawascii :c - case :ascii [ + case rawascii :c [ [[4] output []] [[10] type :c output :line] [[127] if not emptyp :line [ - type (word :backspace_char :space_char :backspace_char) + (type :backspace_char "| | :backspace_char) make "line butlast :line ]] [else type :c diff --git a/impls/logo/step0_repl.lg b/impls/logo/step0_repl.lg index f62cd8d675..97b0254d52 100644 --- a/impls/logo/step0_repl.lg +++ b/impls/logo/step0_repl.lg @@ -4,7 +4,7 @@ to _read :str output :str end -to _eval :ast :env +to _eval :ast output :ast end @@ -12,19 +12,18 @@ to _print :exp output :exp end +to rep :str +output _print _eval _read :str +end + to repl -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +do.until [ + localmake "line readline "|user> | if not emptyp :line [ - print _print _eval _read :line [] + print rep :line ] - ] -] +] [:line = []] +(print) end repl diff --git a/impls/logo/step1_read_print.lg b/impls/logo/step1_read_print.lg index c3e5e61008..b7dfcdabd5 100644 --- a/impls/logo/step1_read_print.lg +++ b/impls/logo/step1_read_print.lg @@ -1,12 +1,13 @@ load "../logo/readline.lg load "../logo/reader.lg load "../logo/printer.lg +load "../logo/types.lg to _read :str output read_str :str end -to _eval :ast :env +to _eval :ast output :ast end @@ -15,26 +16,24 @@ output pr_str :exp "true end to rep :str -output _print _eval _read :str [] +output _print _eval _read :str +end + +to print_exception :exception +if not emptyp :exception [ + (print "Error: item 2 :exception) +] end to repl -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +do.until [ + localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] - localmake "exception error - if not emptyp :exception [ - (print "Error: first butfirst :exception) - ] + print_exception error ] - ] -] +] [:line = []] +(print) end repl diff --git a/impls/logo/step2_eval.lg b/impls/logo/step2_eval.lg index de1be205a2..73b1e50dd2 100644 --- a/impls/logo/step2_eval.lg +++ b/impls/logo/step2_eval.lg @@ -7,23 +7,33 @@ to _read :str output read_str :str end -to eval_ast :ast :env -output case (obj_type :ast) [ - [[symbol] localmake "val hashmap_get :env :ast - if emptyp :val [(throw "error sentence (word "' obj_val :ast "' ) [not found])] - :val ] - [[list] obj_new "list map [_eval ? :env] obj_val :ast] - [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] - [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] - [else :ast] -] -end - to _eval :ast :env -if (obj_type :ast) <> "list [output eval_ast :ast :env] -if emptyp obj_val :ast [output :ast] -make "el obj_val eval_ast :ast :env -output apply first :el butfirst :el +; (print "EVAL: _print :ast) + +case obj_type :ast [ + + [[symbol] + localmake "val map_get :env :ast + if "notfound = obj_type :val [ + (throw "error sentence (word "' symbol_value :ast "') [not found]) + ] + output :val + ] + + [[vector] output vector_new map [_eval ? :env] seq_val :ast] + + [[map] output map_map [_eval ? :env] :ast] + + [[list] + make "ast seq_val :ast + if emptyp :ast [output list_new []] + localmake "a0 first :ast + make "ast butfirst :ast + localmake "f _eval :a0 :env + output nativefn_apply :f map [_eval ? :env] :ast ] + + [else output :ast] +] end to _print :exp @@ -35,44 +45,43 @@ output _print _eval _read :str :repl_env end to mal_add :a :b -output obj_new "number ((obj_val :a) + (obj_val :b)) +output number_new ((number_val :a) + (number_val :b)) end to mal_sub :a :b -output obj_new "number ((obj_val :a) - (obj_val :b)) +output number_new ((number_val :a) - (number_val :b)) end to mal_mul :a :b -output obj_new "number ((obj_val :a) * (obj_val :b)) +output number_new ((number_val :a) * (number_val :b)) end to mal_div :a :b -output obj_new "number ((obj_val :a) / (obj_val :b)) +output number_new ((number_val :a) / (number_val :b)) +end + +to print_exception :exception +if not emptyp :exception [ + (print "Error: item 2 :exception) +] end to repl -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +do.until [ + localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] - localmake "exception error - if not emptyp :exception [ - (print "Error: first butfirst :exception) - ] + print_exception error ] - ] -] +] [:line = []] +(print) end -make "repl_env [] -make "repl_env hashmap_put :repl_env symbol_new "+ "mal_add -make "repl_env hashmap_put :repl_env symbol_new "- "mal_sub -make "repl_env hashmap_put :repl_env symbol_new "* "mal_mul -make "repl_env hashmap_put :repl_env symbol_new "/ "mal_div +make "repl_env map_assoc :map_empty (list + symbol_new "+ nativefn_new "mal_add + symbol_new "- nativefn_new "mal_sub + symbol_new "* nativefn_new "mal_mul + symbol_new "/ nativefn_new "mal_div) + repl bye diff --git a/impls/logo/step3_env.lg b/impls/logo/step3_env.lg index 05147038d6..2ddd38471f 100644 --- a/impls/logo/step3_env.lg +++ b/impls/logo/step3_env.lg @@ -8,39 +8,55 @@ to _read :str output read_str :str end -to eval_ast :ast :env -output case (obj_type :ast) [ - [[symbol] env_get :env :ast] - [[list] obj_new "list map [_eval ? :env] obj_val :ast] - [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] - [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] - [else :ast] +to _eval :ast :env +if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ + (print "EVAL: _print :ast "/ map "_print env_keys :env) ] -end -to _eval :ast :env -if (obj_type :ast) <> "list [output eval_ast :ast :env] -if emptyp obj_val :ast [output :ast] -localmake "a0 nth :ast 0 -case list obj_type :a0 obj_val :a0 [ - [[[symbol def!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - output env_set :env :a1 _eval :a2 :env ] - - [[[symbol let*]] - localmake "a1 nth :ast 1 - localmake "letenv env_new :env [] [] - localmake "i 0 - while [:i < _count :a1] [ - ignore env_set :letenv nth :a1 :i _eval nth :a1 (:i + 1) :letenv - make "i (:i + 2) +case obj_type :ast [ + + [[symbol] + localmake "val env_get :env :ast + if "notfound = obj_type :val [ + (throw "error sentence (word "' symbol_value :ast "') [not found]) ] - output _eval nth :ast 2 :letenv ] + output :val + ] + + [[vector] output vector_new map [_eval ? :env] seq_val :ast] + + [[map] output map_map [_eval ? :env] :ast] + + [[list] + make "ast seq_val :ast + if emptyp :ast [output list_new []] + localmake "a0 first :ast + make "ast butfirst :ast + case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ + + [[def!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "val _eval :a2 :env + env_set :env :a1 :val + output :val ] + + [[let*] + localmake "a1 first :ast + localmake "letenv env_new :env [] [] + foreach seq_val first :ast [ + if 1 = modulo # 2 [ + env_set :letenv ? _eval first ?rest :letenv + ] + ] + output _eval item 2 :ast :letenv ] - [else - make "el obj_val eval_ast :ast :env - output apply first :el butfirst :el ] + [else + localmake "f _eval :a0 :env + output nativefn_apply :f map [_eval ? :env] :ast ] + ] + ] + [else output :ast] ] end @@ -53,44 +69,40 @@ output _print _eval _read :str :repl_env end to mal_add :a :b -output obj_new "number ((obj_val :a) + (obj_val :b)) +output number_new ((number_val :a) + (number_val :b)) end to mal_sub :a :b -output obj_new "number ((obj_val :a) - (obj_val :b)) +output number_new ((number_val :a) - (number_val :b)) end to mal_mul :a :b -output obj_new "number ((obj_val :a) * (obj_val :b)) +output number_new ((number_val :a) * (number_val :b)) end to mal_div :a :b -output obj_new "number ((obj_val :a) / (obj_val :b)) +output number_new ((number_val :a) / (number_val :b)) +end + +to print_exception :exception +if not emptyp :exception [ + (print "Error: item 2 :exception) +] end to repl -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +do.until [ + localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] - localmake "exception error - if not emptyp :exception [ - (print "Error: first butfirst :exception) - ] + print_exception error ] - ] -] +] [:line = []] +(print) end -make "repl_env env_new [] [] [] -ignore env_set :repl_env obj_new "symbol "+ "mal_add -ignore env_set :repl_env obj_new "symbol "- "mal_sub -ignore env_set :repl_env obj_new "symbol "* "mal_mul -ignore env_set :repl_env obj_new "symbol "/ "mal_div +make "repl_env env_new [] map "symbol_new [+ - * / ] ~ + map "nativefn_new [mal_add mal_sub mal_mul mal_div] + repl bye diff --git a/impls/logo/step4_if_fn_do.lg b/impls/logo/step4_if_fn_do.lg index fd1293ea3d..03f15a6b29 100644 --- a/impls/logo/step4_if_fn_do.lg +++ b/impls/logo/step4_if_fn_do.lg @@ -9,66 +9,83 @@ to _read :str output read_str :str end -to eval_ast :ast :env -output case (obj_type :ast) [ - [[symbol] env_get :env :ast] - [[list] obj_new "list map [_eval ? :env] obj_val :ast] - [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] - [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] - [else :ast] +to _eval :ast :env +if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ + (print "EVAL: _print :ast "/ map "_print env_keys :env) ] -end -to _eval :ast :env -if (obj_type :ast) <> "list [output eval_ast :ast :env] -if emptyp obj_val :ast [output :ast] -localmake "a0 nth :ast 0 -case list obj_type :a0 obj_val :a0 [ - [[[symbol def!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - output env_set :env :a1 _eval :a2 :env ] - - [[[symbol let*]] - localmake "a1 nth :ast 1 - localmake "letenv env_new :env [] [] - localmake "i 0 - while [:i < _count :a1] [ - ignore env_set :letenv nth :a1 :i _eval nth :a1 (:i + 1) :letenv - make "i (:i + 2) +case obj_type :ast [ + + [[symbol] + localmake "val env_get :env :ast + if "notfound = obj_type :val [ + (throw "error sentence (word "' symbol_value :ast "') [not found]) + ] + output :val + ] + + [[vector] output vector_new map [_eval ? :env] seq_val :ast] + + [[map] output map_map [_eval ? :env] :ast] + + [[list] + make "ast seq_val :ast + if emptyp :ast [output list_new []] + localmake "a0 first :ast + make "ast butfirst :ast + case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ + + [[def!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "val _eval :a2 :env + env_set :env :a1 :val + output :val ] + + [[let*] + localmake "a1 first :ast + localmake "letenv env_new :env [] [] + foreach seq_val first :ast [ + if 1 = modulo # 2 [ + env_set :letenv ? _eval first ?rest :letenv + ] + ] + output _eval item 2 :ast :letenv ] + + [[do] + foreach :ast [ + ifelse emptyp ?rest [output _eval ? :env] [ignore _eval ? :env] + ] ] - output _eval nth :ast 2 :letenv ] - - [[[symbol do]] - output last obj_val eval_ast rest :ast :env ] - - [[[symbol if]] - localmake "a1 nth :ast 1 - localmake "cond _eval :a1 :env - output case obj_type :cond [ - [[nil false] ifelse (_count :ast) > 3 [ - _eval nth :ast 3 :env - ] [ - nil_new - ]] - [else _eval nth :ast 2 :env] - ]] - - [[[symbol fn*]] - output fn_new nth :ast 1 :env nth :ast 2 ] - - [else - localmake "el eval_ast :ast :env - localmake "f nth :el 0 - case obj_type :f [ - [[nativefn] - output apply obj_val :f butfirst obj_val :el ] - [[fn] - localmake "funcenv env_new fn_env :f fn_args :f rest :el - output _eval fn_body :f :funcenv ] - [else - (throw "error [Wrong type for apply])] - ] ] + + [[if] + localmake "a1 first :ast + localmake "cond _eval :a1 :env + case obj_type :cond [ + [[nil false] ifelse 3 = count :ast [ + output _eval item 3 :ast :env + ] [ + output nil_new + ]] + [else output _eval item 2 :ast :env] + ]] + + [[fn*] + output fn_new seq_val first :ast :env item 2 :ast ] + + [else + localmake "f _eval :a0 :env + case obj_type :f [ + [[nativefn] + output nativefn_apply :f map [_eval ? :env] :ast ] + [[fn] + output _eval fn_body :f fn_gen_env :f map [_eval ? :env] :ast ] + [else + (throw "error [Wrong type for apply])] + ] ] + ] + ] + [else output :ast] ] end @@ -77,37 +94,38 @@ output pr_str :exp "true end to re :str -output _eval _read :str :repl_env +ignore _eval _read :str :repl_env end to rep :str -output _print re :str +output _print _eval _read :str :repl_env +end + +to print_exception :exception +if not emptyp :exception [ + (print "Error: item 2 :exception) +] end to repl -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +do.until [ + localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] - localmake "exception error - if not emptyp :exception [ - (print "Error: first butfirst :exception) - ] + print_exception error ] - ] -] +] [:line = []] +(print) end +; core_ns make "repl_env env_new [] [] [] foreach :core_ns [ - ignore env_set :repl_env first ? first butfirst ? + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] + ; core.mal: defined using the language itself -ignore re "|(def! not (fn* (a) (if a false true)))| +re "|(def! not (fn* (a) (if a false true)))| + repl bye diff --git a/impls/logo/step5_tco.lg b/impls/logo/step5_tco.lg index a9171f39a2..443fceac88 100644 --- a/impls/logo/step5_tco.lg +++ b/impls/logo/step5_tco.lg @@ -9,76 +9,87 @@ to _read :str output read_str :str end -to eval_ast :ast :env -output case (obj_type :ast) [ - [[symbol] env_get :env :ast] - [[list] obj_new "list map [_eval ? :env] obj_val :ast] - [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] - [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] - [else :ast] +to _eval :ast :env +forever [ +if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ + (print "EVAL: _print :ast "/ map "_print env_keys :env) ] -end -to _eval :a_ast :a_env -localmake "ast :a_ast -localmake "env :a_env -forever [ - if (obj_type :ast) <> "list [output eval_ast :ast :env] - if emptyp obj_val :ast [output :ast] - localmake "a0 nth :ast 0 - case list obj_type :a0 obj_val :a0 [ - [[[symbol def!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - output env_set :env :a1 _eval :a2 :env ] - - [[[symbol let*]] - localmake "a1 nth :ast 1 +case obj_type :ast [ + + [[symbol] + localmake "val env_get :env :ast + if "notfound = obj_type :val [ + (throw "error sentence (word "' symbol_value :ast "') [not found]) + ] + output :val + ] + + [[vector] output vector_new map [_eval ? :env] seq_val :ast] + + [[map] output map_map [_eval ? :env] :ast] + + [[list] + make "ast seq_val :ast + if emptyp :ast [output list_new []] + localmake "a0 first :ast + make "ast butfirst :ast + case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ + + [[def!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "val _eval :a2 :env + env_set :env :a1 :val + output :val ] + + [[let*] + localmake "a1 first :ast localmake "letenv env_new :env [] [] - localmake "i 0 - while [:i < _count :a1] [ - ignore env_set :letenv nth :a1 :i _eval nth :a1 (:i + 1) :letenv - make "i (:i + 2) + foreach seq_val first :ast [ + if 1 = modulo # 2 [ + env_set :letenv ? _eval first ?rest :letenv + ] ] make "env :letenv - make "ast nth :ast 2 ] ; TCO + make "ast item 2 :ast ] ; TCO - [[[symbol do]] - localmake "i 1 - while [:i < ((_count :ast) - 1)] [ - ignore _eval nth :ast :i :env - make "i (:i + 1) + [[do] + foreach :ast [ ; TCO for last item + ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] ] - make "ast last obj_val :ast ] ; TCO + ] - [[[symbol if]] - localmake "a1 nth :ast 1 + [[if] + localmake "a1 first :ast localmake "cond _eval :a1 :env case obj_type :cond [ - [[nil false] ifelse (_count :ast) > 3 [ - make "ast nth :ast 3 ; TCO + [[nil false] ifelse 3 = count :ast [ + make "ast item 3 :ast ; TCO ] [ output nil_new ]] - [else make "ast nth :ast 2] ; TCO + [else make "ast item 2 :ast] ; TCO ]] - [[[symbol fn*]] - output fn_new nth :ast 1 :env nth :ast 2 ] + [[fn*] + output fn_new seq_val first :ast :env item 2 :ast ] [else - localmake "el eval_ast :ast :env - localmake "f nth :el 0 + localmake "f _eval :a0 :env case obj_type :f [ [[nativefn] - output apply obj_val :f butfirst obj_val :el ] + output nativefn_apply :f map [_eval ? :env] :ast ] [[fn] - make "env env_new fn_env :f fn_args :f rest :el + make "env fn_gen_env :f map [_eval ? :env] :ast make "ast fn_body :f ] ; TCO [else (throw "error [Wrong type for apply])] ] ] + ] ] + [else output :ast] +] ] end @@ -87,37 +98,38 @@ output pr_str :exp "true end to re :str -output _eval _read :str :repl_env +ignore _eval _read :str :repl_env end to rep :str -output _print re :str +output _print _eval _read :str :repl_env +end + +to print_exception :exception +if not emptyp :exception [ + (print "Error: item 2 :exception) +] end to repl -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +do.until [ + localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] - localmake "exception error - if not emptyp :exception [ - (print "Error: first butfirst :exception) - ] + print_exception error ] - ] -] +] [:line = []] +(print) end +; core_ns make "repl_env env_new [] [] [] foreach :core_ns [ - ignore env_set :repl_env first ? first butfirst ? + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] + ; core.mal: defined using the language itself -ignore re "|(def! not (fn* (a) (if a false true)))| +re "|(def! not (fn* (a) (if a false true)))| + repl bye diff --git a/impls/logo/step6_file.lg b/impls/logo/step6_file.lg index ef51812e9a..387aa32c13 100644 --- a/impls/logo/step6_file.lg +++ b/impls/logo/step6_file.lg @@ -9,76 +9,87 @@ to _read :str output read_str :str end -to eval_ast :ast :env -output case (obj_type :ast) [ - [[symbol] env_get :env :ast] - [[list] obj_new "list map [_eval ? :env] obj_val :ast] - [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] - [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] - [else :ast] +to _eval :ast :env +forever [ +if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ + (print "EVAL: _print :ast "/ map "_print env_keys :env) ] -end -to _eval :a_ast :a_env -localmake "ast :a_ast -localmake "env :a_env -forever [ - if (obj_type :ast) <> "list [output eval_ast :ast :env] - if emptyp obj_val :ast [output :ast] - localmake "a0 nth :ast 0 - case list obj_type :a0 obj_val :a0 [ - [[[symbol def!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - output env_set :env :a1 _eval :a2 :env ] - - [[[symbol let*]] - localmake "a1 nth :ast 1 +case obj_type :ast [ + + [[symbol] + localmake "val env_get :env :ast + if "notfound = obj_type :val [ + (throw "error sentence (word "' symbol_value :ast "') [not found]) + ] + output :val + ] + + [[vector] output vector_new map [_eval ? :env] seq_val :ast] + + [[map] output map_map [_eval ? :env] :ast] + + [[list] + make "ast seq_val :ast + if emptyp :ast [output list_new []] + localmake "a0 first :ast + make "ast butfirst :ast + case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ + + [[def!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "val _eval :a2 :env + env_set :env :a1 :val + output :val ] + + [[let*] + localmake "a1 first :ast localmake "letenv env_new :env [] [] - localmake "i 0 - while [:i < _count :a1] [ - ignore env_set :letenv nth :a1 :i _eval nth :a1 (:i + 1) :letenv - make "i (:i + 2) + foreach seq_val first :ast [ + if 1 = modulo # 2 [ + env_set :letenv ? _eval first ?rest :letenv + ] ] make "env :letenv - make "ast nth :ast 2 ] ; TCO + make "ast item 2 :ast ] ; TCO - [[[symbol do]] - localmake "i 1 - while [:i < ((_count :ast) - 1)] [ - ignore _eval nth :ast :i :env - make "i (:i + 1) + [[do] + foreach :ast [ ; TCO for last item + ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] ] - make "ast last obj_val :ast ] ; TCO + ] - [[[symbol if]] - localmake "a1 nth :ast 1 + [[if] + localmake "a1 first :ast localmake "cond _eval :a1 :env case obj_type :cond [ - [[nil false] ifelse (_count :ast) > 3 [ - make "ast nth :ast 3 ; TCO + [[nil false] ifelse 3 = count :ast [ + make "ast item 3 :ast ; TCO ] [ output nil_new ]] - [else make "ast nth :ast 2] ; TCO + [else make "ast item 2 :ast] ; TCO ]] - [[[symbol fn*]] - output fn_new nth :ast 1 :env nth :ast 2 ] + [[fn*] + output fn_new seq_val first :ast :env item 2 :ast ] [else - localmake "el eval_ast :ast :env - localmake "f nth :el 0 + localmake "f _eval :a0 :env case obj_type :f [ [[nativefn] - output apply obj_val :f butfirst obj_val :el ] + output nativefn_apply :f map [_eval ? :env] :ast ] [[fn] - make "env env_new fn_env :f fn_args :f rest :el + make "env fn_gen_env :f map [_eval ? :env] :ast make "ast fn_body :f ] ; TCO [else (throw "error [Wrong type for apply])] ] ] + ] ] + [else output :ast] +] ] end @@ -87,16 +98,16 @@ output pr_str :exp "true end to re :str -output _eval _read :str :repl_env +ignore _eval _read :str :repl_env end to rep :str -output _print re :str +output _print _eval _read :str :repl_env end to print_exception :exception if not emptyp :exception [ - localmake "e first butfirst :exception + localmake "e item 2 :exception ifelse :e = "_mal_exception_ [ (print "Error: pr_str :global_exception "false) ] [ @@ -106,19 +117,14 @@ if not emptyp :exception [ end to repl -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +do.until [ + localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] print_exception error ] - ] -] +] [:line = []] +(print) end to mal_eval :a @@ -127,25 +133,25 @@ end to argv_list localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] -output obj_new "list map [obj_new "string ?] :argv +output list_new map "string_new :argv end make "repl_env env_new [] [] [] foreach :core_ns [ - ignore env_set :repl_env first ? first butfirst ? + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] -ignore env_set :repl_env [symbol eval] [nativefn mal_eval] -ignore env_set :repl_env [symbol *ARGV*] argv_list +env_set :repl_env symbol_new "eval nativefn_new "mal_eval +env_set :repl_env symbol_new "*ARGV* argv_list ; core.mal: defined using the language itself -ignore re "|(def! not (fn* (a) (if a false true)))| -ignore re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| +re "|(def! not (fn* (a) (if a false true)))| +re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| -if not emptyp :command.line [ - catch "error [ignore re (word "\(load-file :space_char "\" first :command.line "\"\) )] +ifelse emptyp :command.line [ + repl +] [ + catch "error [re (word "|(load-file "| first :command.line "|")| )] print_exception error - bye ] -repl bye diff --git a/impls/logo/step7_quote.lg b/impls/logo/step7_quote.lg index ff93a88719..a239cd7387 100644 --- a/impls/logo/step7_quote.lg +++ b/impls/logo/step7_quote.lg @@ -9,108 +9,123 @@ to _read :str output read_str :str end -to starts_with :ast :sym -if (obj_type :ast) <> "list [output "false] -localmake "xs obj_val :ast -if emptyp :xs [output "false] -localmake "a0 first :xs -output and ((obj_type :a0) = "symbol) ((obj_val :a0) = :sym) +to quasiquote :ast +output case obj_type :ast [ + [[list] localmake "xs seq_val ast + ifelse andthen [not emptyp :xs] + [equal_q first :xs symbol_new "unquote] + [item 2 :xs] + [qq_seq :xs] + ] + [[vector] list_new list symbol_new "vec qq_seq seq_val :ast] + [[map symbol] list_new list symbol_new "quote :ast] + [else :ast] +] end -to quasiquote :ast -if memberp obj_type :ast [hashmap symbol] [output (mal_list symbol_new "quote :ast)] -if not sequentialp :ast [output :ast] -if starts_with :ast "unquote [output nth :ast 1] -localmake "result mal_list -foreach reverse obj_val :ast [ - ifelse starts_with ? "splice-unquote [ - make "result (mal_list symbol_new "concat nth ? 1 :result) - ] [ - make "result (mal_list symbol_new "cons quasiquote ? :result) - ] ] -if (obj_type :ast) = "vector [make "result (mal_list symbol_new "vec :result)] +to qq_seq :xs +localmake "result list_new [] +foreach reverse :xs [make "result qq_folder ? :result] output :result end -to eval_ast :ast :env -output case (obj_type :ast) [ - [[symbol] env_get :env :ast] - [[list] obj_new "list map [_eval ? :env] obj_val :ast] - [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] - [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] - [else :ast] +to qq_folder :elt :acc +if "list = obj_type :elt [ + localmake "ys seq_val :elt + if andthen [not emptyp :ys] [equal_q first :ys symbol_new "splice-unquote] [ + output list_new (list symbol_new "concat item 2 :ys :acc) + ] ] +output list_new (list symbol_new "cons quasiquote :elt :acc) end -to _eval :a_ast :a_env -localmake "ast :a_ast -localmake "env :a_env +to _eval :ast :env forever [ - if (obj_type :ast) <> "list [output eval_ast :ast :env] - if emptyp obj_val :ast [output :ast] - localmake "a0 nth :ast 0 - case list obj_type :a0 obj_val :a0 [ - [[[symbol def!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - output env_set :env :a1 _eval :a2 :env ] - - [[[symbol let*]] - localmake "a1 nth :ast 1 +if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ + (print "EVAL: _print :ast "/ map "_print env_keys :env) +] + +case obj_type :ast [ + + [[symbol] + localmake "val env_get :env :ast + if "notfound = obj_type :val [ + (throw "error sentence (word "' symbol_value :ast "') [not found]) + ] + output :val + ] + + [[vector] output vector_new map [_eval ? :env] seq_val :ast] + + [[map] output map_map [_eval ? :env] :ast] + + [[list] + make "ast seq_val :ast + if emptyp :ast [output list_new []] + localmake "a0 first :ast + make "ast butfirst :ast + case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ + + [[def!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "val _eval :a2 :env + env_set :env :a1 :val + output :val ] + + [[let*] + localmake "a1 first :ast localmake "letenv env_new :env [] [] - localmake "i 0 - while [:i < _count :a1] [ - ignore env_set :letenv nth :a1 :i _eval nth :a1 (:i + 1) :letenv - make "i (:i + 2) + foreach seq_val first :ast [ + if 1 = modulo # 2 [ + env_set :letenv ? _eval first ?rest :letenv + ] ] make "env :letenv - make "ast nth :ast 2 ] ; TCO - - [[[symbol quote]] - output nth :ast 1 ] + make "ast item 2 :ast ] ; TCO - [[[symbol quasiquote]] - make "ast quasiquote nth :ast 1 ] ; TCO + [[quote] + output first :ast] - [[[symbol quasiquoteexpand]] - output quasiquote nth :ast 1] + [[quasiquote] + make "ast quasiquote first :ast ] ; TCO - [[[symbol do]] - localmake "i 1 - while [:i < ((_count :ast) - 1)] [ - ignore _eval nth :ast :i :env - make "i (:i + 1) + [[do] + foreach :ast [ ; TCO for last item + ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] ] - make "ast last obj_val :ast ] ; TCO + ] - [[[symbol if]] - localmake "a1 nth :ast 1 + [[if] + localmake "a1 first :ast localmake "cond _eval :a1 :env case obj_type :cond [ - [[nil false] ifelse (_count :ast) > 3 [ - make "ast nth :ast 3 ; TCO + [[nil false] ifelse 3 = count :ast [ + make "ast item 3 :ast ; TCO ] [ output nil_new ]] - [else make "ast nth :ast 2] ; TCO + [else make "ast item 2 :ast] ; TCO ]] - [[[symbol fn*]] - output fn_new nth :ast 1 :env nth :ast 2 ] + [[fn*] + output fn_new seq_val first :ast :env item 2 :ast ] [else - localmake "el eval_ast :ast :env - localmake "f nth :el 0 + localmake "f _eval :a0 :env case obj_type :f [ [[nativefn] - output apply obj_val :f butfirst obj_val :el ] + output nativefn_apply :f map [_eval ? :env] :ast ] [[fn] - make "env env_new fn_env :f fn_args :f rest :el + make "env fn_gen_env :f map [_eval ? :env] :ast make "ast fn_body :f ] ; TCO [else (throw "error [Wrong type for apply])] ] ] + ] ] + [else output :ast] +] ] end @@ -119,16 +134,16 @@ output pr_str :exp "true end to re :str -output _eval _read :str :repl_env +ignore _eval _read :str :repl_env end to rep :str -output _print re :str +output _print _eval _read :str :repl_env end to print_exception :exception if not emptyp :exception [ - localmake "e first butfirst :exception + localmake "e item 2 :exception ifelse :e = "_mal_exception_ [ (print "Error: pr_str :global_exception "false) ] [ @@ -138,22 +153,14 @@ if not emptyp :exception [ end to repl -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +do.until [ + localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] - localmake "exception error - if not emptyp :exception [ - (print "Error: first butfirst :exception) - ] + print_exception error ] - ] -] +] [:line = []] +(print) end to mal_eval :a @@ -162,25 +169,25 @@ end to argv_list localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] -output obj_new "list map [obj_new "string ?] :argv +output list_new map "string_new :argv end make "repl_env env_new [] [] [] foreach :core_ns [ - ignore env_set :repl_env first ? first butfirst ? + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] -ignore env_set :repl_env [symbol eval] [nativefn mal_eval] -ignore env_set :repl_env [symbol *ARGV*] argv_list +env_set :repl_env symbol_new "eval nativefn_new "mal_eval +env_set :repl_env symbol_new "*ARGV* argv_list ; core.mal: defined using the language itself -ignore re "|(def! not (fn* (a) (if a false true)))| -ignore re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| +re "|(def! not (fn* (a) (if a false true)))| +re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| -if not emptyp :command.line [ - catch "error [ignore re (word "\(load-file :space_char "\" first :command.line "\"\) )] +ifelse emptyp :command.line [ + repl +] [ + catch "error [re (word "|(load-file "| first :command.line "|")| )] print_exception error - bye ] -repl bye diff --git a/impls/logo/step8_macros.lg b/impls/logo/step8_macros.lg index 4f760d7aea..4d14b69c2b 100644 --- a/impls/logo/step8_macros.lg +++ b/impls/logo/step8_macros.lg @@ -9,144 +9,132 @@ to _read :str output read_str :str end -to starts_with :ast :sym -if (obj_type :ast) <> "list [output "false] -localmake "xs obj_val :ast -if emptyp :xs [output "false] -localmake "a0 first :xs -output and ((obj_type :a0) = "symbol) ((obj_val :a0) = :sym) -end - to quasiquote :ast -if memberp obj_type :ast [hashmap symbol] [output (mal_list symbol_new "quote :ast)] -if not sequentialp :ast [output :ast] -if starts_with :ast "unquote [output nth :ast 1] -localmake "result mal_list -foreach reverse obj_val :ast [ - ifelse starts_with ? "splice-unquote [ - make "result (mal_list symbol_new "concat nth ? 1 :result) - ] [ - make "result (mal_list symbol_new "cons quasiquote ? :result) - ] ] -if (obj_type :ast) = "vector [make "result (mal_list symbol_new "vec :result)] -output :result -end - -to macrocallp :ast :env -if (obj_type :ast) = "list [ - if (_count :ast) > 0 [ - localmake "a0 nth :ast 0 - if (obj_type :a0) = "symbol [ - if not emptyp env_find :env :a0 [ - localmake "f env_get :env :a0 - if (obj_type :f) = "fn [ - output fn_is_macro :f - ] - ] - ] +output case obj_type :ast [ + [[list] localmake "xs seq_val ast + ifelse andthen [not emptyp :xs] + [equal_q first :xs symbol_new "unquote] + [item 2 :xs] + [qq_seq :xs] ] + [[vector] list_new list symbol_new "vec qq_seq seq_val :ast] + [[map symbol] list_new list symbol_new "quote :ast] + [else :ast] ] -output "false end -to _macroexpand :ast :env -if not macrocallp :ast :env [output :ast] -localmake "a0 nth :ast 0 -localmake "f env_get :env :a0 -output _macroexpand invoke_fn :f rest :ast :env +to qq_seq :xs +localmake "result list_new [] +foreach reverse :xs [make "result qq_folder ? :result] +output :result end -to eval_ast :ast :env -output case (obj_type :ast) [ - [[symbol] env_get :env :ast] - [[list] obj_new "list map [_eval ? :env] obj_val :ast] - [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] - [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] - [else :ast] +to qq_folder :elt :acc +if "list = obj_type :elt [ + localmake "ys seq_val :elt + if andthen [not emptyp :ys] [equal_q first :ys symbol_new "splice-unquote] [ + output list_new (list symbol_new "concat item 2 :ys :acc) + ] ] +output list_new (list symbol_new "cons quasiquote :elt :acc) end -to _eval :a_ast :a_env -localmake "ast :a_ast -localmake "env :a_env +to _eval :ast :env forever [ - if (obj_type :ast) <> "list [output eval_ast :ast :env] - make "ast _macroexpand :ast :env - if (obj_type :ast) <> "list [output eval_ast :ast :env] - if emptyp obj_val :ast [output :ast] - localmake "a0 nth :ast 0 - case list obj_type :a0 obj_val :a0 [ - [[[symbol def!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - output env_set :env :a1 _eval :a2 :env ] - - [[[symbol let*]] - localmake "a1 nth :ast 1 +if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ + (print "EVAL: _print :ast "/ map "_print env_keys :env) +] + +case obj_type :ast [ + + [[symbol] + localmake "val env_get :env :ast + if "notfound = obj_type :val [ + (throw "error sentence (word "' symbol_value :ast "') [not found]) + ] + output :val + ] + + [[vector] output vector_new map [_eval ? :env] seq_val :ast] + + [[map] output map_map [_eval ? :env] :ast] + + [[list] + make "ast seq_val :ast + if emptyp :ast [output list_new []] + localmake "a0 first :ast + make "ast butfirst :ast + case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ + + [[def!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "val _eval :a2 :env + env_set :env :a1 :val + output :val ] + + [[let*] + localmake "a1 first :ast localmake "letenv env_new :env [] [] - localmake "i 0 - while [:i < _count :a1] [ - ignore env_set :letenv nth :a1 :i _eval nth :a1 (:i + 1) :letenv - make "i (:i + 2) + foreach seq_val first :ast [ + if 1 = modulo # 2 [ + env_set :letenv ? _eval first ?rest :letenv + ] ] make "env :letenv - make "ast nth :ast 2 ] ; TCO - - [[[symbol quote]] - output nth :ast 1 ] - - [[[symbol quasiquote]] - make "ast quasiquote nth :ast 1 ] ; TCO + make "ast item 2 :ast ] ; TCO - [[[symbol quasiquoteexpand]] - output quasiquote nth :ast 1] + [[quote] + output first :ast] - [[[symbol defmacro!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - localmake "macro_fn _eval :a2 :env - fn_set_macro :macro_fn - output env_set :env :a1 :macro_fn ] + [[quasiquote] + make "ast quasiquote first :ast ] ; TCO - [[[symbol macroexpand]] - output _macroexpand nth :ast 1 :env ] + [[defmacro!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "macro_fn macro_new _eval :a2 :env + env_set :env :a1 :macro_fn + output :macro_fn ] - [[[symbol do]] - localmake "i 1 - while [:i < ((_count :ast) - 1)] [ - ignore _eval nth :ast :i :env - make "i (:i + 1) + [[do] + foreach :ast [ ; TCO for last item + ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] ] - make "ast last obj_val :ast ] ; TCO + ] - [[[symbol if]] - localmake "a1 nth :ast 1 + [[if] + localmake "a1 first :ast localmake "cond _eval :a1 :env case obj_type :cond [ - [[nil false] ifelse (_count :ast) > 3 [ - make "ast nth :ast 3 ; TCO + [[nil false] ifelse 3 = count :ast [ + make "ast item 3 :ast ; TCO ] [ output nil_new ]] - [else make "ast nth :ast 2] ; TCO + [else make "ast item 2 :ast] ; TCO ]] - [[[symbol fn*]] - output fn_new nth :ast 1 :env nth :ast 2 ] + [[fn*] + output fn_new seq_val first :ast :env item 2 :ast ] [else - localmake "el eval_ast :ast :env - localmake "f nth :el 0 + localmake "f _eval :a0 :env case obj_type :f [ [[nativefn] - output apply obj_val :f butfirst obj_val :el ] + output nativefn_apply :f map [_eval ? :env] :ast ] [[fn] - make "env env_new fn_env :f fn_args :f rest :el + make "env fn_gen_env :f map [_eval ? :env] :ast make "ast fn_body :f ] ; TCO + [[macro] + make "ast macro_apply :f :ast ] ; TCO [else (throw "error [Wrong type for apply])] ] ] + ] ] + [else output :ast] +] ] end @@ -155,16 +143,16 @@ output pr_str :exp "true end to re :str -output _eval _read :str :repl_env +ignore _eval _read :str :repl_env end to rep :str -output _print re :str +output _print _eval _read :str :repl_env end to print_exception :exception if not emptyp :exception [ - localmake "e first butfirst :exception + localmake "e item 2 :exception ifelse :e = "_mal_exception_ [ (print "Error: pr_str :global_exception "false) ] [ @@ -174,19 +162,14 @@ if not emptyp :exception [ end to repl -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +do.until [ + localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] print_exception error ] - ] -] +] [:line = []] +(print) end to mal_eval :a @@ -195,26 +178,26 @@ end to argv_list localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] -output obj_new "list map [obj_new "string ?] :argv +output list_new map "string_new :argv end make "repl_env env_new [] [] [] foreach :core_ns [ - ignore env_set :repl_env first ? first butfirst ? + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] -ignore env_set :repl_env [symbol eval] [nativefn mal_eval] -ignore env_set :repl_env [symbol *ARGV*] argv_list +env_set :repl_env symbol_new "eval nativefn_new "mal_eval +env_set :repl_env symbol_new "*ARGV* argv_list ; core.mal: defined using the language itself -ignore re "|(def! not (fn* (a) (if a false true)))| -ignore re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| -ignore re "|(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)))))))| - -if not emptyp :command.line [ - catch "error [ignore re (word "\(load-file :space_char "\" first :command.line "\"\) )] +re "|(def! not (fn* (a) (if a false true)))| +re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| +re "|(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)))))))| + +ifelse emptyp :command.line [ + repl +] [ + catch "error [re (word "|(load-file "| first :command.line "|")| )] print_exception error - bye ] -repl bye diff --git a/impls/logo/step9_try.lg b/impls/logo/step9_try.lg index de7882edef..354e0a7827 100644 --- a/impls/logo/step9_try.lg +++ b/impls/logo/step9_try.lg @@ -9,163 +9,154 @@ to _read :str output read_str :str end -to starts_with :ast :sym -if (obj_type :ast) <> "list [output "false] -localmake "xs obj_val :ast -if emptyp :xs [output "false] -localmake "a0 first :xs -output and ((obj_type :a0) = "symbol) ((obj_val :a0) = :sym) -end - to quasiquote :ast -if memberp obj_type :ast [hashmap symbol] [output (mal_list symbol_new "quote :ast)] -if not sequentialp :ast [output :ast] -if starts_with :ast "unquote [output nth :ast 1] -localmake "result mal_list -foreach reverse obj_val :ast [ - ifelse starts_with ? "splice-unquote [ - make "result (mal_list symbol_new "concat nth ? 1 :result) - ] [ - make "result (mal_list symbol_new "cons quasiquote ? :result) - ] ] -if (obj_type :ast) = "vector [make "result (mal_list symbol_new "vec :result)] -output :result -end - -to macrocallp :ast :env -if (obj_type :ast) = "list [ - if (_count :ast) > 0 [ - localmake "a0 nth :ast 0 - if (obj_type :a0) = "symbol [ - if not emptyp env_find :env :a0 [ - localmake "f env_get :env :a0 - if (obj_type :f) = "fn [ - output fn_is_macro :f - ] - ] - ] +output case obj_type :ast [ + [[list] localmake "xs seq_val ast + ifelse andthen [not emptyp :xs] + [equal_q first :xs symbol_new "unquote] + [item 2 :xs] + [qq_seq :xs] ] + [[vector] list_new list symbol_new "vec qq_seq seq_val :ast] + [[map symbol] list_new list symbol_new "quote :ast] + [else :ast] ] -output "false end -to _macroexpand :ast :env -if not macrocallp :ast :env [output :ast] -localmake "a0 nth :ast 0 -localmake "f env_get :env :a0 -output _macroexpand invoke_fn :f rest :ast :env +to qq_seq :xs +localmake "result list_new [] +foreach reverse :xs [make "result qq_folder ? :result] +output :result end -to eval_ast :ast :env -output case (obj_type :ast) [ - [[symbol] env_get :env :ast] - [[list] obj_new "list map [_eval ? :env] obj_val :ast] - [[vector] obj_new "vector map [_eval ? :env] obj_val :ast] - [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast] - [else :ast] +to qq_folder :elt :acc +if "list = obj_type :elt [ + localmake "ys seq_val :elt + if andthen [not emptyp :ys] [equal_q first :ys symbol_new "splice-unquote] [ + output list_new (list symbol_new "concat item 2 :ys :acc) + ] ] +output list_new (list symbol_new "cons quasiquote :elt :acc) end -to _eval :a_ast :a_env -localmake "ast :a_ast -localmake "env :a_env +to _eval :ast :env forever [ - if (obj_type :ast) <> "list [output eval_ast :ast :env] - make "ast _macroexpand :ast :env - if (obj_type :ast) <> "list [output eval_ast :ast :env] - if emptyp obj_val :ast [output :ast] - localmake "a0 nth :ast 0 - case list obj_type :a0 obj_val :a0 [ - [[[symbol def!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - output env_set :env :a1 _eval :a2 :env ] - - [[[symbol let*]] - localmake "a1 nth :ast 1 - localmake "letenv env_new :env [] [] - localmake "i 0 - while [:i < _count :a1] [ - ignore env_set :letenv nth :a1 :i _eval nth :a1 (:i + 1) :letenv - make "i (:i + 2) - ] - make "env :letenv - make "ast nth :ast 2 ] ; TCO +if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ + (print "EVAL: _print :ast "/ map "_print env_keys :env) +] - [[[symbol quote]] - output nth :ast 1 ] +case obj_type :ast [ - [[[symbol quasiquote]] - make "ast quasiquote nth :ast 1 ] ; TCO + [[symbol] + localmake "val env_get :env :ast + if "notfound = obj_type :val [ + (throw "error sentence (word "' symbol_value :ast "') [not found]) + ] + output :val + ] - [[[symbol quasiquoteexpand]] - output quasiquote nth :ast 1] + [[vector] output vector_new map [_eval ? :env] seq_val :ast] - [[[symbol defmacro!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - localmake "macro_fn _eval :a2 :env - fn_set_macro :macro_fn - output env_set :env :a1 :macro_fn ] + [[map] output map_map [_eval ? :env] :ast] - [[[symbol macroexpand]] - output _macroexpand nth :ast 1 :env ] + [[list] + make "ast seq_val :ast + if emptyp :ast [output list_new []] + localmake "a0 first :ast + make "ast butfirst :ast + case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ - [[[symbol try*]] - localmake "a1 nth :ast 1 - if (_count :ast) < 3 [ - output _eval :a1 :env + [[def!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "val _eval :a2 :env + env_set :env :a1 :val + output :val ] + + [[let*] + localmake "a1 first :ast + localmake "letenv env_new :env [] [] + foreach seq_val first :ast [ + if 1 = modulo # 2 [ + env_set :letenv ? _eval first ?rest :letenv + ] ] + make "env :letenv + make "ast item 2 :ast ] ; TCO + + [[quote] + output first :ast] + + [[quasiquote] + make "ast quasiquote first :ast ] ; TCO + + [[defmacro!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "macro_fn macro_new _eval :a2 :env + env_set :env :a1 :macro_fn + output :macro_fn ] + + [[try*] + localmake "a1 first :ast + ifelse 1 = count :ast [ + make "ast :a1 ; TCO + ] [ + localmake "result nil_new localmake "result nil_new catch "error [make "result _eval :a1 :env] localmake "exception error ifelse emptyp :exception [ output :result ] [ - localmake "e first butfirst :exception - localmake "exception_obj ifelse :e = "_mal_exception_ [:global_exception] [obj_new "string :e] - localmake "a2 nth :ast 2 + localmake "e item 2 :exception + localmake "exception_obj ifelse :e = "_mal_exception_ ":global_exception [string_new :e] + localmake "a2 seq_val item 2 :ast localmake "catchenv env_new :env [] [] - ignore env_set :catchenv nth :a2 1 :exception_obj - output _eval nth :a2 2 :catchenv + env_set :catchenv item 2 :a2 :exception_obj + make "env :catchenv + make "ast item 3 :a2 ; TCO ] ] + ] - [[[symbol do]] - localmake "i 1 - while [:i < ((_count :ast) - 1)] [ - ignore _eval nth :ast :i :env - make "i (:i + 1) + [[do] + foreach :ast [ ; TCO for last item + ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] ] - make "ast last obj_val :ast ] ; TCO + ] - [[[symbol if]] - localmake "a1 nth :ast 1 + [[if] + localmake "a1 first :ast localmake "cond _eval :a1 :env case obj_type :cond [ - [[nil false] ifelse (_count :ast) > 3 [ - make "ast nth :ast 3 ; TCO + [[nil false] ifelse 3 = count :ast [ + make "ast item 3 :ast ; TCO ] [ output nil_new ]] - [else make "ast nth :ast 2] ; TCO + [else make "ast item 2 :ast] ; TCO ]] - [[[symbol fn*]] - output fn_new nth :ast 1 :env nth :ast 2 ] + [[fn*] + output fn_new seq_val first :ast :env item 2 :ast ] [else - localmake "el eval_ast :ast :env - localmake "f nth :el 0 + localmake "f _eval :a0 :env case obj_type :f [ [[nativefn] - output apply obj_val :f butfirst obj_val :el ] + output nativefn_apply :f map [_eval ? :env] :ast ] [[fn] - make "env env_new fn_env :f fn_args :f rest :el + make "env fn_gen_env :f map [_eval ? :env] :ast make "ast fn_body :f ] ; TCO + [[macro] + make "ast macro_apply :f :ast ] ; TCO [else (throw "error [Wrong type for apply])] ] ] + ] ] + [else output :ast] +] ] end @@ -174,16 +165,16 @@ output pr_str :exp "true end to re :str -output _eval _read :str :repl_env +ignore _eval _read :str :repl_env end to rep :str -output _print re :str +output _print _eval _read :str :repl_env end to print_exception :exception if not emptyp :exception [ - localmake "e first butfirst :exception + localmake "e item 2 :exception ifelse :e = "_mal_exception_ [ (print "Error: pr_str :global_exception "false) ] [ @@ -193,19 +184,14 @@ if not emptyp :exception [ end to repl -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +do.until [ + localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] print_exception error ] - ] -] +] [:line = []] +(print) end to mal_eval :a @@ -214,26 +200,26 @@ end to argv_list localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] -output obj_new "list map [obj_new "string ?] :argv +output list_new map "string_new :argv end make "repl_env env_new [] [] [] foreach :core_ns [ - ignore env_set :repl_env first ? first butfirst ? + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] -ignore env_set :repl_env [symbol eval] [nativefn mal_eval] -ignore env_set :repl_env [symbol *ARGV*] argv_list +env_set :repl_env symbol_new "eval nativefn_new "mal_eval +env_set :repl_env symbol_new "*ARGV* argv_list ; core.mal: defined using the language itself -ignore re "|(def! not (fn* (a) (if a false true)))| -ignore re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| -ignore re "|(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)))))))| - -if not emptyp :command.line [ - catch "error [ignore re (word "\(load-file :space_char "\" first :command.line "\"\) )] +re "|(def! not (fn* (a) (if a false true)))| +re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| +re "|(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)))))))| + +ifelse emptyp :command.line [ + repl +] [ + catch "error [re (word "|(load-file "| first :command.line "|")| )] print_exception error - bye ] -repl bye diff --git a/impls/logo/stepA_mal.lg b/impls/logo/stepA_mal.lg index 09a5305e9e..386b7f4e0f 100644 --- a/impls/logo/stepA_mal.lg +++ b/impls/logo/stepA_mal.lg @@ -9,132 +9,154 @@ to _read :str output read_str :str end -to starts_with :ast :sym -if (obj_type :ast) <> "list [output "false] -localmake "xs obj_val :ast -if emptyp :xs [output "false] -localmake "a0 first :xs -output and ((obj_type :a0) = "symbol) ((obj_val :a0) = :sym) +to quasiquote :ast +output case obj_type :ast [ + [[list] localmake "xs seq_val ast + ifelse andthen [not emptyp :xs] + [equal_q first :xs symbol_new "unquote] + [item 2 :xs] + [qq_seq :xs] + ] + [[vector] list_new list symbol_new "vec qq_seq seq_val :ast] + [[map symbol] list_new list symbol_new "quote :ast] + [else :ast] +] end -to quasiquote :ast -if memberp obj_type :ast [hashmap symbol] [output (mal_list symbol_new "quote :ast)] -if not sequentialp :ast [output :ast] -if starts_with :ast "unquote [output nth :ast 1] -localmake "result mal_list -foreach reverse obj_val :ast [ - ifelse starts_with ? "splice-unquote [ - make "result (mal_list symbol_new "concat nth ? 1 :result) - ] [ - make "result (mal_list symbol_new "cons quasiquote ? :result) - ] ] -if (obj_type :ast) = "vector [make "result (mal_list symbol_new "vec :result)] +to qq_seq :xs +localmake "result list_new [] +foreach reverse :xs [make "result qq_folder ? :result] output :result end -to _eval :a_ast :a_env -localmake "ast :a_ast -localmake "env :a_env +to qq_folder :elt :acc +if "list = obj_type :elt [ + localmake "ys seq_val :elt + if andthen [not emptyp :ys] [equal_q first :ys symbol_new "splice-unquote] [ + output list_new (list symbol_new "concat item 2 :ys :acc) + ] +] +output list_new (list symbol_new "cons quasiquote :elt :acc) +end + +to _eval :ast :env forever [ - ; (print "EVAL: pr_str :ast "true) - case (obj_type :ast) [ - [[symbol] output env_get :env :ast] - [[vector] output obj_new "vector map [_eval ? :env] obj_val :ast] - [[hashmap] output obj_new "hashmap map [_eval ? :env] obj_val :ast] - [[list]] - [else output :ast] +if not memberp obj_type env_get :env symbol_new "DEBUG-EVAL [false nil notfound] [ + (print "EVAL: _print :ast "/ map "_print env_keys :env) +] + +case obj_type :ast [ + + [[symbol] + localmake "val env_get :env :ast + if "notfound = obj_type :val [ + (throw "error sentence (word "' symbol_value :ast "') [not found]) + ] + output :val ] - if emptyp obj_val :ast [output :ast] - localmake "a0 nth :ast 0 - case list obj_type :a0 obj_val :a0 [ - [[[symbol def!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - output env_set :env :a1 _eval :a2 :env ] - - [[[symbol let*]] - localmake "a1 nth :ast 1 - localmake "letenv env_new :env [] [] - localmake "i 0 - while [:i < _count :a1] [ - ignore env_set :letenv nth :a1 :i _eval nth :a1 (:i + 1) :letenv - make "i (:i + 2) - ] - make "env :letenv - make "ast nth :ast 2 ] ; TCO - [[[symbol quote]] - output nth :ast 1 ] + [[vector] output vector_new map [_eval ? :env] seq_val :ast] - [[[symbol quasiquote]] - make "ast quasiquote nth :ast 1 ] ; TCO + [[map] output map_map [_eval ? :env] :ast] - [[[symbol defmacro!]] - localmake "a1 nth :ast 1 - localmake "a2 nth :ast 2 - localmake "macro_fn _eval :a2 :env - fn_set_macro :macro_fn - output env_set :env :a1 :macro_fn ] + [[list] + make "ast seq_val :ast + if emptyp :ast [output list_new []] + localmake "a0 first :ast + make "ast butfirst :ast + case ifelse "symbol = obj_type :a0 [symbol_value :a0] "" [ - [[[symbol try*]] - localmake "a1 nth :ast 1 - if (_count :ast) < 3 [ - output _eval :a1 :env + [[def!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "val _eval :a2 :env + env_set :env :a1 :val + output :val ] + + [[let*] + localmake "a1 first :ast + localmake "letenv env_new :env [] [] + foreach seq_val first :ast [ + if 1 = modulo # 2 [ + env_set :letenv ? _eval first ?rest :letenv + ] ] + make "env :letenv + make "ast item 2 :ast ] ; TCO + + [[quote] + output first :ast] + + [[quasiquote] + make "ast quasiquote first :ast ] ; TCO + + [[defmacro!] + localmake "a1 first :ast + localmake "a2 item 2 :ast + localmake "macro_fn macro_new _eval :a2 :env + env_set :env :a1 :macro_fn + output :macro_fn ] + + [[try*] + localmake "a1 first :ast + ifelse 1 = count :ast [ + make "ast :a1 ; TCO + ] [ + localmake "result nil_new localmake "result nil_new catch "error [make "result _eval :a1 :env] localmake "exception error ifelse emptyp :exception [ output :result ] [ - localmake "e first butfirst :exception - localmake "exception_obj ifelse :e = "_mal_exception_ [:global_exception] [obj_new "string :e] - localmake "a2 nth :ast 2 + localmake "e item 2 :exception + localmake "exception_obj ifelse :e = "_mal_exception_ ":global_exception [string_new :e] + localmake "a2 seq_val item 2 :ast localmake "catchenv env_new :env [] [] - ignore env_set :catchenv nth :a2 1 :exception_obj - output _eval nth :a2 2 :catchenv + env_set :catchenv item 2 :a2 :exception_obj + make "env :catchenv + make "ast item 3 :a2 ; TCO ] ] + ] - [[[symbol do]] - localmake "i 1 - while [:i < ((_count :ast) - 1)] [ - ignore _eval nth :ast :i :env - make "i (:i + 1) + [[do] + foreach :ast [ ; TCO for last item + ifelse emptyp ?rest [make "ast ?] [ignore _eval ? :env] ] - make "ast last obj_val :ast ] ; TCO + ] - [[[symbol if]] - localmake "a1 nth :ast 1 + [[if] + localmake "a1 first :ast localmake "cond _eval :a1 :env case obj_type :cond [ - [[nil false] ifelse (_count :ast) > 3 [ - make "ast nth :ast 3 ; TCO + [[nil false] ifelse 3 = count :ast [ + make "ast item 3 :ast ; TCO ] [ output nil_new ]] - [else make "ast nth :ast 2] ; TCO + [else make "ast item 2 :ast] ; TCO ]] - [[[symbol fn*]] - output fn_new nth :ast 1 :env nth :ast 2 ] + [[fn*] + output fn_new seq_val first :ast :env item 2 :ast ] [else localmake "f _eval :a0 :env - localmake "args rest :ast case obj_type :f [ [[nativefn] - output apply obj_val :f map [_eval ? :env] obj_val :args ] + output nativefn_apply :f map [_eval ? :env] :ast ] [[fn] - ifelse (fn_is_macro :f) [ - make "ast invoke_fn :f :args - ] [ - make "env env_new fn_env :f fn_args :f obj_new "list map [_eval ? :env] obj_val :args - make "ast fn_body :f ] ; TCO - ] + make "env fn_gen_env :f map [_eval ? :env] :ast + make "ast fn_body :f ] ; TCO + [[macro] + make "ast macro_apply :f :ast ] ; TCO [else (throw "error [Wrong type for apply])] ] ] + ] ] + [else output :ast] +] ] end @@ -143,16 +165,16 @@ output pr_str :exp "true end to re :str -output _eval _read :str :repl_env +ignore _eval _read :str :repl_env end to rep :str -output _print re :str +output _print _eval _read :str :repl_env end to print_exception :exception if not emptyp :exception [ - localmake "e first butfirst :exception + localmake "e item 2 :exception ifelse :e = "_mal_exception_ [ (print "Error: pr_str :global_exception "false) ] [ @@ -162,19 +184,14 @@ if not emptyp :exception [ end to repl -localmake "running "true -while [:running] [ - localmake "line readline word "user> :space_char - ifelse :line=[] [ - print " - make "running "false - ] [ +do.until [ + localmake "line readline "|user> | if not emptyp :line [ catch "error [print rep :line] print_exception error ] - ] -] +] [:line = []] +(print) end to mal_eval :a @@ -183,28 +200,28 @@ end to argv_list localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line] -output obj_new "list map [obj_new "string ?] :argv +output list_new map "string_new :argv end make "repl_env env_new [] [] [] foreach :core_ns [ - ignore env_set :repl_env first ? first butfirst ? + env_set :repl_env symbol_new ? nativefn_new word "mal_ ? ] -ignore env_set :repl_env [symbol eval] [nativefn mal_eval] -ignore env_set :repl_env [symbol *ARGV*] argv_list +env_set :repl_env symbol_new "eval nativefn_new "mal_eval +env_set :repl_env symbol_new "*ARGV* argv_list ; core.mal: defined using the language itself -ignore re "|(def! *host-language* "logo")| -ignore re "|(def! not (fn* (a) (if a false true)))| -ignore re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| -ignore re "|(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)))))))| - -if not emptyp :command.line [ - catch "error [ignore re (word "\(load-file :space_char "\" first :command.line "\"\) )] +re "|(def! *host-language* "logo")| +re "|(def! not (fn* (a) (if a false true)))| +re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))| +re "|(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)))))))| + +ifelse emptyp :command.line [ + re "|(println (str "Mal [" *host-language* "]"))| + repl +] [ + catch "error [re (word "|(load-file "| first :command.line "|")| )] print_exception error - bye ] -ignore re "|(println (str "Mal [" *host-language* "]"))| -repl bye diff --git a/impls/logo/tests/stepA_mal.mal b/impls/logo/tests/stepA_mal.mal index 9175626d1f..7e1cdb7a93 100644 --- a/impls/logo/tests/stepA_mal.mal +++ b/impls/logo/tests/stepA_mal.mal @@ -23,7 +23,7 @@ (logo-eval ":foo") ;=>8 -(logo-eval "apply \"word map [reverse ?] [Abc Abcd Abcde]") +(logo-eval "apply \"word map \"reverse [Abc Abcd Abcde]") ;=>"cbAdcbAedcbA" (logo-eval "map [1 + ?] [1 2 3]") diff --git a/impls/logo/types.lg b/impls/logo/types.lg index dd5fcd1a98..75aa0408ab 100644 --- a/impls/logo/types.lg +++ b/impls/logo/types.lg @@ -10,162 +10,200 @@ catch "case.error [output case.helper :case.value :case.clauses] (throw "error [Empty CASE clause]) end -to obj_new :type :val -output list :type :val +to andthen [:andthen.args] 2 +foreach :andthen.args [if not run ? [output "false]] +output "true end -to obj_new_with_meta :type :val :meta -output (list :type :val :meta) -end +; For efficiency of env_get and env_map, ensure that MAL equality +; (equal_q) and LOGO equality (equalp/=) return the same result when +; an argument is neither a list, map, vector or atom. to obj_type :obj -output first :obj +output ifelse wordp :obj ""symbol [item 1 :obj] +end + +to list_new :val +output list "list :val end -to obj_val :obj +to vector_new :val +output list "vector :val +end + +to seq_val :obj output item 2 :obj end -to obj_meta :obj -if (count :obj) < 3 [output []] -output item 3 :obj +to |mal_with-meta| :obj :meta +output (listtoarray fput :meta ifelse listp :obj [ + :obj +] [ + butfirst arraytolist :obj +] 0) end -make "global_nil obj_new "nil [] +to mal_meta :obj +output ifelse listp :obj "nil_new [item 0 :obj] +end + +; Convenient for map_get and env_get. + +make "global_notfound [notfound] + +to notfound_new +output :global_notfound +end + +make "global_nil [nil] to nil_new output :global_nil end -make "global_true obj_new "true [] +make "global_false [false] +make "global_true [true] -to true_new -output :global_true +to bool_to_mal :bool +output ifelse :bool ":global_true ":global_false end -make "global_false obj_new "false [] +to number_new :val +output list "number :val +end -to false_new -output :global_false +to number_val :obj +output item 2 :obj end to symbol_new :name -output obj_new "symbol :name +output :name end -to hashmap_get :h :key -localmake "i 1 -while [:i < count :h] [ - if equal_q item :i :h :key [ - output item (:i + 1) :h - ] - make "i (:i + 2) -] -output [] +to symbol_value :obj +output :obj end -; Returns a new list with the key-val pair set -to hashmap_put :h :key :val -localmake "res hashmap_delete :h :key -make "res lput :key :res -make "res lput :val :res -output :res +to keyword_new :val +output list "keyword :val end -; Returns a new list without the key-val pair set -to hashmap_delete :h :key -localmake "res [] -localmake "i 1 -while [:i < count :h] [ - if (item :i :h) <> :key [ - make "res lput item :i :h :res - make "res lput item (:i + 1) :h :res +to keyword_val :obj +output item 2 :obj +end + +to string_new :val +output list "string :val +end + +to string_val :obj +output item 2 :obj +end + +to nativefn_new :f +output list "nativefn :f +end + +to nativefn_apply :fn :args +output apply item 2 :fn :args +end + +make "map_empty [map [] []] + +to map_get :map :key +foreach item 2 :map [if ? = :key [output item # item 3 :map]] +output notfound_new +end + +; Returns a new list with the key-val pair set +to map_assoc :map :pairs +foreach :pairs [ + if 1 = modulo # 2 [ + if memberp ? item 2 :map [make "map (mal_dissoc :map ?)] + make "map (list "map fput ? item 2 :map fput first ?rest item 3 :map) ] - make "i (:i + 2) ] -output :res +output :map end -to fn_new :args :env :body -output obj_new "fn (list :args :env :body "false) +; Returns a new list without the key-val pair set +to mal_dissoc :map [:removals] +localmake "keys [] +localmake "vals [] +(foreach item 2 :map item 3 :map [ + if not memberp ?1 :removals [ + make "keys fput ?1 :keys + make "vals fput ?2 :vals + ] +]) +output (list "map :keys :vals) end -to fn_args :fn -output item 1 obj_val :fn +to map_keys :map +output item 2 :map end -to fn_env :fn -output item 2 obj_val :fn +to map_vals :map +output item 3 :map end -to fn_body :fn -output item 3 obj_val :fn +to map_map :fn :map +output (list "map item 2 :map map :fn item 3 :map) end -to fn_is_macro :fn -output item 4 obj_val :fn +to fn_new :args :env :body +localmake "i difference count :args 1 +output ifelse andthen [0 < :i] [equalp symbol_new "& item :i :args] [ + (list "fn :env :body :i filter [# <> :i] :args) +] [ + (list "fn :env :body 0 :args) +] end -to fn_set_macro :fn -.setfirst butfirst butfirst butfirst obj_val :fn "true +to fn_gen_env :fn :args +localmake "varargs item 4 :fn +if :varargs = 0 [output env_new item 2 :fn item 5 :fn :args] +if :varargs = 1 [output env_new item 2 :fn item 5 :fn (list list_new :args)] +localmake "new_args array :varargs +foreach :args [ + .setitem # :new_args ? + if :varargs = # + 1 [ + .setitem :varargs :new_args list_new ?rest + output env_new item 2 :fn item 5 :fn :new_args + ] +] +(throw "error [not enough arguments for vararg function]) end -; zero-based sequence addressing -to nth :seq :index -output item (:index + 1) obj_val :seq +to fn_apply :fn :args +output _eval item 3 :fn fn_gen_env :fn :args end -to _count :seq -output count obj_val :seq +to fn_env :fn +output item 2 :fn end -to rest :seq -output obj_new obj_type :seq butfirst obj_val :seq +to fn_body :fn +output item 3 :fn end -to drop :seq :num -if or :num = 0 (_count :seq) = 0 [output :seq] -foreach obj_val :seq [ - if # >= :num [output obj_new obj_type :seq ?rest] -] +to macro_new :fn +output list "macro :fn end -to sequentialp :obj -output memberp obj_type :obj [list vector] +to macro_apply :fn :args +output fn_apply item 2 :fn :args end -to equal_sequential_q :a :b -if (_count :a) <> (_count :b) [output "false] -(foreach obj_val :a obj_val :b [ - if not equal_q ?1 ?2 [output "false] -]) -output "true +to mal_atom :value +output listtoarray list "atom :value end -to equal_hashmap_q :a :b -if (_count :a) <> (_count :b) [output "false] -localmake "a_keys obj_val mal_keys :a -foreach :a_keys [ - localmake "a_val hashmap_get obj_val :a ? - localmake "b_val hashmap_get obj_val :b ? - if emptyp :b_val [output "false] - if not equal_q :a_val :b_val [output "false] -] -output "true +to mal_deref :a +output item 2 :a end -to equal_q :a :b -output cond [ - [[and sequentialp :a sequentialp :b] - equal_sequential_q :a :b] - [[((obj_type :a) = (obj_type :b))] - case obj_type :a [ - [[true false nil] "true] - [[number string keyword symbol] ((obj_val :a) = (obj_val :b))] - [[hashmap] equal_hashmap_q :a :b] - [[atom] equal_q obj_val :a obj_val :b] - [else "false] - ]] - [else "false] -] +to mal_reset! :a :val +.setitem 2 :a :val +output :val end diff --git a/impls/wren/step2_eval.wren b/impls/wren/step2_eval.wren index a027564bfd..5dc298261a 100644 --- a/impls/wren/step2_eval.wren +++ b/impls/wren/step2_eval.wren @@ -8,13 +8,10 @@ class Mal { return MalReader.read_str(str) } - static eval_ast(ast, env) { - return ast.elements.map { |e| eval(e, env) }.toList - } - static eval(ast, env) { // System.print("EVAL: %(print(ast))") - // Proceed non-list types. + + // Process non-list types. if (ast is MalSymbol) { if (!env.containsKey(ast.value)) Fiber.abort("'%(ast.value)' not found") return env[ast.value] @@ -33,7 +30,7 @@ class Mal { } // ast is a list, search for special forms if (ast.isEmpty) return ast - var evaled_ast = eval_ast(ast, env) + var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList var f = evaled_ast[0] return f.call(evaled_ast[1..-1]) } diff --git a/impls/wren/step3_env.wren b/impls/wren/step3_env.wren index 0e2bbd700d..ee5da6bc0a 100644 --- a/impls/wren/step3_env.wren +++ b/impls/wren/step3_env.wren @@ -9,16 +9,13 @@ class Mal { return MalReader.read_str(str) } - static eval_ast(ast, env) { - return ast.elements.map { |e| eval(e, env) }.toList - } - static eval(ast, env) { var dbgenv = env.find("DEBUG-EVAL") if (dbgenv && env.get("DEBUG-EVAL")) { System.print("EVAL: %(print(ast))") } - // Proceed non-list types. + + // Process non-list types. if (ast is MalSymbol) { return env.get(ast.value) } else if (ast is MalList) { @@ -49,7 +46,7 @@ class Mal { return eval(ast[2], letEnv) } } - var evaled_ast = eval_ast(ast, env) + var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList var f = evaled_ast[0] return f.call(evaled_ast[1..-1]) } diff --git a/impls/wren/step4_if_fn_do.wren b/impls/wren/step4_if_fn_do.wren index 33512beec2..42d972336e 100644 --- a/impls/wren/step4_if_fn_do.wren +++ b/impls/wren/step4_if_fn_do.wren @@ -10,16 +10,12 @@ class Mal { return MalReader.read_str(str) } - static eval_ast(ast, env) { - return ast.elements.map { |e| eval(e, env) }.toList - } - static eval(ast, env) { var dbgenv = env.find("DEBUG-EVAL") if (dbgenv && env.get("DEBUG-EVAL")) { System.print("EVAL: %(print(ast))") } - // Proceed non-list types. + // Process non-list types. if (ast is MalSymbol) { return env.get(ast.value) } else if (ast is MalList) { @@ -49,7 +45,10 @@ class Mal { } return eval(ast[2], letEnv) } else if (ast[0].value == "do") { - return eval_ast(ast.rest, env)[-1] + for (i in 1...(ast.count - 1)) { + eval(ast[i], env) + } + return eval(ast[-1], env) } else if (ast[0].value == "if") { var condval = eval(ast[1], env) if (condval) { @@ -61,7 +60,7 @@ class Mal { return Fn.new { |a| eval(ast[2], Env.new(env, ast[1].elements, a)) } } } - var evaled_ast = eval_ast(ast, env) + var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList var f = evaled_ast[0] return f.call(evaled_ast[1..-1]) } diff --git a/impls/wren/step5_tco.wren b/impls/wren/step5_tco.wren index 5dc07574ef..6756d31fee 100644 --- a/impls/wren/step5_tco.wren +++ b/impls/wren/step5_tco.wren @@ -10,10 +10,6 @@ class Mal { return MalReader.read_str(str) } - static eval_ast(ast, env) { - return ast.elements.map { |e| eval(e, env) }.toList - } - static eval(ast, env) { while (true) { @@ -24,6 +20,7 @@ class Mal { System.print("EVAL: %(print(ast))") } + // Process non-list types. if (ast is MalSymbol) { return env.get(ast.value) } else if (ast is MalList) { @@ -39,6 +36,7 @@ class Mal { } else { return ast } + // ast is a list, search for special forms if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { @@ -75,13 +73,14 @@ class Mal { } } if (!tco) { - var evaled_ast = eval_ast(ast, env) + var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList var f = evaled_ast[0] if (f is MalNativeFn) { return f.call(evaled_ast[1..-1]) } else if (f is MalFn) { ast = f.ast env = Env.new(f.env, f.params, evaled_ast[1..-1]) + tco = true } else { Fiber.abort("unknown function type") } diff --git a/impls/wren/step6_file.wren b/impls/wren/step6_file.wren index cc9b45f5a6..3359de3731 100644 --- a/impls/wren/step6_file.wren +++ b/impls/wren/step6_file.wren @@ -11,10 +11,6 @@ class Mal { return MalReader.read_str(str) } - static eval_ast(ast, env) { - return ast.elements.map { |e| eval(e, env) }.toList - } - static eval(ast, env) { while (true) { @@ -25,6 +21,7 @@ class Mal { System.print("EVAL: %(print(ast))") } + // Process non-list types. if (ast is MalSymbol) { return env.get(ast.value) } else if (ast is MalList) { @@ -40,6 +37,7 @@ class Mal { } else { return ast } + // ast is a list, search for special forms if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { @@ -76,13 +74,14 @@ class Mal { } } if (!tco) { - var evaled_ast = eval_ast(ast, env) + var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList var f = evaled_ast[0] if (f is MalNativeFn) { return f.call(evaled_ast[1..-1]) } else if (f is MalFn) { ast = f.ast env = Env.new(f.env, f.params, evaled_ast[1..-1]) + tco = true } else { Fiber.abort("unknown function type") } diff --git a/impls/wren/step7_quote.wren b/impls/wren/step7_quote.wren index 905433a15d..95a3c62394 100644 --- a/impls/wren/step7_quote.wren +++ b/impls/wren/step7_quote.wren @@ -45,10 +45,6 @@ class Mal { } } - static eval_ast(ast, env) { - return ast.elements.map { |e| eval(e, env) }.toList - } - static eval(ast, env) { while (true) { @@ -59,6 +55,7 @@ class Mal { System.print("EVAL: %(print(ast))") } + // Process non-list types. if (ast is MalSymbol) { return env.get(ast.value) } else if (ast is MalList) { @@ -74,6 +71,7 @@ class Mal { } else { return ast } + // ast is a list, search for special forms if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { @@ -115,13 +113,14 @@ class Mal { } } if (!tco) { - var evaled_ast = eval_ast(ast, env) + var evaled_ast = ast.elements.map { |e| eval(e, env) }.toList var f = evaled_ast[0] if (f is MalNativeFn) { return f.call(evaled_ast[1..-1]) } else if (f is MalFn) { ast = f.ast env = Env.new(f.env, f.params, evaled_ast[1..-1]) + tco = true } else { Fiber.abort("unknown function type") } diff --git a/impls/wren/step8_macros.wren b/impls/wren/step8_macros.wren index fd464864ff..5a44a25db4 100644 --- a/impls/wren/step8_macros.wren +++ b/impls/wren/step8_macros.wren @@ -48,13 +48,14 @@ class Mal { static eval(ast, env) { while (true) { - var tco = false + var tco = false - var dbgenv = env.find("DEBUG-EVAL") - if (dbgenv && env.get("DEBUG-EVAL")) { - System.print("EVAL: %(print(ast))") - } + var dbgenv = env.find("DEBUG-EVAL") + if (dbgenv && env.get("DEBUG-EVAL")) { + System.print("EVAL: %(print(ast))") + } + // Process non-list types. if (ast is MalSymbol) { return env.get(ast.value) } else if (ast is MalList) { @@ -70,6 +71,7 @@ class Mal { } else { return ast } + // ast is a list, search for special forms if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { @@ -115,13 +117,13 @@ class Mal { if (!tco) { var f = eval(ast[0], env) if (f is MalNativeFn) { - var args = MalList.new(ast.elements[1..-1].map { |e| eval(e, env) }.toList) + var args = ast.elements[1..-1].map { |e| eval(e, env) }.toList return f.call(args) } else if (f is MalFn) { if (f.isMacro) { ast = f.call(ast.elements[1..-1]) } else { - var args = MalList.new(ast.elements[1..-1].map { |e| eval(e, env) }.toList) + var args = ast.elements[1..-1].map { |e| eval(e, env) }.toList ast = f.ast env = Env.new(f.env, f.params, args) } diff --git a/impls/wren/step9_try.wren b/impls/wren/step9_try.wren index 2fe9d78c69..7997813f9a 100644 --- a/impls/wren/step9_try.wren +++ b/impls/wren/step9_try.wren @@ -48,13 +48,14 @@ class Mal { static eval(ast, env) { while (true) { - var tco = false + var tco = false - var dbgenv = env.find("DEBUG-EVAL") - if (dbgenv && env.get("DEBUG-EVAL")) { - System.print("EVAL: %(print(ast))") - } + var dbgenv = env.find("DEBUG-EVAL") + if (dbgenv && env.get("DEBUG-EVAL")) { + System.print("EVAL: %(print(ast))") + } + // Process non-list types. if (ast is MalSymbol) { return env.get(ast.value) } else if (ast is MalList) { @@ -70,6 +71,7 @@ class Mal { } else { return ast } + // ast is a list, search for special forms if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { @@ -129,13 +131,13 @@ class Mal { if (!tco) { var f = eval(ast[0], env) if (f is MalNativeFn) { - var args = MalList.new(ast.elements[1..-1].map { |e| eval(e, env) }.toList) + var args = ast.elements[1..-1].map { |e| eval(e, env) }.toList return f.call(args) } else if (f is MalFn) { if (f.isMacro) { ast = f.call(ast.elements[1..-1]) } else { - var args = MalList.new(ast.elements[1..-1].map { |e| eval(e, env) }.toList) + var args = ast.elements[1..-1].map { |e| eval(e, env) }.toList ast = f.ast env = Env.new(f.env, f.params, args) } diff --git a/impls/wren/stepA_mal.wren b/impls/wren/stepA_mal.wren index 6fa5317a88..0f4945611f 100644 --- a/impls/wren/stepA_mal.wren +++ b/impls/wren/stepA_mal.wren @@ -48,13 +48,14 @@ class Mal { static eval(ast, env) { while (true) { - var tco = false + var tco = false - var dbgenv = env.find("DEBUG-EVAL") - if (dbgenv && env.get("DEBUG-EVAL")) { - System.print("EVAL: %(print(ast))") - } + var dbgenv = env.find("DEBUG-EVAL") + if (dbgenv && env.get("DEBUG-EVAL")) { + System.print("EVAL: %(print(ast))") + } + // Process non-list types. if (ast is MalSymbol) { return env.get(ast.value) } else if (ast is MalList) { @@ -70,6 +71,7 @@ class Mal { } else { return ast } + // ast is a list, search for special forms if (ast.isEmpty) return ast if (ast[0] is MalSymbol) { @@ -129,13 +131,13 @@ class Mal { if (!tco) { var f = eval(ast[0], env) if (f is MalNativeFn) { - var args = MalList.new(ast.elements[1..-1].map { |e| eval(e, env) }.toList) + var args = ast.elements[1..-1].map { |e| eval(e, env) }.toList return f.call(args) } else if (f is MalFn) { if (f.isMacro) { ast = f.call(ast.elements[1..-1]) } else { - var args = MalList.new(ast.elements[1..-1].map { |e| eval(e, env) }.toList) + var args = ast.elements[1..-1].map { |e| eval(e, env) }.toList ast = f.ast env = Env.new(f.env, f.params, args) }