wasm/step3_env.wam

   1 (module $step3_env
   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 $res i32 $val2 i32 $val3 i32 $type i32 $found i32)
  13     (local $ret i32 $empty i32 $current i32)
  14
  15     (if (get_global $error_type) (return 0))
  16     (set_local $type ($TYPE $ast))
  17
  18     ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast)
  19
  20     ;;; switch(type)
  21     (block $done
  22       (block $default (block (block
  23       (br_table 2 2 2 2 2 0 1 1 1 2 2 2 2 2 2 2 $type))
  24       ;; symbol
  25       ;; found/res returned as hi 32/lo 32 of i64
  26       (set_local $res ($ENV_GET $env $ast))
  27       (br $done))
  28       ;; list, vector, hashmap
  29       ;; MAP_LOOP_START
  30       (set_local $res ($MAP_LOOP_START $type))
  31       ;; push MAP_LOOP stack
  32       ;;; empty = current = ret = res
  33       (set_local $ret $res)
  34       (set_local $current $res)
  35       (set_local $empty $res)
  36
  37       (block $done
  38         (loop $loop
  39           ;; check if we are done evaluating the source sequence
  40           (if (i32.eq ($VAL0 $ast) 0) (br $done))
  41
  42           (if (i32.eq $type (get_global $HASHMAP_T))
  43             (then
  44               (set_local $res ($EVAL ($MEM_VAL2_ptr $ast) $env)))
  45             (else
  46               (set_local $res ($EVAL ($MEM_VAL1_ptr $ast) $env))))
  47           (set_local $val2 $res)
  48
  49           ;; if error, release the unattached element
  50           (if (get_global $error_type)
  51             (then
  52               ($RELEASE $res)
  53               (set_local $res 0)
  54               (br $done)))
  55
  56           ;; for hash-maps, copy the key (inc ref since we are going
  57           ;; to release it below)
  58           (if (i32.eq $type (get_global $HASHMAP_T))
  59             (then
  60               (set_local $val3 $val2)
  61               (set_local $val2 ($MEM_VAL1_ptr $ast))
  62               (drop ($INC_REF $val2))))
  63
  64           ;; MAP_LOOP_UPDATE
  65           (set_local $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3))
  66           (if (i32.le_u $current (get_global $EMPTY_HASHMAP))
  67             ;; if first element, set return to new element
  68             (set_local $ret $res))
  69           ;; update current to point to new element
  70           (set_local $current $res)
  71
  72           (set_local $ast ($MEM_VAL0_ptr $ast))
  73
  74           (br $loop)
  75         )
  76       )
  77       ;; MAP_LOOP_DONE
  78       (set_local $res $ret)
  79       ;; EVAL_AST_RETURN: nothing to do
  80       (br $done))
  81       ;; default
  82       (set_local $res ($INC_REF $ast))
  83     )
  84
  85     $res
  86   )
  87
  88   (type $fnT (func (param i32) (result i32)))
  89
  90   (table anyfunc
  91     (elem
  92       $add $subtract $multiply $divide))
  93
  94   (func $MAL_GET_A1 (param $ast i32) (result i32)
  95     ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))
  96   (func $MAL_GET_A2 (param $ast i32) (result i32)
  97     ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))
  98   (func $MAL_GET_A3 (param $ast i32) (result i32)
  99     ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))))
 100
 101   (func $EVAL (param $ast i32 $env i32) (result i32)
 102     (local $res i32)
 103     (local $ftype i32 $f_args i32 $f i32 $args i32)
 104     (local $a0 i32 $a0sym i32 $a1 i32 $a2 i32)
 105     (local $let_env i32)
 106
 107     (set_local $res 0)
 108     (set_local $f_args 0)
 109     (set_local $f 0)
 110     (set_local $args 0)
 111
 112     (if (get_global $error_type) (return 0))
 113
 114     ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
 115
 116     (if (i32.ne ($TYPE $ast) (get_global $LIST_T))
 117       (return ($EVAL_AST $ast $env)))
 118
 119     ;; APPLY_LIST
 120     (if ($EMPTY_Q $ast) (return ($INC_REF $ast)))
 121
 122     (set_local $a0 ($MEM_VAL1_ptr $ast))
 123     (set_local $a0sym "")
 124     (if (i32.eq ($TYPE $a0) (get_global $SYMBOL_T))
 125       (set_local $a0sym ($to_String $a0)))
 126
 127     (if (i32.eqz ($strcmp "def!" $a0sym))
 128       (then
 129         (set_local $a1 ($MAL_GET_A1 $ast))
 130         (set_local $a2 ($MAL_GET_A2 $ast))
 131         (set_local $res ($EVAL $a2 $env))
 132         (if (get_global $error_type) (return $res))
 133
 134         ;; set a1 in env to a2
 135         (set_local $res ($ENV_SET $env $a1 $res)))
 136     (else (if (i32.eqz ($strcmp "let*" $a0sym))
 137       (then
 138         (set_local $a1 ($MAL_GET_A1 $ast))
 139         (set_local $a2 ($MAL_GET_A2 $ast))
 140
 141         ;; create new environment with outer as current environment
 142         (set_local $let_env ($ENV_NEW $env))
 143
 144         (block $done
 145           (loop $loop
 146             (if (i32.eqz ($VAL0 $a1))
 147               (br $done))
 148             ;; eval current A1 odd element
 149             (set_local $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1))
 150                                    $let_env))
 151
 152             (if (get_global $error_type) (br $done))
 153
 154             ;; set key/value in the let environment
 155             (set_local $res ($ENV_SET $let_env ($MEM_VAL1_ptr $a1) $res))
 156             ;; release our use, ENV_SET took ownership
 157             ($RELEASE $res)
 158
 159             ;; skip to the next pair of a1 elements
 160             (set_local $a1 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $a1)))
 161             (br $loop)
 162           )
 163         )
 164         (set_local $res ($EVAL $a2 $let_env))
 165         ;; EVAL_RETURN
 166         ($RELEASE $let_env))
 167     (else
 168       ;; EVAL_INVOKE
 169       (set_local $res ($EVAL_AST $ast $env))
 170       (set_local $f_args $res)
 171
 172       ;; if error, return f/args for release by caller
 173       (if (get_global $error_type) (return $f_args))
 174
 175       ;; rest
 176       (set_local $args ($MEM_VAL0_ptr $f_args))
 177       ;; value
 178       (set_local $f ($MEM_VAL1_ptr $f_args))
 179
 180       (set_local $ftype ($TYPE $f))
 181       (if (i32.eq $ftype (get_global $FUNCTION_T))
 182         (then
 183           (set_local $res (call_indirect (type $fnT) $args ($VAL0 $f))))
 184         (else
 185           ($THROW_STR_1 "apply of non-function type: %d\n" $ftype)
 186           (set_local $res 0)))
 187
 188       ($RELEASE $f_args)))))
 189
 190     $res
 191   )
 192
 193   ;; PRINT
 194   (func $PRINT (param $ast i32) (result i32)
 195     ($pr_str $ast 1)
 196   )
 197
 198   ;; REPL
 199   (func $REP (param $line i32 $env i32) (result i32)
 200     (local $mv1 i32 $mv2 i32 $ms i32)
 201     (block $rep_done
 202       (set_local $mv1 ($READ $line))
 203       (if (get_global $error_type) (br $rep_done))
 204
 205       (set_local $mv2 ($EVAL $mv1 $env))
 206       (if (get_global $error_type) (br $rep_done))
 207
 208 ;;      ($PR_MEMORY -1 -1)
 209       (set_local $ms ($PRINT $mv2))
 210     )
 211
 212     ;; release memory from MAL_READ and EVAL
 213     ($RELEASE $mv2)
 214     ($RELEASE $mv1)
 215     $ms
 216   )
 217
 218   (func $add (param $args i32) (result i32)
 219     ($INTEGER
 220       (i32.add ($VAL0 ($MEM_VAL1_ptr $args))
 221                ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
 222   (func $subtract (param $args i32) (result i32)
 223     ($INTEGER
 224       (i32.sub_s ($VAL0 ($MEM_VAL1_ptr $args))
 225                  ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
 226   (func $multiply (param $args i32) (result i32)
 227     ($INTEGER
 228       (i32.mul_s ($VAL0 ($MEM_VAL1_ptr $args))
 229                  ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
 230   (func $divide (param $args i32) (result i32)
 231     ($INTEGER
 232       (i32.div_s ($VAL0 ($MEM_VAL1_ptr $args))
 233                  ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args))))))
 234   (func $pr_memory (param $args i32) (result i32)
 235     ($PR_MEMORY -1 -1)
 236     ($INC_REF (get_global $NIL)))
 237
 238   (func $main (result i32)
 239     (local $line i32 $res i32 $repl_env i32)
 240     (set_local $line (STATIC_ARRAY 201))
 241
 242     ;; DEBUG
 243     ($printf_1 "memoryBase: 0x%x\n" (get_global $memoryBase))
 244     ($printf_1 "heap_start: 0x%x\n" (get_global $heap_start))
 245     ($printf_1 "heap_end: 0x%x\n" (get_global $heap_end))
 246     ($printf_1 "mem: 0x%x\n" (get_global $mem))
 247 ;;    ($printf_1 "string_mem: %d\n" (get_global $string_mem))
 248
 249     (set_global $repl_env ($ENV_NEW (get_global $NIL)))
 250     (set_local $repl_env (get_global $repl_env))
 251
 252     (drop ($ENV_SET_S $repl_env "+" ($FUNCTION 0)))
 253     (drop ($ENV_SET_S $repl_env "-" ($FUNCTION 1)))
 254     (drop ($ENV_SET_S $repl_env "*" ($FUNCTION 2)))
 255     (drop ($ENV_SET_S $repl_env "/" ($FUNCTION 3)))
 256
 257     ;;($PR_MEMORY -1 -1)
 258
 259     ;; Start REPL
 260     (block $repl_done
 261       (loop $repl_loop
 262         (br_if $repl_done (i32.eqz ($readline "user> " $line)))
 263         (br_if $repl_loop (i32.eq (i32.load8_u $line) 0))
 264         (set_local $res ($REP $line $repl_env))
 265         (if (get_global $error_type)
 266           (then
 267             ($printf_1 "Error: %s\n" (get_global $error_str))
 268             (set_global $error_type 0))
 269           (else
 270             ($printf_1 "%s\n" ($to_String $res))))
 271         ($RELEASE $res)
 272         ;;($PR_MEMORY_SUMMARY_SMALL)
 273         (br $repl_loop)
 274       )
 275     )
 276
 277     ($print "\n")
 278     ;;($PR_MEMORY -1 -1)
 279     0
 280   )
 281
 282
 283   (export "_main" (func $main))
 284   (export "__post_instantiate" (func $init_memory))
 285 )
 286