Merge branch 'master' of git://factorcode.org/git/factor

basis/alien/c-types/c-types-tests.factor

@@ -1,50 +1,50 @@
-USING: alien alien.syntax alien.c-types kernel tools.test
+USING: alien alien.syntax alien.c-types alien.parser
-sequences system libc alien.strings io.encodings.utf8
+kernel tools.test sequences system libc alien.strings
-math.constants ;
+io.encodings.utf8 math.constants classes.struct ;
 IN: alien.c-types.tests
 
 CONSTANT: xyz 123
 
-[ 492 ] [ { "int" xyz } heap-size ] unit-test
+[ 492 ] [ { int xyz } heap-size ] unit-test
 
 [ -1 ] [ -1 <char> *char ] unit-test
 [ -1 ] [ -1 <short> *short ] unit-test
 [ -1 ] [ -1 <int> *int ] unit-test
 
-C-UNION: foo
+UNION-STRUCT: foo
-    "int"
+    { a int }
-    "int" ;
+    { b int } ;
 
-[ f ] [ "char*" c-type "void*" c-type eq? ] unit-test
+[ f ] [ "char*"  parse-c-type c-type void* c-type eq? ] unit-test
-[ t ] [ "char**" c-type "void*" c-type eq? ] unit-test
+[ t ] [ "char**" parse-c-type c-type void* c-type eq? ] unit-test
 
-[ t ] [ "foo" heap-size "int" heap-size = ] unit-test
+[ t ] [ foo heap-size int heap-size = ] unit-test
 
 TYPEDEF: int MyInt
 
-[ t ] [ "int" c-type "MyInt" c-type eq? ] unit-test
+[ t ] [ int c-type MyInt c-type eq? ] unit-test
-[ t ] [ "void*" c-type "MyInt*" c-type eq? ] unit-test
+[ t ] [ void* c-type "MyInt*" parse-c-type c-type eq? ] unit-test
 
 TYPEDEF: char MyChar
 
-[ t ] [ "char" c-type "MyChar" c-type eq? ] unit-test
+[ t ] [ char c-type MyChar c-type eq? ] unit-test
-[ f ] [ "void*" c-type "MyChar*" c-type eq? ] unit-test
+[ f ] [  void*               c-type "MyChar*" parse-c-type c-type eq? ] unit-test
-[ t ] [ "char*" c-type "MyChar*" c-type eq? ] unit-test
+[ t ] [ "char*" parse-c-type c-type "MyChar*" parse-c-type c-type eq? ] unit-test
 
-[ 32 ] [ { "int" 8 } heap-size ] unit-test
+[ 32 ] [ { int 8 } heap-size ] unit-test
 
 TYPEDEF: char* MyString
 
-[ t ] [ "char*" c-type "MyString" c-type eq? ] unit-test
+[ t ] [ char* c-type  MyString                c-type eq? ] unit-test
-[ t ] [ "void*" c-type "MyString*" c-type eq? ] unit-test
+[ t ] [ void* c-type "MyString*" parse-c-type c-type eq? ] unit-test
 
 TYPEDEF: int* MyIntArray
 
-[ t ] [ "void*" c-type "MyIntArray" c-type eq? ] unit-test
+[ t ] [ void* c-type MyIntArray c-type eq? ] unit-test
 
 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*>

basis/opengl/gl/windows/windows.factor

@@ -1,4 +1,4 @@
-USING: alien.syntax kernel windows.types ;
+USING: alien.c-types alien.syntax kernel windows.types ;
 IN: opengl.gl.windows
 
 LIBRARY: gl

basis/windows/advapi32/advapi32.factor

@@ -1,5 +1,5 @@
-USING: alien.syntax kernel math windows.types windows.kernel32
+USING: alien.c-types alien.syntax kernel math windows.types
-math.bitwise classes.struct ;
+windows.kernel32 math.bitwise classes.struct ;
 IN: windows.advapi32
 
 LIBRARY: advapi32
@@ -222,15 +222,15 @@ C-ENUM:
     SE_WMIGUID_OBJECT
     SE_REGISTRY_WOW64_32KEY ;
 
-TYPEDEF: TRUSTEE* PTRUSTEE
-
 STRUCT: TRUSTEE
-    { pMultipleTrustee PTRUSTEE }
+    { pMultipleTrustee TRUSTEE* }
     { MultipleTrusteeOperation MULTIPLE_TRUSTEE_OPERATION }
     { TrusteeForm TRUSTEE_FORM }
     { TrusteeType TRUSTEE_TYPE }
     { ptstrName LPTSTR } ;
 
+TYPEDEF: TRUSTEE* PTRUSTEE
+
 STRUCT: EXPLICIT_ACCESS
     { grfAccessPermissions DWORD }
     { grfAccessMode ACCESS_MODE }

basis/windows/com/com.factor

@@ -10,6 +10,8 @@ COM-INTERFACE: IUnknown f {00000000-0000-0000-C000-000000000046}
     ULONG AddRef ( )
     ULONG Release ( ) ;
 
+TYPEDEF: void* IAdviseSink*
+
 COM-INTERFACE: IDataObject IUnknown {0000010E-0000-0000-C000-000000000046}
     HRESULT GetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium )
     HRESULT GetDataHere ( FORMATETC* pFormatetc, STGMEDIUM* pmedium )
@@ -27,6 +29,10 @@ COM-INTERFACE: IDropTarget IUnknown {00000122-0000-0000-C000-000000000046}
     HRESULT DragLeave ( )
     HRESULT Drop ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect ) ;
 
+FUNCTION: HRESULT RegisterDragDrop ( HWND hWnd, IDropTarget* pDropTarget ) ;
+FUNCTION: HRESULT RevokeDragDrop ( HWND hWnd ) ;
+FUNCTION: void ReleaseStgMedium ( LPSTGMEDIUM pmedium ) ;
+
 : com-query-interface ( interface iid -- interface' )
     [
         "void*" malloc-object &free

basis/windows/com/syntax/syntax.factor

@@ -1,8 +1,8 @@
-USING: alien alien.c-types alien.accessors effects kernel
+USING: alien alien.c-types alien.accessors alien.parser
-windows.ole32 parser lexer splitting grouping sequences
+effects kernel windows.ole32 parser lexer splitting grouping
-namespaces assocs quotations generalizations accessors words
+sequences namespaces assocs quotations generalizations
-macros alien.syntax fry arrays layouts math classes.struct
+accessors words macros alien.syntax fry arrays layouts math
-windows.kernel32 ;
+classes.struct windows.kernel32 ;
 IN: windows.com.syntax
 
 <PRIVATE
@@ -14,7 +14,7 @@ MACRO: com-invoke ( n return parameters -- )
         "stdcall" alien-indirect
     ] ;
 
-TUPLE: com-interface-definition name parent iid functions ;
+TUPLE: com-interface-definition word parent iid functions ;
 C: <com-interface-definition> com-interface-definition
 
 TUPLE: com-function-definition name return parameters ;
@@ -25,22 +25,25 @@ SYMBOL: +com-interface-definitions+
 [ H{ } +com-interface-definitions+ set-global ]
 unless
 
+ERROR: no-com-interface interface ;
+
 : find-com-interface-definition ( name -- definition )
-    dup "f" = [ drop f ] [
+    [
         dup +com-interface-definitions+ get-global at*
-        [ nip ]
+        [ nip ] [ drop no-com-interface ] if
-        [ " COM interface hasn't been defined" prepend throw ]
+    ] [ f ] if* ;
-        if
-    ] if ;
 
 : save-com-interface-definition ( definition -- )
-    dup name>> +com-interface-definitions+ get-global set-at ;
+    dup word>> +com-interface-definitions+ get-global set-at ;
 
 : (parse-com-function) ( tokens -- definition )
     [ second ]
     [ first ]
-    [ 3 tail [ CHAR: , swap remove ] map 2 group { "void*" "this" } prefix ]
+    [
-    tri
+        3 tail [ CHAR: , swap remove ] map
+        2 group [ first2 normalize-c-arg 2array ] map
+        { void* "this" } prefix
+    ] tri
     <com-function-definition> ;
 
 : parse-com-functions ( -- functions )
@@ -48,10 +51,11 @@ unless
     [ (parse-com-function) ] map ;
 
 : (iid-word) ( definition -- word )
-    name>> "-iid" append create-in ;
+    word>> name>> "-iid" append create-in ;
 
 : (function-word) ( function interface -- word )
-    name>> "::" rot name>> 3append create-in ;
+    swap [ word>> name>> "::" ] [ name>> ] bi*
+    3append create-in ;
 
 : family-tree ( definition -- definitions )
     dup parent>> [ family-tree ] [ { } ] if*
@@ -79,7 +83,7 @@ unless
 
 : define-words-for-com-interface ( definition -- )
     [ [ (iid-word) ] [ iid>> 1quotation ] bi (( -- iid )) define-declared ]
-    [ name>> "com-interface" swap typedef ]
+    [ word>> void* swap typedef ]
     [
         dup family-tree-functions
         [ (define-word-for-function) ] with each-index
@@ -89,8 +93,8 @@ unless
 PRIVATE>
 
 SYNTAX: COM-INTERFACE:
-    scan
+    CREATE-C-TYPE
-    scan find-com-interface-definition
+    scan-object find-com-interface-definition
     scan string>guid
     parse-com-functions
     <com-interface-definition>

basis/windows/dinput/dinput.factor

@@ -1,6 +1,6 @@
 USING: windows.kernel32 windows.ole32 windows.com windows.com.syntax
 alien alien.c-types alien.syntax kernel system namespaces math
-classes.struct ;
+classes.struct windows.types ;
 IN: windows.dinput
 
 LIBRARY: dinput

basis/windows/gdi32/gdi32.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2006 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax alien.destructors kernel windows.types
+USING: alien alien.c-types alien.syntax alien.destructors
-math.bitwise ;
+kernel windows.types math.bitwise ;
 IN: windows.gdi32
 
 CONSTANT: BI_RGB 0

basis/windows/kernel32/kernel32.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2006 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax kernel windows.types multiline
+USING: alien alien.c-types alien.syntax kernel windows.types
-classes.struct ;
+multiline classes.struct ;
 IN: windows.kernel32
 
 CONSTANT: MAX_PATH 260
@@ -543,7 +543,7 @@ STRUCT: DCB
 TYPEDEF: DCB* PDCB
 TYPEDEF: DCB* LPDCB
 
-STRUCT: COMM_CONFIG
+STRUCT: COMMCONFIG
     { dwSize DWORD }
     { wVersion WORD }
     { wReserved WORD }

basis/windows/ole32/ole32.factor

@@ -111,10 +111,6 @@ CONSTANT: COINIT_SPEED_OVER_MEMORY 8
 FUNCTION: HRESULT OleInitialize ( void* reserved ) ;
 FUNCTION: HRESULT CoInitializeEx ( void* reserved, DWORD dwCoInit ) ;
 
-FUNCTION: HRESULT RegisterDragDrop ( HWND hWnd, IDropTarget* pDropTarget ) ;
-FUNCTION: HRESULT RevokeDragDrop ( HWND hWnd ) ;
-FUNCTION: void ReleaseStgMedium ( LPSTGMEDIUM pmedium ) ;
-
 : succeeded? ( hresult -- ? )
     0 HEX: 7FFFFFFF between? ;
 

basis/windows/shell32/shell32.factor

@@ -3,8 +3,8 @@
 USING: alien alien.c-types alien.strings alien.syntax
 classes.struct combinators io.encodings.utf16n io.files
 io.pathnames kernel windows.errors windows.com
-windows.com.syntax windows.user32 windows.ole32 windows
+windows.com.syntax windows.types windows.user32
-specialized-arrays ;
+windows.ole32 windows specialized-arrays ;
 SPECIALIZED-ARRAY: ushort
 IN: windows.shell32
 

basis/windows/types/types.factor

@@ -61,6 +61,7 @@ TYPEDEF: ulong       ULONG_PTR
 TYPEDEF: int         INT32
 TYPEDEF: uint        UINT32
 TYPEDEF: uint        DWORD32
+TYPEDEF: long        LONG32
 TYPEDEF: ulong       ULONG32
 TYPEDEF: ulonglong   ULONG64
 TYPEDEF: long*       POINTER_32
@@ -75,6 +76,8 @@ TYPEDEF: longlong    LARGE_INTEGER
 TYPEDEF: ulonglong   ULARGE_INTEGER
 TYPEDEF: LARGE_INTEGER* PLARGE_INTEGER
 TYPEDEF: ULARGE_INTEGER* PULARGE_INTEGER
+TYPEDEF: size_t SIZE_T
+TYPEDEF: ptrdiff_t SSIZE_T
 
 TYPEDEF: wchar_t*  LPCSTR
 TYPEDEF: wchar_t*  LPWSTR
@@ -201,15 +204,6 @@ TYPEDEF: LONG_PTR            SSIZE_T
 TYPEDEF: LONGLONG            USN
 TYPEDEF: UINT_PTR            WPARAM
 
-TYPEDEF: RECT* LPRECT
-TYPEDEF: void* PWNDCLASS
-TYPEDEF: void* PWNDCLASSEX
-TYPEDEF: void* LPWNDCLASS
-TYPEDEF: void* LPWNDCLASSEX
-TYPEDEF: void* MSGBOXPARAMSA
-TYPEDEF: void* MSGBOXPARAMSW
-TYPEDEF: void* LPOVERLAPPED_COMPLETION_ROUTINE
-
 TYPEDEF: size_t socklen_t
 
 TYPEDEF: void* WNDPROC
@@ -343,6 +337,14 @@ TYPEDEF: PFD* LPPFD
 TYPEDEF: HANDLE HGLRC
 TYPEDEF: HANDLE HRGN
 
+TYPEDEF: void* PWNDCLASS
+TYPEDEF: void* PWNDCLASSEX
+TYPEDEF: void* LPWNDCLASS
+TYPEDEF: void* LPWNDCLASSEX
+TYPEDEF: void* MSGBOXPARAMSA
+TYPEDEF: void* MSGBOXPARAMSW
+TYPEDEF: void* LPOVERLAPPED_COMPLETION_ROUTINE
+
 STRUCT: LVITEM
     { mask uint }
     { iItem int }

basis/windows/user32/user32.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005, 2006 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax parser namespaces kernel math
+USING: alien alien.c-types alien.syntax parser namespaces
-windows.types generalizations math.bitwise classes.struct
+kernel math windows.types generalizations math.bitwise
-literals ;
+classes.struct literals windows.kernel32 ;
 IN: windows.user32
 
 ! HKL for ActivateKeyboardLayout

basis/windows/usp10/usp10.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax alien.destructors classes.struct ;
+USING: alien.c-types alien.syntax alien.destructors classes.struct
+windows.types ;
 IN: windows.usp10
 
 LIBRARY: usp10
@@ -56,6 +57,9 @@ SCRIPT_JUSTIFFY_RESERVED4 ;
 STRUCT: SCRIPT_VISATTR
     { flags WORD } ;
 
+TYPEDEF: void* SCRIPT_CACHE*
+TYPEDEF: void* ABC*
+
 FUNCTION: HRESULT ScriptShape (
     HDC hdc,
     SCRIPT_CACHE* psc,

basis/windows/winsock/winsock.factor

@@ -105,6 +105,8 @@ CONSTANT: SD_BOTH 2
 
 CONSTANT: SOL_SOCKET HEX: ffff
 
+TYPEDEF: void* sockaddr*
+
 STRUCT: sockaddr-in
     { family short }
     { port ushort }
@@ -139,13 +141,15 @@ STRUCT: timeval
     { sec long }
     { usec long } ;
 
+TYPEDEF: void* fd_set*
+
 LIBRARY: winsock
 
 FUNCTION: int setsockopt ( SOCKET s, int level, int optname, char* optval, int optlen ) ;
 
 FUNCTION: ushort htons ( ushort n ) ;
 FUNCTION: ushort ntohs ( ushort n ) ;
-FUNCTION: int bind ( void* socket, sockaddr_in* sockaddr, int len ) ;
+FUNCTION: int bind ( void* socket, sockaddr-in* sockaddr, int len ) ;
 FUNCTION: int listen ( void* socket, int backlog ) ;
 FUNCTION: char* inet_ntoa ( int in-addr ) ;
 FUNCTION: int getaddrinfo ( char* nodename,
@@ -158,15 +162,15 @@ FUNCTION: void freeaddrinfo ( addrinfo* ai ) ;
 
 FUNCTION: hostent* gethostbyname ( char* name ) ;
 FUNCTION: int gethostname ( char* name, int len ) ;
-FUNCTION: int connect ( void* socket, sockaddr_in* sockaddr, int addrlen ) ;
+FUNCTION: int connect ( void* socket, sockaddr-in* sockaddr, int addrlen ) ;
 FUNCTION: int select ( int nfds, fd_set* readfds, fd_set* writefds, fd_set* exceptfds, timeval* timeout ) ;
 FUNCTION: int closesocket ( SOCKET s ) ;
 FUNCTION: int shutdown ( SOCKET s, int how ) ;
 FUNCTION: int send ( SOCKET s, char* buf, int len, int flags ) ;
 FUNCTION: int recv ( SOCKET s, char* buf, int len, int flags ) ;
 
-FUNCTION: int getsockname ( SOCKET s, sockaddr_in* address, int* addrlen ) ;
+FUNCTION: int getsockname ( SOCKET s, sockaddr-in* address, int* addrlen ) ;
-FUNCTION: int getpeername ( SOCKET s, sockaddr_in* address, int* addrlen ) ;
+FUNCTION: int getpeername ( SOCKET s, sockaddr-in* address, int* addrlen ) ;
 
 TYPEDEF: uint SERVICETYPE
 TYPEDEF: OVERLAPPED WSAOVERLAPPED