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)