From 1c1333fbe99441834639e6275c8da678f0df6bf0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 6 Nov 2008 09:09:21 -0600
Subject: [PATCH] Compile not and >boolean as branchless intrinsics by having
 the CFG builder detect certain code patterns

---
 basis/compiler/cfg/builder/builder.factor | 29 ++++++++++++++++++++++-
 core/kernel/kernel.factor                 |  4 ++--
 2 files changed, 30 insertions(+), 3 deletions(-)

diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor
index a59ceff5b9..5b9f2e068b 100755
--- a/basis/compiler/cfg/builder/builder.factor
+++ b/basis/compiler/cfg/builder/builder.factor
@@ -125,8 +125,35 @@ M: #recursive emit-node
 : ##branch-t ( vreg -- )
     \ f tag-number cc/= ##compare-imm-branch ;
 
+: trivial-branch? ( nodes -- value ? )
+    dup length 1 = [
+        first dup #push? [ literal>> t ] [ drop f f ] if
+    ] [ drop f f ] if ;
+
+: trivial-if? ( #if -- ? )
+    children>> first2
+    [ trivial-branch? [ t eq? ] when ]
+    [ trivial-branch? [ f eq? ] when ] bi*
+    and ;
+
+: emit-trivial-if ( -- )
+    ds-pop \ f tag-number cc/= ^^compare-imm ds-push ;
+
+: trivial-not-if? ( #if -- ? )
+    children>> first2
+    [ trivial-branch? [ f eq? ] when ]
+    [ trivial-branch? [ t eq? ] when ] bi*
+    and ;
+
+: emit-trivial-not-if ( -- )
+    ds-pop \ f tag-number cc= ^^compare-imm ds-push ;
+
 M: #if emit-node
-    ds-pop ##branch-t emit-if iterate-next ;
+    {
+        { [ dup trivial-if? ] [ drop emit-trivial-if ] }
+        { [ dup trivial-not-if? ] [ drop emit-trivial-not-if ] }
+        [ ds-pop ##branch-t emit-if ]
+    } cond iterate-next ;
 
 ! #dispatch
 : dispatch-branch ( nodes word -- label )
diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor
index fae1922d29..62e37ef301 100644
--- a/core/kernel/kernel.factor
+++ b/core/kernel/kernel.factor
@@ -167,11 +167,11 @@ GENERIC: boa ( ... class -- tuple )
     compose compose ; inline
 
 ! Booleans
-: not ( obj -- ? ) f t ? ; inline
+: not ( obj -- ? ) [ f ] [ t ] if ; inline
 
 : and ( obj1 obj2 -- ? ) over ? ; inline
 
-: >boolean ( obj -- ? ) t f ? ; inline
+: >boolean ( obj -- ? ) [ t ] [ f ] if ; inline
 
 : or ( obj1 obj2 -- ? ) dupd ? ; inline