Merge branch 'master' into new-alien-pointers

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

diff --combined basis/alien/c-types/c-types.factor
index 9db6ac7f4a18a9a58b9fe6ceeba7be7f8d130ac0,fff49a44808831871d4c28bddaae6da67f17cc32..a9392b03d7489829d838eaf38c719283de7cf5bb
--- 1/basis/alien/c-types/c-types.factor
--- 2/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@@ -17,8 -17,9 +17,9 @@@ SYMBOLS
      long ulong
      longlong ulonglong
      float double
-     bool void*
-     void ;
+     void* bool ;
+ 
+ SINGLETON: void
  
  DEFER: <int>
  DEFER: *char
@@@ -45,33 -46,29 +46,22 @@@ stack-align? 
  
  ERROR: no-c-type name ;
  
 -PREDICATE: c-type-word < word
 -    "c-type" word-prop ;
 -
 -UNION: c-type-name string c-type-word ;
 -
  ! C type protocol
  GENERIC: c-type ( name -- c-type ) foldable
  
- : void? ( c-type -- ? )
-     void = ; inline
 -GENERIC: resolve-pointer-type ( name -- c-type )
--
 -<< \ void \ void* "pointer-c-type" set-word-prop >>
 +PREDICATE: c-type-word < word
 +    "c-type" word-prop ;
  
 -M: word resolve-pointer-type
 -    dup "pointer-c-type" word-prop
 -    [ ] [ drop void* ] ?if ;
 +TUPLE: pointer { to initial: void read-only } ;
 +C: <pointer> pointer
  
 -M: array resolve-pointer-type
 -    first resolve-pointer-type ;
 +UNION: c-type-name
 +    c-type-word pointer ;
  
  : resolve-typedef ( name -- c-type )
      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 ;
@@@ -242,13 -239,14 +232,13 @@@ M: word typedef ( old new -- 
      {
          [ nip define-symbol ]
          [ swap "c-type" set-word-prop ]
 -        [
 -            swap dup c-type-name? [
 -                resolve-pointer-type
 -                "pointer-c-type" set-word-prop
 -            ] [ 2drop ] if
 -        ]
      } 2cleave ;
  
 +M: pointer typedef ( old new -- )
 +    to>> dup c-type-word?
 +    [ swap "pointer-c-type" set-word-prop ]
 +    [ 2drop ] if ;
 +
  TUPLE: long-long-type < c-type ;
  
  : <long-long-type> ( -- c-type )
@@@ -281,10 -279,6 +271,10 @@@ M: long-long-type box-return ( c-type -
  : if-void ( c-type true false -- )
      pick void? [ drop nip call ] [ nip call ] if ; inline
  
 +SYMBOLS:
 +    ptrdiff_t intptr_t uintptr_t size_t
 +    byte ubyte char* ;
 +
  CONSTANT: primitive-types
      {
          char uchar
@@@ -294,39 -288,11 +284,39 @@@
          longlong ulonglong
          float double
          void* bool
 +        char*
      }
  
 -SYMBOLS:
 -    ptrdiff_t intptr_t uintptr_t size_t
 -    char* uchar* ;
 +: (pointer-c-type) ( void* type -- void*' )
 +    [ clone ] dip c-type-boxer-quot >>boxer-quot ;
 +
 +<PRIVATE
 +
 +: resolve-pointer-typedef ( type -- base-type )
 +    dup "c-type" word-prop dup word?
 +    [ nip resolve-pointer-typedef ] [
 +        pointer? [ drop void* ] when
 +    ] if ;
 +
 +: special-pointer-type ( type -- special-type )
 +    dup c-type-word? [
 +        dup "pointer-c-type" word-prop
 +        [ ] [ resolve-pointer-typedef "pointer-c-type" word-prop ] ?if
 +    ] [ drop f ] if ;
 +
 +: primitive-pointer-type? ( type -- ? )
 +    dup c-type-word? [
 +        resolve-pointer-typedef [ void? ] [ primitive-types member? ] bi or
 +    ] [ drop t ] if ;
 +
 +PRIVATE>
 +
 +M: pointer c-type
 +    [ \ void* c-type ] dip
 +    to>> dup special-pointer-type
 +    [ nip ] [
 +        dup primitive-pointer-type? [ drop ] [ (pointer-c-type) ] if
 +    ] ?if ;
  
  : 8-byte-alignment ( c-type -- c-type )
      {
@@@ -539,9 -505,6 +529,9 @@@
          \ uint c-type \ uintptr_t typedef
          \ uint c-type \ size_t typedef
      ] if
 +
 +    \ char \ byte typedef
 +    \ uchar \ ubyte typedef
  ] with-compilation-unit
  
  M: char-16-rep rep-component-type drop char ;

diff --combined basis/alien/parser/parser.factor
index 837c2e3bdc7f7fe7ae986b2cc609ee6b03f0590d,8385bfb97f61b51d9b807f379d77dbe96a981745..474bb77dc6756b3ba2d25123ab6ed74e1d29af4e
--- 1/basis/alien/parser/parser.factor
--- 2/basis/alien/parser/parser.factor
+++ b/basis/alien/parser/parser.factor
@@@ -1,4 -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
@@@ -18,23 -18,22 +18,23 @@@ IN: alien.parse
      {
          { [ dup "void" =         ] [ drop void ] }
          { [ CHAR: ] over member? ] [ parse-array-type parse-c-type-name prefix ] }
 +        { [ "*" ?tail            ] [ (parse-c-type) <pointer> ] }
          { [ dup search           ] [ parse-c-type-name ] }
 -        { [ "**" ?tail           ] [ drop void* ] }
 -        { [ "*" ?tail            ] [ parse-c-type-name resolve-pointer-type ] }
          [ dup search [ ] [ no-word ] ?if ]
      } cond ;
  
  : valid-c-type? ( c-type -- ? )
 -    { [ array? ] [ c-type-name? ] [ void? ] } 1|| ;
 +    { [ array? ] [ c-type-word? ] [ pointer? ] [ void? ] } 1|| ;
  
  : parse-c-type ( string -- type )
      (parse-c-type) dup valid-c-type? [ no-c-type ] unless ;
  
  : scan-c-type ( -- c-type )
 -    scan dup "{" =
 -    [ drop \ } parse-until >array ]
 -    [ parse-c-type ] if ; 
 +    scan {
 +        { [ dup "{" = ] [ drop \ } parse-until >array ] }
 +        { [ dup "pointer:" = ] [ drop scan-c-type <pointer> ] }
 +        [ parse-c-type ]
 +    } cond ; 
  
  : reset-c-type ( word -- )
      dup "struct-size" word-prop
@@@ -67,16 -66,16 +67,16 @@@
          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 -88,10 +89,10 @@@
      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 -112,3 +113,3 @@@ PREDICATE: alien-function-word < wor
  
  PREDICATE: alien-callback-type-word < typedef-word
      "callback-effect" word-prop ;
- 

diff --combined basis/stack-checker/dependencies/dependencies.factor
index ffa021c9f6ec87d3e0f6dcb2db89b2184094e68b,25fe12cbc5890b211f930d8a4413ff0231fb245e..e2f7c5759301cdd4a3ce908883221d13d781abef
--- 1/basis/stack-checker/dependencies/dependencies.factor
--- 2/basis/stack-checker/dependencies/dependencies.factor
+++ b/basis/stack-checker/dependencies/dependencies.factor
@@@ -40,14 -40,13 +40,16 @@@ SYMBOLS: effect-dependency conditional-
  
  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 ;
  
 +M: pointer depends-on-c-type
 +    to>> depends-on-c-type ;
 +
  ! Generic words that the current quotation depends on
  SYMBOL: generic-dependencies