fortran records

db4
Joe Groff 2009-02-05 18:51:50 -06:00
parent 4429c17f63
commit 7b1f16ae5e
3 changed files with 75 additions and 22 deletions

View File

@ -1,15 +1,11 @@
USING: alien.fortran alien.syntax tools.test ;
USING: accessors alien alien.c-types alien.fortran alien.structs
alien.syntax arrays assocs kernel namespaces sequences tools.test ;
IN: alien.fortran.tests
C-STRUCT: fortran_test_struct
{ "int" "foo" }
{ "float" "bar" }
{ "char[4]" "bas" } ;
! F-RECORD: fortran_test_record
! { "integer" "foo" }
! { "real" "bar" }
! { "character*4" "bar" }
F-RECORD: fortran_test_record
{ "integer" "foo" }
{ "real" "bar" }
{ "character*4" "bas" } ;
! fortran-name>symbol-name
@ -25,7 +21,7 @@ C-STRUCT: fortran_test_struct
[ "integer*4" fortran-type>c-type ] unit-test
[ "int" ]
[ "integer" fortran-type>c-type ] unit-test
[ "INTEGER" fortran-type>c-type ] unit-test
[ "longlong" ]
[ "iNteger*8" fortran-type>c-type ] unit-test
@ -84,9 +80,6 @@ C-STRUCT: fortran_test_struct
[ "(fortran-double-complex)" ]
[ "complex*16" fortran-type>c-type ] unit-test
[ "fortran_test_struct" ]
[ "fortran_test_struct" fortran-type>c-type ] unit-test
[ "fortran_test_record" ]
[ "fortran_test_record" fortran-type>c-type ] unit-test
@ -101,8 +94,8 @@ C-STRUCT: fortran_test_struct
[ "int*" { } ]
[ "integer(*)" fortran-arg-type>c-type ] unit-test
[ "fortran_test_struct*" { } ]
[ "fortran_test_struct" fortran-arg-type>c-type ] unit-test
[ "fortran_test_record*" { } ]
[ "fortran_test_record" fortran-arg-type>c-type ] unit-test
[ "char*" { "long" } ]
[ "character" fortran-arg-type>c-type ] unit-test
@ -139,3 +132,40 @@ C-STRUCT: fortran_test_struct
[ "void" { "fortran_test_record*" } ]
[ "fortran_test_record" fortran-ret-type>c-type ] unit-test
! fortran-sig>c-sig
[ "double" { "int*" "char*" "float*" "double*" "long" } ]
[ "real" { "integer" "character*17" "real" "real*8" } fortran-sig>c-sig ]
unit-test
[ "void" { "char*" "long" "char*" "char*" "int*" "long" "long" } ]
[ "character*18" { "character*17" "character" "integer" } fortran-sig>c-sig ]
unit-test
[ "void" { "(fortran-complex)*" "char*" "char*" "int*" "long" "long" } ]
[ "complex" { "character*17" "character" "integer" } fortran-sig>c-sig ]
unit-test
! fortran-record>c-struct
[ {
{ "double" "ex" }
{ "float" "wye" }
{ "int" "zee" }
{ "char[20]" "woo" }
} ] [
{
{ "DOUBLE PRECISION" "EX" }
{ "REAL" "WYE" }
{ "INTEGER" "ZEE" }
{ "CHARACTER(20)" "WOO" }
} fortran-record>c-struct
] unit-test
! F-RECORD:
[ 12 ] [ "fortran_test_record" heap-size ] unit-test
[ 0 ] [ "foo" "fortran_test_record" offset-of ] unit-test
[ 4 ] [ "bar" "fortran_test_record" offset-of ] unit-test
[ 8 ] [ "bas" "fortran_test_record" offset-of ] unit-test

View File

@ -1,5 +1,6 @@
USING: accessors alien alien.c-types alien.syntax arrays ascii
assocs combinators fry kernel macros math.parser sequences splitting ;
USING: accessors alien alien.c-types alien.structs alien.syntax
arrays ascii assocs combinators fry kernel lexer macros math.parser
namespaces parser sequences splitting vectors vocabs.parser ;
IN: alien.fortran
! XXX this currently only supports the gfortran/f2c abi.
@ -65,9 +66,12 @@ MACRO: size-case-type ( cases -- )
GENERIC: (fortran-type>c-type) ( type -- c-type )
M: f (fortran-type>c-type) ;
M: integer-type (fortran-type>c-type)
{
{ f [ "int" ] }
{ 1 [ "char" ] }
{ 2 [ "short" ] }
{ 4 [ "int" ] }
{ 8 [ "longlong" ] }
@ -140,6 +144,9 @@ GENERIC: (fortran-ret-type>c-type) ( type -- c-type )
M: fortran-type (fortran-ret-type>c-type) (fortran-type>c-type) ;
M: real-type (fortran-ret-type>c-type) drop "double" ;
: suffix! ( seq elt -- seq ) over push ; inline
: append! ( seq-a seq-b -- seq-a ) over push-all ; inline
PRIVATE>
: fortran-type>c-type ( fortran-type -- c-type )
@ -156,10 +163,21 @@ PRIVATE>
[ added-c-args ] [ (fortran-ret-type>c-type) c-type>pointer ] bi prefix
] if ;
: fortran-sig>c-sig ( fortran-return fortran-args -- c-return c-args ) ;
: fortran-arg-types>c-types ( fortran-types -- c-types )
[ length <vector> 1 <vector> ] keep
[ fortran-arg-type>c-type swapd [ suffix! ] [ append! ] 2bi* ] each
append >array ;
! : F-RECORD: ... ; parsing
! : F-ABI: ... ; parsing
: fortran-sig>c-sig ( fortran-return fortran-args -- c-return c-args )
[ fortran-ret-type>c-type ] [ fortran-arg-types>c-types ] bi* append ;
: fortran-record>c-struct ( record -- struct )
[ first2 [ fortran-type>c-type ] [ >lower ] bi* 2array ] map ;
: define-record ( name vocab fields -- )
[ >lower ] [ ] [ fortran-record>c-struct ] tri* define-struct ;
: F-RECORD: scan in get parse-definition define-record ; parsing
! : F-SUBROUTINE: ... ; parsing
! : F-FUNCTION: ... ; parsing

View File

@ -1,6 +1,6 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays generic hashtables kernel kernel.private
USING: accessors arrays assocs generic hashtables kernel kernel.private
math namespaces parser sequences strings words libc fry
alien.c-types alien.structs.fields cpu.architecture math.order ;
IN: alien.structs
@ -61,3 +61,8 @@ M: struct-type stack-size
[ expand-constants ] map
[ [ heap-size ] [ max ] map-reduce ] keep
compute-struct-align f (define-struct) ;
: offset-of ( field struct -- offset )
c-types get at fields>>
[ name>> = ] with find nip offset>> ;