From 8e63b4bde54c5bea75f8dd00fab47e42b660e367 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 1 Dec 2008 22:31:09 -0600
Subject: [PATCH 1/9] irc.gitbot: simple IRC bot which tracks git commits, work
in progress
---
extra/irc/gitbot/gitbot.factor | 55 ++++++++++++++++++++++++++++++++++
1 file changed, 55 insertions(+)
create mode 100644 extra/irc/gitbot/gitbot.factor
diff --git a/extra/irc/gitbot/gitbot.factor b/extra/irc/gitbot/gitbot.factor
new file mode 100644
index 0000000000..93ccb2b407
--- /dev/null
+++ b/extra/irc/gitbot/gitbot.factor
@@ -0,0 +1,55 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: fry irc.client irc.client.private kernel namespaces
+sequences threads io.encodings.8-bit io.launcher io splitting
+make mason.common mason.updates calendar math alarms ;
+IN: irc.gitbot
+
+: bot-profile ( -- obj )
+ "irc.freenode.org" 6667 "jackass" f <irc-profile> ;
+
+: bot-channel ( -- seq ) "#concatenative" ;
+
+GENERIC: handle-message ( msg -- )
+
+M: object handle-message drop ;
+
+: bot-loop ( chat -- )
+ dup hear handle-message bot-loop ;
+
+: start-bot ( -- chat )
+ bot-profile <irc-client>
+ [ connect-irc ]
+ [
+ [ bot-channel <irc-channel-chat> dup ] dip
+ '[ _ [ _ attach-chat ] [ bot-loop ] bi ]
+ "GitBot" spawn drop
+ ] bi ;
+
+: git-log ( from to -- lines )
+ [
+ "git-log" ,
+ "--no-merges" ,
+ "--pretty=format:%h %an: %s" ,
+ ".." swap 3append ,
+ ] { } make
+ latin1 [ input-stream get lines ] with-process-reader ;
+
+: updates ( from to -- lines )
+ git-log reverse
+ dup length 4 > [ 4 head "... and more" suffix ] when ;
+
+: report-updates ( from to chat -- )
+ [ updates ] dip
+ [ 1 seconds sleep ] swap
+ '[ _ speak ] interleave ;
+
+: check-for-updates ( chat -- )
+ [ git-id git-pull-cmd short-running-process git-id ] dip
+ report-updates ;
+
+: bot ( -- )
+ start-bot
+ '[ _ check-for-updates ] 5 minutes every drop ;
+
+MAIN: bot
From 2777f54e74fd3222f64acfdb96d414fbd3bc4d7a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 1 Dec 2008 22:31:15 -0600
Subject: [PATCH 2/9] XML parsing benchmark
---
extra/benchmark/xml/xml.factor | 11 +++++++++++
1 file changed, 11 insertions(+)
create mode 100644 extra/benchmark/xml/xml.factor
diff --git a/extra/benchmark/xml/xml.factor b/extra/benchmark/xml/xml.factor
new file mode 100644
index 0000000000..a61293cd99
--- /dev/null
+++ b/extra/benchmark/xml/xml.factor
@@ -0,0 +1,11 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: io.encodings.utf8 io.files kernel sequences xml ;
+IN: benchmark.xml
+
+: xml-benchmark ( -- )
+ "resource:basis/xmode/modes/" [
+ [ utf8 <file-reader> read-xml drop ] each
+ ] with-directory-files ;
+
+MAIN: xml-benchmark
From 082b788cdb4542f280488c25b7a1bbbb29325310 Mon Sep 17 00:00:00 2001
From: Daniel Lee Harple <dlh+dev@harple.com>
Date: Tue, 2 Dec 2008 01:15:34 -0500
Subject: [PATCH 3/9] Don't add f to vocab-roots
---
basis/environment/environment.factor | 7 +++++--
1 file changed, 5 insertions(+), 2 deletions(-)
diff --git a/basis/environment/environment.factor b/basis/environment/environment.factor
index ca78c3efa7..d6ce34dbcf 100644
--- a/basis/environment/environment.factor
+++ b/basis/environment/environment.factor
@@ -27,6 +27,9 @@ HOOK: (set-os-envs) os ( seq -- )
} cond
[
- "FACTOR_ROOTS" os-env os windows? ";" ":" ? split
- [ add-vocab-root ] each
+ "FACTOR_ROOTS" os-env
+ [
+ os windows? ";" ":" ? split
+ [ add-vocab-root ] each
+ ] when*
] "environment" add-init-hook
From c27faa3de4e0b156d51a39140cc703c8c509225c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 2 Dec 2008 00:25:23 -0600
Subject: [PATCH 4/9] Remove 3compose: nothing in core used it, and basis code
can use fry
---
basis/fry/fry-docs.factor | 4 ++--
basis/xmode/utilities/utilities.factor | 26 +++++++++++++-------------
core/io/io.factor | 2 +-
core/kernel/kernel-docs.factor | 13 -------------
core/kernel/kernel.factor | 3 ---
extra/combinators/lib/lib.factor | 2 +-
extra/inverse/inverse.factor | 7 +++----
extra/sequences/lib/lib.factor | 6 +-----
8 files changed, 21 insertions(+), 42 deletions(-)
diff --git a/basis/fry/fry-docs.factor b/basis/fry/fry-docs.factor
index a982ecdd7d..1dff0942bd 100644
--- a/basis/fry/fry-docs.factor
+++ b/basis/fry/fry-docs.factor
@@ -46,10 +46,10 @@ $nl
"{ 10 20 30 } [ sq ] [ . ] compose each"
"{ 10 20 30 } [ sq . ] each"
}
-"The " { $link _ } " and " { $link @ } " specifiers may be freely mixed:"
+"The " { $link _ } " and " { $link @ } " specifiers may be freely mixed, and the result is considerably more concise and readable than the version using " { $link curry } " and " { $link compose } " directly:"
{ $code
"{ 8 13 14 27 } [ even? ] 5 '[ @ dup _ ? ] map"
- "{ 8 13 14 27 } [ even? ] 5 [ dup ] swap [ ? ] curry 3compose map"
+ "{ 8 13 14 27 } [ even? ] 5 [ dup ] swap [ ? ] curry compose compose map"
"{ 8 13 14 27 } [ even? dup 5 ? ] map"
}
"The following is a no-op:"
diff --git a/basis/xmode/utilities/utilities.factor b/basis/xmode/utilities/utilities.factor
index 8f1a6184e8..23e4195158 100644
--- a/basis/xmode/utilities/utilities.factor
+++ b/basis/xmode/utilities/utilities.factor
@@ -1,30 +1,30 @@
USING: accessors sequences assocs kernel quotations namespaces
-xml.data xml.utilities combinators macros parser lexer words ;
+xml.data xml.utilities combinators macros parser lexer words fry ;
IN: xmode.utilities
-: implies >r not r> or ; inline
+: implies [ not ] dip or ; inline
: child-tags ( tag -- seq ) children>> [ tag? ] filter ;
: map-find ( seq quot -- result elt )
f -rot
- [ nip ] swap [ dup ] 3compose find
- >r [ drop f ] unless r> ; inline
+ '[ nip @ dup ] find
+ [ [ drop f ] unless ] dip ; inline
: tag-init-form ( spec -- quot )
{
{ [ dup quotation? ] [ [ object get tag get ] prepose ] }
{ [ dup length 2 = ] [
- first2 [
- >r >r tag get children>string
- r> [ execute ] when* object get r> execute
- ] 2curry
+ first2 '[
+ tag get children>string
+ _ [ execute ] when* object get _ execute
+ ]
] }
{ [ dup length 3 = ] [
- first3 [
- >r >r tag get at
- r> [ execute ] when* object get r> execute
- ] 3curry
+ first3 '[
+ _ tag get at
+ _ [ execute ] when* object get _ execute
+ ]
] }
} cond ;
@@ -36,7 +36,7 @@ MACRO: (init-from-tag) ( specs -- )
[ with-tag-initializer ] curry ;
: init-from-tag ( tag tuple specs -- tuple )
- over >r (init-from-tag) r> ; inline
+ over [ (init-from-tag) ] dip ; inline
SYMBOL: tag-handlers
SYMBOL: tag-handler-word
diff --git a/core/io/io.factor b/core/io/io.factor
index c1fd69a16a..fc553cc163 100644
--- a/core/io/io.factor
+++ b/core/io/io.factor
@@ -65,7 +65,7 @@ SYMBOL: error-stream
: with-streams ( input output quot -- )
[ [ with-streams* ] 3curry ]
- [ [ drop dispose dispose ] 3curry ] 3bi
+ [ drop [ [ dispose ] bi@ ] 2curry ] 3bi
[ ] cleanup ; inline
: tabular-output ( style quot -- )
diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index 3fc3d175a0..91b18d834b 100644
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@@ -578,18 +578,6 @@ HELP: prepose
{ compose prepose } related-words
-HELP: 3compose
-{ $values { "quot1" callable } { "quot2" callable } { "quot3" callable } { "compose" compose } }
-{ $description "Quotation composition. Outputs a " { $link callable } " which calls " { $snippet "quot1" } ", " { $snippet "quot2" } " and then " { $snippet "quot3" } "." }
-{ $notes
- "The following two lines are equivalent:"
- { $code
- "3compose call"
- "3append call"
- }
- "However, " { $link 3compose } " runs in constant time, and the compiler is able to compile code which calls composed quotations."
-} ;
-
HELP: dip
{ $values { "x" object } { "quot" quotation } }
{ $description "Calls " { $snippet "quot" } " with " { $snippet "obj" } " hidden on the retain stack." }
@@ -814,7 +802,6 @@ ARTICLE: "compositional-combinators" "Compositional combinators"
{ $subsection 3curry }
{ $subsection with }
{ $subsection compose }
-{ $subsection 3compose }
{ $subsection prepose }
"Quotations also implement the sequence protocol, and can be manipulated with sequence words; see " { $link "quotations" } "." ;
diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor
index 1677a2faaa..bbe2d348d8 100644
--- a/core/kernel/kernel.factor
+++ b/core/kernel/kernel.factor
@@ -179,9 +179,6 @@ GENERIC: boa ( ... class -- tuple )
: prepose ( quot1 quot2 -- compose )
swap compose ; inline
-: 3compose ( quot1 quot2 quot3 -- compose )
- compose compose ; inline
-
! Booleans
: not ( obj -- ? ) [ f ] [ t ] if ; inline
diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor
index 9a668b8e6e..0ae86c48c4 100755
--- a/extra/combinators/lib/lib.factor
+++ b/extra/combinators/lib/lib.factor
@@ -142,7 +142,7 @@ MACRO: multikeep ( word out-indexes -- ... )
[ tuck 2slip ] dip while ; inline
: generate ( generator predicate -- obj )
- [ dup ] swap [ dup [ nip ] unless not ] 3compose
+ '[ dup @ dup [ nip ] unless not ]
swap [ ] do-while ;
MACRO: predicates ( seq -- quot/f )
diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor
index dfef23b56a..8a2ce57e70 100755
--- a/extra/inverse/inverse.factor
+++ b/extra/inverse/inverse.factor
@@ -5,7 +5,7 @@ sequences assocs math arrays stack-checker effects generalizations
continuations debugger classes.tuple namespaces make vectors
bit-arrays byte-arrays strings sbufs math.functions macros
sequences.private combinators mirrors
-combinators.short-circuit ;
+combinators.short-circuit fry ;
IN: inverse
TUPLE: fail ;
@@ -46,7 +46,7 @@ M: no-inverse summary
dup word? [ "Badly formed math inverse" throw ] when 1quotation ;
: swap-inverse ( math-inverse revquot -- revquot* quot )
- next assure-constant rot second [ swap ] swap 3compose ;
+ next assure-constant rot second '[ @ swap @ ] ;
: pull-inverse ( math-inverse revquot const -- revquot* quot )
assure-constant rot first compose ;
@@ -236,8 +236,7 @@ DEFER: _
] recover ; inline
: true-out ( quot effect -- quot' )
- out>> [ ndrop ] curry
- [ t ] 3compose ;
+ out>> '[ @ _ ndrop t ] ;
: false-recover ( effect -- quot )
in>> [ ndrop f ] curry [ recover-fail ] curry ;
diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor
index 9dc01c04fa..68bea839a9 100755
--- a/extra/sequences/lib/lib.factor
+++ b/extra/sequences/lib/lib.factor
@@ -90,12 +90,8 @@ ERROR: element-not-found ;
dupd find over [ element-not-found ] unless
>r cut rest r> swap ; inline
-: (map-until) ( quot pred -- quot )
- [ dup ] swap 3compose
- [ [ drop t ] [ , f ] if ] compose [ find 2drop ] curry ;
-
: map-until ( seq quot pred -- newseq )
- (map-until) { } make ;
+ '[ [ @ dup @ [ drop t ] [ , f ] if ] find 2drop ] { } make ;
: take-while ( seq quot -- newseq )
[ not ] compose
From 53d44bb78c3db1b5b7ab0192ecb944224cf60695 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 2 Dec 2008 00:52:48 -0600
Subject: [PATCH 5/9] remove unused vocab
---
basis/unix/statfs/netbsd/authors.txt | 1 -
basis/unix/statfs/netbsd/netbsd.factor | 6 ------
basis/unix/statfs/netbsd/tags.txt | 1 -
basis/unix/statfs/statfs.factor | 4 ++--
4 files changed, 2 insertions(+), 10 deletions(-)
delete mode 100644 basis/unix/statfs/netbsd/authors.txt
delete mode 100644 basis/unix/statfs/netbsd/netbsd.factor
delete mode 100644 basis/unix/statfs/netbsd/tags.txt
diff --git a/basis/unix/statfs/netbsd/authors.txt b/basis/unix/statfs/netbsd/authors.txt
deleted file mode 100644
index b4bd0e7b35..0000000000
--- a/basis/unix/statfs/netbsd/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Doug Coleman
\ No newline at end of file
diff --git a/basis/unix/statfs/netbsd/netbsd.factor b/basis/unix/statfs/netbsd/netbsd.factor
deleted file mode 100644
index 5617ca7533..0000000000
--- a/basis/unix/statfs/netbsd/netbsd.factor
+++ /dev/null
@@ -1,6 +0,0 @@
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel unix.stat math unix
-combinators system io.backend accessors alien.c-types
-io.encodings.utf8 alien.strings unix.types unix.statfs io.files ;
-IN: unix.statfs.netbsd
diff --git a/basis/unix/statfs/netbsd/tags.txt b/basis/unix/statfs/netbsd/tags.txt
deleted file mode 100644
index 6bf68304bb..0000000000
--- a/basis/unix/statfs/netbsd/tags.txt
+++ /dev/null
@@ -1 +0,0 @@
-unportable
diff --git a/basis/unix/statfs/statfs.factor b/basis/unix/statfs/statfs.factor
index bc7b199705..4e3ba0d9f9 100644
--- a/basis/unix/statfs/statfs.factor
+++ b/basis/unix/statfs/statfs.factor
@@ -8,6 +8,6 @@ os {
{ linux [ "unix.statfs.linux" require ] }
{ macosx [ "unix.statfs.macosx" require ] }
{ freebsd [ "unix.statfs.freebsd" require ] }
- { netbsd [ "unix.statfs.netbsd" require ] }
- { openbsd [ "unix.statfs.openbsd" require ] }
+ ! { netbsd [ "unix.statfs.netbsd" require ] }
+ ! { openbsd [ "unix.statfs.openbsd" require ] }
} case
From 3a8f784baadfb56f563ddefec32b663b65be0bac Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 2 Dec 2008 00:53:30 -0600
Subject: [PATCH 6/9] add a tags file
---
basis/unix/statvfs/freebsd/tags.txt | 1 +
1 file changed, 1 insertion(+)
create mode 100644 basis/unix/statvfs/freebsd/tags.txt
diff --git a/basis/unix/statvfs/freebsd/tags.txt b/basis/unix/statvfs/freebsd/tags.txt
new file mode 100644
index 0000000000..6bf68304bb
--- /dev/null
+++ b/basis/unix/statvfs/freebsd/tags.txt
@@ -0,0 +1 @@
+unportable
From 90a50c73edbba17df9add74402c8e208a3996575 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 2 Dec 2008 02:45:53 -0600
Subject: [PATCH 7/9] Forgot to add fry to USING: list in sequences.lib
---
extra/sequences/lib/lib.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor
index 68bea839a9..0674b8d9d2 100755
--- a/extra/sequences/lib/lib.factor
+++ b/extra/sequences/lib/lib.factor
@@ -5,7 +5,7 @@ USING: combinators.lib kernel sequences math namespaces make
assocs random sequences.private shuffle math.functions arrays
math.parser math.private sorting strings ascii macros assocs.lib
quotations hashtables math.order locals generalizations
-math.ranges random ;
+math.ranges random fry ;
IN: sequences.lib
: each-withn ( seq quot n -- ) nwith each ; inline
From e4db2afb7e8f7c2e8ed12c21858ddd40eb62391d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 2 Dec 2008 03:10:01 -0600
Subject: [PATCH 8/9] Update cpu.x86.assembler to use dip instead of >r/r>
---
basis/cpu/x86/assembler/assembler.factor | 12 ++++++------
basis/cpu/x86/assembler/syntax/syntax.factor | 4 ++--
2 files changed, 8 insertions(+), 8 deletions(-)
diff --git a/basis/cpu/x86/assembler/assembler.factor b/basis/cpu/x86/assembler/assembler.factor
index 05fe3a8093..27c00cb3c0 100644
--- a/basis/cpu/x86/assembler/assembler.factor
+++ b/basis/cpu/x86/assembler/assembler.factor
@@ -130,7 +130,7 @@ M: register modifier drop BIN: 11 ;
GENERIC# n, 1 ( value n -- )
M: integer n, >le % ;
-M: byte n, >r value>> r> n, ;
+M: byte n, [ value>> ] dip n, ;
: 1, ( n -- ) 1 n, ; inline
: 4, ( n -- ) 4 n, ; inline
: 2, ( n -- ) 2 n, ; inline
@@ -209,7 +209,7 @@ M: object operand-64? drop f ;
: short-operand ( reg rex.w n -- )
#! Some instructions encode their single operand as part of
#! the opcode.
- >r dupd prefix-1 reg-code r> + , ;
+ [ dupd prefix-1 reg-code ] dip + , ;
: opcode, ( opcode -- ) dup array? [ % ] [ , ] if ;
@@ -224,7 +224,7 @@ M: object operand-64? drop f ;
: 1-operand ( op reg,rex.w,opcode -- )
#! The 'reg' is not really a register, but a value for the
#! 'reg' field of the mod-r/m byte.
- first3 >r >r over r> prefix-1 r> opcode, swap addressing ;
+ first3 [ [ over ] dip prefix-1 ] dip opcode, swap addressing ;
: immediate-operand-size-bit ( imm dst reg,rex.w,opcode -- imm dst reg,rex.w,opcode )
pick integer? [ first3 BIN: 1 opcode-or 3array ] when ;
@@ -250,7 +250,7 @@ M: object operand-64? drop f ;
] if ;
: (2-operand) ( dst src op -- )
- >r 2dup t rex-prefix r> opcode,
+ [ 2dup t rex-prefix ] dip opcode,
reg-code swap addressing ;
: direction-bit ( dst src op -- dst' src' op' )
@@ -271,11 +271,11 @@ M: object operand-64? drop f ;
PRIVATE>
: [] ( reg/displacement -- indirect )
- dup integer? [ >r f f f r> ] [ f f f ] if <indirect> ;
+ dup integer? [ [ f f f ] dip ] [ f f f ] if <indirect> ;
: [+] ( reg displacement -- indirect )
dup integer?
- [ dup zero? [ drop f ] when >r f f r> ]
+ [ dup zero? [ drop f ] when [ f f ] dip ]
[ f f ] if
<indirect> ;
diff --git a/basis/cpu/x86/assembler/syntax/syntax.factor b/basis/cpu/x86/assembler/syntax/syntax.factor
index d267baaf4f..6ddec4af07 100644
--- a/basis/cpu/x86/assembler/syntax/syntax.factor
+++ b/basis/cpu/x86/assembler/syntax/syntax.factor
@@ -4,8 +4,8 @@ USING: kernel words sequences lexer parser fry ;
IN: cpu.x86.assembler.syntax
: define-register ( name num size -- )
- >r >r "cpu.x86.assembler" create dup define-symbol r> r>
- >r dupd "register" set-word-prop r>
+ [ "cpu.x86.assembler" create dup define-symbol ] 2dip
+ [ dupd "register" set-word-prop ] dip
"register-size" set-word-prop ;
: define-registers ( names size -- )
From 74a112f1cf50fa876a6ee3061e4e87b04ddda417 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 2 Dec 2008 03:10:13 -0600
Subject: [PATCH 9/9] Update cpu.x86.basis/io to use dip instead of >r/r>
---
basis/io/buffers/buffers-tests.factor | 2 +-
basis/io/encodings/utf16/utf16.factor | 2 +-
basis/io/monitors/monitors.factor | 2 +-
basis/io/monitors/recursive/recursive.factor | 18 +++++++++---------
basis/io/pools/pools.factor | 2 +-
basis/io/streams/duplex/duplex.factor | 2 +-
basis/io/timeouts/timeouts.factor | 8 ++++----
basis/io/unix/backend/backend.factor | 13 +++++--------
basis/io/unix/linux/monitors/monitors.factor | 8 +++-----
basis/io/unix/macosx/monitors/monitors.factor | 6 ++----
basis/io/unix/select/select.factor | 4 ++--
basis/io/unix/sockets/sockets.factor | 10 +++++-----
basis/io/unix/unix-tests.factor | 8 ++++----
basis/io/windows/files/files.factor | 14 +++++++-------
basis/io/windows/nt/backend/backend.factor | 16 ++++++----------
basis/io/windows/nt/files/files.factor | 2 +-
basis/io/windows/nt/launcher/launcher.factor | 4 ++--
.../io/windows/nt/privileges/privileges.factor | 8 ++++----
basis/io/windows/nt/sockets/sockets.factor | 8 ++++----
basis/io/windows/sockets/sockets.factor | 8 ++++----
basis/io/windows/windows.factor | 3 ++-
21 files changed, 69 insertions(+), 79 deletions(-)
diff --git a/basis/io/buffers/buffers-tests.factor b/basis/io/buffers/buffers-tests.factor
index b3c5c4ee90..4425e08106 100644
--- a/basis/io/buffers/buffers-tests.factor
+++ b/basis/io/buffers/buffers-tests.factor
@@ -5,7 +5,7 @@ destructors ;
: buffer-set ( string buffer -- )
over >byte-array over ptr>> byte-array>memory
- >r length r> buffer-reset ;
+ [ length ] dip buffer-reset ;
: string>buffer ( string -- buffer )
dup length <buffer> tuck buffer-set ;
diff --git a/basis/io/encodings/utf16/utf16.factor b/basis/io/encodings/utf16/utf16.factor
index 037087e452..167d7534d1 100644
--- a/basis/io/encodings/utf16/utf16.factor
+++ b/basis/io/encodings/utf16/utf16.factor
@@ -25,7 +25,7 @@ ERROR: missing-bom ;
: quad-be ( stream byte -- stream char )
double-be over stream-read1 [
dup -2 shift BIN: 110111 number= [
- >r 2 shift r> BIN: 11 bitand bitor
+ [ 2 shift ] dip BIN: 11 bitand bitor
over stream-read1 swap append-nums HEX: 10000 +
] [ 2drop dup stream-read1 drop replacement-char ] if
] when* ;
diff --git a/basis/io/monitors/monitors.factor b/basis/io/monitors/monitors.factor
index 7f33f0caa6..72f2bc80c5 100644
--- a/basis/io/monitors/monitors.factor
+++ b/basis/io/monitors/monitors.factor
@@ -53,7 +53,7 @@ SYMBOL: +rename-file-new+
SYMBOL: +rename-file+
: with-monitor ( path recursive? quot -- )
- >r <monitor> r> with-disposal ; inline
+ [ <monitor> ] dip with-disposal ; inline
{
{ [ os macosx? ] [ "io.unix.macosx.monitors" require ] }
diff --git a/basis/io/monitors/recursive/recursive.factor b/basis/io/monitors/recursive/recursive.factor
index 45979363c9..a96c6f04f1 100644
--- a/basis/io/monitors/recursive/recursive.factor
+++ b/basis/io/monitors/recursive/recursive.factor
@@ -3,7 +3,7 @@
USING: accessors sequences assocs arrays continuations
destructors combinators kernel threads concurrency.messaging
concurrency.mailboxes concurrency.promises io.files io.monitors
-debugger ;
+debugger fry ;
IN: io.monitors.recursive
! Simulate recursive monitors on platforms that don't have them
@@ -29,10 +29,10 @@ DEFER: add-child-monitor
qualify-path dup link-info directory? [
[ add-child-monitors ]
[
- [
- [ f my-mailbox (monitor) ] keep
+ '[
+ _ [ f my-mailbox (monitor) ] keep
monitor tget children>> set-at
- ] curry ignore-errors
+ ] ignore-errors
] bi
] [ drop ] if ;
@@ -48,7 +48,7 @@ M: recursive-monitor dispose*
monitor tget children>> [ nip dispose ] assoc-each ;
: pump-step ( msg -- )
- first3 path>> swap >r prepend-path r> monitor tget 3array
+ first3 path>> swap [ prepend-path ] dip monitor tget 3array
monitor tget queue>>
mailbox-put ;
@@ -71,9 +71,9 @@ M: recursive-monitor dispose*
: pump-loop ( -- )
receive dup synchronous? [
- >r stop-pump t r> reply-synchronous
+ [ stop-pump t ] dip reply-synchronous
] [
- [ [ update-hierarchy ] curry ignore-errors ] [ pump-step ] bi
+ [ '[ _ update-hierarchy ] ignore-errors ] [ pump-step ] bi
pump-loop
] if ;
@@ -88,7 +88,7 @@ M: recursive-monitor dispose*
pump-loop ;
: start-pump-thread ( monitor -- )
- dup [ pump-thread ] curry
+ dup '[ _ pump-thread ]
"Recursive monitor pump" spawn
>>thread drop ;
@@ -96,7 +96,7 @@ M: recursive-monitor dispose*
ready>> ?promise ?linked drop ;
: <recursive-monitor> ( path mailbox -- monitor )
- >r (normalize-path) r>
+ [ (normalize-path) ] dip
recursive-monitor new-monitor
H{ } clone >>children
<promise> >>ready
diff --git a/basis/io/pools/pools.factor b/basis/io/pools/pools.factor
index aa734e6809..2c1f8ea3c3 100644
--- a/basis/io/pools/pools.factor
+++ b/basis/io/pools/pools.factor
@@ -42,7 +42,7 @@ GENERIC: make-connection ( pool -- conn )
[ nip call ] [ drop return-connection ] 3bi ; inline
: with-pooled-connection ( pool quot -- )
- >r [ acquire-connection ] keep r>
+ [ [ acquire-connection ] keep ] dip
[ (with-pooled-connection) ] [ ] [ 2drop dispose ] cleanup ; inline
M: return-connection dispose
diff --git a/basis/io/streams/duplex/duplex.factor b/basis/io/streams/duplex/duplex.factor
index 2ba504c653..9bf637432f 100644
--- a/basis/io/streams/duplex/duplex.factor
+++ b/basis/io/streams/duplex/duplex.factor
@@ -27,7 +27,7 @@ M: duplex-stream dispose
] with-destructors ;
: <encoder-duplex> ( stream-in stream-out encoding -- duplex )
- tuck re-encode >r re-decode r> <duplex-stream> ;
+ tuck [ re-decode ] [ re-encode ] 2bi* <duplex-stream> ;
: with-stream* ( stream quot -- )
[ [ in>> ] [ out>> ] bi ] dip with-streams* ; inline
diff --git a/basis/io/timeouts/timeouts.factor b/basis/io/timeouts/timeouts.factor
index 029cf6cac0..fd1b14de19 100644
--- a/basis/io/timeouts/timeouts.factor
+++ b/basis/io/timeouts/timeouts.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov, Doug Coleman
! See http://factorcode.org/license.txt for BSD license.
USING: kernel calendar alarms io io.encodings accessors
-namespaces ;
+namespaces fry ;
IN: io.timeouts
GENERIC: timeout ( obj -- dt/f )
@@ -14,14 +14,14 @@ M: encoder set-timeout stream>> set-timeout ;
GENERIC: cancel-operation ( obj -- )
: queue-timeout ( obj timeout -- alarm )
- >r [ cancel-operation ] curry r> later ;
+ [ '[ _ cancel-operation ] ] dip later ;
: with-timeout* ( obj timeout quot -- )
- 3dup drop queue-timeout >r nip call r> cancel-alarm ;
+ 3dup drop queue-timeout [ nip call ] dip cancel-alarm ;
inline
: with-timeout ( obj quot -- )
- over timeout [ >r dup timeout r> with-timeout* ] [ call ] if ;
+ over timeout [ [ dup timeout ] dip with-timeout* ] [ call ] if ;
inline
: timeouts ( dt -- )
diff --git a/basis/io/unix/backend/backend.factor b/basis/io/unix/backend/backend.factor
index 5bb0b82555..85363c8404 100644
--- a/basis/io/unix/backend/backend.factor
+++ b/basis/io/unix/backend/backend.factor
@@ -5,7 +5,7 @@ math io.ports sequences strings sbufs threads unix
vectors io.buffers io.backend io.encodings math.parser
continuations system libc qualified namespaces make io.timeouts
io.encodings.utf8 destructors accessors summary combinators
-locals unix.time ;
+locals unix.time fry ;
QUALIFIED: io
IN: io.unix.backend
@@ -88,19 +88,16 @@ M: io-timeout summary drop "I/O operation timed out" ;
: wait-for-fd ( handle event -- )
dup +retry+ eq? [ 2drop ] [
- [
- >r
- swap handle-fd
- mx get-global
- r> {
+ '[
+ swap handle-fd mx get-global _ {
{ +input+ [ add-input-callback ] }
{ +output+ [ add-output-callback ] }
} case
- ] curry "I/O" suspend nip [ io-timeout ] when
+ ] "I/O" suspend nip [ io-timeout ] when
] if ;
: wait-for-port ( port event -- )
- [ >r handle>> r> wait-for-fd ] curry with-timeout ;
+ '[ handle>> _ wait-for-fd ] with-timeout ;
! Some general stuff
: file-mode OCT: 0666 ;
diff --git a/basis/io/unix/linux/monitors/monitors.factor b/basis/io/unix/linux/monitors/monitors.factor
index 12b1cf779b..f27d48c6b0 100644
--- a/basis/io/unix/linux/monitors/monitors.factor
+++ b/basis/io/unix/linux/monitors/monitors.factor
@@ -36,9 +36,7 @@ TUPLE: linux-monitor < monitor wd inotify watches disposed ;
inotify-fd -rot inotify_add_watch dup io-error dup check-existing ;
: add-watch ( path mask mailbox -- monitor )
- >r
- >r (normalize-path) r>
- [ (add-watch) ] [ drop ] 2bi r>
+ [ [ (normalize-path) ] dip [ (add-watch) ] [ drop ] 2bi ] dip
<linux-monitor> [ ] [ ] [ wd>> ] tri watches get set-at ;
: check-inotify ( -- )
@@ -103,12 +101,12 @@ M: linux-monitor dispose* ( monitor -- )
: next-event ( i buffer -- i buffer )
2dup inotify-event@
inotify-event-len "inotify-event" heap-size +
- swap >r + r> ;
+ swap [ + ] dip ;
: parse-file-notifications ( i buffer -- )
2dup events-exhausted? [ 2drop ] [
2dup inotify-event@ dup inotify-event-wd wd>monitor
- >r parse-file-notify r> queue-change
+ [ parse-file-notify ] dip queue-change
next-event parse-file-notifications
] if ;
diff --git a/basis/io/unix/macosx/monitors/monitors.factor b/basis/io/unix/macosx/monitors/monitors.factor
index a5f36aa93b..cde1d6339a 100644
--- a/basis/io/unix/macosx/monitors/monitors.factor
+++ b/basis/io/unix/macosx/monitors/monitors.factor
@@ -2,15 +2,13 @@
! See http://factorcode.org/license.txt for BSD license.
USING: io.backend io.monitors
core-foundation.fsevents continuations kernel sequences
-namespaces arrays system locals accessors destructors ;
+namespaces arrays system locals accessors destructors fry ;
IN: io.unix.macosx.monitors
TUPLE: macosx-monitor < monitor handle ;
: enqueue-notifications ( triples monitor -- )
- [
- >r first { +modify-file+ } r> queue-change
- ] curry each ;
+ '[ first { +modify-file+ } _ queue-change ] each ;
M:: macosx (monitor) ( path recursive? mailbox -- monitor )
[let | path [ path normalize-path ] |
diff --git a/basis/io/unix/select/select.factor b/basis/io/unix/select/select.factor
index 1dd1d51e87..27231aee5a 100644
--- a/basis/io/unix/select/select.factor
+++ b/basis/io/unix/select/select.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types kernel io.ports io.unix.backend
bit-arrays sequences assocs unix math namespaces
-accessors math.order locals unix.time ;
+accessors math.order locals unix.time fry ;
IN: io.unix.select
TUPLE: select-mx < mx read-fdset write-fdset ;
@@ -28,7 +28,7 @@ TUPLE: select-mx < mx read-fdset write-fdset ;
[ check-fd ] 3curry each ; inline
: init-fdset ( fds fdset -- )
- [ >r t swap munge r> set-nth ] curry each ;
+ '[ t swap munge _ set-nth ] each ;
: read-fdset/tasks ( mx -- seq fdset )
[ reads>> keys ] [ read-fdset>> ] bi ;
diff --git a/basis/io/unix/sockets/sockets.factor b/basis/io/unix/sockets/sockets.factor
index a98432b84d..5fba7badb0 100644
--- a/basis/io/unix/sockets/sockets.factor
+++ b/basis/io/unix/sockets/sockets.factor
@@ -16,18 +16,18 @@ IN: io.unix.sockets
0 socket dup io-error <fd> init-fd |dispose ;
: set-socket-option ( fd level opt -- )
- >r >r handle-fd r> r> 1 <int> "int" heap-size setsockopt io-error ;
+ [ handle-fd ] 2dip 1 <int> "int" heap-size setsockopt io-error ;
M: unix addrinfo-error ( n -- )
dup zero? [ drop ] [ gai_strerror throw ] if ;
! Client sockets - TCP and Unix domain
M: object (get-local-address) ( handle remote -- sockaddr )
- >r handle-fd r> empty-sockaddr/size <int>
+ [ handle-fd ] dip empty-sockaddr/size <int>
[ getsockname io-error ] 2keep drop ;
M: object (get-remote-address) ( handle local -- sockaddr )
- >r handle-fd r> empty-sockaddr/size <int>
+ [ handle-fd ] dip empty-sockaddr/size <int>
[ getpeername io-error ] 2keep drop ;
: init-client-socket ( fd -- )
@@ -60,7 +60,7 @@ M: object ((client)) ( addrspec -- fd )
SOL_SOCKET SO_REUSEADDR set-socket-option ;
: server-socket-fd ( addrspec type -- fd )
- >r dup protocol-family r> socket-fd
+ [ dup protocol-family ] dip socket-fd
dup init-server-socket
dup handle-fd rot make-sockaddr/size bind io-error ;
@@ -77,7 +77,7 @@ M: object (server) ( addrspec -- handle )
M: object (accept) ( server addrspec -- fd sockaddr )
2dup do-accept
{
- { [ over 0 >= ] [ >r 2nip <fd> init-fd r> ] }
+ { [ over 0 >= ] [ [ 2nip <fd> init-fd ] dip ] }
{ [ err_no EINTR = ] [ 2drop (accept) ] }
{ [ err_no EAGAIN = ] [
2drop
diff --git a/basis/io/unix/unix-tests.factor b/basis/io/unix/unix-tests.factor
index 7e1dc48e5f..df61420c77 100644
--- a/basis/io/unix/unix-tests.factor
+++ b/basis/io/unix/unix-tests.factor
@@ -46,7 +46,7 @@ yield
"Receive 1" print
- "d" get receive >r reverse r>
+ "d" get receive [ reverse ] dip
"Send 1" print
dup .
@@ -55,7 +55,7 @@ yield
"Receive 2" print
- "d" get receive >r " world" append r>
+ "d" get receive [ " world" append ] dip
"Send 1" print
dup .
@@ -86,7 +86,7 @@ datagram-client <local> <datagram>
[ "olleh" t ] [
"d" get receive
datagram-server <local> =
- >r >string r>
+ [ >string ] dip
] unit-test
[ ] [
@@ -98,7 +98,7 @@ datagram-client <local> <datagram>
[ "hello world" t ] [
"d" get receive
datagram-server <local> =
- >r >string r>
+ [ >string ] dip
] unit-test
[ ] [ "d" get dispose ] unit-test
diff --git a/basis/io/windows/files/files.factor b/basis/io/windows/files/files.factor
index 4c38ee3b12..83954e045b 100755
--- a/basis/io/windows/files/files.factor
+++ b/basis/io/windows/files/files.factor
@@ -10,7 +10,7 @@ IN: io.windows.files
: open-file ( path access-mode create-mode flags -- handle )
[
- >r >r share-mode default-security-attributes r> r>
+ [ share-mode default-security-attributes ] 2dip
CreateFile-flags f CreateFile opened-file
] with-destructors ;
@@ -46,7 +46,7 @@ IN: io.windows.files
GetLastError ERROR_ALREADY_EXISTS = not ;
: set-file-pointer ( handle length method -- )
- >r dupd d>w/w <uint> r> SetFilePointer
+ [ dupd d>w/w <uint> ] dip SetFilePointer
INVALID_SET_FILE_POINTER = [
CloseHandle "SetFilePointer failed" throw
] when drop ;
@@ -348,23 +348,23 @@ M: winnt file-systems ( -- array )
: set-file-times ( path timestamp/f timestamp/f timestamp/f -- )
#! timestamp order: creation access write
[
- >r >r >r
+ [
normalize-path open-existing &dispose handle>>
- r> r> r> (set-file-times)
+ ] 3dip (set-file-times)
] with-destructors ;
: set-file-create-time ( path timestamp -- )
f f set-file-times ;
: set-file-access-time ( path timestamp -- )
- >r f r> f set-file-times ;
+ [ f ] dip f set-file-times ;
: set-file-write-time ( path timestamp -- )
- >r f f r> set-file-times ;
+ [ f f ] dip set-file-times ;
M: winnt touch-file ( path -- )
[
normalize-path
- maybe-create-file >r &dispose r>
+ maybe-create-file [ &dispose ] dip
[ drop ] [ handle>> f now dup (set-file-times) ] if
] with-destructors ;
diff --git a/basis/io/windows/nt/backend/backend.factor b/basis/io/windows/nt/backend/backend.factor
index 4e335da749..8035bd66e9 100644
--- a/basis/io/windows/nt/backend/backend.factor
+++ b/basis/io/windows/nt/backend/backend.factor
@@ -18,8 +18,8 @@ C: <io-callback> io-callback
"OVERLAPPED" malloc-object &free ;
: make-overlapped ( port -- overlapped-ext )
- >r (make-overlapped)
- r> handle>> ptr>> [ over set-OVERLAPPED-offset ] when* ;
+ [ (make-overlapped) ] dip
+ handle>> ptr>> [ over set-OVERLAPPED-offset ] when* ;
: <completion-port> ( handle existing -- handle )
f 1 CreateIoCompletionPort dup win32-error=0/f ;
@@ -64,13 +64,9 @@ M: winnt add-completion ( win32-handle -- )
: handle-overlapped ( us -- ? )
wait-for-overlapped [
dup [
- >r drop GetLastError 1array r> resume-callback t
- ] [
- 2drop f
- ] if
- ] [
- resume-callback t
- ] if ;
+ [ drop GetLastError 1array ] dip resume-callback t
+ ] [ 2drop f ] if
+ ] [ resume-callback t ] if ;
M: win32-handle cancel-operation
[ check-disposed ] [ handle>> CancelIo drop ] bi ;
@@ -94,7 +90,7 @@ M: winnt init-io ( -- )
: wait-for-file ( FileArgs n port -- n )
swap file-error?
- [ 2drop 0 ] [ >r lpOverlapped>> r> twiddle-thumbs ] if ;
+ [ 2drop 0 ] [ [ lpOverlapped>> ] dip twiddle-thumbs ] if ;
: update-file-ptr ( n port -- )
handle>> dup ptr>> [ rot + >>ptr drop ] [ 2drop ] if* ;
diff --git a/basis/io/windows/nt/files/files.factor b/basis/io/windows/nt/files/files.factor
index 2fbc809263..9f25eb5eb1 100644
--- a/basis/io/windows/nt/files/files.factor
+++ b/basis/io/windows/nt/files/files.factor
@@ -59,6 +59,6 @@ M: winnt FileArgs-overlapped ( port -- overlapped )
M: winnt open-append
[ dup file-info size>> ] [ drop 0 ] recover
- >r (open-append) r> >>ptr ;
+ [ (open-append) ] dip >>ptr ;
M: winnt home "USERPROFILE" os-env ;
diff --git a/basis/io/windows/nt/launcher/launcher.factor b/basis/io/windows/nt/launcher/launcher.factor
index 9d02fbe2fd..de4fb99c64 100644
--- a/basis/io/windows/nt/launcher/launcher.factor
+++ b/basis/io/windows/nt/launcher/launcher.factor
@@ -52,7 +52,7 @@ IN: io.windows.nt.launcher
CreateFile dup invalid-handle? <win32-file> &dispose handle>> ;
: redirect-append ( path access-mode create-mode -- handle )
- >r >r path>> r> r>
+ [ path>> ] 2dip
drop OPEN_ALWAYS
redirect-file
dup 0 FILE_END set-file-pointer ;
@@ -61,7 +61,7 @@ IN: io.windows.nt.launcher
2drop handle>> duplicate-handle ;
: redirect-stream ( stream access-mode create-mode -- handle )
- >r >r underlying-handle handle>> r> r> redirect-handle ;
+ [ underlying-handle handle>> ] 2dip redirect-handle ;
: redirect ( obj access-mode create-mode -- handle )
{
diff --git a/basis/io/windows/nt/privileges/privileges.factor b/basis/io/windows/nt/privileges/privileges.factor
index 8418d09a5e..106cf06b77 100644
--- a/basis/io/windows/nt/privileges/privileges.factor
+++ b/basis/io/windows/nt/privileges/privileges.factor
@@ -20,12 +20,12 @@ TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
: with-process-token ( quot -- )
#! quot: ( token-handle -- token-handle )
- >r open-process-token r>
+ [ open-process-token ] dip
[ keep ] curry
[ CloseHandle drop ] [ ] cleanup ; inline
: lookup-privilege ( string -- luid )
- >r f r> "LUID" <c-object>
+ [ f ] dip "LUID" <c-object>
[ LookupPrivilegeValue win32-error=0/f ] keep ;
: make-token-privileges ( name ? -- obj )
@@ -39,10 +39,10 @@ TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
set-LUID_AND_ATTRIBUTES-Attributes
] when
- >r lookup-privilege r>
+ [ lookup-privilege ] dip
[
TOKEN_PRIVILEGES-Privileges
- >r 0 r> LUID_AND_ATTRIBUTES-nth
+ [ 0 ] dip LUID_AND_ATTRIBUTES-nth
set-LUID_AND_ATTRIBUTES-Luid
] keep ;
diff --git a/basis/io/windows/nt/sockets/sockets.factor b/basis/io/windows/nt/sockets/sockets.factor
index 5d94cf2d4a..ecd9ea9d9b 100644
--- a/basis/io/windows/nt/sockets/sockets.factor
+++ b/basis/io/windows/nt/sockets/sockets.factor
@@ -176,8 +176,8 @@ TUPLE: WSASendTo-args port
: make-send-buffer ( packet -- WSABUF )
"WSABUF" malloc-object &free
- [ >r malloc-byte-array &free r> set-WSABUF-buf ]
- [ >r length r> set-WSABUF-len ]
+ [ [ malloc-byte-array &free ] dip set-WSABUF-buf ]
+ [ [ length ] dip set-WSABUF-len ]
[ nip ]
2tri ; inline
@@ -186,8 +186,8 @@ TUPLE: WSASendTo-args port
swap >>port
dup port>> handle>> handle>> >>s
swap make-sockaddr/size
- >r malloc-byte-array &free
- r> [ >>lpTo ] [ >>iToLen ] bi*
+ [ malloc-byte-array &free ] dip
+ [ >>lpTo ] [ >>iToLen ] bi*
swap make-send-buffer >>lpBuffers
1 >>dwBufferCount
0 >>dwFlags
diff --git a/basis/io/windows/sockets/sockets.factor b/basis/io/windows/sockets/sockets.factor
index d9ab10d5e3..809af605e0 100644
--- a/basis/io/windows/sockets/sockets.factor
+++ b/basis/io/windows/sockets/sockets.factor
@@ -20,21 +20,21 @@ M: win32-socket dispose ( stream -- )
<win32-socket> |dispose dup add-completion ;
: open-socket ( addrspec type -- win32-socket )
- >r protocol-family r>
+ [ protocol-family ] dip
0 f 0 WSASocket-flags WSASocket
dup socket-error
opened-socket ;
M: object (get-local-address) ( socket addrspec -- sockaddr )
- >r handle>> r> empty-sockaddr/size <int>
+ [ handle>> ] dip empty-sockaddr/size <int>
[ getsockname socket-error ] 2keep drop ;
M: object (get-remote-address) ( socket addrspec -- sockaddr )
- >r handle>> r> empty-sockaddr/size <int>
+ [ handle>> ] dip empty-sockaddr/size <int>
[ getpeername socket-error ] 2keep drop ;
: bind-socket ( win32-socket sockaddr len -- )
- >r >r handle>> r> r> bind socket-error ;
+ [ handle>> ] 2dip bind socket-error ;
M: object ((client)) ( addrspec -- handle )
[ SOCK_STREAM open-socket ] keep
diff --git a/basis/io/windows/windows.factor b/basis/io/windows/windows.factor
index ce75293b38..94304edc05 100755
--- a/basis/io/windows/windows.factor
+++ b/basis/io/windows/windows.factor
@@ -8,7 +8,8 @@ splitting continuations math.bitwise system accessors ;
IN: io.windows
: set-inherit ( handle ? -- )
- >r HANDLE_FLAG_INHERIT r> >BOOLEAN SetHandleInformation win32-error=0/f ;
+ [ HANDLE_FLAG_INHERIT ] dip
+ >BOOLEAN SetHandleInformation win32-error=0/f ;
TUPLE: win32-handle handle disposed ;