stack-checker.alien: now that C types are words, the compiler can add dependencies...

diff --git a/basis/compiler/tests/redefine24.factor b/basis/compiler/tests/redefine24.factor
new file mode 100644 (file)
index 0000000..3911021
--- /dev/null
+++ b/basis/compiler/tests/redefine24.factor
@@ -0,0 +1,39 @@
+USING: alien alien.syntax eval math tools.test ;
+QUALIFIED: alien.c-types
+IN: compiler.tests.redefine24
+
+TYPEDEF: alien.c-types:int type-1
+
+TYPEDEF: alien.c-types:int type-3
+
+: callback ( -- ptr )
+    type-3 { type-1 type-1 } "cdecl" [ + >integer ] alien-callback ;
+
+TYPEDEF: alien.c-types:float type-2
+
+: indirect ( x y ptr -- z  )
+    type-3 { type-2 type-2 } "cdecl" alien-indirect ;
+
+[ ] [
+    "USING: alien.c-types alien.syntax ;
+    IN: compiler.tests.redefine24 TYPEDEF: int type-2" eval( -- )
+] unit-test
+
+[ 3 ] [ 1 2 callback indirect ] unit-test
+
+[ ] [
+    "USING: alien.c-types alien.syntax ;
+    IN: compiler.tests.redefine24
+    TYPEDEF: float type-1
+    TYPEDEF: float type-2" eval( -- )
+] unit-test
+
+[ 3 ] [ 1.0 2.0 callback indirect ] unit-test
+
+[ ] [
+    "USING: alien.c-types alien.syntax ;
+    IN: compiler.tests.redefine24
+    TYPEDEF: float type-3" eval( -- )
+] unit-test
+
+[ 3.0 ] [ 1.0 2.0 callback indirect ] unit-test

diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor
index fdfda6dd9e37ba417346be7b3bf6c92b1b36b4c0..09121488ef89730d23134d7e1b09d68b5ad5d511 100644 (file)
--- a/basis/stack-checker/alien/alien.factor
+++ b/basis/stack-checker/alien/alien.factor
@@ -3,7 +3,7 @@
 USING: kernel sequences accessors combinators math namespaces
 init sets words assocs alien.libraries alien alien.c-types
 cpu.architecture fry stack-checker.backend stack-checker.errors
-stack-checker.visitor ;
+stack-checker.visitor stack-checker.dependencies ;
 IN: stack-checker.alien
 
 TUPLE: alien-node-params return parameters abi in-d out-d ;
@@ -16,65 +16,91 @@ TUPLE: alien-assembly-params < alien-node-params quot ;
 
 TUPLE: alien-callback-params < alien-node-params quot xt ;
 
-: param-prep-quot ( node -- quot )
+: param-prep-quot ( params -- quot )
     parameters>> [ c-type c-type-unboxer-quot ] map spread>quot ;
 
+: infer-params ( params -- )
+    param-prep-quot infer-quot-here ;
+
 : alien-stack ( params extra -- )
     over parameters>> length + consume-d >>in-d
     dup return>> void? 0 1 ? produce-d >>out-d
     drop ;
 
-: return-prep-quot ( node -- quot )
+: return-prep-quot ( params -- quot )
     return>> [ [ ] ] [ c-type c-type-boxer-quot ] if-void ;
 
+: infer-return ( params -- )
+    return-prep-quot infer-quot-here ;
+
+: pop-return ( params -- params )
+    pop-literal [ depends-on-c-type ] [ nip >>return ] bi ;
+
+: pop-library ( params -- params )
+    pop-literal nip >>library ;
+
+: pop-function ( params -- params )
+    pop-literal nip >>function ;
+
+: pop-params ( params -- params )
+    pop-literal [ [ depends-on-c-type ] each ] [ nip >>parameters ] bi ;
+
+: pop-abi ( params -- params )
+    pop-literal nip >>abi ;
+
+: pop-quot ( params -- params )
+    pop-literal nip >>quot ;
+
 : infer-alien-invoke ( -- )
     alien-invoke-params new
     ! Compile-time parameters
-    pop-literal nip >>parameters
-    pop-literal nip >>function
-    pop-literal nip >>library
-    pop-literal nip >>return
-    ! Quotation which coerces parameters to required types
-    dup param-prep-quot infer-quot-here
+    pop-params
+    pop-function
+    pop-library
+    pop-return
     ! Set ABI
     dup library>> library [ abi>> ] [ "cdecl" ] if* >>abi
+    ! Quotation which coerces parameters to required types
+    dup infer-params
     ! Magic #: consume exactly the number of inputs
     dup 0 alien-stack
     ! Add node to IR
     dup #alien-invoke,
     ! Quotation which coerces return value to required type
-    return-prep-quot infer-quot-here ;
+    infer-return ;
 
 : infer-alien-indirect ( -- )
     alien-indirect-params new
     ! Compile-time parameters
-    pop-literal nip >>abi
-    pop-literal nip >>parameters
-    pop-literal nip >>return
+    pop-abi
+    pop-params
+    pop-return
     ! Quotation which coerces parameters to required types
-    dup param-prep-quot '[ _ dip ] infer-quot-here
+    1 infer->r
+    dup infer-params
+    1 infer-r>
     ! 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 infer-quot-here ;
+    infer-return ;
 
 : infer-alien-assembly ( -- )
     alien-assembly-params new
     ! Compile-time parameters
-    pop-literal nip >>quot
-    pop-literal nip >>abi
-    pop-literal nip >>parameters
-    pop-literal nip >>return
+    pop-quot
+    pop-abi
+    pop-params
+    pop-return
     ! Quotation which coerces parameters to required types
-    dup param-prep-quot infer-quot-here
+    dup infer-params
     ! Magic #: consume exactly the number of inputs
     dup 0 alien-stack
     ! Add node to IR
     dup #alien-assembly,
     ! Quotation which coerces return value to required type
-    return-prep-quot infer-quot-here ;
+    infer-return ;
 
 : callback-xt ( word return-rewind -- alien )
     [ callbacks get ] dip '[ _ <callback> ] cache ;
@@ -85,10 +111,10 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
 
 : infer-alien-callback ( -- )
     alien-callback-params new
-    pop-literal nip >>quot
-    pop-literal nip >>abi
-    pop-literal nip >>parameters
-    pop-literal nip >>return
+    pop-quot
+    pop-abi
+    pop-params
+    pop-return
     "( callback )" <uninterned-word> >>xt
     dup callback-bottom
     #alien-callback, ;

diff --git a/basis/stack-checker/dependencies/dependencies.factor b/basis/stack-checker/dependencies/dependencies.factor
index 1bd7cdcd311e266e628446b1524dbbd436887d0e..25fe12cbc5890b211f930d8a4413ff0231fb245e 100644 (file)
--- a/basis/stack-checker/dependencies/dependencies.factor
+++ b/basis/stack-checker/dependencies/dependencies.factor
@@ -40,6 +40,8 @@ SYMBOLS: effect-dependency conditional-dependency definition-dependency ;
 
 GENERIC: depends-on-c-type ( c-type -- )
 
+M: void depends-on-c-type drop ;
+
 M: c-type-word depends-on-c-type depends-on-definition ;
 
 M: array depends-on-c-type