From d6aa376ed089ce44364ba47693ab32c7f60c9e28 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 6 Feb 2009 04:37:28 -0600 Subject: [PATCH] Removing now-redundant underlying>> calls --- basis/cocoa/messages/messages.factor | 2 +- basis/cocoa/views/views.factor | 2 +- basis/compiler/tests/alien.factor | 4 ++-- basis/db/postgresql/lib/lib.factor | 6 +++--- basis/io/backend/unix/multiplexers/epoll/epoll.factor | 2 +- .../io/backend/unix/multiplexers/kqueue/kqueue.factor | 2 +- .../io/backend/unix/multiplexers/select/select.factor | 4 ++-- basis/io/launcher/windows/windows.factor | 4 ++-- basis/io/pipes/unix/unix.factor | 2 +- basis/libc/libc.factor | 4 ++-- basis/opengl/opengl.factor | 10 +++++----- basis/opengl/shaders/shaders.factor | 2 +- .../specialized-arrays/specialized-arrays-tests.factor | 7 ++++++- basis/struct-arrays/struct-arrays-tests.factor | 4 ++-- basis/unix/utilities/utilities.factor | 4 ++-- basis/windows/com/wrapper/wrapper.factor | 2 +- basis/windows/dinput/constants/constants.factor | 2 +- basis/x11/clipboard/clipboard.factor | 2 +- basis/x11/glx/glx.factor | 2 +- basis/x11/xim/xim.factor | 2 +- 20 files changed, 37 insertions(+), 32 deletions(-) diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor index ebe98a2df1..a0b0e89a0d 100644 --- a/basis/cocoa/messages/messages.factor +++ b/basis/cocoa/messages/messages.factor @@ -202,7 +202,7 @@ assoc-union alien>objc-types set-global [ 0 [ class_copyMethodList ] keep *uint ] dip over 0 = [ 3drop ] [ [ ] dip - [ each ] [ drop underlying>> (free) ] 2bi + [ each ] [ drop (free) ] 2bi ] if ; inline : register-objc-methods ( class -- ) diff --git a/basis/cocoa/views/views.factor b/basis/cocoa/views/views.factor index 03cafd0a0a..e74e912202 100644 --- a/basis/cocoa/views/views.factor +++ b/basis/cocoa/views/views.factor @@ -68,7 +68,7 @@ PRIVATE> NSOpenGLPFASamples , 8 , ] when 0 , - ] int-array{ } make underlying>> + ] int-array{ } make -> initWithAttributes: -> autorelease ; diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor index b1a9853d55..b9c62f1429 100644 --- a/basis/compiler/tests/alien.factor +++ b/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>> - { 4.0 5.0 6.0 } >float-array underlying>> + { 1.0 2.0 3.0 } >float-array + { 4.0 5.0 6.0 } >float-array ffi_test_23 ] unit-test diff --git a/basis/db/postgresql/lib/lib.factor b/basis/db/postgresql/lib/lib.factor index 19cf5c5002..05114a4deb 100644 --- a/basis/db/postgresql/lib/lib.factor +++ b/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 ) [ diff --git a/basis/io/backend/unix/multiplexers/epoll/epoll.factor b/basis/io/backend/unix/multiplexers/epoll/epoll.factor index a91f62f1df..e1428fee4d 100644 --- a/basis/io/backend/unix/multiplexers/epoll/epoll.factor +++ b/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 -- ) diff --git a/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor b/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor index 2a6648981b..7bd157136a 100644 --- a/basis/io/backend/unix/multiplexers/kqueue/kqueue.factor +++ b/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 -- ) diff --git a/basis/io/backend/unix/multiplexers/select/select.factor b/basis/io/backend/unix/multiplexers/select/select.factor index c62101e478..7d0acb4140 100644 --- a/basis/io/backend/unix/multiplexers/select/select.factor +++ b/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 ] - [ write-fdset/tasks [ init-fdset ] [ underlying>> ] bi ] tri + [ read-fdset/tasks [ init-fdset ] keep ] + [ write-fdset/tasks [ init-fdset ] keep ] tri f ; M:: select-mx wait-for-events ( us mx -- ) diff --git a/basis/io/launcher/windows/windows.factor b/basis/io/launcher/windows/windows.factor index 0497754aa2..7de6c25a13 100755 --- a/basis/io/launcher/windows/windows.factor +++ b/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 ; diff --git a/basis/io/pipes/unix/unix.factor b/basis/io/pipes/unix/unix.factor index 6a0015084b..f94733ca56 100644 --- a/basis/io/pipes/unix/unix.factor +++ b/basis/io/pipes/unix/unix.factor @@ -7,5 +7,5 @@ QUALIFIED: io.pipes M: unix io.pipes:(pipe) ( -- pair ) 2 - [ underlying>> pipe io-error ] + [ pipe io-error ] [ first2 [ init-fd ] bi@ io.pipes:pipe boa ] bi ; diff --git a/basis/libc/libc.factor b/basis/libc/libc.factor index c4d351e6a0..1e751833a2 100644 --- a/basis/libc/libc.factor +++ b/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 - (free) ; + >c-ptr [ delete-malloc ] [ (free) ] bi ; : memcpy ( dst src size -- ) "void" "libc" "memcpy" { "void*" "void*" "ulong" } alien-invoke ; diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index f5868ee7a1..6d9ac95965 100644 --- a/basis/opengl/opengl.factor +++ b/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 ; diff --git a/basis/opengl/shaders/shaders.factor b/basis/opengl/shaders/shaders.factor index eb5bbb0ee8..a77d29da2f 100755 --- a/basis/opengl/shaders/shaders.factor +++ b/basis/opengl/shaders/shaders.factor @@ -96,7 +96,7 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ; dup gl-program-shaders-length 0 over - [ underlying>> glGetAttachedShaders ] keep ; + [ glGetAttachedShaders ] keep ; : delete-gl-program-only ( program -- ) glDeleteProgram ; inline diff --git a/basis/specialized-arrays/specialized-arrays-tests.factor b/basis/specialized-arrays/specialized-arrays-tests.factor index 1ca041191e..73e719b806 100644 --- a/basis/specialized-arrays/specialized-arrays-tests.factor +++ b/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 >array +] unit-test \ No newline at end of file diff --git a/basis/struct-arrays/struct-arrays-tests.factor b/basis/struct-arrays/struct-arrays-tests.factor index 6f77e66cd2..a8ce98888c 100755 --- a/basis/struct-arrays/struct-arrays-tests.factor +++ b/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 \ No newline at end of file diff --git a/basis/unix/utilities/utilities.factor b/basis/unix/utilities/utilities.factor index e2f780cd13..29b137e3de 100644 --- a/basis/unix/utilities/utilities.factor +++ b/basis/unix/utilities/utilities.factor @@ -16,5 +16,5 @@ IN: unix.utilities '[ [ advance ] [ *void* _ alien>string ] bi ] [ ] produce nip ; -: strings>alien ( strings encoding -- alien ) - '[ _ malloc-string ] void*-array{ } map-as f suffix underlying>> ; +: strings>alien ( strings encoding -- array ) + '[ _ malloc-string ] void*-array{ } map-as f suffix ; diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor index 813d8315ac..c86cde23d9 100755 --- a/basis/windows/com/wrapper/wrapper.factor +++ b/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 ; diff --git a/basis/windows/dinput/constants/constants.factor b/basis/windows/dinput/constants/constants.factor index 0e9a03f075..314fb167e3 100755 --- a/basis/windows/dinput/constants/constants.factor +++ b/basis/windows/dinput/constants/constants.factor @@ -59,7 +59,7 @@ SYMBOLS: struct args i alien set-nth ] each-index - alien underlying>> + alien ] ; : (DIDATAFORMAT) ( dwSize dwObjSize dwFlags dwDataSize dwNumObjs rgodf alien -- alien ) diff --git a/basis/x11/clipboard/clipboard.factor b/basis/x11/clipboard/clipboard.factor index d3fe0a8447..8375636a72 100644 --- a/basis/x11/clipboard/clipboard.factor +++ b/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 -- ) diff --git a/basis/x11/glx/glx.factor b/basis/x11/glx/glx.factor index e0b786ce7d..11473d6e83 100644 --- a/basis/x11/glx/glx.factor +++ b/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* ; diff --git a/basis/x11/xim/xim.factor b/basis/x11/xim/xim.factor index 856420af0f..534e47ac37 100644 --- a/basis/x11/xim/xim.factor +++ b/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 + swap keybuf get buf-size keysym get 0 XwcLookupString finish-lookup ] with-scope ;