diff --git a/basis/html/templates/chloe/chloe.factor b/basis/html/templates/chloe/chloe.factor
index afbd82fed4..f40fc43b32 100644
--- a/basis/html/templates/chloe/chloe.factor
+++ b/basis/html/templates/chloe/chloe.factor
@@ -3,7 +3,7 @@
USING: accessors kernel sequences combinators kernel namespaces
classes.tuple assocs splitting words arrays memoize
io io.files io.encodings.utf8 io.streams.string
-unicode.case tuple-syntax mirrors fry math urls present
+unicode.case mirrors fry math urls present
multiline xml xml.data xml.writer xml.utilities
html.forms
html.elements
diff --git a/basis/html/templates/chloe/syntax/syntax.factor b/basis/html/templates/chloe/syntax/syntax.factor
index 82309a49b2..65b5cd8790 100644
--- a/basis/html/templates/chloe/syntax/syntax.factor
+++ b/basis/html/templates/chloe/syntax/syntax.factor
@@ -4,7 +4,7 @@ IN: html.templates.chloe.syntax
USING: accessors kernel sequences combinators kernel namespaces
classes.tuple assocs splitting words arrays memoize parser lexer
io io.files io.encodings.utf8 io.streams.string
-unicode.case tuple-syntax mirrors fry math urls
+unicode.case mirrors fry math urls
multiline xml xml.data xml.writer xml.utilities
html.elements
html.components
diff --git a/basis/http/client/client-tests.factor b/basis/http/client/client-tests.factor
index 28a605174a..1219ae0b97 100755
--- a/basis/http/client/client-tests.factor
+++ b/basis/http/client/client-tests.factor
@@ -1,5 +1,5 @@
USING: http.client http.client.private http tools.test
-tuple-syntax namespaces urls ;
+namespaces urls ;
[ "localhost" f ] [ "localhost" parse-host ] unit-test
[ "localhost" 8888 ] [ "localhost:8888" parse-host ] unit-test
@@ -9,12 +9,12 @@ tuple-syntax namespaces urls ;
[ "www.arc.com" ] [ "http://www.arc.com////" download-name ] unit-test
[
- TUPLE{ request
- url: TUPLE{ url protocol: "http" host: "www.apple.com" port: 80 path: "/index.html" }
- method: "GET"
- version: "1.1"
- cookies: V{ }
- header: H{ { "connection" "close" } { "user-agent" "Factor http.client" } }
+ T{ request
+ { url T{ url { protocol "http" } { host "www.apple.com" } { port 80 } { path "/index.html" } } }
+ { method "GET" }
+ { version "1.1" }
+ { cookies V{ } }
+ { header H{ { "connection" "close" } { "user-agent" "Factor http.client" } } }
}
] [
"http://www.apple.com/index.html"
@@ -22,12 +22,12 @@ tuple-syntax namespaces urls ;
] unit-test
[
- TUPLE{ request
- url: TUPLE{ url protocol: "https" host: "www.amazon.com" port: 443 path: "/index.html" }
- method: "GET"
- version: "1.1"
- cookies: V{ }
- header: H{ { "connection" "close" } { "user-agent" "Factor http.client" } }
+ T{ request
+ { url T{ url { protocol "https" } { host "www.amazon.com" } { port 443 } { path "/index.html" } } }
+ { method "GET" }
+ { version "1.1" }
+ { cookies V{ } }
+ { header H{ { "connection" "close" } { "user-agent" "Factor http.client" } } }
}
] [
"https://www.amazon.com/index.html"
diff --git a/basis/http/http-tests.factor b/basis/http/http-tests.factor
index 40154e94ef..db46f1eac5 100755
--- a/basis/http/http-tests.factor
+++ b/basis/http/http-tests.factor
@@ -1,8 +1,8 @@
USING: http http.server http.client tools.test multiline
-tuple-syntax io.streams.string io.encodings.utf8
-io.encodings.8-bit io.encodings.binary io.encodings.string
-kernel arrays splitting sequences assocs io.sockets db db.sqlite
-continuations urls hashtables accessors ;
+io.streams.string io.encodings.utf8 io.encodings.8-bit
+io.encodings.binary io.encodings.string kernel arrays splitting
+sequences assocs io.sockets db db.sqlite continuations urls
+hashtables accessors ;
IN: http.tests
[ "text/plain" latin1 ] [ "text/plain" parse-content-type ] unit-test
@@ -24,13 +24,13 @@ blah
;
[
- TUPLE{ request
- url: TUPLE{ url path: "/bar" }
- method: "POST"
- version: "1.1"
- header: H{ { "some-header" "1; 2" } { "content-length" "4" } { "content-type" "application/octet-stream" } }
- post-data: TUPLE{ post-data content: "blah" raw: "blah" content-type: "application/octet-stream" }
- cookies: V{ }
+ T{ request
+ { url T{ url path: "/bar" } }
+ { method "POST" }
+ { version "1.1" }
+ { header H{ { "some-header" "1; 2" } { "content-length" "4" } { "content-type" "application/octet-stream" } } }
+ { post-data T{ post-data { content "blah" } { raw "blah" } { content-type "application/octet-stream" } } }
+ { cookies V{ } }
}
] [
read-request-test-1 lf>crlf [
@@ -62,12 +62,12 @@ Host: www.sex.com
;
[
- TUPLE{ request
- url: TUPLE{ url host: "www.sex.com" path: "/bar" }
- method: "HEAD"
- version: "1.1"
- header: H{ { "host" "www.sex.com" } }
- cookies: V{ }
+ T{ request
+ { url T{ url host: "www.sex.com" path: "/bar" } }
+ { method "HEAD" }
+ { version "1.1" }
+ { header H{ { "host" "www.sex.com" } } }
+ { cookies V{ } }
}
] [
read-request-test-2 lf>crlf [
@@ -103,14 +103,14 @@ blah
;
[
- TUPLE{ response
- version: "1.1"
- code: 404
- message: "not found"
- header: H{ { "content-type" "text/html; charset=UTF-8" } }
- cookies: { }
- content-type: "text/html"
- content-charset: utf8
+ T{ response
+ { version "1.1" }
+ { code 404 }
+ { message "not found" }
+ { header H{ { "content-type" "text/html; charset=UTF-8" } } }
+ { cookies { } }
+ { content-type "text/html" }
+ { content-charset utf8 }
}
] [
read-response-test-1 lf>crlf
diff --git a/basis/urls/urls-tests.factor b/basis/urls/urls-tests.factor
index 87c9b91950..7f835b2918 100644
--- a/basis/urls/urls-tests.factor
+++ b/basis/urls/urls-tests.factor
@@ -1,7 +1,6 @@
IN: urls.tests
USING: urls urls.private tools.test
-tuple-syntax arrays kernel assocs
-present accessors ;
+arrays kernel assocs present accessors ;
[ "hello%20world" ] [ "hello world" url-encode ] unit-test
[ "hello world" ] [ "hello%20world" url-decode ] unit-test
@@ -30,78 +29,78 @@ present accessors ;
: urls
{
{
- TUPLE{ url
- protocol: "http"
- host: "www.apple.com"
- port: 1234
- path: "/a/path"
- query: H{ { "a" "b" } }
- anchor: "foo"
+ T{ url
+ { protocol "http" }
+ { host "www.apple.com" }
+ { port 1234 }
+ { path "/a/path" }
+ { query H{ { "a" "b" } } }
+ { anchor "foo" }
}
"http://www.apple.com:1234/a/path?a=b#foo"
}
{
- TUPLE{ url
- protocol: "http"
- host: "www.apple.com"
- path: "/a/path"
- query: H{ { "a" "b" } }
- anchor: "foo"
+ T{ url
+ { protocol "http" }
+ { host "www.apple.com" }
+ { path "/a/path" }
+ { query H{ { "a" "b" } } }
+ { anchor "foo" }
}
"http://www.apple.com/a/path?a=b#foo"
}
{
- TUPLE{ url
- protocol: "http"
- host: "www.apple.com"
- port: 1234
- path: "/another/fine/path"
- anchor: "foo"
+ T{ url
+ { protocol "http" }
+ { host "www.apple.com" }
+ { port 1234 }
+ { path "/another/fine/path" }
+ { anchor "foo" }
}
"http://www.apple.com:1234/another/fine/path#foo"
}
{
- TUPLE{ url
- path: "/a/relative/path"
- anchor: "foo"
+ T{ url
+ { path "/a/relative/path" }
+ { anchor "foo" }
}
"/a/relative/path#foo"
}
{
- TUPLE{ url
- path: "/a/relative/path"
+ T{ url
+ { path "/a/relative/path" }
}
"/a/relative/path"
}
{
- TUPLE{ url
- path: "a/relative/path"
+ T{ url
+ { path "a/relative/path" }
}
"a/relative/path"
}
{
- TUPLE{ url
- path: "bar"
- query: H{ { "a" "b" } }
+ T{ url
+ { path "bar" }
+ { query H{ { "a" "b" } } }
}
"bar?a=b"
}
{
- TUPLE{ url
- protocol: "ftp"
- host: "ftp.kernel.org"
- username: "slava"
- path: "/"
+ T{ url
+ { protocol "ftp" }
+ { host "ftp.kernel.org" }
+ { username "slava" }
+ { path "/" }
}
"ftp://slava@ftp.kernel.org/"
}
{
- TUPLE{ url
- protocol: "ftp"
- host: "ftp.kernel.org"
- username: "slava"
- password: "secret"
- path: "/"
+ T{ url
+ { protocol "ftp" }
+ { host "ftp.kernel.org" }
+ { username "slava" }
+ { password "secret" }
+ { path "/" }
}
"ftp://slava:secret@ftp.kernel.org/"
}
@@ -128,94 +127,94 @@ urls [
[ "/xxx/bar" ] [ "/xxx/baz" "bar" url-append-path ] unit-test
[
- TUPLE{ url
- protocol: "http"
- host: "www.apple.com"
- port: 1234
- path: "/a/path"
+ T{ url
+ { protocol "http" }
+ { host "www.apple.com" }
+ { port 1234 }
+ { path "/a/path" }
}
] [
- TUPLE{ url
- protocol: "http"
- host: "www.apple.com"
- port: 1234
- path: "/foo"
+ T{ url
+ { protocol "http" }
+ { host "www.apple.com" }
+ { port 1234 }
+ { path "/foo" }
}
- TUPLE{ url
- path: "/a/path"
+ T{ url
+ { path "/a/path" }
}
derive-url
] unit-test
[
- TUPLE{ url
- protocol: "http"
- host: "www.apple.com"
- port: 1234
- path: "/a/path/relative/path"
- query: H{ { "a" "b" } }
- anchor: "foo"
+ T{ url
+ { protocol "http" }
+ { host "www.apple.com" }
+ { port 1234 }
+ { path "/a/path/relative/path" }
+ { query H{ { "a" "b" } } }
+ { anchor "foo" }
}
] [
- TUPLE{ url
- protocol: "http"
- host: "www.apple.com"
- port: 1234
- path: "/a/path/"
+ T{ url
+ { protocol "http" }
+ { host "www.apple.com" }
+ { port 1234 }
+ { path "/a/path/" }
}
- TUPLE{ url
- path: "relative/path"
- query: H{ { "a" "b" } }
- anchor: "foo"
+ T{ url
+ { path "relative/path" }
+ { query H{ { "a" "b" } } }
+ { anchor "foo" }
}
derive-url
] unit-test
[
- TUPLE{ url
- protocol: "http"
- host: "www.apple.com"
- port: 1234
- path: "/a/path/relative/path"
- query: H{ { "a" "b" } }
- anchor: "foo"
+ T{ url
+ { protocol "http" }
+ { host "www.apple.com" }
+ { port 1234 }
+ { path "/a/path/relative/path" }
+ { query H{ { "a" "b" } } }
+ { anchor "foo" }
}
] [
- TUPLE{ url
- protocol: "http"
- host: "www.apple.com"
- port: 1234
- path: "/a/path/"
+ T{ url
+ { protocol "http" }
+ { host "www.apple.com" }
+ { port 1234 }
+ { path "/a/path/" }
}
- TUPLE{ url
- path: "relative/path"
- query: H{ { "a" "b" } }
- anchor: "foo"
+ T{ url
+ { path "relative/path" }
+ { query H{ { "a" "b" } } }
+ { anchor "foo" }
}
derive-url
] unit-test
[
- TUPLE{ url
- protocol: "http"
- host: "www.apple.com"
- path: "/xxx/baz"
+ T{ url
+ { protocol "http" }
+ { host "www.apple.com" }
+ { path "/xxx/baz" }
}
] [
- TUPLE{ url
- protocol: "http"
- host: "www.apple.com"
- path: "/xxx/bar"
+ T{ url
+ { protocol "http" }
+ { host "www.apple.com" }
+ { path "/xxx/bar" }
}
- TUPLE{ url
- path: "baz"
+ T{ url
+ { path "baz" }
}
derive-url
diff --git a/core/classes/tuple/parser/parser-tests.factor b/core/classes/tuple/parser/parser-tests.factor
index 7b0cb998e4..17376a594f 100644
--- a/core/classes/tuple/parser/parser-tests.factor
+++ b/core/classes/tuple/parser/parser-tests.factor
@@ -91,4 +91,8 @@ must-fail-with
] with-compilation-unit
] unit-test
+TUPLE: syntax-test bar baz ;
+[ T{ syntax-test } ] [ T{ syntax-test } ] unit-test
+[ T{ syntax-test f { 2 3 } { 4 { 5 } } } ]
+[ T{ syntax-test { bar { 2 3 } } { baz { 4 { 5 } } } } ] unit-test
diff --git a/core/classes/tuple/parser/parser.factor b/core/classes/tuple/parser/parser.factor
index e85910d18d..0865de16c3 100644
--- a/core/classes/tuple/parser/parser.factor
+++ b/core/classes/tuple/parser/parser.factor
@@ -1,7 +1,8 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sets namespaces sequences parser
-lexer combinators words classes.parser classes.tuple arrays ;
+lexer combinators words classes.parser classes.tuple arrays
+slots math assocs ;
IN: classes.tuple.parser
: slot-names ( slots -- seq )
@@ -59,9 +60,30 @@ ERROR: invalid-slot-name name ;
dup check-duplicate-slots
3dup check-slot-shadowing ;
-: literal>tuple ( seq -- tuple )
- {
- { [ dup length 1 = ] [ first new ] }
- { [ dup second not ] [ [ 2 tail ] [ first ] bi slots>tuple ] }
- [ "Not implemented" throw ]
- } cond ;
+: parse-slot-value ( -- )
+ scan scan-object 2array , scan "}" assert= ;
+
+: (parse-slot-values) ( -- )
+ parse-slot-value
+ scan {
+ { "{" [ (parse-slot-values) ] }
+ { "}" [ ] }
+ } case ;
+
+: parse-slot-values ( -- )
+ [ (parse-slot-values) ] { } make ;
+
+: boa>tuple ( class slots -- tuple )
+ swap prefix >tuple ;
+
+: assoc>tuple ( class slots -- tuple )
+ [ [ ] [ initial-values ] [ all-slots ] tri ] dip
+ swap [ [ slot-named offset>> 2 - ] curry dip ] curry assoc-map
+ [ dup ] dip update boa>tuple ;
+
+: parse-tuple-literal ( -- tuple )
+ scan-word scan {
+ { "f" [ \ } parse-until boa>tuple ] }
+ { "{" [ parse-slot-values assoc>tuple ] }
+ { "}" [ new ] }
+ } case ;
diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index 89e4e80460..b5c3658542 100755
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -48,14 +48,14 @@ PREDICATE: immutable-tuple-class < tuple-class ( class -- ? )
] 2each
] if-bootstrapping ; inline
+PRIVATE>
+
: initial-values ( class -- slots )
all-slots [ initial>> ] map ;
: pad-slots ( slots class -- slots' class )
[ initial-values over length tail append ] keep ; inline
-PRIVATE>
-
: tuple>array ( tuple -- array )
prepare-tuple>array
>r copy-tuple-slots r>
diff --git a/core/effects/effects.factor b/core/effects/effects.factor
index 27e6328587..8a000b0615 100755
--- a/core/effects/effects.factor
+++ b/core/effects/effects.factor
@@ -65,5 +65,5 @@ M: effect clone
: shuffled-values ( shuffle -- values )
out>> [ get ] map ;
-: shuffle* ( stack shuffle -- newstack )
+: shuffle ( stack shuffle -- newstack )
[ [ load-shuffle ] keep shuffled-values ] with-scope ;
diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor
index 57dec876a5..cd76967e5a 100755
--- a/core/syntax/syntax-docs.factor
+++ b/core/syntax/syntax-docs.factor
@@ -284,10 +284,31 @@ HELP: C{
HELP: T{
{ $syntax "T{ class slots... }" }
-{ $values { "class" "a tuple class word" } { "slots" "list of objects" } }
-{ $description "Marks the beginning of a literal tuple. Literal tuples are terminated by " { $link POSTPONE: } } "."
+{ $values { "class" "a tuple class word" } { "slots" "slot values" } }
+{ $description "Marks the beginning of a literal tuple."
$nl
-"The class word must always be specified. If an insufficient number of values is given after the class word, the remaining slots of the tuple are set to " { $link f } ". If too many values are given, they are ignored." } ;
+"Three literal syntax forms are recognized:"
+{ $list
+ { "empty tuple form: if no slot values are specified, then the literal tuple will have all slots set to their initial values (see " { $link "slot-initial-values" } ")." }
+ { "BOA-form: if the first element of " { $snippet "slots" } " is " { $snippet "f" } ", then the remaining elements are slot values corresponding to slots in the order in which they are defined in the " { $link POSTPONE: TUPLE: } " form." }
+ { "assoc-form: otherwise, " { $snippet "slots" } " is interpreted as a sequence of " { $snippet "{ slot-name value }" } " pairs. The " { $snippet "slot-name" } " should not be quoted." }
+}
+"BOA form is more concise, whereas assoc form is more readable for larger tuples with many slots, or if only a few slots are to be specified."
+$nl
+"With BOA form, specifying an insufficient number of values is given after the class word, the remaining slots of the tuple are set to their initial values (see " { $link "slot-initial-values" } "). If too many values are given, an error will be raised." }
+{ $examples
+"An empty tuple; since vectors have their own literal syntax, the above is equivalent to " { $snippet "V{ }" } ""
+{ $code "T{ vector }" }
+"A BOA-form tuple:"
+{ $code
+ "USE: colors"
+ "T{ rgba f 1.0 0.0 0.5 }"
+}
+"An assoc-form tuple equal to the above:"
+{ $code
+ "USE: colors"
+ "T{ rgba { red 1.0 } { green 0.0 } { blue 0.5 } }"
+} } ;
HELP: W{
{ $syntax "W{ object }" }
diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor
index 1617617b44..105bdc325f 100755
--- a/core/syntax/syntax.factor
+++ b/core/syntax/syntax.factor
@@ -83,7 +83,7 @@ IN: bootstrap.syntax
"B{" [ \ } [ >byte-array ] parse-literal ] define-syntax
"BV{" [ \ } [ >byte-vector ] parse-literal ] define-syntax
"H{" [ \ } [ >hashtable ] parse-literal ] define-syntax
- "T{" [ \ } [ literal>tuple ] parse-literal ] define-syntax
+ "T{" [ parse-tuple-literal parsed ] define-syntax
"W{" [ \ } [ first ] parse-literal ] define-syntax
"POSTPONE:" [ scan-word parsed ] define-syntax
diff --git a/extra/tuple-syntax/authors.txt b/extra/tuple-syntax/authors.txt
deleted file mode 100644
index f990dd0ed2..0000000000
--- a/extra/tuple-syntax/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Daniel Ehrenberg
diff --git a/extra/tuple-syntax/summary.txt b/extra/tuple-syntax/summary.txt
deleted file mode 100644
index f243374925..0000000000
--- a/extra/tuple-syntax/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-Tuple literals with named slots
diff --git a/extra/tuple-syntax/tags.txt b/extra/tuple-syntax/tags.txt
deleted file mode 100644
index abf53a421b..0000000000
--- a/extra/tuple-syntax/tags.txt
+++ /dev/null
@@ -1 +0,0 @@
-reflection
diff --git a/extra/tuple-syntax/tuple-syntax-docs.factor b/extra/tuple-syntax/tuple-syntax-docs.factor
deleted file mode 100644
index d27cf27c9b..0000000000
--- a/extra/tuple-syntax/tuple-syntax-docs.factor
+++ /dev/null
@@ -1,8 +0,0 @@
-USING: help.markup help.syntax ;
-IN: tuple-syntax
-
-HELP: TUPLE{
-{ $syntax "TUPLE{ class slot-name: value... }" }
-{ $values { "class" "a tuple class word" } { "slot-name" "the name of a slot, without the tuple class name" } { "value" "the value for a slot" } }
-{ $description "Marks the beginning of a literal tuple. Literal tuples are terminated by " { $link POSTPONE: } } ". The class word must be specified. Slots which aren't specified are set to f. If slot names are duplicated, the latest one is used." }
-{ $see-also POSTPONE: T{ } ;
diff --git a/extra/tuple-syntax/tuple-syntax-tests.factor b/extra/tuple-syntax/tuple-syntax-tests.factor
deleted file mode 100755
index 452672ea2a..0000000000
--- a/extra/tuple-syntax/tuple-syntax-tests.factor
+++ /dev/null
@@ -1,8 +0,0 @@
-USING: tools.test tuple-syntax ;
-IN: tuple-syntax.tests
-
-TUPLE: foo bar baz ;
-
-[ T{ foo } ] [ TUPLE{ foo } ] unit-test
-[ T{ foo f { 2 3 } { 4 { 5 } } } ]
-[ TUPLE{ foo bar: { 2 3 } baz: { 4 { 5 } } } ] unit-test
diff --git a/extra/tuple-syntax/tuple-syntax.factor b/extra/tuple-syntax/tuple-syntax.factor
deleted file mode 100755
index 0feb251691..0000000000
--- a/extra/tuple-syntax/tuple-syntax.factor
+++ /dev/null
@@ -1,18 +0,0 @@
-USING: classes.tuple accessors kernel sequences slots parser
-lexer words classes slots.private mirrors ;
-IN: tuple-syntax
-
-! TUPLE: foo bar baz ;
-! TUPLE{ foo bar: 1 baz: 2 }
-
-: parse-slot-writer ( tuple -- slot# )
- scan dup "}" = [ 2drop f ] [
- but-last swap class all-slots slot-named offset>>
- ] if ;
-
-: parse-slots ( accum tuple -- accum tuple )
- dup parse-slot-writer
- [ scan-object pick rot set-slot parse-slots ] when* ;
-
-: TUPLE{
- scan-word new parse-slots parsed ; parsing