Removing now-redundant underlying>> calls

basis/cocoa/messages/messages.factor

@@ -202,7 +202,7 @@ assoc-union alien>objc-types set-global
     [ 0 <uint> [ class_copyMethodList ] keep *uint ] dip
     over 0 = [ 3drop ] [
         [ <direct-void*-array> ] dip
-        [ each ] [ drop underlying>> (free) ] 2bi
+        [ each ] [ drop (free) ] 2bi
     ] if ; inline
 
 : register-objc-methods ( class -- )

basis/cocoa/views/views.factor

@@ -68,7 +68,7 @@ PRIVATE>
             NSOpenGLPFASamples , 8 ,
         ] when
         0 ,
-    ] int-array{ } make underlying>>
+    ] int-array{ } make
     -> initWithAttributes:
     -> autorelease ;
 

basis/compiler/tests/alien.factor

@@ -198,8 +198,8 @@ FUNCTION: int ffi_test_12 int a int b rect c int d int e int f ;
 FUNCTION: float ffi_test_23 ( float[3] x, float[3] y ) ;
 
 [ 32.0 ] [
-    { 1.0 2.0 3.0 } >float-array underlying>>
+    { 1.0 2.0 3.0 } >float-array
-    { 4.0 5.0 6.0 } >float-array underlying>>
+    { 4.0 5.0 6.0 } >float-array
     ffi_test_23
 ] unit-test
 

basis/db/postgresql/lib/lib.factor

@@ -65,7 +65,7 @@ M: postgresql-result-null summary ( obj -- str )
     } case ;
 
 : param-types ( statement -- seq )
-    in-params>> [ type>> type>oid ] uint-array{ } map-as underlying>> ;
+    in-params>> [ type>> type>oid ] uint-array{ } map-as ;
 
 : malloc-byte-array/length ( byte-array -- alien length )
     [ malloc-byte-array &free ] [ length ] bi ;
@@ -91,11 +91,11 @@ M: postgresql-result-null summary ( obj -- str )
     ] 2map flip [
         f f
     ] [
-        first2 [ >void*-array underlying>> ] [ >uint-array underlying>> ] bi*
+        first2 [ >void*-array ] [ >uint-array ] bi*
     ] if-empty ;
 
 : param-formats ( statement -- seq )
-    in-params>> [ type>> type>param-format ] uint-array{ } map-as underlying>> ;
+    in-params>> [ type>> type>param-format ] uint-array{ } map-as ;
 
 : do-postgresql-bound-statement ( statement -- res )
     [

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

@@ -51,7 +51,7 @@ M: epoll-mx remove-output-callbacks ( fd mx -- seq )
     ] [ 2drop f ] if ;
 
 : wait-event ( mx us -- n )
-    [ [ fd>> ] [ events>> ] bi [ underlying>> ] [ length ] bi ] [ 1000 /i ] bi*
+    [ [ fd>> ] [ events>> ] bi dup length ] [ 1000 /i ] bi*
     epoll_wait multiplexer-error ;
 
 : handle-event ( event mx -- )

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

@@ -59,7 +59,7 @@ M: kqueue-mx remove-output-callbacks ( fd mx -- seq )
 : wait-kevent ( mx timespec -- n )
     [
         [ fd>> f 0 ]
-        [ events>> [ underlying>> ] [ length ] bi ] bi
+        [ events>> dup length ] bi
     ] dip kevent multiplexer-error ;
 
 : handle-kevent ( mx kevent -- )

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

@@ -44,8 +44,8 @@ TUPLE: select-mx < mx read-fdset write-fdset ;
 
 : init-fdsets ( mx -- nfds read write except )
     [ num-fds ]
-    [ read-fdset/tasks [ init-fdset ] [ underlying>> ] bi ]
+    [ read-fdset/tasks [ init-fdset ] keep ]
-    [ write-fdset/tasks [ init-fdset ] [ underlying>> ] bi ] tri
+    [ write-fdset/tasks [ init-fdset ] keep ] tri
     f ;
 
 M:: select-mx wait-for-events ( us mx -- )

basis/io/launcher/windows/windows.factor

@@ -103,7 +103,7 @@ TUPLE: CreateProcess-args
             over get-environment
             [ swap % "=" % % "\0" % ] assoc-each
             "\0" %
-        ] ushort-array{ } make underlying>>
+        ] ushort-array{ } make
         >>lpEnvironment
     ] when ;
 
@@ -158,7 +158,7 @@ M: windows kill-process* ( handle -- )
 M: windows wait-for-processes ( -- ? )
     processes get keys dup
     [ handle>> PROCESS_INFORMATION-hProcess ] void*-array{ } map-as
-    [ length ] [ underlying>> ] bi 0 0
+    [ length ] keep 0 0
     WaitForMultipleObjects
     dup HEX: ffffffff = [ win32-error ] when
     dup WAIT_TIMEOUT = [ 2drop t ] [ swap nth process-exited f ] if ;

basis/io/pipes/unix/unix.factor

@@ -7,5 +7,5 @@ QUALIFIED: io.pipes
 
 M: unix io.pipes:(pipe) ( -- pair )
     2 <int-array>
-    [ underlying>> pipe io-error ]
+    [ pipe io-error ]
     [ first2 [ <fd> init-fd ] bi@ io.pipes:pipe boa ] bi ;

basis/libc/libc.factor

@@ -75,14 +75,14 @@ PRIVATE>
     dup add-malloc ;
 
 : realloc ( alien size -- newalien )
+    [ >c-ptr ] dip
     over malloc-exists? [ realloc-error ] unless
     dupd (realloc) check-ptr
     swap delete-malloc
     dup add-malloc ;
 
 : free ( alien -- )
-    dup delete-malloc
+    >c-ptr [ delete-malloc ] [ (free) ] bi ;
-    (free) ;
 
 : memcpy ( dst src size -- )
     "void" "libc" "memcpy" { "void*" "void*" "ulong" } alien-invoke ;

basis/opengl/opengl.factor

@@ -53,16 +53,16 @@ MACRO: all-enabled-client-state ( seq quot -- )
     glMatrixMode glPopMatrix ; inline
 
 : gl-material ( face pname params -- )
-    float-array{ } like underlying>> glMaterialfv ;
+    float-array{ } like glMaterialfv ;
 
 : gl-vertex-pointer ( seq -- )
-    [ 2 GL_FLOAT 0 ] dip underlying>> glVertexPointer ; inline
+    [ 2 GL_FLOAT 0 ] dip glVertexPointer ; inline
 
 : gl-color-pointer ( seq -- )
-    [ 4 GL_FLOAT 0 ] dip underlying>> glColorPointer ; inline
+    [ 4 GL_FLOAT 0 ] dip glColorPointer ; inline
 
 : gl-texture-coord-pointer ( seq -- )
-    [ 2 GL_FLOAT 0 ] dip underlying>> glTexCoordPointer ; inline
+    [ 2 GL_FLOAT 0 ] dip glTexCoordPointer ; inline
 
 : line-vertices ( a b -- )
     [ first2 [ 0.5 + ] bi@ ] bi@ 4 float-array{ } nsequence
@@ -177,7 +177,7 @@ MACRO: all-enabled-client-state ( seq quot -- )
     glActiveTexture swap glBindTexture gl-error ;
 
 : (set-draw-buffers) ( buffers -- )
-    [ length ] [ >uint-array underlying>> ] bi glDrawBuffers ;
+    [ length ] [ >uint-array ] bi glDrawBuffers ;
 
 MACRO: set-draw-buffers ( buffers -- )
     words>values [ (set-draw-buffers) ] curry ;

basis/opengl/shaders/shaders.factor

@@ -96,7 +96,7 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ;
     dup gl-program-shaders-length
     0 <int>
     over <uint-array>
-    [ underlying>> glGetAttachedShaders ] keep ;
+    [ glGetAttachedShaders ] keep ;
 
 : delete-gl-program-only ( program -- )
     glDeleteProgram ; inline

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

@@ -1,7 +1,8 @@
 IN: specialized-arrays.tests
 USING: tools.test specialized-arrays sequences
 specialized-arrays.int specialized-arrays.bool
-specialized-arrays.ushort alien.c-types accessors kernel ;
+specialized-arrays.ushort alien.c-types accessors kernel
+specialized-arrays.direct.int arrays ;
 
 [ t ] [ { 1 2 3 } >int-array int-array? ] unit-test
 
@@ -16,3 +17,7 @@ specialized-arrays.ushort alien.c-types accessors kernel ;
 ] unit-test
 
 [ B{ 210 4 1 } byte-array>ushort-array ] must-fail
+
+[ { 3 1 3 3 7 } ] [
+    int-array{ 3 1 3 3 7 } malloc-byte-array 5 <direct-int-array> >array
+] unit-test

basis/struct-arrays/struct-arrays-tests.factor

@@ -22,7 +22,7 @@ C-STRUCT: test-struct
 [ 5/4 ] [
     [
         2 "test-struct" malloc-struct-array
-        dup underlying>> &free drop
+        dup &free drop
         1 2 make-point over set-first
         3 4 make-point over set-second
         0 [ [ test-struct-x ] [ test-struct-y ] bi / + ] reduce
@@ -34,6 +34,6 @@ C-STRUCT: test-struct
 [ ] [
     [
         10 "test-struct" malloc-struct-array
-        underlying>> &free drop
+        &free drop
     ] with-destructors
 ] unit-test

basis/unix/utilities/utilities.factor

@@ -16,5 +16,5 @@ IN: unix.utilities
     '[ [ advance ] [ *void* _ alien>string ] bi ]
     [ ] produce nip ;
 
-: strings>alien ( strings encoding -- alien )
+: strings>alien ( strings encoding -- array )
-    '[ _ malloc-string ] void*-array{ } map-as f suffix underlying>> ;
+    '[ _ malloc-string ] void*-array{ } map-as f suffix ;

basis/windows/com/wrapper/wrapper.factor

@@ -132,7 +132,7 @@ unless
     [ [ 1 ] 2dip set-alien-unsigned-4 ] [ drop ] 2bi ;
 
 : (callbacks>vtbl) ( callbacks -- vtbl )
-    [ execute ] void*-array{ } map-as underlying>> malloc-byte-array ;
+    [ execute ] void*-array{ } map-as malloc-byte-array ;
 : (callbacks>vtbls) ( callbacks -- vtbls )
     [ (callbacks>vtbl) ] map ;
 

basis/windows/dinput/constants/constants.factor

@@ -59,7 +59,7 @@ SYMBOLS:
             struct args <DIOBJECTDATAFORMAT>
             i alien set-nth
         ] each-index
-        alien underlying>>
+        alien
     ] ;
 
 : (DIDATAFORMAT) ( dwSize dwObjSize dwFlags dwDataSize dwNumObjs rgodf alien -- alien )

basis/x11/clipboard/clipboard.factor

@@ -51,7 +51,7 @@ TUPLE: x-clipboard atom contents ;
     "TARGETS" x-atom 32 PropModeReplace
     {
         "UTF8_STRING" "STRING" "TARGETS" "TIMESTAMP"
-    } [ x-atom ] int-array{ } map-as underlying>>
+    } [ x-atom ] int-array{ } map-as
     4 XChangeProperty drop ;
 
 : set-timestamp-prop ( evt -- )

basis/x11/glx/glx.factor

@@ -93,7 +93,7 @@ FUNCTION: void* glXGetProcAddressARB ( char* procname ) ;
         GLX_RGBA ,
         GLX_DEPTH_SIZE , 16 ,
         0 ,
-    ] int-array{ } make underlying>>
+    ] int-array{ } make
     glXChooseVisual
     [ "Could not get a double-buffered GLX RGBA visual" throw ] unless* ;
 

basis/x11/xim/xim.factor

@@ -50,7 +50,7 @@ SYMBOL: keysym
 : lookup-string ( event xic -- string keysym )
     [
         prepare-lookup
-        swap keybuf get underlying>> buf-size keysym get 0 <int>
+        swap keybuf get buf-size keysym get 0 <int>
         XwcLookupString
         finish-lookup
     ] with-scope ;