stack-checker.alien: new word stack-shape which replaces alien-inputs/outputs

diff --git a/basis/stack-checker/alien/alien-tests.factor b/basis/stack-checker/alien/alien-tests.factor
index 8f360145104af545f52d823c290f7631f62766f4..5116aad9a9ed83e424fc568dbc630af6dd6434b7 100644 (file)
--- a/basis/stack-checker/alien/alien-tests.factor
+++ b/basis/stack-checker/alien/alien-tests.factor
@@ -15,7 +15,7 @@ IN: stack-checker.alien.tests
     V{ } clone literals set
     30 \ <value> set-global
     alien-node-params new int >>return { int int } >>parameters
-    alien-inputs/outputs
+    inputs/outputs
 ] unit-test
 
 {
@@ -28,7 +28,7 @@ IN: stack-checker.alien.tests
     V{ } clone literals set
     30 \ <value> set-global
     alien-indirect-params new int >>return { int int } >>parameters
-    alien-inputs/outputs
+    inputs/outputs
 ] unit-test
 
 ! wrap-callback-quot

diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor
index bcd577a7332b11984149117abc45a3934d2885ea..3588a0074a4edce35ea70a7033724c72674355cf 100644 (file)
--- a/basis/stack-checker/alien/alien.factor
+++ b/basis/stack-checker/alien/alien.factor
@@ -25,11 +25,13 @@ TUPLE: alien-callback-params < alien-node-params
 : param-prep-quot ( params -- quot )
     parameters>> [ lookup-c-type c-type-unboxer-quot ] map deep-spread>quot ;
 
-: alien-inputs/outputs ( params -- in-d out-d )
+: stack-shape ( params -- in out )
     [
-        [ parameters>> length ]
-        [ alien-indirect-params? 1 0 ? ] bi + consume-d
-    ] [ return>> void? 0 1 ? produce-d ] bi ;
+        [ parameters>> length ] [ alien-indirect-params? 1 0 ? ] bi +
+    ] [ return>> void? 0 1 ? ] bi ;
+
+: inputs/outputs ( params -- in-d out-d )
+    stack-shape [ consume-d ] [ produce-d ] bi* ;
 
 : return-prep-quot ( params -- quot )
     return>> [ [ ] ] [ lookup-c-type c-type-boxer-quot ] if-void ;
@@ -67,7 +69,7 @@ TUPLE: alien-callback-params < alien-node-params
     ! Quotation which coerces parameters to required types
     dup param-prep-quot infer-quot-here
     ! Consume inputs and outputs and add node to IR
-    dup dup alien-inputs/outputs #alien-invoke,
+    dup dup inputs/outputs #alien-invoke,
     ! Quotation which coerces return value to required type
     infer-return ;
 
@@ -80,7 +82,7 @@ TUPLE: alien-callback-params < alien-node-params
     ! Coerce parameters to required types
     dup param-prep-quot '[ _ [ >c-ptr ] bi* ] infer-quot-here
     ! Consume inputs and outputs and add node to IR
-    dup dup alien-inputs/outputs #alien-indirect,
+    dup dup inputs/outputs #alien-indirect,
     ! Quotation which coerces return value to required type
     infer-return ;
 
@@ -94,7 +96,7 @@ TUPLE: alien-callback-params < alien-node-params
     ! Quotation which coerces parameters to required types
     dup param-prep-quot infer-quot-here
     ! Consume inputs and outputs and add node to IR
-    dup dup alien-inputs/outputs #alien-assembly,
+    dup dup inputs/outputs #alien-assembly,
     ! Quotation which coerces return value to required type
     infer-return ;
 
@@ -126,8 +128,7 @@ M: callable wrap-callback-quot
     '[ _ _ do-callback ] >quotation ;
 
 : callback-effect ( params -- effect )
-    [ parameters>> length "x" <array> ]
-    [ return>> void? { } { "x" } ? ] bi <effect> ;
+    stack-shape [ "x" <array> ] bi@ <effect> ;
 
 : infer-callback-quot ( params quot -- child )
     [