From f3038f2ae866d994ed9d31d56a2eb8b79f4b33a9 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Fri, 20 Mar 2009 19:53:54 -0500 Subject: [PATCH 01/16] More docs for Unicode and simple-flat-file; moving more parsing code there --- basis/regexp/regexp-docs.factor | 4 +-- .../simple-flat-file-docs.factor | 22 ++++++++++++-- .../simple-flat-file/simple-flat-file.factor | 24 ++++++++++++++- basis/unicode/breaks/breaks.factor | 5 ++-- basis/unicode/data/data-docs.factor | 30 +++++++++++++++---- basis/unicode/data/data.factor | 26 +--------------- basis/unicode/script/script.factor | 8 ++--- basis/unicode/syntax/syntax.factor | 7 ++--- 8 files changed, 77 insertions(+), 49 deletions(-) diff --git a/basis/regexp/regexp-docs.factor b/basis/regexp/regexp-docs.factor index 6d9f03781d..01a727d017 100644 --- a/basis/regexp/regexp-docs.factor +++ b/basis/regexp/regexp-docs.factor @@ -45,7 +45,7 @@ ARTICLE: { "regexp" "construction" } "Constructing regular expressions" ARTICLE: { "regexp" "syntax" } "Regular expression syntax" "Regexp syntax is largely compatible with Perl, Java and extended POSIX regexps, but not completely. Below, the syntax is documented." { $heading "Characters" } -"At its core, regular expressions consist of character literals. For example, " { $snippet "R/ f/" } " is a regular expression matching just the string 'f'. In addition, the normal escape codes are provided, like " { $snippet "\\t" } " for the tab character and " { $snippet "\\uxxxxxx" } "for an arbitrary Unicode code point, by its hex value. In addition, any character can be preceded by a backslash to escape it, unless this has special meaning. For example, to match a literal opening parenthesis, use " { $snippet "\\(" } "." +"At its core, regular expressions consist of character literals. For example, " { $snippet "R/ f/" } " is a regular expression matching just the string 'f'. In addition, the normal escape codes are provided, like " { $snippet "\\t" } " for the tab character and " { $snippet "\\uxxxxxx" } " for an arbitrary Unicode code point, by its hex value. In addition, any character can be preceded by a backslash to escape it, unless this has special meaning. For example, to match a literal opening parenthesis, use " { $snippet "\\(" } "." { $heading "Concatenation, alternation and grouping" } "Regular expressions can be built out of multiple characters by concatenation. For example, " { $snippet "R/ ab/" } " matches a followed by b. The " { $snippet "|" } " (alternation) operator can construct a regexp which matches one of two alternatives. Parentheses can be used for gropuing. So " { $snippet "R/ f(oo|ar)/" } " would match either 'foo' or 'far'." { $heading "Character classes" } @@ -72,7 +72,7 @@ ARTICLE: { "regexp" "syntax" } "Regular expression syntax" { { $snippet "\\p{blank}" } "Non-newline whitespace" } { { $snippet "\\p{cntrl}" } "Control character" } { { $snippet "\\p{space}" } "Whitespace" } - { { $snippet "\\p{xdigit}" } "Hexidecimal digit" } + { { $snippet "\\p{xdigit}" } "Hexadecimal digit" } { { $snippet "\\p{Nd}" } "Character in Unicode category Nd" } { { $snippet "\\p{Z}" } "Character in Unicode category beginning with Z" } { { $snippet "\\p{script=Cham}" } "Character in the Cham writing system" } } diff --git a/basis/simple-flat-file/simple-flat-file-docs.factor b/basis/simple-flat-file/simple-flat-file-docs.factor index 9ed5de7d2b..0223d94af9 100644 --- a/basis/simple-flat-file/simple-flat-file-docs.factor +++ b/basis/simple-flat-file/simple-flat-file-docs.factor @@ -1,8 +1,24 @@ -USING: help.syntax help.markup strings ; +! Copyright (C) 2009 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: help.syntax help.markup strings biassocs arrays ; IN: simple-flat-file ABOUT: "simple-flat-file" ARTICLE: "simple-flat-file" "Parsing simple flat files" -"The " { $vocab-link "simple-flat-file" } " vocabulary provides words for loading and parsing simple flat files in a particular format which is common for encoding tasks." -{ $subsection flat-file>biassoc } ; +"The " { $vocab-link "simple-flat-file" } " vocabulary provides words for loading and parsing simple flat files in a particular format which is common for encoding and Unicode tasks." +{ $subsection flat-file>biassoc } +{ $subsection load-interval-file } +{ $subsection data } ; + +HELP: load-interval-file +{ $values { "filename" string } { "table" "an interval map" } } +{ $description "This loads a file that looks like Script.txt in the Unicode Character Database and converts it into an efficient interval map, where the keys are characters and the values are strings for the properties." } ; + +HELP: data +{ $values { "filename" string } { "data" array } } +{ $description "This loads a file that's delineated by semicolons and lines, returning an array of lines, where each line is an array split by the semicolons, with whitespace trimmed off." } ; + +HELP: flat-file>biassoc +{ $values { "filename" string } { "biassoc" biassoc } } +{ $description "This loads a flat file, in the form that many encoding resource files are in, with two columns of numeric data in hex, and returns a biassoc associating them." } ; diff --git a/basis/simple-flat-file/simple-flat-file.factor b/basis/simple-flat-file/simple-flat-file.factor index 6e53c97738..88a64b7746 100644 --- a/basis/simple-flat-file/simple-flat-file.factor +++ b/basis/simple-flat-file/simple-flat-file.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. USING: sequences splitting kernel math.parser io.files io.encodings.utf8 -biassocs ascii ; +biassocs ascii namespaces arrays make assocs interval-maps sets ; IN: simple-flat-file : drop-comments ( seq -- newseq ) @@ -30,3 +30,25 @@ IN: simple-flat-file : data ( filename -- data ) utf8 file-lines drop-comments [ split-; ] map ; + +SYMBOL: interned + +: range, ( value key -- ) + swap interned get + [ = ] with find nip 2array , ; + +: expand-ranges ( assoc -- interval-map ) + [ + [ + swap CHAR: . over member? [ + ".." split1 [ hex> ] bi@ 2array + ] [ hex> ] if range, + ] assoc-each + ] { } make ; + +: process-interval-file ( ranges -- table ) + dup values prune interned + [ expand-ranges ] with-variable ; + +: load-interval-file ( filename -- table ) + data process-interval-file ; diff --git a/basis/unicode/breaks/breaks.factor b/basis/unicode/breaks/breaks.factor index 91f6a45911..f397ebb2de 100644 --- a/basis/unicode/breaks/breaks.factor +++ b/basis/unicode/breaks/breaks.factor @@ -5,7 +5,8 @@ combinators splitting sequences math.parser io.files io assocs arrays namespaces make math.ranges unicode.normalize unicode.normalize.private values io.encodings.ascii unicode.syntax unicode.data compiler.units fry -alien.syntax sets accessors interval-maps memoize locals words ; +alien.syntax sets accessors interval-maps memoize locals words +simple-flat-file ; IN: unicode.breaks char } { $subsection char>name } { $subsection property? } -{ $subsection load-key-value } ; +{ $subsection category } +{ $subsection ch>upper } +{ $subsection ch>lower } +{ $subsection ch>title } +{ $subsection special-case } ; HELP: canonical-entry { $values { "char" "a code point" } { "seq" string } } @@ -48,6 +52,22 @@ HELP: property? { $values { "char" "a code point" } { "property" string } { "?" "a boolean" } } { $description "Tests whether the code point is listed under the given property in PropList.txt in the Unicode Character Database." } ; -HELP: load-key-value -{ $values { "filename" string } { "table" "an interval map" } } -{ $description "This loads a file that looks like Script.txt in the Unicode Character Database and converts it into an efficient interval map, where the keys are characters and the values are strings for the properties." } ; +HELP: category +{ $values { "char" "a code point" } { "category" string } } +{ $description "Returns the general category of a code point, in the form of a string. This will always be a string within the ASCII range of length two. If the code point is unassigned, then it returns " { $snippet "Cn" } "." } ; + +HELP: ch>upper +{ $values { "ch" "a code point" } { "upper" "a code point" } } +{ $description "Returns the simple upper-cased version of the code point, if it exists. This does not handle context-sensitive or locale-dependent properties of linguistically accurate case conversion, and does not correctly handle characters which become multiple characters on conversion to this case." } ; + +HELP: ch>lower +{ $values { "ch" "a code point" } { "lower" "a code point" } } +{ $description "Returns the simple lower-cased version of the code point, if it exists. This does not handle context-sensitive or locale-dependent properties of linguistically accurate case conversion, and does not correctly handle characters which become multiple characters on conversion to this case." } ; + +HELP: ch>title +{ $values { "ch" "a code point" } { "title" "a code point" } } +{ $description "Returns the simple title-cased version of the code point, if it exists. This does not handle context-sensitive or locale-dependent properties of linguistically accurate case conversion, and does not correctly handle characters which become multiple characters on conversion to this case." } ; + +HELP: special-case +{ $values { "ch" "a code point" } { "casing-tuple" { "a tuple, or " { $link f } } } } +{ $description "If a code point has special casing behavior, returns a tuple which represents that information." } ; diff --git a/basis/unicode/data/data.factor b/basis/unicode/data/data.factor index e94036a85e..779ae64d48 100644 --- a/basis/unicode/data/data.factor +++ b/basis/unicode/data/data.factor @@ -58,7 +58,7 @@ CONSTANT: num-chars HEX: 2FA1E PRIVATE> -: category# ( char -- category ) +: category# ( char -- n ) ! There are a few characters that should be Cn ! that this gives Cf or Mn ! Cf = 26; Mn = 5; Cn = 29 @@ -219,27 +219,3 @@ load-properties to: properties [ name>char [ "Invalid character" throw ] unless* ] name>char-hook set-global - -SYMBOL: interned - -: range, ( value key -- ) - swap interned get - [ = ] with find nip 2array , ; - -: expand-ranges ( assoc -- interval-map ) - [ - [ - swap CHAR: . over member? [ - ".." split1 [ hex> ] bi@ 2array - ] [ hex> ] if range, - ] assoc-each - ] { } make ; - -: process-key-value ( ranges -- table ) - dup values prune interned - [ expand-ranges ] with-variable ; - -PRIVATE> - -: load-key-value ( filename -- table ) - data process-key-value ; diff --git a/basis/unicode/script/script.factor b/basis/unicode/script/script.factor index ed80476084..4243c81623 100644 --- a/basis/unicode/script/script.factor +++ b/basis/unicode/script/script.factor @@ -1,17 +1,13 @@ ! Copyright (C) 2008 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors values kernel sequences assocs io.files -io.encodings ascii math.ranges io splitting math.parser -namespaces make byte-arrays locals math sets io.encodings.ascii -words words.symbol compiler.units arrays interval-maps -unicode.data ; +USING: values interval-maps simple-flat-file ; IN: unicode.script diff --git a/basis/unicode/syntax/syntax.factor b/basis/unicode/syntax/syntax.factor index 5bd8c05e15..a42adb42ef 100644 --- a/basis/unicode/syntax/syntax.factor +++ b/basis/unicode/syntax/syntax.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: unicode.data kernel math sequences parser lexer bit-arrays namespaces make sequences.private arrays quotations -assocs classes.predicate math.order strings.parser ; +assocs classes.predicate math.order strings.parser sets ; IN: unicode.syntax : CATEGORY: CREATE ";" parse-tokens define-category ; parsing -: seq-minus ( seq1 seq2 -- diff ) - [ member? not ] curry filter ; - : CATEGORY-NOT: CREATE ";" parse-tokens - categories swap seq-minus define-category ; parsing + categories swap diff define-category ; parsing From f73f4e6293f82915d110a84e7086f840951d7f37 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 21 Mar 2009 00:47:33 -0500 Subject: [PATCH 02/16] Fix load error in mime.multipart --- basis/mime/multipart/multipart.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/basis/mime/multipart/multipart.factor b/basis/mime/multipart/multipart.factor index 7f9c979f40..37d5e13129 100755 --- a/basis/mime/multipart/multipart.factor +++ b/basis/mime/multipart/multipart.factor @@ -3,8 +3,7 @@ USING: multiline kernel sequences io splitting fry namespaces http.parsers hashtables assocs combinators ascii io.files.unique accessors io.encodings.binary io.files byte-arrays math -io.streams.string combinators.short-circuit strings math.order -quoting ; +io.streams.string combinators.short-circuit strings math.order ; IN: mime.multipart CONSTANT: buffer-size 65536 From 62638fb4d30fc1b6126ab84737cfec7305546b56 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sat, 21 Mar 2009 01:11:45 -0500 Subject: [PATCH 03/16] Moving unicode.syntax to unicode.categories.syntax; documenting and modifying syntax --- basis/unicode/breaks/breaks.factor | 8 ++--- basis/unicode/case/case.factor | 4 +-- .../unicode/categories/categories-docs.factor | 7 +++- basis/unicode/categories/categories.factor | 13 +++---- .../{ => categories}/syntax/authors.txt | 0 .../{ => categories}/syntax/summary.txt | 0 .../categories/syntax/syntax-docs.factor | 19 ++++++++++ .../categories/syntax/syntax-tests.factor | 3 ++ basis/unicode/categories/syntax/syntax.factor | 36 +++++++++++++++++++ .../unicode/{ => categories}/syntax/tags.txt | 0 basis/unicode/collation/collation.factor | 2 +- basis/unicode/normalize/normalize.factor | 2 +- basis/unicode/syntax/syntax.factor | 35 ------------------ basis/unicode/unicode-docs.factor | 2 +- basis/xml/char-classes/char-classes.factor | 25 ++++++++----- 15 files changed, 96 insertions(+), 60 deletions(-) rename basis/unicode/{ => categories}/syntax/authors.txt (100%) rename basis/unicode/{ => categories}/syntax/summary.txt (100%) create mode 100644 basis/unicode/categories/syntax/syntax-docs.factor create mode 100644 basis/unicode/categories/syntax/syntax-tests.factor create mode 100644 basis/unicode/categories/syntax/syntax.factor rename basis/unicode/{ => categories}/syntax/tags.txt (100%) delete mode 100644 basis/unicode/syntax/syntax.factor diff --git a/basis/unicode/breaks/breaks.factor b/basis/unicode/breaks/breaks.factor index f397ebb2de..22d6cddfb9 100644 --- a/basis/unicode/breaks/breaks.factor +++ b/basis/unicode/breaks/breaks.factor @@ -4,7 +4,7 @@ USING: combinators.short-circuit unicode.categories kernel math combinators splitting sequences math.parser io.files io assocs arrays namespaces make math.ranges unicode.normalize unicode.normalize.private values io.encodings.ascii -unicode.syntax unicode.data compiler.units fry +unicode.data compiler.units fry unicode.categories.syntax alien.syntax sets accessors interval-maps memoize locals words simple-flat-file ; IN: unicode.breaks @@ -32,9 +32,9 @@ CATEGORY: grapheme-control Zl Zp Cc Cf ; [ drop Control ] } case ; -CATEGORY: (extend) Me Mn ; -: extend? ( ch -- ? ) - { [ (extend)? ] [ "Other_Grapheme_Extend" property? ] } 1|| ; +CATEGORY: extend + Me Mn | + "Other_Grapheme_Extend" property? ; : loe? ( ch -- ? ) "Logical_Order_Exception" property? ; diff --git a/basis/unicode/case/case.factor b/basis/unicode/case/case.factor index fa842b8b81..1ad3931746 100644 --- a/basis/unicode/case/case.factor +++ b/basis/unicode/case/case.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008, 2009 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: unicode.data sequences namespaces -sbufs make unicode.syntax unicode.normalize math hints -unicode.categories combinators unicode.syntax assocs combinators.short-circuit +sbufs make unicode.normalize math hints +unicode.categories combinators assocs combinators.short-circuit strings splitting kernel accessors unicode.breaks fry locals ; QUALIFIED: ascii IN: unicode.case diff --git a/basis/unicode/categories/categories-docs.factor b/basis/unicode/categories/categories-docs.factor index b0870e28fb..924b197417 100644 --- a/basis/unicode/categories/categories-docs.factor +++ b/basis/unicode/categories/categories-docs.factor @@ -12,6 +12,9 @@ HELP: Letter HELP: alpha { $class-description "The class of alphanumeric characters." } ; +HELP: math +{ $class-description "The class of Unicode math characters." } ; + HELP: blank { $class-description "The class of whitespace characters." } ; @@ -54,6 +57,8 @@ ARTICLE: "unicode.categories" "Character classes" { $subsection uncased } { $subsection uncased? } { $subsection character } -{ $subsection character? } ; +{ $subsection character? } +{ $subsection math } +{ $subsection math? } ; ABOUT: "unicode.categories" diff --git a/basis/unicode/categories/categories.factor b/basis/unicode/categories/categories.factor index 0464e31b12..126c03c869 100644 --- a/basis/unicode/categories/categories.factor +++ b/basis/unicode/categories/categories.factor @@ -1,15 +1,16 @@ ! Copyright (C) 2008 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: unicode.syntax ; +USING: unicode.categories.syntax sequences unicode.data ; IN: unicode.categories -CATEGORY: blank Zs Zl Zp \r\n ; -CATEGORY: letter Ll ; -CATEGORY: LETTER Lu ; -CATEGORY: Letter Lu Ll Lt Lm Lo ; +CATEGORY: blank Zs Zl Zp | "\r\n" member? ; +CATEGORY: letter Ll | "Other_Lowercase" property? ; +CATEGORY: LETTER Lu | "Other_Uppercase" property? ; +CATEGORY: Letter Lu Ll Lt Lm Lo Nl ; CATEGORY: digit Nd Nl No ; CATEGORY-NOT: printable Cc Cf Cs Co Cn ; -CATEGORY: alpha Lu Ll Lt Lm Lo Nd Nl No ; +CATEGORY: alpha Lu Ll Lt Lm Lo Nd Nl No | "Other_Alphabetic" property? ; CATEGORY: control Cc ; CATEGORY-NOT: uncased Lu Ll Lt Lm Mn Me ; CATEGORY-NOT: character Cn ; +CATEGORY: math Sm | "Other_Math" property? ; diff --git a/basis/unicode/syntax/authors.txt b/basis/unicode/categories/syntax/authors.txt similarity index 100% rename from basis/unicode/syntax/authors.txt rename to basis/unicode/categories/syntax/authors.txt diff --git a/basis/unicode/syntax/summary.txt b/basis/unicode/categories/syntax/summary.txt similarity index 100% rename from basis/unicode/syntax/summary.txt rename to basis/unicode/categories/syntax/summary.txt diff --git a/basis/unicode/categories/syntax/syntax-docs.factor b/basis/unicode/categories/syntax/syntax-docs.factor new file mode 100644 index 0000000000..6293b92c72 --- /dev/null +++ b/basis/unicode/categories/syntax/syntax-docs.factor @@ -0,0 +1,19 @@ +! Copyright (C) 2008 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. +USING: help.syntax help.markup ; +IN: unicode.categories.syntax + +ABOUT: "unicode.categories.syntax" + +ARTICLE: "unicode.categories.syntax" "Unicode category syntax" +"There is special syntax sugar for making predicate classes which are unions of Unicode general categories, plus some other code." +{ $subsection POSTPONE: CATEGORY: } +{ $subsection POSTPONE: CATEGORY-NOT: } ; + +HELP: CATEGORY: +{ $syntax "CATEGORY: foo Nl Pd Lu | \"Diacritic\" property? ;" } +{ $description "This defines a predicate class which is a subset of code points. In this example, " { $snippet "foo" } " is the class of characters which are in the general category Nl or Pd or Lu, or which have the Diacritic property." } ; + +HELP: CATEGORY-NOT: +{ $syntax "CATEGORY-NOT: foo Nl Pd Lu | \"Diacritic\" property? ;" } +{ $description "This defines a predicate class which is a subset of code points, the complement of what " { $link POSTPONE: CATEGORY: } " would define. In this example, " { $snippet "foo" } " is the class of characters which are neither in the general category Nl or Pd or Lu, nor have the Diacritic property." } ; diff --git a/basis/unicode/categories/syntax/syntax-tests.factor b/basis/unicode/categories/syntax/syntax-tests.factor new file mode 100644 index 0000000000..1ec622fc98 --- /dev/null +++ b/basis/unicode/categories/syntax/syntax-tests.factor @@ -0,0 +1,3 @@ +! Copyright (C) 2009 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. + diff --git a/basis/unicode/categories/syntax/syntax.factor b/basis/unicode/categories/syntax/syntax.factor new file mode 100644 index 0000000000..593bb0bbdd --- /dev/null +++ b/basis/unicode/categories/syntax/syntax.factor @@ -0,0 +1,36 @@ +! Copyright (C) 2008, 2009 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. +USING: unicode.data kernel math sequences parser +bit-arrays namespaces sequences.private arrays classes.parser +assocs classes.predicate sets fry splitting accessors ; +IN: unicode.categories.syntax + +! For use in CATEGORY: +SYMBOLS: Cn Lu Ll Lt Lm Lo Mn Mc Me Nd Nl No Pc Pd Ps Pe Pi Pf Po Sm Sc Sk So Zs Zl Zp Cc Cf Cs Co | ; + +category-array ( categories -- bitarray ) + categories [ swap member? ] with map >bit-array ; + +: [category] ( categories code -- quot ) + [ >category-array ] dip + '[ dup category# _ nth-unsafe [ drop t ] _ if ] ; + +: define-category ( word categories code -- ) + [category] integer swap define-predicate-class ; + +: parse-category ( -- word tokens quot ) + CREATE-CLASS \ ; parse-until { | } split1 + [ [ name>> ] map ] + [ [ [ ] like ] [ [ drop f ] ] if* ] bi* ; + +PRIVATE> + +: CATEGORY: + parse-category define-category ; parsing + +: CATEGORY-NOT: + parse-category + [ categories swap diff ] dip + define-category ; parsing diff --git a/basis/unicode/syntax/tags.txt b/basis/unicode/categories/syntax/tags.txt similarity index 100% rename from basis/unicode/syntax/tags.txt rename to basis/unicode/categories/syntax/tags.txt diff --git a/basis/unicode/collation/collation.factor b/basis/unicode/collation/collation.factor index 0c51ea4352..b6eddccae0 100755 --- a/basis/unicode/collation/collation.factor +++ b/basis/unicode/collation/collation.factor @@ -4,7 +4,7 @@ USING: combinators.short-circuit sequences io.files io.encodings.ascii kernel values splitting accessors math.parser ascii io assocs strings math namespaces make sorting combinators math.order arrays unicode.normalize unicode.data locals -unicode.syntax macros sequences.deep words unicode.breaks +macros sequences.deep words unicode.breaks quotations combinators.short-circuit simple-flat-file ; IN: unicode.collation diff --git a/basis/unicode/normalize/normalize.factor b/basis/unicode/normalize/normalize.factor index 602d9555ea..aca96a5694 100644 --- a/basis/unicode/normalize/normalize.factor +++ b/basis/unicode/normalize/normalize.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: ascii sequences namespaces make unicode.data kernel math arrays locals sorting.insertion accessors assocs math.order combinators -unicode.syntax strings sbufs hints combinators.short-circuit vectors ; +strings sbufs hints combinators.short-circuit vectors ; IN: unicode.normalize category-array ( categories -- bitarray ) - categories [ swap member? ] with map >bit-array ; - -: as-string ( strings -- bit-array ) - concat unescape-string ; - -: [category] ( categories -- quot ) - [ - [ [ categories member? not ] filter as-string ] keep - [ categories member? ] filter >category-array - [ dup category# ] % , [ nth-unsafe [ drop t ] ] % - \ member? 2array >quotation , - \ if , - ] [ ] make ; - -: define-category ( word categories -- ) - [category] integer swap define-predicate-class ; - -PRIVATE> - -: CATEGORY: - CREATE ";" parse-tokens define-category ; parsing - -: CATEGORY-NOT: - CREATE ";" parse-tokens - categories swap diff define-category ; parsing diff --git a/basis/unicode/unicode-docs.factor b/basis/unicode/unicode-docs.factor index 4ae326ac84..9450b49f0b 100644 --- a/basis/unicode/unicode-docs.factor +++ b/basis/unicode/unicode-docs.factor @@ -15,7 +15,7 @@ $nl { $vocab-subsection "Word and grapheme breaks" "unicode.breaks" } { $vocab-subsection "Unicode normalization" "unicode.normalize" } "The following are mostly for internal use:" -{ $vocab-subsection "Unicode syntax" "unicode.syntax" } +{ $vocab-subsection "Unicode category syntax" "unicode.categories.syntax" } { $vocab-subsection "Unicode data tables" "unicode.data" } { $see-also "ascii" "io.encodings" } ; diff --git a/basis/xml/char-classes/char-classes.factor b/basis/xml/char-classes/char-classes.factor index d510c8a881..153fca0bb7 100644 --- a/basis/xml/char-classes/char-classes.factor +++ b/basis/xml/char-classes/char-classes.factor @@ -1,19 +1,26 @@ ! Copyright (C) 2005, 2009 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences unicode.syntax math math.order combinators -hints ; +USING: kernel sequences unicode.categories.syntax math math.order +combinators hints ; IN: xml.char-classes -CATEGORY: 1.0name-start* Ll Lu Lo Lt Nl \u000559\u0006E5\u0006E6_: ; -: 1.0name-start? ( char -- ? ) - dup 1.0name-start*? [ drop t ] - [ HEX: 2BB HEX: 2C1 between? ] if ; +CATEGORY: 1.0name-start + Ll Lu Lo Lt Nl | { + [ HEX: 2BB HEX: 2C1 between? ] + [ "\u000559\u0006E5\u0006E6_:" member? ] + } 1|| ; -CATEGORY: 1.0name-char Ll Lu Lo Lt Nl Mc Me Mn Lm Nd _-.\u000387: ; +CATEGORY: 1.0name-char + Ll Lu Lo Lt Nl Mc Me Mn Lm Nd | + "_-.\u000387:" member? ; -CATEGORY: 1.1name-start Ll Lu Lo Lm Ln Nl _: ; +CATEGORY: 1.1name-start + Ll Lu Lo Lm Ln Nl | + "_:" member? ; -CATEGORY: 1.1name-char Ll Lu Lo Lm Ln Nl Mc Mn Nd Pc Cf _-.\u0000b7: ; +CATEGORY: 1.1name-char + Ll Lu Lo Lm Ln Nl Mc Mn Nd Pc Cf | + "_-.\u0000b7:" member? ; : name-start? ( 1.0? char -- ? ) swap [ 1.0name-start? ] [ 1.1name-start? ] if ; From c6fc88f28f8d846da3d47fbfadfbf385cba01751 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sat, 21 Mar 2009 01:18:25 -0500 Subject: [PATCH 04/16] Unicode categories syntax cleanup --- basis/unicode/categories/syntax/syntax.factor | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/basis/unicode/categories/syntax/syntax.factor b/basis/unicode/categories/syntax/syntax.factor index 593bb0bbdd..93f7919b6b 100644 --- a/basis/unicode/categories/syntax/syntax.factor +++ b/basis/unicode/categories/syntax/syntax.factor @@ -17,8 +17,14 @@ SYMBOLS: Cn Lu Ll Lt Lm Lo Mn Mc Me Nd Nl No Pc Pd Ps Pe Pi Pf Po Sm Sc Sk So Zs [ >category-array ] dip '[ dup category# _ nth-unsafe [ drop t ] _ if ] ; +: integer-predicate-class ( word predicate -- ) + integer swap define-predicate-class ; + : define-category ( word categories code -- ) - [category] integer swap define-predicate-class ; + [category] integer-predicate-class ; + +: define-not-category ( word categories code -- ) + [category] [ not ] compose integer-predicate-class ; : parse-category ( -- word tokens quot ) CREATE-CLASS \ ; parse-until { | } split1 @@ -31,6 +37,4 @@ PRIVATE> parse-category define-category ; parsing : CATEGORY-NOT: - parse-category - [ categories swap diff ] dip - define-category ; parsing + parse-category define-not-category ; parsing From ea60f8ae93f250433be631459afe0028da519eff Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 21 Mar 2009 01:27:50 -0500 Subject: [PATCH 05/16] Changing : foo ; parsing to SYNTAX: foo ; --- basis/alien/destructors/destructors.factor | 2 +- basis/alien/fortran/fortran.factor | 14 +- basis/alien/syntax/syntax.factor | 31 ++-- basis/bit-arrays/bit-arrays.factor | 2 +- basis/bit-vectors/bit-vectors.factor | 2 +- basis/byte-vectors/byte-vectors.factor | 2 +- basis/cocoa/cocoa.factor | 12 +- basis/cocoa/subclassing/subclassing.factor | 4 +- basis/colors/constants/constants.factor | 2 +- .../cfg/instructions/syntax/syntax.factor | 4 +- basis/compiler/cfg/registers/registers.factor | 6 +- basis/constructors/constructors.factor | 4 +- basis/core-text/utilities/utilities.factor | 4 +- .../cpu/ppc/assembler/backend/backend.factor | 28 ++-- basis/cpu/x86/assembler/syntax/syntax.factor | 3 +- basis/definitions/icons/icons.factor | 4 +- basis/delegate/delegate.factor | 12 +- basis/fry/fry.factor | 2 +- basis/functors/functors.factor | 46 +++--- basis/help/syntax/syntax.factor | 12 +- basis/hints/hints.factor | 3 +- .../html/templates/chloe/syntax/syntax.factor | 4 +- basis/html/templates/fhtml/fhtml.factor | 2 +- basis/interpolate/interpolate.factor | 4 +- basis/io/encodings/euc/euc.factor | 4 +- basis/listener/listener-tests.factor | 2 +- basis/locals/locals.factor | 22 ++- basis/logging/logging.factor | 4 +- basis/macros/macros.factor | 2 +- basis/match/match.factor | 4 +- basis/math/blas/matrices/matrices.factor | 2 +- basis/math/blas/vectors/vectors.factor | 2 +- basis/math/complex/complex.factor | 2 +- basis/memoize/memoize.factor | 2 +- basis/multiline/multiline.factor | 22 +-- basis/nibble-arrays/nibble-arrays.factor | 2 +- basis/opengl/gl/extensions/extensions.factor | 5 +- basis/openssl/libssl/libssl.factor | 4 +- basis/peg/ebnf/ebnf.factor | 18 +-- basis/peg/peg.factor | 4 +- basis/persistent/hashtables/hashtables.factor | 2 +- basis/persistent/vectors/vectors.factor | 2 +- basis/prettyprint/prettyprint-docs.factor | 4 +- basis/regexp/regexp.factor | 22 +-- basis/roman/roman.factor | 2 +- basis/see/see.factor | 1 - basis/shuffle/shuffle.factor | 4 +- .../specialized-arrays/functor/functor.factor | 2 +- .../functor/functor.factor | 2 +- basis/suffix-arrays/suffix-arrays.factor | 2 +- basis/tr/tr.factor | 3 +- basis/unicode/syntax/syntax.factor | 8 +- basis/urls/urls.factor | 2 +- basis/values/values.factor | 8 +- basis/vlists/vlists.factor | 4 +- basis/windows/com/syntax/syntax.factor | 7 +- basis/xml/syntax/syntax.factor | 20 +-- basis/xmode/loader/syntax/syntax.factor | 4 +- core/bootstrap/syntax.factor | 2 +- core/parser/parser-docs.factor | 6 +- core/parser/parser-tests.factor | 4 +- core/syntax/syntax-docs.factor | 8 +- core/syntax/syntax.factor | 143 +++++++++--------- core/words/words-docs.factor | 10 +- core/words/words.factor | 5 +- extra/advice/advice.factor | 8 +- extra/annotations/annotations.factor | 2 +- extra/descriptive/descriptive.factor | 6 +- extra/infix/infix.factor | 8 +- extra/literals/literals.factor | 4 +- extra/math/derivatives/syntax/syntax.factor | 4 +- extra/method-chains/method-chains.factor | 4 +- extra/money/money.factor | 3 +- extra/peg-lexer/peg-lexer.factor | 5 +- extra/project-euler/common/common.factor | 4 +- extra/promises/promises.factor | 4 +- extra/slides/slides.factor | 4 +- extra/trees/avl/avl.factor | 4 +- extra/trees/splay/splay.factor | 4 +- extra/trees/trees.factor | 4 +- extra/vars/vars.factor | 8 +- 81 files changed, 328 insertions(+), 335 deletions(-) diff --git a/basis/alien/destructors/destructors.factor b/basis/alien/destructors/destructors.factor index 6c55528b70..1b6022d3b7 100644 --- a/basis/alien/destructors/destructors.factor +++ b/basis/alien/destructors/destructors.factor @@ -26,4 +26,4 @@ M: F-destructor dispose* alien>> F ; ;FUNCTOR -: DESTRUCTOR: scan-word define-destructor ; parsing \ No newline at end of file +SYNTAX: DESTRUCTOR: scan-word define-destructor ; \ No newline at end of file diff --git a/basis/alien/fortran/fortran.factor b/basis/alien/fortran/fortran.factor index 5e3dc24476..83d56bf9e2 100644 --- a/basis/alien/fortran/fortran.factor +++ b/basis/alien/fortran/fortran.factor @@ -416,7 +416,7 @@ PRIVATE> : define-fortran-record ( name vocab fields -- ) [ >lower ] [ ] [ fortran-record>c-struct ] tri* define-struct ; -: RECORD: scan in get parse-definition define-fortran-record ; parsing +SYNTAX: RECORD: scan in get parse-definition define-fortran-record ; : set-fortran-abi ( library -- ) library-fortran-abis get-global at fortran-abi set ; @@ -437,16 +437,16 @@ MACRO: fortran-invoke ( return library function parameters -- ) return library function parameters return [ "void" ] unless* parse-arglist [ \ fortran-invoke 5 [ ] nsequence ] dip define-declared ; -: SUBROUTINE: +SYNTAX: SUBROUTINE: f "c-library" get scan ";" parse-tokens - [ "()" subseq? not ] filter define-fortran-function ; parsing + [ "()" subseq? not ] filter define-fortran-function ; -: FUNCTION: +SYNTAX: FUNCTION: scan "c-library" get scan ";" parse-tokens - [ "()" subseq? not ] filter define-fortran-function ; parsing + [ "()" subseq? not ] filter define-fortran-function ; -: LIBRARY: +SYNTAX: LIBRARY: scan [ "c-library" set ] - [ set-fortran-abi ] bi ; parsing + [ set-fortran-abi ] bi ; diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor index 987c73127e..5406970364 100644 --- a/basis/alien/syntax/syntax.factor +++ b/basis/alien/syntax/syntax.factor @@ -7,35 +7,34 @@ effects assocs combinators lexer strings.parser alien.parser fry vocabs.parser words.constant ; IN: alien.syntax -: DLL" lexer get skip-blank parse-string dlopen parsed ; parsing +SYNTAX: DLL" lexer get skip-blank parse-string dlopen parsed ; -: ALIEN: scan string>number parsed ; parsing +SYNTAX: ALIEN: scan string>number parsed ; -: BAD-ALIEN parsed ; parsing +SYNTAX: BAD-ALIEN parsed ; -: LIBRARY: scan "c-library" set ; parsing +SYNTAX: LIBRARY: scan "c-library" set ; -: FUNCTION: +SYNTAX: FUNCTION: scan "c-library" get scan ";" parse-tokens [ "()" subseq? not ] filter - define-function ; parsing + define-function ; -: TYPEDEF: - scan scan typedef ; parsing +SYNTAX: TYPEDEF: + scan scan typedef ; -: C-STRUCT: - scan in get parse-definition define-struct ; parsing +SYNTAX: C-STRUCT: + scan in get parse-definition define-struct ; -: C-UNION: - scan parse-definition define-union ; parsing +SYNTAX: C-UNION: + scan parse-definition define-union ; -: C-ENUM: +SYNTAX: C-ENUM: ";" parse-tokens [ [ create-in ] dip define-constant ] each-index ; - parsing : address-of ( name library -- value ) load-library dlsym [ "No such symbol" throw ] unless* ; -: &: - scan "c-library" get '[ _ _ address-of ] over push-all ; parsing +SYNTAX: &: + scan "c-library" get '[ _ _ address-of ] over push-all ; diff --git a/basis/bit-arrays/bit-arrays.factor b/basis/bit-arrays/bit-arrays.factor index e7dd6695a7..be8c434e36 100644 --- a/basis/bit-arrays/bit-arrays.factor +++ b/basis/bit-arrays/bit-arrays.factor @@ -68,7 +68,7 @@ M: bit-array resize M: bit-array byte-length length 7 + -3 shift ; -: ?{ \ } [ >bit-array ] parse-literal ; parsing +SYNTAX: ?{ \ } [ >bit-array ] parse-literal ; : integer>bit-array ( n -- bit-array ) dup 0 = [ diff --git a/basis/bit-vectors/bit-vectors.factor b/basis/bit-vectors/bit-vectors.factor index 85bea80b2d..a238f61244 100644 --- a/basis/bit-vectors/bit-vectors.factor +++ b/basis/bit-vectors/bit-vectors.factor @@ -31,7 +31,7 @@ M: bit-array new-resizable drop ; INSTANCE: bit-vector growable -: ?V{ \ } [ >bit-vector ] parse-literal ; parsing +SYNTAX: ?V{ \ } [ >bit-vector ] parse-literal ; M: bit-vector >pprint-sequence ; M: bit-vector pprint-delims drop \ ?V{ \ } ; diff --git a/basis/byte-vectors/byte-vectors.factor b/basis/byte-vectors/byte-vectors.factor index d146017db0..970f4abbd8 100644 --- a/basis/byte-vectors/byte-vectors.factor +++ b/basis/byte-vectors/byte-vectors.factor @@ -42,7 +42,7 @@ M: byte-array like M: byte-array new-resizable drop ; -: BV{ \ } [ >byte-vector ] parse-literal ; parsing +SYNTAX: BV{ \ } [ >byte-vector ] parse-literal ; M: byte-vector pprint* pprint-object ; M: byte-vector pprint-delims drop \ BV{ \ } ; diff --git a/basis/cocoa/cocoa.factor b/basis/cocoa/cocoa.factor index 01f134e283..69d698f9b1 100644 --- a/basis/cocoa/cocoa.factor +++ b/basis/cocoa/cocoa.factor @@ -14,18 +14,14 @@ SYMBOL: sent-messages : remember-send ( selector -- ) sent-messages (remember-send) ; -: -> - scan dup remember-send parsed \ send parsed ; - parsing +SYNTAX: -> scan dup remember-send parsed \ send parsed ; SYMBOL: super-sent-messages : remember-super-send ( selector -- ) super-sent-messages (remember-send) ; -: SUPER-> - scan dup remember-super-send parsed \ super-send parsed ; - parsing +SYNTAX: SUPER-> scan dup remember-super-send parsed \ super-send parsed ; SYMBOL: frameworks @@ -33,9 +29,9 @@ frameworks [ V{ } clone ] initialize [ frameworks get [ load-framework ] each ] "cocoa.messages" add-init-hook -: FRAMEWORK: scan [ load-framework ] [ frameworks get push ] bi ; parsing +SYNTAX: FRAMEWORK: scan [ load-framework ] [ frameworks get push ] bi ; -: IMPORT: scan [ ] import-objc-class ; parsing +SYNTAX: IMPORT: scan [ ] import-objc-class ; "Compiling Objective C bridge..." print diff --git a/basis/cocoa/subclassing/subclassing.factor b/basis/cocoa/subclassing/subclassing.factor index c3f1b471e0..e4db56221f 100644 --- a/basis/cocoa/subclassing/subclassing.factor +++ b/basis/cocoa/subclassing/subclassing.factor @@ -76,6 +76,6 @@ SYMBOL: +superclass+ import-objc-class ] bind ; -: CLASS: +SYNTAX: CLASS: parse-definition unclip - >hashtable define-objc-class ; parsing + >hashtable define-objc-class ; diff --git a/basis/colors/constants/constants.factor b/basis/colors/constants/constants.factor index 91621c110b..38339577cf 100644 --- a/basis/colors/constants/constants.factor +++ b/basis/colors/constants/constants.factor @@ -30,4 +30,4 @@ ERROR: no-such-color name ; : named-color ( name -- color ) dup rgb.txt at [ ] [ no-such-color ] ?if ; -: COLOR: scan named-color parsed ; parsing \ No newline at end of file +SYNTAX: COLOR: scan named-color parsed ; \ No newline at end of file diff --git a/basis/compiler/cfg/instructions/syntax/syntax.factor b/basis/compiler/cfg/instructions/syntax/syntax.factor index 0389841e8f..876ac5596c 100644 --- a/basis/compiler/cfg/instructions/syntax/syntax.factor +++ b/basis/compiler/cfg/instructions/syntax/syntax.factor @@ -13,10 +13,10 @@ IN: compiler.cfg.instructions.syntax : insn-effect ( word -- effect ) boa-effect in>> but-last f ; -: INSN: +SYNTAX: INSN: parse-tuple-definition "regs" suffix [ dup tuple eq? [ drop insn-word ] when ] dip [ define-tuple-class ] [ 2drop save-location ] [ 2drop [ ] [ '[ f _ boa , ] ] [ insn-effect ] tri define-inline ] - 3tri ; parsing + 3tri ; diff --git a/basis/compiler/cfg/registers/registers.factor b/basis/compiler/cfg/registers/registers.factor index 2b9d3df6f6..0882bed06e 100644 --- a/basis/compiler/cfg/registers/registers.factor +++ b/basis/compiler/cfg/registers/registers.factor @@ -17,6 +17,6 @@ C: ds-loc TUPLE: rs-loc < loc ; C: rs-loc -: V scan-word scan-word vreg boa parsed ; parsing -: D scan-word parsed ; parsing -: R scan-word parsed ; parsing +SYNTAX: V scan-word scan-word vreg boa parsed ; +SYNTAX: D scan-word parsed ; +SYNTAX: R scan-word parsed ; diff --git a/basis/constructors/constructors.factor b/basis/constructors/constructors.factor index 2eab91310f..8cfeb83910 100644 --- a/basis/constructors/constructors.factor +++ b/basis/constructors/constructors.factor @@ -16,8 +16,8 @@ MACRO: set-slots ( slots -- quot ) [ [ in>> '[ _ _ construct ] ] dip compose ] [ drop ] 2bi define-declared ; -: CONSTRUCTOR: +SYNTAX: CONSTRUCTOR: scan-word [ name>> "<" ">" surround create-in ] keep "(" expect ")" parse-effect parse-definition - define-constructor ; parsing \ No newline at end of file + define-constructor ; \ No newline at end of file diff --git a/basis/core-text/utilities/utilities.factor b/basis/core-text/utilities/utilities.factor index 8c085d40be..7de601c433 100644 --- a/basis/core-text/utilities/utilities.factor +++ b/basis/core-text/utilities/utilities.factor @@ -3,7 +3,7 @@ USING: words parser alien alien.c-types kernel fry accessors ; IN: core-text.utilities -: C-GLOBAL: +SYNTAX: C-GLOBAL: CREATE-WORD dup name>> '[ _ f dlsym *void* ] - (( -- value )) define-declared ; parsing + (( -- value )) define-declared ; diff --git a/basis/cpu/ppc/assembler/backend/backend.factor b/basis/cpu/ppc/assembler/backend/backend.factor index c6a3a94194..befbe112bd 100644 --- a/basis/cpu/ppc/assembler/backend/backend.factor +++ b/basis/cpu/ppc/assembler/backend/backend.factor @@ -21,7 +21,7 @@ IN: cpu.ppc.assembler.backend : define-d-insn ( word opcode -- ) [ d-insn ] curry (( d a simm -- )) define-declared ; -: D: CREATE scan-word define-d-insn ; parsing +SYNTAX: D: CREATE scan-word define-d-insn ; : sd-insn ( d a simm opcode -- ) [ s>u16 { 0 21 16 } bitfield ] dip insn ; @@ -29,7 +29,7 @@ IN: cpu.ppc.assembler.backend : define-sd-insn ( word opcode -- ) [ sd-insn ] curry (( d a simm -- )) define-declared ; -: SD: CREATE scan-word define-sd-insn ; parsing +SYNTAX: SD: CREATE scan-word define-sd-insn ; : i-insn ( li aa lk opcode -- ) [ { 0 1 0 } bitfield ] dip insn ; @@ -40,26 +40,26 @@ IN: cpu.ppc.assembler.backend : (X) ( -- word quot ) CREATE scan-word scan-word scan-word [ x-insn ] 3curry ; -: X: (X) (( a s b -- )) define-declared ; parsing +SYNTAX: X: (X) (( a s b -- )) define-declared ; : (1) ( quot -- quot' ) [ 0 ] prepose ; -: X1: (X) (1) (( a s -- )) define-declared ; parsing +SYNTAX: X1: (X) (1) (( a s -- )) define-declared ; : xfx-insn ( d spr xo opcode -- ) [ { 1 11 21 } bitfield ] dip insn ; : CREATE-MF ( -- word ) scan "MF" prepend create-in ; -: MFSPR: +SYNTAX: MFSPR: CREATE-MF scan-word 5 shift [ 339 31 xfx-insn ] curry - (( d -- )) define-declared ; parsing + (( d -- )) define-declared ; : CREATE-MT ( -- word ) scan "MT" prepend create-in ; -: MTSPR: +SYNTAX: MTSPR: CREATE-MT scan-word 5 shift [ 467 31 xfx-insn ] curry - (( d -- )) define-declared ; parsing + (( d -- )) define-declared ; : xo-insn ( d a b oe rc xo opcode -- ) [ { 1 0 10 11 16 21 } bitfield ] dip insn ; @@ -68,9 +68,9 @@ IN: cpu.ppc.assembler.backend CREATE scan-word scan-word scan-word scan-word [ xo-insn ] 2curry 2curry ; -: XO: (XO) (( a s b -- )) define-declared ; parsing +SYNTAX: XO: (XO) (( a s b -- )) define-declared ; -: XO1: (XO) (1) (( a s -- )) define-declared ; parsing +SYNTAX: XO1: (XO) (1) (( a s -- )) define-declared ; GENERIC# (B) 2 ( dest aa lk -- ) M: integer (B) 18 i-insn ; @@ -84,11 +84,11 @@ M: label BC [ 0 BC ] dip rc-relative-ppc-2 label-fixup ; : CREATE-B ( -- word ) scan "B" prepend create-in ; -: BC: +SYNTAX: BC: CREATE-B scan-word scan-word - [ rot BC ] 2curry (( c -- )) define-declared ; parsing + [ rot BC ] 2curry (( c -- )) define-declared ; -: B: +SYNTAX: B: CREATE-B scan-word scan-word scan-word scan-word scan-word [ b-insn ] curry curry curry curry curry - (( bo -- )) define-declared ; parsing + (( bo -- )) define-declared ; diff --git a/basis/cpu/x86/assembler/syntax/syntax.factor b/basis/cpu/x86/assembler/syntax/syntax.factor index 343850f9e6..631dcaa8f7 100644 --- a/basis/cpu/x86/assembler/syntax/syntax.factor +++ b/basis/cpu/x86/assembler/syntax/syntax.factor @@ -11,5 +11,4 @@ IN: cpu.x86.assembler.syntax : define-registers ( names size -- ) '[ _ define-register ] each-index ; -: REGISTERS: ( -- ) - scan-word ";" parse-tokens swap define-registers ; parsing +SYNTAX: REGISTERS: scan-word ";" parse-tokens swap define-registers ; diff --git a/basis/definitions/icons/icons.factor b/basis/definitions/icons/icons.factor index fb25ccf715..7c5fbed9f4 100644 --- a/basis/definitions/icons/icons.factor +++ b/basis/definitions/icons/icons.factor @@ -14,10 +14,10 @@ GENERIC: definition-icon ( definition -- path ) << -: ICON: +SYNTAX: ICON: scan-word \ definition-icon create-method scan '[ drop _ definition-icon-path ] - define ; parsing + define ; >> diff --git a/basis/delegate/delegate.factor b/basis/delegate/delegate.factor index 0c16b7c336..fe6ea03794 100644 --- a/basis/delegate/delegate.factor +++ b/basis/delegate/delegate.factor @@ -85,9 +85,9 @@ PRIVATE> : define-consult ( consultation -- ) [ register-consult ] [ consult-methods ] bi ; -: CONSULT: +SYNTAX: CONSULT: scan-word scan-word parse-definition - [ save-location ] [ define-consult ] bi ; parsing + [ save-location ] [ define-consult ] bi ; M: consultation where loc>> ; @@ -144,8 +144,8 @@ PRIVATE> [ initialize-protocol-props ] 2tri ] 2bi ; -: PROTOCOL: - CREATE-WORD parse-definition define-protocol ; parsing +SYNTAX: PROTOCOL: + CREATE-WORD parse-definition define-protocol ; PREDICATE: protocol < word protocol-words ; ! Subclass of symbol? @@ -159,7 +159,7 @@ M: protocol definer drop \ PROTOCOL: \ ; ; M: protocol group-words protocol-words ; -: SLOT-PROTOCOL: +SYNTAX: SLOT-PROTOCOL: CREATE-WORD ";" parse-tokens [ [ reader-word ] [ writer-word ] bi 2array ] map concat - define-protocol ; parsing \ No newline at end of file + define-protocol ; \ No newline at end of file diff --git a/basis/fry/fry.factor b/basis/fry/fry.factor index 9ffad43cf4..d50fd9442b 100644 --- a/basis/fry/fry.factor +++ b/basis/fry/fry.factor @@ -53,4 +53,4 @@ M: callable deep-fry M: object deep-fry , ; -: '[ parse-quotation fry over push-all ; parsing +SYNTAX: '[ parse-quotation fry over push-all ; diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor index caa41d6c29..58c9edaf0c 100644 --- a/basis/functors/functors.factor +++ b/basis/functors/functors.factor @@ -16,6 +16,8 @@ IN: functors : define* ( word def effect -- ) pick set-word define-declared ; +: define-syntax* ( word def -- ) over set-word define-syntax ; + TUPLE: fake-quotation seq ; GENERIC: >fake-quotations ( quot -- fake ) @@ -41,7 +43,7 @@ M: object fake-quotations> ; : DEFINE* ( accum -- accum ) effect get parsed \ define* parsed ; -: `TUPLE: +SYNTAX: `TUPLE: scan-param parsed scan { { ";" [ tuple parsed f parsed ] } @@ -52,40 +54,44 @@ M: object fake-quotations> ; make parsed ] } case - \ define-tuple-class parsed ; parsing + \ define-tuple-class parsed ; -: `M: +SYNTAX: `M: effect off scan-param parsed scan-param parsed \ create-method-in parsed parse-definition* - DEFINE* ; parsing + DEFINE* ; -: `C: +SYNTAX: `C: effect off scan-param parsed scan-param parsed [ [ boa ] curry ] over push-all - DEFINE* ; parsing + DEFINE* ; -: `: +SYNTAX: `: effect off scan-param parsed parse-definition* - DEFINE* ; parsing + DEFINE* ; -: `INSTANCE: +SYNTAX: `SYNTAX: + effect off + scan-param parsed + parse-definition* + \ define-syntax* parsed ; + +SYNTAX: `INSTANCE: scan-param parsed scan-param parsed - \ add-mixin-instance parsed ; parsing + \ add-mixin-instance parsed ; -: `inline [ word make-inline ] over push-all ; parsing +SYNTAX: `inline [ word make-inline ] over push-all ; -: `parsing [ word make-parsing ] over push-all ; parsing - -: `( - ")" parse-effect effect set ; parsing +SYNTAX: `( + ")" parse-effect effect set ; : (INTERPOLATE) ( accum quot -- accum ) [ scan interpolate-locals ] dip @@ -93,11 +99,11 @@ M: object fake-quotations> ; PRIVATE> -: IS [ dup search [ ] [ no-word ] ?if ] (INTERPOLATE) ; parsing +SYNTAX: IS [ dup search [ ] [ no-word ] ?if ] (INTERPOLATE) ; -: DEFINES [ create-in ] (INTERPOLATE) ; parsing +SYNTAX: DEFINES [ create-in ] (INTERPOLATE) ; -: DEFINES-CLASS [ create-class-in ] (INTERPOLATE) ; parsing +SYNTAX: DEFINES-CLASS [ create-class-in ] (INTERPOLATE) ; DEFER: ;FUNCTOR delimiter @@ -110,8 +116,8 @@ DEFER: ;FUNCTOR delimiter { "C:" POSTPONE: `C: } { ":" POSTPONE: `: } { "INSTANCE:" POSTPONE: `INSTANCE: } + { "SYNTAX:" POSTPONE: `SYNTAX: } { "inline" POSTPONE: `inline } - { "parsing" POSTPONE: `parsing } { "(" POSTPONE: `( } } ; @@ -132,4 +138,4 @@ DEFER: ;FUNCTOR delimiter PRIVATE> -: FUNCTOR: (FUNCTOR:) define ; parsing +SYNTAX: FUNCTOR: (FUNCTOR:) define ; diff --git a/basis/help/syntax/syntax.factor b/basis/help/syntax/syntax.factor index 9f98ba6d8d..044768aec2 100644 --- a/basis/help/syntax/syntax.factor +++ b/basis/help/syntax/syntax.factor @@ -5,19 +5,19 @@ help.topics namespaces vocabs definitions compiler.units vocabs.parser ; IN: help.syntax -: HELP: +SYNTAX: HELP: scan-word bootstrap-word dup set-word dup >link save-location - \ ; parse-until >array swap set-word-help ; parsing + \ ; parse-until >array swap set-word-help ; -: ARTICLE: +SYNTAX: ARTICLE: location [ \ ; parse-until >array [ first2 ] keep 2 tail
over add-article >link - ] dip remember-definition ; parsing + ] dip remember-definition ; -: ABOUT: +SYNTAX: ABOUT: in get vocab dup changed-definition - scan-object >>help drop ; parsing + scan-object >>help drop ; diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor index 4093666eb7..52684e55f5 100644 --- a/basis/hints/hints.factor +++ b/basis/hints/hints.factor @@ -59,12 +59,11 @@ M: object specializer-declaration class ; : specialized-length ( specializer -- n ) dup [ array? ] all? [ first ] when length ; -: HINTS: +SYNTAX: HINTS: scan-object dup method-spec? [ first2 method ] when [ redefined ] [ parse-definition "specializer" set-word-prop ] bi ; - parsing ! Default specializers { first first2 first3 first4 } diff --git a/basis/html/templates/chloe/syntax/syntax.factor b/basis/html/templates/chloe/syntax/syntax.factor index 7af37b6592..7c47a44d9e 100644 --- a/basis/html/templates/chloe/syntax/syntax.factor +++ b/basis/html/templates/chloe/syntax/syntax.factor @@ -15,8 +15,8 @@ tags [ H{ } clone ] initialize : define-chloe-tag ( name quot -- ) swap tags get set-at ; -: CHLOE: - scan parse-definition define-chloe-tag ; parsing +SYNTAX: CHLOE: + scan parse-definition define-chloe-tag ; CONSTANT: chloe-ns "http://factorcode.org/chloe/1.0" diff --git a/basis/html/templates/fhtml/fhtml.factor b/basis/html/templates/fhtml/fhtml.factor index f3539f6a0f..21e9f8352d 100644 --- a/basis/html/templates/fhtml/fhtml.factor +++ b/basis/html/templates/fhtml/fhtml.factor @@ -49,7 +49,7 @@ DEFER: <% delimiter drop ] if ; -: %> lexer get parse-%> ; parsing +SYNTAX: %> lexer get parse-%> ; : parse-template-lines ( lines -- quot ) [ diff --git a/basis/interpolate/interpolate.factor b/basis/interpolate/interpolate.factor index 5c859f8947..1de65fa91f 100644 --- a/basis/interpolate/interpolate.factor +++ b/basis/interpolate/interpolate.factor @@ -38,6 +38,6 @@ MACRO: interpolate ( string -- ) : interpolate-locals ( string -- quot ) [ search [ ] ] (interpolate) ; -: I[ +SYNTAX: I[ "]I" parse-multiline-string - interpolate-locals over push-all ; parsing + interpolate-locals over push-all ; diff --git a/basis/io/encodings/euc/euc.factor b/basis/io/encodings/euc/euc.factor index e20580876e..bf882fcfd0 100644 --- a/basis/io/encodings/euc/euc.factor +++ b/basis/io/encodings/euc/euc.factor @@ -63,6 +63,6 @@ SYMBOL: euc-table PRIVATE> -: EUC: +SYNTAX: EUC: ! EUC: euc-kr "vocab:io/encodings/korean/cp949.txt" - CREATE-CLASS scan-object define-euc ; parsing + CREATE-CLASS scan-object define-euc ; diff --git a/basis/listener/listener-tests.factor b/basis/listener/listener-tests.factor index 61aa323924..00f1cca678 100644 --- a/basis/listener/listener-tests.factor +++ b/basis/listener/listener-tests.factor @@ -3,7 +3,7 @@ tools.test parser math namespaces continuations vocabs kernel compiler.units eval vocabs.parser ; IN: listener.tests -: hello "Hi" print ; parsing +SYNTAX: hello "Hi" print ; : parse-interactive ( string -- quot ) stream-read-quot ; diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor index 190be61e23..e6b363c209 100644 --- a/basis/locals/locals.factor +++ b/basis/locals/locals.factor @@ -5,27 +5,25 @@ vocabs.loader words kernel namespaces locals.parser locals.types locals.errors ; IN: locals -: :> +SYNTAX: :> scan locals get [ :>-outside-lambda-error ] unless* - [ make-local ] bind parsed ; parsing + [ make-local ] bind parsed ; -: [| parse-lambda over push-all ; parsing +SYNTAX: [| parse-lambda over push-all ; -: [let parse-let over push-all ; parsing +SYNTAX: [let parse-let over push-all ; -: [let* parse-let* over push-all ; parsing +SYNTAX: [let* parse-let* over push-all ; -: [wlet parse-wlet over push-all ; parsing +SYNTAX: [wlet parse-wlet over push-all ; -: :: (::) define ; parsing +SYNTAX: :: (::) define ; -: M:: (M::) define ; parsing +SYNTAX: M:: (M::) define ; -: MACRO:: (::) define-macro ; parsing +SYNTAX: MACRO:: (::) define-macro ; -: MEMO:: (::) define-memoized ; parsing - -USE: syntax +SYNTAX: MEMO:: (::) define-memoized ; { "locals.macros" diff --git a/basis/logging/logging.factor b/basis/logging/logging.factor index c8413c14fe..c8179108ef 100644 --- a/basis/logging/logging.factor +++ b/basis/logging/logging.factor @@ -135,11 +135,11 @@ PRIVATE> [ [ input-logging-quot ] 2keep drop error-logging-quot ] (define-logging) ; -: LOG: +SYNTAX: LOG: #! Syntax: name level CREATE-WORD dup scan-word '[ 1array stack>message _ _ log-message ] - (( message -- )) define-declared ; parsing + (( message -- )) define-declared ; USE: vocabs.loader diff --git a/basis/macros/macros.factor b/basis/macros/macros.factor index 21a91e567d..4869601588 100644 --- a/basis/macros/macros.factor +++ b/basis/macros/macros.factor @@ -16,7 +16,7 @@ PRIVATE> [ over real-macro-effect memoize-quot [ call ] append define ] 2bi ; -: MACRO: (:) define-macro ; parsing +SYNTAX: MACRO: (:) define-macro ; PREDICATE: macro < word "macro" word-prop >boolean ; diff --git a/basis/match/match.factor b/basis/match/match.factor index 3846dea3be..b21d8c6d73 100644 --- a/basis/match/match.factor +++ b/basis/match/match.factor @@ -16,8 +16,8 @@ SYMBOL: _ : define-match-vars ( seq -- ) [ define-match-var ] each ; -: MATCH-VARS: ! vars ... - ";" parse-tokens define-match-vars ; parsing +SYNTAX: MATCH-VARS: ! vars ... + ";" parse-tokens define-match-vars ; : match-var? ( symbol -- bool ) dup word? [ "match-var" word-prop ] [ drop f ] if ; diff --git a/basis/math/blas/matrices/matrices.factor b/basis/math/blas/matrices/matrices.factor index 6fad545501..1882ccd0d5 100755 --- a/basis/math/blas/matrices/matrices.factor +++ b/basis/math/blas/matrices/matrices.factor @@ -289,7 +289,7 @@ M: MATRIX n*V(*)V+M! M: MATRIX n*V(*)Vconj+M! (prepare-ger) [ XGERC ] dip ; -: XMATRIX{ \ } [ >MATRIX ] parse-literal ; parsing +SYNTAX: XMATRIX{ \ } [ >MATRIX ] parse-literal ; M: MATRIX pprint-delims drop \ XMATRIX{ \ } ; diff --git a/basis/math/blas/vectors/vectors.factor b/basis/math/blas/vectors/vectors.factor index 84b5fd9e6f..d7c6ebc927 100755 --- a/basis/math/blas/vectors/vectors.factor +++ b/basis/math/blas/vectors/vectors.factor @@ -179,7 +179,7 @@ M: VECTOR n*V+V! M: VECTOR n*V! (prepare-scal) [ XSCAL ] dip ; -: XVECTOR{ \ } [ >VECTOR ] parse-literal ; parsing +SYNTAX: XVECTOR{ \ } [ >VECTOR ] parse-literal ; M: VECTOR pprint-delims drop \ XVECTOR{ \ } ; diff --git a/basis/math/complex/complex.factor b/basis/math/complex/complex.factor index 273fd0b2b5..c41faaf558 100644 --- a/basis/math/complex/complex.factor +++ b/basis/math/complex/complex.factor @@ -31,7 +31,7 @@ M: complex sqrt >polar [ fsqrt ] [ 2.0 / ] bi* polar> ; IN: syntax -: C{ \ } [ first2 rect> ] parse-literal ; parsing +SYNTAX: C{ \ } [ first2 rect> ] parse-literal ; USE: prettyprint.custom diff --git a/basis/memoize/memoize.factor b/basis/memoize/memoize.factor index 3bc573dff5..2c0cd357db 100644 --- a/basis/memoize/memoize.factor +++ b/basis/memoize/memoize.factor @@ -41,7 +41,7 @@ PRIVATE> [ drop "memoize" set-word-prop ] 3tri ; -: MEMO: (:) define-memoized ; parsing +SYNTAX: MEMO: (:) define-memoized ; PREDICATE: memoized < word "memoize" word-prop ; diff --git a/basis/multiline/multiline.factor b/basis/multiline/multiline.factor index 53c2789c50..2e8f8eb4c4 100644 --- a/basis/multiline/multiline.factor +++ b/basis/multiline/multiline.factor @@ -20,10 +20,10 @@ PRIVATE> [ (parse-here) ] "" make but-last lexer get next-line ; -: STRING: +SYNTAX: STRING: CREATE-WORD parse-here 1quotation - (( -- string )) define-inline ; parsing + (( -- string )) define-inline ; change-column drop ] "" make ; -: <" - "\">" parse-multiline-string parsed ; parsing +SYNTAX: <" + "\">" parse-multiline-string parsed ; -: <' - "'>" parse-multiline-string parsed ; parsing +SYNTAX: <' + "'>" parse-multiline-string parsed ; -: {' - "'}" parse-multiline-string parsed ; parsing +SYNTAX: {' + "'}" parse-multiline-string parsed ; -: {" - "\"}" parse-multiline-string parsed ; parsing +SYNTAX: {" + "\"}" parse-multiline-string parsed ; -: /* "*/" parse-multiline-string drop ; parsing +SYNTAX: /* "*/" parse-multiline-string drop ; diff --git a/basis/nibble-arrays/nibble-arrays.factor b/basis/nibble-arrays/nibble-arrays.factor index 22a1515908..16bea56862 100644 --- a/basis/nibble-arrays/nibble-arrays.factor +++ b/basis/nibble-arrays/nibble-arrays.factor @@ -62,7 +62,7 @@ M: nibble-array resize M: nibble-array byte-length length nibbles>bytes ; -: N{ \ } [ >nibble-array ] parse-literal ; parsing +SYNTAX: N{ \ } [ >nibble-array ] parse-literal ; INSTANCE: nibble-array sequence diff --git a/basis/opengl/gl/extensions/extensions.factor b/basis/opengl/gl/extensions/extensions.factor index fb2ddfaf3e..ccd3f5fad7 100644 --- a/basis/opengl/gl/extensions/extensions.factor +++ b/basis/opengl/gl/extensions/extensions.factor @@ -47,7 +47,7 @@ reset-gl-function-number-counter parameters return parse-arglist [ abi indirect-quot ] dip define-declared ; -: GL-FUNCTION: +SYNTAX: GL-FUNCTION: gl-function-calling-convention scan scan dup @@ -55,5 +55,4 @@ reset-gl-function-number-counter gl-function-number [ gl-function-pointer ] 2curry swap ";" parse-tokens [ "()" subseq? not ] filter - define-indirect - ; parsing + define-indirect ; diff --git a/basis/openssl/libssl/libssl.factor b/basis/openssl/libssl/libssl.factor index e512e3134c..8ed15a4e5e 100644 --- a/basis/openssl/libssl/libssl.factor +++ b/basis/openssl/libssl/libssl.factor @@ -279,12 +279,12 @@ H{ } clone verify-messages set-global : verify-message ( n -- word ) verify-messages get-global at ; -: X509_V_: +SYNTAX: X509_V_: scan "X509_V_" prepend create-in scan-word [ 1quotation (( -- value )) define-inline ] [ verify-messages get set-at ] - 2bi ; parsing + 2bi ; >> diff --git a/basis/peg/ebnf/ebnf.factor b/basis/peg/ebnf/ebnf.factor index 1f526d47f2..9f730831e7 100644 --- a/basis/peg/ebnf/ebnf.factor +++ b/basis/peg/ebnf/ebnf.factor @@ -34,9 +34,9 @@ TUPLE: tokenizer any one many ; : reset-tokenizer ( -- ) default-tokenizer \ tokenizer set-global ; -: TOKENIZER: +SYNTAX: TOKENIZER: scan search [ "Tokenizer not found" throw ] unless* - execute( -- tokenizer ) \ tokenizer set-global ; parsing + execute( -- tokenizer ) \ tokenizer set-global ; TUPLE: ebnf-non-terminal symbol ; TUPLE: ebnf-terminal symbol ; @@ -522,16 +522,14 @@ M: ebnf-non-terminal (transform) ( ast -- parser ) parse-ebnf dup dup parser [ main swap at compile ] with-variable [ compiled-parse ] curry [ with-scope ast>> ] curry ; -: " reset-tokenizer parse-multiline-string parse-ebnf main swap at - parsed reset-tokenizer ; parsing +SYNTAX: " reset-tokenizer parse-multiline-string parse-ebnf main swap at + parsed reset-tokenizer ; -: [EBNF "EBNF]" reset-tokenizer parse-multiline-string ebnf>quot nip - parsed \ call parsed reset-tokenizer ; parsing +SYNTAX: [EBNF "EBNF]" reset-tokenizer parse-multiline-string ebnf>quot nip + parsed \ call parsed reset-tokenizer ; -: EBNF: +SYNTAX: EBNF: reset-tokenizer CREATE-WORD dup ";EBNF" parse-multiline-string ebnf>quot swapd (( input -- ast )) define-declared "ebnf-parser" set-word-prop - reset-tokenizer ; parsing - - + reset-tokenizer ; diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor index 6c0772aacc..febcde5b25 100644 --- a/basis/peg/peg.factor +++ b/basis/peg/peg.factor @@ -616,7 +616,7 @@ PRIVATE> ERROR: parse-failed input word ; -: PEG: +SYNTAX: PEG: (:) [let | def [ ] word [ ] | [ @@ -630,7 +630,7 @@ ERROR: parse-failed input word ; ] ] with-compilation-unit ] over push-all - ] ; parsing + ] ; USING: vocabs vocabs.loader ; diff --git a/basis/persistent/hashtables/hashtables.factor b/basis/persistent/hashtables/hashtables.factor index 8c80782a2e..67886312c6 100644 --- a/basis/persistent/hashtables/hashtables.factor +++ b/basis/persistent/hashtables/hashtables.factor @@ -48,7 +48,7 @@ M: persistent-hash hashcode* nip assoc-size ; M: persistent-hash clone ; -: PH{ \ } [ >persistent-hash ] parse-literal ; parsing +SYNTAX: PH{ \ } [ >persistent-hash ] parse-literal ; M: persistent-hash pprint-delims drop \ PH{ \ } ; M: persistent-hash >pprint-sequence >alist ; diff --git a/basis/persistent/vectors/vectors.factor b/basis/persistent/vectors/vectors.factor index 478fc0ad25..ae33b7c39a 100644 --- a/basis/persistent/vectors/vectors.factor +++ b/basis/persistent/vectors/vectors.factor @@ -179,7 +179,7 @@ M: persistent-vector equal? : >persistent-vector ( seq -- pvec ) T{ persistent-vector } like ; -: PV{ \ } [ >persistent-vector ] parse-literal ; parsing +SYNTAX: PV{ \ } [ >persistent-vector ] parse-literal ; M: persistent-vector pprint-delims drop \ PV{ \ } ; M: persistent-vector >pprint-sequence ; diff --git a/basis/prettyprint/prettyprint-docs.factor b/basis/prettyprint/prettyprint-docs.factor index 2be725c0f6..f938ab30f7 100644 --- a/basis/prettyprint/prettyprint-docs.factor +++ b/basis/prettyprint/prettyprint-docs.factor @@ -96,12 +96,12 @@ ARTICLE: "prettyprint-literal" "Literal prettyprinting protocol" { $code "TUPLE: rect w h ;" "" - ": RECT[" + "SYNTAX: RECT[" " scan-word" " scan-word \\ * assert=" " scan-word" " scan-word \\ ] assert=" - " parsed ; parsing" + " parsed ;" } "An example literal might be:" { $code "RECT[ 100 * 200 ]" } diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor index 33499b1437..21439640fe 100644 --- a/basis/regexp/regexp.factor +++ b/basis/regexp/regexp.factor @@ -204,17 +204,17 @@ PRIVATE> PRIVATE> -: R! CHAR: ! parsing-regexp ; parsing -: R" CHAR: " parsing-regexp ; parsing -: R# CHAR: # parsing-regexp ; parsing -: R' CHAR: ' parsing-regexp ; parsing -: R( CHAR: ) parsing-regexp ; parsing -: R/ CHAR: / parsing-regexp ; parsing -: R@ CHAR: @ parsing-regexp ; parsing -: R[ CHAR: ] parsing-regexp ; parsing -: R` CHAR: ` parsing-regexp ; parsing -: R{ CHAR: } parsing-regexp ; parsing -: R| CHAR: | parsing-regexp ; parsing +SYNTAX: R! CHAR: ! parsing-regexp ; +SYNTAX: R" CHAR: " parsing-regexp ; +SYNTAX: R# CHAR: # parsing-regexp ; +SYNTAX: R' CHAR: ' parsing-regexp ; +SYNTAX: R( CHAR: ) parsing-regexp ; +SYNTAX: R/ CHAR: / parsing-regexp ; +SYNTAX: R@ CHAR: @ parsing-regexp ; +SYNTAX: R[ CHAR: ] parsing-regexp ; +SYNTAX: R` CHAR: ` parsing-regexp ; +SYNTAX: R{ CHAR: } parsing-regexp ; +SYNTAX: R| CHAR: | parsing-regexp ; USING: vocabs vocabs.loader ; diff --git a/basis/roman/roman.factor b/basis/roman/roman.factor index 24713545b1..71343b723d 100644 --- a/basis/roman/roman.factor +++ b/basis/roman/roman.factor @@ -74,4 +74,4 @@ PRIVATE> : roman/mod ( str1 str2 -- str3 str4 ) [ /mod ] binary-roman-op [ >roman ] dip ; -: ROMAN: scan roman> parsed ; parsing +SYNTAX: ROMAN: scan roman> parsed ; diff --git a/basis/see/see.factor b/basis/see/see.factor index ab9fa2006f..041a72ea0e 100644 --- a/basis/see/see.factor +++ b/basis/see/see.factor @@ -93,7 +93,6 @@ M: object declarations. drop ; M: word declarations. { - POSTPONE: parsing POSTPONE: delimiter POSTPONE: inline POSTPONE: recursive diff --git a/basis/shuffle/shuffle.factor b/basis/shuffle/shuffle.factor index 6cae048d27..d6a4ba8bbb 100644 --- a/basis/shuffle/shuffle.factor +++ b/basis/shuffle/shuffle.factor @@ -19,8 +19,8 @@ MACRO: shuffle-effect ( effect -- ) [ [ at \ swap \ nth [ ] 3sequence ] curry map , \ cleave , ] 2bi ] [ ] make ; -: shuffle( - ")" parse-effect parsed \ shuffle-effect parsed ; parsing +SYNTAX: shuffle( + ")" parse-effect parsed \ shuffle-effect parsed ; : 2swap ( x y z t -- z t x y ) 2 2 mnswap ; inline diff --git a/basis/specialized-arrays/functor/functor.factor b/basis/specialized-arrays/functor/functor.factor index 09433a3b51..c6641463f9 100644 --- a/basis/specialized-arrays/functor/functor.factor +++ b/basis/specialized-arrays/functor/functor.factor @@ -70,7 +70,7 @@ M: A >pprint-sequence ; M: A pprint* pprint-object ; -: A{ \ } [ >A ] parse-literal ; parsing +SYNTAX: A{ \ } [ >A ] parse-literal ; INSTANCE: A sequence diff --git a/basis/specialized-vectors/functor/functor.factor b/basis/specialized-vectors/functor/functor.factor index 9d48a9e79e..412e5b4689 100644 --- a/basis/specialized-vectors/functor/functor.factor +++ b/basis/specialized-vectors/functor/functor.factor @@ -39,7 +39,7 @@ M: V >pprint-sequence ; M: V pprint* pprint-object ; -: V{ \ } [ >V ] parse-literal ; parsing +SYNTAX: V{ \ } [ >V ] parse-literal ; INSTANCE: V growable diff --git a/basis/suffix-arrays/suffix-arrays.factor b/basis/suffix-arrays/suffix-arrays.factor index fa68cc0a8e..f4bd563481 100755 --- a/basis/suffix-arrays/suffix-arrays.factor +++ b/basis/suffix-arrays/suffix-arrays.factor @@ -32,7 +32,7 @@ PRIVATE> : >suffix-array ( seq -- array ) [ suffixes ] map concat natural-sort ; -: SA{ \ } [ >suffix-array ] parse-literal ; parsing +SYNTAX: SA{ \ } [ >suffix-array ] parse-literal ; : query ( begin suffix-array -- matches ) 2dup find-index dup diff --git a/basis/tr/tr.factor b/basis/tr/tr.factor index 66c0276055..daac3c96c7 100644 --- a/basis/tr/tr.factor +++ b/basis/tr/tr.factor @@ -40,10 +40,9 @@ M: bad-tr summary PRIVATE> -: TR: +SYNTAX: TR: scan parse-definition unclip-last [ unclip-last ] dip compute-tr [ check-tr ] [ [ create-tr ] dip define-tr ] [ [ "-fast" append create-tr ] dip define-fast-tr ] 2tri ; - parsing diff --git a/basis/unicode/syntax/syntax.factor b/basis/unicode/syntax/syntax.factor index 5bd8c05e15..dfae31d39c 100644 --- a/basis/unicode/syntax/syntax.factor +++ b/basis/unicode/syntax/syntax.factor @@ -27,12 +27,12 @@ IN: unicode.syntax PRIVATE> -: CATEGORY: - CREATE ";" parse-tokens define-category ; parsing +SYNTAX: CATEGORY: + CREATE ";" parse-tokens define-category ; : seq-minus ( seq1 seq2 -- diff ) [ member? not ] curry filter ; -: CATEGORY-NOT: +SYNTAX: CATEGORY-NOT: CREATE ";" parse-tokens - categories swap seq-minus define-category ; parsing + categories swap seq-minus define-category ; diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor index d71ce4ef7b..38d0016d56 100644 --- a/basis/urls/urls.factor +++ b/basis/urls/urls.factor @@ -179,7 +179,7 @@ PRIVATE> dup protocol>> '[ _ protocol-port or ] change-port ; ! Literal syntax -: URL" lexer get skip-blank parse-string >url parsed ; parsing +SYNTAX: URL" lexer get skip-blank parse-string >url parsed ; USING: vocabs vocabs.loader ; diff --git a/basis/values/values.factor b/basis/values/values.factor index 75a37339b1..b15dcebe49 100644 --- a/basis/values/values.factor +++ b/basis/values/values.factor @@ -30,11 +30,11 @@ PREDICATE: value-word < word [ second \ obj>> = ] } 1&& ; -: VALUE: +SYNTAX: VALUE: CREATE-WORD dup t "no-def-strip" set-word-prop T{ value-holder } clone [ obj>> ] curry - (( -- value )) define-declared ; parsing + (( -- value )) define-declared ; M: value-word definer drop \ VALUE: f ; @@ -43,9 +43,9 @@ M: value-word definition drop f ; : set-value ( value word -- ) def>> first (>>obj) ; -: to: +SYNTAX: to: scan-word literalize parsed - \ set-value parsed ; parsing + \ set-value parsed ; : get-value ( word -- value ) def>> first obj>> ; diff --git a/basis/vlists/vlists.factor b/basis/vlists/vlists.factor index e4f64ca8f8..ae106cbf93 100644 --- a/basis/vlists/vlists.factor +++ b/basis/vlists/vlists.factor @@ -50,7 +50,7 @@ M: vlist like INSTANCE: vlist immutable-sequence -: VL{ \ } [ >vlist ] parse-literal ; parsing +SYNTAX: VL{ \ } [ >vlist ] parse-literal ; M: vlist pprint-delims drop \ VL{ \ } ; M: vlist >pprint-sequence ; @@ -87,7 +87,7 @@ M: valist assoc-like INSTANCE: valist assoc -: VA{ \ } [ >valist ] parse-literal ; parsing +SYNTAX: VA{ \ } [ >valist ] parse-literal ; M: valist pprint-delims drop \ VA{ \ } ; M: valist >pprint-sequence >alist ; diff --git a/basis/windows/com/syntax/syntax.factor b/basis/windows/com/syntax/syntax.factor index 620b608afc..59a76bf4d7 100755 --- a/basis/windows/com/syntax/syntax.factor +++ b/basis/windows/com/syntax/syntax.factor @@ -90,14 +90,13 @@ unless PRIVATE> -: COM-INTERFACE: +SYNTAX: COM-INTERFACE: scan scan find-com-interface-definition scan string>guid parse-com-functions dup save-com-interface-definition - define-words-for-com-interface - ; parsing + define-words-for-com-interface ; -: GUID: scan string>guid parsed ; parsing +SYNTAX: GUID: scan string>guid parsed ; diff --git a/basis/xml/syntax/syntax.factor b/basis/xml/syntax/syntax.factor index 067bb9ec11..0f23aafa6e 100644 --- a/basis/xml/syntax/syntax.factor +++ b/basis/xml/syntax/syntax.factor @@ -26,17 +26,17 @@ M: no-tag summary PRIVATE> -: TAGS: +SYNTAX: TAGS: CREATE [ H{ } clone "xtable" set-word-prop ] - [ define-tags ] bi ; parsing + [ define-tags ] bi ; -: TAG: - scan scan-word parse-definition define-tag ; parsing +SYNTAX: TAG: + scan scan-word parse-definition define-tag ; -: XML-NS: +SYNTAX: XML-NS: CREATE-WORD (( string -- name )) over set-stack-effect - scan '[ f swap _ ] define-memoized ; parsing + scan '[ f swap _ ] define-memoized ; -: " [ string>doc ] parse-def ; parsing +SYNTAX: " [ string>doc ] parse-def ; -: [XML - "XML]" [ string>chunk ] parse-def ; parsing +SYNTAX: [XML + "XML]" [ string>chunk ] parse-def ; boolean ( string -- ? ) "TRUE" = ; diff --git a/core/bootstrap/syntax.factor b/core/bootstrap/syntax.factor index 1c97ee5a50..6e6812e25c 100644 --- a/core/bootstrap/syntax.factor +++ b/core/bootstrap/syntax.factor @@ -57,6 +57,7 @@ IN: bootstrap.syntax "EXCLUDE:" "RENAME:" "ALIAS:" + "SYNTAX:" "V{" "W{" "[" @@ -68,7 +69,6 @@ IN: bootstrap.syntax "foldable" "inline" "recursive" - "parsing" "t" "{" "}" diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor index 23bc41a1bb..547f7c0490 100644 --- a/core/parser/parser-docs.factor +++ b/core/parser/parser-docs.factor @@ -54,8 +54,10 @@ $nl ARTICLE: "parsing-words" "Parsing words" "The Factor parser follows a simple recursive-descent design. The parser reads successive tokens from the input; if the token identifies a number or an ordinary word, it is added to an accumulator vector. Otherwise if the token identifies a parsing word, the parsing word is executed immediately." $nl -"Parsing words are marked by suffixing the definition with a " { $link POSTPONE: parsing } " declaration. Here is the simplest possible parsing word; it prints a greeting at parse time:" -{ $code ": hello \"Hello world\" print ; parsing" } +"Parsing words are defined using the a defining word:" +{ $subsection POSTPONE: SYNTAX: } +"Parsing words have uppercase names by convention. Here is the simplest possible parsing word; it prints a greeting at parse time:" +{ $code "SYNTAX: HELLO \"Hello world\" print ;" } "Parsing words must not pop or push items from the stack; however, they are permitted to access the accumulator vector supplied by the parser at the top of the stack. That is, parsing words must have stack effect " { $snippet "( accum -- accum )" } ", where " { $snippet "accum" } " is the accumulator vector supplied by the parser." $nl "Parsing words can read input, add word definitions to the dictionary, and do anything an ordinary word can." diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index adf1c8adcf..2616e5fadb 100644 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -106,7 +106,7 @@ IN: parser.tests ] unit-test DEFER: foo - "IN: parser.tests USING: math prettyprint ; : foo 2 2 + . ; parsing" eval + "IN: parser.tests USING: math prettyprint ; SYNTAX: foo 2 2 + . ;" eval [ ] [ "USE: parser.tests foo" eval ] unit-test @@ -487,7 +487,7 @@ IN: parser.tests [ "DEFER: blahy" eval ] [ error>> error>> no-current-vocab? ] must-fail-with [ - "IN: parser.tests : blahy ; parsing FORGET: blahy" eval + "IN: parser.tests SYNTAX: blahy ; FORGET: blahy" eval ] [ error>> staging-violation? ] must-fail-with diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index 1a61845fd1..9609b4ffee 100644 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -177,10 +177,10 @@ HELP: delimiter { $syntax ": foo ... ; delimiter" } { $description "Declares the most recently defined word as a delimiter. Delimiters are words which are only ever valid as the end of a nested block to be read by " { $link parse-until } ". An unpaired occurrence of a delimiter is a parse error." } ; -HELP: parsing -{ $syntax ": foo ... ; parsing" } -{ $description "Declares the most recently defined word as a parsing word." } -{ $examples "In the below example, the " { $snippet "world" } " word is never called, however its body references a parsing word which executes immediately:" { $example "USE: io" "IN: scratchpad" "<< : hello \"Hello parser!\" print ; parsing >>\n: world hello ;" "Hello parser!" } } ; +HELP: SYNTAX: +{ $syntax "SYNTAX: foo ... ;" } +{ $description "Defines a parsing word." } +{ $examples "In the below example, the " { $snippet "world" } " word is never called, however its body references a parsing word which executes immediately:" { $example "USE: io" "IN: scratchpad" "<< SYNTAX: HELLO \"Hello parser!\" print ; >>\n: world HELLO ;" "Hello parser!" } } ; HELP: inline { $syntax ": foo ... ; inline" } diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index d01a9ebb2c..47a45f6e4e 100644 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -22,58 +22,58 @@ IN: bootstrap.syntax : define-delimiter ( name -- ) "syntax" lookup t "delimiter" set-word-prop ; -: define-syntax ( name quot -- ) - [ dup "syntax" lookup [ dup ] [ no-word-error ] ?if ] dip - define make-parsing ; +: define-core-syntax ( name quot -- ) + [ dup "syntax" lookup [ ] [ no-word-error ] ?if ] dip + define-syntax ; [ { "]" "}" ";" ">>" } [ define-delimiter ] each "PRIMITIVE:" [ "Primitive definition is not supported" throw - ] define-syntax + ] define-core-syntax "CS{" [ "Call stack literals are not supported" throw - ] define-syntax + ] define-core-syntax - "!" [ lexer get next-line ] define-syntax + "!" [ lexer get next-line ] define-core-syntax - "#!" [ POSTPONE: ! ] define-syntax + "#!" [ POSTPONE: ! ] define-core-syntax - "IN:" [ scan set-in ] define-syntax + "IN:" [ scan set-in ] define-core-syntax - "PRIVATE>" [ in get ".private" ?tail drop set-in ] define-syntax + "PRIVATE>" [ in get ".private" ?tail drop set-in ] define-core-syntax " in get ".private" append set-in - ] define-syntax + ] define-core-syntax - "USE:" [ scan use+ ] define-syntax + "USE:" [ scan use+ ] define-core-syntax - "USING:" [ ";" parse-tokens add-use ] define-syntax + "USING:" [ ";" parse-tokens add-use ] define-core-syntax - "QUALIFIED:" [ scan dup add-qualified ] define-syntax + "QUALIFIED:" [ scan dup add-qualified ] define-core-syntax - "QUALIFIED-WITH:" [ scan scan add-qualified ] define-syntax + "QUALIFIED-WITH:" [ scan scan add-qualified ] define-core-syntax "FROM:" [ scan "=>" expect ";" parse-tokens swap add-words-from - ] define-syntax + ] define-core-syntax "EXCLUDE:" [ scan "=>" expect ";" parse-tokens swap add-words-excluding - ] define-syntax + ] define-core-syntax "RENAME:" [ scan scan "=>" expect scan add-renamed-word - ] define-syntax + ] define-core-syntax - "HEX:" [ 16 parse-base ] define-syntax - "OCT:" [ 8 parse-base ] define-syntax - "BIN:" [ 2 parse-base ] define-syntax + "HEX:" [ 16 parse-base ] define-core-syntax + "OCT:" [ 8 parse-base ] define-core-syntax + "BIN:" [ 2 parse-base ] define-core-syntax - "f" [ f parsed ] define-syntax + "f" [ f parsed ] define-core-syntax "t" "syntax" lookup define-singleton-class "CHAR:" [ @@ -82,157 +82,160 @@ IN: bootstrap.syntax { [ "\\" ?head ] [ next-escape >string "" assert= ] } [ name>char-hook get call( name -- char ) ] } cond parsed - ] define-syntax + ] define-core-syntax - "\"" [ parse-string parsed ] define-syntax + "\"" [ parse-string parsed ] define-core-syntax "SBUF\"" [ lexer get skip-blank parse-string >sbuf parsed - ] define-syntax + ] define-core-syntax "P\"" [ lexer get skip-blank parse-string parsed - ] define-syntax + ] define-core-syntax - "[" [ parse-quotation parsed ] define-syntax - "{" [ \ } [ >array ] parse-literal ] define-syntax - "V{" [ \ } [ >vector ] parse-literal ] define-syntax - "B{" [ \ } [ >byte-array ] parse-literal ] define-syntax - "H{" [ \ } [ >hashtable ] parse-literal ] define-syntax - "T{" [ parse-tuple-literal parsed ] define-syntax - "W{" [ \ } [ first ] parse-literal ] define-syntax + "[" [ parse-quotation parsed ] define-core-syntax + "{" [ \ } [ >array ] parse-literal ] define-core-syntax + "V{" [ \ } [ >vector ] parse-literal ] define-core-syntax + "B{" [ \ } [ >byte-array ] parse-literal ] define-core-syntax + "H{" [ \ } [ >hashtable ] parse-literal ] define-core-syntax + "T{" [ parse-tuple-literal parsed ] define-core-syntax + "W{" [ \ } [ first ] parse-literal ] define-core-syntax - "POSTPONE:" [ scan-word parsed ] define-syntax - "\\" [ scan-word parsed ] define-syntax - "inline" [ word make-inline ] define-syntax - "recursive" [ word make-recursive ] define-syntax - "foldable" [ word make-foldable ] define-syntax - "flushable" [ word make-flushable ] define-syntax - "delimiter" [ word t "delimiter" set-word-prop ] define-syntax - "parsing" [ word make-parsing ] define-syntax + "POSTPONE:" [ scan-word parsed ] define-core-syntax + "\\" [ scan-word parsed ] define-core-syntax + "inline" [ word make-inline ] define-core-syntax + "recursive" [ word make-recursive ] define-core-syntax + "foldable" [ word make-foldable ] define-core-syntax + "flushable" [ word make-flushable ] define-core-syntax + "delimiter" [ word t "delimiter" set-word-prop ] define-core-syntax + + "SYNTAX:" [ + (:) define-syntax + ] define-core-syntax "SYMBOL:" [ CREATE-WORD define-symbol - ] define-syntax + ] define-core-syntax "SYMBOLS:" [ ";" parse-tokens [ create-in dup reset-generic define-symbol ] each - ] define-syntax + ] define-core-syntax "SINGLETONS:" [ ";" parse-tokens [ create-class-in define-singleton-class ] each - ] define-syntax + ] define-core-syntax "ALIAS:" [ CREATE-WORD scan-word define-alias - ] define-syntax + ] define-core-syntax "CONSTANT:" [ CREATE scan-object define-constant - ] define-syntax + ] define-core-syntax "DEFER:" [ scan current-vocab create [ fake-definition ] [ set-word ] [ [ undefined ] define ] tri - ] define-syntax + ] define-core-syntax ":" [ (:) define - ] define-syntax + ] define-core-syntax "GENERIC:" [ CREATE-GENERIC define-simple-generic - ] define-syntax + ] define-core-syntax "GENERIC#" [ CREATE-GENERIC scan-word define-generic - ] define-syntax + ] define-core-syntax "MATH:" [ CREATE-GENERIC T{ math-combination } define-generic - ] define-syntax + ] define-core-syntax "HOOK:" [ CREATE-GENERIC scan-word define-generic - ] define-syntax + ] define-core-syntax "M:" [ (M:) define - ] define-syntax + ] define-core-syntax "UNION:" [ CREATE-CLASS parse-definition define-union-class - ] define-syntax + ] define-core-syntax "INTERSECTION:" [ CREATE-CLASS parse-definition define-intersection-class - ] define-syntax + ] define-core-syntax "MIXIN:" [ CREATE-CLASS define-mixin-class - ] define-syntax + ] define-core-syntax "INSTANCE:" [ location [ scan-word scan-word 2dup add-mixin-instance ] dip remember-definition - ] define-syntax + ] define-core-syntax "PREDICATE:" [ CREATE-CLASS scan "<" assert= scan-word parse-definition define-predicate-class - ] define-syntax + ] define-core-syntax "SINGLETON:" [ CREATE-CLASS define-singleton-class - ] define-syntax + ] define-core-syntax "TUPLE:" [ parse-tuple-definition define-tuple-class - ] define-syntax + ] define-core-syntax "SLOT:" [ scan define-protocol-slot - ] define-syntax + ] define-core-syntax "C:" [ CREATE-WORD scan-word define-boa-word - ] define-syntax + ] define-core-syntax "ERROR:" [ parse-tuple-definition pick save-location define-error-class - ] define-syntax + ] define-core-syntax "FORGET:" [ scan-object forget - ] define-syntax + ] define-core-syntax "(" [ ")" parse-effect word dup [ set-stack-effect ] [ 2drop ] if - ] define-syntax + ] define-core-syntax "((" [ "))" parse-effect parsed - ] define-syntax + ] define-core-syntax - "MAIN:" [ scan-word in get vocab (>>main) ] define-syntax + "MAIN:" [ scan-word in get vocab (>>main) ] define-core-syntax "<<" [ [ \ >> parse-until >quotation ] with-nested-compilation-unit call( -- ) - ] define-syntax + ] define-core-syntax "call-next-method" [ current-method get [ @@ -241,13 +244,13 @@ IN: bootstrap.syntax ] [ not-in-a-method-error ] if* - ] define-syntax + ] define-core-syntax "initial:" "syntax" lookup define-symbol "read-only" "syntax" lookup define-symbol - "call(" [ \ call-effect parse-call( ] define-syntax + "call(" [ \ call-effect parse-call( ] define-core-syntax - "execute(" [ \ execute-effect parse-call( ] define-syntax + "execute(" [ \ execute-effect parse-call( ] define-core-syntax ] with-compilation-unit diff --git a/core/words/words-docs.factor b/core/words/words-docs.factor index 9c32a8094e..63b58bf9d5 100644 --- a/core/words/words-docs.factor +++ b/core/words/words-docs.factor @@ -57,16 +57,12 @@ $nl } ; ARTICLE: "declarations" "Declarations" -"Declarations give special behavior to a word. Declarations are parsing words that set a word property in the most recently defined word." -$nl -"The first declaration specifies the time when a word runs. It affects both the non-optimizing and optimizing compilers:" -{ $subsection POSTPONE: parsing } -"The remaining declarations only affect definitions compiled with the optimizing compiler. They do not change evaluation semantics of a word, but instead declare that the word follows a certain contract, and thus may be compiled differently." -{ $warning "If a generic word is declared " { $link POSTPONE: foldable } " or " { $link POSTPONE: flushable } ", all methods must satisfy the contract, otherwise unpredicable behavior will occur." } +"Declarations are parsing words that set a word property in the most recently defined word. Declarations only affect definitions compiled with the optimizing compiler. They do not change evaluation semantics of a word, but instead declare that the word follows a certain contract, and thus may be compiled differently." { $subsection POSTPONE: inline } { $subsection POSTPONE: foldable } { $subsection POSTPONE: flushable } { $subsection POSTPONE: recursive } +{ $warning "If a generic word is declared " { $link POSTPONE: foldable } " or " { $link POSTPONE: flushable } ", all methods must satisfy the contract, otherwise unpredicable behavior will occur." } "Stack effect declarations are documented in " { $link "effect-declaration" } "." ; ARTICLE: "word-definition" "Defining words" @@ -279,7 +275,7 @@ HELP: bootstrap-word HELP: parsing-word? ( obj -- ? ) { $values { "obj" object } { "?" "a boolean" } } -{ $description "Tests if an object is a parsing word declared by " { $link POSTPONE: parsing } "." } +{ $description "Tests if an object is a parsing word declared by " { $link POSTPONE: SYNTAX: } "." } { $notes "Outputs " { $link f } " if the object is not a word." } ; HELP: define-declared diff --git a/core/words/words.factor b/core/words/words.factor index c4a94f0a4c..c255c00eae 100755 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -232,7 +232,10 @@ ERROR: bad-create name vocab ; PREDICATE: parsing-word < word "parsing" word-prop ; -: make-parsing ( word -- ) t "parsing" set-word-prop ; +M: parsing-word definer drop \ SYNTAX: \ ; ; + +: define-syntax ( word quot -- ) + [ drop ] [ define ] 2bi t "parsing" set-word-prop ; : delimiter? ( obj -- ? ) dup word? [ "delimiter" word-prop ] [ drop f ] if ; diff --git a/extra/advice/advice.factor b/extra/advice/advice.factor index be9835c5b9..9c0963469e 100644 --- a/extra/advice/advice.factor +++ b/extra/advice/advice.factor @@ -56,8 +56,8 @@ PRIVATE> : unadvise ( word -- ) [ reset ] [ { before after around advised } [ f swap set-word-prop ] with each ] bi ; -: ADVISE: ! word adname location => word adname quot loc - scan-word scan scan-word parse-definition swap [ spin ] dip advise ; parsing +SYNTAX: ADVISE: ! word adname location => word adname quot loc + scan-word scan scan-word parse-definition swap [ spin ] dip advise ; -: UNADVISE: - scan-word parsed \ unadvise parsed ; parsing \ No newline at end of file +SYNTAX: UNADVISE: + scan-word parsed \ unadvise parsed ; \ No newline at end of file diff --git a/extra/annotations/annotations.factor b/extra/annotations/annotations.factor index b3eccad6a3..387c73abe4 100644 --- a/extra/annotations/annotations.factor +++ b/extra/annotations/annotations.factor @@ -24,7 +24,7 @@ NAMEs. DEFINES ${NAME}s. WHERE : (NAME) ( str -- ) drop ; inline -: !NAME (parse-annotation) \ (NAME) parsed ; parsing +SYNTAX: !NAME (parse-annotation) \ (NAME) parsed ; : NAMEs ( -- usages ) \ (NAME) (non-annotation-usage) ; diff --git a/extra/descriptive/descriptive.factor b/extra/descriptive/descriptive.factor index dd0042455c..ed412ee445 100755 --- a/extra/descriptive/descriptive.factor +++ b/extra/descriptive/descriptive.factor @@ -23,8 +23,7 @@ PRIVATE> [ "descriptive-definition" set-word-prop ] [ dupd [descriptive] define ] 2bi ; -: DESCRIPTIVE: - (:) define-descriptive ; parsing +SYNTAX: DESCRIPTIVE: (:) define-descriptive ; PREDICATE: descriptive < word "descriptive-definition" word-prop ; @@ -34,8 +33,7 @@ M: descriptive definer drop \ DESCRIPTIVE: \ ; ; M: descriptive definition "descriptive-definition" word-prop ; -: DESCRIPTIVE:: - (::) define-descriptive ; parsing +SYNTAX: DESCRIPTIVE:: (::) define-descriptive ; INTERSECTION: descriptive-lambda descriptive lambda-word ; diff --git a/extra/infix/infix.factor b/extra/infix/infix.factor index 87080683b2..ed268e558d 100644 --- a/extra/infix/infix.factor +++ b/extra/infix/infix.factor @@ -81,8 +81,8 @@ M: ast-function infix-codegen infix-codegen prepare-operand ; PRIVATE> -: [infix - "infix]" [infix-parse parsed \ call parsed ; parsing +SYNTAX: [infix + "infix]" [infix-parse parsed \ call parsed ; ] with-scope ; PRIVATE> -: [infix| +SYNTAX: [infix| "|" parse-bindings "infix]" parse-infix-locals - ?rewrite-closures over push-all ; parsing + ?rewrite-closures over push-all ; diff --git a/extra/literals/literals.factor b/extra/literals/literals.factor index 6bff666f07..e55d78ab6e 100644 --- a/extra/literals/literals.factor +++ b/extra/literals/literals.factor @@ -2,5 +2,5 @@ USING: accessors continuations kernel parser words quotations vectors ; IN: literals -: $ scan-word [ def>> call ] curry with-datastack >vector ; parsing -: $[ parse-quotation with-datastack >vector ; parsing +SYNTAX: $ scan-word [ def>> call ] curry with-datastack >vector ; +SYNTAX: $[ parse-quotation with-datastack >vector ; diff --git a/extra/math/derivatives/syntax/syntax.factor b/extra/math/derivatives/syntax/syntax.factor index 02b0608ed8..1dadfd18c8 100644 --- a/extra/math/derivatives/syntax/syntax.factor +++ b/extra/math/derivatives/syntax/syntax.factor @@ -5,6 +5,6 @@ USING: kernel parser words effects accessors sequences IN: math.derivatives.syntax -: DERIVATIVE: scan-object dup stack-effect in>> length [1,b] +SYNTAX: DERIVATIVE: scan-object dup stack-effect in>> length [1,b] [ drop scan-object ] map - "derivative" set-word-prop ; parsing \ No newline at end of file + "derivative" set-word-prop ; \ No newline at end of file diff --git a/extra/method-chains/method-chains.factor b/extra/method-chains/method-chains.factor index ae1801a8b5..5d24311898 100644 --- a/extra/method-chains/method-chains.factor +++ b/extra/method-chains/method-chains.factor @@ -3,5 +3,5 @@ USING: kernel generic generic.parser words fry ; IN: method-chains -: AFTER: (M:) dupd '[ [ _ (call-next-method) ] _ bi ] define ; parsing -: BEFORE: (M:) over '[ _ [ _ (call-next-method) ] bi ] define ; parsing +SYNTAX: AFTER: (M:) dupd '[ [ _ (call-next-method) ] _ bi ] define ; +SYNTAX: BEFORE: (M:) over '[ _ [ _ (call-next-method) ] bi ] define ; diff --git a/extra/money/money.factor b/extra/money/money.factor index 1b9dee74b7..994d214335 100644 --- a/extra/money/money.factor +++ b/extra/money/money.factor @@ -30,5 +30,4 @@ ERROR: not-an-integer x ; ] keep length 10 swap ^ / + swap [ neg ] when ; -: DECIMAL: - scan parse-decimal parsed ; parsing +SYNTAX: DECIMAL: scan parse-decimal parsed ; diff --git a/extra/peg-lexer/peg-lexer.factor b/extra/peg-lexer/peg-lexer.factor index d48d67cfd4..1b5f17df4c 100644 --- a/extra/peg-lexer/peg-lexer.factor +++ b/extra/peg-lexer/peg-lexer.factor @@ -40,8 +40,9 @@ M: lex-hash at* swap { : create-bnf ( name parser -- ) reset-tokenizer [ lexer get skip-blank parse* parsed ] curry define word make-parsing ; -: ON-BNF: CREATE-WORD reset-tokenizer ";ON-BNF" parse-multiline-string parse-ebnf - main swap at create-bnf ; parsing +SYNTAX: ON-BNF: + CREATE-WORD reset-tokenizer ";ON-BNF" parse-multiline-string parse-ebnf + main swap at create-bnf ; ! Tokenizer like standard factor lexer EBNF: factor diff --git a/extra/project-euler/common/common.factor b/extra/project-euler/common/common.factor index bd50f817b6..423512465e 100644 --- a/extra/project-euler/common/common.factor +++ b/extra/project-euler/common/common.factor @@ -128,10 +128,10 @@ PRIVATE> : d-transform ( triple -- new-triple ) { { -1 -2 -2 } { 2 1 2 } { 2 2 3 } } transform ; -: SOLUTION: +SYNTAX: SOLUTION: scan-word [ name>> "-main" append create-in ] keep [ drop in get vocab (>>main) ] [ [ . ] swap prefix (( -- )) define-declared ] - 2bi ; parsing + 2bi ; diff --git a/extra/promises/promises.factor b/extra/promises/promises.factor index 0e193741eb..60b4418c3f 100755 --- a/extra/promises/promises.factor +++ b/extra/promises/promises.factor @@ -35,7 +35,7 @@ TUPLE: promise quot forced? value ; \ promise , ] [ ] make ; -: LAZY: +SYNTAX: LAZY: CREATE-WORD dup parse-definition - make-lazy-quot define ; parsing + make-lazy-quot define ; diff --git a/extra/slides/slides.factor b/extra/slides/slides.factor index c7a27f87a4..29367a2b2b 100755 --- a/extra/slides/slides.factor +++ b/extra/slides/slides.factor @@ -94,8 +94,8 @@ TUPLE: slides < book ; 2 + (strip-tease) ] with map ; -: STRIP-TEASE: - parse-definition strip-tease [ parsed ] each ; parsing +SYNTAX: STRIP-TEASE: + parse-definition strip-tease [ parsed ] each ; \ slides H{ { T{ button-down } [ request-focus ] } diff --git a/extra/trees/avl/avl.factor b/extra/trees/avl/avl.factor index 264db53a9e..04c7022077 100755 --- a/extra/trees/avl/avl.factor +++ b/extra/trees/avl/avl.factor @@ -152,7 +152,7 @@ M: avl new-assoc 2drop ; M: avl assoc-like drop dup avl? [ >avl ] unless ; -: AVL{ - \ } [ >avl ] parse-literal ; parsing +SYNTAX: AVL{ + \ } [ >avl ] parse-literal ; M: avl pprint-delims drop \ AVL{ \ } ; diff --git a/extra/trees/splay/splay.factor b/extra/trees/splay/splay.factor index c47b6b5d07..66ef154b63 100755 --- a/extra/trees/splay/splay.factor +++ b/extra/trees/splay/splay.factor @@ -131,8 +131,8 @@ M: splay new-assoc : >splay ( assoc -- tree ) T{ splay f f 0 } assoc-clone-like ; -: SPLAY{ - \ } [ >splay ] parse-literal ; parsing +SYNTAX: SPLAY{ + \ } [ >splay ] parse-literal ; M: splay assoc-like drop dup splay? [ >splay ] unless ; diff --git a/extra/trees/trees.factor b/extra/trees/trees.factor index 41a8a21c1d..4efea6ae42 100755 --- a/extra/trees/trees.factor +++ b/extra/trees/trees.factor @@ -198,8 +198,8 @@ M: tree clone dup assoc-clone-like ; M: tree assoc-like drop dup tree? [ >tree ] unless ; -: TREE{ - \ } [ >tree ] parse-literal ; parsing +SYNTAX: TREE{ + \ } [ >tree ] parse-literal ; M: tree assoc-size count>> ; M: tree pprint-delims drop \ TREE{ \ } ; diff --git a/extra/vars/vars.factor b/extra/vars/vars.factor index c12367ba5e..21c9b303f3 100644 --- a/extra/vars/vars.factor +++ b/extra/vars/vars.factor @@ -21,11 +21,11 @@ IN: vars [ define-var-getter ] [ define-var-setter ] tri ; -: VAR: ! var - scan define-var ; parsing +SYNTAX: VAR: ! var + scan define-var ; : define-vars ( seq -- ) [ define-var ] each ; -: VARS: ! vars ... - ";" parse-tokens define-vars ; parsing +SYNTAX: VARS: ! vars ... + ";" parse-tokens define-vars ; From 899b096f901c44b23ba0089f0c3554ad1c046e6f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 21 Mar 2009 02:51:15 -0500 Subject: [PATCH 06/16] Dan asked me to remove state-machine --- extra/state-machine/authors.txt | 1 - extra/state-machine/state-machine.factor | 42 ------------------------ 2 files changed, 43 deletions(-) delete mode 100755 extra/state-machine/authors.txt delete mode 100755 extra/state-machine/state-machine.factor diff --git a/extra/state-machine/authors.txt b/extra/state-machine/authors.txt deleted file mode 100755 index f990dd0ed2..0000000000 --- a/extra/state-machine/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Daniel Ehrenberg diff --git a/extra/state-machine/state-machine.factor b/extra/state-machine/state-machine.factor deleted file mode 100755 index 18c3720927..0000000000 --- a/extra/state-machine/state-machine.factor +++ /dev/null @@ -1,42 +0,0 @@ -USING: kernel parser lexer strings math namespaces make -sequences words io arrays quotations debugger accessors -sequences.private ; -IN: state-machine - -: STATES: - ! STATES: set-name state1 state2 ... ; - ";" parse-tokens - [ length ] keep - unclip suffix - [ create-in swap 1quotation define ] 2each ; parsing - -TUPLE: state place data ; - -ERROR: missing-state ; - -M: missing-state error. - drop "Missing state" print ; - -: make-machine ( states -- table quot ) - ! quot is ( state string -- output-string ) - [ missing-state ] dup - [ - [ [ dup [ data>> ] [ place>> ] bi ] dip ] % - [ swapd bounds-check dispatch ] curry , - [ each pick (>>place) swap (>>date) ] % - ] [ ] make [ over make ] curry ; - -: define-machine ( word state-class -- ) - execute make-machine - [ over ] dip define - "state-table" set-word-prop ; - -: MACHINE: - ! MACHINE: utf8 unicode-states - CREATE scan-word define-machine ; parsing - -: S: - ! S: state state-machine definition... ; - ! definition MUST be ( data char -- newdata state ) - scan-word execute scan-word "state-table" word-prop - parse-definition -rot set-nth ; parsing From d6f9947bff87e7c16d1e918056f70a0f8b1cc02b Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sat, 21 Mar 2009 02:53:36 -0500 Subject: [PATCH 07/16] Regexp character class intersection and difference syntax --- basis/regexp/classes/classes.factor | 11 ++++++++++- basis/regexp/parser/parser-tests.factor | 2 +- basis/regexp/parser/parser.factor | 18 +++++++++++++---- basis/regexp/regexp-tests.factor | 26 +++++++++++++++++++++++++ 4 files changed, 51 insertions(+), 6 deletions(-) diff --git a/basis/regexp/classes/classes.factor b/basis/regexp/classes/classes.factor index e114dea260..a1c4e3ca2a 100644 --- a/basis/regexp/classes/classes.factor +++ b/basis/regexp/classes/classes.factor @@ -230,7 +230,10 @@ TUPLE: class-partition integers not-integers simples not-simples and or other ; dup or-class flatten partition-classes dup not-integers>> length { { 0 [ nip make-or-class ] } - { 1 [ not-integers>> first [ class>> '[ _ swap class-member? ] any? ] keep or ] } + { 1 [ + not-integers>> first + [ class>> '[ _ swap class-member? ] any? ] keep or + ] } [ 3drop t ] } case ; @@ -251,6 +254,12 @@ M: or-class M: t drop f ; M: f drop t ; +: ( a b -- a-b ) + 2array ; + +: ( a b -- a~b ) + 2array [ ] [ ] bi ; + M: primitive-class class-member? class>> class-member? ; diff --git a/basis/regexp/parser/parser-tests.factor b/basis/regexp/parser/parser-tests.factor index d606015f61..5ea9753fba 100644 --- a/basis/regexp/parser/parser-tests.factor +++ b/basis/regexp/parser/parser-tests.factor @@ -11,7 +11,7 @@ IN: regexp.parser.tests "a|b" "a.b" "a|b|c" "abc|b" "a|bcd" "a|(b)" "(?-i:a)" "||" "(a)|b" "(a|b)" "((a)|(b))" "(?:a)" "(?i:a)" "|b" "b|" "[abc]" "[a-c]" "[^a-c]" "[^]]" "[]a]" "[[]" "[]-a]" "[a-]" "[-]" - "[--a]" "foo*" "(foo)*" "(a|b)|c" "(foo){2,3}" "(foo){2,}" + "foo*" "(foo)*" "(a|b)|c" "(foo){2,3}" "(foo){2,}" "(foo){2}" "{2,3}" "{," "{,}" "}" "foo}" "[^]-a]" "[^-]a]" "[a-]" "[^a-]" "[^a-]" "a{,2}" "(?#foobar)" "\\p{Space}" "\\t" "\\[" "[\\]]" "\\P{Space}" diff --git a/basis/regexp/parser/parser.factor b/basis/regexp/parser/parser.factor index e8de469a94..9fcadc4008 100644 --- a/basis/regexp/parser/parser.factor +++ b/basis/regexp/parser/parser.factor @@ -148,19 +148,29 @@ Character = EscapeSequence | "^" => [[ ^ ]] | . ?[ allowed-char? ]? -AnyRangeCharacter = EscapeSequence | . +AnyRangeCharacter = !("&&"|"||"|"--"|"~~") (EscapeSequence | .) RangeCharacter = !("]") AnyRangeCharacter -Range = RangeCharacter:a "-" RangeCharacter:b => [[ a b ]] +Range = RangeCharacter:a "-" !("-") RangeCharacter:b => [[ a b ]] | RangeCharacter -StartRange = AnyRangeCharacter:a "-" RangeCharacter:b => [[ a b ]] +StartRange = AnyRangeCharacter:a "-" !("-") RangeCharacter:b => [[ a b ]] | AnyRangeCharacter Ranges = StartRange:s Range*:r => [[ r s prefix ]] -CharClass = "^"?:n Ranges:e => [[ e n char-class ]] +BasicCharClass = "^"?:n Ranges:e => [[ e n char-class ]] + +CharClass = BasicCharClass:b "&&" CharClass:c + => [[ b c 2array ]] + | BasicCharClass:b "||" CharClass:c + => [[ b c 2array ]] + | BasicCharClass:b "~~" CharClass:c + => [[ b c ]] + | BasicCharClass:b "--" CharClass:c + => [[ b c ]] + | BasicCharClass Options = [idmsux]* diff --git a/basis/regexp/regexp-tests.factor b/basis/regexp/regexp-tests.factor index 999caeaed6..2234386803 100644 --- a/basis/regexp/regexp-tests.factor +++ b/basis/regexp/regexp-tests.factor @@ -508,3 +508,29 @@ IN: regexp-tests [ t ] [ " " R/ \P{LL}/ matches? ] unit-test [ f ] [ "a" R/ \P{sCriPt = latin}/ matches? ] unit-test [ t ] [ " " R/ \P{SCRIPT = laTIn}/ matches? ] unit-test + +! Logical operators +[ t ] [ "a" R/ [\p{script=latin}\p{lower}]/ matches? ] unit-test +[ t ] [ "π" R/ [\p{script=latin}\p{lower}]/ matches? ] unit-test +[ t ] [ "A" R/ [\p{script=latin}\p{lower}]/ matches? ] unit-test +[ f ] [ "3" R/ [\p{script=latin}\p{lower}]/ matches? ] unit-test + +[ t ] [ "a" R/ [\p{script=latin}||\p{lower}]/ matches? ] unit-test +[ t ] [ "π" R/ [\p{script=latin}||\p{lower}]/ matches? ] unit-test +[ t ] [ "A" R/ [\p{script=latin}||\p{lower}]/ matches? ] unit-test +[ f ] [ "3" R/ [\p{script=latin}||\p{lower}]/ matches? ] unit-test + +[ t ] [ "a" R/ [\p{script=latin}&&\p{lower}]/ matches? ] unit-test +[ f ] [ "π" R/ [\p{script=latin}&&\p{lower}]/ matches? ] unit-test +[ f ] [ "A" R/ [\p{script=latin}&&\p{lower}]/ matches? ] unit-test +[ f ] [ "3" R/ [\p{script=latin}&&\p{lower}]/ matches? ] unit-test + +[ f ] [ "a" R/ [\p{script=latin}~~\p{lower}]/ matches? ] unit-test +[ t ] [ "π" R/ [\p{script=latin}~~\p{lower}]/ matches? ] unit-test +[ t ] [ "A" R/ [\p{script=latin}~~\p{lower}]/ matches? ] unit-test +[ f ] [ "3" R/ [\p{script=latin}~~\p{lower}]/ matches? ] unit-test + +[ f ] [ "a" R/ [\p{script=latin}--\p{lower}]/ matches? ] unit-test +[ f ] [ "π" R/ [\p{script=latin}--\p{lower}]/ matches? ] unit-test +[ t ] [ "A" R/ [\p{script=latin}--\p{lower}]/ matches? ] unit-test +[ f ] [ "3" R/ [\p{script=latin}--\p{lower}]/ matches? ] unit-test From 59dbba09a30632784ab04c072aeb5ec50e90d128 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 21 Mar 2009 02:54:59 -0500 Subject: [PATCH 08/16] Oops, quoting is actually needed by db.postgresql --- basis/mime/multipart/multipart.factor | 15 ++------------- basis/quoting/authors.txt | 1 + basis/quoting/quoting.factor | 16 ++++++++++++++++ 3 files changed, 19 insertions(+), 13 deletions(-) create mode 100644 basis/quoting/authors.txt create mode 100644 basis/quoting/quoting.factor diff --git a/basis/mime/multipart/multipart.factor b/basis/mime/multipart/multipart.factor index 37d5e13129..0edfb05a30 100755 --- a/basis/mime/multipart/multipart.factor +++ b/basis/mime/multipart/multipart.factor @@ -3,7 +3,8 @@ USING: multiline kernel sequences io splitting fry namespaces http.parsers hashtables assocs combinators ascii io.files.unique accessors io.encodings.binary io.files byte-arrays math -io.streams.string combinators.short-circuit strings math.order ; +io.streams.string combinators.short-circuit strings math.order +quoting ; IN: mime.multipart CONSTANT: buffer-size 65536 @@ -75,18 +76,6 @@ ERROR: end-of-stream multipart ; : empty-name? ( string -- ? ) { "''" "\"\"" "" f } member? ; -: quote? ( ch -- ? ) "'\"" member? ; - -: quoted? ( str -- ? ) - { - [ length 1 > ] - [ first quote? ] - [ [ first ] [ peek ] bi = ] - } 1&& ; - -: unquote ( str -- newstr ) - dup quoted? [ but-last-slice rest-slice >string ] when ; - : save-uploaded-file ( multipart -- ) dup filename>> empty-name? [ drop diff --git a/basis/quoting/authors.txt b/basis/quoting/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/quoting/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/quoting/quoting.factor b/basis/quoting/quoting.factor new file mode 100644 index 0000000000..5b09347c8c --- /dev/null +++ b/basis/quoting/quoting.factor @@ -0,0 +1,16 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: sequences math kernel strings combinators.short-circuit ; +IN: quoting + +: quote? ( ch -- ? ) "'\"" member? ; + +: quoted? ( str -- ? ) + { + [ length 1 > ] + [ first quote? ] + [ [ first ] [ peek ] bi = ] + } 1&& ; + +: unquote ( str -- newstr ) + dup quoted? [ but-last-slice rest-slice >string ] when ; \ No newline at end of file From 385892be64deb72dfc3c2f26b057d620a77ef833 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 21 Mar 2009 03:10:21 -0500 Subject: [PATCH 09/16] Make the member? transform better --- .../transforms/transforms-tests.factor | 7 ++- .../transforms/transforms.factor | 48 ++++++++----------- 2 files changed, 26 insertions(+), 29 deletions(-) diff --git a/basis/stack-checker/transforms/transforms-tests.factor b/basis/stack-checker/transforms/transforms-tests.factor index 521cf9fcb7..0aa3876907 100644 --- a/basis/stack-checker/transforms/transforms-tests.factor +++ b/basis/stack-checker/transforms/transforms-tests.factor @@ -65,4 +65,9 @@ DEFER: curry-folding-test ( quot -- ) { 3 0 } [ [ 1 2 3 ] curry-folding-test ] must-infer-as { 3 0 } [ 1 [ 2 3 ] curry curry-folding-test ] must-infer-as -{ 3 0 } [ [ 1 2 ] 3 [ ] curry compose curry-folding-test ] must-infer-as \ No newline at end of file +{ 3 0 } [ [ 1 2 ] 3 [ ] curry compose curry-folding-test ] must-infer-as + +: member?-test ( a -- ? ) { 1 2 3 10 7 58 } member? ; + +[ f ] [ 1.0 member?-test ] unit-test +[ t ] [ \ member?-test def>> first [ member?-test ] all? ] unit-test \ No newline at end of file diff --git a/basis/stack-checker/transforms/transforms.factor b/basis/stack-checker/transforms/transforms.factor index 3b783ce467..dd36c5a82b 100755 --- a/basis/stack-checker/transforms/transforms.factor +++ b/basis/stack-checker/transforms/transforms.factor @@ -1,12 +1,12 @@ ! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: fry accessors arrays kernel kernel.private combinators.private -words sequences generic math namespaces make quotations assocs -combinators classes.tuple classes.tuple.private effects summary -hashtables classes generic sets definitions generic.standard -slots.private continuations locals generalizations -stack-checker.backend stack-checker.state stack-checker.visitor -stack-checker.errors stack-checker.values +words sequences generic math math.order namespaces make quotations assocs +combinators combinators.short-circuit classes.tuple +classes.tuple.private effects summary hashtables classes generic sets +definitions generic.standard slots.private continuations locals +generalizations stack-checker.backend stack-checker.state +stack-checker.visitor stack-checker.errors stack-checker.values stack-checker.recursive-state ; IN: stack-checker.transforms @@ -107,36 +107,28 @@ IN: stack-checker.transforms ] 1 define-transform ! Membership testing -CONSTANT: bit-member-n 256 +CONSTANT: bit-member-max 256 : bit-member? ( seq -- ? ) #! Can we use a fast byte array test here? { - { [ dup length 8 < ] [ f ] } - { [ dup [ integer? not ] any? ] [ f ] } - { [ dup [ 0 < ] any? ] [ f ] } - { [ dup [ bit-member-n >= ] any? ] [ f ] } - [ t ] - } cond nip ; + [ length 4 > ] + [ [ integer? ] all? ] + [ [ 0 bit-member-max between? ] any? ] + } 1&& ; : bit-member-seq ( seq -- flags ) - bit-member-n swap [ member? 1 0 ? ] curry B{ } map-as ; - -: exact-float? ( f -- ? ) - dup float? [ dup >integer >float = ] [ drop f ] if ; inline + [ supremum 1+ ] keep '[ _ member? 1 0 ? ] B{ } map-as ; : bit-member-quot ( seq -- newquot ) - [ - bit-member-seq , - [ - { - { [ over fixnum? ] [ ?nth 1 eq? ] } - { [ over bignum? ] [ ?nth 1 eq? ] } - { [ over exact-float? ] [ ?nth 1 eq? ] } - [ 2drop f ] - } cond - ] % - ] [ ] make ; + bit-member-seq + '[ + _ { + { [ over fixnum? ] [ ?nth 1 eq? ] } + { [ over bignum? ] [ ?nth 1 eq? ] } + [ 2drop f ] + } cond + ] ; : member-quot ( seq -- newquot ) dup bit-member? [ From 4f83e2057ad090d357a61767a0e858cd1b65ca14 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sat, 21 Mar 2009 03:17:20 -0500 Subject: [PATCH 10/16] Making unicode.categories.syntax use member?, simplifying the code --- basis/unicode/categories/syntax/syntax.factor | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/basis/unicode/categories/syntax/syntax.factor b/basis/unicode/categories/syntax/syntax.factor index 93f7919b6b..87f143aadc 100644 --- a/basis/unicode/categories/syntax/syntax.factor +++ b/basis/unicode/categories/syntax/syntax.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008, 2009 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: unicode.data kernel math sequences parser +USING: unicode.data kernel math sequences parser unicode.data.private bit-arrays namespaces sequences.private arrays classes.parser assocs classes.predicate sets fry splitting accessors ; IN: unicode.categories.syntax @@ -10,12 +10,8 @@ SYMBOLS: Cn Lu Ll Lt Lm Lo Mn Mc Me Nd Nl No Pc Pd Ps Pe Pi Pf Po Sm Sc Sk So Zs category-array ( categories -- bitarray ) - categories [ swap member? ] with map >bit-array ; - : [category] ( categories code -- quot ) - [ >category-array ] dip - '[ dup category# _ nth-unsafe [ drop t ] _ if ] ; + '[ dup category# _ member? [ drop t ] _ if ] ; : integer-predicate-class ( word predicate -- ) integer swap define-predicate-class ; @@ -28,7 +24,7 @@ SYMBOLS: Cn Lu Ll Lt Lm Lo Mn Mc Me Nd Nl No Pc Pd Ps Pe Pi Pf Po Sm Sc Sk So Zs : parse-category ( -- word tokens quot ) CREATE-CLASS \ ; parse-until { | } split1 - [ [ name>> ] map ] + [ [ name>> categories-map at ] map ] [ [ [ ] like ] [ [ drop f ] ] if* ] bi* ; PRIVATE> From 30816ba5d0c6ca570529f479a5069be9da7e61c1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 21 Mar 2009 03:22:21 -0500 Subject: [PATCH 11/16] Get more code to load after SYNTAX: change --- .../chloe/components/components.factor | 3 +- extra/multi-methods/multi-methods.factor | 9 ++-- extra/peg-lexer/peg-lexer.factor | 46 +++++++++++-------- 3 files changed, 33 insertions(+), 25 deletions(-) diff --git a/basis/html/templates/chloe/components/components.factor b/basis/html/templates/chloe/components/components.factor index 19f2019266..d69dc08537 100644 --- a/basis/html/templates/chloe/components/components.factor +++ b/basis/html/templates/chloe/components/components.factor @@ -25,8 +25,7 @@ M: tuple-class component-tag ( tag class -- ) [ compile-component-attrs ] 2bi [ render ] [code] ; -: COMPONENT: +SYNTAX: COMPONENT: scan-word [ name>> ] [ '[ _ component-tag ] ] bi define-chloe-tag ; - parsing diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor index 7c5d5fb431..ec069a4894 100755 --- a/extra/multi-methods/multi-methods.factor +++ b/extra/multi-methods/multi-methods.factor @@ -224,8 +224,7 @@ M: no-method error. ] if ; ! Syntax -: GENERIC: - CREATE define-generic ; parsing +SYNTAX: GENERIC: CREATE define-generic ; : parse-method ( -- quot classes generic ) parse-definition [ 2 tail ] [ second ] [ first ] tri ; @@ -238,13 +237,13 @@ M: no-method error. : (METHOD:) ( -- method def ) CREATE-METHOD parse-definition ; -: METHOD: (METHOD:) define ; parsing +SYNTAX: METHOD: (METHOD:) define ; ! For compatibility -: M: +SYNTAX: M: scan-word 1array scan-word create-method-in parse-definition - define ; parsing + define ; ! Definition protocol. We qualify core generics here QUALIFIED: syntax diff --git a/extra/peg-lexer/peg-lexer.factor b/extra/peg-lexer/peg-lexer.factor index 1b5f17df4c..90d2e0e34c 100644 --- a/extra/peg-lexer/peg-lexer.factor +++ b/extra/peg-lexer/peg-lexer.factor @@ -9,36 +9,46 @@ CONSULT: assoc-protocol lex-hash hash>> ; : pos-or-0 ( neg? -- pos/0 ) dup 0 < [ drop 0 ] when ; :: prepare-pos ( v i -- c l ) - [let | n [ i v head-slice ] | - v CHAR: \n n last-index -1 or 1+ - - n [ CHAR: \n = ] count 1+ ] ; + [let | n [ i v head-slice ] | + v CHAR: \n n last-index -1 or 1+ - + n [ CHAR: \n = ] count 1+ + ] ; -: store-pos ( v a -- ) input swap at prepare-pos - lexer get [ (>>line) ] keep (>>column) ; +: store-pos ( v a -- ) + input swap at prepare-pos + lexer get [ (>>line) ] keep (>>column) ; -M: lex-hash set-at swap { - { pos [ store-pos ] } - [ swap hash>> set-at ] } case ; +M: lex-hash set-at + swap { + { pos [ store-pos ] } + [ swap hash>> set-at ] + } case ; :: at-pos ( t l c -- p ) t l head-slice [ length ] map sum l 1- + c + ; -M: lex-hash at* swap { +M: lex-hash at* + swap { { input [ drop lexer get text>> "\n" join t ] } { pos [ drop lexer get [ text>> ] [ line>> 1- ] [ column>> 1+ ] tri at-pos t ] } - [ swap hash>> at* ] } case ; + [ swap hash>> at* ] + } case ; : with-global-lexer ( quot -- result ) - [ f lrstack set - V{ } clone error-stack set H{ } clone \ heads set - H{ } clone \ packrat set ] f make-assoc + [ + f lrstack set + V{ } clone error-stack set H{ } clone \ heads set + H{ } clone \ packrat set + ] f make-assoc swap bind ; inline -: parse* ( parser -- ast ) compile - [ execute [ error-stack get first throw ] unless* ] with-global-lexer - ast>> ; +: parse* ( parser -- ast ) + compile + [ execute [ error-stack get first throw ] unless* ] with-global-lexer + ast>> ; -: create-bnf ( name parser -- ) reset-tokenizer [ lexer get skip-blank parse* parsed ] curry - define word make-parsing ; +: create-bnf ( name parser -- ) + reset-tokenizer [ lexer get skip-blank parse* parsed ] curry + define-syntax ; SYNTAX: ON-BNF: CREATE-WORD reset-tokenizer ";ON-BNF" parse-multiline-string parse-ebnf From 62c2ee8d3b8d0a6aec1dcf19b64a70fdcdff6e9e Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sat, 21 Mar 2009 03:22:50 -0500 Subject: [PATCH 12/16] Documenting character class operations --- basis/regexp/regexp-docs.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/basis/regexp/regexp-docs.factor b/basis/regexp/regexp-docs.factor index 01a727d017..3a914f4283 100644 --- a/basis/regexp/regexp-docs.factor +++ b/basis/regexp/regexp-docs.factor @@ -76,6 +76,8 @@ ARTICLE: { "regexp" "syntax" } "Regular expression syntax" { { $snippet "\\p{Nd}" } "Character in Unicode category Nd" } { { $snippet "\\p{Z}" } "Character in Unicode category beginning with Z" } { { $snippet "\\p{script=Cham}" } "Character in the Cham writing system" } } +{ $heading "Character class operations" } +"Character classes can be composed using four binary operations: " { $snippet "|| && ~~ --" } ". These do the operations union, intersection, symmetric difference and difference, respectively. For example, characters which are lower-case but not Latin script could be matched as " { $snippet "[\\p{lower}--\\p{script=latin}]" } ". These operations are right-associative, and " { $snippet "^" } " binds tighter than them. There is no syntax for grouping." { $heading "Boundaries" } "Special operators exist to match certain points in the string. These are called 'zero-width' because they do not consume any characters." { $table From 87b90cf3718c7ceb96e13c657eb044fda20cb30d Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Sat, 21 Mar 2009 03:39:30 -0500 Subject: [PATCH 13/16] Fixing XML char classes --- basis/xml/char-classes/char-classes.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/xml/char-classes/char-classes.factor b/basis/xml/char-classes/char-classes.factor index 153fca0bb7..3deab0a287 100644 --- a/basis/xml/char-classes/char-classes.factor +++ b/basis/xml/char-classes/char-classes.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2009 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences unicode.categories.syntax math math.order -combinators hints ; +combinators hints combinators.short-circuit ; IN: xml.char-classes CATEGORY: 1.0name-start @@ -15,11 +15,11 @@ CATEGORY: 1.0name-char "_-.\u000387:" member? ; CATEGORY: 1.1name-start - Ll Lu Lo Lm Ln Nl | + Ll Lu Lo Lm Nl | "_:" member? ; CATEGORY: 1.1name-char - Ll Lu Lo Lm Ln Nl Mc Mn Nd Pc Cf | + Ll Lu Lo Lm Nl Mc Mn Nd Pc Cf | "_-.\u0000b7:" member? ; : name-start? ( 1.0? char -- ? ) From 35a3170f422a8a787fa54b5566af71ca77bca53a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 21 Mar 2009 03:43:38 -0500 Subject: [PATCH 14/16] Stack inference for mason --- extra/mason/child/child.factor | 2 +- extra/mason/report/report.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/mason/child/child.factor b/extra/mason/child/child.factor index 1999c76d83..04c4a09f61 100644 --- a/extra/mason/child/child.factor +++ b/extra/mason/child/child.factor @@ -67,7 +67,7 @@ IN: mason.child try-process ] with-directory ; -: return-with ( obj -- ) return-continuation get continue-with ; +: return-with ( obj -- * ) return-continuation get continue-with ; : build-clean? ( -- ? ) { diff --git a/extra/mason/report/report.factor b/extra/mason/report/report.factor index 1b2697a5d1..52e1608885 100644 --- a/extra/mason/report/report.factor +++ b/extra/mason/report/report.factor @@ -16,7 +16,7 @@ IN: mason.report "git id: " write "git-id" eval-file print nl ; : with-report ( quot -- ) - [ "report" utf8 ] dip '[ common-report @ ] with-file-writer ; + [ "report" utf8 ] dip '[ common-report @ ] with-file-writer ; inline : compile-failed-report ( error -- ) [ From ea26949051eaccbbe8e211a38966296924727db1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 21 Mar 2009 04:07:28 -0500 Subject: [PATCH 15/16] Minor fixes to regexp docs --- basis/regexp/authors.txt | 1 + basis/regexp/regexp-docs.factor | 21 +++++++++++++++------ 2 files changed, 16 insertions(+), 6 deletions(-) diff --git a/basis/regexp/authors.txt b/basis/regexp/authors.txt index 7c1b2f2279..a4a77d97e9 100644 --- a/basis/regexp/authors.txt +++ b/basis/regexp/authors.txt @@ -1 +1,2 @@ Doug Coleman +Daniel Ehrenberg diff --git a/basis/regexp/regexp-docs.factor b/basis/regexp/regexp-docs.factor index 3a914f4283..2ff31f0cec 100644 --- a/basis/regexp/regexp-docs.factor +++ b/basis/regexp/regexp-docs.factor @@ -47,9 +47,9 @@ ARTICLE: { "regexp" "syntax" } "Regular expression syntax" { $heading "Characters" } "At its core, regular expressions consist of character literals. For example, " { $snippet "R/ f/" } " is a regular expression matching just the string 'f'. In addition, the normal escape codes are provided, like " { $snippet "\\t" } " for the tab character and " { $snippet "\\uxxxxxx" } " for an arbitrary Unicode code point, by its hex value. In addition, any character can be preceded by a backslash to escape it, unless this has special meaning. For example, to match a literal opening parenthesis, use " { $snippet "\\(" } "." { $heading "Concatenation, alternation and grouping" } -"Regular expressions can be built out of multiple characters by concatenation. For example, " { $snippet "R/ ab/" } " matches a followed by b. The " { $snippet "|" } " (alternation) operator can construct a regexp which matches one of two alternatives. Parentheses can be used for gropuing. So " { $snippet "R/ f(oo|ar)/" } " would match either 'foo' or 'far'." +"Regular expressions can be built out of multiple characters by concatenation. For example, " { $snippet "R/ ab/" } " matches a followed by b. The " { $snippet "|" } " (alternation) operator can construct a regexp which matches one of two alternatives. Parentheses can be used for grouping. So " { $snippet "R/ f(oo|ar)/" } " would match either 'foo' or 'far'." { $heading "Character classes" } -"Square brackets define a convenient way to refer to a set of characters. For example, " { $snippet "[ab]" } " refers to either a or b. And " { $snippet "[a-z]" } " refers to all of the characters between a and z, in code point order. You can use these together, as in " { $snippet "[ac-fz]" } " which matches all of the characters between c and f, in addition to a and z. Character classes can be negated using a carat, as in " { $snippet "[^a]" } " which matches all characters which are not a." +"Square brackets define a convenient way to refer to a set of characters. For example, " { $snippet "[ab]" } " refers to either a or b. And " { $snippet "[a-z]" } " refers to all of the characters between a and z, in code point order. You can use these together, as in " { $snippet "[ac-fz]" } " which matches all of the characters between c and f, in addition to a and z. Character classes can be negated using a caret, as in " { $snippet "[^a]" } " which matches all characters which are not a." { $heading "Predefined character classes" } "Several character classes are predefined, both for convenience and because they are too large to represent directly. In Factor regular expressions, all character classes are Unicode-aware." { $table @@ -109,9 +109,18 @@ ARTICLE: { "regexp" "syntax" } "Regular expression syntax" { $heading "Quotation" } "To make it convenient to have a long string which uses regexp operators, a special syntax is provided. If a substring begins with " { $snippet "\\Q" } " then everything until " { $snippet "\\E" } " is quoted (escaped). For example, " { $snippet "R/ \\Qfoo\\bar|baz()\\E/" } " matches exactly the string " { $snippet "\"foo\\bar|baz()\"" } "." { $heading "Unsupported features" } -"One missing feature is backreferences. This is because of a design decision to allow only regular expressions following the formal theory of regular languages. For more information, see " { $link { "regexp" "theory" } } ". You can create a new regular expression to match a particular string using " { $vocab-link "regexp.combinators" } " and group capture is available to extract parts of a regular expression match." $nl -"Another feature is Perl's " { $snippet "\\G" } " syntax, which references the previous match, is not included. This is because that sequence is inherently stateful, and Factor regexps don't hold state." $nl -"None of the operations which embed code into a regexp are supported, as this would require the inclusion of the Factor parser and compiler in any application which wants to expose regexps to the user. None of the casing operations are included of Perl like \\L, for simplicity." ; ! Also describe syntax, from the beginning +{ $subheading "Group capture" } +{ $subheading "Reluctant and posessive quantifiers" } +{ $subheading "Backreferences" } +"Backreferences were omitted because of a design decision to allow only regular expressions following the formal theory of regular languages. For more information, see " { $link { "regexp" "theory" } } "." +$nl +"To work around the lack of backreferences, consider using group capture and then creating a new regular expression to match the captured string using " { $vocab-link "regexp.combinators" } "." +{ $subheading "Previous match" } +"Another feature that is not included is Perl's " { $snippet "\\G" } " syntax, which references the previous match. This is because that sequence is inherently stateful, and Factor regexps don't hold state." +{ $subheading "Embedding code" } +"Operations which embed code into a regexp are not supported. This would require the inclusion of the Factor parser and compiler in any deployed application which wants to expose regexps to the user, leading to an undesirable increase in the code size." +{ $heading "Casing operations" } +"No special casing operations are included, for example Perl's " { $snippet "\\L" } "." ; ARTICLE: { "regexp" "options" } "Regular expression options" "When " { $link { "regexp" "construction" } } ", various options can be provided. Options have single-character names. A string of options has one of the following two forms:" @@ -154,7 +163,7 @@ ARTICLE: { "regexp" "theory" } "The theory of regular expressions" "This implies, by DeMorgan's law, that, if you have two regular languages, their intersection is also regular. That is, for any two regular expressions, there exists a regular expression which matches strings that match both inputs." $nl "Traditionally, regular expressions on computer support an additional operation: backreferences. For example, the Perl regexp " { $snippet "/(.*)$1/" } " matches a string repated twice. If a backreference refers to a string with a predetermined maximum length, then the resulting language is still regular." $nl "But, if not, the language is not regular. There is strong evidence that there is no efficient way to parse with backreferences in the general case. Perl uses a naive backtracking algorithm which has pathological behavior in some cases, taking exponential time to match even if backreferences aren't used. Additionally, expressions with backreferences don't have the properties with negation and intersection described above." $nl -"The Factor regular expression engine was built with the design decision to support negation and intersection at the expense of backreferences. This lets us have a guaranteed linear-time matching algorithm. Systems like Ragel and Lex also use this algorithm, but in the Factor regular expression engine, all other features of regexps are still present." ; +"The Factor regular expression engine was built with the design decision to support negation and intersection at the expense of backreferences. This lets us have a guaranteed linear-time matching algorithm. Systems like Ragel and Lex use the same algorithm." ; ARTICLE: { "regexp" "operations" } "Matching operations with regular expressions" "Testing if a string matches a regular expression:" From b9459fb860f6c992ff3545ec8bbd4e4208024fb8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 21 Mar 2009 04:14:18 -0500 Subject: [PATCH 16/16] Minor cleanup in io.encodings.iso2022 --- .../io/encodings/iso2022/iso2022-tests.factor | 44 +++++++++---------- basis/io/encodings/iso2022/iso2022.factor | 12 ++--- 2 files changed, 28 insertions(+), 28 deletions(-) diff --git a/basis/io/encodings/iso2022/iso2022-tests.factor b/basis/io/encodings/iso2022/iso2022-tests.factor index b8a628c8ba..9111eee955 100644 --- a/basis/io/encodings/iso2022/iso2022-tests.factor +++ b/basis/io/encodings/iso2022/iso2022-tests.factor @@ -7,30 +7,30 @@ IN: io.encodings.iso2022 [ "hello" ] [ "hello" >byte-array iso2022 decode ] unit-test [ "hello" ] [ "hello" iso2022 encode >string ] unit-test -[ "hi" ] [ B{ CHAR: h $ ESC CHAR: ( CHAR: B CHAR: i } iso2022 decode ] unit-test -[ "hi" ] [ B{ CHAR: h CHAR: i $ ESC CHAR: ( CHAR: B } iso2022 decode ] unit-test -[ "hi\u00fffd" ] [ B{ CHAR: h CHAR: i $ ESC CHAR: ( } iso2022 decode ] unit-test -[ "hi\u00fffd" ] [ B{ CHAR: h CHAR: i $ ESC } iso2022 decode ] unit-test +[ "hi" ] [ B{ CHAR: h ESC CHAR: ( CHAR: B CHAR: i } iso2022 decode ] unit-test +[ "hi" ] [ B{ CHAR: h CHAR: i ESC CHAR: ( CHAR: B } iso2022 decode ] unit-test +[ "hi\u00fffd" ] [ B{ CHAR: h CHAR: i ESC CHAR: ( } iso2022 decode ] unit-test +[ "hi\u00fffd" ] [ B{ CHAR: h CHAR: i ESC } iso2022 decode ] unit-test -[ B{ CHAR: h $ ESC CHAR: ( CHAR: J HEX: D8 } ] [ "h\u00ff98" iso2022 encode ] unit-test -[ "h\u00ff98" ] [ B{ CHAR: h $ ESC CHAR: ( CHAR: J HEX: D8 } iso2022 decode ] unit-test -[ "hi" ] [ B{ CHAR: h $ ESC CHAR: ( CHAR: J CHAR: i } iso2022 decode ] unit-test -[ "h" ] [ B{ CHAR: h $ ESC CHAR: ( CHAR: J } iso2022 decode ] unit-test -[ "h\u00fffd" ] [ B{ CHAR: h $ ESC CHAR: ( CHAR: J HEX: 80 } iso2022 decode ] unit-test +[ B{ CHAR: h ESC CHAR: ( CHAR: J HEX: D8 } ] [ "h\u00ff98" iso2022 encode ] unit-test +[ "h\u00ff98" ] [ B{ CHAR: h ESC CHAR: ( CHAR: J HEX: D8 } iso2022 decode ] unit-test +[ "hi" ] [ B{ CHAR: h ESC CHAR: ( CHAR: J CHAR: i } iso2022 decode ] unit-test +[ "h" ] [ B{ CHAR: h ESC CHAR: ( CHAR: J } iso2022 decode ] unit-test +[ "h\u00fffd" ] [ B{ CHAR: h ESC CHAR: ( CHAR: J HEX: 80 } iso2022 decode ] unit-test -[ B{ CHAR: h $ ESC CHAR: $ CHAR: B HEX: 3E HEX: 47 } ] [ "h\u007126" iso2022 encode ] unit-test -[ "h\u007126" ] [ B{ CHAR: h $ ESC CHAR: $ CHAR: B HEX: 3E HEX: 47 } iso2022 decode ] unit-test -[ "h\u00fffd" ] [ B{ CHAR: h $ ESC CHAR: $ CHAR: B HEX: 3E } iso2022 decode ] unit-test -[ "h" ] [ B{ CHAR: h $ ESC CHAR: $ CHAR: B } iso2022 decode ] unit-test -[ "h\u00fffd" ] [ B{ CHAR: h $ ESC CHAR: $ } iso2022 decode ] unit-test -[ "h\u00fffd" ] [ B{ CHAR: h $ ESC } iso2022 decode ] unit-test -[ "h\u00fffd" ] [ B{ CHAR: h $ ESC CHAR: $ CHAR: B HEX: 80 HEX: 80 } iso2022 decode ] unit-test +[ B{ CHAR: h ESC CHAR: $ CHAR: B HEX: 3E HEX: 47 } ] [ "h\u007126" iso2022 encode ] unit-test +[ "h\u007126" ] [ B{ CHAR: h ESC CHAR: $ CHAR: B HEX: 3E HEX: 47 } iso2022 decode ] unit-test +[ "h\u00fffd" ] [ B{ CHAR: h ESC CHAR: $ CHAR: B HEX: 3E } iso2022 decode ] unit-test +[ "h" ] [ B{ CHAR: h ESC CHAR: $ CHAR: B } iso2022 decode ] unit-test +[ "h\u00fffd" ] [ B{ CHAR: h ESC CHAR: $ } iso2022 decode ] unit-test +[ "h\u00fffd" ] [ B{ CHAR: h ESC } iso2022 decode ] unit-test +[ "h\u00fffd" ] [ B{ CHAR: h ESC CHAR: $ CHAR: B HEX: 80 HEX: 80 } iso2022 decode ] unit-test -[ B{ CHAR: h $ ESC CHAR: $ CHAR: ( CHAR: D HEX: 38 HEX: 54 } ] [ "h\u0058ce" iso2022 encode ] unit-test -[ "h\u0058ce" ] [ B{ CHAR: h $ ESC CHAR: $ CHAR: ( CHAR: D HEX: 38 HEX: 54 } iso2022 decode ] unit-test -[ "h\u00fffd" ] [ B{ CHAR: h $ ESC CHAR: $ CHAR: ( CHAR: D HEX: 38 } iso2022 decode ] unit-test -[ "h" ] [ B{ CHAR: h $ ESC CHAR: $ CHAR: ( CHAR: D } iso2022 decode ] unit-test -[ "h\u00fffd" ] [ B{ CHAR: h $ ESC CHAR: $ CHAR: ( } iso2022 decode ] unit-test -[ "h\u00fffd" ] [ B{ CHAR: h $ ESC CHAR: $ CHAR: ( CHAR: D HEX: 70 HEX: 70 } iso2022 decode ] unit-test +[ B{ CHAR: h ESC CHAR: $ CHAR: ( CHAR: D HEX: 38 HEX: 54 } ] [ "h\u0058ce" iso2022 encode ] unit-test +[ "h\u0058ce" ] [ B{ CHAR: h ESC CHAR: $ CHAR: ( CHAR: D HEX: 38 HEX: 54 } iso2022 decode ] unit-test +[ "h\u00fffd" ] [ B{ CHAR: h ESC CHAR: $ CHAR: ( CHAR: D HEX: 38 } iso2022 decode ] unit-test +[ "h" ] [ B{ CHAR: h ESC CHAR: $ CHAR: ( CHAR: D } iso2022 decode ] unit-test +[ "h\u00fffd" ] [ B{ CHAR: h ESC CHAR: $ CHAR: ( } iso2022 decode ] unit-test +[ "h\u00fffd" ] [ B{ CHAR: h ESC CHAR: $ CHAR: ( CHAR: D HEX: 70 HEX: 70 } iso2022 decode ] unit-test [ "\u{syriac-music}" iso2022 encode ] must-fail diff --git a/basis/io/encodings/iso2022/iso2022.factor b/basis/io/encodings/iso2022/iso2022.factor index 3dabb894e4..a057df28e0 100644 --- a/basis/io/encodings/iso2022/iso2022.factor +++ b/basis/io/encodings/iso2022/iso2022.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: io.encodings kernel sequences io simple-flat-file sets math combinators.short-circuit io.binary values arrays assocs -locals accessors combinators literals biassocs byte-arrays ; +locals accessors combinators biassocs byte-arrays parser ; IN: io.encodings.iso2022 SINGLETON: iso2022 @@ -31,12 +31,12 @@ M: iso2022 M: iso2022 make-iso-coder ; -CONSTANT: ESC HEX: 16 +<< SYNTAX: ESC HEX: 16 parsed ; >> -CONSTANT: switch-ascii B{ $ ESC CHAR: ( CHAR: B } -CONSTANT: switch-jis201 B{ $ ESC CHAR: ( CHAR: J } -CONSTANT: switch-jis208 B{ $ ESC CHAR: $ CHAR: B } -CONSTANT: switch-jis212 B{ $ ESC CHAR: $ CHAR: ( CHAR: D } +CONSTANT: switch-ascii B{ ESC CHAR: ( CHAR: B } +CONSTANT: switch-jis201 B{ ESC CHAR: ( CHAR: J } +CONSTANT: switch-jis208 B{ ESC CHAR: $ CHAR: B } +CONSTANT: switch-jis212 B{ ESC CHAR: $ CHAR: ( CHAR: D } : find-type ( char -- code type ) {