From fa15da56ffcefb4d2c6f02c39056656259ae7e98 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 23 Sep 2009 12:04:06 -0500
Subject: [PATCH 01/12] add sample word to random vocab
---
basis/random/random-docs.factor | 12 ++++++++++++
basis/random/random-tests.factor | 5 +++++
basis/random/random.factor | 27 +++++++++++++++++++++++----
3 files changed, 40 insertions(+), 4 deletions(-)
diff --git a/basis/random/random-docs.factor b/basis/random/random-docs.factor
index 222ecaf935..32641f5fc1 100755
--- a/basis/random/random-docs.factor
+++ b/basis/random/random-docs.factor
@@ -72,6 +72,18 @@ HELP: randomize
}
{ $description "Randomizes a sequence in-place with the Fisher-Yates algorithm and returns the sequence." } ;
+HELP: sample
+{ $values
+ { "seq" sequence } { "n" integer }
+ { "seq'" sequence }
+}
+{ $description "Takes " { $snippet "n" } " samples at random without replacement from a sequence. Throws an error if " { $snippet "n" } " is longer than the sequence." }
+{ $examples
+ { $unchecked-example "USING: random prettyprint ; { 1 2 3 } 2 sample ."
+ "{ 3 2 }"
+ }
+} ;
+
HELP: delete-random
{ $values
{ "seq" sequence }
diff --git a/basis/random/random-tests.factor b/basis/random/random-tests.factor
index 2b6ac9b1b8..da8d4a1844 100644
--- a/basis/random/random-tests.factor
+++ b/basis/random/random-tests.factor
@@ -25,3 +25,8 @@ IN: random.tests
[ 100 [ { 0 1 } random ] replicate all-equal? ] unit-test
[ 49 ] [ 50 random-bits* log2 ] unit-test
+
+[ { 1 2 } 3 sample ] [ too-many-samples? ] must-fail-with
+
+[ 3 ] [ { 1 2 3 4 } 3 sample prune length ] unit-test
+[ 99 ] [ 100 99 sample prune length ] unit-test
diff --git a/basis/random/random.factor b/basis/random/random.factor
index 4c94e87928..afdf0b43ba 100755
--- a/basis/random/random.factor
+++ b/basis/random/random.factor
@@ -1,9 +1,9 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types kernel math namespaces sequences
-io.backend io.binary combinators system vocabs.loader
-summary math.bitwise byte-vectors fry byte-arrays
-math.ranges math.constants math.functions accessors ;
+USING: accessors alien.c-types assocs byte-arrays byte-vectors
+combinators fry io.backend io.binary kernel locals math
+math.bitwise math.constants math.functions math.ranges
+namespaces sequences sets summary system vocabs.loader ;
IN: random
SYMBOL: system-random-generator
@@ -60,6 +60,25 @@ PRIVATE>
[ [ iota random ] [ 1 - ] bi [ pick exchange ] keep ]
while drop ;
+ERROR: too-many-samples seq n ;
+
+<PRIVATE
+
+:: next-sample ( length n seq hashtable -- elt )
+ n hashtable key? [
+ length n 1 + length mod seq hashtable next-sample
+ ] [
+ n hashtable conjoin
+ n seq nth
+ ] if ;
+
+PRIVATE>
+
+: sample ( seq n -- seq' )
+ 2dup [ length ] dip < [ too-many-samples ] when
+ swap [ length ] [ ] bi H{ } clone
+ '[ _ dup random _ _ next-sample ] replicate ;
+
: delete-random ( seq -- elt )
[ length random-integer ] keep [ nth ] 2keep delete-nth ;
From 204da68c23d56521760de7e913f31ab148f337c8 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 23 Sep 2009 12:24:50 -0500
Subject: [PATCH 02/12] link to sample
---
basis/random/random-docs.factor | 2 ++
1 file changed, 2 insertions(+)
diff --git a/basis/random/random-docs.factor b/basis/random/random-docs.factor
index 32641f5fc1..bb0fc57312 100755
--- a/basis/random/random-docs.factor
+++ b/basis/random/random-docs.factor
@@ -112,6 +112,8 @@ $nl
{ $subsection "random-protocol" }
"Randomizing a sequence:"
{ $subsection randomize }
+"Sampling a sequences:"
+{ $subsection sample }
"Deleting a random element from a sequence:"
{ $subsection delete-random }
"Random numbers with " { $snippet "n" } " bits:"
From 402e7702963ce113c59945597b52ad0181516a0e Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 23 Sep 2009 12:47:20 -0500
Subject: [PATCH 03/12] fix using
---
basis/math/vectors/simd/simd-docs.factor | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/basis/math/vectors/simd/simd-docs.factor b/basis/math/vectors/simd/simd-docs.factor
index 5153b0c6f4..9b832526d8 100644
--- a/basis/math/vectors/simd/simd-docs.factor
+++ b/basis/math/vectors/simd/simd-docs.factor
@@ -1,6 +1,6 @@
-USING: help.markup help.syntax sequences math math.vectors
-classes.tuple.private
-math.vectors.simd.intrinsics cpu.architecture ;
+USING: classes.tuple.private cpu.architecture help.markup
+help.syntax kernel.private math math.vectors
+math.vectors.simd.intrinsics sequences ;
IN: math.vectors.simd
ARTICLE: "math.vectors.simd.intro" "Introduction to SIMD support"
From b9bc619b1b2ca6f0786b9708479eeab27e9d7203 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 23 Sep 2009 12:49:30 -0500
Subject: [PATCH 04/12] fix db docs for multiline strings
---
basis/db/db-docs.factor | 20 ++++++++++----------
1 file changed, 10 insertions(+), 10 deletions(-)
diff --git a/basis/db/db-docs.factor b/basis/db/db-docs.factor
index eb5cc71f81..77474fffbd 100644
--- a/basis/db/db-docs.factor
+++ b/basis/db/db-docs.factor
@@ -251,7 +251,7 @@ ARTICLE: "db-lowlevel-tutorial" "Low-level database tutorial"
{ $subsection sql-query }
"Here's an example usage where we'll make a book table, insert some objects, and query them." $nl
"First, let's set up a custom combinator for using our database. See " { $link "db-custom-database-combinators" } " for more details."
-{ $code "
+{ $code """
USING: db.sqlite db io.files io.files.temp ;
: with-book-db ( quot -- )
"book.db" temp-file <sqlite-db> swap with-db ; inline" }
@@ -259,16 +259,16 @@ USING: db.sqlite db io.files io.files.temp ;
{ $code " "create table books
(id integer primary key, title text, author text, date_published timestamp,
edition integer, cover_price double, condition text)"
- [ sql-command ] with-book-db" }
+ [ sql-command ] with-book-db""" }
"Time to insert some books:"
-{ $code "
+{ $code """
"insert into books
(title, author, date_published, edition, cover_price, condition)
values('Factor for Sheeple', 'Mister Stacky Pants', date('now'), 1, 13.37, 'mint')"
-[ sql-command ] with-book-db" }
+[ sql-command ] with-book-db""" }
"Now let's select the book:"
-{ $code "
-"select id, title, cover_price from books;" [ sql-query ] with-book-db " }
+{ $code """
+"select id, title, cover_price from books;" [ sql-query ] with-book-db""" }
"Notice that the result of this query is a Factor array containing the database rows as arrays of strings. We would have to convert the " { $snippet "cover_price" } " from a string to a number in order to use it in a calculation." $nl
"In conclusion, this method of accessing a database is supported, but it is fairly low-level and generally specific to a single database. The " { $vocab-link "db.tuples" } " vocabulary is a good alternative to writing SQL by hand." ;
@@ -278,13 +278,13 @@ ARTICLE: "db-custom-database-combinators" "Custom database combinators"
"Make a " { $snippet "with-" } " combinator to open and close a database so that resources are not leaked." $nl
"SQLite example combinator:"
-{ $code "
+{ $code """
USING: db.sqlite db io.files io.files.temp ;
: with-sqlite-db ( quot -- )
- "my-database.db" temp-file <sqlite-db> swap with-db ; inline" }
+ "my-database.db" temp-file <sqlite-db> swap with-db ; inline""" }
"PostgreSQL example combinator:"
-{ $code " USING: db.postgresql db ;
+{ $code """USING: db.postgresql db ;
: with-postgresql-db ( quot -- )
<postgresql-db>
"localhost" >>host
@@ -292,7 +292,7 @@ USING: db.sqlite db io.files io.files.temp ;
"erg" >>username
"secrets?" >>password
"factor-test" >>database
- swap with-db ; inline"
+ swap with-db ; inline"""
} ;
ABOUT: "db"
From 05ddfb37dc08df94ce9e0d09b92a58bd981c90fb Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 23 Sep 2009 12:52:42 -0500
Subject: [PATCH 05/12] fixing docs
---
basis/db/sqlite/sqlite.factor | 26 +++++++++++++-------------
extra/site-watcher/email/email.factor | 4 ++--
2 files changed, 15 insertions(+), 15 deletions(-)
diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor
index ec6c2a1568..ffcbec70d0 100755
--- a/basis/db/sqlite/sqlite.factor
+++ b/basis/db/sqlite/sqlite.factor
@@ -201,19 +201,19 @@ M: sqlite-db-connection persistent-table ( -- assoc )
: insert-trigger ( -- string )
[
- "
+ """
CREATE TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE INSERT ON ${table-name}
FOR EACH ROW BEGIN
SELECT RAISE(ROLLBACK, 'insert on table "${table-name}" violates foreign key constraint "fki_${table-name}_$table-id}_${foreign-table-name}_${foreign-table-id}_id"')
WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
END;
- " interpolate
+ """ interpolate
] with-string-writer ;
: insert-trigger-not-null ( -- string )
[
- "
+ """
CREATE TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE INSERT ON ${table-name}
FOR EACH ROW BEGIN
@@ -221,24 +221,24 @@ M: sqlite-db-connection persistent-table ( -- assoc )
WHERE NEW.${table-id} IS NOT NULL
AND (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
END;
- " interpolate
+ """ interpolate
] with-string-writer ;
: update-trigger ( -- string )
[
- "
+ """
CREATE TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE UPDATE ON ${table-name}
FOR EACH ROW BEGIN
SELECT RAISE(ROLLBACK, 'update on table "${table-name}" violates foreign key constraint "fku_${table-name}_$table-id}_${foreign-table-name}_${foreign-table-id}_id"')
WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
END;
- " interpolate
+ """ interpolate
] with-string-writer ;
: update-trigger-not-null ( -- string )
[
- "
+ """
CREATE TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE UPDATE ON ${table-name}
FOR EACH ROW BEGIN
@@ -246,30 +246,30 @@ M: sqlite-db-connection persistent-table ( -- assoc )
WHERE NEW.${table-id} IS NOT NULL
AND (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
END;
- " interpolate
+ """ interpolate
] with-string-writer ;
: delete-trigger-restrict ( -- string )
[
- "
+ """
CREATE TRIGGER fkd_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE DELETE ON ${foreign-table-name}
FOR EACH ROW BEGIN
SELECT RAISE(ROLLBACK, 'delete on table "${foreign-table-name}" violates foreign key constraint "fkd_${table-name}_$table-id}_${foreign-table-name}_${foreign-table-id}_id"')
WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = OLD.${foreign-table-id}) IS NOT NULL;
END;
- " interpolate
+ """ interpolate
] with-string-writer ;
: delete-trigger-cascade ( -- string )
-
- "
+ [
+ """
CREATE TRIGGER fkd_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE DELETE ON ${foreign-table-name}
FOR EACH ROW BEGIN
DELETE from ${table-name} WHERE ${table-id} = OLD.${foreign-table-id};
END;
- " interpolate
+ """ interpolate
] with-string-writer ;
: can-be-null? ( -- ? )
diff --git a/extra/site-watcher/email/email.factor b/extra/site-watcher/email/email.factor
index d028788e26..08cf4fe7fd 100644
--- a/extra/site-watcher/email/email.factor
+++ b/extra/site-watcher/email/email.factor
@@ -1,6 +1,6 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: smtp namespaces accessors kernel arrays ;
+USING: smtp namespaces accessors kernel arrays site-watcher.db ;
IN: site-watcher.email
SYMBOL: site-watcher-from
@@ -11,4 +11,4 @@ site-watcher-from [ "factor-site-watcher@gmail.com" ] initialize
pick [
[ <email> site-watcher-from get >>from ] 3dip
[ 1array >>to ] [ >>body ] [ >>subject ] tri* send-email
- ] [ 3drop ] if ;
\ No newline at end of file
+ ] [ 3drop ] if ;
From 823c2c0a5877f42f6283ace285927fec32f4d87f Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 23 Sep 2009 12:54:34 -0500
Subject: [PATCH 06/12] fix using and tests
---
basis/wrap/strings/strings-tests.factor | 14 +++++++-------
extra/svg/svg-tests.factor | 2 +-
2 files changed, 8 insertions(+), 8 deletions(-)
diff --git a/basis/wrap/strings/strings-tests.factor b/basis/wrap/strings/strings-tests.factor
index cf01499bcb..b9abedc4c4 100644
--- a/basis/wrap/strings/strings-tests.factor
+++ b/basis/wrap/strings/strings-tests.factor
@@ -1,29 +1,29 @@
! Copyright (C) 2008, 2009 Daniel Ehrenberg, Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: wrap.strings tools.test multiline ;
+USING: wrap.strings tools.test ;
IN: wrap.strings.tests
[
- <" This is a
+ """This is a
long piece
of text
that we
wish to
-word wrap.">
+word wrap."""
] [
- <" This is a long piece of text that we wish to word wrap."> 10
+ """This is a long piece of text that we wish to word wrap.""" 10
wrap-string
] unit-test
[
- <" This is a
+ """ This is a
long piece
of text
that we
wish to
- word wrap.">
+ word wrap."""
] [
- <" This is a long piece of text that we wish to word wrap."> 12
+ """This is a long piece of text that we wish to word wrap.""" 12
" " wrap-indented-string
] unit-test
diff --git a/extra/svg/svg-tests.factor b/extra/svg/svg-tests.factor
index 43a12a6e78..92a431adef 100644
--- a/extra/svg/svg-tests.factor
+++ b/extra/svg/svg-tests.factor
@@ -1,6 +1,6 @@
! (c)2009 Joe Groff, see BSD license
USING: accessors arrays literals math math.affine-transforms
-math.functions sequences svg tools.test xml xml.traversal ;
+math.functions sequences svg tools.test xml xml.traversal multiline ;
IN: svg.tests
{ 1.0 2.25 } { -3.0 4.0 } { 5.5 0.5 } <affine-transform> 1array [
From faf54ce8e2eaee5ed84f5637f802c060d0c9baea Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 23 Sep 2009 12:57:37 -0500
Subject: [PATCH 07/12] fix yet more multiline tests
---
basis/xml/writer/writer-docs.factor | 3 ++-
extra/sequences/product/product-docs.factor | 4 ++--
2 files changed, 4 insertions(+), 3 deletions(-)
diff --git a/basis/xml/writer/writer-docs.factor b/basis/xml/writer/writer-docs.factor
index c5a81fb935..c578455a77 100644
--- a/basis/xml/writer/writer-docs.factor
+++ b/basis/xml/writer/writer-docs.factor
@@ -52,7 +52,8 @@ HELP: sensitive-tags
{ $example """USING: xml.syntax xml.writer namespaces ;
[XML <html> <head> <title> something</title></head><body><pre>bing
bang
- bong</pre></body></html> XML] { "pre" } sensitive-tags [ pprint-xml ] with-variable "} {"
+ bong</pre></body></html> XML] { "pre" } sensitive-tags [ pprint-xml ] with-variable"""
+"""
<html>
<head>
<title>
diff --git a/extra/sequences/product/product-docs.factor b/extra/sequences/product/product-docs.factor
index a2d1786a52..f1097a7350 100644
--- a/extra/sequences/product/product-docs.factor
+++ b/extra/sequences/product/product-docs.factor
@@ -24,8 +24,8 @@ HELP: <product-sequence>
{ $description "Constructs a " { $link product-sequence } " over " { $snippet "sequences" } "." }
{ $examples
{ $example """USING: arrays prettyprint sequences.product ;
-{ { 1 2 3 } { "a" "b" "c" } } <product-sequence> >array .
-""" """ {
+{ { 1 2 3 } { "a" "b" "c" } } <product-sequence> >array ."""
+"""{
{ 1 "a" }
{ 2 "a" }
{ 3 "a" }
From a4524874f4aeca84d97c24c8fd8fdd0c7486cd98 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 23 Sep 2009 16:24:32 -0500
Subject: [PATCH 08/12] remove <" from multiline tests
---
basis/multiline/multiline-tests.factor | 11 -----------
basis/xml/syntax/syntax-docs.factor | 5 ++++-
2 files changed, 4 insertions(+), 12 deletions(-)
diff --git a/basis/multiline/multiline-tests.factor b/basis/multiline/multiline-tests.factor
index 25610ed660..ad624dd917 100644
--- a/basis/multiline/multiline-tests.factor
+++ b/basis/multiline/multiline-tests.factor
@@ -8,17 +8,6 @@ bar
;
[ "foo\nbar\n" ] [ test-it ] unit-test
-[ "foo\nbar\n" ] [ <" foo
-bar
-"> ] unit-test
-
-[ "hello\nworld" ] [ <" hello
-world"> ] unit-test
-
-[ "hello" "world" ] [ <" hello"> <" world"> ] unit-test
-
-[ "\nhi" ] [ <"
-hi"> ] unit-test
! HEREDOC:
diff --git a/basis/xml/syntax/syntax-docs.factor b/basis/xml/syntax/syntax-docs.factor
index d0e09663e4..3b506c0501 100644
--- a/basis/xml/syntax/syntax-docs.factor
+++ b/basis/xml/syntax/syntax-docs.factor
@@ -54,6 +54,7 @@ $nl
"one two three" " " split
[ [XML <item><-></item> XML] ] map
<XML <doc><-></doc> XML> pprint-xml"""
+
"""<?xml version="1.0" encoding="UTF-8"?>
<doc>
<item>
@@ -83,6 +84,7 @@ $nl
string=<-string->
word=<-word-> />
XML> pprint-xml ]"""
+
"""<?xml version="1.0" encoding="UTF-8"?>
<x number="3" url="http://factorcode.org/" string="hello" word="drop"/>""" }
"XML interpolation can also be used, in conjunction with " { $vocab-link "inverse" } " in pattern matching. For example:"
@@ -94,7 +96,8 @@ $nl
{ [ [XML <b val='yes'/> XML] ] [ "yes" ] }
{ [ [XML <b val=<->/> XML] ] [ "no" prepend ] }
} switch ;
-[XML <a>pple</a> XML] dispatch write""" "apple" } ;
+[XML <a>pple</a> XML] dispatch write"""
+"apple" } ;
HELP: XML-NS:
{ $syntax "XML-NS: name http://url" }
From 9dd51d58de73d23efdb58f35872790ee7a9c298a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Wed, 23 Sep 2009 17:33:03 -0500
Subject: [PATCH 09/12] rpn: fix operator order issue (reported by Jason
Merrill)
---
extra/rpn/rpn-tests.factor | 4 ++++
extra/rpn/rpn.factor | 8 ++++----
2 files changed, 8 insertions(+), 4 deletions(-)
create mode 100644 extra/rpn/rpn-tests.factor
diff --git a/extra/rpn/rpn-tests.factor b/extra/rpn/rpn-tests.factor
new file mode 100644
index 0000000000..c24d5cb244
--- /dev/null
+++ b/extra/rpn/rpn-tests.factor
@@ -0,0 +1,4 @@
+IN: rpn.tests
+USING: rpn lists tools.test ;
+
+[ { 2 } ] [ "4 2 -" rpn-parse rpn-eval list>array ] unit-test
\ No newline at end of file
diff --git a/extra/rpn/rpn.factor b/extra/rpn/rpn.factor
index 7175746862..ba697df8d1 100644
--- a/extra/rpn/rpn.factor
+++ b/extra/rpn/rpn.factor
@@ -10,7 +10,7 @@ TUPLE: push-insn value ;
GENERIC: eval-insn ( stack insn -- stack )
: binary-op ( stack quot: ( x y -- z ) -- stack )
- [ uncons uncons ] dip dip cons ; inline
+ [ uncons uncons [ swap ] dip ] dip dip cons ; inline
M: add-insn eval-insn drop [ + ] binary-op ;
M: sub-insn eval-insn drop [ - ] binary-op ;
@@ -35,11 +35,11 @@ M: push-insn eval-insn value>> swons ;
: print-stack ( list -- )
[ number>string print ] leach ;
-: rpn-eval ( tokens -- )
- nil [ eval-insn ] foldl print-stack ;
+: rpn-eval ( tokens -- stack )
+ nil [ eval-insn ] foldl ;
: rpn ( -- )
"RPN> " write flush
- readln [ rpn-parse rpn-eval rpn ] when* ;
+ readln [ rpn-parse rpn-eval print-stack rpn ] when* ;
MAIN: rpn
From 1788957e1d38a98f1984cd2a34313ded5cbd6f3b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Wed, 23 Sep 2009 17:50:00 -0500
Subject: [PATCH 10/12] syntax: fix typos in " docs
---
core/syntax/syntax-docs.factor | 12 +++++++-----
1 file changed, 7 insertions(+), 5 deletions(-)
diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor
index a5867745a5..4a24bdd51f 100644
--- a/core/syntax/syntax-docs.factor
+++ b/core/syntax/syntax-docs.factor
@@ -530,17 +530,19 @@ HELP: CHAR:
} ;
HELP: "
-{ $syntax "\"string...\"" }
-{ $syntax "\"\"\"string...\"\"\"" }
+{ $syntax "\"string...\"" "\"\"\"string...\"\"\"" }
{ $values { "string" "literal and escaped characters" } }
-{ $description "Reads from the input string until the next occurrence of " { $link POSTPONE: " } " or " { $snippet "\"\"\"" } ", and appends the resulting string to the parse tree. String literals can span multiple lines. For strings beginning with a single double-quote, the " { $link POSTPONE: " } " character and various other special characters can be read by inserting " { $link "escape" } ". For triple quoted strings, the double-quote character does not require escaping." }
+{ $description "Reads from the input string until the next occurrence of " { $snippet "\"" } " or " { $snippet "\"\"\"" } ", and appends the resulting string to the parse tree. String literals can span multiple lines. Various special characters can be read by inserting " { $link "escape" } ". For triple quoted strings, the double-quote character does not require escaping." }
{ $examples
- "A string with a newline in it:"
+ "A string with an escaped newline in it:"
{ $example "USE: io" "\"Hello\\nworld\" print" "Hello\nworld" }
+ "A string with an actual newline in it:"
+ { $example "USE: io" "\"Hello\nworld\" print" "Hello\nworld" }
"A string with a named Unicode code point:"
{ $example "USE: io" "\"\\u{greek-capital-letter-sigma}\" print" "\u{greek-capital-letter-sigma}" }
"A triple-quoted string:"
- { $example "USE: io \"\"\"\"Teach a man to fish...\"\"\"\" print" """"Teach a man to fish..."""" }
+ { $example "USE: io \"\"\"Teach a man to \"fish\"...\nand fish will go extinct\"\"\" print" """Teach a man to \"fish\"...
+and fish will go extinct""" }
} ;
HELP: SBUF"
From 413dc67985fc6592cba170d73d906b2a549a4d00 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Wed, 23 Sep 2009 17:55:54 -0500
Subject: [PATCH 11/12] Put bad escape code in the bad-escape error
---
basis/debugger/debugger.factor | 4 +++-
core/strings/parser/parser.factor | 4 ++--
2 files changed, 5 insertions(+), 3 deletions(-)
diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor
index 1e08896e8d..4888896866 100644
--- a/basis/debugger/debugger.factor
+++ b/basis/debugger/debugger.factor
@@ -319,7 +319,9 @@ M: lexer-error error-help
M: bad-effect summary
drop "Bad stack effect declaration" ;
-M: bad-escape summary drop "Bad escape code" ;
+M: bad-escape error.
+ "Bad escape code: \\" write
+ char>> 1string print ;
M: bad-literal-tuple summary drop "Bad literal tuple" ;
diff --git a/core/strings/parser/parser.factor b/core/strings/parser/parser.factor
index b8aadc608c..49287ed112 100644
--- a/core/strings/parser/parser.factor
+++ b/core/strings/parser/parser.factor
@@ -5,7 +5,7 @@ namespaces parser sequences splitting strings arrays
math.order ;
IN: strings.parser
-ERROR: bad-escape ;
+ERROR: bad-escape char ;
: escape ( escape -- ch )
H{
@@ -19,7 +19,7 @@ ERROR: bad-escape ;
{ CHAR: 0 CHAR: \0 }
{ CHAR: \\ CHAR: \\ }
{ CHAR: \" CHAR: \" }
- } at [ bad-escape ] unless* ;
+ } ?at [ bad-escape ] unless ;
SYMBOL: name>char-hook
From 7c83ccf6b0e48946fc469067a8ea742ae8fbc426 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Wed, 23 Sep 2009 17:56:19 -0500
Subject: [PATCH 12/12] xml.syntax: fix help lint
---
basis/xml/syntax/syntax-docs.factor | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/basis/xml/syntax/syntax-docs.factor b/basis/xml/syntax/syntax-docs.factor
index 3b506c0501..b8a804b360 100644
--- a/basis/xml/syntax/syntax-docs.factor
+++ b/basis/xml/syntax/syntax-docs.factor
@@ -75,7 +75,7 @@ $nl
false [ f ]
url [ URL" http://factorcode.org/" ]
string [ "hello" ]
- word [ \ drop ] |
+ word [ \\ drop ] |
<XML
<x
number=<-number->
@@ -83,7 +83,8 @@ $nl
url=<-url->
string=<-string->
word=<-word-> />
- XML> pprint-xml ]"""
+ XML> pprint-xml
+]"""
"""<?xml version="1.0" encoding="UTF-8"?>
<x number="3" url="http://factorcode.org/" string="hello" word="drop"/>""" }