(module $step2_eval (global $repl_env (mut i32) (i32.const 0)) ;; READ (func $READ (param $str i32) (result i32) ($read_str $str) ) ;; EVAL (func $EVAL_AST (param $ast i32 $env i32) (result i32) (local $res2 i64) (LET $res 0 $val2 0 $val3 0 $type 0 $found 0 $ret 0 $empty 0 $current 0) (if (global.get $error_type) (return 0)) (local.set $type ($TYPE $ast)) ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast) ;;; switch(type) (block $done (block $default (block (block (br_table 2 2 2 2 2 0 1 1 1 2 2 2 2 2 2 2 $type)) ;; symbol ;; found/res returned as hi 32/lo 32 of i64 (local.set $res2 ($HASHMAP_GET $env $ast)) (local.set $res (i32.wrap_i64 $res2)) (local.set $found (i32.wrap_i64 (i64.shr_u $res2 (i64.const 32)))) (if (i32.eqz $found) ($THROW_STR_1 "'%s' not found" ($to_String $ast))) (local.set $res ($INC_REF $res)) (br $done)) ;; list, vector, hashmap ;; MAP_LOOP_START (local.set $res ($MAP_LOOP_START $type)) ;; push MAP_LOOP stack ;;; empty = current = ret = res (local.set $ret $res) (local.set $current $res) (local.set $empty $res) (block $done (loop $loop ;; check if we are done evaluating the source sequence (br_if $done (i32.eq ($VAL0 $ast) 0)) (if (i32.eq $type (global.get $HASHMAP_T)) (then (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env))) (else (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env)))) (local.set $val2 $res) ;; if error, release the unattached element (if (global.get $error_type) (then ($RELEASE $res) (local.set $res 0) (br $done))) ;; for hash-maps, copy the key (inc ref since we are going ;; to release it below) (if (i32.eq $type (global.get $HASHMAP_T)) (then (local.set $val3 $val2) (local.set $val2 ($MEM_VAL1_ptr $ast)) (drop ($INC_REF $val2)))) ;; MAP_LOOP_UPDATE (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) ;; if first element, set return to new element (local.set $ret $res)) ;; update current to point to new element (local.set $current $res) (local.set $ast ($MEM_VAL0_ptr $ast)) (br $loop) ) ) ;; MAP_LOOP_DONE (local.set $res $ret) ;; EVAL_AST_RETURN: nothing to do (br $done)) ;; default (local.set $res ($INC_REF $ast)) ) $res ) (type $fnT (func (param i32) (result i32))) (table funcref (elem $add $subtract $multiply $divide)) (func $EVAL (param $ast i32 $env i32) (result i32) (LET $res 0 $ftype 0 $f_args 0 $f 0 $args 0) (local.set $f_args 0) (local.set $f 0) (local.set $args 0) (if (global.get $error_type) (return 0)) ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast) (if (i32.ne ($TYPE $ast) (global.get $LIST_T)) (return ($EVAL_AST $ast $env))) ;; APPLY_LIST (if ($EMPTY_Q $ast) (return ($INC_REF $ast))) ;; EVAL_INVOKE (local.set $res ($EVAL_AST $ast $env)) (local.set $f_args $res) ;; if error, return f/args for release by caller (if (global.get $error_type) (return $f_args)) (local.set $args ($MEM_VAL0_ptr $f_args)) ;; rest (local.set $f ($MEM_VAL1_ptr $f_args)) ;; value (local.set $ftype ($TYPE $f)) (if (i32.eq $ftype (global.get $FUNCTION_T)) (then (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f)))) (else ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) (local.set $res 0))) ($RELEASE $f_args) $res ) ;; PRINT (func $PRINT (param $ast i32) (result i32) ($pr_str $ast 1) ) ;; REPL (func $REP (param $line i32 $env i32) (result i32) (LET $mv1 0 $mv2 0 $ms 0) (block $done (local.set $mv1 ($READ $line)) (br_if $done (global.get $error_type)) (local.set $mv2 ($EVAL $mv1 $env)) (br_if $done (global.get $error_type)) ;; ($PR_MEMORY -1 -1) (local.set $ms ($PRINT $mv2)) ) ;; release memory from MAL_READ and EVAL ($RELEASE $mv2) ($RELEASE $mv1) $ms ) (func $add (param $args i32) (result i32) ($INTEGER (i32.add ($VAL0 ($MEM_VAL1_ptr $args)) ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) (func $subtract (param $args i32) (result i32) ($INTEGER (i32.sub ($VAL0 ($MEM_VAL1_ptr $args)) ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) (func $multiply (param $args i32) (result i32) ($INTEGER (i32.mul ($VAL0 ($MEM_VAL1_ptr $args)) ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) (func $divide (param $args i32) (result i32) ($INTEGER (i32.div_s ($VAL0 ($MEM_VAL1_ptr $args)) ($VAL0 ($MEM_VAL1_ptr ($MEM_VAL0_ptr $args)))))) (func $main (param $argc i32 $argv i32) (result i32) (LET $line (STATIC_ARRAY 201) $res 0 $repl_env 0) ;; DEBUG ;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) ;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) ;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) ;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) ;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) (global.set $repl_env ($HASHMAP)) (local.set $repl_env (global.get $repl_env)) (local.set $repl_env ($ASSOC1_S $repl_env "+" ($FUNCTION 0))) (local.set $repl_env ($ASSOC1_S $repl_env "-" ($FUNCTION 1))) (local.set $repl_env ($ASSOC1_S $repl_env "*" ($FUNCTION 2))) (local.set $repl_env ($ASSOC1_S $repl_env "/" ($FUNCTION 3))) ;;($PR_MEMORY -1 -1) ;; Start REPL (block $repl_done (loop $repl_loop (br_if $repl_done (i32.eqz ($readline "user> " $line))) (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) (local.set $res ($REP $line $repl_env)) (if (global.get $error_type) (then ($printf_1 "Error: %s\n" (global.get $error_str)) (global.set $error_type 0)) (else ($printf_1 "%s\n" ($to_String $res)))) ($RELEASE $res) ;;($PR_MEMORY_SUMMARY_SMALL) (br $repl_loop) ) ) ($print "\n") ;;($PR_MEMORY -1 -1) 0 ) )