commit b97e3d36e52f0da1c9260fb3f5c56dcc35e6ee4f
parent 1721f75a69bfd518d1f4c1c7327118b7353b1393
Author: Ryan Sepassi <rsepassi@gmail.com>
Date: Wed, 22 Apr 2026 09:16:36 -0700
lisp.M1: move 14 primitives to Scheme prelude for reviewability
Promoted all fixed-arity helpers that can be derived from the
remaining primitives:
arithmetic: <=, >=, zero?, negative?, positive?, abs
list: list?, length, reverse, assoc, member
vector: vector->list, list->vector
structural: equal? (+ removes equal_helper and eq_* sub-labels)
Also adds Scheme-side nice-to-haves that were never P1 primitives but
are commonly expected: not, caar/cadr/cdar/cddr/caddr, list-ref,
for-each.
Variadic primitives (list, append, min, max) stay in P1 because
env_extend doesn't yet support (lambda args body) or dotted-tail
params; revisit after that lands. Remaining primitive code ids are
renumbered contiguously 0..45.
lisp.M1 shrinks ~560 lines; src/prelude.scm grows ~150. Tests
28/28 on aarch64 and amd64 (riscv64 in progress at commit time).
Diffstat:
| M | src/lisp.M1 | | | 828 | +++++++++++++------------------------------------------------------------------ |
| M | src/prelude.scm | | | 159 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- |
2 files changed, 289 insertions(+), 698 deletions(-)
diff --git a/src/lisp.M1 b/src/lisp.M1
@@ -3865,159 +3865,117 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
li_br &prim_gt
beq_r3,r0
li_r0 %8
- li_br &prim_le
- beq_r3,r0
- li_r0 %9
- li_br &prim_ge
- beq_r3,r0
- li_r0 %10
- li_br &prim_zerop
- beq_r3,r0
- li_r0 %11
- li_br &prim_negativep
- beq_r3,r0
- li_r0 %12
- li_br &prim_positivep
- beq_r3,r0
- li_r0 %13
- li_br &prim_abs
- beq_r3,r0
- li_r0 %14
li_br &prim_min
beq_r3,r0
- li_r0 %15
+ li_r0 %9
li_br &prim_max
beq_r3,r0
- li_r0 %16
+ li_r0 %10
li_br &prim_bitand
beq_r3,r0
- li_r0 %17
+ li_r0 %11
li_br &prim_bitor
beq_r3,r0
- li_r0 %18
+ li_r0 %12
li_br &prim_bitxor
beq_r3,r0
- li_r0 %19
+ li_r0 %13
li_br &prim_bitnot
beq_r3,r0
- li_r0 %20
+ li_r0 %14
li_br &prim_ashift
beq_r3,r0
- li_r0 %21
+ li_r0 %15
li_br &prim_numberp
beq_r3,r0
- li_r0 %22
+ li_r0 %16
li_br &prim_symbolp
beq_r3,r0
- li_r0 %23
+ li_r0 %17
li_br &prim_stringp
beq_r3,r0
- li_r0 %24
+ li_r0 %18
li_br &prim_vectorp
beq_r3,r0
- li_r0 %25
+ li_r0 %19
li_br &prim_procp
beq_r3,r0
- li_r0 %26
+ li_r0 %20
li_br &prim_eqp
beq_r3,r0
- li_r0 %27
+ li_r0 %21
li_br &prim_cons
beq_r3,r0
- li_r0 %28
+ li_r0 %22
li_br &prim_car
beq_r3,r0
- li_r0 %29
+ li_r0 %23
li_br &prim_cdr
beq_r3,r0
- li_r0 %30
+ li_r0 %24
li_br &prim_pairp
beq_r3,r0
- li_r0 %31
+ li_r0 %25
li_br &prim_nullp
beq_r3,r0
- li_r0 %32
+ li_r0 %26
li_br &prim_list
beq_r3,r0
- li_r0 %33
- li_br &prim_length
- beq_r3,r0
- li_r0 %34
- li_br &prim_listp
- beq_r3,r0
- li_r0 %35
+ li_r0 %27
li_br &prim_append
beq_r3,r0
- li_r0 %36
- li_br &prim_reverse
- beq_r3,r0
- li_r0 %37
- li_br &prim_assoc
- beq_r3,r0
- li_r0 %38
- li_br &prim_member
- beq_r3,r0
- li_r0 %39
+ li_r0 %28
li_br &prim_string_length
beq_r3,r0
- li_r0 %40
+ li_r0 %29
li_br &prim_string_ref
beq_r3,r0
- li_r0 %41
+ li_r0 %30
li_br &prim_substring
beq_r3,r0
- li_r0 %42
+ li_r0 %31
li_br &prim_string_append
beq_r3,r0
- li_r0 %43
+ li_r0 %32
li_br &prim_string_to_symbol
beq_r3,r0
- li_r0 %44
+ li_r0 %33
li_br &prim_symbol_to_string
beq_r3,r0
- li_r0 %45
+ li_r0 %34
li_br &prim_make_vector
beq_r3,r0
- li_r0 %46
+ li_r0 %35
li_br &prim_vector_ref
beq_r3,r0
- li_r0 %47
+ li_r0 %36
li_br &prim_vector_set
beq_r3,r0
- li_r0 %48
+ li_r0 %37
li_br &prim_vector_length
beq_r3,r0
- li_r0 %49
- li_br &prim_vector_to_list
- beq_r3,r0
- li_r0 %50
- li_br &prim_list_to_vector
- beq_r3,r0
- li_r0 %51
+ li_r0 %38
li_br &prim_display
beq_r3,r0
- li_r0 %52
+ li_r0 %39
li_br &prim_write
beq_r3,r0
- li_r0 %53
+ li_r0 %40
li_br &prim_newline
beq_r3,r0
- li_r0 %54
+ li_r0 %41
li_br &prim_format
beq_r3,r0
- li_r0 %55
+ li_r0 %42
li_br &prim_error
beq_r3,r0
- li_r0 %56
+ li_r0 %43
li_br &prim_read_file
beq_r3,r0
- li_r0 %57
+ li_r0 %44
li_br &prim_write_file
beq_r3,r0
- li_r0 %58
- li_br &prim_equal
- beq_r3,r0
- li_r0 %59
+ li_r0 %45
li_br &prim_apply
beq_r3,r0
@@ -4172,74 +4130,8 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
ret
-## (<= x y) ≡ !(y < x). Invert the BLT result.
-:prim_le
- ld_r3,r2,0
- ld_r0,r2,8
- li_br &prim_le_false
- blt_r0,r3
- li_r0 TRUE ## #t
- ret
-:prim_le_false
- li_r0 %23
- ret
-
-
-## (>= x y) ≡ !(x < y).
-:prim_ge
- ld_r3,r2,0
- ld_r0,r2,8
- li_br &prim_ge_false
- blt_r3,r0
- li_r0 %15
- ret
-:prim_ge_false
- li_r0 %23
- ret
-
-
-## (zero? x). Tagged fixnum 0 = 0x01.
-:prim_zerop
- ld_r3,r2,0
- li_r0 %1
- li_br &prim_true
- beq_r3,r0
- li_r0 %23
- ret
-
-
-## (negative? x) — tagged-compare against 0x01.
-:prim_negativep
- ld_r3,r2,0
- li_r0 %1
- li_br &prim_true
- blt_r3,r0
- li_r0 %23
- ret
-
-
-## (positive? x).
-:prim_positivep
- ld_r3,r2,0
- li_r0 %1
- li_br &prim_true
- blt_r0,r3
- li_r0 %23
- ret
-
-
-## (abs x) — branch-on-sign; negate by 0 - v.
-:prim_abs
- ld_r3,r2,0
- sari_r3,r3,3 ## decode
- li_r0 %0
- li_br &prim_abs_done
- blt_r0,r3 ## 0 < v → already positive
- sub_r3,r0,r3 ## v = -v
-:prim_abs_done
- shli_r0,r3,3
- ori_r0,r0,1
- ret
+## (<=, >=, zero?, negative?, positive?, abs) live in the Scheme
+## prelude now — see src/prelude.scm.
## (min ...) — variadic; first arg is seed, each later arg replaces
@@ -4554,47 +4446,8 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
ret
-## (length lst) — count pairs until nil. No proper-list check; an
-## improper or non-list tail will dereference a bogus ptr (matching
-## the seed's "no validation on bad input" stance).
-:prim_length
- ld_r1,r2,0
- li_r3 %0
-:prim_length_loop
- li_r0 %7
- li_br &prim_length_done
- beq_r1,r0
- addi_r0,r1,neg2
- ld_r1,r0,8
- addi_r3,r3,1
- li_br &prim_length_loop
- b
-:prim_length_done
- shli_r0,r3,3
- ori_r0,r0,1
- ret
-
-
-## (list? x) — walks to nil. Returns #t at nil, #f at any non-pair
-## node. No cycle check (per LISP.md §equal? policy).
-:prim_listp
- ld_r1,r2,0
-:prim_listp_loop
- li_r0 %7
- li_br &prim_true
- beq_r1,r0
- mov_r0,r1
- andi_r0,r0,7
- li_r3 %2
- li_br &prim_listp_false
- bne_r0,r3
- addi_r0,r1,neg2
- ld_r1,r0,8
- li_br &prim_listp_loop
- b
-:prim_listp_false
- li_r0 %23
- ret
+## (length, list?) live in the Scheme prelude now — see
+## src/prelude.scm.
## append_one(r1=xs, r2=ys) -> r0 = xs ++ ys. Copies xs's spine; ys
@@ -4663,83 +4516,8 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
ret
-## (reverse lst) — single-pass cons-reverse onto nil accumulator.
-:prim_reverse
- prologue_n2
- ld_r0,r2,0
- mov_r3,sp
- st_r0,sp,24 ## slot1 = current
- li_r0 %7
- st_r0,sp,32 ## slot2 = accumulator (nil)
-:prim_reverse_loop
- mov_r3,sp
- ld_r0,sp,24
- li_r1 %7
- li_br &prim_reverse_done
- beq_r0,r1
- addi_r0,r0,neg2
- ld_r1,r0,0 ## r1 = car
- ld_r2,r0,8 ## r2 = cdr (next current)
- st_r2,sp,24 ## slot1 = next
- ld_r2,sp,32 ## r2 = accumulator
- li_br &cons
- call
- st_r0,sp,32
- li_br &prim_reverse_loop
- b
-:prim_reverse_done
- ld_r0,sp,32
- epilogue_n2
- ret
-
-
-## (assoc key alist) — eq?-keyed alist lookup. Returns the matched
-## (key . val) cell or #f.
-:prim_assoc
- ld_r3,r2,0 ## r3 = key
- ld_r0,r2,8 ## r0 = alist cursor
-:prim_assoc_loop
- li_r1 %7
- li_br &prim_assoc_miss
- beq_r0,r1
- addi_r1,r0,neg2 ## raw alist cell
- ld_r2,r1,0 ## r2 = inner pair (tagged)
- addi_r2,r2,neg2
- ld_r2,r2,0 ## r2 = candidate key
- li_br &prim_assoc_hit
- beq_r2,r3
- ld_r0,r1,8 ## advance alist
- li_br &prim_assoc_loop
- b
-:prim_assoc_hit
- ld_r0,r1,0 ## return inner pair
- ret
-:prim_assoc_miss
- li_r0 %23
- ret
-
-
-## (member x lst) — eq?-keyed; returns the first sublist whose car
-## equals x, else #f.
-:prim_member
- ld_r3,r2,0 ## r3 = needle
- ld_r0,r2,8 ## r0 = list cursor
-:prim_member_loop
- li_r1 %7
- li_br &prim_member_miss
- beq_r0,r1
- addi_r1,r0,neg2
- ld_r2,r1,0 ## r2 = car
- li_br &prim_member_hit
- beq_r2,r3
- ld_r0,r1,8 ## next sublist (tagged)
- li_br &prim_member_loop
- b
-:prim_member_hit
- ret ## r0 already = current sublist
-:prim_member_miss
- li_r0 %23
- ret
+## (reverse, assoc, member) live in the Scheme prelude now — see
+## src/prelude.scm.
## ---- (string-length s) — fixnum length out of header ---------------
@@ -4957,100 +4735,8 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
ret
-## ---- (vector->list v) — cons-snake from tail to head ---------------
-## Walks slots end → base, pushing each onto an accumulator. Result
-## order matches slot order.
-:prim_vector_to_list
- prologue_n4
- st_r6,sp,24
- st_r7,sp,32
-
- ld_r0,r2,0 ## tagged vec
- addi_r0,r0,neg3 ## raw
- ld_r3,r0,0
- shli_r3,r3,32
- shri_r3,r3,32 ## len
- addi_r0,r0,8 ## payload base
- shli_r1,r3,3
- mov_r2,r0 ## r2 = payload base
- add_r6,r1,r2 ## r6 = end cursor = base + len*8
-
- mov_r3,sp
- st_r0,r3,40 ## slot3 = base ptr
-
- li_r7 NIL ## acc
-:pvtl_loop
- mov_r3,sp
- ld_r0,r3,40
- li_br &pvtl_done
- beq_r6,r0
-
- addi_r6,r6,neg8
- ld_r1,r6,0 ## element
- mov_r2,r7 ## acc
- li_br &cons
- call
- mov_r7,r0
- li_br &pvtl_loop
- b
-:pvtl_done
- mov_r0,r7
- ld_r6,sp,24
- ld_r7,sp,32
- epilogue_n4
- ret
-
-
-## ---- (list->vector lst) — count then fill ---------------------------
-:prim_list_to_vector
- prologue_n4
- st_r6,sp,24
- st_r7,sp,32
-
- ld_r0,r2,0 ## tagged list
- mov_r3,sp
- st_r0,r3,40 ## slot3 = list head
-
- li_r6 %0 ## r6 = count
- mov_r7,r0 ## r7 = cursor
-:pltv_lp1
- li_r0 NIL
- li_br &pltv_done1
- beq_r7,r0
- addi_r0,r7,neg2 ## raw pair
- ld_r7,r0,8 ## next
- addi_r6,r6,1
- li_br &pltv_lp1
- b
-:pltv_done1
- mov_r1,r6 ## raw len
- li_r2 NIL
- li_br &make_vector
- call ## r0 = tagged vector
- mov_r3,sp
- st_r0,r3,48 ## slot4 = result
-
- addi_r6,r0,neg3
- addi_r6,r6,8 ## r6 = payload cursor
- ld_r7,r3,40 ## r7 = list cursor
-:pltv_lp2
- li_r0 NIL
- li_br &pltv_done2
- beq_r7,r0
- addi_r0,r7,neg2
- ld_r1,r0,0 ## car
- ld_r7,r0,8 ## next
- st_r1,r6,0
- addi_r6,r6,8
- li_br &pltv_lp2
- b
-:pltv_done2
- mov_r3,sp
- ld_r0,r3,48
- ld_r6,sp,24
- ld_r7,sp,32
- epilogue_n4
- ret
+## (vector->list, list->vector) live in the Scheme prelude now —
+## see src/prelude.scm.
## ---- (display x) — runtime printer (unspec result) ------------------
@@ -5310,159 +4996,7 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
ret
-## ---- equal_helper(r1=a, r2=b) -> r0 = 0|1 --------------------------
-## Structural equality: eq?, then bytewise for strings, elementwise for
-## vectors, recursive for pairs. No cycle detection.
-## Always saves r6/r7 (slot1/slot2); slot3/slot4 store tagged a/b for
-## paths that need them across recursive calls.
-:equal_helper
- prologue_n4
- st_r6,sp,24
- st_r7,sp,32
-
- li_br &eq_true
- beq_r1,r2
-
- mov_r3,r1
- andi_r3,r3,7
- mov_r0,r2
- andi_r0,r0,7
- li_br &eq_false
- bne_r3,r0
-
- li_r0 TAG_PAIR
- li_br &eq_pair
- beq_r3,r0
- li_r0 TAG_STRING
- li_br &eq_string
- beq_r3,r0
- li_r0 TAG_VECTOR
- li_br &eq_vector
- beq_r3,r0
-
-:eq_false
- li_r0 %0
- ld_r6,sp,24
- ld_r7,sp,32
- epilogue_n4
- ret
-
-:eq_true
- li_r0 %1
- ld_r6,sp,24
- ld_r7,sp,32
- epilogue_n4
- ret
-
-:eq_pair
- st_r1,sp,40 ## slot3 = tagged a
- st_r2,sp,48 ## slot4 = tagged b
-
- addi_r0,r1,neg2
- ld_r1,r0,0 ## a.car
- addi_r0,r2,neg2
- ld_r2,r0,0 ## b.car
-
- li_br &equal_helper
- call
- li_br &eq_false
- beqz_r0
-
- mov_r3,sp
- ld_r0,r3,40
- addi_r0,r0,neg2
- ld_r1,r0,8 ## a.cdr
- ld_r0,r3,48
- addi_r0,r0,neg2
- ld_r2,r0,8 ## b.cdr
- li_br &equal_helper
- call
-
- ld_r6,sp,24
- ld_r7,sp,32
- epilogue_n4
- ret
-
-:eq_string
- addi_r1,r1,neg4
- addi_r2,r2,neg4
- ld_r3,r1,0
- shli_r3,r3,32
- shri_r3,r3,32 ## len_a
- ld_r0,r2,0
- shli_r0,r0,16
- shri_r0,r0,16 ## len_b
- li_br &eq_false
- bne_r3,r0
-
- addi_r6,r1,8 ## a payload cursor
- addi_r7,r2,8 ## b payload cursor
-:eq_string_loop
- li_br &eq_true
- beqz_r3
- lb_r0,r6,0
- lb_r1,r7,0
- li_br &eq_false
- bne_r0,r1
- addi_r6,r6,1
- addi_r7,r7,1
- addi_r3,r3,neg1
- li_br &eq_string_loop
- b
-
-:eq_vector
- addi_r1,r1,neg3
- addi_r2,r2,neg3
- ld_r3,r1,0
- shli_r3,r3,32
- shri_r3,r3,32 ## len_a
- ld_r0,r2,0
- shli_r0,r0,16
- shri_r0,r0,16 ## len_b
- li_br &eq_false
- bne_r3,r0
-
- addi_r6,r1,8 ## a payload cursor
- addi_r7,r2,8 ## b payload cursor
-:eq_vector_loop
- li_br &eq_true
- beqz_r3
-
- ld_r1,r6,0
- ld_r2,r7,0
- st_r3,sp,40 ## save remaining count
-
- li_br &equal_helper
- call
- li_br &eq_false
- beqz_r0
-
- mov_r3,sp
- ld_r3,r3,40
- addi_r6,r6,8
- addi_r7,r7,8
- addi_r3,r3,neg1
- li_br &eq_vector_loop
- b
-
-
-## ---- (equal? a b) — wraps equal_helper ----------------------------
-:prim_equal
- prologue
- ld_r1,r2,0
- ld_r2,r2,8
- li_br &equal_helper
- call
-
- li_br &peq_true
- bnez_r0
- li_r0 FALSE
- epilogue
- ret
-:peq_true
- li_r0 TRUE
- epilogue
- ret
+## (equal?) lives in the Scheme prelude now — see src/prelude.scm.
## ---- (apply proc arg ... last-list) ---------------------------------
@@ -6634,12 +6168,6 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
:str_prim_numeq "="
:str_prim_lt "<"
:str_prim_gt ">"
-:str_prim_le "<="
-:str_prim_ge ">="
-:str_prim_zerop "zero?"
-:str_prim_negativep "negative?"
-:str_prim_positivep "positive?"
-:str_prim_abs "abs"
:str_prim_min "min"
:str_prim_max "max"
:str_prim_bitand "bit-and"
@@ -6661,12 +6189,7 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
:str_prim_pairp "pair?"
:str_prim_nullp "null?"
:str_prim_list "list"
-:str_prim_length "length"
-:str_prim_listp "list?"
:str_prim_append "append"
-:str_prim_reverse "reverse"
-:str_prim_assoc "assoc"
-:str_prim_member "member"
## Step-10e string / vector / I/O / equal? / apply names.
:str_prim_string_length "string-length"
@@ -6679,8 +6202,6 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
:str_prim_vector_ref "vector-ref"
:str_prim_vector_set "vector-set!"
:str_prim_vector_length "vector-length"
-:str_prim_vector_to_list "vector->list"
-:str_prim_list_to_vector "list->vector"
:str_prim_display "display"
:str_prim_write "write"
:str_prim_newline "newline"
@@ -6688,7 +6209,6 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
:str_prim_error "error"
:str_prim_read_file "read-file"
:str_prim_write_file "write-file"
-:str_prim_equal "equal?"
:str_prim_apply "apply"
@@ -6696,364 +6216,284 @@ DEFINE ZERO32 '0000000000000000000000000000000000000000000000000000000000000000'
## type(8) + arity(8). End-sentinel = zero name pointer. _start iterates
## with ADDI +40.
:prim_table
-## (+ ...) variadic
+## Primitives promoted to the Scheme prelude (src/prelude.scm) and no
+## longer registered here: <=, >=, zero?, negative?, positive?, abs,
+## length, list?, reverse, assoc, member, vector->list, list->vector,
+## equal?. Code ids are contiguous 0..45 after that removal.
+## (+ ...) variadic — code 0
&str_prim_plus %0
%1 %0
%0 %0
%6 %0
%0 %0
-## (- x ...) variadic (fixes unary-negate branch in body)
+## (- x ...) variadic — code 1 (unary-negate branch in body)
&str_prim_minus %0
%1 %0
%1 %0
%6 %0
%0 %0
-## (* ...) variadic
+## (* ...) variadic — code 2
&str_prim_mul %0
%1 %0
%2 %0
%6 %0
%0 %0
-## (/ x y) fixed 2
+## (/ x y) fixed 2 — code 3
&str_prim_div %0
%1 %0
%3 %0
%5 %0
%2 %0
-## (% x y) fixed 2
+## (% x y) fixed 2 — code 4
&str_prim_mod %0
%1 %0
%4 %0
%5 %0
%2 %0
-## (= x y) fixed 2
+## (= x y) fixed 2 — code 5
&str_prim_numeq %0
%1 %0
%5 %0
%5 %0
%2 %0
-## (< x y) fixed 2
+## (< x y) fixed 2 — code 6
&str_prim_lt %0
%1 %0
%6 %0
%5 %0
%2 %0
-## (> x y) fixed 2
+## (> x y) fixed 2 — code 7
&str_prim_gt %0
%1 %0
%7 %0
%5 %0
%2 %0
-## (<= x y) fixed 2
-&str_prim_le %0
-%2 %0
-%8 %0
-%5 %0
-%2 %0
-## (>= x y) fixed 2
-&str_prim_ge %0
-%2 %0
-%9 %0
-%5 %0
-%2 %0
-## (zero? x) fixed 1
-&str_prim_zerop %0
-%5 %0
-%10 %0
-%5 %0
-%1 %0
-## (negative? x) fixed 1
-&str_prim_negativep %0
-%9 %0
-%11 %0
-%5 %0
-%1 %0
-## (positive? x) fixed 1
-&str_prim_positivep %0
-%9 %0
-%12 %0
-%5 %0
-%1 %0
-## (abs x) fixed 1
-&str_prim_abs %0
-%3 %0
-%13 %0
-%5 %0
-%1 %0
-## (min ...) variadic — arity 0 ignored, but ≥1 enforced by body load
+## (min ...) variadic — code 8 (≥1 enforced by body load)
&str_prim_min %0
%3 %0
-%14 %0
+%8 %0
%6 %0
%0 %0
-## (max ...) variadic
+## (max ...) variadic — code 9
&str_prim_max %0
%3 %0
-%15 %0
+%9 %0
%6 %0
%0 %0
-## (bit-and ...) variadic
+## (bit-and ...) variadic — code 10
&str_prim_bitand %0
%7 %0
-%16 %0
+%10 %0
%6 %0
%0 %0
-## (bit-or ...) variadic
+## (bit-or ...) variadic — code 11
&str_prim_bitor %0
%6 %0
-%17 %0
+%11 %0
%6 %0
%0 %0
-## (bit-xor ...) variadic
+## (bit-xor ...) variadic — code 12
&str_prim_bitxor %0
%7 %0
-%18 %0
+%12 %0
%6 %0
%0 %0
-## (bit-not x) fixed 1
+## (bit-not x) fixed 1 — code 13
&str_prim_bitnot %0
%7 %0
-%19 %0
+%13 %0
%5 %0
%1 %0
-## (arithmetic-shift n k) fixed 2
+## (arithmetic-shift n k) fixed 2 — code 14
&str_prim_ashift %0
%16 %0
-%20 %0
+%14 %0
%5 %0
%2 %0
-## (number? x) fixed 1
+## (number? x) fixed 1 — code 15
&str_prim_numberp %0
%7 %0
-%21 %0
+%15 %0
%5 %0
%1 %0
-## (symbol? x) fixed 1
+## (symbol? x) fixed 1 — code 16
&str_prim_symbolp %0
%7 %0
-%22 %0
+%16 %0
%5 %0
%1 %0
-## (string? x) fixed 1
+## (string? x) fixed 1 — code 17
&str_prim_stringp %0
%7 %0
-%23 %0
+%17 %0
%5 %0
%1 %0
-## (vector? x) fixed 1
+## (vector? x) fixed 1 — code 18
&str_prim_vectorp %0
%7 %0
-%24 %0
+%18 %0
%5 %0
%1 %0
-## (procedure? x) fixed 1
+## (procedure? x) fixed 1 — code 19
&str_prim_procp %0
%10 %0
-%25 %0
+%19 %0
%5 %0
%1 %0
-## (eq? x y) fixed 2
+## (eq? x y) fixed 2 — code 20
&str_prim_eqp %0
%3 %0
-%26 %0
+%20 %0
%5 %0
%2 %0
-## (cons a d) fixed 2
+## (cons a d) fixed 2 — code 21
&str_prim_cons %0
%4 %0
-%27 %0
+%21 %0
%5 %0
%2 %0
-## (car p) fixed 1
+## (car p) fixed 1 — code 22
&str_prim_car %0
%3 %0
-%28 %0
+%22 %0
%5 %0
%1 %0
-## (cdr p) fixed 1
+## (cdr p) fixed 1 — code 23
&str_prim_cdr %0
%3 %0
-%29 %0
+%23 %0
%5 %0
%1 %0
-## (pair? x) fixed 1
+## (pair? x) fixed 1 — code 24
&str_prim_pairp %0
%5 %0
-%30 %0
+%24 %0
%5 %0
%1 %0
-## (null? x) fixed 1
+## (null? x) fixed 1 — code 25
&str_prim_nullp %0
%5 %0
-%31 %0
+%25 %0
%5 %0
%1 %0
-## (list ...) variadic
+## (list ...) variadic — code 26
&str_prim_list %0
%4 %0
-%32 %0
+%26 %0
%6 %0
%0 %0
-## (length lst) fixed 1
-&str_prim_length %0
-%6 %0
-%33 %0
-%5 %0
-%1 %0
-## (list? x) fixed 1
-&str_prim_listp %0
-%5 %0
-%34 %0
-%5 %0
-%1 %0
-## (append ...) variadic
+## (append ...) variadic — code 27
&str_prim_append %0
%6 %0
-%35 %0
+%27 %0
%6 %0
%0 %0
-## (reverse lst) fixed 1
-&str_prim_reverse %0
-%7 %0
-%36 %0
-%5 %0
-%1 %0
-## (assoc key alist) fixed 2
-&str_prim_assoc %0
-%5 %0
-%37 %0
-%5 %0
-%2 %0
-## (member x lst) fixed 2
-&str_prim_member %0
-%6 %0
-%38 %0
-%5 %0
-%2 %0
-## (string-length s) fixed 1
+## (string-length s) fixed 1 — code 28
&str_prim_string_length %0
%13 %0
-%39 %0
+%28 %0
%5 %0
%1 %0
-## (string-ref s i) fixed 2
+## (string-ref s i) fixed 2 — code 29
&str_prim_string_ref %0
%10 %0
-%40 %0
+%29 %0
%5 %0
%2 %0
-## (substring s start end) fixed 3
+## (substring s start end) fixed 3 — code 30
&str_prim_substring %0
%9 %0
-%41 %0
+%30 %0
%5 %0
%3 %0
-## (string-append ...) variadic
+## (string-append ...) variadic — code 31
&str_prim_string_append %0
%13 %0
-%42 %0
+%31 %0
%6 %0
%0 %0
-## (string->symbol s) fixed 1
+## (string->symbol s) fixed 1 — code 32
&str_prim_string_to_symbol %0
%14 %0
-%43 %0
+%32 %0
%5 %0
%1 %0
-## (symbol->string sym) fixed 1
+## (symbol->string sym) fixed 1 — code 33
&str_prim_symbol_to_string %0
%14 %0
-%44 %0
+%33 %0
%5 %0
%1 %0
-## (make-vector n init) fixed 2
+## (make-vector n init) fixed 2 — code 34
&str_prim_make_vector %0
%11 %0
-%45 %0
+%34 %0
%5 %0
%2 %0
-## (vector-ref v i) fixed 2
+## (vector-ref v i) fixed 2 — code 35
&str_prim_vector_ref %0
%10 %0
-%46 %0
+%35 %0
%5 %0
%2 %0
-## (vector-set! v i x) fixed 3
+## (vector-set! v i x) fixed 3 — code 36
&str_prim_vector_set %0
%11 %0
-%47 %0
+%36 %0
%5 %0
%3 %0
-## (vector-length v) fixed 1
+## (vector-length v) fixed 1 — code 37
&str_prim_vector_length %0
%13 %0
-%48 %0
-%5 %0
-%1 %0
-## (vector->list v) fixed 1
-&str_prim_vector_to_list %0
-%12 %0
-%49 %0
-%5 %0
-%1 %0
-## (list->vector lst) fixed 1
-&str_prim_list_to_vector %0
-%12 %0
-%50 %0
+%37 %0
%5 %0
%1 %0
-## (display x) fixed 1
+## (display x) fixed 1 — code 38
&str_prim_display %0
%7 %0
-%51 %0
+%38 %0
%5 %0
%1 %0
-## (write x) fixed 1
+## (write x) fixed 1 — code 39
&str_prim_write %0
%5 %0
-%52 %0
+%39 %0
%5 %0
%1 %0
-## (newline) fixed 0
+## (newline) fixed 0 — code 40
&str_prim_newline %0
%7 %0
-%53 %0
+%40 %0
%5 %0
%0 %0
-## (format fmt ...) variadic
+## (format fmt ...) variadic — code 41
&str_prim_format %0
%6 %0
-%54 %0
+%41 %0
%6 %0
%0 %0
-## (error msg) fixed 1
+## (error msg) fixed 1 — code 42
&str_prim_error %0
%5 %0
-%55 %0
+%42 %0
%5 %0
%1 %0
-## (read-file path) fixed 1
+## (read-file path) fixed 1 — code 43
&str_prim_read_file %0
%9 %0
-%56 %0
+%43 %0
%5 %0
%1 %0
-## (write-file path data) fixed 2
+## (write-file path data) fixed 2 — code 44
&str_prim_write_file %0
%10 %0
-%57 %0
-%5 %0
-%2 %0
-## (equal? a b) fixed 2
-&str_prim_equal %0
-%6 %0
-%58 %0
+%44 %0
%5 %0
%2 %0
-## (apply proc arg ... last-list) variadic
+## (apply proc arg ... last-list) variadic — code 45
&str_prim_apply %0
%5 %0
-%59 %0
+%45 %0
%6 %0
%0 %0
## End sentinel: zero name pointer.
diff --git a/src/prelude.scm b/src/prelude.scm
@@ -1,7 +1,83 @@
-;; Prelude: map / filter / fold. Concatenated ahead of every user script
-;; by the Makefile (cat src/prelude.scm $user.scm > combined.scm) so the
-;; interpreter keeps its single-argv contract and lisp.M1 stays free of
-;; embedded Scheme source.
+;; Prelude — helpers promoted out of lisp.M1 into Scheme for
+;; reviewability. Prepended to every user script by the Makefile
+;; (cat src/prelude.scm $user.scm > combined.scm) so these names
+;; are in scope before user code runs.
+;;
+;; Only fixed-arity helpers live here — variadic lambdas aren't yet
+;; supported by env_extend, so list/append/min/max stay as P1 primitives.
+
+;; --- Boolean / logical ----------------------------------------------
+(define not
+ (lambda (x) (if x #f #t)))
+
+;; --- Arithmetic helpers (derivable from <, =, -) --------------------
+(define <=
+ (lambda (x y) (if (< y x) #f #t)))
+
+(define >=
+ (lambda (x y) (if (< x y) #f #t)))
+
+(define zero?
+ (lambda (x) (= x 0)))
+
+(define negative?
+ (lambda (x) (< x 0)))
+
+(define positive?
+ (lambda (x) (> x 0)))
+
+(define abs
+ (lambda (x) (if (< x 0) (- 0 x) x)))
+
+;; --- Common c*r compositions ---------------------------------------
+(define caar (lambda (x) (car (car x))))
+(define cadr (lambda (x) (car (cdr x))))
+(define cdar (lambda (x) (cdr (car x))))
+(define cddr (lambda (x) (cdr (cdr x))))
+(define caddr (lambda (x) (car (cdr (cdr x)))))
+
+;; --- List helpers (derivable from cons/car/cdr/null?/pair?/eq?) -----
+(define list?
+ (lambda (x)
+ (if (null? x)
+ #t
+ (if (pair? x) (list? (cdr x)) #f))))
+
+(define length-helper
+ (lambda (xs acc)
+ (if (null? xs) acc (length-helper (cdr xs) (+ acc 1)))))
+
+(define length
+ (lambda (xs) (length-helper xs 0)))
+
+(define reverse-helper
+ (lambda (xs acc)
+ (if (null? xs) acc (reverse-helper (cdr xs) (cons (car xs) acc)))))
+
+(define reverse
+ (lambda (xs) (reverse-helper xs (quote ()))))
+
+(define list-ref
+ (lambda (xs n)
+ (if (= n 0) (car xs) (list-ref (cdr xs) (- n 1)))))
+
+(define assoc
+ (lambda (key alist)
+ (if (null? alist)
+ #f
+ (if (eq? (car (car alist)) key)
+ (car alist)
+ (assoc key (cdr alist))))))
+
+(define member
+ (lambda (x xs)
+ (if (null? xs)
+ #f
+ (if (eq? (car xs) x)
+ xs
+ (member x (cdr xs))))))
+
+;; --- map / filter / fold / for-each ---------------------------------
(define map
(lambda (f xs)
(if (null? xs)
@@ -21,3 +97,78 @@
(if (null? xs)
acc
(fold f (f acc (car xs)) (cdr xs)))))
+
+(define for-each
+ (lambda (f xs)
+ (if (null? xs)
+ (quote ())
+ (begin
+ (f (car xs))
+ (for-each f (cdr xs))))))
+
+;; --- Vector <-> list (derivable from make-vector/vector-ref/set) ----
+(define vector->list-helper
+ (lambda (v i acc)
+ (if (< i 0)
+ acc
+ (vector->list-helper v (- i 1) (cons (vector-ref v i) acc)))))
+
+(define vector->list
+ (lambda (v)
+ (vector->list-helper v (- (vector-length v) 1) (quote ()))))
+
+(define list->vector-helper
+ (lambda (v xs i)
+ (if (null? xs)
+ v
+ (begin
+ (vector-set! v i (car xs))
+ (list->vector-helper v (cdr xs) (+ i 1))))))
+
+(define list->vector
+ (lambda (xs)
+ (list->vector-helper (make-vector (length xs) 0) xs 0)))
+
+;; --- Structural equality --------------------------------------------
+;; equal? — eq? fast-path, then recurse into pairs, string contents,
+;; and vector elements. No cycle detection (matches the pre-move P1
+;; version's policy).
+(define equal?-string
+ (lambda (a b i n)
+ (if (= i n)
+ #t
+ (if (= (string-ref a i) (string-ref b i))
+ (equal?-string a b (+ i 1) n)
+ #f))))
+
+(define equal?-vector
+ (lambda (a b i n)
+ (if (= i n)
+ #t
+ (if (equal? (vector-ref a i) (vector-ref b i))
+ (equal?-vector a b (+ i 1) n)
+ #f))))
+
+(define equal?
+ (lambda (a b)
+ (if (eq? a b)
+ #t
+ (if (pair? a)
+ (if (pair? b)
+ (if (equal? (car a) (car b))
+ (equal? (cdr a) (cdr b))
+ #f)
+ #f)
+ (if (string? a)
+ (if (string? b)
+ (if (= (string-length a) (string-length b))
+ (equal?-string a b 0 (string-length a))
+ #f)
+ #f)
+ (if (vector? a)
+ (if (vector? b)
+ (if (= (vector-length a) (vector-length b))
+ (equal?-vector a b 0 (vector-length a))
+ #f)
+ #f)
+ #f))))))
