logo/step6_file.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 print_exception :exception
  98 if not emptyp :exception [
  99   localmake "e first butfirst :exception
 100   ifelse :e = "_mal_exception_ [
 101     (print "Error: pr_str :global_exception "false)
 102   ] [
 103     (print "Error: :e)
 104   ]
 105 ]
 106 end
 107
 108 to repl
 109 localmake "running "true
 110 while [:running] [
 111   localmake "line readline word "user> :space_char
 112   ifelse :line=[] [
 113     print "
 114     make "running "false
 115   ] [
 116     if not emptyp :line [
 117       catch "error [print rep :line]
 118       print_exception error
 119     ]
 120   ]
 121 ]
 122 end
 123
 124 to mal_eval :a
 125 output _eval :a :repl_env
 126 end
 127
 128 to argv_list
 129 localmake "argv ifelse emptyp :command.line [[]] [butfirst :command.line]
 130 output obj_new "list map [obj_new "string ?] :argv
 131 end
 132
 133 make "repl_env env_new [] [] []
 134 foreach :core_ns [
 135   ignore env_set :repl_env first ? first butfirst ?
 136 ]
 137 ignore env_set :repl_env [symbol eval] [nativefn mal_eval]
 138 ignore env_set :repl_env [symbol *ARGV*] argv_list
 139
 140 ; core.mal: defined using the language itself
 141 ignore re "|(def! not (fn* (a) (if a false true)))|
 142 ignore re "|(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\\nnil)\")))))|
 143
 144 if not emptyp :command.line [
 145   catch "error [ignore re (word "\(load-file :space_char "\" first :command.line "\"\) )]
 146   print_exception error
 147   bye
 148 ]
 149
 150 repl
 151 bye