wasm/types.wam

   1 ;; Mal value memory layout
   2 ;;   type           words
   3 ;;   ----------     ----------
   4 ;;   nil            ref/ 0 |  0           |               |
   5 ;;   false          ref/ 1 |  0           |               |
   6 ;;   true           ref/ 1 |  1           |               |
   7 ;;   integer        ref/ 2 | int          |               |
   8 ;;   float          ref/ 3 | ???          |               |
   9 ;;   string/kw      ref/ 4 | string ptr   |               |
  10 ;;   symbol         ref/ 5 | string ptr   |               |
  11 ;;   list           ref/ 6 | next mem idx | val mem idx   |
  12 ;;   vector         ref/ 7 | next mem idx | val mem idx   |
  13 ;;   hashmap        ref/ 8 | next mem idx | key mem idx   | val mem idx
  14 ;;   function       ref/ 9 | fn idx       |               |
  15 ;;   mal function   ref/10 | body mem idx | param mem idx | env mem idx
  16 ;;   macro fn       ref/11 | body mem idx | param mem idx | env mem idx
  17 ;;   atom           ref/12 | val mem idx  |               |
  18 ;;   environment    ref/13 | hmap mem idx | outer mem idx |
  19 ;;   metadata       ref/14 | obj mem idx  | meta mem idx  |
  20 ;;   FREE            sz/15 | next mem idx |               |
  21
  22 (module $types
  23
  24   (global $NIL_T                  i32 0)
  25   (global $BOOLEAN_T              i32 1)
  26   (global $INTEGER_T              i32 2)
  27   (global $FLOAT_T                i32 3)
  28   (global $STRING_T               i32 4)
  29   (global $SYMBOL_T               i32 5)
  30   (global $LIST_T                 i32 6)
  31   (global $VECTOR_T               i32 7)
  32   (global $HASHMAP_T              i32 8)
  33   (global $FUNCTION_T             i32 9)
  34   (global $MALFUNC_T              i32 10)
  35   (global $MACRO_T                i32 11)
  36   (global $ATOM_T                 i32 12)
  37   (global $ENVIRONMENT_T          i32 13)
  38   (global $METADATA_T             i32 14)
  39   (global $FREE_T                 i32 15)
  40
  41   (global $error_type             (mut i32) 0)
  42   (global $error_val              (mut i32) 0)
  43   ;; Index into static string memory (static.wast)
  44   (global $error_str              (mut i32) 0)
  45
  46   (global $NIL                    (mut i32) 0)
  47   (global $FALSE                  (mut i32) 0)
  48   (global $TRUE                   (mut i32) 0)
  49   (global $EMPTY_LIST             (mut i32) 0)
  50   (global $EMPTY_VECTOR           (mut i32) 0)
  51   (global $EMPTY_HASHMAP          (mut i32) 0)
  52
  53   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  54   ;; General functions
  55
  56   (func $INC_REF (param $mv i32) (result i32)
  57     (i32.store $mv (i32.add (i32.load $mv) 32))
  58     $mv
  59   )
  60
  61   (func $TRUE_FALSE (param $val i32) (result i32)
  62     ($INC_REF (if (result i32) $val (global.get $TRUE) (global.get $FALSE)))
  63   )
  64
  65   (func $THROW_STR_0 (param $fmt i32)
  66     (drop ($sprintf_1 (global.get $error_str) $fmt ""))
  67     (global.set $error_type 1)
  68   )
  69
  70   (func $THROW_STR_1 (param $fmt i32) (param $v0 i32)
  71     (drop ($sprintf_1 (global.get $error_str) $fmt $v0))
  72     (global.set $error_type 1)
  73   )
  74
  75   (func $EQUAL_Q (param $a i32 $b i32) (result i32)
  76     (LET $ta ($TYPE $a)
  77          $tb ($TYPE $b))
  78
  79     (if (AND (OR (i32.eq $ta (global.get $LIST_T))
  80                  (i32.eq $ta (global.get $VECTOR_T)))
  81              (OR (i32.eq $tb (global.get $LIST_T))
  82                  (i32.eq $tb (global.get $VECTOR_T))))
  83       (then
  84         ;; EQUAL_Q_SEQ
  85         (block $done
  86           (loop $loop
  87             (if (OR (i32.eq ($VAL0 $a) 0) (i32.eq ($VAL0 $b) 0))
  88               (br $done))
  89             (if ($EQUAL_Q ($MEM_VAL1_ptr $a) ($MEM_VAL1_ptr $b))
  90               (then
  91                 (local.set $a ($MEM_VAL0_ptr $a))
  92                 (local.set $b ($MEM_VAL0_ptr $b)))
  93               (else
  94                 (return 0)))
  95             (br $loop)
  96           )
  97         )
  98         (return (AND (i32.eq ($VAL0 $a) 0) (i32.eq ($VAL0 $b) 0))))
  99     (else (if (AND (i32.eq $ta (global.get $HASHMAP_T))
 100                    (i32.eq $tb (global.get $HASHMAP_T)))
 101       ;; EQUAL_Q_HM
 102       (then (return 1))
 103     ;; TODO: remove this once strings are interned
 104     (else (if (OR (AND (i32.eq $ta (global.get $STRING_T))
 105                        (i32.eq $tb (global.get $STRING_T)))
 106                   (AND (i32.eq $ta (global.get $SYMBOL_T))
 107                        (i32.eq $tb (global.get $SYMBOL_T))))
 108       (then (return (i32.eqz ($strcmp ($to_String $a) ($to_String $b)))))
 109     (else
 110       (return (AND (i32.eq $ta $tb)
 111                    (i32.eq ($VAL0 $a) ($VAL0 $b))))))))))
 112     0 ;; not reachable
 113   )
 114
 115   (func $DEREF_META (param $mv i32) (result i32)
 116     (loop $loop
 117       (if (i32.eq ($TYPE $mv) (global.get $METADATA_T))
 118         (then
 119           (local.set $mv ($MEM_VAL0_ptr $mv))
 120           (br $loop)))
 121     )
 122     $mv
 123   )
 124
 125   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 126   ;; string functions
 127
 128   (func $to_MalString (param $mv i32) (result i32)
 129     ;; TODO: assert mv is a string/keyword/symbol
 130     (i32.add (global.get $string_mem) ($VAL0 $mv))
 131   )
 132
 133   (func $to_String (param $mv i32) (result i32)
 134     ;; skip string refcnt and size
 135     (i32.add 4 ($to_MalString $mv))
 136   )
 137
 138   ;; Duplicate regular character array string into a Mal string and
 139   ;; return the MalVal pointer
 140   (func $STRING (param $type i32 $str i32) (result i32)
 141     (LET $ms ($ALLOC_STRING $str ($strlen $str) 1))
 142     ($ALLOC_SCALAR $type (i32.sub $ms (global.get $string_mem)))
 143   )
 144
 145   ;; Find first duplicate (internet) of mv. If one is found, free up
 146   ;; mv and return the interned version. If no duplicate is found,
 147   ;; return NULL.
 148   (func $INTERN_STRING (param $mv i32) (result i32)
 149     (LET $res         0
 150          $ms          ($to_MalString $mv)
 151          $existing_ms ($FIND_STRING (i32.add $ms 4))
 152          $tmp         0)
 153     (if (AND $existing_ms (i32.lt_s $existing_ms $ms))
 154       (then
 155         (local.set $tmp $mv)
 156         (local.set $res ($ALLOC_SCALAR (global.get $STRING_T)
 157                                        (i32.sub $existing_ms
 158                                                   (global.get $string_mem))))
 159         (i32.store16 $existing_ms (i32.add (i32.load16_u $existing_ms) 1))
 160         ($RELEASE $tmp)))
 161     $res
 162   )
 163
 164   (func $STRING_INIT (param $type i32) (result i32)
 165     (LET $ms ($ALLOC_STRING "" 0 0))
 166     ($ALLOC_SCALAR $type (i32.sub $ms (global.get $string_mem)))
 167   )
 168
 169   (func $STRING_FINALIZE (param $mv i32 $size i32) (result i32)
 170     ;; Check if the new string can be interned.
 171     (LET $tmp ($INTERN_STRING $mv)
 172          $ms  ($to_MalString $mv))
 173     (if $tmp
 174       (then
 175         (local.set $mv $tmp))
 176       (else
 177         ;;; ms->size = sizeof(MalString) + size + 1
 178         (i32.store16 (i32.add $ms 2)
 179                      (i32.add (i32.add 4 $size) 1))
 180         ;;; string_mem_next = (void *)ms  + ms->size
 181         (global.set $string_mem_next
 182                     (i32.add $ms (i32.load16_u (i32.add $ms 2))))))
 183     $mv
 184   )
 185
 186   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 187   ;; numeric functions
 188
 189   (func $INTEGER (param $val i32) (result i32)
 190     ($ALLOC_SCALAR (global.get $INTEGER_T) $val)
 191   )
 192
 193   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 194   ;; sequence functions
 195
 196   (func $MAP_LOOP_START (param $type i32) (result i32)
 197     (LET $res (if (result i32) (i32.eq $type (global.get $LIST_T))
 198                 (then (global.get $EMPTY_LIST))
 199               (else (if (result i32) (i32.eq $type (global.get $VECTOR_T))
 200                 (then (global.get $EMPTY_VECTOR))
 201               (else (if (result i32) (i32.eq $type (global.get $HASHMAP_T))
 202                 (then (global.get $EMPTY_HASHMAP))
 203               (else
 204                 ($THROW_STR_1 "read_seq invalid type %d" $type)
 205                 0)))))))
 206
 207     ($INC_REF $res)
 208   )
 209
 210   (func $MAP_LOOP_UPDATE (param $type i32) (param $empty i32)
 211         (param $current i32) (param $val2 i32) (param $val3 i32)
 212         (result i32)
 213     (LET $res ($ALLOC $type $empty $val2 $val3))
 214
 215     ;; sequence took ownership
 216     ($RELEASE $empty)
 217     ($RELEASE $val2)
 218     (if (i32.eq $type (global.get $HASHMAP_T))
 219       ($RELEASE $val3))
 220     (if (i32.gt_u $current (global.get $EMPTY_HASHMAP))
 221       ;; if not first element, set current next to point to new element
 222       (i32.store ($VAL0_ptr $current) ($IDX $res)))
 223
 224     $res
 225   )
 226
 227   (func $FORCE_SEQ_TYPE (param $type i32) (param $mv i32) (result i32)
 228     (LET $res 0)
 229     ;; if it's already the right type, inc ref cnt and return it
 230     (if (i32.eq $type ($TYPE $mv)) (return ($INC_REF $mv)))
 231     ;; if it's empty, return the sequence match
 232     (if (i32.le_u $mv (global.get $EMPTY_HASHMAP))
 233       (return ($MAP_LOOP_START $type)))
 234     ;; otherwise, copy first element to turn it into correct type
 235     ($ALLOC $type ($MEM_VAL0_ptr $mv) ($MEM_VAL1_ptr $mv) 0)
 236   )
 237
 238   (func $LIST (param $seq i32 $first i32) (result i32)
 239     ($ALLOC (global.get $LIST_T) $seq $first 0)
 240   )
 241
 242   (func $LIST2 (param $first i32 $second i32) (result i32)
 243     ;; last element is empty list
 244     (LET $tmp ($LIST (global.get $EMPTY_LIST) $second)
 245          $res ($LIST $tmp $first))
 246     ($RELEASE $tmp) ;; new list takes ownership of previous
 247     $res
 248   )
 249
 250   (func $LIST3 (param $first i32 $second i32 $third i32) (result i32)
 251     (LET $tmp ($LIST2 $second $third)
 252          $res ($LIST $tmp $first))
 253     ($RELEASE $tmp) ;; new list takes ownership of previous
 254     $res
 255   )
 256
 257   (func $LIST_Q (param $mv i32) (result i32)
 258     (i32.eq ($TYPE $mv) (global.get $LIST_T))
 259   )
 260
 261   (func $EMPTY_Q (param $mv i32) (result i32)
 262     (i32.eq ($VAL0 $mv) 0)
 263   )
 264
 265   (func $COUNT (param $mv i32) (result i32)
 266     (LET $cnt 0)
 267     (block $done
 268       (loop $loop
 269         (if (i32.eq ($VAL0 $mv) 0) (br $done))
 270         (local.set $cnt (i32.add $cnt 1))
 271         (local.set $mv ($MEM_VAL0_ptr $mv))
 272         (br $loop)
 273       )
 274     )
 275     $cnt
 276   )
 277
 278   (func $LAST (param $mv i32) (result i32)
 279     (LET $cur 0)
 280     ;; TODO: check that actually a list/vector
 281     (if (i32.eq ($VAL0 $mv) 0)
 282       ;; empty seq, return nil
 283       (return ($INC_REF (global.get $NIL))))
 284     (block $done
 285       (loop $loop
 286         ;; end, return previous value
 287         (if (i32.eq ($VAL0 $mv) 0) (br $done))
 288         ;; current becomes previous entry
 289         (local.set $cur $mv)
 290         ;; next entry
 291         (local.set $mv ($MEM_VAL0_ptr $mv))
 292         (br $loop)
 293       )
 294     )
 295     ($INC_REF ($MEM_VAL1_ptr $cur))
 296   )
 297
 298   ;; make a copy of sequence seq from index start to end
 299   ;; set last to last element of slice before the empty
 300   ;; set after to element following slice (or original)
 301   (func $SLICE (param $seq i32) (param $start i32) (param $end i32)
 302         (result i64)
 303     (LET $idx  0
 304          $res  ($INC_REF (global.get $EMPTY_LIST))
 305          $last 0
 306          $tmp  $res)
 307     ;; advance seq to start
 308     (block $done
 309       (loop $loop
 310         (if (OR (i32.ge_s $idx $start)
 311                 (i32.eqz ($VAL0 $seq)))
 312           (br $done))
 313         (local.set $seq ($MEM_VAL0_ptr $seq))
 314         (local.set $idx (i32.add $idx 1))
 315         (br $loop)
 316       )
 317     )
 318     (block $done
 319       (loop $loop
 320         ;; if current position is at end, then return or if we reached
 321         ;; end seq, then return
 322         (if (OR (AND (i32.ne $end -1)
 323                      (i32.ge_s $idx $end))
 324                 (i32.eqz ($VAL0 $seq)))
 325           (then
 326             (local.set $res $tmp)
 327             (br $done)))
 328         ;; allocate new list element with copied value
 329         (local.set $res ($LIST (global.get $EMPTY_LIST)
 330                                ($MEM_VAL1_ptr $seq)))
 331         ;; sequence took ownership
 332         ($RELEASE (global.get $EMPTY_LIST))
 333         (if (i32.eqz $last)
 334           (then
 335             ;; if first element, set return value to new element
 336             (local.set $tmp $res))
 337           (else
 338             ;; if not the first element, set return value to new element
 339             (i32.store ($VAL0_ptr $last) ($IDX $res))))
 340         (local.set $last $res) ;; update last list element
 341         ;; advance to next element of seq
 342         (local.set $seq ($MEM_VAL0_ptr $seq))
 343         (local.set $idx (i32.add $idx 1))
 344         (br $loop)
 345       )
 346     )
 347
 348     ;; combine last/res as hi 32/low 32 of i64
 349     (i64.or
 350       (i64.shl (i64.extend_i32_u $last) (i64.const 32))
 351       (i64.extend_i32_u $res))
 352   )
 353
 354   (func $HASHMAP (result i32)
 355     ;; just point to static empty hash-map
 356     ($INC_REF (global.get $EMPTY_HASHMAP))
 357   )
 358
 359   (func $ASSOC1 (param $hm i32 $k i32 $v i32) (result i32)
 360     (LET $res ($ALLOC (global.get $HASHMAP_T) $hm $k $v))
 361     ;; we took ownership of previous release
 362     ($RELEASE $hm)
 363     $res
 364   )
 365
 366   (func $ASSOC1_S (param $hm i32 $k i32 $v i32) (result i32)
 367     (LET $kmv ($STRING (global.get $STRING_T) $k)
 368          $res ($ASSOC1 $hm $kmv $v))
 369     ;; map took ownership of key
 370     ($RELEASE $kmv)
 371     $res
 372   )
 373
 374   (func $HASHMAP_GET (param $hm i32) (param $key_mv i32) (result i64)
 375     (LET $key         ($to_String $key_mv)
 376          $found       0
 377          $res         0
 378          $test_key_mv 0)
 379
 380     (block $done
 381       (loop $loop
 382         ;;; if (VAL0(hm) == 0)
 383         (if (i32.eq ($VAL0 $hm) 0)
 384           (then
 385             (local.set $res (global.get $NIL))
 386             (br $done)))
 387         ;;; test_key_mv = MEM_VAL1(hm)
 388         (local.set $test_key_mv ($MEM_VAL1_ptr $hm))
 389         ;;; if (strcmp(key, to_String(test_key_mv)) == 0)
 390         (if (i32.eq ($strcmp $key ($to_String $test_key_mv)) 0)
 391           (then
 392             (local.set $found 1)
 393             (local.set $res ($MEM_VAL2_ptr $hm))
 394             (br $done)))
 395         (local.set $hm ($MEM_VAL0_ptr $hm))
 396
 397         (br $loop)
 398       )
 399     )
 400
 401     ;; combine found/res as hi 32/low 32 of i64
 402     (i64.or (i64.shl (i64.extend_i32_u $found) (i64.const 32))
 403             (i64.extend_i32_u $res))
 404   )
 405
 406   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 407   ;; function functions
 408
 409   (func $FUNCTION (param $index i32) (result i32)
 410     ($ALLOC_SCALAR (global.get $FUNCTION_T) $index)
 411   )
 412
 413   (func $MALFUNC (param $ast i32 $params i32 $env i32) (result i32)
 414     ($ALLOC (global.get $MALFUNC_T) $ast $params $env)
 415   )
 416
 417 )