wasm: backport recent changes to steps0-9

asarhaddon · Aug 7, 2024 · 4bfc047 · 4bfc047
1 parent 2592df1
commit 4bfc047
Show file tree

Hide file tree

Showing 8 changed files with 552 additions and 567 deletions.
diff --git a/impls/wasm/step2_eval.wam b/impls/wasm/step2_eval.wam
@@ -9,32 +9,16 @@
 
   ;; 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))
     (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
@@ -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
@@ -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,23 +10,16 @@
 
   ;; 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))
     (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 $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