alien.fortran: convert fortran types to word c-types

diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index 24221160ce85bfb78ebda04465b95646d70c07ef..4ff599e0d147cbc86a686ef446e6abeb996e593f 100644 (file)
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -78,6 +78,9 @@ M: string resolve-pointer-type
         [ resolve-pointer-type ] [ drop void* ] if
     ] if ;
 
+M: array resolve-pointer-type
+    first resolve-pointer-type ;
+
 : resolve-typedef ( name -- c-type )
     dup void? [ no-c-type ] when
     dup c-type-name? [ c-type ] when ;

diff --git a/basis/alien/fortran/fortran-tests.factor b/basis/alien/fortran/fortran-tests.factor
index 238207f192a7a8f9648c7030314b6efb88e9954a..a4099a9cc4ca24ce4d770ed72d44208c5ebf91f1 100644 (file)
--- a/basis/alien/fortran/fortran-tests.factor
+++ b/basis/alien/fortran/fortran-tests.factor
@@ -4,11 +4,12 @@ alien.data alien.fortran alien.fortran.private alien.strings
 classes.struct arrays assocs byte-arrays combinators fry
 generalizations io.encodings.ascii kernel macros
 macros.expander namespaces sequences shuffle tools.test ;
+QUALIFIED-WITH: alien.c-types c
 IN: alien.fortran.tests
 
 << intel-unix-abi "(alien.fortran-tests)" (add-fortran-library) >>
 LIBRARY: (alien.fortran-tests)
-STRUCT: FORTRAN_TEST_RECORD
+STRUCT: fortran_test_record
     { FOO int }
     { BAR double[2] }
     { BAS char[4] } ;
@@ -23,148 +24,148 @@ intel-unix-abi fortran-abi [
 
     ! fortran-type>c-type
 
-    [ "short" ]
+    [ c:short ]
     [ "integer*2" fortran-type>c-type ] unit-test
 
-    [ "int" ]
+    [ c:int ]
     [ "integer*4" fortran-type>c-type ] unit-test
 
-    [ "int" ]
+    [ c:int ]
     [ "INTEGER" fortran-type>c-type ] unit-test
 
-    [ "longlong" ]
+    [ c:longlong ]
     [ "iNteger*8" fortran-type>c-type ] unit-test
 
-    [ "int[0]" ]
+    [ { c:int 0 } ]
     [ "integer(*)" fortran-type>c-type ] unit-test
 
-    [ "int[0]" ]
+    [ { c:int 0 } ]
     [ "integer(3,*)" fortran-type>c-type ] unit-test
 
-    [ "int[3]" ]
+    [ { c:int 3 } ]
     [ "integer(3)" fortran-type>c-type ] unit-test
 
-    [ "int[6]" ]
+    [ { c:int 6 } ]
     [ "integer(3,2)" fortran-type>c-type ] unit-test
 
-    [ "int[24]" ]
+    [ { c:int 24 } ]
     [ "integer(4,3,2)" fortran-type>c-type ] unit-test
 
-    [ "char" ]
+    [ c:char ]
     [ "character" fortran-type>c-type ] unit-test
 
-    [ "char" ]
+    [ c:char ]
     [ "character*1" fortran-type>c-type ] unit-test
 
-    [ "char[17]" ]
+    [ { c:char 17 } ]
     [ "character*17" fortran-type>c-type ] unit-test
 
-    [ "char[17]" ]
+    [ { c:char 17 } ]
     [ "character(17)" fortran-type>c-type ] unit-test
 
-    [ "int" ]
+    [ c:int ]
     [ "logical" fortran-type>c-type ] unit-test
 
-    [ "float" ]
+    [ c:float ]
     [ "real" fortran-type>c-type ] unit-test
 
-    [ "double" ]
+    [ c:double ]
     [ "double-precision" fortran-type>c-type ] unit-test
 
-    [ "float" ]
+    [ c:float ]
     [ "real*4" fortran-type>c-type ] unit-test
 
-    [ "double" ]
+    [ c:double ]
     [ "real*8" fortran-type>c-type ] unit-test
 
-    [ "complex-float" ]
+    [ complex-float ]
     [ "complex" fortran-type>c-type ] unit-test
 
-    [ "complex-double" ]
+    [ complex-double ]
     [ "double-complex" fortran-type>c-type ] unit-test
 
-    [ "complex-float" ]
+    [ complex-float ]
     [ "complex*8" fortran-type>c-type ] unit-test
 
-    [ "complex-double" ]
+    [ complex-double ]
     [ "complex*16" fortran-type>c-type ] unit-test
 
-    [ "fortran_test_record" ]
+    [ fortran_test_record ]
     [ "fortran_test_record" fortran-type>c-type ] unit-test
 
     ! fortran-arg-type>c-type
 
-    [ "int*" { } ]
+    [ c:void* { } ]
     [ "integer" fortran-arg-type>c-type ] unit-test
 
-    [ "int*" { } ]
+    [ c:void* { } ]
     [ "integer(3)" fortran-arg-type>c-type ] unit-test
 
-    [ "int*" { } ]
+    [ c:void* { } ]
     [ "integer(*)" fortran-arg-type>c-type ] unit-test
 
-    [ "fortran_test_record*" { } ]
+    [ c:void* { } ]
     [ "fortran_test_record" fortran-arg-type>c-type ] unit-test
 
-    [ "char*" { } ]
+    [ c:char* { } ]
     [ "character" fortran-arg-type>c-type ] unit-test
 
-    [ "char*" { } ]
+    [ c:char* { } ]
     [ "character(1)" fortran-arg-type>c-type ] unit-test
 
-    [ "char*" { "long" } ]
+    [ c:char* { long } ]
     [ "character(17)" fortran-arg-type>c-type ] unit-test
 
     ! fortran-ret-type>c-type
 
-    [ "char" { } ]
+    [ c:char { } ]
     [ "character(1)" fortran-ret-type>c-type ] unit-test
 
-    [ "void" { "char*" "long" } ]
+    [ c:void { c:char* long } ]
     [ "character(17)" fortran-ret-type>c-type ] unit-test
 
-    [ "int" { } ]
+    [ c:int { } ]
     [ "integer" fortran-ret-type>c-type ] unit-test
 
-    [ "int" { } ]
+    [ c:int { } ]
     [ "logical" fortran-ret-type>c-type ] unit-test
 
-    [ "float" { } ]
+    [ c:float { } ]
     [ "real" fortran-ret-type>c-type ] unit-test
 
-    [ "void" { "float*" } ]
+    [ c:void { c:void* } ]
     [ "real(*)" fortran-ret-type>c-type ] unit-test
 
-    [ "double" { } ]
+    [ c:double { } ]
     [ "double-precision" fortran-ret-type>c-type ] unit-test
 
-    [ "void" { "complex-float*" } ]
+    [ c:void { c:void* } ]
     [ "complex" fortran-ret-type>c-type ] unit-test
 
-    [ "void" { "complex-double*" } ]
+    [ c:void { c:void* } ]
     [ "double-complex" fortran-ret-type>c-type ] unit-test
 
-    [ "void" { "int*" } ]
+    [ c:void { c:void* } ]
     [ "integer(*)" fortran-ret-type>c-type ] unit-test
 
-    [ "void" { "fortran_test_record*" } ]
+    [ c:void { c:void* } ]
     [ "fortran_test_record" fortran-ret-type>c-type ] unit-test
 
     ! fortran-sig>c-sig
 
-    [ "float" { "int*" "char*" "float*" "double*" "long" } ]
+    [ c:float { c:void* c:char* c:void* c:void* c:long } ]
     [ "real" { "integer" "character*17" "real" "real*8" } fortran-sig>c-sig ]
     unit-test
 
-    [ "char" { "char*" "char*" "int*" "long" } ]
+    [ c:char { c:char* c:char* c:void* c:long } ]
     [ "character(1)" { "character*17" "character" "integer" } fortran-sig>c-sig ]
     unit-test
 
-    [ "void" { "char*" "long" "char*" "char*" "int*" "long" } ]
+    [ c:void { c:char* c:long c:char* c:char* c:void* c:long } ]
     [ "character*18" { "character*17" "character" "integer" } fortran-sig>c-sig ]
     unit-test
 
-    [ "void" { "complex-float*" "char*" "char*" "int*" "long" } ]
+    [ c:void { c:void* c:char* c:char* c:void* c:long } ]
     [ "complex" { "character*17" "character" "integer" } fortran-sig>c-sig ]
     unit-test
 
@@ -184,8 +185,8 @@ intel-unix-abi fortran-abi [
         } 5 ncleave
         ! [fortran-invoke]
         [ 
-            "void" "funpack" "funtimes_"
-            { "char*" "longlong*" "float*" "complex-float*" "short*" "long" }
+            c:void "funpack" "funtimes_"
+            { c:char* c:void* c:void* c:void* c:void* c:long }
             alien-invoke
         ] 6 nkeep
         ! [fortran-results>]
@@ -210,7 +211,7 @@ intel-unix-abi fortran-abi [
             [ { [ drop ] } spread ]
         } 1 ncleave
         ! [fortran-invoke]
-        [ "float" "funpack" "fun_times_" { "float*" } alien-invoke ]
+        [ c:float "funpack" "fun_times_" { void* } alien-invoke ]
         1 nkeep
         ! [fortran-results>]
         shuffle( reta aa -- reta aa ) 
@@ -222,13 +223,13 @@ intel-unix-abi fortran-abi [
 
     [ [
         ! [<fortran-result>]
-        [ "complex-float" <c-object> ] 1 ndip
+        [ complex-float <c-object> ] 1 ndip
         ! [fortran-args>c-args]
         { [ { [ ] } spread ] [ { [ drop ] } spread ] } 1 ncleave
         ! [fortran-invoke]
         [
-            "void" "funpack" "fun_times_"
-            { "complex-float*" "float*" } 
+            c:void "funpack" "fun_times_"
+            { void* void* } 
             alien-invoke
         ] 2 nkeep
         ! [fortran-results>]
@@ -244,8 +245,8 @@ intel-unix-abi fortran-abi [
         [ 20 <byte-array> 20 ] 0 ndip
         ! [fortran-invoke]
         [
-            "void" "funpack" "fun_times_"
-            { "char*" "long" } 
+            c:void "funpack" "fun_times_"
+            { c:char* long } 
             alien-invoke
         ] 2 nkeep
         ! [fortran-results>]
@@ -270,8 +271,8 @@ intel-unix-abi fortran-abi [
         } 3 ncleave
         ! [fortran-invoke]
         [
-            "void" "funpack" "fun_times_"
-            { "char*" "long" "char*" "float*" "char*" "long" "long" } 
+            c:void "funpack" "fun_times_"
+            { c:char* long c:char* c:void* c:char* c:long c:long } 
             alien-invoke
         ] 7 nkeep
         ! [fortran-results>]
@@ -302,19 +303,19 @@ intel-windows-abi fortran-abi [
 
 f2c-abi fortran-abi [
 
-    [ "char[1]" ]
+    [ { c:char 1 } ]
     [ "character(1)" fortran-type>c-type ] unit-test
 
-    [ "char*" { "long" } ]
+    [ c:char* { c:long } ]
     [ "character" fortran-arg-type>c-type ] unit-test
 
-    [ "void" { "char*" "long" } ]
+    [ c:void { c:char* c:long } ]
     [ "character" fortran-ret-type>c-type ] unit-test
 
-    [ "double" { } ]
+    [ c:double { } ]
     [ "real" fortran-ret-type>c-type ] unit-test
 
-    [ "void" { "float*" } ]
+    [ c:void { void* } ]
     [ "real(*)" fortran-ret-type>c-type ] unit-test
 
     [ "fun_" ] [ "FUN" fortran-name>symbol-name ] unit-test
@@ -325,34 +326,34 @@ f2c-abi fortran-abi [
 
 gfortran-abi fortran-abi [
 
-    [ "float" { } ]
+    [ c:float { } ]
     [ "real" fortran-ret-type>c-type ] unit-test
 
-    [ "void" { "float*" } ]
+    [ c:void { void* } ]
     [ "real(*)" fortran-ret-type>c-type ] unit-test
 
-    [ "complex-float" { } ]
+    [ complex-float { } ]
     [ "complex" fortran-ret-type>c-type ] unit-test
 
-    [ "complex-double" { } ]
+    [ complex-double { } ]
     [ "double-complex" fortran-ret-type>c-type ] unit-test
 
-    [ "char[1]" ]
+    [ { char 1 } ]
     [ "character(1)" fortran-type>c-type ] unit-test
 
-    [ "char*" { "long" } ]
+    [ c:char* { c:long } ]
     [ "character" fortran-arg-type>c-type ] unit-test
 
-    [ "void" { "char*" "long" } ]
+    [ c:void { c:char* c:long } ]
     [ "character" fortran-ret-type>c-type ] unit-test
 
-    [ "complex-float" { } ]
+    [ complex-float { } ]
     [ "complex" fortran-ret-type>c-type ] unit-test
 
-    [ "complex-double" { } ]
+    [ complex-double { } ]
     [ "double-complex" fortran-ret-type>c-type ] unit-test
 
-    [ "void" { "complex-double*" } ]
+    [ c:void { c:void* } ]
     [ "double-complex(3)" fortran-ret-type>c-type ] unit-test
 
 ] with-variable

diff --git a/basis/alien/fortran/fortran.factor b/basis/alien/fortran/fortran.factor
index d7659d8400f90e110a691dd98ebcfbb3bccb865e..65e927f85a50d00de4e3cc1602b276ec664db11e 100644 (file)
--- a/basis/alien/fortran/fortran.factor
+++ b/basis/alien/fortran/fortran.factor
@@ -1,11 +1,12 @@
 ! (c) 2009 Joe Groff, see BSD license
-USING: accessors alien alien.c-types alien.complex alien.data grouping
-alien.strings alien.syntax arrays ascii assocs
+USING: accessors alien alien.c-types alien.complex alien.data alien.parser
+grouping alien.strings alien.syntax arrays ascii assocs
 byte-arrays combinators combinators.short-circuit fry generalizations
 kernel lexer macros math math.parser namespaces parser sequences
 splitting stack-checker vectors vocabs.parser words locals
 io.encodings.ascii io.encodings.string shuffle effects math.ranges
 math.order sorting strings system alien.libraries ;
+QUALIFIED-WITH: alien.c-types c
 IN: alien.fortran
 
 SINGLETONS: f2c-abi g95-abi gfortran-abi intel-unix-abi intel-windows-abi ;
@@ -101,8 +102,7 @@ CONSTANT: fortran>c-types H{
 }
 
 : append-dimensions ( base-c-type type -- c-type )
-    dims>>
-    [ product number>string "[" "]" surround append ] when* ;
+    dims>> [ product 2array ] when* ;
 
 MACRO: size-case-type ( cases -- )
     [ invalid-fortran-type ] suffix
@@ -118,35 +118,35 @@ MACRO: size-case-type ( cases -- )
 
 GENERIC: (fortran-type>c-type) ( type -- c-type )
 
-M: f (fortran-type>c-type) drop "void" ;
+M: f (fortran-type>c-type) drop c:void ;
 
 M: integer-type (fortran-type>c-type)
     {
-        { f [ "int"      ] }
-        { 1 [ "char"     ] }
-        { 2 [ "short"    ] }
-        { 4 [ "int"      ] }
-        { 8 [ "longlong" ] }
+        { f [ c:int      ] }
+        { 1 [ c:char     ] }
+        { 2 [ c:short    ] }
+        { 4 [ c:int      ] }
+        { 8 [ c:longlong ] }
     } size-case-type ;
 M: real-type (fortran-type>c-type)
     {
-        { f [ "float"  ] }
-        { 4 [ "float"  ] }
-        { 8 [ "double" ] }
+        { f [ c:float  ] }
+        { 4 [ c:float  ] }
+        { 8 [ c:double ] }
     } size-case-type ;
 M: real-complex-type (fortran-type>c-type)
     {
-        {  f [ "complex-float"  ] }
-        {  8 [ "complex-float"  ] }
-        { 16 [ "complex-double" ] }
+        {  f [ complex-float  ] }
+        {  8 [ complex-float  ] }
+        { 16 [ complex-double ] }
     } size-case-type ;
 
 M: double-precision-type (fortran-type>c-type)
-    "double" simple-type ;
+    c:double simple-type ;
 M: double-complex-type (fortran-type>c-type)
-    "complex-double" simple-type ;
+    complex-double simple-type ;
 M: misc-type (fortran-type>c-type)
-    dup name>> simple-type ;
+    dup name>> parse-c-type simple-type ;
 
 : single-char? ( character-type -- ? )
     { [ drop character(1)-maps-to-char? ] [ dims>> product 1 = ] } 1&& ;
@@ -158,7 +158,7 @@ M: misc-type (fortran-type>c-type)
     dup single-char? [ f >>dims ] when ;
 
 M: character-type (fortran-type>c-type)
-    fix-character-type "char" simple-type ;
+    fix-character-type c:char simple-type ;
 
 : dimension>number ( string -- number )
     dup "*" = [ drop 0 ] [ string>number ] if ;
@@ -181,13 +181,10 @@ M: character-type (fortran-type>c-type)
 : parse-fortran-type ( fortran-type-string/f -- type/f )
     dup [ (parse-fortran-type) ] when ;
 
-: c-type>pointer ( c-type -- c-type* )
-    "[" split1 drop "*" append ;
-
 GENERIC: added-c-args ( type -- args )
 
 M: fortran-type added-c-args drop { } ;
-M: character-type added-c-args fix-character-type single-char? [ { } ] [ { "long" } ] if ;
+M: character-type added-c-args fix-character-type single-char? [ { } ] [ { c:long } ] if ;
 
 GENERIC: returns-by-value? ( type -- ? )
 
@@ -200,10 +197,10 @@ M: complex-type returns-by-value?
 
 GENERIC: (fortran-ret-type>c-type) ( type -- c-type )
 
-M: f (fortran-ret-type>c-type) drop "void" ;
+M: f (fortran-ret-type>c-type) drop c:void ;
 M: fortran-type (fortran-ret-type>c-type) (fortran-type>c-type) ;
 M: real-type (fortran-ret-type>c-type)
-    drop real-functions-return-double? [ "double" ] [ "float" ] if ;
+    drop real-functions-return-double? [ c:double ] [ c:float ] if ;
 
 GENERIC: (fortran-arg>c-args) ( type -- main-quot added-quot )
 
@@ -354,7 +351,7 @@ M: character-type (<fortran-result>)
 
 : (shuffle-map) ( return parameters -- ret par )
     [
-        fortran-ret-type>c-type length swap "void" = [ 1 + ] unless
+        fortran-ret-type>c-type length swap void? [ 1 + ] unless
         letters swap head [ "ret" swap suffix ] map
     ] [
         [ fortran-arg-type>c-type nip length 1 + ] map letters swap zip
@@ -395,13 +392,13 @@ PRIVATE>
 
 : fortran-arg-type>c-type ( fortran-type -- c-type added-args )
     parse-fortran-type
-    [ (fortran-type>c-type) c-type>pointer ]
+    [ (fortran-type>c-type) resolve-pointer-type ]
     [ added-c-args ] bi ;
 : fortran-ret-type>c-type ( fortran-type -- c-type added-args )
     parse-fortran-type dup returns-by-value?
     [ (fortran-ret-type>c-type) { } ] [
-        "void" swap 
-        [ added-c-args ] [ (fortran-type>c-type) c-type>pointer ] bi prefix
+        c:void swap 
+        [ added-c-args ] [ (fortran-type>c-type) resolve-pointer-type ] bi prefix
     ] if ;
 
 : fortran-arg-types>c-types ( fortran-types -- c-types )
@@ -433,7 +430,7 @@ MACRO: fortran-invoke ( return library function parameters -- )
 
 :: define-fortran-function ( return library function parameters -- )
     function create-in dup reset-generic 
-    return library function parameters return [ "void" ] unless* parse-arglist
+    return library function parameters return [ c:void ] unless* parse-arglist
     [ \ fortran-invoke 5 [ ] nsequence ] dip define-declared ;
 
 SYNTAX: SUBROUTINE: