Fix compiler: handle clause-syntax cond — (cond (test body) ...)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
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:
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user