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

basis/calendar/windows/windows.factor

@@ -1,15 +1,13 @@
 USING: calendar namespaces alien.c-types system
-windows.kernel32 kernel math combinators windows.errors ;
+windows.kernel32 kernel math combinators windows.errors
+accessors classes.struct ;
 IN: calendar.windows
 
 M: windows gmt-offset ( -- hours minutes seconds )
-    "TIME_ZONE_INFORMATION" <c-object>
+    TIME_ZONE_INFORMATION <struct>
     dup GetTimeZoneInformation {
         { TIME_ZONE_ID_INVALID [ win32-error-string throw ] }
-        { TIME_ZONE_ID_UNKNOWN [ TIME_ZONE_INFORMATION-Bias ] }
+        { TIME_ZONE_ID_UNKNOWN [ Bias>> ] }
-        { TIME_ZONE_ID_STANDARD [ TIME_ZONE_INFORMATION-Bias ] }
+        { TIME_ZONE_ID_STANDARD [ Bias>> ] }
-        { TIME_ZONE_ID_DAYLIGHT [
+        { TIME_ZONE_ID_DAYLIGHT [ [ Bias>> ] [ DaylightBias>> ] bi + ] }
-            [ TIME_ZONE_INFORMATION-Bias ]
-            [ TIME_ZONE_INFORMATION-DaylightBias ] bi +
-        ] }
     } case neg 60 /mod 0 ;

basis/classes/struct/struct-tests.factor

@@ -6,7 +6,7 @@ kernel libc literals math multiline namespaces prettyprint
 prettyprint.config see sequences specialized-arrays.ushort
 system tools.test compiler.tree.debugger struct-arrays
 classes.tuple.private specialized-arrays.direct.int
-compiler.units ;
+compiler.units byte-arrays specialized-arrays.char ;
 IN: classes.struct.tests
 
 <<
@@ -204,4 +204,27 @@ STRUCT: struct-test-optimization
 
 [ f ] [ [ memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
 
-[ f ] [ struct-test-foo <struct> dup clone [ >c-ptr ] bi@ eq? ] unit-test
+! Test cloning structs
+STRUCT: clone-test-struct { x int } { y char[3] } ;
+
+[ 1 char-array{ 9 1 1 } ] [
+    clone-test-struct <struct>
+    1 >>x char-array{ 9 1 1 } >>y
+    clone
+    [ x>> ] [ y>> >char-array ] bi
+] unit-test
+
+[ t 1 char-array{ 9 1 1 } ] [
+    [
+        clone-test-struct malloc-struct &free
+        1 >>x char-array{ 9 1 1 } >>y
+        clone
+        [ >c-ptr byte-array? ] [ x>> ] [ y>> >char-array ] tri
+    ] with-destructors
+] unit-test
+
+STRUCT: struct-that's-a-word { x int } ;
+
+: struct-that's-a-word ( -- ) "OOPS" throw ;
+
+[ -77 ] [ S{ struct-that's-a-word { x -77 } } clone x>> ] unit-test

basis/classes/struct/struct.factor

@@ -46,9 +46,6 @@ M: struct equal?
     dup struct-class? [ '[ _ boa ] ] [ drop f ] if
 ] 1 define-partial-eval
 
-M: struct clone
-    [ >c-ptr ] [ byte-length memory>byte-array ] [ class memory>struct ] tri ;
-
 <PRIVATE
 : (init-struct) ( class with-prototype: ( prototype -- alien ) sans-prototype: ( class -- alien ) -- alien )
     '[ dup struct-prototype _ _ ?if ] keep memory>struct ; inline
@@ -58,13 +55,13 @@ PRIVATE>
     [ heap-size malloc ] keep memory>struct ; inline
 
 : malloc-struct ( class -- struct )
-    [ >c-ptr malloc-byte-array ] [ 1 swap heap-size calloc ] (init-struct) ;
+    [ >c-ptr malloc-byte-array ] [ 1 swap heap-size calloc ] (init-struct) ; inline
 
 : (struct) ( class -- struct )
     [ heap-size (byte-array) ] keep memory>struct ; inline
 
 : <struct> ( class -- struct )
-    [ >c-ptr clone ] [ heap-size <byte-array> ] (init-struct) ;
+    [ >c-ptr clone ] [ heap-size <byte-array> ] (init-struct) ; inline
 
 MACRO: <struct-boa> ( class -- quot: ( ... -- struct ) )
     [
@@ -119,13 +116,24 @@ M: struct-class writer-quot
     \ cleave [ ] 2sequence
     \ output>array [ ] 2sequence ;
 
+: define-inline-method ( class generic quot -- )
+    [ create-method-in ] dip [ define ] [ drop make-inline ] 2bi ;
+
 : (define-struct-slot-values-method) ( class -- )
-    [ \ struct-slot-values create-method-in ]
+    [ \ struct-slot-values ] [ struct-slot-values-quot ] bi
-    [ struct-slot-values-quot ] bi define ;
+    define-inline-method ;
 
 : (define-byte-length-method) ( class -- )
-    [ \ byte-length create-method-in ]
+    [ \ byte-length ] [ heap-size \ drop swap [ ] 2sequence ] bi
-    [ heap-size \ drop swap [ ] 2sequence ] bi define ;
+    define-inline-method ;
+
+: clone-underlying ( struct -- byte-array )
+    [ >c-ptr ] [ byte-length ] bi memory>byte-array ; inline
+
+: (define-clone-method) ( class -- )
+    [ \ clone ]
+    [ \ clone-underlying swap literalize \ memory>struct [ ] 3sequence ] bi
+    define-inline-method ;
 
 : slot>field ( slot -- field )
     field-spec new swap {
@@ -207,7 +215,9 @@ M: struct-class heap-size
 
 : (struct-methods) ( class -- )
     [ (define-struct-slot-values-method) ]
-    [ (define-byte-length-method) ] bi ;
+    [ (define-byte-length-method) ]
+    [ (define-clone-method) ]
+    tri ;
 
 : (struct-word-props) ( class slots size align -- )
     [

basis/compiler/cfg/intrinsics/intrinsics.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: words sequences kernel combinators cpu.architecture
+USING: words sequences kernel combinators cpu.architecture assocs
 compiler.cfg.hats
 compiler.cfg.instructions
 compiler.cfg.intrinsics.alien
@@ -25,201 +25,120 @@ QUALIFIED: math.floats.private
 QUALIFIED: math.libm
 IN: compiler.cfg.intrinsics
 
-: enable-intrinsics ( words -- )
+: enable-intrinsics ( alist -- )
-    [ t "intrinsic" set-word-prop ] each ;
+    [ "intrinsic" set-word-prop ] assoc-each ;
 
 {
-    kernel.private:tag
+    { kernel.private:tag [ drop emit-tag ] }
-    kernel.private:getenv
+    { kernel.private:getenv [ emit-getenv ] }
-    math.private:both-fixnums?
+    { math.private:both-fixnums? [ drop emit-both-fixnums? ] }
-    math.private:fixnum+
+    { math.private:fixnum+ [ drop emit-fixnum+ ] }
-    math.private:fixnum-
+    { math.private:fixnum- [ drop emit-fixnum- ] }
-    math.private:fixnum*
+    { math.private:fixnum* [ drop emit-fixnum* ] }
-    math.private:fixnum+fast
+    { math.private:fixnum+fast [ drop [ ^^add ] emit-fixnum-op ] }
-    math.private:fixnum-fast
+    { math.private:fixnum-fast [ drop [ ^^sub ] emit-fixnum-op ] }
-    math.private:fixnum-bitand
+    { math.private:fixnum*fast [ drop emit-fixnum*fast ] }
-    math.private:fixnum-bitor 
+    { math.private:fixnum-bitand [ drop [ ^^and ] emit-fixnum-op ] }
-    math.private:fixnum-bitxor
+    { math.private:fixnum-bitor [ drop [ ^^or ] emit-fixnum-op ] }
-    math.private:fixnum-shift-fast
+    { math.private:fixnum-bitxor [ drop [ ^^xor ] emit-fixnum-op ] }
-    math.private:fixnum-bitnot
+    { math.private:fixnum-shift-fast [ emit-fixnum-shift-fast ] }
-    math.private:fixnum*fast
+    { math.private:fixnum-bitnot [ drop emit-fixnum-bitnot ] }
-    math.private:fixnum< 
+    { math.private:fixnum< [ drop cc< emit-fixnum-comparison ] }
-    math.private:fixnum<=
+    { math.private:fixnum<= [ drop cc<= emit-fixnum-comparison ] }
-    math.private:fixnum>=
+    { math.private:fixnum>= [ drop cc>= emit-fixnum-comparison ] }
-    math.private:fixnum>
+    { math.private:fixnum> [ drop cc> emit-fixnum-comparison ] }
-    ! math.private:bignum>fixnum
+    { kernel:eq? [ drop cc= emit-fixnum-comparison ] }
-    ! math.private:fixnum>bignum
+    { slots.private:slot [ emit-slot ] }
-    kernel:eq?
+    { slots.private:set-slot [ emit-set-slot ] }
-    slots.private:slot
+    { strings.private:string-nth [ drop emit-string-nth ] }
-    slots.private:set-slot
+    { strings.private:set-string-nth-fast [ drop emit-set-string-nth-fast ] }
-    strings.private:string-nth
+    { classes.tuple.private:<tuple-boa> [ emit-<tuple-boa> ] }
-    strings.private:set-string-nth-fast
+    { arrays:<array> [ emit-<array> ] }
-    classes.tuple.private:<tuple-boa>
+    { byte-arrays:<byte-array> [ emit-<byte-array> ] }
-    arrays:<array>
+    { byte-arrays:(byte-array) [ emit-(byte-array) ] }
-    byte-arrays:<byte-array>
+    { kernel:<wrapper> [ emit-simple-allot ] }
-    byte-arrays:(byte-array)
+    { alien:<displaced-alien> [ emit-<displaced-alien> ] }
-    kernel:<wrapper>
+    { alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter ] }
-    alien:<displaced-alien>
+    { alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter ] }
-    alien.accessors:alien-unsigned-1
+    { alien.accessors:alien-signed-1 [ 1 emit-alien-signed-getter ] }
-    alien.accessors:set-alien-unsigned-1
+    { alien.accessors:set-alien-signed-1 [ 1 emit-alien-integer-setter ] }
-    alien.accessors:alien-signed-1
+    { alien.accessors:alien-unsigned-2 [ 2 emit-alien-unsigned-getter ] }
-    alien.accessors:set-alien-signed-1
+    { alien.accessors:set-alien-unsigned-2 [ 2 emit-alien-integer-setter ] }
-    alien.accessors:alien-unsigned-2
+    { alien.accessors:alien-signed-2 [ 2 emit-alien-signed-getter ] }
-    alien.accessors:set-alien-unsigned-2
+    { alien.accessors:set-alien-signed-2 [ 2 emit-alien-integer-setter ] }
-    alien.accessors:alien-signed-2
+    { alien.accessors:alien-cell [ emit-alien-cell-getter ] }
-    alien.accessors:set-alien-signed-2
+    { alien.accessors:set-alien-cell [ emit-alien-cell-setter ] }
-    alien.accessors:alien-cell
-    alien.accessors:set-alien-cell
 } enable-intrinsics
 
 : enable-alien-4-intrinsics ( -- )
     {
-        alien.accessors:alien-unsigned-4
+        { alien.accessors:alien-unsigned-4 [ 4 emit-alien-unsigned-getter ] }
-        alien.accessors:set-alien-unsigned-4
+        { alien.accessors:set-alien-unsigned-4 [ 4 emit-alien-integer-setter ] }
-        alien.accessors:alien-signed-4
+        { alien.accessors:alien-signed-4 [ 4 emit-alien-signed-getter ] }
-        alien.accessors:set-alien-signed-4
+        { alien.accessors:set-alien-signed-4 [ 4 emit-alien-integer-setter ] }
     } enable-intrinsics ;
 
 : enable-float-intrinsics ( -- )
     {
-        math.private:float+
+        { math.private:float+ [ drop [ ^^add-float ] emit-float-op ] }
-        math.private:float-
+        { math.private:float- [ drop [ ^^sub-float ] emit-float-op ] }
-        math.private:float*
+        { math.private:float* [ drop [ ^^mul-float ] emit-float-op ] }
-        math.private:float/f
+        { math.private:float/f [ drop [ ^^div-float ] emit-float-op ] }
-        math.private:fixnum>float
+        { math.private:float< [ drop cc< emit-float-comparison ] }
-        math.private:float>fixnum
+        { math.private:float<= [ drop cc<= emit-float-comparison ] }
-        math.private:float<
+        { math.private:float>= [ drop cc>= emit-float-comparison ] }
-        math.private:float<=
+        { math.private:float> [ drop cc> emit-float-comparison ] }
-        math.private:float>
+        { math.private:float= [ drop cc= emit-float-comparison ] }
-        math.private:float>=
+        { math.private:float>fixnum [ drop emit-float>fixnum ] }
-        math.private:float=
+        { math.private:fixnum>float [ drop emit-fixnum>float ] }
-        alien.accessors:alien-float
+        { alien.accessors:alien-float [ single-float-rep emit-alien-float-getter ] }
-        alien.accessors:set-alien-float
+        { alien.accessors:set-alien-float [ single-float-rep emit-alien-float-setter ] }
-        alien.accessors:alien-double
+        { alien.accessors:alien-double [ double-float-rep emit-alien-float-getter ] }
-        alien.accessors:set-alien-double
+        { alien.accessors:set-alien-double [ double-float-rep emit-alien-float-setter ] }
     } enable-intrinsics ;
 
 : enable-fsqrt ( -- )
-    \ math.libm:fsqrt t "intrinsic" set-word-prop ;
+    {
+        { math.libm:fsqrt [ drop emit-fsqrt ] }
+    } enable-intrinsics ;
 
 : enable-float-min/max ( -- )
     {
-        math.floats.private:float-min
+        { math.floats.private:float-min [ drop [ ^^min-float ] emit-float-op ] }
-        math.floats.private:float-max
+        { math.floats.private:float-max [ drop [ ^^max-float ] emit-float-op ] }
     } enable-intrinsics ;
 
 : enable-float-functions ( -- )
     ! Everything except for fsqrt
     {
-        math.libm:facos
+        { math.libm:facos [ drop "acos" emit-unary-float-function ] }
-        math.libm:fasin
+        { math.libm:fasin [ drop "asin" emit-unary-float-function ] }
-        math.libm:fatan
+        { math.libm:fatan [ drop "atan" emit-unary-float-function ] }
-        math.libm:fatan2
+        { math.libm:fatan2 [ drop "atan2" emit-binary-float-function ] }
-        math.libm:fcos
+        { math.libm:fcos [ drop "cos" emit-unary-float-function ] }
-        math.libm:fsin
+        { math.libm:fsin [ drop "sin" emit-unary-float-function ] }
-        math.libm:ftan
+        { math.libm:ftan [ drop "tan" emit-unary-float-function ] }
-        math.libm:fcosh
+        { math.libm:fcosh [ drop "cosh" emit-unary-float-function ] }
-        math.libm:fsinh
+        { math.libm:fsinh [ drop "sinh" emit-unary-float-function ] }
-        math.libm:ftanh
+        { math.libm:ftanh [ drop "tanh" emit-unary-float-function ] }
-        math.libm:fexp
+        { math.libm:fexp [ drop "exp" emit-unary-float-function ] }
-        math.libm:flog
+        { math.libm:flog [ drop "log" emit-unary-float-function ] }
-        math.libm:fpow
+        { math.libm:fpow [ drop "pow" emit-binary-float-function ] }
-        math.libm:facosh
+        { math.libm:facosh [ drop "acosh" emit-unary-float-function ] }
-        math.libm:fasinh
+        { math.libm:fasinh [ drop "asinh" emit-unary-float-function ] }
-        math.libm:fatanh
+        { math.libm:fatanh [ drop "atanh" emit-unary-float-function ] }
     } enable-intrinsics ;
 
 : enable-min/max ( -- )
     {
-        math.integers.private:fixnum-min
+        { math.integers.private:fixnum-min [ drop [ ^^min ] emit-fixnum-op ] }
-        math.integers.private:fixnum-max
+        { math.integers.private:fixnum-max [ drop [ ^^max ] emit-fixnum-op ] }
     } enable-intrinsics ;
 
 : enable-fixnum-log2 ( -- )
-    { math.integers.private:fixnum-log2 } enable-intrinsics ;
+    {
+        { math.integers.private:fixnum-log2 [ drop emit-fixnum-log2 ] }
+    } enable-intrinsics ;
 
 : emit-intrinsic ( node word -- )
-    {
+    "intrinsic" word-prop call( node -- ) ;
-        { \ kernel.private:tag [ drop emit-tag ] }
-        { \ kernel.private:getenv [ emit-getenv ] }
-        { \ math.private:both-fixnums? [ drop emit-both-fixnums? ] }
-        { \ math.private:fixnum+ [ drop emit-fixnum+ ] }
-        { \ math.private:fixnum- [ drop emit-fixnum- ] }
-        { \ math.private:fixnum* [ drop emit-fixnum* ] }
-        { \ math.private:fixnum+fast [ drop [ ^^add ] emit-fixnum-op ] }
-        { \ math.private:fixnum-fast [ drop [ ^^sub ] emit-fixnum-op ] }
-        { \ math.private:fixnum-bitand [ drop [ ^^and ] emit-fixnum-op ] }
-        { \ math.private:fixnum-bitor [ drop [ ^^or ] emit-fixnum-op ] }
-        { \ math.private:fixnum-bitxor [ drop [ ^^xor ] emit-fixnum-op ] }
-        { \ math.private:fixnum-shift-fast [ emit-fixnum-shift-fast ] }
-        { \ math.private:fixnum-bitnot [ drop emit-fixnum-bitnot ] }
-        { \ math.integers.private:fixnum-log2 [ drop emit-fixnum-log2 ] }
-        { \ math.private:fixnum*fast [ drop emit-fixnum*fast ] }
-        { \ math.private:fixnum< [ drop cc< emit-fixnum-comparison ] }
-        { \ math.private:fixnum<= [ drop cc<= emit-fixnum-comparison ] }
-        { \ math.private:fixnum>= [ drop cc>= emit-fixnum-comparison ] }
-        { \ math.private:fixnum> [ drop cc> emit-fixnum-comparison ] }
-        { \ kernel:eq? [ drop cc= emit-fixnum-comparison ] }
-        { \ math.integers.private:fixnum-min [ drop [ ^^min ] emit-fixnum-op ] }
-        { \ math.integers.private:fixnum-max [ drop [ ^^max ] emit-fixnum-op ] }
-        { \ math.private:bignum>fixnum [ drop emit-bignum>fixnum ] }
-        { \ math.private:fixnum>bignum [ drop emit-fixnum>bignum ] }
-        { \ math.private:float+ [ drop [ ^^add-float ] emit-float-op ] }
-        { \ math.private:float- [ drop [ ^^sub-float ] emit-float-op ] }
-        { \ math.private:float* [ drop [ ^^mul-float ] emit-float-op ] }
-        { \ math.private:float/f [ drop [ ^^div-float ] emit-float-op ] }
-        { \ math.private:float< [ drop cc< emit-float-comparison ] }
-        { \ math.private:float<= [ drop cc<= emit-float-comparison ] }
-        { \ math.private:float>= [ drop cc>= emit-float-comparison ] }
-        { \ math.private:float> [ drop cc> emit-float-comparison ] }
-        { \ math.private:float= [ drop cc= emit-float-comparison ] }
-        { \ math.private:float>fixnum [ drop emit-float>fixnum ] }
-        { \ math.private:fixnum>float [ drop emit-fixnum>float ] }
-        { \ math.floats.private:float-min [ drop [ ^^min-float ] emit-float-op ] }
-        { \ math.floats.private:float-max [ drop [ ^^max-float ] emit-float-op ] }
-        { \ math.libm:fsqrt [ drop emit-fsqrt ] }
-        { \ math.libm:facos [ drop "acos" emit-unary-float-function ] }
-        { \ math.libm:fasin [ drop "asin" emit-unary-float-function ] }
-        { \ math.libm:fatan [ drop "atan" emit-unary-float-function ] }
-        { \ math.libm:fatan2 [ drop "atan2" emit-binary-float-function ] }
-        { \ math.libm:fcos [ drop "cos" emit-unary-float-function ] }
-        { \ math.libm:fsin [ drop "sin" emit-unary-float-function ] }
-        { \ math.libm:ftan [ drop "tan" emit-unary-float-function ] }
-        { \ math.libm:fcosh [ drop "cosh" emit-unary-float-function ] }
-        { \ math.libm:fsinh [ drop "sinh" emit-unary-float-function ] }
-        { \ math.libm:ftanh [ drop "tanh" emit-unary-float-function ] }
-        { \ math.libm:fexp [ drop "exp" emit-unary-float-function ] }
-        { \ math.libm:flog [ drop "log" emit-unary-float-function ] }
-        { \ math.libm:fpow [ drop "pow" emit-binary-float-function ] }
-        { \ math.libm:facosh [ drop "acosh" emit-unary-float-function ] }
-        { \ math.libm:fasinh [ drop "asinh" emit-unary-float-function ] }
-        { \ math.libm:fatanh [ drop "atanh" emit-unary-float-function ] }
-        { \ slots.private:slot [ emit-slot ] }
-        { \ slots.private:set-slot [ emit-set-slot ] }
-        { \ strings.private:string-nth [ drop emit-string-nth ] }
-        { \ strings.private:set-string-nth-fast [ drop emit-set-string-nth-fast ] }
-        { \ classes.tuple.private:<tuple-boa> [ emit-<tuple-boa> ] }
-        { \ arrays:<array> [ emit-<array> ] }
-        { \ byte-arrays:<byte-array> [ emit-<byte-array> ] }
-        { \ byte-arrays:(byte-array) [ emit-(byte-array) ] }
-        { \ kernel:<wrapper> [ emit-simple-allot ] }
-        { \ alien:<displaced-alien> [ emit-<displaced-alien> ] }
-        { \ alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter ] }
-        { \ alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter ] }
-        { \ alien.accessors:alien-signed-1 [ 1 emit-alien-signed-getter ] }
-        { \ alien.accessors:set-alien-signed-1 [ 1 emit-alien-integer-setter ] }
-        { \ alien.accessors:alien-unsigned-2 [ 2 emit-alien-unsigned-getter ] }
-        { \ alien.accessors:set-alien-unsigned-2 [ 2 emit-alien-integer-setter ] }
-        { \ alien.accessors:alien-signed-2 [ 2 emit-alien-signed-getter ] }
-        { \ alien.accessors:set-alien-signed-2 [ 2 emit-alien-integer-setter ] }
-        { \ alien.accessors:alien-unsigned-4 [ 4 emit-alien-unsigned-getter ] }
-        { \ alien.accessors:set-alien-unsigned-4 [ 4 emit-alien-integer-setter ] }
-        { \ alien.accessors:alien-signed-4 [ 4 emit-alien-signed-getter ] }
-        { \ alien.accessors:set-alien-signed-4 [ 4 emit-alien-integer-setter ] }
-        { \ alien.accessors:alien-cell [ emit-alien-cell-getter ] }
-        { \ alien.accessors:set-alien-cell [ emit-alien-cell-setter ] }
-        { \ alien.accessors:alien-float [ single-float-rep emit-alien-float-getter ] }
-        { \ alien.accessors:set-alien-float [ single-float-rep emit-alien-float-setter ] }
-        { \ alien.accessors:alien-double [ double-float-rep emit-alien-float-getter ] }
-        { \ alien.accessors:set-alien-double [ double-float-rep emit-alien-float-setter ] }
-    } case ;

basis/compiler/tests/codegen.factor

@@ -3,7 +3,7 @@ math hashtables.private math.private namespaces sequences tools.test
 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.order math.libm math.parser ;
 QUALIFIED: namespaces.private
 IN: compiler.tests.codegen
 
@@ -409,7 +409,7 @@ cell 4 = [
 
 [ ] [ missing-gc-check-2 ] unit-test
 
-[ 1 0.169967142900241 ] [ 1.4 [ 1 swap fcos ] compile-call ] unit-test
+[ 1 "0.169967142900241" ] [ 1.4 [ 1 swap fcos ] compile-call number>string ] unit-test
-[ 1 0.169967142900241 ] [ 1.4 1 [ swap fcos ] compile-call ] unit-test
+[ 1 "0.169967142900241" ] [ 1.4 1 [ swap fcos ] compile-call number>string ] unit-test
-[ 0.169967142900241 0.9854497299884601 ] [ 1.4 [ [ fcos ] [ fsin ] bi ] compile-call ] unit-test
+[ "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 ] unit-test
+[ 1 "0.169967142900241" "0.9854497299884601" ] [ 1.4 1 [ swap >float [ fcos ] [ fsin ] bi ] compile-call [ number>string ] bi@ ] unit-test

basis/environment/winnt/winnt.factor

@@ -6,8 +6,10 @@ alien.c-types sequences windows.errors io.streams.memory
 io.encodings io ;
 IN: environment.winnt
 
+<< "TCHAR" require-c-type-arrays >>
+
 M: winnt os-env ( key -- value )
-    MAX_UNICODE_PATH "TCHAR" <c-array>
+    MAX_UNICODE_PATH "TCHAR" <c-type-array>
     [ dup length GetEnvironmentVariable ] keep over 0 = [
         2drop f
     ] [

basis/game-input/dinput/dinput.factor

@@ -6,7 +6,7 @@ math.rectangles namespaces parser sequences shuffle
 struct-arrays ui.backend.windows vectors windows.com
 windows.dinput windows.dinput.constants windows.errors
 windows.kernel32 windows.messages windows.ole32
-windows.user32 ;
+windows.user32 classes.struct ;
 IN: game-input.dinput
 CONSTANT: MOUSE-BUFFER-SIZE 16
 
@@ -162,7 +162,7 @@ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+
     [ remove-controller ] each ;
 
 : device-interface? ( dbt-broadcast-hdr -- ? )
-    DEV_BROADCAST_HDR-dbch_devicetype DBT_DEVTYP_DEVICEINTERFACE = ;
+    dbch_devicetype>> DBT_DEVTYP_DEVICEINTERFACE = ;
 
 : device-arrived ( dbt-broadcast-hdr -- )
     device-interface? [ find-controllers ] when ;
@@ -185,9 +185,9 @@ TUPLE: window-rect < rect window-loc ;
     { 0 0 } >>dim ;
 
 : (device-notification-filter) ( -- DEV_BROADCAST_DEVICEW )
-    "DEV_BROADCAST_DEVICEW" <c-object>
+    DEV_BROADCAST_DEVICEW <struct>
-    "DEV_BROADCAST_DEVICEW" heap-size over set-DEV_BROADCAST_DEVICEW-dbcc_size
+        DEV_BROADCAST_DEVICEW heap-size >>dbcc_size
-    DBT_DEVTYP_DEVICEINTERFACE over set-DEV_BROADCAST_DEVICEW-dbcc_devicetype ;
+        DBT_DEVTYP_DEVICEINTERFACE >>dbcc_devicetype ;
 
 : create-device-change-window ( -- )
     <zero-window-rect> WS_OVERLAPPEDWINDOW 0 create-window
@@ -239,11 +239,13 @@ M: dinput-game-input-backend (close-game-input)
     delete-dinput ;
 
 M: dinput-game-input-backend (reset-game-input)
-    {
+    global [
-        +dinput+ +keyboard-device+ +keyboard-state+
+        {
-        +controller-devices+ +controller-guids+
+            +dinput+ +keyboard-device+ +keyboard-state+
-        +device-change-window+ +device-change-handle+
+            +controller-devices+ +controller-guids+
-    } [ f swap set-global ] each ;
+            +device-change-window+ +device-change-handle+
+        } [ off ] each
+    ] bind ;
 
 M: dinput-game-input-backend get-controllers
     +controller-devices+ get

basis/io/backend/unix/multiplexers/kqueue/kqueue.factor

@@ -2,28 +2,28 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien.c-types combinators destructors
 io.backend.unix kernel math.bitwise sequences struct-arrays unix
-unix.kqueue unix.time assocs io.backend.unix.multiplexers ;
+unix.kqueue unix.time assocs io.backend.unix.multiplexers
+classes.struct ;
 IN: io.backend.unix.multiplexers.kqueue
 
 TUPLE: kqueue-mx < mx events ;
 
-: max-events ( -- n )
+! We read up to 256 events at a time. This is an arbitrary
-    #! We read up to 256 events at a time. This is an arbitrary
+! constant...
-    #! constant...
+CONSTANT: max-events 256
-    256 ; inline
 
 : <kqueue-mx> ( -- mx )
     kqueue-mx new-mx
         kqueue dup io-error >>fd
-        max-events "kevent" <struct-array> >>events ;
+        max-events \ kevent <struct-array> >>events ;
 
 M: kqueue-mx dispose* fd>> close-file ;
 
 : make-kevent ( fd filter flags -- event )
-    "kevent" <c-object>
+    \ kevent <struct>
-    [ set-kevent-flags ] keep
+        swap >>flags
-    [ set-kevent-filter ] keep
+        swap >>filter
-    [ set-kevent-ident ] keep ;
+        swap >>ident ;
 
 : register-kevent ( kevent mx -- )
     fd>> swap 1 f 0 f kevent io-error ;
@@ -63,13 +63,14 @@ M: kqueue-mx remove-output-callbacks ( fd mx -- seq )
     ] dip kevent multiplexer-error ;
 
 : handle-kevent ( mx kevent -- )
-    [ kevent-ident swap ] [ kevent-filter ] bi {
+    [ ident>> swap ] [ filter>> ] bi {
         { EVFILT_READ [ input-available ] }
         { EVFILT_WRITE [ output-available ] }
     } case ;
 
 : handle-kevents ( mx n -- )
-    [ dup events>> ] dip head-slice [ handle-kevent ] with each ;
+    [ dup events>> ] dip head-slice
+    [ handle-kevent ] with each ;
 
 M: kqueue-mx wait-for-events ( us mx -- )
     swap dup [ make-timespec ] when

basis/io/backend/unix/unix-tests.factor

@@ -74,8 +74,7 @@ yield
 
 [ datagram-client delete-file ] ignore-errors
 
-datagram-client <local> <datagram>
+[ ] [ datagram-client <local> <datagram> "d" set ] unit-test
-"d" set
 
 [ ] [
     "hello" >byte-array

basis/io/directories/unix/linux/linux.factor

@@ -1,10 +1,11 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types io.directories.unix kernel system unix ;
+USING: alien.c-types io.directories.unix kernel system unix
+classes.struct ;
 IN: io.directories.unix.linux
 
-M: unix find-next-file ( DIR* -- byte-array )
+M: unix find-next-file ( DIR* -- dirent )
-    "dirent" <c-object>
+    dirent <struct>
     f <void*>
     [ readdir64_r 0 = [ (io-error) ] unless ] 2keep
     *void* [ drop f ] unless ;

basis/io/directories/unix/unix.factor

@@ -4,7 +4,7 @@ USING: accessors alien.c-types alien.strings combinators
 continuations destructors fry io io.backend io.backend.unix
 io.directories io.encodings.binary io.encodings.utf8 io.files
 io.pathnames io.files.types kernel math.bitwise sequences system
-unix unix.stat vocabs.loader ;
+unix unix.stat vocabs.loader classes.struct ;
 IN: io.directories.unix
 
 : touch-mode ( -- n )
@@ -37,7 +37,7 @@ M: unix copy-file ( from to -- )
 HOOK: find-next-file os ( DIR* -- byte-array )
 
 M: unix find-next-file ( DIR* -- byte-array )
-    "dirent" <c-object>
+    dirent <struct>
     f <void*>
     [ readdir_r 0 = [ (io-error) ] unless ] 2keep
     *void* [ drop f ] unless ;
@@ -57,8 +57,8 @@ M: unix find-next-file ( DIR* -- byte-array )
 
 M: unix >directory-entry ( byte-array -- directory-entry )
     {
-        [ dirent-d_name underlying>> utf8 alien>string ]
+        [ d_name>> underlying>> utf8 alien>string ]
-        [ dirent-d_type dirent-type>file-type ]
+        [ d_type>> dirent-type>file-type ]
     } cleave directory-entry boa ;
 
 M: unix (directory-entries) ( path -- seq )

basis/io/directories/windows/windows.factor

@@ -4,7 +4,7 @@ USING: system io.directories io.encodings.utf16n alien.strings
 io.pathnames io.backend io.files.windows destructors
 kernel accessors calendar windows windows.errors
 windows.kernel32 alien.c-types sequences splitting
-fry continuations ;
+fry continuations classes.struct ;
 IN: io.directories.windows
 
 M: windows touch-file ( path -- )
@@ -33,12 +33,12 @@ M: windows delete-directory ( path -- )
     RemoveDirectory win32-error=0/f ;
 
 : find-first-file ( path -- WIN32_FIND_DATA handle )
-    "WIN32_FIND_DATA" <c-object>
+    WIN32_FIND_DATA <struct>
     [ nip ] [ FindFirstFile ] 2bi
     [ INVALID_HANDLE_VALUE = [ win32-error-string throw ] when ] keep ;
 
 : find-next-file ( path -- WIN32_FIND_DATA/f )
-    "WIN32_FIND_DATA" <c-object>
+    WIN32_FIND_DATA <struct>
     [ nip ] [ FindNextFile ] 2bi 0 = [
         GetLastError ERROR_NO_MORE_FILES = [
             win32-error
@@ -48,10 +48,11 @@ M: windows delete-directory ( path -- )
 TUPLE: windows-directory-entry < directory-entry attributes ;
 
 M: windows >directory-entry ( byte-array -- directory-entry )
-    [ WIN32_FIND_DATA-cFileName utf16n alien>string ]
+    [ cFileName>> utf16n alien>string ]
-    [ WIN32_FIND_DATA-dwFileAttributes win32-file-type ]
+    [
-    [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes ]
+        dwFileAttributes>>
-    tri
+        [ win32-file-type ] [ win32-file-attributes ] bi
+    ] bi
     dupd remove windows-directory-entry boa ;
 
 M: windows (directory-entries) ( path -- seq )

basis/io/files/info/unix/openbsd/openbsd.factor

@@ -47,6 +47,6 @@ M: openbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-in
 
 M: openbsd file-systems ( -- seq )
     f 0 0 getfsstat dup io-error
-    statfs <c-type-array> dup dup length 0 getfsstat io-error 
+    \ statfs <c-type-array> dup dup length 0 getfsstat io-error 
-    statfs heap-size group 
+    \ statfs heap-size group 
     [ f_mntonname>> alien>native-string file-system-info ] map ;

basis/io/files/info/windows/windows.factor

@@ -5,7 +5,8 @@ io.files.windows io.files.windows.nt kernel windows.kernel32
 windows.time windows accessors alien.c-types combinators
 generalizations system alien.strings io.encodings.utf16n
 sequences splitting windows.errors fry continuations destructors
-calendar ascii combinators.short-circuit locals classes.struct ;
+calendar ascii combinators.short-circuit locals classes.struct
+specialized-arrays.ushort ;
 IN: io.files.info.windows
 
 :: round-up-to ( n multiple -- n' )
@@ -35,20 +36,17 @@ TUPLE: windows-file-info < file-info attributes ;
 : WIN32_FIND_DATA>file-info ( WIN32_FIND_DATA -- file-info )
     [ \ windows-file-info new ] dip
     {
-        [ WIN32_FIND_DATA-dwFileAttributes win32-file-type >>type ]
+        [ dwFileAttributes>> win32-file-type >>type ]
-        [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes >>attributes ]
+        [ dwFileAttributes>> win32-file-attributes >>attributes ]
-        [
+        [ [ nFileSizeLow>> ] [ nFileSizeHigh>> ] bi >64bit >>size ]
-            [ WIN32_FIND_DATA-nFileSizeLow ]
+        [ dwFileAttributes>> >>permissions ]
-            [ WIN32_FIND_DATA-nFileSizeHigh ] bi >64bit >>size
+        [ ftCreationTime>> FILETIME>timestamp >>created ]
-        ]
+        [ ftLastWriteTime>> FILETIME>timestamp >>modified ]
-        [ WIN32_FIND_DATA-dwFileAttributes >>permissions ]
+        [ ftLastAccessTime>> FILETIME>timestamp >>accessed ]
-        [ WIN32_FIND_DATA-ftCreationTime FILETIME>timestamp >>created ]
-        [ WIN32_FIND_DATA-ftLastWriteTime FILETIME>timestamp >>modified ]
-        [ WIN32_FIND_DATA-ftLastAccessTime FILETIME>timestamp >>accessed ]
     } cleave ;
 
 : find-first-file-stat ( path -- WIN32_FIND_DATA )
-    "WIN32_FIND_DATA" <c-object> [
+    WIN32_FIND_DATA <struct> [
         FindFirstFile
         [ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep
         FindClose win32-error=0/f
@@ -147,7 +145,7 @@ M: winnt file-system-info ( path -- file-system-info )
     calculate-file-system-info ;
 
 : volume>paths ( string -- array )
-    16384 "ushort" <c-array> tuck dup length
+    16384 <ushort-array> tuck dup length
     0 <uint> dup [ GetVolumePathNamesForVolumeName 0 = ] dip swap [
         win32-error-string throw
     ] [

basis/io/files/windows/nt/nt.factor

@@ -5,19 +5,18 @@ windows.kernel32 kernel libc math threads system environment
 alien.c-types alien.arrays alien.strings sequences combinators
 combinators.short-circuit ascii splitting alien strings assocs
 namespaces make accessors tr windows.time windows.shell32
-windows.errors ;
+windows.errors specialized-arrays.ushort classes.struct ;
 IN: io.files.windows.nt
 
 M: winnt cwd
-    MAX_UNICODE_PATH dup "ushort" <c-array>
+    MAX_UNICODE_PATH dup <ushort-array>
     [ GetCurrentDirectory win32-error=0/f ] keep
     utf16n alien>string ;
 
 M: winnt cd
     SetCurrentDirectory win32-error=0/f ;
 
-: unicode-prefix ( -- seq )
+CONSTANT: unicode-prefix "\\\\?\\"
-    "\\\\?\\" ; inline
 
 M: winnt root-directory? ( path -- ? )
     {
@@ -48,10 +47,9 @@ M: winnt CreateFile-flags ( DWORD -- DWORD )
 <PRIVATE
 
 : windows-file-size ( path -- size )
-    normalize-path 0 "WIN32_FILE_ATTRIBUTE_DATA" <c-object>
+    normalize-path 0 WIN32_FILE_ATTRIBUTE_DATA <struct>
     [ GetFileAttributesEx win32-error=0/f ] keep
-    [ WIN32_FILE_ATTRIBUTE_DATA-nFileSizeLow ]
+    [ nFileSizeLow>> ] [ nFileSizeHigh>> ] bi >64bit ;
-    [ WIN32_FILE_ATTRIBUTE_DATA-nFileSizeHigh ] bi >64bit ;
 
 PRIVATE>
 

basis/io/monitors/windows/nt/nt.factor

@@ -7,7 +7,7 @@ system accessors threads splitting io.backend io.backend.windows
 io.backend.windows.nt io.files.windows.nt io.monitors io.ports
 io.buffers io.files io.timeouts io.encodings.string
 io.encodings.utf16n io windows.errors windows.kernel32 windows.types
-io.pathnames ;
+io.pathnames classes.struct ;
 IN: io.monitors.windows.nt
 
 : open-directory ( path -- handle )
@@ -55,17 +55,14 @@ TUPLE: win32-monitor < monitor port ;
     memory>byte-array utf16n decode ;
 
 : parse-notify-record ( buffer -- path changed )
-    [
+    [ [ FileName>> ] [ FileNameLength>> ] bi memory>u16-string ]
-        [ FILE_NOTIFY_INFORMATION-FileName ]
+    [ Action>> parse-action ] bi ;
-        [ FILE_NOTIFY_INFORMATION-FileNameLength ]
-        bi memory>u16-string
-    ]
-    [ FILE_NOTIFY_INFORMATION-Action parse-action ] bi ;
 
 : (file-notify-records) ( buffer -- buffer )
+    FILE_NOTIFY_INFORMATION memory>struct
     dup ,
-    dup FILE_NOTIFY_INFORMATION-NextEntryOffset zero? [
+    dup NextEntryOffset>> zero? [
-        [ FILE_NOTIFY_INFORMATION-NextEntryOffset ] keep <displaced-alien>
+        [ NextEntryOffset>> ] [ >c-ptr <displaced-alien> ] bi
         (file-notify-records)
     ] unless ;
 

basis/io/sockets/unix/unix.factor

@@ -61,8 +61,8 @@ M: object ((client)) ( addrspec -- fd )
 
 : server-socket-fd ( addrspec type -- fd )
     [ dup protocol-family ] dip socket-fd
-    dup init-server-socket
+    [ init-server-socket ] keep
-    dup handle-fd rot make-sockaddr/size bind io-error ;
+    [ handle-fd swap make-sockaddr/size bind io-error ] keep ;
 
 M: object (server) ( addrspec -- handle )
     [
@@ -148,7 +148,7 @@ M: local make-sockaddr
     dup length 1 + max-un-path > [ "Path too long" throw ] when
     "sockaddr-un" <c-object>
     AF_UNIX over set-sockaddr-un-family
-    dup sockaddr-un-path rot utf8 string>alien dup length memcpy ;
+    [ [ utf8 string>alien ] dip set-sockaddr-un-path ] keep ;
 
 M: local parse-sockaddr
     drop

basis/io/sockets/windows/nt/nt.factor

@@ -2,7 +2,8 @@ USING: alien alien.accessors alien.c-types byte-arrays
 continuations destructors io.ports io.timeouts io.sockets
 io namespaces io.streams.duplex io.backend.windows
 io.sockets.windows io.backend.windows.nt windows.winsock kernel
-libc math sequences threads system combinators accessors ;
+libc math sequences threads system combinators accessors
+classes.struct windows.kernel32 ;
 IN: io.sockets.windows.nt
 
 : malloc-int ( object -- object )
@@ -14,7 +15,7 @@ M: winnt WSASocket-flags ( -- DWORD )
 : get-ConnectEx-ptr ( socket -- void* )
     SIO_GET_EXTENSION_FUNCTION_POINTER
     WSAID_CONNECTEX
-    "GUID" heap-size
+    GUID heap-size
     "void*" <c-object>
     [
         "void*" heap-size
@@ -127,9 +128,9 @@ TUPLE: WSARecvFrom-args port
        lpFlags lpFrom lpFromLen lpOverlapped lpCompletionRoutine ;
 
 : make-receive-buffer ( -- WSABUF )
-    "WSABUF" malloc-object &free
+    WSABUF malloc-struct &free
-    default-buffer-size get over set-WSABUF-len
+        default-buffer-size get
-    default-buffer-size get malloc &free over set-WSABUF-buf ; inline
+        [ >>len ] [ malloc &free >>buf ] bi ; inline
 
 : <WSARecvFrom-args> ( datagram -- WSARecvFrom )
     WSARecvFrom-args new
@@ -158,7 +159,7 @@ TUPLE: WSARecvFrom-args port
     } cleave WSARecvFrom socket-error* ; inline
 
 : parse-WSARecvFrom ( n WSARecvFrom -- packet sockaddr )
-    [ lpBuffers>> WSABUF-buf swap memory>byte-array ]
+    [ lpBuffers>> buf>> swap memory>byte-array ]
     [ [ lpFrom>> ] [ lpFromLen>> *int ] bi memory>byte-array ] bi ; inline
 
 M: winnt (receive) ( datagram -- packet addrspec )
@@ -175,11 +176,9 @@ TUPLE: WSASendTo-args port
        dwFlags lpTo iToLen lpOverlapped lpCompletionRoutine ;
 
 : make-send-buffer ( packet -- WSABUF )
-    "WSABUF" malloc-object &free
+    [ WSABUF malloc-struct &free ] dip
-    [ [ malloc-byte-array &free ] dip set-WSABUF-buf ]
+        [ malloc-byte-array &free >>buf ]
-    [ [ length ] dip set-WSABUF-len ]
+        [ length >>len ] bi ; inline
-    [ nip ]
-    2tri ; inline
 
 : <WSASendTo-args> ( packet addrspec datagram -- WSASendTo )
     WSASendTo-args new

basis/ui/backend/windows/windows.factor

@@ -260,12 +260,14 @@ CONSTANT: window-control>ex-style
     window-controls>> window-control>ex-style symbols>flags ;
 
 : get-RECT-top-left ( RECT -- x y )
-    [ RECT-left ] keep RECT-top ;
+    [ left>> ] [ top>> ] bi ;
+
+: get-RECT-width/height ( RECT -- width height )
+    [ [ right>> ] [ left>> ] bi - ]
+    [ [ bottom>> ] [ top>> ] bi - ] bi ;
 
 : get-RECT-dimensions ( RECT -- x y width height )
-    [ get-RECT-top-left ] keep
+    [ get-RECT-top-left ] [ get-RECT-width/height ] bi ;
-    [ RECT-right ] keep [ RECT-left - ] keep
-    [ RECT-bottom ] keep RECT-top - ;
 
 : handle-wm-paint ( hWnd uMsg wParam lParam -- )
     #! wParam and lParam are unused
@@ -503,14 +505,15 @@ SYMBOL: nc-buttons
     ] if ;
 
 : make-TRACKMOUSEEVENT ( hWnd -- alien )
-    "TRACKMOUSEEVENT" <c-object> [ set-TRACKMOUSEEVENT-hwndTrack ] keep
+    TRACKMOUSEEVENT <struct>
-    "TRACKMOUSEEVENT" heap-size over set-TRACKMOUSEEVENT-cbSize ;
+        swap >>hwndTrack
+        TRACKMOUSEEVENT heap-size >>cbSize ;
 
 : handle-wm-mousemove ( hWnd uMsg wParam lParam -- )
     2nip
     over make-TRACKMOUSEEVENT
-    TME_LEAVE over set-TRACKMOUSEEVENT-dwFlags
+        TME_LEAVE >>dwFlags
-    0 over set-TRACKMOUSEEVENT-dwHoverTime
+        0 >>dwHoverTime
     TrackMouseEvent drop
     >lo-hi swap window move-hand fire-motion ;
 
@@ -588,19 +591,18 @@ M: windows-ui-backend do-events
     ] if ;
 
 :: register-window-class ( class-name-ptr -- )
-    "WNDCLASSEX" <c-object> f GetModuleHandle
+    WNDCLASSEX <struct> f GetModuleHandle
     class-name-ptr pick GetClassInfoEx 0 = [
-        "WNDCLASSEX" heap-size over set-WNDCLASSEX-cbSize
+        WNDCLASSEX heap-size >>cbSize
-        { CS_HREDRAW CS_VREDRAW CS_OWNDC } flags over set-WNDCLASSEX-style
+        { CS_HREDRAW CS_VREDRAW CS_OWNDC } flags >>style
-        ui-wndproc over set-WNDCLASSEX-lpfnWndProc
+        ui-wndproc >>lpfnWndProc
-        0 over set-WNDCLASSEX-cbClsExtra
+        0 >>cbClsExtra
-        0 over set-WNDCLASSEX-cbWndExtra
+        0 >>cbWndExtra
-        f GetModuleHandle over set-WNDCLASSEX-hInstance
+        f GetModuleHandle >>hInstance
-        f GetModuleHandle "fraptor" utf16n string>alien LoadIcon
+        f GetModuleHandle "fraptor" utf16n string>alien LoadIcon >>hIcon
-        over set-WNDCLASSEX-hIcon
+        f IDC_ARROW LoadCursor >>hCursor
-        f IDC_ARROW LoadCursor over set-WNDCLASSEX-hCursor
 
-        class-name-ptr over set-WNDCLASSEX-lpszClassName
+        class-name-ptr >>lpszClassName
         RegisterClassEx win32-error=0/f
     ] [ drop ] if ;
 
@@ -610,12 +612,12 @@ M: windows-ui-backend do-events
 : make-RECT ( world -- RECT )
     [ window-loc>> ] [ dim>> ] bi <RECT> ;
 
-: default-position-RECT ( RECT -- )
+: default-position-RECT ( RECT -- RECT' )
-    dup get-RECT-dimensions [ 2drop ] 2dip
+    dup get-RECT-width/height
-    CW_USEDEFAULT + pick set-RECT-bottom
+        [ CW_USEDEFAULT + >>bottom ] dip
-    CW_USEDEFAULT + over set-RECT-right
+        CW_USEDEFAULT + >>right
-    CW_USEDEFAULT over set-RECT-left
+        CW_USEDEFAULT >>left
-    CW_USEDEFAULT swap set-RECT-top ;
+        CW_USEDEFAULT >>top ;
 
 : make-adjusted-RECT ( rect style ex-style -- RECT )
     [
@@ -623,7 +625,7 @@ M: windows-ui-backend do-events
         dup get-RECT-top-left [ zero? ] both? swap
         dup
     ] 2dip adjust-RECT
-    swap [ dup default-position-RECT ] when ;
+    swap [ default-position-RECT ] when ;
 
 : get-window-class ( -- class-name )
     class-name-ptr [
@@ -749,17 +751,18 @@ M: windows-ui-backend beep ( -- )
 
 : fullscreen-RECT ( hwnd -- RECT )
     MONITOR_DEFAULTTONEAREST MonitorFromWindow
-    "MONITORINFOEX" <c-object> dup length over set-MONITORINFOEX-cbSize
+    MONITORINFOEX <struct>
-    [ GetMonitorInfo win32-error=0/f ] keep MONITORINFOEX-rcMonitor ;
+        MONITORINFOEX heap-size >>cbSize
+    [ GetMonitorInfo win32-error=0/f ] keep rcMonitor>> ;
 
 : client-area>RECT ( hwnd -- RECT )
-    "RECT" <c-object>
+    RECT <struct>
     [ GetClientRect win32-error=0/f ]
     [ "POINT" byte-array>struct-array [ ClientToScreen drop ] with each ]
     [ nip ] 2tri ;
 
 : hwnd>RECT ( hwnd -- RECT )
-    "RECT" <c-object> [ GetWindowRect win32-error=0/f ] keep ;
+    RECT <struct> [ GetWindowRect win32-error=0/f ] keep ;
 
 M: windows-ui-backend (grab-input) ( handle -- )
     0 ShowCursor drop

basis/ui/backend/x11/x11.factor

@@ -1,14 +1,13 @@
 ! Copyright (C) 2005, 2009 Eduardo Cavazos and Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types arrays ui ui.private ui.gadgets
+USING: accessors alien.c-types arrays ascii assocs
-ui.gadgets.private ui.gestures ui.backend ui.clipboards
+classes.struct combinators io.encodings.ascii
-ui.gadgets.worlds ui.render ui.event-loop assocs kernel math
+io.encodings.string io.encodings.utf8 kernel literals math
-namespaces opengl sequences strings x11 x11.xlib x11.events x11.xim
+namespaces sequences strings ui ui.backend ui.clipboards
-x11.glx x11.clipboard x11.constants x11.windows x11.io
+ui.event-loop ui.gadgets ui.gadgets.private ui.gadgets.worlds
-io.encodings.string io.encodings.ascii io.encodings.utf8 combinators
+ui.gestures ui.pixel-formats ui.pixel-formats.private
-command-line math.vectors classes.tuple opengl.gl threads
+ui.private x11 x11.clipboard x11.constants x11.events x11.glx
-math.rectangles environment ascii literals
+x11.io x11.windows x11.xim x11.xlib environment command-line ;
-ui.pixel-formats ui.pixel-formats.private ;
 IN: ui.backend.x11
 
 SINGLETON: x11-ui-backend
@@ -25,8 +24,7 @@ C: <x11-pixmap-handle> x11-pixmap-handle
 M: world expose-event nip relayout ;
 
 M: world configure-event
-    over configured-loc >>window-loc
+    swap [ event-loc >>window-loc ] [ event-dim >>dim ] bi
-    swap configured-dim >>dim
     ! In case dimensions didn't change
     relayout-1 ;
 
@@ -51,7 +49,8 @@ PIXEL-FORMAT-ATTRIBUTE-TABLE: glx-visual { $ GLX_USE_GL $ GLX_RGBA } H{
 
 M: x11-ui-backend (make-pixel-format)
     [ drop dpy get scr get ] dip
-    >glx-visual-int-array glXChooseVisual ;
+    >glx-visual-int-array glXChooseVisual
+    XVisualInfo memory>struct ;
 
 M: x11-ui-backend (free-pixel-format)
     handle>> XFree ;
@@ -103,7 +102,7 @@ CONSTANT: key-codes
     dup key-codes at [ t ] [ 1string f ] ?if ;
 
 : event-modifiers ( event -- seq )
-    XKeyEvent-state modifiers modifier ;
+    state>> modifiers modifier ;
 
 : valid-input? ( string gesture -- ? )
     over empty? [ 2drop f ] [
@@ -132,10 +131,7 @@ M: world key-up-event
     [ key-up-event>gesture ] dip propagate-key-gesture ;
 
 : mouse-event>gesture ( event -- modifiers button loc )
-    [ event-modifiers ]
+    [ event-modifiers ] [ button>> ] [ event-loc ] tri ;
-    [ XButtonEvent-button ]
-    [ mouse-event-loc ]
-    tri ;
 
 M: world button-down-event
     [ mouse-event>gesture [ <button-down> ] dip ] dip
@@ -146,7 +142,7 @@ M: world button-up-event
     send-button-up ;
 
 : mouse-event>scroll-direction ( event -- pair )
-    XButtonEvent-button {
+    button>> {
         { 4 { 0 -1 } }
         { 5 { 0 1 } }
         { 6 { -1 0 } }
@@ -154,7 +150,7 @@ M: world button-up-event
     } at ;
 
 M: world wheel-event
-    [ [ mouse-event>scroll-direction ] [ mouse-event-loc ] bi ] dip
+    [ [ mouse-event>scroll-direction ] [ event-loc ] bi ] dip
     send-wheel ;
 
 M: world enter-event motion-event ;
@@ -162,16 +158,13 @@ M: world enter-event motion-event ;
 M: world leave-event 2drop forget-rollover ;
 
 M: world motion-event
-    [ [ XMotionEvent-x ] [ XMotionEvent-y ] bi 2array ] dip
+    [ event-loc ] dip move-hand fire-motion ;
-    move-hand fire-motion ;
 
 M: world focus-in-event
-    nip
+    nip [ handle>> xic>> XSetICFocus ] [ focus-world ] bi ;
-    [ handle>> xic>> XSetICFocus ] [ focus-world ] bi ;
 
 M: world focus-out-event
-    nip
+    nip [ handle>> xic>> XUnsetICFocus ] [ unfocus-world ] bi ;
-    [ handle>> xic>> XUnsetICFocus ] [ unfocus-world ] bi ;
 
 M: world selection-notify-event
     [ handle>> window>> selection-from-event ] keep
@@ -189,22 +182,18 @@ M: world selection-notify-event
     } case ;
 
 : encode-clipboard ( string type -- bytes )
-    XSelectionRequestEvent-target
+    target>> XA_UTF8_STRING = utf8 ascii ? encode ;
-    XA_UTF8_STRING = utf8 ascii ? encode ;
 
 : set-selection-prop ( evt -- )
     dpy get swap
-    [ XSelectionRequestEvent-requestor ] keep
+    [ requestor>> ] keep
-    [ XSelectionRequestEvent-property ] keep
+    [ property>> ] keep
-    [ XSelectionRequestEvent-target ] keep
+    [ target>> 8 PropModeReplace ] keep
-    [ 8 PropModeReplace ] dip
+    [ selection>> clipboard-for-atom contents>> ] keep
-    [
+    encode-clipboard dup length XChangeProperty drop ;
-        XSelectionRequestEvent-selection
-        clipboard-for-atom contents>>
-    ] keep encode-clipboard dup length XChangeProperty drop ;
 
 M: world selection-request-event
-    drop dup XSelectionRequestEvent-target {
+    drop dup target>> {
         { [ dup supported-type? ] [ drop dup set-selection-prop send-notify-success ] }
         { [ dup "TARGETS" x-atom = ] [ drop dup set-targets-prop send-notify-success ] }
         { [ dup "TIMESTAMP" x-atom = ] [ drop dup set-timestamp-prop send-notify-success ] }
@@ -235,7 +224,7 @@ M: world client-event
     ] [ wait-for-display wait-event ] if ;
 
 M: x11-ui-backend do-events
-    wait-event dup XAnyEvent-window window dup
+    wait-event dup XAnyEvent>> window>> window dup
     [ handle-event ] [ 2drop ] if ;
 
 : x-clipboard@ ( gadget clipboard -- prop win )
@@ -269,17 +258,13 @@ M: x11-ui-backend set-title ( string world -- )
     [ dpy get ] 2dip [ set-title-old ] [ set-title-new ] 3bi ;
 
 M: x11-ui-backend (set-fullscreen) ( world ? -- )
-    [
+    XClientMessageEvent <struct>
-        handle>> window>> "XClientMessageEvent" <c-object>
+    swap _NET_WM_STATE_ADD _NET_WM_STATE_REMOVE ? >>data0
-        [ set-XClientMessageEvent-window ] keep
+    swap handle>> window>> >>window
-    ] dip
+    dpy get >>display
-    _NET_WM_STATE_ADD _NET_WM_STATE_REMOVE ?
+    "_NET_WM_STATE" x-atom >>message_type
-    over set-XClientMessageEvent-data0
+    32 >>format
-    ClientMessage over set-XClientMessageEvent-type
+    "_NET_WM_STATE_FULLSCREEN" x-atom >>data1
-    dpy get over set-XClientMessageEvent-display
-    "_NET_WM_STATE" x-atom over set-XClientMessageEvent-message_type
-    32 over set-XClientMessageEvent-format
-    "_NET_WM_STATE_FULLSCREEN" x-atom over set-XClientMessageEvent-data1
     [ dpy get root get 0 SubstructureNotifyMask ] dip XSendEvent drop ;
 
 M: x11-ui-backend (open-window) ( world -- )
@@ -312,9 +297,9 @@ M: x11-pixmap-handle flush-gl-context ( handle -- )
     drop ;
 
 M: x11-ui-backend (open-offscreen-buffer) ( world -- )
-    dup [ [ dim>> ] [ handle>> ] bi* glx-pixmap ]
+    dup [ [ dim>> ] [ handle>> ] bi* glx-pixmap ] with-world-pixel-format
-    with-world-pixel-format
     <x11-pixmap-handle> >>handle drop ;
+
 M: x11-ui-backend (close-offscreen-buffer) ( handle -- )
     dpy get swap
     [ glx-pixmap>> glXDestroyGLXPixmap ]

basis/unix/bsd/freebsd/freebsd.factor

@@ -1,4 +1,4 @@
-USING: alien.syntax ;
+USING: alien.syntax classes.struct ;
 IN: unix
 
 CONSTANT: FD_SETSIZE 1024
@@ -13,12 +13,12 @@ C-STRUCT: addrinfo
     { "void*" "addr" }
     { "addrinfo*" "next" } ;
 
-C-STRUCT: dirent
+STRUCT: dirent
-    { "u_int32_t" "d_fileno" }
+    { d_fileno u_int32_t }
-    { "u_int16_t" "d_reclen" }
+    { d_reclen u_int16_t }
-    { "u_int8_t"  "d_type" }
+    { d_type u_int8_t }
-    { "u_int8_t"  "d_namlen" }
+    { d_namlen u_int8_t }
-    { { "char" 256 } "d_name" } ;
+    { d_name char[256] } ;
 
 CONSTANT: EPERM 1
 CONSTANT: ENOENT 2

basis/unix/bsd/macosx/macosx.factor

@@ -1,4 +1,4 @@
-USING: alien.syntax unix.time ;
+USING: alien.syntax unix.time classes.struct ;
 IN: unix
 
 CONSTANT: FD_SETSIZE 1024
@@ -32,12 +32,12 @@ CONSTANT: __DARWIN_MAXPATHLEN 1024
 CONSTANT: __DARWIN_MAXNAMELEN 255
 CONSTANT: __DARWIN_MAXNAMELEN+1 255
 
-C-STRUCT: dirent
+STRUCT: dirent
-    { "ino_t" "d_ino" }
+    { d_ino ino_t }
-    { "__uint16_t" "d_reclen" }
+    { d_reclen __uint16_t }
-    { "__uint8_t"  "d_type" }
+    { d_type __uint8_t }
-    { "__uint8_t"  "d_namlen" }
+    { d_namlen __uint8_t }
-    { { "char" __DARWIN_MAXNAMELEN+1 } "d_name" } ;
+    { d_name { "char" __DARWIN_MAXNAMELEN+1 } } ;
 
 CONSTANT: EPERM 1
 CONSTANT: ENOENT 2

basis/unix/bsd/netbsd/netbsd.factor

@@ -1,4 +1,5 @@
-USING: alien.syntax alien.c-types math vocabs.loader ;
+USING: alien.syntax alien.c-types math vocabs.loader
+classes.struct ;
 IN: unix
 
 CONSTANT: FD_SETSIZE 256
@@ -13,12 +14,12 @@ C-STRUCT: addrinfo
     { "void*" "addr" }
     { "addrinfo*" "next" } ;
 
-C-STRUCT: dirent
+STRUCT: dirent
-    { "__uint32_t" "d_fileno" }
+    { d_fileno __uint32_t }
-    { "__uint16_t" "d_reclen" }
+    { d_reclen __uint16_t }
-    { "__uint8_t"  "d_type" }
+    { d_type __uint8_t }
-    { "__uint8_t"  "d_namlen" }
+    { d_namlen __uint8_t }
-    { { "char" 256 } "d_name" } ;
+    { d_name char[256] } ;
 
 CONSTANT: EPERM 1
 CONSTANT: ENOENT 2
@@ -126,8 +127,7 @@ CONSTANT: _UTX_LINESIZE   32
 CONSTANT: _UTX_IDSIZE     4
 CONSTANT: _UTX_HOSTSIZE   256
 
-: _SS_MAXSIZE ( -- n )
+CONSTANT: _SS_MAXSIZE 128
-    128 ; inline
 
 : _SS_ALIGNSIZE ( -- n )
     "__int64_t" heap-size ; inline

basis/unix/bsd/openbsd/openbsd.factor

@@ -1,4 +1,4 @@
-USING: alien.syntax ;
+USING: alien.syntax classes.struct ;
 IN: unix
 
 CONSTANT: FD_SETSIZE 1024
@@ -13,12 +13,12 @@ C-STRUCT: addrinfo
     { "char*" "canonname" }
     { "addrinfo*" "next" } ;
 
-C-STRUCT: dirent
+STRUCT: dirent
-    { "__uint32_t" "d_fileno" }
+    { d_fileno __uint32_t }
-    { "__uint16_t" "d_reclen" }
+    { d_reclen __uint16_t }
-    { "__uint8_t"  "d_type" }
+    { d_type __uint8_t }
-    { "__uint8_t"  "d_namlen" }
+    { d_namlen __uint8_t }
-    { { "char" 256 } "d_name" } ;
+    { d_name char[256] } ;
 
 CONSTANT: EPERM 1
 CONSTANT: ENOENT 2

basis/unix/kqueue/freebsd/freebsd.factor

@@ -1,14 +1,13 @@
-USING: alien.syntax ;
+USING: alien.syntax classes.struct ;
 IN: unix.kqueue
 
-C-STRUCT: kevent
+STRUCT: kevent
-    { "ulong"  "ident"  } ! identifier for this event
+    { ident  ulong }
-    { "short"  "filter" } ! filter for event
+    { filter short }
-    { "ushort" "flags"  } ! action flags for kqueue
+    { flags  ushort }
-    { "uint"   "fflags" } ! filter flag value
+    { fflags uint }
-    { "long"   "data"   } ! filter data value
+    { data   long }
-    { "void*"  "udata"  } ! opaque user data identifier
+    { udata  void* } ;
-;
 
 FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ;
 

basis/unix/kqueue/macosx/macosx.factor

@@ -1,14 +1,13 @@
-USING: alien.syntax ;
+USING: alien.syntax classes.struct ;
 IN: unix.kqueue
 
-C-STRUCT: kevent
+STRUCT: kevent
-    { "ulong"  "ident"  } ! identifier for this event
+    { ident  ulong }
-    { "short"  "filter" } ! filter for event
+    { filter short }
-    { "ushort" "flags"  } ! action flags for kqueue
+    { flags  ushort }
-    { "uint"   "fflags" } ! filter flag value
+    { fflags uint }
-    { "long"   "data"   } ! filter data value
+    { data   long }
-    { "void*"  "udata"  } ! opaque user data identifier
+    { udata  void* } ;
-;
 
 FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ;
 

basis/unix/kqueue/netbsd/netbsd.factor

@@ -1,14 +1,13 @@
-USING: alien.syntax ;
+USING: alien.syntax classes.struct ;
 IN: unix.kqueue
 
-C-STRUCT: kevent
+STRUCT: kevent
-    { "ulong"    "ident"  } ! identifier for this event
+    { ident  ulong }
-    { "uint"     "filter" } ! filter for event
+    { filter uint }
-    { "uint"     "flags"  } ! action flags for kqueue
+    { flags  uint }
-    { "uint"     "fflags" } ! filter flag value
+    { fflags uint }
-    { "longlong" "data"   } ! filter data value
+    { data   longlong }
-    { "void*"    "udata"  } ! opaque user data identifier
+    { udata  void* } ;
-;
 
 FUNCTION: int kevent ( int kq, kevent* changelist, size_t nchanges, kevent* eventlist, size_t nevents, timespec* timeout ) ;
 

basis/unix/kqueue/openbsd/openbsd.factor

@@ -1,14 +1,13 @@
-USING: alien.syntax ;
+USING: alien.syntax classes.struct ;
 IN: unix.kqueue
 
-C-STRUCT: kevent
+STRUCT: kevent
-    { "uint"   "ident"  } ! identifier for this event
+    { ident  uint }
-    { "short"  "filter" } ! filter for event
+    { filter short }
-    { "ushort" "flags"  } ! action flags for kqueue
+    { flags  ushort }
-    { "uint"   "fflags" } ! filter flag value
+    { fflags uint }
-    { "int"    "data"   } ! filter data value
+    { data   int }
-    { "void*"  "udata"  } ! opaque user data identifier
+    { udata  void* } ;
-;
 
 FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ;
 

basis/unix/linux/linux.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax alien system ;
+USING: alien.syntax alien system classes.struct ;
 IN: unix
 
 ! Linux.
@@ -94,12 +94,12 @@ C-STRUCT: passwd
     { "char*"  "pw_shell" } ;
 
 ! dirent64
-C-STRUCT: dirent
+STRUCT: dirent
-    { "ulonglong" "d_ino" }
+    { d_ino ulonglong }
-    { "longlong" "d_off" }
+    { d_off longlong }
-    { "ushort" "d_reclen" }
+    { d_reclen ushort }
-    { "uchar" "d_type" }
+    { d_type uchar }
-    { { "char" 256 } "d_name" } ;
+    { d_name char[256] } ;
 
 FUNCTION: int open64 ( char* path, int flags, int prot ) ;
 FUNCTION: dirent64* readdir64 ( DIR* dirp ) ;

basis/unix/stat/freebsd/freebsd.factor

@@ -9,7 +9,7 @@ STRUCT: stat
     { st_mode mode_t }
     { st_nlink nlink_t }
     { st_uid uid_t }
-    { st_gid git_t }
+    { st_gid gid_t }
     { st_rdev __dev_t }
     { st_atimespec timespec }
     { st_mtimespec timespec }
@@ -18,10 +18,10 @@ STRUCT: stat
     { st_blocks blkcnt_t }
     { st_blksize blksize_t }
     { st_flags fflags_t }
-    { st_gen _uint32_t }
+    { st_gen __uint32_t }
     { st_lspare __int32_t }
     { st_birthtimespec timespec }
-    { pad0 __int32_t[2] }
+    { pad0 __int32_t[2] } ;
 
 FUNCTION: int stat  ( char* pathname, stat* buf ) ;
 FUNCTION: int lstat ( char* pathname, stat* buf ) ;

basis/windows/com/syntax/syntax.factor

@@ -1,18 +1,16 @@
 USING: alien alien.c-types alien.accessors effects kernel
 windows.ole32 parser lexer splitting grouping sequences
 namespaces assocs quotations generalizations accessors words
-macros alien.syntax fry arrays layouts math ;
+macros alien.syntax fry arrays layouts math classes.struct
+windows.kernel32 prettyprint.custom prettyprint.sections ;
 IN: windows.com.syntax
 
 <PRIVATE
 
-C-STRUCT: com-interface
-    { "void*" "vtbl" } ;
-
 MACRO: com-invoke ( n return parameters -- )
     [ 2nip length ] 3keep
     '[
-        _ npick com-interface-vtbl _ cell * alien-cell _ _
+        _ npick *void* _ cell * alien-cell _ _
         "stdcall" alien-indirect
     ] ;
 
@@ -31,7 +29,7 @@ unless
     dup "f" = [ drop f ] [
         dup +com-interface-definitions+ get-global at*
         [ nip ]
-        [ swap " COM interface hasn't been defined" append throw ]
+        [ " COM interface hasn't been defined" prepend throw ]
         if
     ] if ;
 
@@ -100,3 +98,5 @@ SYNTAX: COM-INTERFACE:
     define-words-for-com-interface ;
 
 SYNTAX: GUID: scan string>guid parsed ;
+
+M: GUID pprint* guid>string "GUID: " prepend text ;

basis/windows/com/wrapper/wrapper.factor

@@ -48,7 +48,7 @@ unless
 : (make-query-interface) ( interfaces -- quot )
     (query-interface-cases) 
     '[
-        swap 16 memory>byte-array
+        swap GUID memory>struct
         _ case
         [
             "void*" heap-size * rot <displaced-alien> com-add-ref

basis/windows/errors/errors.factor

@@ -696,6 +696,8 @@ CONSTANT: FORMAT_MESSAGE_MAX_WIDTH_MASK   HEX: 000000FF
 : make-lang-id ( lang1 lang2 -- n )
     10 shift bitor ; inline
 
+<< "TCHAR" require-c-type-arrays >>
+
 ERROR: error-message-failed id ;
 :: n>win32-error-string ( id -- string )
     {
@@ -705,7 +707,7 @@ ERROR: error-message-failed id ;
     f
     id
     LANG_NEUTRAL SUBLANG_DEFAULT make-lang-id
-    32768 [ "TCHAR" <c-array> ] keep 
+    32768 [ "TCHAR" <c-type-array> ] [ ] bi
     f pick [ FormatMessage 0 = [ id error-message-failed ] when ] dip
     utf16n alien>string [ blank? ] trim ;
 

basis/windows/fonts/fonts.factor

@@ -1,37 +1,37 @@
-USING: assocs memoize locals kernel accessors init fonts math
+USING: assocs memoize locals kernel accessors init fonts math
-combinators windows.errors windows.types windows.gdi32 ;
+combinators windows.errors windows.types windows.gdi32 ;
-IN: windows.fonts
+IN: windows.fonts
-
+
-: windows-font-name ( string -- string' )
+: windows-font-name ( string -- string' )
-    H{
+    H{
-        { "sans-serif" "Tahoma" }
+        { "sans-serif" "Tahoma" }
-        { "serif" "Times New Roman" }
+        { "serif" "Times New Roman" }
-        { "monospace" "Courier New" }
+        { "monospace" "Courier New" }
-    } ?at drop ;
+    } ?at drop ;
-    
+
-MEMO:: (cache-font) ( font -- HFONT )
+MEMO:: (cache-font) ( font -- HFONT )
-    font size>> neg ! nHeight
+    font size>> neg ! nHeight
-    0 0 0 ! nWidth, nEscapement, nOrientation
+    0 0 0 ! nWidth, nEscapement, nOrientation
-    font bold?>> FW_BOLD FW_NORMAL ? ! fnWeight
+    font bold?>> FW_BOLD FW_NORMAL ? ! fnWeight
-    font italic?>> TRUE FALSE ? ! fdwItalic
+    font italic?>> TRUE FALSE ? ! fdwItalic
-    FALSE ! fdwUnderline
+    FALSE ! fdwUnderline
-    FALSE ! fdWStrikeOut
+    FALSE ! fdWStrikeOut
-    DEFAULT_CHARSET ! fdwCharSet
+    DEFAULT_CHARSET ! fdwCharSet
-    OUT_OUTLINE_PRECIS ! fdwOutputPrecision
+    OUT_OUTLINE_PRECIS ! fdwOutputPrecision
-    CLIP_DEFAULT_PRECIS ! fdwClipPrecision
+    CLIP_DEFAULT_PRECIS ! fdwClipPrecision
-    DEFAULT_QUALITY ! fdwQuality
+    DEFAULT_QUALITY ! fdwQuality
-    DEFAULT_PITCH ! fdwPitchAndFamily
+    DEFAULT_PITCH ! fdwPitchAndFamily
-    font name>> windows-font-name
+    font name>> windows-font-name
-    CreateFont
+    CreateFont
-    dup win32-error=0/f ;
+    dup win32-error=0/f ;
-
+
-: cache-font ( font -- HFONT ) strip-font-colors (cache-font) ;
+: cache-font ( font -- HFONT ) strip-font-colors (cache-font) ;
-
+
-[ \ (cache-font) reset-memoized ] "windows.fonts" add-init-hook
+[ \ (cache-font) reset-memoized ] "windows.fonts" add-init-hook
-
+
-: TEXTMETRIC>metrics ( TEXTMETRIC -- metrics )
+: TEXTMETRIC>metrics ( TEXTMETRIC -- metrics )
-    [ metrics new 0 >>width ] dip {
+    [ metrics new 0 >>width ] dip {
-        [ TEXTMETRICW-tmHeight >>height ]
+        [ tmHeight>> >>height ]
-        [ TEXTMETRICW-tmAscent >>ascent ]
+        [ tmAscent>> >>ascent ]
-        [ TEXTMETRICW-tmDescent >>descent ]
+        [ tmDescent>> >>descent ]
-    } cleave ;
+    } cleave ;

basis/windows/kernel32/kernel32.factor

@@ -90,11 +90,12 @@ CONSTANT: FILE_ACTION_MODIFIED 3
 CONSTANT: FILE_ACTION_RENAMED_OLD_NAME 4
 CONSTANT: FILE_ACTION_RENAMED_NEW_NAME 5
 
-C-STRUCT: FILE_NOTIFY_INFORMATION
+STRUCT: FILE_NOTIFY_INFORMATION
-    { "DWORD" "NextEntryOffset" }
+    { NextEntryOffset DWORD }
-    { "DWORD" "Action" }
+    { Action DWORD }
-    { "DWORD" "FileNameLength" }
+    { FileNameLength DWORD }
-    { "WCHAR[1]" "FileName" } ;
+    { FileName WCHAR[1] } ;
+
 TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION
 
 CONSTANT: STD_INPUT_HANDLE  -10
@@ -226,14 +227,14 @@ STRUCT: SYSTEMTIME
     { wSecond WORD }
     { wMilliseconds WORD } ;
 
-C-STRUCT: TIME_ZONE_INFORMATION
+STRUCT: TIME_ZONE_INFORMATION
-    { "LONG" "Bias" }
+    { Bias LONG }
-    { { "WCHAR" 32 } "StandardName" }
+    { StandardName WCHAR[32] }
-    { "SYSTEMTIME" "StandardDate" }
+    { StandardDate SYSTEMTIME }
-    { "LONG" "StandardBias" }
+    { StandardBias LONG }
-    { { "WCHAR" 32 } "DaylightName" }
+    { DaylightName WCHAR[32] }
-    { "SYSTEMTIME" "DaylightDate" }
+    { DaylightDate SYSTEMTIME }
-    { "LONG" "DaylightBias" } ;
+    { DaylightBias LONG } ;
 
 STRUCT: FILETIME
     { dwLowDateTime DWORD }
@@ -306,13 +307,13 @@ STRUCT: MEMORYSTATUSEX
 
 TYPEDEF: void* LPMEMORYSTATUSEX
 
-C-STRUCT: OSVERSIONINFO
+STRUCT: OSVERSIONINFO
-    { "DWORD" "dwOSVersionInfoSize" }
+    { dwOSVersionInfoSize DWORD }
-    { "DWORD" "dwMajorVersion" }
+    { dwMajorVersion DWORD }
-    { "DWORD" "dwMinorVersion" }
+    { dwMinorVersion DWORD }
-    { "DWORD" "dwBuildNumber" }
+    { dwBuildNumber DWORD }
-    { "DWORD" "dwPlatformId" }
+    { dwPlatformId DWORD }
-    { { "WCHAR" 128 } "szCSDVersion" } ;
+    { szCSDVersion WCHAR[128] } ;
 
 TYPEDEF: void* LPOSVERSIONINFO
 
@@ -325,11 +326,11 @@ C-STRUCT: MEMORY_BASIC_INFORMATION
   { "DWORD" "protect" }
   { "DWORD" "type" } ;
 
-C-STRUCT: GUID
+STRUCT: GUID
-    { "ULONG" "Data1" }
+    { Data1 ULONG }
-    { "WORD"  "Data2" }
+    { Data2 WORD }
-    { "WORD"  "Data3" }
+    { Data3 WORD }
-    { { "UCHAR" 8 } "Data4" } ;
+    { Data4 UCHAR[8] } ;
 
 /*
     fBinary  :1;
@@ -659,13 +660,13 @@ C-STRUCT: TOKEN_PRIVILEGES
     { "LUID_AND_ATTRIBUTES*" "Privileges" } ;
 TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
 
-C-STRUCT: WIN32_FILE_ATTRIBUTE_DATA
+STRUCT: WIN32_FILE_ATTRIBUTE_DATA
-    { "DWORD" "dwFileAttributes" }
+    { dwFileAttributes DWORD }
-    { "FILETIME" "ftCreationTime" }
+    { ftCreationTime FILETIME }
-    { "FILETIME" "ftLastAccessTime" }
+    { ftLastAccessTime FILETIME }
-    { "FILETIME" "ftLastWriteTime" }
+    { ftLastWriteTime FILETIME }
-    { "DWORD" "nFileSizeHigh" }
+    { nFileSizeHigh DWORD }
-    { "DWORD" "nFileSizeLow" } ;
+    { nFileSizeLow DWORD } ;
 TYPEDEF: WIN32_FILE_ATTRIBUTE_DATA* LPWIN32_FILE_ATTRIBUTE_DATA
 
 C-STRUCT: BY_HANDLE_FILE_INFORMATION
@@ -694,19 +695,17 @@ C-STRUCT: OFSTRUCT
 
 TYPEDEF: OFSTRUCT* LPOFSTRUCT
 
-! MAX_PATH = 260
+STRUCT: WIN32_FIND_DATA
-C-STRUCT: WIN32_FIND_DATA
+    { dwFileAttributes DWORD }
-    { "DWORD" "dwFileAttributes" }
+    { ftCreationTime FILETIME }
-    { "FILETIME" "ftCreationTime" }
+    { ftLastAccessTime FILETIME }
-    { "FILETIME" "ftLastAccessTime" }
+    { ftLastWriteTime FILETIME }
-    { "FILETIME" "ftLastWriteTime" }
+    { nFileSizeHigh DWORD }
-    { "DWORD" "nFileSizeHigh" }
+    { nFileSizeLow DWORD }
-    { "DWORD" "nFileSizeLow" }
+    { dwReserved0 DWORD }
-    { "DWORD" "dwReserved0" }
+    { dwReserved1 DWORD }
-    { "DWORD" "dwReserved1" }
+    { cFileName { "TCHAR" MAX_PATH } }
-    ! { { "TCHAR" MAX_PATH } "cFileName" }
+    { cAlternateFileName TCHAR[14] } ;
-    { { "TCHAR" 260 } "cFileName" }
-    { { "TCHAR" 14 } "cAlternateFileName" } ;
 
 STRUCT: BY_HANDLE_FILE_INFORMATION
     { dwFileAttributes DWORD }

basis/windows/offscreen/offscreen.factor

@@ -2,25 +2,26 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types kernel combinators sequences
 math windows.gdi32 windows.types images destructors
-accessors fry locals ;
+accessors fry locals classes.struct ;
 IN: windows.offscreen
 
 : (bitmap-info) ( dim -- BITMAPINFO )
-    "BITMAPINFO" <c-object> [
+    [
-        BITMAPINFO-bmiHeader {
+        BITMAPINFO <struct>
-            [ nip "BITMAPINFOHEADER" heap-size swap set-BITMAPINFOHEADER-biSize ]
+        dup bmiHeader>>
-            [ [ first ] dip set-BITMAPINFOHEADER-biWidth ]
+        BITMAPINFOHEADER heap-size >>biSize
-            [ [ second ] dip set-BITMAPINFOHEADER-biHeight ]
+    ] dip
-            [ nip 1 swap set-BITMAPINFOHEADER-biPlanes ]
+        [ first >>biWidth ]
-            [ nip 32 swap set-BITMAPINFOHEADER-biBitCount ]
+        [ second >>biHeight ]
-            [ nip BI_RGB swap set-BITMAPINFOHEADER-biCompression ]
+        [ first2 * 4 * >>biSizeImage ] tri
-            [ [ first2 * 4 * ] dip set-BITMAPINFOHEADER-biSizeImage ]
+        1 >>biPlanes
-            [ nip 72 swap set-BITMAPINFOHEADER-biXPelsPerMeter ]
+        32 >>biBitCount
-            [ nip 72 swap set-BITMAPINFOHEADER-biYPelsPerMeter ]
+        BI_RGB >>biCompression
-            [ nip 0 swap set-BITMAPINFOHEADER-biClrUsed ]
+        72 >>biXPelsPerMeter
-            [ nip 0 swap set-BITMAPINFOHEADER-biClrImportant ]
+        72 >>biYPelsPerMeter
-        } 2cleave
+        0 >>biClrUsed
-    ] keep ;
+        0 >>biClrImportant
+        drop ;
 
 : make-bitmap ( dim dc -- hBitmap bits )
     [ nip ]

basis/windows/ole32/ole32-tests.factor

@@ -1,4 +1,5 @@
-USING: kernel tools.test windows.ole32 alien.c-types ;
+USING: kernel tools.test windows.ole32 alien.c-types
+classes.struct specialized-arrays.uchar windows.kernel32 ;
 IN: windows.ole32.tests
 
 [ t ] [
@@ -19,17 +20,9 @@ IN: windows.ole32.tests
     guid=
 ] unit-test
         
-little-endian?
+[
-[ B{
+    GUID: 01234567-89ab-cdef-0123-456789abcdef}
-    HEX: 67 HEX: 45 HEX: 23 HEX: 01 HEX: ab HEX: 89 HEX: ef HEX: cd
+] [ "{01234567-89ab-cdef-0123-456789abcdef}" string>guid ] unit-test
-    HEX: 01 HEX: 23 HEX: 45 HEX: 67 HEX: 89 HEX: ab HEX: cd HEX: ef
-} ]
-[ B{
-    HEX: 01 HEX: 23 HEX: 45 HEX: 67 HEX: 89 HEX: ab HEX: cd HEX: ef
-    HEX: 01 HEX: 23 HEX: 45 HEX: 67 HEX: 89 HEX: ab HEX: cd HEX: ef
-} ] ?
-[ "{01234567-89ab-cdef-0123-456789abcdef}" string>guid ]
-unit-test
 
 [ "{01234567-89ab-cdef-0123-456789abcdef}" ]
 [ "{01234567-89ab-cdef-0123-456789abcdef}" string>guid guid>string ]

basis/windows/ole32/ole32.factor

@@ -1,7 +1,8 @@
 USING: alien alien.syntax alien.c-types alien.strings math
 kernel sequences windows.errors windows.types io
 accessors math.order namespaces make math.parser windows.kernel32
-combinators locals specialized-arrays.direct.uchar ;
+combinators locals specialized-arrays.direct.uchar
+literals splitting grouping classes.struct combinators.smart ;
 IN: windows.ole32
 
 LIBRARY: ole32
@@ -130,60 +131,34 @@ TUPLE: ole32-error code message ;
 : guid= ( a b -- ? )
     [ 16 memory>byte-array ] bi@ = ;
 
-: GUID-STRING-LENGTH ( -- n )
+CONSTANT: GUID-STRING-LENGTH
-    "{01234567-89ab-cdef-0123-456789abcdef}" length ; inline
+    $[ "{01234567-89ab-cdef-0123-456789abcdef}" length ]
-
-:: (guid-section>guid) ( string guid start end quot -- )
-    start end string subseq hex> guid quot call ; inline
-
-:: (guid-byte>guid) ( string guid start end byte -- )
-    start end string subseq hex> byte guid set-nth ; inline
 
 : string>guid ( string -- guid )
-    "GUID" <c-object> [
+    "{-}" split harvest
-        {
+    [ first3 [ hex> ] tri@ ]
-            [  1  9 [ set-GUID-Data1 ] (guid-section>guid) ]
+    [ 3 tail concat 2 group [ hex> ] B{ } map-as ] bi
-            [ 10 14 [ set-GUID-Data2 ] (guid-section>guid) ]
+    GUID <struct-boa> ;
-            [ 15 19 [ set-GUID-Data3 ] (guid-section>guid) ]
-            [ ]
-        } 2cleave
-
-        GUID-Data4 {
-            [ 20 22 0 (guid-byte>guid) ]
-            [ 22 24 1 (guid-byte>guid) ]
-
-            [ 25 27 2 (guid-byte>guid) ]
-            [ 27 29 3 (guid-byte>guid) ]
-            [ 29 31 4 (guid-byte>guid) ]
-            [ 31 33 5 (guid-byte>guid) ]
-            [ 33 35 6 (guid-byte>guid) ]
-            [ 35 37 7 (guid-byte>guid) ]
-        } 2cleave
-    ] keep ;
-
-: (guid-section%) ( guid quot len -- )
-    [ call >hex ] dip CHAR: 0 pad-head % ; inline
-
-: (guid-byte%) ( guid byte -- )
-    swap nth >hex 2 CHAR: 0 pad-head % ; inline
 
 : guid>string ( guid -- string )
     [
-        "{" % {
+        [ "{" ] dip {
-            [ [ GUID-Data1 ] 8 (guid-section%) "-" % ]
+            [ Data1>> >hex 8 CHAR: 0 pad-head "-" ]
-            [ [ GUID-Data2 ] 4 (guid-section%) "-" % ]
+            [ Data2>> >hex 4 CHAR: 0 pad-head "-" ]
-            [ [ GUID-Data3 ] 4 (guid-section%) "-" % ]
+            [ Data3>> >hex 4 CHAR: 0 pad-head "-" ]
-            [ ]
+            [
+                Data4>> [
+                    {
+                        [ >hex 2 CHAR: 0 pad-head ]
+                        [ >hex 2 CHAR: 0 pad-head "-" ]
+                        [ >hex 2 CHAR: 0 pad-head ]
+                        [ >hex 2 CHAR: 0 pad-head ]
+                        [ >hex 2 CHAR: 0 pad-head ]
+                        [ >hex 2 CHAR: 0 pad-head ]
+                        [ >hex 2 CHAR: 0 pad-head ]
+                        [ >hex 2 CHAR: 0 pad-head ]
+                    } spread
+                ] input<sequence "}"
+            ]
         } cleave
-        GUID-Data4 {
+    ] "" append-outputs-as ;
-            [ 0 (guid-byte%) ]
-            [ 1 (guid-byte%) "-" % ]
-            [ 2 (guid-byte%) ]
-            [ 3 (guid-byte%) ]
-            [ 4 (guid-byte%) ]
-            [ 5 (guid-byte%) ]
-            [ 6 (guid-byte%) ]
-            [ 7 (guid-byte%) "}" % ]
-        } cleave
-    ] "" make ;
-

basis/windows/shell32/shell32.factor

@@ -3,7 +3,7 @@
 USING: alien alien.c-types alien.strings alien.syntax
 combinators io.encodings.utf16n io.files io.pathnames kernel
 windows.errors windows.com windows.com.syntax windows.user32
-windows.ole32 windows ;
+windows.ole32 windows specialized-arrays.ushort classes.struct ;
 IN: windows.shell32
 
 CONSTANT: CSIDL_DESKTOP HEX: 00
@@ -90,7 +90,7 @@ ALIAS: ShellExecute ShellExecuteW
 
 : shell32-directory ( n -- str )
     f swap f SHGFP_TYPE_DEFAULT
-    MAX_UNICODE_PATH "ushort" <c-array>
+    MAX_UNICODE_PATH <ushort-array>
     [ SHGetFolderPath drop ] keep utf16n alien>string ;
 
 : desktop ( -- str )
@@ -167,23 +167,23 @@ CONSTANT: SFGAO_NEWCONTENT        HEX: 00200000
 
 TYPEDEF: ULONG SFGAOF
 
-C-STRUCT: DROPFILES
+STRUCT: DROPFILES
-    { "DWORD" "pFiles" }
+    { pFiles DWORD }
-    { "POINT" "pt" }
+    { pt POINT }
-    { "BOOL" "fNC" }
+    { fNC BOOL }
-    { "BOOL" "fWide" } ;
+    { fWide BOOL } ;
 TYPEDEF: DROPFILES* LPDROPFILES
 TYPEDEF: DROPFILES* LPCDROPFILES
 TYPEDEF: HANDLE HDROP
 
-C-STRUCT: SHITEMID
+STRUCT: SHITEMID
-    { "USHORT" "cb" }
+    { cb USHORT }
-    { "BYTE[1]" "abID" } ;
+    { abID BYTE[1] } ;
 TYPEDEF: SHITEMID* LPSHITEMID
 TYPEDEF: SHITEMID* LPCSHITEMID
 
-C-STRUCT: ITEMIDLIST
+STRUCT: ITEMIDLIST
-    { "SHITEMID" "mkid" } ;
+    { mkid SHITEMID } ;
 TYPEDEF: ITEMIDLIST* LPITEMIDLIST
 TYPEDEF: ITEMIDLIST* LPCITEMIDLIST
 TYPEDEF: ITEMIDLIST ITEMID_CHILD
@@ -195,9 +195,9 @@ CONSTANT: STRRET_OFFSET 1
 CONSTANT: STRRET_CSTR 2
 
 C-UNION: STRRET-union "LPWSTR" "LPSTR" "UINT" "char[260]" ;
-C-STRUCT: STRRET
+STRUCT: STRRET
-    { "int" "uType" }
+    { uType int }
-    { "STRRET-union" "union" } ;
+    { union STRRET-union } ;
 
 COM-INTERFACE: IEnumIDList IUnknown {000214F2-0000-0000-C000-000000000046}
     HRESULT Next ( ULONG celt, LPITEMIDLIST* rgelt, ULONG* pceltFetched )

basis/windows/types/types-tests.factor

@@ -0,0 +1,10 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: classes.struct tools.test windows.types ;
+IN: windows.types.tests
+
+[ S{ RECT { right 100 } { bottom 100 } } ]
+[ { 0 0 } { 100 100 } <RECT> ] unit-test
+
+[ S{ RECT { left 100 } { top 100 } { right 200 } { bottom 200 } } ]
+[ { 100 100 } { 100 100 } <RECT> ] unit-test

basis/windows/types/types.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.syntax namespaces kernel words
 sequences math math.bitwise math.vectors colors
-io.encodings.utf16n classes.struct ;
+io.encodings.utf16n classes.struct accessors ;
 IN: windows.types
 
 TYPEDEF: char                CHAR
@@ -216,37 +216,37 @@ CONSTANT: TRUE 1
 
 ! typedef LRESULT (CALLBACK* WNDPROC)(HWND, UINT, WPARAM, LPARAM);
 
-C-STRUCT: WNDCLASS
+STRUCT: WNDCLASS
-    { "UINT" "style" }
+    { style UINT }
-    { "WNDPROC" "lpfnWndProc" }
+    { lpfnWndProc WNDPROC }
-    { "int" "cbClsExtra" }
+    { cbClsExtra int }
-    { "int" "cbWndExtra" }
+    { cbWndExtra int }
-    { "HINSTANCE" "hInstance" }
+    { hInstance HINSTANCE }
-    { "HICON" "hIcon" }
+    { hIcon HICON }
-    { "HCURSOR" "hCursor" }
+    { hCursor HCURSOR }
-    { "HBRUSH" "hbrBackground" }
+    { hbrBackground HBRUSH }
-    { "LPCTSTR" "lpszMenuName" }
+    { lpszMenuName LPCTSTR }
-    { "LPCTSTR" "lpszClassName" } ;
+    { lpszClassName LPCTSTR } ;
 
-C-STRUCT: WNDCLASSEX
+STRUCT: WNDCLASSEX
-    { "UINT" "cbSize" }
+    { cbSize UINT }
-    { "UINT" "style" }
+    { style UINT }
-    { "WNDPROC" "lpfnWndProc" }
+    { lpfnWndProc WNDPROC }
-    { "int" "cbClsExtra" }
+    { cbClsExtra int }
-    { "int" "cbWndExtra" }
+    { cbWndExtra int }
-    { "HINSTANCE" "hInstance" }
+    { hInstance HINSTANCE }
-    { "HICON" "hIcon" }
+    { hIcon HICON }
-    { "HCURSOR" "hCursor" }
+    { hCursor HCURSOR }
-    { "HBRUSH" "hbrBackground" }
+    { hbrBackground HBRUSH }
-    { "LPCTSTR" "lpszMenuName" }
+    { lpszMenuName LPCTSTR }
-    { "LPCTSTR" "lpszClassName" }
+    { lpszClassName LPCTSTR }
-    { "HICON" "hIconSm" } ;
+    { hIconSm HICON } ;
 
-C-STRUCT: RECT
+STRUCT: RECT
-    { "LONG" "left" }
+    { left LONG }
-    { "LONG" "top" }
+    { top LONG }
-    { "LONG" "right" }
+    { right LONG }
-    { "LONG" "bottom" } ;
+    { bottom LONG } ;
 
 C-STRUCT: PAINTSTRUCT
     { "HDC" " hdc" }
@@ -257,28 +257,28 @@ C-STRUCT: PAINTSTRUCT
     { "BYTE[32]" "rgbReserved" }
 ;
 
-C-STRUCT: BITMAPINFOHEADER
+STRUCT: BITMAPINFOHEADER
-    { "DWORD"  "biSize" }
+    { biSize DWORD }
-    { "LONG"   "biWidth" }
+    { biWidth LONG }
-    { "LONG"   "biHeight" }
+    { biHeight LONG }
-    { "WORD"   "biPlanes" }
+    { biPlanes WORD }
-    { "WORD"   "biBitCount" }
+    { biBitCount WORD }
-    { "DWORD"  "biCompression" }
+    { biCompression DWORD }
-    { "DWORD"  "biSizeImage" }
+    { biSizeImage DWORD }
-    { "LONG"   "biXPelsPerMeter" }
+    { biXPelsPerMeter LONG }
-    { "LONG"   "biYPelsPerMeter" }
+    { biYPelsPerMeter LONG }
-    { "DWORD"  "biClrUsed" }
+    { biClrUsed DWORD }
-    { "DWORD"  "biClrImportant" } ;
+    { biClrImportant DWORD } ;
 
-C-STRUCT: RGBQUAD
+STRUCT: RGBQUAD
-    { "BYTE" "rgbBlue" }
+    { rgbBlue BYTE }
-    { "BYTE" "rgbGreen" }
+    { rgbGreen BYTE }
-    { "BYTE" "rgbRed" }
+    { rgbRed BYTE }
-    { "BYTE" "rgbReserved" } ;
+    { rgbReserved BYTE } ;
 
-C-STRUCT: BITMAPINFO
+STRUCT: BITMAPINFO
-    { "BITMAPINFOHEADER" "bmiHeader" }
+    { bmiHeader BITMAPINFOHEADER }
-    { "RGBQUAD[1]" "bmiColors" } ;
+    { bimColors RGBQUAD[1] } ;
 
 TYPEDEF: void* LPPAINTSTRUCT
 TYPEDEF: void* PAINTSTRUCT
@@ -287,9 +287,9 @@ C-STRUCT: POINT
     { "LONG" "x" }
     { "LONG" "y" } ; 
 
-C-STRUCT: SIZE
+STRUCT: SIZE
-    { "LONG" "cx" }
+    { cx LONG }
-    { "LONG" "cy" } ; 
+    { cy LONG } ;
 
 C-STRUCT: MSG
     { "HWND" "hWnd" }
@@ -329,19 +329,10 @@ STRUCT: PIXELFORMATDESCRIPTOR
     { dwVisibleMask DWORD }
     { dwDamageMask DWORD } ;
 
-C-STRUCT: RECT
-    { "LONG" "left" }
-    { "LONG" "top" }
-    { "LONG" "right" }
-    { "LONG" "bottom" } ;
-
 : <RECT> ( loc dim -- RECT )
-    over v+
+    [ RECT <struct> ] 2dip
-    "RECT" <c-object>
+    [ drop [ first >>left ] [ second >>top ] bi ]
-    over first over set-RECT-right
+    [ v+ [ first >>right ] [ second >>bottom ] bi ] 2bi ;
-    swap second over set-RECT-bottom
-    over first over set-RECT-left
-    swap second over set-RECT-top ;
 
 TYPEDEF: RECT* PRECT
 TYPEDEF: RECT* LPRECT
@@ -389,26 +380,26 @@ TYPEDEF: DWORD* LPCOLORREF
 : color>RGB ( color -- COLORREF )
     >rgba-components drop [ 255 * >integer ] tri@ RGB ;
 
-C-STRUCT: TEXTMETRICW
+STRUCT: TEXTMETRICW
-    { "LONG" "tmHeight" }
+    { tmHeight LONG }
-    { "LONG" "tmAscent" }
+    { tmAscent LONG }
-    { "LONG" "tmDescent" }
+    { tmDescent LONG }
-    { "LONG" "tmInternalLeading" }
+    { tmInternalLeading LONG }
-    { "LONG" "tmExternalLeading" }
+    { tmExternalLeading LONG }
-    { "LONG" "tmAveCharWidth" }
+    { tmAveCharWidth LONG }
-    { "LONG" "tmMaxCharWidth" }
+    { tmMaxCharWidth LONG }
-    { "LONG" "tmWeight" }
+    { tmWeight LONG }
-    { "LONG" "tmOverhang" }
+    { tmOverhang LONG }
-    { "LONG" "tmDigitizedAspectX" }
+    { tmDigitizedAspectX LONG }
-    { "LONG" "tmDigitizedAspectY" }
+    { tmDigitizedAspectY LONG }
-    { "WCHAR" "tmFirstChar" }
+    { tmFirstChar WCHAR }
-    { "WCHAR" "tmLastChar" }
+    { tmLastChar WCHAR }
-    { "WCHAR" "tmDefaultChar" }
+    { tmDefaultChar WCHAR }
-    { "WCHAR" "tmBreakChar" }
+    { tmBreakChar WCHAR }
-    { "BYTE" "tmItalic" }
+    { tmItalic BYTE }
-    { "BYTE" "tmUnderlined" }
+    { tmUnderlined BYTE }
-    { "BYTE" "tmStruckOut" }
+    { tmStruckOut BYTE }
-    { "BYTE" "tmPitchAndFamily" }
+    { tmPitchAndFamily BYTE }
-    { "BYTE" "tmCharSet" } ;
+    { tmCharSet BYTE } ;
 
 TYPEDEF: TEXTMETRICW* LPTEXTMETRIC

basis/windows/uniscribe/uniscribe.factor

@@ -4,7 +4,8 @@ USING: kernel assocs math sequences fry io.encodings.string
 io.encodings.utf16n accessors arrays combinators destructors
 cache namespaces init fonts alien.c-types windows.usp10
 windows.offscreen windows.gdi32 windows.ole32 windows.types
-windows.fonts opengl.textures locals windows.errors ;
+windows.fonts opengl.textures locals windows.errors
+classes.struct ;
 IN: windows.uniscribe
 
 TUPLE: script-string < disposable font string metrics ssa size image ;
@@ -81,10 +82,11 @@ TUPLE: script-string < disposable font string metrics ssa size image ;
 : script-string-size ( script-string -- dim )
     ssa>> ScriptString_pSize
     dup win32-error=0/f
-    [ SIZE-cx ] [ SIZE-cy ] bi 2array ;
+    SIZE memory>struct
+    [ cx>> ] [ cy>> ] bi 2array ;
 
 : dc-metrics ( dc -- metrics )
-    "TEXTMETRICW" <c-object>
+    TEXTMETRICW <struct>
     [ GetTextMetrics drop ] keep
     TEXTMETRIC>metrics ;
 

basis/windows/user32/user32.factor

@@ -1,7 +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
-windows.types generalizations math.bitwise classes.struct ;
+windows.types generalizations math.bitwise classes.struct
+literals ;
 IN: windows.user32
 
 ! HKL for ActivateKeyboardLayout
@@ -74,8 +75,10 @@ CONSTANT: WS_EX_RIGHTSCROLLBAR    HEX: 00000000
 CONSTANT: WS_EX_CONTROLPARENT     HEX: 00010000
 CONSTANT: WS_EX_STATICEDGE        HEX: 00020000
 CONSTANT: WS_EX_APPWINDOW         HEX: 00040000
+
 : WS_EX_OVERLAPPEDWINDOW ( -- n )
     WS_EX_WINDOWEDGE WS_EX_CLIENTEDGE bitor ; foldable
+
 : WS_EX_PALETTEWINDOW ( -- n )
     { WS_EX_WINDOWEDGE WS_EX_TOOLWINDOW WS_EX_TOPMOST } flags ; foldable
 
@@ -521,11 +524,11 @@ CONSTANT: TME_NONCLIENT 16
 CONSTANT: TME_QUERY HEX: 40000000
 CONSTANT: TME_CANCEL HEX: 80000000
 CONSTANT: HOVER_DEFAULT HEX: ffffffff
-C-STRUCT: TRACKMOUSEEVENT
+STRUCT: TRACKMOUSEEVENT
-    { "DWORD" "cbSize" }
+    { cbSize DWORD }
-    { "DWORD" "dwFlags" }
+    { dwFlags DWORD }
-    { "HWND" "hwndTrack" }
+    { hwndTrack HWND }
-    { "DWORD" "dwHoverTime" } ;
+    { dwHoverTime DWORD } ;
 TYPEDEF: TRACKMOUSEEVENT* LPTRACKMOUSEEVENT
 
 CONSTANT: DBT_DEVICEARRIVAL HEX: 8000
@@ -538,26 +541,26 @@ CONSTANT: DEVICE_NOTIFY_SERVICE_HANDLE 1
 
 CONSTANT: DEVICE_NOTIFY_ALL_INTERFACE_CLASSES 4
 
-C-STRUCT: DEV_BROADCAST_HDR
+STRUCT: DEV_BROADCAST_HDR
-    { "DWORD" "dbch_size" }
+    { dbch_size DWORD }
-    { "DWORD" "dbch_devicetype" }
+    { dbch_devicetype DWORD }
-    { "DWORD" "dbch_reserved" } ;
+    { dbch_reserved DWORD } ;
 
-C-STRUCT: DEV_BROADCAST_DEVICEW
+STRUCT: DEV_BROADCAST_DEVICEW
-    { "DWORD" "dbcc_size" }
+    { dbcc_size DWORD }
-    { "DWORD" "dbcc_devicetype" }
+    { dbcc_devicetype DWORD }
-    { "DWORD" "dbcc_reserved" }
+    { dbcc_reserved DWORD }
-    { "GUID"  "dbcc_classguid" }
+    { dbcc_classguid GUID }
-    { { "WCHAR" 1 } "dbcc_name" } ;
+    { dbcc_name WCHAR[1] } ;
 
 CONSTANT: CCHDEVICENAME 32
 
-C-STRUCT: MONITORINFOEX
+STRUCT: MONITORINFOEX
-    { "DWORD" "cbSize" }
+    { cbSize DWORD }
-    { "RECT"  "rcMonitor" }
+    { rcMonitor RECT }
-    { "RECT"  "rcWork" }
+    { rcWork RECT }
-    { "DWORD" "dwFlags" }
+    { dwFlags DWORD }
-    { { "TCHAR" CCHDEVICENAME } "szDevice" } ;
+    { szDevice { "TCHAR" $ CCHDEVICENAME } } ;
 
 TYPEDEF: MONITORINFOEX* LPMONITORINFOEX
 TYPEDEF: MONITORINFOEX* LPMONITORINFO

basis/windows/winsock/winsock.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.strings alien.syntax arrays
 byte-arrays kernel math sequences windows.types windows.kernel32
-windows.errors math.bitwise io.encodings.utf16n ;
+windows.errors math.bitwise io.encodings.utf16n classes.struct
+literals windows.com.syntax ;
 IN: windows.winsock
 
 USE: libc
@@ -121,12 +122,12 @@ C-STRUCT: sockaddr-in6
     { { "uchar" 16 } "addr" }
     { "uint" "scopeid" } ;
 
-C-STRUCT: hostent
+STRUCT: hostent
-    { "char*" "name" }
+    { name char* }
-    { "void*" "aliases" }
+    { aliases void* }
-    { "short" "addrtype" }
+    { addrtype short }
-    { "short" "length" }
+    { length short }
-    { "void*" "addr-list" } ;
+    { addr-list void* } ;
 
 C-STRUCT: addrinfo
     { "int" "flags" }
@@ -142,11 +143,8 @@ C-STRUCT: timeval
     { "long" "sec" }
     { "long" "usec" } ;
 
-: hostent-addr ( hostent -- addr ) hostent-addr-list *void* ; ! *uint ;
-
 LIBRARY: winsock
 
-
 FUNCTION: int setsockopt ( SOCKET s, int level, int optname, char* optval, int optlen ) ;
 
 FUNCTION: ushort htons ( ushort n ) ;
@@ -195,9 +193,9 @@ C-STRUCT: FLOWSPEC
 TYPEDEF: FLOWSPEC* PFLOWSPEC
 TYPEDEF: FLOWSPEC* LPFLOWSPEC
 
-C-STRUCT: WSABUF
+STRUCT: WSABUF
-    { "ulong" "len" }
+    { len ulong }
-    { "void*" "buf" } ;
+    { buf void* } ;
 TYPEDEF: WSABUF* LPWSABUF
 
 C-STRUCT: QOS
@@ -377,8 +375,6 @@ FUNCTION: DWORD WSAWaitForMultipleEvents ( DWORD cEvents,
                                            BOOL fAlertable ) ;
 
 
-
-
 LIBRARY: mswsock
 
 ! Not in Windows CE
@@ -387,18 +383,10 @@ FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, voi
 
 CONSTANT: SIO_GET_EXTENSION_FUNCTION_POINTER -939524090
 
-: WSAID_CONNECTEX ( -- GUID )
+CONSTANT: WSAID_CONNECTEX GUID: {25a207b9-ddf3-4660-8ee9-76e58c74063e}
-    "GUID" <c-object>
-    HEX: 25a207b9 over set-GUID-Data1
-    HEX: ddf3 over set-GUID-Data2
-    HEX: 4660 over set-GUID-Data3
-    B{
-        HEX: 8e HEX: e9 HEX: 76 HEX: e5
-        HEX: 8c HEX: 74 HEX: 06 HEX: 3e
-    } over set-GUID-Data4 ;
 
 : winsock-expected-error? ( n -- ? )
-    ERROR_IO_PENDING ERROR_SUCCESS WSA_IO_PENDING 3array member? ;
+    ${ ERROR_IO_PENDING ERROR_SUCCESS WSA_IO_PENDING } member? ;
 
 : (winsock-error-string) ( n -- str )
     ! #! WSAStartup returns the error code 'n' directly

basis/x11/clipboard/clipboard.factor

@@ -1,9 +1,8 @@
 ! Copyright (C) 2006, 2007 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings alien.syntax arrays
+USING: accessors alien.c-types alien.strings classes.struct
-kernel math namespaces sequences io.encodings.string
+io.encodings.utf8 kernel namespaces sequences
-io.encodings.utf8 io.encodings.ascii x11 x11.xlib x11.constants
+specialized-arrays.int x11 x11.constants x11.xlib ;
-specialized-arrays.int accessors ;
 IN: x11.clipboard
 
 ! This code was based on by McCLIM's Backends/CLX/port.lisp
@@ -34,20 +33,15 @@ TUPLE: x-clipboard atom contents ;
     [ XGetWindowProperty drop ] keep snarf-property ;
 
 : selection-from-event ( event window -- string )
-    swap XSelectionEvent-property zero? [
+    swap property>> 0 =
-        drop f
+    [ drop f ] [ selection-property 1 window-property ] if ;
-    ] [
-        selection-property 1 window-property
-    ] if ;
 
 : own-selection ( prop win -- )
     [ dpy get ] 2dip CurrentTime XSetSelectionOwner drop
     flush-dpy ;
 
 : set-targets-prop ( evt -- )
-    dpy get swap
+    [ dpy get ] dip [ requestor>> ] [ property>> ] bi
-    [ XSelectionRequestEvent-requestor ] keep
-    XSelectionRequestEvent-property
     "TARGETS" x-atom 32 PropModeReplace
     {
         "UTF8_STRING" "STRING" "TARGETS" "TIMESTAMP"
@@ -55,28 +49,27 @@ TUPLE: x-clipboard atom contents ;
     4 XChangeProperty drop ;
 
 : set-timestamp-prop ( evt -- )
-    dpy get swap
+    [ dpy get ] dip
-    [ XSelectionRequestEvent-requestor ] keep
+    [ requestor>> ]
-    [ XSelectionRequestEvent-property ] keep
+    [ property>> "TIMESTAMP" x-atom 32 PropModeReplace ]
-    [ "TIMESTAMP" x-atom 32 PropModeReplace ] dip
+    [ time>> <int> ] tri
-    XSelectionRequestEvent-time <int>
     1 XChangeProperty drop ;
 
 : send-notify ( evt prop -- )
-    "XSelectionEvent" <c-object>
+    XSelectionEvent <struct>
-    SelectionNotify over set-XSelectionEvent-type
+    SelectionNotify >>type
-    [ set-XSelectionEvent-property ] keep
+    swap >>property
-    over XSelectionRequestEvent-display   over set-XSelectionEvent-display
+    over display>>   >>display
-    over XSelectionRequestEvent-requestor over set-XSelectionEvent-requestor
+    over requestor>> >>requestor
-    over XSelectionRequestEvent-selection over set-XSelectionEvent-selection
+    over selection>> >>selection
-    over XSelectionRequestEvent-target    over set-XSelectionEvent-target
+    over target>>    >>target
-    over XSelectionRequestEvent-time      over set-XSelectionEvent-time
+    over time>>      >>time
-    [ dpy get swap XSelectionRequestEvent-requestor 0 0 ] dip
+    [ [ dpy get ] dip requestor>> 0 0 ] dip
     XSendEvent drop
     flush-dpy ;
 
 : send-notify-success ( evt -- )
-    dup XSelectionRequestEvent-property send-notify ;
+    dup property>> send-notify ;
 
 : send-notify-failure ( evt -- )
     0 send-notify ;

basis/x11/events/events.factor

@@ -1,8 +1,7 @@
 ! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types arrays hashtables io kernel math
+USING: accessors arrays classes.struct combinators kernel
-math.order namespaces prettyprint sequences strings combinators
+math.order namespaces x11 x11.xlib ;
-x11 x11.xlib ;
 IN: x11.events
 
 GENERIC: expose-event ( event window -- )
@@ -36,14 +35,14 @@ GENERIC: selection-request-event ( event window -- )
 GENERIC: client-event ( event window -- )
 
 : next-event ( -- event )
-    dpy get "XEvent" <c-object> [ XNextEvent drop ] keep ;
+    dpy get XEvent <struct> [ XNextEvent drop ] keep ;
 
 : mask-event ( mask -- event )
-    [ dpy get ] dip "XEvent" <c-object> [ XMaskEvent drop ] keep ;
+    [ dpy get ] dip XEvent <struct> [ XMaskEvent drop ] keep ;
 
 : events-queued ( mode -- n ) [ dpy get ] dip XEventsQueued ;
 
-: wheel? ( event -- ? ) XButtonEvent-button 4 7 between? ;
+: wheel? ( event -- ? ) button>> 4 7 between? ;
 
 : button-down-event$ ( event window -- )
     over wheel? [ wheel-event ] [ button-down-event ] if ;
@@ -52,34 +51,31 @@ GENERIC: client-event ( event window -- )
     over wheel? [ 2drop ] [ button-up-event ] if ;
 
 : handle-event ( event window -- )
-    over XAnyEvent-type {
+    swap dup XAnyEvent>> type>> {
-        { Expose [ expose-event ] }
+        { Expose [ XExposeEvent>> swap expose-event ] }
-        { ConfigureNotify [ configure-event ] }
+        { ConfigureNotify [ XConfigureEvent>> swap configure-event ] }
-        { ButtonPress [ button-down-event$ ] }
+        { ButtonPress [ XButtonEvent>> swap button-down-event$ ] }
-        { ButtonRelease [ button-up-event$ ] }
+        { ButtonRelease [ XButtonEvent>> swap button-up-event$ ] }
-        { EnterNotify [ enter-event ] }
+        { EnterNotify [ XCrossingEvent>> swap enter-event ] }
-        { LeaveNotify [ leave-event ] }
+        { LeaveNotify [ XCrossingEvent>> swap leave-event ] }
-        { MotionNotify [ motion-event ] }
+        { MotionNotify [ XMotionEvent>> swap motion-event ] }
-        { KeyPress [ key-down-event ] }
+        { KeyPress [ XKeyEvent>> swap key-down-event ] }
-        { KeyRelease [ key-up-event ] }
+        { KeyRelease [ XKeyEvent>> swap key-up-event ] }
-        { FocusIn [ focus-in-event ] }
+        { FocusIn [ XFocusChangeEvent>> swap focus-in-event ] }
-        { FocusOut [ focus-out-event ] }
+        { FocusOut [ XFocusChangeEvent>> swap focus-out-event ] }
-        { SelectionNotify [ selection-notify-event ] }
+        { SelectionNotify [ XSelectionEvent>> swap selection-notify-event ] }
-        { SelectionRequest [ selection-request-event ] }
+        { SelectionRequest [ XSelectionRequestEvent>> swap selection-request-event ] }
-        { ClientMessage [ client-event ] }
+        { ClientMessage [ XClientMessageEvent>> swap client-event ] }
         [ 3drop ]
     } case ;
 
-: configured-loc ( event -- dim )
+: event-loc ( event -- loc )
-    [ XConfigureEvent-x ] [ XConfigureEvent-y ] bi 2array ;
+    [ x>> ] [ y>> ] bi 2array ;
 
-: configured-dim ( event -- dim )
+: event-dim ( event -- dim )
-    [ XConfigureEvent-width ] [ XConfigureEvent-height ] bi 2array ;
+    [ width>> ] [ height>> ] bi 2array ;
-
-: mouse-event-loc ( event -- loc )
-    [ XButtonEvent-x ] [ XButtonEvent-y ] bi 2array ;
 
 : close-box? ( event -- ? )
-    [ XClientMessageEvent-message_type "WM_PROTOCOLS" x-atom = ]
+    [ message_type>> "WM_PROTOCOLS" x-atom = ]
-    [ XClientMessageEvent-data0 "WM_DELETE_WINDOW" x-atom = ]
+    [ data0>> "WM_DELETE_WINDOW" x-atom = ]
     bi and ;

basis/x11/windows/windows.factor

@@ -1,15 +1,15 @@
 ! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types hashtables kernel math math.vectors
+USING: accessors kernel math math.bitwise math.vectors
-math.bitwise namespaces sequences x11 x11.xlib x11.constants x11.glx
+namespaces sequences x11 x11.xlib x11.constants x11.glx arrays
-arrays fry ;
+fry classes.struct ;
 IN: x11.windows
 
 : create-window-mask ( -- n )
     { CWBackPixel CWBorderPixel CWColormap CWEventMask } flags ;
 
 : create-colormap ( visinfo -- colormap )
-    [ dpy get root get ] dip XVisualInfo-visual AllocNone
+    [ dpy get root get ] dip visual>> AllocNone
     XCreateColormap ;
 
 : event-mask ( -- n )
@@ -28,15 +28,15 @@ IN: x11.windows
     } flags ;
 
 : window-attributes ( visinfo -- attributes )
-    "XSetWindowAttributes" <c-object>
+    XSetWindowAttributes <struct>
-    0 over set-XSetWindowAttributes-background_pixel
+    0 >>background_pixel
-    0 over set-XSetWindowAttributes-border_pixel
+    0 >>border_pixel
-    [ [ create-colormap ] dip set-XSetWindowAttributes-colormap ] keep
+    event-mask >>event_mask
-    event-mask over set-XSetWindowAttributes-event_mask ;
+    swap create-colormap >>colormap ;
 
 : set-size-hints ( window -- )
-    "XSizeHints" <c-object>
+    XSizeHints <struct>
-    USPosition over set-XSizeHints-flags
+    USPosition >>flags
     [ dpy get ] 2dip XSetWMNormalHints ;
 
 : auto-position ( window loc -- )
@@ -47,8 +47,8 @@ IN: x11.windows
 : create-window ( loc dim visinfo -- window )
     pick [
         [ [ [ dpy get root get ] dip >xy ] dip { 1 1 } vmax >xy 0 ] dip
-        [ XVisualInfo-depth InputOutput ] keep
+        [ depth>> InputOutput ] keep
-        [ XVisualInfo-visual create-window-mask ] keep
+        [ visual>> create-window-mask ] keep
         window-attributes XCreateWindow
         dup
     ] dip auto-position ;

core/alien/strings/strings.factor

@@ -35,6 +35,8 @@ M: string string>alien
     [ stream>> >byte-array ]
     tri ;
 
+M: tuple string>alien drop underlying>> ;
+
 HOOK: alien>native-string os ( alien -- string )
 
 M: windows alien>native-string utf16n alien>string ;

extra/io/serial/windows/windows.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.files.windows io.streams.duplex kernel math
 math.bitwise windows.kernel32 accessors alien.c-types
-windows io.files.windows fry locals continuations ;
+windows io.files.windows fry locals continuations
+classes.struct ;
 IN: io.serial.windows
 
 : <serial-stream> ( path encoding -- duplex )
@@ -10,7 +11,7 @@ IN: io.serial.windows
 
 : get-comm-state ( duplex -- dcb )
     in>> handle>>
-    "DCB" <c-object> tuck
+    DCB <struct> tuck
     GetCommState win32-error=0/f ;
 
 : set-comm-state ( duplex dcb -- )

extra/system-info/windows/windows.factor

@@ -21,24 +21,24 @@ IN: system-info.windows
     system-info dwOemId>> HEX: ffff0000 bitand ;
 
 : os-version ( -- os-version )
-    "OSVERSIONINFO" <c-object>
+    OSVERSIONINFO <struct>
-    "OSVERSIONINFO" heap-size over set-OSVERSIONINFO-dwOSVersionInfoSize
+        OSVERSIONINFO heap-size >>dwOSVersionInfoSize
     dup GetVersionEx win32-error=0/f ;
 
 : windows-major ( -- n )
-    os-version OSVERSIONINFO-dwMajorVersion ;
+    os-version dwMajorVersion>> ;
 
 : windows-minor ( -- n )
-    os-version OSVERSIONINFO-dwMinorVersion ;
+    os-version dwMinorVersion>> ;
 
 : windows-build# ( -- n )
-    os-version OSVERSIONINFO-dwBuildNumber ;
+    os-version dwBuildNumber>> ;
 
 : windows-platform-id ( -- n )
-    os-version OSVERSIONINFO-dwPlatformId ;
+    os-version dwPlatformId>> ;
 
 : windows-service-pack ( -- string )
-    os-version OSVERSIONINFO-szCSDVersion alien>native-string ;
+    os-version szCSDVersion>> alien>native-string ;
 
 : feature-present? ( n -- ? )
     IsProcessorFeaturePresent zero? not ;