From 4f6ae2dee6bff6af2c3af5a8c1afbceb6108c1d2 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 11 Sep 2008 18:15:48 -0700
Subject: [PATCH 01/87] Adding support for MacVim.
---
basis/editors/macvim/authors.txt | 1 +
basis/editors/macvim/macvim.factor | 13 +++++++++++++
basis/editors/macvim/summary.txt | 1 +
basis/editors/macvim/tags.txt | 1 +
4 files changed, 16 insertions(+)
create mode 100644 basis/editors/macvim/authors.txt
create mode 100755 basis/editors/macvim/macvim.factor
create mode 100644 basis/editors/macvim/summary.txt
create mode 100644 basis/editors/macvim/tags.txt
diff --git a/basis/editors/macvim/authors.txt b/basis/editors/macvim/authors.txt
new file mode 100644
index 0000000000..e091bb8164
--- /dev/null
+++ b/basis/editors/macvim/authors.txt
@@ -0,0 +1 @@
+John Benediktsson
diff --git a/basis/editors/macvim/macvim.factor b/basis/editors/macvim/macvim.factor
new file mode 100755
index 0000000000..b5f864dcd0
--- /dev/null
+++ b/basis/editors/macvim/macvim.factor
@@ -0,0 +1,13 @@
+USING: definitions io.launcher kernel math math.parser parser
+namespaces prettyprint editors make ;
+
+IN: editors.macvim
+
+: macvim-location ( file line -- )
+ drop
+ [ "open" , "-a" , "MacVim", , ] { } make
+ try-process ;
+
+[ macvim-location ] edit-hook set-global
+
+
diff --git a/basis/editors/macvim/summary.txt b/basis/editors/macvim/summary.txt
new file mode 100644
index 0000000000..894d635b47
--- /dev/null
+++ b/basis/editors/macvim/summary.txt
@@ -0,0 +1 @@
+MacVim editor integration
diff --git a/basis/editors/macvim/tags.txt b/basis/editors/macvim/tags.txt
new file mode 100644
index 0000000000..6bf68304bb
--- /dev/null
+++ b/basis/editors/macvim/tags.txt
@@ -0,0 +1 @@
+unportable
From b1231476c50f65af2936d1bd3e4d6bfefab1316d Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 11 Sep 2008 18:15:59 -0700
Subject: [PATCH 02/87] Adding support for TextEdit.
---
basis/editors/textedit/authors.txt | 1 +
basis/editors/textedit/summary.txt | 1 +
basis/editors/textedit/tags.txt | 1 +
basis/editors/textedit/textedit.factor | 13 +++++++++++++
4 files changed, 16 insertions(+)
create mode 100644 basis/editors/textedit/authors.txt
create mode 100644 basis/editors/textedit/summary.txt
create mode 100644 basis/editors/textedit/tags.txt
create mode 100755 basis/editors/textedit/textedit.factor
diff --git a/basis/editors/textedit/authors.txt b/basis/editors/textedit/authors.txt
new file mode 100644
index 0000000000..e091bb8164
--- /dev/null
+++ b/basis/editors/textedit/authors.txt
@@ -0,0 +1 @@
+John Benediktsson
diff --git a/basis/editors/textedit/summary.txt b/basis/editors/textedit/summary.txt
new file mode 100644
index 0000000000..1d72d10db0
--- /dev/null
+++ b/basis/editors/textedit/summary.txt
@@ -0,0 +1 @@
+TextEdit editor integration
diff --git a/basis/editors/textedit/tags.txt b/basis/editors/textedit/tags.txt
new file mode 100644
index 0000000000..6bf68304bb
--- /dev/null
+++ b/basis/editors/textedit/tags.txt
@@ -0,0 +1 @@
+unportable
diff --git a/basis/editors/textedit/textedit.factor b/basis/editors/textedit/textedit.factor
new file mode 100755
index 0000000000..6942e24534
--- /dev/null
+++ b/basis/editors/textedit/textedit.factor
@@ -0,0 +1,13 @@
+USING: definitions io.launcher kernel math math.parser parser
+namespaces prettyprint editors make ;
+
+IN: editors.textedit
+
+: textedit-location ( file line -- )
+ drop
+ [ "open" , "-a" , "TextEdit", , ] { } make
+ try-process ;
+
+[ textedit-location ] edit-hook set-global
+
+
From 571794ba057b403c1cdf23d99c033fbe9614a54e Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 11 Sep 2008 18:16:35 -0700
Subject: [PATCH 03/87] Initial version of printf.
---
extra/printf/authors.txt | 1 +
extra/printf/printf-tests.factor | 79 ++++++++++++++++++
extra/printf/printf.factor | 135 +++++++++++++++++++++++++++++++
3 files changed, 215 insertions(+)
create mode 100644 extra/printf/authors.txt
create mode 100644 extra/printf/printf-tests.factor
create mode 100644 extra/printf/printf.factor
diff --git a/extra/printf/authors.txt b/extra/printf/authors.txt
new file mode 100644
index 0000000000..e091bb8164
--- /dev/null
+++ b/extra/printf/authors.txt
@@ -0,0 +1 @@
+John Benediktsson
diff --git a/extra/printf/printf-tests.factor b/extra/printf/printf-tests.factor
new file mode 100644
index 0000000000..b2a49573f7
--- /dev/null
+++ b/extra/printf/printf-tests.factor
@@ -0,0 +1,79 @@
+! Copyright (C) 2008 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: kernel printf tools.test ;
+
+[ t ] [ "10" [ "%d" { 10 } sprintf ] call = ] unit-test
+
+[ t ] [ "123.456" [ "%f" { 123.456 } sprintf ] call = ] unit-test
+
+[ t ] [ "123.10" [ "%01.2f" { 123.1 } sprintf ] call = ] unit-test
+
+[ t ] [ "1.2345" [ "%.4f" { 1.23456789 } sprintf ] call = ] unit-test
+
+[ t ] [ " 1.23" [ "%6.2f" { 1.23456789 } sprintf ] call = ] unit-test
+
+[ t ] [ "3.625e+8" [ "%.3e" { 362525200 } sprintf ] call = ] unit-test
+
+[ t ] [ "2008-09-10"
+ [ "%04d-%02d-%02d" { 2008 9 10 } sprintf ] call = ] unit-test
+
+[ t ] [ "Hello, World!"
+ [ "%s" { "Hello, World!" } sprintf ] call = ] unit-test
+
+[ t ] [ "printf test"
+ [ "printf test" { } sprintf ] call = ] unit-test
+
+[ t ] [ "char a = 'a'"
+ [ "char %c = 'a'" { CHAR: a } sprintf ] call = ] unit-test
+
+[ t ] [ "00" [ "%02x" { HEX: 0 } sprintf ] call = ] unit-test
+
+[ t ] [ "ff" [ "%02x" { HEX: ff } sprintf ] call = ] unit-test
+
+[ t ] [ "signed -3 = unsigned 4294967293 = hex fffffffd"
+ [ "signed %d = unsigned %u = hex %x" { -3 -3 -3 } sprintf ] call = ] unit-test
+
+[ t ] [ "0 message(s)"
+ [ "%d %s(s)%" { 0 "message" } sprintf ] call = ] unit-test
+
+[ t ] [ "0 message(s) with %"
+ [ "%d %s(s) with %%" { 0 "message" } sprintf ] call = ] unit-test
+
+[ t ] [ "justif: \"left \""
+ [ "justif: \"%-10s\"" { "left" } sprintf ] call = ] unit-test
+
+[ t ] [ "justif: \" right\""
+ [ "justif: \"%10s\"" { "right" } sprintf ] call = ] unit-test
+
+[ t ] [ " 3: 0003 zero padded"
+ [ " 3: %04d zero padded" { 3 } sprintf ] call = ] unit-test
+
+[ t ] [ " 3: 3 left justif"
+ [ " 3: %-4d left justif" { 3 } sprintf ] call = ] unit-test
+
+[ t ] [ " 3: 3 right justif"
+ [ " 3: %4d right justif" { 3 } sprintf ] call = ] unit-test
+
+[ t ] [ " -3: -003 zero padded"
+ [ " -3: %04d zero padded" { -3 } sprintf ] call = ] unit-test
+
+[ t ] [ " -3: -3 left justif"
+ [ " -3: %-4d left justif" { -3 } sprintf ] call = ] unit-test
+
+[ t ] [ " -3: -3 right justif"
+ [ " -3: %4d right justif" { -3 } sprintf ] call = ] unit-test
+
+[ t ] [ "There are 10 monkeys in the kitchen"
+ [ "There are %d monkeys in the %s" { 10 "kitchen" } sprintf ] call = ] unit-test
+
+[ f ] [ "%d" [ "%d" 10 sprintf ] call = ] unit-test
+
+[ t ] [ "[monkey]" [ "[%s]" { "monkey" } sprintf ] call = ] unit-test
+[ t ] [ "[ monkey]" [ "[%10s]" { "monkey" } sprintf ] call = ] unit-test
+[ t ] [ "[monkey ]" [ "[%-10s]" { "monkey" } sprintf ] call = ] unit-test
+[ t ] [ "[0000monkey]" [ "[%010s]" { "monkey" } sprintf ] call = ] unit-test
+[ t ] [ "[####monkey]" [ "[%'#10s]" { "monkey" } sprintf ] call = ] unit-test
+[ t ] [ "[many monke]" [ "[%10.10s]" { "many monkeys" } sprintf ] call = ] unit-test
+
+
diff --git a/extra/printf/printf.factor b/extra/printf/printf.factor
new file mode 100644
index 0000000000..8638afcca6
--- /dev/null
+++ b/extra/printf/printf.factor
@@ -0,0 +1,135 @@
+! Copyright (C) 2008 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: ascii io io.encodings.ascii io.files present kernel strings
+math math.parser unicode.case sequences combinators
+accessors namespaces prettyprint vectors ;
+
+IN: printf
+
+! FIXME: Handle invalid formats properly.
+! FIXME: Handle incomplete formats properly.
+! FIXME: Deal only with CHAR rather than converting to { CHAR } ?
+! FIXME: Understand intermediate allocations that are happening...
+
+TUPLE: state type pad align width decimals neg loop ;
+
+SYMBOL: current
+
+SYMBOL: args
+
+<PRIVATE
+
+: start-% ( -- )
+ state new
+ CHAR: s >>type
+ CHAR: \s >>pad
+ CHAR: r >>align
+ 0 >>width
+ -1 >>decimals
+ f >>neg
+ CHAR: % >>loop
+ current set ;
+
+: stop-% ( -- )
+ current off ;
+
+: render ( s -- s )
+ >vector
+
+ current get decimals>> 0 >= current get type>> CHAR: f = and
+ [ CHAR: . swap dup rot swap index current get decimals>> + 1 + dup rot swap
+ CHAR: 0 pad-right swap 0 swap rot <slice> ] when
+
+ current get align>> CHAR: l =
+
+ [ current get neg>> [ { CHAR: - } prepend ] when
+ current get width>> CHAR: \s pad-right ]
+
+ [ current get pad>> CHAR: \s =
+ [ current get neg>> [ { CHAR: - } prepend ] when
+ current get width>> current get pad>> pad-left ]
+ [ current get width>> current get neg>> [ 1 - ] when
+ current get pad>> pad-left
+ current get neg>> [ { CHAR: - } prepend ] when ] if
+ ] if
+
+ current get decimals>> 0 >= current get type>> CHAR: f = not and
+ [ current get align>> CHAR: l =
+ [ current get decimals>> CHAR: \s pad-right ]
+ [ current get decimals>> current get pad>> pad-left ] if
+ current get decimals>> head-slice ] when
+ >string ;
+
+: loop-% ( c -- s )
+ current get swap
+ {
+ { CHAR: % [ drop stop-% "%" ] }
+ { CHAR: ' [ CHAR: ' >>loop drop "" ] }
+ { CHAR: . [ CHAR: . >>loop 0 >>decimals drop "" ] }
+ { CHAR: - [ CHAR: l >>align drop "" ] }
+ { CHAR: 0 [ dup width>> 0 = [ CHAR: 0 >>pad ] when
+ [ 10 * 0 + ] change-width drop "" ] }
+ { CHAR: 1 [ [ 10 * 1 + ] change-width drop "" ] }
+ { CHAR: 2 [ [ 10 * 2 + ] change-width drop "" ] }
+ { CHAR: 3 [ [ 10 * 3 + ] change-width drop "" ] }
+ { CHAR: 4 [ [ 10 * 4 + ] change-width drop "" ] }
+ { CHAR: 5 [ [ 10 * 5 + ] change-width drop "" ] }
+ { CHAR: 6 [ [ 10 * 6 + ] change-width drop "" ] }
+ { CHAR: 7 [ [ 10 * 7 + ] change-width drop "" ] }
+ { CHAR: 8 [ [ 10 * 8 + ] change-width drop "" ] }
+ { CHAR: 9 [ [ 10 * 9 + ] change-width drop "" ] }
+ { CHAR: d [ CHAR: d >>type drop
+ args get pop >fixnum
+ dup 0 < [ current get t >>neg drop ] when
+ abs present render stop-% ] }
+ { CHAR: f [ CHAR: f >>type drop
+ args get pop >float
+ dup 0 < [ current get t >>neg drop ] when
+ abs present render stop-% ] }
+ { CHAR: s [ CHAR: s >>type drop
+ args get pop present render stop-% ] }
+ { CHAR: c [ CHAR: c >>type 1 >>width drop
+ 1 args get pop <string> stop-% ] }
+ { CHAR: x [ CHAR: x >>type drop
+ args get pop >hex present render stop-% ] }
+ { CHAR: X [ CHAR: X >>type drop
+ args get pop >hex present >upper render stop-% ] }
+ [ drop drop stop-% "" ]
+ } case ;
+
+: loop-. ( c -- s )
+ dup digit? current get swap
+ [ swap CHAR: 0 - swap [ 10 * + ] change-decimals drop "" ]
+ [ CHAR: % >>loop drop loop-% ] if ;
+
+: loop-' ( c -- s )
+ current get swap >>pad CHAR: % >>loop drop "" ;
+
+: loop- ( c -- s )
+ dup CHAR: % = [ drop start-% "" ] [ 1 swap <string> ] if ;
+
+: loop ( c -- s )
+ current get
+ [ current get loop>>
+ {
+ { CHAR: % [ loop-% ] }
+ { CHAR: ' [ loop-' ] }
+ { CHAR: . [ loop-. ] }
+ [ drop stop-% loop- ] ! FIXME: RAISE ERROR
+ } case ]
+ [ loop- ] if ;
+
+PRIVATE>
+
+: sprintf ( fmt args -- str )
+ [ >vector reverse args set
+ V{ } swap [ loop append ] each >string ] with-scope ;
+
+: printf ( fmt args -- )
+ sprintf print ;
+
+: fprintf ( path fmt args -- )
+ rot ascii [ sprintf write flush ] with-file-appender ;
+
+
From ccac749a70c336305fb98bf99967055986dcfe44 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Sun, 14 Sep 2008 10:04:04 -0700
Subject: [PATCH 04/87] Adding support for fry quotations.
---
misc/factor.vim | 22 +++++++++++-----------
1 file changed, 11 insertions(+), 11 deletions(-)
diff --git a/misc/factor.vim b/misc/factor.vim
index d1c46cee0b..90a3d46d50 100644
--- a/misc/factor.vim
+++ b/misc/factor.vim
@@ -131,18 +131,18 @@ syn region factorStackEffect start=/\<(\>/ end=/\<)\>/ contained
"adapted from lisp.vim
if exists("g:factor_norainbow")
- syn region factorQuotation matchgroup=factorDelimiter start=/\<\[\>/ matchgroup=factorDelimiter end=/\<\]\>/ contains=ALL
+ syn region factorQuotation0 matchgroup=factorDelimiter start=/\<\'\?\[\>/ matchgroup=factorDelimiter end=/\<\]\>/ contains=ALL
else
- syn region factorQuotation0 matchgroup=hlLevel0 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation1,factorArray1
- syn region factorQuotation1 contained matchgroup=hlLevel1 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation2,factorArray2
- syn region factorQuotation2 contained matchgroup=hlLevel2 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation3,factorArray3
- syn region factorQuotation3 contained matchgroup=hlLevel3 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation4,factorArray4
- syn region factorQuotation4 contained matchgroup=hlLevel4 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation5,factorArray5
- syn region factorQuotation5 contained matchgroup=hlLevel5 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation6,factorArray6
- syn region factorQuotation6 contained matchgroup=hlLevel6 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation7,factorArray7
- syn region factorQuotation7 contained matchgroup=hlLevel7 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation8,factorArray8
- syn region factorQuotation8 contained matchgroup=hlLevel8 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation9,factorArray9
- syn region factorQuotation9 contained matchgroup=hlLevel9 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation0,factorArray0
+ syn region factorQuotation0 matchgroup=hlLevel0 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation1,factorArray1
+ syn region factorQuotation1 contained matchgroup=hlLevel1 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation2,factorArray2
+ syn region factorQuotation2 contained matchgroup=hlLevel2 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation3,factorArray3
+ syn region factorQuotation3 contained matchgroup=hlLevel3 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation4,factorArray4
+ syn region factorQuotation4 contained matchgroup=hlLevel4 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation5,factorArray5
+ syn region factorQuotation5 contained matchgroup=hlLevel5 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation6,factorArray6
+ syn region factorQuotation6 contained matchgroup=hlLevel6 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation7,factorArray7
+ syn region factorQuotation7 contained matchgroup=hlLevel7 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation8,factorArray8
+ syn region factorQuotation8 contained matchgroup=hlLevel8 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation9,factorArray9
+ syn region factorQuotation9 contained matchgroup=hlLevel9 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation0,factorArray0
endif
if exists("g:factor_norainbow")
From 55003480bc3b22645572d5006d6f5826f6c50e89 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Tue, 16 Sep 2008 17:26:28 -0700
Subject: [PATCH 05/87] Changing printf to use peg.ebnf.
---
extra/printf/printf-tests.factor | 79 +++++++-----
extra/printf/printf.factor | 209 ++++++++++++++-----------------
2 files changed, 141 insertions(+), 147 deletions(-)
diff --git a/extra/printf/printf-tests.factor b/extra/printf/printf-tests.factor
index b2a49573f7..05c33956d9 100644
--- a/extra/printf/printf-tests.factor
+++ b/extra/printf/printf-tests.factor
@@ -3,77 +3,90 @@
USING: kernel printf tools.test ;
-[ t ] [ "10" [ "%d" { 10 } sprintf ] call = ] unit-test
+[ t ] [ "10" [ { 10 } "%d" sprintf ] call = ] unit-test
-[ t ] [ "123.456" [ "%f" { 123.456 } sprintf ] call = ] unit-test
+[ t ] [ "123.456" [ { 123.456 } "%f" sprintf ] call = ] unit-test
-[ t ] [ "123.10" [ "%01.2f" { 123.1 } sprintf ] call = ] unit-test
+[ t ] [ "123.10" [ { 123.1 } "%01.2f" sprintf ] call = ] unit-test
-[ t ] [ "1.2345" [ "%.4f" { 1.23456789 } sprintf ] call = ] unit-test
+[ t ] [ "1.2345" [ { 1.23456789 } "%.4f" sprintf ] call = ] unit-test
-[ t ] [ " 1.23" [ "%6.2f" { 1.23456789 } sprintf ] call = ] unit-test
+[ t ] [ " 1.23" [ { 1.23456789 } "%6.2f" sprintf ] call = ] unit-test
-[ t ] [ "3.625e+8" [ "%.3e" { 362525200 } sprintf ] call = ] unit-test
+[ t ] [ "1.234e+08" [ { 123400000 } "%e" sprintf ] call = ] unit-test
+
+[ t ] [ "1.234567e+08" [ { 123456700 } "%e" sprintf ] call = ] unit-test
+
+[ t ] [ "3.625e+08" [ { 362525200 } "%.3e" sprintf ] call = ] unit-test
+
+[ t ] [ "2.5e-03" [ { 0.0025 } "%e" sprintf ] call = ] unit-test
+
+[ t ] [ "2.5E-03" [ { 0.0025 } "%E" sprintf ] call = ] unit-test
+
+[ t ] [ "ff" [ { HEX: ff } "%x" sprintf ] call = ] unit-test
+
+[ t ] [ "FF" [ { HEX: ff } "%X" sprintf ] call = ] unit-test
+
+[ t ] [ "0f" [ { HEX: f } "%02x" sprintf ] call = ] unit-test
+
+[ t ] [ "0F" [ { HEX: f } "%02X" sprintf ] call = ] unit-test
[ t ] [ "2008-09-10"
- [ "%04d-%02d-%02d" { 2008 9 10 } sprintf ] call = ] unit-test
+ [ { 2008 9 10 } "%04d-%02d-%02d" sprintf ] call = ] unit-test
[ t ] [ "Hello, World!"
- [ "%s" { "Hello, World!" } sprintf ] call = ] unit-test
+ [ { "Hello, World!" } "%s" sprintf ] call = ] unit-test
[ t ] [ "printf test"
- [ "printf test" { } sprintf ] call = ] unit-test
+ [ { } "printf test" sprintf ] call = ] unit-test
[ t ] [ "char a = 'a'"
- [ "char %c = 'a'" { CHAR: a } sprintf ] call = ] unit-test
+ [ { CHAR: a } "char %c = 'a'" sprintf ] call = ] unit-test
-[ t ] [ "00" [ "%02x" { HEX: 0 } sprintf ] call = ] unit-test
+[ t ] [ "00" [ { HEX: 0 } "%02x" sprintf ] call = ] unit-test
-[ t ] [ "ff" [ "%02x" { HEX: ff } sprintf ] call = ] unit-test
-
-[ t ] [ "signed -3 = unsigned 4294967293 = hex fffffffd"
- [ "signed %d = unsigned %u = hex %x" { -3 -3 -3 } sprintf ] call = ] unit-test
+[ t ] [ "ff" [ { HEX: ff } "%02x" sprintf ] call = ] unit-test
[ t ] [ "0 message(s)"
- [ "%d %s(s)%" { 0 "message" } sprintf ] call = ] unit-test
+ [ { 0 "message" } "%d %s(s)%" sprintf ] call = ] unit-test
[ t ] [ "0 message(s) with %"
- [ "%d %s(s) with %%" { 0 "message" } sprintf ] call = ] unit-test
+ [ { 0 "message" } "%d %s(s) with %%" sprintf ] call = ] unit-test
[ t ] [ "justif: \"left \""
- [ "justif: \"%-10s\"" { "left" } sprintf ] call = ] unit-test
+ [ { "left" } "justif: \"%-10s\"" sprintf ] call = ] unit-test
[ t ] [ "justif: \" right\""
- [ "justif: \"%10s\"" { "right" } sprintf ] call = ] unit-test
+ [ { "right" } "justif: \"%10s\"" sprintf ] call = ] unit-test
[ t ] [ " 3: 0003 zero padded"
- [ " 3: %04d zero padded" { 3 } sprintf ] call = ] unit-test
+ [ { 3 } " 3: %04d zero padded" sprintf ] call = ] unit-test
[ t ] [ " 3: 3 left justif"
- [ " 3: %-4d left justif" { 3 } sprintf ] call = ] unit-test
+ [ { 3 } " 3: %-4d left justif" sprintf ] call = ] unit-test
[ t ] [ " 3: 3 right justif"
- [ " 3: %4d right justif" { 3 } sprintf ] call = ] unit-test
+ [ { 3 } " 3: %4d right justif" sprintf ] call = ] unit-test
[ t ] [ " -3: -003 zero padded"
- [ " -3: %04d zero padded" { -3 } sprintf ] call = ] unit-test
+ [ { -3 } " -3: %04d zero padded" sprintf ] call = ] unit-test
[ t ] [ " -3: -3 left justif"
- [ " -3: %-4d left justif" { -3 } sprintf ] call = ] unit-test
+ [ { -3 } " -3: %-4d left justif" sprintf ] call = ] unit-test
[ t ] [ " -3: -3 right justif"
- [ " -3: %4d right justif" { -3 } sprintf ] call = ] unit-test
+ [ { -3 } " -3: %4d right justif" sprintf ] call = ] unit-test
[ t ] [ "There are 10 monkeys in the kitchen"
- [ "There are %d monkeys in the %s" { 10 "kitchen" } sprintf ] call = ] unit-test
+ [ { 10 "kitchen" } "There are %d monkeys in the %s" sprintf ] call = ] unit-test
-[ f ] [ "%d" [ "%d" 10 sprintf ] call = ] unit-test
+[ f ] [ "%d" [ { 10 } "%d" sprintf ] call = ] unit-test
-[ t ] [ "[monkey]" [ "[%s]" { "monkey" } sprintf ] call = ] unit-test
-[ t ] [ "[ monkey]" [ "[%10s]" { "monkey" } sprintf ] call = ] unit-test
-[ t ] [ "[monkey ]" [ "[%-10s]" { "monkey" } sprintf ] call = ] unit-test
-[ t ] [ "[0000monkey]" [ "[%010s]" { "monkey" } sprintf ] call = ] unit-test
-[ t ] [ "[####monkey]" [ "[%'#10s]" { "monkey" } sprintf ] call = ] unit-test
-[ t ] [ "[many monke]" [ "[%10.10s]" { "many monkeys" } sprintf ] call = ] unit-test
+[ t ] [ "[monkey]" [ { "monkey" } "[%s]" sprintf ] call = ] unit-test
+[ t ] [ "[ monkey]" [ { "monkey" } "[%10s]" sprintf ] call = ] unit-test
+[ t ] [ "[monkey ]" [ { "monkey" } "[%-10s]" sprintf ] call = ] unit-test
+[ t ] [ "[0000monkey]" [ { "monkey" } "[%010s]" sprintf ] call = ] unit-test
+[ t ] [ "[####monkey]" [ { "monkey" } "[%'#10s]" sprintf ] call = ] unit-test
+[ t ] [ "[many monke]" [ { "many monkeys" } "[%10.10s]" sprintf ] call = ] unit-test
diff --git a/extra/printf/printf.factor b/extra/printf/printf.factor
index 8638afcca6..f46d08adfa 100644
--- a/extra/printf/printf.factor
+++ b/extra/printf/printf.factor
@@ -1,135 +1,116 @@
! Copyright (C) 2008 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
-USING: ascii io io.encodings.ascii io.files present kernel strings
-math math.parser unicode.case sequences combinators
-accessors namespaces prettyprint vectors ;
+USING: io io.encodings.ascii io.files
+kernel sequences strings vectors math math.parser macros
+fry peg.ebnf unicode.case arrays prettyprint quotations ;
-IN: printf
-
-! FIXME: Handle invalid formats properly.
-! FIXME: Handle incomplete formats properly.
-! FIXME: Deal only with CHAR rather than converting to { CHAR } ?
-! FIXME: Understand intermediate allocations that are happening...
-
-TUPLE: state type pad align width decimals neg loop ;
-
-SYMBOL: current
-
-SYMBOL: args
+IN: printf
<PRIVATE
-: start-% ( -- )
- state new
- CHAR: s >>type
- CHAR: \s >>pad
- CHAR: r >>align
- 0 >>width
- -1 >>decimals
- f >>neg
- CHAR: % >>loop
- current set ;
+: compose-all ( seq -- quot )
+ [ ] [ compose ] reduce ;
-: stop-% ( -- )
- current off ;
+: write-all ( seq -- quot )
+ [ [ write ] append ] map ;
-: render ( s -- s )
- >vector
+: append-all ( seq -- string )
+ SBUF" " [ dip swap append ] reduce ;
- current get decimals>> 0 >= current get type>> CHAR: f = and
- [ CHAR: . swap dup rot swap index current get decimals>> + 1 + dup rot swap
- CHAR: 0 pad-right swap 0 swap rot <slice> ] when
+: apply-format ( params quot -- params string )
+ [ dup pop ] dip call ;
- current get align>> CHAR: l =
+: fix-neg ( string -- string )
+ dup CHAR: 0 swap index 0 =
+ [ dup CHAR: - swap index dup
+ [ swap remove-nth "-" prepend ]
+ [ drop ] if ] when ;
- [ current get neg>> [ { CHAR: - } prepend ] when
- current get width>> CHAR: \s pad-right ]
+: >digits ( string -- digits )
+ dup length 0 > [ >string string>number ] [ drop 0 ] if ;
- [ current get pad>> CHAR: \s =
- [ current get neg>> [ { CHAR: - } prepend ] when
- current get width>> current get pad>> pad-left ]
- [ current get width>> current get neg>> [ 1 - ] when
- current get pad>> pad-left
- current get neg>> [ { CHAR: - } prepend ] when ] if
- ] if
+: zero-pad ( string digits -- string )
+ swap dup
+ CHAR: . swap index rot + 1+
+ dup rot swap
+ CHAR: 0 pad-right
+ swap head-slice ;
- current get decimals>> 0 >= current get type>> CHAR: f = not and
- [ current get align>> CHAR: l =
- [ current get decimals>> CHAR: \s pad-right ]
- [ current get decimals>> current get pad>> pad-left ] if
- current get decimals>> head-slice ] when
- >string ;
-
-: loop-% ( c -- s )
- current get swap
- {
- { CHAR: % [ drop stop-% "%" ] }
- { CHAR: ' [ CHAR: ' >>loop drop "" ] }
- { CHAR: . [ CHAR: . >>loop 0 >>decimals drop "" ] }
- { CHAR: - [ CHAR: l >>align drop "" ] }
- { CHAR: 0 [ dup width>> 0 = [ CHAR: 0 >>pad ] when
- [ 10 * 0 + ] change-width drop "" ] }
- { CHAR: 1 [ [ 10 * 1 + ] change-width drop "" ] }
- { CHAR: 2 [ [ 10 * 2 + ] change-width drop "" ] }
- { CHAR: 3 [ [ 10 * 3 + ] change-width drop "" ] }
- { CHAR: 4 [ [ 10 * 4 + ] change-width drop "" ] }
- { CHAR: 5 [ [ 10 * 5 + ] change-width drop "" ] }
- { CHAR: 6 [ [ 10 * 6 + ] change-width drop "" ] }
- { CHAR: 7 [ [ 10 * 7 + ] change-width drop "" ] }
- { CHAR: 8 [ [ 10 * 8 + ] change-width drop "" ] }
- { CHAR: 9 [ [ 10 * 9 + ] change-width drop "" ] }
- { CHAR: d [ CHAR: d >>type drop
- args get pop >fixnum
- dup 0 < [ current get t >>neg drop ] when
- abs present render stop-% ] }
- { CHAR: f [ CHAR: f >>type drop
- args get pop >float
- dup 0 < [ current get t >>neg drop ] when
- abs present render stop-% ] }
- { CHAR: s [ CHAR: s >>type drop
- args get pop present render stop-% ] }
- { CHAR: c [ CHAR: c >>type 1 >>width drop
- 1 args get pop <string> stop-% ] }
- { CHAR: x [ CHAR: x >>type drop
- args get pop >hex present render stop-% ] }
- { CHAR: X [ CHAR: X >>type drop
- args get pop >hex present >upper render stop-% ] }
- [ drop drop stop-% "" ]
- } case ;
-
-: loop-. ( c -- s )
- dup digit? current get swap
- [ swap CHAR: 0 - swap [ 10 * + ] change-decimals drop "" ]
- [ CHAR: % >>loop drop loop-% ] if ;
-
-: loop-' ( c -- s )
- current get swap >>pad CHAR: % >>loop drop "" ;
-
-: loop- ( c -- s )
- dup CHAR: % = [ drop start-% "" ] [ 1 swap <string> ] if ;
-
-: loop ( c -- s )
- current get
- [ current get loop>>
- {
- { CHAR: % [ loop-% ] }
- { CHAR: ' [ loop-' ] }
- { CHAR: . [ loop-. ] }
- [ drop stop-% loop- ] ! FIXME: RAISE ERROR
- } case ]
- [ loop- ] if ;
+: >exponential ( n -- base exp )
+ 0
+ [ swap dup [ 10.0 > ] keep 1.0 < or ]
+ [ dup 10.0 >
+ [ 10.0 / [ 1+ ] dip swap ]
+ [ 10.0 * [ 1- ] dip swap ] if
+ ] [ swap ] while
+ [ number>string ] dip
+ dup abs number>string 2 CHAR: 0 pad-left
+ [ 0 < [ "-" ] [ "+" ] if ] dip append
+ "e" prepend ;
PRIVATE>
-: sprintf ( fmt args -- str )
- [ >vector reverse args set
- V{ } swap [ loop append ] each >string ] with-scope ;
+EBNF: parse-format-string
-: printf ( fmt args -- )
- sprintf print ;
+plain-text = (!("%").)+ => [[ >string 1quotation ]]
+
+percents = "%" => [[ '[ "%" ] ]]
+
+pad-zero = "0" => [[ CHAR: 0 ]]
+pad-char = "'" (.) => [[ second ]]
+pad-char_ = (pad-zero|pad-char)? => [[ CHAR: \s or 1quotation ]]
+pad-align = ("-")? => [[ [ [ pad-right ] ] [ [ pad-left ] ] if ]]
+pad-width = ([0-9])* => [[ >digits 1quotation ]]
+pad = (pad-align) (pad-char_) (pad-width) => [[ reverse compose-all ]]
+
+width = "." ([0-9])* => [[ second >digits '[ _ head-slice ] ]]
+width_ = (width)? => [[ [ ] or ]]
+
+digits = "." ([0-9])* => [[ second >digits '[ _ zero-pad ] ]]
+digits_ = (digits)? => [[ [ ] or ]]
+
+fmt-c = "c" => [[ [ 1string ] ]]
+fmt-C = "C" => [[ [ 1string >upper ] ]]
+chars = (fmt-c|fmt-C) => [[ '[ _ apply-format ] ]]
+
+fmt-s = "s" => [[ [ ] ]]
+fmt-S = "S" => [[ [ >upper ] ]]
+strings = (pad) (width_) (fmt-s|fmt-S) => [[ reverse compose-all '[ _ apply-format ] ]]
+
+fmt-d = "d" => [[ [ >fixnum number>string ] ]]
+decimals = fmt-d
+
+fmt-e = "e" => [[ [ >exponential ] ]]
+fmt-E = "E" => [[ [ >exponential >upper ] ]]
+exps = (digits_) (fmt-e|fmt-E) => [[ reverse [ swap ] join [ swap append ] append ]]
+
+fmt-f = "f" => [[ [ >float number>string ] ]]
+floats = (digits_) (fmt-f) => [[ reverse compose-all ]]
+
+fmt-x = "x" => [[ [ >hex ] ]]
+fmt-X = "X" => [[ [ >hex >upper ] ]]
+hex = fmt-x | fmt-X
+
+numbers = (pad) (decimals|floats|hex|exps) => [[ reverse compose-all [ fix-neg ] append '[ _ apply-format ] ]]
+
+formats = "%" (chars|strings|numbers|percents) => [[ second ]]
+
+text = (formats|plain-text)*
+
+;EBNF
+
+MACRO: printf ( format-string -- )
+ parse-format-string
+ '[ reverse >vector _ write-all compose-all call drop ] ;
+
+MACRO: sprintf ( format-string -- )
+ parse-format-string
+ '[ reverse >vector _ append-all >string swap drop ] ;
+
+MACRO: fprintf ( format-string -- )
+ parse-format-string
+ '[ reverse >vector _ write-all compose-all rot ascii [ call ] with-file-appender drop ] ;
-: fprintf ( path fmt args -- )
- rot ascii [ sprintf write flush ] with-file-appender ;
From 8fd119ede2c51c0bcccbbefc7fc86924dcaaad88 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 17 Sep 2008 10:36:06 -0500
Subject: [PATCH 06/87] fail, these words are used
---
basis/db/types/types.factor | 6 ++++++
1 file changed, 6 insertions(+)
diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor
index 7397694ba5..476d82a1e2 100755
--- a/basis/db/types/types.factor
+++ b/basis/db/types/types.factor
@@ -117,6 +117,12 @@ ERROR: no-sql-type ;
modifiers>> [ lookup-modifier ] map " " join
[ "" ] [ " " prepend ] if-empty ;
+: join-space ( string1 string2 -- new-string )
+ " " swap 3append ;
+
+: paren ( string -- new-string )
+ "(" swap ")" 3append ;
+
HOOK: bind% db ( spec -- )
HOOK: bind# db ( spec obj -- )
From 3e1303f784115b466e3b224290ab0b37a77e80b0 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Wed, 17 Sep 2008 09:22:48 -0700
Subject: [PATCH 07/87] Adding documentation for printf, and improvements based
on IRC feedback.
---
extra/printf/printf-docs.factor | 47 ++++++++++++++++++
extra/printf/printf-tests.factor | 84 +++++++++++++++++---------------
extra/printf/printf.factor | 57 +++++++++-------------
3 files changed, 117 insertions(+), 71 deletions(-)
create mode 100755 extra/printf/printf-docs.factor
diff --git a/extra/printf/printf-docs.factor b/extra/printf/printf-docs.factor
new file mode 100755
index 0000000000..c1638f0d23
--- /dev/null
+++ b/extra/printf/printf-docs.factor
@@ -0,0 +1,47 @@
+
+USING: help.syntax help.markup kernel prettyprint sequences strings ;
+
+IN: printf
+
+HELP: printf
+{ $values { "format-string" string } }
+{ $description
+ "Writes the arguments formatted according to the format string."
+ { $table
+ { "%%" "Single %" "" }
+ { "%Wd" "Integer W digits wide (e.g., \"1234\")" "fixnum" }
+ { "%W.De" "Scientific notation" "fixnum, float" }
+ { "%W.DE" "Scientific notation" "fixnum, float" }
+ { "%W.Df" "Fixed format" "fixnum, float" }
+ { "%Wx" "Hexadecimal" "hex" }
+ { "%WX" "Hexadecimal uppercase" "hex" }
+ { "%W.Ds" "String format" "string" }
+ { "%W.DS" "String format uppercase" "string" }
+ { "%c" "Character format" "char" }
+ { "%C" "Character format uppercase" "char" }
+ }
+}
+{ $examples
+ { $example
+ "USING: printf ;"
+ "{ 123 } \"%05d\" printf"
+ "00123" }
+ { $example
+ "USING: printf ;"
+ "{ HEX: ff } \"04X\" printf"
+ "00FF" }
+ { $example
+ "USING: printf ;"
+ "{ 1.23456789 } \"%.3f\" printf"
+ "1.234" }
+ { $example
+ "USING: printf ;"
+ "{ 1234567890 } \"%.5e\" printf"
+ "1.23456e+09" }
+} ;
+
+HELP: sprintf
+{ $values { "params" sequence } { "format-string" string } { "result" string } }
+{ $description "Returns the arguments formatted according to the format string as a result string." }
+{ $see-also printf } ;
+
diff --git a/extra/printf/printf-tests.factor b/extra/printf/printf-tests.factor
index 05c33956d9..7d89b35ae9 100644
--- a/extra/printf/printf-tests.factor
+++ b/extra/printf/printf-tests.factor
@@ -3,90 +3,98 @@
USING: kernel printf tools.test ;
-[ t ] [ "10" [ { 10 } "%d" sprintf ] call = ] unit-test
+[ "%s" printf ] must-infer
-[ t ] [ "123.456" [ { 123.456 } "%f" sprintf ] call = ] unit-test
+[ t ] [ "10" { 10 } "%d" sprintf = ] unit-test
-[ t ] [ "123.10" [ { 123.1 } "%01.2f" sprintf ] call = ] unit-test
+[ t ] [ "123.456" { 123.456 } "%f" sprintf = ] unit-test
-[ t ] [ "1.2345" [ { 1.23456789 } "%.4f" sprintf ] call = ] unit-test
+[ t ] [ "123.10" { 123.1 } "%01.2f" sprintf = ] unit-test
-[ t ] [ " 1.23" [ { 1.23456789 } "%6.2f" sprintf ] call = ] unit-test
+[ t ] [ "1.2345" { 1.23456789 } "%.4f" sprintf = ] unit-test
-[ t ] [ "1.234e+08" [ { 123400000 } "%e" sprintf ] call = ] unit-test
+[ t ] [ " 1.23" { 1.23456789 } "%6.2f" sprintf = ] unit-test
-[ t ] [ "1.234567e+08" [ { 123456700 } "%e" sprintf ] call = ] unit-test
+[ t ] [ "1.234e+08" { 123400000 } "%e" sprintf = ] unit-test
-[ t ] [ "3.625e+08" [ { 362525200 } "%.3e" sprintf ] call = ] unit-test
+[ t ] [ "1.234567e+08" { 123456700 } "%e" sprintf = ] unit-test
-[ t ] [ "2.5e-03" [ { 0.0025 } "%e" sprintf ] call = ] unit-test
+[ t ] [ "3.625e+08" { 362525200 } "%.3e" sprintf = ] unit-test
-[ t ] [ "2.5E-03" [ { 0.0025 } "%E" sprintf ] call = ] unit-test
+[ t ] [ "2.5e-03" { 0.0025 } "%e" sprintf = ] unit-test
-[ t ] [ "ff" [ { HEX: ff } "%x" sprintf ] call = ] unit-test
+[ t ] [ "2.5E-03" { 0.0025 } "%E" sprintf = ] unit-test
-[ t ] [ "FF" [ { HEX: ff } "%X" sprintf ] call = ] unit-test
+[ t ] [ "ff" { HEX: ff } "%x" sprintf = ] unit-test
-[ t ] [ "0f" [ { HEX: f } "%02x" sprintf ] call = ] unit-test
+[ t ] [ "FF" { HEX: ff } "%X" sprintf = ] unit-test
-[ t ] [ "0F" [ { HEX: f } "%02X" sprintf ] call = ] unit-test
+[ t ] [ "0f" { HEX: f } "%02x" sprintf = ] unit-test
+
+[ t ] [ "0F" { HEX: f } "%02X" sprintf = ] unit-test
[ t ] [ "2008-09-10"
- [ { 2008 9 10 } "%04d-%02d-%02d" sprintf ] call = ] unit-test
+ { 2008 9 10 } "%04d-%02d-%02d" sprintf = ] unit-test
[ t ] [ "Hello, World!"
- [ { "Hello, World!" } "%s" sprintf ] call = ] unit-test
+ { "Hello, World!" } "%s" sprintf = ] unit-test
[ t ] [ "printf test"
- [ { } "printf test" sprintf ] call = ] unit-test
+ { } "printf test" sprintf = ] unit-test
[ t ] [ "char a = 'a'"
- [ { CHAR: a } "char %c = 'a'" sprintf ] call = ] unit-test
+ { CHAR: a } "char %c = 'a'" sprintf = ] unit-test
-[ t ] [ "00" [ { HEX: 0 } "%02x" sprintf ] call = ] unit-test
+[ t ] [ "00" { HEX: 0 } "%02x" sprintf = ] unit-test
-[ t ] [ "ff" [ { HEX: ff } "%02x" sprintf ] call = ] unit-test
+[ t ] [ "ff" { HEX: ff } "%02x" sprintf = ] unit-test
[ t ] [ "0 message(s)"
- [ { 0 "message" } "%d %s(s)%" sprintf ] call = ] unit-test
+ { 0 "message" } "%d %s(s)%" sprintf = ] unit-test
[ t ] [ "0 message(s) with %"
- [ { 0 "message" } "%d %s(s) with %%" sprintf ] call = ] unit-test
+ { 0 "message" } "%d %s(s) with %%" sprintf = ] unit-test
[ t ] [ "justif: \"left \""
- [ { "left" } "justif: \"%-10s\"" sprintf ] call = ] unit-test
+ { "left" } "justif: \"%-10s\"" sprintf = ] unit-test
[ t ] [ "justif: \" right\""
- [ { "right" } "justif: \"%10s\"" sprintf ] call = ] unit-test
+ { "right" } "justif: \"%10s\"" sprintf = ] unit-test
[ t ] [ " 3: 0003 zero padded"
- [ { 3 } " 3: %04d zero padded" sprintf ] call = ] unit-test
+ { 3 } " 3: %04d zero padded" sprintf = ] unit-test
[ t ] [ " 3: 3 left justif"
- [ { 3 } " 3: %-4d left justif" sprintf ] call = ] unit-test
+ { 3 } " 3: %-4d left justif" sprintf = ] unit-test
[ t ] [ " 3: 3 right justif"
- [ { 3 } " 3: %4d right justif" sprintf ] call = ] unit-test
+ { 3 } " 3: %4d right justif" sprintf = ] unit-test
[ t ] [ " -3: -003 zero padded"
- [ { -3 } " -3: %04d zero padded" sprintf ] call = ] unit-test
+ { -3 } " -3: %04d zero padded" sprintf = ] unit-test
[ t ] [ " -3: -3 left justif"
- [ { -3 } " -3: %-4d left justif" sprintf ] call = ] unit-test
+ { -3 } " -3: %-4d left justif" sprintf = ] unit-test
[ t ] [ " -3: -3 right justif"
- [ { -3 } " -3: %4d right justif" sprintf ] call = ] unit-test
+ { -3 } " -3: %4d right justif" sprintf = ] unit-test
[ t ] [ "There are 10 monkeys in the kitchen"
- [ { 10 "kitchen" } "There are %d monkeys in the %s" sprintf ] call = ] unit-test
+ { 10 "kitchen" } "There are %d monkeys in the %s" sprintf = ] unit-test
-[ f ] [ "%d" [ { 10 } "%d" sprintf ] call = ] unit-test
+[ f ] [ "%d" { 10 } "%d" sprintf = ] unit-test
+
+[ t ] [ "[monkey]" { "monkey" } "[%s]" sprintf = ] unit-test
+
+[ t ] [ "[ monkey]" { "monkey" } "[%10s]" sprintf = ] unit-test
+
+[ t ] [ "[monkey ]" { "monkey" } "[%-10s]" sprintf = ] unit-test
+
+[ t ] [ "[0000monkey]" { "monkey" } "[%010s]" sprintf = ] unit-test
+
+[ t ] [ "[####monkey]" { "monkey" } "[%'#10s]" sprintf = ] unit-test
+
+[ t ] [ "[many monke]" { "many monkeys" } "[%10.10s]" sprintf = ] unit-test
-[ t ] [ "[monkey]" [ { "monkey" } "[%s]" sprintf ] call = ] unit-test
-[ t ] [ "[ monkey]" [ { "monkey" } "[%10s]" sprintf ] call = ] unit-test
-[ t ] [ "[monkey ]" [ { "monkey" } "[%-10s]" sprintf ] call = ] unit-test
-[ t ] [ "[0000monkey]" [ { "monkey" } "[%010s]" sprintf ] call = ] unit-test
-[ t ] [ "[####monkey]" [ { "monkey" } "[%'#10s]" sprintf ] call = ] unit-test
-[ t ] [ "[many monke]" [ { "many monkeys" } "[%10.10s]" sprintf ] call = ] unit-test
diff --git a/extra/printf/printf.factor b/extra/printf/printf.factor
index f46d08adfa..b24e58d6cc 100644
--- a/extra/printf/printf.factor
+++ b/extra/printf/printf.factor
@@ -1,8 +1,8 @@
! Copyright (C) 2008 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
-USING: io io.encodings.ascii io.files
-kernel sequences strings vectors math math.parser macros
+USING: io io.encodings.ascii io.files io.streams.string
+kernel sequences splitting strings vectors math math.parser macros
fry peg.ebnf unicode.case arrays prettyprint quotations ;
IN: printf
@@ -15,11 +15,8 @@ IN: printf
: write-all ( seq -- quot )
[ [ write ] append ] map ;
-: append-all ( seq -- string )
- SBUF" " [ dip swap append ] reduce ;
-
: apply-format ( params quot -- params string )
- [ dup pop ] dip call ;
+ [ dup pop ] dip call ; inline
: fix-neg ( string -- string )
dup CHAR: 0 swap index 0 =
@@ -28,14 +25,13 @@ IN: printf
[ drop ] if ] when ;
: >digits ( string -- digits )
- dup length 0 > [ >string string>number ] [ drop 0 ] if ;
+ [ 0 ] [ string>number ] if-empty ;
-: zero-pad ( string digits -- string )
- swap dup
- CHAR: . swap index rot + 1+
- dup rot swap
- CHAR: 0 pad-right
- swap head-slice ;
+: max-digits ( string digits -- string )
+ [ "." split1 ] dip [ CHAR: 0 pad-right ] [ head-slice ] bi "." swap 3append ;
+
+: max-width ( string length -- string )
+ [ dup length ] dip [ > ] keep swap [ head-slice >string ] [ drop ] if ;
: >exponential ( n -- base exp )
0
@@ -49,8 +45,6 @@ IN: printf
[ 0 < [ "-" ] [ "+" ] if ] dip append
"e" prepend ;
-PRIVATE>
-
EBNF: parse-format-string
plain-text = (!("%").)+ => [[ >string 1quotation ]]
@@ -62,31 +56,31 @@ pad-char = "'" (.) => [[ second ]]
pad-char_ = (pad-zero|pad-char)? => [[ CHAR: \s or 1quotation ]]
pad-align = ("-")? => [[ [ [ pad-right ] ] [ [ pad-left ] ] if ]]
pad-width = ([0-9])* => [[ >digits 1quotation ]]
-pad = (pad-align) (pad-char_) (pad-width) => [[ reverse compose-all ]]
+pad = pad-align pad-char_ pad-width => [[ reverse compose-all ]]
-width = "." ([0-9])* => [[ second >digits '[ _ head-slice ] ]]
+width = "." ([0-9])* => [[ second >digits '[ _ max-width ] ]]
width_ = (width)? => [[ [ ] or ]]
-digits = "." ([0-9])* => [[ second >digits '[ _ zero-pad ] ]]
+digits = "." ([0-9])* => [[ second >digits '[ _ max-digits ] ]]
digits_ = (digits)? => [[ [ ] or ]]
fmt-c = "c" => [[ [ 1string ] ]]
fmt-C = "C" => [[ [ 1string >upper ] ]]
-chars = (fmt-c|fmt-C) => [[ '[ _ apply-format ] ]]
+chars = (fmt-c | fmt-C) => [[ '[ _ apply-format ] ]]
fmt-s = "s" => [[ [ ] ]]
fmt-S = "S" => [[ [ >upper ] ]]
-strings = (pad) (width_) (fmt-s|fmt-S) => [[ reverse compose-all '[ _ apply-format ] ]]
+strings = pad width_ (fmt-s | fmt-S) => [[ reverse compose-all '[ _ apply-format ] ]]
fmt-d = "d" => [[ [ >fixnum number>string ] ]]
decimals = fmt-d
fmt-e = "e" => [[ [ >exponential ] ]]
fmt-E = "E" => [[ [ >exponential >upper ] ]]
-exps = (digits_) (fmt-e|fmt-E) => [[ reverse [ swap ] join [ swap append ] append ]]
+exps = digits_ (fmt-e | fmt-E) => [[ reverse [ swap ] join [ swap append ] append ]]
fmt-f = "f" => [[ [ >float number>string ] ]]
-floats = (digits_) (fmt-f) => [[ reverse compose-all ]]
+floats = digits_ fmt-f => [[ reverse compose-all ]]
fmt-x = "x" => [[ [ >hex ] ]]
fmt-X = "X" => [[ [ >hex >upper ] ]]
@@ -96,21 +90,18 @@ numbers = (pad) (decimals|floats|hex|exps) => [[ reverse compose-all [ fix-neg
formats = "%" (chars|strings|numbers|percents) => [[ second ]]
-text = (formats|plain-text)*
+text = (formats|plain-text)* => [[ write-all compose-all ]]
;EBNF
+PRIVATE>
+
MACRO: printf ( format-string -- )
- parse-format-string
- '[ reverse >vector _ write-all compose-all call drop ] ;
-
-MACRO: sprintf ( format-string -- )
- parse-format-string
- '[ reverse >vector _ append-all >string swap drop ] ;
-
-MACRO: fprintf ( format-string -- )
- parse-format-string
- '[ reverse >vector _ write-all compose-all rot ascii [ call ] with-file-appender drop ] ;
+ parse-format-string '[ reverse >vector @ drop ] ;
+: sprintf ( params format-string -- result )
+ [ printf ] with-string-writer ;
+: fprintf ( filename params format-string -- )
+ rot ascii [ printf ] with-file-appender ;
From 53197ddb1b03ddc1564e6922bde4aac42ca47971 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Wed, 17 Sep 2008 10:59:44 -0700
Subject: [PATCH 08/87] Adding more docs for printf.
---
extra/printf/printf-docs.factor | 37 +++++++++++++++++++++++++--------
1 file changed, 28 insertions(+), 9 deletions(-)
diff --git a/extra/printf/printf-docs.factor b/extra/printf/printf-docs.factor
index c1638f0d23..21981b8b4a 100755
--- a/extra/printf/printf-docs.factor
+++ b/extra/printf/printf-docs.factor
@@ -6,20 +6,35 @@ IN: printf
HELP: printf
{ $values { "format-string" string } }
{ $description
- "Writes the arguments formatted according to the format string."
+ "Writes the arguments formatted according to the format string.\n"
{ $table
{ "%%" "Single %" "" }
- { "%Wd" "Integer W digits wide (e.g., \"1234\")" "fixnum" }
- { "%W.De" "Scientific notation" "fixnum, float" }
- { "%W.DE" "Scientific notation" "fixnum, float" }
- { "%W.Df" "Fixed format" "fixnum, float" }
- { "%Wx" "Hexadecimal" "hex" }
- { "%WX" "Hexadecimal uppercase" "hex" }
- { "%W.Ds" "String format" "string" }
- { "%W.DS" "String format uppercase" "string" }
+ { "%Pd" "Integer format" "fixnum" }
+ { "%P.De" "Scientific notation" "fixnum, float" }
+ { "%P.DE" "Scientific notation" "fixnum, float" }
+ { "%P.Df" "Fixed format" "fixnum, float" }
+ { "%Px" "Hexadecimal" "hex" }
+ { "%PX" "Hexadecimal uppercase" "hex" }
+ { "%P.Ds" "String format" "string" }
+ { "%P.DS" "String format uppercase" "string" }
{ "%c" "Character format" "char" }
{ "%C" "Character format uppercase" "char" }
}
+ "\n"
+ "Padding ('P') is used to specify the minimum width of the result string, the padding character, and the alignment. By default, the padding character defaults to a space and the alignment defaults to right-aligned. For example:\n"
+ { $list
+ "\"%5s\" formats a string padding with spaces up to 5 characters wide."
+ "\"%08d\" formats an integer padding with zeros up to 3 characters wide."
+ "\"%'#5f\" formats a float padding with '#' up to 3 characters wide."
+ "\"%-10d\" formats an integer to 10 characters wide and left-aligns."
+ }
+ "\n"
+ "Digits ('D') is used to specify the maximum digits in the result string. For example:\n"
+ { $list
+ "\"%.3s\" formats a string to truncate at 3 characters (from the left)."
+ "\"%.10f\" formats a float to pad-right with zeros up to 10 digits beyond the decimal point."
+ "\"%.5E\" formats a float into scientific notation with zeros up to 5 digits beyond the decimal point, but before the exponent."
+ }
}
{ $examples
{ $example
@@ -38,6 +53,10 @@ HELP: printf
"USING: printf ;"
"{ 1234567890 } \"%.5e\" printf"
"1.23456e+09" }
+ { $example
+ "USING: printf ;"
+ "{ 12 } \"%'#4d\" printf"
+ "##12" }
} ;
HELP: sprintf
From affc0b4830246baaf16980968fa3db4406973c1e Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 17 Sep 2008 18:37:57 -0500
Subject: [PATCH 09/87] move some words to private, make stack effects for
slices contain explicit -slice
---
core/sequences/sequences.factor | 30 +++++++++++++++++++++++-------
1 file changed, 23 insertions(+), 7 deletions(-)
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 6cda7fc73f..376133b02d 100755
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -289,6 +289,8 @@ M: immutable-sequence clone-like like ;
: push-all ( src dest -- ) [ length ] [ copy ] bi ;
+<PRIVATE
+
: ((append)) ( seq1 seq2 accum -- accum )
[ >r over length r> copy ]
[ 0 swap copy ]
@@ -304,6 +306,8 @@ M: immutable-sequence clone-like like ;
[ ((append)) ] bi
] new-like ; inline
+PRIVATE>
+
: append ( seq1 seq2 -- newseq ) over (append) ;
: prepend ( seq1 seq2 -- newseq ) swap append ; inline
@@ -402,7 +406,7 @@ PRIVATE>
: 2map ( seq1 seq2 quot -- newseq )
pick 2map-as ; inline
-: 2change-each ( seq1 seq2 quot -- newseq )
+: 2change-each ( seq1 seq2 quot -- )
pick 2map-into ; inline
: 2all? ( seq1 seq2 quot -- ? )
@@ -543,6 +547,8 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
2over number=
[ 3drop ] [ [ nth swap ] [ set-nth ] bi ] if ; inline
+<PRIVATE
+
: (delete) ( elt store scan seq -- elt store scan seq )
2dup length < [
3dup move
@@ -550,6 +556,8 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
[ >r >r 1+ r> r> ] unless >r 1+ r> (delete)
] when ;
+PRIVATE>
+
: delete ( elt seq -- ) 0 0 rot (delete) nip set-length drop ;
: prefix ( seq elt -- newseq )
@@ -568,6 +576,8 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
: pop* ( seq -- ) [ length 1- ] [ shorten ] bi ;
+<PRIVATE
+
: move-backward ( shift from to seq -- )
2over number= [
2drop 2drop
@@ -591,6 +601,8 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
>r >r over - r> r> move-backward
] if ;
+PRIVATE>
+
: open-slice ( shift from seq -- )
pick zero? [
3drop
@@ -650,9 +662,13 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
first like
] if-empty ;
+<PRIVATE
+
: joined-length ( seq glue -- n )
>r dup sum-lengths swap length 1 [-] r> length * + ;
+PRIVATE>
+
: join ( seq glue -- newseq )
[
2dup joined-length over new-resizable spin
@@ -671,7 +687,7 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
: pad-right ( seq n elt -- padded )
[ append ] padding ;
-: shorter? ( seq1 seq2 -- ? ) >r length r> length < ;
+: shorter? ( seq1 seq2 -- ? ) [ length ] bi@ < ;
: head? ( seq begin -- ? )
2dup shorter? [
@@ -687,7 +703,7 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
tuck length tail-slice* sequence=
] if ;
-: cut-slice ( seq n -- before after )
+: cut-slice ( seq n -- before-slice after-slice )
[ head-slice ] [ tail-slice ] 2bi ;
: insert-nth ( elt n seq -- seq' )
@@ -695,7 +711,7 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
: midpoint@ ( seq -- n ) length 2/ ; inline
-: halves ( seq -- first second )
+: halves ( seq -- first-slice second-slice )
dup midpoint@ cut-slice ;
: binary-reduce ( seq start quot: ( elt1 elt2 -- newelt ) -- value )
@@ -749,10 +765,10 @@ PRIVATE>
: unclip-last ( seq -- butlast last )
[ but-last ] [ peek ] bi ;
-: unclip-slice ( seq -- rest first )
+: unclip-slice ( seq -- rest-slice first )
[ rest-slice ] [ first ] bi ; inline
-: 2unclip-slice ( seq1 seq2 -- seq1' seq2' elt1 elt2 )
+: 2unclip-slice ( seq1 seq2 -- rest-slice1 rest-slice2 first1 first2 )
[ unclip-slice ] bi@ swapd ; inline
: map-reduce ( seq map-quot reduce-quot -- result )
@@ -763,7 +779,7 @@ PRIVATE>
[ [ 2unclip-slice ] dip [ call ] keep ] dip
compose 2reduce ; inline
-: unclip-last-slice ( seq -- butlast last )
+: unclip-last-slice ( seq -- butlast-slice last )
[ but-last-slice ] [ peek ] bi ; inline
: <flat-slice> ( seq -- slice )
From 0967d85f8569a079065e15d1e40e33a37707991b Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 17 Sep 2008 18:38:32 -0500
Subject: [PATCH 10/87] document the rest of the interesting words in sequences
---
core/sequences/sequences-docs.factor | 178 +++++++++++++++++++++++++--
1 file changed, 170 insertions(+), 8 deletions(-)
diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor
index f9c539f16a..789837ea47 100755
--- a/core/sequences/sequences-docs.factor
+++ b/core/sequences/sequences-docs.factor
@@ -42,7 +42,7 @@ $nl
HELP: nths
{ $values
- { "indices" null } { "seq" sequence }
+ { "indices" sequence } { "seq" sequence }
{ "seq'" sequence } }
{ $description "Ouptuts a sequence of elements from the input sequence indexed by the indices." }
{ $examples
@@ -264,7 +264,7 @@ HELP: reduce
HELP: reduce-index
{ $values
{ "seq" sequence } { "identity" object } { "quot" quotation } }
-{ $description "Combines successive elements of the sequence and their indices using a binary operation, and outputs the final result. On the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", the first element of the sequence, and its index, 0. On successive iterations, the first input is the result of the previous iteration, the second input is the corresponding element of the sequence, and the third is its index." }
+{ $description "Combines successive elements of the sequence and their indices binary operations, and outputs the final result. On the first iteration, the three inputs to the quotation are " { $snippet "identity" } ", the first element of the sequence, and its index, 0. On successive iterations, the first input is the result of the previous iteration, the second input is the corresponding element of the sequence, and the third is its index." }
{ $examples { $example "USING: sequences prettyprint math ;"
"{ 10 50 90 } 0 [ + + ] reduce-index ."
"153"
@@ -596,7 +596,8 @@ HELP: reverse
HELP: <reversed> ( seq -- reversed )
{ $values { "seq" sequence } { "reversed" "a new sequence" } }
-{ $description "Creates an instance of the " { $link reversed } " virtual sequence." } ;
+{ $description "Creates an instance of the " { $link reversed } " class." }
+{ $see-also "virtual-sequences" } ;
HELP: slice-error
{ $values { "str" "a reason" } }
@@ -786,7 +787,7 @@ HELP: tail?
{ delete-nth remove delete } related-words
HELP: cut-slice
-{ $values { "seq" sequence } { "n" "a non-negative integer" } { "before" sequence } { "after" "a slice" } }
+{ $values { "seq" sequence } { "n" "a non-negative integer" } { "before-slice" sequence } { "after-slice" "a slice" } }
{ $description "Outputs a pair of sequences, where " { $snippet "before" } " consists of the first " { $snippet "n" } " elements of " { $snippet "seq" } " and has the same type, while " { $snippet "after" } " is a slice of the remaining elements." }
{ $notes "Unlike " { $link cut } ", the run time of this word is proportional to the length of " { $snippet "before" } ", not " { $snippet "after" } ", so it is suitable for use in an iterative algorithm which cuts successive pieces off a sequence." } ;
@@ -823,7 +824,7 @@ HELP: unclip
} ;
HELP: unclip-slice
-{ $values { "seq" sequence } { "rest" slice } { "first" object } }
+{ $values { "seq" sequence } { "rest-slice" slice } { "first" object } }
{ $description "Outputs a tail sequence and the first element of " { $snippet "seq" } "; the tail sequence consists of all elements of " { $snippet "seq" } " but the first. Unlike " { $link unclip } ", this word does not make a copy of the input sequence, and runs in constant time." } ;
HELP: unclip-last
@@ -834,7 +835,7 @@ HELP: unclip-last
} ;
HELP: unclip-last-slice
-{ $values { "seq" sequence } { "butlast" slice } { "last" object } }
+{ $values { "seq" sequence } { "butlast-slice" slice } { "last" object } }
{ $description "Outputs a head sequence and the last element of " { $snippet "seq" } "; the head sequence consists of all elements of " { $snippet "seq" } " but the last Unlike " { $link unclip-last } ", this word does not make a copy of the input sequence, and runs in constant time." } ;
HELP: sum
@@ -1078,6 +1079,165 @@ HELP: virtual@
{ "n'" integer } { "seq'" sequence } }
{ $description "Part of the sequence protocol, this word translates the input index " { $snippet "n" } " into an index into the underlying storage returned by " { $link virtual-seq } "." } ;
+HELP: 2change-each
+{ $values
+ { "seq1" sequence } { "seq2" sequence } { "quot" quotation } }
+{ $description "Calls the quotation on subsequent pairs of objects from the two input sequences. The resulting computation replaces the element in the first sequence." }
+{ $examples { $example "USING: kernel math sequences prettyprint ;"
+ "{ 10 20 30 } dup { 60 70 80 } [ + ] 2change-each ."
+ "{ 70 90 110 }"
+} } ;
+
+HELP: 2map-reduce
+{ $values
+ { "seq1" sequence } { "seq2" sequence } { "map-quot" quotation } { "reduce-quot" quotation }
+ { "result" object } }
+{ $description "Unclips the first element of each sequence and calls " { $snippet "map-quot" } " on both objects. The result of this calculation is passed, along with the rest of both sequences, to " { $link 2reduce } ", with the computed object as the identity." }
+{ $examples { $example "USING: sequences prettyprint math ;"
+ "{ 10 30 50 } { 200 400 600 } [ + ] [ + ] 2map-reduce ."
+ "1290"
+} } ;
+
+HELP: 2pusher
+{ $values
+ { "quot" quotation }
+ { "quot" quotation } { "accum1" vector } { "accum2" vector } }
+{ $description "Creates two new vectors to accumultate values based on a predicate. The first vector accumulates values for which the predicate yields true; the second for false." } ;
+
+HELP: 2reverse-each
+{ $values
+ { "seq1" sequence } { "seq2" sequence } { "quot" quotation } }
+{ $description "Reverse the sequences using the " { $link <reversed> } " word and calls " { $link 2each } " on the reversed sequences." }
+{ $examples { $example "USING: sequences math prettyprint ;"
+ "{ 10 20 30 } { 1 2 3 } [ + . ] 2reverse-each"
+ "33\n22\n11"
+} } ;
+
+HELP: 2unclip-slice
+{ $values
+ { "seq1" sequence } { "seq2" sequence }
+ { "rest-slice1" sequence } { "rest-slice2" sequence } { "first1" object } { "first2" object } }
+{ $description "Unclips the first element of each sequence and leaves two slice elements and the two unclipped objects on the stack." }
+{ $examples { $example "USING: sequences prettyprint kernel arrays ;"
+ "{ 1 2 } { 3 4 } 2unclip-slice 4array [ . ] each"
+ "T{ slice { from 1 } { to 2 } { seq { 1 2 } } }\nT{ slice { from 1 } { to 2 } { seq { 3 4 } } }\n1\n3"
+} } ;
+
+HELP: accumulator
+{ $values
+ { "quot" quotation }
+ { "quot'" quotation } { "vec" vector } }
+{ $description "Creates a new quotation that pushes its result to a vector and outputs that vector on the stack." }
+{ $examples { $example "USING: sequences prettyprint kernel math ;"
+ "{ 1 2 } [ 30 + ] accumulator [ each ] dip ."
+ "V{ 31 32 }"
+} } ;
+
+HELP: binary-reduce
+{ $values
+ { "seq" sequence } { "start" integer } { "quot" quotation }
+ { "value" object } }
+{ $description "Like " { $link reduce } ", but splits the sequence in half recursively until each sequence is small enough, and calls the quotation on these smaller sequences. If the quotation computes values that depend on the size of their input, such as bignum arithmetic, then this algorithm can be more efficient than using " { $link reduce } "." }
+{ $examples "Computing factorial:"
+ { $example "USING: prettyprint sequences math ;"
+ "40 rest-slice 1 [ * ] binary-reduce ."
+ "20397882081197443358640281739902897356800000000" }
+} ;
+
+HELP: follow
+{ $values
+ { "obj" object } { "quot" quotation }
+ { "seq" sequence } }
+{ $description "Outputs a sequence containing the input object and all of the objects generated by successively feeding the result of the quotation called on the input object to the quotation recursuively. Objects yielded by the quotation are added to the output sequence until the quotation yields " { $link f } ", at which point the recursion terminates." }
+{ $examples "Get random numbers until zero is reached:"
+ { $unchecked-example
+ "USING: random sequences prettyprint math ;"
+ "100 [ random dup zero? [ drop f ] when ] follow ."
+ "{ 100 86 34 32 24 11 7 2 }"
+} } ;
+
+HELP: halves
+{ $values
+ { "seq" sequence }
+ { "first-slice" slice } { "second-slice" slice } }
+{ $description "Splits a sequence into two slices at the midpoint. If the sequence has an odd number of elements, the extra element is returned in the second slice." }
+{ $examples { $example "USING: arrays sequences prettyprint kernel ;"
+ "{ 1 2 3 4 5 } halves [ >array . ] bi@"
+ "{ 1 2 }\n{ 3 4 5 }"
+} } ;
+
+HELP: indices
+{ $values
+ { "obj" object } { "seq" sequence }
+ { "indices" sequence } }
+{ $description "Compares the input object to every element in the sequence and returns a vector containing the index of every position where the element was found." }
+{ $examples { $example "USING: sequences prettyprint ;"
+ "2 { 2 4 2 6 2 8 2 10 } indices ."
+ "V{ 0 2 4 6 }"
+} } ;
+
+HELP: insert-nth
+{ $values
+ { "elt" object } { "n" integer } { "seq" sequence }
+ { "seq'" sequence } }
+{ $description "Creates a new sequence where the " { $snippet "n" } "th index is set to the input object." }
+{ $examples { $example "USING: prettyprint sequences ;"
+ "40 3 { 10 20 30 50 } insert-nth ."
+ "{ 10 20 30 40 50 }"
+} } ;
+
+HELP: map-reduce
+{ $values
+ { "seq" sequence } { "map-quot" quotation } { "reduce-quot" quotation }
+ { "result" object } }
+{ $description "Unclips the first element of the sequence, calls " { $snippet "map-quot" } " on that element, and proceeds like a " { $link reduce } ", where the calculated element is the identity element and the rest of the sequence is the sequence to reduce." }
+{ $examples { $example "USING: sequences prettyprint math ;"
+ "{ 1 3 5 } [ sq ] [ + ] map-reduce ."
+ "35"
+} } ;
+
+HELP: new-like
+{ $values
+ { "len" integer } { "exemplar" "an exemplar sequence" } { "quot" quotation }
+ { "seq" sequence } }
+{ $description "Creates a new sequence of length " { $snippet "len" } " and calls the quotation with this sequence on the stack. The output of the quotation and the original exemplar are then passed to " { $link like } " so that the output sequence is the exemplar's type." } ;
+
+HELP: push-either
+{ $values
+ { "elt" object } { "quot" quotation } { "accum1" vector } { "accum2" vector } }
+{ $description "Pushes the input object onto one of the accumualators; the first if the quotation yields true, the second if false." } ;
+
+HELP: sequence-hashcode
+{ $values
+ { "n" integer } { "seq" sequence }
+ { "x" integer } }
+{ $description "Iterates over a sequence, computes a hashcode with " { $link hashcode* } " for each element, and combines them using " { $link sequence-hashcode-step } "." } ;
+
+HELP: sequence-hashcode-step
+{ $values
+ { "oldhash" integer } { "newpart" integer }
+ { "newhash" integer } }
+{ $description "An implementation word that computes a running hashcode of a sequence using some bit-twiddling. The resulting hashcode is always a fixnum." } ;
+
+HELP: short
+{ $values
+ { "seq" sequence } { "n" integer }
+ { "seq" sequence } { "n'" integer } }
+{ $description "Returns the input sequence and its length or " { $snippet "n" } ", whichever is less." }
+{ $examples { $example "USING: sequences kernel prettyprint ;"
+ "\"abcd\" 3 short [ . ] bi@"
+ "\"abcd\"\n3"
+} } ;
+
+HELP: shorten
+{ $values
+ { "n" integer } { "seq" sequence } }
+{ $description "Shortens a " { $link "growable" } " sequence to by " { $snippet "n" } " elements long." }
+{ $examples { $example "USING: sequences prettyprint kernel ;"
+ "V{ 1 2 3 4 5 } 3 over shorten ."
+ "V{ 1 2 3 }"
+} } ;
+
ARTICLE: "sequences-unsafe" "Unsafe sequence operations"
"The " { $link nth-unsafe } " and " { $link set-nth-unsafe } " sequence protocol bypasses bounds checks for increased performance."
$nl
@@ -1113,7 +1273,7 @@ ARTICLE: "sequence-protocol" "Sequence protocol"
{ $subsection new-resizable }
{ $see-also "sequences-unsafe" } ;
-ARTICLE: "sequences-virtual-protocol" "Virtual sequence protocol"
+ARTICLE: "virtual-sequences-protocol" "Virtual sequence protocol"
"Virtual sequences must know their length:"
{ $subsection length }
"The underlying sequence to look up a value in:"
@@ -1122,7 +1282,9 @@ ARTICLE: "sequences-virtual-protocol" "Virtual sequence protocol"
{ $subsection virtual@ } ;
ARTICLE: "virtual-sequences" "Virtual sequences"
-"Virtual sequences allow different ways of accessing a sequence without having to create a new sequence or a new data structure altogether. To do this, they translate the virtual index into a normal index into an underlying sequence using the " { $link "sequences-virtual-protocol" } "." ;
+"Virtual sequences allow different ways of accessing a sequence without having to create a new sequence or a new data structure altogether. To do this, they translate the virtual index into a normal index into an underlying sequence using the " { $link "virtual-sequences-protocol" } "."
+$nl
+"One current limitation of the virtual sequence protocol is that sequences must be indexed starting at zero." ;
ARTICLE: "sequences-integers" "Integer sequences and counted loops"
"Integers support the sequence protocol in a trivial fashion; a non-negative integer presents its non-negative predecessors as elements. For example, the integer 3, when viewed as a sequence, contains the elements 0, 1, and 2. This is very useful for performing counted loops."
From 6dde29e9c78a9de9eb678cff5b172831f387d2b5 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 17 Sep 2008 18:52:11 -0500
Subject: [PATCH 11/87] Reworking inline allocation codegen
---
unfinished/compiler/backend/backend.factor | 57 +---
.../compiler/backend/x86/sse2/sse2.factor | 20 +-
unfinished/compiler/backend/x86/x86.factor | 290 ++++++------------
.../compiler/cfg/builder/builder.factor | 47 ++-
.../cfg/instructions/instructions.factor | 20 +-
.../live-intervals/live-intervals.factor | 1 +
unfinished/compiler/cfg/stacks/stacks.factor | 66 ++--
.../compiler/cfg/templates/templates.factor | 19 +-
unfinished/compiler/codegen/codegen.factor | 84 ++++-
9 files changed, 274 insertions(+), 330 deletions(-)
diff --git a/unfinished/compiler/backend/backend.factor b/unfinished/compiler/backend/backend.factor
index ffe8f73ba9..2efd22610e 100644
--- a/unfinished/compiler/backend/backend.factor
+++ b/unfinished/compiler/backend/backend.factor
@@ -2,8 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs arrays generic kernel kernel.private
math memory namespaces make sequences layouts system hashtables
-classes alien byte-arrays combinators words sets classes.algebra
-compiler.cfg.registers compiler.cfg.instructions ;
+classes alien byte-arrays combinators words ;
IN: compiler.backend
! Labels
@@ -30,7 +29,7 @@ GENERIC: param-reg ( n register-class -- reg )
M: object param-reg param-regs nth ;
! Load a literal (immediate or indirect)
-GENERIC# load-literal 1 ( obj vreg -- )
+GENERIC# load-literal 1 ( obj reg -- )
HOOK: load-indirect cpu ( obj reg -- )
@@ -52,10 +51,10 @@ HOOK: %call cpu ( word -- )
HOOK: %jump-label cpu ( label -- )
! Test if vreg is 'f' or not
-HOOK: %jump-f cpu ( label vreg -- )
+HOOK: %jump-f cpu ( label reg -- )
! Test if vreg is 't' or not
-HOOK: %jump-t cpu ( label vreg -- )
+HOOK: %jump-t cpu ( label reg -- )
HOOK: %dispatch cpu ( -- )
@@ -71,10 +70,10 @@ HOOK: %inc-d cpu ( n -- )
HOOK: %inc-r cpu ( n -- )
! Load stack into vreg
-HOOK: %peek cpu ( vreg loc -- )
+HOOK: %peek cpu ( reg loc -- )
! Store vreg to stack
-HOOK: %replace cpu ( vreg loc -- )
+HOOK: %replace cpu ( reg loc -- )
! Copy values between vregs
HOOK: %copy cpu ( dst src -- )
@@ -148,21 +147,11 @@ M: stack-params param-reg drop ;
M: stack-params param-regs drop f ;
-GENERIC: v>operand ( obj -- operand )
-
-SYMBOL: registers
-
-M: constant v>operand
- value>> [ tag-fixnum ] [ \ f tag-number ] if* ;
-
-M: value v>operand
- >vreg [ registers get at ] [ "Bad value" throw ] if* ;
-
-M: object load-literal v>operand load-indirect ;
+M: object load-literal load-indirect ;
PREDICATE: small-slot < integer cells small-enough? ;
-PREDICATE: small-tagged < integer v>operand small-enough? ;
+PREDICATE: small-tagged < integer tag-fixnum small-enough? ;
: if-small-struct ( n size true false -- ? )
[ over not over struct-small-enough? and ] 2dip
@@ -194,30 +183,10 @@ HOOK: %unbox-any-c-ptr cpu ( dst src -- )
HOOK: %box-alien cpu ( dst src -- )
+! Allocation
+HOOK: %allot cpu ( dst size type tag temp -- )
+
+HOOK: %write-barrier cpu ( src temp -- )
+
! GC check
HOOK: %gc cpu ( -- )
-
-SYMBOL: operands
-
-: init-intrinsic ( insn -- )
- [ defs-vregs>> ] [ uses-vregs>> ] bi append operands set ;
-
-: (operand) ( name -- operand )
- operands get at* [ "Bad operand name" throw ] unless ;
-
-: operand ( name -- operand )
- (operand) v>operand ;
-
-: operand-class ( var -- class )
- (operand) value-class ;
-
-: operand-tag ( operand -- tag/f )
- operand-class dup [ class-tag ] when ;
-
-UNION: immediate fixnum POSTPONE: f ;
-
-: operand-immediate? ( operand -- ? )
- operand-class immediate class<= ;
-
-: unique-operands ( operands quot -- )
- >r [ operand ] map prune r> each ; inline
diff --git a/unfinished/compiler/backend/x86/sse2/sse2.factor b/unfinished/compiler/backend/x86/sse2/sse2.factor
index 2d82a7a368..4364a8c24a 100644
--- a/unfinished/compiler/backend/x86/sse2/sse2.factor
+++ b/unfinished/compiler/backend/x86/sse2/sse2.factor
@@ -2,27 +2,24 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.accessors arrays generic kernel system
kernel.private math math.private memory namespaces sequences
-words math.floats.private layouts quotations cpu.x86
-compiler.cfg.templates compiler.cfg.builder compiler.cfg.registers
-compiler.constants compiler.backend compiler.backend.x86 ;
+words math.floats.private layouts quotations locals cpu.x86
+compiler.codegen compiler.cfg.templates compiler.cfg.builder
+compiler.cfg.registers compiler.constants compiler.backend
+compiler.backend.x86 ;
IN: compiler.backend.x86.sse2
-M: x86 %box-float ( dst src -- )
+M:: x86 %box-float ( dst src temp -- )
#! Only called by pentium4 backend, uses SSE2 instruction
- #! dest is a loc or a vreg
- float 16 [
- 8 (object@) swap v>operand MOVSD
- float %store-tagged
- ] %allot ;
+ dst 16 float float temp %allot
+ dst 8 float tag-number - [+] src MOVSD ;
M: x86 %unbox-float ( dst src -- )
- [ v>operand ] bi@ float-offset [+] MOVSD ;
+ float-offset [+] MOVSD ;
: define-float-op ( word op -- )
[ "x" operand "y" operand ] swap suffix T{ template
{ input { { float "x" } { float "y" } } }
{ output { "x" } }
- { gc t }
} define-intrinsic ;
{
@@ -65,7 +62,6 @@ M: x86 %unbox-float ( dst src -- )
{ scratch { { float "out" } } }
{ output { "out" } }
{ clobber { "in" } }
- { gc t }
} define-intrinsic
: alien-float-get-template
diff --git a/unfinished/compiler/backend/x86/x86.factor b/unfinished/compiler/backend/x86/x86.factor
index 1ef2ebfbc4..da0586a7b9 100644
--- a/unfinished/compiler/backend/x86/x86.factor
+++ b/unfinished/compiler/backend/x86/x86.factor
@@ -4,20 +4,12 @@ USING: accessors arrays byte-arrays alien.accessors
compiler.backend kernel kernel.private math memory namespaces
make sequences words system layouts combinators math.order
math.private alien alien.c-types slots.private cpu.x86
-cpu.x86.private compiler.backend compiler.codegen.fixup
+cpu.x86.private locals compiler.backend compiler.codegen.fixup
compiler.constants compiler.intrinsics compiler.cfg.builder
compiler.cfg.registers compiler.cfg.stacks
-compiler.cfg.templates ;
+compiler.cfg.templates compiler.codegen ;
IN: compiler.backend.x86
-M: word MOV 0 rot (MOV-I) rc-absolute-cell rel-word ;
-M: word JMP (JMP) rel-word ;
-M: label JMP (JMP) label-fixup ;
-M: word CALL (CALL) rel-word ;
-M: label CALL (CALL) label-fixup ;
-M: word JUMPcc (JUMPcc) rel-word ;
-M: label JUMPcc (JUMPcc) label-fixup ;
-
HOOK: ds-reg cpu ( -- reg )
HOOK: rs-reg cpu ( -- reg )
HOOK: stack-reg cpu ( -- reg )
@@ -27,8 +19,10 @@ HOOK: stack-save-reg cpu ( -- reg )
: reg-stack ( n reg -- op ) swap cells neg [+] ;
-M: ds-loc v>operand n>> ds-reg reg-stack ;
-M: rs-loc v>operand n>> rs-reg reg-stack ;
+GENERIC: loc>operand ( loc -- operand )
+
+M: ds-loc loc>operand n>> ds-reg reg-stack ;
+M: rs-loc loc>operand n>> rs-reg reg-stack ;
M: int-regs %save-param-reg drop >r stack@ r> MOV ;
M: int-regs %load-param-reg drop swap stack@ MOV ;
@@ -54,10 +48,10 @@ HOOK: fixnum>slot@ cpu ( op -- )
HOOK: prepare-division cpu ( -- )
M: f load-literal
- v>operand \ f tag-number MOV drop ;
+ \ f tag-number MOV drop ;
M: fixnum load-literal
- v>operand swap tag-fixnum MOV ;
+ swap tag-fixnum MOV ;
M: x86 stack-frame ( n -- i )
3 cells + 16 align cell - ;
@@ -99,16 +93,16 @@ M: x86 %jump-t ( label vreg -- ) \ f tag-number CMP JNE ;
: align-code ( n -- )
0 <repetition> % ;
-M: x86 %dispatch ( -- )
+M:: x86 %dispatch ( src temp -- )
! Load jump table base. We use a temporary register
! since on AMD64 we have to load a 64-bit immediate. On
! x86, this is redundant.
! Untag and multiply to get a jump table offset
- temp-reg-1 fixnum>slot@
+ src fixnum>slot@
! Add jump table base
- temp-reg-2 HEX: ffffffff MOV rc-absolute-cell rel-here
- temp-reg-1 temp-reg-2 ADD
- temp-reg-1 HEX: 7f [+] JMP
+ temp HEX: ffffffff MOV rc-absolute-cell rel-here
+ src temp ADD
+ src HEX: 7f [+] JMP
! Fix up the displacement above
code-alignment dup bootstrap-cell 8 = 15 9 ? +
building get dup pop* push
@@ -117,9 +111,9 @@ M: x86 %dispatch ( -- )
M: x86 %dispatch-label ( word -- )
0 cell, rc-absolute-cell rel-word ;
-M: x86 %peek [ v>operand ] bi@ MOV ;
+M: x86 %peek loc>operand MOV ;
-M: x86 %replace swap %peek ;
+M: x86 %replace loc>operand swap MOV ;
: (%inc) ( n reg -- ) swap cells dup 0 > [ ADD ] [ neg SUB ] if ;
@@ -146,13 +140,13 @@ M: x86 %return ( -- ) 0 %unwind ;
! Alien intrinsics
M: x86 %unbox-byte-array ( dst src -- )
- [ v>operand ] bi@ byte-array-offset [+] LEA ;
+ byte-array-offset [+] LEA ;
M: x86 %unbox-alien ( dst src -- )
- [ v>operand ] bi@ alien-offset [+] MOV ;
+ alien-offset [+] MOV ;
M: x86 %unbox-f ( dst src -- )
- drop v>operand 0 MOV ;
+ drop 0 MOV ;
M: x86 %unbox-any-c-ptr ( dst src -- )
{ "is-byte-array" "end" "start" } [ define-label ] each
@@ -161,7 +155,7 @@ M: x86 %unbox-any-c-ptr ( dst src -- )
ds-reg 0 MOV
! Object is stored in ds-reg
rs-reg PUSH
- rs-reg swap v>operand MOV
+ rs-reg swap MOV
! We come back here with displaced aliens
"start" resolve-label
! Is the object f?
@@ -182,34 +176,45 @@ M: x86 %unbox-any-c-ptr ( dst src -- )
ds-reg byte-array-offset ADD
"end" resolve-label
! Done, store address in destination register
- v>operand ds-reg MOV
+ ds-reg MOV
! Restore rs-reg
rs-reg POP
! Restore ds-reg
ds-reg POP ;
-: allot-reg ( -- reg )
- #! We temporarily use the datastack register, since it won't
- #! be accessed inside the quotation given to %allot in any
- #! case.
- ds-reg ;
+M:: x86 %write-barrier ( src temp -- )
+ #! Mark the card pointed to by vreg.
+ ! Mark the card
+ src card-bits SHR
+ "cards_offset" f temp %alien-global
+ temp temp [+] card-mark <byte> MOV
-: (object@) ( n -- operand ) allot-reg swap [+] ;
-
-: object@ ( n -- operand ) cells (object@) ;
+ ! Mark the card deck
+ temp deck-bits card-bits - SHR
+ "decks_offset" f temp %alien-global
+ temp temp [+] card-mark <byte> MOV ;
: load-zone-ptr ( reg -- )
#! Load pointer to start of zone array
0 MOV "nursery" f rc-absolute-cell rel-dlsym ;
-: load-allot-ptr ( -- )
- allot-reg load-zone-ptr
- allot-reg PUSH
- allot-reg dup cell [+] MOV ;
+: load-allot-ptr ( temp -- )
+ [ load-zone-ptr ] [ PUSH ] [ dup cell [+] MOV ] tri ;
-: inc-allot-ptr ( n -- )
- allot-reg POP
- allot-reg cell [+] swap 8 align ADD ;
+: inc-allot-ptr ( n temp -- )
+ [ POP ] [ cell [+] swap 8 align ADD ] bi ;
+
+: store-header ( temp type -- )
+ [ 0 [+] ] [ type-number tag-fixnum ] bi* MOV ;
+
+: store-tagged ( dst temp tag -- )
+ dupd tag-number OR MOV ;
+
+M:: x86 %allot ( dst size type tag temp -- )
+ temp load-allot-ptr
+ temp type store-header
+ temp size inc-allot-ptr
+ dst temp store-tagged ;
M: x86 %gc ( -- )
"end" define-label
@@ -223,73 +228,53 @@ M: x86 %gc ( -- )
"minor_gc" f %alien-invoke
"end" resolve-label ;
-: store-header ( header -- )
- 0 object@ swap type-number tag-fixnum MOV ;
+: bignum@ ( reg n -- op ) cells bignum tag-number - [+] ;
-: %allot ( header size quot -- )
- allot-reg PUSH
- swap >r >r
- load-allot-ptr
- store-header
- r> call
- r> inc-allot-ptr
- allot-reg POP ; inline
-
-: fresh-object drop ;
-
-: %store-tagged ( reg tag -- )
- >r dup fresh-object v>operand r>
- allot-reg swap tag-number OR
- allot-reg MOV ;
-
-: %allot-bignum-signed-1 ( outreg inreg -- )
+:: %allot-bignum-signed-1 ( dst src temp -- )
#! on entry, inreg is a signed 32-bit quantity
#! exits with tagged ptr to bignum in outreg
#! 1 cell header, 1 cell length, 1 cell sign, + digits
#! length is the # of digits + sign
[
- { "end" "nonzero" "positive" "store" }
- [ define-label ] each
- dup v>operand 0 CMP ! is it zero?
+ { "end" "nonzero" "positive" "store" } [ define-label ] each
+ src 0 CMP ! is it zero?
"nonzero" get JNE
- 0 >bignum pick v>operand load-indirect ! this is our result
+ ! Use cached zero value
+ 0 >bignum dst load-indirect
"end" get JMP
"nonzero" resolve-label
- bignum 4 cells [
- ! Write length
- 1 object@ 2 v>operand MOV
- ! Test sign
- dup v>operand 0 CMP
- "positive" get JGE
- 2 object@ 1 MOV ! negative sign
- dup v>operand NEG
- "store" get JMP
- "positive" resolve-label
- 2 object@ 0 MOV ! positive sign
- "store" resolve-label
- 3 object@ swap v>operand MOV
- ! Store tagged ptr in reg
- bignum %store-tagged
- ] %allot
+ ! Allocate a bignum
+ dst 4 cells bignum bignum temp %allot
+ ! Write length
+ dst 1 bignum@ 2 MOV
+ ! Test sign
+ src 0 CMP
+ "positive" get JGE
+ dst 2 bignum@ 1 MOV ! negative sign
+ src NEG
+ "store" get JMP
+ "positive" resolve-label
+ dst 2 bignum@ 0 MOV ! positive sign
+ "store" resolve-label
+ dst 3 bignum@ src MOV
"end" resolve-label
] with-scope ;
-M: x86 %box-alien ( dst src -- )
+: alien@ ( reg n -- op ) cells object tag-number - [+] ;
+
+M:: x86 %box-alien ( dst src temp -- )
[
{ "end" "f" } [ define-label ] each
- dup v>operand 0 CMP
+ src 0 CMP
"f" get JE
- alien 4 cells [
- 1 object@ \ f tag-number MOV
- 2 object@ \ f tag-number MOV
- ! Store src in alien-offset slot
- 3 object@ swap v>operand MOV
- ! Store tagged ptr in dst
- dup object %store-tagged
- ] %allot
+ dst 4 cells alien object temp %allot
+ dst 1 alien@ \ f tag-number MOV
+ dst 2 alien@ \ f tag-number MOV
+ ! Store src in alien-offset slot
+ dst 3 alien@ src MOV
"end" get JMP
"f" resolve-label
- f [ v>operand ] bi@ MOV
+ \ f tag-number MOV
"end" resolve-label
] with-scope ;
@@ -321,7 +306,7 @@ M: x86 %box-alien ( dst src -- )
! Slot number is literal and the tag is known
{
[ "val" operand %slot-literal-known-tag MOV ] T{ template
- { input { { f "obj" known-tag } { [ small-slot? ] "n" } } }
+ { input { { f "obj" known-tag } { small-slot "n" } } }
{ scratch { { f "val" } } }
{ output { "val" } }
}
@@ -329,7 +314,7 @@ M: x86 %box-alien ( dst src -- )
! Slot number is literal
{
[ "obj" operand %slot-literal-any-tag MOV ] T{ template
- { input { { f "obj" } { [ small-slot? ] "n" } } }
+ { input { { f "obj" } { small-slot "n" } } }
{ output { "obj" } }
}
}
@@ -343,40 +328,26 @@ M: x86 %box-alien ( dst src -- )
}
} define-intrinsics
-: generate-write-barrier ( -- )
- #! Mark the card pointed to by vreg.
- "val" operand-immediate? "obj" fresh-object? or [
- ! Mark the card
- "obj" operand card-bits SHR
- "cards_offset" f "scratch" operand %alien-global
- "scratch" operand "obj" operand [+] card-mark <byte> MOV
-
- ! Mark the card deck
- "obj" operand deck-bits card-bits - SHR
- "decks_offset" f "scratch" operand %alien-global
- "scratch" operand "obj" operand [+] card-mark <byte> MOV
- ] unless ;
-
-\ set-slot {
+\ (set-slot) {
! Slot number is literal and the tag is known
{
- [ %slot-literal-known-tag "val" operand MOV generate-write-barrier ] T{ template
- { input { { f "val" } { f "obj" known-tag } { [ small-slot? ] "n" } } }
+ [ %slot-literal-known-tag "val" operand MOV ] T{ template
+ { input { { f "val" } { f "obj" known-tag } { small-slot "n" } } }
{ scratch { { f "scratch" } } }
{ clobber { "obj" } }
}
}
! Slot number is literal
{
- [ %slot-literal-any-tag "val" operand MOV generate-write-barrier ] T{ template
- { input { { f "val" } { f "obj" } { [ small-slot? ] "n" } } }
+ [ %slot-literal-any-tag "val" operand MOV ] T{ template
+ { input { { f "val" } { f "obj" } { small-slot "n" } } }
{ scratch { { f "scratch" } } }
{ clobber { "obj" } }
}
}
! Slot number in a register
{
- [ %slot-any "val" operand MOV generate-write-barrier ] T{ template
+ [ %slot-any "val" operand MOV ] T{ template
{ input { { f "val" } { f "obj" } { f "n" } } }
{ scratch { { f "scratch" } } }
{ clobber { "obj" "n" } }
@@ -400,7 +371,7 @@ M: x86 %box-alien ( dst src -- )
: fixnum-value-op ( op -- pair )
T{ template
- { input { { f "x" } { [ small-tagged? ] "y" } } }
+ { input { { f "x" } { small-tagged "y" } } }
{ output { "x" } }
} fixnum-op ;
@@ -476,7 +447,7 @@ M: x86 %box-alien ( dst src -- )
! There was an overflow. Recompute the original operand.
{ "y" "x" } %untag-fixnums
"x" operand "y" operand rot execute
- "z" get "x" get %allot-bignum-signed-1
+ "z" operand "x" operand "y" operand %allot-bignum-signed-1
"end" resolve-label ; inline
: overflow-template ( word insn -- )
@@ -516,9 +487,10 @@ M: x86 %box-alien ( dst src -- )
\ fixnum>bignum [
"x" operand %untag-fixnum
- "x" get dup %allot-bignum-signed-1
+ "x" operand dup "scratch" operand %allot-bignum-signed-1
] T{ template
{ input { { f "x" } } }
+ { scratch { { f "scratch" } } }
{ output { "x" } }
{ gc t }
} define-intrinsic
@@ -531,7 +503,7 @@ M: x86 %box-alien ( dst src -- )
"y" operand "x" operand cell [+] MOV
! if the length is 1, its just the sign and nothing else,
! so output 0
- "y" operand 1 v>operand CMP
+ "y" operand 1 tag-fixnum CMP
"nonzero" get JNE
"y" operand 0 MOV
"end" get JMP
@@ -577,90 +549,6 @@ M: x86 %box-alien ( dst src -- )
{ clobber { "n" } }
} define-intrinsic
-\ (tuple) [
- tuple "layout" get size>> 2 + cells [
- ! Store layout
- "layout" get "scratch" operand load-indirect
- 1 object@ "scratch" operand MOV
- ! Store tagged ptr in reg
- "tuple" get tuple %store-tagged
- ] %allot
-] T{ template
- { input { { [ ] "layout" } } }
- { scratch { { f "tuple" } { f "scratch" } } }
- { output { "tuple" } }
- { gc t }
-} define-intrinsic
-
-\ (array) [
- array "n" get 2 + cells [
- ! Store length
- 1 object@ "n" operand MOV
- ! Store tagged ptr in reg
- "array" get object %store-tagged
- ] %allot
-] T{ template
- { input { { [ ] "n" } } }
- { scratch { { f "array" } } }
- { output { "array" } }
- { gc t }
-} define-intrinsic
-
-\ (byte-array) [
- byte-array "n" get 2 cells + [
- ! Store length
- 1 object@ "n" operand MOV
- ! Store tagged ptr in reg
- "array" get object %store-tagged
- ] %allot
-] T{ template
- { input { { [ ] "n" } } }
- { scratch { { f "array" } } }
- { output { "array" } }
- { gc t }
-} define-intrinsic
-
-\ <ratio> [
- ratio 3 cells [
- 1 object@ "numerator" operand MOV
- 2 object@ "denominator" operand MOV
- ! Store tagged ptr in reg
- "ratio" get ratio %store-tagged
- ] %allot
-] T{ template
- { input { { f "numerator" } { f "denominator" } } }
- { scratch { { f "ratio" } } }
- { output { "ratio" } }
- { gc t }
-} define-intrinsic
-
-\ <complex> [
- complex 3 cells [
- 1 object@ "real" operand MOV
- 2 object@ "imaginary" operand MOV
- ! Store tagged ptr in reg
- "complex" get complex %store-tagged
- ] %allot
-] T{ template
- { input { { f "real" } { f "imaginary" } } }
- { scratch { { f "complex" } } }
- { output { "complex" } }
- { gc t }
-} define-intrinsic
-
-\ <wrapper> [
- wrapper 2 cells [
- 1 object@ "obj" operand MOV
- ! Store tagged ptr in reg
- "wrapper" get object %store-tagged
- ] %allot
-] T{ template
- { input { { f "obj" } } }
- { scratch { { f "wrapper" } } }
- { output { "wrapper" } }
- { gc t }
-} define-intrinsic
-
! Alien intrinsics
: %alien-accessor ( quot -- )
"offset" operand %untag-fixnum
diff --git a/unfinished/compiler/cfg/builder/builder.factor b/unfinished/compiler/cfg/builder/builder.factor
index 60dc5efdd9..ff1ddd9747 100755
--- a/unfinished/compiler/cfg/builder/builder.factor
+++ b/unfinished/compiler/cfg/builder/builder.factor
@@ -1,7 +1,10 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators hashtables kernel
-math fry namespaces make sequences words stack-checker.inlining
+math fry namespaces make sequences words byte-arrays
+locals layouts
+stack-checker.inlining
+compiler.intrinsics
compiler.tree
compiler.tree.builder
compiler.tree.combinators
@@ -142,8 +145,7 @@ M: #recursive emit-node
children>> [ emit-nodes ] emit-branches ;
M: #if emit-node
- { { f "flag" } } lazy-load first ##branch-t
- emit-if iterate-next ;
+ phantom-pop ##branch-t emit-if iterate-next ;
! #dispatch
: dispatch-branch ( nodes word -- label )
@@ -167,7 +169,9 @@ M: #if emit-node
] each ;
: emit-dispatch ( node -- )
- ##epilogue ##dispatch dispatch-branches init-phantoms ;
+ phantom-pop int-regs next-vreg
+ [ finalize-contents finalize-heights ##epilogue ] 2dip ##dispatch
+ dispatch-branches init-phantoms ;
M: #dispatch emit-node
tail-call? [
@@ -225,12 +229,45 @@ M: #dispatch emit-node
: setup-value-classes ( #call -- )
node-input-infos [ class>> ] map set-value-classes ;
+{
+ (tuple) (array) (byte-array)
+ (complex) (ratio) (wrapper)
+ (write-barrier)
+} [ t "intrinsic" set-word-prop ] each
+
+: allot-size ( #call -- n )
+ 1 phantom-datastack get phantom-input first value>> ;
+
+:: emit-allot ( size type tag -- )
+ int-regs next-vreg
+ dup fresh-object
+ dup size type tag int-regs next-vreg ##allot
+ type tagged boa phantom-push ;
+
+: emit-write-barrier ( -- )
+ phantom-pop dup >vreg fresh-object? [ drop ] [
+ int-regs next-vreg ##write-barrier
+ ] if ;
+
+: emit-intrinsic ( word -- next )
+ {
+ { \ (tuple) [ allot-size 2 cells + tuple tuple emit-allot ] }
+ { \ (array) [ allot-size 2 cells + array object emit-allot ] }
+ { \ (byte-array) [ allot-size cells 2 + byte-array object emit-allot ] }
+ { \ (complex) [ 3 cells complex complex emit-allot ] }
+ { \ (ratio) [ 3 cells ratio ratio emit-allot ] }
+ { \ (wrapper) [ 2 cells wrapper object emit-allot ] }
+ { \ (write-barrier) [ emit-write-barrier ] }
+ } case
+ iterate-next ;
+
M: #call emit-node
dup setup-value-classes
dup find-if-intrinsic [ do-if-intrinsic ] [
dup find-boolean-intrinsic [ do-boolean-intrinsic ] [
dup find-intrinsic [ do-intrinsic ] [
- word>> emit-call
+ word>> dup "intrinsic" word-prop
+ [ emit-intrinsic ] [ emit-call ] if
] ?if
] ?if
] ?if ;
diff --git a/unfinished/compiler/cfg/instructions/instructions.factor b/unfinished/compiler/cfg/instructions/instructions.factor
index 185dc1196a..415f964acf 100644
--- a/unfinished/compiler/cfg/instructions/instructions.factor
+++ b/unfinished/compiler/cfg/instructions/instructions.factor
@@ -27,7 +27,7 @@ INSN: ##intrinsic quot defs-vregs uses-vregs ;
! Jump tables
INSN: ##dispatch-label label ;
-INSN: ##dispatch ;
+INSN: ##dispatch src temp ;
! Boxing and unboxing
INSN: ##copy < ##unary ;
@@ -37,9 +37,12 @@ INSN: ##unbox-f < ##unary ;
INSN: ##unbox-alien < ##unary ;
INSN: ##unbox-byte-array < ##unary ;
INSN: ##unbox-any-c-ptr < ##unary ;
-INSN: ##box-float < ##unary ;
-INSN: ##box-alien < ##unary ;
+INSN: ##box-float < ##unary temp ;
+INSN: ##box-alien < ##unary temp ;
+! Memory allocation
+INSN: ##allot < ##nullary size type tag temp ;
+INSN: ##write-barrier src temp ;
INSN: ##gc ;
! FFI
@@ -52,10 +55,21 @@ GENERIC: uses-vregs ( insn -- seq )
M: ##nullary defs-vregs dst>> >vreg 1array ;
M: ##unary defs-vregs dst>> >vreg 1array ;
+M: ##write-barrier defs-vregs temp>> >vreg 1array ;
+
+: allot-defs-vregs ( insn -- seq )
+ [ dst>> >vreg ] [ temp>> >vreg ] bi 2array ;
+
+M: ##box-float defs-vregs allot-defs-vregs ;
+M: ##box-alien defs-vregs allot-defs-vregs ;
+M: ##allot defs-vregs allot-defs-vregs ;
+M: ##dispatch defs-vregs temp>> >vreg 1array ;
M: insn defs-vregs drop f ;
M: ##replace uses-vregs src>> >vreg 1array ;
M: ##unary uses-vregs src>> >vreg 1array ;
+M: ##write-barrier uses-vregs src>> >vreg 1array ;
+M: ##dispatch uses-vregs src>> >vreg 1array ;
M: insn uses-vregs drop f ;
: intrinsic-vregs ( assoc -- seq' )
diff --git a/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
index 41b9895af2..d6ee979fe5 100644
--- a/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
+++ b/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
@@ -28,6 +28,7 @@ SYMBOL: live-intervals
at [ (>>end) ] [ uses>> push ] 2bi ;
: new-live-interval ( n vreg live-intervals -- )
+ 2dup key? [ "Multiple defs" throw ] when
[ [ <live-interval> ] keep ] dip set-at ;
: compute-live-intervals* ( insn n -- )
diff --git a/unfinished/compiler/cfg/stacks/stacks.factor b/unfinished/compiler/cfg/stacks/stacks.factor
index 811ec5842f..39cd942bb2 100755
--- a/unfinished/compiler/cfg/stacks/stacks.factor
+++ b/unfinished/compiler/cfg/stacks/stacks.factor
@@ -3,18 +3,12 @@
USING: arrays assocs classes classes.private classes.algebra
combinators hashtables kernel layouts math fry namespaces
quotations sequences system vectors words effects alien
-byte-arrays accessors sets math.order compiler.cfg.instructions
-compiler.cfg.registers ;
+byte-arrays accessors sets math.order compiler.backend
+compiler.cfg.instructions compiler.cfg.registers ;
IN: compiler.cfg.stacks
! Converting stack operations into register operations, while
! doing a bit of optimization along the way.
-
-USE: qualified
-FROM: compiler.generator.registers => +input+ ;
-FROM: compiler.generator.registers => +output+ ;
-FROM: compiler.generator.registers => +scratch+ ;
-FROM: compiler.generator.registers => +clobber+ ;
SYMBOL: known-tag
! Value protocol
@@ -100,6 +94,14 @@ M: constant move-spec class ;
swap >>class
%move ;
+! Operands holding pointers to freshly-allocated objects which
+! are guaranteed to be in the nursery
+SYMBOL: fresh-objects
+
+: fresh-object ( vreg/t -- ) fresh-objects get push ;
+
+: fresh-object? ( vreg -- ? ) fresh-objects get memq? ;
+
: %move ( dst src -- )
2dup [ move-spec ] bi@ 2array {
{ { f f } [ ##copy ] }
@@ -114,8 +116,8 @@ M: constant move-spec class ;
{ { f constant } [ value>> ##load-literal ] }
- { { f float } [ ##box-float ] }
- { { f unboxed-alien } [ ##box-alien ] }
+ { { f float } [ int-regs next-vreg ##box-float t fresh-object ] }
+ { { f unboxed-alien } [ int-regs next-vreg ##box-alien t fresh-object ] }
{ { f loc } [ ##peek ] }
{ { float f } [ ##unbox-float ] }
@@ -223,10 +225,6 @@ M: phantom-retainstack finalize-height
: live-locs ( -- seq )
[ (live-locs) ] each-phantom append prune ;
-! Operands holding pointers to freshly-allocated objects which
-! are guaranteed to be in the nursery
-SYMBOL: fresh-objects
-
: reg-spec>class ( spec -- class )
float eq? double-float-regs int-regs ? ;
@@ -255,7 +253,7 @@ SYMBOL: fresh-objects
M: value (lazy-load)
{
- { [ dup quotation? ] [ drop ] }
+ { [ dup { small-slot small-tagged } memq? ] [ drop ] }
{ [ 2dup compatible? ] [ drop ] }
[ (eager-load) ]
} cond ;
@@ -280,23 +278,11 @@ M: loc lazy-store
dup loc? over cached? or [ 2drop ] [ %move ] if
] each-loc ;
-: reset-phantom ( phantom -- )
- #! Kill register assignments but preserve constants and
- #! class information.
- dup phantom-locs*
- over stack>> [
- dup constant? [ nip ] [
- value-class over set-value-class
- ] if
- ] 2map
- over stack>> delete-all
- swap stack>> push-all ;
-
-: reset-phantoms ( -- )
- [ reset-phantom ] each-phantom ;
+: clear-phantoms ( -- )
+ [ stack>> delete-all ] each-phantom ;
: finalize-contents ( -- )
- finalize-locs finalize-vregs reset-phantoms ;
+ finalize-locs finalize-vregs clear-phantoms ;
! Loading stacks to vregs
: vreg-substitution ( value vreg -- pair )
@@ -312,26 +298,22 @@ M: loc lazy-store
[ substitute-vreg? ] assoc-filter >hashtable
'[ stack>> _ substitute-here ] each-phantom ;
-: clear-phantoms ( -- )
- [ stack>> delete-all ] each-phantom ;
-
: set-value-classes ( classes -- )
phantom-datastack get
over length over add-locs
- stack>> [ set-value-class ] 2reverse-each ;
+ stack>> [
+ [ value-class class-and ] keep set-value-class
+ ] 2reverse-each ;
: finalize-phantoms ( -- )
#! Commit all deferred stacking shuffling, and ensure the
#! in-memory data and retain stacks are up to date with
#! respect to the compiler's current picture.
finalize-contents
- clear-phantoms
finalize-heights
- fresh-objects get [ empty? [ ##gc ] unless ] [ delete-all ] bi ;
-
-: fresh-object ( obj -- ) fresh-objects get push ;
-
-: fresh-object? ( obj -- ? ) fresh-objects get memq? ;
+ fresh-objects get [
+ empty? [ 0 ##frame-required ##gc ] unless
+ ] [ delete-all ] bi ;
: init-phantoms ( -- )
V{ } clone fresh-objects set
@@ -364,3 +346,7 @@ M: loc lazy-store
: phantom-rdrop ( n -- )
phantom-retainstack get phantom-input drop ;
+
+: phantom-pop ( -- vreg )
+ 1 phantom-datastack get phantom-input dup first f (lazy-load)
+ [ 1array substitute-vregs ] keep ;
diff --git a/unfinished/compiler/cfg/templates/templates.factor b/unfinished/compiler/cfg/templates/templates.factor
index a99102a9bb..12a56704d0 100644
--- a/unfinished/compiler/cfg/templates/templates.factor
+++ b/unfinished/compiler/cfg/templates/templates.factor
@@ -1,8 +1,8 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs accessors sequences kernel fry namespaces
-quotations combinators classes.algebra compiler.cfg.instructions
-compiler.cfg.registers compiler.cfg.stacks ;
+quotations combinators classes.algebra compiler.backend
+compiler.cfg.instructions compiler.cfg.registers compiler.cfg.stacks ;
IN: compiler.cfg.templates
TUPLE: template input output scratch clobber gc ;
@@ -57,7 +57,9 @@ TUPLE: template input output scratch clobber gc ;
: apply-template ( pair quot -- vregs )
[
- first2 dup do-template-inputs
+ first2
+ dup gc>> [ t fresh-object ] when
+ dup do-template-inputs
[ do-template-outputs ] 2keep
] dip call ; inline
@@ -67,12 +69,11 @@ TUPLE: template input output scratch clobber gc ;
#! to the fixnum. Otherwise, the values don't match. If the
#! spec is not a quotation, its a reg-class, in which case
#! the value is always good.
- dup quotation? [
- over constant?
- [ >r value>> r> 2drop f ] [ 2drop f ] if
- ] [
- 2drop t
- ] if ;
+ {
+ { [ dup small-slot eq? ] [ drop dup constant? [ value>> small-slot? ] [ drop f ] if ] }
+ { [ dup small-tagged eq? ] [ drop dup constant? [ value>> small-tagged? ] [ drop f ] if ] }
+ [ 2drop t ]
+ } cond ;
: class-matches? ( actual expected -- ? )
{
diff --git a/unfinished/compiler/codegen/codegen.factor b/unfinished/compiler/codegen/codegen.factor
index ce2aa93fe6..9ed7b3132f 100644
--- a/unfinished/compiler/codegen/codegen.factor
+++ b/unfinished/compiler/codegen/codegen.factor
@@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces make math math.parser sequences accessors
kernel kernel.private layouts assocs words summary arrays
-threads continuations.private libc combinators
-alien alien.c-types alien.structs alien.strings
+combinators classes.algebra alien alien.c-types alien.structs
+alien.strings sets threads libc continuations.private
compiler.errors
compiler.alien
compiler.backend
@@ -15,6 +15,16 @@ IN: compiler.codegen
GENERIC: generate-insn ( insn -- )
+GENERIC: v>operand ( obj -- operand )
+
+SYMBOL: registers
+
+M: constant v>operand
+ value>> [ tag-fixnum ] [ \ f tag-number ] if* ;
+
+M: value v>operand
+ >vreg [ registers get at ] [ "Bad value" throw ] if* ;
+
: generate-insns ( insns -- code )
[
[
@@ -66,11 +76,14 @@ M: _prologue generate-insn
M: _epilogue generate-insn
n>> %epilogue ;
-M: ##load-literal generate-insn [ obj>> ] [ dst>> ] bi load-literal ;
+M: ##load-literal generate-insn
+ [ obj>> ] [ dst>> v>operand ] bi load-literal ;
-M: ##peek generate-insn [ dst>> ] [ loc>> ] bi %peek ;
+M: ##peek generate-insn
+ [ dst>> v>operand ] [ loc>> ] bi %peek ;
-M: ##replace generate-insn [ src>> ] [ loc>> ] bi %replace ;
+M: ##replace generate-insn
+ [ src>> ] [ loc>> ] bi %replace ;
M: ##inc-d generate-insn n>> %inc-d ;
@@ -82,9 +95,32 @@ M: ##call generate-insn word>> [ add-call ] [ %call ] bi ;
M: ##jump generate-insn word>> [ add-call ] [ %jump-label ] bi ;
+SYMBOL: operands
+
+: init-intrinsic ( insn -- )
+ [ defs-vregs>> ] [ uses-vregs>> ] bi append operands set ;
+
M: ##intrinsic generate-insn
[ init-intrinsic ] [ quot>> call ] bi ;
+: (operand) ( name -- operand )
+ operands get at* [ "Bad operand name" throw ] unless ;
+
+: operand ( name -- operand )
+ (operand) v>operand ;
+
+: operand-class ( var -- class )
+ (operand) value-class ;
+
+: operand-tag ( operand -- tag/f )
+ operand-class dup [ class-tag ] when ;
+
+: operand-immediate? ( operand -- ? )
+ operand-class immediate class<= ;
+
+: unique-operands ( operands quot -- )
+ >r [ operand ] map prune r> each ; inline
+
M: _if-intrinsic generate-insn
[ init-intrinsic ]
[ [ label>> lookup-label ] [ quot>> ] bi call ] bi ;
@@ -93,32 +129,48 @@ M: _branch generate-insn
label>> lookup-label %jump-label ;
M: _branch-f generate-insn
- [ src>> ] [ label>> lookup-label ] bi %jump-f ;
+ [ src>> v>operand ] [ label>> lookup-label ] bi %jump-f ;
M: _branch-t generate-insn
- [ src>> ] [ label>> lookup-label ] bi %jump-t ;
+ [ src>> v>operand ] [ label>> lookup-label ] bi %jump-t ;
M: ##dispatch-label generate-insn label>> %dispatch-label ;
M: ##dispatch generate-insn drop %dispatch ;
-M: ##copy generate-insn %copy ;
+: dst/src ( insn -- dst src )
+ [ dst>> v>operand ] [ src>> v>operand ] bi ;
-M: ##copy-float generate-insn %copy-float ;
+M: ##copy generate-insn dst/src %copy ;
-M: ##unbox-float generate-insn [ dst>> ] [ src>> ] bi %unbox-float ;
+M: ##copy-float generate-insn dst/src %copy-float ;
-M: ##unbox-f generate-insn [ dst>> ] [ src>> ] bi %unbox-f ;
+M: ##unbox-float generate-insn dst/src %unbox-float ;
-M: ##unbox-alien generate-insn [ dst>> ] [ src>> ] bi %unbox-alien ;
+M: ##unbox-f generate-insn dst/src %unbox-f ;
-M: ##unbox-byte-array generate-insn [ dst>> ] [ src>> ] bi %unbox-byte-array ;
+M: ##unbox-alien generate-insn dst/src %unbox-alien ;
-M: ##unbox-any-c-ptr generate-insn [ dst>> ] [ src>> ] bi %unbox-any-c-ptr ;
+M: ##unbox-byte-array generate-insn dst/src %unbox-byte-array ;
-M: ##box-float generate-insn [ dst>> ] [ src>> ] bi %box-float ;
+M: ##unbox-any-c-ptr generate-insn dst/src %unbox-any-c-ptr ;
-M: ##box-alien generate-insn [ dst>> ] [ src>> ] bi %box-alien ;
+M: ##box-float generate-insn dst/src %box-float ;
+
+M: ##box-alien generate-insn dst/src %box-alien ;
+
+M: ##allot generate-insn
+ {
+ [ dst>> v>operand ]
+ [ size>> ]
+ [ type>> ]
+ [ tag>> ]
+ [ temp>> v>operand ]
+ } cleave
+ %allot ;
+
+M: ##write-barrier generate-insn
+ [ src>> v>operand ] [ temp>> v>operand ] bi %write-barrier ;
M: ##gc generate-insn drop %gc ;
From 0f2118cf38c39e85494d92e9fc013e6f9315d0b7 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 17 Sep 2008 19:31:35 -0500
Subject: [PATCH 12/87] Count integer and float spills separately, build stack
frame after register allocation since spilling requires a stack frame
---
unfinished/compiler/cfg/cfg.factor | 8 ++-
.../cfg/instructions/instructions.factor | 11 ++--
.../linear-scan/allocation/allocation.factor | 17 +++---
.../linear-scan/assignment/assignment.factor | 18 +++++-
.../cfg/linear-scan/linear-scan.factor | 13 ++--
.../live-intervals/live-intervals.factor | 5 +-
.../cfg/linearization/linearization.factor | 24 +-------
.../cfg/stack-frame/stack-frame.factor | 59 +++++++++++++++++++
unfinished/compiler/codegen/codegen.factor | 4 +-
unfinished/compiler/new/new.factor | 10 +++-
10 files changed, 118 insertions(+), 51 deletions(-)
create mode 100644 unfinished/compiler/cfg/stack-frame/stack-frame.factor
diff --git a/unfinished/compiler/cfg/cfg.factor b/unfinished/compiler/cfg/cfg.factor
index 54b991bff1..140d406c4c 100644
--- a/unfinished/compiler/cfg/cfg.factor
+++ b/unfinished/compiler/cfg/cfg.factor
@@ -19,6 +19,10 @@ successors ;
V{ } clone >>instructions
V{ } clone >>successors ;
-TUPLE: mr instructions word label ;
+TUPLE: mr instructions word label frame-size spill-counts ;
-C: <mr> mr
+: <mr> ( instructions word label -- mr )
+ mr new
+ swap >>label
+ swap >>word
+ swap >>instructions ;
diff --git a/unfinished/compiler/cfg/instructions/instructions.factor b/unfinished/compiler/cfg/instructions/instructions.factor
index 415f964acf..9bb576dcb3 100644
--- a/unfinished/compiler/cfg/instructions/instructions.factor
+++ b/unfinished/compiler/cfg/instructions/instructions.factor
@@ -100,8 +100,8 @@ M: ##if-intrinsic defs-vregs intrinsic-defs-vregs ;
M: ##if-intrinsic uses-vregs intrinsic-uses-vregs ;
! Instructions used by machine IR only.
-INSN: _prologue n ;
-INSN: _epilogue n ;
+INSN: _prologue ;
+INSN: _epilogue ;
INSN: _label id ;
@@ -117,5 +117,8 @@ M: _cond-branch uses-vregs src>> >vreg 1array ;
M: _if-intrinsic defs-vregs intrinsic-defs-vregs ;
M: _if-intrinsic uses-vregs intrinsic-uses-vregs ;
-INSN: _spill src n ;
-INSN: _reload dst n ;
+INSN: _spill-integer src n ;
+INSN: _reload-integer dst n ;
+
+INSN: _spill-float src n ;
+INSN: _reload-float dst n ;
diff --git a/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor b/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor
index 0bfcc8bcd0..4a9646c88a 100644
--- a/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor
+++ b/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor
@@ -2,6 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces sequences math math.order kernel assocs
accessors vectors fry heaps
+compiler.cfg.registers
compiler.cfg.linear-scan.live-intervals
compiler.backend ;
IN: compiler.cfg.linear-scan.allocation
@@ -68,10 +69,10 @@ SYMBOL: progress
[ peek >>reg drop ] [ pop >>reg add-active ] if ;
! Spilling
-SYMBOL: spill-counter
+SYMBOL: spill-counts
-: next-spill-location ( -- n )
- spill-counter [ dup 1+ ] change ;
+: next-spill-location ( reg-class -- n )
+ spill-counts get [ dup 1+ ] change-at ;
: interval-to-spill ( -- live-interval )
#! We spill the interval with the most distant use location.
@@ -141,7 +142,7 @@ SYMBOL: spill-counter
V{ } clone active-intervals set
<min-heap> unhandled-intervals set
[ reverse >vector ] assoc-map free-registers set
- 0 spill-counter set
+ H{ { int-regs 0 } { double-float-regs 0 } } clone spill-counts set
-1 progress set ;
: handle-interval ( live-interval -- )
@@ -152,8 +153,6 @@ SYMBOL: spill-counter
: allocate-registers ( live-intervals machine-registers -- live-intervals )
#! This modifies the input live-intervals.
- [
- init-allocator
- dup init-unhandled
- (allocate-registers)
- ] with-scope ;
+ init-allocator
+ dup init-unhandled
+ (allocate-registers) ;
diff --git a/unfinished/compiler/cfg/linear-scan/assignment/assignment.factor b/unfinished/compiler/cfg/linear-scan/assignment/assignment.factor
index 8b53ee9531..ffe8e6b687 100644
--- a/unfinished/compiler/cfg/linear-scan/assignment/assignment.factor
+++ b/unfinished/compiler/cfg/linear-scan/assignment/assignment.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel math assocs namespaces sequences heaps
-fry make
+fry make combinators
compiler.cfg.registers
compiler.cfg.instructions
compiler.cfg.linear-scan.live-intervals ;
@@ -34,7 +34,13 @@ SYMBOL: unhandled-intervals
[ add-unhandled ] each ;
: insert-spill ( live-interval -- )
- [ reg>> ] [ spill-to>> ] bi dup [ _spill ] [ 2drop ] if ;
+ [ reg>> ] [ spill-to>> ] [ vreg>> reg-class>> ] tri
+ over [
+ {
+ { int-regs [ _spill-integer ] }
+ { double-float-regs [ _spill-float ] }
+ } case
+ ] [ 3drop ] if ;
: expire-old-intervals ( n -- )
active-intervals get
@@ -43,7 +49,13 @@ SYMBOL: unhandled-intervals
[ insert-spill ] each ;
: insert-reload ( live-interval -- )
- [ reg>> ] [ reload-from>> ] bi dup [ _reload ] [ 2drop ] if ;
+ [ reg>> ] [ reload-from>> ] [ vreg>> reg-class>> ] tri
+ over [
+ {
+ { int-regs [ _reload-integer ] }
+ { double-float-regs [ _reload-float ] }
+ } case
+ ] [ 3drop ] if ;
: activate-new-intervals ( n -- )
#! Any live intervals which start on the current instruction
diff --git a/unfinished/compiler/cfg/linear-scan/linear-scan.factor b/unfinished/compiler/cfg/linear-scan/linear-scan.factor
index 80737badc3..f62e3a39d1 100644
--- a/unfinished/compiler/cfg/linear-scan/linear-scan.factor
+++ b/unfinished/compiler/cfg/linear-scan/linear-scan.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors
+USING: kernel accessors namespaces
compiler.backend
compiler.cfg
compiler.cfg.linear-scan.live-intervals
@@ -24,7 +24,10 @@ IN: compiler.cfg.linear-scan
: linear-scan ( mr -- mr' )
[
- dup compute-live-intervals
- machine-registers allocate-registers
- assign-registers
- ] change-instructions ;
+ [
+ dup compute-live-intervals
+ machine-registers allocate-registers
+ assign-registers
+ ] change-instructions
+ spill-counts get >>spill-counts
+ ] with-scope ;
diff --git a/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
index d6ee979fe5..a0699b80bd 100644
--- a/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
+++ b/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
@@ -43,7 +43,6 @@ SYMBOL: live-intervals
: compute-live-intervals ( instructions -- live-intervals )
H{ } clone [
- live-intervals [
- [ compute-live-intervals* ] each-index
- ] with-variable
+ live-intervals set
+ [ compute-live-intervals* ] each-index
] keep finalize-live-intervals ;
diff --git a/unfinished/compiler/cfg/linearization/linearization.factor b/unfinished/compiler/cfg/linearization/linearization.factor
index fd21b5d3b6..24730cd17f 100644
--- a/unfinished/compiler/cfg/linearization/linearization.factor
+++ b/unfinished/compiler/cfg/linearization/linearization.factor
@@ -9,13 +9,6 @@ compiler.cfg.instructions.syntax ;
IN: compiler.cfg.linearization
! Convert CFG IR to machine IR.
-SYMBOL: frame-size
-
-: compute-frame-size ( rpo -- )
- [ instructions>> [ ##frame-required? ] filter ] map concat
- [ f ] [ [ n>> ] map supremum ] if-empty
- frame-size set ;
-
GENERIC: linearize-insn ( basic-block insn -- )
: linearize-insns ( basic-block -- )
@@ -23,14 +16,6 @@ GENERIC: linearize-insn ( basic-block insn -- )
M: insn linearize-insn , drop ;
-M: ##frame-required linearize-insn 2drop ;
-
-M: ##prologue linearize-insn
- 2drop frame-size get [ _prologue ] when* ;
-
-M: ##epilogue linearize-insn
- 2drop frame-size get [ _epilogue ] when* ;
-
: useless-branch? ( basic-block successor -- ? )
#! If our successor immediately follows us in RPO, then we
#! don't need to branch.
@@ -78,9 +63,6 @@ M: ##if-intrinsic linearize-insn
[ [ linearize-basic-block ] each ] { } make ;
: build-mr ( cfg -- mr )
- [
- entry>> reverse-post-order [
- [ compute-frame-size ]
- [ linearize-basic-blocks ] bi
- ] with-scope
- ] [ word>> ] [ label>> ] tri <mr> ;
+ [ entry>> reverse-post-order linearize-basic-blocks ]
+ [ word>> ] [ label>> ]
+ tri <mr> ;
diff --git a/unfinished/compiler/cfg/stack-frame/stack-frame.factor b/unfinished/compiler/cfg/stack-frame/stack-frame.factor
new file mode 100644
index 0000000000..56282cfb09
--- /dev/null
+++ b/unfinished/compiler/cfg/stack-frame/stack-frame.factor
@@ -0,0 +1,59 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: namespaces accessors math.order assocs kernel sequences
+make compiler.cfg.instructions compiler.cfg.instructions.syntax
+compiler.cfg.registers ;
+IN: compiler.cfg.stack-frame
+
+SYMBOL: frame-required?
+
+SYMBOL: frame-size
+
+SYMBOL: spill-counts
+
+: init-stack-frame-builder ( -- )
+ frame-required? off
+ 0 frame-size set ;
+
+GENERIC: compute-frame-size* ( insn -- )
+
+M: ##frame-required compute-frame-size*
+ frame-required? on
+ n>> frame-size [ max ] change ;
+
+M: _spill-integer compute-frame-size*
+ drop frame-required? on ;
+
+M: _spill-float compute-frame-size*
+ drop frame-required? on ;
+
+M: insn compute-frame-size* drop ;
+
+: compute-frame-size ( insns -- )
+ [ compute-frame-size* ] each ;
+
+GENERIC: insert-pro/epilogues* ( insn -- )
+
+M: ##frame-required insert-pro/epilogues* drop ;
+
+M: ##prologue insert-pro/epilogues*
+ drop frame-required? get [ _prologue ] when ;
+
+M: ##epilogue insert-pro/epilogues*
+ drop frame-required? get [ _epilogue ] when ;
+
+M: insn insert-pro/epilogues* , ;
+
+: insert-pro/epilogues ( insns -- insns )
+ [ [ insert-pro/epilogues* ] each ] { } make ;
+
+: build-stack-frame ( mr -- mr )
+ [
+ init-stack-frame-builder
+ [
+ [ compute-frame-size ]
+ [ insert-pro/epilogues ]
+ bi
+ ] change-instructions
+ frame-size get >>frame-size
+ ] with-scope ;
diff --git a/unfinished/compiler/codegen/codegen.factor b/unfinished/compiler/codegen/codegen.factor
index 9ed7b3132f..15ebd691bf 100644
--- a/unfinished/compiler/codegen/codegen.factor
+++ b/unfinished/compiler/codegen/codegen.factor
@@ -71,10 +71,10 @@ M: _label generate-insn
id>> lookup-label , ;
M: _prologue generate-insn
- n>> %prologue ;
+ drop %prologue ;
M: _epilogue generate-insn
- n>> %epilogue ;
+ drop %epilogue ;
M: ##load-literal generate-insn
[ obj>> ] [ dst>> v>operand ] bi load-literal ;
diff --git a/unfinished/compiler/new/new.factor b/unfinished/compiler/new/new.factor
index 9b640b8d84..fd402916a0 100644
--- a/unfinished/compiler/new/new.factor
+++ b/unfinished/compiler/new/new.factor
@@ -7,7 +7,7 @@ stack-checker stack-checker.state stack-checker.inlining
compiler.errors compiler.units compiler.tree.builder
compiler.tree.optimizer compiler.cfg.builder
compiler.cfg.linearization compiler.cfg.linear-scan
-compiler.codegen ;
+compiler.cfg.stack-frame compiler.codegen ;
IN: compiler.new
SYMBOL: compile-queue
@@ -79,7 +79,13 @@ SYMBOL: +failed+
bi ;
: backend ( nodes word -- )
- build-cfg [ build-mr linear-scan generate save-asm ] each ;
+ build-cfg [
+ build-mr
+ linear-scan
+ build-stack-frame
+ generate
+ save-asm
+ ] each ;
: (compile) ( word -- )
'[
From 5885a924fc2cce6bfb8bd9f9b0c031cc37bdfe94 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Wed, 17 Sep 2008 19:59:22 -0700
Subject: [PATCH 13/87] Changing printf to use arguments from the stack.
---
extra/printf/printf-docs.factor | 10 ++---
extra/printf/printf-tests.factor | 76 ++++++++++++++++----------------
extra/printf/printf.factor | 60 ++++++++++---------------
3 files changed, 67 insertions(+), 79 deletions(-)
diff --git a/extra/printf/printf-docs.factor b/extra/printf/printf-docs.factor
index 21981b8b4a..ca26337026 100755
--- a/extra/printf/printf-docs.factor
+++ b/extra/printf/printf-docs.factor
@@ -39,23 +39,23 @@ HELP: printf
{ $examples
{ $example
"USING: printf ;"
- "{ 123 } \"%05d\" printf"
+ "123 \"%05d\" printf"
"00123" }
{ $example
"USING: printf ;"
- "{ HEX: ff } \"04X\" printf"
+ "HEX: ff \"04X\" printf"
"00FF" }
{ $example
"USING: printf ;"
- "{ 1.23456789 } \"%.3f\" printf"
+ "1.23456789 \"%.3f\" printf"
"1.234" }
{ $example
"USING: printf ;"
- "{ 1234567890 } \"%.5e\" printf"
+ "1234567890 \"%.5e\" printf"
"1.23456e+09" }
{ $example
"USING: printf ;"
- "{ 12 } \"%'#4d\" printf"
+ "12 \"%'#4d\" printf"
"##12" }
} ;
diff --git a/extra/printf/printf-tests.factor b/extra/printf/printf-tests.factor
index 7d89b35ae9..9a608cbffc 100644
--- a/extra/printf/printf-tests.factor
+++ b/extra/printf/printf-tests.factor
@@ -5,96 +5,96 @@ USING: kernel printf tools.test ;
[ "%s" printf ] must-infer
-[ t ] [ "10" { 10 } "%d" sprintf = ] unit-test
+[ t ] [ "10" 10 "%d" sprintf = ] unit-test
-[ t ] [ "123.456" { 123.456 } "%f" sprintf = ] unit-test
+[ t ] [ "123.456" 123.456 "%f" sprintf = ] unit-test
-[ t ] [ "123.10" { 123.1 } "%01.2f" sprintf = ] unit-test
+[ t ] [ "123.10" 123.1 "%01.2f" sprintf = ] unit-test
-[ t ] [ "1.2345" { 1.23456789 } "%.4f" sprintf = ] unit-test
+[ t ] [ "1.2345" 1.23456789 "%.4f" sprintf = ] unit-test
-[ t ] [ " 1.23" { 1.23456789 } "%6.2f" sprintf = ] unit-test
+[ t ] [ " 1.23" 1.23456789 "%6.2f" sprintf = ] unit-test
-[ t ] [ "1.234e+08" { 123400000 } "%e" sprintf = ] unit-test
+[ t ] [ "1.234e+08" 123400000 "%e" sprintf = ] unit-test
-[ t ] [ "1.234567e+08" { 123456700 } "%e" sprintf = ] unit-test
+[ t ] [ "1.234567e+08" 123456700 "%e" sprintf = ] unit-test
-[ t ] [ "3.625e+08" { 362525200 } "%.3e" sprintf = ] unit-test
+[ t ] [ "3.625e+08" 362525200 "%.3e" sprintf = ] unit-test
-[ t ] [ "2.5e-03" { 0.0025 } "%e" sprintf = ] unit-test
+[ t ] [ "2.5e-03" 0.0025 "%e" sprintf = ] unit-test
-[ t ] [ "2.5E-03" { 0.0025 } "%E" sprintf = ] unit-test
+[ t ] [ "2.5E-03" 0.0025 "%E" sprintf = ] unit-test
-[ t ] [ "ff" { HEX: ff } "%x" sprintf = ] unit-test
+[ t ] [ "ff" HEX: ff "%x" sprintf = ] unit-test
-[ t ] [ "FF" { HEX: ff } "%X" sprintf = ] unit-test
+[ t ] [ "FF" HEX: ff "%X" sprintf = ] unit-test
-[ t ] [ "0f" { HEX: f } "%02x" sprintf = ] unit-test
+[ t ] [ "0f" HEX: f "%02x" sprintf = ] unit-test
-[ t ] [ "0F" { HEX: f } "%02X" sprintf = ] unit-test
+[ t ] [ "0F" HEX: f "%02X" sprintf = ] unit-test
[ t ] [ "2008-09-10"
- { 2008 9 10 } "%04d-%02d-%02d" sprintf = ] unit-test
+ 2008 9 10 "%04d-%02d-%02d" sprintf = ] unit-test
[ t ] [ "Hello, World!"
- { "Hello, World!" } "%s" sprintf = ] unit-test
+ "Hello, World!" "%s" sprintf = ] unit-test
[ t ] [ "printf test"
- { } "printf test" sprintf = ] unit-test
+ "printf test" sprintf = ] unit-test
[ t ] [ "char a = 'a'"
- { CHAR: a } "char %c = 'a'" sprintf = ] unit-test
+ CHAR: a "char %c = 'a'" sprintf = ] unit-test
-[ t ] [ "00" { HEX: 0 } "%02x" sprintf = ] unit-test
+[ t ] [ "00" HEX: 0 "%02x" sprintf = ] unit-test
-[ t ] [ "ff" { HEX: ff } "%02x" sprintf = ] unit-test
+[ t ] [ "ff" HEX: ff "%02x" sprintf = ] unit-test
[ t ] [ "0 message(s)"
- { 0 "message" } "%d %s(s)%" sprintf = ] unit-test
+ 0 "message" "%d %s(s)" sprintf = ] unit-test
[ t ] [ "0 message(s) with %"
- { 0 "message" } "%d %s(s) with %%" sprintf = ] unit-test
+ 0 "message" "%d %s(s) with %%" sprintf = ] unit-test
[ t ] [ "justif: \"left \""
- { "left" } "justif: \"%-10s\"" sprintf = ] unit-test
+ "left" "justif: \"%-10s\"" sprintf = ] unit-test
[ t ] [ "justif: \" right\""
- { "right" } "justif: \"%10s\"" sprintf = ] unit-test
+ "right" "justif: \"%10s\"" sprintf = ] unit-test
[ t ] [ " 3: 0003 zero padded"
- { 3 } " 3: %04d zero padded" sprintf = ] unit-test
+ 3 " 3: %04d zero padded" sprintf = ] unit-test
[ t ] [ " 3: 3 left justif"
- { 3 } " 3: %-4d left justif" sprintf = ] unit-test
+ 3 " 3: %-4d left justif" sprintf = ] unit-test
[ t ] [ " 3: 3 right justif"
- { 3 } " 3: %4d right justif" sprintf = ] unit-test
+ 3 " 3: %4d right justif" sprintf = ] unit-test
[ t ] [ " -3: -003 zero padded"
- { -3 } " -3: %04d zero padded" sprintf = ] unit-test
+ -3 " -3: %04d zero padded" sprintf = ] unit-test
[ t ] [ " -3: -3 left justif"
- { -3 } " -3: %-4d left justif" sprintf = ] unit-test
+ -3 " -3: %-4d left justif" sprintf = ] unit-test
[ t ] [ " -3: -3 right justif"
- { -3 } " -3: %4d right justif" sprintf = ] unit-test
+ -3 " -3: %4d right justif" sprintf = ] unit-test
[ t ] [ "There are 10 monkeys in the kitchen"
- { 10 "kitchen" } "There are %d monkeys in the %s" sprintf = ] unit-test
+ 10 "kitchen" "There are %d monkeys in the %s" sprintf = ] unit-test
-[ f ] [ "%d" { 10 } "%d" sprintf = ] unit-test
+[ f ] [ "%d" 10 "%d" sprintf = ] unit-test
-[ t ] [ "[monkey]" { "monkey" } "[%s]" sprintf = ] unit-test
+[ t ] [ "[monkey]" "monkey" "[%s]" sprintf = ] unit-test
-[ t ] [ "[ monkey]" { "monkey" } "[%10s]" sprintf = ] unit-test
+[ t ] [ "[ monkey]" "monkey" "[%10s]" sprintf = ] unit-test
-[ t ] [ "[monkey ]" { "monkey" } "[%-10s]" sprintf = ] unit-test
+[ t ] [ "[monkey ]" "monkey" "[%-10s]" sprintf = ] unit-test
-[ t ] [ "[0000monkey]" { "monkey" } "[%010s]" sprintf = ] unit-test
+[ t ] [ "[0000monkey]" "monkey" "[%010s]" sprintf = ] unit-test
-[ t ] [ "[####monkey]" { "monkey" } "[%'#10s]" sprintf = ] unit-test
+[ t ] [ "[####monkey]" "monkey" "[%'#10s]" sprintf = ] unit-test
-[ t ] [ "[many monke]" { "many monkeys" } "[%10.10s]" sprintf = ] unit-test
+[ t ] [ "[many monke]" "many monkeys" "[%10.10s]" sprintf = ] unit-test
diff --git a/extra/printf/printf.factor b/extra/printf/printf.factor
index b24e58d6cc..4c66db3661 100644
--- a/extra/printf/printf.factor
+++ b/extra/printf/printf.factor
@@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license
USING: io io.encodings.ascii io.files io.streams.string
-kernel sequences splitting strings vectors math math.parser macros
-fry peg.ebnf unicode.case arrays prettyprint quotations ;
+kernel sequences splitting strings math math.parser macros
+fry peg.ebnf unicode.case arrays quotations vectors ;
IN: printf
@@ -12,12 +12,6 @@ IN: printf
: compose-all ( seq -- quot )
[ ] [ compose ] reduce ;
-: write-all ( seq -- quot )
- [ [ write ] append ] map ;
-
-: apply-format ( params quot -- params string )
- [ dup pop ] dip call ; inline
-
: fix-neg ( string -- string )
dup CHAR: 0 swap index 0 =
[ dup CHAR: - swap index dup
@@ -47,61 +41,55 @@ IN: printf
EBNF: parse-format-string
-plain-text = (!("%").)+ => [[ >string 1quotation ]]
+zero = "0" => [[ CHAR: 0 ]]
+char = "'" (.) => [[ second ]]
-percents = "%" => [[ '[ "%" ] ]]
-
-pad-zero = "0" => [[ CHAR: 0 ]]
-pad-char = "'" (.) => [[ second ]]
-pad-char_ = (pad-zero|pad-char)? => [[ CHAR: \s or 1quotation ]]
+pad-char = (zero|char)? => [[ CHAR: \s or 1quotation ]]
pad-align = ("-")? => [[ [ [ pad-right ] ] [ [ pad-left ] ] if ]]
pad-width = ([0-9])* => [[ >digits 1quotation ]]
-pad = pad-align pad-char_ pad-width => [[ reverse compose-all ]]
+pad = pad-align pad-char pad-width => [[ reverse compose-all [ first ] keep swap 0 = [ drop [ ] ] when ]]
-width = "." ([0-9])* => [[ second >digits '[ _ max-width ] ]]
-width_ = (width)? => [[ [ ] or ]]
+width_ = "." ([0-9])* => [[ second >digits '[ _ max-width ] ]]
+width = (width_)? => [[ [ ] or ]]
-digits = "." ([0-9])* => [[ second >digits '[ _ max-digits ] ]]
-digits_ = (digits)? => [[ [ ] or ]]
+digits_ = "." ([0-9])* => [[ second >digits '[ _ max-digits ] ]]
+digits = (digits_)? => [[ [ ] or ]]
+fmt-% = "%" => [[ [ "%" ] ]]
fmt-c = "c" => [[ [ 1string ] ]]
fmt-C = "C" => [[ [ 1string >upper ] ]]
-chars = (fmt-c | fmt-C) => [[ '[ _ apply-format ] ]]
-
fmt-s = "s" => [[ [ ] ]]
fmt-S = "S" => [[ [ >upper ] ]]
-strings = pad width_ (fmt-s | fmt-S) => [[ reverse compose-all '[ _ apply-format ] ]]
-
fmt-d = "d" => [[ [ >fixnum number>string ] ]]
-decimals = fmt-d
-
fmt-e = "e" => [[ [ >exponential ] ]]
fmt-E = "E" => [[ [ >exponential >upper ] ]]
-exps = digits_ (fmt-e | fmt-E) => [[ reverse [ swap ] join [ swap append ] append ]]
-
fmt-f = "f" => [[ [ >float number>string ] ]]
-floats = digits_ fmt-f => [[ reverse compose-all ]]
-
fmt-x = "x" => [[ [ >hex ] ]]
fmt-X = "X" => [[ [ >hex >upper ] ]]
+unknown = (.)* => [[ "Unknown directive" throw ]]
+
+chars = fmt-c | fmt-C
+strings = pad width (fmt-s|fmt-S) => [[ reverse compose-all ]]
+decimals = fmt-d
+exps = digits (fmt-e|fmt-E) => [[ reverse [ swap ] join [ swap append ] append ]]
+floats = digits fmt-f => [[ reverse compose-all ]]
hex = fmt-x | fmt-X
+numbers = pad (decimals|floats|hex|exps) => [[ reverse compose-all [ fix-neg ] append ]]
-numbers = (pad) (decimals|floats|hex|exps) => [[ reverse compose-all [ fix-neg ] append '[ _ apply-format ] ]]
+formats = "%" (chars|strings|numbers|fmt-%|unknown) => [[ second '[ _ dip ] ]]
-formats = "%" (chars|strings|numbers|percents) => [[ second ]]
+plain-text = (!("%").)+ => [[ >string '[ _ swap ] ]]
-text = (formats|plain-text)* => [[ write-all compose-all ]]
+text = (formats|plain-text)* => [[ reverse [ [ dup [ push ] dip ] append ] map ]]
;EBNF
PRIVATE>
MACRO: printf ( format-string -- )
- parse-format-string '[ reverse >vector @ drop ] ;
+ parse-format-string [ length ] keep compose-all '[ _ <vector> @ reverse [ write ] each ] ;
-: sprintf ( params format-string -- result )
+: sprintf ( format-string -- )
[ printf ] with-string-writer ;
-: fprintf ( filename params format-string -- )
- rot ascii [ printf ] with-file-appender ;
From 1a865f89ac487ebce50d4236ecd67c6b3bd5677c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 17 Sep 2008 22:18:08 -0500
Subject: [PATCH 14/87] Some optimizer change sfores for new codegen
---
basis/compiler/intrinsics/intrinsics.factor | 34 +++++++++++++++----
.../tree/propagation/info/info.factor | 6 ++++
core/layouts/layouts.factor | 4 ++-
3 files changed, 37 insertions(+), 7 deletions(-)
diff --git a/basis/compiler/intrinsics/intrinsics.factor b/basis/compiler/intrinsics/intrinsics.factor
index b995e6d737..471c05ee59 100644
--- a/basis/compiler/intrinsics/intrinsics.factor
+++ b/basis/compiler/intrinsics/intrinsics.factor
@@ -4,20 +4,42 @@ USING: kernel classes.tuple classes.tuple.private math arrays
byte-arrays words stack-checker.known-words ;
IN: compiler.intrinsics
-: (tuple) ( layout -- tuple )
- "BUG: missing (tuple) intrinsic" throw ;
+ERROR: missing-intrinsic ;
+
+: (tuple) ( n -- tuple ) missing-intrinsic ;
\ (tuple) { tuple-layout } { tuple } define-primitive
\ (tuple) make-flushable
-: (array) ( n -- array )
- "BUG: missing (array) intrinsic" throw ;
+: (array) ( n -- array ) missing-intrinsic ;
\ (array) { integer } { array } define-primitive
\ (array) make-flushable
-: (byte-array) ( n -- byte-array )
- "BUG: missing (byte-array) intrinsic" throw ;
+: (byte-array) ( n -- byte-array ) missing-intrinsic ;
\ (byte-array) { integer } { byte-array } define-primitive
\ (byte-array) make-flushable
+
+: (ratio) ( -- ratio ) missing-intrinsic ;
+
+\ (ratio) { } { ratio } define-primitive
+\ (ratio) make-flushable
+
+: (complex) ( -- complex ) missing-intrinsic ;
+
+\ (complex) { } { complex } define-primitive
+\ (complex) make-flushable
+
+: (wrapper) ( -- wrapper ) missing-intrinsic ;
+
+\ (wrapper) { } { wrapper } define-primitive
+\ (wrapper) make-flushable
+
+: (set-slot) ( val obj n -- ) missing-intrinsic ;
+
+\ (set-slot) { object object fixnum } { } define-primitive
+
+: (write-barrier) ( obj -- ) missing-intrinsic ;
+
+\ (write-barrier) { object } { } define-primitive
diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor
index 0891a6629c..5f8de4eb49 100644
--- a/basis/compiler/tree/propagation/info/info.factor
+++ b/basis/compiler/tree/propagation/info/info.factor
@@ -298,6 +298,12 @@ SYMBOL: value-infos
: node-output-infos ( node -- seq )
dup out-d>> [ node-value-info ] with map ;
+: first-literal ( #call -- obj )
+ dup in-d>> first node-value-info literal>> ;
+
+: last-literal ( #call -- obj )
+ dup out-d>> peek node-value-info literal>> ;
+
: immutable-tuple-boa? ( #call -- ? )
dup word>> \ <tuple-boa> eq? [
dup in-d>> peek node-value-info
diff --git a/core/layouts/layouts.factor b/core/layouts/layouts.factor
index 4788af1a91..6bd5367528 100755
--- a/core/layouts/layouts.factor
+++ b/core/layouts/layouts.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces math words kernel assocs classes
math.order kernel.private ;
@@ -74,3 +74,5 @@ M: bignum >integer
M: real >integer
dup most-negative-fixnum most-positive-fixnum between?
[ >fixnum ] [ >bignum ] if ;
+
+UNION: immediate fixnum POSTPONE: f ;
From 3a83c1e895c76e72f66bfe760bd404fe7002d95f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 17 Sep 2008 22:40:51 -0500
Subject: [PATCH 15/87] Improve resource-path behavior on NetBSD and OpenBSD
---
core/io/files/files.factor | 10 +++++++---
1 file changed, 7 insertions(+), 3 deletions(-)
diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index e52799d10a..6a04410559 100755
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -192,11 +192,15 @@ PRIVATE>
SYMBOL: current-directory
-[ cwd current-directory set-global ] "io.files" add-init-hook
+[
+ cwd current-directory set-global
+ image parent-directory "./" ?head
+ [ cwd prepend-path ] when
+ "resource-path" set
+] "io.files" add-init-hook
: resource-path ( path -- newpath )
- "resource-path" get [ image parent-directory ] unless*
- prepend-path ;
+ "resource-path" get prepend-path ;
: (normalize-path) ( path -- path' )
"resource:" ?head [
From 34faf1f78609c0831276bb755629a21727d0b0c8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 17 Sep 2008 23:28:54 -0500
Subject: [PATCH 16/87] Fix cache polution issue
---
basis/bootstrap/image/image.factor | 16 ++++++++--------
1 file changed, 8 insertions(+), 8 deletions(-)
diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor
index 9284728a7a..f18232b7c4 100755
--- a/basis/bootstrap/image/image.factor
+++ b/basis/bootstrap/image/image.factor
@@ -412,14 +412,14 @@ M: quotation '
all-words [ emit-word ] each ;
: emit-global ( -- )
- [
- {
- dictionary source-files builtins
- update-map implementors-map class<=-cache
- class-not-cache classes-intersect-cache class-and-cache
- class-or-cache
- } [ dup get swap bootstrap-word set ] each
- ] H{ } make-assoc
+ {
+ dictionary source-files builtins
+ update-map implementors-map
+ } [ [ bootstrap-word ] [ get ] bi ] H{ } map>assoc
+ {
+ class<=-cache class-not-cache classes-intersect-cache
+ class-and-cache class-or-cache
+ } [ H{ } clone ] H{ } map>assoc assoc-union
bootstrap-global set
bootstrap-global emit-userenv ;
From 562118e158bb33f2c848a8777c2d48d60ba8c12d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 18 Sep 2008 00:20:51 -0500
Subject: [PATCH 17/87] Better fix for *BSD resource path
---
basis/bootstrap/image/image.factor | 1 -
core/io/files/files.factor | 4 +---
2 files changed, 1 insertion(+), 4 deletions(-)
diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor
index f18232b7c4..f3f570b462 100755
--- a/basis/bootstrap/image/image.factor
+++ b/basis/bootstrap/image/image.factor
@@ -26,7 +26,6 @@ IN: bootstrap.image
"x86.32"
"x86.64"
"linux-ppc" "macosx-ppc"
- ! "arm"
} ;
<PRIVATE
diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index 6a04410559..58a08ed30c 100755
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -194,9 +194,7 @@ SYMBOL: current-directory
[
cwd current-directory set-global
- image parent-directory "./" ?head
- [ cwd prepend-path ] when
- "resource-path" set
+ image parent-directory cwd prepend-path "resource-path" set
] "io.files" add-init-hook
: resource-path ( path -- newpath )
From e966330bbb8ef5ce7759b2bfaffa8020db8d9db6 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Wed, 17 Sep 2008 23:11:02 -0700
Subject: [PATCH 18/87] printf: Allow positive sign to prefix numbers, add more
tests, fix negative numbers in exponentials.
---
extra/printf/printf-tests.factor | 24 ++++++++++++++++++++++++
extra/printf/printf.factor | 30 ++++++++++++++++++++----------
2 files changed, 44 insertions(+), 10 deletions(-)
diff --git a/extra/printf/printf-tests.factor b/extra/printf/printf-tests.factor
index 9a608cbffc..084553c54d 100644
--- a/extra/printf/printf-tests.factor
+++ b/extra/printf/printf-tests.factor
@@ -7,6 +7,16 @@ USING: kernel printf tools.test ;
[ t ] [ "10" 10 "%d" sprintf = ] unit-test
+[ t ] [ "+10" 10 "%+d" sprintf = ] unit-test
+
+[ t ] [ "-10" -10 "%d" sprintf = ] unit-test
+
+[ t ] [ " -10" -10 "%5d" sprintf = ] unit-test
+
+[ t ] [ "-0010" -10 "%05d" sprintf = ] unit-test
+
+[ t ] [ "+0010" 10 "%+05d" sprintf = ] unit-test
+
[ t ] [ "123.456" 123.456 "%f" sprintf = ] unit-test
[ t ] [ "123.10" 123.1 "%01.2f" sprintf = ] unit-test
@@ -17,6 +27,8 @@ USING: kernel printf tools.test ;
[ t ] [ "1.234e+08" 123400000 "%e" sprintf = ] unit-test
+[ t ] [ "-1.234e+08" -123400000 "%e" sprintf = ] unit-test
+
[ t ] [ "1.234567e+08" 123456700 "%e" sprintf = ] unit-test
[ t ] [ "3.625e+08" 362525200 "%.3e" sprintf = ] unit-test
@@ -25,6 +37,18 @@ USING: kernel printf tools.test ;
[ t ] [ "2.5E-03" 0.0025 "%E" sprintf = ] unit-test
+[ t ] [ " 1.0E+01" 10 "%10.1E" sprintf = ] unit-test
+
+[ t ] [ " -1.0E+01" -10 "%10.1E" sprintf = ] unit-test
+
+[ t ] [ " -1.0E+01" -10 "%+10.1E" sprintf = ] unit-test
+
+[ t ] [ " +1.0E+01" 10 "%+10.1E" sprintf = ] unit-test
+
+[ t ] [ "-001.0E+01" -10 "%+010.1E" sprintf = ] unit-test
+
+[ t ] [ "+001.0E+01" 10 "%+010.1E" sprintf = ] unit-test
+
[ t ] [ "ff" HEX: ff "%x" sprintf = ] unit-test
[ t ] [ "FF" HEX: ff "%X" sprintf = ] unit-test
diff --git a/extra/printf/printf.factor b/extra/printf/printf.factor
index 4c66db3661..346a344093 100644
--- a/extra/printf/printf.factor
+++ b/extra/printf/printf.factor
@@ -1,9 +1,9 @@
! Copyright (C) 2008 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
-USING: io io.encodings.ascii io.files io.streams.string
+USING: io io.encodings.ascii io.files io.streams.string combinators
kernel sequences splitting strings math math.parser macros
-fry peg.ebnf unicode.case arrays quotations vectors ;
+fry peg.ebnf ascii unicode.case arrays quotations vectors ;
IN: printf
@@ -12,11 +12,17 @@ IN: printf
: compose-all ( seq -- quot )
[ ] [ compose ] reduce ;
-: fix-neg ( string -- string )
+: fix-sign ( string -- string )
dup CHAR: 0 swap index 0 =
- [ dup CHAR: - swap index dup
- [ swap remove-nth "-" prepend ]
- [ drop ] if ] when ;
+ [ dup 0 swap [ [ CHAR: 0 = not ] keep digit? and ] find-from
+ [ dup 1- rot dup [ nth ] dip swap
+ {
+ { CHAR: - [ [ 1- ] dip remove-nth "-" prepend ] }
+ { CHAR: + [ [ 1- ] dip remove-nth "+" prepend ] }
+ [ drop swap drop ]
+ } case
+ ] [ drop ] if
+ ] when ;
: >digits ( string -- digits )
[ 0 ] [ string>number ] if-empty ;
@@ -28,16 +34,18 @@ IN: printf
[ dup length ] dip [ > ] keep swap [ head-slice >string ] [ drop ] if ;
: >exponential ( n -- base exp )
+ [ 0 < ] keep abs
0
- [ swap dup [ 10.0 > ] keep 1.0 < or ]
- [ dup 10.0 >
+ [ swap dup [ 10.0 >= ] keep 1.0 < or ]
+ [ dup 10.0 >=
[ 10.0 / [ 1+ ] dip swap ]
[ 10.0 * [ 1- ] dip swap ] if
] [ swap ] while
[ number>string ] dip
dup abs number>string 2 CHAR: 0 pad-left
[ 0 < [ "-" ] [ "+" ] if ] dip append
- "e" prepend ;
+ "e" prepend
+ rot [ [ "-" prepend ] dip ] when ;
EBNF: parse-format-string
@@ -49,6 +57,8 @@ pad-align = ("-")? => [[ [ [ pad-right ] ] [ [ pad-left ] ] if ]]
pad-width = ([0-9])* => [[ >digits 1quotation ]]
pad = pad-align pad-char pad-width => [[ reverse compose-all [ first ] keep swap 0 = [ drop [ ] ] when ]]
+sign = ("+")? => [[ [ [ dup CHAR: - swap index not [ "+" prepend ] when ] ] [ [ ] ] if ]]
+
width_ = "." ([0-9])* => [[ second >digits '[ _ max-width ] ]]
width = (width_)? => [[ [ ] or ]]
@@ -74,7 +84,7 @@ decimals = fmt-d
exps = digits (fmt-e|fmt-E) => [[ reverse [ swap ] join [ swap append ] append ]]
floats = digits fmt-f => [[ reverse compose-all ]]
hex = fmt-x | fmt-X
-numbers = pad (decimals|floats|hex|exps) => [[ reverse compose-all [ fix-neg ] append ]]
+numbers = sign pad (decimals|floats|hex|exps) => [[ reverse first3 swap 3append [ fix-sign ] append ]]
formats = "%" (chars|strings|numbers|fmt-%|unknown) => [[ second '[ _ dip ] ]]
From 37aaaf141683be563578cd64d03b69b4e9b87ee8 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 18 Sep 2008 12:26:26 -0700
Subject: [PATCH 19/87] Updated printf docs.
---
extra/printf/printf-docs.factor | 22 ++++++++++++++--------
1 file changed, 14 insertions(+), 8 deletions(-)
diff --git a/extra/printf/printf-docs.factor b/extra/printf/printf-docs.factor
index ca26337026..5025fa421f 100755
--- a/extra/printf/printf-docs.factor
+++ b/extra/printf/printf-docs.factor
@@ -9,19 +9,21 @@ HELP: printf
"Writes the arguments formatted according to the format string.\n"
{ $table
{ "%%" "Single %" "" }
- { "%Pd" "Integer format" "fixnum" }
- { "%P.De" "Scientific notation" "fixnum, float" }
- { "%P.DE" "Scientific notation" "fixnum, float" }
- { "%P.Df" "Fixed format" "fixnum, float" }
- { "%Px" "Hexadecimal" "hex" }
- { "%PX" "Hexadecimal uppercase" "hex" }
{ "%P.Ds" "String format" "string" }
{ "%P.DS" "String format uppercase" "string" }
{ "%c" "Character format" "char" }
{ "%C" "Character format uppercase" "char" }
+ { "%+Pd" "Integer format" "fixnum" }
+ { "%+P.De" "Scientific notation" "fixnum, float" }
+ { "%+P.DE" "Scientific notation" "fixnum, float" }
+ { "%+P.Df" "Fixed format" "fixnum, float" }
+ { "%+Px" "Hexadecimal" "hex" }
+ { "%+PX" "Hexadecimal uppercase" "hex" }
}
"\n"
- "Padding ('P') is used to specify the minimum width of the result string, the padding character, and the alignment. By default, the padding character defaults to a space and the alignment defaults to right-aligned. For example:\n"
+ "A plus sign ('+') is used to optionally specify that the number should be formatted with a '+' preceeding it if positive."
+ "\n"
+ "Padding ('P') is used to optionally specify the minimum width of the result string, the padding character, and the alignment. By default, the padding character defaults to a space and the alignment defaults to right-aligned. For example:\n"
{ $list
"\"%5s\" formats a string padding with spaces up to 5 characters wide."
"\"%08d\" formats an integer padding with zeros up to 3 characters wide."
@@ -29,7 +31,7 @@ HELP: printf
"\"%-10d\" formats an integer to 10 characters wide and left-aligns."
}
"\n"
- "Digits ('D') is used to specify the maximum digits in the result string. For example:\n"
+ "Digits ('D') is used to optionally specify the maximum digits in the result string. For example:\n"
{ $list
"\"%.3s\" formats a string to truncate at 3 characters (from the left)."
"\"%.10f\" formats a float to pad-right with zeros up to 10 digits beyond the decimal point."
@@ -57,6 +59,10 @@ HELP: printf
"USING: printf ;"
"12 \"%'#4d\" printf"
"##12" }
+ { $example
+ "USING: printf ;"
+ "1234 \"%+d\" printf"
+ "+1234" }
} ;
HELP: sprintf
From edc1a27fcd77525aef0591820b3052c2d03343ed Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Thu, 18 Sep 2008 15:18:32 -0700
Subject: [PATCH 20/87] Adding a summary for printf.
---
extra/printf/summary.txt | 1 +
1 file changed, 1 insertion(+)
create mode 100644 extra/printf/summary.txt
diff --git a/extra/printf/summary.txt b/extra/printf/summary.txt
new file mode 100644
index 0000000000..da1aa31abb
--- /dev/null
+++ b/extra/printf/summary.txt
@@ -0,0 +1 @@
+Format data according to a specified format string, and writes (or returns) the result string.
From 6d2a25efc3648b5b6840fbeccb779bf16c98e16e Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Sat, 20 Sep 2008 21:46:35 -0700
Subject: [PATCH 21/87] Some simplification to printf, more to come.
---
extra/printf/printf.factor | 11 +++++------
1 file changed, 5 insertions(+), 6 deletions(-)
diff --git a/extra/printf/printf.factor b/extra/printf/printf.factor
index 346a344093..2f23085644 100644
--- a/extra/printf/printf.factor
+++ b/extra/printf/printf.factor
@@ -31,11 +31,10 @@ IN: printf
[ "." split1 ] dip [ CHAR: 0 pad-right ] [ head-slice ] bi "." swap 3append ;
: max-width ( string length -- string )
- [ dup length ] dip [ > ] keep swap [ head-slice >string ] [ drop ] if ;
+ short head ;
: >exponential ( n -- base exp )
- [ 0 < ] keep abs
- 0
+ [ 0 < ] keep abs 0
[ swap dup [ 10.0 >= ] keep 1.0 < or ]
[ dup 10.0 >=
[ 10.0 / [ 1+ ] dip swap ]
@@ -43,7 +42,7 @@ IN: printf
] [ swap ] while
[ number>string ] dip
dup abs number>string 2 CHAR: 0 pad-left
- [ 0 < [ "-" ] [ "+" ] if ] dip append
+ [ 0 < "-" "+" ? ] dip append
"e" prepend
rot [ [ "-" prepend ] dip ] when ;
@@ -53,11 +52,11 @@ zero = "0" => [[ CHAR: 0 ]]
char = "'" (.) => [[ second ]]
pad-char = (zero|char)? => [[ CHAR: \s or 1quotation ]]
-pad-align = ("-")? => [[ [ [ pad-right ] ] [ [ pad-left ] ] if ]]
+pad-align = ("-")? => [[ [ pad-right ] [ pad-left ] ? ]]
pad-width = ([0-9])* => [[ >digits 1quotation ]]
pad = pad-align pad-char pad-width => [[ reverse compose-all [ first ] keep swap 0 = [ drop [ ] ] when ]]
-sign = ("+")? => [[ [ [ dup CHAR: - swap index not [ "+" prepend ] when ] ] [ [ ] ] if ]]
+sign = ("+")? => [[ [ dup CHAR: - swap index not [ "+" prepend ] when ] [ ] ? ]]
width_ = "." ([0-9])* => [[ second >digits '[ _ max-width ] ]]
width = (width_)? => [[ [ ] or ]]
From 7cbbd3e0e68aa9a259239957c2227839f66b36a3 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Sat, 20 Sep 2008 22:22:12 -0700
Subject: [PATCH 22/87] Some fixes to printf for help-lint warnings.
---
extra/printf/printf-docs.factor | 8 ++++----
extra/printf/printf-tests.factor | 2 ++
extra/printf/printf.factor | 4 ++--
3 files changed, 8 insertions(+), 6 deletions(-)
diff --git a/extra/printf/printf-docs.factor b/extra/printf/printf-docs.factor
index 5025fa421f..fabf6d1ddd 100755
--- a/extra/printf/printf-docs.factor
+++ b/extra/printf/printf-docs.factor
@@ -6,7 +6,7 @@ IN: printf
HELP: printf
{ $values { "format-string" string } }
{ $description
- "Writes the arguments formatted according to the format string.\n"
+ "Writes the arguments (specified on the stack) formatted according to the format string.\n"
{ $table
{ "%%" "Single %" "" }
{ "%P.Ds" "String format" "string" }
@@ -45,7 +45,7 @@ HELP: printf
"00123" }
{ $example
"USING: printf ;"
- "HEX: ff \"04X\" printf"
+ "HEX: ff \"%04X\" printf"
"00FF" }
{ $example
"USING: printf ;"
@@ -66,7 +66,7 @@ HELP: printf
} ;
HELP: sprintf
-{ $values { "params" sequence } { "format-string" string } { "result" string } }
-{ $description "Returns the arguments formatted according to the format string as a result string." }
+{ $values { "format-string" string } { "result" string } }
+{ $description "Returns the arguments (specified on the stack) formatted according to the format string as a result string." }
{ $see-also printf } ;
diff --git a/extra/printf/printf-tests.factor b/extra/printf/printf-tests.factor
index 084553c54d..b365343bf0 100644
--- a/extra/printf/printf-tests.factor
+++ b/extra/printf/printf-tests.factor
@@ -5,6 +5,8 @@ USING: kernel printf tools.test ;
[ "%s" printf ] must-infer
+[ "%s" sprintf ] must-infer
+
[ t ] [ "10" 10 "%d" sprintf = ] unit-test
[ t ] [ "+10" 10 "%+d" sprintf = ] unit-test
diff --git a/extra/printf/printf.factor b/extra/printf/printf.factor
index 2f23085644..c7a7153d6a 100644
--- a/extra/printf/printf.factor
+++ b/extra/printf/printf.factor
@@ -98,7 +98,7 @@ PRIVATE>
MACRO: printf ( format-string -- )
parse-format-string [ length ] keep compose-all '[ _ <vector> @ reverse [ write ] each ] ;
-: sprintf ( format-string -- )
- [ printf ] with-string-writer ;
+: sprintf ( format-string -- result )
+ [ printf ] with-string-writer ; inline
From 2d5778c5af7c0f36a0f2973775fab32beb6dc955 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Sat, 20 Sep 2008 22:39:12 -0700
Subject: [PATCH 23/87] Moving format specifications to a help article.
---
extra/printf/printf-docs.factor | 68 +++++++++++++++++----------------
1 file changed, 35 insertions(+), 33 deletions(-)
diff --git a/extra/printf/printf-docs.factor b/extra/printf/printf-docs.factor
index fabf6d1ddd..a6f18cef8e 100755
--- a/extra/printf/printf-docs.factor
+++ b/extra/printf/printf-docs.factor
@@ -5,39 +5,7 @@ IN: printf
HELP: printf
{ $values { "format-string" string } }
-{ $description
- "Writes the arguments (specified on the stack) formatted according to the format string.\n"
- { $table
- { "%%" "Single %" "" }
- { "%P.Ds" "String format" "string" }
- { "%P.DS" "String format uppercase" "string" }
- { "%c" "Character format" "char" }
- { "%C" "Character format uppercase" "char" }
- { "%+Pd" "Integer format" "fixnum" }
- { "%+P.De" "Scientific notation" "fixnum, float" }
- { "%+P.DE" "Scientific notation" "fixnum, float" }
- { "%+P.Df" "Fixed format" "fixnum, float" }
- { "%+Px" "Hexadecimal" "hex" }
- { "%+PX" "Hexadecimal uppercase" "hex" }
- }
- "\n"
- "A plus sign ('+') is used to optionally specify that the number should be formatted with a '+' preceeding it if positive."
- "\n"
- "Padding ('P') is used to optionally specify the minimum width of the result string, the padding character, and the alignment. By default, the padding character defaults to a space and the alignment defaults to right-aligned. For example:\n"
- { $list
- "\"%5s\" formats a string padding with spaces up to 5 characters wide."
- "\"%08d\" formats an integer padding with zeros up to 3 characters wide."
- "\"%'#5f\" formats a float padding with '#' up to 3 characters wide."
- "\"%-10d\" formats an integer to 10 characters wide and left-aligns."
- }
- "\n"
- "Digits ('D') is used to optionally specify the maximum digits in the result string. For example:\n"
- { $list
- "\"%.3s\" formats a string to truncate at 3 characters (from the left)."
- "\"%.10f\" formats a float to pad-right with zeros up to 10 digits beyond the decimal point."
- "\"%.5E\" formats a float into scientific notation with zeros up to 5 digits beyond the decimal point, but before the exponent."
- }
-}
+{ $description "Writes the arguments (specified on the stack) formatted according to the format string." }
{ $examples
{ $example
"USING: printf ;"
@@ -70,3 +38,37 @@ HELP: sprintf
{ $description "Returns the arguments (specified on the stack) formatted according to the format string as a result string." }
{ $see-also printf } ;
+ARTICLE: "printf" "Formatted printing"
+"The " { $vocab-link "printf" } " and " { $vocab-link "sprintf" } " words are used for formatted printing.\n"
+"\n"
+"Several format specifications exist for handling arguments of different types, and specifying attributes for the result string, including such things as maximum width, padding, and decimals.\n"
+{ $table
+ { "%%" "Single %" "" }
+ { "%P.Ds" "String format" "string" }
+ { "%P.DS" "String format uppercase" "string" }
+ { "%c" "Character format" "char" }
+ { "%C" "Character format uppercase" "char" }
+ { "%+Pd" "Integer format" "fixnum" }
+ { "%+P.De" "Scientific notation" "fixnum, float" }
+ { "%+P.DE" "Scientific notation" "fixnum, float" }
+ { "%+P.Df" "Fixed format" "fixnum, float" }
+ { "%+Px" "Hexadecimal" "hex" }
+ { "%+PX" "Hexadecimal uppercase" "hex" }
+}
+"\n"
+"A plus sign ('+') is used to optionally specify that the number should be formatted with a '+' preceeding it if positive."
+"\n"
+"Padding ('P') is used to optionally specify the minimum width of the result string, the padding character, and the alignment. By default, the padding character defaults to a space and the alignment defaults to right-aligned. For example:\n"
+{ $list
+ "\"%5s\" formats a string padding with spaces up to 5 characters wide."
+ "\"%08d\" formats an integer padding with zeros up to 3 characters wide."
+ "\"%'#5f\" formats a float padding with '#' up to 3 characters wide."
+ "\"%-10d\" formats an integer to 10 characters wide and left-aligns."
+}
+"\n"
+"Digits ('D') is used to optionally specify the maximum digits in the result string. For example:\n"
+{ $list
+ "\"%.3s\" formats a string to truncate at 3 characters (from the left)."
+ "\"%.10f\" formats a float to pad-right with zeros up to 10 digits beyond the decimal point."
+ "\"%.5E\" formats a float into scientific notation with zeros up to 5 digits beyond the decimal point, but before the exponent."
+} ;
From a9f2fbd4a2a7e62af25e9ed55b8a315ac5503024 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Sat, 20 Sep 2008 22:41:16 -0700
Subject: [PATCH 24/87] Fix newline.
---
extra/printf/printf-docs.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/printf/printf-docs.factor b/extra/printf/printf-docs.factor
index a6f18cef8e..fdecc2ad68 100755
--- a/extra/printf/printf-docs.factor
+++ b/extra/printf/printf-docs.factor
@@ -56,7 +56,7 @@ ARTICLE: "printf" "Formatted printing"
{ "%+PX" "Hexadecimal uppercase" "hex" }
}
"\n"
-"A plus sign ('+') is used to optionally specify that the number should be formatted with a '+' preceeding it if positive."
+"A plus sign ('+') is used to optionally specify that the number should be formatted with a '+' preceeding it if positive.\n"
"\n"
"Padding ('P') is used to optionally specify the minimum width of the result string, the padding character, and the alignment. By default, the padding character defaults to a space and the alignment defaults to right-aligned. For example:\n"
{ $list
From 6032bdf8e664093e8e0d2b5c6f6c970a34b84af0 Mon Sep 17 00:00:00 2001
From: Alexander Solovyov <piranha@piranha.org.ua>
Date: Sat, 12 Apr 2008 19:10:34 +0300
Subject: [PATCH 25/87] first efforts to get indentation in emacs
---
misc/factor.el | 45 +++++++++++++++++++++++++++++++++++++++++++--
1 file changed, 43 insertions(+), 2 deletions(-)
diff --git a/misc/factor.el b/misc/factor.el
index 5c9d050468..af6ec6c95c 100644
--- a/misc/factor.el
+++ b/misc/factor.el
@@ -111,6 +111,7 @@
(use-local-map factor-mode-map)
(setq major-mode 'factor-mode)
(setq mode-name "Factor")
+ (set (make-local-variable 'indent-line-function) #'factor-indent-line)
(make-local-variable 'comment-start)
(setq comment-start "! ")
(make-local-variable 'font-lock-defaults)
@@ -224,6 +225,48 @@
(define-key factor-mode-map "\C-c\C-h" 'factor-help)
(define-key factor-mode-map "\C-cc" 'comment-region)
(define-key factor-mode-map [return] 'newline-and-indent)
+(define-key factor-mode-map [tab] 'indent-for-tab-command)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; factor-indent-line
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun factor-calculate-indentation ()
+ "Calculate Factor indentation for line at point."
+ (let ((not-indented t)
+ (cur-indent 0))
+ (save-excursion
+ (beginning-of-line)
+ (if (bobp)
+ (setq cur-indent 0)
+ (save-excursion
+ (while not-indented
+ (forward-line -1)
+ ;; Check that we are after the end of previous word
+ (if (looking-at ".*;[ \t]*$")
+ (progn
+ (setq cur-indent (- (current-indentation) default-tab-width))
+ (setq not-indented nil))
+ (if (looking-at "^\\(\\|:\\): ")
+ (progn
+ (setq cur-indent (+ (current-indentation) default-tab-width))
+ (setq not-indented nil))
+ (if (bobp)
+ (setq not-indented nil))))))))
+ cur-indent))
+
+(defun factor-indent-line ()
+ "Indent current line as Factor code"
+ (let ((target (factor-calculate-indentation))
+ (pos (- (point-max) (point))))
+ (if (= target (current-indentation))
+ (if (< (current-column) (current-indentation))
+ (back-to-indentation))
+ (beginning-of-line)
+ (delete-horizontal-space)
+ (indent-to target)
+ (if (> (- (point-max) pos) (point))
+ (goto-char (- (point-max) pos))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; factor-listener-mode
@@ -244,5 +287,3 @@
(defun factor-refresh-all ()
(interactive)
(comint-send-string "*factor*" "refresh-all\n"))
-
-
From 22c10e8f4f133f043e6106e9de65d466db7da133 Mon Sep 17 00:00:00 2001
From: Alexander Solovyov <piranha@piranha.org.ua>
Date: Mon, 28 Apr 2008 23:36:54 +0300
Subject: [PATCH 26/87] Got Emacs' factor-mode indentation working with
non-closed brackets
---
misc/factor.el | 40 ++++++++++++++++++++++++++++------------
1 file changed, 28 insertions(+), 12 deletions(-)
diff --git a/misc/factor.el b/misc/factor.el
index af6ec6c95c..402dfdf484 100644
--- a/misc/factor.el
+++ b/misc/factor.el
@@ -76,7 +76,7 @@
(modify-syntax-entry ?\" "\" " factor-mode-syntax-table)))
(defvar factor-mode-map (make-sparse-keymap))
-
+
(defcustom factor-mode-hook nil
"Hook run when entering Factor mode."
:type 'hook
@@ -211,7 +211,7 @@
(defun factor-clear ()
(interactive)
(factor-send-string "clear"))
-
+
(defun factor-comment-line ()
(interactive)
(beginning-of-line)
@@ -241,19 +241,35 @@
(setq cur-indent 0)
(save-excursion
(while not-indented
- (forward-line -1)
- ;; Check that we are after the end of previous word
- (if (looking-at ".*;[ \t]*$")
+ ;; Check that we are inside open brackets
+ (if (> (factor-brackets-depth) 0)
(progn
- (setq cur-indent (- (current-indentation) default-tab-width))
- (setq not-indented nil))
- (if (looking-at "^\\(\\|:\\): ")
+ (let ((cur-depth (factor-brackets-depth)))
+ (forward-line -1)
+ (setq cur-indent (+ (current-indentation)
+ (* default-tab-width
+ (- cur-depth (factor-brackets-depth)))))
+ (setq not-indented nil)))
+ (forward-line -1)
+ ;; Check that we are after the end of previous word
+ (if (looking-at ".*;[ \t]*$")
(progn
- (setq cur-indent (+ (current-indentation) default-tab-width))
+ (setq cur-indent (- (current-indentation) default-tab-width))
(setq not-indented nil))
- (if (bobp)
- (setq not-indented nil))))))))
- cur-indent))
+ ;; Check that we are after the start of word
+ (if (looking-at "^\\(\\|:\\): ")
+ (progn
+ (setq cur-indent (+ (current-indentation) default-tab-width))
+ (setq not-indented nil))
+ (if (bobp)
+ (setq not-indented nil)))))))))
+ cur-indent))
+
+(defun factor-brackets-depth ()
+ "Returns number of brackets, not closed on previous lines."
+ (syntax-ppss-depth
+ (save-excursion
+ (syntax-ppss (line-beginning-position)))))
(defun factor-indent-line ()
"Indent current line as Factor code"
From 83ef3149fe6739b7e623cfcf24098929110ae4ec Mon Sep 17 00:00:00 2001
From: Alexander Solovyov <piranha@piranha.org.ua>
Date: Sun, 21 Sep 2008 18:42:48 +0300
Subject: [PATCH 27/87] Upgraded version of emacs indentation
---
misc/factor.el | 33 +++++++++++++++++++++------------
1 file changed, 21 insertions(+), 12 deletions(-)
diff --git a/misc/factor.el b/misc/factor.el
index 402dfdf484..1ae8919559 100644
--- a/misc/factor.el
+++ b/misc/factor.el
@@ -228,9 +228,17 @@
(define-key factor-mode-map [tab] 'indent-for-tab-command)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; factor-indent-line
+;; indentation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defconst factor-word-starting-keywords
+ '("" ":" "TUPLE" "MACRO" "MACRO:" "M"))
+
+(defmacro factor-word-start-re (keywords)
+ `(format
+ "^\\(%s\\): "
+ (mapconcat 'identity ,keywords "\\|")))
+
(defun factor-calculate-indentation ()
"Calculate Factor indentation for line at point."
(let ((not-indented t)
@@ -242,27 +250,28 @@
(save-excursion
(while not-indented
;; Check that we are inside open brackets
- (if (> (factor-brackets-depth) 0)
- (progn
- (let ((cur-depth (factor-brackets-depth)))
- (forward-line -1)
- (setq cur-indent (+ (current-indentation)
- (* default-tab-width
- (- cur-depth (factor-brackets-depth)))))
- (setq not-indented nil)))
- (forward-line -1)
+ (save-excursion
+ (let ((cur-depth (factor-brackets-depth)))
+ (forward-line -1)
+ (setq cur-indent (+ (current-indentation)
+ (* default-tab-width
+ (- cur-depth (factor-brackets-depth)))))
+ (setq not-indented nil)))
+ (forward-line -1)
;; Check that we are after the end of previous word
(if (looking-at ".*;[ \t]*$")
(progn
(setq cur-indent (- (current-indentation) default-tab-width))
(setq not-indented nil))
;; Check that we are after the start of word
- (if (looking-at "^\\(\\|:\\): ")
+ (if (looking-at (factor-word-start-re factor-word-starting-keywords))
+; (if (looking-at "^[A-Z:]*: ")
(progn
+ (message "inword")
(setq cur-indent (+ (current-indentation) default-tab-width))
(setq not-indented nil))
(if (bobp)
- (setq not-indented nil)))))))))
+ (setq not-indented nil))))))))
cur-indent))
(defun factor-brackets-depth ()
From c5a3f89b0409487b8bc1e178d635f668efa4405f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 21 Sep 2008 11:58:09 -0500
Subject: [PATCH 28/87] add feed:// since firefox and safari support it, throw
a better error than "fall-through in case"
---
basis/urls/urls.factor | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor
index 4f2639975b..f4a6a7d792 100644
--- a/basis/urls/urls.factor
+++ b/basis/urls/urls.factor
@@ -212,11 +212,15 @@ PRIVATE>
[ [ host>> ] [ port>> ] bi <inet> ] [ protocol>> ] bi
secure-protocol? [ <secure> ] when ;
+ERROR: no-protocol-found protocol ;
+
: protocol-port ( protocol -- port )
{
{ "http" [ 80 ] }
{ "https" [ 443 ] }
+ { "feed" [ 80 ] }
{ "ftp" [ 21 ] }
+ [ no-protocol-found ]
} case ;
: ensure-port ( url -- url' )
From e9b30d2bbce0ee1dfcefadb63fe0b26385c6b639 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 21 Sep 2008 19:42:05 -0500
Subject: [PATCH 29/87] Debugging asides and conversation scope
---
basis/furnace/actions/actions.factor | 2 +-
basis/furnace/alloy/alloy.factor | 7 +-
basis/furnace/asides/asides.factor | 111 ++++++++++++++++++
.../deactivate-user/deactivate-user.factor | 2 +-
.../features/edit-profile/edit-profile.factor | 4 +-
.../recover-password/recover-password.factor | 2 +-
basis/furnace/auth/login/login.factor | 13 +-
basis/furnace/chloe-tags/chloe-tags.factor | 2 +-
.../conversations/conversations.factor | 85 ++------------
basis/furnace/furnace.factor | 12 ++
basis/furnace/redirection/redirection.factor | 2 +-
basis/furnace/sessions/sessions.factor | 4 +
basis/furnace/syndication/syndication.factor | 4 +-
13 files changed, 160 insertions(+), 90 deletions(-)
create mode 100644 basis/furnace/asides/asides.factor
diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor
index 6e55ca44a0..2a63489299 100755
--- a/basis/furnace/actions/actions.factor
+++ b/basis/furnace/actions/actions.factor
@@ -86,7 +86,7 @@ TUPLE: action rest authorize init display validate submit ;
begin-conversation
nested-forms-key param " " split harvest nested-forms cset
form get form cset
- <redirect>
+ <continue-conversation>
] [ <400> ] if*
exit-with ;
diff --git a/basis/furnace/alloy/alloy.factor b/basis/furnace/alloy/alloy.factor
index 6f5f6fdbf6..f27c7d67c0 100644
--- a/basis/furnace/alloy/alloy.factor
+++ b/basis/furnace/alloy/alloy.factor
@@ -3,6 +3,7 @@
USING: kernel sequences db.tuples alarms calendar db fry
furnace.db
furnace.cache
+furnace.asides
furnace.referrer
furnace.sessions
furnace.conversations
@@ -12,17 +13,17 @@ IN: furnace.alloy
: <alloy> ( responder db params -- responder' )
'[
+ <asides>
<conversations>
<sessions>
_ _ <db-persistence>
<check-form-submissions>
] call ;
-: state-classes { session conversation permit } ; inline
+: state-classes { session aside conversation permit user } ; inline
: init-furnace-tables ( -- )
- state-classes ensure-tables
- user ensure-table ;
+ state-classes ensure-tables ;
: start-expiring ( db params -- )
'[
diff --git a/basis/furnace/asides/asides.factor b/basis/furnace/asides/asides.factor
new file mode 100644
index 0000000000..6d4196cf0b
--- /dev/null
+++ b/basis/furnace/asides/asides.factor
@@ -0,0 +1,111 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: namespaces assocs kernel sequences accessors hashtables
+urls db.types db.tuples math.parser fry logging combinators
+html.templates.chloe.syntax
+http http.server http.server.filters http.server.redirection
+furnace
+furnace.cache
+furnace.sessions
+furnace.redirection ;
+IN: furnace.asides
+
+TUPLE: aside < server-state
+session method url post-data ;
+
+: <aside> ( id -- aside )
+ aside new-server-state ;
+
+aside "ASIDES" {
+ { "session" "SESSION" BIG-INTEGER +not-null+ }
+ { "method" "METHOD" { VARCHAR 10 } }
+ { "url" "URL" URL }
+ { "post-data" "POST_DATA" FACTOR-BLOB }
+} define-persistent
+
+: aside-id-key "__a" ;
+
+TUPLE: asides < server-state-manager ;
+
+: <asides> ( responder -- responder' )
+ asides new-server-state-manager ;
+
+SYMBOL: aside-id
+
+: get-aside ( id -- aside )
+ dup [ aside get-state ] when check-session ;
+
+: request-aside-id ( request -- id )
+ aside-id-key swap request-params at string>number ;
+
+: request-aside ( request -- aside )
+ request-aside-id get-aside ;
+
+: set-aside ( aside -- )
+ [ id>> aside-id set ] when* ;
+
+: init-asides ( asides -- )
+ asides set
+ request get request-aside-id
+ get-aside
+ set-aside ;
+
+M: asides call-responder*
+ [ init-asides ] [ asides set ] [ call-next-method ] tri ;
+
+: touch-aside ( aside -- )
+ asides get touch-state ;
+
+: begin-aside ( url -- )
+ f <aside>
+ swap >>url
+ session get id>> >>session
+ request get method>> >>method
+ request get post-data>> >>post-data
+ [ touch-aside ] [ insert-tuple ] [ set-aside ] tri ;
+
+: end-aside-post ( aside -- response )
+ [ url>> ] [ post-data>> ] bi
+ request [
+ clone
+ swap >>post-data
+ over >>url
+ ] change
+ [ url set ] [ path>> split-path ] bi
+ asides get responder>> call-responder ;
+
+\ end-aside-post DEBUG add-input-logging
+
+ERROR: end-aside-in-get-error ;
+
+: move-on ( id -- response )
+ post-request? [ end-aside-in-get-error ] unless
+ dup method>> {
+ { "GET" [ url>> <redirect> ] }
+ { "HEAD" [ url>> <redirect> ] }
+ { "POST" [ end-aside-post ] }
+ } case ;
+
+: end-aside ( default -- response )
+ aside-id get aside-id off get-aside [ move-on ] [ <redirect> ] ?if ;
+
+M: asides link-attr ( tag -- )
+ drop
+ "aside" optional-attr {
+ { "none" [ aside-id off ] }
+ { "begin" [ url get begin-aside ] }
+ { "current" [ ] }
+ { f [ ] }
+ } case ;
+
+M: asides modify-query ( query asides -- query' )
+ drop
+ aside-id get [
+ aside-id-key associate assoc-union
+ ] when* ;
+
+M: asides modify-form ( asides -- )
+ drop
+ aside-id get
+ aside-id-key
+ hidden-form-field ;
diff --git a/basis/furnace/auth/features/deactivate-user/deactivate-user.factor b/basis/furnace/auth/features/deactivate-user/deactivate-user.factor
index 43560d021c..4e80f9188b 100644
--- a/basis/furnace/auth/features/deactivate-user/deactivate-user.factor
+++ b/basis/furnace/auth/features/deactivate-user/deactivate-user.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel assocs namespaces accessors db db.tuples urls
http.server.dispatchers
-furnace.conversations
+furnace.asides
furnace.actions
furnace.auth
furnace.auth.providers ;
diff --git a/basis/furnace/auth/features/edit-profile/edit-profile.factor b/basis/furnace/auth/features/edit-profile/edit-profile.factor
index e6d85809b9..243ea7bfff 100644
--- a/basis/furnace/auth/features/edit-profile/edit-profile.factor
+++ b/basis/furnace/auth/features/edit-profile/edit-profile.factor
@@ -3,8 +3,8 @@
USING: kernel accessors namespaces sequences assocs
validators urls html.forms http.server.dispatchers
furnace.auth
-furnace.actions
-furnace.conversations ;
+furnace.asides
+furnace.actions ;
IN: furnace.auth.features.edit-profile
: <edit-profile-action> ( -- action )
diff --git a/basis/furnace/auth/features/recover-password/recover-password.factor b/basis/furnace/auth/features/recover-password/recover-password.factor
index a0fd05c6d4..49e692d5a6 100644
--- a/basis/furnace/auth/features/recover-password/recover-password.factor
+++ b/basis/furnace/auth/features/recover-password/recover-password.factor
@@ -19,7 +19,7 @@ SYMBOL: lost-password-from
[ username>> "username" set-query-param ]
[ ticket>> "ticket" set-query-param ]
bi
- adjust-url relative-to-request ;
+ adjust-url ;
: password-email ( user -- email )
<email>
diff --git a/basis/furnace/auth/login/login.factor b/basis/furnace/auth/login/login.factor
index 1a4477023d..232e217305 100755
--- a/basis/furnace/auth/login/login.factor
+++ b/basis/furnace/auth/login/login.factor
@@ -5,6 +5,7 @@ calendar validators urls logging html.forms
http http.server http.server.dispatchers
furnace
furnace.auth
+furnace.asides
furnace.actions
furnace.sessions
furnace.utilities
@@ -93,9 +94,15 @@ SYMBOL: capabilities
[ logout ] >>submit ;
M: login-realm login-required* ( description capabilities login -- response )
- begin-aside
- [ description cset ] [ capabilities cset ] [ drop ] tri*
- URL" $realm/login" >secure-url <redirect> ;
+ begin-conversation
+ [ description cset ] [ capabilities cset ] [ secure>> ] tri*
+ [
+ url get >secure-url begin-aside
+ URL" $realm/login" >secure-url <continue-conversation>
+ ] [
+ url get begin-aside
+ URL" $realm/login" <continue-conversation>
+ ] if ;
: <login-realm> ( responder name -- auth )
login-realm new-realm
diff --git a/basis/furnace/chloe-tags/chloe-tags.factor b/basis/furnace/chloe-tags/chloe-tags.factor
index 4e619ad534..6645e04c93 100644
--- a/basis/furnace/chloe-tags/chloe-tags.factor
+++ b/basis/furnace/chloe-tags/chloe-tags.factor
@@ -37,7 +37,7 @@ IN: furnace.chloe-tags
<url>
swap parse-query-attr >>query
-rot a-url-path >>path
- adjust-url relative-to-request
+ adjust-url
] if ;
: compile-a-url ( tag -- )
diff --git a/basis/furnace/conversations/conversations.factor b/basis/furnace/conversations/conversations.factor
index 1c28193de8..671296ce57 100644
--- a/basis/furnace/conversations/conversations.factor
+++ b/basis/furnace/conversations/conversations.factor
@@ -11,18 +11,13 @@ furnace.sessions
furnace.redirection ;
IN: furnace.conversations
-TUPLE: conversation < scope
-session
-method url post-data ;
+TUPLE: conversation < scope session ;
-: <conversation> ( id -- aside )
+: <conversation> ( id -- conversation )
conversation new-server-state ;
conversation "CONVERSATIONS" {
{ "session" "SESSION" BIG-INTEGER +not-null+ }
- { "method" "METHOD" { VARCHAR 10 } }
- { "url" "URL" URL }
- { "post-data" "POST_DATA" FACTOR-BLOB }
} define-persistent
: conversation-id-key "__c" ;
@@ -46,8 +41,7 @@ SYMBOL: conversation-id
conversation get scope-change ; inline
: get-conversation ( id -- conversation )
- dup [ conversation get-state ] when
- dup [ dup session>> session get id>> = [ drop f ] unless ] when ;
+ dup [ conversation get-state ] when check-session ;
: request-conversation-id ( request -- id )
conversation-id-key swap request-params at string>number ;
@@ -88,22 +82,21 @@ M: conversations call-responder*
: add-conversation ( conversation -- )
[ touch-conversation ] [ insert-tuple ] bi ;
-: begin-conversation* ( -- conversation )
- empty-conversastion dup add-conversation ;
-
: begin-conversation ( -- )
conversation get [
- begin-conversation*
- set-conversation
+ empty-conversastion
+ [ add-conversation ]
+ [ set-conversation ] bi
] unless ;
: end-conversation ( -- )
conversation off
conversation-id off ;
-: <conversation-redirect> ( url seq -- response )
- begin-conversation
- [ [ get ] keep cset ] each
+: <continue-conversation> ( url -- response )
+ conversation-id get
+ conversation-id-key
+ set-query-param
<redirect> ;
: restore-conversation ( seq -- )
@@ -114,64 +107,6 @@ M: conversations call-responder*
bi
] [ 2drop ] if ;
-: begin-aside ( -- )
- begin-conversation
- conversation get
- request get
- [ method>> >>method ]
- [ url>> >>url ]
- [ post-data>> >>post-data ]
- tri
- touch-conversation ;
-
-: end-aside-post ( aside -- response )
- request [
- clone
- over post-data>> >>post-data
- over url>> >>url
- ] change
- [ url>> url set ]
- [ url>> path>> split-path ] bi
- conversations get responder>> call-responder ;
-
-\ end-aside-post DEBUG add-input-logging
-
-ERROR: end-aside-in-get-error ;
-
-: move-on ( id -- response )
- post-request? [ end-aside-in-get-error ] unless
- dup method>> {
- { "GET" [ url>> <redirect> ] }
- { "HEAD" [ url>> <redirect> ] }
- { "POST" [ end-aside-post ] }
- } case ;
-
-: get-aside ( id -- conversation )
- get-conversation dup [ dup method>> [ drop f ] unless ] when ;
-
-: end-aside* ( url id -- response )
- get-aside [ move-on ] [ <redirect> ] ?if ;
-
-: end-aside ( default -- response )
- conversation-id get
- end-conversation
- end-aside* ;
-
-M: conversations link-attr ( tag -- )
- drop
- "aside" optional-attr {
- { "none" [ conversation-id off ] }
- { "begin" [ begin-aside ] }
- { "current" [ ] }
- { f [ ] }
- } case ;
-
-M: conversations modify-query ( query conversations -- query' )
- drop
- conversation-id get [
- conversation-id-key associate assoc-union
- ] when* ;
-
M: conversations modify-form ( conversations -- )
drop
conversation-id get
diff --git a/basis/furnace/furnace.factor b/basis/furnace/furnace.factor
index 6a798abb9f..4f0189e3f4 100644
--- a/basis/furnace/furnace.factor
+++ b/basis/furnace/furnace.factor
@@ -37,6 +37,10 @@ GENERIC: modify-query ( query responder -- query' )
M: object modify-query drop ;
+GENERIC: modify-redirect-query ( query responder -- query' )
+
+M: object modify-redirect-query drop ;
+
GENERIC: adjust-url ( url -- url' )
M: url adjust-url
@@ -47,6 +51,14 @@ M: url adjust-url
M: string adjust-url ;
+GENERIC: adjust-redirect-url ( url -- url' )
+
+M: url adjust-redirect-url
+ adjust-url
+ [ [ modify-redirect-query ] each-responder ] change-query ;
+
+M: string adjust-redirect-url ;
+
GENERIC: link-attr ( tag responder -- )
M: object link-attr 2drop ;
diff --git a/basis/furnace/redirection/redirection.factor b/basis/furnace/redirection/redirection.factor
index ff3ce951cb..113319d83b 100644
--- a/basis/furnace/redirection/redirection.factor
+++ b/basis/furnace/redirection/redirection.factor
@@ -7,7 +7,7 @@ http.server.filters furnace ;
IN: furnace.redirection
: <redirect> ( url -- response )
- adjust-url request get method>> {
+ adjust-redirect-url request get method>> {
{ "GET" [ <temporary-redirect> ] }
{ "HEAD" [ <temporary-redirect> ] }
{ "POST" [ <permanent-redirect> ] }
diff --git a/basis/furnace/sessions/sessions.factor b/basis/furnace/sessions/sessions.factor
index 718953c58c..0d070e2e30 100755
--- a/basis/furnace/sessions/sessions.factor
+++ b/basis/furnace/sessions/sessions.factor
@@ -107,3 +107,7 @@ M: sessions call-responder* ( path responder -- response )
sessions set
request-session [ begin-session ] unless*
existing-session put-session-cookie ;
+
+: check-session ( state/f -- state/f )
+ dup [ dup session>> session get id>> = [ drop f ] unless ] when ;
+
diff --git a/basis/furnace/syndication/syndication.factor b/basis/furnace/syndication/syndication.factor
index 396296bfac..a326e62f02 100644
--- a/basis/furnace/syndication/syndication.factor
+++ b/basis/furnace/syndication/syndication.factor
@@ -32,7 +32,7 @@ M: object >entry
: process-entries ( seq -- seq' )
20 short head-slice [
>entry clone
- [ adjust-url relative-to-request ] change-url
+ [ adjust-url ] change-url
] map ;
: <feed-content> ( body -- response )
@@ -46,7 +46,7 @@ TUPLE: feed-action < action title url entries ;
feed new
_
[ title>> call >>title ]
- [ url>> call adjust-url relative-to-request >>url ]
+ [ url>> call adjust-url >>url ]
[ entries>> call process-entries >>entries ]
tri
<feed-content>
From 440818dcafd2a335a29663f0c80488429ac771fc Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 21 Sep 2008 19:45:28 -0500
Subject: [PATCH 30/87] Rename sidebar to contents
---
extra/webapps/wiki/wiki-common.xml | 6 +++---
extra/webapps/wiki/wiki.factor | 6 +++---
2 files changed, 6 insertions(+), 6 deletions(-)
diff --git a/extra/webapps/wiki/wiki-common.xml b/extra/webapps/wiki/wiki-common.xml
index 978551a638..6a90f0d0de 100644
--- a/extra/webapps/wiki/wiki-common.xml
+++ b/extra/webapps/wiki/wiki-common.xml
@@ -10,10 +10,10 @@
<table width="100%">
<tr>
- <t:if t:value="sidebar">
+ <t:if t:value="contents">
<td valign="top" style="width: 210px;">
- <div class="sidebar">
- <t:bind t:name="sidebar">
+ <div class="contents">
+ <t:bind t:name="contents">
<h2>
<t:a t:href="$wiki/view" t:query="title">
<t:label t:name="title" />
diff --git a/extra/webapps/wiki/wiki.factor b/extra/webapps/wiki/wiki.factor
index 9d1ad15aa4..7165f169c5 100644
--- a/extra/webapps/wiki/wiki.factor
+++ b/extra/webapps/wiki/wiki.factor
@@ -344,8 +344,8 @@ M: revision feed-entry-url id>> revision-url ;
[ "author" value user-edits-url ] >>url
[ list-user-edits ] >>entries ;
-: init-sidebar ( -- )
- "Sidebar" latest-revision [ "sidebar" [ from-object ] nest-form ] when*
+: init-sidebars ( -- )
+ "Contents" latest-revision [ "contents" [ from-object ] nest-form ] when*
"Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ;
: <wiki> ( -- dispatcher )
@@ -367,7 +367,7 @@ M: revision feed-entry-url id>> revision-url ;
<list-changes-feed-action> "changes.atom" add-responder
<delete-action> "delete" add-responder
<boilerplate>
- [ init-sidebar ] >>init
+ [ init-sidebars ] >>init
{ wiki "wiki-common" } >>template ;
: init-wiki ( -- )
From ee4faceb4190f65a1faa232653d0123597c833a4 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 21 Sep 2008 21:45:27 -0500
Subject: [PATCH 31/87] traversal flags machinery in place, lookahead works but
shouldnt create capturing groups
---
unfinished/regexp/dfa/dfa.factor | 16 +++++++-----
unfinished/regexp/regexp-tests.factor | 4 +--
unfinished/regexp/traversal/traversal.factor | 26 +++++++++++++++-----
3 files changed, 32 insertions(+), 14 deletions(-)
diff --git a/unfinished/regexp/dfa/dfa.factor b/unfinished/regexp/dfa/dfa.factor
index 6200a1b3c0..cd6dab6a06 100644
--- a/unfinished/regexp/dfa/dfa.factor
+++ b/unfinished/regexp/dfa/dfa.factor
@@ -68,12 +68,16 @@ IN: regexp.dfa
1vector >>new-states drop ;
: set-traversal-flags ( regexp -- )
- [ dfa-table>> transitions>> keys ]
+ dup
[ nfa-traversal-flags>> ]
- bi 2drop ;
+ [ dfa-table>> transitions>> keys ] bi
+ [ tuck [ swap at ] with map concat ] with H{ } map>assoc
+ >>dfa-traversal-flags drop ;
: construct-dfa ( regexp -- )
- [ set-initial-state ]
- [ new-transitions ]
- [ set-final-states ] tri ;
- ! [ set-traversal-flags ] quad ;
+ {
+ [ set-initial-state ]
+ [ new-transitions ]
+ [ set-final-states ]
+ [ set-traversal-flags ]
+ } cleave ;
diff --git a/unfinished/regexp/regexp-tests.factor b/unfinished/regexp/regexp-tests.factor
index 78098952d3..ab3bca9ead 100644
--- a/unfinished/regexp/regexp-tests.factor
+++ b/unfinished/regexp/regexp-tests.factor
@@ -251,8 +251,8 @@ IN: regexp-tests
! [ t ] [ "fxxbar" "(?!foo).{3}bar" <regexp> matches? ] unit-test
! [ f ] [ "foobar" "(?!foo).{3}bar" <regexp> matches? ] unit-test
-! [ 3 ] [ "foobar" "foo(?=bar)" <regexp> match-head ] unit-test
-! [ f ] [ "foobxr" "foo(?=bar)" <regexp> match-head ] unit-test
+[ 3 ] [ "foobar" "foo(?=bar)" <regexp> match-head ] unit-test
+[ f ] [ "foobxr" "foo(?=bar)" <regexp> match-head ] unit-test
! [ f ] [ "foobxr" "foo\\z" <regexp> match-head ] unit-test
! [ 3 ] [ "foo" "foo\\z" <regexp> match-head ] unit-test
diff --git a/unfinished/regexp/traversal/traversal.factor b/unfinished/regexp/traversal/traversal.factor
index cfc97aff29..6f41b16d95 100644
--- a/unfinished/regexp/traversal/traversal.factor
+++ b/unfinished/regexp/traversal/traversal.factor
@@ -1,8 +1,8 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs combinators kernel math math.ranges
-quotations sequences regexp.parser regexp.classes
-combinators.short-circuit regexp.utils ;
+quotations sequences regexp.parser regexp.classes fry
+combinators.short-circuit regexp.utils prettyprint regexp.nfa ;
IN: regexp.traversal
TUPLE: dfa-traverser
@@ -10,7 +10,7 @@ TUPLE: dfa-traverser
traversal-flags
capture-groups
{ capture-group-index integer }
- { lookahead-counter integer }
+ lookahead-counters
last-state current-state
text
start-index current-index
@@ -26,7 +26,8 @@ TUPLE: dfa-traverser
0 >>start-index
0 >>current-index
V{ } clone >>matches
- V{ } clone >>capture-groups ;
+ V{ } clone >>capture-groups
+ V{ } clone >>lookahead-counters ;
: final-state? ( dfa-traverser -- ? )
[ current-state>> ] [ dfa-table>> final-states>> ] bi
@@ -43,9 +44,21 @@ TUPLE: dfa-traverser
dup save-final-state
] when text-finished? ;
-: print-flags ( dfa-traverser -- dfa-traverser )
+GENERIC: flag-action ( dfa-traverser flag -- )
+
+M: lookahead-on flag-action ( dfa-traverser flag -- )
+ drop
+ lookahead-counters>> 0 swap push ;
+
+M: lookahead-off flag-action ( dfa-traverser flag -- )
+ drop
+ dup lookahead-counters>> pop
+ '[ _ - ] change-current-index drop ;
+
+: process-flags ( dfa-traverser -- )
+ [ [ 1+ ] map ] change-lookahead-counters
dup [ current-state>> ] [ traversal-flags>> ] bi
- ;
+ at [ dup . flag-action ] with each ;
: increment-state ( dfa-traverser state -- dfa-traverser )
[
@@ -79,6 +92,7 @@ TUPLE: dfa-traverser
[ nth ] 2dip ;
: do-match ( dfa-traverser -- dfa-traverser )
+ dup process-flags
dup match-done? [
dup setup-match match-transition
[ increment-state do-match ] when*
From cae42362d99744c1ffcc84a45626ea080155e483 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 21 Sep 2008 23:55:36 -0500
Subject: [PATCH 32/87] Fix load error
---
basis/furnace/sessions/sessions.factor | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/basis/furnace/sessions/sessions.factor b/basis/furnace/sessions/sessions.factor
index 0d070e2e30..b7120aaf11 100755
--- a/basis/furnace/sessions/sessions.factor
+++ b/basis/furnace/sessions/sessions.factor
@@ -108,6 +108,7 @@ M: sessions call-responder* ( path responder -- response )
request-session [ begin-session ] unless*
existing-session put-session-cookie ;
+SLOT: session
+
: check-session ( state/f -- state/f )
dup [ dup session>> session get id>> = [ drop f ] unless ] when ;
-
From 7fb336ef1836da593b3f987fe58f53984a3ce2e0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 22 Sep 2008 00:36:07 -0500
Subject: [PATCH 33/87] Fixing relative link prefix lossage
---
basis/furnace/alloy/alloy.factor | 5 +++--
basis/html/components/components.factor | 8 +++++---
extra/webapps/wiki/view.xml | 2 +-
extra/webapps/wiki/wiki-common.xml | 4 ++--
extra/webapps/wiki/wiki.factor | 11 +++++++----
5 files changed, 18 insertions(+), 12 deletions(-)
diff --git a/basis/furnace/alloy/alloy.factor b/basis/furnace/alloy/alloy.factor
index f27c7d67c0..684c4aef4c 100644
--- a/basis/furnace/alloy/alloy.factor
+++ b/basis/furnace/alloy/alloy.factor
@@ -20,10 +20,11 @@ IN: furnace.alloy
<check-form-submissions>
] call ;
-: state-classes { session aside conversation permit user } ; inline
+: state-classes { session aside conversation permit } ; inline
: init-furnace-tables ( -- )
- state-classes ensure-tables ;
+ state-classes ensure-tables
+ user ensure-table ;
: start-expiring ( db params -- )
'[
diff --git a/basis/html/components/components.factor b/basis/html/components/components.factor
index 6965cb582a..9ade669157 100644
--- a/basis/html/components/components.factor
+++ b/basis/html/components/components.factor
@@ -144,7 +144,7 @@ M: code render*
[ string-lines ] [ drop ] [ mode>> value ] tri* htmlize-lines ;
! Farkup component
-TUPLE: farkup no-follow disable-images ;
+TUPLE: farkup no-follow disable-images parsed ;
: string>boolean ( string -- boolean )
{
@@ -154,9 +154,11 @@ TUPLE: farkup no-follow disable-images ;
M: farkup render*
[
+ nip
[ no-follow>> [ string>boolean link-no-follow? set ] when* ]
- [ disable-images>> [ string>boolean disable-images? set ] when* ] bi
- drop string-lines "\n" join write-farkup
+ [ disable-images>> [ string>boolean disable-images? set ] when* ]
+ [ parsed>> string>boolean [ (write-farkup) ] [ write-farkup ] if ]
+ tri
] with-scope ;
! Inspector component
diff --git a/extra/webapps/wiki/view.xml b/extra/webapps/wiki/view.xml
index 5136e4945d..e3774bbe0b 100644
--- a/extra/webapps/wiki/view.xml
+++ b/extra/webapps/wiki/view.xml
@@ -5,7 +5,7 @@
<t:title><t:label t:name="title" /></t:title>
<div class="description">
- <t:html t:name="html" />
+ <t:farkup t:name="parsed" t:parsed="true" />
</div>
<p>
diff --git a/extra/webapps/wiki/wiki-common.xml b/extra/webapps/wiki/wiki-common.xml
index 6a90f0d0de..628485955e 100644
--- a/extra/webapps/wiki/wiki-common.xml
+++ b/extra/webapps/wiki/wiki-common.xml
@@ -20,7 +20,7 @@
</t:a>
</h2>
- <t:html t:name="html" />
+ <t:farkup t:name="parsed" t:parsed="true" />
</t:bind>
</div>
</td>
@@ -59,7 +59,7 @@
<td colspan="2">
<t:bind t:name="footer">
<small>
- <t:html t:name="html" />
+ <t:farkup t:name="parsed" t:parsed="true" />
</small>
</t:bind>
</td>
diff --git a/extra/webapps/wiki/wiki.factor b/extra/webapps/wiki/wiki.factor
index 7165f169c5..420d71d26b 100644
--- a/extra/webapps/wiki/wiki.factor
+++ b/extra/webapps/wiki/wiki.factor
@@ -47,7 +47,7 @@ article "ARTICLES" {
: <article> ( title -- article ) article new swap >>title ;
-TUPLE: revision id title author date content html description ;
+TUPLE: revision id title author date content parsed description ;
revision "REVISIONS" {
{ "id" "ID" INTEGER +db-assigned-id+ }
@@ -55,7 +55,7 @@ revision "REVISIONS" {
{ "author" "AUTHOR" { VARCHAR 256 } +not-null+ } ! uid
{ "date" "DATE" TIMESTAMP +not-null+ }
{ "content" "CONTENT" TEXT +not-null+ }
- { "html" "HTML" TEXT +not-null+ } ! Farkup converted to HTML
+ { "parsed" "PARSED" FACTOR-BLOB +not-null+ } ! Farkup AST
{ "description" "DESCRIPTION" TEXT }
} define-persistent
@@ -73,7 +73,7 @@ M: revision feed-entry-url id>> revision-url ;
revision new swap >>id ;
: compute-html ( revision -- )
- dup content>> convert-farkup >>html drop ;
+ dup content>> parse-farkup >>parsed drop ;
: validate-title ( -- )
{ { "title" [ v-one-line ] } } validate-params ;
@@ -348,6 +348,9 @@ M: revision feed-entry-url id>> revision-url ;
"Contents" latest-revision [ "contents" [ from-object ] nest-form ] when*
"Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ;
+: init-relative-link-prefix ( -- )
+ URL" $wiki/view/" adjust-url present relative-link-prefix set ;
+
: <wiki> ( -- dispatcher )
wiki new-dispatcher
<main-article-action> "" add-responder
@@ -367,7 +370,7 @@ M: revision feed-entry-url id>> revision-url ;
<list-changes-feed-action> "changes.atom" add-responder
<delete-action> "delete" add-responder
<boilerplate>
- [ init-sidebars ] >>init
+ [ init-sidebars init-relative-link-prefix ] >>init
{ wiki "wiki-common" } >>template ;
: init-wiki ( -- )
From c78c59cde2092f6739acd264de2c38b7e0c3f058 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 22 Sep 2008 00:42:37 -0500
Subject: [PATCH 34/87] More Wiki fixes
---
extra/webapps/wiki/initial-content/Wiki Help.txt | 2 +-
extra/webapps/wiki/wiki.css | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/extra/webapps/wiki/initial-content/Wiki Help.txt b/extra/webapps/wiki/initial-content/Wiki Help.txt
index 9c65876377..f7e357c860 100644
--- a/extra/webapps/wiki/initial-content/Wiki Help.txt
+++ b/extra/webapps/wiki/initial-content/Wiki Help.txt
@@ -1,5 +1,5 @@
This Wiki uses [[Farkup]] to mark up text.
-Two special article names are recognized by the Wiki: [[Sidebar]] and [[Footer]]. They do not exist by default, but if you create them, they will be visible on every page.
+Two special article names are recognized by the Wiki: [[Contents]] and [[Footer]]. They do not exist by default, but if you create them, they will be visible on every page.
The Wiki supports hierarchical article organization. You can separate components in article names with slashes, and Wiki links only display the last component. An example: [[Factor/Features]].
diff --git a/extra/webapps/wiki/wiki.css b/extra/webapps/wiki/wiki.css
index 67000ae63c..7315b132d2 100644
--- a/extra/webapps/wiki/wiki.css
+++ b/extra/webapps/wiki/wiki.css
@@ -38,7 +38,7 @@
border-width: 1px 1px 0 0;
}
-.sidebar {
+.contents {
padding: 4px;
margin: 4px;
border: 1px dashed grey;
From 22f9478c5e39eeb6447cc65602f364d566e1cb30 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 22 Sep 2008 02:27:07 -0500
Subject: [PATCH 35/87] Better error printing
---
basis/stack-checker/errors/errors.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/basis/stack-checker/errors/errors.factor b/basis/stack-checker/errors/errors.factor
index 3d92aea3e8..bab6c17c85 100644
--- a/basis/stack-checker/errors/errors.factor
+++ b/basis/stack-checker/errors/errors.factor
@@ -72,8 +72,8 @@ TUPLE: effect-error word inferred declared ;
M: effect-error error.
"Stack effects of the word " write
[ word>> pprint " do not match." print ]
- [ "Inferred: " write inferred>> effect>string . ]
- [ "Declared: " write declared>> effect>string . ] tri ;
+ [ "Inferred: " write inferred>> . ]
+ [ "Declared: " write declared>> . ] tri ;
TUPLE: recursive-quotation-error quot ;
From 4fab0695b8f76f72e024167cbfc92a81ddc49fed Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 22 Sep 2008 02:28:10 -0500
Subject: [PATCH 36/87] Add some words
---
unfinished/regexp/regexp.factor | 39 ++++++++++++++++++++++++++-------
1 file changed, 31 insertions(+), 8 deletions(-)
diff --git a/unfinished/regexp/regexp.factor b/unfinished/regexp/regexp.factor
index 85bdccc2f4..c4ab2675d2 100644
--- a/unfinished/regexp/regexp.factor
+++ b/unfinished/regexp/regexp.factor
@@ -1,10 +1,9 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators kernel math math.ranges
-sequences regexp.backend regexp.utils memoize sets
-regexp.parser regexp.nfa regexp.dfa regexp.traversal
-regexp.transition-tables assocs prettyprint.backend
-make lexer namespaces parser ;
+USING: accessors combinators kernel math math.ranges sequences
+sets assocs prettyprint.backend make lexer namespaces parser
+arrays fry regexp.backend regexp.utils regexp.parser regexp.nfa
+regexp.dfa regexp.traversal regexp.transition-tables ;
IN: regexp
: default-regexp ( string -- regexp )
@@ -47,6 +46,33 @@ IN: regexp
[ 3drop drop f f ] [ drop [ 1+ ] dip match-range ] if
] if ;
+: first-match ( string regexp -- pair/f )
+ 0 swap match-range dup [ 2array ] [ 2drop f ] if ;
+
+: re-cut ( string regexp -- end/f start )
+ dupd first-match
+ [ [ second tail-slice ] [ first head ] 2bi ]
+ [ "" like f swap ]
+ if* ;
+
+: re-split ( string regexp -- seq )
+ [ dup ] swap '[ _ re-cut ] [ ] produce nip ;
+
+: re-replace ( string regexp replacement -- result )
+ [ re-split ] dip join ;
+
+: next-match ( string regexp -- end/f match/f )
+ dupd first-match dup
+ [ [ second tail-slice ] keep ]
+ [ 2drop f f ]
+ if ;
+
+: all-matches ( string regexp -- seq )
+ [ dup ] swap '[ _ next-match ] [ ] produce nip ;
+
+: count-matches ( string regexp -- n )
+ all-matches length 1- ;
+
: initial-option ( regexp option -- regexp' )
over options>> conjoin ;
@@ -102,8 +128,6 @@ IN: regexp
: option? ( option regexp -- ? )
options>> key? ;
-USE: multiline
-/*
M: regexp pprint*
[
[
@@ -112,4 +136,3 @@ M: regexp pprint*
case-insensitive swap option? [ "i" % ] when
] "" make
] keep present-text ;
-*/
From fe071a8908d4e08abac7623a6c1bbf8139235897 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 22 Sep 2008 02:37:40 -0500
Subject: [PATCH 37/87] Move regexp to basis
---
{unfinished => basis}/regexp/authors.txt | 0
{unfinished => basis}/regexp/backend/backend.factor | 0
{unfinished => basis}/regexp/classes/classes.factor | 0
{unfinished => basis}/regexp/dfa/dfa.factor | 0
{unfinished => basis}/regexp/nfa/nfa.factor | 0
{unfinished => basis}/regexp/parser/parser-tests.factor | 0
{unfinished => basis}/regexp/parser/parser.factor | 0
{unfinished => basis}/regexp/regexp-docs.factor | 0
{unfinished => basis}/regexp/regexp-tests.factor | 0
{unfinished => basis}/regexp/regexp.factor | 0
{unfinished => basis}/regexp/summary.txt | 0
{unfinished => basis}/regexp/tags.txt | 0
.../regexp/transition-tables/transition-tables.factor | 0
{unfinished => basis}/regexp/traversal/traversal.factor | 0
{unfinished => basis}/regexp/utils/utils.factor | 0
15 files changed, 0 insertions(+), 0 deletions(-)
rename {unfinished => basis}/regexp/authors.txt (100%)
rename {unfinished => basis}/regexp/backend/backend.factor (100%)
rename {unfinished => basis}/regexp/classes/classes.factor (100%)
rename {unfinished => basis}/regexp/dfa/dfa.factor (100%)
rename {unfinished => basis}/regexp/nfa/nfa.factor (100%)
rename {unfinished => basis}/regexp/parser/parser-tests.factor (100%)
rename {unfinished => basis}/regexp/parser/parser.factor (100%)
rename {unfinished => basis}/regexp/regexp-docs.factor (100%)
rename {unfinished => basis}/regexp/regexp-tests.factor (100%)
rename {unfinished => basis}/regexp/regexp.factor (100%)
rename {unfinished => basis}/regexp/summary.txt (100%)
rename {unfinished => basis}/regexp/tags.txt (100%)
rename {unfinished => basis}/regexp/transition-tables/transition-tables.factor (100%)
rename {unfinished => basis}/regexp/traversal/traversal.factor (100%)
rename {unfinished => basis}/regexp/utils/utils.factor (100%)
diff --git a/unfinished/regexp/authors.txt b/basis/regexp/authors.txt
similarity index 100%
rename from unfinished/regexp/authors.txt
rename to basis/regexp/authors.txt
diff --git a/unfinished/regexp/backend/backend.factor b/basis/regexp/backend/backend.factor
similarity index 100%
rename from unfinished/regexp/backend/backend.factor
rename to basis/regexp/backend/backend.factor
diff --git a/unfinished/regexp/classes/classes.factor b/basis/regexp/classes/classes.factor
similarity index 100%
rename from unfinished/regexp/classes/classes.factor
rename to basis/regexp/classes/classes.factor
diff --git a/unfinished/regexp/dfa/dfa.factor b/basis/regexp/dfa/dfa.factor
similarity index 100%
rename from unfinished/regexp/dfa/dfa.factor
rename to basis/regexp/dfa/dfa.factor
diff --git a/unfinished/regexp/nfa/nfa.factor b/basis/regexp/nfa/nfa.factor
similarity index 100%
rename from unfinished/regexp/nfa/nfa.factor
rename to basis/regexp/nfa/nfa.factor
diff --git a/unfinished/regexp/parser/parser-tests.factor b/basis/regexp/parser/parser-tests.factor
similarity index 100%
rename from unfinished/regexp/parser/parser-tests.factor
rename to basis/regexp/parser/parser-tests.factor
diff --git a/unfinished/regexp/parser/parser.factor b/basis/regexp/parser/parser.factor
similarity index 100%
rename from unfinished/regexp/parser/parser.factor
rename to basis/regexp/parser/parser.factor
diff --git a/unfinished/regexp/regexp-docs.factor b/basis/regexp/regexp-docs.factor
similarity index 100%
rename from unfinished/regexp/regexp-docs.factor
rename to basis/regexp/regexp-docs.factor
diff --git a/unfinished/regexp/regexp-tests.factor b/basis/regexp/regexp-tests.factor
similarity index 100%
rename from unfinished/regexp/regexp-tests.factor
rename to basis/regexp/regexp-tests.factor
diff --git a/unfinished/regexp/regexp.factor b/basis/regexp/regexp.factor
similarity index 100%
rename from unfinished/regexp/regexp.factor
rename to basis/regexp/regexp.factor
diff --git a/unfinished/regexp/summary.txt b/basis/regexp/summary.txt
similarity index 100%
rename from unfinished/regexp/summary.txt
rename to basis/regexp/summary.txt
diff --git a/unfinished/regexp/tags.txt b/basis/regexp/tags.txt
similarity index 100%
rename from unfinished/regexp/tags.txt
rename to basis/regexp/tags.txt
diff --git a/unfinished/regexp/transition-tables/transition-tables.factor b/basis/regexp/transition-tables/transition-tables.factor
similarity index 100%
rename from unfinished/regexp/transition-tables/transition-tables.factor
rename to basis/regexp/transition-tables/transition-tables.factor
diff --git a/unfinished/regexp/traversal/traversal.factor b/basis/regexp/traversal/traversal.factor
similarity index 100%
rename from unfinished/regexp/traversal/traversal.factor
rename to basis/regexp/traversal/traversal.factor
diff --git a/unfinished/regexp/utils/utils.factor b/basis/regexp/utils/utils.factor
similarity index 100%
rename from unfinished/regexp/utils/utils.factor
rename to basis/regexp/utils/utils.factor
From a3d9f8634022cc5bae7ba879b96e5994a0cef05f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 22 Sep 2008 02:37:48 -0500
Subject: [PATCH 38/87] New benchmark
---
.../benchmark/regex-dna/regex-dna-test-in.txt | 1671 +++++++++++++++++
.../regex-dna/regex-dna-test-out.txt | 13 +
.../regex-dna/regex-dna-tests.factor | 10 +
extra/benchmark/regex-dna/regex-dna.factor | 60 +
4 files changed, 1754 insertions(+)
create mode 100644 extra/benchmark/regex-dna/regex-dna-test-in.txt
create mode 100644 extra/benchmark/regex-dna/regex-dna-test-out.txt
create mode 100644 extra/benchmark/regex-dna/regex-dna-tests.factor
create mode 100644 extra/benchmark/regex-dna/regex-dna.factor
diff --git a/extra/benchmark/regex-dna/regex-dna-test-in.txt b/extra/benchmark/regex-dna/regex-dna-test-in.txt
new file mode 100644
index 0000000000..fb23263397
--- /dev/null
+++ b/extra/benchmark/regex-dna/regex-dna-test-in.txt
@@ -0,0 +1,1671 @@
+>ONE Homo sapiens alu
+GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGA
+TCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACT
+AAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAG
+GCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCG
+CCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGT
+GGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCA
+GGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAA
+TTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAG
+AATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCA
+GCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGT
+AATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACC
+AGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTG
+GTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACC
+CGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAG
+AGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTT
+TGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACA
+TGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCT
+GTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGG
+TTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGT
+CTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGG
+CGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCG
+TCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTA
+CTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCG
+AGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCG
+GGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACC
+TGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAA
+TACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGA
+GGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACT
+GCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTC
+ACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGT
+TCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGC
+CGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCG
+CTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTG
+GGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCC
+CAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCT
+GGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGC
+GCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGA
+GGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGA
+GACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGA
+GGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTG
+AAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAAT
+CCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCA
+GTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAA
+AAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGC
+GGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCT
+ACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGG
+GAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATC
+GCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGC
+GGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGG
+TCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAA
+AAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAG
+GAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACT
+CCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCC
+TGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAG
+ACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGC
+GTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGA
+ACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGA
+CAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCA
+CTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCA
+ACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCG
+CCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGG
+AGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTC
+CGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCG
+AGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACC
+CCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAG
+CTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAG
+CCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGG
+CCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATC
+ACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAA
+AAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGC
+TGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCC
+ACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGG
+CTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGG
+AGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATT
+AGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAA
+TCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGC
+CTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAA
+TCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAG
+CCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGT
+GGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCG
+GGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAG
+CGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTG
+GGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATG
+GTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGT
+AATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTT
+GCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCT
+CAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCG
+GGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTC
+TCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACT
+CGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAG
+ATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGG
+CGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTG
+AGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATA
+CAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGG
+CAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGC
+ACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCAC
+GCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTC
+GAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCG
+GGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCT
+TGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGG
+CGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCA
+GCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGG
+CCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGC
+GCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGG
+CGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGA
+CTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGG
+CCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAA
+ACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCC
+CAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGT
+GAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAA
+AGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGG
+ATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTAC
+TAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGA
+GGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGC
+GCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGG
+TGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTC
+AGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAA
+ATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGA
+GAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCC
+AGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTG
+TAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGAC
+CAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGT
+GGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAAC
+CCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACA
+GAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACT
+TTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAAC
+ATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCC
+TGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAG
+GTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCG
+TCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAG
+GCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCC
+GTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCT
+ACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCC
+GAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCC
+GGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCAC
+CTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAA
+ATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTG
+AGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCAC
+TGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCT
+CACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAG
+TTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAG
+CCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATC
+GCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCT
+GGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATC
+CCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCC
+TGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGG
+CGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGG
+AGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCG
+AGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGG
+AGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGT
+GAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAA
+TCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGC
+AGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCA
+AAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGG
+CGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTC
+TACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCG
+GGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGAT
+CGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCG
+CGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAG
+GTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACA
+AAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCA
+GGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCAC
+TCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGC
+CTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGA
+GACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGG
+CGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTG
+AACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCG
+ACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGC
+ACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCC
+AACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGC
+GCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCG
+GAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACT
+CCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCC
+GAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAAC
+CCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCA
+GCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGA
+GCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAG
+GCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGAT
+CACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTA
+AAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGG
+CTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGC
+CACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTG
+GCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAG
+GAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAAT
+TAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGA
+ATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAG
+CCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTA
+ATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCA
+GCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGG
+TGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCC
+GGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGA
+GCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTT
+GGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACAT
+GGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTG
+TAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGT
+TGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTC
+TCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGC
+GGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGT
+CTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTAC
+TCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGA
+GATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGG
+GCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCT
+GAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAAT
+ACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAG
+GCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTG
+CACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCA
+CGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTT
+CGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCC
+GGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGC
+TTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGG
+GCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCC
+AGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTG
+GCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCG
+CGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAG
+GCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAG
+ACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAG
+GCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGA
+AACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATC
+CCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAG
+TGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAA
+AAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCG
+GATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTA
+CTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGG
+AGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCG
+CGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCG
+GTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGT
+CAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAA
+AATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGG
+AGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTC
+CAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCT
+GTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGA
+CCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCG
+TGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAA
+CCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGAC
+AGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCAC
+TTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAA
+CATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGC
+CTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGA
+GGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCC
+GTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGA
+GGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCC
+CGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGC
+TACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGC
+CGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGC
+CGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCA
+CCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAA
+AATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCT
+GAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCA
+CTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGC
+TCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGA
+GTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTA
+GCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAAT
+CGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCC
+TGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAAT
+CCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGC
+CTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTG
+GCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGG
+GAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGC
+GAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGG
+GAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGG
+TGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTA
+ATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTG
+CAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTC
+AAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGG
+GCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCT
+CTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTC
+GGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGA
+TCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGC
+GCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGA
+GGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATAC
+AAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGC
+AGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCA
+CTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACG
+CCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCG
+AGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGG
+GCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTT
+GAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGC
+GACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAG
+CACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGC
+CAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCG
+CGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGC
+GGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGAC
+TCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGC
+CGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAA
+CCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCC
+AGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTG
+AGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA
+GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGA
+TCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACT
+AAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAG
+GCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCG
+CCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGT
+GGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCA
+GGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAA
+TTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAG
+AATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCA
+GCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGT
+AATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACC
+AGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTG
+GTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACC
+CGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAG
+AGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTT
+TGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACA
+TGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCT
+GTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGG
+TTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGT
+CTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGG
+CGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCG
+TCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTA
+CTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCG
+AGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCG
+GGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACC
+TGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAA
+TACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGA
+GGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACT
+GCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTC
+ACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGT
+TCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGC
+CGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCG
+CTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTG
+GGCGACAGAGCGAGACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCC
+CAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCT
+GGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGC
+GCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGA
+GGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGA
+GACTCCGTCTCAAAAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGA
+GGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTG
+AAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAAT
+CCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCA
+GTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAA
+AAAGGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGC
+GGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCT
+ACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGG
+GAGGCTGAGGCAGGAGAATC
+>TWO IUB ambiguity codes
+cttBtatcatatgctaKggNcataaaSatgtaaaDcDRtBggDtctttataattcBgtcg
+tactDtDagcctatttSVHtHttKtgtHMaSattgWaHKHttttagacatWatgtRgaaa
+NtactMcSMtYtcMgRtacttctWBacgaaatatagScDtttgaagacacatagtVgYgt
+cattHWtMMWcStgttaggKtSgaYaaccWStcgBttgcgaMttBYatcWtgacaYcaga
+gtaBDtRacttttcWatMttDBcatWtatcttactaBgaYtcttgttttttttYaaScYa
+HgtgttNtSatcMtcVaaaStccRcctDaataataStcYtRDSaMtDttgttSagtRRca
+tttHatSttMtWgtcgtatSSagactYaaattcaMtWatttaSgYttaRgKaRtccactt
+tattRggaMcDaWaWagttttgacatgttctacaaaRaatataataaMttcgDacgaSSt
+acaStYRctVaNMtMgtaggcKatcttttattaaaaagVWaHKYagtttttatttaacct
+tacgtVtcVaattVMBcttaMtttaStgacttagattWWacVtgWYagWVRctDattBYt
+gtttaagaagattattgacVatMaacattVctgtBSgaVtgWWggaKHaatKWcBScSWa
+accRVacacaaactaccScattRatatKVtactatatttHttaagtttSKtRtacaaagt
+RDttcaaaaWgcacatWaDgtDKacgaacaattacaRNWaatHtttStgttattaaMtgt
+tgDcgtMgcatBtgcttcgcgaDWgagctgcgaggggVtaaScNatttacttaatgacag
+cccccacatYScaMgtaggtYaNgttctgaMaacNaMRaacaaacaKctacatagYWctg
+ttWaaataaaataRattagHacacaagcgKatacBttRttaagtatttccgatctHSaat
+actcNttMaagtattMtgRtgaMgcataatHcMtaBSaRattagttgatHtMttaaKagg
+YtaaBataSaVatactWtataVWgKgttaaaacagtgcgRatatacatVtHRtVYataSa
+KtWaStVcNKHKttactatccctcatgWHatWaRcttactaggatctataDtDHBttata
+aaaHgtacVtagaYttYaKcctattcttcttaataNDaaggaaaDYgcggctaaWSctBa
+aNtgctggMBaKctaMVKagBaactaWaDaMaccYVtNtaHtVWtKgRtcaaNtYaNacg
+gtttNattgVtttctgtBaWgtaattcaagtcaVWtactNggattctttaYtaaagccgc
+tcttagHVggaYtgtNcDaVagctctctKgacgtatagYcctRYHDtgBattDaaDgccK
+tcHaaStttMcctagtattgcRgWBaVatHaaaataYtgtttagMDMRtaataaggatMt
+ttctWgtNtgtgaaaaMaatatRtttMtDgHHtgtcattttcWattRSHcVagaagtacg
+ggtaKVattKYagactNaatgtttgKMMgYNtcccgSKttctaStatatNVataYHgtNa
+BKRgNacaactgatttcctttaNcgatttctctataScaHtataRagtcRVttacDSDtt
+aRtSatacHgtSKacYagttMHtWataggatgactNtatSaNctataVtttRNKtgRacc
+tttYtatgttactttttcctttaaacatacaHactMacacggtWataMtBVacRaSaatc
+cgtaBVttccagccBcttaRKtgtgcctttttRtgtcagcRttKtaaacKtaaatctcac
+aattgcaNtSBaaccgggttattaaBcKatDagttactcttcattVtttHaaggctKKga
+tacatcBggScagtVcacattttgaHaDSgHatRMaHWggtatatRgccDttcgtatcga
+aacaHtaagttaRatgaVacttagattVKtaaYttaaatcaNatccRttRRaMScNaaaD
+gttVHWgtcHaaHgacVaWtgttScactaagSgttatcttagggDtaccagWattWtRtg
+ttHWHacgattBtgVcaYatcggttgagKcWtKKcaVtgaYgWctgYggVctgtHgaNcV
+taBtWaaYatcDRaaRtSctgaHaYRttagatMatgcatttNattaDttaattgttctaa
+ccctcccctagaWBtttHtBccttagaVaatMcBHagaVcWcagBVttcBtaYMccagat
+gaaaaHctctaacgttagNWRtcggattNatcRaNHttcagtKttttgWatWttcSaNgg
+gaWtactKKMaacatKatacNattgctWtatctaVgagctatgtRaHtYcWcttagccaa
+tYttWttaWSSttaHcaaaaagVacVgtaVaRMgattaVcDactttcHHggHRtgNcctt
+tYatcatKgctcctctatVcaaaaKaaaagtatatctgMtWtaaaacaStttMtcgactt
+taSatcgDataaactaaacaagtaaVctaggaSccaatMVtaaSKNVattttgHccatca
+cBVctgcaVatVttRtactgtVcaattHgtaaattaaattttYtatattaaRSgYtgBag
+aHSBDgtagcacRHtYcBgtcacttacactaYcgctWtattgSHtSatcataaatataHt
+cgtYaaMNgBaatttaRgaMaatatttBtttaaaHHKaatctgatWatYaacttMctctt
+ttVctagctDaaagtaVaKaKRtaacBgtatccaaccactHHaagaagaaggaNaaatBW
+attccgStaMSaMatBttgcatgRSacgttVVtaaDMtcSgVatWcaSatcttttVatag
+ttactttacgatcaccNtaDVgSRcgVcgtgaacgaNtaNatatagtHtMgtHcMtagaa
+attBgtataRaaaacaYKgtRccYtatgaagtaataKgtaaMttgaaRVatgcagaKStc
+tHNaaatctBBtcttaYaBWHgtVtgacagcaRcataWctcaBcYacYgatDgtDHccta
+aagacYRcaggattHaYgtKtaatgcVcaataMYacccatatcacgWDBtgaatcBaata
+cKcttRaRtgatgaBDacggtaattaaYtataStgVHDtDctgactcaaatKtacaatgc
+gYatBtRaDatHaactgtttatatDttttaaaKVccYcaaccNcBcgHaaVcattHctcg
+attaaatBtatgcaaaaatYMctSactHatacgaWacattacMBgHttcgaatVaaaaca
+BatatVtctgaaaaWtctRacgBMaatSgRgtgtcgactatcRtattaScctaStagKga
+DcWgtYtDDWKRgRtHatRtggtcgaHgggcgtattaMgtcagccaBggWVcWctVaaat
+tcgNaatcKWagcNaHtgaaaSaaagctcYctttRVtaaaatNtataaccKtaRgtttaM
+tgtKaBtRtNaggaSattHatatWactcagtgtactaKctatttgRYYatKatgtccgtR
+tttttatttaatatVgKtttgtatgtNtataRatWYNgtRtHggtaaKaYtKSDcatcKg
+taaYatcSRctaVtSMWtVtRWHatttagataDtVggacagVcgKWagBgatBtaaagNc
+aRtagcataBggactaacacRctKgttaatcctHgDgttKHHagttgttaatgHBtatHc
+DaagtVaBaRccctVgtgDtacRHSctaagagcggWYaBtSaKtHBtaaactYacgNKBa
+VYgtaacttagtVttcttaatgtBtatMtMtttaattaatBWccatRtttcatagVgMMt
+agctStKctaMactacDNYgKYHgaWcgaHgagattacVgtttgtRaSttaWaVgataat
+gtgtYtaStattattMtNgWtgttKaccaatagNYttattcgtatHcWtctaaaNVYKKt
+tWtggcDtcgaagtNcagatacgcattaagaccWctgcagcttggNSgaNcHggatgtVt
+catNtRaaBNcHVagagaaBtaaSggDaatWaatRccaVgggStctDaacataKttKatt
+tggacYtattcSatcttagcaatgaVBMcttDattctYaaRgatgcattttNgVHtKcYR
+aatRKctgtaaacRatVSagctgtWacBtKVatctgttttKcgtctaaDcaagtatcSat
+aWVgcKKataWaYttcccSaatgaaaacccWgcRctWatNcWtBRttYaattataaNgac
+acaatagtttVNtataNaYtaatRaVWKtBatKagtaatataDaNaaaaataMtaagaaS
+tccBcaatNgaataWtHaNactgtcDtRcYaaVaaaaaDgtttRatctatgHtgttKtga
+aNSgatactttcgagWaaatctKaaDaRttgtggKKagcDgataaattgSaacWaVtaNM
+acKtcaDaaatttctRaaVcagNacaScRBatatctRatcctaNatWgRtcDcSaWSgtt
+RtKaRtMtKaatgttBHcYaaBtgatSgaSWaScMgatNtctcctatttctYtatMatMt
+RRtSaattaMtagaaaaStcgVgRttSVaScagtgDtttatcatcatacRcatatDctta
+tcatVRtttataaHtattcYtcaaaatactttgVctagtaaYttagatagtSYacKaaac
+gaaKtaaatagataatSatatgaaatSgKtaatVtttatcctgKHaatHattagaaccgt
+YaaHactRcggSBNgtgctaaBagBttgtRttaaattYtVRaaaattgtaatVatttctc
+ttcatgBcVgtgKgaHaaatattYatagWacNctgaaMcgaattStagWaSgtaaKagtt
+ttaagaDgatKcctgtaHtcatggKttVDatcaaggtYcgccagNgtgcVttttagagat
+gctaccacggggtNttttaSHaNtatNcctcatSaaVgtactgBHtagcaYggYVKNgta
+KBcRttgaWatgaatVtagtcgattYgatgtaatttacDacSctgctaaaStttaWMagD
+aaatcaVYctccgggcgaVtaaWtStaKMgDtttcaaMtVgBaatccagNaaatcYRMBg
+gttWtaaScKttMWtYataRaDBMaDataatHBcacDaaKDactaMgagttDattaHatH
+taYatDtattDcRNStgaatattSDttggtattaaNSYacttcDMgYgBatWtaMagact
+VWttctttgYMaYaacRgHWaattgRtaagcattctMKVStatactacHVtatgatcBtV
+NataaBttYtSttacKgggWgYDtgaVtYgatDaacattYgatggtRDaVDttNactaSa
+MtgNttaacaaSaBStcDctaccacagacgcaHatMataWKYtaYattMcaMtgSttDag
+cHacgatcaHttYaKHggagttccgatYcaatgatRaVRcaagatcagtatggScctata
+ttaNtagcgacgtgKaaWaactSgagtMYtcttccaKtStaacggMtaagNttattatcg
+tctaRcactctctDtaacWYtgaYaSaagaWtNtatttRacatgNaatgttattgWDDcN
+aHcctgaaHacSgaataaRaataMHttatMtgaSDSKatatHHaNtacagtccaYatWtc
+actaactatKDacSaStcggataHgYatagKtaatKagStaNgtatactatggRHacttg
+tattatgtDVagDVaRctacMYattDgtttYgtctatggtKaRSttRccRtaaccttaga
+gRatagSaaMaacgcaNtatgaaatcaRaagataatagatactcHaaYKBctccaagaRa
+BaStNagataggcgaatgaMtagaatgtcaKttaaatgtaWcaBttaatRcggtgNcaca
+aKtttScRtWtgcatagtttWYaagBttDKgcctttatMggNttattBtctagVtacata
+aaYttacacaaRttcYtWttgHcaYYtaMgBaBatctNgcDtNttacgacDcgataaSat
+YaSttWtcctatKaatgcagHaVaacgctgcatDtgttaSataaaaYSNttatagtaNYt
+aDaaaNtggggacttaBggcHgcgtNtaaMcctggtVtaKcgNacNtatVaSWctWtgaW
+cggNaBagctctgaYataMgaagatBSttctatacttgtgtKtaattttRagtDtacata
+tatatgatNHVgBMtKtaKaNttDHaagatactHaccHtcatttaaagttVaMcNgHata
+tKtaNtgYMccttatcaaNagctggacStttcNtggcaVtattactHaSttatgNMVatt
+MMDtMactattattgWMSgtHBttStStgatatRaDaagattttctatMtaaaaaggtac
+taaVttaSacNaatactgMttgacHaHRttgMacaaaatagttaatatWKRgacDgaRta
+tatttattatcYttaWtgtBRtWatgHaaattHataagtVaDtWaVaWtgStcgtMSgaS
+RgMKtaaataVacataatgtaSaatttagtcgaaHtaKaatgcacatcggRaggSKctDc
+agtcSttcccStYtccRtctctYtcaaKcgagtaMttttcRaYDttgttatctaatcata
+NctctgctatcaMatactataggDaHaaSttMtaDtcNatataattctMcStaaBYtaNa
+gatgtaatHagagSttgWHVcttatKaYgDctcttggtgttMcRaVgSgggtagacaata
+aDtaattSaDaNaHaBctattgNtaccaaRgaVtKNtaaYggHtaKKgHcatctWtctDt
+ttctttggSDtNtaStagttataaacaattgcaBaBWggHgcaaaBtYgctaatgaaatW
+cDcttHtcMtWWattBHatcatcaaatctKMagtDNatttWaBtHaaaNgMttaaStagt
+tctctaatDtcRVaYttgttMtRtgtcaSaaYVgSWDRtaatagctcagDgcWWaaaBaa
+RaBctgVgggNgDWStNaNBKcBctaaKtttDcttBaaggBttgaccatgaaaNgttttt
+tttatctatgttataccaaDRaaSagtaVtDtcaWatBtacattaWacttaSgtattggD
+gKaaatScaattacgWcagKHaaccaYcRcaRttaDttRtttHgaHVggcttBaRgtccc
+tDatKaVtKtcRgYtaKttacgtatBtStaagcaattaagaRgBagSaattccSWYttta
+ttVaataNctgHgttaaNBgcVYgtRtcccagWNaaaacaDNaBcaaaaRVtcWMgBagM
+tttattacgDacttBtactatcattggaaatVccggttRttcatagttVYcatYaSHaHc
+ttaaagcNWaHataaaRWtctVtRYtagHtaaaYMataHYtNBctNtKaatattStgaMc
+BtRgctaKtgcScSttDgYatcVtggaaKtaagatWccHccgKYctaNNctacaWctttt
+gcRtgtVcgaKttcMRHgctaHtVaataaDtatgKDcttatBtDttggNtacttttMtga
+acRattaaNagaactcaaaBBVtcDtcgaStaDctgaaaSgttMaDtcgttcaccaaaag
+gWtcKcgSMtcDtatgtttStaaBtatagDcatYatWtaaaBacaKgcaDatgRggaaYc
+taRtccagattDaWtttggacBaVcHtHtaacDacYgtaatataMagaatgHMatcttat
+acgtatttttatattacHactgttataMgStYaattYaccaattgagtcaaattaYtgta
+tcatgMcaDcgggtcttDtKgcatgWRtataatatRacacNRBttcHtBgcRttgtgcgt
+catacMtttBctatctBaatcattMttMYgattaaVYatgDaatVagtattDacaacDMa
+tcMtHcccataagatgBggaccattVWtRtSacatgctcaaggggYtttDtaaNgNtaaB
+atggaatgtctRtaBgBtcNYatatNRtagaacMgagSaSDDSaDcctRagtVWSHtVSR
+ggaacaBVaccgtttaStagaacaMtactccagtttVctaaRaaHttNcttagcaattta
+ttaatRtaaaatctaacDaBttggSagagctacHtaaRWgattcaaBtctRtSHaNtgta
+cattVcaHaNaagtataccacaWtaRtaaVKgMYaWgttaKggKMtKcgWatcaDatYtK
+SttgtacgaccNctSaattcDcatcttcaaaDKttacHtggttHggRRaRcaWacaMtBW
+VHSHgaaMcKattgtaRWttScNattBBatYtaNRgcggaagacHSaattRtttcYgacc
+BRccMacccKgatgaacttcgDgHcaaaaaRtatatDtatYVtttttHgSHaSaatagct
+NYtaHYaVYttattNtttgaaaYtaKttWtctaNtgagaaaNctNDctaaHgttagDcRt
+tatagccBaacgcaRBtRctRtggtaMYYttWtgataatcgaataattattataVaaaaa
+ttacNRVYcaaMacNatRttcKatMctgaagactaattataaYgcKcaSYaatMNctcaa
+cgtgatttttBacNtgatDccaattattKWWcattttatatatgatBcDtaaaagttgaa
+VtaHtaHHtBtataRBgtgDtaataMttRtDgDcttattNtggtctatctaaBcatctaR
+atgNacWtaatgaagtcMNaacNgHttatactaWgcNtaStaRgttaaHacccgaYStac
+aaaatWggaYaWgaattattcMaactcBKaaaRVNcaNRDcYcgaBctKaacaaaaaSgc
+tccYBBHYaVagaatagaaaacagYtctVccaMtcgtttVatcaatttDRtgWctagtac
+RttMctgtDctttcKtWttttataaatgVttgBKtgtKWDaWagMtaaagaaattDVtag
+gttacatcatttatgtcgMHaVcttaBtVRtcgtaYgBRHatttHgaBcKaYWaatcNSc
+tagtaaaaatttacaatcactSWacgtaatgKttWattagttttNaggtctcaagtcact
+attcttctaagKggaataMgtttcataagataaaaatagattatDgcBVHWgaBKttDgc
+atRHaagcaYcRaattattatgtMatatattgHDtcaDtcaaaHctStattaatHaccga
+cNattgatatattttgtgtDtRatagSacaMtcRtcattcccgacacSattgttKaWatt
+NHcaacttccgtttSRtgtctgDcgctcaaMagVtBctBMcMcWtgtaacgactctcttR
+ggRKSttgYtYatDccagttDgaKccacgVatWcataVaaagaataMgtgataaKYaaat
+cHDaacgataYctRtcYatcgcaMgtNttaBttttgatttaRtStgcaacaaaataccVg
+aaDgtVgDcStctatatttattaaaaRKDatagaaagaKaaYYcaYSgKStctccSttac
+agtcNactttDVttagaaagMHttRaNcSaRaMgBttattggtttaRMggatggcKDgWR
+tNaataataWKKacttcKWaaagNaBttaBatMHtccattaacttccccYtcBcYRtaga
+ttaagctaaYBDttaNtgaaaccHcaRMtKtaaHMcNBttaNaNcVcgVttWNtDaBatg
+ataaVtcWKcttRggWatcattgaRagHgaattNtatttctctattaattaatgaDaaMa
+tacgttgggcHaYVaaNaDDttHtcaaHtcVVDgBVagcMacgtgttaaBRNtatRtcag
+taagaggtttaagacaVaaggttaWatctccgtVtaDtcDatttccVatgtacNtttccg
+tHttatKgScBatgtVgHtYcWagcaKtaMYaaHgtaattaSaHcgcagtWNaatNccNN
+YcacgVaagaRacttctcattcccRtgtgtaattagcSttaaStWaMtctNNcSMacatt
+ataaactaDgtatWgtagtttaagaaaattgtagtNagtcaataaatttgatMMYactaa
+tatcggBWDtVcYttcDHtVttatacYaRgaMaacaStaatcRttttVtagaDtcacWat
+ttWtgaaaagaaagNRacDtttStVatBaDNtaactatatcBSMcccaSttccggaMatg
+attaaWatKMaBaBatttgataNctgttKtVaagtcagScgaaaDggaWgtgttttKtWt
+atttHaatgtagttcactaaKMagttSYBtKtaYgaactcagagRtatagtVtatcaaaW
+YagcgNtaDagtacNSaaYDgatBgtcgataacYDtaaactacagWDcYKaagtttatta
+gcatcgagttKcatDaattgattatDtcagRtWSKtcgNtMaaaaacaMttKcaWcaaSV
+MaaaccagMVtaMaDtMaHaBgaacataBBVtaatVYaNSWcSgNtDNaaKacacBttta
+tKtgtttcaaHaMctcagtaacgtcgYtactDcgcctaNgagagcYgatattttaaattt
+ccattttacatttDaaRctattttWctttacgtDatYtttcagacgcaaVttagtaaKaa
+aRtgVtccataBggacttatttgtttaWNtgttVWtaWNVDaattgtatttBaagcBtaa
+BttaaVatcHcaVgacattccNggtcgacKttaaaRtagRtctWagaYggtgMtataatM
+tgaaRttattttgWcttNtDRRgMDKacagaaaaggaaaRStcccagtYccVattaNaaK
+StNWtgacaVtagaagcttSaaDtcacaacgDYacWDYtgtttKatcVtgcMaDaSKStV
+cgtagaaWaKaagtttcHaHgMgMtctataagBtKaaaKKcactggagRRttaagaBaaN
+atVVcgRcKSttDaactagtSttSattgttgaaRYatggttVttaataaHttccaagDtg
+atNWtaagHtgcYtaactRgcaatgMgtgtRaatRaNaacHKtagactactggaatttcg
+ccataacgMctRgatgttaccctaHgtgWaYcactcacYaattcttaBtgacttaaacct
+gYgaWatgBttcttVttcgttWttMcNYgtaaaatctYgMgaaattacNgaHgaacDVVM
+tttggtHtctaaRgtacagacgHtVtaBMNBgattagcttaRcttacaHcRctgttcaaD
+BggttKaacatgKtttYataVaNattccgMcgcgtagtRaVVaattaKaatggttRgaMc
+agtatcWBttNtHagctaatctagaaNaaacaYBctatcgcVctBtgcaaagDgttVtga
+HtactSNYtaaNccatgtgDacgaVtDcgKaRtacDcttgctaagggcagMDagggtBWR
+tttSgccttttttaacgtcHctaVtVDtagatcaNMaVtcVacatHctDWNaataRgcgt
+aVHaggtaaaaSgtttMtattDgBtctgatSgtRagagYtctSaKWaataMgattRKtaa
+catttYcgtaacacattRWtBtcggtaaatMtaaacBatttctKagtcDtttgcBtKYYB
+aKttctVttgttaDtgattttcttccacttgSaaacggaaaNDaattcYNNaWcgaaYat
+tttMgcBtcatRtgtaaagatgaWtgaccaYBHgaatagataVVtHtttVgYBtMctaMt
+cctgaDcYttgtccaaaRNtacagcMctKaaaggatttacatgtttaaWSaYaKttBtag
+DacactagctMtttNaKtctttcNcSattNacttggaacaatDagtattRtgSHaataat
+gccVgacccgatactatccctgtRctttgagaSgatcatatcgDcagWaaHSgctYYWta
+tHttggttctttatVattatcgactaagtgtagcatVgtgHMtttgtttcgttaKattcM
+atttgtttWcaaStNatgtHcaaaDtaagBaKBtRgaBgDtSagtatMtaacYaatYtVc
+KatgtgcaacVaaaatactKcRgtaYtgtNgBBNcKtcttaccttKgaRaYcaNKtactt
+tgagSBtgtRagaNgcaaaNcacagtVtttHWatgttaNatBgtttaatNgVtctgaata
+tcaRtattcttttttttRaaKcRStctcggDgKagattaMaaaKtcaHacttaataataK
+taRgDtKVBttttcgtKaggHHcatgttagHggttNctcgtatKKagVagRaaaggaaBt
+NatttVKcRttaHctaHtcaaatgtaggHccaBataNaNaggttgcWaatctgatYcaaa
+HaatWtaVgaaBttagtaagaKKtaaaKtRHatMaDBtBctagcatWtatttgWttVaaa
+ScMNattRactttgtYtttaaaagtaagtMtaMaSttMBtatgaBtttaKtgaatgagYg
+tNNacMtcNRacMMHcttWtgtRtctttaacaacattattcYaMagBaacYttMatcttK
+cRMtgMNccattaRttNatHaHNaSaaHMacacaVaatacaKaSttHatattMtVatWga
+ttttttaYctttKttHgScWaacgHtttcaVaaMgaacagNatcgttaacaaaaagtaca
+HBNaattgttKtcttVttaaBtctgctacgBgcWtttcaggacacatMgacatcccagcg
+gMgaVKaBattgacttaatgacacacaaaaaatRKaaBctacgtRaDcgtagcVBaacDS
+BHaaaaSacatatacagacRNatcttNaaVtaaaataHattagtaaaaSWccgtatWatg
+gDttaactattgcccatcttHaSgYataBttBaactattBtcHtgatcaataSttaBtat
+KSHYttWggtcYtttBttaataccRgVatStaHaKagaatNtagRMNgtcttYaaSaact
+cagDSgagaaYtMttDtMRVgWKWtgMaKtKaDttttgactatacataatcNtatNaHat
+tVagacgYgatatatttttgtStWaaatctWaMgagaRttRatacgStgattcttaagaD
+taWccaaatRcagcagaaNKagtaaDggcgccBtYtagSBMtactaaataMataBSacRM
+gDgattMMgtcHtcaYDtRaDaacggttDaggcMtttatgttaNctaattaVacgaaMMt
+aatDccSgtattgaRtWWaccaccgagtactMcgVNgctDctaMScatagcgtcaactat
+acRacgHRttgctatttaatgaattataYKttgtaagWgtYttgcHgMtaMattWaWVta
+RgcttgYgttBHtYataSccStBtgtagMgtDtggcVaaSBaatagDttgBgtctttctc
+attttaNagtHKtaMWcYactVcgcgtatMVtttRacVagDaatcttgctBBcRDgcaac
+KttgatSKtYtagBMagaRtcgBattHcBWcaactgatttaatttWDccatttatcgagS
+KaWttataHactaHMttaatHtggaHtHagaatgtKtaaRactgtttMatacgatcaagD
+gatKaDctataMggtHDtggHacctttRtatcttYattttgacttgaaSaataaatYcgB
+aaaaccgNatVBttMacHaKaataagtatKgtcaagactcttaHttcggaattgttDtct
+aaccHttttWaaatgaaatataaaWattccYDtKtaaaacggtgaggWVtctattagtga
+ctattaagtMgtttaagcatttgSgaaatatccHaaggMaaaattttcWtatKctagDtY
+tMcctagagHcactttactatacaaacattaacttaHatcVMYattYgVgtMttaaRtga
+aataaDatcaHgtHHatKcDYaatcttMtNcgatYatgSaMaNtcttKcWataScKggta
+tcttacgcttWaaagNatgMgHtctttNtaacVtgttcMaaRatccggggactcMtttaY
+MtcWRgNctgNccKatcttgYDcMgattNYaRagatHaaHgKctcataRDttacatBatc
+cattgDWttatttaWgtcggagaaaaatacaatacSNtgggtttccttacSMaagBatta
+caMaNcactMttatgaRBacYcYtcaaaWtagctSaacttWgDMHgaggatgBVgcHaDt
+ggaactttggtcNatNgtaKaBcccaNtaagttBaacagtatacDYttcctNgWgcgSMc
+acatStctHatgRcNcgtacacaatRttMggaNKKggataaaSaYcMVcMgtaMaHtgat
+tYMatYcggtcttcctHtcDccgtgRatcattgcgccgatatMaaYaataaYSggatagc
+gcBtNtaaaScaKgttBgagVagttaKagagtatVaactaSacWactSaKatWccaKaaa
+atBKgaaKtDMattttgtaaatcRctMatcaaMagMttDgVatggMaaWgttcgaWatga
+aatttgRtYtattaWHKcRgctacatKttctaccaaHttRatctaYattaaWatVNccat
+NgagtcKttKataStRaatatattcctRWatDctVagttYDgSBaatYgttttgtVaatt
+taatagcagMatRaacttBctattgtMagagattaaactaMatVtHtaaatctRgaaaaa
+aaatttWacaacaYccYDSaattMatgaccKtaBKWBattgtcaagcHKaagttMMtaat
+ttcKcMagNaaKagattggMagaggtaatttYacatcWaaDgatMgKHacMacgcVaaca
+DtaDatatYggttBcgtatgWgaSatttgtagaHYRVacaRtctHaaRtatgaactaata
+tctSSBgggaaHMWtcaagatKgagtDaSatagttgattVRatNtctMtcSaagaSHaat
+aNataataRaaRgattctttaataaagWaRHcYgcatgtWRcttgaaggaMcaataBRaa
+ccagStaaacNtttcaatataYtaatatgHaDgcStcWttaacctaRgtYaRtataKtgM
+ttttatgactaaaatttacYatcccRWtttHRtattaaatgtttatatttgttYaatMca
+RcSVaaDatcgtaYMcatgtagacatgaaattgRtcaaYaaYtRBatKacttataccaNa
+aattVaBtctggacaagKaaYaaatatWtMtatcYaaVNtcgHaactBaagKcHgtctac
+aatWtaDtSgtaHcataHtactgataNctRgttMtDcDttatHtcgtacatcccaggStt
+aBgtcacacWtccNMcNatMVaVgtccDYStatMaccDatggYaRKaaagataRatttHK
+tSaaatDgataaacttaHgttgVBtcttVttHgDacgaKatgtatatNYataactctSat
+atatattgcHRRYttStggaactHgttttYtttaWtatMcttttctatctDtagVHYgMR
+BgtHttcctaatYRttKtaagatggaVRataKDctaMtKBNtMtHNtWtttYcVtattMc
+gRaacMcctNSctcatttaaagDcaHtYccSgatgcaatYaaaaDcttcgtaWtaattct
+cgttttScttggtaatctttYgtctaactKataHacctMctcttacHtKataacacagcN
+RatgKatttttSaaatRYcgDttaMRcgaaattactMtgcgtaagcgttatBtttttaat
+taagtNacatHgttcRgacKcBBtVgatKttcgaBaatactDRgtRtgaNacWtcacYtt
+aaKcgttctHaKttaNaMgWgWaggtctRgaKgWttSttBtDcNtgtttacaaatYcDRt
+gVtgcctattcNtctaaaDMNttttNtggctgagaVctDaacVtWccaagtaacacaNct
+gaScattccDHcVBatcgatgtMtaatBgHaatDctMYgagaatgYWKcctaatNaStHa
+aaKccgHgcgtYaaYtattgtStgtgcaaRtattaKatattagaWVtcaMtBagttatta
+gNaWHcVgcaattttDcMtgtaRHVYtHtctgtaaaaHVtMKacatcgNaatttMatatg
+ttgttactagWYtaRacgataKagYNKcattataNaRtgaacKaYgcaaYYacaNccHat
+MatDcNgtHttRaWttagaaDcaaaaaatagggtKDtStaDaRtaVtHWKNtgtattVct
+SVgRgataDaRaWataBgaagaaKtaataaYgDcaStaNgtaDaaggtattHaRaWMYaY
+aWtggttHYgagVtgtgcttttcaaDKcagVcgttagacNaaWtagtaataDttctggtt
+VcatcataaagtgKaaaNaMtaBBaattaatWaattgctHaVKaSgDaaVKaHtatatat
+HatcatSBagNgHtatcHYMHgttDgtaHtBttWatcgtttaRaattgStKgSKNWKatc
+agDtctcagatttctRtYtBatBgHHtKaWtgYBgacVVWaKtacKcDttKMaKaVcggt
+gttataagaataaHaatattagtataatMHgttYgaRttagtaRtcaaVatacggtcMcg
+agtaaRttacWgactKRYataaaagSattYaWgagatYagKagatgSaagKgttaatMgg
+tataatgttWYttatgagaaacctNVataatHcccKtDctcctaatactggctHggaSag
+gRtKHaWaattcgSatMatttagaggcYtctaMcgctcataSatatgRagacNaaDagga
+VBagaYttKtacNaKgtSYtagttggaWcatcWttaatctatgaVtcgtgtMtatcaYcg
+tRccaaYgDctgcMgtgtWgacWtgataacacgcgctBtgttaKtYDtatDcatcagKaV
+MctaatcttgVcaaRgcRMtDcgattaHttcaNatgaatMtactacVgtRgatggaWttt
+actaaKatgagSaaKggtaNtactVaYtaaKRagaacccacaMtaaMtKtatBcttgtaa
+WBtMctaataaVcDaaYtcRHBtcgttNtaaHatttBNgRStVDattBatVtaagttaYa
+tVattaagaBcacggtSgtVtatttaRattgatgtaHDKgcaatattKtggcctatgaWD
+KRYcggattgRctatNgatacaatMNttctgtcRBYRaaaHctNYattcHtaWcaattct
+BtMKtVgYataatMgYtcagcttMDataVtggRtKtgaatgccNcRttcaMtRgattaac
+attRcagcctHtWMtgtDRagaKaBtgDttYaaaaKatKgatctVaaYaacWcgcatagB
+VtaNtRtYRaggBaaBtgKgttacataagagcatgtRattccacttaccatRaaatgWgD
+aMHaYVgVtaSctatcgKaatatattaDgacccYagtgtaYNaaatKcagtBRgagtcca
+tgKgaaaccBgaagBtgSttWtacgatWHaYatcgatttRaaNRgcaNaKVacaNtDgat
+tgHVaatcDaagcgtatgcNttaDataatcSataaKcaataaHWataBtttatBtcaKtK
+tatagttaDgSaYctacaRatNtaWctSaatatttYaKaKtaccWtatcRagacttaYtt
+VcKgSDcgagaagatccHtaattctSttatggtKYgtMaHagVaBRatttctgtRgtcta
+tgggtaHKgtHacHtSYacgtacacHatacKaaBaVaccaDtatcSaataaHaagagaat
+ScagactataaRttagcaaVcaHataKgDacatWccccaagcaBgagWatctaYttgaaa
+tctVNcYtttWagHcgcgcDcVaaatgttKcHtNtcaatagtgtNRaactttttcaatgg
+WgBcgDtgVgtttctacMtaaataaaRggaaacWaHttaRtNtgctaaRRtVBctYtVta
+tDcattDtgaccYatagatYRKatNYKttNgcctagtaWtgaactaMVaacctgaStttc
+tgaKVtaaVaRKDttVtVctaDNtataaaDtccccaagtWtcgatcactDgYaBcatcct
+MtVtacDaaBtYtMaKNatNtcaNacgDatYcatcgcaRatWBgaacWttKttagYtaat
+tcggttgSWttttDWctttacYtatatWtcatDtMgtBttgRtVDggttaacYtacgtac
+atgaattgaaWcttMStaDgtatattgaDtcRBcattSgaaVBRgagccaaKtttcDgcg
+aSMtatgWattaKttWtgDBMaggBBttBaatWttRtgcNtHcgttttHtKtcWtagHSt
+aacagttgatatBtaWSaWggtaataaMttaKacDaatactcBttcaatatHttcBaaSa
+aatYggtaRtatNtHcaatcaHtagVtgtattataNggaMtcttHtNagctaaaggtaga
+YctMattNaMVNtcKtactBKcaHHcBttaSagaKacataYgctaKaYgttYcgacWVtt
+WtSagcaacatcccHaccKtcttaacgaKttcacKtNtacHtatatRtaaatacactaBt
+ttgaHaRttggttWtatYagcatYDatcggagagcWBataagRtacctataRKgtBgatg
+aDatataSttagBaHtaatNtaDWcWtgtaattacagKttcNtMagtattaNgtctcgtc
+ctcttBaHaKcKccgtRcaaYagSattaagtKataDatatatagtcDtaacaWHcaKttD
+gaaRcgtgYttgtcatatNtatttttatggccHtgDtYHtWgttatYaacaattcaWtat
+NgctcaaaSttRgctaatcaaatNatcgtttaBtNNVtgttataagcaaagattBacgtD
+atttNatttaaaDcBgtaSKgacgtagataatttcHMVNttgttBtDtgtaWKaaRMcKM
+tHtaVtagataWctccNNaSWtVaHatctcMgggDgtNHtDaDttatatVWttgttattt
+aacctttcacaaggaSaDcggttttttatatVtctgVtaacaStDVaKactaMtttaSNa
+gtgaaattaNacttSKctattcctctaSagKcaVttaagNaVcttaVaaRNaHaaHttat
+gtHttgtgatMccaggtaDcgaccgtWgtWMtttaHcRtattgScctatttKtaaccaag
+tYagaHgtWcHaatgccKNRtttagtMYSgaDatctgtgaWDtccMNcgHgcaaacNDaa
+aRaStDWtcaaaaHKtaNBctagBtgtattaactaattttVctagaatggcWSatMaccc
+ttHttaSgSgtgMRcatRVKtatctgaaaccDNatYgaaVHNgatMgHRtacttaaaRta
+tStRtDtatDttYatattHggaBcttHgcgattgaKcKtttcRataMtcgaVttWacatN
+catacctRataDDatVaWNcggttgaHtgtMacVtttaBHtgagVttMaataattatgtt
+cttagtttgtgcDtSatttgBtcaacHattaaBagVWcgcaSYttMgcttacYKtVtatc
+aYaKctgBatgcgggcYcaaaaacgNtctagKBtattatctttKtaVttatagtaYtRag
+NtaYataaVtgaatatcHgcaaRataHtacacatgtaNtgtcgYatWMatttgaactacR
+ctaWtWtatacaatctBatatgYtaagtatgtgtatSttactVatcttYtaBcKgRaSgg
+RaaaaatgcagtaaaWgtaRgcgataatcBaataccgtatttttccatcNHtatWYgatH
+SaaaDHttgctgtccHtggggcctaataatttttctatattYWtcattBtgBRcVttaVM
+RSgctaatMagtYtttaaaaatBRtcBttcaaVtaacagctccSaaSttKNtHtKYcagc
+agaaaccccRtttttaaDcDtaStatccaagcgctHtatcttaDRYgatDHtWcaaaBcW
+gKWHttHataagHacgMNKttMKHccaYcatMVaacgttaKgYcaVaaBtacgcaacttt
+MctaaHaatgtBatgagaSatgtatgSRgHgWaVWgataaatatttccKagVgataattW
+aHNcYggaaatgctHtKtaDtctaaagtMaatVDVactWtSaaWaaMtaHtaSKtcBRaN
+cttStggtBttacNagcatagRgtKtgcgaacaacBcgKaatgataagatgaaaattgta
+ctgcgggtccHHWHaaNacaBttNKtKtcaaBatatgctaHNgtKcDWgtttatNgVDHg
+accaacWctKaaggHttgaRgYaatHcaBacaatgagcaaattactgtaVaaYaDtagat
+tgagNKggtggtgKtWKaatacagDRtatRaMRtgattDggtcaaYRtatttNtagaDtc
+acaaSDctDtataatcgtactaHttatacaatYaacaaHttHatHtgcgatRRttNgcat
+SVtacWWgaaggagtatVMaVaaattScDDKNcaYBYaDatHgtctatBagcaacaagaa
+tgagaaRcataaKNaRtBDatcaaacgcattttttaaBtcSgtacaRggatgtMNaattg
+gatatWtgagtattaaaVctgcaYMtatgatttttYgaHtgtcttaagWBttHttgtctt
+attDtcgtatWtataataSgctaHagcDVcNtaatcaagtaBDaWaDgtttagYctaNcc
+DtaKtaHcttaataacccaRKtacaVaatNgcWRaMgaattatgaBaaagattVYaHMDc
+aDHtcRcgYtcttaaaWaaaVKgatacRtttRRKYgaatacaWVacVcRtatMacaBtac
+tggMataaattttHggNagSctacHgtBagcgtcgtgattNtttgatSaaggMttctttc
+ttNtYNagBtaaacaaatttMgaccttacataattgYtcgacBtVMctgStgMDtagtaR
+ctHtatgttcatatVRNWataDKatWcgaaaaagttaaaagcacgHNacgtaatctttMR
+tgacttttDacctataaacgaaatatgattagaactccSYtaBctttaataacWgaaaYa
+tagatgWttcatKtNgatttttcaagHtaYgaaRaDaagtaggagcttatVtagtctttc
+attaaaatcgKtattaRttacagVaDatgcatVgattgggtctttHVtagKaaRBtaHta
+aggccccaaaaKatggtttaMWgtBtaaacttcactttKHtcgatctccctaYaBacMgt
+cttBaBaNgcgaaacaatctagtHccHtKttcRtRVttccVctttcatacYagMVtMcag
+aMaaacaataBctgYtaatRaaagattaaccatVRatHtaRagcgcaBcgDttStttttc
+VtttaDtKgcaaWaaaaatSccMcVatgtKgtaKgcgatatgtagtSaaaDttatacaaa
+catYaRRcVRHctKtcgacKttaaVctaDaatgttMggRcWaacttttHaDaKaDaBctg
+taggcgtttaHBccatccattcNHtDaYtaataMttacggctNVaacDattgatatttta
+cVttSaattacaaRtataNDgacVtgaacataVRttttaDtcaaacataYDBtttaatBa
+DtttYDaDaMccMttNBttatatgagaaMgaNtattHccNataattcaHagtgaaggDga
+tgtatatatgYatgaStcataaBStWacgtcccataRMaaDattggttaaattcMKtctM
+acaBSactcggaatDDgatDgcWctaacaccgggaVcacWKVacggtaNatatacctMta
+tgatagtgcaKagggVaDtgtaacttggagtcKatatcgMcttRaMagcattaBRaStct
+YSggaHYtacaactMBaagDcaBDRaaacMYacaHaattagcattaaaHgcgctaaggSc
+cKtgaaKtNaBtatDDcKBSaVtgatVYaagVtctSgMctacgttaacWaaattctSgtD
+actaaStaaattgcagBBRVctaatatacctNttMcRggctttMttagacRaHcaBaacV
+KgaataHttttMgYgattcYaNRgttMgcVaaacaVVcDHaatttgKtMYgtatBtVVct
+WgVtatHtacaaHttcacgatagcagtaaNattBatatatttcVgaDagcggttMaagtc
+ScHagaaatgcYNggcgtttttMtStggtRatctacttaaatVVtBacttHNttttaRca
+aatcacagHgagagtMgatcSWaNRacagDtatactaaDKaSRtgattctccatSaaRtt
+aaYctacacNtaRtaactggatgaccYtacactttaattaattgattYgttcagDtNKtt
+agDttaaaaaaaBtttaaNaYWKMBaaaacVcBMtatWtgBatatgaacVtattMtYatM
+NYDKNcKgDttDaVtaaaatgggatttctgtaaatWtctcWgtVVagtcgRgacttcccc
+taDcacagcRcagagtgtWSatgtacatgttaaSttgtaaHcgatgggMagtgaacttat
+RtttaVcaccaWaMgtactaatSSaHtcMgaaYtatcgaaggYgggcgtgaNDtgttMNg
+aNDMtaattcgVttttaacatgVatgtWVMatatcaKgaaattcaBcctccWcttgaaWH
+tWgHtcgNWgaRgctcBgSgaattgcaaHtgattgtgNagtDttHHgBttaaWcaaWagc
+aSaHHtaaaVctRaaMagtaDaatHtDMtcVaWMtagSagcttHSattaacaaagtRacM
+tRtctgttagcMtcaBatVKtKtKacgagaSNatSactgtatatcBctgagVtYactgta
+aattaaaggcYgDHgtaacatSRDatMMccHatKgttaacgactKtgKagtcttcaaHRV
+tccttKgtSataatttacaactggatDNgaacttcaRtVaagDcaWatcBctctHYatHa
+DaaatttagYatSatccaWtttagaaatVaacBatHcatcgtacaatatcgcNYRcaata
+YaRaYtgattVttgaatgaVaactcRcaNStgtgtattMtgaggtNttBaDRcgaaaagc
+tNgBcWaWgtSaDcVtgVaatMKBtttcgtttctaaHctaaagYactgMtatBDtcStga
+ccgtSDattYaataHctgggaYYttcggttaWaatctggtRagWMaDagtaacBccacta
+cgHWMKaatgatWatcctgHcaBaSctVtcMtgtDttacctaVgatYcWaDRaaaaRtag
+atcgaMagtggaRaWctctgMgcWttaagKBRtaaDaaWtctgtaagYMttactaHtaat
+cttcataacggcacBtSgcgttNHtgtHccatgttttaaagtatcgaKtMttVcataYBB
+aKtaMVaVgtattNDSataHcagtWMtaggtaSaaKgttgBtVtttgttatcatKcgHac
+acRtctHatNVagSBgatgHtgaRaSgttRcctaacaaattDNttgacctaaYtBgaaaa
+tagttattactcttttgatgtNNtVtgtatMgtcttRttcatttgatgacacttcHSaaa
+ccaWWDtWagtaRDDVNacVaRatgttBccttaatHtgtaaacStcVNtcacaSRttcYa
+gacagaMMttttgMcNttBcgWBtactgVtaRttctccaaYHBtaaagaBattaYacgat
+ttacatctgtaaMKaRYtttttactaaVatWgctBtttDVttctggcDaHaggDaagtcg
+aWcaagtagtWttHtgKtVataStccaMcWcaagataagatcactctHatgtcYgaKcat
+cagatactaagNSStHcctRRNtattgtccttagttagMVgtatagactaactctVcaat
+MctgtttgtgttgccttatWgtaBVtttctggMcaaKgDWtcgtaaYStgSactatttHg
+atctgKagtagBtVacRaagRtMctatgggcaaaKaaaatacttcHctaRtgtDcttDat
+taggaaatttcYHaRaaBttaatggcacKtgctHVcaDcaaaVDaaaVcgMttgtNagcg
+taDWgtcgttaatDgKgagcSatatcSHtagtagttggtgtHaWtaHKtatagctgtVga
+ttaBVaatgaataagtaatVatSttaHctttKtttgtagttaccttaatcgtagtcctgB
+cgactatttVcMacHaaaggaatgDatggKtaHtgStatattaaSagctWcctccRtata
+BaDYcgttgcNaagaggatRaaaYtaWgNtSMcaatttactaacatttaaWttHtatBat
+tgtcgacaatNgattgcNgtMaaaKaBDattHacttggtRtttaYaacgVactBtaBaKt
+gBttatgVttgtVttcaatcWcNctDBaaBgaDHacBttattNtgtDtatttVSaaacag
+gatgcRatSgtaSaNtgBatagttcHBgcBBaaattaHgtDattatDaKaatBaaYaaMa
+ataaataKtttYtagtBgMatNcatgtttgaNagtgttgtgKaNaSagtttgaSMaYBca
+aaacDStagttVacaaaaactaaWttBaagtctgtgcgtMgtaattctcctacctcaNtt
+taaccaaaaVtBcacataacaccccBcWMtatVtggaatgaWtcaaWaaaaaaaaWtDta
+atatRcctDWtcctaccMtVVatKttaWaaKaaatataaagScHBagaggBaSMtaWaVt
+atattactSaaaKNaactatNatccttgaYctattcaaaVgatttYHcRagattttaSat
+aggttattcVtaaagaKgtattattKtRttNcggcRgtgtgtWYtaacHgKatKgatYta
+cYagDtWcHBDctctgRaYKaYagcactKcacSaRtBttttBHKcMtNtcBatttatttt
+tgSatVgaaagaWtcDtagDatatgMacaacRgatatatgtttgtKtNRaatatNatgYc
+aHtgHataacKtgagtagtaacYttaNccaaatHcacaacaVDtagtaYtccagcattNt
+acKtBtactaaagaBatVtKaaHBctgStgtBgtatgaSNtgDataaccctgtagcaBgt
+gatcttaDataStgaMaccaSBBgWagtacKcgattgaDgNNaaaacacagtSatBacKD
+gcgtataBKcatacactaSaatYtYcDaactHttcatRtttaatcaattataRtttgtaa
+gMcgNttcatcBtYBagtNWNMtSHcattcRctttttRWgaKacKttgggagBcgttcgc
+MaWHtaatactgtctctatttataVgtttaBScttttaBMaNaatMacactYtBMggtHa
+cMagtaRtctgcatttaHtcaaaatttgagKtgNtactBacaHtcgtatttctMaSRagc
+agttaatgtNtaaattgagagWcKtaNttagVtacgatttgaatttcgRtgtWcVatcgt
+taaDVctgtttBWgaccagaaagtcSgtVtatagaBccttttcctaaattgHtatcggRa
+ttttcaaggcYSKaagWaWtRactaaaacccBatMtttBaatYtaagaactSttcgaaSc
+aatagtattgaccaagtgttttctaacatgtttNVaatcaaagagaaaNattaaRtttta
+VaaaccgcaggNMtatattVctcaagaggaacgBgtttaacaagttcKcYaatatactaa
+ccBaaaSggttcNtattctagttRtBacgScVctcaatttaatYtaaaaaaatgSaatga
+tagaMBRatgRcMcgttgaWHtcaVYgaatYtaatctttYttatRaWtctgBtDcgatNa
+tcKaBaDgatgtaNatWKctccgatattaacattNaaacDatgBgttctgtDtaaaMggt
+gaBaSHataacgccSctaBtttaRBtcNHcDatcDcctagagtcRtaBgWttDRVHagat
+tYatgtatcWtaHtttYcattWtaaagtctNgtStggRNcgcggagSSaaagaaaatYcH
+DtcgctttaatgYcKBVSgtattRaYBaDaaatBgtatgaHtaaRaRgcaSWNtagatHa
+acttNctBtcaccatctMcatattccaSatttgcgaDagDgtatYtaaaVDtaagtttWV
+aagtagYatRttaagDcNgacKBcScagHtattatcDaDactaaaaaYgHttBcgaDttg
+gataaaKSRcBMaBcgaBSttcWtgNBatRaccgattcatttataacggHVtaattcaca
+agagVttaaRaatVVRKcgWtVgacctgDgYaaHaWtctttcacMagggatVgactagMa
+aataKaaNWagKatagNaaWtaaaatttgaattttatttgctaaVgaHatBatcaaBWcB
+gttcMatcgBaaNgttcgSNaggSaRtttgHtRtattaNttcDcatSaVttttcgaaaaa
+ttgHatctaRaggSaNatMDaaatDcacgattttagaHgHaWtYgattaatHNSttatMS
+gggNtcKtYatRggtttgtMWVtttaYtagcagBagHaYagttatatggtBacYcattaR
+SataBatMtttaaatctHcaaaSaaaagttNSaaWcWRccRtKaagtBWtcaaattSttM
+tattggaaaccttaacgttBtWatttatatWcDaatagattcctScacctaagggRaaYt
+aNaatgVtBcttaaBaacaMVaaattatStYgRcctgtactatcMcVKatttcgSgatRH
+MaaaHtagtaaHtVgcaaataatatcgKKtgccaatBNgaaWcVttgagttaKatagttc
+aggKDatDtattgaKaVcaKtaataDataataHSaHcattagttaatRVYcNaHtaRcaa
+ggtNHcgtcaaccaBaaagYtHWaaaRcKgaYaaDttgcWYtataRgaatatgtYtgcKt
+aNttWacatYHctRaDtYtattcBttttatcSataYaYgttWaRagcacHMgtttHtYtt
+YaatcggtatStttcgtRSattaaDaKMaatatactaNBaWgctacacYtgaYVgtgHta
+aaRaaRgHtagtWattataaaSDaaWtgMattatcgaaaagtaYRSaWtSgNtBgagcRY
+aMDtactaacttaWgtatctagacaagNtattHggataatYttYatcataDcgHgttBtt
+ctttVttgccgaaWtaaaacgKgtatctaaaaaNtccDtaDatBMaMggaatNKtatBaa
+atVtccRaHtaSacataHattgtttKVYattcataVaattWtcgtgMttcttKtgtctaa
+cVtatctatatBRataactcgKatStatattcatHHRttKtccaacgtgggtgRgtgaMt
+attattggctatcgtgacMtRcBDtcttgtactaatRHttttaagatcgVMDStattatY
+BtttDttgtBtNttgRcMtYtgBacHaWaBaatDKctaagtgaaactaatgRaaKgatcc
+aagNaaaatattaggWNtaagtatacttttKcgtcggSYtcttgRctataYcttatataa
+agtatattaatttataVaacacaDHatctatttttKYVatHRactttaBHccaWagtact
+BtcacgaVgcgttRtttttttSVgtSagtBaaattctgaHgactcttgMcattttagVta
+agaattHctHtcaDaaNtaacRggWatagttcgtSttgaDatcNgNagctagDgatcNtt
+KgttgtaDtctttRaaYStRatDtgMggactSttaDtagSaVtBDttgtDgccatcacaM
+attaaaMtNacaVcgSWcVaaDatcaHaatgaattaMtatccVtctBtaattgtWattat
+BRcWcaatgNNtactWYtDaKttaaatcactcagtRaaRgatggtKgcgccaaHgaggat
+StattYcaNMtcaBttacttatgagDaNtaMgaaWtgtttcttctaHtMNgttatctaWW
+atMtBtaaatagDVatgtBYtatcggcttaagacMRtaHScgatatYgRDtcattatSDa
+HggaaataNgaWSRRaaaBaatagBattaDctttgHWNttacaataaaaaaatacggttt
+gHgVtaHtWMttNtBtctagtMcgKMgHgYtataHaNagWtcaacYattaataYRgtaWK
+gaBctataaccgatttaHaNBRaRaMtccggtNgacMtctcatttgcaattcWgMactta
+caaDaaNtactWatVtttagccttMaatcagVaagtctVaaDaBtattaattaYtNaYtg
+gattaKtaKctYaMtattYgatattataatKtVgDcttatatNBtcgttgtStttttMag
+aggttaHYSttcKgtcKtDNtataagttataagSgttatDtRttattgttttSNggRtca
+aKMNatgaatattgtBWtaMacctgggYgaSgaagYataagattacgagaatBtggtRcV
+HtgYggaDgaYaKagWagctatagacgaaHgtWaNgacttHRatVaWacKYtgRVNgVcS
+gRWctacatcKSactctgWYtBggtataagcttNRttVtgRcaWaaatDMatYattaact
+ttcgaagRatSctgccttgcRKaccHtttSNVagtagHagBagttagaccaRtataBcca
+taatSHatRtcHagacBWatagcaMtacaRtgtgaaBatctKRtScttccaNaatcNgta
+atatWtcaMgactctBtWtaaNactHaaaaRctcgcatggctMcaaNtcagaaaaacaca
+gtggggWttRttagtaagaVctVMtcgaatcttcMaaaHcaHBttcgattatgtcaDagc
+YRtBtYcgacMgtDcagcgaNgttaataatagcagKYYtcgtaBtYctMaRtaRtDagaa
+aacacatgYaBttgattattcgaaNttBctSataaMataWRgaHtttccgtDgaYtatgg
+tDgHKgMtatttVtMtVagttaRatMattRagataaccctKctMtSttgaHagtcStcta
+tttccSagatgttccacgaggYNttHRacgattcDatatDcataaaatBBttatcgaHtN
+HaaatatDNaggctgaNcaaggagttBttMgRagVatBcRtaWgatgBtSgaKtcgHttt
+gaatcaaDaHttcSBgHcagtVaaSttDcagccgttNBtgttHagYtattctttRWaaVt
+SttcatatKaaRaaaNacaVtVctMtSDtDtRHRcgtaatgctcttaaatSacacaatcg
+HattcaWcttaaaatHaaatcNctWttaNMcMtaKctVtcctaagYgatgatcYaaaRac
+tctaRDaYagtaacgtDgaggaaatctcaaacatcaScttcKttNtaccatNtaNataca
+tttHaaDHgcaDatMWaaBttcRggctMaagctVYcacgatcaDttatYtaatcKatWat
+caatVYtNagatttgattgaYttttYgacttVtcKaRagaaaHVgDtaMatKYagagttN
+atWttaccNtYtcDWgSatgaRgtMatgKtcgacaagWtacttaagtcgKtgatccttNc
+ttatagMatHVggtagcgHctatagccctYttggtaattKNaacgaaYatatVctaataM
+aaaYtgVtcKaYtaataacagaatHcacVagatYWHttagaaSMaatWtYtgtaaagNaa
+acaVgaWtcacNWgataNttcaSagctMDaRttgNactaccgataMaaatgtttattDtc
+aagacgctDHYYatggttcaagccNctccttcMctttagacBtaaWtaWVHggaaaaNat
+ttaDtDtgctaaHHtMtatNtMtagtcatttgcaaaRatacagRHtatDNtgtDgaatVg
+tVNtcaaatYBMaaaagcaKgtgatgatMgWWMaHttttMgMagatDtataaattaacca
+actMtacataaattgRataatacgBtKtaataattRgtatDagDtcRDacctatRcagag
+cSHatNtcaScNtttggacNtaaggaccgtgKNttgttNcttgaaRgYgRtNtcagttBc
+ttttcHtKtgcttYaaNgYagtaaatgaatggWaMattBHtatctatSgtcYtgcHtaat
+tHgaaMtHcagaaSatggtatgccaHBtYtcNattWtgtNgctttaggtttgtWatNtgH
+tgcDttactttttttgcNtactKtWRaVcttcatagtgSNKaNccgaataaBttataata
+YtSagctttaaatSttggctaaKSaatRccgWHgagDttaaatcatgagMtcgagtVtaD
+ggaBtatttgDacataaacgtagYRagBWtgDStKDgatgaagttcattatttaKWcata
+aatWRgatataRgttRacaaNKttNtKagaaYaStaactScattattaacgatttaaatg
+DtaattagatHgaYataaactatggggatVHtgccgtNgatNYcaStRtagaccacWcaM
+tatRagHgVactYtWHtcttcatgatWgagaKggagtatgaWtDtVtNaNtcgYYgtaaa
+ctttaDtBactagtaDctatagtaatatttatatataacgHaaaRagKattSagttYtSt
+>THREE Homo sapiens frequency
+agagagacgatgaaaattaatcgtcaatacgctggcgaacactgagggggacccaatgct
+cttctcggtctaaaaaggaatgtgtcagaaattggtcagttcaaaagtagaccggatctt
+tgcggagaacaattcacggaacgtagcgttgggaaatatcctttctaccacacatcggat
+tttcgccctctcccattatttattgtgttctcacatagaattattgtttagacatccctc
+gttgtatggagagttgcccgagcgtaaaggcataatccatataccgccgggtgagtgacc
+tgaaattgtttttagttgggatttcgctatggattagcttacacgaagagattctaatgg
+tactataggataattataatgctgcgtggcgcagtacaccgttacaaacgtcgttcgcat
+atgtggctaacacggtgaaaatacctacatcgtatttgcaatttcggtcgtttcatagag
+cgcattgaattactcaaaaattatatatgttgattatttgattagactgcgtggaaagaa
+ggggtactcaagccatttgtaaaagctgcatctcgcttaagtttgagagcttacattagt
+ctatttcagtcttctaggaaatgtctgtgtgagtggttgtcgtccataggtcactggcat
+atgcgattcatgacatgctaaactaagaaagtagattactattaccggcatgcctaatgc
+gattgcactgctatgaaggtgcggacgtcgcgcccatgtagccctgataataccaatact
+tacatttggtcagcaattctgacattatacctagcacccataaatttactcagacttgag
+gacaggctcttggagtcgatcttctgtttgtatgcatgtgatcatatagatgaataagcg
+atgcgactagttagggcatagtatagatctgtgtatacagttcagctgaacgtccgcgag
+tggaagtacagctgagatctatcctaaaatgcaaccatatcgttcacacatgatatgaac
+ccagggggaaacattgagttcagttaaattggcagcgaatcccccaagaagaaggcggag
+tgacgttgaacgggcttatggtttttcagtacttcctccgtataagttgagcgaaatgta
+aacagaataatcgttgtgttaacaacattaaaatcgcggaatatgatgagaatacacagt
+gtgagcatttcacttgtaaaatatctttggtagaacttactttgctttaaatatgttaaa
+ccgatctaataatctacaaaacggtagattttgcctagcacattgcgtccttctctattc
+agatagaggcaatactcagaaggttttatccaaagcactgtgttgactaacctaagtttt
+agtctaataatcatgattgattataggtgccgtggactacatgactcgtccacaaataat
+acttagcagatcagcaattggccaagcacccgacttttatttaatggttgtgcaatagtc
+cagattcgtattcgggactctttcaaataatagtttcctggcatctaagtaagaaaagct
+cataaggaagcgatattatgacacgctcttccgccgctgttttgaaacttgagtattgct
+cgtccgaaattgagggtcacttcaaaatttactgagaagacgaagatcgactaaagttaa
+aatgctagtccacagttggtcaagttgaattcatccacgagttatatagctattttaatt
+tatagtcgagtgtacaaaaaacatccacaataagatttatcttagaataacaacccccgt
+atcatcgaaatcctccgttatggcctgactcctcgagcttatagcatttgtgctggcgct
+cttgccaggaacttgctcgcgaggtggtgacgagtgagatgatcagtttcattatgatga
+tacgattttatcgcgactagttaatcatcatagcaagtaaaatttgaattatgtcattat
+catgctccattaacaggttatttaattgatactgacgaaattttttcacaatgggttttc
+tagaatttaatatcagtaattgaagccttcataggggtcctactagtatcctacacgacg
+caggtccgcagtatcctggagggacgtgttactgattaaaagggtcaaaggaatgaaggc
+tcacaatgttacctgcttcaccatagtgagccgatgagttttacattagtactaaatccc
+aaatcatactttacgatgaggcttgctagcgctaaagagaatacatacaccaccacatag
+aattgttagcgatgatatcaaatagactcctggaagtgtcagggggaaactgttcaatat
+ttcgtccacaggactgaccaggcatggaaaagactgacgttggaaactataccatctcac
+gcccgacgcttcactaattgatgatccaaaaaatatagcccggattcctgattagcaaag
+ggttcacagagaaagatattatcgacgtatatcccaaaaaacagacgtaatgtgcatctt
+cgaatcgggatgaatacttgtatcataaaaatgtgacctctagtatacaggttaatgtta
+gtgatacacaatactcgtgggccatgggttctcaaataaaatgtaatattgcgtcgatca
+ctcacccacgtatttggtctaattatgttttatttagtgacaatccaatagataaccggt
+cctattaagggctatatttttagcgaccacgcgtttaaacaaaggattgtatgtagatgg
+taccagtttaattgccagtgggcaatcctaagcaaaatgagattctatcctaaagtttgg
+gcttgatataagatttcggatgtatgggttttataatcgttggagagctcaatcatgagc
+taatacatggatttcgctacctcaccgagagaccttgcatgaagaattctaaccaaaagt
+ttaataggccggattggattgagttaattaagaccttgttcagtcatagtaaaaaccctt
+aaattttaccgattgacaaagtgagcagtcgcaataccctatgcgaaacgcctcgatagt
+gactaggtatacaaggtttttgagttcctttgaaatagttaactaatttaaaattaatta
+acgacatggaaatcacagaacctaatgctttgtaggagttatttatgctgtttactgcct
+ctacaaccctaataaagcagtcctaagaatgaaacgcatcttttagttcagaaagtggta
+tccagggtggtcaatttaataaattcaacatcgggtctcaggatattcggtcatataatt
+tattaagggctcttcgagtcttactctgagtgaaattggaaacagtcatccttttcgttg
+tgaggcatcttacaccgctatcgatatacaatgcattccaccgcggtgtcccgtacacaa
+ggaaacttgttaccttggggatataagaaaactcacacgtctcattattaaactgagtac
+aatttttgcacgagaaagtaatgcaatacaatatgatgaaagccagctaatgaaaaggga
+tggaacgcacctcggatctgttgcactggattaaaatccgattatttttaaaaatattca
+gtgctagagcatatcaggtctacttttttatctggtatgtaaagcccacggagcgatagt
+gagatccttacgactcaacgaaaagttataacataactcccgttagccaaagcccaatcc
+cgattactgccctaccctaacgtctgccatctaaatatcgaacttgttatgatcaatgtg
+actacctcccaccctttccccttcatttgttccactggggataagctagcgttttcagaa
+tcaatgcaataagaatagccaattgtctcacttcatcagagctcttggcaattccaggcg
+ctacgtggttctggaatatattcatttttcaaatagtaatacgtttagtgttgctattgt
+ctacacgtttggatattacgttatgtgagcggacatcaatagttgtctaactctttagta
+agccagagatagcactcttagcgaatggataccatcttccataagtttagttaatagtcc
+gaaacaactgcttcgagcatatttgaacctccttgtaggcaaatagcctcttcaaagcaa
+tcttactaatagatagagtttgttttaagggactactagaaatgggacaatcttaatagt
+atgacctaaactgacatttaaagatatatccaggtggcaagcataaagatcattgcgcca
+cctccaccgtgggattacttatcagtcgatatcctatatgctaagtttgcgacggcagaa
+tacaaactaagctgagttgatgctaaccttacctatgataccccattggaccggttaaca
+gccctacttattccaaataaaagaacttttatgctgtagaagctattatagtgatgcctg
+gtaacttcagtatattaaaatgacacacatacgccatatagagctcctggaactttgaat
+aatgagcgaacttcgaagttgaagagcaagaaaccatatgtcacggttgcctaaagcccg
+gtaaccagacatgtgctatcattgatcattatcgaggttttcataaccttgacccattat
+cggctgtgcgcggacaagtacttaaatcactagtttcttcacctgcttatcggtaagaaa
+taaggttggcaaagaatcgcataagacggacgtagagccgcagcgttgtgcgagtccagg
+tgcatgcgcagcaataggattttaaattttgttccatttttaatttagccgtaaggatgt
+ccgtaaatgattgaaaattggattcaatctttgggcctatgctactggaacctgatcgac
+aaaatttcaaacatacgttaactccgaaagaccgtatttttgcggctagaatagtcagtc
+gcttggagccatataccttaccacttaaacgacgtgctcctgtagttgaaatataaacag
+aacacaaagactaccgatcatatcaactgaagatctttgtaactttgaggcgaagcaccc
+tcttcgagacaactaagagtaaagtaccgggcgccgcaaggagtcgattgggaccctaaa
+tcttgacgaattgctaagaggctcagagctaccactgtaatttctctagagcccataata
+aatgaacgatacatccgtaggtagcacctaagggattataatggaagccaaatgcagtta
+ataatattatatactggcgtacacgattcgacggatctctcacatagtgattcacgaccc
+ccccctttgattgacacagcgtcagcattttgcaagaacgatcttctgcatagggtgcgc
+caccgtaaggatgacgtcgaagctacaactgggtataatttaccatgcttccctgatgct
+gagtgcaatacactaagaatgagtttttaccccatatcaccagtatttgttctgttattg
+cgaagaaatggctatgctgagttggcgactaaagtcacccatcctttttattaggtaacc
+ccctcccttaaactaactgatttgctggagctgccctgcatacatatactttatcattta
+tggacgtccgtgacgcttattatccaccatagtcgatatgctacacggattcattaatgg
+atcgtaggagtttaagttatatttactaagatcggtctcggctactatcccgccttaccc
+ggcgctatttacggccatttttaatatattgacggtaattattcctatggtttcgaccgc
+acgtccttggacaagaaagaatggcaaaaaaaatgtaaaagaaaaaaaatattgagtccc
+taccatcatataaaaaatatgtgatgagtaacttgacgaaatgttagtggttattaaaga
+ctatctattacaccttttgttttctgtcgtagtatattaaagtctagaagccttacagga
+aaatcagggttatacagccgatactccgcagcatgaatcatcgaggaggtgtcctaccat
+cgcgccttgtaatcttgtctgtgtatactgtatttagaccttttatacaaagtaaatatc
+tcggctttatgtgattgggaggggcctactcaaacatgatgacttgacctaataatcact
+gtgcgggcgtcttatgactagctattccttgaaatccaccaccaaatggttaatatgtaa
+aaactttgacgatgaaacaaggtgaatgtgtagttactttgtgtaattagctgcgtcgag
+cattgcttgtaaaaccgtcaatcgcacacgttacttccataaaatttctacgaatacacc
+cttcttaaaaaaaacgtaggaattcacgagtttaacaaacgataactgtataaagtggaa
+gtccgaagaaagcagatgcccgaactactcgaagatgtttcgttttcttaaccatagggg
+cttcttaatggcccactacgcacattttgttcaagcccgagagggacatccccattacgg
+gagtattactaaaactgttccgtaatacgttcagcaagggatgaaaaaggccactgctca
+agttattgacgtgggagtattacatcggaagcctgaatcccacactatgatggtctgtac
+aggcctagggactgcgtctagacggtattaccggcttctaatcatacgatcgtgagtctt
+aacgggaagtaaggctcacacctaccccaaaccatttatctatgtaagtataaaattgtg
+cgtaagtgttcaaagtggacaataaagacgtggcaaaaacccccgcacataagccgcttt
+agatttcacaaataccaatgcggttaaaaacatccttgagtcgtacatacaccatactcg
+cgttaaacggatataacagaagataataaatccggatgtggagtcggtgtaactatagaa
+agccaagtgaaataatgcttaccagtcatttagctatacggctttcatttcatgtcaaga
+gggtggagtttgacctgtacagttgatatatcaccgatacttagaactcacctaaagcta
+aaattgctcgcagcgtgtaatccgcatattacaaacaatagatgggattcattatacata
+agacacgatgatctgctttttcaggttgcgagatgttgcctatcgtcaatcgagtcctgc
+cttacaccacttaaacaaaagtattgacagggaacctattttcgaggtattatatagtcc
+agcttgaatatcaatttgacagttaacctagtgaaaatcagtaagaggaaatacgccaca
+ttctccagtgaaattctacgggttatcgtctagtccaactatcaattataactcacgaga
+tataagtaaattctcgtacttggcctgatttttattatactttggatccttagtaaacag
+gaagggagaaaccttcaacgaaaaacactggattttgttttactctcaaagctcttatat
+gacggaaataccctgtcaagtcttaactttattactagactaatgaaatgggcttggggt
+ggccagaatcatagtacaatttagcggatacactattcggactttcctatcggctgtctg
+gttggataagtatggggactaataggctagacatacctatacttaaactatacaggcgtc
+atctatctctgcaactttggagttccctgatgttctcccgccctttgggttcacatcttc
+tataccgacacccctaataacgattagtttgtgggttagagtaaattaatacggttaata
+ttaatgtatcgttgaaaagctggtgtcgccaataaggtaaccggctaggcagagtatatg
+tcacgaagtataactaccctaatgataagctgtaggaataaaattaatgctgtctctaag
+cgaagagatatttccgactctgttttaatgacgaatctcattacttctgacttgcaaatg
+ttcaatatggcacggtttcacggcacctttgtgacgcatataatgaacttagaagattat
+aacgacggaactttatatgataatccgttacgattaaagaatctgttaaatatcataatg
+gcattcagttctagaccgtgcatcatggtaaacttactttctctgcatggcgacatacat
+ttcgctattcaaattcgcgtgtggttacacccactcgcacctttggaatattaagagaag
+atgatcagaaaatccattcgctcaatttttctgacgtacgtctaatttatcctaggagac
+aaatcgttttatgtctctcacatttttgaagaaaggttcgagagacaatactcaggtcct
+gaactgctagaagatactcggtggagcgtggcaacaatgaaaaactcgtgacataaatga
+atgatacttttccaagttcagttaagtgaatatgtttaacatacccggcttttcgatctt
+aagctgacgctggacgtgcgagtaatgtcagtctcttacatacactagtgactccaagtt
+tcgtcaaaaacgccccctcccttctcgagcccactcacgctatgtattgacgcgaacttg
+ttcgggatcagacttttcaggagttcggtcgcgtgtccctatgtgctaatatataagtta
+gatcgcattagatgctaatctgaatacttatagacgaccttcaacgagaacgggtaccac
+cttgaggctagagttaggtgtgaaacgacaggtagggacatataaaatttgagtgcggct
+ttagttaagggtttaattacctactcaaacatcacgctcgcgcccttcgtacgtaatcga
+ccatctagaggctaaggggactgtactaggtagtgattaatgatatcctagacgcacgtg
+ccttagatcttcagactctgatggtccgcgatcaccgtaattgtagtcctccaactcgat
+cactttgttggcgtcaaagaaattacgatatctaaatacttataatacaataaccaagga
+tgagaatgactcatcgcgttggagttatattgcttgaagttctatggaatgaaagcacgt
+tatctgccgtcccaatatctccagtgagctaattcattggacggtccactttgatcaatc
+cccgaggagatgttcggacactttagtctgtaacacttagcgttgagaccacgaacaatt
+gattactcagtcttgaaggtgttttccaaagttcattttaaataagactacgataggcct
+ttcctattgatataaactacccggctctgttgttcgtgtgagtcgtacttctctgtgttt
+ttctgattatagcaagattcgattcttagtgtaaacagcgatttttatttgacccgtcaa
+tgagaagcgcataggatctaagcaaaattatcaagttgtgccacaaggtaagatctttcc
+agttattgcaggtaggatgtatcccacgttgatagtatgaggtctgacgtcaactgtcta
+ggagagttgaccgcgtgcgggtacaccggatttgcatcgatgttgagaacgcagaactcc
+cactgtcgtggcggcgttcctgatatttagcaagaggcgttgataaagccctcatcatct
+agatctcgacctcatctgccctcttgctccatcattttctacacagactactttcctatc
+tacgttagtataattgctttctatcttagtatcatttagagcttctccgtcaacaggttc
+gtgctattaaagttagtacgaaagggacaacttgtagcaacgcatttaatcggttttcga
+ctacttcgcacaaaatcagataaagaagtttgtcattctattagacattgaattgcgcaa
+ttgacttgtaccacttatgatcgaacactgaatcaagactgtgattaactaaaatagaca
+agccactatatcaactaataaaaacgcccctggtggtcgaacatagttgactacaggata
+attaattggactggagccattacattctctacaatcgtatcacttcccaagtagacaact
+ttgaccttgtagtttcatgtacaaaaaaatgctttcgcaggagcacattggtagttcaat
+agtttcatgggaacctcttgagccgtcttctgtgggtgtgttcggatagtaggtactgat
+aaagtcgtgtcgctttcgatgagagggaattcaccggaaaacaccttggttaacaggata
+gtctatgtaaacttcgagacatgtttaagagttaccagcttaatccacggtgctctacta
+gtatcatcagctgtcttgcctcgcctagaaatatgcattctatcgttatcctatcaacgg
+ttgccgtactgagcagccttattgtggaagagtaatatataaatgtagtcttgtctttac
+gaagcagacgtaagtaataatgacttggaataccaaaactaaacatagtggattatcata
+ctcaagaactctccagataaataacagtttttacgatacgtcaccaatgagcttaaagat
+taggatcctcaaaactgatacaaacgctaattcatttgttattggatccagtatcagtta
+aactgaatggagtgaagattgtagaatgttgttctggcctcgcatggggtctaggtgata
+tacaatttctcatacttacacggtagtggaaatctgattctagcttcgtagctgactata
+ctcaaggaaccactgctcaaggtaggagactagttccgaccctacagtcaaagtggccga
+agcttaaactatagactagttgttaaatgctgatttcaagatatcatctatatacagttt
+ggacaattatgtgtgcgaaactaaaattcatgctattcagatggatttcacttatgcctt
+agaaacagatattgcccgagctcaatcaacagttttagccggaaacaatcgaagcatagg
+gacaatgtatcttttcctaaattgccatgtgcagatttctgagtgtcacgaagcgcataa
+tagaatcttgtgttgcctcaactcgttgaaaagtttaaaacaatcgcagcagtctttttg
+gggtctactgtgtgtttgcaaaataactgaaagaaacgcttgaacaactctgaagtagct
+cgagtactcattaaagtgtaacacattagtgaatatcggccaatgaaccaaacgcttccc
+ggtacgctatctctctcatcgggaggcgatgtgcaggttatctacgaaagcatcccttta
+cgttgagagtgtcgatgcatgaacctcattgtaacaatagcccagcaaattctcatacgt
+gcctcagggtccgggcgtactcctccatggaagggcgcgcatctagtgttataccaactc
+gctttttaactactatgctgtagttctacaggcatagtggccagtattttctaacttctc
+tggatagatgctctcactcctcatccatcacggcttcagtttacgtcttacttgcttgtt
+cagcaacggatggaggcattaagtatcttcactgttccctaaaattgctgttcaatatca
+aagtaaggacgatacagggaaagctcaagcacactcattgaatactgccccagttgcaac
+ctcacttaatctgacaaaaataatgactactctaagtgttgcggaagcagtctcttccac
+gagcttgtctgtatcacttcgtataggcatgtaactcgatagacacgaacaccgagtgag
+aaactatattcttgcttccgtgtgtgtgacaccaggtaattgatgcggatataagctgga
+gatcactcacgcccacacaaggcgctgctacctctttattccaatgtgtaagaatttgct
+aacttcatttctagaccgcagctttgcggtcataatttcacggtacggacccttgggtta
+gagacttgataacacacttcgcagtttccaccgcgcacatgttttagtggcttctaacat
+agaatttttgttgtgacataaagagtgcgtgggagacttgcccgaccgttaagccataat
+caattgaaagccccgtgagtcacatctaattggttgtactgcgcatttagctatccttta
+gctgactcgaagagattcgattcctaatataggttaattagatggctgccgcgcgaagta
+aaacgtgaaaaacgtagtgcgcagatctgcataactcgcgcttaattacttatgagtagt
+tccaagttcgctacgttatgagagagattggaattaagcaaatatgttttatggtgattt
+tgggatgagaaggactgctaagtacggctactaaacaaatttctaaaaccgccatctacc
+ttatcttggagacatttaagttgtatatgtcactagtctagcttttgtctgtgggacgcg
+ttctcggaatgagggaaatgcaagagccgattcatcaaatgcttatctaagaaagtagtg
+gactattacaccaagcacgaatgccagggaactgctttcttgctcaggacctcgcgacaa
+ggtaccccgcataagtcctagaattacatttggtcagcaatgctgacatttgaccgtgaa
+aacataattttaatcagaaggcagctcacccgcttgctctagatcttatctttgtatgaa
+tgtcagaatttactgcaatatccgttccgaatagtgagggcttagtatagttctctgtat
+acaggtcacatcaaactccccctgtcctagtacagctctgagctttaattaattgcatac
+atttccttcaatcatcagatgaaaacaccgcgaatcatgctcttctcgtatagggcaaga
+gaagcaacaaacaactagcccgactcacgttcatccgccgtatccttgttcagttcttac
+tccgtattaggtcagcgaaatctaatcagaataatcggtcgcgtatcaaaattaaaatcc
+cgcttgaggttgacaattaaaacgctgagcagttatcggctattagatagtggggtgaaa
+gtaattggctggaattatgttaaaacgtgatattaagctaaaatacgctacttgttgccg
+acctaattcagtcattcgatattcagttagagccaagaataacaagcttgtataaattga
+acggggtgcactaaacgatgtgttactctaatattcagcttggagtatacctgaaggcga
+attcatgtatcggccaataataagacgttgaagatcacaatttggactagcaaaagaagg
+tgatttatgcgtggggattgagtccactgtacgagtacggtctctggaaaattataggtt
+cagggaatataaggaagtaaagataattaccaagagatttttggtatcgctatgacccag
+aggtgttctaacgtctgttttgatccgcagaatttctgcctcaatgcatatttgacggac
+ttgaactagagcctctaaagttaaatggcgacgcaactgttcctaaacttcaattattac
+tactctttttttcctagggtattgtagaggccagtggacaaaataaatcaaatttaagat
+gtttcggacattaacatcccccgtagcatagaaatcatcagttatccaatctctcatcga
+gcttttacaatttctgctggcgctatggacagcatatgccgcgagacctccgcaagactc
+acttgatcactgtaagtatcttcattagaggttagagcctatagttaagctgctgaccta
+gtaaaattggtattttctaattttattgctcaagttaaaggttagtgaagggataatgac
+gttatttttgaacaatgggttgtattcaattttatatcacgaatggaacccttcattccc
+ggcataatactagacgacacgaacaagctccgatctatcagccaggcacgtgttaaggtt
+taattccggcaaaccaatgaagcatcaaaaggtgacctgatgcaacttagggtcacgatg
+agtttttcaggactacttattacctattaataagttaacatgagccttcataccccgtaa
+gacaatacatactccaccaattagaattctgagccatcttatctttttgtatcatcgaag
+ggtatggccgaataggttaattagttactcctaacgtctctacaggcatgcatttgacgc
+accttcgaaaatagtcaatctctcgccacacgcgtctagtatgcagcatcaaaaatatag
+tccacggtttccggattaccaaacgcggcaaagagaaacattgtatcgacggagataact
+taatacagaaggaaggggcatcttcgaatacggatgaataattctatctgtttattctga
+catcttgttttcaggttaatcttacgcattcaaatgacgcctgccccatgcgtgcgcaat
+tattttctaatattgacgagagcaatctcactccttttgggtctatttatgttttattga
+ggcacaagcctatacagaacaggtactattaaggccgtgagtgtgagactcaaaccgtgg
+aaacaaaggatgggttgttcttggtacaagttttagtgcatgtgggcaatccttaccaaa
+atcagatgctatccttaactttgggctgcatttaagatggcggttggaggcctgtgagaa
+tcctgcgtgtcatctttaatgaccgaattcatccatgtagattcagatcacacactcatt
+ccttgatgttgtctaaacaaaagttgttgtggacgcattggagggagttaagtaacaact
+tgggatcgcatacttataaaaattatatgttaaactttcacaaacgctgaagtccaaagt
+aactagcccaaacgcctcgagagtcactaggtattaatggtgtttgagttcctgtgaaat
+agtgttcgaaggtaaaatttatgtaccaaatcgaaagaacacttaataaggcttgcttgc
+acggaggtatgatgtttactgactctacaaccctaattttccagtacgtacattcattcc
+aataggttagttctcaaagtgctatacaggctcctcaattgatgatatgcttcagccgct
+ctatggatattagctcattttatttaggaagcccgcttagaggcttactatgagggaaat
+gccaaaatgtcatacttttcggtgtgtcccatatgacaccgctttacatagaatttgaat
+taaaacgcgctctcccgttcactaccatacttggtaccgtgcgcatattacatatagata
+taggatcattttttaaagctgtactaggtttgatcgacaatcttatgctatactatatga
+tgtaaccctcataatcaataccgatcgtacgatcctagcataggtggcaagcgattttat
+gccgattattgtgttaaatagtctgtgagtgtgattatcagggctacgttggtagagggg
+ttgtatagacctcgcacacattgtgacatacttaacaatatacgaaaactgatataataa
+atccccttacccaaacaccaatcccgttgaatcaactaccataacgtctcccatataaat
+tgcctacttgtttgcataaatctgaatacataacaccattgcaccttcttgtgttccaat
+cccgttaagattgccttgtcagatgatatgcaagaacaatagcatttgctagcaattatt
+aacagctcttcgaattgcctccacataacgcgggagggtatattttaatttggcaaatac
+taagtactgttggcgtcatatgctattaacggttggatattaagttatgtcagccgtaag
+caagagtgggcgaaatattttgttacccagtgagagcactcttagagtttggatacaata
+ggccatatgttgacttaagaggacgtaactacgccgtacaccattgttcaaccgacttct
+tggcaaatagaatcgtattagcaatcttaagaatagagacacgttcgtgttagggtatac
+tacaaatccgaaaatcttaagaggatcacctaaactgaaatttatacatatttcaacgtg
+gatagatttaacataattcagccacctccaacctgggagtaattttcagtagatttacta
+gatgattagtggcccaacgcacttgactatataagatctggggatcctaacctgacctat
+gagacaaaattggaaacgttaacagcccttatgtgtacaaagaaaagtaagttgttgctg
+ttcaacagatgatagtcatgacgcgtaacttcactatagtaaattgaaacaaatacgcaa
+tttagacagaatggtacggtcatgaatgacagtaattcgaagtgctagaccaacttaaaa
+taggtaaacgtgcccgaaaccccccttaacagaaagctgctatcatggtgcagtatcgac
+gtgttcagaaacttgtaacttttgagcaggtccgagcacatggaagtatatcacgtgttt
+ctgaaccggcttatccctaagatatatccgtcgcaaactttcgatttagtcccacgtaga
+gcccaagcgttgtgcgactccacgtgcatgcccagaaatacgagtttaaatttggttaca
+tggttaattttgaccgaagcatcgcactttatgattgataattggattcaatatgtcgcc
+ctatgcgaatgcaacatgatccacaatttggctataagacgtttaatccgtatcacactt
+tgtttgcggctagtatagtaacgcccgtgcaccaagagtcagtaacaattataagtactc
+cgcaggtacttcaaatataaaaactaatcaaacacgacccatatgatcatctgaagatat
+ttggaactttctcgacaaccaccctcgtactcaatacttacactaatcgacaggcacacg
+caacgtgtacagtcgcaccatattgagtcaagatttgcttagtggcgatgagcgtacacg
+cttatttctctagtcacaattagttatctacgagacatcacgagggagcaaataagcgat
+gttatggctacacataggcacgtatgaatatgatataagccagttaaacagtcgaaccat
+cgagcaaattctcatgcaccaacccacacgttgaggcacaaagagtaagctgtttgaatg
+taacttcttctgctgagcgggccccaacgtaaggatcaactagaagagaaaactcggtat
+tagtttaaatgcgtcacggagcatgagtgcatttcactaagaatgtctgtgtaaccaata
+taacatctatttgttatctgattgcctacttatggctttgcggtcgtggcgactaatgtc
+tccaatccttttgaggtcggtaccaactccctttaaattacgctgtgcaggctcatgcac
+tgcatacatatacggtagcaggtagggacctcacgcacccttattataatcaatagtagt
+tatcagtcaacgaggcaggaatgctgaggtcgaggtgttggtatattttctatgtgccgt
+ctaggcgactatcacgcattaccaggcgagatttaagccaattttgaatatagtcaacgt
+aatttttactatgggttccaccgaaacgccttgcacaactaagaatcccataaaatatcg
+atatcaaataaaagattgtgtcaataccttcatatatattttttcggttgactaacgtga
+actaaggttaggggttttgtatgtctatataggaaacagtttcttttctgtcctacttta
+gtaaagtcttcaagccttactccaaaatcacggtgattaagccgttactcagcagcatga
+ttctgcctgctcgggtcctaaaatccagccttgtaagagtcgctgtgtattagctaggga
+gacctttgttaaaaaggatatatcgcggcgggatgtgagtgcgtggcgcatactcaatct
+tcagctcgtgtcattataatatctctcccccacgcttttcactagatatgccgtgtaagc
+aaacaccttatgcttaatttcgaaaatattggtacttgaaaaaagctgtaggggtactta
+atgtctggtaggagatcaggagagaattgagtgtaaaaccgtaaagccctcacctgactt
+catgtaaatggcttagaagactccatgatttaataaatactacgaaggaaagactggatc
+taaagataactctagtaaggccaactcccttcaatgctgttgccagttataatccaagag
+ctgtccttttctgaaccatagcggcttctgaagcgaactagaagcaaagttggttctagc
+cagacagccacataccctgtacgggtgtattactaaaactggtccggtattagttcacca
+agggaggaattaggcaaaggatctaggtatgcaagtcggagtattacatccctaccctga
+atccatcaataggttcctctgtactggccttcgcaatgagtattcaaggttgtacagccg
+tataataataagatagtgactatgaacgggaagtaacccgctcaccttccccaaaacatt
+gttatatctaagtattaaagtctgccgtagtgttaatactcgaaaataaacaactggcaa
+attacaccgcacttaagccgcttttgatttatatttttccaatgcgcttttaaaaataat
+tcagtcctacatactaattaagacccttaaacggagatatcacaagttaagttttaacca
+tctcgactaggtggaactatagatacccaactcaatttatcattacctgtaatgttccta
+gaaggattgcatttcatgtcaagacggtggagtttcacagcgaaacttcagtgtgaacag
+attctgagaaatcacctaaacctattagtcagagcacccggttagaaccagttgtcaaaa
+aatagagcggttgcatgagacagaagtaacgatgagatccgttgtaacgttgagacatct
+ggcctatcgtcaatacagtcctcccttaaaaatatttttaaatactaggcaaacccaaca
+taggttagtcctatgtgatacgccacatggtatatcattttgtaacgttacctagggata
+atcaggaagtggaattacgcaaaagtagacagtgaaatgcttagggttatagtctagtcc
+aaagataaaggataaagcacgtcagagaactatattagccgaatgggaatcattgttagg
+agactgtggatcatgtctaaaaagcaacgcagaaacagtcatcgaaaaaatctcgttttt
+gtttgaatctaaaagagctttgatgaccgatagtacctgtatactagttactgtattacg
+tgtctaatgatttcggattggggtccccagaatcagacgtcattgtagacgattcaagtt
+taccaatttaatttcccagctctccttggagaactatcgccaataattgcagtcactttc
+cttttctgaaacgataaagccgtcagagttctctgcaacgttggacttacctgaggttct
+aacccactttcggttctaatagtagttaacgacacaacgaataacctttactgtggggct
+ttcacgatattttttcgcttattattaatggttacgtcataagctggtgtccaaattaag
+gttaccggcttcgcagagtagttgtatccaagtataacttccctaatcataagatcgagg
+tagaaaattaatgctgtctctaaccgaacagatatgtcccactatgtggtatggacgttg
+ctaattacttctgaagggaaattggtcattatggatacgtgtctaccatcaggtcggacg
+cagatatggttctgtcttcagttgatccaccgttctttataggataataactgacgatta
+aagattatggtaaatagattaagccaattctcttcttgtcagtgaagcatccttaactga
+cttgctctgcagcccctcatacatttagctattcaaagtaccggctcgtttcaaactctc
+ccacctttggaagaggttgtcaacttgataagtatatcatttacagcattttttcggacg
+tacctctaatgtttcattgcagaaaattagttttttctatcgcacattttgcaagtaacg
+ttagagacacaattatctgcgaatgaactgctagatctgacgaccgggagcctcgcaaat
+atcaaaaaagactgacatatatcaaggagtcgttgacaagtgctggtaagtcaattggtt
+tatctgtcccggcgtttcgatcttaagctgaccatgcacggcagagtaatgtcactctcg
+ttcttacaagtctgtctccaagggtcggcaaaaaagacccctccattctcgagcccactc
+acgatatgtagggacgacaacttgtgcggcttatgaattgtctggactgcgggcgagggt
+ccatatctccgaagttagaagggacatacctttagatgataagatcaattcttattgacg
+aaattcatccacaacggggaacaacttcaccctagacttacgtctgaaaagacacctagc
+gtcttataaaaggtcagtgccccgtttcgtaaggctggaattacctacgcaaacttaaac
+ctcgcgcccttccttacgtatcgacaagatagaggctatcgcgaatgtactacggaggca
+tgaatcatatactagaaccaagtgcctgtgatattaacaagatgatccgacgcgagcacc
+gtaattctaggcataaaactccagcaatttgggggccgaaaacaaatgacgttagctaat
+taattatatgacatgatcaaaggaggtcaatcacgcatcgagttcgacgtatattcattg
+aacttcgtgcgtttgaaagaaacttttatgaaggcaaaattgatcctgtctcctatttca
+tgcgtacctcctagttgataattccccgagcagtggttaggacacttttgtcggtatcaa
+gttccggtctcaaaacgtaaaattctgtaatctgtatggatggtctgtgaattagttaat
+ttttatgaagtcgtcgagacgcagttcctattgatttattctaaacggagatgtgcttcg
+tgggactcggaagtagatctgtgtttatgattattgctactttagatgctgactgttaac
+tccgtgttgtttttcaaccgtatatcacaaccgaattggatagaacctatagtttcaagt
+tctgccacaaggtatcatatttacagttagtgctggttgcttctttcaaacgtggtgagt
+ttgtgctatcacgtcaacggtagagctcagtggaccgagtgcgcgttcaaccctgttcca
+gagagggtgtgatagcacatataccacgctcgtcgaggcgttcatgatagtttgcaagag
+ccggtgttaaacacatattattattgttatccaactaatcggacctatgcataaagcatt
+gtctaaacagaataattgcctatatacggtagttttagtgatttatatcttagtatcagt
+tagagcttcgaactcttcaggttcctcatatttaacgttcttcgaaagcgaaaacttcta
+caaacgaatgtaagcggttttccaagtagtacctataaatcacagaaagatctgtctcag
+tatagttgaaatggtattcagctagtgacgtgtaccaattatcatagttcactcaagcaa
+gacgctcattaacgaatatagacaagacactatatcatataataaaaaagaacatggtgc
+tcgaacatagttgaattcaccatattgaaggggaatgctgacatgtaattcgctactaga
+cgatcaattccctacttgtcaaagttgaactggtacgttcttggaattaaatatgattgc
+gctggaccaaattgcgacttcttgagtttcagggcaaacgattgagccggaggatgtccg
+tctcttacctttcttgcttatgataaacgacggtccctgtacatcactgggaattctcag
+caaaaataattgggtaaatcgagactcgatgtattcggccacaaaggtgttagacgttaa
+agattattcaacggggcgataataggatcataaccggtatgcaagcgcattgaaagagcc
+atgagatccttatccgataaacgctgcacggtatgtgcagccttattgtcgatcacgaat
+ttataaatgtagtctgggctgtaagttgaagacctaagttataatgaagtgcaataccaa
+atcgattcatagtggattatcagactcaagatatctcctgataaattacagttgttaaga
+tacggataaaatgagatttaagattagcagcctctaatctgtttcaatcccgttggaatg
+tggtatgcgatcaaggttaagttaaaatcaagcctgtcttcagtcttgattcttgttctg
+ccatcgcatgcggtctacgtgagttaatatgtagcttacgttctagcttgtgctaatctg
+agtatagattcgtagaggaatattatcaagcttccacgcctcaacgtacgtgtattggtc
+acacaagacactaaaagtggaagtagcgtaaactatagtctagttgttaaatgctcagtt
+cttgttatattcgatatactcttggctaatttatgtctgagtatataaaattaatgatat
+taacttgcatttcacggatcccttagaaaaagattttgaccgagcgcattataaacggtt
+acaccgaatcaatagaagcatacccaatagctttctttgaatttattgcctgcgcaactt
+ggctgactctctagatccgaataattctatatggtcgtgacgaaactagttcattactgt
+ttaaaatgccaacatgtcttttgggccgataatggctctttgcaaaattactcaatgata
+cgattgatcaaagcggtagttgctagtggtagcatgtaagtctatcaaatgtctgattat
+ccgaaaatcttccaaaagagtccacgtaccatatctatctcatagcgacgcgaggggaac
+cttatctaactatcattccatttaccgggtgactctcgatgcaggatccgattgggataa
+attgcccagaaatggctcattcctgactaagggtaaggccgttctcagcaagggaacccc
+gcgaatctaggcttataccatctagattgttaactacttgcctgtagttctacagccata
+ctggacagttgtttctaaatgatcgggattcatgctagcactcctctgaatgcaccgcgt
+aagtttaactattacgtccgtgggcagataaggatggaggctgtatgtatcttaactgtt
+acctaatatggctggtaattatcaaagtaaggaccttaatgccatagcgctagcaatcgc
+tttgtatactgaccatgtgccaacctctcttaatctgtaaaatataatgtcttagctaac
+tgtggacgatcatgtctctgcctagagcttcgctgtatcaattcctatagccagcgtact
+agtgacacaacaacaccgtgtgagaaaagatattagtccttacgtctgtctctctacagc
+ttattgatgaggattgaacatggacatatagctccccctcaaaagcagatgctacctctt
+tattccattctcgaacatttgccgaacttaatttcgacaaacctgaggtcacgtcttaat
+ttatcggtaacgtcacgtccctttgagactggataaatatattaccaggggccaacgagc
+aattgttggaggcgcttctataatacaaggtgtcttgtcaaagaaagacggcgtgcgtct
+cgtgcaactcacttaaccaatattaatgtgaaacccccctctctcacatcttatgcggtg
+tactgccctggtacatttcctgtacaggactccaacagtgtagattcctaagatagctgt
+tggagttgcctcacgccagatcgaaaaactgaataaactagtgagctgagctgcagaaat
+accgcttaattacttatgactagttcaaagggacctacgtgatgtcagacattgcaagga
+agaaattaggtttgtgcgtcattttggctggactagcactccttacttcccctactattc
+aaatgtcgtaaacagcatgagacaggatcgtgctgacatttaaggtctattgggaacgag
+gctacctttggtcgcgcgctcgcgttctccgaatgaccgaaatgcatgagcacagtatgc
+aattgcttatagatctaaggtctggtcgttgaaaccaagcacgtaggcctgggaaatcag
+ttcttcctcagcaactacacaaaagcgtccaagcattagtacttgtagtaaatgtccgaa
+cctatgcgctcatttgaaagtcaaaaaatatttttaagcagtaggcacctaacccgattc
+ctctacttagtagctttctttgattctcagaattgactgcaatatcactgcacaattctg
+tgccattactagacttctctgtattaacgtctcatcttactaacactcgcctaggacaca
+tctgagagtgaagtatttcaatacatttactgaaatcttcagttctaaaatccccgaata
+aggctcttatcggtttggccaacacaagaaaaaaacttcttgcaccactcaccttcatac
+gcaggagcctggggaacttagtaataactatttcggcagacaaagcttataacaagttgc
+cggcgcgtataatatttaaaagaccccttgagctgctcaattaaaacgctcacctggtat
+aggctattagatagtgccgtcttagtaaggggcgggaattatcggataaactgatatttt
+gataaaataaccgacttgttcacgacataagtcactaaggagattttatctttctccaaa
+gtatatcttccttggataatttcaaagcgctgcaatttaagttctgttactagtttatgc
+tgctgggaggtgaccggaaggcgtagtaatctagaggcaaattataagaagttcatcata
+tcattttcgactacaaaaacaaggtgttgtatgccggcgcattgtgtaaactggacgagt
+accctagatggaaaattatacgttaagccaagatttcgatgtaatgataattacctacac
+atttttgctatccataggaacaagagctgttctataggctcgtggcatacgaacatttgc
+tgccgctatgaatattggaagctcttcaactacagactctattcttaattgccgtcgaaa
+atgggccgaatcggctattattaatactcggtttttccgaggggattgttgtcgacagtc
+gtaattattattaatattgatgttggtgaggtcatttaaatacaaccttgcagacaatga
+ataagggatccaatctctcatactccttttacaattgctcatgcccctatgcaaacctta
+tgccgccacacctccgcaactctctcttctgaactgtaagtagcttcattactggtttga
+gactatactgaagctgatgacattctaaaatggctattttcgaatgtgattcataatgtt
+tatcgtttgggatggcagaatcacgttatttttgatatagcccgggtattctattgtata
+gaacgtatgctacaagtcattccccgaagaagactagaagtaaacaacatgcgaccatcg
+ttaagccacgcaaggctgtagctttatttcccgataacctatcttccataaatagcggac
+agcaggatactgacgctcaacatcagtggttatggtctaatttttaacttttaataaggt
+aacttcagcaggcatacacagtaactctttaatttataatcaaattagaagtctgacact
+tcttatatttttctatcatccaacgcgatcgcccattagcttattgtgttactaataacg
+tatctaaaccaatccttttcaagctactgcctatattgtcaatatatacaaacaacagga
+tagtaggctgcttaaaaaatattgtcaaccgtgtacgctttacaatacccggaaatcaca
+aactttgtagacaacgagtgaaatttatacactacgaagggccagcgtacaagacccatg
+aattaggcgatatgtttattctgacatattggtttatccttaatctgtcgctgtaaaatg
+aagccgcccccatccctgcgaattttttttcgaagattcacgactgaaatataaatacgt
+ttggctatatttatgttggagggaggcaatagcctttactgttaaccgaagatttagcca
+gtgagtgtgacactaaaacactggaataaatgcaggcgttcttctgggtaaaaggtttag
+tcaatctcgcctataagttcatatagctctggatataattatctggcccatgcatttatc
+atggcgcttggtgccctgtgtgaagccggcctctcatattgaaggtccgaagtattccat
+gtacattaagatcactctctcattcatgcatcttggcttaacaaatctggttgtccaagc
+tttccaggcacgtatggtacaaattcggatcgaatacttataaaaatgatatgttaaact
+gtctaaaacgctcatctacaaagtaaagtgcactaaccaatagagtctcaagaccgtgta
+atgctggtgcactgaatgtgtaatacggttagaagggattagttatgttacaaatccatt
+gaaaacttaagaagcattgcgtgctcggagggtgcatcttttatcaagagactaacatta
+ttttcaacgacgtacatgctttacaatagggtacttatcaaacgccgagaaacgcgccta
+tagtgatgttatgattatgacccgatatccattggaccgaattttatgtaggttcccagc
+gtactcgcgtaatatctcggtattgccataatgtaatacttgtcggtctctcccagatga
+aaaagcgttacagagtatttcaatgaaaaacagcgcgcaacgtcaatacctttaggggta
+acggccgctgatttcatatagatatacgataagttggtatagctctactaggtggcatcc
+acaatcgttgcatttactatagctggttacaatcataatctataccgttccttacatact
+accatagcgggatagcgtttttttgccgttgattgggtttaagaggatgtcagtctcatt
+atatccgattcggtgggagagccgttgttttcaaatcgcacactttgtgacataatgtac
+aagataacaaaactgatataagatataaactgtcaatatcaccttgacacttgaatcaaa
+gtaaattaactcgcaaatataatttgactaattgggtgcagatttctcaattaataaaaa
+aatggcaccggatgggcttacaagccccttatcattcacttgtatcatgatttccaagaa
+caatagaatttgctagcaagtatgaacagagattcgaattgcatccacagtacgccggag
+cgtttattttaatgtggatatgacgatgtactgttggcggcatttgctagtaaccggtcc
+ttatttacgtagcgcacacgtaagcatgtctgggagaaatatggtggtacaatctcagag
+aaagattacagtttggtttaaataggacttatcgggtcggaagtggaacttaataagcag
+tacacaattgggcaacagacgtcttgcctattacaataggattacaatgcgttagatttc
+agacacgttcgtgtttggctattcgtcaattccctaaatagttagacgatcaactattat
+caaagtgattctttgttcatcctccattcatgtaacagatggcacactacgcataacgcc
+gaggaattttaacgagatttaagagagcagttcgggcacaacccacttgactttataaca
+gctcggcagcataaacggtaatatgtgacaaatttccaaacgttataagaacgtatgtgt
+acttagaaaactaagtggttcatgttcaacagatgtgacgcagcaagcctaacttatcta
+ttggttttgctataaaagaacaaagttacacagaatcctaagggcttgtttcacacttat
+gcctagtgcttcaccatcttaaaatagcgaaaccggcacgaatcaaaccttaaaacaatg
+cgcagatattggtgatggtgactccgggtatgataatggtaactgttgaccagcgcccac
+ctcatcgaagtatagaaagtggttaggataaggatgagaccgaacttatttccggccata
+actttagattttctacctagtacacaacatcagggcggacacgaaaccgccatcacatca
+tataccaggtttaatttgcttaatgggggaagtgtcaacgaaccttcgaactttagcagg
+catatggccattatatatggccccagagcagaatgctacagcagacaaaatttggattta
+tgtagtttaatacctatcaaacttggtgtgaccatacttgtctaacgacagtgcacaaag
+tgtaagttacaattattactactcagcagcttctgcaatgataaaatcttatcatacacg
+tcacatatgataatatctacttagggggaacgggctccacaacctacatagtactcaata
+cttacactattcgacaggcacaccaaacctgtacagtcccaaaagattgagtcaactttg
+cagtactgcagatcacagtaatagcttagttagcgagtcaaaattagttttctacgagac
+tgcacgaccgtgcaaatttccgatgtgttggctacaaatagcaacgtatgaatttgtttg
+aagccacgtaaactgtacaaccttagagataagtctcaggctactaaaaacacgttgtgg
+cactaacaggatcatggttgattcttacttattcggctgaccggcccaataagtaacctt
+caactagaacagaataatcgggagtagtttaattcagtcaaggtgcaggtctcattgtaa
+ctaacaagctctgtgtaaccaagttaaaatcgttttcttagcggattccctacttatgga
+tttgagctcgtccacaatattcgatacaagaagtttgtggtccgtaacaacgaaatttta
+attacgctgtgcagcctcatccaaggaattaatagaaggttgatggtaggctccgaacgc
+tccatgattataatcaagtggactgtgcagtaaacgaggaaggtatcctgacgtcgtggt
+gttcgtttttgttatttgtgccctatacgagtagataaaccatgaacagcacagtgtgaa
+cccatggttgattttaggctaccttatttttaatttccgttacacagaaacgaattccac
+aactaacatgccattaatttttcgatatcttataaaagatggtcgaaattcattcattta
+ttttttttcggttctcgaaagtcaactaagctgtcgcgttttgtttctctttagaggtaa
+aagtggctttgatctcctacgtttggatactagtcaaccattactccatttgatccgtga
+gtatcacctgtctaacatccagcattatgactcctcggcgaagaaaagacacacttctta
+gagtcgatgtgtattagctagggacacagttgtttaatacgatagtgagcccagggaggg
+cagtgcgtcccccagtagatttattcagctagtgtaagtataagatatctcacccacgag
+gttcaagtgatatgcagtcttagaataatacttatcctgaatttcgatattatgggtact
+tcaataatccgctagcgctactttatgtctcgttggacagcaggacacatggcagtctta
+aacactaaagacatcacctgaatgaatgtaatgggattacaagaatcaatgaggtattat
+atacgacgtaggaaactctggatatatacagtaatctagttacgccatcgcacttcattc
+ctctggaaacttagaagacatcagctgtacgtggaggaaccagacccccgtatgtagcca
+aatagaaccaaagttgcttatacaaacacacccaatgacaatggaccgctggagttcgta
+aactcggaacgtagtactgcacaaacccagcatttagcaataggagctacgtatgcaact
+cccacgtggtaataccttcaagctatcaatatataggtgcctagctaatcgcattcgcaa
+gcagtattcaagcttgtaaaccagtataataattacagaggctctatgaaacccaacttt
+ccagctaaaagtcccaattaaatggttatttcgtacttttaaagtcgcccgttctgttat
+tacgcgaattgattctactccaaaattaaacacaaattatcaaccgtttcatttatattt
+gtcaatgcagctgtttaaaataaggctctactaaattataattaagacacttattaccag
+atttctctagttaagtttgaaccagctcgactaccgcgaaagatacattcccttctctat
+ttttcagttcatctatgggtcagagaagcattgaatttattctattcaccctcgtcgttc
+acagcgaatcgtcagtgtgatcagtgtatgagaaatatcctaaaccgtttagtcagacca
+cacgcttagaacaagtggtctaaaaagactgccctggaaggagtaagaagtatacagctg
+atccggtgtatccttcagtcatctgccctatactaattacacgacgcaaggaaaaatagg
+tttattttctaggcaaacccttcataggtgactccgatgtgttacgaatcatgcttgaga
+atgtgctatcgttaccgacggataataacgatctccaatgaaccaaatgtagaatgtcta
+ttgattacccttttactattcgacttagagataggagatagaacctcagtgtactttttt
+agccgaatgggaatctttgggaggtgaatggccataaggtcgtaaatccaaccctcttaa
+agtcttccatattatatcgttgttcgtggaatcgataacagatttgttgacccatagtaa
+atgtatactagtttatgttgtaagtgtagattgttttccgattgccgtccaaactttatg
+tcgtaattgtagaccagtaaagttgaccaaggtaagtgcccagcgatcctgcgagatcga
+tcgccaatttttccagtcactgtaagtgtaggtttagataaagccgtatgagttatatca
+taagggcctcggaaagcagcttcgaaccaaagttcccttataatagtagtttaactataa
+aagtatatactggtctgtcgccctttcacgatttgttttaccggtttatgaagcgttacg
+tcattagagcggctccaatttaaggttaacggcttccatgtgtagttgtatacaaggata
+acttaaagtatctgttcagcgagctagttaagttatcctcgatagaacacaactcagagg
+tcccaagatcgggtttgcaacttgctaatttattctcaaggcaaattgggaattatcgat
+acctgtataccataaggtcgctcgatgtgatgcttatgtcttctggtgatcctaccttag
+ttagtgctgattaacggaacattaatgtttatcgttttgagatttagccaattctctgat
+tctaactcaagatgccttatctgacgtgctatgcagcccctaagtattttacattgtaat
+aggacacgctcctttaaaactcgccaaaaggtcgttgtggttctctactggttaactata
+taatttacagctttgttgagctagttcctctttggtttaagtcctcaatattagttggtt
+cgagcgataagttggctagttaccttagtcactatattagatccgaatgttatgcttcat
+ctgaagaccgccaccctccaaaatttcttttaagactcacttattgcaaggtgtaggtga
+attcggctcgtttctcaagtggtgtatctgtacacgagtttccatattttcatcaacagc
+caccgcacacttatgtcactctaggtattaaaagtcgctctacaaggggacgcaattaag
+aaacagacatgctagtcaaaaataaacatagcgaggcaccactaattcggccgcttatca
+atgggatgctctgcgcgagacgcgccagagctcagtagttagttcggacatacatttact
+tcagatgatcaattagttttctacaaatgcttactctaccccgaaaaaagtcaccagact
+cttacgtctctttagtatccttccgtcttatataaggtcagtcccccgtttcggtaccct
+ggaatttactaagaataatgaaacagcccccaaggacgtacgtttacaaatgatagacca
+gatcgcctagcttattccgacgcatgttgcatagaattgaaccaacggaatgtgagagta
+actagatgagccgaccacagcacccgtttgcgtcgcagaatacgcctgatagttcggcca
+cgaaatcatatgtcctttgagtattaagtatttgtaatgatcaatcgagctcaagcaagc
+ttacacttcctcggatattcagggaacttagtgcctttgaaagatacgttgatcaacgaa
+aaattgataatggctcatatggaatgcctacctcatagtgctgaattaacacagcactgc
+ggacctaacttttcgaggtttcaagttcacgtctcaaaacctaataggctggaatatgta
+gggatcctcggtgaatttgtgattgggtttgttgtagtactgaccaagtgaatattcttt
+ttttctaaaagcagatctgctgccgggcactacgaaggagatctctgtgtatcattattg
+cttcttgacatgatgactcttaaatcactgtgggtgtgcaaaacgatagcacaacccaat
+tcgatagtacatattgttgatacttcgcactaaaccgttcatatttaaaggttgtgctcc
+ttccttcgttaaatactggtgacttggtcctatctactattagctagacctctggggaac
+cacgcccccgtaaaacctgtgcaagagagggggtcatacatcttagacatcgcgcctcca
+ccagggaagcattgggtgattgaccaggtgtgtaacaaatatgattattcttatactaat
+attagcaaagatgcataatgatttgtattaaatgtataattgaattgataagggtctttt
+agtcagtgatagagtagtataaggtagacattagaactcttaaccggacgcagatttttc
+ggtcttagtaagccaattagtcgacaaaacaaggtaagagcggttactagtagtacctat
+aatgcactgaatcttcggtcgaagtatagttctaatgctatgcagattgtgacggcgaca
+aatgttcagacttatatcatgaaacaagctcttgtaagtattgacaaatgaaaagattga
+atatttttaaatacaaaatgcgcctacttattaggggaattaaccagattgaaggccaat
+cctcacatgtaatgagataatagacgataaatgaaattcttgtaatagttgaactgctac
+gtgatgggtattatatatgattgagatcctccaattgccgacgtcttgtcttgatgccca
+aaagattgtcaacgaggagctccctcgcgtacctgtcgtccgtatcataaacgacgcgac
+atgtacagcactccgaagtataagcaataataatgcgggtaatccagactagatcttttc
+ggactcaatgcggtttcacggtaaacatgattaataccggagagtagtcgagcttatcag
+cgatgcaagcgaattcattgtgccaggagatacgttgcagataaaaccggcaacgtatgt
+caacaagttttggcgatctcgttgtttgtattcgacgaggcgcgggaacttcaagaacta
+tcgtatattcaagtccattaccttttagtttcagactggtggagctgactaaagttatat
+catcattttgtacactggtttagttaacgataatttcagatttaacatgaccagacgata
+atcgctgtatatccagttggaatgtggtttgccagaaaggttaacttataatcaagcctc
+tcttcagtcttgattcgtcgtatcccatccattgcgctatacctcagtgtatttggagct
+gtagttataccgtgtgctaagatcagtagacatgacgagagcaatattatctaccttaca
+agcatcaacggacgtctagtcggaacaaaagactctaaaactcgaacttcaggttaatat
+actatagttctgtattcagcagttattcttatattcgatattatcttgcctattggatgt
+ctgactttagtatattaatcatagtatctgccatgtaaaggtgccagtactaaatctgtt
+tcacagtgcgaattataaacggttacaaccattaaagacaacaagaccctatagctttat
+ttgaattttgtcaatgcgcaacttggagctcgcgatacatcccaattagtctatagggtc
+gggacgattctacggcatttctggttataatgacaacatggattgtggcccgagaatcgc
+tctttcattaattaagcaatcattacagtcttataagcgctacttccgagtggtagcagg
+taactcgatataaggtcgcatgagccgaatagcttaaaaaacaggccaccgaacattgat
+agagaataccgaccacagcgcaacctttgattactttcattaaattgtacggctcactcg
+acatcaagcttaagattgcgataatgtgaactcaaatggatcagtactgaagaaccgtaa
+cccacttcgcagaaagcgtacccagagaagatacgctgttacaatatacagggtgaaatt
+attgcctgttcttcgtaaccatttcgccaaacttggttagaaatgatagccattcatgat
+agaaataagctgaatgataccagtatctttaactatgtagtcagggggaagataacgatg
+gtccatgtatgtttctgatatgtgacagtattggccgcgtaatttgctaacgaagctact
+taatgcctttgagcttcatatagatttctttaatcaaaatcggcaaaaagatagtatgag
+ctataatatatgctagtagagaactctggaccatcatctatatgaatactgattcgagcg
+tgcaattactttagcctgcgtactactgactctacaaaacactctgagataagtttgtag
+tcagtaagtcgctctctataaaccttttggatgaccattgtacagccacttatagatccc
+aataaatagcacaggagacagagtttttcaatgctcgatcatttgccgatagtattttcg
+tctaacctcagggcacctattatttgatacctaacctaacggccctttcacaatggagaa
+atatatgacatcgggacaaacacaaatggtgggtggccaggagatatgacatggtggcgt
+ctctaagaaacacggactccctctaggcaaactcacgtaaccaattttaatgtcaaacaa
+aacgctcgaaaagattttgccgtgtaatgacctggtacattgactggtcaggaatacatc
+actgtagttgccgtagtgtcctgttggtgttccatcaagacacatcgtataacgcaattt
+acgacggacatcagatcaagttatacagattatttaagtatcacgtgtgcattgggacat
+aagggatctcacacatgccttggaacatttttgctttgtgccgctttttcgctgcactac
+caatccttacttaccagtatattcaaaggtcgttaacagaatgagaaaggttagggctct
+aagttatcgtcgattgggatagacgagacatttgcgagcgccctccacggatacgaatct
+cccatatcaatgtgaactggatgctatgcagtttagttcttacgtctcctagtggtaaaa
+atcaaagtagcactcgcatagcagttattcagaacctaatacacaaaaccgtcaaacatt
+ttctaattctaggtatgggccgatcataggagctaaggtgaaactcataaatgttttgtt
+agatctagcatcctaaaaagatgcatatactgagtagctggcgtgcattctctcaattgt
+atcctttttaactgaactagtcggtcccatttcgtgactgagatctattaaccgataaga
+ttaataacactcgcattcgtatcagctcagagtgaagtttttcaataatttgactgatat
+attaacttctaaaataaccctttaagcctcggatccgtttcccaatcacatcaaaaattc
+ttattccaactatctacggattaacaacgtgcatggggatcgtagtaagaacttgttccg
+atcactttgagtatatcaagttgacggcccggttattattgaatagaaacattcacctgc
+taaattaaataccgcacatcggatacccgatttcagagggccgtcttactaagggcaggc
+tttgttcggtttaactgagatgttcattattttacagtatgcttcaactaatatgtaacg
+aaggacagtggatctgtctccatagtagatcttcagtcgtgaatttcataccgctcctat
+ttaagttcgcgttcgagttgttgatcatggcacgtgaaagcaacccctagtattctagac
+gaaaattttttctagttcatctgataatttgccaattcaaaaacaaccgctggtttcccg
+gcgcattctctaaaatggaagtcgaacctagagccattatttgtcggtaacccatgagtt
+ccttcttttcagaagttaatacactgtggtcctatacagaggaaaaacagcggttatata
+cgatcgtggcataacaacattggatcaagatagcaatttggctacctattctaattctca
+ctagattcggtattccactacaatatcggcagattaggattggatgaataatcggtgttt
+aagtccggttgcgtctccaatctcctaatttttattaatattgatcttggtgacctattg
+taaataaaaacttcaagactttgaataacggtgaaaagatagaagactcatttgaaaatg
+gatcatccacagatccaaacattagcaagacactaatccccaactagctattctgatcgc
+gatcgtgctgcagtactcctgtcacaatagtctgttcatgatctaattctttttgggctt
+tgttcgatggtgattcagaatctttatccggtcgcttccctgtagctactttgtggggat
+attgcccggggattatagggttgagatcgtttcctaaaagtatttaaaccaagtagactt
+caactaaactacatcagaacatcgtgaagacaccatacgcggtacctttatttaccgata
+acatttcttcaagaaataccggtaagcagcataatgaccctaaacagctcggggtatcgt
+cgtagttttaaattttatttaggttactgctcaaggaataaaaactaactatttaattta
+taataatattacaaggctcacactgattagatttgtctataagacttcgcgatcccccat
+taccggattgtcttaagaataaactagataaaccatgcattttctagataaggcctttag
+tctaattagatacaaaaaacacgatagttgcatccttaatttattgtgtcaaacctggaa
+ccttttaattacccgcaaatcactttatgtcgagactacctctgaaatttattatctacc
+taccgcatgaggacttgaaccatcttgtaggagttatgtttattagctaagattcgttta
+tcctgtagcggtccatgtatattcaacaagcaaaaagcactcagaattgtttttagttga
+gtcaagactgatatataaataagtttccctagttttttcgtggtgggacgatattgaatt
+gaatcttaaccgaagagtttcccactctgtcgcacaataatacacgccaatatttccagc
+cctgcttatgccttaatcggttactcaatctcccattgaagttcattttgatctgcatag
+aagtttcgggcccagccttttttctgccaccttcctccaagctctgtagacgcactctaa
+gattgatgctcacatgtattaattctacattaacataaatatataagtcatgcatcttcg
+agtaaaatatctggttctccaacatgtcctggcacgtatcgttataatgcccatacatgt
+agtattaaaatgattgggttaactggatattaagatcatcgaaattgtaaagtcaaatta
+acaatactgtctcaagaccgtgtattcctcgtgctcggaagggctattacgcttacttcc
+gttttggtatcttaatatgactttcaaaaattaagttgcagtgagtcctacctgcgtgca
+tcggttagcaagagtataaaagttgtttaaacgaactacttgctttacaataccggtcgt
+atatatcgccgtgaatccagaagattgtcttctttggattatcaaccgagatcctgtgga
+ccgatgttttgggaccttcacagaggactccaggtagagctcgcttttgcattaatctaa
+gaattgtacctctctaaaagatctaaaacagtgaatgtgtatttcatggaaaaacacaga
+gaaacgtaaattactttaggccgaaaggcacatgagttattatacatatacgagatggtg
+gtatacatcgaattcggggcatacactatagttgcattgtatttagctgctttaaataat
+atgatattaccttccttacataagacattaccggcataccctggttttcaacttgtgggg
+ctttttgacgatcgcactctcatttgatccgagtagggcggtgacccctgcttttcaaat
+acaaaaatttcgctatgaaggtaatagattacttttcgctgttatgatagaaacggtaaa
+tttaaaattgaaacttctagaaaagtaaagtaacgagaaatgattttgtgaataatgcgg
+tcatgattgcgcaagtaagaaaaaaaggcaaaaggatgcgcggaatagaaacttatcagt
+cacgggtatcttgatttcattcttcttgtcaattgccgacataggatgaaatcagattcc
+aatgcaatacacagtaacccccacccttgattgtaatgtcgatttgaagttgtacgcgtc
+gacgaagtggatagtatacgggccttttgtacggtgcgatcaactatgaatctcggcgag
+ttagatggtcgtacaatctcacacatagaggtcacttgcctgtaatgacgaattttcggc
+taggtactcgaactttattagaagtaaaaatgtgggcaaaagaaggattccattttacaa
+gacgattacaatgagttacatgtctctcaacgtagtctttccctagtagtctttgaacta
+tttaggtactccagaaaattttagcaaagggtttctgtgtgaatccgccattcatgttta
+tgatggaacaataagaataacgccctcgtatgttatcgacagtgaagtcagcagttcggc
+caaaaacatattcaatttagtacagatccccagaagttaagctaagtgctctaaaatggc
+ctaaacggttatcaaagtaggtctaattactatactaacgggtgcatcgtaataactgct
+gtcgatgcaacactatatgatagtgtcgttttgctatatatgtacaatgtgacaaagaag
+ccttagcgattcttgcaaacttaggacttcggattctcaatcttaaatgtccgaaaacgc
+aaagattcaaaaatttaatctatgagcagatatgcctgatggtgactacgcgtatgttaa
+ggctaaatgttgacaaccgcacacataatcgaactattgatagtcgggagcataaccagg
+tgaacgtactttgttcacgacatttattgacatgttctaaatacgtctcaaaatcacggc
+gcactagaaaacgcaatcaaatcattgtcctggtttaagggccgtaatgccggtagtgtc
+aaacttcatgagaactttagctggcttttggccagtatttagggaccaagagcactagcc
+ttaagctgaatattttgccatttatctactgttataactttaaaacttggtggcaccaga
+cttgtcgatacacacgcatcaatctgtaacgtaaaaggtttactaagaacaagcgtagga
+attgagtttatattatatttaaactaaaagatgatattagcttctgagggcgatagggct
+ccaaatcataaagaggaatatattattacacgattagaaacccacaacatacctcgaatc
+gcccaaaagtttgacgaaacttggcagtactccacatctcagtaatacagttgggagagt
+ctcaaatgttgttttattactcaatgaaccaccctcataatttcactgctgttccattaa
+atttgcaaacgatcatttgctttgaagaaacgtaaaatcgacaaaattacagataagtag
+atgcataataaaaaaaactgctcgctataacacgatcatcgtgcattcttacttaggagc
+atcacccgcacaataacgtaccttaaactacaacactattagaccgagtactgtaattca
+cgaaagctcaagctcgcattgtaaagaacttgctctctcgtaaaatgtgataatagtttg
+cggagaggattcaattattttccattgcacctactccactagattcgataaaagaaggtg
+gtcctcccttaaaaagaaatgttaagtaacatcggaaccataagcaaagcatgtaagtga
+accgtcatccttccctaagaaacataaaggtttttaataatgtcgactgtgaactataac
+tgcatcctttcctgacctactccggttccttgttgttatttctgaacgagaccagtagat
+aaacaatgtaaaccacagtgggtaccaatggtgcatgtgacgctaccgttgttttaagtg
+cccgtacaaacataagaagtcataatcttacttgaaattaattttgccttttattttttt
+tcaggctcgaaattaatgatttgttttttttgaccttctagttacgctaatatgcggtcg
+cctgtggtttctattgagtcctataacgggatgggatctaatacgtttggttactagtaa
+acaaggtataaatttgataccggagtatcaactgtataacatcaagctttatgactcata
+cgcgaagtaatgacacaaggctttcaggagatcgcgagtacagagccactaaggggtgta
+ttacgatagtgacaccaccgagcgcactcactccccaagtagatttatgatcctacgcta
+agtattagatatataaccaaagaggttctagtcagtgcaactcttagaataataattagc
+cggttttgcctttttaggcctaatgcaatattcagctagcccttatgtatctcgcgttcc
+acagcaccactcatggcacgcgtttaaactaatcaaatataatctatgaatgttatgcca
+gtacttgaataaatcaggttttttataagtccttgcatactctcgttatatactgttaga
+gtcttaccccatagaaattctttcatctgcaaacttagaagaattctcagctacggggag
+cataaagtccccaggatgttgacaaatacaacaaatgtggcttatacaaacactccatat
+gaaaatcgaaccctcgtggtagttttagccgaaccttgtacggataaatccctccatttt
+ccaatagcagatacctatcctactacctcgtggtattaaattaaagcttgaaatatagag
+ctgcatagcttatccaattcccaagcacgagtctaccgtcgtaaccacgatttgatttac
+agacgctagagcaaacccatctttaaacatataagtaaaaattaaagggtgagtgcgtac
+gtgtttactagcaacttcgcttattaagacaattgtttataagccataattaaaaacata
+tgttcaacaggttcattgatatttgtaattgcacaggtttttaataaggatctacgtaag
+tataatgaacaaactttttaccagagttatattctgtactttgaaaatgctcctctaccg
+ccttagagactttcaattagattttttgcagttaatctatgcgtaagtgaaccatgcaag
+ggatgcgattcaaccgcctcgtgctaaccctatcgtctgtctcataactgtaggtctaat
+ataattttcagttttcgaacacataaccctttgaaaatctgctatttaatgtctcacctg
+catgcactatcttctatactgctcagaacggctatacgtcactatgctccaagtgacgat
+ttaaacgaagcaaggaataataggtttattttagtgcaaaacaattaagtgcggactacg
+tgctctttacaataagccttgtgattgggctataggttaagtcccatattaacgatctcc
+aatgtacaaaatcgacaatcgctttgcattacccggttactagtcgaattacagatagct
+gttagatactcactctaattttggacaacaatcccaatcttggggtcgtctatcgcctga
+agctcgtaaatccttccatcttaaacgattacatattatagacttgttcggggtagagat
+atcacagttgtgcaaacattgtaaatcgatactagtttatgttggtagtctagttgcttt
+taccattccccgaaaaacttgatctactatttcgacaacagtaaacttgaactaggtaag
+tgaaaacagagaatgcctcatagtgccactatttgtccactatatgtaagtgtagcttta
+cataatccactatgactgagatcattacggcctaggaaagcagcgtagaaaaaaagggcc
+cggatattacgactgtaactataaaactagttactggtagcgcgccatgtatagatttgt
+tttaccggttgtggttgcgttaacgaatttcagccgcgaaaattgatccgttaaccagtc
+catctcgacttctataaaacgataaagtaaagttgatgttcagcctccttcttatggttg
+catcgagagtacactactcagtgggaaatagatcggggttcctacttcagattgtattat
+ctaggcaattgccgattgtgccatacctggataaaataagctacctacatgtgatgctta
+tctattatcgtcatactaccttagggtgtcctgttgaacgctacattaatctttagccgt
+ttgagatgttccaatggataggagtctaacgcatgatgaagtttaggaaggcagagcatc
+ccactaagtatgtgacagtgtatttcgaaacgagacgttataaatagaaaaaaggtcctt
+ctggttctattctgctgaactattgaatggaaagattggttgacctacgtactatttgct
+tgaagtcatcaatttgacggggtgagagacatatggtgcatactttacggactctatatt
+ttagatcagaagcttagcagtcttctctacaccccctcacgacataattgcttttaagaa
+tctatgtttgattcctctacgggaattcggatccgttcgcatgtgcggtttatctaaacc
+aggggacatatgttcagctaaagcatacgaacactttgctaactagacgtatgtatagta
+gctataaatcccgacgatatttacaaaaagaaatgagactcaaatatatacatagcgacc
+ctacacttattcgcaccctgatctaggcgatcctagcacccacacccgaaagtgagcact
+agtgtcttccgtattaaatttactgcagttgagattttagttgtctactaaggattactc
+taacccgtaataaggatcaagactcggtactagctttactatcattccctatgtgttttc
+ctaactcacaagggtacgtaccagcctatgtaattacaataatgataaagacacaaagga
+agtaactttacaaatgagtctccagttacactagcttagtccctcccatcttgctttgaa
+gtctaaatacgcaatctctgaggatatacagcagaagaacactcataacgttggagtcca
+agaattagactcatagggcccccaacatttaatatgtactgtgagtttgaaggtgttcta
+ttgttaattcctgctcttgatacatgacacgtactccgtgtttaaggcttcggactgact
+ttctttcataagttgagcaacgaaaatttcagaatcgataagttggattcactaactaat
+acggctgattgaaaactccactccggacctatatggtcgacctttatacgtaaccgatat
+aaaacttataggctggtatatcgagccttcctagcgcaatttcggatggggtttcttcta
+ctactcaacaacggaatagtctttgtttagtaaaccagagctcaggacgcccaatacgta
+ggagagcgctgtggagcatgtgtcattatggactggagcactcttaaatcactctgcgtg
+tgctaaacgatagatcataacatgtcctgagtaaattttcttgatacgtcgcaatatacc
+gttattagttaaacgttctcatccgtcatgcgtgaaatacggctgtcgtgctcagatata
+ctattagcgactcatctcgcctaacacgcacacgtataaactcggaatgactgccgctct
+tacatattagaaatacagactacaccacggaagcattgggtcattctcaaccgctgtata
+aaagatgattagtcttataataagattaccaaagaggcagaatcatgggtagtaaatcta
+ttattcaagtgattaccgtcgtgtaggcagggagtgaggacgagatggtactcaggacaa
+atattaaccggacgaagtggtttacgtcgtactttcactattagtagtaaatacaaggta
+acaccggggaatagtactaaatataatgatatctatcttcgggagaacgagtcgtctatt
+gctttgaacattctcaaggcgtaaaatgtgctgacttatagcatgatacaaccgattgtt
+acttttgtctattcaaaagattgaatagttttttatacaaaagccgcatacttatgacgg
+ctagtatacagtttcatcccctagcatcaatgctatggacagtattgaacttataggaaa
+ttcttctaatagggcaaatccgtcgtgatgcctattttttttcagtcacatcctcaaatg
+gcactagtattgtcgggatcccattaacaggctcaaccacgagctcacgcgaggacatgt
+agtccgtatctttaacgaagcgacagcgacagaactcccatggataaccaattataaggc
+ccgtaatcctctagacatcgtttaccaataaatccgctttctccgtaatcatgttgaata
+ccccagagtagtccagatgataaccgatgaaacacaagtctttctcaatgcacttacggt
+gaacttattaccgccaacgtagctcatcaaggttgcgacatctagttgtgtgtttgcgac
+gagcccagcgaacttcatcaactttcgtatattcaacgccttgtaattttactttaagac
+gcctggtgatgtagattcttagataatcagtttgttatcggctgtactttaccataattt
+cacaggtttcaggtcaagaagattatagctgtatatacagttccatgctcggtgcacaga
+aacgtgatcggataataatcaatcgcttatgtcgtctttaggcgtatccaatacatgccc
+cgataccgcagtgtatttcgacatgtaggtataccgtcgcatttgagctcgagtcaggac
+gtcagctagattagattccttaatagaatataccgacctctagtccgaactaaactatag
+ataacgccaacttcaggttaattgtctagtcgtctgtttgcagatgggattcttagatga
+gtgagtatcggccatattggttcgagcactttagtttttgatgcataggatatgcaatgt
+atagctgaaagtactttatctgtttcaaactcacattgattaaaccggtaaacctttaaa
+gactacaagaaaatattcagtgagggcaattttgtcaatcacaatcttccagctagagat
+acttcacaatttgtcttgaggctacgcaacattagacggattttcgcgttttattgaaat
+aatcgaggggcccaagagtatccatagttcattttgtaagatttctttacaggcttatta
+cagcttcttcagactcctacatgcttacgagttatatgctagcatgtgaacaatagatta
+atatacaggaaaacgtacattgagagagatgaccctacacagcgcaaccgttgagtactt
+tcattaaagggtaacgctctcgagacagcatccttaagatggccttattgtcaaatcatt
+tgcagaagtacgcaagatccctaaccaacgtagaagaatccctacaaacacatgagacgc
+ggtgaaaatagacagggtgttagtattcaatcttcggagtatcaatttcgccaatcttgg
+tgagaaagcataccctttcttcagagaaagaagatcaatcataacactatctttaacgag
+gtacgcacgcgcatcattacctgcctccatggatctttaggatagcggaaagtattggca
+gcgtattgtgatttcgttcctactttatcaatttcacattcatatacatgtcttttatca
+aaatcgccaataagataggatgagctatattagatgctagtagagttcgcgccaacatca
+tcgataggaatactcaggacagcgtgataggacttttcaatccctaatactctctataat
+tataactctctcttaagtttggaggcagtaacgcgctctatataatcagtttgctgcacc
+attcttcagcctctgatacatacaaataaattccacagcagtaagagggtttaattgaga
+catcttgggaacttaggattttactctaacatcaccgaaacgattattggataccgtacc
+taaacgaactttctcaaggcagtaatataggacatccgcaataacacaaatgctgcctcc
+ccaggagttatgtcttcctggaggctatatcttacacccactcactataggcaaactaaa
+gtttaaatgttgattgtctaaaaaaaagatagataagagttggccggcgtagcacatgcg
+aaagtgaatcgtaagctataattctctggacttgaagttctgtcctgttcctctgcaaga
+aacaaacttcctttaaagctatttacgacgcacatctcagcaagttataaacatgttgga
+agtttctagtcggaattcccaaagaacggatctatctaatgcattcctacatttttcctg
+tctgccgatggtgccatcctattcaaagaatttcttaaaagtagattaaatgggactttt
+aacaatgagtaaccttacgcctctaagggttcctcgagtgccatacaccagtcaggtccg
+agccacatacacggagaacattctaacatagcattctcaactcgatcatttgcaggttac
+ttctttcctatcctagtgctaaaaatcatacttgcaatcccatagcacggattaagaacc
+taagaaacaattcagtaaaacatgttcgaattcttggtatgggaacatcattgcagctat
+ggtctaacgcattaatgtttgggtacatcttccatcatataaacaggaagagtctgacga
+cagggagtgcttgcgatcatgtctatcattgtgaaatcaaattgtagctcacatgtcgtc
+tatgagagcgtgtatccgataagatttagaaaaatagaagtcgtataagatctcactgaa
+cttttgaatgaatgtgaagcatatatgatctgctttaataaaactttatccataggatac
+gtttccaaatcaattcaataattattagtcaaaatagataaggatgaacaacctgaaggc
+cgatcggacgtagaaagtggtcccatcactttgagttgatattgttgaaccacacgttat
+tatggttttcaaacagtctcaggatattgtatatacagataatccgataccagttgtctg
+acgcccctcttacgtaccccaccctttgtgacgtttaaagcagttgttcagtattttaaa
+ctaggcggcaactaatttggaaagaagcacagtggatatgtctaaattcttgttattcag
+gcctgaatttaatacaccgcatagttaacttcgcggtagagttgttcatcatgcctcctc
+taagctaccacttctatgatacaccaatagttgttctacggaatctgataattggccaag
+tcataaacttccgctgcgttcaacccccttgctcgaatatccaactcgaaaagacagcct
+tttggtgtccggaacaaatcagttacttcttttctgatgttaattctctgtggtcagata
+cagaccaaaaactccgcggatttaccatcctccaagaacaaatttgcatcaacatagcat
+tttggctacatattctaagtctcaatagtttaggttttcaactacattatcccaacatta
+ggattggaggaataatagctgggtaagtccccttgcgtctacaatcgactattttttatg
+aatatgcttctgccgcacctatggttattaaaaaagtcatgactttgaagaaccctgaaa
+agatagatgaatcaggtgtaatggcagcagccaaagagcatataattagcaacactctaa
+gaacattatagatatgatgatagcgatcgtcatgatgttatccggtcacaatagtagctt
+catcagctaattcgttttgccagtggtgacttgcgctggaagaatcgttatacggtccct
+tccctcttgatacggtgggggcttattcaaccgcgtggattgggttgtcatacttgcatt
+aaacgatgtaaaccatctagtagtcaactatactaaatcacaaaatagtgatcaatacat
+acccgcttcatggttttaaccatttaattgattaaagatattccgctaagaaccattatc
+tacctaaactgatcgccgtatcctagtagtttgaaatttgatgtaccgtaatgatcaacg
+aagtaaaacgttatattgtatgtagaataataggtcttggagctaaatgatgtgattggt
+agtgaagacttacccttacaactttaccggtttctcggaagaatatactagagaatcaat
+gcatgggctacataagcactttagtctaatgagataaaaaatacacgagtcttccatcat
+gaattttttgtcgaaaaactcgaacctggtaatttaaaccatatatctttatgtcgtcaa
+taactctcatatgttttatataacttcccaatcacgacttgtaactgcttgttcgactga
+gctgtttgagctatgaggccgggatccggttgagctacatctatttgctacaagaaaaat
+gaaagcacatttgttgggagttctggctacactcatagagaaataagtggcccgagtggg
+tgcggcctgcctccatattcaagtgtatcttaaaccaagtggttccaacgctcgcgctaa
+agaattaaagcctttatttcctccacggagtagcccgtaatccggttcgaaagagaccat
+tgaagttaattttcatatccagtgaagtttaggcacaagcatgtgttctgccacatgcct
+caaagcgctcttcaaccaagatatgattcatcctaacttcgatgaatgcgtctgtaacat
+aaatatagaaggaatgattcggcgagttaattttcgccttctccaacatggcatccctac
+gttcgttataaggaccatacatgtaggttttaaaggtttgcggttaatcgatatttacat
+catagaaattctatagtcaaatttacaagactctagatactcactcgttgcagccggcta
+ggaagcgctttgtaccttacttcccttttcgttgcgtaatatgaatttcatatagtaagt
+tcaaggcactcatacctccgtgaagagggtagatagactattaaagttgtttaatagtac
+gtattgatggaaatgacccgtaggagatttaccactcaatccacaagattcgctgctgtg
+cattatcaaaacagtgcatgtcgaaacatgggttgggtccttcaaacacgaatccaggta
+gagatacctttgcaattttt
diff --git a/extra/benchmark/regex-dna/regex-dna-test-out.txt b/extra/benchmark/regex-dna/regex-dna-test-out.txt
new file mode 100644
index 0000000000..d36baa5be8
--- /dev/null
+++ b/extra/benchmark/regex-dna/regex-dna-test-out.txt
@@ -0,0 +1,13 @@
+agggtaaa|tttaccct 0
+[cgt]gggtaaa|tttaccc[acg] 3
+a[act]ggtaaa|tttacc[agt]t 9
+ag[act]gtaaa|tttac[agt]ct 8
+agg[act]taaa|ttta[agt]cct 10
+aggg[acg]aaa|ttt[cgt]ccct 3
+agggt[cgt]aa|tt[acg]accct 4
+agggta[cgt]a|t[acg]taccct 3
+agggtaa[cgt]|[acg]ttaccct 5
+
+101745
+100000
+133640
diff --git a/extra/benchmark/regex-dna/regex-dna-tests.factor b/extra/benchmark/regex-dna/regex-dna-tests.factor
new file mode 100644
index 0000000000..f1d4b7f627
--- /dev/null
+++ b/extra/benchmark/regex-dna/regex-dna-tests.factor
@@ -0,0 +1,10 @@
+USING: benchmark.regex-dna io io.files io.encodings.ascii
+io.streams.string kernel tools.test ;
+IN: benchmark.regex-dna.tests
+
+[ t ] [
+ "resource:extra/benchmark/regex-dna/regex-dna-test-in.txt"
+ [ regex-dna ] with-string-writer
+ "resource:extra/benchmark/regex-dna/regex-dna-test-out.txt"
+ ascii file-contents =
+] unit-test
diff --git a/extra/benchmark/regex-dna/regex-dna.factor b/extra/benchmark/regex-dna/regex-dna.factor
new file mode 100644
index 0000000000..0c21de0363
--- /dev/null
+++ b/extra/benchmark/regex-dna/regex-dna.factor
@@ -0,0 +1,60 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors regexp prettyprint io io.encodings.ascii
+io.files kernel sequences assocs namespaces ;
+IN: benchmark.regex-dna
+
+! Based on http://shootout.alioth.debian.org/gp4/benchmark.php?test=regexdna&lang=ruby&id=1
+
+: strip-line-breaks ( string -- string' )
+ R/ >.*\n|\n/ "" re-replace ;
+
+: count-patterns ( string -- )
+ {
+ R/ agggtaaa|tttaccct/i,
+ R/ [cgt]gggtaaa|tttaccc[acg]/i,
+ R/ a[act]ggtaaa|tttacc[agt]t/i,
+ R/ ag[act]gtaaa|tttac[agt]ct/i,
+ R/ agg[act]taaa|ttta[agt]cct/i,
+ R/ aggg[acg]aaa|ttt[cgt]ccct/i,
+ R/ agggt[cgt]aa|tt[acg]accct/i,
+ R/ agggta[cgt]a|t[acg]taccct/i,
+ R/ agggtaa[cgt]|[acg]ttaccct/i
+ } [
+ [ raw>> write bl ]
+ [ count-matches . ]
+ bi
+ ] with each ;
+
+: do-replacements ( string -- string' )
+ {
+ { R/ B/ "(c|g|t)" }
+ { R/ D/ "(a|g|t)" }
+ { R/ H/ "(a|c|t)" }
+ { R/ K/ "(g|t)" }
+ { R/ M/ "(a|c)" }
+ { R/ N/ "(a|c|g|t)" }
+ { R/ R/ "(a|g)" }
+ { R/ S/ "(c|t)" }
+ { R/ V/ "(a|c|g)" }
+ { R/ W/ "(a|t)" }
+ { R/ Y/ "(c|t)" }
+ } [ re-replace ] assoc-each ;
+
+SYMBOL: ilen
+SYMBOL: clen
+
+: regex-dna ( file -- )
+ ascii file-contents dup length ilen set
+ strip-line-breaks dup length clen set
+ dup count-patterns
+ do-replacements
+ nl
+ ilen get .
+ clen get .
+ length . ;
+
+: regex-dna-main ( -- )
+ "resource:extra/benchmark/regex-dna/regex-dna-test-in.txt" regex-dna ;
+
+MAIN: regex-dna-main
From 82b2f36416a2d550d0cb8650882c58a591f84b3d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 22 Sep 2008 02:46:10 -0500
Subject: [PATCH 39/87] Fix regression
---
basis/html/components/components.factor | 1 +
1 file changed, 1 insertion(+)
diff --git a/basis/html/components/components.factor b/basis/html/components/components.factor
index 9ade669157..a46f595459 100644
--- a/basis/html/components/components.factor
+++ b/basis/html/components/components.factor
@@ -150,6 +150,7 @@ TUPLE: farkup no-follow disable-images parsed ;
{
{ "true" [ t ] }
{ "false" [ f ] }
+ { f [ f ] }
} case ;
M: farkup render*
From da35e13153f91a39e2b53971fbcdd103fa9b1145 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 22 Sep 2008 10:48:01 -0500
Subject: [PATCH 40/87] fix the parser for groups
---
basis/regexp/parser/parser.factor | 76 ++++++++++++++-----------------
1 file changed, 35 insertions(+), 41 deletions(-)
diff --git a/basis/regexp/parser/parser.factor b/basis/regexp/parser/parser.factor
index eaee70210e..fc3f949670 100644
--- a/basis/regexp/parser/parser.factor
+++ b/basis/regexp/parser/parser.factor
@@ -1,10 +1,10 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators io io.streams.string
-kernel math math.parser multi-methods namespaces qualified sets
+kernel math math.parser namespaces qualified sets
quotations sequences splitting symbols vectors math.order
unicode.categories strings regexp.backend regexp.utils
-unicode.case ;
+unicode.case words ;
IN: regexp.parser
FROM: math.ranges => [a,b] ;
@@ -25,11 +25,21 @@ TUPLE: reluctant-kleene-star term ; INSTANCE: reluctant-kleene-star node
TUPLE: negation term ; INSTANCE: negation node
TUPLE: constant char ; INSTANCE: constant node
TUPLE: range from to ; INSTANCE: range node
+
+MIXIN: parentheses-group
TUPLE: lookahead term ; INSTANCE: lookahead node
+INSTANCE: lookahead parentheses-group
TUPLE: lookbehind term ; INSTANCE: lookbehind node
+INSTANCE: lookbehind parentheses-group
TUPLE: capture-group term ; INSTANCE: capture-group node
+INSTANCE: capture-group parentheses-group
TUPLE: non-capture-group term ; INSTANCE: non-capture-group node
+INSTANCE: non-capture-group parentheses-group
TUPLE: independent-group term ; INSTANCE: independent-group node ! atomic group
+INSTANCE: independent-group parentheses-group
+TUPLE: comment-group term ; INSTANCE: comment-group node
+INSTANCE: comment-group parentheses-group
+
TUPLE: character-class-range from to ; INSTANCE: character-class-range node
SINGLETON: epsilon INSTANCE: epsilon node
SINGLETON: any-char INSTANCE: any-char node
@@ -98,25 +108,6 @@ left-parenthesis pipe caret dash ;
ERROR: unmatched-parentheses ;
-: make-positive-lookahead ( string -- )
- lookahead boa push-stack ;
-
-: make-negative-lookahead ( string -- )
- <negation> lookahead boa push-stack ;
-
-: make-independent-group ( string -- )
- #! no backtracking
- independent-group boa push-stack ;
-
-: make-positive-lookbehind ( string -- )
- lookbehind boa push-stack ;
-
-: make-negative-lookbehind ( string -- )
- <negation> lookbehind boa push-stack ;
-
-: make-non-capturing-group ( string -- )
- non-capture-group boa push-stack ;
-
ERROR: bad-option ch ;
: option ( ch -- singleton )
@@ -143,33 +134,38 @@ ERROR: bad-option ch ;
DEFER: (parse-regexp)
: parse-special-group ( -- )
- beginning-of-group push-stack
- (parse-regexp) pop-stack make-non-capturing-group ;
+ ;
+ ! beginning-of-group push-stack
+ ! (parse-regexp) pop-stack make-non-capturing-group ;
ERROR: bad-special-group string ;
-DEFER: nested-parse-regexp
+: nested-parse-regexp ( token ? -- )
+ [ push-stack (parse-regexp) pop-stack ] dip
+ [ <negation> ] when pop-stack boa push-stack ;
+
+! non-capturing groups
: (parse-special-group) ( -- )
read1 {
- { [ dup CHAR: # = ]
- [ drop nested-parse-regexp pop-stack drop ] }
+ { [ dup CHAR: # = ] ! comment
+ [ drop comment-group f nested-parse-regexp pop-stack drop ] }
{ [ dup CHAR: : = ]
- [ drop nested-parse-regexp pop-stack make-non-capturing-group ] }
+ [ drop non-capture-group f nested-parse-regexp ] }
{ [ dup CHAR: = = ]
- [ drop nested-parse-regexp pop-stack make-positive-lookahead ] }
+ [ drop lookahead f nested-parse-regexp ] }
{ [ dup CHAR: ! = ]
- [ drop nested-parse-regexp pop-stack make-negative-lookahead ] }
+ [ drop lookahead t nested-parse-regexp ] }
{ [ dup CHAR: > = ]
- [ drop nested-parse-regexp pop-stack make-independent-group ] }
+ [ drop non-capture-group f nested-parse-regexp ] }
{ [ dup CHAR: < = peek1 CHAR: = = and ]
- [ drop drop1 nested-parse-regexp pop-stack make-positive-lookbehind ] }
+ [ drop drop1 lookbehind f nested-parse-regexp ] }
{ [ dup CHAR: < = peek1 CHAR: ! = and ]
- [ drop drop1 nested-parse-regexp pop-stack make-negative-lookbehind ] }
+ [ drop drop1 lookbehind t nested-parse-regexp ] }
[
":)" read-until
[ swap prefix ] dip
{
- { CHAR: : [ parse-options parse-special-group ] }
+ { CHAR: : [ parse-options (parse-special-group) ] }
{ CHAR: ) [ parse-options ] }
[ drop bad-special-group ]
} case
@@ -179,7 +175,7 @@ DEFER: nested-parse-regexp
: handle-left-parenthesis ( -- )
peek1 CHAR: ? =
[ drop1 (parse-special-group) ]
- [ nested-parse-regexp ] if ;
+ [ capture-group f nested-parse-regexp ] if ;
: handle-dot ( -- ) any-char push-stack ;
: handle-pipe ( -- ) pipe push-stack ;
@@ -408,14 +404,12 @@ DEFER: handle-left-bracket
[ first|concatenation ] map first|alternation ;
: handle-right-parenthesis ( -- )
- stack beginning-of-group over last-index cut rest
- [ current-regexp get swap >>stack drop ]
- [ finish-regexp-parse <capture-group> push-stack ] bi* ;
+ stack dup [ parentheses-group "members" word-prop member? ] find-last -rot cut rest
+ [ [ push ] keep current-regexp get (>>stack) ]
+ [ finish-regexp-parse push-stack ] bi* ;
-: nested-parse-regexp ( -- )
- beginning-of-group push-stack (parse-regexp) ;
-: ((parse-regexp)) ( token -- ? )
+: parse-regexp-token ( token -- ? )
{
{ CHAR: . [ handle-dot t ] }
{ CHAR: ( [ handle-left-parenthesis t ] }
@@ -433,7 +427,7 @@ DEFER: handle-left-bracket
} case ;
: (parse-regexp) ( -- )
- read1 [ ((parse-regexp)) [ (parse-regexp) ] when ] when* ;
+ read1 [ parse-regexp-token [ (parse-regexp) ] when ] when* ;
: parse-regexp ( regexp -- )
dup current-regexp [
From 56fbeb25ff88228a270bde7c584d3714a8350568 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 22 Sep 2008 11:45:36 -0500
Subject: [PATCH 41/87] fix options before non-capturing groups
---
basis/regexp/parser/parser.factor | 9 ++-------
1 file changed, 2 insertions(+), 7 deletions(-)
diff --git a/basis/regexp/parser/parser.factor b/basis/regexp/parser/parser.factor
index fc3f949670..987d05591f 100644
--- a/basis/regexp/parser/parser.factor
+++ b/basis/regexp/parser/parser.factor
@@ -132,14 +132,9 @@ ERROR: bad-option ch ;
: parse-options ( string -- )
"-" split1 [ t (parse-options) ] [ f (parse-options) ] bi* ;
-DEFER: (parse-regexp)
-: parse-special-group ( -- )
- ;
- ! beginning-of-group push-stack
- ! (parse-regexp) pop-stack make-non-capturing-group ;
-
ERROR: bad-special-group string ;
+DEFER: (parse-regexp)
: nested-parse-regexp ( token ? -- )
[ push-stack (parse-regexp) pop-stack ] dip
[ <negation> ] when pop-stack boa push-stack ;
@@ -165,7 +160,7 @@ ERROR: bad-special-group string ;
":)" read-until
[ swap prefix ] dip
{
- { CHAR: : [ parse-options (parse-special-group) ] }
+ { CHAR: : [ parse-options non-capture-group f nested-parse-regexp ] }
{ CHAR: ) [ parse-options ] }
[ drop bad-special-group ]
} case
From 80a914769124e6517121f7d7f52fe3b19a59be60 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 22 Sep 2008 13:37:27 -0500
Subject: [PATCH 42/87] working on lookbehind
---
basis/regexp/nfa/nfa.factor | 10 ++++++
basis/regexp/parser/parser.factor | 43 ++++++++++++++++---------
basis/regexp/regexp-tests.factor | 14 ++++++++
basis/regexp/regexp.factor | 3 ++
basis/regexp/traversal/traversal.factor | 24 ++++++++++++--
5 files changed, 75 insertions(+), 19 deletions(-)
diff --git a/basis/regexp/nfa/nfa.factor b/basis/regexp/nfa/nfa.factor
index f070c3528b..aebfea04e1 100644
--- a/basis/regexp/nfa/nfa.factor
+++ b/basis/regexp/nfa/nfa.factor
@@ -14,6 +14,8 @@ SINGLETON: eps
MIXIN: traversal-flag
SINGLETON: lookahead-on INSTANCE: lookahead-on traversal-flag
SINGLETON: lookahead-off INSTANCE: lookahead-off traversal-flag
+SINGLETON: lookbehind-on INSTANCE: lookbehind-on traversal-flag
+SINGLETON: lookbehind-off INSTANCE: lookbehind-off traversal-flag
SINGLETON: capture-group-on INSTANCE: capture-group-on traversal-flag
SINGLETON: capture-group-off INSTANCE: capture-group-off traversal-flag
@@ -143,6 +145,14 @@ M: lookahead nfa-node ( node -- )
lookahead-off add-traversal-flag
2 [ concatenate-nodes ] times ;
+M: lookbehind nfa-node ( node -- )
+ eps literal-transition add-simple-entry
+ lookbehind-on add-traversal-flag
+ term>> nfa-node
+ eps literal-transition add-simple-entry
+ lookbehind-off add-traversal-flag
+ 2 [ concatenate-nodes ] times ;
+
: construct-nfa ( regexp -- )
[
reset-regexp
diff --git a/basis/regexp/parser/parser.factor b/basis/regexp/parser/parser.factor
index 987d05591f..d2ed346bf2 100644
--- a/basis/regexp/parser/parser.factor
+++ b/basis/regexp/parser/parser.factor
@@ -230,8 +230,18 @@ ERROR: invalid-range a b ;
[ [ nip at-most-n ] [ at-least-n ] if* ] if
] [ drop 0 max exactly-n ] if ;
+SINGLETON: beginning-of-input
+SINGLETON: end-of-input
+
+! : beginning-of-input ( -- obj )
: handle-front-anchor ( -- ) front-anchor push-stack ;
-: handle-back-anchor ( -- ) back-anchor push-stack ;
+: end-of-line ( -- obj )
+ end-of-input
+ CHAR: \r <constant>
+ CHAR: \n <constant>
+ 2dup 2array <concatenation> 4array <alternation> lookahead boa ;
+
+: handle-back-anchor ( -- ) end-of-line push-stack ;
ERROR: bad-character-class obj ;
ERROR: expected-posix-class ;
@@ -277,6 +287,8 @@ ERROR: unrecognized-escape char ;
read1
{
{ CHAR: \ [ CHAR: \ <constant> ] }
+ { CHAR: ^ [ CHAR: ^ <constant> ] }
+ { CHAR: $ [ CHAR: $ <constant> ] }
{ CHAR: - [ CHAR: - <constant> ] }
{ CHAR: { [ CHAR: { <constant> ] }
{ CHAR: } [ CHAR: } <constant> ] }
@@ -289,7 +301,6 @@ ERROR: unrecognized-escape char ;
{ CHAR: + [ CHAR: + <constant> ] }
{ CHAR: ? [ CHAR: ? <constant> ] }
{ CHAR: . [ CHAR: . <constant> ] }
-! xyzzy
{ CHAR: : [ CHAR: : <constant> ] }
{ CHAR: t [ CHAR: \t <constant> ] }
{ CHAR: n [ CHAR: \n <constant> ] }
@@ -297,8 +308,6 @@ ERROR: unrecognized-escape char ;
{ CHAR: f [ HEX: c <constant> ] }
{ CHAR: a [ HEX: 7 <constant> ] }
{ CHAR: e [ HEX: 1b <constant> ] }
- { CHAR: $ [ CHAR: $ <constant> ] }
- { CHAR: ^ [ CHAR: ^ <constant> ] }
{ CHAR: d [ digit-class ] }
{ CHAR: D [ digit-class <negation> ] }
@@ -320,16 +329,16 @@ ERROR: unrecognized-escape char ;
! { CHAR: G [ end of previous match ] }
! { CHAR: Z [ handle-end-of-input ] }
! { CHAR: z [ handle-end-of-input ] } ! except for terminator
-! xyzzy
- { CHAR: 1 [ CHAR: 1 <constant> ] }
- { CHAR: 2 [ CHAR: 2 <constant> ] }
- { CHAR: 3 [ CHAR: 3 <constant> ] }
- { CHAR: 4 [ CHAR: 4 <constant> ] }
- { CHAR: 5 [ CHAR: 5 <constant> ] }
- { CHAR: 6 [ CHAR: 6 <constant> ] }
- { CHAR: 7 [ CHAR: 7 <constant> ] }
- { CHAR: 8 [ CHAR: 8 <constant> ] }
- { CHAR: 9 [ CHAR: 9 <constant> ] }
+
+ ! { CHAR: 1 [ CHAR: 1 <constant> ] }
+ ! { CHAR: 2 [ CHAR: 2 <constant> ] }
+ ! { CHAR: 3 [ CHAR: 3 <constant> ] }
+ ! { CHAR: 4 [ CHAR: 4 <constant> ] }
+ ! { CHAR: 5 [ CHAR: 5 <constant> ] }
+ ! { CHAR: 6 [ CHAR: 6 <constant> ] }
+ ! { CHAR: 7 [ CHAR: 7 <constant> ] }
+ ! { CHAR: 8 [ CHAR: 8 <constant> ] }
+ ! { CHAR: 9 [ CHAR: 9 <constant> ] }
{ CHAR: Q [ parse-escaped-literals ] }
[ unrecognized-escape ]
@@ -406,6 +415,10 @@ DEFER: handle-left-bracket
: parse-regexp-token ( token -- ? )
{
+! todo: only match these at beginning/end of regexp
+ { CHAR: ^ [ handle-front-anchor t ] }
+ { CHAR: $ [ handle-back-anchor t ] }
+
{ CHAR: . [ handle-dot t ] }
{ CHAR: ( [ handle-left-parenthesis t ] }
{ CHAR: ) [ handle-right-parenthesis f ] }
@@ -415,8 +428,6 @@ DEFER: handle-left-bracket
{ CHAR: + [ handle-plus t ] }
{ CHAR: { [ handle-left-brace t ] }
{ CHAR: [ [ handle-left-bracket t ] }
- { CHAR: ^ [ handle-front-anchor t ] }
- { CHAR: $ [ handle-back-anchor t ] }
{ CHAR: \ [ handle-escape t ] }
[ <constant> push-stack t ]
} case ;
diff --git a/basis/regexp/regexp-tests.factor b/basis/regexp/regexp-tests.factor
index ab3bca9ead..4d25a58c39 100644
--- a/basis/regexp/regexp-tests.factor
+++ b/basis/regexp/regexp-tests.factor
@@ -285,3 +285,17 @@ IN: regexp-tests
! 2. (A)
! 3. (B(C))
! 4. (C)
+
+! clear "a(?=b*)" <regexp> "ab" over match
+! clear "a(?=b*c)" <regexp> "abbbbbc" over match
+! clear "a(?=b*)" <regexp> "ab" over match
+
+! clear "^a" <regexp> "a" over match
+! clear "^a" <regexp> "\na" over match
+! clear "^a" <regexp> "\r\na" over match
+! clear "^a" <regexp> "\ra" over match
+
+! clear "a$" <regexp> "a" over match
+! clear "a$" <regexp> "a\n" over match
+! clear "a$" <regexp> "a\r" over match
+! clear "a$" <regexp> "a\r\n" over match
diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor
index c4ab2675d2..debf94ef33 100644
--- a/basis/regexp/regexp.factor
+++ b/basis/regexp/regexp.factor
@@ -128,6 +128,8 @@ IN: regexp
: option? ( option regexp -- ? )
options>> key? ;
+USE: multiline
+/*
M: regexp pprint*
[
[
@@ -136,3 +138,4 @@ M: regexp pprint*
case-insensitive swap option? [ "i" % ] when
] "" make
] keep present-text ;
+*/
diff --git a/basis/regexp/traversal/traversal.factor b/basis/regexp/traversal/traversal.factor
index 6f41b16d95..d4b43c37f0 100644
--- a/basis/regexp/traversal/traversal.factor
+++ b/basis/regexp/traversal/traversal.factor
@@ -8,9 +8,11 @@ IN: regexp.traversal
TUPLE: dfa-traverser
dfa-table
traversal-flags
+ traverse-forward
capture-groups
{ capture-group-index integer }
lookahead-counters
+ lookbehind-counters
last-state current-state
text
start-index current-index
@@ -23,10 +25,12 @@ TUPLE: dfa-traverser
swap [ start-state>> >>current-state ] keep
>>dfa-table
swap >>text
+ t >>traverse-forward
0 >>start-index
0 >>current-index
V{ } clone >>matches
V{ } clone >>capture-groups
+ V{ } clone >>lookbehind-counters
V{ } clone >>lookahead-counters ;
: final-state? ( dfa-traverser -- ? )
@@ -52,8 +56,19 @@ M: lookahead-on flag-action ( dfa-traverser flag -- )
M: lookahead-off flag-action ( dfa-traverser flag -- )
drop
- dup lookahead-counters>> pop
- '[ _ - ] change-current-index drop ;
+ dup lookahead-counters>>
+ [ drop ] [ pop '[ _ - ] change-current-index drop ] if-empty ;
+
+M: lookbehind-on flag-action ( dfa-traverser flag -- )
+ drop
+ f >>traverse-forward
+ lookbehind-counters>> 0 swap push ;
+
+M: lookbehind-off flag-action ( dfa-traverser flag -- )
+ drop
+ t >>traverse-forward
+ dup lookbehind-counters>>
+ [ drop ] [ pop '[ _ + ] change-current-index drop ] if-empty ;
: process-flags ( dfa-traverser -- )
[ [ 1+ ] map ] change-lookahead-counters
@@ -62,7 +77,10 @@ M: lookahead-off flag-action ( dfa-traverser flag -- )
: increment-state ( dfa-traverser state -- dfa-traverser )
[
- [ 1+ ] change-current-index dup current-state>> >>last-state
+ dup traverse-forward>>
+ [ [ 1+ ] change-current-index ]
+ [ [ 1- ] change-current-index ] if
+ dup current-state>> >>last-state
] dip
first >>current-state ;
From 864f9ead993e909da0256f05acf825fab476bfea Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 22 Sep 2008 14:55:17 -0500
Subject: [PATCH 43/87] fix negative lookbehind
---
basis/regexp/dfa/dfa.factor | 2 +-
basis/regexp/regexp-tests.factor | 7 +++++++
basis/regexp/traversal/traversal.factor | 14 ++++++++++----
3 files changed, 18 insertions(+), 5 deletions(-)
diff --git a/basis/regexp/dfa/dfa.factor b/basis/regexp/dfa/dfa.factor
index cd6dab6a06..ef985258fd 100644
--- a/basis/regexp/dfa/dfa.factor
+++ b/basis/regexp/dfa/dfa.factor
@@ -25,7 +25,7 @@ IN: regexp.dfa
: find-transitions ( seq1 regexp -- seq2 )
nfa-table>> transitions>>
- [ at keys ] curry map concat
+ [ at keys ] curry gather
eps swap remove ;
: add-todo-state ( state regexp -- )
diff --git a/basis/regexp/regexp-tests.factor b/basis/regexp/regexp-tests.factor
index 4d25a58c39..be19c065f5 100644
--- a/basis/regexp/regexp-tests.factor
+++ b/basis/regexp/regexp-tests.factor
@@ -299,3 +299,10 @@ IN: regexp-tests
! clear "a$" <regexp> "a\n" over match
! clear "a$" <regexp> "a\r" over match
! clear "a$" <regexp> "a\r\n" over match
+
+! "(az)(?<=b)" <regexp> "baz" over first-match
+! "a(?<=b*)" <regexp> "cbaz" over first-match
+! "a(?<=b)" <regexp> "baz" over first-match
+
+! "a(?<!b)" <regexp> "baz" over first-match
+! "a(?<!b)" <regexp> "caz" over first-match
diff --git a/basis/regexp/traversal/traversal.factor b/basis/regexp/traversal/traversal.factor
index d4b43c37f0..d82e9941a2 100644
--- a/basis/regexp/traversal/traversal.factor
+++ b/basis/regexp/traversal/traversal.factor
@@ -38,7 +38,11 @@ TUPLE: dfa-traverser
key? ;
: text-finished? ( dfa-traverser -- ? )
- [ current-index>> ] [ text>> length ] bi >= ;
+ {
+ [ current-state>> empty? ]
+ [ [ current-index>> ] [ text>> length ] bi >= ]
+ ! [ current-index>> 0 < ]
+ } 1|| ;
: save-final-state ( dfa-straverser -- )
[ current-index>> ] [ matches>> ] bi push ;
@@ -62,24 +66,26 @@ M: lookahead-off flag-action ( dfa-traverser flag -- )
M: lookbehind-on flag-action ( dfa-traverser flag -- )
drop
f >>traverse-forward
+ [ 2 - ] change-current-index
lookbehind-counters>> 0 swap push ;
M: lookbehind-off flag-action ( dfa-traverser flag -- )
drop
t >>traverse-forward
dup lookbehind-counters>>
- [ drop ] [ pop '[ _ + ] change-current-index drop ] if-empty ;
+ [ drop ] [ pop '[ _ + 2 + ] change-current-index drop ] if-empty ;
: process-flags ( dfa-traverser -- )
[ [ 1+ ] map ] change-lookahead-counters
+ [ [ 1+ ] map ] change-lookbehind-counters
+ ! dup current-state>> .
dup [ current-state>> ] [ traversal-flags>> ] bi
at [ dup . flag-action ] with each ;
: increment-state ( dfa-traverser state -- dfa-traverser )
[
dup traverse-forward>>
- [ [ 1+ ] change-current-index ]
- [ [ 1- ] change-current-index ] if
+ [ 1+ ] [ 1- ] ? change-current-index
dup current-state>> >>last-state
] dip
first >>current-state ;
From 001b7826bc62aa0a183d382821d42f0789f7d8e4 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 22 Sep 2008 15:14:45 -0500
Subject: [PATCH 44/87] add more advanced lookaround tests
---
basis/regexp/regexp-tests.factor | 16 ++++++++++++++++
1 file changed, 16 insertions(+)
diff --git a/basis/regexp/regexp-tests.factor b/basis/regexp/regexp-tests.factor
index be19c065f5..934b635e50 100644
--- a/basis/regexp/regexp-tests.factor
+++ b/basis/regexp/regexp-tests.factor
@@ -306,3 +306,19 @@ IN: regexp-tests
! "a(?<!b)" <regexp> "baz" over first-match
! "a(?<!b)" <regexp> "caz" over first-match
+
+! "a(?=bcdefg)bcd" <regexp> "abcdefg" over first-match
+! "a(?#bcdefg)bcd" <regexp> "abcdefg" over first-match
+! "a(?:bcdefg)" <regexp> "abcdefg" over first-match
+
+[ { 0 1 } ] [ "ac" "a(?!b)" <regexp> first-match ] unit-test
+[ f ] [ "ab" "a(?!b)" <regexp> first-match ] unit-test
+
+! "a(?<=b)" <regexp> "caba" over first-match
+
+[ { 0 1 } ] [ "ab" "a(?=b)(?=b)" <regexp> first-match ] unit-test
+[ { 1 2 } ] [ "ba" "a(?<=b)(?<=b)" <regexp> first-match ] unit-test
+
+
+[ { 1 2 } ] [ "cab" "a(?=b)(?<=c)" <regexp> first-match ] unit-test
+
From 78008e99048fdf51f545368419166a02c8ff1355 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 22 Sep 2008 16:09:10 -0500
Subject: [PATCH 45/87] Better connection logging
---
basis/io/servers/connection/connection.factor | 14 ++++++++++----
basis/io/sockets/secure/secure.factor | 4 +++-
basis/io/sockets/sockets.factor | 17 ++++++++++++-----
3 files changed, 25 insertions(+), 10 deletions(-)
diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor
index 7d72659f6d..1b8707fc8c 100755
--- a/basis/io/servers/connection/connection.factor
+++ b/basis/io/servers/connection/connection.factor
@@ -2,10 +2,10 @@
! See http://factorcode.org/license.txt for BSD license.
USING: continuations destructors kernel math math.parser
namespaces parser sequences strings prettyprint debugger
-quotations combinators logging calendar assocs
+quotations combinators logging calendar assocs present
fry accessors arrays io io.sockets io.encodings.ascii
io.sockets.secure io.files io.streams.duplex io.timeouts
-io.encodings threads concurrency.combinators
+io.encodings threads make concurrency.combinators
concurrency.semaphores concurrency.flags
combinators.short-circuit ;
IN: io.servers.connection
@@ -56,11 +56,17 @@ GENERIC: handle-client* ( threaded-server -- )
[ secure>> >secure ] [ insecure>> >insecure ] bi
[ resolve-host ] bi@ append ;
-LOG: accepted-connection NOTICE
+: accepted-connection ( remote local -- )
+ [
+ [ "remote: " % present % ", " % ]
+ [ "local: " % present % ]
+ bi*
+ ] "" make
+ \ accepted-connection NOTICE log-message ;
: log-connection ( remote local -- )
+ [ accepted-connection ]
[ [ remote-address set ] [ local-address set ] bi* ]
- [ 2array accepted-connection ]
2bi ;
M: threaded-server handle-client* handler>> call ;
diff --git a/basis/io/sockets/secure/secure.factor b/basis/io/sockets/secure/secure.factor
index 3e516dff8b..42ca727653 100755
--- a/basis/io/sockets/secure/secure.factor
+++ b/basis/io/sockets/secure/secure.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel symbols namespaces continuations
destructors io.sockets sequences summary calendar delegate
-system vocabs.loader combinators ;
+system vocabs.loader combinators present ;
IN: io.sockets.secure
SYMBOL: secure-socket-timeout
@@ -43,6 +43,8 @@ TUPLE: secure addrspec ;
C: <secure> secure
+M: secure present addrspec>> present " (secure)" append ;
+
CONSULT: inet secure addrspec>> ;
M: secure resolve-host ( secure -- seq )
diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor
index 8c9f26b1dd..9bfcc7e310 100755
--- a/basis/io/sockets/sockets.factor
+++ b/basis/io/sockets/sockets.factor
@@ -5,8 +5,8 @@ USING: generic kernel io.backend namespaces continuations
sequences arrays io.encodings io.ports io.streams.duplex
io.encodings.ascii alien.strings io.binary accessors destructors
classes debugger byte-arrays system combinators parser
-alien.c-types math.parser splitting grouping
-math assocs summary system vocabs.loader combinators ;
+alien.c-types math.parser splitting grouping math assocs summary
+system vocabs.loader combinators present ;
IN: io.sockets
<< {
@@ -40,7 +40,14 @@ TUPLE: local path ;
: <local> ( path -- addrspec )
normalize-path local boa ;
-TUPLE: inet4 host port ;
+M: local present path>> "Unix domain socket: " prepend ;
+
+TUPLE: abstract-inet host port ;
+
+M: abstract-inet present
+ [ host>> ":" ] [ port>> number>string ] bi 3append ;
+
+TUPLE: inet4 < abstract-inet ;
C: <inet4> inet4
@@ -81,7 +88,7 @@ M: inet4 parse-sockaddr
>r dup sockaddr-in-addr <uint> r> inet-ntop
swap sockaddr-in-port ntohs <inet4> ;
-TUPLE: inet6 host port ;
+TUPLE: inet6 < abstract-inet ;
C: <inet6> inet6
@@ -255,7 +262,7 @@ HOOK: addrinfo-error io-backend ( n -- )
GENERIC: resolve-host ( addrspec -- seq )
-TUPLE: inet host port ;
+TUPLE: inet < abstract-inet ;
C: <inet> inet
From 55b450f3711dd1f4de412783b9e9217293cec2d2 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 22 Sep 2008 16:09:20 -0500
Subject: [PATCH 46/87] Log user in after registration
---
basis/furnace/auth/auth.factor | 6 +++++-
.../furnace/auth/features/registration/registration.factor | 3 +--
basis/furnace/auth/login/login.factor | 3 +++
3 files changed, 9 insertions(+), 3 deletions(-)
diff --git a/basis/furnace/auth/auth.factor b/basis/furnace/auth/auth.factor
index 8e18c18df9..1b5c5f9e73 100755
--- a/basis/furnace/auth/auth.factor
+++ b/basis/furnace/auth/auth.factor
@@ -3,7 +3,7 @@
USING: accessors assocs namespaces kernel sequences sets
destructors combinators fry logging
io.encodings.utf8 io.encodings.string io.binary random
-checksums checksums.sha2
+checksums checksums.sha2 urls
html.forms
http.server
http.server.filters
@@ -60,6 +60,10 @@ TUPLE: realm < dispatcher name users checksum secure ;
GENERIC: login-required* ( description capabilities realm -- response )
+GENERIC: user-registered ( user realm -- response )
+
+M: object user-registered 2drop URL" $realm" <redirect> ;
+
GENERIC: init-realm ( realm -- )
GENERIC: logged-in-username ( realm -- username )
diff --git a/basis/furnace/auth/features/registration/registration.factor b/basis/furnace/auth/features/registration/registration.factor
index da58e2b2ed..ef8923c98b 100644
--- a/basis/furnace/auth/features/registration/registration.factor
+++ b/basis/furnace/auth/features/registration/registration.factor
@@ -33,8 +33,7 @@ IN: furnace.auth.features.registration
users new-user [ user-exists ] unless*
realm get init-user-profile
-
- URL" $realm" <redirect>
+ realm get user-registered
] >>submit
<auth-boilerplate>
<secure-realm-only> ;
diff --git a/basis/furnace/auth/login/login.factor b/basis/furnace/auth/login/login.factor
index 232e217305..2c98672490 100755
--- a/basis/furnace/auth/login/login.factor
+++ b/basis/furnace/auth/login/login.factor
@@ -104,6 +104,9 @@ M: login-realm login-required* ( description capabilities login -- response )
URL" $realm/login" <continue-conversation>
] if ;
+M: login-realm user-registered ( user realm -- )
+ drop successful-login ;
+
: <login-realm> ( responder name -- auth )
login-realm new-realm
<login-action> "login" add-responder
From 6d60b5a74f497785eea935a4b1e034322e14f5a8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 22 Sep 2008 16:49:50 -0500
Subject: [PATCH 47/87] Implement port remapping
---
basis/furnace/redirection/redirection.factor | 9 ++++-----
basis/http/server/remapping/remapping.factor | 12 ++++++++++++
basis/http/server/server.factor | 3 ++-
3 files changed, 18 insertions(+), 6 deletions(-)
create mode 100644 basis/http/server/remapping/remapping.factor
diff --git a/basis/furnace/redirection/redirection.factor b/basis/furnace/redirection/redirection.factor
index 113319d83b..c5a63a795c 100644
--- a/basis/furnace/redirection/redirection.factor
+++ b/basis/furnace/redirection/redirection.factor
@@ -1,9 +1,8 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors combinators namespaces fry
-io.servers.connection urls http http.server
-http.server.redirection http.server.responses
-http.server.filters furnace ;
+USING: kernel accessors combinators namespaces fry urls http
+http.server http.server.redirection http.server.responses
+http.server.remapping http.server.filters furnace ;
IN: furnace.redirection
: <redirect> ( url -- response )
@@ -16,7 +15,7 @@ IN: furnace.redirection
: >secure-url ( url -- url' )
clone
"https" >>protocol
- secure-port >>port ;
+ secure-http-port >>port ;
: <secure-redirect> ( url -- response )
>secure-url <redirect> ;
diff --git a/basis/http/server/remapping/remapping.factor b/basis/http/server/remapping/remapping.factor
new file mode 100644
index 0000000000..36e769731b
--- /dev/null
+++ b/basis/http/server/remapping/remapping.factor
@@ -0,0 +1,12 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: namespaces assocs kernel io.servers.connection ;
+IN: http.server.remapping
+
+SYMBOL: port-remapping
+
+: remap-port ( n -- n' )
+ [ port-remapping get at ] keep or ;
+
+: secure-http-port ( -- n )
+ secure-port remap-port ;
diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor
index bad1eb4831..64331cfd21 100755
--- a/basis/http/server/server.factor
+++ b/basis/http/server/server.factor
@@ -18,6 +18,7 @@ fry logging logging.insomniac calendar urls
http
http.parsers
http.server.responses
+http.server.remapping
html.templates
html.elements
html.streams ;
@@ -188,7 +189,7 @@ LOG: httpd-header NOTICE
"/" split harvest ;
: init-request ( request -- )
- [ request set ] [ url>> url set ] bi
+ [ request set ] [ url>> [ remap-port ] change-port url set ] bi
V{ } clone responder-nesting set ;
: dispatch-request ( request -- response )
From 7a83d2798cb2aa32550bbcbf699d37ae96cfdbc6 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 22 Sep 2008 16:54:34 -0500
Subject: [PATCH 48/87] Messing with port remapping
---
basis/http/server/server.factor | 9 +++++----
1 file changed, 5 insertions(+), 4 deletions(-)
diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor
index 64331cfd21..3acae8d927 100755
--- a/basis/http/server/server.factor
+++ b/basis/http/server/server.factor
@@ -189,7 +189,7 @@ LOG: httpd-header NOTICE
"/" split harvest ;
: init-request ( request -- )
- [ request set ] [ url>> [ remap-port ] change-port url set ] bi
+ [ request set ] [ url>> url set ] bi
V{ } clone responder-nesting set ;
: dispatch-request ( request -- response )
@@ -199,19 +199,20 @@ LOG: httpd-header NOTICE
[
local-address get
[ secure? "https" "http" ? >>protocol ]
- [ port>> '[ _ or ] change-port ]
+ [ port>> remap-port '[ _ or ] change-port ]
bi
] change-url drop ;
: valid-request? ( request -- ? )
- url>> port>> local-address get port>> = ;
+ url>> port>> remap-port
+ local-address get port>> remap-port = ;
: do-request ( request -- response )
'[
_
{
- [ init-request ]
[ prepare-request ]
+ [ init-request ]
[ log-request ]
[ dup valid-request? [ dispatch-request ] [ drop <400> ] if ]
} cleave
From bbdc84312284873d5dc4e3cdb4cd6292f1981a33 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 22 Sep 2008 17:01:41 -0500
Subject: [PATCH 49/87] Forgot to remap port
---
basis/furnace/furnace.factor | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/basis/furnace/furnace.factor b/basis/furnace/furnace.factor
index 4f0189e3f4..efd730c26c 100644
--- a/basis/furnace/furnace.factor
+++ b/basis/furnace/furnace.factor
@@ -4,7 +4,7 @@ USING: namespaces make assocs sequences kernel classes splitting
vocabs.loader accessors strings combinators arrays
continuations present fry
urls html.elements
-http http.server http.server.redirection ;
+http http.server http.server.redirection http.server.remapping ;
IN: furnace
: nested-responders ( -- seq )
@@ -91,7 +91,8 @@ M: object modify-form drop ;
: referrer ( -- referrer )
#! Typo is intentional, its in the HTTP spec!
- "referer" request get header>> at >url ;
+ "referer" request get header>> at
+ >url [ remap-port ] change-port ;
: user-agent ( -- user-agent )
"user-agent" request get header>> at "" or ;
From 977dd43d465f41a720c0ebebfb0e1174966176a7 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 22 Sep 2008 17:06:31 -0500
Subject: [PATCH 50/87] One last fix
---
basis/furnace/furnace.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/furnace/furnace.factor b/basis/furnace/furnace.factor
index efd730c26c..34d2beb717 100644
--- a/basis/furnace/furnace.factor
+++ b/basis/furnace/furnace.factor
@@ -92,7 +92,7 @@ M: object modify-form drop ;
: referrer ( -- referrer )
#! Typo is intentional, its in the HTTP spec!
"referer" request get header>> at
- >url [ remap-port ] change-port ;
+ >url ensure-port [ remap-port ] change-port ;
: user-agent ( -- user-agent )
"user-agent" request get header>> at "" or ;
From 18a44674f2b30b1ff64374e3fbf3cb750578086d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 22 Sep 2008 17:15:59 -0500
Subject: [PATCH 51/87] More referrer fixes
---
basis/furnace/furnace-tests.factor | 10 ++++++++--
basis/furnace/furnace.factor | 10 ++++++----
basis/furnace/referrer/referrer.factor | 2 +-
basis/urls/urls.factor | 4 +---
4 files changed, 16 insertions(+), 10 deletions(-)
diff --git a/basis/furnace/furnace-tests.factor b/basis/furnace/furnace-tests.factor
index 223b20455d..00e4f6f152 100644
--- a/basis/furnace/furnace-tests.factor
+++ b/basis/furnace/furnace-tests.factor
@@ -1,7 +1,7 @@
IN: furnace.tests
-USING: http.server.dispatchers http.server.responses
+USING: http http.server.dispatchers http.server.responses
http.server furnace tools.test kernel namespaces accessors
-io.streams.string ;
+io.streams.string urls ;
TUPLE: funny-dispatcher < dispatcher ;
: <funny-dispatcher> funny-dispatcher new-dispatcher ;
@@ -33,3 +33,9 @@ M: base-path-check-responder call-responder*
[ "<input type='hidden' name='foo' value='&&&'/>" ]
[ [ "&&&" "foo" hidden-form-field ] with-string-writer ]
unit-test
+
+[ f ] [ <request> request [ referrer ] with-variable ] unit-test
+
+[ t ] [ URL" http://foo" dup url [ same-host? ] with-variable ] unit-test
+
+[ f ] [ f URL" http://foo" url [ same-host? ] with-variable ] unit-test
diff --git a/basis/furnace/furnace.factor b/basis/furnace/furnace.factor
index 34d2beb717..376da79ef2 100644
--- a/basis/furnace/furnace.factor
+++ b/basis/furnace/furnace.factor
@@ -89,17 +89,19 @@ M: object modify-form drop ;
] }
} case ;
-: referrer ( -- referrer )
+: referrer ( -- referrer/f )
#! Typo is intentional, its in the HTTP spec!
"referer" request get header>> at
- >url ensure-port [ remap-port ] change-port ;
+ dup [ >url ensure-port [ remap-port ] change-port ] when ;
: user-agent ( -- user-agent )
"user-agent" request get header>> at "" or ;
: same-host? ( url -- ? )
- url get
- [ [ protocol>> ] [ host>> ] [ port>> ] tri 3array ] bi@ = ;
+ dup [
+ url get
+ [ [ protocol>> ] [ host>> ] [ port>> ] tri 3array ] bi@ =
+ ] when ;
: cookie-client-state ( key request -- value/f )
swap get-cookie dup [ value>> ] when ;
diff --git a/basis/furnace/referrer/referrer.factor b/basis/furnace/referrer/referrer.factor
index 4cfd4bb6c6..b7a3df4b53 100644
--- a/basis/furnace/referrer/referrer.factor
+++ b/basis/furnace/referrer/referrer.factor
@@ -14,4 +14,4 @@ M: referrer-check call-responder*
[ 2drop 403 "Bad referrer" <trivial-response> ] if ;
: <check-form-submissions> ( responder -- responder' )
- [ same-host? post-request? not or ] <referrer-check> ;
+ [ post-request? [ same-host? ] [ drop f ] if ] <referrer-check> ;
diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor
index f4a6a7d792..488e0a121c 100644
--- a/basis/urls/urls.factor
+++ b/basis/urls/urls.factor
@@ -212,15 +212,13 @@ PRIVATE>
[ [ host>> ] [ port>> ] bi <inet> ] [ protocol>> ] bi
secure-protocol? [ <secure> ] when ;
-ERROR: no-protocol-found protocol ;
-
: protocol-port ( protocol -- port )
{
{ "http" [ 80 ] }
{ "https" [ 443 ] }
{ "feed" [ 80 ] }
{ "ftp" [ 21 ] }
- [ no-protocol-found ]
+ [ drop f ]
} case ;
: ensure-port ( url -- url' )
From 436e66513752192ff5f5d9ce0cf2e2fa11fe4cee Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 22 Sep 2008 20:05:06 -0500
Subject: [PATCH 52/87] add orderd lists to farkup
---
basis/farkup/farkup-tests.factor | 8 ++++++++
basis/farkup/farkup.factor | 29 +++++++++++++++++++++--------
2 files changed, 29 insertions(+), 8 deletions(-)
diff --git a/basis/farkup/farkup-tests.factor b/basis/farkup/farkup-tests.factor
index 571d333359..1a0ab23af5 100644
--- a/basis/farkup/farkup-tests.factor
+++ b/basis/farkup/farkup-tests.factor
@@ -35,6 +35,14 @@ link-no-follow? off
[ "<ul><li>foo</li>\n</ul><p>bar\n</p>" ] [ "-foo\nbar\n" convert-farkup ] unit-test
+[ "<ol><li>a-b</li></ol>" ] [ "#a-b" convert-farkup ] unit-test
+[ "<ol><li>foo</li></ol>" ] [ "#foo" convert-farkup ] unit-test
+[ "<ol><li>foo</li>\n</ol>" ] [ "#foo\n" convert-farkup ] unit-test
+[ "<ol><li>foo</li>\n<li>bar</li></ol>" ] [ "#foo\n#bar" convert-farkup ] unit-test
+[ "<ol><li>foo</li>\n<li>bar</li>\n</ol>" ] [ "#foo\n#bar\n" convert-farkup ] unit-test
+
+[ "<ol><li>foo</li>\n</ol><p>bar\n</p>" ] [ "#foo\nbar\n" convert-farkup ] unit-test
+
[ "\n\n" ] [ "\n\n" convert-farkup ] unit-test
[ "\n\n" ] [ "\r\n\r\n" convert-farkup ] unit-test
diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor
index cc56f48949..acd52f3cf8 100644
--- a/basis/farkup/farkup.factor
+++ b/basis/farkup/farkup.factor
@@ -20,8 +20,10 @@ TUPLE: superscript child ;
TUPLE: subscript child ;
TUPLE: inline-code child ;
TUPLE: paragraph child ;
-TUPLE: list-item child ;
-TUPLE: list child ;
+TUPLE: unordered-list-item child ;
+TUPLE: unordered-list child ;
+TUPLE: ordered-list-item child ;
+TUPLE: ordered-list child ;
TUPLE: table child ;
TUPLE: table-row child ;
TUPLE: link href text ;
@@ -108,10 +110,19 @@ paragraph = ((paragraph-item nl => [[ first ]])+ nl+ => [[ first ]]
| paragraph-item)
=> [[ paragraph boa ]]
-list-item = '-' (cell | inline-tag)*
- => [[ second list-item boa ]]
-list = ((list-item nl)+ list-item? | list-item)
- => [[ list boa ]]
+list-item = (cell | inline-tag)*
+
+ordered-list-item = '#' list-item
+ => [[ second ordered-list-item boa ]]
+ordered-list = ((ordered-list-item nl)+ ordered-list-item? | ordered-list-item)
+ => [[ ordered-list boa ]]
+
+unordered-list-item = '-' list-item
+ => [[ second unordered-list-item boa ]]
+unordered-list = ((unordered-list-item nl)+ unordered-list-item? | unordered-list-item)
+ => [[ unordered-list boa ]]
+
+list = ordered-list | unordered-list
code = '[' (!('{' | nl | '[').)+ '{' (!("}]").)+ "}]"
=> [[ [ second >string ] [ fourth >string ] bi code boa ]]
@@ -176,8 +187,10 @@ 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: unordered-list-item (write-farkup) [ child>> (write-farkup) ] "li" in-tag. ;
+M: unordered-list (write-farkup) [ child>> (write-farkup) ] "ul" in-tag. ;
+M: ordered-list-item (write-farkup) [ child>> (write-farkup) ] "li" in-tag. ;
+M: ordered-list (write-farkup) [ child>> (write-farkup) ] "ol" 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 ;
From c252060bb5f7b765e4c85d5f7a73577c3665821e Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 22 Sep 2008 20:09:42 -0500
Subject: [PATCH 53/87] first stab at capture groups. they work for
unambiguous groups (no overlap), working on fixing it for any case
---
basis/regexp/nfa/nfa.factor | 7 +++++-
basis/regexp/regexp-tests.factor | 14 +++++++++--
basis/regexp/regexp.factor | 3 +++
basis/regexp/traversal/traversal.factor | 32 +++++++++++++++++++++----
4 files changed, 48 insertions(+), 8 deletions(-)
diff --git a/basis/regexp/nfa/nfa.factor b/basis/regexp/nfa/nfa.factor
index aebfea04e1..72d0fe970b 100644
--- a/basis/regexp/nfa/nfa.factor
+++ b/basis/regexp/nfa/nfa.factor
@@ -121,7 +121,12 @@ M: character-class-range nfa-node ( node -- )
class-transition add-simple-entry ;
M: capture-group nfa-node ( node -- )
- term>> nfa-node ;
+ eps literal-transition add-simple-entry
+ capture-group-on add-traversal-flag
+ term>> nfa-node
+ eps literal-transition add-simple-entry
+ capture-group-off add-traversal-flag
+ 2 [ concatenate-nodes ] times ;
! xyzzy
M: non-capture-group nfa-node ( node -- )
diff --git a/basis/regexp/regexp-tests.factor b/basis/regexp/regexp-tests.factor
index 934b635e50..46696c8c0f 100644
--- a/basis/regexp/regexp-tests.factor
+++ b/basis/regexp/regexp-tests.factor
@@ -318,7 +318,17 @@ IN: regexp-tests
[ { 0 1 } ] [ "ab" "a(?=b)(?=b)" <regexp> first-match ] unit-test
[ { 1 2 } ] [ "ba" "a(?<=b)(?<=b)" <regexp> first-match ] unit-test
-
-
[ { 1 2 } ] [ "cab" "a(?=b)(?<=c)" <regexp> first-match ] unit-test
+! capture group 1: "aaaa" 2: ""
+! "aaaa" "(a*)(a*)" <regexp> match*
+! "aaaa" "(a*)(a+)" <regexp> match*
+
+[ { 0 2 } ] [ "ab" "(a|ab)(bc)?" <regexp> first-match ] unit-test
+[ { 0 3 } ] [ "abc" "(a|ab)(bc)?" <regexp> first-match ] unit-test
+
+[ { 0 2 } ] [ "ab" "(ab|a)(bc)?" <regexp> first-match ] unit-test
+[ { 0 3 } ] [ "abc" "(ab|a)(bc)?" <regexp> first-match ] unit-test
+
+[ { 23 24 } ] [ "aaaaaaaaaaaaaaaaaaaaaaab" "((a*)*b)*b" <regexp> first-match ] unit-test
+
diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor
index debf94ef33..73555fe953 100644
--- a/basis/regexp/regexp.factor
+++ b/basis/regexp/regexp.factor
@@ -28,6 +28,9 @@ IN: regexp
: match ( string regexp -- pair )
<dfa-traverser> do-match return-match ;
+: match* ( string regexp -- pair )
+ <dfa-traverser> do-match [ return-match ] [ captured-groups>> ] bi ;
+
: matches? ( string regexp -- ? )
dupd match
[ [ length ] [ length>> 1- ] bi* = ] [ drop f ] if* ;
diff --git a/basis/regexp/traversal/traversal.factor b/basis/regexp/traversal/traversal.factor
index d82e9941a2..f5a235fa7f 100644
--- a/basis/regexp/traversal/traversal.factor
+++ b/basis/regexp/traversal/traversal.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs combinators kernel math math.ranges
-quotations sequences regexp.parser regexp.classes fry
+quotations sequences regexp.parser regexp.classes fry arrays
combinators.short-circuit regexp.utils prettyprint regexp.nfa ;
IN: regexp.traversal
@@ -9,10 +9,11 @@ TUPLE: dfa-traverser
dfa-table
traversal-flags
traverse-forward
- capture-groups
- { capture-group-index integer }
lookahead-counters
lookbehind-counters
+ capture-counters
+ captured-groups
+ capture-group-index
last-state current-state
text
start-index current-index
@@ -28,10 +29,12 @@ TUPLE: dfa-traverser
t >>traverse-forward
0 >>start-index
0 >>current-index
+ 0 >>capture-group-index
V{ } clone >>matches
- V{ } clone >>capture-groups
+ V{ } clone >>capture-counters
V{ } clone >>lookbehind-counters
- V{ } clone >>lookahead-counters ;
+ V{ } clone >>lookahead-counters
+ H{ } clone >>captured-groups ;
: final-state? ( dfa-traverser -- ? )
[ current-state>> ] [ dfa-table>> final-states>> ] bi
@@ -75,9 +78,28 @@ M: lookbehind-off flag-action ( dfa-traverser flag -- )
dup lookbehind-counters>>
[ drop ] [ pop '[ _ + 2 + ] change-current-index drop ] if-empty ;
+M: capture-group-on flag-action ( dfa-traverser flag -- )
+ drop
+ [ current-index>> 0 2array ]
+ [ capture-counters>> ] bi push ;
+
+M: capture-group-off flag-action ( dfa-traverser flag -- )
+ drop
+ dup capture-counters>> empty? [
+ drop
+ ] [
+ {
+ [ capture-counters>> pop first2 dupd + ]
+ [ text>> <slice> ]
+ [ [ 1+ ] change-capture-group-index capture-group-index>> ]
+ [ captured-groups>> set-at ]
+ } cleave
+ ] if ;
+
: process-flags ( dfa-traverser -- )
[ [ 1+ ] map ] change-lookahead-counters
[ [ 1+ ] map ] change-lookbehind-counters
+ [ [ first2 1+ 2array ] map ] change-capture-counters
! dup current-state>> .
dup [ current-state>> ] [ traversal-flags>> ] bi
at [ dup . flag-action ] with each ;
From 7e983e5ee07f0409d28e68f3ebf05461cc1df6da Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 22 Sep 2008 20:13:24 -0500
Subject: [PATCH 54/87] remove code duplication
---
basis/farkup/farkup.factor | 10 ++++------
1 file changed, 4 insertions(+), 6 deletions(-)
diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor
index acd52f3cf8..d3c982ebf2 100644
--- a/basis/farkup/farkup.factor
+++ b/basis/farkup/farkup.factor
@@ -20,9 +20,8 @@ TUPLE: superscript child ;
TUPLE: subscript child ;
TUPLE: inline-code child ;
TUPLE: paragraph child ;
-TUPLE: unordered-list-item child ;
+TUPLE: list-item child ;
TUPLE: unordered-list child ;
-TUPLE: ordered-list-item child ;
TUPLE: ordered-list child ;
TUPLE: table child ;
TUPLE: table-row child ;
@@ -113,12 +112,12 @@ paragraph = ((paragraph-item nl => [[ first ]])+ nl+ => [[ first ]]
list-item = (cell | inline-tag)*
ordered-list-item = '#' list-item
- => [[ second ordered-list-item boa ]]
+ => [[ second list-item boa ]]
ordered-list = ((ordered-list-item nl)+ ordered-list-item? | ordered-list-item)
=> [[ ordered-list boa ]]
unordered-list-item = '-' list-item
- => [[ second unordered-list-item boa ]]
+ => [[ second list-item boa ]]
unordered-list = ((unordered-list-item nl)+ unordered-list-item? | unordered-list-item)
=> [[ unordered-list boa ]]
@@ -187,9 +186,8 @@ 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: unordered-list-item (write-farkup) [ child>> (write-farkup) ] "li" in-tag. ;
+M: list-item (write-farkup) [ child>> (write-farkup) ] "li" in-tag. ;
M: unordered-list (write-farkup) [ child>> (write-farkup) ] "ul" in-tag. ;
-M: ordered-list-item (write-farkup) [ child>> (write-farkup) ] "li" in-tag. ;
M: ordered-list (write-farkup) [ child>> (write-farkup) ] "ol" in-tag. ;
M: paragraph (write-farkup) [ child>> (write-farkup) ] "p" in-tag. ;
M: link (write-farkup) [ href>> ] [ text>> ] bi write-link ;
From 3ad286dc0971469f2d1e3cae1eec628bf57f8668 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 22 Sep 2008 20:20:39 -0500
Subject: [PATCH 55/87] lists in paragraphs
---
basis/farkup/farkup-tests.factor | 4 ++++
basis/farkup/farkup.factor | 2 +-
2 files changed, 5 insertions(+), 1 deletion(-)
diff --git a/basis/farkup/farkup-tests.factor b/basis/farkup/farkup-tests.factor
index 1a0ab23af5..5237774b04 100644
--- a/basis/farkup/farkup-tests.factor
+++ b/basis/farkup/farkup-tests.factor
@@ -128,3 +128,7 @@ link-no-follow? off
[ "<p><a href='C%2b%2b'>C++</a></p>" ] [ "[[C++]]" convert-farkup ] unit-test
[ "<p><foo></p>" ] [ "<foo>" convert-farkup ] unit-test
+
+[ "<p>asdf\n<ul><li>lol</li>\n<li>haha</li></ul></p>" ] [ "asdf\n-lol\n-haha" convert-farkup ] unit-test
+
+[ "<p>asdf</p><ul><li>lol</li>\n<li>haha</li></ul>" ] [ "asdf\n\n-lol\n-haha" convert-farkup ] unit-test
diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor
index d3c982ebf2..495e6d9b57 100644
--- a/basis/farkup/farkup.factor
+++ b/basis/farkup/farkup.factor
@@ -103,7 +103,7 @@ table = ((table-row nl => [[ first ]] )+ table-row? | table-row)
text = (!(nl | code | heading | inline-delimiter | table ).)+
=> [[ >string ]]
-paragraph-item = (table | text | inline-tag | inline-delimiter)+
+paragraph-item = (table | list | text | inline-tag | inline-delimiter)+
paragraph = ((paragraph-item nl => [[ first ]])+ nl+ => [[ first ]]
| (paragraph-item nl)+ paragraph-item?
| paragraph-item)
From 1c6e08b50c3c4540ea6cd833fe45707e401bc88f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 22 Sep 2008 20:20:57 -0500
Subject: [PATCH 56/87] farkup demo -- ordered lists
---
extra/webapps/wiki/initial-content/Farkup.txt | 8 +++++++-
1 file changed, 7 insertions(+), 1 deletion(-)
diff --git a/extra/webapps/wiki/initial-content/Farkup.txt b/extra/webapps/wiki/initial-content/Farkup.txt
index b8de408588..65f9defc5b 100644
--- a/extra/webapps/wiki/initial-content/Farkup.txt
+++ b/extra/webapps/wiki/initial-content/Farkup.txt
@@ -16,12 +16,18 @@ Images can be embedded in the text:
[[image:http://factorcode.org/graphics/logo.png]]
-Lists:
+Unordered lists:
- a list
- with three
- items
+Ordered lists:
+
+# a list
+# with three
+# numbered items
+
Tables:
|a table|with|four|columns|
From c689ef53d840ad801b5ca9084557ed0516f36fff Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 22 Sep 2008 21:31:15 -0500
Subject: [PATCH 57/87] Minor cleanup
---
extra/math/statistics/statistics.factor | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/extra/math/statistics/statistics.factor b/extra/math/statistics/statistics.factor
index f7295604cd..28cc05151b 100644
--- a/extra/math/statistics/statistics.factor
+++ b/extra/math/statistics/statistics.factor
@@ -4,21 +4,21 @@ IN: math.statistics
: mean ( seq -- n )
#! arithmetic mean, sum divided by length
- [ sum ] keep length / ;
+ [ sum ] [ length ] bi / ;
: geometric-mean ( seq -- n )
#! geometric mean, nth root of product
- [ product ] keep length swap nth-root ;
+ [ length ] [ product ] bi nth-root ;
: harmonic-mean ( seq -- n )
#! harmonic mean, reciprocal of sum of reciprocals.
#! positive reals only
- 0 [ recip + ] reduce recip ;
+ [ recip ] sigma recip ;
: median ( seq -- n )
#! middle number if odd, avg of two middle numbers if even
natural-sort dup length dup even? [
- 1- 2 / swap [ nth ] 2keep >r 1+ r> nth + 2 /
+ 1- 2 / swap [ nth ] [ >r 1+ r> nth ] 2bi + 2 /
] [
2 / swap nth
] if ;
From c2bcd893ef098c78b303d34ff51a43d2e459981f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 22 Sep 2008 21:34:10 -0500
Subject: [PATCH 58/87] fix farkup docs
---
basis/farkup/farkup-docs.factor | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/basis/farkup/farkup-docs.factor b/basis/farkup/farkup-docs.factor
index 6e7a5ddcb0..8e7270cc01 100644
--- a/basis/farkup/farkup-docs.factor
+++ b/basis/farkup/farkup-docs.factor
@@ -30,7 +30,8 @@ ARTICLE: "farkup-ast" "Farkup syntax tree nodes"
{ $subsection inline-code }
{ $subsection paragraph }
{ $subsection list-item }
-{ $subsection list }
+{ $subsection unordered-list }
+{ $subsection ordered-list }
{ $subsection table }
{ $subsection table-row }
{ $subsection link }
From 8abda5c6534bc5810bd29d4f96da70d6f269446f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 22 Sep 2008 23:45:16 -0500
Subject: [PATCH 59/87] Fix RSS feed links
---
extra/webapps/wiki/wiki.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/webapps/wiki/wiki.factor b/extra/webapps/wiki/wiki.factor
index 420d71d26b..16c51a876b 100644
--- a/extra/webapps/wiki/wiki.factor
+++ b/extra/webapps/wiki/wiki.factor
@@ -19,7 +19,7 @@ db.types db.tuples lcs farkup urls ;
IN: webapps.wiki
: wiki-url ( rest path -- url )
- [ "$wiki/" % % "/" % % ] "" make
+ [ "$wiki/" % % "/" % present % ] "" make
<url> swap >>path ;
: view-url ( title -- url ) "view" wiki-url ;
From cbee5b39c2128518b05b7b94392b11fed260cfee Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 23 Sep 2008 01:27:39 -0500
Subject: [PATCH 60/87] farkup: add horizontal lines as ___ (3 underlines)
---
basis/farkup/farkup-tests.factor | 3 +++
basis/farkup/farkup.factor | 7 ++++++-
2 files changed, 9 insertions(+), 1 deletion(-)
diff --git a/basis/farkup/farkup-tests.factor b/basis/farkup/farkup-tests.factor
index 5237774b04..42979007e8 100644
--- a/basis/farkup/farkup-tests.factor
+++ b/basis/farkup/farkup-tests.factor
@@ -132,3 +132,6 @@ link-no-follow? off
[ "<p>asdf\n<ul><li>lol</li>\n<li>haha</li></ul></p>" ] [ "asdf\n-lol\n-haha" convert-farkup ] unit-test
[ "<p>asdf</p><ul><li>lol</li>\n<li>haha</li></ul>" ] [ "asdf\n\n-lol\n-haha" convert-farkup ] unit-test
+
+[ "<hr/>" ] [ "___" convert-farkup ] unit-test
+[ "<hr/>\n" ] [ "___\n" convert-farkup ] unit-test
diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor
index 495e6d9b57..f482f8beaa 100644
--- a/basis/farkup/farkup.factor
+++ b/basis/farkup/farkup.factor
@@ -28,6 +28,7 @@ TUPLE: table-row child ;
TUPLE: link href text ;
TUPLE: image href text ;
TUPLE: code mode string ;
+TUPLE: line ;
: absolute-url? ( string -- ? )
{ "http://" "https://" "ftp://" } [ head? ] with contains? ;
@@ -123,6 +124,9 @@ unordered-list = ((unordered-list-item nl)+ unordered-list-item? | unordered-lis
list = ordered-list | unordered-list
+line = '___'
+ => [[ drop line new ]]
+
code = '[' (!('{' | nl | '[').)+ '{' (!("}]").)+ "}]"
=> [[ [ second >string ] [ fourth >string ] bi code boa ]]
@@ -131,7 +135,7 @@ simple-code
=> [[ second f swap code boa ]]
stand-alone
- = (code | simple-code | heading | list | table | paragraph | nl)*
+ = (line | code | simple-code | heading | list | table | paragraph | nl)*
;EBNF
@@ -193,6 +197,7 @@ 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: line (write-farkup) drop <hr/> ;
M: table-row (write-farkup) ( obj -- )
child>> [ [ [ (write-farkup) ] "td" in-tag. ] each ] "tr" in-tag. ;
M: table (write-farkup) [ child>> (write-farkup) ] "table" in-tag. ;
From 5037a841d952e828a71fcf8a5785190ffb6afc23 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 23 Sep 2008 01:50:34 -0500
Subject: [PATCH 61/87] <hr/>, it's what farkup craves
---
basis/html/elements/elements.factor | 1 +
1 file changed, 1 insertion(+)
diff --git a/basis/html/elements/elements.factor b/basis/html/elements/elements.factor
index ad75b58df3..ced2f700dc 100644
--- a/basis/html/elements/elements.factor
+++ b/basis/html/elements/elements.factor
@@ -149,6 +149,7 @@ SYMBOL: html
[
"input"
"br"
+ "hr"
"link"
"img"
] [ define-open-html-word ] each
From 216064ab50e659ba051af334d7f7667fa5def90c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 03:34:35 -0500
Subject: [PATCH 62/87] Fix referrer bug
---
basis/furnace/referrer/referrer.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/furnace/referrer/referrer.factor b/basis/furnace/referrer/referrer.factor
index b7a3df4b53..003028ab1e 100644
--- a/basis/furnace/referrer/referrer.factor
+++ b/basis/furnace/referrer/referrer.factor
@@ -14,4 +14,4 @@ M: referrer-check call-responder*
[ 2drop 403 "Bad referrer" <trivial-response> ] if ;
: <check-form-submissions> ( responder -- responder' )
- [ post-request? [ same-host? ] [ drop f ] if ] <referrer-check> ;
+ [ post-request? [ same-host? ] [ drop t ] if ] <referrer-check> ;
From b890c8374445f767b974377c9db748a1213dbce7 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 03:34:48 -0500
Subject: [PATCH 63/87] Make alloy easier to use by creating the database
tables for you
---
basis/furnace/alloy/alloy.factor | 21 ++++++++++++---------
1 file changed, 12 insertions(+), 9 deletions(-)
diff --git a/basis/furnace/alloy/alloy.factor b/basis/furnace/alloy/alloy.factor
index 684c4aef4c..decee690a3 100644
--- a/basis/furnace/alloy/alloy.factor
+++ b/basis/furnace/alloy/alloy.factor
@@ -11,21 +11,24 @@ furnace.auth.providers
furnace.auth.login.permits ;
IN: furnace.alloy
-: <alloy> ( responder db params -- responder' )
- '[
- <asides>
- <conversations>
- <sessions>
- _ _ <db-persistence>
- <check-form-submissions>
- ] call ;
-
: state-classes { session aside conversation permit } ; inline
: init-furnace-tables ( -- )
state-classes ensure-tables
user ensure-table ;
+: <alloy> ( responder db params -- responder' )
+ [ [ init-furnace-tables ] with-db ]
+ [
+ [
+ <asides>
+ <conversations>
+ <sessions>
+ ] 2dip
+ <db-persistence>
+ <check-form-submissions>
+ ] 2bi ;
+
: start-expiring ( db params -- )
'[
_ _ [ state-classes [ expire-state ] each ] with-db
From 47a74f05454b9e081fd9d316b798f069ef3603a9 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 03:35:01 -0500
Subject: [PATCH 64/87] Update webapps.counter for alloy change
---
extra/webapps/counter/counter.factor | 11 +++--------
1 file changed, 3 insertions(+), 8 deletions(-)
diff --git a/extra/webapps/counter/counter.factor b/extra/webapps/counter/counter.factor
index a0ee3a1b29..f49d8f008e 100644
--- a/extra/webapps/counter/counter.factor
+++ b/extra/webapps/counter/counter.factor
@@ -2,8 +2,7 @@
! 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
-fry urls ;
+html.components html.forms fry urls ;
IN: webapps.counter
SYMBOL: count
@@ -32,17 +31,13 @@ M: counter-app init-session* drop 0 count sset ;
<sessions> ;
! Deployment example
-USING: db.sqlite db.tuples db furnace.db namespaces ;
+USING: db.sqlite furnace.alloy 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>
+ counter-db <alloy>
main-responder set-global
8080 httpd ;
From 88c59b16399eccb08d63a6f35a3f63233ae4de12 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 03:35:09 -0500
Subject: [PATCH 65/87] New webapps.calculator demo
---
extra/webapps/calculator/calculator.factor | 44 ++++++++++++++++++++++
extra/webapps/calculator/calculator.xml | 28 ++++++++++++++
2 files changed, 72 insertions(+)
create mode 100644 extra/webapps/calculator/calculator.factor
create mode 100644 extra/webapps/calculator/calculator.xml
diff --git a/extra/webapps/calculator/calculator.factor b/extra/webapps/calculator/calculator.factor
new file mode 100644
index 0000000000..f1416fb02d
--- /dev/null
+++ b/extra/webapps/calculator/calculator.factor
@@ -0,0 +1,44 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: furnace.actions furnace.redirection
+http.server.dispatchers html.forms validators urls accessors
+math ;
+IN: webapps.calculator
+
+TUPLE: calculator < dispatcher ;
+
+: <calculator-action> ( -- action )
+ <page-action>
+
+ [
+ { { "z" [ [ v-number ] v-optional ] } } validate-params
+ ] >>init
+
+ { calculator "calculator" } >>template
+
+ [
+ {
+ { "x" [ v-number ] }
+ { "y" [ v-number ] }
+ } validate-params
+
+ URL" $calculator" "x" value "y" value + "z" set-query-param
+ <redirect>
+ ] >>submit ;
+
+: <calculator> ( -- responder )
+ calculator new-dispatcher
+ <calculator-action> >>default ;
+
+! Deployment example
+USING: db.sqlite furnace.alloy namespaces http.server ;
+
+: calculator-db ( -- params db ) "calculator.db" sqlite-db ;
+
+: run-calculator ( -- )
+ <calculator>
+ calculator-db <alloy>
+ main-responder set-global
+ 8080 httpd ;
+
+MAIN: run-calculator
diff --git a/extra/webapps/calculator/calculator.xml b/extra/webapps/calculator/calculator.xml
new file mode 100644
index 0000000000..ed8e60d89a
--- /dev/null
+++ b/extra/webapps/calculator/calculator.xml
@@ -0,0 +1,28 @@
+<?xml version='1.0' ?>
+
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+
+ <head> <title>Calculator</title> </head>
+
+ <body>
+ <h1>Calculator</h1>
+
+ <t:form t:action="$calculator">
+
+ <table>
+ <tr><td>First value:</td><td> <t:field t:name="x" /> </td></tr>
+ <tr><td>Second value:</td><td> <t:field t:name="y" /> </td></tr>
+ </table>
+
+ <input type="SUBMIT" value="Compute" />
+
+ <t:if t:value="z">
+ <br/>
+
+ Result: <t:label t:name="z" />
+ </t:if>
+
+ </t:form>
+ </body>
+
+</t:chloe>
From a2a1a51765cd17bf451a48d80f9475c09d90b12d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 14:06:36 -0500
Subject: [PATCH 66/87] Fix another bug in same-host?
---
basis/furnace/furnace.factor | 8 ++++++--
1 file changed, 6 insertions(+), 2 deletions(-)
diff --git a/basis/furnace/furnace.factor b/basis/furnace/furnace.factor
index 376da79ef2..7285c436bc 100644
--- a/basis/furnace/furnace.factor
+++ b/basis/furnace/furnace.factor
@@ -99,8 +99,12 @@ M: object modify-form drop ;
: same-host? ( url -- ? )
dup [
- url get
- [ [ protocol>> ] [ host>> ] [ port>> ] tri 3array ] bi@ =
+ url get [
+ [ protocol>> ]
+ [ host>> ]
+ [ port>> remap-port ]
+ tri 3array
+ ] bi@ =
] when ;
: cookie-client-state ( key request -- value/f )
From bb9d24c18a7b624859fb313a3f1ad4821ede4151 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 14:06:49 -0500
Subject: [PATCH 67/87] Fix paste order
---
extra/webapps/pastebin/pastebin.factor | 10 ++++++----
1 file changed, 6 insertions(+), 4 deletions(-)
diff --git a/extra/webapps/pastebin/pastebin.factor b/extra/webapps/pastebin/pastebin.factor
index 3aeb21420f..2de31c82e7 100644
--- a/extra/webapps/pastebin/pastebin.factor
+++ b/extra/webapps/pastebin/pastebin.factor
@@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces assocs sorting sequences kernel accessors
hashtables sequences.lib db.types db.tuples db combinators
-calendar calendar.format math.parser syndication urls xml.writer
-xmode.catalog validators
+calendar calendar.format math.parser math.order syndication urls
+xml.writer xmode.catalog validators
html.forms
html.components
html.templates.chloe
@@ -58,7 +58,9 @@ TUPLE: paste < entity annotations ;
swap >>id ;
: pastes ( -- pastes )
- f <paste> select-tuples ;
+ f <paste> select-tuples
+ [ [ date>> ] compare ] sort
+ reverse ;
TUPLE: annotation < entity parent ;
@@ -111,7 +113,7 @@ M: annotation entity-url
<feed-action>
[ pastebin-url ] >>url
[ "Factor Pastebin" ] >>title
- [ pastes <reversed> ] >>entries ;
+ [ pastes ] >>entries ;
! ! !
! PASTES
From d9d5dcc7a622af4aa9ede34707832920aba6776e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 14:17:02 -0500
Subject: [PATCH 68/87] Fix Safari weirdness
---
basis/urls/urls-tests.factor | 2 ++
basis/urls/urls.factor | 28 ++++++++++++++++++----------
2 files changed, 20 insertions(+), 10 deletions(-)
diff --git a/basis/urls/urls-tests.factor b/basis/urls/urls-tests.factor
index 7f835b2918..75ee7b6740 100644
--- a/basis/urls/urls-tests.factor
+++ b/basis/urls/urls-tests.factor
@@ -225,3 +225,5 @@ urls [
] unit-test
[ "foo#3" ] [ URL" foo" clone 3 >>anchor present ] unit-test
+
+[ "http://www.foo.com/" ] [ "http://www.foo.com:80" >url present ] unit-test
diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor
index 488e0a121c..19bae087af 100644
--- a/basis/urls/urls.factor
+++ b/basis/urls/urls.factor
@@ -155,13 +155,30 @@ M: string >url
% password>> [ ":" % % ] when* "@" %
] [ 2drop ] if ;
+: protocol-port ( protocol -- port )
+ {
+ { "http" [ 80 ] }
+ { "https" [ 443 ] }
+ { "feed" [ 80 ] }
+ { "ftp" [ 21 ] }
+ [ drop f ]
+ } case ;
+
+<PRIVATE
+
+: url-port ( url -- port/f )
+ [ port>> ] [ port>> ] [ protocol>> protocol-port ] tri =
+ [ drop f ] when ;
+
+PRIVATE>
+
: unparse-host-part ( url protocol -- )
%
"://" %
{
[ unparse-username-password ]
[ host>> url-encode % ]
- [ port>> [ ":" % # ] when* ]
+ [ url-port [ ":" % # ] when* ]
[ path>> "/" head? [ "/" % ] unless ]
} cleave ;
@@ -212,15 +229,6 @@ PRIVATE>
[ [ host>> ] [ port>> ] bi <inet> ] [ protocol>> ] bi
secure-protocol? [ <secure> ] when ;
-: protocol-port ( protocol -- port )
- {
- { "http" [ 80 ] }
- { "https" [ 443 ] }
- { "feed" [ 80 ] }
- { "ftp" [ 21 ] }
- [ drop f ]
- } case ;
-
: ensure-port ( url -- url' )
dup protocol>> '[ _ protocol-port or ] change-port ;
From 46262a6554d1ff78e92cc12361e67115a22c1692 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 23 Sep 2008 15:59:33 -0500
Subject: [PATCH 69/87] refactoring db.tuples, all tests pass so far..
---
basis/db/queries/queries.factor | 8 +++---
basis/db/tuples/tuples-tests.factor | 15 ++++++++++
basis/db/tuples/tuples.factor | 44 ++++++++++++++++++-----------
3 files changed, 46 insertions(+), 21 deletions(-)
diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor
index 89c28b5262..300822cc50 100644
--- a/basis/db/queries/queries.factor
+++ b/basis/db/queries/queries.factor
@@ -168,7 +168,7 @@ M: db <select-by-slots-statement> ( tuple class -- statement )
number>string " limit " swap 3append
] curry change-sql drop ;
-: make-query ( tuple query -- tuple' )
+: make-query* ( tuple query -- tuple' )
dupd
{
[ group>> [ drop ] [ do-group ] if-empty ]
@@ -177,8 +177,8 @@ M: db <select-by-slots-statement> ( tuple class -- statement )
[ offset>> [ do-offset ] [ drop ] if* ]
} 2cleave ;
-M: db <query> ( tuple class query -- tuple )
- [ <select-by-slots-statement> ] dip make-query ;
+M: db make-query ( tuple class query -- tuple )
+ [ <select-by-slots-statement> ] dip make-query* ;
! select ID, NAME, SCORE from EXAM limit 1 offset 3
@@ -198,7 +198,7 @@ M: db <count-statement> ( tuple class groups -- statement )
\ query new
swap >>group
[ [ "select count(*) from " 0% 0% where-clause ] query-make ]
- dip make-query ;
+ dip make-query* ;
: create-index ( index-name table-name columns -- )
[
diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor
index 67e46f9e18..466d086fbe 100755
--- a/basis/db/tuples/tuples-tests.factor
+++ b/basis/db/tuples/tuples-tests.factor
@@ -499,3 +499,18 @@ string-encoding-test "STRING_ENCODING_TEST" {
\ ensure-table must-infer
\ create-table must-infer
\ drop-table must-infer
+
+: test-queries ( -- )
+ [ ] [ exam ensure-table ] unit-test
+ ! [ ] [ T{ exam f f "Kyle" 100 } insert-tuple ] unit-test
+ ! [ ] [ T{ exam f f "Stan" 80 } insert-tuple ] unit-test
+ ! [ ] [ T{ exam f f "Kenny" 60 } insert-tuple ] unit-test
+ ! [ ] [ T{ exam f f "Cartman" 41 } insert-tuple ] unit-test
+ [ ] [ 10 [ random-exam insert-tuple ] times ] unit-test
+ [ ] [ ] unit-test
+ ! [ ] [ query ] unit-test
+
+ ;
+
+: test-db ( -- )
+ "tuples-test.db" temp-file sqlite-db make-db db-open db set ;
diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor
index 3c3bae3adc..534b91b8fc 100755
--- a/basis/db/tuples/tuples.factor
+++ b/basis/db/tuples/tuples.factor
@@ -6,6 +6,30 @@ math.parser io prettyprint db.types continuations
destructors mirrors ;
IN: db.tuples
+TUPLE: query tuple group order offset limit ;
+
+: <query> ( -- query ) \ query new ;
+
+GENERIC: >query ( object -- query )
+
+M: query >query ;
+
+M: tuple >query <query> swap >>tuple ;
+
+! returns a sequence of prepared-statements
+HOOK: create-sql-statement db ( class -- object )
+HOOK: drop-sql-statement db ( class -- object )
+
+HOOK: <insert-db-assigned-statement> db ( class -- object )
+HOOK: <insert-user-assigned-statement> db ( class -- object )
+HOOK: <update-tuple-statement> db ( class -- object )
+HOOK: <delete-tuples-statement> db ( tuple class -- object )
+HOOK: <select-by-slots-statement> db ( tuple class -- tuple )
+HOOK: <count-statement> db ( tuple class groups -- statement )
+HOOK: make-query db ( tuple class query -- statement )
+
+HOOK: insert-tuple* db ( tuple statement -- )
+
: define-persistent ( class table columns -- )
>r dupd "db-table" set-word-prop dup r>
[ relation? ] partition swapd
@@ -33,21 +57,6 @@ SYMBOL: sql-counter
: next-sql-counter ( -- str )
sql-counter [ inc ] [ get ] bi number>string ;
-! returns a sequence of prepared-statements
-HOOK: create-sql-statement db ( class -- object )
-HOOK: drop-sql-statement db ( class -- object )
-
-HOOK: <insert-db-assigned-statement> db ( class -- object )
-HOOK: <insert-user-assigned-statement> db ( class -- object )
-HOOK: <update-tuple-statement> db ( class -- object )
-HOOK: <delete-tuples-statement> db ( tuple class -- object )
-HOOK: <select-by-slots-statement> db ( tuple class -- tuple )
-TUPLE: query group order offset limit ;
-HOOK: <query> db ( tuple class query -- statement' )
-HOOK: <count-statement> db ( tuple class groups -- n )
-
-HOOK: insert-tuple* db ( tuple statement -- )
-
GENERIC: eval-generator ( singleton -- object )
: resulting-tuple ( exemplar-tuple row out-params -- tuple )
@@ -121,13 +130,14 @@ GENERIC: eval-generator ( singleton -- object )
[ [ bind-tuple ] [ query-tuples ] 2bi ] with-disposal ;
: query ( tuple query -- tuples )
- [ dup dup class ] dip <query> do-select ;
+ [ dup dup class ] dip make-query do-select ;
+
: select-tuples ( tuple -- tuples )
dup dup class <select-by-slots-statement> do-select ;
: select-tuple ( tuple -- tuple/f )
- dup dup class \ query new 1 >>limit <query> do-select
+ dup dup class \ query new 1 >>limit make-query do-select
[ f ] [ first ] if-empty ;
: do-count ( exemplar-tuple statement -- tuples )
From 9bd661870763bb86c9e78415bdbd49782ae2cfba Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 16:11:11 -0500
Subject: [PATCH 70/87] Fix load error
---
basis/urls/urls.factor | 12 +++++-------
1 file changed, 5 insertions(+), 7 deletions(-)
diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor
index 19bae087af..e35292e9d7 100644
--- a/basis/urls/urls.factor
+++ b/basis/urls/urls.factor
@@ -148,13 +148,6 @@ M: string >url
]
[ url-decode >>anchor ] bi* ;
-<PRIVATE
-
-: unparse-username-password ( url -- )
- dup username>> dup [
- % password>> [ ":" % % ] when* "@" %
- ] [ 2drop ] if ;
-
: protocol-port ( protocol -- port )
{
{ "http" [ 80 ] }
@@ -166,6 +159,11 @@ M: string >url
<PRIVATE
+: unparse-username-password ( url -- )
+ dup username>> dup [
+ % password>> [ ":" % % ] when* "@" %
+ ] [ 2drop ] if ;
+
: url-port ( url -- port/f )
[ port>> ] [ port>> ] [ protocol>> protocol-port ] tri =
[ drop f ] when ;
From 79f3865f9257a9a70e87440c1d23875bff48c950 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 16:11:59 -0500
Subject: [PATCH 71/87] Add missing meta-data
---
basis/alarms/summary.txt | 1 +
basis/alias/summary.txt | 1 +
basis/binary-search/summary.txt | 1 +
basis/boxes/summary.txt | 1 +
basis/colors/summary.txt | 1 +
basis/eval/authors.txt | 1 +
basis/eval/summary.txt | 1 +
basis/generalizations/authors.txt | 4 ++++
basis/generalizations/summary.txt | 1 +
basis/html/components/authors.txt | 1 +
basis/html/components/summary.txt | 1 +
basis/html/components/tags.txt | 1 +
basis/html/elements/summary.txt | 1 +
basis/html/elements/tags.txt | 1 +
basis/html/forms/authors.txt | 1 +
basis/html/forms/summary.txt | 1 +
basis/html/forms/tags.txt | 1 +
basis/html/streams/summary.txt | 2 +-
basis/html/templates/authors.txt | 1 +
basis/html/templates/chloe/authors.txt | 1 +
basis/html/templates/chloe/summary.txt | 1 +
basis/html/templates/chloe/tags.txt | 1 +
basis/html/templates/fhtml/authors.txt | 2 +-
basis/html/templates/fhtml/summary.txt | 1 +
basis/html/templates/fhtml/tags.txt | 1 +
basis/html/templates/summary.txt | 1 +
basis/html/templates/tags.txt | 1 +
basis/nmake/authors.txt | 1 +
basis/nmake/summary.txt | 1 +
basis/nmake/tags.txt | 1 +
basis/present/authors.txt | 1 +
basis/present/summary.txt | 1 +
basis/random/authors.txt | 2 ++
basis/random/summary.txt | 1 +
basis/summary/authors.txt | 1 +
basis/summary/summary.txt | 1 +
basis/symbols/summary.txt | 1 +
basis/validators/authors.txt | 1 +
basis/validators/summary.txt | 1 +
core/checksums/authors.txt | 1 +
core/checksums/summary.txt | 1 +
core/lexer/authors.txt | 1 +
core/lexer/summary.txt | 1 +
core/make/authors.txt | 1 +
core/make/summary.txt | 1 +
core/make/tags.txt | 1 +
46 files changed, 50 insertions(+), 2 deletions(-)
create mode 100644 basis/alarms/summary.txt
create mode 100644 basis/alias/summary.txt
create mode 100644 basis/binary-search/summary.txt
create mode 100644 basis/boxes/summary.txt
create mode 100644 basis/colors/summary.txt
create mode 100644 basis/eval/authors.txt
create mode 100644 basis/eval/summary.txt
create mode 100644 basis/generalizations/authors.txt
create mode 100644 basis/generalizations/summary.txt
create mode 100644 basis/html/components/authors.txt
create mode 100644 basis/html/components/summary.txt
create mode 100644 basis/html/components/tags.txt
create mode 100644 basis/html/elements/summary.txt
create mode 100644 basis/html/elements/tags.txt
create mode 100644 basis/html/forms/authors.txt
create mode 100644 basis/html/forms/summary.txt
create mode 100644 basis/html/forms/tags.txt
create mode 100644 basis/html/templates/authors.txt
create mode 100644 basis/html/templates/chloe/authors.txt
create mode 100644 basis/html/templates/chloe/summary.txt
create mode 100644 basis/html/templates/chloe/tags.txt
create mode 100644 basis/html/templates/fhtml/summary.txt
create mode 100644 basis/html/templates/fhtml/tags.txt
create mode 100644 basis/html/templates/summary.txt
create mode 100644 basis/html/templates/tags.txt
create mode 100644 basis/nmake/authors.txt
create mode 100644 basis/nmake/summary.txt
create mode 100644 basis/nmake/tags.txt
create mode 100644 basis/present/authors.txt
create mode 100644 basis/present/summary.txt
create mode 100644 basis/random/authors.txt
create mode 100644 basis/random/summary.txt
create mode 100644 basis/summary/authors.txt
create mode 100644 basis/summary/summary.txt
create mode 100644 basis/symbols/summary.txt
create mode 100644 basis/validators/authors.txt
create mode 100644 basis/validators/summary.txt
create mode 100644 core/checksums/authors.txt
create mode 100644 core/checksums/summary.txt
create mode 100644 core/lexer/authors.txt
create mode 100644 core/lexer/summary.txt
create mode 100644 core/make/authors.txt
create mode 100644 core/make/summary.txt
create mode 100644 core/make/tags.txt
diff --git a/basis/alarms/summary.txt b/basis/alarms/summary.txt
new file mode 100644
index 0000000000..f6e12238fa
--- /dev/null
+++ b/basis/alarms/summary.txt
@@ -0,0 +1 @@
+One-time and recurring events
diff --git a/basis/alias/summary.txt b/basis/alias/summary.txt
new file mode 100644
index 0000000000..15690a7b9b
--- /dev/null
+++ b/basis/alias/summary.txt
@@ -0,0 +1 @@
+Defining multiple words with the same name
diff --git a/basis/binary-search/summary.txt b/basis/binary-search/summary.txt
new file mode 100644
index 0000000000..c4fd4f2774
--- /dev/null
+++ b/basis/binary-search/summary.txt
@@ -0,0 +1 @@
+Fast searching of sorted arrays
diff --git a/basis/boxes/summary.txt b/basis/boxes/summary.txt
new file mode 100644
index 0000000000..44c1352e36
--- /dev/null
+++ b/basis/boxes/summary.txt
@@ -0,0 +1 @@
+An abstraction for enforcing a mutual-exclusion invariant
diff --git a/basis/colors/summary.txt b/basis/colors/summary.txt
new file mode 100644
index 0000000000..a90b1aaf76
--- /dev/null
+++ b/basis/colors/summary.txt
@@ -0,0 +1 @@
+Colors as a first-class data type
diff --git a/basis/eval/authors.txt b/basis/eval/authors.txt
new file mode 100644
index 0000000000..1901f27a24
--- /dev/null
+++ b/basis/eval/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
diff --git a/basis/eval/summary.txt b/basis/eval/summary.txt
new file mode 100644
index 0000000000..679f074e90
--- /dev/null
+++ b/basis/eval/summary.txt
@@ -0,0 +1 @@
+Ad-hoc evaluation of strings of code
diff --git a/basis/generalizations/authors.txt b/basis/generalizations/authors.txt
new file mode 100644
index 0000000000..6c66b7480e
--- /dev/null
+++ b/basis/generalizations/authors.txt
@@ -0,0 +1,4 @@
+Chris Double
+Doug Coleman
+Eduardo Cavazos
+Slava Pestov
diff --git a/basis/generalizations/summary.txt b/basis/generalizations/summary.txt
new file mode 100644
index 0000000000..a8ccb7d6c2
--- /dev/null
+++ b/basis/generalizations/summary.txt
@@ -0,0 +1 @@
+Generalized stack shufflers and combinators to arbitrary numbers of inputs
diff --git a/basis/html/components/authors.txt b/basis/html/components/authors.txt
new file mode 100644
index 0000000000..1901f27a24
--- /dev/null
+++ b/basis/html/components/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
diff --git a/basis/html/components/summary.txt b/basis/html/components/summary.txt
new file mode 100644
index 0000000000..9df7695ca1
--- /dev/null
+++ b/basis/html/components/summary.txt
@@ -0,0 +1 @@
+HTML components for form rendering and validation
diff --git a/basis/html/components/tags.txt b/basis/html/components/tags.txt
new file mode 100644
index 0000000000..c0772185a0
--- /dev/null
+++ b/basis/html/components/tags.txt
@@ -0,0 +1 @@
+web
diff --git a/basis/html/elements/summary.txt b/basis/html/elements/summary.txt
new file mode 100644
index 0000000000..7e4a4a03db
--- /dev/null
+++ b/basis/html/elements/summary.txt
@@ -0,0 +1 @@
+Rendering HTML with a familiar look and feel
diff --git a/basis/html/elements/tags.txt b/basis/html/elements/tags.txt
new file mode 100644
index 0000000000..c0772185a0
--- /dev/null
+++ b/basis/html/elements/tags.txt
@@ -0,0 +1 @@
+web
diff --git a/basis/html/forms/authors.txt b/basis/html/forms/authors.txt
new file mode 100644
index 0000000000..1901f27a24
--- /dev/null
+++ b/basis/html/forms/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
diff --git a/basis/html/forms/summary.txt b/basis/html/forms/summary.txt
new file mode 100644
index 0000000000..d4b20eefca
--- /dev/null
+++ b/basis/html/forms/summary.txt
@@ -0,0 +1 @@
+HTML form rendering and validation
diff --git a/basis/html/forms/tags.txt b/basis/html/forms/tags.txt
new file mode 100644
index 0000000000..c0772185a0
--- /dev/null
+++ b/basis/html/forms/tags.txt
@@ -0,0 +1 @@
+web
diff --git a/basis/html/streams/summary.txt b/basis/html/streams/summary.txt
index 29ec8d3df7..56b83c5c52 100644
--- a/basis/html/streams/summary.txt
+++ b/basis/html/streams/summary.txt
@@ -1 +1 @@
-HTML reader, writer and utilities
+HTML implementation of formatted output stream protocol
diff --git a/basis/html/templates/authors.txt b/basis/html/templates/authors.txt
new file mode 100644
index 0000000000..1901f27a24
--- /dev/null
+++ b/basis/html/templates/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
diff --git a/basis/html/templates/chloe/authors.txt b/basis/html/templates/chloe/authors.txt
new file mode 100644
index 0000000000..1901f27a24
--- /dev/null
+++ b/basis/html/templates/chloe/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
diff --git a/basis/html/templates/chloe/summary.txt b/basis/html/templates/chloe/summary.txt
new file mode 100644
index 0000000000..568fb3fac1
--- /dev/null
+++ b/basis/html/templates/chloe/summary.txt
@@ -0,0 +1 @@
+XHTML templating engine with extensible compiler and separation of concerns
diff --git a/basis/html/templates/chloe/tags.txt b/basis/html/templates/chloe/tags.txt
new file mode 100644
index 0000000000..c0772185a0
--- /dev/null
+++ b/basis/html/templates/chloe/tags.txt
@@ -0,0 +1 @@
+web
diff --git a/basis/html/templates/fhtml/authors.txt b/basis/html/templates/fhtml/authors.txt
index b47eafb62a..22d592c1dd 100644
--- a/basis/html/templates/fhtml/authors.txt
+++ b/basis/html/templates/fhtml/authors.txt
@@ -1,2 +1,2 @@
Slava Pestov
-Matthew Willis
+Alex Chapman
diff --git a/basis/html/templates/fhtml/summary.txt b/basis/html/templates/fhtml/summary.txt
new file mode 100644
index 0000000000..71745ffa1f
--- /dev/null
+++ b/basis/html/templates/fhtml/summary.txt
@@ -0,0 +1 @@
+Simple templating engine mixing Factor code with content
diff --git a/basis/html/templates/fhtml/tags.txt b/basis/html/templates/fhtml/tags.txt
new file mode 100644
index 0000000000..c0772185a0
--- /dev/null
+++ b/basis/html/templates/fhtml/tags.txt
@@ -0,0 +1 @@
+web
diff --git a/basis/html/templates/summary.txt b/basis/html/templates/summary.txt
new file mode 100644
index 0000000000..ef0aa59228
--- /dev/null
+++ b/basis/html/templates/summary.txt
@@ -0,0 +1 @@
+HTML templating engine interface
diff --git a/basis/html/templates/tags.txt b/basis/html/templates/tags.txt
new file mode 100644
index 0000000000..c0772185a0
--- /dev/null
+++ b/basis/html/templates/tags.txt
@@ -0,0 +1 @@
+web
diff --git a/basis/nmake/authors.txt b/basis/nmake/authors.txt
new file mode 100644
index 0000000000..7c1b2f2279
--- /dev/null
+++ b/basis/nmake/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
diff --git a/basis/nmake/summary.txt b/basis/nmake/summary.txt
new file mode 100644
index 0000000000..1b82985a72
--- /dev/null
+++ b/basis/nmake/summary.txt
@@ -0,0 +1 @@
+Generalization of make for constructing several sequences simultaneously
diff --git a/basis/nmake/tags.txt b/basis/nmake/tags.txt
new file mode 100644
index 0000000000..42d711b32b
--- /dev/null
+++ b/basis/nmake/tags.txt
@@ -0,0 +1 @@
+collections
diff --git a/basis/present/authors.txt b/basis/present/authors.txt
new file mode 100644
index 0000000000..1901f27a24
--- /dev/null
+++ b/basis/present/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
diff --git a/basis/present/summary.txt b/basis/present/summary.txt
new file mode 100644
index 0000000000..94d0a5b14c
--- /dev/null
+++ b/basis/present/summary.txt
@@ -0,0 +1 @@
+Generic word for converting objects to strings for human consumption
diff --git a/basis/random/authors.txt b/basis/random/authors.txt
new file mode 100644
index 0000000000..5674120196
--- /dev/null
+++ b/basis/random/authors.txt
@@ -0,0 +1,2 @@
+Doug Coleman
+Slava Pestov
diff --git a/basis/random/summary.txt b/basis/random/summary.txt
new file mode 100644
index 0000000000..6981c56062
--- /dev/null
+++ b/basis/random/summary.txt
@@ -0,0 +1 @@
+Random number generator protocol and implementations
diff --git a/basis/summary/authors.txt b/basis/summary/authors.txt
new file mode 100644
index 0000000000..1901f27a24
--- /dev/null
+++ b/basis/summary/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
diff --git a/basis/summary/summary.txt b/basis/summary/summary.txt
new file mode 100644
index 0000000000..02294138e0
--- /dev/null
+++ b/basis/summary/summary.txt
@@ -0,0 +1 @@
+Generic word for converting an object into a brief one-line string
diff --git a/basis/symbols/summary.txt b/basis/symbols/summary.txt
new file mode 100644
index 0000000000..3093468c50
--- /dev/null
+++ b/basis/symbols/summary.txt
@@ -0,0 +1 @@
+Utility for defining multiple symbols at a time
diff --git a/basis/validators/authors.txt b/basis/validators/authors.txt
new file mode 100644
index 0000000000..1901f27a24
--- /dev/null
+++ b/basis/validators/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
diff --git a/basis/validators/summary.txt b/basis/validators/summary.txt
new file mode 100644
index 0000000000..bcf9ac045f
--- /dev/null
+++ b/basis/validators/summary.txt
@@ -0,0 +1 @@
+Value validation for the web framework
diff --git a/core/checksums/authors.txt b/core/checksums/authors.txt
new file mode 100644
index 0000000000..1901f27a24
--- /dev/null
+++ b/core/checksums/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
diff --git a/core/checksums/summary.txt b/core/checksums/summary.txt
new file mode 100644
index 0000000000..e85ab359a0
--- /dev/null
+++ b/core/checksums/summary.txt
@@ -0,0 +1 @@
+Checksum protocol and implementations
diff --git a/core/lexer/authors.txt b/core/lexer/authors.txt
new file mode 100644
index 0000000000..1901f27a24
--- /dev/null
+++ b/core/lexer/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
diff --git a/core/lexer/summary.txt b/core/lexer/summary.txt
new file mode 100644
index 0000000000..7c31988ee2
--- /dev/null
+++ b/core/lexer/summary.txt
@@ -0,0 +1 @@
+Factor source code lexer
diff --git a/core/make/authors.txt b/core/make/authors.txt
new file mode 100644
index 0000000000..1901f27a24
--- /dev/null
+++ b/core/make/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
diff --git a/core/make/summary.txt b/core/make/summary.txt
new file mode 100644
index 0000000000..e07624198e
--- /dev/null
+++ b/core/make/summary.txt
@@ -0,0 +1 @@
+Sequence construction utility
diff --git a/core/make/tags.txt b/core/make/tags.txt
new file mode 100644
index 0000000000..42d711b32b
--- /dev/null
+++ b/core/make/tags.txt
@@ -0,0 +1 @@
+collections
From efafe1df31586ba51cdd97772d1655d247d49da6 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 16:14:34 -0500
Subject: [PATCH 72/87] Doc fixes
---
basis/circular/circular-docs.factor | 2 +-
basis/combinators/short-circuit/short-circuit-docs.factor | 2 +-
basis/combinators/short-circuit/smart/smart-docs.factor | 5 +++--
3 files changed, 5 insertions(+), 4 deletions(-)
diff --git a/basis/circular/circular-docs.factor b/basis/circular/circular-docs.factor
index 362d41c9de..c7af57c1fe 100644
--- a/basis/circular/circular-docs.factor
+++ b/basis/circular/circular-docs.factor
@@ -43,7 +43,7 @@ HELP: push-growing-circular
{ "elt" object } { "circular" circular } }
{ $description "Pushes an element onto a " { $link growing-circular } " object." } ;
-ARTICLE: "circular" "circular"
+ARTICLE: "circular" "Circular sequences"
"The " { $vocab-link "circular" } " vocabulary implements the " { $link "sequence-protocol" } " to allow an arbitrary start index and wrap-around indexing." $nl
"Creating a new circular object:"
{ $subsection <circular> }
diff --git a/basis/combinators/short-circuit/short-circuit-docs.factor b/basis/combinators/short-circuit/short-circuit-docs.factor
index 058291d022..54fc3aac43 100644
--- a/basis/combinators/short-circuit/short-circuit-docs.factor
+++ b/basis/combinators/short-circuit/short-circuit-docs.factor
@@ -64,7 +64,7 @@ HELP: n||-rewrite
{ "quot" quotation } }
{ $description "A macro that reqrites the code to pass " { $snippet "N" } " parameters from the stack to each OR quotation." } ;
-ARTICLE: "combinators.short-circuit" "combinators.short-circuit"
+ARTICLE: "combinators.short-circuit" "Short-circuit combinators"
"The " { $vocab-link "combinators.short-circuit" } " vocabulary stops a computation early once a condition is met." $nl
"AND combinators:"
{ $subsection 0&& }
diff --git a/basis/combinators/short-circuit/smart/smart-docs.factor b/basis/combinators/short-circuit/smart/smart-docs.factor
index abf3ff0eef..34abde15b6 100644
--- a/basis/combinators/short-circuit/smart/smart-docs.factor
+++ b/basis/combinators/short-circuit/smart/smart-docs.factor
@@ -27,8 +27,9 @@ HELP: ||
}
} ;
-ARTICLE: "combinators.short-circuit.smart" "combinators.short-circuit.smart"
-"The " { $vocab-link "combinators.short-circuit.smart" } " vocabulary infers the number of inputs that the sequence of quotations takes." $nl
+ARTICLE: "combinators.short-circuit.smart" "Smart short-circuit combinators"
+"The " { $vocab-link "combinators.short-circuit.smart" } " vocabulary is similar to " { $vocab-link "combinators.short-circuit" } " except the combinators here infer the number of inputs that the sequence of quotations takes."
+$nl
"Generalized AND:"
{ $subsection && }
"Generalized OR:"
From 9a6408623b49bf54d66889bf327019b50df07959 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 16:19:32 -0500
Subject: [PATCH 73/87] More doc fixes
---
basis/smtp/smtp-docs.factor | 2 +-
core/sequences/sequences-docs.factor | 5 +++--
2 files changed, 4 insertions(+), 3 deletions(-)
diff --git a/basis/smtp/smtp-docs.factor b/basis/smtp/smtp-docs.factor
index e859e082ff..c1c2d1c1f8 100644
--- a/basis/smtp/smtp-docs.factor
+++ b/basis/smtp/smtp-docs.factor
@@ -41,7 +41,7 @@ HELP: send-email
}
} ;
-ARTICLE: "smtp" "SMTP Client Library"
+ARTICLE: "smtp" "SMTP client library"
"Configuring SMTP:"
{ $subsection smtp-server }
{ $subsection smtp-read-timeout }
diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor
index b8be31c55c..0a4974607d 100755
--- a/core/sequences/sequences-docs.factor
+++ b/core/sequences/sequences-docs.factor
@@ -1258,6 +1258,8 @@ ARTICLE: "sequence-protocol" "Sequence protocol"
"At least one of the following two generic words must have a method for accessing elements; the " { $link sequence } " mixin has default definitions which are mutually recursive:"
{ $subsection nth }
{ $subsection nth-unsafe }
+"Note that sequences are always indexed starting from zero."
+$nl
"At least one of the following two generic words must have a method for storing elements; the " { $link sequence } " mixin has default definitions which are mutually recursive:"
{ $subsection set-nth }
{ $subsection set-nth-unsafe }
@@ -1283,8 +1285,7 @@ ARTICLE: "virtual-sequences-protocol" "Virtual sequence protocol"
ARTICLE: "virtual-sequences" "Virtual sequences"
"Virtual sequences allow different ways of accessing a sequence without having to create a new sequence or a new data structure altogether. To do this, they translate the virtual index into a normal index into an underlying sequence using the " { $link "virtual-sequences-protocol" } "."
-$nl
-"One current limitation of the virtual sequence protocol is that sequences must be indexed starting at zero." ;
+{ $subsection "virtual-sequences-protocol" } ;
ARTICLE: "sequences-integers" "Integer sequences and counted loops"
"Integers support the sequence protocol in a trivial fashion; a non-negative integer presents its non-negative predecessors as elements. For example, the integer 3, when viewed as a sequence, contains the elements 0, 1, and 2. This is very useful for performing counted loops."
From 9a5222427d65154fd78e63b3d323439ee75bbfdb Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 16:23:57 -0500
Subject: [PATCH 74/87] Oops, we were compiling the XML PI after the prolog
---
basis/html/templates/chloe/compiler/compiler.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/html/templates/chloe/compiler/compiler.factor b/basis/html/templates/chloe/compiler/compiler.factor
index aa741ebf9f..4f2eaafe26 100644
--- a/basis/html/templates/chloe/compiler/compiler.factor
+++ b/basis/html/templates/chloe/compiler/compiler.factor
@@ -123,8 +123,8 @@ DEFER: compile-element
: compile-prologue ( xml -- )
[
- [ before>> compile-chunk ]
[ prolog>> [ write-prolog ] [code-with] ]
+ [ before>> compile-chunk ]
bi
] compile-quot
[ if-not-nested ] [code] ;
From 52e68e0e86b7dc98c0cbf29a5718d534acf9a6e0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 16:32:10 -0500
Subject: [PATCH 75/87] Fix XHTML validation error
---
basis/html/templates/chloe/chloe.factor | 6 +++++-
1 file changed, 5 insertions(+), 1 deletion(-)
diff --git a/basis/html/templates/chloe/chloe.factor b/basis/html/templates/chloe/chloe.factor
index cc51bd05d3..e83040b00d 100644
--- a/basis/html/templates/chloe/chloe.factor
+++ b/basis/html/templates/chloe/chloe.factor
@@ -37,7 +37,11 @@ CHLOE: style
] ?if ;
CHLOE: write-style
- drop [ <style> write-style </style> ] [code] ;
+ drop [
+ <style "text/css" =type style>
+ write-style
+ </style>
+ ] [code] ;
CHLOE: even
[ "index" value even? swap when ] process-children ;
From bda6bd6f21f88e1011af56a5c0c30e564e71e5c9 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 16:34:28 -0500
Subject: [PATCH 76/87] Fix XHTML validation error
---
extra/webapps/wiki/wiki-common.xml | 6 ++----
extra/webapps/wiki/wiki.css | 4 ++++
2 files changed, 6 insertions(+), 4 deletions(-)
diff --git a/extra/webapps/wiki/wiki-common.xml b/extra/webapps/wiki/wiki-common.xml
index 628485955e..bca48ce260 100644
--- a/extra/webapps/wiki/wiki-common.xml
+++ b/extra/webapps/wiki/wiki-common.xml
@@ -56,11 +56,9 @@
<t:if t:value="footer">
<tr>
- <td colspan="2">
+ <td colspan="2" class="footer">
<t:bind t:name="footer">
- <small>
- <t:farkup t:name="parsed" t:parsed="true" />
- </small>
+ <t:farkup t:name="parsed" t:parsed="true" />
</t:bind>
</td>
</tr>
diff --git a/extra/webapps/wiki/wiki.css b/extra/webapps/wiki/wiki.css
index 7315b132d2..c27c44315f 100644
--- a/extra/webapps/wiki/wiki.css
+++ b/extra/webapps/wiki/wiki.css
@@ -45,3 +45,7 @@
background: #f5f1fd;
width: 200px;
}
+
+.footer {
+ font-size: 75%;
+}
From dad89fb2b79bc7156587ac55b38ba6d86a515723 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 16:46:50 -0500
Subject: [PATCH 77/87] Fix XHTML validation
---
basis/furnace/chloe-tags/chloe-tags.factor | 8 +++++---
1 file changed, 5 insertions(+), 3 deletions(-)
diff --git a/basis/furnace/chloe-tags/chloe-tags.factor b/basis/furnace/chloe-tags/chloe-tags.factor
index 6645e04c93..b67431092c 100644
--- a/basis/furnace/chloe-tags/chloe-tags.factor
+++ b/basis/furnace/chloe-tags/chloe-tags.factor
@@ -72,9 +72,11 @@ CHLOE: a
: compile-hidden-form-fields ( for -- )
'[
- _ [ "," split [ hidden render ] each ] when*
- nested-forms get " " join f like nested-forms-key hidden-form-field
- [ modify-form ] each-responder
+ <div "display: none;" =style div>
+ _ [ "," split [ hidden render ] each ] when*
+ nested-forms get " " join f like nested-forms-key hidden-form-field
+ [ modify-form ] each-responder
+ </div>
] [code] ;
: compile-form-attrs ( method action attrs -- )
From 28bf85e9677d7fdb2d457bbf75b56964081a095d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 16:50:23 -0500
Subject: [PATCH 78/87] Fix XHTML validation
---
basis/furnace/chloe-tags/chloe-tags.factor | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/basis/furnace/chloe-tags/chloe-tags.factor b/basis/furnace/chloe-tags/chloe-tags.factor
index b67431092c..d3ed2054b5 100644
--- a/basis/furnace/chloe-tags/chloe-tags.factor
+++ b/basis/furnace/chloe-tags/chloe-tags.factor
@@ -111,7 +111,7 @@ CHLOE: form
STRING: button-tag-markup
<t:form class="inline" xmlns:t="http://factorcode.org/chloe/1.0">
- <button type="submit"></button>
+ <div><button type="submit"></button></div>
</t:form>
;
@@ -122,7 +122,7 @@ CHLOE: button
button-tag-markup string>xml body>>
{
[ [ attrs>> chloe-attrs-only ] dip add-tag-attrs ]
- [ [ attrs>> non-chloe-attrs-only ] dip "button" tag-named add-tag-attrs ]
- [ [ children>> ] dip "button" tag-named (>>children) ]
+ [ [ attrs>> non-chloe-attrs-only ] dip "button" deep-tag-named add-tag-attrs ]
+ [ [ children>> ] dip "button" deep-tag-named (>>children) ]
[ nip ]
} 2cleave compile-chloe-tag ;
From 57c3a823b53df3eff86905c3477de945f1287484 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 16:52:50 -0500
Subject: [PATCH 79/87] Fix XHTML validation
---
extra/webapps/pastebin/pastebin.xml | 8 +++++---
1 file changed, 5 insertions(+), 3 deletions(-)
diff --git a/extra/webapps/pastebin/pastebin.xml b/extra/webapps/pastebin/pastebin.xml
index a6b3078aa7..3c9cb7ce96 100644
--- a/extra/webapps/pastebin/pastebin.xml
+++ b/extra/webapps/pastebin/pastebin.xml
@@ -5,9 +5,11 @@
<t:title>Pastebin</t:title>
<table width="100%">
- <th align="left" width="50%">Summary:</th>
- <th align="left" width="100">Paste by:</th>
- <th align="left" width="200">Date:</th>
+ <tr>
+ <th align="left" width="50%">Summary:</th>
+ <th align="left" width="100">Paste by:</th>
+ <th align="left" width="200">Date:</th>
+ </tr>
<t:bind-each t:name="pastes">
<tr>
From ce7117e3d1ada79db85b800b1175965034e1af93 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 16:55:00 -0500
Subject: [PATCH 80/87] Fix CSS validation
---
extra/webapps/wiki/wiki.css | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/webapps/wiki/wiki.css b/extra/webapps/wiki/wiki.css
index c27c44315f..4ecc6e5282 100644
--- a/extra/webapps/wiki/wiki.css
+++ b/extra/webapps/wiki/wiki.css
@@ -41,7 +41,7 @@
.contents {
padding: 4px;
margin: 4px;
- border: 1px dashed grey;
+ border: 1px dashed gray;
background: #f5f1fd;
width: 200px;
}
From 8eea1d13c2dd269ac6e7c8cc3fd8c017cbee4f0a Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 23 Sep 2008 16:55:32 -0500
Subject: [PATCH 81/87] define-persistent checks that slots exist
---
basis/db/tuples/tuples-tests.factor | 14 ++++++++++++--
basis/db/tuples/tuples.factor | 13 +++++++++++--
2 files changed, 23 insertions(+), 4 deletions(-)
diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor
index 466d086fbe..45a51719f9 100755
--- a/basis/db/tuples/tuples-tests.factor
+++ b/basis/db/tuples/tuples-tests.factor
@@ -236,6 +236,17 @@ TUPLE: exam id name score ;
exam boa ;
: test-intervals ( -- )
+ [
+ exam "EXAM"
+ {
+ { "idd" "ID" +db-assigned-id+ }
+ { "named" "NAME" TEXT }
+ { "score" "SCORE" INTEGER }
+ } define-persistent
+ ] [
+ seq>> { "idd" "named" } =
+ ] must-fail-with
+
exam "EXAM"
{
{ "id" "ID" +db-assigned-id+ }
@@ -507,9 +518,8 @@ string-encoding-test "STRING_ENCODING_TEST" {
! [ ] [ T{ exam f f "Kenny" 60 } insert-tuple ] unit-test
! [ ] [ T{ exam f f "Cartman" 41 } insert-tuple ] unit-test
[ ] [ 10 [ random-exam insert-tuple ] times ] unit-test
- [ ] [ ] unit-test
+ ! [ ] [ T{ exam { name "Kenny" } } >query ] unit-test
! [ ] [ query ] unit-test
-
;
: test-db ( -- )
diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor
index 534b91b8fc..bff83b5b49 100755
--- a/basis/db/tuples/tuples.factor
+++ b/basis/db/tuples/tuples.factor
@@ -3,7 +3,7 @@
USING: arrays assocs classes db kernel namespaces
classes.tuple words sequences slots math accessors
math.parser io prettyprint db.types continuations
-destructors mirrors ;
+destructors mirrors sets ;
IN: db.tuples
TUPLE: query tuple group order offset limit ;
@@ -30,8 +30,17 @@ HOOK: make-query db ( tuple class query -- statement )
HOOK: insert-tuple* db ( tuple statement -- )
+ERROR: no-slots-named class seq ;
+: check-columns ( class columns -- )
+ tuck
+ [ [ first ] map ]
+ [ "slots" word-prop [ name>> ] map ] bi* diff
+ [ drop ] [ no-slots-named ] if-empty ;
+
: define-persistent ( class table columns -- )
- >r dupd "db-table" set-word-prop dup r>
+ pick dupd
+ check-columns
+ [ dupd "db-table" set-word-prop dup ] dip
[ relation? ] partition swapd
dupd [ spec>tuple ] with map
"db-columns" set-word-prop
From d3044b698ab2104c4d451ea3d27d69fd05de37e2 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 17:01:57 -0500
Subject: [PATCH 82/87] XHTML 1.1
---
extra/websites/concatenative/page.xml | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/extra/websites/concatenative/page.xml b/extra/websites/concatenative/page.xml
index 129dcb1546..2a5cbf7024 100644
--- a/extra/websites/concatenative/page.xml
+++ b/extra/websites/concatenative/page.xml
@@ -1,7 +1,6 @@
<?xml version='1.0' ?>
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
- "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
From 3a11e4d09a39dd91ec6f757b5cbf4bfc80de067b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 19:08:32 -0500
Subject: [PATCH 83/87] Fix rendering issue
---
basis/furnace/chloe-tags/chloe-tags.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/furnace/chloe-tags/chloe-tags.factor b/basis/furnace/chloe-tags/chloe-tags.factor
index d3ed2054b5..faa74d1a16 100644
--- a/basis/furnace/chloe-tags/chloe-tags.factor
+++ b/basis/furnace/chloe-tags/chloe-tags.factor
@@ -111,7 +111,7 @@ CHLOE: form
STRING: button-tag-markup
<t:form class="inline" xmlns:t="http://factorcode.org/chloe/1.0">
- <div><button type="submit"></button></div>
+ <div style="display: inline;"><button type="submit"></button></div>
</t:form>
;
From f16348fe757e872619ce1cd6aa368d534343d283 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 19:29:09 -0500
Subject: [PATCH 84/87] Fix tests
---
.../redirection/redirection-tests.factor | 20 +++++++++++--------
1 file changed, 12 insertions(+), 8 deletions(-)
diff --git a/basis/http/server/redirection/redirection-tests.factor b/basis/http/server/redirection/redirection-tests.factor
index c7a1370397..14855ca875 100644
--- a/basis/http/server/redirection/redirection-tests.factor
+++ b/basis/http/server/redirection/redirection-tests.factor
@@ -15,35 +15,39 @@ namespaces tools.test present kernel ;
>>url
request set
- [ "http://www.apple.com:80/xxx/bar" ] [
+ [ "http://www.apple.com/xxx/bar" ] [
<url> relative-to-request present
] unit-test
- [ "http://www.apple.com:80/xxx/baz" ] [
+ [ "http://www.apple.com/xxx/baz" ] [
<url> "baz" >>path relative-to-request present
] unit-test
- [ "http://www.apple.com:80/xxx/baz?c=d" ] [
+ [ "http://www.apple.com/xxx/baz?c=d" ] [
<url> "baz" >>path { { "c" "d" } } >>query relative-to-request present
] unit-test
- [ "http://www.apple.com:80/xxx/bar?c=d" ] [
+ [ "http://www.apple.com/xxx/bar?c=d" ] [
<url> { { "c" "d" } } >>query relative-to-request present
] unit-test
- [ "http://www.apple.com:80/flip" ] [
+ [ "http://www.apple.com/flip" ] [
<url> "/flip" >>path relative-to-request present
] unit-test
- [ "http://www.apple.com:80/flip?c=d" ] [
+ [ "http://www.apple.com/flip?c=d" ] [
<url> "/flip" >>path { { "c" "d" } } >>query relative-to-request present
] unit-test
- [ "http://www.jedit.org:80/" ] [
+ [ "http://www.jedit.org/" ] [
"http://www.jedit.org" >url relative-to-request present
] unit-test
- [ "http://www.jedit.org:80/?a=b" ] [
+ [ "http://www.jedit.org/?a=b" ] [
"http://www.jedit.org" >url { { "a" "b" } } >>query relative-to-request present
] unit-test
+
+ [ "http://www.jedit.org:1234/?a=b" ] [
+ "http://www.jedit.org:1234" >url { { "a" "b" } } >>query relative-to-request present
+ ] unit-test
] with-scope
From 94ec8c7f78d00ae6c1ed683ca52d7231771555a4 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 23 Sep 2008 20:34:33 -0500
Subject: [PATCH 85/87] search all-slots instead
---
basis/db/tuples/tuples.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor
index bff83b5b49..2bdbb138d7 100755
--- a/basis/db/tuples/tuples.factor
+++ b/basis/db/tuples/tuples.factor
@@ -34,7 +34,7 @@ ERROR: no-slots-named class seq ;
: check-columns ( class columns -- )
tuck
[ [ first ] map ]
- [ "slots" word-prop [ name>> ] map ] bi* diff
+ [ all-slots [ name>> ] map ] bi* diff
[ drop ] [ no-slots-named ] if-empty ;
: define-persistent ( class table columns -- )
From f1317758343b99d956a0d81b86abce82d8b01d30 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 22:01:19 -0500
Subject: [PATCH 86/87] Fix Chloe unit tests
---
basis/html/templates/chloe/chloe-tests.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/html/templates/chloe/chloe-tests.factor b/basis/html/templates/chloe/chloe-tests.factor
index 3fd0d00712..5114b4088a 100644
--- a/basis/html/templates/chloe/chloe-tests.factor
+++ b/basis/html/templates/chloe/chloe-tests.factor
@@ -134,7 +134,7 @@ TUPLE: person first-name last-name ;
[ ] [ H{ { "a" H{ { "b" "c" } } } } values set ] unit-test
-[ "<form method='post' action='foo'><input type='hidden' name='__n' value='a'/></form>" ] [
+[ "<form method='post' action='foo'><div style='display: none;'><input type='hidden' name='__n' value='a'/></div></form>" ] [
[
"test10" test-template call-template
] run-template
From f435e1cf75a2864f5af3c7abc8fa10dbffd51cb4 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 23 Sep 2008 22:01:26 -0500
Subject: [PATCH 87/87] Docs for html.*
---
basis/html/components/components-docs.factor | 105 +++++++
basis/html/components/components.factor | 3 +
basis/html/elements/elements-docs.factor | 29 ++
basis/html/elements/elements.factor | 41 +--
basis/html/forms/forms-docs.factor | 125 ++++++++
basis/html/forms/forms.factor | 2 +-
basis/html/streams/streams-docs.factor | 32 +++
basis/html/streams/streams.factor | 2 +-
basis/html/templates/chloe/chloe-docs.factor | 284 +++++++++++++++++++
basis/html/templates/fhtml/fhtml-docs.factor | 14 +
basis/html/templates/templates-docs.factor | 89 ++++++
basis/html/templates/templates.factor | 2 +-
12 files changed, 685 insertions(+), 43 deletions(-)
create mode 100644 basis/html/components/components-docs.factor
create mode 100644 basis/html/elements/elements-docs.factor
create mode 100644 basis/html/forms/forms-docs.factor
create mode 100644 basis/html/streams/streams-docs.factor
create mode 100644 basis/html/templates/chloe/chloe-docs.factor
create mode 100644 basis/html/templates/fhtml/fhtml-docs.factor
create mode 100644 basis/html/templates/templates-docs.factor
diff --git a/basis/html/components/components-docs.factor b/basis/html/components/components-docs.factor
new file mode 100644
index 0000000000..d7690b30e2
--- /dev/null
+++ b/basis/html/components/components-docs.factor
@@ -0,0 +1,105 @@
+! Copyright (C) 2008 Your name.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax io.streams.string kernel strings
+urls lcs inspector present io ;
+IN: html.components
+
+HELP: checkbox
+{ $class-description "Checkbox components render a boolean value. The " { $slot "label" } " slot must be set to a string." } ;
+
+HELP: choice
+{ $class-description "Choice components render a popup menu or list box with either single or multiple selection."
+$nl
+"The " { $slot "multiple" } " slot determines whether multiple elements may be selected at once; if this is set to a true value, then the component value must be a sequence of strings, otherwise it must be a single string."
+$nl
+"The " { $slot "size" } " slot determines the number of items visible at one time; if neither this nor " { $slot "multiple" } " is set, the component is rendered as a popup menu rather than a list."
+$nl
+"The " { $slot "choices" } " slot determines all possible choices which may be selected. It names a value, rather than storing the choices directly." } ;
+
+HELP: code
+{ $class-description "Code components render string value with the " { $vocab-link "xmode.code2html" } " syntax highlighting vocabulary. The " { $slot "mode" } " slot names a value holding an XMode mode name." } ;
+
+HELP: field
+{ $class-description "Field components display a one-line editor for a string value. The " { $slot "size" } " slot determines the maximum displayed width of the field." } ;
+
+HELP: password
+{ $class-description "Password field components display a one-line editor which obscures the user's input. The " { $slot "size" } " slot determines the maximum displayed width of the field. Unlike other components, on failed validation, the contents of a password field are not sent back to the client. This is a security feature, intended to avoid revealing the password to potential snoopers who use the " { $strong "View Source" } " feature." } ;
+
+HELP: textarea
+{ $class-description "Text area components display a multi-line editor for a string value. The " { $slot "rows" } " and " { $slot "cols" } " properties determine the size of the text area." } ;
+
+HELP: link
+{ $description "Link components render a link to an object stored at a value, with the link title and URL determined by the " { $link link-title } " and " { $link link-href } " generic words." } ;
+
+HELP: link-title
+{ $values { "obj" object } { "string" string } }
+{ $description "Outputs the title to render for a link to the object." } ;
+
+HELP: link-href
+{ $values { "obj" object } { "url" "a " { $link string } " or " { $link url } } }
+{ $description "Outputs the URL to render for a link to the object." } ;
+
+ARTICLE: "html.components.links" "Link components"
+"Link components render a link to an object."
+{ $subsection link }
+"The link title and URL are determined by passing the object to a pair of generic words:"
+{ $subsection link-title }
+{ $subsection link-href }
+"The generic words provide methods on the " { $link string } " and " { $link url } " classes which treat the object as a URL. New methods can be defined for rendering links to custom data types." ;
+
+HELP: comparison
+{ $description "Comparison components render diffs output by the " { $link diff } " word." } ;
+
+HELP: farkup
+{ $description "Farkup components render " { $link "farkup" } "." } ;
+
+HELP: hidden
+{ $description "Hidden components render as a hidden form field. For example, a page for editing a weblog post might contain a hidden field with the post ID." } ;
+
+HELP: html
+{ $description "HTML components render HTML verbatim, without any escaping. Care must be taken to only render trusted input, to avoid cross-site scripting attacks." } ;
+
+HELP: inspector
+{ $description "Inspector components render an arbitrary object by passing it to the " { $link describe } " word." } ;
+
+HELP: label
+{ $description "Label components render an object as a piece of text by passing it to the " { $link present } " word." } ;
+
+HELP: render
+{ $values { "name" "a value name" } { "renderer" "a component renderer" } }
+{ $description "Renders an HTML component to the " { $link output-stream } "." } ;
+
+HELP: render*
+{ $values { "value" "a value" } { "name" "a value name" } { "renderer" "a component renderer" } }
+{ $contract "Renders an HTML component to the " { $link output-stream } "." } ;
+
+ARTICLE: "html.components" "HTML components"
+"The " { $vocab-link "html.components" } " vocabulary provides various HTML form components."
+$nl
+"Most web applications can use the " { $vocab-link "html.templates.chloe" } " templating framework instead of using this vocabulary directly. Where maximum flexibility is required, this vocabulary can be used together with the " { $vocab-link "html.templates.fhtml" } " templating framework."
+$nl
+"Rendering components:"
+{ $subsection render }
+"Components render a named value, and the name of the value is passed in every time the component is rendered, rather than being associated with the component itself. Named values are taken from the current HTML form (see " { $link "html.forms" } ")."
+$nl
+"Component come in two varieties: singletons and tuples. Components with no configuration are singletons; they do not have to instantiated, rather the class word represents the component. Tuple components have to be instantiated and offer configuration options."
+$nl
+"Singleton components:"
+{ $subsection hidden }
+{ $subsection link }
+{ $subsection inspector }
+{ $subsection comparison }
+{ $subsection html }
+"Tuple components:"
+{ $subsection field }
+{ $subsection password }
+{ $subsection textarea }
+{ $subsection choice }
+{ $subsection checkbox }
+{ $subsection code }
+{ $subsection farkup }
+"Creating custom components:"
+{ $subsection render* }
+"Custom components can emit HTML using the " { $vocab-link "html.elements" } " vocabulary." ;
+
+ABOUT: "html.components"
diff --git a/basis/html/components/components.factor b/basis/html/components/components.factor
index a46f595459..b78e3473a7 100644
--- a/basis/html/components/components.factor
+++ b/basis/html/components/components.factor
@@ -146,6 +146,9 @@ M: code render*
! Farkup component
TUPLE: farkup no-follow disable-images parsed ;
+: <farkup> ( -- farkup )
+ farkup new ;
+
: string>boolean ( string -- boolean )
{
{ "true" [ t ] }
diff --git a/basis/html/elements/elements-docs.factor b/basis/html/elements/elements-docs.factor
new file mode 100644
index 0000000000..f6e15e46cd
--- /dev/null
+++ b/basis/html/elements/elements-docs.factor
@@ -0,0 +1,29 @@
+IN: html.elements
+USING: help.markup help.syntax io present ;
+
+ARTICLE: "html.elements" "HTML elements"
+"The " { $vocab-link "html.elements" } " vocabulary provides words for writing HTML tags to the " { $link output-stream } " with a familiar look and feel in the code."
+$nl
+"HTML tags can be used in a number of different ways. The simplest is a tag with no attributes:"
+{ $code "<p> \"someoutput\" write </p>" }
+"In the above, " { $link <p> } " will output the opening tag with no attributes. and " { $link </p> } " will output the closing tag."
+{ $code "<p \"red\" =class p> \"someoutput\" write </p>" }
+"This time the opening tag does not have the '>'. Any attribute words used between the calls to " { $link <p } " and " { $link p> } " will write an attribute whose value is the top of the stack. Attribute values can be any object supported by the " { $link present } " word."
+$nl
+"Values for attributes can be used directly without any stack operations. Assuming we have a string on the stack, all three of the below will output a link:"
+{ $code "<a =href a> \"Click me\" write </a>" }
+{ $code "<a \"http://\" prepend =href a> \"click\" write </a>" }
+{ $code "<a [ \"http://\" % % ] \"\" make =href a> \"click\" write </a>" }
+"Tags that have no ``closing'' equivalent have a trailing " { $snippet "tag/>" } " form:"
+{ $code "<input \"text\" =type \"name\" =name 20 =size input/>" }
+"For the full list of HTML tags and attributes, consult the word list for the " { $vocab-link "html.elements" } " vocabulary. In addition to HTML tag and attribute words, a few utilities are provided."
+$nl
+"Writing unescaped HTML to " { $vocab-link "html.streams" } ":"
+{ $subsection write-html }
+{ $subsection print-html }
+"Writing some common HTML patterns:"
+{ $subsection xhtml-preamble }
+{ $subsection simple-page }
+{ $subsection render-error } ;
+
+ABOUT: "html.elements"
diff --git a/basis/html/elements/elements.factor b/basis/html/elements/elements.factor
index ced2f700dc..c7281df54d 100644
--- a/basis/html/elements/elements.factor
+++ b/basis/html/elements/elements.factor
@@ -9,45 +9,6 @@ urls math math.parser combinators present fry ;
IN: html.elements
-! These words are used to provide a means of writing
-! formatted HTML to standard output with a familiar 'html' look
-! and feel in the code.
-!
-! HTML tags can be used in a number of different ways. The highest
-! level involves a similar syntax to HTML:
-!
-! <p> "someoutput" write </p>
-!
-! <p> will output the opening tag and </p> will output the closing
-! tag with no attributes.
-!
-! <p "red" =class p> "someoutput" write </p>
-!
-! This time the opening tag does not have the '>'. It pushes
-! a namespace on the stack to hold the attributes and values.
-! Any attribute words used will store the attribute and values
-! in that namespace. Before the attribute word should come the
-! value of that attribute.
-! The finishing word will print out the operning tag including
-! attributes.
-! Any writes after this will appear after the opening tag.
-!
-! Values for attributes can be used directly without any stack
-! operations:
-!
-! (url -- )
-! <a =href a> "Click me" write </a>
-!
-! (url -- )
-! <a "http://" prepend =href a> "click" write </a>
-!
-! (url -- )
-! <a [ "http://" % % ] "" make =href a> "click" write </a>
-!
-! Tags that have no 'closing' equivalent have a trailing tag/> form:
-!
-! <input "text" =type "name" =name "20" =size input/>
-
SYMBOL: html
: write-html ( str -- )
@@ -170,7 +131,7 @@ SYMBOL: html
: xhtml-preamble ( -- )
"<?xml version=\"1.0\"?>" write-html
- "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">" write-html ;
+ "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">" write-html ;
: simple-page ( title quot -- )
#! Call the quotation, with all output going to the
diff --git a/basis/html/forms/forms-docs.factor b/basis/html/forms/forms-docs.factor
new file mode 100644
index 0000000000..7a2134c996
--- /dev/null
+++ b/basis/html/forms/forms-docs.factor
@@ -0,0 +1,125 @@
+IN: html.forms
+USING: help.markup help.syntax strings quotations kernel assocs ;
+
+HELP: <form>
+{ $values { "form" form } }
+{ $description "Creates a new form. Usually " { $link with-form } " is used instead." } ;
+
+HELP: form
+{ $var-description "Variable holding current form. Bound by " { $link with-form } ", " { $link nest-form } " and " { $link begin-form } "." }
+{ $class-description "The class of HTML forms. New instances are created by " { $link <form> } "." } ;
+
+HELP: with-form
+{ $values { "name" string } { "quot" quotation } }
+{ $description "Runs the quotation in a new dynamic scope with the " { $link form } " variable rebound to the form stored in the value named " { $snippet "name" } "." } ;
+
+HELP: nest-form
+{ $values { "name" string } { "quot" quotation } }
+{ $description "Runs the quotation in a new dynamic scope with the " { $link form } " variable rebound to a new form, which is subsequently stored in the value named " { $snippet "name" } "." }
+{ $examples
+ "The " { $vocab-link "webapps.pastebin" } " uses a form to display pastes; inside this form it nests another form for creating annotations, and fills in some default values for new annotations:"
+ { $code
+ "<page-action>"
+ " ["
+ " validate-integer-id"
+ " \"id\" value paste from-object"
+ ""
+ " \"id\" value"
+ " \"new-annotation\" ["
+ " \"parent\" set-value"
+ " mode-names \"modes\" set-value"
+ " \"factor\" \"mode\" set-value"
+ " ] nest-form"
+ " ] >>init"
+ }
+} ;
+
+HELP: begin-form
+{ $description "Begins a new form." } ;
+
+HELP: value
+{ $values { "name" string } { "value" object } }
+{ $description "Gets a form value. This word is used to get form field values after validation." } ;
+
+HELP: set-value
+{ $values { "value" object } { "name" string } }
+{ $description "Sets a form value. This word is used to preset form field values before rendering." } ;
+
+HELP: from-object
+{ $values { "object" object } }
+{ $description "Sets the current form's values to the object's slot values." }
+{ $examples
+ "Here is a typical action implementation, which selects a golf course object from the database with the ID specified in the HTTP request, and renders a form with values from this object:"
+ { $code
+ "<page-action>"
+ ""
+ " ["
+ " validate-integer-id"
+ " \"id\" value <golf-course>"
+ " select-tuple from-object"
+ " ] >>init"
+ ""
+ " { golf \"view-course\" } >>template"
+ }
+} ;
+
+HELP: to-object
+{ $values { "destination" object } { "names" "a sequence of value names" } }
+{ $description "Stores the given sequence of form values into the slots of the object having the same names. This word is used to extract form field values after validation." } ;
+
+HELP: with-each-value
+{ $values { "name" string } { "quot" quotation } }
+{ $description "Calls the quotation with each element of the value named " { $snippet "name" } "; the value must be a sequence. The quotation is called in a new dynamic scope with the " { $snippet "index" } " and " { $snippet "value" } " values set to the one-based index, and the sequence element in question, respectively." }
+{ $notes "This word is used to implement the " { $snippet "t:each" } " tag of the " { $vocab-link "html.templates.chloe" } " templating system. It can also be called directly from " { $vocab-link "html.templates.fhtml" } " templates." } ;
+
+HELP: with-each-object
+{ $description "Calls the quotation with each element of the value named " { $snippet "name" } "; the value must be a sequence. The quotation is called in a new dynamic scope where the object's slots become named values, as if " { $link from-object } " was called." }
+{ $notes "This word is used to implement the " { $snippet "t:bind-each" } " tag of the " { $vocab-link "html.templates.chloe" } " templating system. It can also be called directly from " { $vocab-link "html.templates.fhtml" } " templates." } ;
+
+HELP: validation-failed?
+{ $values { "?" "a boolean" } }
+{ $description "Tests if validation of the current form failed." } ;
+
+HELP: validate-values
+{ $values { "assoc" assoc } { "validators" "an assoc mapping value names to quotations" } }
+{ $description "Validates values in the assoc by looking up the corresponding validation quotation, and storing the results in named values of the current form." } ;
+
+ARTICLE: "html.forms.forms" "HTML form infrastructure"
+"The below words are used to implement the " { $vocab-link "furnace.actions" } " vocabulary. Calling them directly is rarely necessary."
+$nl
+"Creating a new form:"
+{ $subsection <form> }
+"Variable holding current form:"
+{ $subsection form }
+"Working with forms:"
+{ $subsection with-form }
+{ $subsection begin-form }
+"Validation:"
+{ $subsection validation-error }
+{ $subsection validation-failed? }
+{ $subsection validate-values } ;
+
+ARTICLE: "html.forms.values" "HTML form values"
+"Form values are a central concept in the Furnace framework. Web actions primarily concern themselves with validating values, marshalling values to a database, and setting values for display in a form."
+$nl
+"Getting and setting values:"
+{ $subsection value }
+{ $subsection set-value }
+{ $subsection from-object }
+{ $subsection to-object }
+"Iterating over values; these words are used by " { $vocab-link "html.templates.chloe" } " to implement the " { $snippet "t:each" } " and " { $snippet "t:bind-each" } " tags:"
+{ $subsection with-each-value }
+{ $subsection with-each-object }
+"Nesting a form inside another form as a value:"
+{ $subsection nest-form } ;
+
+ARTICLE: "html.forms" "HTML forms"
+"The " { $vocab-link "html.forms" } " vocabulary implements support for rendering and validating HTML forms. The definition of a " { $emphasis "form" } " is a bit more general than the content of an " { $snippet "<form>" } " tag. Namely, a page which displays a database record without offering any editing capability is considered a form too; it consists entirely of read-only components."
+$nl
+"This vocabulary is an integral part of the " { $vocab-link "furnace" } " web framework. The " { $vocab-link "html.templates.chloe" } " vocabulary uses the HTML form words to implement various template tags. The words are also often used directly from web action implementations."
+$nl
+"This vocabulary can be used without either the Furnace framework or the HTTP server; for example, as part of a static HTML generation tool."
+{ $subsection "html.forms.forms" }
+{ $subsection "html.forms.values" } ;
+
+ABOUT: "html.forms"
diff --git a/basis/html/forms/forms.factor b/basis/html/forms/forms.factor
index 7dd4b6146b..c1c1aa3def 100644
--- a/basis/html/forms/forms.factor
+++ b/basis/html/forms/forms.factor
@@ -102,5 +102,5 @@ C: <validation-error> validation-error
dup validation-error? [ form get t >>validation-failed drop ] when
swap set-value ;
-: validate-values ( assoc validators -- assoc' )
+: validate-values ( assoc validators -- )
swap '[ [ dup _ at ] dip validate-value ] assoc-each ;
diff --git a/basis/html/streams/streams-docs.factor b/basis/html/streams/streams-docs.factor
new file mode 100644
index 0000000000..7c5bea805d
--- /dev/null
+++ b/basis/html/streams/streams-docs.factor
@@ -0,0 +1,32 @@
+IN: html.streams
+USING: help.markup help.syntax kernel strings io io.styles
+quotations ;
+
+HELP: browser-link-href
+{ $values { "presented" object } { "href" string } }
+{ $contract "Outputs a link to a page displaying a presentation of the given object. This word is called when " { $link write-object } " is called on " { $link html-stream } " instances." } ;
+
+HELP: html-stream
+{ $class-description "A formatted output stream which emits HTML markup." } ;
+
+HELP: <html-stream>
+{ $values { "stream" "an output stream" } { "html-stream" html-stream } }
+{ $description "Creates a new formatted output stream which emits HTML markup on " { $snippet "stream" } "." } ;
+
+HELP: with-html-stream
+{ $values { "quot" quotation } }
+{ $description "Calls the quotation in a new dynamic scope with " { $link output-stream } " rebound to an " { $link html-stream } " wrapping the current " { $link output-stream } "." }
+{ $examples
+ { $example
+ "[ \"Hello\" { { font-style bold } } format nl ] with-html-stream"
+ "<span style='font-style: normal; font-weight: bold; '>Hello</span><br/>"
+ }
+} ;
+
+ARTICLE: "html.streams" "HTML streams"
+"The " { $vocab-link "html.streams" } " vocabulary provides a stream which implements " { $link "styles" } " by writing HTML markup to the wrapped stream."
+{ $subsection html-stream }
+{ $subsection <html-stream> }
+{ $subsection with-html-stream } ;
+
+ABOUT: "html.streams"
diff --git a/basis/html/streams/streams.factor b/basis/html/streams/streams.factor
index 7d90296fcb..7d0fe9b17c 100755
--- a/basis/html/streams/streams.factor
+++ b/basis/html/streams/streams.factor
@@ -25,7 +25,7 @@ TUPLE: html-stream stream last-div ;
: a-div ( stream -- straem )
t >>last-div ; inline
-: <html-stream> ( stream -- stream )
+: <html-stream> ( stream -- html-stream )
f html-stream boa ;
<PRIVATE
diff --git a/basis/html/templates/chloe/chloe-docs.factor b/basis/html/templates/chloe/chloe-docs.factor
new file mode 100644
index 0000000000..b97a4c5c35
--- /dev/null
+++ b/basis/html/templates/chloe/chloe-docs.factor
@@ -0,0 +1,284 @@
+IN: html.templates.chloe
+USING: help.markup help.syntax html.components html.forms
+html.templates html.templates.chloe.syntax
+html.templates.chloe.compiler html.templates.chloe.components
+math xml.data strings quotations namespaces ;
+
+HELP: <chloe> ( path -- template )
+{ $values { "path" "a pathname string without the trailing " { $snippet ".xml" } " extension" } { "template" chloe } }
+{ $description "Creates a new Chloe template object which can be passed to " { $link call-template } "." } ;
+
+HELP: required-attr
+{ $values { "tag" tag } { "name" string } { "value" string } }
+{ $description "Extracts an attribute from a tag." }
+{ $errors "Throws an error if the attribute is not specified." } ;
+
+HELP: optional-attr
+{ $values { "tag" tag } { "name" string } { "value" "a " { $link string } " or " { $link f } } }
+{ $description "Extracts an attribute from a tag." }
+{ $notes "Outputs " { $link f } " if the attribute is not specified." } ;
+
+HELP: compile-attr
+{ $values { "value" "an attribute value" } }
+{ $description "Compiles code which pushes an attribute value previously extracted by " { $link required-attr } " or " { $link optional-attr } " on the stack. If the attribute value begins with " { $snippet "@" } ", compiles into code which pushes the a form value." } ;
+
+HELP: CHLOE:
+{ $syntax "name definition... ;" }
+{ $values { "name" "the tag name" } { "definition" "a quotation with stack effect " { $snippet "( tag -- )" } } }
+{ $description "Defines compilation semantics for the Chloe tag named " { $snippet "tag" } ". The definition body receives a " { $link tag } " on the stack." } ;
+
+HELP: CHLOE-SINGLETON:
+{ $syntax "CHLOE-SINGLETON: name" }
+{ $description "Defines a Chloe tag named " { $snippet "name" } " rendering an HTML component with singleton class word " { $snippet "name" } ". See " { $link "html.components" } "." } ;
+
+HELP: CHLOE-TUPLE:
+{ $syntax "CHLOE-TUPLE: name" }
+{ $description "Defines a Chloe tag named " { $snippet "name" } " rendering an HTML component with tuple class word " { $snippet "name" } ". See " { $link "html.components" } "." } ;
+
+HELP: reset-cache
+{ $description "Resets the compiled template cache. Chloe automatically recompiles templates when their file changes on disk, however other when redefining Chloe tags or words which they call, the cache may have to be reset manually for the changes to take effect." } ;
+
+HELP: tag-stack
+{ $var-description "During template compilation, holds the current nesting of XML element names. Can be used from " { $link POSTPONE: CHLOE: } " definitions to make a custom tag behave differently depending on how it is nested." } ;
+
+HELP: [write]
+{ $values { "string" string } }
+{ $description "Compiles code which writes the string when the template is called." } ;
+
+HELP: [code]
+{ $values { "quot" quotation } }
+{ $description "Compiles the quotation. It will be called when the template is called." } ;
+
+HELP: process-children
+{ $values { "tag" tag } { "quot" "a quotation with stack effect " { $snippet "( compiled-tag -- )" } } }
+{ $description "Compiles the tag. The quotation will be applied to the resulting quotation when the template is called." }
+{ $examples "See " { $link "html.templates.chloe.extend.tags.example" } " for an example which uses this word to implement a custom control flow tag." } ;
+
+HELP: compile-children>string
+{ $values { "tag" tag } }
+{ $description "Compiles the tag so that the output it generates is written to a string, which is pushed on the stack when the template runs. A subsequent " { $link [code] } " call must be made with a quotation which consumes the string." } ;
+
+HELP: compile-with-scope
+{ $values { "quot" quotation } }
+{ $description "Calls the quotation and wraps any output it compiles in a " { $link with-scope } " form." } ;
+
+ARTICLE: "html.templates.chloe.tags.component" "Component Chloe tags"
+"The following Chloe tags correspond exactly to " { $link "html.components" } ". Singleton component tags do not allow any attributes. Attributes of tuple component tags are mapped to tuple slot values of the component instance."
+{ $table
+ { "Tag" "Component class" }
+ { { $snippet "t:checkbox" } { $link checkbox } }
+ { { $snippet "t:choice" } { $link choice } }
+ { { $snippet "t:code" } { $link code } }
+ { { $snippet "t:comparison" } { $link comparison } }
+ { { $snippet "t:farkup" } { $link farkup } }
+ { { $snippet "t:field" } { $link field } }
+ { { $snippet "t:hidden" } { $link hidden } }
+ { { $snippet "t:html" } { $link html } }
+ { { $snippet "t:inspector" } { $link inspector } }
+ { { $snippet "t:label" } { $link label } }
+ { { $snippet "t:link" } { $link link } }
+ { { $snippet "t:password" } { $link password } }
+ { { $snippet "t:textarea" } { $link textarea } }
+} ;
+
+ARTICLE: "html.templates.chloe.tags.boilerplate" "Boilerplate Chloe tags"
+"The following Chloe tags interface with the HTML templating " { $link "html.templates.boilerplate" } "."
+$nl
+"The tags marked with (*) are only available if the " { $vocab-link "furnace.chloe-tags" } " vocabulary is loaded."
+{ $table
+ { { $snippet "t:title" } "Sets the title from a child template" }
+ { { $snippet "t:write-title" } "Renders the child's title from a master template" }
+ { { $snippet "t:style" } "Adds CSS markup from a child template" }
+ { { $snippet "t:write-style" } "Renders the children's CSS from a master template" }
+ { { $snippet "t:atom" } "Adds an Atom feed link from a child template (*)" }
+ { { $snippet "t:write-atom" } "Renders the children's list of Atom feed links (*)" }
+ { { $snippet "t:call-next-template" } "Calls the child template from a master template" }
+} ;
+
+ARTICLE: "html.templates.chloe.tags.control" "Control-flow Chloe tags"
+"While most control flow and logic should be embedded in the web actions themselves and not in the template, Chloe templates do support a minimal amount of control flow."
+{ $table
+ { { $snippet "t:comment" } "All markup within a comment tag is ignored by the compiler." }
+ { { $snippet "t:bind" } { "Renders child content bound to a nested form named by the " { $snippet "t:name" } " attribute. See " { $link with-form } "." } }
+ { { $snippet "t:each" } { "Renders child content once for each element of the sequence in the value named by the " { $snippet "t:name" } " attribute. The sequence element and index are bound to the " { $snippet "value" } " and " { $snippet "index" } " values, respectively. See " { $link with-each-value } "." } }
+ { { $snippet "t:bind-each" } { "Renders child content once for each element of the sequence in the value named by the " { $snippet "t:name" } " attribute. The sequence element's slots are bound to values. See " { $link with-each-object } "." } }
+ { { $snippet "t:even" } { "Only valid inside a " { $snippet "t:each" } " or " { $snippet "t:bind-each" } ". Only renders child content if the " { $snippet "index" } " value is even." } }
+ { { $snippet "t:odd" } "As above, but only if the index value is odd." }
+ { { $snippet "t:if" } { "Renders child content if a boolean condition evaluates to true. The condition value is determined by the " { $snippet "t:code" } " or " { $snippet "t:value" } " attribute, exactly one of which must be specified. The former is a string of the form " { $snippet "vocabulary:word" } " denoting a word to execute with stack effect " { $snippet "( -- ? )" } ". The latter is a value name." } }
+} ;
+
+ARTICLE: "html.templates.chloe.tags.form" "Chloe link and form tags"
+"The following tags are only available if the " { $vocab-link "furnace.chloe-tags" } " vocabulary is loaded."
+{ $table
+ { { $snippet "t:a" } { "Renders a link; extends the standard XHTML " { $snippet "a" } " tag by providing some integration with other web framework features. The following attributes are supported:"
+ { $list
+ { { $snippet "href" } " - a URL. If it begins with " { $snippet "$" } ", then it is interpreted as a responder-relative path." }
+ { { $snippet "rest" } " - a value to add at the end of the URL." }
+ { { $snippet "query" } " - a comma-separated list of value names defined in the current form which are to be passed to the link as query parameters." }
+ { { $snippet "value" } " - a value name holding a URL. If this attribute is specified, it overrides all others." }
+ }
+ "Any attributes not in the Chloe XML namespace are passed on to the generated " { $snippet "a" } " tag."
+ $nl
+ "An example:"
+ { $code
+ "<t:a t:href=\"$wiki/view/\""
+ " t:rest=\"title\""
+ " class=\"small-link\">"
+ " View"
+ "</t:a>"
+ }
+ "The above might render as"
+ { $code
+ "<a href=\"http://mysite.org/wiki/view/Factor\""
+ " class=\"small-link\">"
+ " View"
+ "s</a>"
+ }
+ } }
+ { { $snippet "t:form" } {
+ "Renders a form; extends the standard XHTML " { $snippet "form" } " tag by providing some integration with other web framework features, for example by adding hidden fields for authentication credentials and session management allowing those features to work with form submission transparently. The following attributes are supported:"
+ { $list
+ { { $snippet "t:method" } " - just like the " { $snippet "method" } " attribute of an HTML " { $snippet "form" } " tag, this can equal " { $snippet "get" } " or " { $snippet "post" } ". Unlike the HTML tag, the default is " { $snippet "post" } "." }
+ { { $snippet "t:action" } " - a URL. If it begins with " { $snippet "$" } ", then it is interpreted as a responder-relative path." }
+ { { $snippet "t:for" } " - a comma-separated list of form values which are to be inserted in the form as hidden fields. Other than being more concise, this is equivalent to nesting a series of " { $snippet "t:hidden" } " tags inside the form." }
+ }
+ "Any attributes not in the Chloe XML namespace are passed on to the generated " { $snippet "form" } " tag."
+ } }
+ { { $snippet "t:button" } {
+ "Shorthand for a form with a single button, whose label is the text child of the " { $snippet "t:button" } " tag. Attributes are processed as with the " { $snippet "t:form" } " tag, with the exception that any attributes not in the Chloe XML namespace are passed on to the generated " { $snippet "button" } " tag, rather than the " { $snippet "form" } " tag surrounding it."
+ $nl
+ "An example:"
+ { $code
+ "<t:button t:method=\"POST\""
+ " t:action=\"$wiki/delete\""
+ " t:for=\"id\">"
+ " class=\"link-button\""
+ " Delete"
+ "</t:button>"
+ }
+ } }
+} ;
+
+ARTICLE: "html.templates.chloe.tags" "Standard Chloe tags"
+"A Chloe template is an XML file with a mix of standard XHTML and Chloe tags."
+$nl
+"XHTML tags are rendered verbatim, except attribute values which begin with " { $snippet "@" } " are replaced with the corresponding " { $link "html.forms.values" } "."
+$nl
+"Chloe tags are defined in the " { $snippet "http://factorcode.org/chloe/1.0" } " namespace; by convention, it is bound with a prefix of " { $snippet "t" } ". The top-level tag must always be the " { $snippet "t:chloe" } " tag. A typical Chloe template looks like so:"
+{ $code
+ "<?xml version=\"1.0\"?>"
+ ""
+ "<t:chloe xmlns:t=\"http://factorcode.org/chloe/1.0\">"
+ " ..."
+ "</t:chloe>"
+}
+{ $subsection "html.templates.chloe.tags.component" }
+{ $subsection "html.templates.chloe.tags.boilerplate" }
+{ $subsection "html.templates.chloe.tags.control" }
+{ $subsection "html.templates.chloe.tags.form" } ;
+
+ARTICLE: "html.templates.chloe.extend" "Extending Chloe"
+"The " { $vocab-link "html.templates.chloe.syntax" } " and " { $vocab-link "html.templates.chloe.compiler" } " vocabularies contain the heart of the Chloe implementation."
+$nl
+"Chloe is implemented as a compiler which converts XML templates into Factor quotations. The template only has to be parsed and compiled once, and not on every HTTP request. This helps improve performance and memory usage."
+$nl
+"These vocabularies provide various hooks by which Chloe can be extended. First of all, new " { $link "html.components" } " can be wired in. If further flexibility is needed, entirely new tags can be defined by hooking into the Chloe compiler."
+{ $subsection "html.templates.chloe.extend.components" }
+{ $subsection "html.templates.chloe.extend.tags" } ;
+
+ARTICLE: "html.templates.chloe.extend.tags" "Extending Chloe with custom tags"
+"Syntax for defining custom tags:"
+{ $subsection POSTPONE: CHLOE: }
+"A number of compiler words can be used from the " { $link POSTPONE: CHLOE: } " body to emit compiled template code."
+$nl
+"Extracting attributes from the XML tag:"
+{ $subsection required-attr }
+{ $subsection optional-attr }
+{ $subsection compile-attr }
+"Examining tag nesting:"
+{ $subsection tag-stack }
+"Generating code for printing strings and calling quotations:"
+{ $subsection [write] }
+{ $subsection [code] }
+"Generating code from child elements:"
+{ $subsection process-children }
+{ $subsection compile-children>string }
+{ $subsection compile-with-scope }
+"Examples which illustrate some of the above:"
+{ $subsection "html.templates.chloe.extend.tags.example" } ;
+
+ARTICLE: "html.templates.chloe.extend.tags.example" "Examples of custom Chloe tags"
+"As a first example, let's develop a custom Chloe tag which simply renders a random number. The tag will be used as follows:"
+{ $code
+ "<t:random t:min='10' t:max='20' t:generator='system' />"
+}
+"The " { $snippet "t:min" } " and " { $snippet "t:max" } " parameters are required, and " { $snippet "t:generator" } ", which can equal one of " { $snippet "default" } ", " { $snippet "system" } " or " { $snippet "secure" } ", is optional, with the default being " { $snippet "default" } "."
+$nl
+"Here is the " { $link POSTPONE: USING: } " form that we need for the below code to work:"
+{ $code
+ "USING: combinators kernel math.parser math.ranges random"
+ "html.templates.chloe.compiler html.templates.chloe.syntax ;"
+}
+"We write a word which extracts the relevant attributes from an XML tag:"
+{ $code
+ ": random-attrs ( tag -- min max generator )"
+ " [ \"min\" required-attr string>number ]"
+ " [ \"max\" required-attr string>number ]"
+ " [ \"generator\" optional-attr ]"
+ " tri ;"
+}
+"Next, we convert a random generator name into a random generator object:"
+{ $code
+ ": string>random-generator ( string -- generator )"
+ " {"
+ " { \"default\" [ random-generator ] }"
+ " { \"system\" [ system-random-generator ] }"
+ " { \"secure\" [ secure-random-generator ] }"
+ " } case ;"
+}
+"Finally, we can write our Chloe tag:"
+{ $code
+ "CHLOE: random"
+ " random-attrs string>random-generator"
+ " '["
+ " _ _ _"
+ " [ [a,b] random present write ]"
+ " with-random-generator"
+ " ] [code] ;"
+}
+"For the second example, let's develop a Chloe tag which repeatedly renders its child several times, where the number comes from a form value. The tag will be used as follows:"
+{ $code
+ "<t:repeat t:times='n'>Hello world.<br /></t:repeat>"
+}
+"This time, we cannot simply extract the " { $snippet "t:times" } " attribute at compile time since its value cannot be determined then. Instead, we execute " { $link compile-attr } " to generate code which pushes the value of that attribute on the stack. We then use " { $link process-children } " to compile child elements as a nested quotation which we apply " { $link times } " to."
+{ $code
+ "CHLOE: repeat"
+ " [ \"times\" required-attr compile-attr ]"
+ " [ [ times ] process-children ]"
+ " bi ;"
+} ;
+
+ARTICLE: "html.templates.chloe.extend.components.example" "An example of a custom Chloe component"
+"As an example, let's develop a custom Chloe component which renders an image stored in a form value. Since the component does not require any configuration, we can define a singleton class:"
+{ $code "SINGLETON: image" }
+"Now we define a method on the " { $link render* } " generic word which renders the image using " { $vocab-link "html.elements" } ":"
+{ $code "M: image render* 2drop <img =src img/> ;" }
+"Finally, we can define a Chloe component:"
+{ $code "CHLOE-SINGLETON: image" }
+"We can use it as follows, assuming the current form has a value named " { $snippet "image" } ":"
+{ $code "<t:image t:name='image' />" } ;
+
+ARTICLE: "html.templates.chloe.extend.components" "Extending Chloe with custom components"
+"Custom HTML components implementing the " { $link render* } " word can be wired up with Chloe using the following syntax from " { $vocab-link "html.templates.chloe.components" } ":"
+{ $subsection POSTPONE: CHLOE-SINGLETON: }
+{ $subsection POSTPONE: CHLOE-TUPLE: }
+{ $subsection "html.templates.chloe.extend.components.example" } ;
+
+ARTICLE: "html.templates.chloe" "Chloe templates"
+"The " { $vocab-link "html.templates.chloe" } " vocabulary implements an XHTML templating engine. Unlike " { $vocab-link "html.templates.fhtml" } ", Chloe templates are always well-formed XML, and no Factor code can be embedded in them, enforcing proper separation of concerns. Chloe templates can be edited using standard XML editing tools; they are less flexible than FHTML, but often simpler as a result."
+{ $subsection <chloe> }
+{ $subsection reset-cache }
+{ $subsection "html.templates.chloe.tags" }
+{ $subsection "html.templates.chloe.extend" } ;
+
+ABOUT: "html.templates.chloe"
diff --git a/basis/html/templates/fhtml/fhtml-docs.factor b/basis/html/templates/fhtml/fhtml-docs.factor
new file mode 100644
index 0000000000..3d2b2a2240
--- /dev/null
+++ b/basis/html/templates/fhtml/fhtml-docs.factor
@@ -0,0 +1,14 @@
+IN: html.templates.fhtml
+USING: help.markup help.syntax ;
+
+HELP: <fhtml> ;
+
+ARTICLE: "html.templates.fhtml" "FHTML templates"
+"The " { $vocab-link "html.templates.fhtml" } " vocabulary implements a templating engine which mixes markup with Factor code."
+$nl
+"FHTML provides an alternative to " { $vocab-link "html.templates.chloe" } " for situations where complex logic must be embedded in the presentation layer of a web application. While this is discouraged for larger applications, it is useful for prototyping as well as simpler applications."
+$nl
+"The entire syntax of an FHTML template can be summarized as thus: text outside of " { $snippet "<%" } " and " { $snippet "%>" } " is rendered literally. Text inside " { $snippet "<%" } " and " { $snippet "%>" } " is interpreted as Factor source code."
+{ $subsection <fhtml> } ;
+
+ABOUT: "html.templates.fhtml"
diff --git a/basis/html/templates/templates-docs.factor b/basis/html/templates/templates-docs.factor
new file mode 100644
index 0000000000..ff53ca978a
--- /dev/null
+++ b/basis/html/templates/templates-docs.factor
@@ -0,0 +1,89 @@
+IN: html.templates
+USING: help.markup help.syntax io strings quotations xml.data
+continuations urls ;
+
+HELP: template
+{ $class-description "The class of HTML templates." } ;
+
+HELP: call-template*
+{ $values { "template" template } }
+{ $contract "Writes a template to " { $link output-stream } ", possibly using " { $vocab-link "html.forms" } " state."
+$nl
+"In addition to methods added by other vocabularies, this generic word has methods on the following classes:"
+{ $list
+ { { $link string } " - the simplest type of template; simply written to " { $link output-stream } }
+ { { $link callable } " - a custom quotation, called to yield output" }
+ { { $link xml } " - written to " { $link output-stream } }
+ { "an input stream - copied to " { $link output-stream } }
+} } ;
+
+HELP: call-template
+{ $values { "template" template } }
+{ $description "Writes a template to " { $link output-stream } ", possibly using " { $vocab-link "html.forms" } " state."
+$nl
+"This word calls " { $link call-template* } ", wrapping it in a " { $link recover } " form which improves error reporting by combining the underlying error with the template object." } ;
+
+HELP: set-title
+{ $values { "string" string } }
+{ $description "Sets the title of the current page. This is usually called by child templates, and a master template calls " { $link write-title } "." } ;
+
+HELP: write-title
+{ $values { "string" string } }
+{ $description "Writes the title of the current page, previously set by " { $link set-title } ". This is usually called by a master template after rendering a child template." } ;
+
+HELP: add-style
+{ $values { "string" string } }
+{ $description "Adds some CSS markup to the CSS stylesheet of a master template. Usually called by child templates which need to insert CSS style information in the " { $snippet "<head>" } " tag of the resulting HTML page." } ;
+
+HELP: write-style
+{ $description "Writes a CSS stylesheet assembled from " { $link add-style } " calls by child templates. Usually called by the master template to emit a CSS style in the " { $snippet "<head>" } " tag of the resulting HTML page." } ;
+
+HELP: add-atom-feed
+{ $values { "title" string } { "url" "a " { $link string } " or " { $link url } } }
+{ $description "Adds an Atom feed link to the list of feeds in a master template. Usually called by child templates which need to insert an Atom feed link information in the " { $snippet "<head>" } " tag of the resulting HTML page." } ;
+
+HELP: write-atom-feeds
+{ $description "Writes a list of Atom feed links assembled from " { $link add-atom-feed } " calls by child templates. Usually called by the master template to emit a list of Atom feed links in the " { $snippet "<head>" } " tag of the resulting HTML page." } ;
+
+HELP: nested-template?
+{ $var-description "Set to a true value if the current call to " { $link call-template } " is nested inside a " { $link with-boilerplate } " and will therefore appear as part of another template. In this case, XML processing instructions and document type declarations should be omitted." } ;
+
+HELP: call-next-template
+{ $description "Calls the next innermost child template from a master template. This is used to implement the " { $snippet "t:call-next-template" } " tag in the " { $vocab-link "html.templates.chloe" } " templating engine." } ;
+
+HELP: with-boilerplate
+{ $values { "child" template } { "master" template } }
+{ $description "Calls the child template, storing its output in a string, then calls the master template. The master template may call " { $link call-next-template } " to insert the output of the child template at any point; both templates may also use the master/child interface words documented in " { $link "html.templates.boilerplate" } "." } ;
+
+HELP: template-convert
+{ $values { "template" template } { "output" "a pathname string" } }
+{ $description "Calls the template and writes its output to a file with UTF8 encoding." } ;
+
+ARTICLE: "html.templates.boilerplate" "Boilerplate support"
+"The following words define the interface between a templating engine and the " { $vocab-link "furnace.boilerplate" } " vocabulary."
+$nl
+"The master/child template interface follows a pattern where for each concept there is a word called by the child to store an entity, and another word to write the entity out; this solves the problem where certain HTML tags, such as " { $snippet "<title>" } " and " { $snippet "<link>" } " must appear inside the " { $snippet "<head>" } " tag, even though those tags are usually precisely those that the child template will want to set."
+{ $subsection set-title }
+{ $subsection write-title }
+{ $subsection add-style }
+{ $subsection write-style }
+{ $subsection add-atom-feed }
+{ $subsection write-atom-feeds }
+"Processing a master template with a child:"
+{ $subsection with-boilerplate }
+{ $subsection call-next-template } ;
+
+ARTICLE: "html.templates" "HTML template interface"
+"The " { $vocab-link "html.templates" } " vocabulary implements an abstract interface to HTML templating engines. The " { $vocab-link "html.templates.fhtml" } " and " { $vocab-link "html.templates.chloe" } " vocabularies are two implementations of this."
+$nl
+"An HTML template is an instance of a mixin:"
+{ $subsection template }
+"HTML templates must also implement a method on a generic word:"
+{ $subsection call-template* }
+"Calling an HTML template:"
+{ $subsection call-template }
+"Usually HTML templates are invoked dynamically by the Furnace web framework and HTTP server. They can also be used in static HTML generation tools:"
+{ $subsection template-convert }
+{ $subsection "html.templates.boilerplate" } ;
+
+ABOUT: "html.templates"
diff --git a/basis/html/templates/templates.factor b/basis/html/templates/templates.factor
index de774f0864..57418a3e02 100644
--- a/basis/html/templates/templates.factor
+++ b/basis/html/templates/templates.factor
@@ -67,7 +67,7 @@ SYMBOL: next-template
M: f call-template* drop call-next-template ;
-: with-boilerplate ( body template -- )
+: with-boilerplate ( child master -- )
[
title [ <box> or ] change
style [ SBUF" " clone or ] change