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

wat iter-2: chars + 27 string/char primitives

Browse source 
Char type added (tag=6, 8 bytes). Reader handles #\char and named chars
(space, newline, tab, return, null). Chars self-evaluate in eval, render
via print_value, compare via equal_p.

Primitives added (IDs 61-87):
  string-length, string-ref (returns char), substring, string-append,
  string=?, string<?, string-upcase, string-downcase, string->list,
  list->string, string->symbol, symbol->string, make-string,
  char?, char->integer, integer->char,
  char-alphabetic?, char-numeric?, char-whitespace?,
  char-upcase, char-downcase, char=?, char<?,
  number->string, string->number,
  string-contains, string-join

Plus helpers: substring_op, string_append_op (variadic),
string_lt, string_case_op, string_to_list, list_to_string,
symbol_to_string, make_string_filled, number_to_string,
string_to_number, string_contains_p, string_join_op,
bytes_eq_s, read_char_literal.

39/39 wasm tests pass (20 unit + 8 integration + 11 functional).
This commit is contained in:
russell@unturf.com 2026-06-14 12:36:41 -04:00
parent 73dc042ea8
commit 3054fccc33
No known key found for this signature in database
2 changed files with 711 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

714
wasm/asm/lumbda.wat
View file

@ -151,6 +151,42 @@
(then (i32.const 0))
(else (i32.eq (call $obj_tag (local.get $v)) (i32.const 5)))))))
(func $is_char (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 6)))))))
(func $make_char (param $code i32) (result i32)
(local $p i32)
(local.set $p (call $alloc (i32.const 8)))
(i32.store (local.get $p) (i32.const 6))
(i32.store offset=4 (local.get $p) (local.get $code))
(local.get $p))
(func $char_code (param $v i32) (result i32)
(i32.load offset=4 (local.get $v)))
;; Allocate an empty string object of the given length, return pointer.
;; Bytes are uninitialized; caller must fill before use.
(func $make_string_raw (param $len i32) (result i32)
(local $p i32)
(local.set $p (call $alloc (i32.add (i32.const 8) (local.get $len))))
(i32.store (local.get $p) (i32.const 5))
(i32.store offset=4 (local.get $p) (local.get $len))
(local.get $p))
(func $string_len (param $s i32) (result i32)
(i32.load offset=4 (local.get $s)))
(func $string_byte (param $s i32) (param $i i32) (result i32)
(i32.load8_u (i32.add (i32.add (local.get $s) (i32.const 8)) (local.get $i))))
(func $string_set_byte (param $s i32) (param $i i32) (param $c i32)
(i32.store8 (i32.add (i32.add (local.get $s) (i32.const 8)) (local.get $i)) (local.get $c)))
;; ─── Constructors ──────────────────────────────────────────────
(func $make_fixnum (export "make_fixnum") (param $n i32) (result i32)
(i32.or (i32.shl (local.get $n) (i32.const 1)) (i32.const 1)))
@ -384,6 +420,10 @@
(local.set $len (i32.load offset=4 (local.get $v)))
(call $out_str (local.get $bytes) (local.get $len))
(return)))
(if (call $is_char (local.get $v))
(then
(call $out_char (call $char_code (local.get $v)))
(return)))
(if (call $is_pair (local.get $v))
(then
(call $out_char (i32.const 40)) ;; (
@ -493,13 +533,18 @@
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
(return (call $read_string))))
;; #t #f
;; #t #f #\char
(if (i32.eq (local.get $c) (i32.const 35)) ;; #
(then
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
(if (i32.ge_u (global.get $source_ptr) (global.get $source_end))
(then (return (global.get $VOID))))
(local.set $c (i32.load8_u (global.get $source_ptr)))
;; #\char — backslash then a char or named character (space, newline, tab)
(if (i32.eq (local.get $c) (i32.const 92)) ;; \
(then
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
(return (call $read_char_literal))))
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
(if (i32.eq (local.get $c) (i32.const 116)) ;; t
(then (return (global.get $TRUE))))
@ -585,6 +630,67 @@
(br $loop)))
(local.get $head))
;; Read a char literal: #\X already consumed up through \. The next byte
;; may be a single char ("a"), or the start of a named char (space, newline, tab).
;; Named chars are detected by seeing a letter followed by more letters.
(func $read_char_literal (result i32)
(local $first i32)
(local $start i32)
(local $len i32)
(if (i32.ge_u (global.get $source_ptr) (global.get $source_end))
(then (return (call $make_char (i32.const 32)))))
(local.set $first (i32.load8_u (global.get $source_ptr)))
(local.set $start (global.get $source_ptr))
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
;; If first is a letter, scan further letters to detect named char.
(if (i32.and
(i32.ge_u (local.get $first) (i32.const 97)) ;; a
(i32.le_u (local.get $first) (i32.const 122))) ;; z
(then
(block $done
(loop $l
(br_if $done (i32.ge_u (global.get $source_ptr) (global.get $source_end)))
(br_if $done (i32.eqz (i32.and
(i32.ge_u (i32.load8_u (global.get $source_ptr)) (i32.const 97))
(i32.le_u (i32.load8_u (global.get $source_ptr)) (i32.const 122)))))
(global.set $source_ptr (i32.add (global.get $source_ptr) (i32.const 1)))
(br $l)))
(local.set $len (i32.sub (global.get $source_ptr) (local.get $start)))
(if (i32.eq (local.get $len) (i32.const 1))
(then (return (call $make_char (local.get $first)))))
;; Named chars: space, newline, tab, return, null
(if (call $bytes_eq_s (local.get $start) (local.get $len) (i32.const 0xE2D0) (i32.const 5))
(then (return (call $make_char (i32.const 32))))) ;; space
(if (call $bytes_eq_s (local.get $start) (local.get $len) (i32.const 0xE2D8) (i32.const 7))
(then (return (call $make_char (i32.const 10))))) ;; newline
(if (call $bytes_eq_s (local.get $start) (local.get $len) (i32.const 0xE2E0) (i32.const 3))
(then (return (call $make_char (i32.const 9))))) ;; tab
(if (call $bytes_eq_s (local.get $start) (local.get $len) (i32.const 0xE2E4) (i32.const 6))
(then (return (call $make_char (i32.const 13))))) ;; return
(if (call $bytes_eq_s (local.get $start) (local.get $len) (i32.const 0xE2EC) (i32.const 4))
(then (return (call $make_char (i32.const 0))))) ;; null
;; Unknown name — return first letter
(return (call $make_char (local.get $first)))))
;; Single character (non-letter)
(call $make_char (local.get $first)))
;; Compare two byte regions for equality. Returns 1 if equal.
(func $bytes_eq_s (param $a i32) (param $alen i32) (param $b i32) (param $blen i32) (result i32)
(local $i i32)
(if (i32.ne (local.get $alen) (local.get $blen))
(then (return (i32.const 0))))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $alen)))
(if (i32.ne
(i32.load8_u (i32.add (local.get $a) (local.get $i)))
(i32.load8_u (i32.add (local.get $b) (local.get $i))))
(then (return (i32.const 0))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(i32.const 1))
;; Read a string literal (we've already consumed the opening ").
(func $read_string (result i32)
(local $start i32)
@ -628,13 +734,15 @@
(local $params i32)
(local $body i32)
;; Self-evaluating: fixnum, immediate, string, closure, primitive
;; Self-evaluating: fixnum, immediate, string, char, closure, primitive
(if (call $is_fixnum (local.get $expr))
(then (return (local.get $expr))))
(if (call $is_immediate (local.get $expr))
(then (return (local.get $expr))))
(if (call $is_string (local.get $expr))
(then (return (local.get $expr))))
(if (call $is_char (local.get $expr))
(then (return (local.get $expr))))
(if (call $is_closure (local.get $expr))
(then (return (local.get $expr))))
(if (call $is_primitive (local.get $expr))
@ -1093,6 +1201,13 @@
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(return (global.get $TRUE))))
(if (call $is_char (local.get $a))
(then
(if (i32.eqz (call $is_char (local.get $b)))
(then (return (global.get $FALSE))))
(if (i32.eq (call $char_code (local.get $a)) (call $char_code (local.get $b)))
(then (return (global.get $TRUE))))
(return (global.get $FALSE))))
;; Fall through: not equal (different types / not pair)
(global.get $FALSE))
@ -1167,6 +1282,383 @@
(br $l)))
(global.get $FALSE))
;; ─── String / char helpers ─────────────────────────────────────
(func $substring_op (param $s i32) (param $start i32) (param $end i32) (result i32)
(local $out i32)
(local $len i32)
(local $i i32)
(local.set $len (i32.sub (local.get $end) (local.get $start)))
(local.set $out (call $make_string_raw (local.get $len)))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $len)))
(call $string_set_byte (local.get $out) (local.get $i)
(call $string_byte (local.get $s) (i32.add (local.get $start) (local.get $i))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(local.get $out))
;; Append all string args together. Args = list of strings.
(func $string_append_op (param $args i32) (result i32)
(local $total i32)
(local $cur i32)
(local $s i32)
(local $slen i32)
(local $out i32)
(local $i i32)
(local $pos i32)
;; Pass 1: total length
(local.set $total (i32.const 0))
(local.set $cur (local.get $args))
(block $d1
(loop $l1
(br_if $d1 (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $s (call $car (local.get $cur)))
(if (call $is_string (local.get $s))
(then (local.set $total (i32.add (local.get $total) (call $string_len (local.get $s))))))
(local.set $cur (call $cdr (local.get $cur)))
(br $l1)))
(local.set $out (call $make_string_raw (local.get $total)))
;; Pass 2: copy bytes
(local.set $pos (i32.const 0))
(local.set $cur (local.get $args))
(block $d2
(loop $l2
(br_if $d2 (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $s (call $car (local.get $cur)))
(if (call $is_string (local.get $s))
(then
(local.set $slen (call $string_len (local.get $s)))
(local.set $i (i32.const 0))
(block $d3
(loop $l3
(br_if $d3 (i32.ge_u (local.get $i) (local.get $slen)))
(call $string_set_byte (local.get $out) (i32.add (local.get $pos) (local.get $i))
(call $string_byte (local.get $s) (local.get $i)))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l3)))
(local.set $pos (i32.add (local.get $pos) (local.get $slen)))))
(local.set $cur (call $cdr (local.get $cur)))
(br $l2)))
(local.get $out))
(func $string_lt (param $a i32) (param $b i32) (result i32)
(local $alen i32)
(local $blen i32)
(local $i i32)
(local $minlen i32)
(local $ca i32)
(local $cb i32)
(local.set $alen (call $string_len (local.get $a)))
(local.set $blen (call $string_len (local.get $b)))
(local.set $minlen (local.get $alen))
(if (i32.lt_u (local.get $blen) (local.get $minlen))
(then (local.set $minlen (local.get $blen))))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $minlen)))
(local.set $ca (call $string_byte (local.get $a) (local.get $i)))
(local.set $cb (call $string_byte (local.get $b) (local.get $i)))
(if (i32.lt_u (local.get $ca) (local.get $cb))
(then (return (global.get $TRUE))))
(if (i32.gt_u (local.get $ca) (local.get $cb))
(then (return (global.get $FALSE))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(if (i32.lt_u (local.get $alen) (local.get $blen))
(then (return (global.get $TRUE))))
(global.get $FALSE))
;; upper=1 → upcase, upper=0 → downcase
(func $string_case_op (param $s i32) (param $upper i32) (result i32)
(local $len i32)
(local $out i32)
(local $i i32)
(local $c i32)
(local.set $len (call $string_len (local.get $s)))
(local.set $out (call $make_string_raw (local.get $len)))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $len)))
(local.set $c (call $string_byte (local.get $s) (local.get $i)))
(if (local.get $upper)
(then
(if (i32.and (i32.ge_u (local.get $c) (i32.const 97)) (i32.le_u (local.get $c) (i32.const 122)))
(then (local.set $c (i32.sub (local.get $c) (i32.const 32))))))
(else
(if (i32.and (i32.ge_u (local.get $c) (i32.const 65)) (i32.le_u (local.get $c) (i32.const 90)))
(then (local.set $c (i32.add (local.get $c) (i32.const 32)))))))
(call $string_set_byte (local.get $out) (local.get $i) (local.get $c))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(local.get $out))
(func $string_to_list (param $s i32) (result i32)
(local $len i32)
(local $i i32)
(local $head i32)
(local $tail i32)
(local $new i32)
(local.set $len (call $string_len (local.get $s)))
(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 $make_char (call $string_byte (local.get $s) (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 $list_to_string (param $list i32) (result i32)
(local $len i32)
(local $cur i32)
(local $out i32)
(local $i i32)
(local $ch i32)
;; count length
(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 $out (call $make_string_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))))
(local.set $ch (call $car (local.get $cur)))
(if (call $is_char (local.get $ch))
(then (call $string_set_byte (local.get $out) (local.get $i) (call $char_code (local.get $ch))))
(else (call $string_set_byte (local.get $out) (local.get $i) (call $fixnum_val (local.get $ch)))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(local.set $cur (call $cdr (local.get $cur)))
(br $l2)))
(local.get $out))
(func $symbol_to_string (param $sym i32) (result i32)
(local $len i32)
(local $out i32)
(local $i i32)
(local.set $len (i32.load offset=4 (local.get $sym)))
(local.set $out (call $make_string_raw (local.get $len)))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $len)))
(call $string_set_byte (local.get $out) (local.get $i)
(i32.load8_u (i32.add (i32.add (local.get $sym) (i32.const 8)) (local.get $i))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(local.get $out))
(func $make_string_filled (param $n i32) (param $code i32) (result i32)
(local $out i32)
(local $i i32)
(local.set $out (call $make_string_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 $string_set_byte (local.get $out) (local.get $i) (local.get $code))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(local.get $out))
;; Convert a signed i32 to a freshly-allocated string.
(func $number_to_string (param $n i32) (result i32)
(local $buf i32)
(local $neg i32)
(local $i i32)
(local $out i32)
(local $j i32)
(local.set $buf (i32.const 0x200)) ;; 32-byte scratch
(local.set $neg (i32.const 0))
(if (i32.lt_s (local.get $n) (i32.const 0))
(then
(local.set $neg (i32.const 1))
(local.set $n (i32.sub (i32.const 0) (local.get $n)))))
(local.set $i (i32.const 0))
(if (i32.eqz (local.get $n))
(then
(i32.store8 (i32.add (local.get $buf) (local.get $i)) (i32.const 48))
(local.set $i (i32.const 1)))
(else
(block $done
(loop $l
(br_if $done (i32.eqz (local.get $n)))
(i32.store8 (i32.add (local.get $buf) (local.get $i))
(i32.add (i32.const 48) (i32.rem_u (local.get $n) (i32.const 10))))
(local.set $n (i32.div_u (local.get $n) (i32.const 10)))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))))
(local.set $out (call $make_string_raw
(i32.add (local.get $i)
(if (result i32) (local.get $neg) (then (i32.const 1)) (else (i32.const 0))))))
(local.set $j (i32.const 0))
(if (local.get $neg)
(then
(call $string_set_byte (local.get $out) (i32.const 0) (i32.const 45))
(local.set $j (i32.const 1))))
(block $done2
(loop $l2
(br_if $done2 (i32.eqz (local.get $i)))
(local.set $i (i32.sub (local.get $i) (i32.const 1)))
(call $string_set_byte (local.get $out) (local.get $j)
(i32.load8_u (i32.add (local.get $buf) (local.get $i))))
(local.set $j (i32.add (local.get $j) (i32.const 1)))
(br $l2)))
(local.get $out))
;; Parse a string as integer. Returns FALSE on parse failure.
(func $string_to_number (param $s i32) (result i32)
(local $len i32)
(local $i i32)
(local $start i32)
(local $neg i32)
(local $n i32)
(local $c i32)
(local.set $len (call $string_len (local.get $s)))
(if (i32.eqz (local.get $len)) (then (return (global.get $FALSE))))
(local.set $start (i32.const 0))
(local.set $neg (i32.const 0))
(local.set $c (call $string_byte (local.get $s) (i32.const 0)))
(if (i32.eq (local.get $c) (i32.const 45))
(then
(local.set $neg (i32.const 1))
(local.set $start (i32.const 1))))
(if (i32.eq (local.get $c) (i32.const 43))
(then (local.set $start (i32.const 1))))
(if (i32.ge_u (local.get $start) (local.get $len)) (then (return (global.get $FALSE))))
(local.set $n (i32.const 0))
(local.set $i (local.get $start))
(block $done
(loop $l
(br_if $done (i32.ge_u (local.get $i) (local.get $len)))
(local.set $c (call $string_byte (local.get $s) (local.get $i)))
(if (i32.eqz (call $is_digit (local.get $c)))
(then (return (global.get $FALSE))))
(local.set $n (i32.add (i32.mul (local.get $n) (i32.const 10))
(i32.sub (local.get $c) (i32.const 48))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(if (local.get $neg)
(then (local.set $n (i32.sub (i32.const 0) (local.get $n)))))
(call $make_fixnum (local.get $n)))
;; Returns TRUE if needle is a substring of haystack, else FALSE.
(func $string_contains_p (param $hay i32) (param $needle i32) (result i32)
(local $hlen i32)
(local $nlen i32)
(local $i i32)
(local $j i32)
(local $matched i32)
(local.set $hlen (call $string_len (local.get $hay)))
(local.set $nlen (call $string_len (local.get $needle)))
(if (i32.eqz (local.get $nlen)) (then (return (global.get $TRUE))))
(if (i32.gt_u (local.get $nlen) (local.get $hlen)) (then (return (global.get $FALSE))))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.gt_u (i32.add (local.get $i) (local.get $nlen)) (local.get $hlen)))
(local.set $j (i32.const 0))
(local.set $matched (i32.const 1))
(block $inner
(loop $il
(br_if $inner (i32.ge_u (local.get $j) (local.get $nlen)))
(if (i32.ne
(call $string_byte (local.get $hay) (i32.add (local.get $i) (local.get $j)))
(call $string_byte (local.get $needle) (local.get $j)))
(then (local.set $matched (i32.const 0)) (br $inner)))
(local.set $j (i32.add (local.get $j) (i32.const 1)))
(br $il)))
(if (local.get $matched) (then (return (global.get $TRUE))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(global.get $FALSE))
;; (string-join '("a" "b" "c") "-") → "a-b-c"
(func $string_join_op (param $list i32) (param $sep i32) (result i32)
(local $cur i32)
(local $total i32)
(local $s i32)
(local $slen i32)
(local $seplen i32)
(local $out i32)
(local $pos i32)
(local $i i32)
(local $first i32)
(local.set $seplen (call $string_len (local.get $sep)))
(local.set $total (i32.const 0))
(local.set $cur (local.get $list))
(local.set $first (i32.const 1))
(block $d1
(loop $l1
(br_if $d1 (i32.eqz (call $is_pair (local.get $cur))))
(local.set $s (call $car (local.get $cur)))
(if (call $is_string (local.get $s))
(then
(if (i32.eqz (local.get $first))
(then (local.set $total (i32.add (local.get $total) (local.get $seplen)))))
(local.set $total (i32.add (local.get $total) (call $string_len (local.get $s))))
(local.set $first (i32.const 0))))
(local.set $cur (call $cdr (local.get $cur)))
(br $l1)))
(local.set $out (call $make_string_raw (local.get $total)))
(local.set $pos (i32.const 0))
(local.set $first (i32.const 1))
(local.set $cur (local.get $list))
(block $d2
(loop $l2
(br_if $d2 (i32.eqz (call $is_pair (local.get $cur))))
(local.set $s (call $car (local.get $cur)))
(if (call $is_string (local.get $s))
(then
(if (i32.eqz (local.get $first))
(then
;; copy sep
(local.set $i (i32.const 0))
(block $d3
(loop $l3
(br_if $d3 (i32.ge_u (local.get $i) (local.get $seplen)))
(call $string_set_byte (local.get $out) (i32.add (local.get $pos) (local.get $i))
(call $string_byte (local.get $sep) (local.get $i)))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l3)))
(local.set $pos (i32.add (local.get $pos) (local.get $seplen)))))
;; copy s
(local.set $slen (call $string_len (local.get $s)))
(local.set $i (i32.const 0))
(block $d4
(loop $l4
(br_if $d4 (i32.ge_u (local.get $i) (local.get $slen)))
(call $string_set_byte (local.get $out) (i32.add (local.get $pos) (local.get $i))
(call $string_byte (local.get $s) (local.get $i)))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l4)))
(local.set $pos (i32.add (local.get $pos) (local.get $slen)))
(local.set $first (i32.const 0))))
(local.set $cur (call $cdr (local.get $cur)))
(br $l2)))
(local.get $out))
;; ─── Primitives ────────────────────────────────────────────────
(func $apply_primitive (param $id i32) (param $args i32) (result i32)
(local $a i32)
@ -1618,6 +2110,161 @@
(if (i32.eq (local.get $id) (i32.const 60))
(then (return (global.get $VOID))))
;; string-length (61)
(if (i32.eq (local.get $id) (i32.const 61))
(then (return (call $make_fixnum (call $string_len (local.get $a))))))
;; string-ref (62) — returns char
(if (i32.eq (local.get $id) (i32.const 62))
(then (return (call $make_char
(call $string_byte (local.get $a) (call $fixnum_val (local.get $b)))))))
;; substring (63) — (substring s start end)
(if (i32.eq (local.get $id) (i32.const 63))
(then (return (call $substring_op (local.get $a)
(call $fixnum_val (local.get $b))
(call $fixnum_val (call $car (call $cdr (call $cdr (local.get $args)))))))))
;; string-append (64) — variadic
(if (i32.eq (local.get $id) (i32.const 64))
(then (return (call $string_append_op (local.get $args)))))
;; string=? (65)
(if (i32.eq (local.get $id) (i32.const 65))
(then (return (call $equal_p (local.get $a) (local.get $b)))))
;; string<? (66)
(if (i32.eq (local.get $id) (i32.const 66))
(then (return (call $string_lt (local.get $a) (local.get $b)))))
;; string-upcase (67)
(if (i32.eq (local.get $id) (i32.const 67))
(then (return (call $string_case_op (local.get $a) (i32.const 1)))))
;; string-downcase (68)
(if (i32.eq (local.get $id) (i32.const 68))
(then (return (call $string_case_op (local.get $a) (i32.const 0)))))
;; string->list (69)
(if (i32.eq (local.get $id) (i32.const 69))
(then (return (call $string_to_list (local.get $a)))))
;; list->string (70)
(if (i32.eq (local.get $id) (i32.const 70))
(then (return (call $list_to_string (local.get $a)))))
;; string->symbol (71)
(if (i32.eq (local.get $id) (i32.const 71))
(then
(return (call $intern
(i32.add (local.get $a) (i32.const 8))
(call $string_len (local.get $a))))))
;; symbol->string (72) — copy symbol bytes into a fresh string
(if (i32.eq (local.get $id) (i32.const 72))
(then (return (call $symbol_to_string (local.get $a)))))
;; make-string (73) — (make-string n) or (make-string n char)
(if (i32.eq (local.get $id) (i32.const 73))
(then (return (call $make_string_filled
(call $fixnum_val (local.get $a))
(if (result i32) (call $is_char (local.get $b))
(then (call $char_code (local.get $b)))
(else (i32.const 32)))))))
;; char? (74)
(if (i32.eq (local.get $id) (i32.const 74))
(then
(if (call $is_char (local.get $a))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; char->integer (75)
(if (i32.eq (local.get $id) (i32.const 75))
(then (return (call $make_fixnum (call $char_code (local.get $a))))))
;; integer->char (76)
(if (i32.eq (local.get $id) (i32.const 76))
(then (return (call $make_char (call $fixnum_val (local.get $a))))))
;; char-alphabetic? (77)
(if (i32.eq (local.get $id) (i32.const 77))
(then
(local.set $sum (call $char_code (local.get $a)))
(if (i32.or
(i32.and (i32.ge_u (local.get $sum) (i32.const 65)) (i32.le_u (local.get $sum) (i32.const 90)))
(i32.and (i32.ge_u (local.get $sum) (i32.const 97)) (i32.le_u (local.get $sum) (i32.const 122))))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; char-numeric? (78)
(if (i32.eq (local.get $id) (i32.const 78))
(then
(local.set $sum (call $char_code (local.get $a)))
(if (i32.and (i32.ge_u (local.get $sum) (i32.const 48)) (i32.le_u (local.get $sum) (i32.const 57)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; char-whitespace? (79)
(if (i32.eq (local.get $id) (i32.const 79))
(then
(local.set $sum (call $char_code (local.get $a)))
(if (i32.or
(i32.or
(i32.eq (local.get $sum) (i32.const 32))
(i32.eq (local.get $sum) (i32.const 9)))
(i32.or
(i32.eq (local.get $sum) (i32.const 10))
(i32.eq (local.get $sum) (i32.const 13))))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; char-upcase (80)
(if (i32.eq (local.get $id) (i32.const 80))
(then
(local.set $sum (call $char_code (local.get $a)))
(if (i32.and (i32.ge_u (local.get $sum) (i32.const 97)) (i32.le_u (local.get $sum) (i32.const 122)))
(then (local.set $sum (i32.sub (local.get $sum) (i32.const 32)))))
(return (call $make_char (local.get $sum)))))
;; char-downcase (81)
(if (i32.eq (local.get $id) (i32.const 81))
(then
(local.set $sum (call $char_code (local.get $a)))
(if (i32.and (i32.ge_u (local.get $sum) (i32.const 65)) (i32.le_u (local.get $sum) (i32.const 90)))
(then (local.set $sum (i32.add (local.get $sum) (i32.const 32)))))
(return (call $make_char (local.get $sum)))))
;; char=? (82)
(if (i32.eq (local.get $id) (i32.const 82))
(then
(if (i32.eq (call $char_code (local.get $a)) (call $char_code (local.get $b)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; char<? (83)
(if (i32.eq (local.get $id) (i32.const 83))
(then
(if (i32.lt_u (call $char_code (local.get $a)) (call $char_code (local.get $b)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; number->string (84)
(if (i32.eq (local.get $id) (i32.const 84))
(then (return (call $number_to_string (call $fixnum_val (local.get $a))))))
;; string->number (85)
(if (i32.eq (local.get $id) (i32.const 85))
(then (return (call $string_to_number (local.get $a)))))
;; string-contains (86) — returns #t if substring present, else #f
(if (i32.eq (local.get $id) (i32.const 86))
(then (return (call $string_contains_p (local.get $a) (local.get $b)))))
;; string-join (87) — (string-join list-of-strings sep-string)
(if (i32.eq (local.get $id) (i32.const 87))
(then (return (call $string_join_op (local.get $a) (local.get $b)))))
(global.get $VOID))
;; ─── Init ──────────────────────────────────────────────────────
@ -1712,6 +2359,40 @@
(data (i32.const 0xE2B0) "list-ref")
(data (i32.const 0xE2BC) "list-tail")
(data (i32.const 0xE2C8) "void")
;; Named character spellings.
(data (i32.const 0xE2D0) "space")
(data (i32.const 0xE2D8) "newline")
(data (i32.const 0xE2E0) "tab")
(data (i32.const 0xE2E4) "return")
(data (i32.const 0xE2EC) "null")
;; String + char primitive names.
(data (i32.const 0xE300) "string-length")
(data (i32.const 0xE310) "string-ref")
(data (i32.const 0xE31C) "substring")
(data (i32.const 0xE328) "string-append")
(data (i32.const 0xE338) "string=?")
(data (i32.const 0xE344) "string<?")
(data (i32.const 0xE350) "string-upcase")
(data (i32.const 0xE360) "string-downcase")
(data (i32.const 0xE374) "string->list")
(data (i32.const 0xE384) "list->string")
(data (i32.const 0xE394) "string->symbol")
(data (i32.const 0xE3A4) "symbol->string")
(data (i32.const 0xE3B4) "make-string")
(data (i32.const 0xE3C0) "char?")
(data (i32.const 0xE3C8) "char->integer")
(data (i32.const 0xE3D8) "integer->char")
(data (i32.const 0xE3E8) "char-alphabetic?")
(data (i32.const 0xE3FC) "char-numeric?")
(data (i32.const 0xE40C) "char-whitespace?")
(data (i32.const 0xE420) "char-upcase")
(data (i32.const 0xE42C) "char-downcase")
(data (i32.const 0xE43C) "char=?")
(data (i32.const 0xE444) "char<?")
(data (i32.const 0xE44C) "number->string")
(data (i32.const 0xE45C) "string->number")
(data (i32.const 0xE46C) "string-contains")
(data (i32.const 0xE47C) "string-join")
(func $bind_prim (param $name_ptr i32) (param $name_len i32) (param $id i32)
(local $sym i32)
@ -1803,7 +2484,34 @@
(call $bind_prim (i32.const 0xE2A8) (i32.const 4) (i32.const 57)) ;; assq
(call $bind_prim (i32.const 0xE2B0) (i32.const 8) (i32.const 58)) ;; list-ref
(call $bind_prim (i32.const 0xE2BC) (i32.const 9) (i32.const 59)) ;; list-tail
(call $bind_prim (i32.const 0xE2C8) (i32.const 4) (i32.const 60))) ;; void
(call $bind_prim (i32.const 0xE2C8) (i32.const 4) (i32.const 60)) ;; void
(call $bind_prim (i32.const 0xE300) (i32.const 13) (i32.const 61)) ;; string-length
(call $bind_prim (i32.const 0xE310) (i32.const 10) (i32.const 62)) ;; string-ref
(call $bind_prim (i32.const 0xE31C) (i32.const 9) (i32.const 63)) ;; substring
(call $bind_prim (i32.const 0xE328) (i32.const 13) (i32.const 64)) ;; string-append
(call $bind_prim (i32.const 0xE338) (i32.const 8) (i32.const 65)) ;; string=?
(call $bind_prim (i32.const 0xE344) (i32.const 8) (i32.const 66)) ;; string<?
(call $bind_prim (i32.const 0xE350) (i32.const 13) (i32.const 67)) ;; string-upcase
(call $bind_prim (i32.const 0xE360) (i32.const 15) (i32.const 68)) ;; string-downcase
(call $bind_prim (i32.const 0xE374) (i32.const 12) (i32.const 69)) ;; string->list
(call $bind_prim (i32.const 0xE384) (i32.const 12) (i32.const 70)) ;; list->string
(call $bind_prim (i32.const 0xE394) (i32.const 14) (i32.const 71)) ;; string->symbol
(call $bind_prim (i32.const 0xE3A4) (i32.const 14) (i32.const 72)) ;; symbol->string
(call $bind_prim (i32.const 0xE3B4) (i32.const 11) (i32.const 73)) ;; make-string
(call $bind_prim (i32.const 0xE3C0) (i32.const 5) (i32.const 74)) ;; char?
(call $bind_prim (i32.const 0xE3C8) (i32.const 13) (i32.const 75)) ;; char->integer
(call $bind_prim (i32.const 0xE3D8) (i32.const 13) (i32.const 76)) ;; integer->char
(call $bind_prim (i32.const 0xE3E8) (i32.const 16) (i32.const 77)) ;; char-alphabetic?
(call $bind_prim (i32.const 0xE3FC) (i32.const 13) (i32.const 78)) ;; char-numeric?
(call $bind_prim (i32.const 0xE40C) (i32.const 16) (i32.const 79)) ;; char-whitespace?
(call $bind_prim (i32.const 0xE420) (i32.const 11) (i32.const 80)) ;; char-upcase
(call $bind_prim (i32.const 0xE42C) (i32.const 13) (i32.const 81)) ;; char-downcase
(call $bind_prim (i32.const 0xE43C) (i32.const 6) (i32.const 82)) ;; char=?
(call $bind_prim (i32.const 0xE444) (i32.const 6) (i32.const 83)) ;; char<?
(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
;; ─── 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.