commit 4b41d120da4d603fd18c7a860f4acdf5af3acfe2
parent 8e6c12f7c9592d655124146d115a456b531a6b9a
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Tue, 21 Apr 2026 17:26:38 -0700
lisp.M1 steps 11-12: reader shorthand + set!/let/letrec/cond/quasiquote
Step 11 (reader): quote/quasiquote/unquote/unquote-splicing shorthand,
#\char literals (incl. space/newline/tab), #(...) vector literals,
improper dotted lists, 0x hex and negative fixnum literals.
Step 12 (eval): set! (local-first, global-fallback), let/let*/letrec
with two-pass pre-bind for mutual recursion, cond with else,
quasiquote/unquote/unquote-splicing, and inner-define rewriting into
letrec-shape at lambda-body scope.
Tests cover distinct code paths: local vs. global set!, mutually
recursive letrec (even?/odd?), and a recursive inner define that
requires true letrec semantics.
Diffstat:
21 files changed, 1552 insertions(+), 123 deletions(-)
diff --git a/src/lisp.M1 b/src/lisp.M1
@@ -111,9 +111,9 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
## Publish src_base/src_len so the reader can walk the source,
## and park (src_buf, bytes_read) in callee-saved r6/r7 so the
- ## tuple survives primitive registration + prelude eval down to
- ## the final eval_source CALL below. Capture r0 into r7 NOW —
- ## sys_close below will overwrite r0 with its own return value.
+ ## tuple survives primitive registration down to the eval_source
+ ## CALL below. Capture r0 into r7 NOW — sys_close below will
+ ## overwrite r0 with its own return value.
mov_r7,r0 ## r7 = bytes_read (captured pre-close)
li_r6 &src_buf ## r6 = &src_buf
li_r1 &src_len
@@ -174,6 +174,69 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
li_r2 &sym_define
st_r0,r2,0
+ li_r1 &str_quasiquote
+ li_r2 %10
+ li_br &intern
+ call
+ li_r2 &sym_quasiquote
+ st_r0,r2,0
+
+ li_r1 &str_unquote
+ li_r2 %7
+ li_br &intern
+ call
+ li_r2 &sym_unquote
+ st_r0,r2,0
+
+ li_r1 &str_unquote_splicing
+ li_r2 %16
+ li_br &intern
+ call
+ li_r2 &sym_unquote_splicing
+ st_r0,r2,0
+
+ li_r1 &str_set
+ li_r2 %4
+ li_br &intern
+ call
+ li_r2 &sym_set
+ st_r0,r2,0
+
+ li_r1 &str_let
+ li_r2 %3
+ li_br &intern
+ call
+ li_r2 &sym_let
+ st_r0,r2,0
+
+ li_r1 &str_letstar
+ li_r2 %4
+ li_br &intern
+ call
+ li_r2 &sym_letstar
+ st_r0,r2,0
+
+ li_r1 &str_letrec
+ li_r2 %6
+ li_br &intern
+ call
+ li_r2 &sym_letrec
+ st_r0,r2,0
+
+ li_r1 &str_cond
+ li_r2 %4
+ li_br &intern
+ call
+ li_r2 &sym_cond
+ st_r0,r2,0
+
+ li_r1 &str_else
+ li_r2 %4
+ li_br &intern
+ call
+ li_r2 &sym_else
+ st_r0,r2,0
+
## Register primitives (LISP.md step 10b). Walk prim_table with
## r4 = cursor, r5 = saved sym across make_primitive. Entry is
## 40 bytes; zero name pointer ends the loop.
@@ -203,15 +266,9 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
li_br &_start_reg_prim_loop
b
:_start_reg_prim_done
- ## Evaluate the embedded Lisp prelude (map/filter/fold) so user
- ## scripts see those bindings.
- li_r1 &prelude_src
- li_r2 &prelude_src_end
- sub_r2,r2,r1
- li_br &eval_source
- call
-
- ## Evaluate the script read from argv[1].
+ ## Evaluate the script read from argv[1]. The Makefile cats
+ ## src/prelude.scm ahead of the user script before invoking us,
+ ## so map/filter/fold are in scope by the time user code runs.
mov_r1,r6
mov_r2,r7
li_br &eval_source
@@ -972,6 +1029,28 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
ret
+## ---- peek2_char() -> r0 = char at cursor+1 (0..255) or -1 on EOF ----
+## Used by the reader to distinguish `,` vs `,@`, `-` vs `-<digit>`, and
+## `0` vs `0x`/`0X` without consuming input.
+:peek2_char
+ li_r1 &src_cursor
+ ld_r1,r1,0
+ addi_r1,r1,1 ## r1 = cursor + 1
+ li_r2 &src_len
+ ld_r2,r2,0
+ li_br &peek2_char_inb
+ blt_r1,r2
+ li_r0 %0
+ addi_r0,r0,neg1
+ ret
+:peek2_char_inb
+ li_r2 &src_base
+ ld_r2,r2,0
+ add_r2,r2,r1
+ lb_r0,r2,0
+ ret
+
+
## ---- advance_char() — consume current char, track line/col --------
:advance_char
prologue
@@ -1021,13 +1100,6 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
li_br &skip_ws_done
beq_r0,r1
- ## NUL (0x00) — treated as whitespace so adjacent M1 "..." chunks
- ## (which each emit a trailing NUL) concatenate cleanly in the
- ## embedded prelude.
- li_r1 %0
- li_br &skip_ws_eat
- beq_r0,r1
-
## ' ' (0x20)
li_r1 %32
li_br &skip_ws_eat
@@ -1103,9 +1175,10 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
## ---- read_number() -> r0 = tagged fixnum ----------------------------
-## Reads a non-negative decimal integer. Digits are consumed while
-## peek_char is in [0-9]. Uses r6 = accumulator across iterations
-## (saved via PROLOGUE_N1 slot 1).
+## Reads a non-negative decimal integer, or a hex integer with `0x`/`0X`
+## prefix. Digits are consumed while peek_char is in [0-9] (or [0-9a-fA-F]
+## after the hex prefix). Uses r6 = accumulator across iterations (saved
+## via PROLOGUE_N1 slot 1).
:read_number
prologue
mov_r3,sp
@@ -1113,6 +1186,52 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
li_r6 %0 ## r6 = 0 (accumulator)
+ ## Detect `0x` / `0X` hex prefix — only triggers if the very first
+ ## byte is '0' and the next is 'x' or 'X'. Anything else falls
+ ## through to the decimal digit loop (including bare `0` or `07`).
+ li_br &peek_char
+ call
+ li_r1 %48 ## '0'
+ li_br &read_number_loop
+ bne_r0,r1
+ li_br &peek2_char
+ call
+ li_r1 %120 ## 'x'
+ li_br &read_number_hex_start
+ beq_r0,r1
+ li_r1 %88 ## 'X'
+ li_br &read_number_hex_start
+ beq_r0,r1
+ li_br &read_number_loop
+ b
+
+:read_number_hex_start
+ li_br &advance_char
+ call ## eat '0'
+ li_br &advance_char
+ call ## eat 'x' / 'X'
+
+:read_number_hex_loop
+ li_br &peek_char
+ call
+ mov_r1,r0
+ li_br &hex_digit_val
+ call ## r0 = digit (0..15) or -1
+ li_r1 %0
+ addi_r1,r1,neg1
+ li_br &read_number_done
+ beq_r0,r1
+
+ ## r6 = r6 * 16 + digit. ADDI_IMMS lacks 4-shift, so SHLI 2 twice.
+ shli_r6,r6,2
+ shli_r6,r6,2
+ add_r6,r6,r0
+
+ li_br &advance_char
+ call
+ li_br &read_number_hex_loop
+ b
+
:read_number_loop
li_br &peek_char
call ## r0 = char (or -1)
@@ -1151,6 +1270,47 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
ret
+## ---- hex_digit_val(r1=c) -> r0 = digit in [0..15] or -1 ------------
+## Classifies one byte as a hex digit. Range-checks via BLT then does
+## an arithmetic subtract: digits subtract '0', A-F subtract 55, a-f
+## subtract 87. Non-hex chars (including EOF=-1) return -1.
+:hex_digit_val
+ li_r2 %48 ## '0'
+ li_br &hex_dv_none
+ blt_r1,r2
+ li_r2 %58 ## ':' (one past '9')
+ li_br &hex_dv_dec
+ blt_r1,r2
+ li_r2 %65 ## 'A'
+ li_br &hex_dv_none
+ blt_r1,r2
+ li_r2 %71 ## 'G' (one past 'F')
+ li_br &hex_dv_upper
+ blt_r1,r2
+ li_r2 %97 ## 'a'
+ li_br &hex_dv_none
+ blt_r1,r2
+ li_r2 %103 ## 'g' (one past 'f')
+ li_br &hex_dv_lower
+ blt_r1,r2
+:hex_dv_none
+ li_r0 %0
+ addi_r0,r0,neg1
+ ret
+:hex_dv_dec
+ mov_r0,r1
+ addi_r0,r0,neg48
+ ret
+:hex_dv_upper
+ li_r0 %55 ## 'A' - 10 = 55
+ sub_r0,r1,r0
+ ret
+:hex_dv_lower
+ li_r0 %87 ## 'a' - 10 = 87
+ sub_r0,r1,r0
+ ret
+
+
## ---- is_delim(c) -> r0 = 0 or 1 ------------------------------------
## Returns 1 if c is a token delimiter: whitespace, '(', ')', ';', or EOF.
:is_delim
@@ -1372,9 +1532,13 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
li_br &err_reader_bad
beq_r0,r1
- ## Read head element, then tail, then cons them.
- st_r6,sp,8 ## save outer r6 (if any)
+ ## '.' followed by a delimiter → dotted tail. `.<alpha>` still
+ ## parses as a regular symbol (fall-through to read_expr).
+ li_r1 %46 ## '.'
+ li_br &read_list_maybe_dotted
+ beq_r0,r1
+ ## Read head element, then tail, then cons them.
li_br &read_expr
call ## r0 = head
@@ -1389,9 +1553,50 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
li_br &cons
call
- ## Restore r6 (we clobbered the slot when storing head; outer r6 is gone.
- ## In this test we never rely on r6 across read_list invocations, so
- ## leave it; slot is scratch).
+ epilogue
+ ret
+
+:read_list_maybe_dotted
+ li_br &peek2_char
+ call
+ mov_r1,r0
+ li_br &is_delim
+ call
+ li_r1 %1
+ li_br &read_list_dotted
+ beq_r0,r1
+
+ ## Bare `.` followed by non-delim → fall back to regular item path.
+ li_br &read_expr
+ call
+ st_r0,sp,8
+ li_br &read_list
+ call
+ ld_r1,sp,8
+ mov_r2,r0
+ li_br &cons
+ call
+ epilogue
+ ret
+
+:read_list_dotted
+ li_br &advance_char
+ call ## eat '.'
+ li_br &skip_ws
+ call
+ li_br &read_expr
+ call ## r0 = dotted tail expr
+ st_r0,sp,8
+ li_br &skip_ws
+ call
+ li_br &peek_char
+ call
+ li_r1 %41 ## ')'
+ li_br &err_reader_bad
+ bne_r0,r1
+ li_br &advance_char
+ call ## eat ')'
+ ld_r0,sp,8
epilogue
ret
@@ -1430,11 +1635,32 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
li_br &read_expr_string
beq_r0,r1
- ## '#' → hash-prefix literal (#t, #f for now).
+ ## '#' → hash-prefix literal (#t, #f, #\char, #(...)).
li_r1 %35
li_br &read_expr_hash
beq_r0,r1
+ ## '\'' → (quote x)
+ li_r1 %39
+ li_br &read_expr_quote
+ beq_r0,r1
+
+ ## '`' → (quasiquote x)
+ li_r1 %96
+ li_br &read_expr_quasiquote
+ beq_r0,r1
+
+ ## ',' → (unquote x) or (unquote-splicing x) if followed by '@'
+ li_r1 %44
+ li_br &read_expr_unquote
+ beq_r0,r1
+
+ ## '-' followed by a digit → negative fixnum literal. Plain '-'
+ ## still reads as a symbol (the subtraction primitive).
+ li_r1 %45
+ li_br &read_expr_maybe_neg
+ beq_r0,r1
+
## digit → number.
mov_r1,r0
li_br &is_digit
@@ -1469,8 +1695,8 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
epilogue
ret
-## Hash-prefix literals: `#t` → 0x0F, `#f` → 0x17. Inherits read_expr's
-## PROLOGUE (no new frame). Extended syntax (#\char, #(…)) is step 11.
+## Hash-prefix literals: `#t`/`#f` singletons, `#\char` ASCII fixnum,
+## `#(...)` vector literal. Inherits read_expr's PROLOGUE.
:read_expr_hash
li_br &advance_char
call ## eat '#'
@@ -1483,6 +1709,12 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
li_r1 %102 ## 'f'
li_br &read_expr_hash_f
beq_r0,r1
+ li_r1 %92 ## '\\'
+ li_br &read_expr_hash_char
+ beq_r0,r1
+ li_r1 %40 ## '('
+ li_br &read_expr_hash_vector
+ beq_r0,r1
li_br &err_reader_bad
b
@@ -1501,65 +1733,398 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
epilogue
ret
+:read_expr_hash_char
+ li_br &read_char_literal
+ call
+ epilogue
+ ret
-## ---- Display --------------------------------------------------------
+:read_expr_hash_vector
+ li_br &read_vector_literal
+ call
+ epilogue
+ ret
-## ---- putc(r1=char) — write one byte to fd 1 ------------------------
-:putc_buf %0 %0
-:putc
- prologue
- li_r2 &putc_buf
- sb_r1,r2,0 ## *putc_buf = low byte of r1
- li_r0 sys_write
- li_r1 %1
- ## r2 = &putc_buf already
- li_r3 %1
- syscall
+## ---- read_expr_quote / quasiquote / unquote / maybe_neg -------------
+## All inherit read_expr's PROLOGUE; each wraps the downstream value and
+## ret/epilogue out.
+:read_expr_quote
+ li_br &advance_char
+ call ## eat '\''
+ li_r1 &sym_quote
+ ld_r1,r1,0
+ li_br &read_quoted_wrap
+ call
epilogue
ret
+:read_expr_quasiquote
+ li_br &advance_char
+ call ## eat '`'
+ li_r1 &sym_quasiquote
+ ld_r1,r1,0
+ li_br &read_quoted_wrap
+ call
+ epilogue
+ ret
-## ---- display_uint(r1=u64, r2=fd) — decimal, no sign --------------
-## Writes digits to `digit_buf` right-to-left, then SYS_WRITEs the
-## filled range to fd. 24-byte buffer covers any 61-bit value.
-## fd is spilled into slot 3 because the digit loop reuses r2 as the
-## divisor '10' constant — keeping fd in a reg would require saving
-## another callee-saved, which costs the same.
-:digit_buf '000000000000000000000000000000000000000000000000'
-:digit_buf_end %0
+:read_expr_unquote
+ li_br &advance_char
+ call ## eat ','
+ li_br &peek_char
+ call
+ li_r1 %64 ## '@'
+ li_br &read_expr_unquote_splicing
+ beq_r0,r1
+ li_r1 &sym_unquote
+ ld_r1,r1,0
+ li_br &read_quoted_wrap
+ call
+ epilogue
+ ret
-:display_uint
- prologue_n3
- st_r6,sp,8
- st_r7,sp,16
- st_r2,sp,24 ## save fd
+:read_expr_unquote_splicing
+ li_br &advance_char
+ call ## eat '@'
+ li_r1 &sym_unquote_splicing
+ ld_r1,r1,0
+ li_br &read_quoted_wrap
+ call
+ epilogue
+ ret
- li_r6 &digit_buf_end ## r6 = end-of-buffer cursor (moves left)
- mov_r7,r1 ## r7 = value (mutated)
+:read_expr_maybe_neg
+ li_br &peek2_char
+ call
+ mov_r1,r0
+ li_br &is_digit
+ call
+ li_r1 %1
+ li_br &read_expr_negnum
+ beq_r0,r1
+ ## Not a digit after '-' → treat as a regular symbol (the '-' is
+ ## the sub primitive, or a longer ident like `-ident`).
+ li_br &read_symbol
+ call
+ epilogue
+ ret
- ## Special-case zero.
- li_br &du_loop
- bnez_r7 ## if value != 0, loop; else write '0'
- addi_r6,r6,neg1
- li_r1 %48 ## '0'
- sb_r1,r6,0
- li_br &du_write
- b
+:read_expr_negnum
+ li_br &advance_char
+ call ## eat '-'
+ li_br &read_number
+ call ## r0 = tagged positive number
+ sari_r0,r0,3 ## decode
+ li_r1 %0
+ sub_r0,r1,r0 ## r0 = -value
+ shli_r0,r0,3
+ ori_r0,r0,1 ## retag
+ epilogue
+ ret
-:du_loop
- li_br &du_write
- beqz_r7 ## value == 0 → done digit gen
- ## digit = value % 10.
- mov_r1,r7
- li_r2 %10
- rem_r1,r1,r2 ## r1 = value % 10
- addi_r1,r1,48 ## r1 += '0'
- addi_r6,r6,neg1
- sb_r1,r6,0 ## *--r6 = digit
+## ---- read_quoted_wrap(r1=tagged_sym) -> r0 = (sym expr) -------------
+## Reads one expression and returns (sym . (expr . nil)). Shared by the
+## four reader shorthand forms (quote/quasi/unquote/unquote-splicing).
+:read_quoted_wrap
+ prologue
+ st_r1,sp,8 ## save tagged sym
+ li_br &read_expr
+ call ## r0 = expr
+ mov_r1,r0
+ li_r2 NIL
+ li_br &cons
+ call ## r0 = (expr . nil)
+ mov_r2,r0
+ ld_r1,sp,8
+ li_br &cons ## r0 = (sym . (expr . nil))
+ tail
- ## value = value / 10.
+
+## ---- read_char_literal() -> r0 = tagged fixnum (ASCII) -------------
+## `\` already at cursor. Consumes `\`, then one or more chars. If the
+## first char is followed by a delimiter, that char is the result. If
+## more chars follow, the full span is matched against `space`, `newline`,
+## or `tab`; anything else errors out.
+:read_char_literal
+ prologue_n4
+ li_br &advance_char
+ call ## eat '\\'
+
+ li_r1 &src_cursor
+ ld_r0,r1,0
+ st_r0,sp,8 ## slot 1 = start cursor
+
+ li_br &peek_char
+ call ## r0 = first char (must not be EOF)
+ li_r1 %0
+ addi_r1,r1,neg1
+ li_br &err_reader_bad
+ beq_r0,r1
+
+ st_r0,sp,16 ## slot 2 = first char
+ li_br &advance_char
+ call ## eat first char
+
+ li_br &peek_char
+ call
+ mov_r1,r0
+ li_br &is_delim
+ call
+ li_r1 %1
+ li_br &rcl_single
+ beq_r0,r1
+
+:rcl_name_loop
+ li_br &peek_char
+ call
+ mov_r1,r0
+ li_br &is_delim
+ call
+ li_r1 %1
+ li_br &rcl_compare
+ beq_r0,r1
+ li_br &advance_char
+ call
+ li_br &rcl_name_loop
+ b
+
+:rcl_compare
+ ## r2 = len (cursor - start), r0 = ptr (base + start).
+ li_r1 &src_cursor
+ ld_r2,r1,0
+ ld_r1,sp,8
+ sub_r2,r2,r1
+ li_r0 &src_base
+ ld_r0,r0,0
+ add_r0,r0,r1
+ li_r1 %5
+ li_br &rcl_cmp5
+ beq_r2,r1
+ li_r1 %7
+ li_br &rcl_cmp7
+ beq_r2,r1
+ li_r1 %3
+ li_br &rcl_cmp3
+ beq_r2,r1
+ li_br &err_reader_bad
+ b
+
+:rcl_cmp5
+ ## "space" → 32
+ lb_r1,r0,0
+ li_r2 %115
+ li_br &err_reader_bad
+ bne_r1,r2
+ addi_r0,r0,1
+ lb_r1,r0,0
+ li_r2 %112
+ li_br &err_reader_bad
+ bne_r1,r2
+ addi_r0,r0,1
+ lb_r1,r0,0
+ li_r2 %97
+ li_br &err_reader_bad
+ bne_r1,r2
+ addi_r0,r0,1
+ lb_r1,r0,0
+ li_r2 %99
+ li_br &err_reader_bad
+ bne_r1,r2
+ addi_r0,r0,1
+ lb_r1,r0,0
+ li_r2 %101
+ li_br &err_reader_bad
+ bne_r1,r2
+ li_r0 %32
+ shli_r0,r0,3
+ ori_r0,r0,1
+ epilogue_n4
+ ret
+
+:rcl_cmp7
+ ## "newline" → 10
+ lb_r1,r0,0
+ li_r2 %110
+ li_br &err_reader_bad
+ bne_r1,r2
+ addi_r0,r0,1
+ lb_r1,r0,0
+ li_r2 %101
+ li_br &err_reader_bad
+ bne_r1,r2
+ addi_r0,r0,1
+ lb_r1,r0,0
+ li_r2 %119
+ li_br &err_reader_bad
+ bne_r1,r2
+ addi_r0,r0,1
+ lb_r1,r0,0
+ li_r2 %108
+ li_br &err_reader_bad
+ bne_r1,r2
+ addi_r0,r0,1
+ lb_r1,r0,0
+ li_r2 %105
+ li_br &err_reader_bad
+ bne_r1,r2
+ addi_r0,r0,1
+ lb_r1,r0,0
+ li_r2 %110
+ li_br &err_reader_bad
+ bne_r1,r2
+ addi_r0,r0,1
+ lb_r1,r0,0
+ li_r2 %101
+ li_br &err_reader_bad
+ bne_r1,r2
+ li_r0 %10
+ shli_r0,r0,3
+ ori_r0,r0,1
+ epilogue_n4
+ ret
+
+:rcl_cmp3
+ ## "tab" → 9
+ lb_r1,r0,0
+ li_r2 %116
+ li_br &err_reader_bad
+ bne_r1,r2
+ addi_r0,r0,1
+ lb_r1,r0,0
+ li_r2 %97
+ li_br &err_reader_bad
+ bne_r1,r2
+ addi_r0,r0,1
+ lb_r1,r0,0
+ li_r2 %98
+ li_br &err_reader_bad
+ bne_r1,r2
+ li_r0 %9
+ shli_r0,r0,3
+ ori_r0,r0,1
+ epilogue_n4
+ ret
+
+:rcl_single
+ ld_r0,sp,16
+ shli_r0,r0,3
+ ori_r0,r0,1
+ epilogue_n4
+ ret
+
+
+## ---- read_vector_literal() -> r0 = tagged vector -------------------
+## `#(` detected; cursor at `(`. Read the body as a list, then convert
+## element-by-element into a freshly-allocated vector.
+:read_vector_literal
+ prologue_n3
+ li_br &advance_char
+ call ## eat '('
+ li_br &read_list
+ call ## r0 = tagged list
+ st_r0,sp,8 ## slot 1 = list head
+
+ mov_r1,r0
+ li_r2 %0 ## r2 = count
+:rvl_count
+ li_r0 NIL
+ li_br &rvl_alloc
+ beq_r1,r0
+ addi_r0,r1,neg2
+ ld_r1,r0,8
+ addi_r2,r2,1
+ li_br &rvl_count
+ b
+
+:rvl_alloc
+ mov_r1,r2
+ li_r2 NIL
+ li_br &make_vector
+ call ## r0 = tagged vector
+ st_r0,sp,16 ## slot 2 = vec
+
+ addi_r3,r0,neg3
+ addi_r3,r3,8 ## r3 = payload cursor
+ ld_r1,sp,8
+
+:rvl_fill
+ li_r0 NIL
+ li_br &rvl_done
+ beq_r1,r0
+ addi_r0,r1,neg2
+ ld_r2,r0,0
+ ld_r1,r0,8
+ st_r2,r3,0
+ addi_r3,r3,8
+ li_br &rvl_fill
+ b
+
+:rvl_done
+ ld_r0,sp,16
+ epilogue_n3
+ ret
+
+
+## ---- Display --------------------------------------------------------
+
+## ---- putc(r1=char) — write one byte to fd 1 ------------------------
+:putc_buf %0 %0
+
+:putc
+ prologue
+ li_r2 &putc_buf
+ sb_r1,r2,0 ## *putc_buf = low byte of r1
+ li_r0 sys_write
+ li_r1 %1
+ ## r2 = &putc_buf already
+ li_r3 %1
+ syscall
+ epilogue
+ ret
+
+
+## ---- display_uint(r1=u64, r2=fd) — decimal, no sign --------------
+## Writes digits to `digit_buf` right-to-left, then SYS_WRITEs the
+## filled range to fd. 24-byte buffer covers any 61-bit value.
+## fd is spilled into slot 3 because the digit loop reuses r2 as the
+## divisor '10' constant — keeping fd in a reg would require saving
+## another callee-saved, which costs the same.
+:digit_buf '000000000000000000000000000000000000000000000000'
+:digit_buf_end %0
+
+:display_uint
+ prologue_n3
+ st_r6,sp,8
+ st_r7,sp,16
+ st_r2,sp,24 ## save fd
+
+ li_r6 &digit_buf_end ## r6 = end-of-buffer cursor (moves left)
+ mov_r7,r1 ## r7 = value (mutated)
+
+ ## Special-case zero.
+ li_br &du_loop
+ bnez_r7 ## if value != 0, loop; else write '0'
+ addi_r6,r6,neg1
+ li_r1 %48 ## '0'
+ sb_r1,r6,0
+ li_br &du_write
+ b
+
+:du_loop
+ li_br &du_write
+ beqz_r7 ## value == 0 → done digit gen
+
+ ## digit = value % 10.
+ mov_r1,r7
+ li_r2 %10
+ rem_r1,r1,r2 ## r1 = value % 10
+ addi_r1,r1,48 ## r1 += '0'
+ addi_r6,r6,neg1
+ sb_r1,r6,0 ## *--r6 = digit
+
+ ## value = value / 10.
mov_r1,r7
li_r2 %10
div_r1,r1,r2
@@ -4137,6 +4702,36 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
li_br &eval_define
beq_r0,r1
+ li_r1 &sym_set
+ ld_r1,r1,0
+ li_br &eval_set
+ beq_r0,r1
+
+ li_r1 &sym_let
+ ld_r1,r1,0
+ li_br &eval_let
+ beq_r0,r1
+
+ li_r1 &sym_letstar
+ ld_r1,r1,0
+ li_br &eval_letstar
+ beq_r0,r1
+
+ li_r1 &sym_letrec
+ ld_r1,r1,0
+ li_br &eval_letrec
+ beq_r0,r1
+
+ li_r1 &sym_cond
+ ld_r1,r1,0
+ li_br &eval_cond
+ beq_r0,r1
+
+ li_r1 &sym_quasiquote
+ ld_r1,r1,0
+ li_br &eval_quasiquote
+ beq_r0,r1
+
## Application: callee = eval(callee-expr, env)
mov_r1,r0
ld_r2,sp,16
@@ -4278,12 +4873,13 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
ret
:eval_lambda
- ## (lambda params body). Slot 1 gets repurposed to hold params
- ## once we no longer need the original expr.
+ ## (lambda params body1 body2 ...). Collect body-list, rewrite any
+ ## leading (define …) forms into a letrec (step 12e), then stash
+ ## the resulting single expression as the closure's body.
ld_r1,sp,8
li_br &cdr
- call ## r0 = (params body)
- st_r0,sp,24 ## slot 3 = (params body)
+ call ## r0 = (params body1 body2 ...)
+ st_r0,sp,24 ## slot 3 = after-head
mov_r1,r0
li_br &car
@@ -4292,15 +4888,15 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
ld_r1,sp,24
li_br &cdr
- call ## r0 = (body)
+ call ## r0 = body list
mov_r1,r0
- li_br &car
- call ## r0 = body
+ li_br &rewrite_lambda_body
+ call ## r0 = rewritten single expr
mov_r2,r0
ld_r1,sp,8 ## r1 = params
ld_r3,sp,16 ## r3 = env
- li_br &make_closure ## tail: no Scheme-visible work after
+ li_br &make_closure
tail_n3
:eval_define
@@ -4337,34 +4933,752 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
ret
-## ---- Step-6 error landing pads --------------------------------------
-:err_unbound
- li_r1 &msg_unbound
- li_r2 %14 ## strlen("unbound symbol") == 14
- li_br &error
- b
+## ---- eval_set (step 12a) -------------------------------------------
+## (set! sym val-expr). Evaluates val-expr, then mutates the first
+## binding of sym found in local→global search order.
+:eval_set
+ ld_r1,sp,8
+ li_br &cdr
+ call ## r0 = (sym val-expr)
+ mov_r1,r0
+ li_br &car
+ call ## r0 = sym
+ st_r0,sp,24 ## slot 3 = sym
-:err_arity
- li_r1 &msg_arity
- li_r2 %14 ## strlen("arity mismatch") == 14
- li_br &error
- b
+ ld_r1,sp,8
+ li_br &cdr
+ call
+ mov_r1,r0
+ li_br &cdr
+ call
+ mov_r1,r0
+ li_br &car
+ call ## r0 = val-expr
+ mov_r1,r0
+ ld_r2,sp,16
+ li_br &eval
+ call ## r0 = val
-:err_not_callable
- li_r1 &msg_not_callable
- li_r2 %12 ## strlen("not callable") == 12
- li_br &error
- b
+ mov_r3,r0
+ ld_r1,sp,24
+ ld_r2,sp,16
+ li_br &set_binding
+ tail_n3
-:err_too_many_args
- li_r1 &msg_too_many_args
- li_r2 %21 ## strlen("primitive argc > 32") == 21
- li_br &error
- b
-:err_bad_prim
- li_r1 &msg_bad_prim
- li_r2 %20 ## strlen("unknown primitive id") == 20
+## ---- set_binding(r1=sym, r2=env, r3=val) -> r0 = unspec -------------
+## Looks up the first (sym . v) cell in env (local alist first, then
+## global) and mutates the cdr to val. Errors out on unbound sym.
+:set_binding
+ prologue_n3
+ st_r3,sp,24 ## slot 3 = val
+ st_r1,sp,8 ## slot 1 = sym (for global fallback)
+
+ li_br &lookup_alist
+ call ## r0 = (sym . v) pair or nil
+ li_r1 NIL
+ li_br &set_binding_global
+ beq_r0,r1
+
+ ld_r1,sp,24
+ addi_r0,r0,neg2 ## raw pair ptr
+ st_r1,r0,8 ## mutate cdr
+ li_r0 UNSPEC
+ epilogue_n3
+ ret
+
+:set_binding_global
+ ld_r1,sp,8
+ li_r2 &global_env_cell
+ ld_r2,r2,0
+ li_br &lookup_alist
+ call
+ li_r1 NIL
+ li_br &err_unbound
+ beq_r0,r1
+
+ ld_r1,sp,24
+ addi_r0,r0,neg2
+ st_r1,r0,8
+ li_r0 UNSPEC
+ epilogue_n3
+ ret
+
+
+## ---- eval_let (step 12b) -------------------------------------------
+## (let ((n1 e1) …) body…). Each RHS is evaluated in the *outer* env;
+## then body evaluates in env extended with all new bindings.
+:eval_let
+ ld_r1,sp,8
+ li_br &cdr
+ call ## r0 = (bindings body…)
+ st_r0,sp,24 ## slot 3 = after-head
+
+ mov_r1,r0
+ li_br &car
+ call ## r0 = bindings
+ mov_r1,r0
+ ld_r2,sp,16
+ li_br &build_let_env
+ call ## r0 = new env
+ st_r0,sp,16 ## slot 2 = new env
+
+ ld_r1,sp,24
+ li_br &cdr
+ call ## r0 = body list
+ mov_r2,r0
+ li_r1 &sym_begin
+ ld_r1,r1,0
+ li_br &cons
+ call ## r0 = (begin . body)
+ mov_r1,r0
+ ld_r2,sp,16
+ li_br &eval
+ tail_n3
+
+
+## ---- eval_letstar --------------------------------------------------
+## (let* ((n1 e1) …) body…). Each RHS is evaluated in the env built
+## from previous bindings, then body evaluates in the final env.
+:eval_letstar
+ ld_r1,sp,8
+ li_br &cdr
+ call
+ st_r0,sp,24
+
+ mov_r1,r0
+ li_br &car
+ call
+ mov_r1,r0
+ ld_r2,sp,16
+ li_br &build_letstar_env
+ call
+ st_r0,sp,16
+
+ ld_r1,sp,24
+ li_br &cdr
+ call
+ mov_r2,r0
+ li_r1 &sym_begin
+ ld_r1,r1,0
+ li_br &cons
+ call
+ mov_r1,r0
+ ld_r2,sp,16
+ li_br &eval
+ tail_n3
+
+
+## ---- eval_letrec ---------------------------------------------------
+## (letrec ((n1 e1) …) body…). Pre-binds each name to UNSPEC, then
+## walks the binding list a second time evaluating each RHS in the
+## fully pre-bound env and mutating the binding cell.
+:eval_letrec
+ ld_r1,sp,8
+ li_br &cdr
+ call
+ st_r0,sp,24
+
+ mov_r1,r0
+ li_br &car
+ call
+ mov_r1,r0
+ ld_r2,sp,16
+ li_br &build_letrec_env
+ call
+ st_r0,sp,16
+
+ ld_r1,sp,24
+ li_br &cdr
+ call
+ mov_r2,r0
+ li_r1 &sym_begin
+ ld_r1,r1,0
+ li_br &cons
+ call
+ mov_r1,r0
+ ld_r2,sp,16
+ li_br &eval
+ tail_n3
+
+
+## ---- eval_cond (step 12c) ------------------------------------------
+## (cond (test body…) … (else body…)). Walks clauses in order, evaluates
+## each test; on truthy test or literal `else`, evaluates body as a begin.
+## Returns unspec if no clause fires.
+:eval_cond
+ ld_r1,sp,8
+ li_br &cdr
+ call ## r0 = clauses
+ st_r0,sp,8 ## slot 1 = cursor
+
+:eval_cond_loop
+ ld_r1,sp,8
+ li_r0 NIL
+ li_br &eval_cond_done
+ beq_r1,r0
+
+ li_br &car
+ call ## r0 = clause
+ st_r0,sp,24 ## slot 3 = clause
+
+ mov_r1,r0
+ li_br &car
+ call ## r0 = test
+
+ li_r1 &sym_else
+ ld_r1,r1,0
+ li_br &eval_cond_body
+ beq_r0,r1
+
+ mov_r1,r0
+ ld_r2,sp,16
+ li_br &eval
+ call ## r0 = test value
+
+ li_r1 FALSE
+ li_br &eval_cond_next
+ beq_r0,r1
+
+:eval_cond_body
+ ld_r1,sp,24
+ li_br &cdr
+ call ## r0 = body list
+ mov_r2,r0
+ li_r1 &sym_begin
+ ld_r1,r1,0
+ li_br &cons
+ call
+ mov_r1,r0
+ ld_r2,sp,16
+ li_br &eval
+ tail_n3
+
+:eval_cond_next
+ ld_r1,sp,8
+ li_br &cdr
+ call
+ st_r0,sp,8
+ li_br &eval_cond_loop
+ b
+
+:eval_cond_done
+ li_r0 UNSPEC
+ epilogue_n3
+ ret
+
+
+## ---- eval_quasiquote (step 12d) -------------------------------------
+## (quasiquote template). Delegates to quasi_expand which walks the
+## template recursively, handling `,x` (unquote) and `,@x`
+## (unquote-splicing) forms.
+:eval_quasiquote
+ ld_r1,sp,8
+ li_br &cdr
+ call
+ mov_r1,r0
+ li_br &car
+ call ## r0 = template
+ mov_r1,r0
+ ld_r2,sp,16
+ li_br &quasi_expand
+ tail_n3
+
+
+## ---- build_let_env(r1=bindings, r2=outer_env) -> r0 = new_env ------
+## Builds a fresh alist extending outer_env. Each RHS expression is
+## evaluated in the *outer* env — the let semantics.
+:build_let_env
+ prologue_n4
+ st_r1,sp,8 ## slot 1 = cursor
+ st_r2,sp,16 ## slot 2 = outer env
+ st_r2,sp,24 ## slot 3 = new env acc
+
+:ble_loop
+ ld_r1,sp,8
+ li_r0 NIL
+ li_br &ble_done
+ beq_r1,r0
+
+ li_br &car
+ call ## r0 = (name expr)
+ st_r0,sp,32 ## slot 4 = (name expr)
+
+ mov_r1,r0
+ li_br &cdr
+ call
+ mov_r1,r0
+ li_br &car
+ call ## r0 = expr
+
+ mov_r1,r0
+ ld_r2,sp,16 ## outer env
+ li_br &eval
+ call ## r0 = val
+
+ mov_r2,r0
+ ld_r1,sp,32
+ addi_r1,r1,neg2
+ ld_r1,r1,0 ## r1 = name
+ li_br &cons
+ call ## r0 = (name . val)
+
+ mov_r1,r0
+ ld_r2,sp,24
+ li_br &cons
+ call ## r0 = extended env
+ st_r0,sp,24
+
+ ld_r1,sp,8
+ li_br &cdr
+ call
+ st_r0,sp,8
+ li_br &ble_loop
+ b
+
+:ble_done
+ ld_r0,sp,24
+ epilogue_n4
+ ret
+
+
+## ---- build_letstar_env(r1=bindings, r2=outer_env) -> r0 = new_env --
+## Like build_let_env, but each RHS is evaluated in the env accumulated
+## so far (not the fixed outer env).
+:build_letstar_env
+ prologue_n4
+ st_r1,sp,8
+ st_r2,sp,24 ## slot 3 = current env
+
+:bls_loop
+ ld_r1,sp,8
+ li_r0 NIL
+ li_br &bls_done
+ beq_r1,r0
+
+ li_br &car
+ call
+ st_r0,sp,32
+
+ mov_r1,r0
+ li_br &cdr
+ call
+ mov_r1,r0
+ li_br &car
+ call ## r0 = expr
+
+ mov_r1,r0
+ ld_r2,sp,24 ## current env
+ li_br &eval
+ call ## r0 = val
+
+ mov_r2,r0
+ ld_r1,sp,32
+ addi_r1,r1,neg2
+ ld_r1,r1,0
+ li_br &cons
+ call
+
+ mov_r1,r0
+ ld_r2,sp,24
+ li_br &cons
+ call
+ st_r0,sp,24
+
+ ld_r1,sp,8
+ li_br &cdr
+ call
+ st_r0,sp,8
+ li_br &bls_loop
+ b
+
+:bls_done
+ ld_r0,sp,24
+ epilogue_n4
+ ret
+
+
+## ---- build_letrec_env(r1=bindings, r2=outer_env) -> r0 = new_env --
+## Two-pass: pass 1 seeds each name with UNSPEC; pass 2 evaluates each
+## RHS in the fully pre-bound env and mutates the binding's cdr via
+## set_binding. Supports mutual recursion.
+:build_letrec_env
+ prologue_n4
+ st_r1,sp,8 ## slot 1 = cursor
+ st_r1,sp,16 ## slot 2 = original bindings (for pass 2)
+ st_r2,sp,24 ## slot 3 = new env
+
+:blr_pre_loop
+ ld_r1,sp,8
+ li_r0 NIL
+ li_br &blr_pre_done
+ beq_r1,r0
+
+ li_br &car
+ call ## r0 = (name expr)
+ mov_r1,r0
+ li_br &car
+ call ## r0 = name
+
+ mov_r1,r0
+ li_r2 UNSPEC
+ li_br &cons
+ call ## r0 = (name . UNSPEC)
+
+ mov_r1,r0
+ ld_r2,sp,24
+ li_br &cons
+ call
+ st_r0,sp,24
+
+ ld_r1,sp,8
+ li_br &cdr
+ call
+ st_r0,sp,8
+ li_br &blr_pre_loop
+ b
+
+:blr_pre_done
+ ld_r1,sp,16
+ st_r1,sp,8 ## reset cursor
+
+:blr_eval_loop
+ ld_r1,sp,8
+ li_r0 NIL
+ li_br &blr_eval_done
+ beq_r1,r0
+
+ li_br &car
+ call
+ st_r0,sp,32 ## slot 4 = (name expr)
+
+ mov_r1,r0
+ li_br &cdr
+ call
+ mov_r1,r0
+ li_br &car
+ call ## r0 = expr
+
+ mov_r1,r0
+ ld_r2,sp,24
+ li_br &eval
+ call ## r0 = val
+
+ mov_r3,r0
+ ld_r1,sp,32
+ addi_r1,r1,neg2
+ ld_r1,r1,0 ## r1 = name
+ ld_r2,sp,24
+ li_br &set_binding
+ call
+
+ ld_r1,sp,8
+ li_br &cdr
+ call
+ st_r0,sp,8
+ li_br &blr_eval_loop
+ b
+
+:blr_eval_done
+ ld_r0,sp,24
+ epilogue_n4
+ ret
+
+
+## ---- rewrite_lambda_body(r1=body_list) -> r0 = single body expr ----
+## Collects leading (define name val) forms from a lambda body and
+## rewrites the body into (letrec ((n1 v1) …) body-tail…) if any are
+## present. Otherwise returns either the single body form or a
+## (begin . body) wrapper.
+:rewrite_lambda_body
+ prologue_n4
+ st_r1,sp,8 ## slot 1 = cursor
+ li_r0 NIL
+ st_r0,sp,16 ## slot 2 = reversed bindings acc
+
+:rlb_loop
+ ld_r1,sp,8
+ li_r0 NIL
+ li_br &rlb_done
+ beq_r1,r0
+
+ li_br &car
+ call ## r0 = body form
+ mov_r1,r0
+ andi_r0,r0,7
+ li_r2 TAG_PAIR
+ li_br &rlb_done
+ bne_r0,r2
+
+ st_r1,sp,24 ## slot 3 = form
+ li_br &car
+ call ## r0 = head
+ li_r1 &sym_define
+ ld_r1,r1,0
+ li_br &rlb_done
+ bne_r0,r1
+
+ ld_r1,sp,24
+ li_br &cdr
+ call ## r0 = (name val)
+
+ mov_r1,r0
+ ld_r2,sp,16
+ li_br &cons
+ call
+ st_r0,sp,16
+
+ ld_r1,sp,8
+ li_br &cdr
+ call
+ st_r0,sp,8
+ li_br &rlb_loop
+ b
+
+:rlb_done
+ ld_r1,sp,16
+ li_r0 NIL
+ li_br &rlb_no_defs
+ beq_r1,r0
+
+ ld_r1,sp,16
+ li_br &list_reverse
+ call
+ st_r0,sp,16
+
+ ld_r1,sp,16
+ ld_r2,sp,8
+ li_br &cons
+ call ## r0 = (bindings . body-tail)
+ mov_r2,r0
+ li_r1 &sym_letrec
+ ld_r1,r1,0
+ li_br &cons
+ tail_n4
+
+:rlb_no_defs
+ ld_r1,sp,8
+ li_br &cdr
+ call
+ li_r1 NIL
+ li_br &rlb_single
+ beq_r0,r1
+
+ ld_r2,sp,8
+ li_r1 &sym_begin
+ ld_r1,r1,0
+ li_br &cons
+ tail_n4
+
+:rlb_single
+ ld_r1,sp,8
+ li_br &car
+ tail_n4
+
+
+## ---- list_reverse(r1=list) -> r0 = reversed list --------------------
+## Simple tail-consing reverse; used by rewrite_lambda_body to restore
+## source-order bindings.
+:list_reverse
+ prologue_n2
+ st_r1,sp,8
+ li_r0 NIL
+ st_r0,sp,16
+
+:lrv_loop
+ ld_r1,sp,8
+ li_r0 NIL
+ li_br &lrv_done
+ beq_r1,r0
+
+ li_br &car
+ call
+ mov_r1,r0
+ ld_r2,sp,16
+ li_br &cons
+ call
+ st_r0,sp,16
+
+ ld_r1,sp,8
+ li_br &cdr
+ call
+ st_r0,sp,8
+ li_br &lrv_loop
+ b
+
+:lrv_done
+ ld_r0,sp,16
+ epilogue_n2
+ ret
+
+
+## ---- quasi_expand(r1=template, r2=env) -> r0 = value ---------------
+## Top-level quasiquote walker. Non-pair templates self-evaluate. A pair
+## whose car is `unquote` evaluates the first element of its cdr.
+## Otherwise the pair is walked as a list via quasi_list.
+:quasi_expand
+ prologue_n3
+ st_r1,sp,8
+ st_r2,sp,16
+
+ mov_r0,r1
+ andi_r0,r0,7
+ li_r2 TAG_PAIR
+ li_br &qe_pair
+ beq_r0,r2
+ ld_r0,sp,8
+ epilogue_n3
+ ret
+
+:qe_pair
+ ld_r1,sp,8
+ li_br &car
+ call
+ li_r1 &sym_unquote
+ ld_r1,r1,0
+ li_br &qe_unquote
+ beq_r0,r1
+
+ ld_r1,sp,8
+ ld_r2,sp,16
+ li_br &quasi_list
+ tail_n3
+
+:qe_unquote
+ ld_r1,sp,8
+ li_br &cdr
+ call
+ mov_r1,r0
+ li_br &car
+ call
+ mov_r1,r0
+ ld_r2,sp,16
+ li_br &eval
+ tail_n3
+
+
+## ---- quasi_list(r1=list, r2=env) -> r0 = expanded list --------------
+## Recursively expands each element. If an element is (unquote-splicing X),
+## evaluates X and appends the resulting list into the output; else it
+## recursively calls quasi_expand on the element.
+:quasi_list
+ prologue_n4
+ st_r1,sp,8 ## slot 1 = cursor
+ st_r2,sp,16 ## slot 2 = env
+
+ li_r0 NIL
+ li_br &ql_nil
+ beq_r1,r0
+
+ mov_r0,r1
+ andi_r0,r0,7
+ li_r2 TAG_PAIR
+ li_br &ql_nonpair
+ bne_r0,r2
+
+ li_br &car
+ call ## r0 = head
+ st_r0,sp,24 ## slot 3 = head
+
+ mov_r1,r0
+ andi_r0,r0,7
+ li_r2 TAG_PAIR
+ li_br &ql_head_reg
+ bne_r0,r2
+
+ ld_r1,sp,24
+ li_br &car
+ call ## r0 = car(head)
+ li_r1 &sym_unquote_splicing
+ ld_r1,r1,0
+ li_br &ql_splice
+ beq_r0,r1
+
+:ql_head_reg
+ ld_r1,sp,24
+ ld_r2,sp,16
+ li_br &quasi_expand
+ call
+ st_r0,sp,24 ## slot 3 = expanded head
+
+ ld_r1,sp,8
+ li_br &cdr
+ call
+ mov_r1,r0
+ ld_r2,sp,16
+ li_br &quasi_list
+ call
+
+ mov_r2,r0
+ ld_r1,sp,24
+ li_br &cons
+ tail_n4
+
+:ql_splice
+ ld_r1,sp,24
+ li_br &cdr
+ call
+ mov_r1,r0
+ li_br &car
+ call ## r0 = X (the spliced expression)
+ mov_r1,r0
+ ld_r2,sp,16
+ li_br &eval
+ call ## r0 = evaluated list
+ st_r0,sp,24
+
+ ld_r1,sp,8
+ li_br &cdr
+ call
+ mov_r1,r0
+ ld_r2,sp,16
+ li_br &quasi_list
+ call
+
+ mov_r2,r0
+ ld_r1,sp,24
+ li_br &append_one
+ tail_n4
+
+:ql_nil
+ li_r0 NIL
+ epilogue_n4
+ ret
+
+:ql_nonpair
+ ld_r0,sp,8
+ epilogue_n4
+ ret
+
+
+## ---- Step-6 error landing pads --------------------------------------
+:err_unbound
+ li_r1 &msg_unbound
+ li_r2 %14 ## strlen("unbound symbol") == 14
+ li_br &error
+ b
+
+:err_arity
+ li_r1 &msg_arity
+ li_r2 %14 ## strlen("arity mismatch") == 14
+ li_br &error
+ b
+
+:err_not_callable
+ li_r1 &msg_not_callable
+ li_r2 %12 ## strlen("not callable") == 12
+ li_br &error
+ b
+
+:err_too_many_args
+ li_r1 &msg_too_many_args
+ li_r2 %21 ## strlen("primitive argc > 32") == 21
+ li_br &error
+ b
+
+:err_bad_prim
+ li_r1 &msg_bad_prim
+ li_r2 %20 ## strlen("unknown primitive id") == 20
li_br &error
b
@@ -4407,6 +5721,15 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
:str_begin "begin"
:str_lambda "lambda"
:str_define "define"
+:str_quasiquote "quasiquote"
+:str_unquote "unquote"
+:str_unquote_splicing "unquote-splicing"
+:str_set "set!"
+:str_let "let"
+:str_letstar "let*"
+:str_letrec "letrec"
+:str_cond "cond"
+:str_else "else"
## Primitive name strings (step 10b). The registration table below
## holds (ptr, len, code_id, type, arity) for each. _start walks the
@@ -4477,16 +5800,6 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
:str_prim_equal "equal?"
:str_prim_apply "apply"
-:prelude_src
-"(define map (lambda (f xs) (if (null? xs) (quote ()) "
-"(cons (f (car xs)) (map f (cdr xs))))))"
-"(define filter (lambda (p xs) (if (null? xs) (quote ()) "
-"(if (p (car xs)) (cons (car xs) (filter p (cdr xs))) "
-"(filter p (cdr xs))))))"
-"(define fold (lambda (f acc xs) (if (null? xs) acc "
-"(fold f (f acc (car xs)) (cdr xs)))))"
-:prelude_src_end
-
## Registration table. 40-byte records: ptr(8) + len(8) + code_id(8) +
## type(8) + arity(8). End-sentinel = zero name pointer. _start iterates
@@ -4863,11 +6176,20 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
## ---- Special-form symbol slots --------------------------------------
## Zero-initialized; _start populates each slot with the interned
## tagged-symbol pointer so eval_pair can dispatch by pointer identity.
-:sym_quote %0 %0
-:sym_if %0 %0
-:sym_begin %0 %0
-:sym_lambda %0 %0
-:sym_define %0 %0
+:sym_quote %0 %0
+:sym_if %0 %0
+:sym_begin %0 %0
+:sym_lambda %0 %0
+:sym_define %0 %0
+:sym_quasiquote %0 %0
+:sym_unquote %0 %0
+:sym_unquote_splicing %0 %0
+:sym_set %0 %0
+:sym_let %0 %0
+:sym_letstar %0 %0
+:sym_letrec %0 %0
+:sym_cond %0 %0
+:sym_else %0 %0
## Global-binding alist head. Zero-initialized (which is a valid
## untagged pair/nil sentinel? No — nil = 0x07. Seed to nil on entry
diff --git a/tests/lisp/20-quote.expected b/tests/lisp/20-quote.expected
@@ -0,0 +1 @@
+42
diff --git a/tests/lisp/20-quote.scm b/tests/lisp/20-quote.scm
@@ -0,0 +1,11 @@
+;; Step 11a: quote shorthand. 'x → (quote x); same for the atomic,
+;; symbol, and list cases.
+(if (= (quote 42) 42)
+ (if (eq? (quote foo) (quote foo))
+ (if (= (car (quote (1 2 3))) 1)
+ (if (= (length (quote (1 2 3))) 3)
+ (if (= '42 42)
+ (if (eq? 'foo 'foo)
+ (if (= (car '(1 2 3)) 1)
+ (if (= (length '(1 2 3)) 3)
+ 42 0) 0) 0) 0) 0) 0) 0) 0)
diff --git a/tests/lisp/21-neg-hex.expected b/tests/lisp/21-neg-hex.expected
@@ -0,0 +1 @@
+42
diff --git a/tests/lisp/21-neg-hex.scm b/tests/lisp/21-neg-hex.scm
@@ -0,0 +1,7 @@
+;; Step 11b: negative decimal and 0x hex fixnum literals.
+(if (< -5 0)
+ (if (= (+ -3 5) 2)
+ (if (= 0xFF 255)
+ (if (= 0xa 10)
+ (if (= -0x10 -16)
+ 42 0) 0) 0) 0) 0)
diff --git a/tests/lisp/22-char.expected b/tests/lisp/22-char.expected
@@ -0,0 +1 @@
+42
diff --git a/tests/lisp/22-char.scm b/tests/lisp/22-char.scm
@@ -0,0 +1,8 @@
+;; Step 11c: character literals #\a, #\space, #\newline, #\tab.
+(if (= #\a 97)
+ (if (= #\Z 90)
+ (if (= #\space 32)
+ (if (= #\newline 10)
+ (if (= #\tab 9)
+ (if (= #\0 48)
+ 42 0) 0) 0) 0) 0) 0)
diff --git a/tests/lisp/23-vector.expected b/tests/lisp/23-vector.expected
@@ -0,0 +1 @@
+42
diff --git a/tests/lisp/23-vector.scm b/tests/lisp/23-vector.scm
@@ -0,0 +1,8 @@
+;; Step 11d: vector literals #(...). Reader builds a vector of the
+;; constituent values (no element-level evaluation — literals only).
+(if (= (vector-ref #(10 20 30) 0) 10)
+ (if (= (vector-ref #(10 20 30) 1) 20)
+ (if (= (vector-ref #(10 20 30) 2) 30)
+ (if (= (vector-length #(1 2 3 4)) 4)
+ (if (= (vector-length #()) 0)
+ 42 0) 0) 0) 0) 0)
diff --git a/tests/lisp/24-dotted.expected b/tests/lisp/24-dotted.expected
@@ -0,0 +1 @@
+42
diff --git a/tests/lisp/24-dotted.scm b/tests/lisp/24-dotted.scm
@@ -0,0 +1,7 @@
+;; Step 11e: improper (dotted) list tail. (a b . c) is
+;; (cons a (cons b c)).
+(if (= (car '(1 . 2)) 1)
+ (if (= (cdr '(1 . 2)) 2)
+ (if (= (car (cdr '(1 2 . 3))) 2)
+ (if (= (cdr (cdr '(1 2 . 3))) 3)
+ 42 0) 0) 0) 0)
diff --git a/tests/lisp/25-set.expected b/tests/lisp/25-set.expected
@@ -0,0 +1 @@
+42
diff --git a/tests/lisp/25-set.scm b/tests/lisp/25-set.scm
@@ -0,0 +1,8 @@
+;; Step 12a: set!. Mutates an existing binding. Exercises both the
+;; global path and the local (let-bound) path — set_binding is
+;; local-first with global fallback, so the two paths are distinct.
+(define x 10)
+(set! x 30)
+(if (= x 30)
+ (if (= (let ((y 1)) (set! y 12) y) 12)
+ 42 0) 0)
diff --git a/tests/lisp/26-let.expected b/tests/lisp/26-let.expected
@@ -0,0 +1 @@
+42
diff --git a/tests/lisp/26-let.scm b/tests/lisp/26-let.scm
@@ -0,0 +1,15 @@
+;; Step 12b: let / let* / letrec.
+;; letrec must pre-bind all names so mutually recursive bindings can
+;; see each other — this is the key behavior that distinguishes it
+;; from let*.
+(if (= (let ((x 5) (y 7)) (+ x y)) 12)
+ (if (= (let* ((x 5) (y (+ x 3))) y) 8)
+ (if (= (letrec ((f (lambda (n)
+ (if (< n 2) 1 (* n (f (- n 1)))))))
+ (f 5)) 120)
+ (if (= (letrec ((even? (lambda (n)
+ (if (= n 0) 1 (odd? (- n 1)))))
+ (odd? (lambda (n)
+ (if (= n 0) 0 (even? (- n 1))))))
+ (+ (even? 4) (odd? 7))) 2)
+ 42 0) 0) 0) 0)
diff --git a/tests/lisp/27-cond.expected b/tests/lisp/27-cond.expected
@@ -0,0 +1 @@
+42
diff --git a/tests/lisp/27-cond.scm b/tests/lisp/27-cond.scm
@@ -0,0 +1,10 @@
+;; Step 12c: cond.
+(define classify
+ (lambda (n)
+ (cond ((< n 0) 'neg)
+ ((= n 0) 'zero)
+ (else 'pos))))
+(if (eq? (classify -5) 'neg)
+ (if (eq? (classify 0) 'zero)
+ (if (eq? (classify 7) 'pos)
+ 42 0) 0) 0)
diff --git a/tests/lisp/28-quasi.expected b/tests/lisp/28-quasi.expected
@@ -0,0 +1 @@
+42
diff --git a/tests/lisp/28-quasi.scm b/tests/lisp/28-quasi.scm
@@ -0,0 +1,6 @@
+;; Step 12d: quasiquote / unquote / unquote-splicing.
+(define x 5)
+(if (= (car (cdr `(1 ,x 3))) 5)
+ (if (= (length `(1 ,@(list 2 3) 4)) 4)
+ (if (= (car (cdr (cdr `(1 ,@(list 2 3) 4)))) 3)
+ 42 0) 0) 0)
diff --git a/tests/lisp/29-innerdef.expected b/tests/lisp/29-innerdef.expected
@@ -0,0 +1 @@
+42
diff --git a/tests/lisp/29-innerdef.scm b/tests/lisp/29-innerdef.scm
@@ -0,0 +1,17 @@
+;; Step 12e: inner (define …) inside a lambda body is rewritten into
+;; letrec-shape so the definitions share scope with the trailing body.
+;; A recursive inner define actually requires letrec semantics — plain
+;; let* would leave `fact` unbound in its own RHS.
+(define f
+ (lambda (x)
+ (define a 1)
+ (define b 2)
+ (+ x a b)))
+(define g
+ (lambda (n)
+ (define fact
+ (lambda (k) (if (< k 2) 1 (* k (fact (- k 1))))))
+ (fact n)))
+(if (= (f 10) 13)
+ (if (= (g 5) 120)
+ 42 0) 0)
