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/4] 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/4] 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/4] 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/4] 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