logo/step5_tco.lg

   1 load "../logo/readline.lg
   2 load "../logo/reader.lg
   3 load "../logo/printer.lg
   4 load "../logo/types.lg
   5 load "../logo/env.lg
   6 load "../logo/core.lg
   7
   8 to _read :str
   9 output read_str :str
  10 end
  11
  12 to eval_ast :ast :env
  13 output case (obj_type :ast) [
  14   [[symbol]  env_get :env :ast]
  15   [[list]    obj_new "list    map [_eval ? :env] obj_val :ast]
  16   [[vector]  obj_new "vector  map [_eval ? :env] obj_val :ast]
  17   [[hashmap] obj_new "hashmap map [_eval ? :env] obj_val :ast]
  18   [else :ast]
  19 ]
  20 end
  21
  22 to _eval :a_ast :a_env
  23 localmake "ast :a_ast
  24 localmake "env :a_env
  25 forever [
  26   if (obj_type :ast) <> "list [output eval_ast :ast :env]
  27   if emptyp obj_val :ast [output :ast]
  28   localmake "a0 nth :ast 0
  29   case list obj_type :a0 obj_val :a0 [
  30     [[[symbol def!]]
  31       localmake "a1 nth :ast 1
  32       localmake "a2 nth :ast 2
  33       output env_set :env :a1 _eval :a2 :env ]
  34
  35     [[[symbol let*]]
  36       localmake "a1 nth :ast 1
  37       localmake "letenv env_new :env [] []
  38       localmake "i 0
  39       while [:i < _count :a1] [
  40         ignore env_set :letenv nth :a1 :i _eval nth :a1 (:i + 1) :letenv
  41         make "i (:i + 2)
  42       ]
  43       make "env :letenv
  44       make "ast nth :ast 2 ]        ; TCO
  45
  46     [[[symbol do]]
  47       localmake "i 1
  48       while [:i < ((_count :ast) - 1)] [
  49         ignore _eval nth :ast :i :env
  50         make "i (:i + 1)
  51       ]
  52       make "ast last obj_val :ast ] ; TCO
  53
  54     [[[symbol if]]
  55       localmake "a1 nth :ast 1
  56       localmake "cond _eval :a1 :env
  57       case obj_type :cond [
  58         [[nil false] ifelse (_count :ast) > 3 [
  59                        make "ast nth :ast 3  ; TCO
  60                      ] [
  61                        output nil_new
  62                      ]]
  63         [else        make "ast nth :ast 2]   ; TCO
  64       ]]
  65
  66     [[[symbol fn*]]
  67       output fn_new nth :ast 1 :env nth :ast 2 ]
  68
  69     [else
  70       localmake "el eval_ast :ast :env
  71       localmake "f nth :el 0
  72       case obj_type :f [
  73         [[nativefn]
  74           output apply obj_val :f butfirst obj_val :el ]
  75         [[fn]
  76           make "env env_new fn_env :f fn_args :f rest :el
  77           make "ast fn_body :f ]  ; TCO
  78         [else
  79           (throw "error [Wrong type for apply])]
  80       ] ]
  81   ]
  82 ]
  83 end
  84
  85 to _print :exp
  86 output pr_str :exp "true
  87 end
  88
  89 to re :str
  90 output _eval _read :str :repl_env
  91 end
  92
  93 to rep :str
  94 output _print re :str
  95 end
  96
  97 to repl
  98 localmake "running "true
  99 while [:running] [
 100   localmake "line readline word "user> :space_char
 101   ifelse :line=[] [
 102     print "
 103     make "running "false
 104   ] [
 105     if not emptyp :line [
 106       catch "error [print rep :line]
 107       localmake "exception error
 108       if not emptyp :exception [
 109         (print "Error: first butfirst :exception)
 110       ]
 111     ]
 112   ]
 113 ]
 114 end
 115
 116 make "repl_env env_new [] [] []
 117 foreach :core_ns [
 118   ignore env_set :repl_env first ? first butfirst ?
 119 ]
 120 ; core.mal: defined using the language itself
 121 ignore re "|(def! not (fn* (a) (if a false true)))|
 122 repl
 123 bye