alien.fortran: convert fortran types to word c-types
Joe Groff
parent
df744bf633
commit
9adfda095f
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
Loading…
Reference in New Issue