Merge branch 'master' into new-alien-pointers

Conflicts:
	basis/alien/c-types/c-types.factor
	basis/stack-checker/dependencies/dependencies.factor

diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index 9db6ac7f4a18a9a58b9fe6ceeba7be7f8d130ac0..a9392b03d7489829d838eaf38c719283de7cf5bb 100644 (file)
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -17,8 +17,9 @@ SYMBOLS:
     long ulong
     longlong ulonglong
     float double
-    bool void*
-    void ;
+    void* bool ;
+
+SINGLETON: void
 
 DEFER: <int>
 DEFER: *char
@@ -48,9 +49,6 @@ ERROR: no-c-type name ;
 ! C type protocol
 GENERIC: c-type ( name -- c-type ) foldable
 
-: void? ( c-type -- ? )
-    void = ; inline
-
 PREDICATE: c-type-word < word
     "c-type" word-prop ;
 
@@ -64,14 +62,6 @@ UNION: c-type-name
     dup void? [ no-c-type ] when
     dup c-type-name? [ c-type ] when ;
 
-<PRIVATE
-
-: parse-array-type ( name -- dims c-type )
-    "[" split unclip
-    [ [ "]" ?tail drop string>number ] map ] dip ;
-
-PRIVATE>
-
 M: word c-type
     dup "c-type" word-prop resolve-typedef
     [ ] [ no-c-type ] ?if ;

diff --git a/basis/alien/libraries/authors.txt b/basis/alien/libraries/authors.txt
index 1901f27a24507e2512d93a1f956aaaa0d2f05714..580f882c8d78327fd1fc737a4da0624407fe0e7a 100644 (file)
--- a/basis/alien/libraries/authors.txt
+++ b/basis/alien/libraries/authors.txt
@@ -1 +1,2 @@
 Slava Pestov
+Joe Groff

diff --git a/basis/alien/libraries/libraries.factor b/basis/alien/libraries/libraries.factor
index 6f80900da0c54a1e72832dc58c4162e081455e73..47e34fe5fffa495699b6487b5393eece7a23d6a6 100644 (file)
--- a/basis/alien/libraries/libraries.factor
+++ b/basis/alien/libraries/libraries.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov, Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.strings assocs io.backend
 kernel namespaces destructors sequences system io.pathnames ;
@@ -9,10 +9,8 @@ IN: alien.libraries
 : dlsym ( name dll -- alien ) [ string>symbol ] dip (dlsym) ;
 
 SYMBOL: libraries
-SYMBOL: deploy-libraries
 
 libraries [ H{ } clone ] initialize
-deploy-libraries [ V{ } clone ] initialize
 
 TUPLE: library path abi dll ;
 
@@ -37,18 +35,29 @@ M: library dispose dll>> [ dispose ] when* ;
     [ 2drop remove-library ]
     [ <library> swap libraries get set-at ] 3bi ;
 
+: library-abi ( library -- abi )
+    library [ abi>> ] [ "cdecl" ] if* ;
+
+SYMBOL: deploy-libraries
+
+deploy-libraries [ V{ } clone ] initialize
+
 : deploy-library ( name -- )
     dup libraries get key?
     [ deploy-libraries get 2dup member? [ 2drop ] [ push ] if ]
     [ no-library ] if ;
 
 <PRIVATE
+
 HOOK: >deployed-library-path os ( path -- path' )
 
 M: windows >deployed-library-path
     file-name ;
+
 M: unix >deployed-library-path
     file-name "$ORIGIN" prepend-path ;
+
 M: macosx >deployed-library-path
     file-name "@executable_path/../Frameworks" prepend-path ;
+
 PRIVATE>

diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor
index 837c2e3bdc7f7fe7ae986b2cc609ee6b03f0590d..474bb77dc6756b3ba2d25123ab6ed74e1d29af4e 100644 (file)
--- a/basis/alien/parser/parser.factor
+++ b/basis/alien/parser/parser.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
+! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types alien.parser
 alien.libraries arrays assocs classes combinators
@@ -67,16 +67,16 @@ IN: alien.parser
         2 group [ first2 normalize-c-arg 2array ] map
         unzip [ "," ?tail drop ] map
     ]
-    [ [ { } ] [ 1array ] if-void ]
+    [ [ { } ] [ name>> 1array ] if-void ]
     bi* <effect> ;
 
 : function-quot ( return library function types -- quot )
     '[ _ _ _ _ alien-invoke ] ;
 
 :: make-function ( return library function parameters -- word quot effect )
-    return function normalize-c-arg :> ( return-c-type function )
+    return function normalize-c-arg :> ( return function )
     function create-in dup reset-generic
-    return-c-type library function
+    return library function
     parameters return parse-arglist [ function-quot ] dip ;
 
 : parse-arg-tokens ( -- tokens )
@@ -89,13 +89,10 @@ IN: alien.parser
     make-function define-declared ;
 
 : callback-quot ( return types abi -- quot )
-    [ [ ] 3curry dip alien-callback ] 3curry ;
+    '[ [ _ _ _ ] dip alien-callback ] ;
 
-: library-abi ( lib -- abi )
-    library [ abi>> ] [ "cdecl" ] if* ;
-
-:: make-callback-type ( lib return! type-name! parameters -- word quot effect )
-    return type-name normalize-c-arg type-name! return!
+:: make-callback-type ( lib return type-name parameters -- word quot effect )
+    return type-name normalize-c-arg :> ( return type-name )
     type-name current-vocab create :> type-word 
     type-word [ reset-generic ] [ reset-c-type ] bi
     void* type-word typedef
@@ -116,4 +113,3 @@ PREDICATE: alien-function-word < word
 
 PREDICATE: alien-callback-type-word < typedef-word
     "callback-effect" word-prop ;
-

diff --git a/basis/compiler/tests/redefine24.factor b/basis/compiler/tests/redefine24.factor
new file mode 100644 (file)
index 0000000..3911021
--- /dev/null
+++ b/basis/compiler/tests/redefine24.factor
@@ -0,0 +1,39 @@
+USING: alien alien.syntax eval math tools.test ;
+QUALIFIED: alien.c-types
+IN: compiler.tests.redefine24
+
+TYPEDEF: alien.c-types:int type-1
+
+TYPEDEF: alien.c-types:int type-3
+
+: callback ( -- ptr )
+    type-3 { type-1 type-1 } "cdecl" [ + >integer ] alien-callback ;
+
+TYPEDEF: alien.c-types:float type-2
+
+: indirect ( x y ptr -- z  )
+    type-3 { type-2 type-2 } "cdecl" alien-indirect ;
+
+[ ] [
+    "USING: alien.c-types alien.syntax ;
+    IN: compiler.tests.redefine24 TYPEDEF: int type-2" eval( -- )
+] unit-test
+
+[ 3 ] [ 1 2 callback indirect ] unit-test
+
+[ ] [
+    "USING: alien.c-types alien.syntax ;
+    IN: compiler.tests.redefine24
+    TYPEDEF: float type-1
+    TYPEDEF: float type-2" eval( -- )
+] unit-test
+
+[ 3 ] [ 1.0 2.0 callback indirect ] unit-test
+
+[ ] [
+    "USING: alien.c-types alien.syntax ;
+    IN: compiler.tests.redefine24
+    TYPEDEF: float type-3" eval( -- )
+] unit-test
+
+[ 3.0 ] [ 1.0 2.0 callback indirect ] unit-test

diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor
index fdfda6dd9e37ba417346be7b3bf6c92b1b36b4c0..81d8a93240dfc2ce867f3bfd0fdf9222671ae718 100644 (file)
--- a/basis/stack-checker/alien/alien.factor
+++ b/basis/stack-checker/alien/alien.factor
@@ -3,7 +3,7 @@
 USING: kernel sequences accessors combinators math namespaces
 init sets words assocs alien.libraries alien alien.c-types
 cpu.architecture fry stack-checker.backend stack-checker.errors
-stack-checker.visitor ;
+stack-checker.visitor stack-checker.dependencies ;
 IN: stack-checker.alien
 
 TUPLE: alien-node-params return parameters abi in-d out-d ;
@@ -16,65 +16,91 @@ TUPLE: alien-assembly-params < alien-node-params quot ;
 
 TUPLE: alien-callback-params < alien-node-params quot xt ;
 
-: param-prep-quot ( node -- quot )
+: param-prep-quot ( params -- quot )
     parameters>> [ c-type c-type-unboxer-quot ] map spread>quot ;
 
+: infer-params ( params -- )
+    param-prep-quot infer-quot-here ;
+
 : alien-stack ( params extra -- )
     over parameters>> length + consume-d >>in-d
     dup return>> void? 0 1 ? produce-d >>out-d
     drop ;
 
-: return-prep-quot ( node -- quot )
+: return-prep-quot ( params -- quot )
     return>> [ [ ] ] [ c-type c-type-boxer-quot ] if-void ;
 
+: infer-return ( params -- )
+    return-prep-quot infer-quot-here ;
+
+: pop-return ( params -- params )
+    pop-literal [ depends-on-c-type ] [ nip >>return ] bi ;
+
+: pop-library ( params -- params )
+    pop-literal nip >>library ;
+
+: pop-function ( params -- params )
+    pop-literal nip >>function ;
+
+: pop-params ( params -- params )
+    pop-literal [ [ depends-on-c-type ] each ] [ nip >>parameters ] bi ;
+
+: pop-abi ( params -- params )
+    pop-literal nip >>abi ;
+
+: pop-quot ( params -- params )
+    pop-literal nip >>quot ;
+
 : infer-alien-invoke ( -- )
     alien-invoke-params new
     ! Compile-time parameters
-    pop-literal nip >>parameters
-    pop-literal nip >>function
-    pop-literal nip >>library
-    pop-literal nip >>return
-    ! Quotation which coerces parameters to required types
-    dup param-prep-quot infer-quot-here
+    pop-params
+    pop-function
+    pop-library
+    pop-return
     ! Set ABI
-    dup library>> library [ abi>> ] [ "cdecl" ] if* >>abi
+    dup library>> library-abi >>abi
+    ! Quotation which coerces parameters to required types
+    dup infer-params
     ! Magic #: consume exactly the number of inputs
     dup 0 alien-stack
     ! Add node to IR
     dup #alien-invoke,
     ! Quotation which coerces return value to required type
-    return-prep-quot infer-quot-here ;
+    infer-return ;
 
 : infer-alien-indirect ( -- )
     alien-indirect-params new
     ! Compile-time parameters
-    pop-literal nip >>abi
-    pop-literal nip >>parameters
-    pop-literal nip >>return
+    pop-abi
+    pop-params
+    pop-return
     ! Quotation which coerces parameters to required types
-    dup param-prep-quot '[ _ dip ] infer-quot-here
+    1 infer->r
+    dup infer-params
+    1 infer-r>
     ! Magic #: consume the function pointer, too
     dup 1 alien-stack
     ! Add node to IR
     dup #alien-indirect,
     ! Quotation which coerces return value to required type
-    return-prep-quot infer-quot-here ;
+    infer-return ;
 
 : infer-alien-assembly ( -- )
     alien-assembly-params new
     ! Compile-time parameters
-    pop-literal nip >>quot
-    pop-literal nip >>abi
-    pop-literal nip >>parameters
-    pop-literal nip >>return
+    pop-quot
+    pop-abi
+    pop-params
+    pop-return
     ! Quotation which coerces parameters to required types
-    dup param-prep-quot infer-quot-here
+    dup infer-params
     ! Magic #: consume exactly the number of inputs
     dup 0 alien-stack
     ! Add node to IR
     dup #alien-assembly,
     ! Quotation which coerces return value to required type
-    return-prep-quot infer-quot-here ;
+    infer-return ;
 
 : callback-xt ( word return-rewind -- alien )
     [ callbacks get ] dip '[ _ <callback> ] cache ;
@@ -85,10 +111,10 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
 
 : infer-alien-callback ( -- )
     alien-callback-params new
-    pop-literal nip >>quot
-    pop-literal nip >>abi
-    pop-literal nip >>parameters
-    pop-literal nip >>return
+    pop-quot
+    pop-abi
+    pop-params
+    pop-return
     "( callback )" <uninterned-word> >>xt
     dup callback-bottom
     #alien-callback, ;

diff --git a/basis/stack-checker/dependencies/dependencies.factor b/basis/stack-checker/dependencies/dependencies.factor
index ffa021c9f6ec87d3e0f6dcb2db89b2184094e68b..e2f7c5759301cdd4a3ce908883221d13d781abef 100644 (file)
--- a/basis/stack-checker/dependencies/dependencies.factor
+++ b/basis/stack-checker/dependencies/dependencies.factor
@@ -40,7 +40,9 @@ SYMBOLS: effect-dependency conditional-dependency definition-dependency ;
 
 GENERIC: depends-on-c-type ( c-type -- )
 
-M: word depends-on-c-type depends-on-definition ;
+M: void depends-on-c-type drop ;
+
+M: c-type-word depends-on-c-type depends-on-definition ;
 
 M: array depends-on-c-type
     [ word? ] filter [ depends-on-definition ] each ;

diff --git a/basis/windows/ddk/hid/platforms.txt b/basis/windows/ddk/hid/platforms.txt
new file mode 100644 (file)
index 0000000..205e643
--- /dev/null
+++ b/basis/windows/ddk/hid/platforms.txt
@@ -0,0 +1 @@
+winnt