Fixing bootstrap with specialized arrays

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

@@ -89,16 +89,6 @@ HELP: malloc-byte-array
 { $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
 { $errors "Throws an error if memory allocation fails." } ;
 
-HELP: define-nth
-{ $values { "name" "a word name" } { "vocab" "a vocabulary name" } }
-{ $description "Defines a word " { $snippet { $emphasis "name" } "-nth" } " with stack effect " { $snippet "( n c-ptr -- value )" } " for reading the value with C type " { $snippet "name" } " stored at an alien pointer, displaced by a multiple of the C type's size." }
-{ $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ;
-
-HELP: define-set-nth
-{ $values { "name" "a word name" } { "vocab" "a vocabulary name" } }
-{ $description "Defines a word " { $snippet "set-" { $emphasis "name" } "-nth" } " with stack effect " { $snippet "( value n c-ptr -- )" } " for writing the value with C type " { $snippet "name" } " to an alien pointer, displaced by a multiple of the C type's size." }
-{ $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ;
-
 HELP: box-parameter
 { $values { "n" integer } { "ctype" string } }
 { $description "Generates code for converting a C value stored at  offset " { $snippet "n" } " from the top of the stack into a Factor object to be pushed on the data stack." }

basis/bit-arrays/bit-arrays.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types accessors math alien.accessors kernel
 kernel.private locals sequences sequences.private byte-arrays
-parser prettyprint.backend ;
+parser prettyprint.backend fry ;
 IN: bit-arrays
 
 TUPLE: bit-array
@@ -24,9 +24,8 @@ TUPLE: bit-array
 : bits>bytes 7 + n>byte ; inline
 
 : (set-bits) ( bit-array n -- )
-    [ [ length bits>cells ] keep ] dip
+    [ [ length bits>cells ] keep ] dip swap underlying>>
-    [ -rot underlying>> set-uint-nth ] 2curry
+    '[ [ _ _ ] dip set-alien-unsigned-4 ] each ; inline
-    each ; inline
 
 PRIVATE>
 
@@ -84,9 +83,9 @@ M: bit-array byte-length length 7 + -3 shift ;
     ] if ;
 
 : bit-array>integer ( bit-array -- n )
-    0 swap underlying>> [ length ] keep [
+    0 swap underlying>> dup length [
-        uchar-nth swap 8 shift bitor
+        alien-unsigned-1 swap 8 shift bitor
-    ] curry each ;
+    ] with each ;
 
 INSTANCE: bit-array sequence
 

basis/cocoa/enumeration/enumeration.factor

@@ -1,26 +1,31 @@
-USING: kernel cocoa cocoa.types alien.c-types locals math sequences
+! Copyright (C) 2008 Joe Groff.
-vectors fry libc ;
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel cocoa cocoa.types alien.c-types locals math
+sequences vectors fry libc destructors
+specialized-arrays.direct.alien ;
 IN: cocoa.enumeration
 
 : NS-EACH-BUFFER-SIZE 16 ; inline
 
-: (with-enumeration-buffers) ( quot -- )
+: with-enumeration-buffers ( quot -- )
-    "NSFastEnumerationState" heap-size swap '[
+    [
-        NS-EACH-BUFFER-SIZE "id" heap-size * [
+        [
-            NS-EACH-BUFFER-SIZE @
+            "NSFastEnumerationState" malloc-object &free
-        ] with-malloc
+            NS-EACH-BUFFER-SIZE "id" heap-size * malloc-object &free
-    ] with-malloc ; inline
+            NS-EACH-BUFFER-SIZE
+        ] dip call
+    ] with-destructors ; inline
 
 :: (NSFastEnumeration-each) ( object quot: ( elt -- ) state stackbuf count -- )
     object state stackbuf count -> countByEnumeratingWithState:objects:count:
-    dup zero? [ drop ] [
+    dup 0 = [ drop ] [
         state NSFastEnumerationState-itemsPtr [ stackbuf ] unless*
-        '[ _ void*-nth quot call ] each
+        swap <direct-void*-array> quot each
         object quot state stackbuf count (NSFastEnumeration-each)
     ] if ; inline recursive
 
 : NSFastEnumeration-each ( object quot -- )
-    [ (NSFastEnumeration-each) ] (with-enumeration-buffers) ; inline
+    [ (NSFastEnumeration-each) ] with-enumeration-buffers ; inline
 
 : NSFastEnumeration-map ( object quot -- vector )
     NS-EACH-BUFFER-SIZE <vector>

basis/cocoa/messages/messages.factor

@@ -5,7 +5,8 @@ combinators compiler compiler.alien kernel math namespaces make
 parser prettyprint prettyprint.sections quotations sequences
 strings words cocoa.runtime io macros memoize debugger
 io.encodings.ascii effects libc libc.private parser lexer init
-core-foundation fry generalizations ;
+core-foundation fry generalizations
+specialized-arrays.direct.alien ;
 IN: cocoa.messages
 
 : make-sender ( method function -- quot )
@@ -198,8 +199,11 @@ assoc-union alien>objc-types set-global
     objc-methods get set-at ;
 
 : each-method-in-class ( class quot -- )
-    [ 0 <uint> [ class_copyMethodList ] keep *uint over ] dip
+    [ 0 <uint> [ class_copyMethodList ] keep *uint ] dip
-    '[ _ void*-nth @ ] each (free) ; inline
+    over 0 = [ 3drop ] [
+        [ <direct-void*-array> ] dip
+        [ each ] [ drop underlying>> (free) ] 2bi
+    ] if ; inline
 
 : register-objc-methods ( class -- )
     [ register-objc-method ] each-method-in-class ;

basis/cocoa/pasteboard/pasteboard.factor

@@ -1,8 +1,8 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types arrays kernel cocoa.messages
+USING: alien.accessors arrays kernel cocoa.messages
-cocoa.classes cocoa.application cocoa core-foundation
+cocoa.classes cocoa.application cocoa core-foundation sequences
-sequences ;
+;
 IN: cocoa.pasteboard
 
 : NSStringPboardType "NSStringPboardType" ;
@@ -24,7 +24,7 @@ IN: cocoa.pasteboard
 
 : pasteboard-error ( error -- f )
     "Pasteboard does not hold a string" <NSString>
-    0 spin set-void*-nth f ;
+    0 set-alien-cell f ;
 
 : ?pasteboard-string ( pboard error -- str/f )
     over pasteboard-string? [

basis/compiler/tree/propagation/propagation-tests.factor

@@ -167,7 +167,8 @@ IN: compiler.tree.propagation.tests
 
 [ V{ fixnum } ] [
     [
-        [ uchar-nth ] 2keep [ uchar-nth ] 2keep uchar-nth
+        { fixnum byte-array } declare
+        [ nth-unsafe ] 2keep [ nth-unsafe ] 2keep nth-unsafe
         >r >r 298 * r> 100 * - r> 208 * - 128 + -8 shift
         255 min 0 max
     ] final-classes

basis/core-foundation/core-foundation.factor

@@ -104,7 +104,7 @@ FUNCTION: CFTypeID CFGetTypeID ( CFTypeRef cf ) ;
     CF>array [ CF>string ] map ;
 
 : <CFStringArray> ( seq -- alien )
-    [ <CFString> ] map dup <CFArray> swap [ CFRelease ] each ;
+    [ <CFString> ] map [ <CFArray> ] [ [ CFRelease ] each ] bi ;
 
 : <CFFileSystemURL> ( string dir? -- url )
     [ <CFString> f over kCFURLPOSIXPathStyle ] dip

basis/core-foundation/fsevents/fsevents.factor

@@ -4,7 +4,9 @@ USING: alien alien.c-types alien.strings alien.syntax kernel
 math sequences namespaces make assocs init accessors
 continuations combinators core-foundation
 core-foundation.run-loop core-foundation.run-loop.thread
-io.encodings.utf8 destructors locals arrays ;
+io.encodings.utf8 destructors locals arrays
+specialized-arrays.direct.alien specialized-arrays.direct.int
+specialized-arrays.direct.longlong ;
 IN: core-foundation.fsevents
 
 : kFSEventStreamCreateFlagUseCFTypes 2 ; inline
@@ -160,11 +162,12 @@ SYMBOL: event-stream-callbacks
 : remove-event-source-callback ( id -- )
     event-stream-callbacks get delete-at ;
 
-:: >event-triple ( n eventPaths eventFlags eventIds -- triple )
+:: (master-event-source-callback) ( eventStream info numEvents eventPaths eventFlags eventIds -- )
-    n eventPaths void*-nth utf8 alien>string
+    eventPaths numEvents <direct-void*-array> [ utf8 alien>string ] { } map-as
-    n eventFlags int-nth
+    eventFlags numEvents <direct-int-array>
-    n eventIds longlong-nth
+    eventIds numEvents <direct-longlong-array>
-    3array ;
+    3array flip
+    info event-stream-callbacks get at [ drop ] or call ;
 
 : master-event-source-callback ( -- alien )
     "void"
@@ -176,19 +179,15 @@ SYMBOL: event-stream-callbacks
         "FSEventStreamEventFlags*"
         "FSEventStreamEventId*"
     }
-    "cdecl" [
+    "cdecl" [ (master-event-source-callback) ] alien-callback ;
-        [ >event-triple ] 3curry map
-        swap event-stream-callbacks get at
-        dup [ call drop ] [ 3drop ] if
-    ] alien-callback ;
 
 TUPLE: event-stream info handle disposed ;
 
 : <event-stream> ( quot paths latency flags -- event-stream )
-    >r >r >r
+    [
         add-event-source-callback dup
-    >r master-event-source-callback r>
+        [ master-event-source-callback ] dip
-    r> r> r> <FSEventStream>
+    ] 3dip <FSEventStream>
     dup enable-event-stream
     f event-stream boa ;
 

basis/functors/functors.factor

@@ -54,7 +54,7 @@ IN: functors
     [ scan interpolate-locals ] dip
     '[ _ with-string-writer @ ] parsed ;
 
-: IS [ search ] (INTERPOLATE) ; parsing
+: IS [ dup search [ ] [ no-word ] ?if ] (INTERPOLATE) ; parsing
 
 : DEFINES [ in get create ] (INTERPOLATE) ; parsing
 

basis/io/unix/files/files.factor

@@ -313,8 +313,7 @@ PRIVATE>
 <PRIVATE
 
 : make-timeval-array ( array -- byte-array )
-    [ length "timeval" <c-array> ] keep
+    [ [ "timeval" <c-object> ] unless* ] map concat ;
-    dup length [ over [ pick set-timeval-nth ] [ 2drop ] if ] 2each ;
 
 : timestamp>timeval ( timestamp -- timeval )
     unix-1970 time- duration>microseconds make-timeval ;

basis/io/unix/pipes/pipes.factor

@@ -1,11 +1,11 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: system kernel unix math sequences qualified
-io.unix.backend io.ports specialized-arrays.int ;
+io.unix.backend io.ports specialized-arrays.int accessors ;
 IN: io.unix.pipes
 QUALIFIED: io.pipes
 
 M: unix io.pipes:(pipe) ( -- pair )
     2 <int-array>
-    dup underlying>> pipe io-error
+    [ underlying>> pipe io-error ]
-    first2 [ <fd> init-fd ] bi@ io.pipes:pipe boa ;
+    [ first2 [ <fd> init-fd ] bi@ io.pipes:pipe boa ] bi ;

basis/locals/locals.factor

@@ -373,12 +373,12 @@ M: wlet local-rewrite*
     let-rewrite ;
 
 : parse-locals ( -- vars assoc )
-    ")" parse-effect
+    "(" expect ")" parse-effect
     word [ over "declared-effect" set-word-prop ] when*
     in>> [ dup pair? [ first ] when ] map make-locals dup push-locals ;
 
 : parse-locals-definition ( word -- word quot )
-    "(" expect parse-locals \ ; (parse-lambda) <lambda>
+    parse-locals \ ; (parse-lambda) <lambda>
     2dup "lambda" set-word-prop
     lambda-rewrite dup length 1 = [ first ] [ bad-lambda-rewrite ] if ;
 

basis/opengl/opengl.factor

@@ -62,7 +62,7 @@ MACRO: all-enabled-client-state ( seq quot -- )
     [ 4 GL_FLOAT 0 ] dip underlying>> glColorPointer ; inline
 
 : gl-texture-coord-pointer ( seq -- )
-    [ 2 GL_FLOAT 0 ] dip glTexCoordPointer ; inline
+    [ 2 GL_FLOAT 0 ] dip underlying>> glTexCoordPointer ; inline
 
 : line-vertices ( a b -- )
     [ first2 [ 0.5 + ] bi@ ] bi@ 4 float-array{ } nsequence
@@ -80,6 +80,7 @@ MACRO: all-enabled-client-state ( seq quot -- )
         [ first 0.3 - 0.5 ]
         [ [ first 0.3 - ] [ second 0.3 - ] bi ]
         [ second 0.3 - 0.5 swap ]
+        [ drop 0.5 0.5 ]
     } cleave 10 float-array{ } nsequence ;
 
 : rect-vertices ( dim -- )

basis/random/mersenne-twister/mersenne-twister.factor

@@ -2,9 +2,9 @@
 ! See http://factorcode.org/license.txt for BSD license.
 ! mersenne twister based on 
 ! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
-USING: arrays kernel math namespaces sequences system init
+USING: kernel math namespaces sequences system init
 accessors math.ranges random circular math.bitwise
-combinators ;
+combinators specialized-arrays.uint ;
 IN: random.mersenne-twister
 
 <PRIVATE
@@ -39,11 +39,11 @@ TUPLE: mersenne-twister seq i ;
 
 : init-mt-rest ( seq -- )
     mt-n 1- swap [
-        [ init-mt-formula ] [ >r 1+ r> set-nth ] 2bi
+        [ init-mt-formula ] [ [ 1+ ] dip set-nth ] 2bi
     ] curry each ;
 
 : init-mt-seq ( seed -- seq )
-    32 bits mt-n 0 <array> <circular>
+    32 bits mt-n <uint-array> <circular>
     [ set-first ] [ init-mt-rest ] [ ] tri ;
 
 : mt-temper ( y -- yt )

basis/specialized-arrays/direct/alien/alien.factor

@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.alien specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.alien
 
 << "void*" define-direct-array >>

basis/specialized-arrays/direct/bool/bool.factor

@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.bool specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.bool
 
 << "bool" define-direct-array >>

basis/specialized-arrays/direct/char/char.factor

@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.char specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.char
 
 << "char" define-direct-array >>

basis/specialized-arrays/direct/direct-tests.factor

@@ -0,0 +1,7 @@
+IN: specialized-arrays.direct.tests
+USING: specialized-arrays.direct.ushort tools.test
+specialized-arrays.ushort alien.syntax sequences ;
+
+[ ushort-array{ 0 0 0 } ] [
+    3 ALIEN: 123 100 <direct-ushort-array> new-sequence
+] unit-test

basis/specialized-arrays/direct/double/double.factor

@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.double specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.double
 
 << "double" define-direct-array >>

basis/specialized-arrays/direct/float/float.factor

@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.float specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.float
 
 << "float" define-direct-array >>

basis/specialized-arrays/direct/int/int.factor

@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.int specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.int
 
 << "int" define-direct-array >>

basis/specialized-arrays/direct/long/long.factor

@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.long specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.long
 
 << "long" define-direct-array >>

basis/specialized-arrays/direct/longlong/longlong.factor

@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.longlong specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.longlong
 
 << "longlong" define-direct-array >>

basis/specialized-arrays/direct/short/short.factor

@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.short specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.short
 
 << "short" define-direct-array >>

basis/specialized-arrays/direct/uchar/uchar.factor

@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.uchar specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.uchar
 
 << "uchar" define-direct-array >>

basis/specialized-arrays/direct/uint/uint.factor

@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.uint specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.uint
 
 << "uint" define-direct-array >>

basis/specialized-arrays/direct/ulong/ulong.factor

@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.ulong specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.ulong
 
 << "ulong" define-direct-array >>

basis/specialized-arrays/direct/ulonglong/ulonglong.factor

@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.ulonglong specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.ulonglong
 
 << "ulonglong" define-direct-array >>

basis/specialized-arrays/direct/ushort/ushort.factor

@@ -1,4 +1,4 @@
-USE: specialized-arrays.direct.functor
+USING: specialized-arrays.ushort specialized-arrays.direct.functor ;
 IN: specialized-arrays.direct.ushort
 
 << "ushort" define-direct-array >>

basis/ui/freetype/freetype.factor

@@ -4,8 +4,7 @@ USING: alien alien.accessors alien.c-types arrays io kernel libc
 math math.vectors namespaces opengl opengl.gl prettyprint assocs
 sequences io.files io.styles continuations freetype
 ui.gadgets.worlds ui.render ui.backend byte-arrays accessors
-locals ;
+locals specialized-arrays.direct.uchar ;
-
 IN: ui.freetype
 
 TUPLE: freetype-renderer ;
@@ -135,8 +134,8 @@ M: freetype-renderer string-height ( open-font string -- h )
     FT_RENDER_MODE_NORMAL FT_Render_Glyph freetype-error ;
 
 :: copy-pixel ( i j bitmap texture -- i j )
-    255 j texture set-char-nth
+    255 j texture set-nth
-    i bitmap char-nth j 1 + texture set-char-nth
+    i bitmap nth j 1 + texture set-nth
     i 1 + j 2 + ; inline
 
 :: (copy-row) ( i j bitmap texture end -- )
@@ -155,15 +154,18 @@ M: freetype-renderer string-height ( open-font string -- h )
             rows [ glyph glyph-bitmap-rows ]
             width [ glyph glyph-bitmap-width ]
             width2 [ width next-power-of-2 2 * ] |
+        bitmap [
+            [let | bitmap' [ bitmap rows width * <direct-uchar-array> ] |
                 0 0
-        rows [ bitmap texture width width2 copy-row ] times
+                rows [ bitmap' texture width width2 copy-row ] times
                 2drop
+            ]
+        ] when
     ] ;
 
 : bitmap>texture ( glyph sprite -- id )
-    tuck sprite-size2 * 2 * [
+    tuck sprite-size2 * 2 * <byte-array>
-        [ copy-bitmap ] keep gray-texture
+    [ copy-bitmap ] keep gray-texture ;
-    ] with-malloc ;
 
 : glyph-texture-loc ( glyph font -- loc )
     [ drop glyph-hori-bearing-x ft-floor ]

basis/ui/gadgets/buttons/buttons.factor

@@ -2,12 +2,11 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays kernel math models namespaces sequences
 strings quotations assocs combinators classes colors
-<<<<<<< HEAD:basis/ui/gadgets/buttons/buttons.factor
 classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets
 ui.gadgets.borders ui.gadgets.labels ui.gadgets.theme
 ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures
 ui.render math.geometry.rect locals alien.c-types
-specialized-arrays.float ;
+specialized-arrays.float fry ;
 IN: ui.gadgets.buttons
 
 TUPLE: button < border pressed? selected? quot ;

basis/unix/utilities/utilities.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.strings
 combinators.short-circuit fry kernel layouts sequences
-specialized-arrays.alien ;
+specialized-arrays.alien accessors ;
 IN: unix.utilities
 
 : more? ( alien -- ? )
@@ -17,4 +17,4 @@ IN: unix.utilities
     [ ] produce nip ;
 
 : strings>alien ( strings encoding -- alien )
-    '[ _ malloc-string ] void*-array{ } map f suffix underlying>> ;
+    '[ _ malloc-string ] void*-array{ } map-as f suffix underlying>> ;