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

basis/cocoa/application/application.factor

@@ -14,7 +14,7 @@ NSApplicationDelegateReplyCancel
 NSApplicationDelegateReplyFailure ;
 
 : with-autorelease-pool ( quot -- )
-    NSAutoreleasePool -> new slip -> release ; inline
+    NSAutoreleasePool -> new [ call ] [ -> release ] bi* ; inline
 
 : NSApp ( -- app ) NSApplication -> sharedApplication ;
 

basis/compiler/codegen/codegen.factor

@@ -444,8 +444,7 @@ TUPLE: callback-context ;
 
 : do-callback ( quot token -- )
     init-catchstack
-    dup 2 setenv
-    slip
+    [ 2 setenv call ] keep
     wait-to-return ; inline
 
 : callback-return-quot ( ctype -- quot )

basis/fry/fry-docs.factor

@@ -57,7 +57,6 @@ $nl
 "Here are some built-in combinators rewritten in terms of fried quotations:"
 { $table
     { { $link literalize } { $snippet ": literalize '[ _ ] ;" } }
-    { { $link slip } { $snippet ": slip '[ @ _ ] call ;" } }
     { { $link curry } { $snippet ": curry '[ _ @ ] ;" } }
     { { $link compose } { $snippet ": compose '[ @ @ ] ;" } }
     { { $link bi@ } { $snippet ": bi@ tuck '[ _ @ _ @ ] call ;" } }

basis/generalizations/generalizations-docs.factor

@@ -161,22 +161,6 @@ HELP: ndip
     }
 } ;
 
-HELP: nslip
-{ $values { "n" integer } }
-{ $description "A generalization of " { $link slip } " that can work " 
-"for any stack depth. The first " { $snippet "n" } " items after the quotation will be "
-"removed from the stack, the quotation called, and the items restored."
-} 
-{ $examples
-  { $example "USING: generalizations kernel prettyprint ;" "[ 99 ] 1 2 3 4 5 5 nslip 6 narray ." "{ 99 1 2 3 4 5 }" }
-  "Some core words expressed in terms of " { $link nslip } ":"
-    { $table
-        { { $link slip } { $snippet "1 nslip" } }
-        { { $link 2slip } { $snippet "2 nslip" } }
-        { { $link 3slip } { $snippet "3 nslip" } }
-    }
-} ;
-
 HELP: nkeep
 { $values { "quot" quotation } { "n" integer } }
 { $description "A generalization of " { $link keep } " that can work " 
@@ -339,7 +323,6 @@ ARTICLE: "shuffle-generalizations" "Generalized shuffle words"
 
 ARTICLE: "combinator-generalizations" "Generalized combinators"
 { $subsection ndip }
-{ $subsection nslip }
 { $subsection nkeep }
 { $subsection napply }
 { $subsection ncleave }

basis/generalizations/generalizations-tests.factor

@@ -26,8 +26,6 @@ IN: generalizations.tests
 [ [ 1 ] 5 ndip ] must-infer
 [ 1 2 3 4 ] [ 2 3 4 [ 1 ] 3 ndip ] unit-test
 
-[ [ 99 ] 1 2 3 4 5 5 nslip ] must-infer
-{ 99 1 2 3 4 5 } [ [ 99 ] 1 2 3 4 5 5 nslip ] unit-test
 [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] must-infer
 { 2 1 2 3 4 5 } [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] unit-test
 [ [ 1 2 3 + ] ] [ 1 2 3 [ + ] 3 ncurry ] unit-test

basis/generalizations/generalizations.factor

@@ -60,9 +60,6 @@ MACRO: ntuck ( n -- )
 MACRO: ndip ( quot n -- )
     [ '[ _ dip ] ] times ;
 
-MACRO: nslip ( n -- )
-    '[ [ call ] _ ndip ] ;
-
 MACRO: nkeep ( quot n -- )
     tuck '[ _ ndup _ _ ndip ] ;
 

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

@@ -48,7 +48,7 @@ concurrency.promises threads unix.process ;
     try-process
 ] unit-test
 
-[ f ] [
+[ "" ] [
     "cat"
     "launcher-test-1" temp-file
     2array

basis/io/streams/string/string-tests.factor

@@ -2,6 +2,8 @@ USING: io.streams.string io kernel arrays namespaces make
 tools.test ;
 IN: io.streams.string.tests
 
+[ "" ] [ "" [ contents ] with-string-reader ] unit-test
+
 [ "line 1" CHAR: l ]
 [
     "line 1\nline 2\nline 3" <string-reader>

basis/stack-checker/known-words/known-words.factor

@@ -95,15 +95,6 @@ M: composed infer-call*
 M: object infer-call*
     "literal quotation" literal-expected ;
 
-: infer-nslip ( n -- )
-    [ infer->r infer-call ] [ infer-r> ] bi ;
-
-: infer-slip ( -- ) 1 infer-nslip ;
-
-: infer-2slip ( -- ) 2 infer-nslip ;
-
-: infer-3slip ( -- ) 3 infer-nslip ;
-
 : infer-ndip ( word n -- )
     [ literals get ] 2dip
     [ '[ _ def>> infer-quot-here ] ]
@@ -180,9 +171,6 @@ M: object infer-call*
         { \ declare [ infer-declare ] }
         { \ call [ infer-call ] }
         { \ (call) [ infer-call ] }
-        { \ slip [ infer-slip ] }
-        { \ 2slip [ infer-2slip ] }
-        { \ 3slip [ infer-3slip ] }
         { \ dip [ infer-dip ] }
         { \ 2dip [ infer-2dip ] }
         { \ 3dip [ infer-3dip ] }
@@ -216,7 +204,7 @@ M: object infer-call*
     "local-word-def" word-prop infer-quot-here ;
 
 {
-    declare call (call) slip 2slip 3slip dip 2dip 3dip curry compose
+    declare call (call) dip 2dip 3dip curry compose
     execute (execute) call-effect-unsafe execute-effect-unsafe if
     dispatch <tuple-boa> exit load-local load-locals get-local
     drop-locals do-primitive alien-invoke alien-indirect

basis/xml/xml.factor

@@ -143,7 +143,7 @@ PRIVATE>
 <PRIVATE
 
 : call-under ( quot object -- quot )
-    swap dup slip ; inline
+    swap [ call ] keep ; inline
 
 : xml-loop ( quot: ( xml-elem -- ) -- )
     parse-text call-under

core/combinators/combinators-docs.factor

@@ -62,9 +62,6 @@ $nl
     ": dip   [ ] bi* ;"
     ": 2dip  [ ] [ ] tri* ;"
     ""
-    ": slip  [ call ] [ ] bi* ;"
-    ": 2slip [ call ] [ ] [ ] tri* ;"
-    ""
     ": nip   [ drop ] [ ] bi* ;"
     ": 2nip  [ drop ] [ drop ] [ ] tri* ;"
     ""
@@ -121,7 +118,7 @@ $nl
 { $subsection both? }
 { $subsection either? } ;
 
-ARTICLE: "slip-keep-combinators" "Retain stack combinators"
+ARTICLE: "retainstack-combinators" "Retain stack combinators"
 "Sometimes an additional storage area is needed to hold objects. The " { $emphasis "retain stack" } " is an auxilliary stack for this purpose. Objects can be moved between the data and retain stacks using a set of combinators."
 $nl
 "The dip combinators invoke the quotation at the top of the stack, hiding the values underneath:"
@@ -129,10 +126,6 @@ $nl
 { $subsection 2dip }
 { $subsection 3dip }
 { $subsection 4dip }
-"The slip combinators invoke a quotation further down on the stack. They are most useful for implementing other combinators:"
-{ $subsection slip }
-{ $subsection 2slip }
-{ $subsection 3slip }
 "The keep combinators invoke a quotation which takes a number of values off the stack, and then they restore those values:"
 { $subsection keep }
 { $subsection 2keep }
@@ -259,7 +252,7 @@ ARTICLE: "conditionals" "Conditional combinators"
 
 ARTICLE: "dataflow-combinators" "Data flow combinators"
 "Data flow combinators pass values between quotations:"
-{ $subsection "slip-keep-combinators" }
+{ $subsection "retainstack-combinators" }
 { $subsection "cleave-combinators" }
 { $subsection "spread-combinators" }
 { $subsection "apply-combinators" }

core/io/io-docs.factor

@@ -239,13 +239,13 @@ HELP: each-block
 { $description "Calls the quotation with successive blocks of data, until the current " { $link input-stream } " is exhausted." } ;
 
 HELP: stream-contents
-{ $values { "stream" "an input stream" } { "seq" "a string, byte array or " { $link f } } }
-{ $description "Reads the entire contents of a stream. If the stream is empty, outputs "  { $link f } "." }
+{ $values { "stream" "an input stream" } { "seq" { $or string byte-array } } }
+{ $description "Reads all elements in the given stream until the stream is exhausted. The type of the sequence depends on the stream's element type." }
 $io-error ;
 
 HELP: contents
-{ $values { "seq" "a string, byte array or " { $link f } } }
-{ $description "Reads the entire contents of a the stream stored in " { $link input-stream } ". If the stream is empty, outputs " { $link f } "." }
+{ $values { "seq" { $or string byte-array } } }
+{ $description "Reads all elements in the " { $link input-stream } " until the stream is exhausted. The type of the sequence depends on the stream's element type." }
 $io-error ;
 
 ARTICLE: "stream-protocol" "Stream protocol"

core/io/io.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2003, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: hashtables generic kernel math namespaces make sequences
-continuations destructors assocs ;
+continuations destructors assocs combinators ;
 IN: io
 
 SYMBOLS: +byte+ +character+ ;
@@ -20,7 +20,9 @@ GENERIC: stream-flush ( stream -- )
 GENERIC: stream-nl ( stream -- )
 
 ERROR: bad-seek-type type ;
+
 SINGLETONS: seek-absolute seek-relative seek-end ;
+
 GENERIC: stream-seek ( n seek-type stream -- )
 
 : stream-print ( str stream -- ) [ stream-write ] keep stream-nl ;
@@ -68,29 +70,39 @@ SYMBOL: error-stream
 
 : bl ( -- ) " " write ;
 
-: stream-lines ( stream -- seq )
-    [ [ readln dup ] [ ] produce nip ] with-input-stream ;
-
-: lines ( -- seq )
-    input-stream get stream-lines ;
-
 <PRIVATE
 
 : each-morsel ( handler: ( data -- ) reader: ( -- data ) -- )
     [ dup ] compose swap while drop ; inline
 
+: stream-element-exemplar ( type -- exemplar )
+    {
+        { +byte+ [ B{ } ] }
+        { +character+ [ "" ] }
+    } case ;
+
+: element-exemplar ( -- exemplar )
+    input-stream get
+    stream-element-type
+    stream-element-exemplar ;
+
 PRIVATE>
 
 : each-line ( quot -- )
     [ readln ] each-morsel ; inline
 
-: stream-contents ( stream -- seq )
-    [
-        [ 65536 read-partial dup ] [ ] produce nip concat f like
-    ] with-input-stream ;
+: lines ( -- seq )
+    [ ] accumulator [ each-line ] dip { } like ;
+
+: stream-lines ( stream -- seq )
+    [ lines ] with-input-stream ;
 
 : contents ( -- seq )
-    input-stream get stream-contents ;
+    [ 65536 read-partial dup ] [ ] produce nip
+    element-exemplar concat-as ;
+
+: stream-contents ( stream -- seq )
+    [ contents ] with-input-stream ;
 
 : each-block ( quot: ( block -- ) -- )
     [ 8192 read-partial ] each-morsel ; inline

core/io/streams/byte-array/byte-array-tests.factor

@@ -1,6 +1,7 @@
 USING: tools.test io.streams.byte-array io.encodings.binary
 io.encodings.utf8 io kernel arrays strings namespaces ;
 
+[ B{ } ] [ B{ } binary [ contents ] with-byte-reader ] unit-test
 [ B{ 1 2 3 } ] [ binary [ B{ 1 2 3 } write ] with-byte-writer ] unit-test
 [ B{ 1 2 3 } ] [ { 1 2 3 } binary [ 3 read ] with-byte-reader ] unit-test
 

core/kernel/kernel-docs.factor

@@ -212,18 +212,6 @@ HELP: call-clear ( quot -- )
 { $description "Calls a quotation with an empty call stack. If the quotation returns, Factor will exit.." }
 { $notes "Used to implement " { $link "threads" } "." } ;
 
-HELP: slip
-{ $values { "quot" quotation } { "x" object } }
-{ $description "Calls a quotation while hiding the top of the stack." } ;
-
-HELP: 2slip
-{ $values { "quot" quotation } { "x" object } { "y" object } }
-{ $description "Calls a quotation while hiding the top two stack elements." } ;
-
-HELP: 3slip
-{ $values { "quot" quotation } { "x" object } { "y" object } { "z" object } }
-{ $description "Calls a quotation while hiding the top three stack elements." } ;
-
 HELP: keep
 { $values { "quot" { $quotation "( x -- ... )" } } { "x" object } }
 { $description "Call a quotation with a value on the stack, restoring the value when the quotation returns." }

core/kernel/kernel.factor

@@ -58,37 +58,19 @@ DEFER: if
 : ?if ( default cond true false -- )
     pick [ drop [ drop ] 2dip call ] [ 2nip call ] if ; inline
 
-! Slippers and dippers.
+! Dippers.
 ! Not declared inline because the compiler special-cases them
 
-: slip ( quot x -- x )
-    #! 'slip' and 'dip' can be defined in terms of each other
-    #! because the JIT special-cases a 'dip' preceeded by
-    #! a literal quotation.
-    [ call ] dip ;
+: dip ( x quot -- x ) swap [ call ] dip ;
 
-: 2slip ( quot x y -- x y )
-    #! '2slip' and '2dip' can be defined in terms of each other
-    #! because the JIT special-cases a '2dip' preceeded by
-    #! a literal quotation.
-    [ call ] 2dip ;
+: 2dip ( x y quot -- x y ) -rot [ call ] 2dip ;
 
-: 3slip ( quot x y z -- x y z )
-    #! '3slip' and '3dip' can be defined in terms of each other
-    #! because the JIT special-cases a '3dip' preceeded by
-    #! a literal quotation.
-    [ call ] 3dip ;
-
-: dip ( x quot -- x ) swap slip ;
-
-: 2dip ( x y quot -- x y ) -rot 2slip ;
-
-: 3dip ( x y z quot -- x y z ) -roll 3slip ;
+: 3dip ( x y z quot -- x y z ) -roll [ call ] 3dip ;
 
 : 4dip ( w x y z quot -- w x y z ) swap [ 3dip ] dip ; inline
 
 ! Keepers
-: keep ( x quot -- x ) over slip ; inline
+: keep ( x quot -- x ) over [ call ] dip ; inline
 
 : 2keep ( x y quot -- x y ) [ 2dup ] dip 2dip ; inline
 

core/quotations/quotations.factor

@@ -19,7 +19,7 @@ M: quotation call (call) ;
 
 M: curry call uncurry call ;
 
-M: compose call uncompose slip call ;
+M: compose call uncompose [ call ] dip call ;
 
 M: wrapper equal?
     over wrapper? [ [ wrapped>> ] bi@ = ] [ 2drop f ] if ;

core/sequences/sequences-docs.factor

@@ -533,12 +533,18 @@ HELP: concat
 { $description "Concatenates a sequence of sequences together into one sequence. If " { $snippet "seq" } " is empty, outputs " { $snippet "{ }" } ", otherwise the resulting sequence is of the same class as the first element of " { $snippet "seq" } "." }
 { $errors "Throws an error if one of the sequences in " { $snippet "seq" } " contains elements not permitted in sequences of the same class as the first element of " { $snippet "seq" } "." } ;
 
+HELP: concat-as
+{ $values { "seq" sequence } { "exemplar" sequence } { "newseq" sequence } }
+{ $description "Concatenates a sequence of sequences together into one sequence with the same type as " { $snippet "exemplar" } "." }
+{ $errors "Throws an error if one of the sequences in " { $snippet "seq" } " contains elements not permitted in sequences of the same class as " { $snippet "exemplar" } "." } ;
+
 HELP: join
 { $values { "seq" sequence } { "glue" sequence } { "newseq" sequence } }
 { $description "Concatenates a sequence of sequences together into one sequence, placing a copy of " { $snippet "glue" } " between each pair of sequences. The resulting sequence is of the same class as " { $snippet "glue" } "." }
+{ $notes "If the " { $snippet "glue" } " sequence is empty, this word calls " { $link concat-as } "." }
 { $errors "Throws an error if one of the sequences in " { $snippet "seq" } " contains elements not permitted in sequences of the same class as " { $snippet "glue" } "." } ;
 
-{ join concat } related-words
+{ join concat concat-as } related-words
 
 HELP: peek
 { $values { "seq" sequence } { "elt" object } }

core/sequences/sequences.factor

@@ -704,13 +704,14 @@ PRIVATE>
 : sum-lengths ( seq -- n )
     0 [ length + ] reduce ;
 
+: concat-as ( seq exemplar -- newseq )
+    swap [ { } ] [
+        [ sum-lengths over new-resizable ] keep
+        [ over push-all ] each
+    ] if-empty swap like ;
+
 : concat ( seq -- newseq )
-    [ { } ] [
-        [ sum-lengths ] keep
-        [ first new-resizable ] keep
-        [ [ over push-all ] each ] keep
-        first like
-    ] if-empty ;
+    [ { } ] [ dup first concat-as ] if-empty ;
 
 <PRIVATE
 
@@ -720,12 +721,14 @@ PRIVATE>
 PRIVATE>
 
 : join ( seq glue -- newseq )
-    [
-        2dup joined-length over new-resizable [
-            [ [ push-all ] 2curry ] [ [ nip push-all ] 2curry ] 2bi
-            interleave
-        ] keep
-    ] keep like ;
+    dup empty? [ concat-as ] [
+        [
+            2dup joined-length over new-resizable [
+                [ [ push-all ] 2curry ] [ [ nip push-all ] 2curry ] 2bi
+                interleave
+            ] keep
+        ] keep like
+    ] if ;
 
 : padding ( seq n elt quot -- newseq )
     [

extra/mason/common/common.factor

@@ -5,12 +5,12 @@ math.functions make io io.files io.pathnames io.directories
 io.directories.hierarchy io.launcher io.encodings.utf8 prettyprint
 combinators.short-circuit parser combinators calendar
 calendar.format arrays mason.config locals system debugger fry
-continuations ;
+continuations strings ;
 IN: mason.common
 
 SYMBOL: current-git-id
 
-ERROR: output-process-error output process ;
+ERROR: output-process-error { output string } { process process } ;
 
 M: output-process-error error.
     [ "Process:" print process>> . nl ]

extra/mason/notify/notify.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays accessors io io.sockets io.encodings.utf8 io.files
 io.launcher kernel make mason.config mason.common mason.email
-mason.twitter namespaces sequences prettyprint ;
+mason.twitter namespaces sequences prettyprint fry ;
 IN: mason.notify
 
 : status-notify ( input-file args -- )
@@ -14,10 +14,12 @@ IN: mason.notify
             target-cpu get ,
             target-os get ,
         ] { } make prepend
-        <process>
-            swap >>command
-            swap [ +closed+ ] unless* >>stdin
-        try-output-process
+        [ 5 ] 2dip '[
+            <process>
+                _ >>command
+                _ [ +closed+ ] unless* >>stdin
+            try-output-process
+        ] retry
     ] [ 2drop ] if ;
 
 : notify-begin-build ( git-id -- )

extra/reports/noise/noise.factor

@@ -52,7 +52,6 @@ IN: reports.noise
         { nkeep 5 }
         { npick 6 }
         { nrot 5 }
-        { nslip 5 }
         { ntuck 6 }
         { nwith 4 }
         { over 2 }