stack-checker.alien: new word stack-shape which replaces alien-inputs/outputs
parent
a79309680c
commit
0c7b871de7
|
@ -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
|
||||
|
|
|
@ -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 )
|
||||
[
|
||||
|
|
Loading…
Reference in New Issue