From 5f793727893e1eb658546ee8285a9353740fcf1c Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Fri, 15 Feb 2008 22:51:52 -0800
Subject: [PATCH] Rename out-keep to multikeep and move it into combinators.lib

---
 core/alien/alien-docs.factor        | 18 +-----------------
 core/alien/alien.factor             |  7 -------
 extra/combinators/lib/lib.factor    |  7 +++++++
 extra/opengl/shaders/shaders.factor |  2 +-
 extra/windows/ole32/ole32.factor    |  4 ++--
 5 files changed, 11 insertions(+), 27 deletions(-)

diff --git a/core/alien/alien-docs.factor b/core/alien/alien-docs.factor
index 68509db37f..19ee52b039 100755
--- a/core/alien/alien-docs.factor
+++ b/core/alien/alien-docs.factor
@@ -145,23 +145,7 @@ HELP: alien-callback
 }
 { $errors "Throws an " { $link alien-callback-error } " if the word calling " { $link alien-callback } " is not compiled." } ;
 
-HELP: out-keep
-{ $values { "quot" "A quotation" } { "out-indexes" "A sequence of indexes relative to the top of the stack" } }
-{ $description
-    "Invokes " { $snippet "quot" } ", restoring the values to the stack indicated by " { $snippet "out-indexes" } ". This word is useful for calling C functions with out parameters. " { $snippet "quot" } " can invoke the function and manipulate its return value, after which the actually interesting values stored in the out parameters are brought back to the top of the stack." }
-{ $notes "The indexes in " { $snippet "out-indexes" } " are relative to the top of the stack, with " { $snippet "1" } " indicating the topmost value. This means that the indexes are reversed relative to the order in the C prototype; 1 indicates the rightmost parameter, and higher numbers count leftward." }
-{ $examples
-    "A simple wrapper around memcpy (pretending that the return value is not equal to the out parameter):"
-    { $code
-        "LIBRARY: libc"
-        "FUNCTION: void* memcpy ( void* out, void* in, size_t n ) ;"
-        ": copy-byte-array ( a -- a' )"
-        "    dup length dup <byte-array> -rot"
-        "    [ memcpy drop ] { 3 } out-keep ;"
-    }
-} ;
-
-{ alien-invoke alien-indirect alien-callback out-keep } related-words
+{ alien-invoke alien-indirect alien-callback } related-words
 
 ARTICLE: "aliens" "Alien addresses"
 "Instances of the " { $link alien } " class represent pointers to C data outside the Factor heap:"
diff --git a/core/alien/alien.factor b/core/alien/alien.factor
index b644846393..d5e9b5c3e9 100755
--- a/core/alien/alien.factor
+++ b/core/alien/alien.factor
@@ -90,10 +90,3 @@ TUPLE: alien-invoke-error library symbol ;
 
 : alien-invoke ( ... return library function parameters -- ... )
     2over \ alien-invoke-error construct-boa throw ;
-
-MACRO: out-keep ( word out-indexes -- ... )
-    [
-        dup >r [ \ npick \ >r 3array % ] each
-        %
-        r> [ drop \ r> , ] each
-    ] [ ] make ;
diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor
index 9ccada1ec1..f73a99c1a2 100755
--- a/extra/combinators/lib/lib.factor
+++ b/extra/combinators/lib/lib.factor
@@ -167,3 +167,10 @@ MACRO: construct-slots ( assoc tuple-class -- tuple )
 
 : and? ( obj quot1 quot2 -- ? )
     >r keep r> rot [ call ] [ 2drop f ] if ; inline
+
+MACRO: multikeep ( word out-indexes -- ... )
+    [
+        dup >r [ \ npick \ >r 3array % ] each
+        %
+        r> [ drop \ r> , ] each
+    ] [ ] make ;
diff --git a/extra/opengl/shaders/shaders.factor b/extra/opengl/shaders/shaders.factor
index 7755df6513..6033933146 100755
--- a/extra/opengl/shaders/shaders.factor
+++ b/extra/opengl/shaders/shaders.factor
@@ -95,7 +95,7 @@ PREDICATE: gl-shader fragment-shader (fragment-shader?) ;
     dup gl-program-shaders-length
     dup "GLuint" <c-array>
     0 <int> swap
-    [ glGetAttachedShaders ] { 3 1 } out-keep
+    [ glGetAttachedShaders ] { 3 1 } multikeep
     c-uint-array> ;
 
 : delete-gl-program-only ( program -- )
diff --git a/extra/windows/ole32/ole32.factor b/extra/windows/ole32/ole32.factor
index 6d62e17d6c..ec0b02bc3f 100755
--- a/extra/windows/ole32/ole32.factor
+++ b/extra/windows/ole32/ole32.factor
@@ -1,5 +1,5 @@
 USING: alien alien.syntax alien.c-types math kernel sequences
-windows windows.types ;
+windows windows.types combinators.lib ;
 IN: windows.ole32
 
 LIBRARY: ole32
@@ -39,5 +39,5 @@ FUNCTION: HRESULT CLSIDFromString ( LPOLESTR lpsz, REFGUID out_rguid ) ;
     string>u16-alien "GUID" <c-object> [ CLSIDFromString ole32-error ] keep ;
 : guid>string ( guid -- string )
     GUID-STRING-LENGTH 1+ [ "ushort" <c-array> ] keep
-    [ StringFromGUID2 drop ] { 2 } out-keep alien>u16-string ;
+    [ StringFromGUID2 drop ] { 2 } multikeep alien>u16-string ;