]> gitweb.factorcode.org Git - factor.git/commitdiff
Clean up recursive-state usage
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Mon, 3 Nov 2008 09:06:11 +0000 (03:06 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Mon, 3 Nov 2008 09:06:11 +0000 (03:06 -0600)
basis/stack-checker/alien/alien.factor
basis/stack-checker/backend/backend.factor
basis/stack-checker/branches/branches.factor
basis/stack-checker/known-words/known-words.factor
basis/stack-checker/stack-checker.factor
basis/stack-checker/state/state.factor

index f81b7fdaa36e371f8a402c663f7c67f37f8a1e34..a38e9ea784201229e8a1dab3e1a1427c482b9a13 100644 (file)
@@ -36,7 +36,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
     pop-literal nip >>library
     pop-literal nip >>return
     ! Quotation which coerces parameters to required types
-    dup param-prep-quot recursive-state get infer-quot
+    dup param-prep-quot infer-quot-here
     ! Set ABI
     dup library>> library [ abi>> ] [ "cdecl" ] if* >>abi
     ! Magic #: consume exactly the number of inputs
@@ -44,7 +44,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
     ! Add node to IR
     dup #alien-invoke,
     ! Quotation which coerces return value to required type
-    return-prep-quot recursive-state get infer-quot ;
+    return-prep-quot infer-quot-here ;
 
 : infer-alien-indirect ( -- )
     alien-indirect-params new
@@ -53,13 +53,13 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
     pop-parameters >>parameters
     pop-literal nip >>return
     ! Quotation which coerces parameters to required types
-    dup param-prep-quot [ dip ] curry recursive-state get infer-quot
+    dup param-prep-quot [ dip ] curry infer-quot-here
     ! Magic #: consume the function pointer, too
     dup 1 alien-stack
     ! Add node to IR
     dup #alien-indirect,
     ! Quotation which coerces return value to required type
-    return-prep-quot recursive-state get infer-quot ;
+    return-prep-quot infer-quot-here ;
 
 ! Callbacks are registered in a global hashtable. If you clear
 ! this hashtable, they will all be blown away by code GC, beware
@@ -71,7 +71,7 @@ SYMBOL: callbacks
 
 : callback-bottom ( params -- )
     xt>> [ [ register-callback ] [ word-xt drop <alien> ] bi ] curry
-    recursive-state get infer-quot ;
+    infer-quot-here ;
 
 : infer-alien-callback ( -- )
     alien-callback-params new
index aa280b96b6ca516463db730465ce8463db49a502..f8dec5f823c84cc079e95edd40c264206ffd087f 100644 (file)
@@ -60,17 +60,20 @@ M: object apply-object push-literal ;
 : terminate ( -- )
     terminated? on meta-d get clone meta-r get clone #terminate, ;
 
+: infer-quot-here ( quot -- )
+    [ apply-object terminated? get not ] all? drop ;
+
 : infer-quot ( quot rstate -- )
     recursive-state get [
         recursive-state set
-        [ apply-object terminated? get not ] all? drop
+        infer-quot-here
     ] dip recursive-state set ;
 
 : infer-quot-recursive ( quot word label -- )
     2array recursive-state get swap prefix infer-quot ;
 
 : time-bomb ( error -- )
-    '[ _ throw ] recursive-state get infer-quot ;
+    '[ _ throw ] infer-quot-here ;
 
 : bad-call ( -- )
     "call must be given a callable" time-bomb ;
index 6b73661471cefbc86c2df161c6fe51ff33f7c1b5..d1417d035ce64c461b35948fe74d24bd79cfe845 100644 (file)
@@ -100,7 +100,7 @@ SYMBOL: quotations
     dup [ known [ curried? ] [ composed? ] bi or ] contains? [
         output-d
         [ rot [ drop call ] [ nip call ] if ]
-        recursive-state get infer-quot
+        infer-quot-here
     ] [
         [ #drop, ] [ [ literal ] map (infer-if) ] bi
     ] if ;
index 1332415c4938899f42d53df9e7090a28891a4bcc..2c0bae5328aaf142467d3179df297ed096e370e3 100644 (file)
@@ -68,14 +68,14 @@ M: literal infer-call*
 
 M: curried infer-call*
     swap push-d
-    [ uncurry ] recursive-state get infer-quot
+    [ uncurry ] infer-quot-here
     [ quot>> known pop-d [ set-known ] keep ]
     [ obj>> known pop-d [ set-known ] keep ] bi
     push-d infer-call ;
 
 M: composed infer-call*
     swap push-d
-    [ uncompose ] recursive-state get infer-quot
+    [ uncompose ] infer-quot-here
     [ quot2>> known pop-d [ set-known ] keep ]
     [ quot1>> known pop-d [ set-known ] keep ] bi
     push-d push-d
index bc3b65518cc2ad74945ee8d586747ca6a789cb26..c990a51cc184bd807adce0a04ba6bc4c7515209e 100644 (file)
@@ -10,7 +10,7 @@ IN: stack-checker
 GENERIC: infer ( quot -- effect )
 
 M: callable infer ( quot -- effect )
-    [ recursive-state get infer-quot ] with-infer drop ;
+    [ infer-quot-here ] with-infer drop ;
 
 : infer. ( quot -- )
     #! Safe to call from inference transforms.
index d3d32b50147d73eccd56d75d4c2e90571a338809..11dc6f9ef8d1cceb34d5f66f068f4ead7cb10727 100644 (file)
@@ -75,8 +75,8 @@ SYMBOL: meta-r
     recursive-state get at ;
 
 : local-recursive-state ( -- assoc )
-    recursive-state get dup keys
-    [ dup word? [ inline? ] when not ] find drop
+    recursive-state get dup
+    [ first dup word? [ inline? ] when not ] find drop
     [ head-slice ] when* ;
 
 : inline-recursive-label ( word -- label/f )