forth/step2_eval.fs

   1 require reader.fs
   2 require printer.fs
   3
   4 : args-as-native { argv argc -- entry*argc... }
   5     argc 0 ?do
   6         argv i cells + @ as-native
   7     loop ;
   8
   9 : env-assoc ( map sym-str-addr sym-str-len xt )
  10     -rot MalSymbol. swap MalNativeFn. rot assoc ;
  11
  12 MalMap/Empty
  13     s" +" :noname args-as-native + MalInt. ; env-assoc
  14     s" -" :noname args-as-native - MalInt. ; env-assoc
  15     s" *" :noname args-as-native * MalInt. ; env-assoc
  16     s" /" :noname args-as-native / MalInt. ; env-assoc
  17 constant repl-env
  18
  19 : read read-str ;
  20 : eval ( env obj ) mal-eval ;
  21 : print
  22     \ ." Type: " dup mal-type @ type-name safe-type cr
  23     pr-str ;
  24
  25 MalDefault extend mal-eval nip ;; drop \ By default, evalutate to yourself
  26
  27 MalKeyword
  28   extend eval-invoke { env list kw -- val }
  29     0   kw   env list MalList/start @ cell+ @ eval   get
  30     ?dup 0= if
  31         \ compute not-found value
  32         list MalList/count @ 1 > if
  33             env  list MalList/start @ 2 cells + @  eval
  34         else
  35             mal-nil
  36         endif
  37     endif ;;
  38 drop
  39
  40 \ eval all but the first item of list
  41 : eval-rest { env list -- argv argc }
  42     list MalList/start @ cell+ { expr-start }
  43     list MalList/count @ 1- { argc }
  44     argc cells allocate throw { target }
  45     argc 0 ?do
  46         env expr-start i cells + @ eval
  47         target i cells + !
  48     loop
  49     target argc ;
  50
  51 MalNativeFn
  52   extend eval-invoke ( env list this -- list )
  53     MalNativeFn/xt @ { xt }
  54     eval-rest ( argv argc )
  55     xt execute ( return-val ) ;;
  56 drop
  57
  58 MalSymbol
  59   extend mal-eval { env sym -- val }
  60     0 sym env get
  61     dup 0= if
  62         drop
  63         ." Symbol '"
  64         sym pr-str safe-type
  65         ." ' not found." cr
  66         1 throw
  67     endif ;;
  68 drop
  69
  70 : eval-ast { env list -- list }
  71     here
  72     list MalList/start @ { expr-start }
  73     list MalList/count @ 0 ?do
  74         env expr-start i cells + @ eval ,
  75     loop
  76     here>MalList ;
  77
  78 MalList
  79   extend mal-eval { env list -- val }
  80     env list MalList/start @ @ eval
  81     env list rot eval-invoke ;;
  82 drop
  83
  84 MalVector
  85   extend mal-eval ( env vector -- vector )
  86     MalVector/list @ eval-ast
  87     MalVector new swap over MalVector/list ! ;;
  88 drop
  89
  90 MalMap
  91   extend mal-eval ( env map -- map )
  92     MalMap/list @ eval-ast
  93     MalMap new swap over MalMap/list ! ;;
  94 drop
  95
  96 : rep ( str-addr str-len -- str-addr str-len )
  97     read
  98     repl-env swap eval
  99     print ;
 100
 101 create buff 128 allot
 102 77777777777 constant stack-leak-detect
 103
 104 : read-lines
 105     begin
 106       ." user> "
 107       stack-leak-detect
 108       buff 128 stdin read-line throw
 109     while ( num-bytes-read )
 110       buff swap ( str-addr str-len )
 111       ['] rep
 112       \ execute safe-type
 113       catch ?dup 0= if safe-type else ." Caught error " . endif
 114       cr
 115       stack-leak-detect <> if ." --stack leak--" cr endif
 116     repeat ;
 117
 118 read-lines
 119 cr
 120 bye