From 005cdd4d3a6db484417fbeb3ff6f00e37c7949dd Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 19 Sep 2008 11:22:40 -0500
Subject: [PATCH 01/14] tweaking hello-world deploy
---
extra/hello-world/deploy.factor | 18 +++++++++---------
1 file changed, 9 insertions(+), 9 deletions(-)
diff --git a/extra/hello-world/deploy.factor b/extra/hello-world/deploy.factor
index 403cb4737e..c683ef6e06 100755
--- a/extra/hello-world/deploy.factor
+++ b/extra/hello-world/deploy.factor
@@ -1,15 +1,15 @@
USING: tools.deploy.config ;
H{
- { deploy-word-props? f }
- { deploy-random? f }
- { deploy-compiler? f }
{ deploy-c-types? f }
- { deploy-ui? f }
- { deploy-reflection 1 }
- { deploy-threads? f }
- { deploy-io 2 }
- { deploy-word-defs? f }
- { "stop-after-last-window?" t }
{ deploy-name "Hello world (console)" }
+ { deploy-threads? f }
+ { deploy-word-props? f }
+ { deploy-reflection 2 }
+ { deploy-random? f }
+ { deploy-io 2 }
{ deploy-math? f }
+ { deploy-ui? f }
+ { deploy-compiler? f }
+ { "stop-after-last-window?" t }
+ { deploy-word-defs? f }
}
From be4915ee9c6b91d8e7878a8f5af4821a36d7e0f4 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 19 Sep 2008 14:44:58 -0500
Subject: [PATCH 02/14] Fix save-image-and-exit bug
---
core/memory/memory-tests.factor | 3 ++-
vm/image.c | 9 ++++++---
2 files changed, 8 insertions(+), 4 deletions(-)
diff --git a/core/memory/memory-tests.factor b/core/memory/memory-tests.factor
index 9fded3eb3a..1c23e700ca 100755
--- a/core/memory/memory-tests.factor
+++ b/core/memory/memory-tests.factor
@@ -1,4 +1,4 @@
-USING: generic kernel kernel.private math memory prettyprint
+USING: generic kernel kernel.private math memory prettyprint io
sequences tools.test words namespaces layouts classes
classes.builtin arrays quotations ;
IN: memory.tests
@@ -19,6 +19,7 @@ TUPLE: testing x y z ;
[ ] [
num-types get [
type>class [
+ dup . flush
"predicate" word-prop instances [
class drop
] each
diff --git a/vm/image.c b/vm/image.c
index a668cb7913..62f9e1c906 100755
--- a/vm/image.c
+++ b/vm/image.c
@@ -186,13 +186,16 @@ void strip_compiled_quotations(void)
DEFINE_PRIMITIVE(save_image_and_exit)
{
- /* This reduces deployed image size */
- strip_compiled_quotations();
-
+ /* We unbox this before doing anything else. This is the only point
+ where we might throw an error, so we have to throw an error here since
+ later steps destroy the current image. */
F_CHAR *path = unbox_native_string();
REGISTER_C_STRING(path);
+ /* This reduces deployed image size */
+ strip_compiled_quotations();
+
/* strip out userenv data which is set on startup anyway */
CELL i;
for(i = 0; i < FIRST_SAVE_ENV; i++)
From 40009dac8793f6f1972c120446512b0078f08f61 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 19 Sep 2008 15:14:05 -0500
Subject: [PATCH 03/14] add match-range to regexp
---
unfinished/regexp/regexp.factor | 14 +++++++++++++-
1 file changed, 13 insertions(+), 1 deletion(-)
diff --git a/unfinished/regexp/regexp.factor b/unfinished/regexp/regexp.factor
index 47c6e52c39..85bdccc2f4 100644
--- a/unfinished/regexp/regexp.factor
+++ b/unfinished/regexp/regexp.factor
@@ -33,7 +33,19 @@ IN: regexp
dupd match
[ [ length ] [ length>> 1- ] bi* = ] [ drop f ] if* ;
-: match-head ( string regexp -- end ) match length>> 1- ;
+: match-head ( string regexp -- end/f ) match [ length>> 1- ] [ f ] if* ;
+
+: match-at ( string m regexp -- n/f finished? )
+ [
+ 2dup swap length > [ 2drop f f ] [ tail-slice t ] if
+ ] dip swap [ match-head f ] [ 2drop f t ] if ;
+
+: match-range ( string m regexp -- a/f b/f )
+ 3dup match-at over [
+ drop nip rot drop dupd +
+ ] [
+ [ 3drop drop f f ] [ drop [ 1+ ] dip match-range ] if
+ ] if ;
: initial-option ( regexp option -- regexp' )
over options>> conjoin ;
From 65e88f70b99f9973153f59154bac1861305b065c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 19 Sep 2008 15:45:27 -0500
Subject: [PATCH 04/14] Make counter runnable to demonstrate web app deployment
---
extra/webapps/counter/counter.factor | 19 +++++++++++++++++++
1 file changed, 19 insertions(+)
diff --git a/extra/webapps/counter/counter.factor b/extra/webapps/counter/counter.factor
index f3efb3868f..a0ee3a1b29 100644
--- a/extra/webapps/counter/counter.factor
+++ b/extra/webapps/counter/counter.factor
@@ -1,3 +1,5 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
USING: math kernel accessors http.server http.server.dispatchers
furnace furnace.actions furnace.sessions furnace.redirection
html.components html.forms html.templates.chloe
@@ -28,3 +30,20 @@ M: counter-app init-session* drop 0 count sset ;
[ 1- ] <counter-action> "dec" add-responder
<display-action> "" add-responder
<sessions> ;
+
+! Deployment example
+USING: db.sqlite db.tuples db furnace.db namespaces ;
+
+: counter-db ( -- params db ) "counter.db" sqlite-db ;
+
+: init-counter-db ( -- )
+ counter-db [ session ensure-table ] with-db ;
+
+: run-counter ( -- )
+ init-counter-db
+ <counter-app>
+ counter-db <db-persistence>
+ main-responder set-global
+ 8080 httpd ;
+
+MAIN: run-counter
From 90e440bf60ccfdc5164a4a81971166b28249b600 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 19 Sep 2008 15:45:45 -0500
Subject: [PATCH 05/14] Fix html.elements load problem
---
basis/html/elements/elements.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/basis/html/elements/elements.factor b/basis/html/elements/elements.factor
index ab9d987b67..ad75b58df3 100644
--- a/basis/html/elements/elements.factor
+++ b/basis/html/elements/elements.factor
@@ -48,8 +48,6 @@ IN: html.elements
!
! <input "text" =type "name" =name "20" =size input/>
-: elements-vocab ( -- vocab-name ) "html.elements" ;
-
SYMBOL: html
: write-html ( str -- )
@@ -60,6 +58,8 @@ SYMBOL: html
<<
+: elements-vocab ( -- vocab-name ) "html.elements" ;
+
: html-word ( name def effect -- )
#! Define 'word creating' word to allow
#! dynamically creating words.
From 5647d08f5905b8b35d539ffbef7ffed64e044c6b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 19 Sep 2008 15:46:02 -0500
Subject: [PATCH 06/14] Fix some farkup bugs
---
basis/farkup/farkup-docs.factor | 6 +-
basis/farkup/farkup-tests.factor | 4 ++
basis/farkup/farkup.factor | 103 ++++++++++++++++---------------
3 files changed, 61 insertions(+), 52 deletions(-)
diff --git a/basis/farkup/farkup-docs.factor b/basis/farkup/farkup-docs.factor
index f2d53d2362..6e7a5ddcb0 100644
--- a/basis/farkup/farkup-docs.factor
+++ b/basis/farkup/farkup-docs.factor
@@ -9,7 +9,7 @@ HELP: write-farkup
{ $values { "string" string } }
{ $description "Parse a Farkup string and writes the resulting HTML to " { $link output-stream } "." } ;
-HELP: farkup ( string -- farkup )
+HELP: parse-farkup ( string -- farkup )
{ $values { "string" string } { "farkup" "a Farkup syntax tree node" } }
{ $description "Parses Farkup and outputs a tree of " { $link "farkup-ast" } "." } ;
@@ -18,7 +18,7 @@ HELP: (write-farkup)
{ $description "Writes a Farkup syntax tree as HTML on " { $link output-stream } "." } ;
ARTICLE: "farkup-ast" "Farkup syntax tree nodes"
-"The " { $link farkup } " word outputs a tree of nodes corresponding to the Farkup syntax of the input string. This tree can be programatically traversed and mutated before being passed on to " { $link write-farkup } "."
+"The " { $link parse-farkup } " word outputs a tree of nodes corresponding to the Farkup syntax of the input string. This tree can be programatically traversed and mutated before being passed on to " { $link write-farkup } "."
{ $subsection heading1 }
{ $subsection heading2 }
{ $subsection heading3 }
@@ -44,7 +44,7 @@ $nl
{ $subsection convert-farkup }
{ $subsection write-farkup }
"The syntax tree of a piece of Farkup can also be inspected and modified:"
-{ $subsection farkup }
+{ $subsection parse-farkup }
{ $subsection (write-farkup) }
{ $subsection "farkup-ast" } ;
diff --git a/basis/farkup/farkup-tests.factor b/basis/farkup/farkup-tests.factor
index e25fa34960..cc032913b7 100644
--- a/basis/farkup/farkup-tests.factor
+++ b/basis/farkup/farkup-tests.factor
@@ -118,3 +118,7 @@ link-no-follow? off
] unit-test
[ "<p><a href='a'>a</a> <a href='b'>c</a></p>" ] [ "[[a]] [[b|c]]" convert-farkup ] unit-test
+
+[ "<p><a href='C%2b%2b'>C++</a></p>" ] [ "[[C++]]" convert-farkup ] unit-test
+
+[ "<p><foo></p>" ] [ "<foo>" convert-farkup ] unit-test
diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor
index 4d6ac127ad..cc56f48949 100644
--- a/basis/farkup/farkup.factor
+++ b/basis/farkup/farkup.factor
@@ -1,29 +1,29 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays combinators html.elements io io.streams.string
-kernel math memoize namespaces peg peg.ebnf prettyprint
-sequences sequences.deep strings xml.entities vectors splitting
-xmode.code2html ;
+USING: accessors arrays combinators html.elements io
+io.streams.string kernel math memoize namespaces peg peg.ebnf
+prettyprint sequences sequences.deep strings xml.entities
+vectors splitting xmode.code2html urls ;
IN: farkup
SYMBOL: relative-link-prefix
SYMBOL: disable-images?
SYMBOL: link-no-follow?
-TUPLE: heading1 obj ;
-TUPLE: heading2 obj ;
-TUPLE: heading3 obj ;
-TUPLE: heading4 obj ;
-TUPLE: strong obj ;
-TUPLE: emphasis obj ;
-TUPLE: superscript obj ;
-TUPLE: subscript obj ;
-TUPLE: inline-code obj ;
-TUPLE: paragraph obj ;
-TUPLE: list-item obj ;
-TUPLE: list obj ;
-TUPLE: table obj ;
-TUPLE: table-row obj ;
+TUPLE: heading1 child ;
+TUPLE: heading2 child ;
+TUPLE: heading3 child ;
+TUPLE: heading4 child ;
+TUPLE: strong child ;
+TUPLE: emphasis child ;
+TUPLE: superscript child ;
+TUPLE: subscript child ;
+TUPLE: inline-code child ;
+TUPLE: paragraph child ;
+TUPLE: list-item child ;
+TUPLE: list child ;
+TUPLE: table child ;
+TUPLE: table-row child ;
TUPLE: link href text ;
TUPLE: image href text ;
TUPLE: code mode string ;
@@ -34,7 +34,7 @@ TUPLE: code mode string ;
: simple-link-title ( string -- string' )
dup absolute-url? [ "/" last-split1 swap or ] unless ;
-EBNF: farkup
+EBNF: parse-farkup
nl = ("\r\n" | "\r" | "\n") => [[ drop "\n" ]]
2nl = nl nl
@@ -65,7 +65,7 @@ subscript = "~" (!("~" | nl).)+ "~"
inline-code = "%" (!("%" | nl).)+ "%"
=> [[ second >string inline-code boa ]]
-escaped-char = "\" . => [[ second ]]
+escaped-char = "\" . => [[ second 1string ]]
link-content = (!("|"|"]").)+
@@ -89,20 +89,26 @@ inline-tag = strong | emphasis | superscript | subscript | inline-code
inline-delimiter = '*' | '_' | '^' | '~' | '%' | '\' | '['
-table-column = (list | (!(nl | inline-delimiter | '|').)+ | inline-tag | inline-delimiter ) '|'
+cell = (!(inline-delimiter | '|' | nl).)+
+ => [[ >string ]]
+
+table-column = (list | cell | inline-tag | inline-delimiter ) '|'
=> [[ first ]]
table-row = "|" (table-column)+
=> [[ second table-row boa ]]
table = ((table-row nl => [[ first ]] )+ table-row? | table-row)
=> [[ table boa ]]
-paragraph-item = ( table | (!(nl | code | heading | inline-delimiter | table ).) | inline-tag | inline-delimiter)+
+text = (!(nl | code | heading | inline-delimiter | table ).)+
+ => [[ >string ]]
+
+paragraph-item = (table | text | inline-tag | inline-delimiter)+
paragraph = ((paragraph-item nl => [[ first ]])+ nl+ => [[ first ]]
| (paragraph-item nl)+ paragraph-item?
| paragraph-item)
=> [[ paragraph boa ]]
-
-list-item = '-' ((!(inline-delimiter | nl).)+ | inline-tag)*
+
+list-item = '-' (cell | inline-tag)*
=> [[ second list-item boa ]]
list = ((list-item nl)+ list-item? | list-item)
=> [[ list boa ]]
@@ -136,7 +142,7 @@ stand-alone
: write-link ( href text -- )
escape-link
- [ <a =href link-no-follow? get [ "true" =nofollow ] when a> ]
+ [ <a url-encode =href link-no-follow? get [ "true" =nofollow ] when a> ]
[ write </a> ]
bi* ;
@@ -146,7 +152,7 @@ stand-alone
<strong> "Images are not allowed" write </strong>
] [
escape-link
- [ <img =src ] [ [ =alt ] unless-empty img/> ] bi*
+ [ <img url-encode =src ] [ [ =alt ] unless-empty img/> ] bi*
] if ;
: render-code ( string mode -- string' )
@@ -161,31 +167,30 @@ GENERIC: (write-farkup) ( farkup -- )
: <foo.> ( string -- ) <foo> write ;
: </foo.> ( string -- ) </foo> write ;
: in-tag. ( obj quot string -- ) [ <foo.> call ] keep </foo.> ; inline
-M: heading1 (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "h1" in-tag. ;
-M: heading2 (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "h2" in-tag. ;
-M: heading3 (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "h3" in-tag. ;
-M: heading4 (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "h4" in-tag. ;
-M: strong (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "strong" in-tag. ;
-M: emphasis (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "em" in-tag. ;
-M: superscript (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "sup" in-tag. ;
-M: subscript (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "sub" in-tag. ;
-M: inline-code (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "code" in-tag. ;
-M: list-item (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "li" in-tag. ;
-M: list (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "ul" in-tag. ;
-M: paragraph (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "p" in-tag. ;
-M: link (write-farkup) ( obj -- ) [ href>> ] [ text>> ] bi write-link ;
-M: image (write-farkup) ( obj -- ) [ href>> ] [ text>> ] bi write-image-link ;
-M: code (write-farkup) ( obj -- ) [ string>> ] [ mode>> ] bi render-code ;
+M: heading1 (write-farkup) [ child>> (write-farkup) ] "h1" in-tag. ;
+M: heading2 (write-farkup) [ child>> (write-farkup) ] "h2" in-tag. ;
+M: heading3 (write-farkup) [ child>> (write-farkup) ] "h3" in-tag. ;
+M: heading4 (write-farkup) [ child>> (write-farkup) ] "h4" in-tag. ;
+M: strong (write-farkup) [ child>> (write-farkup) ] "strong" in-tag. ;
+M: emphasis (write-farkup) [ child>> (write-farkup) ] "em" in-tag. ;
+M: superscript (write-farkup) [ child>> (write-farkup) ] "sup" in-tag. ;
+M: subscript (write-farkup) [ child>> (write-farkup) ] "sub" in-tag. ;
+M: inline-code (write-farkup) [ child>> (write-farkup) ] "code" in-tag. ;
+M: list-item (write-farkup) [ child>> (write-farkup) ] "li" in-tag. ;
+M: list (write-farkup) [ child>> (write-farkup) ] "ul" in-tag. ;
+M: paragraph (write-farkup) [ child>> (write-farkup) ] "p" in-tag. ;
+M: link (write-farkup) [ href>> ] [ text>> ] bi write-link ;
+M: image (write-farkup) [ href>> ] [ text>> ] bi write-image-link ;
+M: code (write-farkup) [ string>> ] [ mode>> ] bi render-code ;
M: table-row (write-farkup) ( obj -- )
- obj>> [ [ [ (write-farkup) ] "td" in-tag. ] each ] "tr" in-tag. ;
-M: table (write-farkup) ( obj -- ) [ obj>> (write-farkup) ] "table" in-tag. ;
-M: fixnum (write-farkup) ( obj -- ) write1 ;
-M: string (write-farkup) ( obj -- ) write ;
-M: vector (write-farkup) ( obj -- ) [ (write-farkup) ] each ;
-M: f (write-farkup) ( obj -- ) drop ;
+ child>> [ [ [ (write-farkup) ] "td" in-tag. ] each ] "tr" in-tag. ;
+M: table (write-farkup) [ child>> (write-farkup) ] "table" in-tag. ;
+M: string (write-farkup) escape-string write ;
+M: vector (write-farkup) [ (write-farkup) ] each ;
+M: f (write-farkup) drop ;
: write-farkup ( string -- )
- farkup (write-farkup) ;
+ parse-farkup (write-farkup) ;
: convert-farkup ( string -- string' )
- farkup [ (write-farkup) ] with-string-writer ;
+ parse-farkup [ (write-farkup) ] with-string-writer ;
From ad1c520d13ad01d40617b80783e7866e0ecf4acf Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 19 Sep 2008 15:46:12 -0500
Subject: [PATCH 07/14] Fix stack effects
---
basis/urls/urls.factor | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor
index e16f62d1f1..4f2639975b 100644
--- a/basis/urls/urls.factor
+++ b/basis/urls/urls.factor
@@ -14,7 +14,7 @@ IN: urls
[ letter? ]
[ LETTER? ]
[ digit? ]
- [ "/_-." member? ]
+ [ "/_-.:" member? ]
} 1|| ; foldable
<PRIVATE
@@ -25,7 +25,7 @@ IN: urls
PRIVATE>
-: url-encode ( str -- str )
+: url-encode ( str -- encoded )
[
[ dup url-quotable? [ , ] [ push-utf8 ] if ] each
] "" make ;
@@ -58,7 +58,7 @@ PRIVATE>
PRIVATE>
-: url-decode ( str -- str )
+: url-decode ( str -- decoded )
[ 0 swap url-decode-iter ] "" make utf8 decode ;
<PRIVATE
From a3dcbb43a979a9060a954d8dd6eaf6d39c51e4fe Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 19 Sep 2008 16:36:31 -0500
Subject: [PATCH 08/14] Fix validation-messages tag
---
basis/furnace/actions/actions.factor | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)
diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor
index cce098f208..6e55ca44a0 100755
--- a/basis/furnace/actions/actions.factor
+++ b/basis/furnace/actions/actions.factor
@@ -14,7 +14,8 @@ html.elements
html.components
html.components
html.templates.chloe
-html.templates.chloe.syntax ;
+html.templates.chloe.syntax
+html.templates.chloe.compiler ;
IN: furnace.actions
SYMBOL: params
@@ -29,7 +30,8 @@ SYMBOL: rest
</ul>
] unless-empty ;
-CHLOE: validation-messages drop render-validation-messages ;
+CHLOE: validation-messages
+ drop [ render-validation-messages ] [code] ;
TUPLE: action rest authorize init display validate submit ;
From 0f284816c1fd90cbd7d09bbeb8b090022bdf7771 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 19 Sep 2008 16:37:27 -0500
Subject: [PATCH 09/14] Fix docs
---
core/sequences/sequences-docs.factor | 8 +++++---
1 file changed, 5 insertions(+), 3 deletions(-)
diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor
index 789837ea47..b8be31c55c 100755
--- a/core/sequences/sequences-docs.factor
+++ b/core/sequences/sequences-docs.factor
@@ -1356,16 +1356,18 @@ ARTICLE: "sequences-slices" "Subsequences and slices"
"A " { $emphasis "slice" } " is a virtual sequence which presents as view of a subsequence of an underlying sequence:"
{ $subsection slice }
{ $subsection slice? }
-"Creating slices:"
+"Extracting a slice:"
{ $subsection <slice> }
{ $subsection head-slice }
{ $subsection tail-slice }
-{ $subsection but-last-slice }
-{ $subsection rest-slice }
{ $subsection head-slice* }
{ $subsection tail-slice* }
+"Removing the first or last element:"
+{ $subsection rest-slice }
+{ $subsection but-last-slice }
"Taking a sequence apart into a head and a tail:"
{ $subsection unclip-slice }
+{ $subsection unclip-last-slice }
{ $subsection cut-slice }
"A utility for words which use slices as iterators:"
{ $subsection <flat-slice> } ;
From 7b8be1222f87475b8aae1dd648aa369542d6fe70 Mon Sep 17 00:00:00 2001
From: "U-WSCHLIEP-PC\\wschliep" <wschliep@wschliep-pc.(none)>
Date: Fri, 19 Sep 2008 18:32:49 -0400
Subject: [PATCH 10/14] irc.client: Got rid of the annoying 100% CPU
---
extra/irc/client/client.factor | 13 ++++++-------
1 file changed, 6 insertions(+), 7 deletions(-)
mode change 100644 => 100755 extra/irc/client/client.factor
diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor
old mode 100644
new mode 100755
index 2474fd643a..76382edf1b
--- a/extra/irc/client/client.factor
+++ b/extra/irc/client/client.factor
@@ -91,8 +91,6 @@ SYMBOL: current-irc-client
: irc-send ( irc-message -- ) irc> out-messages>> mailbox-put ;
: listener> ( name -- listener/f ) irc> listeners>> at ;
-: maybe-mailbox-get ( mailbox quot: ( irc-message -- ) -- )
- [ dup mailbox-empty? [ drop 0.1 sleep ] ] dip '[ mailbox-get @ ] if ; inline
GENERIC: to-listener ( message obj -- )
@@ -294,14 +292,14 @@ DEFER: (connect-irc)
[ (reader-loop) ] [ handle-disconnect ] recover t ;
: writer-loop ( -- ? )
- irc> out-messages>> [ handle-outgoing-irc ] maybe-mailbox-get t ;
+ irc> out-messages>> mailbox-get handle-outgoing-irc t ;
! ======================================
! Processing loops
! ======================================
: in-multiplexer-loop ( -- ? )
- irc> in-messages>> [ handle-incoming-irc ] maybe-mailbox-get t ;
+ irc> in-messages>> mailbox-get handle-incoming-irc t ;
: strings>privmsg ( name string -- privmsg )
privmsg new [ (>>trailing) ] keep [ (>>name) ] keep ;
@@ -314,9 +312,10 @@ DEFER: (connect-irc)
: listener-loop ( name -- ? )
dup listener> [
- out-messages>> [ maybe-annotate-with-name
- irc> out-messages>> mailbox-put ] with
- maybe-mailbox-get t
+ out-messages>> mailbox-get
+ maybe-annotate-with-name
+ irc> out-messages>> mailbox-put
+ t
] [ drop f ] if* ;
: spawn-irc-loop ( quot: ( -- ? ) name -- )
From 19b2f6a6f31c70c77a51959d008f2d536267c4f3 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 19 Sep 2008 17:48:32 -0500
Subject: [PATCH 11/14] Fix farkup tests
---
basis/farkup/farkup-tests.factor | 6 ++----
1 file changed, 2 insertions(+), 4 deletions(-)
diff --git a/basis/farkup/farkup-tests.factor b/basis/farkup/farkup-tests.factor
index cc032913b7..571d333359 100644
--- a/basis/farkup/farkup-tests.factor
+++ b/basis/farkup/farkup-tests.factor
@@ -11,13 +11,11 @@ link-no-follow? off
[ "Baz" ] [ "Baz" simple-link-title ] unit-test
[ ] [
- "abcd-*strong*\nasdifj\nweouh23ouh23"
- "paragraph" \ farkup rule parse drop
+ "abcd-*strong*\nasdifj\nweouh23ouh23" parse-farkup drop
] unit-test
[ ] [
- "abcd-*strong*\nasdifj\nweouh23ouh23\n"
- "paragraph" \ farkup rule parse drop
+ "abcd-*strong*\nasdifj\nweouh23ouh23\n" parse-farkup drop
] unit-test
[ "<p>a-b</p>" ] [ "a-b" convert-farkup ] unit-test
From 9643ad1b9ea1bf829c71029daa24c34eca6b2a05 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 19 Sep 2008 17:54:34 -0500
Subject: [PATCH 12/14] work for lookahead
---
unfinished/regexp/dfa/dfa.factor | 1 -
unfinished/regexp/transition-tables/transition-tables.factor | 5 +++++
unfinished/regexp/traversal/traversal.factor | 4 ++++
3 files changed, 9 insertions(+), 1 deletion(-)
diff --git a/unfinished/regexp/dfa/dfa.factor b/unfinished/regexp/dfa/dfa.factor
index 6f244dc8af..6200a1b3c0 100644
--- a/unfinished/regexp/dfa/dfa.factor
+++ b/unfinished/regexp/dfa/dfa.factor
@@ -27,7 +27,6 @@ IN: regexp.dfa
nfa-table>> transitions>>
[ at keys ] curry map concat
eps swap remove ;
- ! dup t member? [ t swap remove t suffix ] when ;
: add-todo-state ( state regexp -- )
2dup visited-states>> key? [
diff --git a/unfinished/regexp/transition-tables/transition-tables.factor b/unfinished/regexp/transition-tables/transition-tables.factor
index 82e2db8496..1c9a3e3001 100644
--- a/unfinished/regexp/transition-tables/transition-tables.factor
+++ b/unfinished/regexp/transition-tables/transition-tables.factor
@@ -32,7 +32,12 @@ TUPLE: transition-table transitions start-state final-states ;
H{ } clone >>transitions
H{ } clone >>final-states ;
+: maybe-initialize-key ( key hashtable -- )
+ 2dup key? [ 2drop ] [ H{ } clone -rot set-at ] if ;
+
: set-transition ( transition hash -- )
+ #! set the state as a key
+ 2dup [ to>> ] dip maybe-initialize-key
[ [ to>> ] [ obj>> ] [ from>> ] tri ] dip
2dup at* [ 2nip insert-at ]
[ drop >r >r H{ } clone [ insert-at ] keep r> r> set-at ] if ;
diff --git a/unfinished/regexp/traversal/traversal.factor b/unfinished/regexp/traversal/traversal.factor
index 752323de91..cfc97aff29 100644
--- a/unfinished/regexp/traversal/traversal.factor
+++ b/unfinished/regexp/traversal/traversal.factor
@@ -43,6 +43,10 @@ TUPLE: dfa-traverser
dup save-final-state
] when text-finished? ;
+: print-flags ( dfa-traverser -- dfa-traverser )
+ dup [ current-state>> ] [ traversal-flags>> ] bi
+ ;
+
: increment-state ( dfa-traverser state -- dfa-traverser )
[
[ 1+ ] change-current-index dup current-state>> >>last-state
From 57df3b9ee54f3515fcf3b95268d5931db34897dc Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 19 Sep 2008 18:46:54 -0500
Subject: [PATCH 13/14] Check template modification time, recompile if changed
---
basis/html/templates/chloe/chloe.factor | 47 +++++++++++++------
.../templates/chloe/compiler/compiler.factor | 30 ++++++++----
2 files changed, 53 insertions(+), 24 deletions(-)
diff --git a/basis/html/templates/chloe/chloe.factor b/basis/html/templates/chloe/chloe.factor
index 5fe53fc7a5..cc51bd05d3 100644
--- a/basis/html/templates/chloe/chloe.factor
+++ b/basis/html/templates/chloe/chloe.factor
@@ -1,9 +1,9 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sequences combinators kernel fry
-namespaces make classes.tuple assocs splitting words arrays
-memoize io io.files io.encodings.utf8 io.streams.string
-unicode.case mirrors math urls present multiline quotations xml
+namespaces make classes.tuple assocs splitting words arrays io
+io.files io.encodings.utf8 io.streams.string unicode.case
+mirrors math urls present multiline quotations xml logging
xml.data
html.forms
html.elements
@@ -89,21 +89,40 @@ CHLOE-TUPLE: choice
CHLOE-TUPLE: checkbox
CHLOE-TUPLE: code
-: read-template ( chloe -- xml )
- path>> ".xml" append utf8 <file-reader> read-xml ;
+SYMBOL: template-cache
-MEMO: template-quot ( chloe -- quot )
- read-template compile-template ;
+H{ } template-cache set-global
-MEMO: nested-template-quot ( chloe -- quot )
- read-template compile-nested-template ;
+TUPLE: cached-template path last-modified quot ;
-: reset-templates ( -- )
- { template-quot nested-template-quot } [ reset-memoized ] each ;
+: load-template ( chloe -- cached-template )
+ path>> ".xml" append
+ [ ]
+ [ file-info modified>> ]
+ [ utf8 <file-reader> read-xml compile-template ] tri
+ \ cached-template boa ;
+
+\ load-template DEBUG add-input-logging
+
+: cached-template ( chloe -- cached-template/f )
+ template-cache get at* [
+ [
+ [ path>> file-info modified>> ]
+ [ last-modified>> ]
+ bi =
+ ] keep and
+ ] when ;
+
+: template-quot ( chloe -- quot )
+ dup cached-template [ ] [
+ [ load-template dup ] keep
+ template-cache get set-at
+ ] ?if quot>> ;
+
+: reset-cache ( -- )
+ template-cache get clear-assoc ;
M: chloe call-template*
- nested-template? get
- [ nested-template-quot ] [ template-quot ] if
- assert-depth ;
+ template-quot assert-depth ;
INSTANCE: chloe template
diff --git a/basis/html/templates/chloe/compiler/compiler.factor b/basis/html/templates/chloe/compiler/compiler.factor
index f32923f620..aa741ebf9f 100644
--- a/basis/html/templates/chloe/compiler/compiler.factor
+++ b/basis/html/templates/chloe/compiler/compiler.factor
@@ -3,7 +3,7 @@
USING: assocs namespaces make kernel sequences accessors
combinators strings splitting io io.streams.string present
xml.writer xml.data xml.entities html.forms
-html.templates.chloe.syntax ;
+html.templates html.templates.chloe.syntax ;
IN: html.templates.chloe.compiler
: chloe-attrs-only ( assoc -- assoc' )
@@ -98,9 +98,6 @@ DEFER: compile-element
reset-buffer
] [ ] make ; inline
-: compile-nested-template ( xml -- quot )
- [ compile-element ] with-compiler ;
-
: compile-chunk ( seq -- )
[ compile-element ] each ;
@@ -121,12 +118,25 @@ DEFER: compile-element
: compile-with-scope ( quot -- )
compile-quot [ with-scope ] [code] ; inline
+: if-not-nested ( quot -- )
+ nested-template? get swap unless ; inline
+
+: compile-prologue ( xml -- )
+ [
+ [ before>> compile-chunk ]
+ [ prolog>> [ write-prolog ] [code-with] ]
+ bi
+ ] compile-quot
+ [ if-not-nested ] [code] ;
+
+: compile-epilogue ( xml -- )
+ [ after>> compile-chunk ] compile-quot
+ [ if-not-nested ] [code] ;
+
: compile-template ( xml -- quot )
[
- {
- [ prolog>> [ write-prolog ] [code-with] ]
- [ before>> compile-chunk ]
- [ compile-element ]
- [ after>> compile-chunk ]
- } cleave
+ [ compile-prologue ]
+ [ compile-element ]
+ [ compile-epilogue ]
+ tri
] with-compiler ;
From 6b5af35cb608312801ec4a3c8e05b3272e974afe Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 20 Sep 2008 03:33:46 -0500
Subject: [PATCH 14/14] reset-templates no longer needed
---
basis/html/templates/chloe/chloe-tests.factor | 2 --
extra/websites/concatenative/concatenative.factor | 1 -
2 files changed, 3 deletions(-)
diff --git a/basis/html/templates/chloe/chloe-tests.factor b/basis/html/templates/chloe/chloe-tests.factor
index 9eb4a5709c..3fd0d00712 100644
--- a/basis/html/templates/chloe/chloe-tests.factor
+++ b/basis/html/templates/chloe/chloe-tests.factor
@@ -4,8 +4,6 @@ namespaces xml html.components html.forms
splitting unicode.categories furnace accessors ;
IN: html.templates.chloe.tests
-reset-templates
-
: run-template
with-string-writer [ "\r\n\t" member? not ] filter
"?>" split1 nip ; inline
diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor
index a35358ae6b..dfb7ff400f 100644
--- a/extra/websites/concatenative/concatenative.factor
+++ b/extra/websites/concatenative/concatenative.factor
@@ -69,7 +69,6 @@ SYMBOL: key-file
SYMBOL: dh-file
: common-configuration ( -- )
- reset-templates
"concatenative.org" 25 <inet> smtp-server set-global
"noreply@concatenative.org" lost-password-from set-global
"website@concatenative.org" insomniac-sender set-global