use reject instead of [ ... not ] filter.

[factor.git] / extra / alien / fortran / fortran.factor

diff --git a/extra/alien/fortran/fortran.factor b/extra/alien/fortran/fortran.factor
index 75178f931b936eb481a6f7bbb242df142ccfa423..0dc7b79fc2e12ec2038108ea9bf2778d60dc1663 100755 (executable)
--- a/extra/alien/fortran/fortran.factor
+++ b/extra/alien/fortran/fortran.factor
@@ -12,13 +12,8 @@ IN: alien.fortran
 
 SINGLETONS: f2c-abi g95-abi gfortran-abi intel-unix-abi intel-windows-abi ;
 
-<< 
-: add-f2c-libraries ( -- )
-    "I77" "libI77.so" cdecl add-library
-    "F77" "libF77.so" cdecl add-library ;
-
-! os netbsd? [ add-f2c-libraries ] when
->>
+TUPLE: bad-fortran-abi detail ;
+C: <bad-fortran-abi> bad-fortran-abi
 
 : alien>nstring ( alien len encoding -- string )
     [ memory>byte-array ] dip decode ;
@@ -43,6 +38,7 @@ library-fortran-abis [ H{ } clone ] initialize
     [ "__" append ] [ "_" append ] if ;
 
 HOOK: fortran-c-abi fortran-abi ( -- abi )
+M: bad-fortran-abi fortran-c-abi cdecl ;
 M: f2c-abi fortran-c-abi cdecl ;
 M: g95-abi fortran-c-abi cdecl ;
 M: gfortran-abi fortran-c-abi cdecl ;
@@ -415,7 +411,7 @@ PRIVATE>
 : set-fortran-abi ( library -- )
     library-fortran-abis get-global at fortran-abi set ;
 
-: (fortran-invoke) ( return library function parameters -- quot )
+: ((fortran-invoke)) ( return library function parameters -- quot )
     {
         [ 2nip [<fortran-result>] ]
         [ nip nip nip [fortran-args>c-args] ]
@@ -423,6 +419,11 @@ PRIVATE>
         [ 2nip [fortran-results>] ]
     } 4 ncleave 4 nappend ;
 
+:: (fortran-invoke) ( return library function parameters -- quot )
+    library library-fortran-abis get-global at dup bad-fortran-abi?
+    [ '[ _ throw ] ]
+    [ drop return library function parameters ((fortran-invoke)) ] if ;
+
 MACRO: fortran-invoke ( return library function parameters -- )
     { [ 2drop nip set-fortran-abi ] [ (fortran-invoke) ] } 4 ncleave ;
 
@@ -441,11 +442,11 @@ MACRO: fortran-invoke ( return library function parameters -- )
 
 SYNTAX: SUBROUTINE: 
     f current-library get scan-token ";" parse-tokens
-    [ "()" subseq? not ] filter define-fortran-function ;
+    [ "()" subseq? ] reject define-fortran-function ;
 
 SYNTAX: FUNCTION:
     scan-token current-library get scan-token ";" parse-tokens
-    [ "()" subseq? not ] filter define-fortran-function ;
+    [ "()" subseq? ] reject define-fortran-function ;
 
 SYNTAX: LIBRARY:
     scan-token