From cee44902fb5ee26ef25347c67e6c916d7697e2a2 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 17 May 2016 11:25:29 -0700
Subject: [PATCH] stack-checker: stop early with compiler error. easier for
 debbuging.

---
 basis/bootstrap/compiler/compiler.factor      |  7 +++-
 .../row-polymorphism/row-polymorphism.factor  | 32 +++++++++----------
 2 files changed, 21 insertions(+), 18 deletions(-)

diff --git a/basis/bootstrap/compiler/compiler.factor b/basis/bootstrap/compiler/compiler.factor
index 91e1c0de79..258f48db10 100644
--- a/basis/bootstrap/compiler/compiler.factor
+++ b/basis/bootstrap/compiler/compiler.factor
@@ -5,7 +5,7 @@ classes.tuple.private compiler.units hashtables
 hashtables.private io kernel libc math math.parser memory
 namespaces namespaces.private quotations quotations.private
 sbufs sequences sequences.private splitting system vectors
-vocabs vocabs.loader words ;
+vocabs vocabs.loader words stack-checker.row-polymorphism ;
 FROM: compiler => enable-optimizer ;
 IN: bootstrap.compiler
 
@@ -63,6 +63,11 @@ gc
 
     "." write flush
 
+    {
+        unify-variables
+        (balance-actual-depth)
+    } compile-unoptimized
+
     {
         bitand bitor bitxor bitnot
     } compile-unoptimized
diff --git a/core/stack-checker/row-polymorphism/row-polymorphism.factor b/core/stack-checker/row-polymorphism/row-polymorphism.factor
index 5e2b2481ac..1bcf6d2753 100644
--- a/core/stack-checker/row-polymorphism/row-polymorphism.factor
+++ b/core/stack-checker/row-polymorphism/row-polymorphism.factor
@@ -33,11 +33,9 @@ IN: stack-checker.row-polymorphism
     actual declared [ slot call length ] bi@ declared var-slot call
     [ vars (check-variable) ] keep ; inline
 
+
 :: unify-variables ( in-diff in-ok? in-var out-diff out-ok? out-var vars -- ? )
-    in-ok?
-    out-ok? and
-    in-diff out-diff = and
-    dup [
+    { [ in-ok? ] [ out-ok? ] [ in-diff out-diff = ] }  0 n&&  dup [
         in-var  [ in-diff  swap vars adjust-variable ] when*
         out-var [ out-diff swap vars adjust-variable ] when*
     ] when ;
@@ -45,19 +43,19 @@ IN: stack-checker.row-polymorphism
 ! A bit of a hack. If the declared effect is one-sided monomorphic and the actual effect is a
 ! shallow subtype of the root effect, adjust it here
 :: (balance-actual-depth) ( declared actual -- depth/f )
-    declared in-var>>
-    declared out-var>> not and
-    actual out>> length declared out>> length < and [
-        declared out>> length actual out>> length -
-    ] [
-        declared in-var>> not
-        declared out-var>> and
-        actual in>> length declared in>> length < and [
-            declared in>> length actual in>> length -
-        ] [
-            f
-        ] if
-    ] if ;
+    {
+        { [ {
+            [ declared in-var>> ]
+            [ declared out-var>> not ]
+            [ actual out>> length declared out>> length < ]
+        } 0 n&& ] [ declared out>> length actual out>> length - ] }
+        { [ {
+            [ declared in-var>> not ]
+            [ declared out-var>> ]
+            [ actual in>> length declared in>> length < ]
+        } 0 n&& ] [ declared in>> length actual in>> length - ] }
+        [ f ]
+    } cond ;
 
 : (balance-by) ( effect n -- effect' )
     "x" <array> swap