engineering/lumbda
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

wat iter-3: vectors + hash tables (19 new primitives)

Browse source 
Two new heap tags:
  7 = vector  [tag, len, elem_0, elem_1, ...]   8 + 4*len bytes
  8 = hashtable  [tag, count, alist_ptr]        12 bytes

Vector primitives (88-95):
  vector, vector?, make-vector, vector-length,
  vector-ref, vector-set!, vector->list, list->vector

Hash table primitives (96-106):
  make-hash-table, hash-table?, hash-table-set!,
  hash-table-ref, hash-table-ref/default,
  hash-table-delete!, hash-table-exists?, hash-table-size,
  hash-table-keys, hash-table-values, hash-table->alist

Hash table lookup is linear (equal? on each key) — fine for browser-scale
demos. Same linear-scan caveat as the symbol intern; would warrant a real
hash function at scale.

print_value now renders vectors as #(a b c) and hashtables as #<hashtable>.
This commit is contained in:
russell@unturf.com 2026-06-14 12:41:36 -04:00
parent 0c0bec7784
commit 3800271b1b
No known key found for this signature in database
2 changed files with 387 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

388
wasm/asm/lumbda.wat
View file

@ -166,6 +166,117 @@
(i32.store offset=4 (local.get $p) (local.get $code))
(local.get $p))
;; ─── Vectors (tag=7) ───────────────────────────────────────────
;; Layout: [tag=7, len, elem_0, elem_1, ...] — 8 + 4*len bytes.
(func $is_vector (param $v i32) (result i32)
(if (result i32) (call $is_fixnum (local.get $v))
(then (i32.const 0))
(else
(if (result i32) (call $is_immediate (local.get $v))
(then (i32.const 0))
(else (i32.eq (call $obj_tag (local.get $v)) (i32.const 7)))))))
(func $make_vector_raw (param $len i32) (result i32)
(local $p i32)
(local.set $p (call $alloc (i32.add (i32.const 8) (i32.mul (local.get $len) (i32.const 4)))))
(i32.store (local.get $p) (i32.const 7))
(i32.store offset=4 (local.get $p) (local.get $len))
(local.get $p))
(func $vector_len (param $v i32) (result i32)
(i32.load offset=4 (local.get $v)))
(func $vector_get (param $v i32) (param $i i32) (result i32)
(i32.load (i32.add (i32.add (local.get $v) (i32.const 8)) (i32.mul (local.get $i) (i32.const 4)))))
(func $vector_put (param $v i32) (param $i i32) (param $val i32)
(i32.store (i32.add (i32.add (local.get $v) (i32.const 8)) (i32.mul (local.get $i) (i32.const 4))) (local.get $val)))
;; ─── Hash tables (tag=8) ───────────────────────────────────────
;; Layout: [tag=8, count, alist_ptr]. alist is a list of (key . val) pairs.
;; Lookup is linear — fine for browser demos; would be MOAD-0001 at scale,
;; same caveat as my linear symbol intern.
(func $is_hashtable (param $v i32) (result i32)
(if (result i32) (call $is_fixnum (local.get $v))
(then (i32.const 0))
(else
(if (result i32) (call $is_immediate (local.get $v))
(then (i32.const 0))
(else (i32.eq (call $obj_tag (local.get $v)) (i32.const 8)))))))
(func $make_hashtable (result i32)
(local $p i32)
(local.set $p (call $alloc (i32.const 12)))
(i32.store (local.get $p) (i32.const 8))
(i32.store offset=4 (local.get $p) (i32.const 0))
(i32.store offset=8 (local.get $p) (global.get $NIL))
(local.get $p))
(func $ht_count (param $h i32) (result i32)
(i32.load offset=4 (local.get $h)))
(func $ht_alist (param $h i32) (result i32)
(i32.load offset=8 (local.get $h)))
(func $ht_set_alist (param $h i32) (param $a i32)
(i32.store offset=8 (local.get $h) (local.get $a)))
(func $ht_set_count (param $h i32) (param $n i32)
(i32.store offset=4 (local.get $h) (local.get $n)))
;; Find binding for key in hashtable, returns the (k.v) pair or FALSE.
(func $ht_find (param $h i32) (param $key i32) (result i32)
(local $cur i32)
(local $pair i32)
(local.set $cur (call $ht_alist (local.get $h)))
(block $done
(loop $l
(br_if $done (i32.eqz (call $is_pair (local.get $cur))))
(local.set $pair (call $car (local.get $cur)))
(if (i32.eq (call $equal_p (call $car (local.get $pair)) (local.get $key)) (global.get $TRUE))
(then (return (local.get $pair))))
(local.set $cur (call $cdr (local.get $cur)))
(br $l)))
(global.get $FALSE))
(func $ht_set (param $h i32) (param $key i32) (param $val i32)
(local $found i32)
(local.set $found (call $ht_find (local.get $h) (local.get $key)))
(if (i32.eq (local.get $found) (global.get $FALSE))
(then
(call $ht_set_alist (local.get $h)
(call $make_pair
(call $make_pair (local.get $key) (local.get $val))
(call $ht_alist (local.get $h))))
(call $ht_set_count (local.get $h)
(i32.add (call $ht_count (local.get $h)) (i32.const 1))))
(else
(call $set_cdr (local.get $found) (local.get $val)))))
;; Remove binding for key, returns 1 if removed, 0 if not present.
(func $ht_delete (param $h i32) (param $key i32) (result i32)
(local $cur i32)
(local $prev i32)
(local $pair i32)
(local.set $cur (call $ht_alist (local.get $h)))
(local.set $prev (global.get $NIL))
(block $done
(loop $l
(br_if $done (i32.eqz (call $is_pair (local.get $cur))))
(local.set $pair (call $car (local.get $cur)))
(if (i32.eq (call $equal_p (call $car (local.get $pair)) (local.get $key)) (global.get $TRUE))
(then
(if (i32.eq (local.get $prev) (global.get $NIL))
(then (call $ht_set_alist (local.get $h) (call $cdr (local.get $cur))))
(else (call $set_cdr (local.get $prev) (call $cdr (local.get $cur)))))
(call $ht_set_count (local.get $h)
(i32.sub (call $ht_count (local.get $h)) (i32.const 1)))
(return (i32.const 1))))
(local.set $prev (local.get $cur))
(local.set $cur (call $cdr (local.get $cur)))
(br $l)))
(i32.const 0))
(func $char_code (param $v i32) (result i32)
(i32.load offset=4 (local.get $v)))
@ -430,9 +541,33 @@
(call $print_list_items (local.get $v))
(call $out_char (i32.const 41)) ;; )
(return)))
(if (call $is_vector (local.get $v))
(then
(call $out_str (i32.const 0xF050) (i32.const 2)) ;; "#("
(call $print_vector_items (local.get $v))
(call $out_char (i32.const 41)) ;; )
(return)))
(if (call $is_hashtable (local.get $v))
(then
(call $out_str (i32.const 0xF060) (i32.const 12)) ;; "#<hashtable>"
(return)))
;; closure / primitive
(call $out_str (i32.const 0xF030) (i32.const 11))) ;; "<procedure>"
(func $print_vector_items (param $v i32)
(local $len i32)
(local $i i32)
(local.set $len (call $vector_len (local.get $v)))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $len)))
(call $print_value (call $vector_get (local.get $v) (local.get $i)))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(if (i32.lt_u (local.get $i) (local.get $len))
(then (call $out_char (i32.const 32))))
(br $l))))
(func $print_list_items (param $p i32)
(block $done
(loop $loop
@ -1659,6 +1794,111 @@
(br $l2)))
(local.get $out))
;; ─── Vector / hashtable helpers ────────────────────────────────
(func $list_to_vector_op (param $list i32) (result i32)
(local $len i32)
(local $cur i32)
(local $v i32)
(local $i i32)
(local.set $len (i32.const 0))
(local.set $cur (local.get $list))
(block $d1
(loop $l1
(br_if $d1 (i32.eqz (call $is_pair (local.get $cur))))
(local.set $len (i32.add (local.get $len) (i32.const 1)))
(local.set $cur (call $cdr (local.get $cur)))
(br $l1)))
(local.set $v (call $make_vector_raw (local.get $len)))
(local.set $cur (local.get $list))
(local.set $i (i32.const 0))
(block $d2
(loop $l2
(br_if $d2 (i32.eqz (call $is_pair (local.get $cur))))
(call $vector_put (local.get $v) (local.get $i) (call $car (local.get $cur)))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(local.set $cur (call $cdr (local.get $cur)))
(br $l2)))
(local.get $v))
(func $vector_to_list_op (param $v i32) (result i32)
(local $len i32)
(local $i i32)
(local $head i32)
(local $tail i32)
(local $new i32)
(local.set $len (call $vector_len (local.get $v)))
(local.set $head (global.get $NIL))
(local.set $tail (global.get $NIL))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $len)))
(local.set $new (call $make_pair (call $vector_get (local.get $v) (local.get $i)) (global.get $NIL)))
(if (i32.eq (local.get $head) (global.get $NIL))
(then (local.set $head (local.get $new))
(local.set $tail (local.get $new)))
(else (call $set_cdr (local.get $tail) (local.get $new))
(local.set $tail (local.get $new))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(local.get $head))
(func $make_vector_filled (param $n i32) (param $init i32) (result i32)
(local $v i32)
(local $i i32)
(local.set $v (call $make_vector_raw (local.get $n)))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $n)))
(call $vector_put (local.get $v) (local.get $i) (local.get $init))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(local.get $v))
(func $ht_keys_op (param $h i32) (result i32)
(local $cur i32)
(local $head i32)
(local $tail i32)
(local $new i32)
(local.set $cur (call $ht_alist (local.get $h)))
(local.set $head (global.get $NIL))
(local.set $tail (global.get $NIL))
(block $done
(loop $l
(br_if $done (i32.eqz (call $is_pair (local.get $cur))))
(local.set $new (call $make_pair (call $car (call $car (local.get $cur))) (global.get $NIL)))
(if (i32.eq (local.get $head) (global.get $NIL))
(then (local.set $head (local.get $new))
(local.set $tail (local.get $new)))
(else (call $set_cdr (local.get $tail) (local.get $new))
(local.set $tail (local.get $new))))
(local.set $cur (call $cdr (local.get $cur)))
(br $l)))
(local.get $head))
(func $ht_values_op (param $h i32) (result i32)
(local $cur i32)
(local $head i32)
(local $tail i32)
(local $new i32)
(local.set $cur (call $ht_alist (local.get $h)))
(local.set $head (global.get $NIL))
(local.set $tail (global.get $NIL))
(block $done
(loop $l
(br_if $done (i32.eqz (call $is_pair (local.get $cur))))
(local.set $new (call $make_pair (call $cdr (call $car (local.get $cur))) (global.get $NIL)))
(if (i32.eq (local.get $head) (global.get $NIL))
(then (local.set $head (local.get $new))
(local.set $tail (local.get $new)))
(else (call $set_cdr (local.get $tail) (local.get $new))
(local.set $tail (local.get $new))))
(local.set $cur (call $cdr (local.get $cur)))
(br $l)))
(local.get $head))
;; ─── Primitives ────────────────────────────────────────────────
(func $apply_primitive (param $id i32) (param $args i32) (result i32)
(local $a i32)
@ -2265,6 +2505,111 @@
(if (i32.eq (local.get $id) (i32.const 87))
(then (return (call $string_join_op (local.get $a) (local.get $b)))))
;; vector (88) — (vector a b c ...) returns a vector with the args
(if (i32.eq (local.get $id) (i32.const 88))
(then (return (call $list_to_vector_op (local.get $args)))))
;; vector? (89)
(if (i32.eq (local.get $id) (i32.const 89))
(then
(if (call $is_vector (local.get $a))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; make-vector (90) — (make-vector n [init])
(if (i32.eq (local.get $id) (i32.const 90))
(then (return (call $make_vector_filled
(call $fixnum_val (local.get $a))
(local.get $b)))))
;; vector-length (91)
(if (i32.eq (local.get $id) (i32.const 91))
(then (return (call $make_fixnum (call $vector_len (local.get $a))))))
;; vector-ref (92)
(if (i32.eq (local.get $id) (i32.const 92))
(then (return (call $vector_get (local.get $a) (call $fixnum_val (local.get $b))))))
;; vector-set! (93) — (vector-set! v i val)
(if (i32.eq (local.get $id) (i32.const 93))
(then
(call $vector_put (local.get $a)
(call $fixnum_val (local.get $b))
(call $car (call $cdr (call $cdr (local.get $args)))))
(return (global.get $VOID))))
;; vector->list (94)
(if (i32.eq (local.get $id) (i32.const 94))
(then (return (call $vector_to_list_op (local.get $a)))))
;; list->vector (95)
(if (i32.eq (local.get $id) (i32.const 95))
(then (return (call $list_to_vector_op (local.get $a)))))
;; make-hash-table (96)
(if (i32.eq (local.get $id) (i32.const 96))
(then (return (call $make_hashtable))))
;; hash-table? (97)
(if (i32.eq (local.get $id) (i32.const 97))
(then
(if (call $is_hashtable (local.get $a))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; hash-table-set! (98) — (hash-table-set! h k v)
(if (i32.eq (local.get $id) (i32.const 98))
(then
(call $ht_set (local.get $a) (local.get $b)
(call $car (call $cdr (call $cdr (local.get $args)))))
(return (global.get $VOID))))
;; hash-table-ref (99) — (hash-table-ref h k) — returns value or FALSE
(if (i32.eq (local.get $id) (i32.const 99))
(then
(local.set $sum (call $ht_find (local.get $a) (local.get $b)))
(if (i32.eq (local.get $sum) (global.get $FALSE))
(then (return (global.get $FALSE))))
(return (call $cdr (local.get $sum)))))
;; hash-table-ref/default (100) — (hash-table-ref/default h k def)
(if (i32.eq (local.get $id) (i32.const 100))
(then
(local.set $sum (call $ht_find (local.get $a) (local.get $b)))
(if (i32.eq (local.get $sum) (global.get $FALSE))
(then (return (call $car (call $cdr (call $cdr (local.get $args)))))))
(return (call $cdr (local.get $sum)))))
;; hash-table-delete! (101)
(if (i32.eq (local.get $id) (i32.const 101))
(then
(drop (call $ht_delete (local.get $a) (local.get $b)))
(return (global.get $VOID))))
;; hash-table-exists? (102)
(if (i32.eq (local.get $id) (i32.const 102))
(then
(local.set $sum (call $ht_find (local.get $a) (local.get $b)))
(if (i32.eq (local.get $sum) (global.get $FALSE))
(then (return (global.get $FALSE))))
(return (global.get $TRUE))))
;; hash-table-size (103)
(if (i32.eq (local.get $id) (i32.const 103))
(then (return (call $make_fixnum (call $ht_count (local.get $a))))))
;; hash-table-keys (104) — fresh list of keys
(if (i32.eq (local.get $id) (i32.const 104))
(then (return (call $ht_keys_op (local.get $a)))))
;; hash-table-values (105) — fresh list of values
(if (i32.eq (local.get $id) (i32.const 105))
(then (return (call $ht_values_op (local.get $a)))))
;; hash-table->alist (106)
(if (i32.eq (local.get $id) (i32.const 106))
(then (return (call $ht_alist (local.get $a)))))
(global.get $VOID))
;; ─── Init ──────────────────────────────────────────────────────
@ -2275,6 +2620,8 @@
(data (i32.const 0xF020) "#f")
(data (i32.const 0xF030) "<procedure>")
(data (i32.const 0xF040) " . ")
(data (i32.const 0xF050) "#(")
(data (i32.const 0xF060) "#<hashtable>")
;; Helper to intern from a fixed-string region. We embed literal symbols
;; in dataregions 0xE000+ and intern them at init.
@ -2393,6 +2740,26 @@
(data (i32.const 0xE45C) "string->number")
(data (i32.const 0xE46C) "string-contains")
(data (i32.const 0xE47C) "string-join")
;; Vectors & hash tables.
(data (i32.const 0xE490) "vector")
(data (i32.const 0xE498) "vector?")
(data (i32.const 0xE4A0) "make-vector")
(data (i32.const 0xE4AC) "vector-length")
(data (i32.const 0xE4BC) "vector-ref")
(data (i32.const 0xE4C8) "vector-set!")
(data (i32.const 0xE4D4) "vector->list")
(data (i32.const 0xE4E4) "list->vector")
(data (i32.const 0xE4F4) "make-hash-table")
(data (i32.const 0xE504) "hash-table?")
(data (i32.const 0xE510) "hash-table-set!")
(data (i32.const 0xE520) "hash-table-ref")
(data (i32.const 0xE530) "hash-table-ref/default")
(data (i32.const 0xE548) "hash-table-delete!")
(data (i32.const 0xE55C) "hash-table-exists?")
(data (i32.const 0xE570) "hash-table-size")
(data (i32.const 0xE580) "hash-table-keys")
(data (i32.const 0xE590) "hash-table-values")
(data (i32.const 0xE5A4) "hash-table->alist")
(func $bind_prim (param $name_ptr i32) (param $name_len i32) (param $id i32)
(local $sym i32)
@ -2511,7 +2878,26 @@
(call $bind_prim (i32.const 0xE44C) (i32.const 14) (i32.const 84)) ;; number->string
(call $bind_prim (i32.const 0xE45C) (i32.const 14) (i32.const 85)) ;; string->number
(call $bind_prim (i32.const 0xE46C) (i32.const 15) (i32.const 86)) ;; string-contains
(call $bind_prim (i32.const 0xE47C) (i32.const 11) (i32.const 87))) ;; string-join
(call $bind_prim (i32.const 0xE47C) (i32.const 11) (i32.const 87)) ;; string-join
(call $bind_prim (i32.const 0xE490) (i32.const 6) (i32.const 88)) ;; vector
(call $bind_prim (i32.const 0xE498) (i32.const 7) (i32.const 89)) ;; vector?
(call $bind_prim (i32.const 0xE4A0) (i32.const 11) (i32.const 90)) ;; make-vector
(call $bind_prim (i32.const 0xE4AC) (i32.const 13) (i32.const 91)) ;; vector-length
(call $bind_prim (i32.const 0xE4BC) (i32.const 10) (i32.const 92)) ;; vector-ref
(call $bind_prim (i32.const 0xE4C8) (i32.const 11) (i32.const 93)) ;; vector-set!
(call $bind_prim (i32.const 0xE4D4) (i32.const 12) (i32.const 94)) ;; vector->list
(call $bind_prim (i32.const 0xE4E4) (i32.const 12) (i32.const 95)) ;; list->vector
(call $bind_prim (i32.const 0xE4F4) (i32.const 15) (i32.const 96)) ;; make-hash-table
(call $bind_prim (i32.const 0xE504) (i32.const 11) (i32.const 97)) ;; hash-table?
(call $bind_prim (i32.const 0xE510) (i32.const 15) (i32.const 98)) ;; hash-table-set!
(call $bind_prim (i32.const 0xE520) (i32.const 14) (i32.const 99)) ;; hash-table-ref
(call $bind_prim (i32.const 0xE530) (i32.const 22) (i32.const 100)) ;; hash-table-ref/default
(call $bind_prim (i32.const 0xE548) (i32.const 18) (i32.const 101)) ;; hash-table-delete!
(call $bind_prim (i32.const 0xE55C) (i32.const 18) (i32.const 102)) ;; hash-table-exists?
(call $bind_prim (i32.const 0xE570) (i32.const 15) (i32.const 103)) ;; hash-table-size
(call $bind_prim (i32.const 0xE580) (i32.const 15) (i32.const 104)) ;; hash-table-keys
(call $bind_prim (i32.const 0xE590) (i32.const 17) (i32.const 105)) ;; hash-table-values
(call $bind_prim (i32.const 0xE5A4) (i32.const 17) (i32.const 106))) ;; hash-table->alist
;; ─── Public eval entry ─────────────────────────────────────────
;; JS writes UTF-8 source into 0x20000 and calls lumbda_eval(len).

BIN
www/playground/asm/lumbda-asm.wasm
View file

Binary file not shown.