From 3c419501e1f18d549a4a1f2e801da11a8479fa3d Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 3 Apr 2026 10:20:31 +0000 Subject: [PATCH] =?UTF-8?q?Fix=20r7rs.sx:=20remove=20guard=20macro=20(tran?= =?UTF-8?q?spiler=20blocker),=20fix=20null=3F/boolean=3D=3F?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit guard macro expansion loops in the transpiled evaluator because expand_macro→eval_expr→CEK can't handle let+first/rest in macro bodies. Removed guard macro; will re-add as special form once transpiler handles runtime AST construction (cons/append/make-symbol). Fixed null? to handle empty lists (not just nil). Fixed boolean=? to use = instead of undefined eq?. 2561/2568 tests pass (37 new vs baseline, 5 guard + 2 scope pending). Co-Authored-By: Claude Opus 4.6 (1M context) --- hosts/ocaml/bin/run_tests.ml | 4 ++-- lib/r7rs.sx | 14 ++------------ 2 files changed, 4 insertions(+), 14 deletions(-) diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml index fd64e6f2..d8fc8eac 100644 --- a/hosts/ocaml/bin/run_tests.ml +++ b/hosts/ocaml/bin/run_tests.ml @@ -1159,8 +1159,8 @@ let run_spec_tests env test_files = with e -> Printf.eprintf "Warning: %s: %s\n%!" name (Printexc.to_string e)) end in - (* R7RS compatibility library — TODO: debug hang in transpiled eval *) - (* load_module "r7rs.sx" lib_dir; *) + (* R7RS compatibility library — minimal test version *) + load_module "r7rs.sx" lib_dir; (* Render adapter for test-render-html.sx *) load_module "render.sx" spec_dir; load_module "canonical.sx" spec_dir; diff --git a/lib/r7rs.sx b/lib/r7rs.sx index 97384d10..2bf0d5af 100644 --- a/lib/r7rs.sx +++ b/lib/r7rs.sx @@ -18,16 +18,6 @@ (quasiquote (handler-bind (((fn (c) true) (unquote handler))) ((unquote thunk))))) -(defmacro - guard - (var-and-clauses &rest body) - (let - ((var (first var-and-clauses)) (clauses (rest var-and-clauses))) - (quasiquote - (handler-bind - (((fn (c) true) (fn ((unquote var)) (cond (splice-unquote clauses) (else (raise (unquote var))))))) - (splice-unquote body))))) - (define car first) (define cdr rest) @@ -44,13 +34,13 @@ (define cadddr (fn (x) (first (rest (rest (rest x)))))) -(define null? nil?) +(define null? (fn (x) (or (nil? x) (and (list? x) (empty? x))))) (define pair? (fn (x) (and (list? x) (not (empty? x))))) (define procedure? (fn (x) (or (lambda? x) (callable? x)))) -(define boolean=? (fn (a b) (eq? a b))) +(define boolean=? (fn (a b) (= a b))) (define symbol->string symbol-name)