diff --git a/module/language/tree-il/compile-bytecode.scm b/module/language/tree-il/compile-bytecode.scm index d0e5271ba..e2eaabfcc 100644 --- a/module/language/tree-il/compile-bytecode.scm +++ b/module/language/tree-il/compile-bytecode.scm @@ -399,6 +399,7 @@ (define (finish-conditional exp) (define (true? x) (match x (($ _ val) val) (_ #f))) (define (false? x) (match x (($ _ val) (not val)) (_ #f))) + (define (predicate? name) (primitive-predicate? (lookup-primitive name))) (match exp (($ src ($ _ test (? true?) (? false?)) consequent alternate) @@ -406,6 +407,8 @@ (($ src ($ _ test (? false?) (? true?)) consequent alternate) (finish-conditional (make-conditional src test alternate consequent))) + (($ src ($ _ (? predicate?))) + exp) (($ src test consequent alternate) (make-conditional src (make-primcall src 'false? (list test)) alternate consequent)))) @@ -864,8 +867,8 @@ in the frame with for the lambda-case clause @var{clause}." (kf (gensym "false")) (kdone (gensym "done"))) (match args - ((a) (emit asm args a kf)) - ((a b) (emit asm args a b kf))) + ((a) (emit asm a kf)) + ((a b) (emit asm a b kf))) (for-context consequent env ctx) (unless (eq? ctx 'tail) (emit-j asm kdone))