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         0 0 s" ' not found" sym pr-str s" '" ...throw-str
  64     endif ;;
  65 drop
  66
  67 : eval-ast { env list -- list }
  68     here
  69     list MalList/start @ { expr-start }
  70     list MalList/count @ 0 ?do
  71         env expr-start i cells + @ eval ,
  72     loop
  73     here>MalList ;
  74
  75 MalList
  76   extend mal-eval { env list -- val }
  77     list MalList/count @ 0= if
  78         list
  79     else
  80         env list MalList/start @ @ eval
  81         env list rot eval-invoke
  82     endif ;;
  83 drop
  84
  85 MalVector
  86   extend mal-eval ( env vector -- vector )
  87     MalVector/list @ eval-ast
  88     MalVector new swap over MalVector/list ! ;;
  89 drop
  90
  91 MalMap
  92   extend mal-eval ( env map -- map )
  93     MalMap/list @ eval-ast
  94     MalMap new swap over MalMap/list ! ;;
  95 drop
  96
  97 : rep ( str-addr str-len -- str-addr str-len )
  98     read
  99     repl-env swap eval
 100     print ;
 101
 102 create buff 128 allot
 103 77777777777 constant stack-leak-detect
 104
 105 : read-lines
 106     begin
 107       ." user> "
 108       stack-leak-detect
 109       buff 128 stdin read-line throw
 110     while ( num-bytes-read )
 111       dup 0 <> if
 112         buff swap ( str-addr str-len )
 113         ['] rep
 114         \ execute ['] nop \ uncomment to see stack traces
 115         catch ?dup 0= if
 116             safe-type cr
 117             stack-leak-detect <> if ." --stack leak--" cr endif
 118         else { errno }
 119             begin stack-leak-detect = until
 120             errno 1 <> if
 121                 s" forth-errno" MalKeyword. errno MalInt. MalMap/Empty assoc
 122                 to exception-object
 123             endif
 124             ." Uncaught exception: "
 125             exception-object pr-str safe-type cr
 126         endif
 127       endif
 128     repeat ;
 129
 130 read-lines
 131 cr
 132 bye