From cfdaf35d7380c790c152762a5b155a8dde8ddf83 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Mon, 4 May 2020 22:28:34 +0200
Subject: [PATCH] Fix baseline compilation of conditionals

* module/language/tree-il/compile-bytecode.scm (canonicalize): Don't add
  an extra false? around predicates.
  (compile-closure): Fix predicate comparison instructions.
---
 module/language/tree-il/compile-bytecode.scm | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

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 (($ <const> _ val) val) (_ #f)))
     (define (false? x) (match x (($ <const> _ val) (not val)) (_ #f)))
+    (define (predicate? name) (primitive-predicate? (lookup-primitive name)))
     (match exp
       (($ <conditional> src ($ <conditional> _ test (? true?) (? false?))
           consequent alternate)
@@ -406,6 +407,8 @@
       (($ <conditional> src ($ <conditional> _ test (? false?) (? true?))
           consequent alternate)
        (finish-conditional (make-conditional src test alternate consequent)))
+      (($ <conditional> src ($ <primcall> _ (? predicate?)))
+       exp)
       (($ <conditional> 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))