impls/wasm/stepA_mal.wam

   1 (module $stepA_mal
   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
  12
  13   (func $QUASIQUOTE (param $ast i32) (result i32)
  14     (LET $type ($TYPE $ast) $res 0 $sym 0 $second 0)
  15
  16     ;; symbol or map -> ('quote ast)
  17     (if (OR (i32.eq $type (global.get $SYMBOL_T))
  18             (i32.eq $type (global.get $HASHMAP_T)))
  19     (then
  20       (local.set $sym ($STRING (global.get $SYMBOL_T) "quote"))
  21       (local.set $res ($LIST2 $sym $ast))
  22       ($RELEASE $sym)
  23       (return $res)))
  24
  25     ;; [xs..] -> ('vec (processed like a list))
  26     (if (i32.eq $type (global.get $VECTOR_T)) (then
  27       (local.set $sym ($STRING (global.get $SYMBOL_T) "vec"))
  28       (local.set $second ($qq_foldr $ast))
  29       (local.set $res ($LIST2 $sym $second))
  30       ($RELEASE $sym)
  31       ($RELEASE $second)
  32       (return $res)))
  33
  34     ;; If ast is not affected by eval, return it unchanged.
  35     (if (i32.ne $type (global.get $LIST_T)) (then
  36       (return ($INC_REF $ast))))
  37
  38     ;; (unquote x) -> x
  39     (local.set $second ($qq_unquote $ast "unquote"))
  40     (if $second (then
  41       (return ($INC_REF $second))))
  42
  43     ;; ast is a normal list, iterate on its elements
  44     (return ($qq_foldr $ast)))
  45
  46   ;; Helper for quasiquote.
  47   ;; If the given list ast contains at least two elements and starts
  48   ;; with the given symbol, return the second element. Else return 0.
  49   (func $qq_unquote (param $ast i32) (param $sym i32) (result i32)
  50     (LET $car 0 $cdr 0)
  51     (if ($VAL0 $ast) (then
  52       (local.set $car ($MEM_VAL1_ptr $ast))
  53       (if (i32.eq ($TYPE $car) (global.get $SYMBOL_T)) (then
  54         (if (i32.eqz ($strcmp ($to_String $car) $sym)) (then
  55           (local.set $cdr ($MEM_VAL0_ptr $ast))
  56           (if ($VAL0 $cdr) (then
  57             (return ($MEM_VAL1_ptr $cdr))))))))))
  58     (return 0))
  59
  60   ;; Iteration on sequences for quasiquote (right reduce/fold).
  61   (func $qq_foldr (param $xs i32) (result i32)
  62     (if ($VAL0 $xs) (then
  63       (return ($qq_loop ($MEM_VAL1_ptr $xs) ($qq_foldr ($MEM_VAL0_ptr $xs)))))
  64     (else
  65       (return ($INC_REF (global.get $EMPTY_LIST))))))
  66
  67   ;; Transition function for quasiquote right fold/reduce.
  68   (func $qq_loop (param $elt i32) (param $acc i32) (result i32)
  69     (LET $sym 0 $second 0 $res 0)
  70
  71     ;; If elt is ('splice-unquote x) -> ('concat, x, acc)
  72     (if (i32.eq ($TYPE $elt) (global.get $LIST_T)) (then
  73       (local.set $second ($qq_unquote $elt "splice-unquote"))
  74       (if $second (then
  75         (local.set $sym    ($STRING (global.get $SYMBOL_T) "concat"))
  76         (local.set $res    ($LIST3 $sym $second $acc))
  77         ;; release inner quasiquoted since outer list takes ownership
  78         ($RELEASE $sym)
  79         (return $res)))))
  80
  81     ;; normal elt -> ('cons, (quasiquoted x), acc)
  82     (local.set $sym    ($STRING (global.get $SYMBOL_T) "cons"))
  83     (local.set $second ($QUASIQUOTE $elt))
  84     (local.set $res    ($LIST3 $sym $second $acc))
  85     ;; release inner quasiquoted since outer list takes ownership
  86     ($RELEASE $second)
  87     ($RELEASE $sym)
  88     (return $res))
  89
  90
  91   (global $mac_stack (mut i32) (i32.const 0))
  92   (global $mac_stack_top (mut i32) (i32.const -1))
  93
  94   (func $MACROEXPAND (param $orig_ast i32 $env i32) (result i32)
  95     (local $mac_env i64)
  96     (LET $ast $orig_ast
  97          $mac 0)
  98     (global.set $mac_stack (STATIC_ARRAY 2048)) ;; 512 * 4, TODO: move to init
  99     (block $done
 100       (loop $loop
 101         (br_if $done
 102                (OR (i32.ne ($TYPE $ast) (global.get $LIST_T)) ;; a list
 103                    (i32.eqz ($VAL0 $ast))                     ;; non-empty
 104                    (i32.ne ($TYPE ($MEM_VAL1_ptr $ast))       ;; leading symbol
 105                            (global.get $SYMBOL_T))))
 106         (local.set $mac_env ($ENV_FIND $env ($MEM_VAL1_ptr $ast)))
 107         (local.set $mac (i32.wrap_i64 (i64.shr_u $mac_env (i64.const 32))))
 108         (br_if $done (OR (i32.eqz (i32.wrap_i64 $mac_env))    ;; defined in env
 109                          (i32.ne ($TYPE $mac)                 ;; a macro
 110                                  (global.get $MACRO_T))))
 111
 112         (local.set $ast ($APPLY $mac ($MEM_VAL0_ptr $ast)))
 113         ;; PEND_A_LV
 114         ;; if ast is not the first ast that was passed in, then add it
 115         ;; to the pending release list.
 116         (if (i32.ne $ast $orig_ast)
 117           (then
 118             (global.set $mac_stack_top
 119                         (i32.add (global.get $mac_stack_top) 1))
 120             (if (i32.ge_s (i32.mul (global.get $mac_stack_top) 4) 2048) ;; 512 * 4
 121               ($fatal 7 "Exhausted mac_stack!\n"))
 122             (i32.store (i32.add
 123                          (global.get $mac_stack)
 124                          (i32.mul (global.get $mac_stack_top) 4))
 125               $ast)))
 126         (br_if $done (global.get $error_type))
 127
 128         (br $loop)
 129       )
 130     )
 131     $ast
 132   )
 133
 134   (func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32)
 135     (LET $res 0 $val2 0 $val3 0 $type 0 $found 0
 136          $ret 0 $empty 0 $current 0)
 137
 138     (if (global.get $error_type) (return 0))
 139     (local.set $type ($TYPE $ast))
 140
 141     ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast)
 142
 143     ;;; switch(type)
 144     (block $done
 145       (block $default (block (block
 146       (br_table 2 2 2 2 2 0 1 1 1 2 2 2 2 2 2 2 $type))
 147       ;; symbol
 148       ;; found/res returned as hi 32/lo 32 of i64
 149       (local.set $res ($ENV_GET $env $ast))
 150       (br $done))
 151       ;; list, vector, hashmap
 152       ;; MAP_LOOP_START
 153       (local.set $res ($MAP_LOOP_START $type))
 154       ;; push MAP_LOOP stack
 155       ;;; empty = current = ret = res
 156       (local.set $ret $res)
 157       (local.set $current $res)
 158       (local.set $empty $res)
 159
 160       (block $done
 161         (loop $loop
 162           ;; check if we are done evaluating the source sequence
 163           (br_if $done (i32.eq ($VAL0 $ast) 0))
 164
 165           (if $skiplast
 166             (br_if $done (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast)))))
 167
 168           (if (i32.eq $type (global.get $HASHMAP_T))
 169             (then
 170               (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env)))
 171             (else
 172               (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env))))
 173           (local.set $val2 $res)
 174
 175           ;; if error, release the unattached element
 176           (if (global.get $error_type)
 177             (then
 178               ($RELEASE $res)
 179               (local.set $res 0)
 180               (br $done)))
 181
 182           ;; for hash-maps, copy the key (inc ref since we are going
 183           ;; to release it below)
 184           (if (i32.eq $type (global.get $HASHMAP_T))
 185             (then
 186               (local.set $val3 $val2)
 187               (local.set $val2 ($MEM_VAL1_ptr $ast))
 188               (drop ($INC_REF $val2))))
 189
 190           ;; MAP_LOOP_UPDATE
 191           (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3))
 192           (if (i32.le_u $current (global.get $EMPTY_HASHMAP))
 193             ;; if first element, set return to new element
 194             (local.set $ret $res))
 195           ;; update current to point to new element
 196           (local.set $current $res)
 197
 198           (local.set $ast ($MEM_VAL0_ptr $ast))
 199
 200           (br $loop)
 201         )
 202       )
 203       ;; MAP_LOOP_DONE
 204       (local.set $res $ret)
 205       ;; EVAL_AST_RETURN: nothing to do
 206       (br $done))
 207       ;; default
 208       (local.set $res ($INC_REF $ast))
 209     )
 210
 211     $res
 212   )
 213
 214   (func $MAL_GET_A1 (param $ast i32) (result i32)
 215     ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))
 216   (func $MAL_GET_A2 (param $ast i32) (result i32)
 217     ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))
 218   (func $MAL_GET_A3 (param $ast i32) (result i32)
 219     ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))))
 220
 221   (func $EVAL (param $orig_ast i32 $orig_env i32) (result i32)
 222     (LET $ast $orig_ast
 223          $env $orig_env
 224          $orig_mac_stack_top (global.get $mac_stack_top)
 225          $prev_ast 0 $prev_env 0 $res 0 $el 0
 226          $ftype 0 $f_args 0 $f 0 $args 0
 227          $a0 0 $a0sym 0 $a1 0 $a2 0
 228          $err 0)
 229
 230     (block $EVAL_return
 231     (loop $TCO_loop
 232
 233     (local.set $f_args 0)
 234     (local.set $f 0)
 235     (local.set $args 0)
 236
 237     (if (global.get $error_type)
 238       (then
 239         (local.set $res 0)
 240         (br $EVAL_return)))
 241
 242     ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast)
 243
 244     (if (i32.ne ($TYPE $ast) (global.get $LIST_T))
 245       (then
 246         (local.set $res ($EVAL_AST $ast $env 0))
 247         (br $EVAL_return)))
 248
 249     ;; APPLY_LIST
 250     (local.set $ast ($MACROEXPAND $ast $env))
 251     ;;($PR_VALUE ">>> >>> EVAL ast: '%s'\n" $ast)
 252
 253     (if (i32.ne ($TYPE $ast) (global.get $LIST_T))
 254       (then
 255         (local.set $res ($EVAL_AST $ast $env 0))
 256         (br $EVAL_return)))
 257
 258     (if ($EMPTY_Q $ast)
 259       (then
 260         (local.set $res ($INC_REF $ast))
 261         (br $EVAL_return)))
 262
 263     (local.set $a0 ($MEM_VAL1_ptr $ast))
 264     (local.set $a0sym "")
 265     (if (i32.eq ($TYPE $a0) (global.get $SYMBOL_T))
 266       (local.set $a0sym ($to_String $a0)))
 267
 268     (if (i32.eqz ($strcmp "def!" $a0sym))
 269       (then
 270         (local.set $a1 ($MAL_GET_A1 $ast))
 271         (local.set $a2 ($MAL_GET_A2 $ast))
 272         (local.set $res ($EVAL $a2 $env))
 273         (br_if $EVAL_return (global.get $error_type))
 274
 275         ;; set a1 in env to a2
 276         (local.set $res ($ENV_SET $env $a1 $res))
 277         (br $EVAL_return))
 278     (else (if (i32.eqz ($strcmp "let*" $a0sym))
 279       (then
 280         (local.set $a1 ($MAL_GET_A1 $ast))
 281         (local.set $a2 ($MAL_GET_A2 $ast))
 282
 283         ;; create new environment with outer as current environment
 284         (local.set $prev_env $env) ;; save env for later release
 285         (local.set $env ($ENV_NEW $env))
 286
 287         (block $done
 288           (loop $loop
 289             (br_if $done (i32.eqz ($VAL0 $a1)))
 290             ;; eval current A1 odd element
 291             (local.set $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $env))
 292
 293             (br_if $done (global.get $error_type))
 294
 295             ;; set key/value in the let environment
 296             (local.set $res ($ENV_SET $env ($MEM_VAL1_ptr $a1) $res))
 297             ;; release our use, ENV_SET took ownership
 298             ($RELEASE $res)
 299
 300             ;; skip to the next pair of a1 elements
 301             (local.set $a1 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $a1)))
 302             (br $loop)
 303           )
 304         )
 305
 306         ;; release previous environment if not the current EVAL env
 307         (if (i32.ne $prev_env $orig_env)
 308           (then
 309             ($RELEASE $prev_env)
 310             (local.set $prev_env 0)))
 311
 312         (local.set $ast $a2)
 313         (br $TCO_loop))
 314     (else (if (i32.eqz ($strcmp "do" $a0sym))
 315       (then
 316         ;; EVAL the rest through second to last
 317         (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1))
 318         (local.set $ast ($LAST $ast))
 319         ($RELEASE $ast) ;; we already own it via ast
 320         ($RELEASE $el)
 321         (br $TCO_loop))
 322     (else (if (i32.eqz ($strcmp "quote" $a0sym))
 323       (then
 324         (local.set $res ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))))
 325         (br $EVAL_return))
 326     (else (if (i32.eqz ($strcmp "quasiquoteexpand" $a0sym))
 327       (then
 328         (local.set $res ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))))
 329         (br $EVAL_return))
 330     (else (if (i32.eqz ($strcmp "quasiquote" $a0sym))
 331       (then
 332         (local.set $ast ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))))
 333
 334         ;; if we have already been here via TCO, release previous ast
 335         (if $prev_ast ($RELEASE $prev_ast))
 336         (local.set $prev_ast $ast)
 337         (br $TCO_loop))
 338     (else (if (i32.eqz ($strcmp "defmacro!" $a0sym))
 339       (then
 340         (local.set $a1 ($MAL_GET_A1 $ast))
 341         (local.set $a2 ($MAL_GET_A2 $ast))
 342         (local.set $res ($EVAL $a2 $env))
 343         ($SET_TYPE $res (global.get $MACRO_T))
 344         (br_if $EVAL_return (global.get $error_type))
 345
 346         ;; set a1 in env to a2
 347         (local.set $res ($ENV_SET $env $a1 $res))
 348         (br $EVAL_return))
 349     (else (if (i32.eqz ($strcmp "macroexpand" $a0sym))
 350       (then
 351         ;; since we are returning it unevaluated, inc the ref cnt
 352         (local.set $res ($INC_REF ($MACROEXPAND
 353                                     ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))
 354                                     $env))))
 355     (else (if (i32.eqz ($strcmp "try*" $a0sym))
 356       (then
 357         (local.set $a1 ($MAL_GET_A1 $ast))
 358         (local.set $res ($EVAL $a1 $env))
 359
 360         ;; if there is no error, return
 361         (br_if $EVAL_return (i32.eqz (global.get $error_type)))
 362         ;; if there is an error and res is set, we need to free it
 363         ($RELEASE $res)
 364         ;; if there is no catch block then return
 365         (br_if $EVAL_return
 366                (i32.eqz ($VAL0 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))))
 367
 368         ;; save the current environment for release
 369         (local.set $prev_env $env)
 370         ;; create environment for the catch block eval
 371         (local.set $env ($ENV_NEW $env))
 372
 373         ;; set a1 and a2 from the catch block
 374         (local.set $a1 ($MAL_GET_A1 ($MAL_GET_A2 $ast)))
 375         (local.set $a2 ($MAL_GET_A2 ($MAL_GET_A2 $ast)))
 376
 377         ;; create object for string errors
 378         (if (i32.eq (global.get $error_type) 1)
 379           (then
 380             (local.set $err ($STRING (global.get $STRING_T)
 381                                      (global.get $error_str))))
 382           (else
 383             (local.set $err (global.get $error_val))))
 384         ;; bind the catch symbol to the error object
 385         (drop ($ENV_SET $env $a1 $err))
 386         ;; release our use, env took ownership
 387         ($RELEASE $err)
 388
 389         ;; unset error for catch eval
 390         (global.set $error_type 0)
 391         (i32.store (global.get $error_str) (CHR "\x00"))
 392
 393         ;; release previous environment if not the current EVAL env
 394         (if (i32.ne $prev_env $orig_env)
 395           (then
 396             ($RELEASE $prev_env)
 397             (local.set $prev_env 0)))
 398
 399         (local.set $ast $a2)
 400         (br $TCO_loop))
 401     (else (if (i32.eqz ($strcmp "if" $a0sym))
 402       (then
 403         (local.set $a1 ($MAL_GET_A1 $ast))
 404         (local.set $res ($EVAL $a1 $env))
 405
 406         (if (global.get $error_type)
 407           (then (nop))
 408         (else (if (OR (i32.eq $res (global.get $NIL))
 409                       (i32.eq $res (global.get $FALSE)))
 410           (then
 411             ($RELEASE $res)
 412             ;; if no false case (A3), return nil
 413             (if (i32.lt_u ($COUNT $ast) 4)
 414               (then
 415                 (local.set $res ($INC_REF (global.get $NIL)))
 416                 (br $EVAL_return))
 417               (else
 418                 (local.set $ast ($MAL_GET_A3 $ast)))))
 419         (else
 420           ($RELEASE $res)
 421           (local.set $ast ($MAL_GET_A2 $ast))))))
 422         (br $TCO_loop))
 423     (else (if (i32.eqz ($strcmp "fn*" $a0sym))
 424       (then
 425         (local.set $a1 ($MAL_GET_A1 $ast))
 426         (local.set $a2 ($MAL_GET_A2 $ast))
 427         (local.set $res ($MALFUNC $a2 $a1 $env))
 428         (br $EVAL_return))
 429     (else
 430       ;; EVAL_INVOKE
 431       (local.set $res ($EVAL_AST $ast $env 0))
 432       (local.set $f_args $res)
 433
 434       ;; if error, return f/args for release by caller
 435       (if (global.get $error_type)
 436        (then
 437          (local.set $res $f_args)
 438          (br $EVAL_return)))
 439
 440       (local.set $args ($MEM_VAL0_ptr $f_args)) ;; rest
 441       (local.set $f ($DEREF_META ($MEM_VAL1_ptr $f_args))) ;; value
 442
 443       (local.set $ftype ($TYPE $f))
 444       (if (i32.eq $ftype (global.get $FUNCTION_T))
 445         (then
 446           (if (i32.eq ($VAL0 $f) 0) ;; eval
 447             (then
 448               (local.set $res ($EVAL ($MEM_VAL1_ptr $args)
 449                                      (global.get $repl_env))))
 450             (else
 451               (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f)))))
 452           ;; release f/args
 453           ($RELEASE $f_args)
 454           (br $EVAL_return))
 455       (else (if (i32.eq $ftype (global.get $MALFUNC_T))
 456         (then
 457           ;; save the current environment for release
 458           (local.set $prev_env $env)
 459           ;; create new environment using env and params stored in function
 460           (local.set $env ($ENV_NEW_BINDS ($MEM_VAL2_ptr $f)
 461                                           ($MEM_VAL1_ptr $f) $args))
 462
 463           ;; release previous environment if not the current EVAL env
 464           ;; because our new env refers to it and we no longer need to
 465           ;; track it (since we are TCO recurring)
 466           (if (i32.ne $prev_env $orig_env)
 467             (then
 468               ($RELEASE $prev_env)
 469               (local.set $prev_env 0)))
 470
 471           ;; claim the AST before releasing the list containing it
 472           (local.set $ast ($MEM_VAL0_ptr $f))
 473           (drop ($INC_REF $ast))
 474
 475           ;; if we have already been here via TCO, release previous
 476           ;; ast
 477           ;; PEND_A_LV
 478           (if $prev_ast ($RELEASE $prev_ast))
 479           (local.set $prev_ast $ast)
 480
 481           ;; release f/args
 482           ($RELEASE $f_args)
 483
 484           (br $TCO_loop))
 485       (else
 486         ($THROW_STR_1 "apply of non-function type: %d\n" $ftype)
 487         (local.set $res 0)
 488         ($RELEASE $f_args)
 489         (br $EVAL_return)))))))))))))))))))))))))))
 490
 491     ) ;; end of TCO_loop
 492     ) ;; end of EVAL_return
 493
 494     ;; EVAL_RETURN
 495     (if (i32.ne $env $orig_env) ($RELEASE $env))
 496     (if $prev_ast ($RELEASE $prev_ast))
 497
 498     ;; release memory from MACROEXPAND
 499     ;; TODO: needs to happen here so self-hosting doesn't leak
 500     (block $done
 501       (loop $loop
 502         (br_if $done (i32.le_s (global.get $mac_stack_top) $orig_mac_stack_top))
 503         ($RELEASE (i32.load (i32.add
 504                               (global.get $mac_stack)
 505                               (i32.mul (global.get $mac_stack_top) 4))))
 506         (global.set $mac_stack_top
 507                     (i32.sub (global.get $mac_stack_top) 1))
 508         (br $loop)
 509       )
 510     )
 511
 512     $res
 513   )
 514
 515   ;; PRINT
 516   (func $PRINT (param $ast i32) (result i32)
 517     ($pr_str $ast 1)
 518   )
 519
 520   ;; REPL
 521   (func $RE (param $line i32 $env i32) (result i32)
 522     (LET $mv1 0 $res 0)
 523     (block $done
 524       (local.set $mv1 ($READ $line))
 525       (br_if $done (global.get $error_type))
 526
 527       (local.set $res ($EVAL $mv1 $env))
 528     )
 529
 530     ;; release memory from MAL_READ
 531     ($RELEASE $mv1)
 532     $res
 533   )
 534
 535   (func $REP (param $line i32 $env i32) (result i32)
 536     (LET $mv2 0 $ms 0)
 537     (block $done
 538       (local.set $mv2 ($RE $line $env))
 539       (br_if $done (global.get $error_type))
 540
 541 ;;      ($PR_MEMORY -1 -1)
 542       (local.set $ms ($PRINT $mv2))
 543     )
 544
 545     ;; release memory from RE
 546     ($RELEASE $mv2)
 547     $ms
 548   )
 549
 550   (func $main (param $argc i32 $argv i32) (result i32)
 551     (LET $line (STATIC_ARRAY 201)
 552          $res 0 $repl_env 0 $ms 0
 553          ;; argument processing
 554          $i 0 $ret 0 $empty 0 $current 0 $val2 0)
 555
 556     ;; DEBUG
 557 ;;    ($printf_1 "argc: 0x%x\n" $argc)
 558 ;;    ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase))
 559 ;;    ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start))
 560 ;;    ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end))
 561 ;;    ($printf_1 "mem: 0x%x\n" (global.get $mem))
 562 ;;    ($printf_1 "string_mem: %d\n" (global.get $string_mem))
 563
 564     (global.set $repl_env ($ENV_NEW (global.get $NIL)))
 565     (local.set $repl_env (global.get $repl_env))
 566
 567     ;; core.EXT: defined in wasm
 568     ($add_core_ns $repl_env)
 569     (drop ($ENV_SET_S $repl_env "eval" ($FUNCTION 0)))
 570
 571     ($checkpoint_user_memory)
 572
 573     ;; core.mal: defined using the language itself
 574     ($RELEASE ($RE "(def! *host-language* \"WebAssembly\")" $repl_env))
 575     ($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env))
 576     ($RELEASE ($RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" $repl_env))
 577     ($RELEASE ($RE "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))" $repl_env))
 578
 579     ;; Command line arguments
 580     (local.set $res ($MAP_LOOP_START (global.get $LIST_T)))
 581     ;; push MAP_LOP stack
 582     ;; empty = current = ret = res
 583     (local.set $ret $res)
 584     (local.set $current $res)
 585     (local.set $empty $res)
 586
 587     (local.set $i 2)
 588     (block $done
 589       (loop $loop
 590         (br_if $done (i32.ge_u $i $argc))
 591
 592         (local.set $val2 ($STRING (global.get $STRING_T)
 593                                   (i32.load (i32.add $argv (i32.mul $i 4)))))
 594
 595         ;; MAP_LOOP_UPDATE
 596         (local.set $res ($MAP_LOOP_UPDATE
 597                           (global.get $LIST_T) $empty $current $val2 0))
 598         (if (i32.le_u $current (global.get $EMPTY_HASHMAP))
 599           ;; if first element, set return to new element
 600           (local.set $ret $res))
 601         ;; update current to point to new element
 602         (local.set $current $res)
 603
 604         (local.set $i (i32.add $i 1))
 605         (br $loop)
 606       )
 607     )
 608     (drop ($ENV_SET_S $repl_env "*ARGV*" $ret))
 609
 610
 611     ;;($PR_MEMORY -1 -1)
 612
 613     (if (i32.gt_u $argc 1)
 614       (then
 615         (drop ($ENV_SET_S $repl_env
 616                           "*FILE*" ($STRING (global.get $STRING_T)
 617                                             (i32.load (i32.add $argv 4)))))
 618         ($RELEASE ($RE "(load-file *FILE*)" $repl_env))
 619         (if (global.get $error_type)
 620           (then
 621             ($printf_1 "Error: %s\n" (global.get $error_str))
 622             (return 1))
 623           (else
 624             (return 0)))))
 625
 626     ($RELEASE ($RE "(println (str \"Mal [\" *host-language* \"]\"))" $repl_env))
 627
 628     ;; Start REPL
 629     (block $repl_done
 630       (loop $repl_loop
 631         (br_if $repl_done (i32.eqz ($readline "user> " $line)))
 632         (br_if $repl_loop (i32.eq (i32.load8_u $line) 0))
 633         (local.set $res ($REP $line $repl_env))
 634         (if (global.get $error_type)
 635           (then
 636             (if (i32.eq 2 (global.get $error_type))
 637               (then
 638                 (local.set $ms ($pr_str (global.get $error_val) 1))
 639                 ($printf_1 "Error: %s\n" ($to_String $ms))
 640                 ($RELEASE $ms)
 641                 ($RELEASE (global.get $error_val)))
 642               (else
 643                 ($printf_1 "Error: %s\n" (global.get $error_str))))
 644             (global.set $error_type 0))
 645           (else
 646             ($printf_1 "%s\n" ($to_String $res))))
 647         ($RELEASE $res)
 648         ;;($PR_MEMORY_SUMMARY_SMALL)
 649         (br $repl_loop)
 650       )
 651     )
 652
 653     ($print "\n")
 654     ;;($PR_MEMORY -1 -1)
 655     0
 656   )
 657
 658 )
 659