alien: move code for supporting CONSTANT: foo 123 { "int" foo } C types into one...

diff --git a/basis/alien/arrays/arrays.factor b/basis/alien/arrays/arrays.factor
index fbf59e6f116a835d3b2d7afeee543863fa9e6fbd..e56f1513834af5583954eb5dce6618dfe56dbfb5 100755 (executable)
--- a/basis/alien/arrays/arrays.factor
+++ b/basis/alien/arrays/arrays.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.strings alien.c-types alien.accessors alien.structs
 arrays words sequences math kernel namespaces fry libc cpu.architecture
-io.encodings.utf8 ;
+io.encodings.utf8 accessors ;
 IN: alien.arrays
 
 UNION: value-type array struct-type ;
@@ -13,7 +13,10 @@ M: array c-type-class drop object ;
 
 M: array c-type-boxed-class drop object ;
 
-M: array heap-size unclip [ product ] [ heap-size ] bi* * ;
+: array-length ( seq -- n )
+    [ dup word? [ def>> call( -- object ) ] when ] [ * ] map-reduce ;
+
+M: array heap-size unclip [ array-length ] [ heap-size ] bi* * ;
 
 M: array c-type-align first c-type-align ;
 
@@ -31,7 +34,7 @@ M: array stack-size drop "void*" stack-size ;
 
 M: array c-type-boxer-quot
     unclip
-    [ product ]
+    [ array-length ]
     [ [ require-c-type-arrays ] keep ] bi*
     [ <c-type-direct-array> ] 2curry ;
 

diff --git a/basis/alien/c-types/c-types-tests.factor b/basis/alien/c-types/c-types-tests.factor
index 0de26aad20e2309331301c141c5c54404c37cd25..bfeff5f1de2bc0186006b5621a39f44de4c5136b 100644 (file)
--- a/basis/alien/c-types/c-types-tests.factor
+++ b/basis/alien/c-types/c-types-tests.factor
@@ -4,7 +4,7 @@ IN: alien.c-types.tests
 
 CONSTANT: xyz 123
 
-[ { "blah" 123 } ] [ { "blah" xyz } expand-constants ] unit-test
+[ 492 ] [ { "int" xyz } heap-size ] unit-test
 
 [ -1 ] [ -1 <char> *char ] unit-test
 [ -1 ] [ -1 <short> *short ] unit-test

diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index 400af25373cbca041cab05ce7ac8937a8a09bbb0..4c3c8d16689d5043f57cecb0c6f561607097c6c1 100755 (executable)
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -326,17 +326,6 @@ M: long-long-type box-return ( type -- )
     [ define-out ]
     tri ;
 
-: expand-constants ( c-type -- c-type' )
-    dup array? [
-        unclip [
-            [
-                dup word? [
-                    def>> call( -- object )
-                ] when
-            ] map
-        ] dip prefix
-    ] when ;
-
 : malloc-file-contents ( path -- alien len )
     binary file-contents [ malloc-byte-array ] [ length ] bi ;
 

diff --git a/basis/alien/structs/fields/fields.factor b/basis/alien/structs/fields/fields.factor
index 7e2d4615b5d0786b06433eb47a8b5282e8e8a57c..25c595b8648f22443daec0dd634dc8a19b716045 100644 (file)
--- a/basis/alien/structs/fields/fields.factor
+++ b/basis/alien/structs/fields/fields.factor
@@ -16,7 +16,7 @@ TUPLE: field-spec name offset type reader writer ;
     field-spec new
         0 >>offset
         swap >>name
-        swap expand-constants >>type
+        swap >>type
         3dup name>> swap reader-word >>reader
         3dup name>> swap writer-word >>writer
     2nip ;

diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor
index 85b55f2cbc46d1e84e9b68f68f19d72cfac368ed..3cc4857ecbfde9c4e47d6131a66e69441344af94 100755 (executable)
--- a/basis/alien/structs/structs.factor
+++ b/basis/alien/structs/structs.factor
@@ -58,7 +58,6 @@ M: struct-type stack-size
     [ define-field ] each ;
 
 : define-union ( name members -- )
-    [ expand-constants ] map
     [ [ heap-size ] [ max ] map-reduce ] keep
     compute-struct-align f struct-type (define-struct) ;
 

diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor
index 0b135319fffec3ab72176a54dc0e3605e8e27093..da559abd7808178af73967cb849ab6556287be1d 100644 (file)
--- a/basis/stack-checker/alien/alien.factor
+++ b/basis/stack-checker/alien/alien.factor
@@ -14,9 +14,6 @@ TUPLE: alien-indirect-params < alien-node-params ;
 
 TUPLE: alien-callback-params < alien-node-params quot xt ;
 
-: pop-parameters ( -- seq )
-    pop-literal nip [ expand-constants ] map ;
-
 : param-prep-quot ( node -- quot )
     parameters>> [ c-type c-type-unboxer-quot ] map spread>quot ;
 
@@ -31,7 +28,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
 : infer-alien-invoke ( -- )
     alien-invoke-params new
     ! Compile-time parameters
-    pop-parameters >>parameters
+    pop-literal nip >>parameters
     pop-literal nip >>function
     pop-literal nip >>library
     pop-literal nip >>return
@@ -50,7 +47,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
     alien-indirect-params new
     ! Compile-time parameters
     pop-literal nip >>abi
-    pop-parameters >>parameters
+    pop-literal nip >>parameters
     pop-literal nip >>return
     ! Quotation which coerces parameters to required types
     dup param-prep-quot [ dip ] curry infer-quot-here
@@ -71,7 +68,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
     alien-callback-params new
     pop-literal nip >>quot
     pop-literal nip >>abi
-    pop-parameters >>parameters
+    pop-literal nip >>parameters
     pop-literal nip >>return
     gensym >>xt
     dup callback-bottom