coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cl-runtime: add lib/common-lisp/runtime.sx + test.sh (68/68 pass)

Browse Source 
Type predicates, arithmetic, chars (inline α/digit/case),
format, gensym, values, sets, radix, list utilities.
cl-empty? guards all list traversal against () vs nil in sx_server.
Load spec/stdlib.sx in test.sh to expose format.
Fix lib/r7rs.sx number->string to use (= (len r) 0) not (nil? r).

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-05-01 21:00:22 +00:00
parent f4193a2e8e
commit 1ad8e74aa6
3 changed files with 609 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

302
lib/common-lisp/test.sh Executable file
View File

@@ -0,0 +1,302 @@
#!/usr/bin/env bash
# lib/common-lisp/test.sh — quick smoke-test the CL runtime layer.
# Uses sx_server.exe epoch protocol (same as lib/lua/test.sh).
#
# Usage:
# bash lib/common-lisp/test.sh
# bash lib/common-lisp/test.sh -v
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found. Run: cd hosts/ocaml && dune build"
exit 1
fi
VERBOSE="${1:-}"
PASS=0; FAIL=0; ERRORS=""
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
cat > "$TMPFILE" << 'EPOCHS'
(epoch 1)
(load "spec/stdlib.sx")
(load "lib/common-lisp/runtime.sx")
;; --- Type predicates ---
(epoch 10)
(eval "(cl-null? nil)")
(epoch 11)
(eval "(cl-null? false)")
(epoch 12)
(eval "(cl-consp? (list 1 2))")
(epoch 13)
(eval "(cl-consp? nil)")
(epoch 14)
(eval "(cl-listp? nil)")
(epoch 15)
(eval "(cl-listp? (list 1))")
(epoch 16)
(eval "(cl-atom? nil)")
(epoch 17)
(eval "(cl-atom? (list 1))")
(epoch 18)
(eval "(cl-integerp? 42)")
(epoch 19)
(eval "(cl-floatp? 3.14)")
(epoch 20)
(eval "(cl-characterp? (integer->char 65))")
(epoch 21)
(eval "(cl-stringp? \"hello\")")
;; --- Arithmetic ---
(epoch 30)
(eval "(cl-mod 10 3)")
(epoch 31)
(eval "(cl-rem 10 3)")
(epoch 32)
(eval "(cl-quotient 10 3)")
(epoch 33)
(eval "(cl-gcd 12 8)")
(epoch 34)
(eval "(cl-lcm 4 6)")
(epoch 35)
(eval "(cl-abs -5)")
(epoch 36)
(eval "(cl-abs 5)")
(epoch 37)
(eval "(cl-min 2 7)")
(epoch 38)
(eval "(cl-max 2 7)")
(epoch 39)
(eval "(cl-evenp? 4)")
(epoch 40)
(eval "(cl-evenp? 3)")
(epoch 41)
(eval "(cl-oddp? 7)")
(epoch 42)
(eval "(cl-zerop? 0)")
(epoch 43)
(eval "(cl-plusp? 1)")
(epoch 44)
(eval "(cl-minusp? -1)")
(epoch 45)
(eval "(cl-signum 42)")
(epoch 46)
(eval "(cl-signum -7)")
(epoch 47)
(eval "(cl-signum 0)")
;; --- Characters ---
(epoch 50)
(eval "(cl-char-code (integer->char 65))")
(epoch 51)
(eval "(char? (cl-code-char 65))")
(epoch 52)
(eval "(cl-char=? (integer->char 65) (integer->char 65))")
(epoch 53)
(eval "(cl-char<? (integer->char 65) (integer->char 90))")
(epoch 54)
(eval "(cl-char-code cl-char-space)")
(epoch 55)
(eval "(cl-char-code cl-char-newline)")
(epoch 56)
(eval "(cl-alpha-char-p (integer->char 65))")
(epoch 57)
(eval "(cl-digit-char-p (integer->char 48))")
;; --- Format ---
(epoch 60)
(eval "(cl-format nil \"hello\")")
(epoch 61)
(eval "(cl-format nil \"~a\" \"world\")")
(epoch 62)
(eval "(cl-format nil \"~d\" 42)")
(epoch 63)
(eval "(cl-format nil \"~x\" 255)")
(epoch 64)
(eval "(cl-format nil \"x=~d y=~d\" 3 4)")
;; --- Gensym ---
(epoch 70)
(eval "(= (type-of (cl-gensym)) \"symbol\")")
(epoch 71)
(eval "(not (= (cl-gensym) (cl-gensym)))")
;; --- Sets ---
(epoch 80)
(eval "(cl-set? (cl-make-set))")
(epoch 81)
(eval "(let ((s (cl-make-set))) (do (cl-set-add s 1) (cl-set-memberp s 1)))")
(epoch 82)
(eval "(cl-set-memberp (cl-make-set) 42)")
(epoch 83)
(eval "(cl-set-memberp (cl-list->set (list 1 2 3)) 2)")
;; --- Lists ---
(epoch 90)
(eval "(cl-nth 0 (list 1 2 3))")
(epoch 91)
(eval "(cl-nth 2 (list 1 2 3))")
(epoch 92)
(eval "(cl-last (list 1 2 3))")
(epoch 93)
(eval "(cl-butlast (list 1 2 3))")
(epoch 94)
(eval "(cl-nthcdr 1 (list 1 2 3))")
(epoch 95)
(eval "(cl-assoc \"b\" (list (list \"a\" 1) (list \"b\" 2)))")
(epoch 96)
(eval "(cl-assoc \"z\" (list (list \"a\" 1)))")
(epoch 97)
(eval "(cl-getf (list \"x\" 42 \"y\" 99) \"x\")")
(epoch 98)
(eval "(cl-adjoin 0 (list 1 2))")
(epoch 99)
(eval "(cl-adjoin 1 (list 1 2))")
(epoch 100)
(eval "(cl-member 2 (list 1 2 3))")
(epoch 101)
(eval "(cl-member 9 (list 1 2 3))")
(epoch 102)
(eval "(cl-flatten (list 1 (list 2 3) 4))")
;; --- Radix ---
(epoch 110)
(eval "(cl-format-binary 10)")
(epoch 111)
(eval "(cl-format-octal 15)")
(epoch 112)
(eval "(cl-format-hex 255)")
(epoch 113)
(eval "(cl-format-decimal 42)")
(epoch 114)
(eval "(cl-integer-to-string 31 16)")
(epoch 115)
(eval "(cl-string-to-integer \"1f\" 16)")
EPOCHS
OUTPUT=$(timeout 30 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
check() {
local epoch="$1" desc="$2" expected="$3"
local actual
# ok-len format: value appears on the line AFTER "(ok-len N length)"
actual=$(echo "$OUTPUT" | grep -A1 "^(ok-len $epoch " | tail -1 || true)
# strip any leading "(ok-len ...)" if grep -A1 returned it instead
if echo "$actual" | grep -q "^(ok-len"; then actual=""; fi
if [ -z "$actual" ]; then
actual=$(echo "$OUTPUT" | grep "^(ok $epoch " | head -1 || true)
fi
if [ -z "$actual" ]; then
actual=$(echo "$OUTPUT" | grep "^(error $epoch " | head -1 || true)
fi
[ -z "$actual" ] && actual="<no output for epoch $epoch>"
if echo "$actual" | grep -qF -- "$expected"; then
PASS=$((PASS+1))
[ "$VERBOSE" = "-v" ] && echo " ok $desc"
else
FAIL=$((FAIL+1))
ERRORS+=" FAIL [$desc] (epoch $epoch) expected: $expected | actual: $actual
"
fi
}
# Type predicates
check 10 "cl-null? nil" "true"
check 11 "cl-null? false" "false"
check 12 "cl-consp? pair" "true"
check 13 "cl-consp? nil" "false"
check 14 "cl-listp? nil" "true"
check 15 "cl-listp? list" "true"
check 16 "cl-atom? nil" "true"
check 17 "cl-atom? pair" "false"
check 18 "cl-integerp?" "true"
check 19 "cl-floatp?" "true"
check 20 "cl-characterp?" "true"
check 21 "cl-stringp?" "true"
# Arithmetic
check 30 "cl-mod 10 3" "1"
check 31 "cl-rem 10 3" "1"
check 32 "cl-quotient 10 3" "3"
check 33 "cl-gcd 12 8" "4"
check 34 "cl-lcm 4 6" "12"
check 35 "cl-abs -5" "5"
check 36 "cl-abs 5" "5"
check 37 "cl-min 2 7" "2"
check 38 "cl-max 2 7" "7"
check 39 "cl-evenp? 4" "true"
check 40 "cl-evenp? 3" "false"
check 41 "cl-oddp? 7" "true"
check 42 "cl-zerop? 0" "true"
check 43 "cl-plusp? 1" "true"
check 44 "cl-minusp? -1" "true"
check 45 "cl-signum pos" "1"
check 46 "cl-signum neg" "-1"
check 47 "cl-signum zero" "0"
# Characters
check 50 "cl-char-code" "65"
check 51 "code-char returns char" "true"
check 52 "cl-char=?" "true"
check 53 "cl-char<?" "true"
check 54 "cl-char-space code" "32"
check 55 "cl-char-newline code" "10"
check 56 "cl-alpha-char-p A" "true"
check 57 "cl-digit-char-p 0" "true"
# Format
check 60 "cl-format plain" '"hello"'
check 61 "cl-format ~a" '"world"'
check 62 "cl-format ~d" '"42"'
check 63 "cl-format ~x" '"ff"'
check 64 "cl-format multi" '"x=3 y=4"'
# Gensym
check 70 "gensym returns symbol" "true"
check 71 "gensyms are unique" "true"
# Sets
check 80 "make-set is set?" "true"
check 81 "set-add + member" "true"
check 82 "member in empty" "false"
check 83 "list->set member" "true"
# Lists
check 90 "cl-nth 0" "1"
check 91 "cl-nth 2" "3"
check 92 "cl-last" "(3)"
check 93 "cl-butlast" "(1 2)"
check 94 "cl-nthcdr 1" "(2 3)"
check 95 "cl-assoc hit" '("b" 2)'
check 96 "cl-assoc miss" "nil"
check 97 "cl-getf hit" "42"
check 98 "cl-adjoin new" "(0 1 2)"
check 99 "cl-adjoin dup" "(1 2)"
check 100 "cl-member hit" "(2 3)"
check 101 "cl-member miss" "nil"
check 102 "cl-flatten" "(1 2 3 4)"
# Radix
check 110 "cl-format-binary 10" '"1010"'
check 111 "cl-format-octal 15" '"17"'
check 112 "cl-format-hex 255" '"ff"'
check 113 "cl-format-decimal 42" '"42"'
check 114 "n->s base 16" '"1f"'
check 115 "s->n base 16" "31"
TOTAL=$((PASS+FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL lib/common-lisp tests passed"
else
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
echo "$ERRORS"
fi
[ $FAIL -eq 0 ]