wasm/env.wam

   1 (module $env
   2
   3   (func $ENV_NEW (param $outer i32) (result i32)
   4     (LET $data ($HASHMAP) ;; allocate the data hashmap
   5          $env  ($ALLOC (global.get $ENVIRONMENT_T) $data $outer 0))
   6     ;; environment takes ownership
   7     ($RELEASE $data)
   8     $env
   9   )
  10
  11   (func $ENV_NEW_BINDS (param $outer i32 $binds i32 $exprs i32) (result i32)
  12     (LET $env ($ENV_NEW $outer)
  13          $key 0)
  14
  15     ;; process bindings
  16     (block $done
  17       (loop $loop
  18         (br_if $done (i32.eqz ($VAL0 $binds)))
  19
  20         ;; get/deref the key from binds
  21         (local.set $key ($MEM_VAL1_ptr $binds))
  22         (if (i32.eqz ($strcmp "&" ($to_String $key)))
  23           (then
  24             ;; ENV_NEW_BIND_VARGS
  25             ;; get/deref the key from the next element of binds
  26             (local.set $binds ($MEM_VAL0_ptr $binds))
  27             (local.set $key ($MEM_VAL1_ptr $binds))
  28             ;; the value is the remaining list in exprs
  29             (local.set $exprs ($FORCE_SEQ_TYPE (global.get $LIST_T) $exprs))
  30             ;; set the binding in the environment data
  31             (drop ($ENV_SET $env $key $exprs))
  32             ;; list is owned by the environment
  33             ($RELEASE $exprs)
  34             (br $done))
  35           (else
  36             ;; ENV_NEW_BIND_1x1
  37             ;; set the binding in the environment data
  38             (drop ($ENV_SET $env $key ($MEM_VAL1_ptr $exprs)))
  39             ;; go to next element of binds and exprs
  40             (local.set $binds ($MEM_VAL0_ptr $binds))
  41             (local.set $exprs ($MEM_VAL0_ptr $exprs))))
  42
  43         (br $loop)
  44       )
  45     )
  46     $env
  47   )
  48
  49   (func $ENV_SET (param $env i32 $key i32 $value i32) (result i32)
  50     (LET $data ($MEM_VAL0_ptr $env))
  51     (i32.store ($VAL0_ptr $env) ($IDX ($ASSOC1 $data $key $value)))
  52     $value
  53   )
  54
  55   (func $ENV_SET_S (param $env i32 $key i32 $value i32) (result i32)
  56     (LET $data ($MEM_VAL0_ptr $env))
  57     (i32.store ($VAL0_ptr $env) ($IDX ($ASSOC1_S $data $key $value)))
  58     $value
  59   )
  60
  61   (func $ENV_FIND (param $env i32 $key i32) (result i64)
  62     (local $found_res i64)
  63     (LET $res 0
  64          $data 0)
  65
  66     (block $done
  67       (loop $loop
  68         (local.set $data ($MEM_VAL0_ptr $env))
  69         (local.set $found_res ($HASHMAP_GET $data $key))
  70         ;;; if (found)
  71         (if (i32.wrap_i64 (i64.shr_u $found_res (i64.const 32)))
  72           (then
  73             (local.set $res (i32.wrap_i64 $found_res))
  74             (br $done)))
  75         (local.set $env ($MEM_VAL1_ptr $env))
  76         (if (i32.eq $env (global.get $NIL))
  77           (then
  78             (local.set $env 0)
  79             (br $done)))
  80         (br $loop)
  81       )
  82     )
  83
  84     ;; combine res/env as hi 32/low 32 of i64
  85     (i64.or
  86       (i64.shl (i64.extend_i32_u $res) (i64.const 32))
  87       (i64.extend_i32_u $env))
  88   )
  89
  90   (func $ENV_GET (param $env i32 $key i32) (result i32)
  91     (local $res_env i64)
  92     (LET $res 0)
  93
  94     (local.set $res_env ($ENV_FIND $env $key))
  95     (local.set $env (i32.wrap_i64 $res_env))
  96     (local.set $res (i32.wrap_i64 (i64.shr_u $res_env (i64.const 32))))
  97
  98     (if (i32.eqz $env)
  99       (then
 100         ($THROW_STR_1 "'%s' not found" ($to_String $key))
 101         (return $res)))
 102     (return ($INC_REF $res))
 103   )
 104 )