]> gitweb.factorcode.org Git - factor.git/commitdiff
ditch string c-types
authorJoe Groff <arcata@gmail.com>
Sun, 21 Feb 2010 18:28:42 +0000 (10:28 -0800)
committerJoe Groff <arcata@gmail.com>
Sun, 21 Feb 2010 18:58:21 +0000 (10:58 -0800)
basis/alien/c-types/c-types-docs.factor
basis/alien/c-types/c-types.factor
basis/alien/complex/complex-tests.factor
basis/alien/complex/complex.factor
basis/alien/complex/functor/functor.factor
basis/classes/struct/struct-tests.factor
basis/classes/struct/struct.factor
basis/specialized-arrays/specialized-arrays.factor

index b221051efc69d3bf0bdc27c793e0c7b3f367a559..215ca1b0ef45dd7c10cc28037cd04c55a1588270 100644 (file)
@@ -32,13 +32,10 @@ HELP: no-c-type
 { $description "Throws a " { $link no-c-type } " error." }
 { $error-description "Thrown by " { $link c-type } " if a given string does not name a C type. When thrown during compile time, indicates a typo in an " { $link alien-invoke } " or " { $link alien-callback } " form." } ;
 
-HELP: c-types
-{ $var-description "Global variable holding a hashtable mapping C type names to C types. Use the " { $link c-type } " word to look up C types." } ;
-
 HELP: c-type
 { $values { "name" "a C type" } { "c-type" c-type } }
 { $description "Looks up a C type by name." }
-{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
+{ $errors "Throws a " { $link no-c-type } " error if the type does not exist, or the word is not a C type." } ;
 
 HELP: c-getter
 { $values { "name" "a C type" } { "quot" { $quotation "( c-ptr n -- obj )" } } }
index e2f15f5de88b69c782b339e0e9545e6577297f9f..a929cba954244573159b87bc449c7daf2091617f 100644 (file)
@@ -43,12 +43,6 @@ stack-align? ;
 : <c-type> ( -- c-type )
     \ c-type new ; inline
 
-SYMBOL: c-types
-
-global [
-    c-types [ H{ } assoc-like ] change
-] bind
-
 ERROR: no-c-type name ;
 
 PREDICATE: c-type-word < word
@@ -70,14 +64,6 @@ M: word resolve-pointer-type
     dup "pointer-c-type" word-prop
     [ ] [ drop void* ] ?if ;
 
-M: string resolve-pointer-type
-    dup "*" append dup c-types get at
-    [ nip ] [
-        drop
-        c-types get at dup c-type-name?
-        [ resolve-pointer-type ] [ drop void* ] if
-    ] if ;
-
 M: array resolve-pointer-type
     first resolve-pointer-type ;
 
@@ -93,15 +79,6 @@ M: array resolve-pointer-type
 
 PRIVATE>
 
-M: string c-type ( name -- c-type )
-    CHAR: ] over member? [
-        parse-array-type prefix
-    ] [
-        dup c-types get at [ ] [
-            "*" ?tail [ resolve-pointer-type ] [ no-c-type ] if
-        ] ?if resolve-typedef
-    ] if ;
-
 M: word c-type
     dup "c-type" word-prop resolve-typedef
     [ ] [ no-c-type ] ?if ;
@@ -268,12 +245,9 @@ GENERIC: typedef ( old new -- )
 PREDICATE: typedef-word < c-type-word
     "c-type" word-prop c-type-name? ;
 
-M: string typedef ( old new -- ) c-types get set-at ;
-
 M: word typedef ( old new -- )
     {
         [ nip define-symbol ]
-        [ name>> typedef ]
         [ swap "c-type" set-word-prop ]
         [
             swap dup c-type-name? [
index 87f0c98b474336e1bb43b236ded6f29435703467..63d73ef0291907919233aa5376c664dce4b0b4b3 100644 (file)
@@ -16,6 +16,6 @@ STRUCT: complex-holder
 
 [ C{ 1.0 2.0 } ] [ "h" get z>> ] unit-test
 
-[ complex ] [ "complex-float" c-type-boxed-class ] unit-test
+[ complex ] [ complex-float c-type-boxed-class ] unit-test
 
-[ complex ] [ "complex-double" c-type-boxed-class ] unit-test
+[ complex ] [ complex-double c-type-boxed-class ] unit-test
index 65c4095e25f926a11fee3920899ef5468e7481f6..fbf28071d013744f6c074f18d2d524256205374b 100644 (file)
@@ -6,8 +6,10 @@ IN: alien.complex
 
 <<
 { "float" "double" } [ dup "complex-" prepend define-complex-type ] each
+>>
 
+<<
 ! This overrides the fact that small structures are never returned
 ! in registers on NetBSD, Linux and Solaris running on 32-bit x86.
-"complex-float" c-type t >>return-in-registers? drop
+\ complex-float c-type t >>return-in-registers? drop
 >>
index cb46f2d67a0c5a77da1ba5ef3eeb7609f5d97594..90fb5174c19a96dface9c2393cf8da173514c468 100644 (file)
@@ -7,6 +7,8 @@ IN: alien.complex.functor
 
 FUNCTOR: define-complex-type ( N T -- )
 
+N-type IS ${N}
+
 T-class DEFINES-CLASS ${T}
 
 <T> DEFINES <${T}>
@@ -14,7 +16,7 @@ T-class DEFINES-CLASS ${T}
 
 WHERE
 
-STRUCT: T-class { real N } { imaginary N } ;
+STRUCT: T-class { real N-type } { imaginary N-type } ;
 
 : <T> ( z -- alien )
     >rect T-class <struct-boa> >c-ptr ;
index cb7e4ee2b085b9f344856bcccf930e31602651cb..44a2be5a70eafe116686ce1847c03f88991b6db3 100644 (file)
@@ -361,13 +361,6 @@ TUPLE: a-subclass < will-become-struct ;
 
 [ tuple ] [ a-subclass superclass ] unit-test
 
-! Remove c-type when struct class is forgotten
-[ ] [
-    "USE: classes.struct IN: classes.struct.tests TUPLE: a-struct ;" eval( -- )
-] unit-test
-
-[ f ] [ "a-struct" c-types get key? ] unit-test
-
 STRUCT: bit-field-test
     { a uint bits: 12 }
     { b int bits: 2 }
index a5711de609f67e83235ab8e89058865260d7cd57..4e7a565a5aba4fa8b6fba621c93e046afbee426e 100644 (file)
@@ -296,9 +296,6 @@ PRIVATE>
 : define-union-struct-class ( class slots -- )
     [ compute-union-offsets ] (define-struct-class) ;
 
-M: struct-class reset-class
-    [ call-next-method ] [ name>> c-types get delete-at ] bi ;
-
 ERROR: invalid-struct-slot token ;
 
 : struct-slot-class ( c-type -- class' )
index e2840b89dd2ced0223a72dff05c75e6b4ed435fb..fe2a93844cf9ccf8f034fd8e78b7c2810bd160dc 100644 (file)
@@ -116,10 +116,7 @@ M: A v*high [ * \ T heap-size neg shift ] 2map ; inline
 
 ;FUNCTOR
 
-GENERIC: (underlying-type) ( c-type -- c-type' )
-
-M: string (underlying-type) c-types get at ;
-M: word (underlying-type) "c-type" word-prop ;
+: (underlying-type) ( word -- c-type ) "c-type" word-prop ; inline
 
 : underlying-type ( c-type -- c-type' )
     dup (underlying-type) {