From 62b9ea6f922921496aef835a3e40de2d1a61135b Mon Sep 17 00:00:00 2001 From: Nicolas Boulenguez Date: Wed, 7 Aug 2024 18:10:56 +0200 Subject: [PATCH] wasm: backport recent changes to steps0-9 --- impls/wasm/step2_eval.wam | 87 ++++++-------- impls/wasm/step3_env.wam | 98 ++++++++------- impls/wasm/step4_if_fn_do.wam | 124 ++++++++++--------- impls/wasm/step5_tco.wam | 122 +++++++++++-------- impls/wasm/step6_file.wam | 122 +++++++++++-------- impls/wasm/step7_quote.wam | 132 ++++++++++++--------- impls/wasm/step8_macros.wam | 217 ++++++++++++++-------------------- impls/wasm/step9_try.wam | 217 ++++++++++++++-------------------- 8 files changed, 552 insertions(+), 567 deletions(-) diff --git a/impls/wasm/step2_eval.wam b/impls/wasm/step2_eval.wam index fdf161a8e3..408991cd2f 100644 --- a/impls/wasm/step2_eval.wam +++ b/impls/wasm/step2_eval.wam @@ -9,8 +9,9 @@ ;; 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 + ;; Return a list/vector/map with evaluated elements + ;; of a list, vector or hashmap $ast + (LET $res 0 $val2 0 $val3 0 $type 0 $ret 0 $empty 0 $current 0) (if (global.get $error_type) (return 0)) @@ -18,23 +19,6 @@ ;;($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 @@ -43,10 +27,11 @@ (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.eqz ($VAL0 $ast)) + (then + (return $ret))) (if (i32.eq $type (global.get $HASHMAP_T)) (then @@ -59,8 +44,7 @@ (if (global.get $error_type) (then ($RELEASE $res) - (local.set $res 0) - (br $done))) + (return 0))) ;; for hash-maps, copy the key (inc ref since we are going ;; to release it below) @@ -82,16 +66,7 @@ (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))) @@ -101,25 +76,41 @@ $add $subtract $multiply $divide)) (func $EVAL (param $ast i32 $env i32) (result i32) + (local $res2 i64) (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) + $ftype 0 $f_args 0 $ast_type 0 $f 0 $args 0 $found 0) (if (global.get $error_type) (return 0)) - ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast) + ;;($PR_VALUE "EVAL: %s\n" $ast) + + (local.set $ast_type ($TYPE $ast)) + + (if (i32.eq $ast_type (global.get $SYMBOL_T)) + (then + (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))) + (return ($INC_REF $res)))) + + (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) + (i32.eq $ast_type (global.get $HASHMAP_T))) + (then + (return ($EVAL_AST $ast $env)))) - (if (i32.ne ($TYPE $ast) (global.get $LIST_T)) - (return ($EVAL_AST $ast $env))) + (if (OR (i32.ne $ast_type (global.get $LIST_T)) + ($EMPTY_Q $ast)) + (then + (return ($INC_REF $ast)))) ;; APPLY_LIST - (if ($EMPTY_Q $ast) - (return ($INC_REF $ast))) ;; EVAL_INVOKE + (local.set $res ($EVAL_AST $ast $env)) (local.set $f_args $res) @@ -133,14 +124,14 @@ (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))) + (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))) + ($RELEASE $f_args) + (return $res)) + ) + ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) ($RELEASE $f_args) - - $res + (return 0) ) ;; PRINT diff --git a/impls/wasm/step3_env.wam b/impls/wasm/step3_env.wam index c756dff984..6135e1d722 100644 --- a/impls/wasm/step3_env.wam +++ b/impls/wasm/step3_env.wam @@ -1,6 +1,7 @@ (module $step3_env (global $repl_env (mut i32) (i32.const 0)) + (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED ;; READ (func $READ (param $str i32) (result i32) @@ -9,7 +10,9 @@ ;; EVAL (func $EVAL_AST (param $ast i32 $env i32) (result i32) - (LET $res 0 $val2 0 $val3 0 $type 0 $found 0 + ;; Return a list/vector/map with evaluated elements + ;; of a list, vector or hashmap $ast + (LET $res 0 $val2 0 $val3 0 $type 0 $ret 0 $empty 0 $current 0) (if (global.get $error_type) (return 0)) @@ -17,15 +20,6 @@ ;;($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 $res ($ENV_GET $env $ast)) - (br $done)) - ;; list, vector, hashmap ;; MAP_LOOP_START (local.set $res ($MAP_LOOP_START $type)) ;; push MAP_LOOP stack @@ -34,10 +28,11 @@ (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.eqz ($VAL0 $ast)) + (then + (return $ret))) (if (i32.eq $type (global.get $HASHMAP_T)) (then @@ -50,8 +45,7 @@ (if (global.get $error_type) (then ($RELEASE $res) - (local.set $res 0) - (br $done))) + (return 0))) ;; for hash-maps, copy the key (inc ref since we are going ;; to release it below) @@ -73,16 +67,7 @@ (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))) @@ -98,26 +83,44 @@ (func $MAL_GET_A3 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) + (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) + (local $res_env i64 $value i32) + (local.set $res_env ($ENV_FIND $env (global.get $DEBUG_EVAL_S))) + (if (i32.wrap_i64 $res_env) + (then + (local.set $value (i32.wrap_i64 (i64.shr_u $res_env (i64.const 32)))) + (if (AND (i32.ne $value (global.get $NIL)) + (i32.ne $value (global.get $FALSE))) + (then + ($PR_VALUE "EVAL: %s\n" $ast)))))) + (func $EVAL (param $ast i32 $env i32) (result i32) (LET $res 0 - $ftype 0 $f_args 0 $f 0 $args 0 + $ftype 0 $f_args 0 $ast_type 0 $f 0 $args 0 $a0 0 $a0sym 0 $a1 0 $a2 0 $let_env 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) + ($ECHO_IF_DEBUG_EVAL $ast $env) + + (local.set $ast_type ($TYPE $ast)) - (if (i32.ne ($TYPE $ast) (global.get $LIST_T)) - (return ($EVAL_AST $ast $env))) + (if (i32.eq $ast_type (global.get $SYMBOL_T)) + (then + (return ($ENV_GET $env $ast)))) + + (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) + (i32.eq $ast_type (global.get $HASHMAP_T))) + (then + (return ($EVAL_AST $ast $env)))) + + (if (OR (i32.ne $ast_type (global.get $LIST_T)) + ($EMPTY_Q $ast)) + (then + (return ($INC_REF $ast)))) ;; APPLY_LIST - (if ($EMPTY_Q $ast) - (return ($INC_REF $ast))) (local.set $a0 ($MEM_VAL1_ptr $ast)) (local.set $a0sym "") @@ -132,8 +135,9 @@ (if (global.get $error_type) (return $res)) ;; set a1 in env to a2 - (local.set $res ($ENV_SET $env $a1 $res))) - (else (if (i32.eqz ($strcmp "let*" $a0sym)) + (return ($ENV_SET $env $a1 $res))) + ) + (if (i32.eqz ($strcmp "let*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) @@ -148,7 +152,9 @@ (local.set $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $let_env)) - (br_if $done (global.get $error_type)) + (if (global.get $error_type) + (then + (return 0))) ;; set key/value in the let environment (local.set $res ($ENV_SET $let_env ($MEM_VAL1_ptr $a1) $res)) @@ -162,9 +168,11 @@ ) (local.set $res ($EVAL $a2 $let_env)) ;; EVAL_RETURN - ($RELEASE $let_env)) - (else + ($RELEASE $let_env) + (return $res)) + ) ;; EVAL_INVOKE + (local.set $res ($EVAL_AST $ast $env)) (local.set $f_args $res) @@ -178,14 +186,14 @@ (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))))) + (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))) + ($RELEASE $f_args) + (return $res)) + ) - $res + ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) + ($RELEASE $f_args) + (return 0) ) ;; PRINT diff --git a/impls/wasm/step4_if_fn_do.wam b/impls/wasm/step4_if_fn_do.wam index c984bf57e4..26020305e5 100644 --- a/impls/wasm/step4_if_fn_do.wam +++ b/impls/wasm/step4_if_fn_do.wam @@ -1,6 +1,7 @@ (module $step4_if_fn_do (global $repl_env (mut i32) (i32.const 0)) + (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED ;; READ (func $READ (param $str i32) (result i32) @@ -9,7 +10,9 @@ ;; EVAL (func $EVAL_AST (param $ast i32 $env i32) (result i32) - (LET $res 0 $val2 0 $val3 0 $type 0 $found 0 + ;; Return a list/vector/map with evaluated elements + ;; of a list, vector or hashmap $ast + (LET $res 0 $val2 0 $val3 0 $type 0 $ret 0 $empty 0 $current 0) (if (global.get $error_type) (return 0)) @@ -17,15 +20,6 @@ ;;($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 $res ($ENV_GET $env $ast)) - (br $done)) - ;; list, vector, hashmap ;; MAP_LOOP_START (local.set $res ($MAP_LOOP_START $type)) ;; push MAP_LOOP stack @@ -34,10 +28,11 @@ (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.eqz ($VAL0 $ast)) + (then + (return $ret))) (if (i32.eq $type (global.get $HASHMAP_T)) (then @@ -50,8 +45,7 @@ (if (global.get $error_type) (then ($RELEASE $res) - (local.set $res 0) - (br $done))) + (return 0))) ;; for hash-maps, copy the key (inc ref since we are going ;; to release it below) @@ -73,16 +67,7 @@ (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 ) (func $MAL_GET_A1 (param $ast i32) (result i32) @@ -92,26 +77,44 @@ (func $MAL_GET_A3 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) + (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) + (local $res_env i64 $value i32) + (local.set $res_env ($ENV_FIND $env (global.get $DEBUG_EVAL_S))) + (if (i32.wrap_i64 $res_env) + (then + (local.set $value (i32.wrap_i64 (i64.shr_u $res_env (i64.const 32)))) + (if (AND (i32.ne $value (global.get $NIL)) + (i32.ne $value (global.get $FALSE))) + (then + ($PR_VALUE "EVAL: %s\n" $ast)))))) + (func $EVAL (param $ast i32 $env i32) (result i32) (LET $res 0 $el 0 - $ftype 0 $f_args 0 $f 0 $args 0 + $ftype 0 $f_args 0 $ast_type 0 $f 0 $args 0 $a0 0 $a0sym 0 $a1 0 $a2 0 $a3 0 $let_env 0 $fn_env 0 $a 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) + ($ECHO_IF_DEBUG_EVAL $ast $env) + + (local.set $ast_type ($TYPE $ast)) + + (if (i32.eq $ast_type (global.get $SYMBOL_T)) + (then + (return ($ENV_GET $env $ast)))) + + (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) + (i32.eq $ast_type (global.get $HASHMAP_T))) + (then + (return ($EVAL_AST $ast $env)))) - (if (i32.ne ($TYPE $ast) (global.get $LIST_T)) - (return ($EVAL_AST $ast $env))) + (if (OR (i32.ne $ast_type (global.get $LIST_T)) + ($EMPTY_Q $ast)) + (then + (return ($INC_REF $ast)))) ;; APPLY_LIST - (if ($EMPTY_Q $ast) - (return ($INC_REF $ast))) (local.set $a0 ($MEM_VAL1_ptr $ast)) (local.set $a0sym "") @@ -126,8 +129,9 @@ (if (global.get $error_type) (return $res)) ;; set a1 in env to a2 - (local.set $res ($ENV_SET $env $a1 $res))) - (else (if (i32.eqz ($strcmp "let*" $a0sym)) + (return ($ENV_SET $env $a1 $res))) + ) + (if (i32.eqz ($strcmp "let*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) @@ -142,7 +146,9 @@ (local.set $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $let_env)) - (br_if $done (global.get $error_type)) + (if (global.get $error_type) + (then + (return 0))) ;; set key/value in the let environment (local.set $res ($ENV_SET $let_env ($MEM_VAL1_ptr $a1) $res)) @@ -156,13 +162,17 @@ ) (local.set $res ($EVAL $a2 $let_env)) ;; EVAL_RETURN - ($RELEASE $let_env)) - (else (if (i32.eqz ($strcmp "do" $a0sym)) + ($RELEASE $let_env) + (return $res)) + ) + (if (i32.eqz ($strcmp "do" $a0sym)) (then (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env)) (local.set $res ($LAST $el)) - ($RELEASE $el)) - (else (if (i32.eqz ($strcmp "if" $a0sym)) + ($RELEASE $el) + (return $res)) + ) + (if (i32.eqz ($strcmp "if" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $res ($EVAL $a1 $env)) @@ -176,21 +186,23 @@ ;; if no false case (A3), return nil (if (i32.lt_u ($COUNT $ast) 4) (then - (local.set $res ($INC_REF (global.get $NIL)))) + (return ($INC_REF (global.get $NIL)))) (else (local.set $a3 ($MAL_GET_A3 $ast)) - (local.set $res ($EVAL $a3 $env))))) + (return ($EVAL $a3 $env))))) (else ($RELEASE $res) (local.set $a2 ($MAL_GET_A2 $ast)) - (local.set $res ($EVAL $a2 $env))))))) - (else (if (i32.eqz ($strcmp "fn*" $a0sym)) + (return ($EVAL $a2 $env))))))) + ) + (if (i32.eqz ($strcmp "fn*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) - (local.set $res ($ALLOC (global.get $MALFUNC_T) $a2 $a1 $env))) - (else + (return ($ALLOC (global.get $MALFUNC_T) $a2 $a1 $env))) + ) ;; EVAL_INVOKE + (local.set $res ($EVAL_AST $ast $env)) (local.set $f_args $res) @@ -205,9 +217,10 @@ (if (i32.eq $ftype (global.get $FUNCTION_T)) (then (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))) - ;; release f/args - ($RELEASE $f_args)) - (else (if (i32.eq $ftype (global.get $MALFUNC_T)) + ($RELEASE $f_args) + (return $res)) + ) + (if (i32.eq $ftype (global.get $MALFUNC_T)) (then (local.set $fn_env ($ENV_NEW_BINDS ($MEM_VAL2_ptr $f) ($MEM_VAL1_ptr $f) $args)) @@ -222,14 +235,14 @@ (local.set $res ($EVAL $a $fn_env)) ;; EVAL_RETURN ($RELEASE $fn_env) - ($RELEASE $a)) - (else + ($RELEASE $a) + (return $res)) + ) ;; create new environment using env and params stored in function - ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) - (local.set $res 0) - ($RELEASE $f_args))))))))))))))) - $res + ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) + ($RELEASE $f_args) + (return 0) ) ;; PRINT @@ -278,6 +291,7 @@ ;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) ;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) + (global.set $DEBUG_EVAL_S ($STRING (global.get $SYMBOL_T) "DEBUG-EVAL")) (global.set $repl_env ($ENV_NEW (global.get $NIL))) (local.set $repl_env (global.get $repl_env)) diff --git a/impls/wasm/step5_tco.wam b/impls/wasm/step5_tco.wam index 1268d46b54..8751a0e699 100644 --- a/impls/wasm/step5_tco.wam +++ b/impls/wasm/step5_tco.wam @@ -1,6 +1,7 @@ (module $step5_tco (global $repl_env (mut i32) (i32.const 0)) + (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED ;; READ (func $READ (param $str i32) (result i32) @@ -9,7 +10,9 @@ ;; EVAL (func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32) - (LET $res 0 $val2 0 $val3 0 $type 0 $found 0 + ;; Return a list/vector/map with evaluated elements + ;; of a list, vector or hashmap $ast + (LET $res 0 $val2 0 $val3 0 $type 0 $ret 0 $empty 0 $current 0) (if (global.get $error_type) (return 0)) @@ -17,15 +20,6 @@ ;;($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 $res ($ENV_GET $env $ast)) - (br $done)) - ;; list, vector, hashmap ;; MAP_LOOP_START (local.set $res ($MAP_LOOP_START $type)) ;; push MAP_LOOP stack @@ -34,13 +28,13 @@ (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 $skiplast - (br_if $done (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) + (if (OR (i32.eqz ($VAL0 $ast)) + (AND $skiplast + (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) + (then + (return $ret))) (if (i32.eq $type (global.get $HASHMAP_T)) (then @@ -53,8 +47,7 @@ (if (global.get $error_type) (then ($RELEASE $res) - (local.set $res 0) - (br $done))) + (return 0))) ;; for hash-maps, copy the key (inc ref since we are going ;; to release it below) @@ -76,16 +69,7 @@ (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 ) (func $MAL_GET_A1 (param $ast i32) (result i32) @@ -95,33 +79,54 @@ (func $MAL_GET_A3 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) + (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) + (local $res_env i64 $value i32) + (local.set $res_env ($ENV_FIND $env (global.get $DEBUG_EVAL_S))) + (if (i32.wrap_i64 $res_env) + (then + (local.set $value (i32.wrap_i64 (i64.shr_u $res_env (i64.const 32)))) + (if (AND (i32.ne $value (global.get $NIL)) + (i32.ne $value (global.get $FALSE))) + (then + ($PR_VALUE "EVAL: %s\n" $ast)))))) + (func $EVAL (param $orig_ast i32 $orig_env i32) (result i32) (LET $ast $orig_ast $env $orig_env $prev_ast 0 $prev_env 0 $res 0 $el 0 - $ftype 0 $f_args 0 $f 0 $args 0 + $ftype 0 $ast_type 0 $f 0 $args 0 $a0 0 $a0sym 0 $a1 0 $a2 0) (block $EVAL_return (loop $TCO_loop - (local.set $f_args 0) - (local.set $f 0) - (local.set $args 0) - (if (global.get $error_type) (then (local.set $res 0) (br $EVAL_return))) - ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast) + ($ECHO_IF_DEBUG_EVAL $ast $env) + + (local.set $ast_type ($TYPE $ast)) + + (if (i32.eq $ast_type (global.get $SYMBOL_T)) + (then + (local.set $res ($ENV_GET $env $ast)) + (br $EVAL_return))) - (if (i32.ne ($TYPE $ast) (global.get $LIST_T)) + (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) + (i32.eq $ast_type (global.get $HASHMAP_T))) (then (local.set $res ($EVAL_AST $ast $env 0)) (br $EVAL_return))) + (if (i32.ne $ast_type (global.get $LIST_T)) + (then + (local.set $res ($INC_REF $ast)) + (br $EVAL_return))) + ;; APPLY_LIST + (if ($EMPTY_Q $ast) (then (local.set $res ($INC_REF $ast)) @@ -142,7 +147,8 @@ ;; set a1 in env to a2 (local.set $res ($ENV_SET $env $a1 $res)) (br $EVAL_return)) - (else (if (i32.eqz ($strcmp "let*" $a0sym)) + ) + (if (i32.eqz ($strcmp "let*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) @@ -178,7 +184,8 @@ (local.set $ast $a2) (br $TCO_loop)) - (else (if (i32.eqz ($strcmp "do" $a0sym)) + ) + (if (i32.eqz ($strcmp "do" $a0sym)) (then ;; EVAL the rest through second to last (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1)) @@ -186,7 +193,8 @@ ($RELEASE $ast) ;; we already own it via ast ($RELEASE $el) (br $TCO_loop)) - (else (if (i32.eqz ($strcmp "if" $a0sym)) + ) + (if (i32.eqz ($strcmp "if" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $res ($EVAL $a1 $env)) @@ -208,34 +216,43 @@ ($RELEASE $res) (local.set $ast ($MAL_GET_A2 $ast)))))) (br $TCO_loop)) - (else (if (i32.eqz ($strcmp "fn*" $a0sym)) + ) + (if (i32.eqz ($strcmp "fn*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $res ($MALFUNC $a2 $a1 $env)) (br $EVAL_return)) - (else + ) ;; EVAL_INVOKE - (local.set $res ($EVAL_AST $ast $env 0)) - (local.set $f_args $res) + ;; Evaluate the first element to find a function. + (local.set $f ($EVAL $a0 $env)) + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + + (local.set $ftype ($TYPE $f)) + + ;; Evaluate the arguments. + (local.set $args ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 0)) ;; if error, return f/args for release by caller (if (global.get $error_type) (then - (local.set $res $f_args) + (local.set $res $f) + ($RELEASE $args) (br $EVAL_return))) - (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))) ;; release f/args - ($RELEASE $f_args) + ($RELEASE $f) + ($RELEASE $args) (br $EVAL_return)) - (else (if (i32.eq $ftype (global.get $MALFUNC_T)) + ) + (if (i32.eq $ftype (global.get $MALFUNC_T)) (then ;; save the current environment for release (local.set $prev_env $env) @@ -262,14 +279,16 @@ (local.set $prev_ast $ast) ;; release f/args - ($RELEASE $f_args) + ($RELEASE $f) + ($RELEASE $args) (br $TCO_loop)) - (else + ) ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) (local.set $res 0) - ($RELEASE $f_args) - (br $EVAL_return))))))))))))))) + ($RELEASE $f) + ($RELEASE $args) + (br $EVAL_return) ) ;; end of TCO_loop ) ;; end of EVAL_return @@ -327,6 +346,7 @@ ;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) ;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) + (global.set $DEBUG_EVAL_S ($STRING (global.get $SYMBOL_T) "DEBUG-EVAL")) (global.set $repl_env ($ENV_NEW (global.get $NIL))) (local.set $repl_env (global.get $repl_env)) diff --git a/impls/wasm/step6_file.wam b/impls/wasm/step6_file.wam index e6afbb4a90..813f7f487a 100644 --- a/impls/wasm/step6_file.wam +++ b/impls/wasm/step6_file.wam @@ -1,6 +1,7 @@ (module $step6_file (global $repl_env (mut i32) (i32.const 0)) + (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED ;; READ (func $READ (param $str i32) (result i32) @@ -9,7 +10,9 @@ ;; EVAL (func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32) - (LET $res 0 $val2 0 $val3 0 $type 0 $found 0 + ;; Return a list/vector/map with evaluated elements + ;; of a list, vector or hashmap $ast + (LET $res 0 $val2 0 $val3 0 $type 0 $ret 0 $empty 0 $current 0) (if (global.get $error_type) (return 0)) @@ -17,15 +20,6 @@ ;;($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 $res ($ENV_GET $env $ast)) - (br $done)) - ;; list, vector, hashmap ;; MAP_LOOP_START (local.set $res ($MAP_LOOP_START $type)) ;; push MAP_LOOP stack @@ -34,13 +28,13 @@ (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 $skiplast - (br_if $done (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) + (if (OR (i32.eqz ($VAL0 $ast)) + (AND $skiplast + (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) + (then + (return $ret))) (if (i32.eq $type (global.get $HASHMAP_T)) (then @@ -53,8 +47,7 @@ (if (global.get $error_type) (then ($RELEASE $res) - (local.set $res 0) - (br $done))) + (return 0))) ;; for hash-maps, copy the key (inc ref since we are going ;; to release it below) @@ -76,16 +69,7 @@ (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 ) (func $MAL_GET_A1 (param $ast i32) (result i32) @@ -95,33 +79,54 @@ (func $MAL_GET_A3 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) + (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) + (local $res_env i64 $value i32) + (local.set $res_env ($ENV_FIND $env (global.get $DEBUG_EVAL_S))) + (if (i32.wrap_i64 $res_env) + (then + (local.set $value (i32.wrap_i64 (i64.shr_u $res_env (i64.const 32)))) + (if (AND (i32.ne $value (global.get $NIL)) + (i32.ne $value (global.get $FALSE))) + (then + ($PR_VALUE "EVAL: %s\n" $ast)))))) + (func $EVAL (param $orig_ast i32 $orig_env i32) (result i32) (LET $ast $orig_ast $env $orig_env $prev_ast 0 $prev_env 0 $res 0 $el 0 - $ftype 0 $f_args 0 $f 0 $args 0 + $ftype 0 $ast_type 0 $f 0 $args 0 $a0 0 $a0sym 0 $a1 0 $a2 0) (block $EVAL_return (loop $TCO_loop - (local.set $f_args 0) - (local.set $f 0) - (local.set $args 0) - (if (global.get $error_type) (then (local.set $res 0) (br $EVAL_return))) - ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast) + ($ECHO_IF_DEBUG_EVAL $ast $env) + + (local.set $ast_type ($TYPE $ast)) + + (if (i32.eq $ast_type (global.get $SYMBOL_T)) + (then + (local.set $res ($ENV_GET $env $ast)) + (br $EVAL_return))) - (if (i32.ne ($TYPE $ast) (global.get $LIST_T)) + (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) + (i32.eq $ast_type (global.get $HASHMAP_T))) (then (local.set $res ($EVAL_AST $ast $env 0)) (br $EVAL_return))) + (if (i32.ne $ast_type (global.get $LIST_T)) + (then + (local.set $res ($INC_REF $ast)) + (br $EVAL_return))) + ;; APPLY_LIST + (if ($EMPTY_Q $ast) (then (local.set $res ($INC_REF $ast)) @@ -142,7 +147,8 @@ ;; set a1 in env to a2 (local.set $res ($ENV_SET $env $a1 $res)) (br $EVAL_return)) - (else (if (i32.eqz ($strcmp "let*" $a0sym)) + ) + (if (i32.eqz ($strcmp "let*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) @@ -178,7 +184,8 @@ (local.set $ast $a2) (br $TCO_loop)) - (else (if (i32.eqz ($strcmp "do" $a0sym)) + ) + (if (i32.eqz ($strcmp "do" $a0sym)) (then ;; EVAL the rest through second to last (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1)) @@ -186,7 +193,8 @@ ($RELEASE $ast) ;; we already own it via ast ($RELEASE $el) (br $TCO_loop)) - (else (if (i32.eqz ($strcmp "if" $a0sym)) + ) + (if (i32.eqz ($strcmp "if" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $res ($EVAL $a1 $env)) @@ -208,27 +216,34 @@ ($RELEASE $res) (local.set $ast ($MAL_GET_A2 $ast)))))) (br $TCO_loop)) - (else (if (i32.eqz ($strcmp "fn*" $a0sym)) + ) + (if (i32.eqz ($strcmp "fn*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $res ($MALFUNC $a2 $a1 $env)) (br $EVAL_return)) - (else + ) ;; EVAL_INVOKE - (local.set $res ($EVAL_AST $ast $env 0)) - (local.set $f_args $res) + ;; Evaluate the first element to find a function. + (local.set $f ($EVAL $a0 $env)) + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + + (local.set $ftype ($TYPE $f)) + + ;; Evaluate the arguments. + (local.set $args ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 0)) ;; if error, return f/args for release by caller (if (global.get $error_type) (then - (local.set $res $f_args) + (local.set $res $f) + ($RELEASE $args) (br $EVAL_return))) - (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 (if (i32.eq ($VAL0 $f) 0) ;; eval @@ -238,9 +253,11 @@ (else (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))))) ;; release f/args - ($RELEASE $f_args) + ($RELEASE $f) + ($RELEASE $args) (br $EVAL_return)) - (else (if (i32.eq $ftype (global.get $MALFUNC_T)) + ) + (if (i32.eq $ftype (global.get $MALFUNC_T)) (then ;; save the current environment for release (local.set $prev_env $env) @@ -267,14 +284,16 @@ (local.set $prev_ast $ast) ;; release f/args - ($RELEASE $f_args) + ($RELEASE $f) + ($RELEASE $args) (br $TCO_loop)) - (else + ) ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) (local.set $res 0) - ($RELEASE $f_args) - (br $EVAL_return))))))))))))))) + ($RELEASE $f) + ($RELEASE $args) + (br $EVAL_return) ) ;; end of TCO_loop ) ;; end of EVAL_return @@ -335,6 +354,7 @@ ;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) ;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) + (global.set $DEBUG_EVAL_S ($STRING (global.get $SYMBOL_T) "DEBUG-EVAL")) (global.set $repl_env ($ENV_NEW (global.get $NIL))) (local.set $repl_env (global.get $repl_env)) diff --git a/impls/wasm/step7_quote.wam b/impls/wasm/step7_quote.wam index 0da34e3a44..9127aa9efe 100644 --- a/impls/wasm/step7_quote.wam +++ b/impls/wasm/step7_quote.wam @@ -1,6 +1,7 @@ (module $step7_quote (global $repl_env (mut i32) (i32.const 0)) + (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED ;; READ (func $READ (param $str i32) (result i32) @@ -89,7 +90,9 @@ (func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32) - (LET $res 0 $val2 0 $val3 0 $type 0 $found 0 + ;; Return a list/vector/map with evaluated elements + ;; of a list, vector or hashmap $ast + (LET $res 0 $val2 0 $val3 0 $type 0 $ret 0 $empty 0 $current 0) (if (global.get $error_type) (return 0)) @@ -97,15 +100,6 @@ ;;($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 $res ($ENV_GET $env $ast)) - (br $done)) - ;; list, vector, hashmap ;; MAP_LOOP_START (local.set $res ($MAP_LOOP_START $type)) ;; push MAP_LOOP stack @@ -114,13 +108,13 @@ (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 $skiplast - (br_if $done (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) + (if (OR (i32.eqz ($VAL0 $ast)) + (AND $skiplast + (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) + (then + (return $ret))) (if (i32.eq $type (global.get $HASHMAP_T)) (then @@ -133,8 +127,7 @@ (if (global.get $error_type) (then ($RELEASE $res) - (local.set $res 0) - (br $done))) + (return 0))) ;; for hash-maps, copy the key (inc ref since we are going ;; to release it below) @@ -156,16 +149,7 @@ (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 ) (func $MAL_GET_A1 (param $ast i32) (result i32) @@ -175,33 +159,54 @@ (func $MAL_GET_A3 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) + (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) + (local $res_env i64 $value i32) + (local.set $res_env ($ENV_FIND $env (global.get $DEBUG_EVAL_S))) + (if (i32.wrap_i64 $res_env) + (then + (local.set $value (i32.wrap_i64 (i64.shr_u $res_env (i64.const 32)))) + (if (AND (i32.ne $value (global.get $NIL)) + (i32.ne $value (global.get $FALSE))) + (then + ($PR_VALUE "EVAL: %s\n" $ast)))))) + (func $EVAL (param $orig_ast i32 $orig_env i32) (result i32) (LET $ast $orig_ast $env $orig_env $prev_ast 0 $prev_env 0 $res 0 $el 0 - $ftype 0 $f_args 0 $f 0 $args 0 + $ftype 0 $ast_type 0 $f 0 $args 0 $a0 0 $a0sym 0 $a1 0 $a2 0) (block $EVAL_return (loop $TCO_loop - (local.set $f_args 0) - (local.set $f 0) - (local.set $args 0) - (if (global.get $error_type) (then (local.set $res 0) (br $EVAL_return))) - ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast) + ($ECHO_IF_DEBUG_EVAL $ast $env) + + (local.set $ast_type ($TYPE $ast)) + + (if (i32.eq $ast_type (global.get $SYMBOL_T)) + (then + (local.set $res ($ENV_GET $env $ast)) + (br $EVAL_return))) - (if (i32.ne ($TYPE $ast) (global.get $LIST_T)) + (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) + (i32.eq $ast_type (global.get $HASHMAP_T))) (then (local.set $res ($EVAL_AST $ast $env 0)) (br $EVAL_return))) + (if (i32.ne $ast_type (global.get $LIST_T)) + (then + (local.set $res ($INC_REF $ast)) + (br $EVAL_return))) + ;; APPLY_LIST + (if ($EMPTY_Q $ast) (then (local.set $res ($INC_REF $ast)) @@ -222,7 +227,8 @@ ;; set a1 in env to a2 (local.set $res ($ENV_SET $env $a1 $res)) (br $EVAL_return)) - (else (if (i32.eqz ($strcmp "let*" $a0sym)) + ) + (if (i32.eqz ($strcmp "let*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) @@ -258,7 +264,8 @@ (local.set $ast $a2) (br $TCO_loop)) - (else (if (i32.eqz ($strcmp "do" $a0sym)) + ) + (if (i32.eqz ($strcmp "do" $a0sym)) (then ;; EVAL the rest through second to last (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1)) @@ -266,15 +273,13 @@ ($RELEASE $ast) ;; we already own it via ast ($RELEASE $el) (br $TCO_loop)) - (else (if (i32.eqz ($strcmp "quote" $a0sym)) + ) + (if (i32.eqz ($strcmp "quote" $a0sym)) (then (local.set $res ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) (br $EVAL_return)) - (else (if (i32.eqz ($strcmp "quasiquoteexpand" $a0sym)) - (then - (local.set $res ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) - (br $EVAL_return)) - (else (if (i32.eqz ($strcmp "quasiquote" $a0sym)) + ) + (if (i32.eqz ($strcmp "quasiquote" $a0sym)) (then (local.set $ast ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) @@ -282,7 +287,8 @@ (if $prev_ast ($RELEASE $prev_ast)) (local.set $prev_ast $ast) (br $TCO_loop)) - (else (if (i32.eqz ($strcmp "if" $a0sym)) + ) + (if (i32.eqz ($strcmp "if" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $res ($EVAL $a1 $env)) @@ -304,27 +310,34 @@ ($RELEASE $res) (local.set $ast ($MAL_GET_A2 $ast)))))) (br $TCO_loop)) - (else (if (i32.eqz ($strcmp "fn*" $a0sym)) + ) + (if (i32.eqz ($strcmp "fn*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $res ($MALFUNC $a2 $a1 $env)) (br $EVAL_return)) - (else + ) ;; EVAL_INVOKE - (local.set $res ($EVAL_AST $ast $env 0)) - (local.set $f_args $res) + ;; Evaluate the first element to find a function. + (local.set $f ($EVAL $a0 $env)) + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + + (local.set $ftype ($TYPE $f)) + + ;; Evaluate the arguments. + (local.set $args ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 0)) ;; if error, return f/args for release by caller (if (global.get $error_type) (then - (local.set $res $f_args) + (local.set $res $f) + ($RELEASE $args) (br $EVAL_return))) - (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 (if (i32.eq ($VAL0 $f) 0) ;; eval @@ -334,9 +347,11 @@ (else (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))))) ;; release f/args - ($RELEASE $f_args) + ($RELEASE $f) + ($RELEASE $args) (br $EVAL_return)) - (else (if (i32.eq $ftype (global.get $MALFUNC_T)) + ) + (if (i32.eq $ftype (global.get $MALFUNC_T)) (then ;; save the current environment for release (local.set $prev_env $env) @@ -363,14 +378,16 @@ (local.set $prev_ast $ast) ;; release f/args - ($RELEASE $f_args) + ($RELEASE $f) + ($RELEASE $args) (br $TCO_loop)) - (else + ) ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) (local.set $res 0) - ($RELEASE $f_args) - (br $EVAL_return))))))))))))))))))))) + ($RELEASE $f) + ($RELEASE $args) + (br $EVAL_return) ) ;; end of TCO_loop ) ;; end of EVAL_return @@ -431,6 +448,7 @@ ;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) ;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) + (global.set $DEBUG_EVAL_S ($STRING (global.get $SYMBOL_T) "DEBUG-EVAL")) (global.set $repl_env ($ENV_NEW (global.get $NIL))) (local.set $repl_env (global.get $repl_env)) diff --git a/impls/wasm/step8_macros.wam b/impls/wasm/step8_macros.wam index 331e0d69b3..f8e58d3760 100644 --- a/impls/wasm/step8_macros.wam +++ b/impls/wasm/step8_macros.wam @@ -1,6 +1,7 @@ (module $step8_macros (global $repl_env (mut i32) (i32.const 0)) + (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED ;; READ (func $READ (param $str i32) (result i32) @@ -88,51 +89,10 @@ (return $res)) - (global $mac_stack (mut i32) (i32.const 0)) - (global $mac_stack_top (mut i32) (i32.const -1)) - - (func $MACROEXPAND (param $orig_ast i32 $env i32) (result i32) - (local $mac_env i64) - (LET $ast $orig_ast - $mac 0) - (global.set $mac_stack (STATIC_ARRAY 2048)) ;; 512 * 4, TODO: move to init - (block $done - (loop $loop - (br_if $done - (OR (i32.ne ($TYPE $ast) (global.get $LIST_T)) ;; a list - (i32.eqz ($VAL0 $ast)) ;; non-empty - (i32.ne ($TYPE ($MEM_VAL1_ptr $ast)) ;; leading symbol - (global.get $SYMBOL_T)))) - (local.set $mac_env ($ENV_FIND $env ($MEM_VAL1_ptr $ast))) - (local.set $mac (i32.wrap_i64 (i64.shr_u $mac_env (i64.const 32)))) - (br_if $done (OR (i32.eqz (i32.wrap_i64 $mac_env)) ;; defined in env - (i32.ne ($TYPE $mac) ;; a macro - (global.get $MACRO_T)))) - - (local.set $ast ($APPLY $mac ($MEM_VAL0_ptr $ast))) - ;; PEND_A_LV - ;; if ast is not the first ast that was passed in, then add it - ;; to the pending release list. - (if (i32.ne $ast $orig_ast) - (then - (global.set $mac_stack_top - (i32.add (global.get $mac_stack_top) 1)) - (if (i32.ge_s (i32.mul (global.get $mac_stack_top) 4) 2048) ;; 512 * 4 - ($fatal 7 "Exhausted mac_stack!\n")) - (i32.store (i32.add - (global.get $mac_stack) - (i32.mul (global.get $mac_stack_top) 4)) - $ast))) - (br_if $done (global.get $error_type)) - - (br $loop) - ) - ) - $ast - ) - (func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32) - (LET $res 0 $val2 0 $val3 0 $type 0 $found 0 + ;; Return a list/vector/map with evaluated elements + ;; of a list, vector or hashmap $ast + (LET $res 0 $val2 0 $val3 0 $type 0 $ret 0 $empty 0 $current 0) (if (global.get $error_type) (return 0)) @@ -140,15 +100,6 @@ ;;($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 $res ($ENV_GET $env $ast)) - (br $done)) - ;; list, vector, hashmap ;; MAP_LOOP_START (local.set $res ($MAP_LOOP_START $type)) ;; push MAP_LOOP stack @@ -157,13 +108,13 @@ (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 $skiplast - (br_if $done (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) + (if (OR (i32.eqz ($VAL0 $ast)) + (AND $skiplast + (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) + (then + (return $ret))) (if (i32.eq $type (global.get $HASHMAP_T)) (then @@ -176,8 +127,7 @@ (if (global.get $error_type) (then ($RELEASE $res) - (local.set $res 0) - (br $done))) + (return 0))) ;; for hash-maps, copy the key (inc ref since we are going ;; to release it below) @@ -199,16 +149,7 @@ (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 ) (func $MAL_GET_A1 (param $ast i32) (result i32) @@ -218,42 +159,55 @@ (func $MAL_GET_A3 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) + (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) + (local $res_env i64 $value i32) + (local.set $res_env ($ENV_FIND $env (global.get $DEBUG_EVAL_S))) + (if (i32.wrap_i64 $res_env) + (then + (local.set $value (i32.wrap_i64 (i64.shr_u $res_env (i64.const 32)))) + (if (AND (i32.ne $value (global.get $NIL)) + (i32.ne $value (global.get $FALSE))) + (then + ($PR_VALUE "EVAL: %s\n" $ast)))))) + (func $EVAL (param $orig_ast i32 $orig_env i32) (result i32) (LET $ast $orig_ast $env $orig_env - $orig_mac_stack_top (global.get $mac_stack_top) $prev_ast 0 $prev_env 0 $res 0 $el 0 - $ftype 0 $f_args 0 $f 0 $args 0 - $a0 0 $a0sym 0 $a1 0 $a2 0) + $ftype 0 $ast_type 0 $f 0 $args 0 + $a0 0 $a0sym 0 $a1 0 $a2 0 + $err 0) (block $EVAL_return (loop $TCO_loop - (local.set $f_args 0) - (local.set $f 0) - (local.set $args 0) - (if (global.get $error_type) (then (local.set $res 0) (br $EVAL_return))) - ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast) + ($ECHO_IF_DEBUG_EVAL $ast $env) - (if (i32.ne ($TYPE $ast) (global.get $LIST_T)) + (local.set $ast_type ($TYPE $ast)) + + (if (i32.eq $ast_type (global.get $SYMBOL_T)) (then - (local.set $res ($EVAL_AST $ast $env 0)) + (local.set $res ($ENV_GET $env $ast)) (br $EVAL_return))) - ;; APPLY_LIST - (local.set $ast ($MACROEXPAND $ast $env)) - ;;($PR_VALUE ">>> >>> EVAL ast: '%s'\n" $ast) - - (if (i32.ne ($TYPE $ast) (global.get $LIST_T)) + (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) + (i32.eq $ast_type (global.get $HASHMAP_T))) (then (local.set $res ($EVAL_AST $ast $env 0)) (br $EVAL_return))) + (if (i32.ne $ast_type (global.get $LIST_T)) + (then + (local.set $res ($INC_REF $ast)) + (br $EVAL_return))) + + ;; APPLY_LIST + (if ($EMPTY_Q $ast) (then (local.set $res ($INC_REF $ast)) @@ -274,7 +228,8 @@ ;; set a1 in env to a2 (local.set $res ($ENV_SET $env $a1 $res)) (br $EVAL_return)) - (else (if (i32.eqz ($strcmp "let*" $a0sym)) + ) + (if (i32.eqz ($strcmp "let*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) @@ -310,7 +265,8 @@ (local.set $ast $a2) (br $TCO_loop)) - (else (if (i32.eqz ($strcmp "do" $a0sym)) + ) + (if (i32.eqz ($strcmp "do" $a0sym)) (then ;; EVAL the rest through second to last (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1)) @@ -318,15 +274,13 @@ ($RELEASE $ast) ;; we already own it via ast ($RELEASE $el) (br $TCO_loop)) - (else (if (i32.eqz ($strcmp "quote" $a0sym)) + ) + (if (i32.eqz ($strcmp "quote" $a0sym)) (then (local.set $res ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) (br $EVAL_return)) - (else (if (i32.eqz ($strcmp "quasiquoteexpand" $a0sym)) - (then - (local.set $res ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) - (br $EVAL_return)) - (else (if (i32.eqz ($strcmp "quasiquote" $a0sym)) + ) + (if (i32.eqz ($strcmp "quasiquote" $a0sym)) (then (local.set $ast ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) @@ -334,7 +288,8 @@ (if $prev_ast ($RELEASE $prev_ast)) (local.set $prev_ast $ast) (br $TCO_loop)) - (else (if (i32.eqz ($strcmp "defmacro!" $a0sym)) + ) + (if (i32.eqz ($strcmp "defmacro!" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) @@ -345,13 +300,8 @@ ;; set a1 in env to a2 (local.set $res ($ENV_SET $env $a1 $res)) (br $EVAL_return)) - (else (if (i32.eqz ($strcmp "macroexpand" $a0sym)) - (then - ;; since we are returning it unevaluated, inc the ref cnt - (local.set $res ($INC_REF ($MACROEXPAND - ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)) - $env)))) - (else (if (i32.eqz ($strcmp "if" $a0sym)) + ) + (if (i32.eqz ($strcmp "if" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $res ($EVAL $a1 $env)) @@ -373,27 +323,44 @@ ($RELEASE $res) (local.set $ast ($MAL_GET_A2 $ast)))))) (br $TCO_loop)) - (else (if (i32.eqz ($strcmp "fn*" $a0sym)) + ) + (if (i32.eqz ($strcmp "fn*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $res ($MALFUNC $a2 $a1 $env)) (br $EVAL_return)) - (else + ) ;; EVAL_INVOKE - (local.set $res ($EVAL_AST $ast $env 0)) - (local.set $f_args $res) + ;; Evaluate the first element to find a function or macro. + (local.set $f ($EVAL $a0 $env)) + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + + (local.set $ftype ($TYPE $f)) + + (if (i32.eq $ftype (global.get $MACRO_T)) + (then + (local.set $ast ($APPLY $f ($MEM_VAL0_ptr $ast))) + ($RELEASE $f) + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + (br $TCO_loop))) + + ;; Evaluate the arguments. + (local.set $args ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 0)) ;; if error, return f/args for release by caller (if (global.get $error_type) (then - (local.set $res $f_args) + (local.set $res $f) + ($RELEASE $args) (br $EVAL_return))) - (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 (if (i32.eq ($VAL0 $f) 0) ;; eval @@ -403,9 +370,11 @@ (else (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))))) ;; release f/args - ($RELEASE $f_args) + ($RELEASE $f) + ($RELEASE $args) (br $EVAL_return)) - (else (if (i32.eq $ftype (global.get $MALFUNC_T)) + ) + (if (i32.eq $ftype (global.get $MALFUNC_T)) (then ;; save the current environment for release (local.set $prev_env $env) @@ -432,14 +401,16 @@ (local.set $prev_ast $ast) ;; release f/args - ($RELEASE $f_args) + ($RELEASE $f) + ($RELEASE $args) (br $TCO_loop)) - (else + ) ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) (local.set $res 0) - ($RELEASE $f_args) - (br $EVAL_return))))))))))))))))))))))))) + ($RELEASE $f) + ($RELEASE $args) + (br $EVAL_return) ) ;; end of TCO_loop ) ;; end of EVAL_return @@ -448,20 +419,6 @@ (if (i32.ne $env $orig_env) ($RELEASE $env)) (if $prev_ast ($RELEASE $prev_ast)) - ;; release memory from MACROEXPAND - ;; TODO: needs to happen here so self-hosting doesn't leak - (block $done - (loop $loop - (br_if $done (i32.le_s (global.get $mac_stack_top) $orig_mac_stack_top)) - ($RELEASE (i32.load (i32.add - (global.get $mac_stack) - (i32.mul (global.get $mac_stack_top) 4)))) - (global.set $mac_stack_top - (i32.sub (global.get $mac_stack_top) 1)) - (br $loop) - ) - ) - $res ) @@ -514,6 +471,7 @@ ;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) ;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) + (global.set $DEBUG_EVAL_S ($STRING (global.get $SYMBOL_T) "DEBUG-EVAL")) (global.set $repl_env ($ENV_NEW (global.get $NIL))) (local.set $repl_env (global.get $repl_env)) @@ -528,7 +486,6 @@ ($RELEASE ($RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" $repl_env)) ($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)) - ;; Command line arguments (local.set $res ($MAP_LOOP_START (global.get $LIST_T))) ;; push MAP_LOP stack diff --git a/impls/wasm/step9_try.wam b/impls/wasm/step9_try.wam index 01569353a7..9ac89481d0 100644 --- a/impls/wasm/step9_try.wam +++ b/impls/wasm/step9_try.wam @@ -1,6 +1,7 @@ (module $step9_try (global $repl_env (mut i32) (i32.const 0)) + (global $DEBUG_EVAL_S (mut i32) (i32.const 0)) ;; never $RELEASED ;; READ (func $READ (param $str i32) (result i32) @@ -88,51 +89,10 @@ (return $res)) - (global $mac_stack (mut i32) (i32.const 0)) - (global $mac_stack_top (mut i32) (i32.const -1)) - - (func $MACROEXPAND (param $orig_ast i32 $env i32) (result i32) - (local $mac_env i64) - (LET $ast $orig_ast - $mac 0) - (global.set $mac_stack (STATIC_ARRAY 2048)) ;; 512 * 4, TODO: move to init - (block $done - (loop $loop - (br_if $done - (OR (i32.ne ($TYPE $ast) (global.get $LIST_T)) ;; a list - (i32.eqz ($VAL0 $ast)) ;; non-empty - (i32.ne ($TYPE ($MEM_VAL1_ptr $ast)) ;; leading symbol - (global.get $SYMBOL_T)))) - (local.set $mac_env ($ENV_FIND $env ($MEM_VAL1_ptr $ast))) - (local.set $mac (i32.wrap_i64 (i64.shr_u $mac_env (i64.const 32)))) - (br_if $done (OR (i32.eqz (i32.wrap_i64 $mac_env)) ;; defined in env - (i32.ne ($TYPE $mac) ;; a macro - (global.get $MACRO_T)))) - - (local.set $ast ($APPLY $mac ($MEM_VAL0_ptr $ast))) - ;; PEND_A_LV - ;; if ast is not the first ast that was passed in, then add it - ;; to the pending release list. - (if (i32.ne $ast $orig_ast) - (then - (global.set $mac_stack_top - (i32.add (global.get $mac_stack_top) 1)) - (if (i32.ge_s (i32.mul (global.get $mac_stack_top) 4) 2048) ;; 512 * 4 - ($fatal 7 "Exhausted mac_stack!\n")) - (i32.store (i32.add - (global.get $mac_stack) - (i32.mul (global.get $mac_stack_top) 4)) - $ast))) - (br_if $done (global.get $error_type)) - - (br $loop) - ) - ) - $ast - ) - (func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32) - (LET $res 0 $val2 0 $val3 0 $type 0 $found 0 + ;; Return a list/vector/map with evaluated elements + ;; of a list, vector or hashmap $ast + (LET $res 0 $val2 0 $val3 0 $type 0 $ret 0 $empty 0 $current 0) (if (global.get $error_type) (return 0)) @@ -140,15 +100,6 @@ ;;($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 $res ($ENV_GET $env $ast)) - (br $done)) - ;; list, vector, hashmap ;; MAP_LOOP_START (local.set $res ($MAP_LOOP_START $type)) ;; push MAP_LOOP stack @@ -157,13 +108,13 @@ (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 $skiplast - (br_if $done (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) + (if (OR (i32.eqz ($VAL0 $ast)) + (AND $skiplast + (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) + (then + (return $ret))) (if (i32.eq $type (global.get $HASHMAP_T)) (then @@ -176,8 +127,7 @@ (if (global.get $error_type) (then ($RELEASE $res) - (local.set $res 0) - (br $done))) + (return 0))) ;; for hash-maps, copy the key (inc ref since we are going ;; to release it below) @@ -199,16 +149,7 @@ (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 ) (func $MAL_GET_A1 (param $ast i32) (result i32) @@ -218,43 +159,55 @@ (func $MAL_GET_A3 (param $ast i32) (result i32) ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) + (func $ECHO_IF_DEBUG_EVAL (param $ast i32 $env i32) + (local $res_env i64 $value i32) + (local.set $res_env ($ENV_FIND $env (global.get $DEBUG_EVAL_S))) + (if (i32.wrap_i64 $res_env) + (then + (local.set $value (i32.wrap_i64 (i64.shr_u $res_env (i64.const 32)))) + (if (AND (i32.ne $value (global.get $NIL)) + (i32.ne $value (global.get $FALSE))) + (then + ($PR_VALUE "EVAL: %s\n" $ast)))))) + (func $EVAL (param $orig_ast i32 $orig_env i32) (result i32) (LET $ast $orig_ast $env $orig_env - $orig_mac_stack_top (global.get $mac_stack_top) $prev_ast 0 $prev_env 0 $res 0 $el 0 - $ftype 0 $f_args 0 $f 0 $args 0 + $ftype 0 $ast_type 0 $f 0 $args 0 $a0 0 $a0sym 0 $a1 0 $a2 0 $err 0) (block $EVAL_return (loop $TCO_loop - (local.set $f_args 0) - (local.set $f 0) - (local.set $args 0) - (if (global.get $error_type) (then (local.set $res 0) (br $EVAL_return))) - ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast) + ($ECHO_IF_DEBUG_EVAL $ast $env) + + (local.set $ast_type ($TYPE $ast)) - (if (i32.ne ($TYPE $ast) (global.get $LIST_T)) + (if (i32.eq $ast_type (global.get $SYMBOL_T)) (then - (local.set $res ($EVAL_AST $ast $env 0)) + (local.set $res ($ENV_GET $env $ast)) (br $EVAL_return))) - ;; APPLY_LIST - (local.set $ast ($MACROEXPAND $ast $env)) - ;;($PR_VALUE ">>> >>> EVAL ast: '%s'\n" $ast) - - (if (i32.ne ($TYPE $ast) (global.get $LIST_T)) + (if (OR (i32.eq $ast_type (global.get $VECTOR_T)) + (i32.eq $ast_type (global.get $HASHMAP_T))) (then (local.set $res ($EVAL_AST $ast $env 0)) (br $EVAL_return))) + (if (i32.ne $ast_type (global.get $LIST_T)) + (then + (local.set $res ($INC_REF $ast)) + (br $EVAL_return))) + + ;; APPLY_LIST + (if ($EMPTY_Q $ast) (then (local.set $res ($INC_REF $ast)) @@ -275,7 +228,8 @@ ;; set a1 in env to a2 (local.set $res ($ENV_SET $env $a1 $res)) (br $EVAL_return)) - (else (if (i32.eqz ($strcmp "let*" $a0sym)) + ) + (if (i32.eqz ($strcmp "let*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) @@ -311,7 +265,8 @@ (local.set $ast $a2) (br $TCO_loop)) - (else (if (i32.eqz ($strcmp "do" $a0sym)) + ) + (if (i32.eqz ($strcmp "do" $a0sym)) (then ;; EVAL the rest through second to last (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1)) @@ -319,15 +274,13 @@ ($RELEASE $ast) ;; we already own it via ast ($RELEASE $el) (br $TCO_loop)) - (else (if (i32.eqz ($strcmp "quote" $a0sym)) + ) + (if (i32.eqz ($strcmp "quote" $a0sym)) (then (local.set $res ($INC_REF ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) (br $EVAL_return)) - (else (if (i32.eqz ($strcmp "quasiquoteexpand" $a0sym)) - (then - (local.set $res ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) - (br $EVAL_return)) - (else (if (i32.eqz ($strcmp "quasiquote" $a0sym)) + ) + (if (i32.eqz ($strcmp "quasiquote" $a0sym)) (then (local.set $ast ($QUASIQUOTE ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)))) @@ -335,7 +288,8 @@ (if $prev_ast ($RELEASE $prev_ast)) (local.set $prev_ast $ast) (br $TCO_loop)) - (else (if (i32.eqz ($strcmp "defmacro!" $a0sym)) + ) + (if (i32.eqz ($strcmp "defmacro!" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) @@ -346,13 +300,8 @@ ;; set a1 in env to a2 (local.set $res ($ENV_SET $env $a1 $res)) (br $EVAL_return)) - (else (if (i32.eqz ($strcmp "macroexpand" $a0sym)) - (then - ;; since we are returning it unevaluated, inc the ref cnt - (local.set $res ($INC_REF ($MACROEXPAND - ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast)) - $env)))) - (else (if (i32.eqz ($strcmp "try*" $a0sym)) + ) + (if (i32.eqz ($strcmp "try*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $res ($EVAL $a1 $env)) @@ -398,7 +347,8 @@ (local.set $ast $a2) (br $TCO_loop)) - (else (if (i32.eqz ($strcmp "if" $a0sym)) + ) + (if (i32.eqz ($strcmp "if" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $res ($EVAL $a1 $env)) @@ -420,27 +370,44 @@ ($RELEASE $res) (local.set $ast ($MAL_GET_A2 $ast)))))) (br $TCO_loop)) - (else (if (i32.eqz ($strcmp "fn*" $a0sym)) + ) + (if (i32.eqz ($strcmp "fn*" $a0sym)) (then (local.set $a1 ($MAL_GET_A1 $ast)) (local.set $a2 ($MAL_GET_A2 $ast)) (local.set $res ($MALFUNC $a2 $a1 $env)) (br $EVAL_return)) - (else + ) ;; EVAL_INVOKE - (local.set $res ($EVAL_AST $ast $env 0)) - (local.set $f_args $res) + ;; Evaluate the first element to find a function or macro. + (local.set $f ($EVAL $a0 $env)) + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + + (local.set $ftype ($TYPE $f)) + + (if (i32.eq $ftype (global.get $MACRO_T)) + (then + (local.set $ast ($APPLY $f ($MEM_VAL0_ptr $ast))) + ($RELEASE $f) + (if (global.get $error_type) + (then + (local.set $res 0) + (br $EVAL_return))) + (br $TCO_loop))) + + ;; Evaluate the arguments. + (local.set $args ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 0)) ;; if error, return f/args for release by caller (if (global.get $error_type) (then - (local.set $res $f_args) + (local.set $res $f) + ($RELEASE $args) (br $EVAL_return))) - (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 (if (i32.eq ($VAL0 $f) 0) ;; eval @@ -450,9 +417,11 @@ (else (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))))) ;; release f/args - ($RELEASE $f_args) + ($RELEASE $f) + ($RELEASE $args) (br $EVAL_return)) - (else (if (i32.eq $ftype (global.get $MALFUNC_T)) + ) + (if (i32.eq $ftype (global.get $MALFUNC_T)) (then ;; save the current environment for release (local.set $prev_env $env) @@ -479,14 +448,16 @@ (local.set $prev_ast $ast) ;; release f/args - ($RELEASE $f_args) + ($RELEASE $f) + ($RELEASE $args) (br $TCO_loop)) - (else + ) ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) (local.set $res 0) - ($RELEASE $f_args) - (br $EVAL_return))))))))))))))))))))))))))) + ($RELEASE $f) + ($RELEASE $args) + (br $EVAL_return) ) ;; end of TCO_loop ) ;; end of EVAL_return @@ -495,20 +466,6 @@ (if (i32.ne $env $orig_env) ($RELEASE $env)) (if $prev_ast ($RELEASE $prev_ast)) - ;; release memory from MACROEXPAND - ;; TODO: needs to happen here so self-hosting doesn't leak - (block $done - (loop $loop - (br_if $done (i32.le_s (global.get $mac_stack_top) $orig_mac_stack_top)) - ($RELEASE (i32.load (i32.add - (global.get $mac_stack) - (i32.mul (global.get $mac_stack_top) 4)))) - (global.set $mac_stack_top - (i32.sub (global.get $mac_stack_top) 1)) - (br $loop) - ) - ) - $res ) @@ -561,6 +518,7 @@ ;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) ;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) + (global.set $DEBUG_EVAL_S ($STRING (global.get $SYMBOL_T) "DEBUG-EVAL")) (global.set $repl_env ($ENV_NEW (global.get $NIL))) (local.set $repl_env (global.get $repl_env)) @@ -575,7 +533,6 @@ ($RELEASE ($RE "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))" $repl_env)) ($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)) - ;; Command line arguments (local.set $res ($MAP_LOOP_START (global.get $LIST_T))) ;; push MAP_LOP stack