wasm/step2_eval.wam

   1 (module $step2_eval
   2
   3   (global $repl_env (mut i32) (i32.const 0))
   4
   5   ;; READ
   6   (func $READ (param $str i32) (result i32)
   7     ($read_str $str)
   8   )
   9
  10   ;; EVAL
  11   (func $EVAL_AST (param $ast i32 $env i32) (result i32)
  12     (local $res2 i64)
  13     (LET $res 0 $val2 0 $val3 0 $type 0 $found 0
  14          $ret 0 $empty 0 $current 0)
  15
  16     (if (global.get $error_type) (return 0))
  17     (local.set $type ($TYPE $ast))
  18
  19     ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast)
  20
  21     ;;; switch(type)
  22     (block $done
  23       (block $default (block (block
  24       (br_table 2 2 2 2 2 0 1 1 1 2 2 2 2 2 2 2 $type))
  25       ;; symbol
  26       ;; found/res returned as hi 32/lo 32 of i64
  27       (local.set $res2 ($HASHMAP_GET $env $ast))
  28       (local.set $res (i32.wrap_i64 $res2))
  29       (local.set $found (i32.wrap_i64 (i64.shr_u $res2
  30                                                  (i64.const 32))))
  31       (if (i32.eqz $found)
  32           ($THROW_STR_1 "'%s' not found"
  33                 ($to_String $ast)))
  34       (local.set $res ($INC_REF $res))
  35
  36       (br $done))
  37       ;; list, vector, hashmap
  38       ;; MAP_LOOP_START
  39       (local.set $res ($MAP_LOOP_START $type))
  40       ;; push MAP_LOOP stack
  41       ;;; empty = current = ret = res
  42       (local.set $ret $res)
  43       (local.set $current $res)
  44       (local.set $empty $res)
  45
  46       (block $done
  47         (loop $loop
  48           ;; check if we are done evaluating the source sequence
  49           (br_if $done (i32.eq ($VAL0 $ast) 0))
  50
  51           (if (i32.eq $type (global.get $HASHMAP_T))
  52             (then
  53               (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env)))
  54             (else
  55               (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env))))
  56           (local.set $val2 $res)
  57
  58           ;; if error, release the unattached element
  59           (if (global.get $error_type)
  60             (then
  61               ($RELEASE $res)
  62               (local.set $res 0)
  63               (br $done)))
  64
  65           ;; for hash-maps, copy the key (inc ref since we are going
  66           ;; to release it below)
  67           (if (i32.eq $type (global.get $HASHMAP_T))
  68             (then
  69               (local.set $val3 $val2)
  70               (local.set $val2 ($MEM_VAL1_ptr $ast))
  71               (drop ($INC_REF $val2))))
  72
  73           ;; MAP_LOOP_UPDATE
  74           (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3))
  75           (if (i32.le_u $current (global.get $EMPTY_HASHMAP))
  76             ;; if first element, set return to new element
  77             (local.set $ret $res))
  78           ;; update current to point to new element
  79           (local.set $current $res)
  80
  81           (local.set $ast ($MEM_VAL0_ptr $ast))
  82
  83           (br $loop)
  84         )
  85       )
  86       ;; MAP_LOOP_DONE
  87       (local.set $res $ret)
  88       ;; EVAL_AST_RETURN: nothing to do
  89       (br $done))
  90       ;; default
  91       (local.set $res ($INC_REF $ast))
  92     )
  93
  94     $res
  95   )
  96
  97   (type $fnT (func (param i32) (result i32)))
  98
  99   (table funcref
 100     (elem
 101       $add $subtract $multiply $divide))
 102
 103   (func $EVAL (param $ast i32 $env i32) (result i32)
 104     (LET $res 0
 105          $ftype 0 $f_args 0 $f 0 $args 0)
 106
 107     (local.set $f_args 0)
 108     (local.set $f 0)
 109     (local.set $args 0)
 110
 111     (if (global.get $error_type) (return 0))
 112
 113     ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
 114
 115     (if (i32.ne ($TYPE $ast) (global.get $LIST_T))
 116       (return ($EVAL_AST $ast $env)))
 117
 118     ;; APPLY_LIST
 119     (if ($EMPTY_Q $ast)
 120       (return ($INC_REF $ast)))
 121
 122       ;; EVAL_INVOKE
 123       (local.set $res ($EVAL_AST $ast $env))
 124       (local.set $f_args $res)
 125
 126       ;; if error, return f/args for release by caller
 127       (if (global.get $error_type)
 128         (return $f_args))
 129
 130       (local.set $args ($MEM_VAL0_ptr $f_args)) ;; rest
 131       (local.set $f ($MEM_VAL1_ptr $f_args)) ;; value
 132
 133       (local.set $ftype ($TYPE $f))
 134       (if (i32.eq $ftype (global.get $FUNCTION_T))
 135         (then
 136           (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))))
 137         (else
 138           ($THROW_STR_1 "apply of non-function type: %d\n" $ftype)
 139           (local.set $res 0)))
 140
 141       ($RELEASE $f_args)
 142
 143     $res
 144   )
 145
 146   ;; PRINT
 147   (func $PRINT (param $ast i32) (result i32)
 148     ($pr_str $ast 1)
 149   )
 150
 151   ;; REPL
 152   (func $REP (param $line i32 $env i32) (result i32)
 153     (LET $mv1 0 $mv2 0 $ms 0)
 154     (block $done
 155       (local.set $mv1 ($READ $line))
 156       (br_if $done (global.get $error_type))
 157
 158       (local.set $mv2 ($EVAL $mv1 $env))
 159       (br_if $done (global.get $error_type))
 160
 161 ;;      ($PR_MEMORY -1 -1)
 162       (local.set $ms ($PRINT $mv2))
 163     )
 164
 165     ;; release memory from MAL_READ and EVAL
 166     ($RELEASE $mv2)
 167     ($RELEASE $mv1)
 168     $ms
 169   )
 170
 171   (func $add (param $args i32) (result i32)
 172     ($INTEGER
 173       (i32.add ($VAL0 ($MEM_VAL1_ptr $args))
 174                ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
 175   (func $subtract (param $args i32) (result i32)
 176     ($INTEGER
 177       (i32.sub ($VAL0 ($MEM_VAL1_ptr $args))
 178                  ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
 179   (func $multiply (param $args i32) (result i32)
 180     ($INTEGER
 181       (i32.mul ($VAL0 ($MEM_VAL1_ptr $args))
 182                  ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
 183   (func $divide (param $args i32) (result i32)
 184     ($INTEGER
 185       (i32.div_s ($VAL0 ($MEM_VAL1_ptr $args))
 186                  ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
 187
 188   (func $main (param $argc i32 $argv i32) (result i32)
 189     (LET $line (STATIC_ARRAY 201)
 190          $res 0 $repl_env 0)
 191
 192     ;; DEBUG
 193 ;;    ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase))
 194 ;;    ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start))
 195 ;;    ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end))
 196 ;;    ($printf_1 "mem: 0x%x\n" (global.get $mem))
 197 ;;    ($printf_1 "string_mem: %d\n" (global.get $string_mem))
 198
 199     (global.set $repl_env ($HASHMAP))
 200     (local.set $repl_env (global.get $repl_env))
 201
 202     (local.set $repl_env ($ASSOC1_S $repl_env "+" ($FUNCTION 0)))
 203     (local.set $repl_env ($ASSOC1_S $repl_env "-" ($FUNCTION 1)))
 204     (local.set $repl_env ($ASSOC1_S $repl_env "*" ($FUNCTION 2)))
 205     (local.set $repl_env ($ASSOC1_S $repl_env "/" ($FUNCTION 3)))
 206
 207     ;;($PR_MEMORY -1 -1)
 208
 209     ;; Start REPL
 210     (block $repl_done
 211       (loop $repl_loop
 212         (br_if $repl_done (i32.eqz ($readline "user> " $line)))
 213         (br_if $repl_loop (i32.eq (i32.load8_u $line) 0))
 214         (local.set $res ($REP $line $repl_env))
 215         (if (global.get $error_type)
 216           (then
 217             ($printf_1 "Error: %s\n" (global.get $error_str))
 218             (global.set $error_type 0))
 219           (else
 220             ($printf_1 "%s\n" ($to_String $res))))
 221         ($RELEASE $res)
 222         ;;($PR_MEMORY_SUMMARY_SMALL)
 223         (br $repl_loop)
 224       )
 225     )
 226
 227     ($print "\n")
 228     ;;($PR_MEMORY -1 -1)
 229     0
 230   )
 231
 232 )
 233