From: Joe Groff <arcata@gmail.com>
Date: Sun, 21 Feb 2010 18:28:42 +0000 (-0800)
Subject: ditch string c-types
X-Git-Tag: 0.97~4876
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=62e97c138ab5a792ab027b154c0a82c7b9bc7241

ditch string c-types
---

diff --git a/basis/alien/c-types/c-types-docs.factor b/basis/alien/c-types/c-types-docs.factor
index b221051efc..215ca1b0ef 100644
--- a/basis/alien/c-types/c-types-docs.factor
+++ b/basis/alien/c-types/c-types-docs.factor
@@ -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 )" } } }
diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index e2f15f5de8..a929cba954 100644
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -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? [
diff --git a/basis/alien/complex/complex-tests.factor b/basis/alien/complex/complex-tests.factor
index 87f0c98b47..63d73ef029 100644
--- a/basis/alien/complex/complex-tests.factor
+++ b/basis/alien/complex/complex-tests.factor
@@ -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
diff --git a/basis/alien/complex/complex.factor b/basis/alien/complex/complex.factor
index 65c4095e25..fbf28071d0 100644
--- a/basis/alien/complex/complex.factor
+++ b/basis/alien/complex/complex.factor
@@ -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
 >>
diff --git a/basis/alien/complex/functor/functor.factor b/basis/alien/complex/functor/functor.factor
index cb46f2d67a..90fb5174c1 100644
--- a/basis/alien/complex/functor/functor.factor
+++ b/basis/alien/complex/functor/functor.factor
@@ -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 ;
diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor
index cb7e4ee2b0..44a2be5a70 100644
--- a/basis/classes/struct/struct-tests.factor
+++ b/basis/classes/struct/struct-tests.factor
@@ -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 }
diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor
index a5711de609..4e7a565a5a 100644
--- a/basis/classes/struct/struct.factor
+++ b/basis/classes/struct/struct.factor
@@ -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' )
diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor
index e2840b89dd..fe2a93844c 100644
--- a/basis/specialized-arrays/specialized-arrays.factor
+++ b/basis/specialized-arrays/specialized-arrays.factor
@@ -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) {