diff --git a/extra/tuple-syntax/about.txt b/extra/tuple-syntax/about.txt new file mode 100644 index 0000000000..f243374925 --- /dev/null +++ b/extra/tuple-syntax/about.txt @@ -0,0 +1 @@ +Tuple literals with named slots diff --git a/extra/tuple-syntax/authors.txt b/extra/tuple-syntax/authors.txt new file mode 100644 index 0000000000..f990dd0ed2 --- /dev/null +++ b/extra/tuple-syntax/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/extra/tuple-syntax/tags.txt b/extra/tuple-syntax/tags.txt new file mode 100644 index 0000000000..71c0ff7282 --- /dev/null +++ b/extra/tuple-syntax/tags.txt @@ -0,0 +1 @@ +syntax diff --git a/extra/tuple-syntax/tuple-syntax-docs.factor b/extra/tuple-syntax/tuple-syntax-docs.factor new file mode 100644 index 0000000000..7d4c12c0e9 --- /dev/null +++ b/extra/tuple-syntax/tuple-syntax-docs.factor @@ -0,0 +1,10 @@ +USING: help.markup help.syntax 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{ } ; + +IN: tuple-syntax +ABOUT: POSTPONE: TUPLE{ diff --git a/extra/tuple-syntax/tuple-syntax-tests.factor b/extra/tuple-syntax/tuple-syntax-tests.factor new file mode 100644 index 0000000000..b16c5b337d --- /dev/null +++ b/extra/tuple-syntax/tuple-syntax-tests.factor @@ -0,0 +1,7 @@ +USING: tools.test tuple-syntax ; + +TUPLE: foo bar baz ; + +[ T{ foo } ] [ TUPLE{ foo } ] unit-test +[ T{ foo 1 { 2 3 } { 4 { 5 } } } ] +[ TUPLE{ foo bar: { 2 3 } delegate: 1 baz: { 4 { 5 } } } ] unit-test diff --git a/extra/tuple-syntax/tuple-syntax.factor b/extra/tuple-syntax/tuple-syntax.factor new file mode 100644 index 0000000000..ddc90a8961 --- /dev/null +++ b/extra/tuple-syntax/tuple-syntax.factor @@ -0,0 +1,21 @@ +USING: kernel sequences slots parser words classes ; +IN: tuple-syntax + +! TUPLE: foo bar baz ; +! TUPLE{ foo bar: 1 baz: 2 } + +: parse-object ( -- object ) + scan-word dup parsing? [ V{ } clone swap execute first ] when ; + +: parse-slot-writer ( tuple -- slot-setter ) + scan dup "}" = [ 2drop f ] [ + 1 head* swap class "slots" word-prop + [ slot-spec-name = ] curry* find nip slot-spec-writer + ] if ; + +: parse-slots ( accum tuple -- accum tuple ) + dup parse-slot-writer + [ parse-object pick rot execute parse-slots ] when* ; + +: TUPLE{ + scan-word construct-empty parse-slots parsed ; parsing