Merge branches 'master' and 'master' of joe@factorcode.org:/git/factor into c-type...

diff --git a/basis/alien/arrays/arrays.factor b/basis/alien/arrays/arrays.factor
index a69f7609b1847ad54f89ae83148d63ed7d11be7c..52c6afa4dfdd60ae1bf478f1e7b462b210373033 100755 (executable)
--- a/basis/alien/arrays/arrays.factor
+++ b/basis/alien/arrays/arrays.factor
@@ -22,15 +22,15 @@ M: array c-type-align first c-type-align ;
 
 M: array c-type-stack-align? drop f ;
 
-M: array unbox-parameter drop "void*" unbox-parameter ;
+M: array unbox-parameter drop void* unbox-parameter ;
 
-M: array unbox-return drop "void*" unbox-return ;
+M: array unbox-return drop void* unbox-return ;
 
-M: array box-parameter drop "void*" box-parameter ;
+M: array box-parameter drop void* box-parameter ;
 
-M: array box-return drop "void*" box-return ;
+M: array box-return drop void* box-return ;
 
-M: array stack-size drop "void*" stack-size ;
+M: array stack-size drop void* stack-size ;
 
 M: array c-type-boxer-quot
     unclip
@@ -41,7 +41,7 @@ M: array c-type-boxer-quot
 M: array c-type-unboxer-quot drop [ >c-ptr ] ;
 
 PREDICATE: string-type < pair
-    first2 [ "char*" = ] [ word? ] bi* and ;
+    first2 [ char* = ] [ word? ] bi* and ;
 
 M: string-type c-type ;
 
@@ -50,37 +50,37 @@ M: string-type c-type-class drop object ;
 M: string-type c-type-boxed-class drop object ;
 
 M: string-type heap-size
-    drop "void*" heap-size ;
+    drop void* heap-size ;
 
 M: string-type c-type-align
-    drop "void*" c-type-align ;
+    drop void* c-type-align ;
 
 M: string-type c-type-stack-align?
-    drop "void*" c-type-stack-align? ;
+    drop void* c-type-stack-align? ;
 
 M: string-type unbox-parameter
-    drop "void*" unbox-parameter ;
+    drop void* unbox-parameter ;
 
 M: string-type unbox-return
-    drop "void*" unbox-return ;
+    drop void* unbox-return ;
 
 M: string-type box-parameter
-    drop "void*" box-parameter ;
+    drop void* box-parameter ;
 
 M: string-type box-return
-    drop "void*" box-return ;
+    drop void* box-return ;
 
 M: string-type stack-size
-    drop "void*" stack-size ;
+    drop void* stack-size ;
 
 M: string-type c-type-rep
     drop int-rep ;
 
 M: string-type c-type-boxer
-    drop "void*" c-type-boxer ;
+    drop void* c-type-boxer ;
 
 M: string-type c-type-unboxer
-    drop "void*" c-type-unboxer ;
+    drop void* c-type-unboxer ;
 
 M: string-type c-type-boxer-quot
     second '[ _ alien>string ] ;
@@ -94,6 +94,8 @@ M: string-type c-type-getter
 M: string-type c-type-setter
     drop [ set-alien-cell ] ;
 
-{ "char*" utf8 } "char*" typedef
-"char*" "uchar*" typedef
+{ char* utf8 } char* typedef
+char* uchar* typedef
 
+char  char*  "pointer-c-type" set-word-prop
+uchar uchar* "pointer-c-type" set-word-prop

diff --git a/basis/alien/c-types/c-types-tests.factor b/basis/alien/c-types/c-types-tests.factor
index bfeff5f1de2bc0186006b5621a39f44de4c5136b..792e7d416acf1aa86f1c5762a7e7142dcb429f4c 100644 (file)
--- a/basis/alien/c-types/c-types-tests.factor
+++ b/basis/alien/c-types/c-types-tests.factor
@@ -43,7 +43,7 @@ TYPEDEF: int* MyIntArray
 
 TYPEDEF: uchar* MyLPBYTE
 
-[ t ] [ { "char*" utf8 } c-type "MyLPBYTE" c-type = ] unit-test
+[ t ] [ { char* utf8 } c-type "MyLPBYTE" c-type = ] unit-test
 
 [
     0 B{ 1 2 3 4 } <displaced-alien> <void*>

diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index 35a9627d503b63c9474c6dbd7a12a86a2a20be50..6d63987265f3fcddc91fd4a22571b6c4e8e043b5 100755 (executable)
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -5,9 +5,20 @@ namespaces make parser sequences strings words splitting math.parser
 cpu.architecture alien alien.accessors alien.strings quotations
 layouts system compiler.units io io.files io.encodings.binary
 io.streams.memory accessors combinators effects continuations fry
-classes vocabs vocabs.loader ;
+classes vocabs vocabs.loader words.symbol ;
+QUALIFIED: math
 IN: alien.c-types
 
+SYMBOLS:
+    char uchar
+    short ushort
+    int uint
+    long ulong
+    longlong ulonglong
+    float double
+    void* bool
+    void ;
+
 DEFER: <int>
 DEFER: *char
 
@@ -40,50 +51,62 @@ global [
 
 ERROR: no-c-type name ;
 
-: (c-type) ( name -- type/f )
-    c-types get-global at dup [
-        dup string? [ (c-type) ] when
-    ] when ;
+PREDICATE: c-type-word < word
+    "c-type" word-prop ;
+
+UNION: c-type-name string c-type-word ;
 
 ! C type protocol
 GENERIC: c-type ( name -- type ) foldable
 
-: resolve-pointer-type ( name -- name )
-    c-types get at dup string?
-    [ "*" append ] [ drop "void*" ] if
-    c-type ;
+GENERIC: resolve-pointer-type ( name -- c-type )
+
+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 ;
 
 : resolve-typedef ( name -- type )
-    dup string? [ c-type ] when ;
+    dup c-type-name? [ c-type ] when ;
 
-: parse-array-type ( name -- array )
+: parse-array-type ( name -- dims type )
     "[" split unclip
-    [ [ "]" ?tail drop string>number ] map ] dip prefix ;
+    [ [ "]" ?tail drop string>number ] map ] dip ;
 
 M: string c-type ( name -- type )
     CHAR: ] over member? [
-        parse-array-type
+        parse-array-type prefix
     ] [
-        dup c-types get at [
-            resolve-typedef
-        ] [
+        dup c-types get at [ ] [
             "*" ?tail [ resolve-pointer-type ] [ no-c-type ] if
-        ] ?if
+        ] ?if resolve-typedef
     ] if ;
 
+M: word c-type
+    "c-type" word-prop resolve-typedef ;
+
+: void? ( c-type -- ? )
+    { void "void" } member? ;
+
 GENERIC: c-struct? ( type -- ? )
 
 M: object c-struct?
     drop f ;
-M: string c-struct?
-    dup "void" = [ drop f ] [ c-type c-struct? ] if ;
+M: c-type-name c-struct?
+    dup void? [ drop f ] [ c-type c-struct? ] if ;
 
 ! These words being foldable means that words need to be
 ! recompiled if a C type is redefined. Even so, folding the
 ! size facilitates some optimizations.
 GENERIC: heap-size ( type -- size ) foldable
 
-M: string heap-size c-type heap-size ;
+M: c-type-name heap-size c-type heap-size ;
 
 M: abstract-c-type heap-size size>> ;
 
@@ -99,17 +122,17 @@ GENERIC: c-direct-array-constructor ( c-type -- word )
 
 GENERIC: <c-array> ( len c-type -- array )
 
-M: string <c-array>
+M: c-type-name <c-array>
     c-array-constructor execute( len -- array ) ; inline
 
 GENERIC: (c-array) ( len c-type -- array )
 
-M: string (c-array)
+M: c-type-name (c-array)
     c-(array)-constructor execute( len -- array ) ; inline
 
 GENERIC: <c-direct-array> ( alien len c-type -- array )
 
-M: string <c-direct-array>
+M: c-type-name <c-direct-array>
     c-direct-array-constructor execute( alien len -- array ) ; inline
 
 : malloc-array ( n type -- alien )
@@ -122,67 +145,67 @@ GENERIC: c-type-class ( name -- class )
 
 M: abstract-c-type c-type-class class>> ;
 
-M: string c-type-class c-type c-type-class ;
+M: c-type-name c-type-class c-type c-type-class ;
 
 GENERIC: c-type-boxed-class ( name -- class )
 
 M: abstract-c-type c-type-boxed-class boxed-class>> ;
 
-M: string c-type-boxed-class c-type c-type-boxed-class ;
+M: c-type-name c-type-boxed-class c-type c-type-boxed-class ;
 
 GENERIC: c-type-boxer ( name -- boxer )
 
 M: c-type c-type-boxer boxer>> ;
 
-M: string c-type-boxer c-type c-type-boxer ;
+M: c-type-name c-type-boxer c-type c-type-boxer ;
 
 GENERIC: c-type-boxer-quot ( name -- quot )
 
 M: abstract-c-type c-type-boxer-quot boxer-quot>> ;
 
-M: string c-type-boxer-quot c-type c-type-boxer-quot ;
+M: c-type-name c-type-boxer-quot c-type c-type-boxer-quot ;
 
 GENERIC: c-type-unboxer ( name -- boxer )
 
 M: c-type c-type-unboxer unboxer>> ;
 
-M: string c-type-unboxer c-type c-type-unboxer ;
+M: c-type-name c-type-unboxer c-type c-type-unboxer ;
 
 GENERIC: c-type-unboxer-quot ( name -- quot )
 
 M: abstract-c-type c-type-unboxer-quot unboxer-quot>> ;
 
-M: string c-type-unboxer-quot c-type c-type-unboxer-quot ;
+M: c-type-name c-type-unboxer-quot c-type c-type-unboxer-quot ;
 
 GENERIC: c-type-rep ( name -- rep )
 
 M: c-type c-type-rep rep>> ;
 
-M: string c-type-rep c-type c-type-rep ;
+M: c-type-name c-type-rep c-type c-type-rep ;
 
 GENERIC: c-type-getter ( name -- quot )
 
 M: c-type c-type-getter getter>> ;
 
-M: string c-type-getter c-type c-type-getter ;
+M: c-type-name c-type-getter c-type c-type-getter ;
 
 GENERIC: c-type-setter ( name -- quot )
 
 M: c-type c-type-setter setter>> ;
 
-M: string c-type-setter c-type c-type-setter ;
+M: c-type-name c-type-setter c-type c-type-setter ;
 
 GENERIC: c-type-align ( name -- n )
 
 M: abstract-c-type c-type-align align>> ;
 
-M: string c-type-align c-type c-type-align ;
+M: c-type-name c-type-align c-type c-type-align ;
 
 GENERIC: c-type-stack-align? ( name -- ? )
 
 M: c-type c-type-stack-align? stack-align?>> ;
 
-M: string c-type-stack-align? c-type c-type-stack-align? ;
+M: c-type-name c-type-stack-align? c-type c-type-stack-align? ;
 
 : c-type-box ( n type -- )
     [ c-type-rep ] [ c-type-boxer [ "No boxer" throw ] unless* ] bi
@@ -196,29 +219,29 @@ GENERIC: box-parameter ( n ctype -- )
 
 M: c-type box-parameter c-type-box ;
 
-M: string box-parameter c-type box-parameter ;
+M: c-type-name box-parameter c-type box-parameter ;
 
 GENERIC: box-return ( ctype -- )
 
 M: c-type box-return f swap c-type-box ;
 
-M: string box-return c-type box-return ;
+M: c-type-name box-return c-type box-return ;
 
 GENERIC: unbox-parameter ( n ctype -- )
 
 M: c-type unbox-parameter c-type-unbox ;
 
-M: string unbox-parameter c-type unbox-parameter ;
+M: c-type-name unbox-parameter c-type unbox-parameter ;
 
 GENERIC: unbox-return ( ctype -- )
 
 M: c-type unbox-return f swap c-type-unbox ;
 
-M: string unbox-return c-type unbox-return ;
+M: c-type-name unbox-return c-type unbox-return ;
 
 GENERIC: stack-size ( type -- size ) foldable
 
-M: string stack-size c-type stack-size ;
+M: c-type-name stack-size c-type stack-size ;
 
 M: c-type stack-size size>> cell align ;
 
@@ -287,7 +310,24 @@ M: memory-stream stream-read
         \ swap , [ heap-size , [ * >fixnum ] % ] [ % ] bi*
     ] [ ] make ;
 
-: typedef ( old new -- ) c-types get set-at ;
+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? [
+                resolve-pointer-type
+                "pointer-c-type" set-word-prop
+            ] [ 2drop ] if
+        ]
+    } 2cleave ;
 
 TUPLE: long-long-type < c-type ;
 
@@ -321,27 +361,31 @@ M: long-long-type box-return ( type -- )
 
 : define-primitive-type ( type name -- )
     [ typedef ]
-    [ define-deref ]
-    [ define-out ]
+    [ name>> define-deref ]
+    [ name>> define-out ]
     tri ;
 
 : malloc-file-contents ( path -- alien len )
     binary file-contents [ malloc-byte-array ] [ length ] bi ;
 
 : if-void ( type true false -- )
-    pick "void" = [ drop nip call ] [ nip call ] if ; inline
+    pick void? [ drop nip call ] [ nip call ] if ; inline
 
 CONSTANT: primitive-types
     {
-        "char" "uchar"
-        "short" "ushort"
-        "int" "uint"
-        "long" "ulong"
-        "longlong" "ulonglong"
-        "float" "double"
-        "void*" "bool"
+        char uchar
+        short ushort
+        int uint
+        long ulong
+        longlong ulonglong
+        float double
+        void* bool
     }
 
+SYMBOLS:
+    ptrdiff_t intptr_t size_t
+    char* uchar* ;
+
 [
     <c-type>
         c-ptr >>class
@@ -353,7 +397,7 @@ CONSTANT: primitive-types
         [ >c-ptr ] >>unboxer-quot
         "box_alien" >>boxer
         "alien_offset" >>unboxer
-    "void*" define-primitive-type
+    \ void* define-primitive-type
 
     <long-long-type>
         integer >>class
@@ -364,7 +408,7 @@ CONSTANT: primitive-types
         8 >>align
         "box_signed_8" >>boxer
         "to_signed_8" >>unboxer
-    "longlong" define-primitive-type
+    \ longlong define-primitive-type
 
     <long-long-type>
         integer >>class
@@ -375,7 +419,7 @@ CONSTANT: primitive-types
         8 >>align
         "box_unsigned_8" >>boxer
         "to_unsigned_8" >>unboxer
-    "ulonglong" define-primitive-type
+    \ ulonglong define-primitive-type
 
     <c-type>
         integer >>class
@@ -386,7 +430,7 @@ CONSTANT: primitive-types
         bootstrap-cell >>align
         "box_signed_cell" >>boxer
         "to_fixnum" >>unboxer
-    "long" define-primitive-type
+    \ long define-primitive-type
 
     <c-type>
         integer >>class
@@ -397,7 +441,7 @@ CONSTANT: primitive-types
         bootstrap-cell >>align
         "box_unsigned_cell" >>boxer
         "to_cell" >>unboxer
-    "ulong" define-primitive-type
+    \ ulong define-primitive-type
 
     <c-type>
         integer >>class
@@ -408,7 +452,7 @@ CONSTANT: primitive-types
         4 >>align
         "box_signed_4" >>boxer
         "to_fixnum" >>unboxer
-    "int" define-primitive-type
+    \ int define-primitive-type
 
     <c-type>
         integer >>class
@@ -419,7 +463,7 @@ CONSTANT: primitive-types
         4 >>align
         "box_unsigned_4" >>boxer
         "to_cell" >>unboxer
-    "uint" define-primitive-type
+    \ uint define-primitive-type
 
     <c-type>
         fixnum >>class
@@ -430,7 +474,7 @@ CONSTANT: primitive-types
         2 >>align
         "box_signed_2" >>boxer
         "to_fixnum" >>unboxer
-    "short" define-primitive-type
+    \ short define-primitive-type
 
     <c-type>
         fixnum >>class
@@ -441,7 +485,7 @@ CONSTANT: primitive-types
         2 >>align
         "box_unsigned_2" >>boxer
         "to_cell" >>unboxer
-    "ushort" define-primitive-type
+    \ ushort define-primitive-type
 
     <c-type>
         fixnum >>class
@@ -452,7 +496,7 @@ CONSTANT: primitive-types
         1 >>align
         "box_signed_1" >>boxer
         "to_fixnum" >>unboxer
-    "char" define-primitive-type
+    \ char define-primitive-type
 
     <c-type>
         fixnum >>class
@@ -463,7 +507,7 @@ CONSTANT: primitive-types
         1 >>align
         "box_unsigned_1" >>boxer
         "to_cell" >>unboxer
-    "uchar" define-primitive-type
+    \ uchar define-primitive-type
 
     <c-type>
         [ alien-unsigned-1 c-bool> ] >>getter
@@ -472,11 +516,11 @@ CONSTANT: primitive-types
         1 >>align
         "box_boolean" >>boxer
         "to_boolean" >>unboxer
-    "bool" define-primitive-type
+    \ bool define-primitive-type
 
     <c-type>
-        float >>class
-        float >>boxed-class
+        math:float >>class
+        math:float >>boxed-class
         [ alien-float ] >>getter
         [ [ >float ] 2dip set-alien-float ] >>setter
         4 >>size
@@ -485,11 +529,11 @@ CONSTANT: primitive-types
         "to_float" >>unboxer
         float-rep >>rep
         [ >float ] >>unboxer-quot
-    "float" define-primitive-type
+    \ float define-primitive-type
 
     <c-type>
-        float >>class
-        float >>boxed-class
+        math:float >>class
+        math:float >>boxed-class
         [ alien-double ] >>getter
         [ [ >float ] 2dip set-alien-double ] >>setter
         8 >>size
@@ -498,10 +542,10 @@ CONSTANT: primitive-types
         "to_double" >>unboxer
         double-rep >>rep
         [ >float ] >>unboxer-quot
-    "double" define-primitive-type
+    \ double define-primitive-type
 
-    "long" "ptrdiff_t" typedef
-    "long" "intptr_t" typedef
-    "ulong" "size_t" typedef
+    \ long \ ptrdiff_t typedef
+    \ long \ intptr_t typedef
+    \ ulong \ size_t typedef
 ] with-compilation-unit
 

diff --git a/basis/alien/fortran/fortran.factor b/basis/alien/fortran/fortran.factor
index 52d69fd193871d323b289ba266bb28edc7d6d272..3670a376e125095edc04a601654d0bf41c669fda 100644 (file)
--- a/basis/alien/fortran/fortran.factor
+++ b/basis/alien/fortran/fortran.factor
@@ -1,5 +1,5 @@
 ! (c) 2009 Joe Groff, see BSD license
-USING: accessors alien alien.c-types alien.complex alien.parser
+USING: accessors alien alien.c-types alien.complex 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
@@ -429,6 +429,11 @@ PRIVATE>
 MACRO: fortran-invoke ( return library function parameters -- )
     { [ 2drop nip set-fortran-abi ] [ (fortran-invoke) ] } 4 ncleave ;
 
+: parse-arglist ( parameters return -- types effect )
+    [ 2 group unzip [ "," ?tail drop ] map ]
+    [ [ { } ] [ 1array ] if-void ]
+    bi* <effect> ;
+
 :: define-fortran-function ( return library function parameters -- )
     function create-in dup reset-generic 
     return library function parameters return [ "void" ] unless* parse-arglist

diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor
index 19ab08c03ca801930f0be6b6f968e855f599dfc7..9a24f7cd4d0ac9359cc49c192196e8f13c6b9e93 100644 (file)
--- a/basis/alien/parser/parser.factor
+++ b/basis/alien/parser/parser.factor
@@ -1,16 +1,42 @@
 ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types arrays assocs effects grouping kernel
-parser sequences splitting words fry locals lexer namespaces
-summary math ;
+USING: accessors alien alien.c-types arrays assocs
+combinators combinators.short-circuit effects grouping
+kernel parser sequences splitting words fry locals lexer
+namespaces summary math vocabs.parser ;
 IN: alien.parser
 
+: parse-c-type-name ( name -- word/string )
+    [ search ] keep or ;
+
+: parse-c-type ( string -- array )
+    {
+        { [ dup "void" =            ] [ drop void ] }
+        { [ CHAR: ] over member?    ] [ parse-array-type parse-c-type-name prefix ] }
+        { [ dup search c-type-word? ] [ parse-c-type-name ] }
+        { [ dup c-types get at      ] [ ] }
+        { [ "*" ?tail               ] [ parse-c-type-name resolve-pointer-type ] }
+        [ no-c-type ]
+    } cond ;
+
+: scan-c-type ( -- c-type )
+    scan dup "{" =
+    [ drop \ } parse-until >array ]
+    [ parse-c-type ] if ; 
+
+: reset-c-type ( word -- )
+    { "c-type" "pointer-c-type" } reset-props ;
+
+: CREATE-C-TYPE ( -- word )
+    scan current-vocab create dup reset-c-type ;
+
 : normalize-c-arg ( type name -- type' name' )
     [ length ]
     [
         [ CHAR: * = ] trim-head
         [ length - CHAR: * <array> append ] keep
-    ] bi ;
+    ] bi
+    [ parse-c-type ] dip ;
 
 : parse-arglist ( parameters return -- types effect )
     [
@@ -36,3 +62,9 @@ IN: alien.parser
 
 : define-function ( return library function parameters -- )
     make-function define-declared ;
+
+PREDICATE: alien-function-word < word
+    def>> {
+        [ length 5 = ]
+        [ last \ alien-invoke eq? ]
+    } 1&& ;

diff --git a/basis/alien/prettyprint/prettyprint.factor b/basis/alien/prettyprint/prettyprint.factor
index 0ffd5023a74b403e422c844ff12a3fceefd5cbf7..4586c0854292f278a931bad17bbca53917e02346 100644 (file)
--- a/basis/alien/prettyprint/prettyprint.factor
+++ b/basis/alien/prettyprint/prettyprint.factor
@@ -1,8 +1,9 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel combinators alien alien.strings alien.syntax
-math.parser prettyprint.backend prettyprint.custom
-prettyprint.sections ;
+USING: accessors kernel combinators alien alien.strings alien.c-types
+alien.parser alien.syntax arrays assocs effects math.parser
+prettyprint.backend prettyprint.custom prettyprint.sections
+definitions see see.private sequences strings words ;
 IN: alien.prettyprint
 
 M: alien pprint*
@@ -13,3 +14,39 @@ M: alien pprint*
     } cond ;
 
 M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ;
+
+M: c-type-word definer drop \ C-TYPE: f ;
+M: c-type-word definition drop f ;
+M: typedef-word declarations. drop ;
+
+GENERIC: pprint-c-type ( c-type -- )
+M: word pprint-c-type pprint-word ;
+M: wrapper pprint-c-type wrapped>> pprint-word ;
+M: string pprint-c-type text ;
+M: array pprint-c-type pprint* ;
+
+M: typedef-word definer drop \ TYPEDEF: f ;
+
+M: typedef-word synopsis*
+    \ TYPEDEF: pprint-word
+    dup "c-type" word-prop pprint-c-type
+    pprint-word ;
+
+: pprint-function-arg ( type name -- )
+    [ pprint-c-type ] [ text ] bi* ;
+
+: pprint-function-args ( word -- )
+    [ def>> fourth ] [ stack-effect in>> ] bi zip [ ] [
+        unclip-last
+        [ [ first2 "," append pprint-function-arg ] each ] dip
+        first2 pprint-function-arg
+    ] if-empty ;
+
+M: alien-function-word definer
+    drop \ FUNCTION: \ ; ;
+M: alien-function-word definition drop f ;
+M: alien-function-word synopsis*
+    \ FUNCTION: pprint-word
+    [ def>> first pprint-c-type ]
+    [ pprint-word ]
+    [ <block "(" text pprint-function-args ")" text block> ] tri ;

diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor
index 80837e9a0135cc9012fac6469d4dfda2c60f5c23..9478f98c6360d64f5e3078cfd935c8a6b4ff7c6b 100755 (executable)
--- a/basis/alien/structs/structs.factor
+++ b/basis/alien/structs/structs.factor
@@ -15,7 +15,7 @@ M: struct-type c-type ;
 M: struct-type c-type-stack-align? drop f ;
 
 : if-value-struct ( ctype true false -- )
-    [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
+    [ dup value-struct? ] 2dip '[ drop void* @ ] if ; inline
 
 M: struct-type unbox-parameter
     [ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ;

diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor
index e8206c6968fd993d11b30c3cc2ca737aa017c4f9..0e3b569fffa753b497269ad79d5d502528746b4a 100644 (file)
--- a/basis/alien/syntax/syntax.factor
+++ b/basis/alien/syntax/syntax.factor
@@ -19,7 +19,7 @@ SYNTAX: FUNCTION:
     (FUNCTION:) define-declared ;
 
 SYNTAX: TYPEDEF:
-    scan scan typedef ;
+    scan-c-type CREATE-C-TYPE typedef ;
 
 SYNTAX: C-STRUCT:
     scan current-vocab parse-definition define-struct ; deprecated
@@ -31,6 +31,9 @@ SYNTAX: C-ENUM:
     ";" parse-tokens
     [ [ create-in ] dip define-constant ] each-index ;
 
+SYNTAX: C-TYPE:
+    "Primitive C type definition not supported" throw ;
+
 ERROR: no-such-symbol name library ;
 
 : address-of ( name library -- value )

diff --git a/basis/classes/struct/prettyprint/prettyprint.factor b/basis/classes/struct/prettyprint/prettyprint.factor
index 2c969531e80285b58b60c453723f737e4a7feae0..7f57e8568a04cd9403bb35b107b1fb65a5618b16 100644 (file)
--- a/basis/classes/struct/prettyprint/prettyprint.factor
+++ b/basis/classes/struct/prettyprint/prettyprint.factor
@@ -1,9 +1,9 @@
 ! (c)Joe Groff bsd license
-USING: accessors alien alien.c-types arrays assocs classes
-classes.struct combinators combinators.short-circuit continuations
-fry kernel libc make math math.parser mirrors prettyprint.backend
-prettyprint.custom prettyprint.sections see.private sequences
-slots strings summary words ;
+USING: accessors alien alien.c-types alien.prettyprint arrays
+assocs classes classes.struct combinators combinators.short-circuit
+continuations fry kernel libc make math math.parser mirrors
+prettyprint.backend prettyprint.custom prettyprint.sections
+see.private sequences slots strings summary words ;
 IN: classes.struct.prettyprint
 
 <PRIVATE
@@ -20,7 +20,7 @@ IN: classes.struct.prettyprint
     <flow \ { pprint-word
     f <inset {
         [ name>> text ]
-        [ type>> dup string? [ text ] [ pprint* ] if ]
+        [ type>> pprint-c-type ]
         [ read-only>> [ \ read-only pprint-word ] when ]
         [ initial>> [ \ initial: pprint-word pprint* ] when* ]
     } cleave block>

diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor
index bbbaf4f1d57983bab04add14f770a468fb55fc19..e9e45487f9e3ea7441905151067ef9c8c057d7f5 100755 (executable)
--- a/basis/classes/struct/struct-tests.factor
+++ b/basis/classes/struct/struct-tests.factor
@@ -6,6 +6,8 @@ io.encodings.utf8 io.pathnames io.streams.string kernel libc
 literals math mirrors multiline namespaces prettyprint
 prettyprint.config see sequences specialized-arrays system
 tools.test parser lexer eval layouts ;
+FROM: math => float ;
+QUALIFIED-WITH: alien.c-types c
 SPECIALIZED-ARRAY: char
 SPECIALIZED-ARRAY: int
 SPECIALIZED-ARRAY: ushort
@@ -46,9 +48,9 @@ STRUCT: struct-test-bar
 
 [ {
     { "underlying" B{ 98 0 0 98 127 0 0 127 0 0 0 0 } }
-    { { "x" "char" } 98            }
-    { { "y" "int"  } HEX: 7F00007F }
-    { { "z" "bool" } f             }
+    { { "x" char } 98            }
+    { { "y" int  } HEX: 7F00007F }
+    { { "z" bool } f             }
 } ] [
     B{ 98 0 0 98 127 0 0 127 0 0 0 0 } struct-test-foo memory>struct
     make-mirror >alist
@@ -128,7 +130,7 @@ STRUCT: struct-test-bar
 ] unit-test
 
 UNION-STRUCT: struct-test-float-and-bits
-    { f float }
+    { f c:float }
     { bits uint } ;
 
 [ 1.0 ] [ struct-test-float-and-bits <struct> 1.0 float>bits >>bits f>> ] unit-test
@@ -181,14 +183,14 @@ STRUCT: struct-test-string-ptr
     ] with-scope
 ] unit-test
 
-[ <" USING: classes.struct ;
+[ <" USING: alien.c-types classes.struct ;
 IN: classes.struct.tests
 STRUCT: struct-test-foo
     { x char initial: 0 } { y int initial: 123 } { z bool } ;
 "> ]
 [ [ struct-test-foo see ] with-string-writer ] unit-test
 
-[ <" USING: classes.struct ;
+[ <" USING: alien.c-types classes.struct ;
 IN: classes.struct.tests
 UNION-STRUCT: struct-test-float-and-bits
     { f float initial: 0.0 } { bits uint initial: 0 } ;
@@ -201,20 +203,20 @@ UNION-STRUCT: struct-test-float-and-bits
         { offset 0 }
         { initial 0 }
         { class fixnum }
-        { type "char" }
+        { type char }
     }
     T{ struct-slot-spec
         { name "y" }
         { offset 4 }
         { initial 123 }
         { class integer }
-        { type "int" }
+        { type int }
     }
     T{ struct-slot-spec
         { name "z" }
         { offset 8 }
         { initial f }
-        { type "bool" }
+        { type bool }
         { class object }
     }
 } ] [ "struct-test-foo" c-type fields>> ] unit-test
@@ -223,14 +225,14 @@ UNION-STRUCT: struct-test-float-and-bits
     T{ struct-slot-spec
         { name "f" }
         { offset 0 }
-        { type "float" }
+        { type c:float }
         { class float }
         { initial 0.0 }
     }
     T{ struct-slot-spec
         { name "bits" }
         { offset 0 }
-        { type "uint" }
+        { type uint }
         { class integer }
         { initial 0 }
     }
@@ -277,7 +279,7 @@ STRUCT: struct-test-array-slots
 ] unit-test
 
 STRUCT: struct-test-optimization
-    { x { "int" 3 } } { y int } ;
+    { x { int 3 } } { y int } ;
 
 SPECIALIZED-ARRAY: struct-test-optimization
 

diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor
index 1de221d2aa61d20ce2dabe4d46eced4602cfb1f5..dabdead10c1d011400ab80a18023960332ca1020 100755 (executable)
--- a/basis/classes/struct/struct.factor
+++ b/basis/classes/struct/struct.factor
@@ -1,12 +1,12 @@
 ! (c)Joe Groff bsd license
-USING: accessors alien alien.c-types arrays byte-arrays classes
-classes.parser classes.tuple classes.tuple.parser
+USING: accessors alien alien.c-types alien.parser arrays
+byte-arrays classes classes.parser classes.tuple classes.tuple.parser
 classes.tuple.private combinators combinators.short-circuit
 combinators.smart cpu.architecture definitions functors.backend
 fry generalizations generic.parser kernel kernel.private lexer
 libc locals macros make math math.order parser quotations
 sequences slots slots.private specialized-arrays vectors words
-summary namespaces assocs ;
+summary namespaces assocs vocabs.parser ;
 IN: classes.struct
 
 SPECIALIZED-ARRAY: uchar
@@ -126,7 +126,7 @@ M: struct-c-type c-type ;
 M: struct-c-type c-type-stack-align? drop f ;
 
 : if-value-struct ( ctype true false -- )
-    [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
+    [ dup value-struct? ] 2dip '[ drop void* @ ] if ; inline
 
 M: struct-c-type unbox-parameter
     [ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ;
@@ -197,20 +197,6 @@ M: struct-c-type c-struct? drop t ;
     [ type>> c-type-align ] [ max ] map-reduce ;
 PRIVATE>
 
-M: struct-class c-type name>> c-type ;
-
-M: struct-class c-type-align c-type c-type-align ;
-
-M: struct-class c-type-getter c-type c-type-getter ;
-
-M: struct-class c-type-setter c-type c-type-setter ;
-
-M: struct-class c-type-boxer-quot c-type c-type-boxer-quot ;
-
-M: struct-class c-type-unboxer-quot c-type c-type-boxer-quot ;
-
-M: struct-class heap-size c-type heap-size ;
-
 M: struct byte-length class "struct-size" word-prop ; foldable
 
 ! class definition
@@ -259,7 +245,7 @@ M: struct byte-length class "struct-size" word-prop ; foldable
         [ check-struct-slots ] _ [ struct-align [ align ] keep ] tri
         (struct-word-props)
     ]
-    [ drop [ c-type-for-class ] [ name>> ] bi typedef ] 2tri ; inline
+    [ drop [ c-type-for-class ] keep typedef ] 2tri ; inline
 PRIVATE>
 
 : define-struct-class ( class slots -- )
@@ -284,9 +270,6 @@ ERROR: invalid-struct-slot token ;
     [ [ dup empty? ] [ peel-off-attributes ] until drop ] tri* ;
 
 <PRIVATE
-: scan-c-type ( -- c-type )
-    scan dup "{" = [ drop \ } parse-until >array ] when ;
-
 : parse-struct-slot ( -- slot )
     scan scan-c-type \ } parse-until <struct-slot-spec> ;
     
@@ -317,7 +300,7 @@ SYNTAX: S@
 
 <PRIVATE
 : scan-c-type` ( -- c-type/param )
-    scan dup "{" = [ drop \ } parse-until >array ] [ >string-param ] if ;
+    scan dup "{" = [ drop \ } parse-until >array ] [ search ] if ;
 
 : parse-struct-slot` ( accum -- accum )
     scan-string-param scan-c-type` \ } parse-until

diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index 0456ff485f077232de68aa2553bfe19a6e32f52a..ddf5aa0e02d8c07897d881440df300880e237fb9 100755 (executable)
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -456,7 +456,7 @@ TUPLE: callback-context ;
 
 : callback-return-quot ( ctype -- quot )
     return>> {
-        { [ dup "void" = ] [ drop [ ] ] }
+        { [ dup void? ] [ drop [ ] ] }
         { [ dup large-struct? ] [ heap-size '[ _ memcpy ] ] }
         [ c-type c-type-unboxer-quot ]
     } cond ;

diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor
index 484b1f4f2f8d49a60eb5c41845e7098bb50c45df..e21e13dc1325569c18d896f85115aedf791cdbe3 100755 (executable)
--- a/basis/compiler/tests/alien.factor
+++ b/basis/compiler/tests/alien.factor
@@ -5,6 +5,7 @@ io.streams.string kernel math memory namespaces
 namespaces.private parser quotations sequences
 specialized-arrays stack-checker stack-checker.errors
 system threads tools.test words ;
+FROM: alien.c-types => float short ;
 SPECIALIZED-ARRAY: float
 SPECIALIZED-ARRAY: char
 IN: compiler.tests.alien

diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor
index fcbac304442048509ad86c24cbfc2c8b80bcf0dc..56e368e3209d46e738bac6accd80eb7fc1476fd0 100644 (file)
--- a/basis/compiler/tests/codegen.factor
+++ b/basis/compiler/tests/codegen.factor
@@ -4,6 +4,7 @@ namespaces.private slots.private sequences.private byte-arrays alien
 alien.accessors layouts words definitions compiler.units io
 combinators vectors grouping make alien.c-types combinators.short-circuit
 math.order math.libm math.parser ;
+FROM: math => float ;
 QUALIFIED: namespaces.private
 IN: compiler.tests.codegen
 
@@ -414,4 +415,4 @@ cell 4 = [
 [ "0.169967142900241" "0.9854497299884601" ] [ 1.4 [ [ fcos ] [ fsin ] bi ] compile-call [ number>string ] bi@ ] unit-test
 [ 1 "0.169967142900241" "0.9854497299884601" ] [ 1.4 1 [ swap >float [ fcos ] [ fsin ] bi ] compile-call [ number>string ] bi@ ] unit-test
 
-[ 6.0 ] [ 1.0 [ >float 3.0 + [ B{ 0 0 0 0 } 0 set-alien-float ] [ 2.0 + ] bi ] compile-call ] unit-test
\ No newline at end of file
+[ 6.0 ] [ 1.0 [ >float 3.0 + [ B{ 0 0 0 0 } 0 set-alien-float ] [ 2.0 + ] bi ] compile-call ] unit-test

diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor
index ad2d2c8be5c0ec2cd28997056507b39a4b89c85d..dc2f5d9257f657726668e232202d42596a7233b0 100644 (file)
--- a/basis/compiler/tests/intrinsics.factor
+++ b/basis/compiler/tests/intrinsics.factor
@@ -5,6 +5,7 @@ hashtables.private byte-arrays system random layouts vectors
 sbufs strings.private slots.private alien math.order
 alien.accessors alien.c-types alien.syntax alien.strings
 namespaces libc io.encodings.ascii classes compiler ;
+FROM: math => float ;
 IN: compiler.tests.intrinsics
 
 ! Make sure that intrinsic ops compile to correct code.

diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor
index faf69686702c78adec3493422e10c30a42b252e4..02e7409c24aa3fd02da25f84977dd8910ed73ba8 100755 (executable)
--- a/basis/compiler/tree/cleanup/cleanup-tests.factor
+++ b/basis/compiler/tree/cleanup/cleanup-tests.factor
@@ -16,6 +16,7 @@ compiler.tree.propagation
 compiler.tree.propagation.info
 compiler.tree.checker
 compiler.tree.debugger ;
+FROM: math => float ;
 IN: compiler.tree.cleanup.tests
 
 [ t ] [ [ [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test

diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index 0c220542ca64da1d6ff45bf84878933d681e1f76..0da234791b8d707a6c769b28a435f086829d225f 100644 (file)
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -10,6 +10,7 @@ compiler.tree.debugger compiler.tree.checker
 slots.private words hashtables classes assocs locals
 specialized-arrays system sorting math.libm
 math.intervals quotations effects alien ;
+FROM: math => float ;
 SPECIALIZED-ARRAY: double
 IN: compiler.tree.propagation.tests
 

diff --git a/basis/core-foundation/numbers/numbers.factor b/basis/core-foundation/numbers/numbers.factor
index f01f522d61bd309bbd2d1fa32d3787a718a50b75..ae061cb4eb8e0e3dcf560e5f87700b7158cf63a3 100644 (file)
--- a/basis/core-foundation/numbers/numbers.factor
+++ b/basis/core-foundation/numbers/numbers.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types alien.syntax kernel math core-foundation ;
+FROM: math => float ;
 IN: core-foundation.numbers
 
 TYPEDEF: void* CFNumberRef

diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 9c829bc390023b8e88ddcb01c734f8f837107b28..f881ff5f9131448fd2a18724147128f9e7eee0d6 100644 (file)
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -770,5 +770,5 @@ USE: vocabs.loader
         4 >>align
         "box_boolean" >>boxer
         "to_boolean" >>unboxer
-    "bool" define-primitive-type
+    bool define-primitive-type
 ] with-compilation-unit

diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor
index 17cc0e3f8042ff40274cad621b243f790585aa52..13e91a87a4709656ac6a8444e56c79c6998295ca 100644 (file)
--- a/basis/cpu/x86/64/unix/unix.factor
+++ b/basis/cpu/x86/64/unix/unix.factor
@@ -16,9 +16,10 @@ M: float-regs param-regs
 
 M: x86.64 reserved-area-size 0 ;
 
-! The ABI for passing structs by value is pretty messed up
-<< "void*" c-type clone "__stack_value" define-primitive-type
-stack-params "__stack_value" c-type (>>rep) >>
+SYMBOL: (stack-value)
+! The ABI for passing structs by value is pretty great
+<< void* c-type clone \ (stack-value) define-primitive-type
+stack-params \ (stack-value) c-type (>>rep) >>
 
 : struct-types&offset ( struct-type -- pairs )
     fields>> [
@@ -33,12 +34,12 @@ stack-params "__stack_value" c-type (>>rep) >>
 : flatten-small-struct ( c-type -- seq )
     struct-types&offset split-struct [
         [ c-type c-type-rep reg-class-of ] map
-        int-regs swap member? "void*" "double" ? c-type
+        int-regs swap member? void* double ? c-type
     ] map ;
 
 : flatten-large-struct ( c-type -- seq )
     heap-size cell align
-    cell /i "__stack_value" c-type <repetition> ;
+    cell /i \ (stack-value) c-type <repetition> ;
 
 : flatten-struct ( c-type -- seq )
     dup heap-size 16 > [

diff --git a/basis/cpu/x86/64/winnt/winnt.factor b/basis/cpu/x86/64/winnt/winnt.factor
index d9f83612e60394729cc9bda88fc8701fb21de26d..bbe943e06ba2419b26cfa8ac34933c9e4ba78ce0 100644 (file)
--- a/basis/cpu/x86/64/winnt/winnt.factor
+++ b/basis/cpu/x86/64/winnt/winnt.factor
@@ -25,8 +25,8 @@ M: x86.64 dummy-fp-params? t ;
 M: x86.64 temp-reg RAX ;
 
 <<
-"longlong" "ptrdiff_t" typedef
-"longlong" "intptr_t" typedef
-"int" c-type "long" define-primitive-type
-"uint" c-type "ulong" define-primitive-type
+longlong ptrdiff_t typedef
+longlong intptr_t  typedef
+int  c-type long  define-primitive-type
+uint c-type ulong define-primitive-type
 >>

diff --git a/basis/cpu/x86/features/features.factor b/basis/cpu/x86/features/features.factor
index 02235bb62ea58ad2854c120334208edfbc753b84..c5cf2d470abd4dbd65fbf1e984ba5f7e79d27736 100644 (file)
--- a/basis/cpu/x86/features/features.factor
+++ b/basis/cpu/x86/features/features.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: system kernel math math.order math.parser namespaces
-alien.syntax combinators locals init io cpu.x86 compiler
-compiler.units accessors ;
+alien.c-types alien.syntax combinators locals init io cpu.x86
+compiler compiler.units accessors ;
 IN: cpu.x86.features
 
 <PRIVATE

diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 27b6667c050858949c5d6a41e380a77bc71fce3d..04b530883653533837fb34b40a7c7ad7368a5a67 100644 (file)
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -12,6 +12,7 @@ compiler.cfg.comparisons
 compiler.cfg.stack-frame
 compiler.codegen
 compiler.codegen.fixup ;
+FROM: math => float ;
 IN: cpu.x86
 
 << enable-fixnum-log2 >>

diff --git a/basis/functors/functors-tests.factor b/basis/functors/functors-tests.factor
index 32d578d05d6e422a20fb0a0403fe165c5c1795c9..58da96aa171279efbb15692ac4158075b1ba04b8 100644 (file)
--- a/basis/functors/functors-tests.factor
+++ b/basis/functors/functors-tests.factor
@@ -1,5 +1,6 @@
 USING: classes.struct functors tools.test math words kernel
 multiline parser io.streams.string generic ;
+QUALIFIED-WITH: alien.c-types c
 IN: functors.tests
 
 <<
@@ -160,15 +161,15 @@ T-class DEFINES-CLASS ${T}
 WHERE
 
 STRUCT: T-class
-    { NAME int }
+    { NAME c:int }
     { x { TYPE 4 } }
-    { y { "short" N } }
+    { y { c:short N } }
     { z TYPE initial: 5 }
-    { float { "float" 2 } } ;
+    { float { c:float 2 } } ;
 
 ;FUNCTOR
 
-"a-struct" "nemo" "char" 2 define-a-struct
+"a-struct" "nemo" c:char 2 define-a-struct
 
 >>
 
@@ -179,35 +180,35 @@ STRUCT: T-class
             { offset 0 }
             { class integer }
             { initial 0 } 
-            { type "int" }
+            { type c:int }
         }
         T{ struct-slot-spec
             { name "x" }
             { offset 4 }
             { class object }
             { initial f } 
-            { type { "char" 4 } }
+            { type { c:char 4 } }
         }
         T{ struct-slot-spec
             { name "y" }
             { offset 8 }
             { class object }
             { initial f } 
-            { type { "short" 2 } }
+            { type { c:short 2 } }
         }
         T{ struct-slot-spec
             { name "z" }
             { offset 12 }
             { class fixnum }
             { initial 5 } 
-            { type "char" }
+            { type c:char }
         }
         T{ struct-slot-spec
             { name "float" }
             { offset 16 }
             { class object }
             { initial f } 
-            { type { "float" 2 } }
+            { type { c:float 2 } }
         }
     }
 ] [ a-struct struct-slots ] unit-test

diff --git a/basis/game-input/dinput/dinput.factor b/basis/game-input/dinput/dinput.factor
index ea3100f95f6f99a2dfb1d70a1de1e6d3b1e09fe3..a7489f26a26cd73f90d58b8eb4fff361ef91d528 100755 (executable)
--- a/basis/game-input/dinput/dinput.factor
+++ b/basis/game-input/dinput/dinput.factor
@@ -160,19 +160,24 @@ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+
     [ device-attached? not ] filter
     [ remove-controller ] each ;
 
-: device-interface? ( dbt-broadcast-hdr -- ? )
-    dbch_devicetype>> DBT_DEVTYP_DEVICEINTERFACE = ;
+: ?device-interface ( dbt-broadcast-hdr -- ? )
+    dup dbch_devicetype>> DBT_DEVTYP_DEVICEINTERFACE =
+    [ >c-ptr DEV_BROADCAST_DEVICEW memory>struct ]
+    [ drop f ] if ; inline
 
 : device-arrived ( dbt-broadcast-hdr -- )
-    device-interface? [ find-controllers ] when ;
+    ?device-interface [ find-controllers ] when ; inline
 
 : device-removed ( dbt-broadcast-hdr -- )
-    device-interface? [ find-and-remove-detached-devices ] when ;
+    ?device-interface [ find-and-remove-detached-devices ] when ; inline
+
+: <DEV_BROADCAST_HDR> ( wParam -- struct )
+    <alien> DEV_BROADCAST_HDR memory>struct ;
 
 : handle-wm-devicechange ( hWnd uMsg wParam lParam -- )
     [ 2drop ] 2dip swap {
-        { [ dup DBT_DEVICEARRIVAL = ]         [ drop <alien> device-arrived ] }
-        { [ dup DBT_DEVICEREMOVECOMPLETE = ]  [ drop <alien> device-removed ] }
+        { [ dup DBT_DEVICEARRIVAL = ]         [ drop <DEV_BROADCAST_HDR> device-arrived ] }
+        { [ dup DBT_DEVICEREMOVECOMPLETE = ]  [ drop <DEV_BROADCAST_HDR> device-removed ] }
         [ 2drop ]
     } cond ;
 

diff --git a/basis/math/blas/matrices/matrices.factor b/basis/math/blas/matrices/matrices.factor
index a051fb250de2b53bb73d17cc8bdc2aea3b93c408..4212f32b2dd2f5e38931cd0bf9f77be18c600ed3 100755 (executable)
--- a/basis/math/blas/matrices/matrices.factor
+++ b/basis/math/blas/matrices/matrices.factor
@@ -5,6 +5,7 @@ math.complex math.functions math.order functors words
 sequences sequences.merged sequences.private shuffle
 parser prettyprint.backend prettyprint.custom ascii
 specialized-arrays ;
+FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 SPECIALIZED-ARRAY: double
 SPECIALIZED-ARRAY: complex-float

diff --git a/basis/math/blas/vectors/vectors.factor b/basis/math/blas/vectors/vectors.factor
index c08fdb612081d0caa7410973a9d2250a9c631bf3..20ee7925b080a285d67838cb96859cf18962ab5b 100755 (executable)
--- a/basis/math/blas/vectors/vectors.factor
+++ b/basis/math/blas/vectors/vectors.factor
@@ -3,6 +3,7 @@ combinators.short-circuit fry kernel math math.blas.ffi
 math.complex math.functions math.order sequences sequences.private
 functors words locals parser prettyprint.backend prettyprint.custom
 specialized-arrays ;
+FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 SPECIALIZED-ARRAY: double
 SPECIALIZED-ARRAY: complex-float

diff --git a/basis/math/libm/libm.factor b/basis/math/libm/libm.factor
index df8b36fd28c49377518c191a4ab4f12edb119f62..0288894081bf1006cdc4e5893d28166ed3926cd5 100644 (file)
--- a/basis/math/libm/libm.factor
+++ b/basis/math/libm/libm.factor
@@ -1,62 +1,62 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien ;
+USING: alien alien.c-types ;
 IN: math.libm
 
 : facos ( x -- y )
-    "double" "libm" "acos" { "double" } alien-invoke ;
+    double "libm" "acos" { double } alien-invoke ;
 
 : fasin ( x -- y )
-    "double" "libm" "asin" { "double" } alien-invoke ;
+    double "libm" "asin" { double } alien-invoke ;
 
 : fatan ( x -- y )
-    "double" "libm" "atan" { "double" } alien-invoke ;
+    double "libm" "atan" { double } alien-invoke ;
 
 : fatan2 ( x y -- z )
-    "double" "libm" "atan2" { "double" "double" } alien-invoke ;
+    double "libm" "atan2" { double double } alien-invoke ;
 
 : fcos ( x -- y )
-    "double" "libm" "cos" { "double" } alien-invoke ;
+    double "libm" "cos" { double } alien-invoke ;
 
 : fsin ( x -- y )
-    "double" "libm" "sin" { "double" } alien-invoke ;
+    double "libm" "sin" { double } alien-invoke ;
 
 : ftan ( x -- y )
-    "double" "libm" "tan" { "double" } alien-invoke ;
+    double "libm" "tan" { double } alien-invoke ;
 
 : fcosh ( x -- y )
-    "double" "libm" "cosh" { "double" } alien-invoke ;
+    double "libm" "cosh" { double } alien-invoke ;
 
 : fsinh ( x -- y )
-    "double" "libm" "sinh" { "double" } alien-invoke ;
+    double "libm" "sinh" { double } alien-invoke ;
 
 : ftanh ( x -- y )
-    "double" "libm" "tanh" { "double" } alien-invoke ;
+    double "libm" "tanh" { double } alien-invoke ;
 
 : fexp ( x -- y )
-    "double" "libm" "exp" { "double" } alien-invoke ;
+    double "libm" "exp" { double } alien-invoke ;
 
 : flog ( x -- y )
-    "double" "libm" "log" { "double" } alien-invoke ;
+    double "libm" "log" { double } alien-invoke ;
 
 : flog10 ( x -- y )
-    "double" "libm" "log10" { "double" } alien-invoke ;
+    double "libm" "log10" { double } alien-invoke ;
 
 : fpow ( x y -- z )
-    "double" "libm" "pow" { "double" "double" } alien-invoke ;
+    double "libm" "pow" { double double } alien-invoke ;
 
 : fsqrt ( x -- y )
-    "double" "libm" "sqrt" { "double" } alien-invoke ;
+    double "libm" "sqrt" { double } alien-invoke ;
     
 ! Windows doesn't have these...
 : flog1+ ( x -- y )
-    "double" "libm" "log1p" { "double" } alien-invoke ;
+    double "libm" "log1p" { double } alien-invoke ;
 
 : facosh ( x -- y )
-    "double" "libm" "acosh" { "double" } alien-invoke ;
+    double "libm" "acosh" { double } alien-invoke ;
 
 : fasinh ( x -- y )
-    "double" "libm" "asinh" { "double" } alien-invoke ;
+    double "libm" "asinh" { double } alien-invoke ;
 
 : fatanh ( x -- y )
-    "double" "libm" "atanh" { "double" } alien-invoke ;
+    double "libm" "atanh" { double } alien-invoke ;

diff --git a/basis/math/vectors/simd/functor/functor.factor b/basis/math/vectors/simd/functor/functor.factor
index cabb731fefbfba55d9a3dcb24efd733f0bbb6ed4..641585a5d71379f7966caf2bd7524f552cebd94a 100644 (file)
--- a/basis/math/vectors/simd/functor/functor.factor
+++ b/basis/math/vectors/simd/functor/functor.factor
@@ -9,14 +9,16 @@ ERROR: bad-length got expected ;
 
 FUNCTOR: define-simd-128 ( T -- )
 
-N            [ 16 T heap-size /i ]
+T-TYPE       IS ${T}
+
+N            [ 16 T-TYPE heap-size /i ]
 
 A            DEFINES-CLASS ${T}-${N}
 >A           DEFINES >${A}
 A{           DEFINES ${A}{
 
-NTH          [ T dup c-type-getter-boxer array-accessor ]
-SET-NTH      [ T dup c-setter array-accessor ]
+NTH          [ T-TYPE dup c-type-getter-boxer array-accessor ]
+SET-NTH      [ T-TYPE dup c-setter array-accessor ]
 
 A-rep        IS ${A}-rep
 A-vv->v-op   DEFINES-PRIVATE ${A}-vv->v-op
@@ -74,7 +76,9 @@ PRIVATE>
 ! Synthesize 256-bit vectors from a pair of 128-bit vectors
 FUNCTOR: define-simd-256 ( T -- )
 
-N            [ 32 T heap-size /i ]
+T-TYPE       IS ${T}
+
+N            [ 32 T-TYPE heap-size /i ]
 
 N/2          [ N 2 / ]
 A/2          IS ${T}-${N/2}

diff --git a/basis/math/vectors/simd/simd.factor b/basis/math/vectors/simd/simd.factor
index 7df9b2d8d2fc312c7d6065e6da69b7dc360462ce..a3c99ae217bda587b6cf3b218b13fa71b0801ca1 100644 (file)
--- a/basis/math/vectors/simd/simd.factor
+++ b/basis/math/vectors/simd/simd.factor
@@ -5,6 +5,8 @@ kernel math math.functions math.vectors
 math.vectors.simd.functor math.vectors.simd.intrinsics
 math.vectors.specialization parser prettyprint.custom sequences
 sequences.private locals assocs words fry ;
+FROM: alien.c-types => float ;
+QUALIFIED-WITH: math m
 IN: math.vectors.simd
 
 <<
@@ -15,9 +17,9 @@ DEFER: float-8
 DEFER: double-4
 
 "double" define-simd-128
-"float" define-simd-128
+"float"  define-simd-128
 "double" define-simd-256
-"float" define-simd-256
+"float"  define-simd-256
 
 >>
 
@@ -136,7 +138,7 @@ DEFER: double-4
 
 PRIVATE>
 
-\ float-4 \ float-4-with float H{
+\ float-4 \ float-4-with m:float H{
     { v+ [ [ (simd-v+) ] float-4-vv->v-op ] }
     { v- [ [ (simd-v-) ] float-4-vv->v-op ] }
     { v* [ [ (simd-v*) ] float-4-vv->v-op ] }
@@ -146,7 +148,7 @@ PRIVATE>
     { sum [ [ (simd-sum) ] float-4-v->n-op ] }
 } simd-vector-words
 
-\ double-2 \ double-2-with float H{
+\ double-2 \ double-2-with m:float H{
     { v+ [ [ (simd-v+) ] double-2-vv->v-op ] }
     { v- [ [ (simd-v-) ] double-2-vv->v-op ] }
     { v* [ [ (simd-v*) ] double-2-vv->v-op ] }
@@ -156,7 +158,7 @@ PRIVATE>
     { sum [ [ (simd-sum) ] double-2-v->n-op ] }
 } simd-vector-words
 
-\ float-8 \ float-8-with float H{
+\ float-8 \ float-8-with m:float H{
     { v+ [ [ (simd-v+) ] float-8-vv->v-op ] }
     { v- [ [ (simd-v-) ] float-8-vv->v-op ] }
     { v* [ [ (simd-v*) ] float-8-vv->v-op ] }
@@ -166,7 +168,7 @@ PRIVATE>
     { sum [ [ (simd-sum) ] [ + ] float-8-v->n-op ] }
 } simd-vector-words
 
-\ double-4 \ double-4-with float H{
+\ double-4 \ double-4-with m:float H{
     { v+ [ [ (simd-v+) ] double-4-vv->v-op ] }
     { v- [ [ (simd-v-) ] double-4-vv->v-op ] }
     { v* [ [ (simd-v*) ] double-4-vv->v-op ] }

diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor
index 75f327664d0c3bef944944a10ea0e780616347c5..cdf68cebd35720a2223ec0e23039587dbb672f22 100755 (executable)
--- a/basis/opengl/opengl.factor
+++ b/basis/opengl/opengl.factor
@@ -8,6 +8,7 @@ math.parser opengl.gl combinators combinators.smart arrays
 sequences splitting words byte-arrays assocs vocabs
 colors colors.constants accessors generalizations locals fry
 specialized-arrays ;
+FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 SPECIALIZED-ARRAY: uint
 IN: opengl

diff --git a/basis/specialized-arrays/specialized-arrays-tests.factor b/basis/specialized-arrays/specialized-arrays-tests.factor
index 2698149bac4c594f261a246353cc56e27e241f69..e289efb0777de224c41406a85c5be612d13c008f 100755 (executable)
--- a/basis/specialized-arrays/specialized-arrays-tests.factor
+++ b/basis/specialized-arrays/specialized-arrays-tests.factor
@@ -5,6 +5,7 @@ kernel arrays combinators compiler compiler.units classes.struct
 combinators.smart compiler.tree.debugger math libc destructors
 sequences.private multiline eval words vocabs namespaces
 assocs prettyprint ;
+FROM: alien.c-types => float ;
 
 SPECIALIZED-ARRAY: int
 SPECIALIZED-ARRAY: bool

diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor
index 15245cc71016c7fe1d38abd771bc18e869648117..0490ede3047c84283897b1d65347c20e8d8d3c2e 100755 (executable)
--- a/basis/specialized-arrays/specialized-arrays.factor
+++ b/basis/specialized-arrays/specialized-arrays.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types assocs byte-arrays classes
-compiler.units functors kernel lexer libc math
+USING: accessors alien alien.c-types alien.parser assocs
+byte-arrays classes compiler.units functors kernel lexer libc math
 math.vectors.specialization namespaces parser prettyprint.custom
 sequences sequences.private strings summary vocabs vocabs.loader
 vocabs.parser words fry combinators ;
@@ -103,13 +103,21 @@ A T c-type-boxed-class f specialize-vector-words
 
 ;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 ( c-type -- c-type' )
-    dup c-types get at {
+    dup (underlying-type) {
         { [ dup not ] [ drop no-c-type ] }
-        { [ dup string? ] [ nip underlying-type ] }
+        { [ dup c-type-name? ] [ nip underlying-type ] }
         [ drop ]
     } cond ;
 
+: underlying-type-name ( c-type -- name )
+    underlying-type dup word? [ name>> ] when ;
+
 : specialized-array-vocab ( c-type -- vocab )
     "specialized-arrays.instances." prepend ;
 
@@ -125,31 +133,31 @@ PRIVATE>
     ] ?if ; inline
 
 : define-array-vocab ( type -- vocab )
-    underlying-type
+    underlying-type-name
     [ specialized-array-vocab ] [ '[ _ define-array ] ] bi
     generate-vocab ;
 
-M: string require-c-array define-array-vocab drop ;
+M: c-type-name require-c-array define-array-vocab drop ;
 
 ERROR: specialized-array-vocab-not-loaded c-type ;
 
-M: string c-array-constructor
-    underlying-type
+M: c-type-name c-array-constructor
+    underlying-type-name
     dup [ "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup
     [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
 
-M: string c-(array)-constructor
-    underlying-type
+M: c-type-name c-(array)-constructor
+    underlying-type-name
     dup [ "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup
     [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
 
-M: string c-direct-array-constructor
-    underlying-type
+M: c-type-name c-direct-array-constructor
+    underlying-type-name
     dup [ "<direct-" "-array>" surround ] [ specialized-array-vocab ] bi lookup
     [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
 
 SYNTAX: SPECIALIZED-ARRAY:
-    scan define-array-vocab use-vocab ;
+    scan-c-type define-array-vocab use-vocab ;
 
 "prettyprint" vocab [
     "specialized-arrays.prettyprint" require

diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor
index da559abd7808178af73967cb849ab6556287be1d..3d150adf9117774057ca51f84080c9a971de5dd0 100644 (file)
--- a/basis/stack-checker/alien/alien.factor
+++ b/basis/stack-checker/alien/alien.factor
@@ -19,7 +19,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
 
 : alien-stack ( params extra -- )
     over parameters>> length + consume-d >>in-d
-    dup return>> "void" = 0 1 ? produce-d >>out-d
+    dup return>> void? 0 1 ? produce-d >>out-d
     drop ;
 
 : return-prep-quot ( node -- quot )

diff --git a/basis/windows/com/syntax/syntax.factor b/basis/windows/com/syntax/syntax.factor
index 2100d6a2156f420d6abe3f044c8abc2b48401775..3cf8b55e39e270e0825b3ecd49ea1014a4d2a639 100755 (executable)
--- a/basis/windows/com/syntax/syntax.factor
+++ b/basis/windows/com/syntax/syntax.factor
@@ -67,7 +67,7 @@ unless
 : (stack-effect-from-return-and-parameters) ( return parameters -- stack-effect )
     swap
     [ [ second ] map ]
-    [ dup "void" = [ drop { } ] [ 1array ] if ] bi*
+    [ dup void? [ drop { } ] [ 1array ] if ] bi*
     <effect> ;
 
 : (define-word-for-function) ( function interface n -- )

diff --git a/basis/windows/dinput/constants/constants.factor b/basis/windows/dinput/constants/constants.factor
index b67b5fa08f18096c6c34837cba37afc36b9abea9..270c2fa3dd873a930c6ca9063379c8086625290c 100755 (executable)
--- a/basis/windows/dinput/constants/constants.factor
+++ b/basis/windows/dinput/constants/constants.factor
@@ -2,7 +2,7 @@ USING: windows.dinput windows.kernel32 windows.ole32 windows.com
 windows.com.syntax alien alien.c-types alien.syntax kernel system namespaces
 combinators sequences fry math accessors macros words quotations
 libc continuations generalizations splitting locals assocs init
-specialized-arrays memoize classes.struct ;
+specialized-arrays memoize classes.struct strings arrays ;
 SPECIALIZED-ARRAY: DIOBJECTDATAFORMAT
 IN: windows.dinput.constants
 
@@ -22,12 +22,17 @@ SYMBOLS:
 MEMO: c-type* ( name -- c-type ) c-type ;
 MEMO: heap-size* ( c-type -- n ) heap-size ;
 
+GENERIC: array-base-type ( c-type -- c-type' )
+M: object array-base-type ;
+M: string array-base-type "[" split1 drop ;
+M: array array-base-type first ;
+
 : (field-spec-of) ( field struct -- field-spec )
     c-type* fields>> [ name>> = ] with find nip ;
 : (offsetof) ( field struct -- offset )
     [ (field-spec-of) offset>> ] [ drop 0 ] if* ;
 : (sizeof) ( field struct -- size )
-    [ (field-spec-of) type>> "[" split1 drop heap-size* ] [ drop 1 ] if* ;
+    [ (field-spec-of) type>> array-base-type heap-size* ] [ drop 1 ] if* ;
 
 : (flag) ( thing -- integer )
     {

diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor
index c882ba2e7f3a16c2ab2fee56a2da30bc708a6803..544abb69a83d32549365d5fb11b764f08a7f4cdc 100755 (executable)
--- a/basis/windows/types/types.factor
+++ b/basis/windows/types/types.factor
@@ -3,6 +3,7 @@
 USING: alien alien.c-types alien.syntax namespaces kernel words
 sequences math math.bitwise math.vectors colors
 io.encodings.utf16n classes.struct accessors ;
+FROM: alien.c-types => float short ;
 IN: windows.types
 
 TYPEDEF: char                CHAR
@@ -69,7 +70,8 @@ TYPEDEF: ulonglong   ULARGE_INTEGER
 TYPEDEF: LARGE_INTEGER* PLARGE_INTEGER
 TYPEDEF: ULARGE_INTEGER* PULARGE_INTEGER
 
-<< { "char*" utf16n } "wchar_t*" typedef >>
+SYMBOL: wchar_t*
+<< { char* utf16n } \ wchar_t* typedef >>
 
 TYPEDEF: wchar_t*  LPCSTR
 TYPEDEF: wchar_t*  LPWSTR

diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor
index 87b8970b02d1f40bfcd03c85d5024c8fa3116cb4..e29eb3e0905cea635b40d77a334dde52bbe720f9 100755 (executable)
--- a/basis/windows/winsock/winsock.factor
+++ b/basis/windows/winsock/winsock.factor
@@ -4,6 +4,7 @@ USING: alien alien.c-types alien.strings alien.syntax arrays
 byte-arrays kernel literals math sequences windows.types
 windows.kernel32 windows.errors math.bitwise io.encodings.utf16n
 classes.struct windows.com.syntax init ;
+FROM: alien.c-types => short ;
 IN: windows.winsock
 
 TYPEDEF: void* SOCKET

diff --git a/basis/x11/xlib/xlib.factor b/basis/x11/xlib/xlib.factor
index 48d556de1ddb28b6a4374b77c26cca506154f56b..98305e83045bf3ccc646460f9c4f9f58981f6694 100644 (file)
--- a/basis/x11/xlib/xlib.factor
+++ b/basis/x11/xlib/xlib.factor
@@ -13,6 +13,7 @@
 USING: accessors kernel arrays alien alien.c-types alien.strings
 alien.syntax classes.struct math math.bitwise words sequences
 namespaces continuations io io.encodings.ascii x11.syntax ;
+FROM: alien.c-types => short ;
 IN: x11.xlib
 
 LIBRARY: xlib

diff --git a/extra/alien/inline/inline.factor b/extra/alien/inline/inline.factor
index 84c3450102953e0444fd19e463d514135bbd39b7..ee69d954eafe13c785eb949914ce1887440cf762 100644 (file)
--- a/extra/alien/inline/inline.factor
+++ b/extra/alien/inline/inline.factor
@@ -41,6 +41,11 @@ SYMBOL: c-strings
     [ current-vocab name>> % "_" % % ] "" make ;
 PRIVATE>
 
+: parse-arglist ( parameters return -- types effect )
+    [ 2 group unzip [ "," ?tail drop ] map ]
+    [ [ { } ] [ 1array ] if-void ]
+    bi* <effect> ;
+
 : append-function-body ( prototype-str body -- str )
     [ swap % " {\n" % % "\n}\n" % ] "" make ;
 

diff --git a/extra/alien/inline/types/types.factor b/extra/alien/inline/types/types.factor
index 070febc3245cab6849ea2c2d93e8f528ba988376..ac7f6ae17f4252d94281f44d5b1d497b6b09bbd7 100644 (file)
--- a/extra/alien/inline/types/types.factor
+++ b/extra/alien/inline/types/types.factor
@@ -2,10 +2,11 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien.c-types assocs combinators.short-circuit
 continuations effects fry kernel math memoize sequences
-splitting strings peg.ebnf make ;
+splitting strings peg.ebnf make words ;
 IN: alien.inline.types
 
 : cify-type ( str -- str' )
+    dup word? [ name>> ] when
     { { CHAR: - CHAR: space } } substitute ;
 
 : factorize-type ( str -- str' )

diff --git a/extra/alien/marshall/marshall.factor b/extra/alien/marshall/marshall.factor
index 2cae12264168235a1d90c7c3af77d0f5c3fe8c86..d343da0fe0db186bf4284edf13f7b6d4cbb48676 100644 (file)
--- a/extra/alien/marshall/marshall.factor
+++ b/extra/alien/marshall/marshall.factor
@@ -6,6 +6,7 @@ combinators combinators.short-circuit destructors fry
 io.encodings.utf8 kernel libc sequences
 specialized-arrays strings unix.utilities vocabs.parser
 words libc.private locals generalizations math ;
+FROM: alien.c-types => float short ;
 SPECIALIZED-ARRAY: bool
 SPECIALIZED-ARRAY: char
 SPECIALIZED-ARRAY: double
@@ -22,7 +23,7 @@ SPECIALIZED-ARRAY: ushort
 SPECIALIZED-ARRAY: void*
 IN: alien.marshall
 
-<< primitive-types [ [ "void*" = ] [ "bool" = ] bi or not ]
+<< primitive-types [ [ void* = ] [ bool = ] bi or not ]
 filter [ define-primitive-marshallers ] each >>
 
 TUPLE: alien-wrapper { underlying alien } ;

diff --git a/extra/bunny/model/model.factor b/extra/bunny/model/model.factor
index dd6730b57f1382d41f9592fb8460eeda57946589..d80f3aa98aa6f00f2d5461c7b86a72d7a0f2a337 100755 (executable)
--- a/extra/bunny/model/model.factor
+++ b/extra/bunny/model/model.factor
@@ -3,8 +3,9 @@ http.client io io.encodings.ascii io.files io.files.temp kernel
 math math.matrices math.parser math.vectors opengl
 opengl.capabilities opengl.gl opengl.demo-support sequences
 splitting vectors words specialized-arrays ;
-SPECIALIZED-ARRAY: float
-SPECIALIZED-ARRAY: uint
+QUALIFIED-WITH: alien.c-types c
+SPECIALIZED-ARRAY: c:float
+SPECIALIZED-ARRAY: c:uint
 IN: bunny.model
 
 : numbers ( str -- seq )

diff --git a/extra/freetype/freetype.factor b/extra/freetype/freetype.factor
index c45475cefa30a9b81567e7232959c84e3f9e4f0b..0bfaae98532eb1248df93a8489a140dec895d859 100644 (file)
--- a/extra/freetype/freetype.factor
+++ b/extra/freetype/freetype.factor
@@ -23,7 +23,7 @@ TYPEDEF: ushort FT_UShort
 TYPEDEF: long FT_Long
 TYPEDEF: ulong FT_ULong
 TYPEDEF: uchar FT_Bool
-TYPEDEF: cell FT_Offset
+TYPEDEF: ulong FT_Offset
 TYPEDEF: int FT_PtrDist
 TYPEDEF: char FT_String
 TYPEDEF: int FT_Tag

diff --git a/extra/gpu/demos/bunny/bunny.factor b/extra/gpu/demos/bunny/bunny.factor
index 10e49984a1c63d5cb052493af8ca67799f1fc1de..d6c7456d63a9cf009201a7e0425f6d8750c71dde 100755 (executable)
--- a/extra/gpu/demos/bunny/bunny.factor
+++ b/extra/gpu/demos/bunny/bunny.factor
@@ -7,6 +7,7 @@ io io.encodings.ascii io.files io.files.temp kernel math
 math.matrices math.parser math.vectors method-chains sequences
 splitting threads ui ui.gadgets ui.gadgets.worlds
 ui.pixel-formats specialized-arrays specialized-vectors ;
+FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 SPECIALIZED-VECTOR: uint
 IN: gpu.demos.bunny

diff --git a/extra/gpu/render/render.factor b/extra/gpu/render/render.factor
index 0ee9ab78c56c1a3f1d26fa9bbde031623fba0ca0..9d8c15ab7a6d824e55fed87e4180b3d99e2bb526 100644 (file)
--- a/extra/gpu/render/render.factor
+++ b/extra/gpu/render/render.factor
@@ -9,7 +9,9 @@ lexer locals math math.order math.parser namespaces opengl
 opengl.gl parser quotations sequences slots sorting
 specialized-arrays strings ui.gadgets.worlds variants
 vocabs.parser words ;
-SPECIALIZED-ARRAY: float
+FROM: math => float ;
+QUALIFIED-WITH: alien.c-types c
+SPECIALIZED-ARRAY: c:float
 SPECIALIZED-ARRAY: int
 SPECIALIZED-ARRAY: uint
 SPECIALIZED-ARRAY: void*

diff --git a/extra/gpu/state/state.factor b/extra/gpu/state/state.factor
index 02d60467221bdd8de3a8fe0a0c85cfd785ebc759..2bca8f72fcf8c4d57bc65911948b680b47bd78e9 100755 (executable)
--- a/extra/gpu/state/state.factor
+++ b/extra/gpu/state/state.factor
@@ -2,8 +2,10 @@
 USING: accessors alien.c-types arrays byte-arrays combinators gpu
 kernel literals math math.rectangles opengl opengl.gl sequences
 variants specialized-arrays ;
+QUALIFIED-WITH: alien.c-types c
+FROM: math => float ;
 SPECIALIZED-ARRAY: int
-SPECIALIZED-ARRAY: float
+SPECIALIZED-ARRAY: c:float
 IN: gpu.state
 
 UNION: ?rect rect POSTPONE: f ;

diff --git a/extra/gpu/textures/textures.factor b/extra/gpu/textures/textures.factor
index 8015ff9a9b7517e90e1b786b9cf8dd15807ecddd..2649f7c586607987e20e1543ca211790bcc3608f 100644 (file)
--- a/extra/gpu/textures/textures.factor
+++ b/extra/gpu/textures/textures.factor
@@ -3,6 +3,7 @@ USING: accessors alien.c-types arrays byte-arrays combinators
 destructors fry gpu gpu.buffers images kernel locals math
 opengl opengl.gl opengl.textures sequences
 specialized-arrays ui.gadgets.worlds variants ;
+FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 IN: gpu.textures
 

diff --git a/extra/jamshred/gl/gl.factor b/extra/jamshred/gl/gl.factor
index 1a03a2c9413fecfb786690d93bf79a04400e7882..60e9e39d9f5abf8d3611841355eedb5e683b3a24 100644 (file)
--- a/extra/jamshred/gl/gl.factor
+++ b/extra/jamshred/gl/gl.factor
@@ -4,6 +4,7 @@ USING: accessors alien.c-types jamshred.game jamshred.oint
 jamshred.player jamshred.tunnel kernel math math.constants
 math.functions math.vectors opengl opengl.gl opengl.glu
 opengl.demo-support sequences specialized-arrays ;
+FROM: alien.c-types => float ;
 SPECIALIZED-ARRAY: float
 IN: jamshred.gl
 

diff --git a/extra/openal/openal.factor b/extra/openal/openal.factor
index 81a6621eff5180d9c4fff499887b407df83ef5e8..bccdec14200a1da41e422bb7b90595380660fdd3 100644 (file)
--- a/extra/openal/openal.factor
+++ b/extra/openal/openal.factor
@@ -4,6 +4,7 @@ USING: kernel accessors arrays alien system combinators
 alien.syntax namespaces alien.c-types sequences vocabs.loader
 shuffle openal.backend alien.libraries generalizations
 specialized-arrays ;
+FROM: alien.c-types => float short ;
 SPECIALIZED-ARRAY: uint
 IN: openal
 

diff --git a/extra/synth/buffers/buffers.factor b/extra/synth/buffers/buffers.factor
index 71b05ac6421f2813af784a4a7012fffae3ea22ab..978fb32d423492a5c7afd22192f3b616648415ad 100644 (file)
--- a/extra/synth/buffers/buffers.factor
+++ b/extra/synth/buffers/buffers.factor
@@ -2,6 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien.c-types combinators kernel locals math
 math.ranges openal sequences sequences.merged specialized-arrays ;
+FROM: alien.c-types => short ;
 SPECIALIZED-ARRAY: uchar
 SPECIALIZED-ARRAY: short
 IN: synth.buffers