Fix compiler: handle clause-syntax cond — (cond (test body) ...)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled

compile-cond expected flat syntax (cond test body test body ...) but
hs-parse uses clause syntax (cond (test body) (test body) ...). The
compiler treated the whole clause as the test expression, compiling
((and ...) (do ...)) as a function call — which tried to call the
and-result as a function, producing "not callable: false" JIT errors.

Now detects clause syntax (first arg is a list whose first element is
also a list) and flattens to the expected format before compilation.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-04-06 14:34:16 +00:00
parent d3ff4f7ef3
commit 75130876c7

View File

@@ -724,38 +724,41 @@
compile-cond compile-cond
(fn (fn
(em args scope tail?) (em args scope tail?)
"Compile (cond test1 body1 test2 body2 ... :else fallback)." "Compile (cond test1 body1 test2 body2 ... :else fallback).\n Also handles clause syntax: (cond (test1 body1) (test2 body2) ...)."
(if (let
(< (len args) 2) ((flat-args (if (and (not (empty? args)) (list? (first args)) (> (len (first args)) 1) (list? (first (first args)))) (reduce (fn (acc clause) (if (list? clause) (append acc clause) (append acc (list clause)))) (list) args) args)))
(emit-op em 2) (if
(let (< (len flat-args) 2)
((test (first args)) (emit-op em 2)
(body (nth args 1)) (let
(rest-clauses (if (> (len args) 2) (slice args 2) (list)))) ((test (nth flat-args 0))
(if (body (nth flat-args 1))
(or (rest-clauses
(and (if (> (len flat-args) 2) (slice flat-args 2) (list))))
(= (type-of test) "keyword") (if
(= (keyword-name test) "else")) (or
(= test true)) (and
(compile-expr em body scope tail?) (= (type-of test) "keyword")
(do (= (keyword-name test) "else"))
(compile-expr em test scope false) (= test true))
(emit-op em 33) (compile-expr em body scope tail?)
(let (do
((skip (current-offset em))) (compile-expr em test scope false)
(emit-i16 em 0) (emit-op em 33)
(compile-expr em body scope tail?)
(emit-op em 32)
(let (let
((end-jump (current-offset em))) ((skip (current-offset em)))
(emit-i16 em 0) (emit-i16 em 0)
(patch-i16 em skip (- (current-offset em) (+ skip 2))) (compile-expr em body scope tail?)
(compile-cond em rest-clauses scope tail?) (emit-op em 32)
(patch-i16 (let
em ((end-jump (current-offset em)))
end-jump (emit-i16 em 0)
(- (current-offset em) (+ end-jump 2))))))))))) (patch-i16 em skip (- (current-offset em) (+ skip 2)))
(compile-cond em rest-clauses scope tail?)
(patch-i16
em
end-jump
(- (current-offset em) (+ end-jump 2))))))))))))
(define (define
compile-case compile-case
(fn (fn