Revert part of an earlier ccompiler.tree.checker hange to fix smalltalk.eval regression

diff --git a/basis/compiler/tree/checker/checker.factor b/basis/compiler/tree/checker/checker.factor
index 718def367d6fab3548dbb19f3aa00a60148d97aa..e25f152aefeda508316a10d7788b47416e898e64 100755 (executable)
--- a/basis/compiler/tree/checker/checker.factor
+++ b/basis/compiler/tree/checker/checker.factor
@@ -144,15 +144,13 @@ M: #terminate check-stack-flow*
 
 SYMBOL: branch-out
 
-: check-branch ( nodes -- datastack )
+: check-branch ( nodes -- stack )
     [
         datastack [ clone ] change
-        retainstack [ clone ] change
-        retainstack get clone [ (check-stack-flow) ] dip
-        terminated? get [ drop f ] [
-            retainstack get assert=
-            datastack get
-        ] if
+        V{ } clone retainstack set
+        (check-stack-flow)
+        terminated? get [ assert-retainstack-empty ] unless
+        terminated? get f datastack get ?
     ] with-scope ;
 
 M: #branch check-stack-flow*

diff --git a/basis/compiler/tree/optimizer/optimizer.factor b/basis/compiler/tree/optimizer/optimizer.factor
index daa8f072caf81437ba433199269180bf3a0aea11..fe3c7acb9248c355a12ba13b6d04050406719fa5 100644 (file)
--- a/basis/compiler/tree/optimizer/optimizer.factor
+++ b/basis/compiler/tree/optimizer/optimizer.factor
@@ -29,7 +29,6 @@ SYMBOL: check-optimizer?
     normalize
     propagate
     cleanup
-    ?check
     dup run-escape-analysis? [
         escape-analysis
         unbox-tuples

diff --git a/basis/stack-checker/backend/backend.factor b/basis/stack-checker/backend/backend.factor
index 182de28cd92d68f2defa7676d897658155615a67..4fb5bab96fcc4329b6e620e8b140db0ab14c64e0 100755 (executable)
--- a/basis/stack-checker/backend/backend.factor
+++ b/basis/stack-checker/backend/backend.factor
@@ -84,8 +84,11 @@ M: object apply-object push-literal ;
     meta-r empty? [ too-many->r ] unless ;
 
 : infer-quot-here ( quot -- )
-    [ apply-object terminated? get not ] all?
-    [ commit-literals ] [ literals get delete-all ] if ;
+    meta-r [
+        V{ } clone \ meta-r set
+        [ apply-object terminated? get not ] all?
+        [ commit-literals check->r ] [ literals get delete-all ] if
+    ] dip \ meta-r set ;
 
 : infer-quot ( quot rstate -- )
     recursive-state get [
@@ -113,33 +116,25 @@ M: object apply-object push-literal ;
     ] if ;
 
 : infer->r ( n -- )
-    terminated? get [ drop ] [
-        consume-d dup copy-values [ nip output-r ] [ #>r, ] 2bi
-    ] if ;
+    consume-d dup copy-values [ nip output-r ] [ #>r, ] 2bi ;
 
 : infer-r> ( n -- )
-    terminated? get [ drop ] [
-        consume-r dup copy-values [ nip output-d ] [ #r>, ] 2bi
-    ] if ;
-
-: (consume/produce) ( effect -- inputs outputs )
-    [ in>> length consume-d ] [ out>> length produce-d ] bi ;
+    consume-r dup copy-values [ nip output-d ] [ #r>, ] 2bi ;
 
 : consume/produce ( effect quot: ( inputs outputs -- ) -- )
-    '[ (consume/produce) @ ]
+    '[ [ in>> length consume-d ] [ out>> length produce-d ] bi @ ]
     [ terminated?>> [ terminate ] when ]
     bi ; inline
 
+: apply-word/effect ( word effect -- )
+    swap '[ _ #call, ] consume/produce ;
+
 : end-infer ( -- )
-    terminated? get [ check->r ] unless
     meta-d clone #return, ;
 
 : required-stack-effect ( word -- effect )
     dup stack-effect [ ] [ missing-effect ] ?if ;
 
-: apply-word/effect ( word effect -- )
-    swap '[ _ #call, ] consume/produce ;
-
 : infer-word ( word -- )
     {
         { [ dup macro? ] [ do-not-compile ] }

diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor
index 9f5d0a2213ffb4eeff3b6756e6b174efb9be1a74..919cd098f6c286bafe168a4b6a707680b3596eff 100644 (file)
--- a/basis/stack-checker/stack-checker-tests.factor
+++ b/basis/stack-checker/stack-checker-tests.factor
@@ -299,7 +299,7 @@ ERROR: custom-error ;
     [ custom-error inference-error ] infer
 ] unit-test
 
-[ T{ effect f 1 1 t } ] [
+[ T{ effect f 1 2 t } ] [
     [ dup [ 3 throw ] dip ] infer
 ] unit-test
 
@@ -369,4 +369,6 @@ DEFER: eee'
 
 [ [ cond ] infer ] must-fail
 [ [ bi ] infer ] must-fail
-[ at ] must-infer
\ No newline at end of file
+[ at ] must-infer
+
+[ [ [ "OOPS" throw ] dip ] [ drop ] if ] must-infer
\ No newline at end of file

diff --git a/basis/stack-checker/state/state.factor b/basis/stack-checker/state/state.factor
index 9b87854b6947e4e413401f7087e0ed9c2d43bee2..a76d302a7ea469f628c18fff73d24cc712e162a7 100644 (file)
--- a/basis/stack-checker/state/state.factor
+++ b/basis/stack-checker/state/state.factor
@@ -42,7 +42,6 @@ SYMBOL: literals
 : init-inference ( -- )
     terminated? off
     V{ } clone \ meta-d set
-    V{ } clone \ meta-r set
     V{ } clone literals set
     0 d-in set ;