diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index e55ee9d852..5343bb513b 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -1,184 +1,184 @@ -! Copyright (C) 2007 Chris Double. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel parser words arrays strings math.parser sequences - quotations vectors namespaces math assocs continuations peg ; -IN: peg.ebnf - -TUPLE: ebnf-non-terminal symbol ; -TUPLE: ebnf-terminal symbol ; -TUPLE: ebnf-choice options ; -TUPLE: ebnf-sequence elements ; -TUPLE: ebnf-repeat0 group ; -TUPLE: ebnf-optional elements ; -TUPLE: ebnf-rule symbol elements ; -TUPLE: ebnf-action word ; -TUPLE: ebnf rules ; - -C: ebnf-non-terminal -C: ebnf-terminal -C: ebnf-choice -C: ebnf-sequence -C: ebnf-repeat0 -C: ebnf-optional -C: ebnf-rule -C: ebnf-action -C: ebnf - -SYMBOL: parsers -SYMBOL: non-terminals -SYMBOL: last-parser - -: reset-parser-generation ( -- ) - V{ } clone parsers set - H{ } clone non-terminals set - f last-parser set ; - -: store-parser ( parser -- number ) - parsers get [ push ] keep length 1- ; - -: get-parser ( index -- parser ) - parsers get nth ; - -: non-terminal-index ( name -- number ) - dup non-terminals get at [ - nip - ] [ - f store-parser [ swap non-terminals get set-at ] keep - ] if* ; - -GENERIC: (generate-parser) ( ast -- id ) - -: generate-parser ( ast -- id ) - (generate-parser) dup last-parser set ; - -M: ebnf-terminal (generate-parser) ( ast -- id ) - ebnf-terminal-symbol token sp store-parser ; - -M: ebnf-non-terminal (generate-parser) ( ast -- id ) - [ - ebnf-non-terminal-symbol dup non-terminal-index , - parsers get , \ nth , [ search ] [ 2drop f ] recover , \ or , - ] [ ] make delay sp store-parser ; - -M: ebnf-choice (generate-parser) ( ast -- id ) - ebnf-choice-options [ - generate-parser get-parser - ] map choice store-parser ; - -M: ebnf-sequence (generate-parser) ( ast -- id ) - ebnf-sequence-elements [ - generate-parser get-parser - ] map seq store-parser ; - -M: ebnf-repeat0 (generate-parser) ( ast -- id ) - ebnf-repeat0-group generate-parser get-parser repeat0 store-parser ; - -M: ebnf-optional (generate-parser) ( ast -- id ) - ebnf-optional-elements generate-parser get-parser optional store-parser ; - -M: ebnf-rule (generate-parser) ( ast -- id ) - dup ebnf-rule-symbol non-terminal-index swap - ebnf-rule-elements generate-parser get-parser ! nt-id body - swap [ parsers get set-nth ] keep ; - -M: ebnf-action (generate-parser) ( ast -- id ) - ebnf-action-word search 1quotation - last-parser get get-parser swap action store-parser ; - -M: vector (generate-parser) ( ast -- id ) - [ generate-parser ] map peek ; - -M: f (generate-parser) ( ast -- id ) - drop last-parser get ; - -M: ebnf (generate-parser) ( ast -- id ) - ebnf-rules [ - generate-parser - ] map peek ; - -DEFER: 'rhs' - -: 'non-terminal' ( -- parser ) - CHAR: a CHAR: z range repeat1 [ >string ] action ; - -: 'terminal' ( -- parser ) - "'" token hide [ CHAR: ' = not ] satisfy repeat1 "'" token hide 3array seq [ first >string ] action ; - -: 'element' ( -- parser ) - 'non-terminal' 'terminal' 2array choice ; - -DEFER: 'choice' - -: 'group' ( -- parser ) - "(" token sp hide - [ 'choice' sp ] delay - ")" token sp hide - 3array seq [ first ] action ; - -: 'repeat0' ( -- parser ) - "{" token sp hide - [ 'choice' sp ] delay - "}" token sp hide - 3array seq [ first ] action ; - -: 'optional' ( -- parser ) - "[" token sp hide - [ 'choice' sp ] delay - "]" token sp hide - 3array seq [ first ] action ; - -: 'sequence' ( -- parser ) - [ - 'element' sp , - 'group' sp , - 'repeat0' sp , - 'optional' sp , - ] { } make choice - repeat1 [ - dup length 1 = [ first ] [ ] if - ] action ; - -: 'choice' ( -- parser ) - 'sequence' sp "|" token sp list-of [ - dup length 1 = [ first ] [ ] if - ] action ; - -: 'action' ( -- parser ) - "=>" token hide - [ blank? ] satisfy ensure-not [ drop t ] satisfy 2array seq [ first ] action repeat1 [ >string ] action sp - 2array seq [ first ] action ; - -: 'rhs' ( -- parser ) - 'choice' 'action' sp optional 2array seq ; - -: 'rule' ( -- parser ) - 'non-terminal' [ ebnf-non-terminal-symbol ] action - "=" token sp hide - 'rhs' - 3array seq [ first2 ] action ; - -: 'ebnf' ( -- parser ) - 'rule' sp "." token sp hide list-of [ ] action ; - -: ebnf>quot ( string -- quot ) - 'ebnf' parse [ - parse-result-ast [ - reset-parser-generation - generate-parser drop - [ - non-terminals get - [ - get-parser [ - swap , \ in , \ get , \ create , - 1quotation , \ define-compound , - ] [ - drop - ] if* - ] assoc-each - ] [ ] make - ] with-scope - ] [ - f - ] if* ; - +! Copyright (C) 2007 Chris Double. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel parser words arrays strings math.parser sequences + quotations vectors namespaces math assocs continuations peg ; +IN: peg.ebnf + +TUPLE: ebnf-non-terminal symbol ; +TUPLE: ebnf-terminal symbol ; +TUPLE: ebnf-choice options ; +TUPLE: ebnf-sequence elements ; +TUPLE: ebnf-repeat0 group ; +TUPLE: ebnf-optional elements ; +TUPLE: ebnf-rule symbol elements ; +TUPLE: ebnf-action word ; +TUPLE: ebnf rules ; + +C: ebnf-non-terminal +C: ebnf-terminal +C: ebnf-choice +C: ebnf-sequence +C: ebnf-repeat0 +C: ebnf-optional +C: ebnf-rule +C: ebnf-action +C: ebnf + +SYMBOL: parsers +SYMBOL: non-terminals +SYMBOL: last-parser + +: reset-parser-generation ( -- ) + V{ } clone parsers set + H{ } clone non-terminals set + f last-parser set ; + +: store-parser ( parser -- number ) + parsers get [ push ] keep length 1- ; + +: get-parser ( index -- parser ) + parsers get nth ; + +: non-terminal-index ( name -- number ) + dup non-terminals get at [ + nip + ] [ + f store-parser [ swap non-terminals get set-at ] keep + ] if* ; + +GENERIC: (generate-parser) ( ast -- id ) + +: generate-parser ( ast -- id ) + (generate-parser) dup last-parser set ; + +M: ebnf-terminal (generate-parser) ( ast -- id ) + ebnf-terminal-symbol token sp store-parser ; + +M: ebnf-non-terminal (generate-parser) ( ast -- id ) + [ + ebnf-non-terminal-symbol dup non-terminal-index , + parsers get , \ nth , [ search ] [ 2drop f ] recover , \ or , + ] [ ] make delay sp store-parser ; + +M: ebnf-choice (generate-parser) ( ast -- id ) + ebnf-choice-options [ + generate-parser get-parser + ] map choice store-parser ; + +M: ebnf-sequence (generate-parser) ( ast -- id ) + ebnf-sequence-elements [ + generate-parser get-parser + ] map seq store-parser ; + +M: ebnf-repeat0 (generate-parser) ( ast -- id ) + ebnf-repeat0-group generate-parser get-parser repeat0 store-parser ; + +M: ebnf-optional (generate-parser) ( ast -- id ) + ebnf-optional-elements generate-parser get-parser optional store-parser ; + +M: ebnf-rule (generate-parser) ( ast -- id ) + dup ebnf-rule-symbol non-terminal-index swap + ebnf-rule-elements generate-parser get-parser ! nt-id body + swap [ parsers get set-nth ] keep ; + +M: ebnf-action (generate-parser) ( ast -- id ) + ebnf-action-word search 1quotation + last-parser get get-parser swap action store-parser ; + +M: vector (generate-parser) ( ast -- id ) + [ generate-parser ] map peek ; + +M: f (generate-parser) ( ast -- id ) + drop last-parser get ; + +M: ebnf (generate-parser) ( ast -- id ) + ebnf-rules [ + generate-parser + ] map peek ; + +DEFER: 'rhs' + +: 'non-terminal' ( -- parser ) + CHAR: a CHAR: z range repeat1 [ >string ] action ; + +: 'terminal' ( -- parser ) + "'" token hide [ CHAR: ' = not ] satisfy repeat1 "'" token hide 3array seq [ first >string ] action ; + +: 'element' ( -- parser ) + 'non-terminal' 'terminal' 2array choice ; + +DEFER: 'choice' + +: 'group' ( -- parser ) + "(" token sp hide + [ 'choice' sp ] delay + ")" token sp hide + 3array seq [ first ] action ; + +: 'repeat0' ( -- parser ) + "{" token sp hide + [ 'choice' sp ] delay + "}" token sp hide + 3array seq [ first ] action ; + +: 'optional' ( -- parser ) + "[" token sp hide + [ 'choice' sp ] delay + "]" token sp hide + 3array seq [ first ] action ; + +: 'sequence' ( -- parser ) + [ + 'element' sp , + 'group' sp , + 'repeat0' sp , + 'optional' sp , + ] { } make choice + repeat1 [ + dup length 1 = [ first ] [ ] if + ] action ; + +: 'choice' ( -- parser ) + 'sequence' sp "|" token sp list-of [ + dup length 1 = [ first ] [ ] if + ] action ; + +: 'action' ( -- parser ) + "=>" token hide + [ blank? ] satisfy ensure-not [ drop t ] satisfy 2array seq [ first ] action repeat1 [ >string ] action sp + 2array seq [ first ] action ; + +: 'rhs' ( -- parser ) + 'choice' 'action' sp optional 2array seq ; + +: 'rule' ( -- parser ) + 'non-terminal' [ ebnf-non-terminal-symbol ] action + "=" token sp hide + 'rhs' + 3array seq [ first2 ] action ; + +: 'ebnf' ( -- parser ) + 'rule' sp "." token sp hide list-of [ ] action ; + +: ebnf>quot ( string -- quot ) + 'ebnf' parse [ + parse-result-ast [ + reset-parser-generation + generate-parser drop + [ + non-terminals get + [ + get-parser [ + swap , \ in , \ get , \ create , + 1quotation , \ define , + ] [ + drop + ] if* + ] assoc-each + ] [ ] make + ] with-scope + ] [ + f + ] if* ; + : " parse-tokens " " join ebnf>quot call ; parsing \ No newline at end of file diff --git a/extra/peg/peg-docs.factor b/extra/peg/peg-docs.factor index 41463d85a0..6dff95c829 100644 --- a/extra/peg/peg-docs.factor +++ b/extra/peg/peg-docs.factor @@ -1,142 +1,143 @@ -! Copyright (C) 2007 Chris Double. -! See http://factorcode.org/license.txt for BSD license. -USING: help.markup help.syntax peg ; - -HELP: parse -{ $values - { "input" "a string" } - { "parser" "a parser" } - { "result" "a parse-result or f" } -} -{ $description - "Given the input string, parse it using the given parser. The result is a object if " - "the parse was successful, otherwise it is f." } ; - -HELP: token -{ $values - { "string" "a string" } - { "parser" "a parser" } -} -{ $description - "Returns a parser that matches the given string." } ; - -HELP: satisfy -{ $values - { "quot" "a quotation" } - { "parser" "a parser" } -} -{ $description - "Returns a parser that calls the quotation on the first character of the input string, " - "succeeding if that quotation returns true. The AST is the character from the string." } ; - -HELP: range -{ $values - { "min" "a character" } - { "max" "a character" } - { "parser" "a parser" } -} -{ $description - "Returns a parser that matches a single character that lies within the range of characters given, inclusive." } -{ $examples { $code ": digit ( -- parser ) CHAR: 0 CHAR: 9 range ;" } } ; - -HELP: seq -{ $values - { "seq" "a sequence of parsers" } - { "parser" "a parser" } -} -{ $description - "Returns a parser that calls all parsers in the given sequence, in order. The parser succeeds if " - "all the parsers succeed, otherwise it fails. The AST produced is a sequence of the AST produced by " - "the individual parsers." } ; - -HELP: choice -{ $values - { "seq" "a sequence of parsers" } - { "parser" "a parser" } -} -{ $description - "Returns a parser that will try all the parsers in the sequence, in order, until one succeeds. " - "The resulting AST is that produced by the successful parser." } ; - -HELP: repeat0 -{ $values - { "parser" "a parser" } -} -{ $description - "Returns a parser that parses 0 or more instances of the 'p1' parser. The AST produced is " - "an array of the AST produced by the 'p1' parser. An empty array indicates 0 instances were " - "parsed." } ; - -HELP: repeat1 -{ $values - { "parser" "a parser" } -} -{ $description - "Returns a parser that parses 1 or more instances of the 'p1' parser. The AST produced is " - "an array of the AST produced by the 'p1' parser." } ; - -HELP: optional -{ $values - { "parser" "a parser" } -} -{ $description - "Returns a parser that parses 0 or 1 instances of the 'p1' parser. The AST produced is " - "'f' if 0 instances are parsed the AST produced is 'f', otherwise it is the AST produced by 'p1'." } ; - -HELP: ensure -{ $values - { "parser" "a parser" } -} -{ $description - "Returns a parser that succeeds if the 'p1' parser succeeds but does not add anything to the " - "AST and does not move the location in the input string. This can be used for lookahead and " - "disambiguation, along with the " { $link ensure-not } " word." } -{ $examples { $code "\"0\" token ensure octal-parser" } } ; - -HELP: ensure-not -{ $values - { "parser" "a parser" } -} -{ $description - "Returns a parser that succeeds if the 'p1' parser fails but does not add anything to the " - "AST and does not move the location in the input string. This can be used for lookahead and " - "disambiguation, along with the " { $link ensure } " word." } -{ $code "\"+\" token \"=\" token ensure-not \"+=\" token 3array seq" } ; - -HELP: action -{ $values - { "parser" "a parser" } - { "quot" "a quotation with stack effect ( ast -- ast )" } -} -{ $description - "Returns a parser that calls the 'p1' parser and applies the quotation to the AST resulting " - "from that parse. The result of the quotation is then used as the final AST. This can be used " - "for manipulating the parse tree to produce a AST better suited for the task at hand rather than " - "the default AST." } -{ $code "CHAR: 0 CHAR: 9 range [ to-digit ] action" } ; - -HELP: sp -{ $values - { "parser" "a parser" } -} -{ $description - "Returns a parser that calls the original parser 'p1' after stripping any whitespace " - " from the left of the input string." } ; - -HELP: hide -{ $values - { "parser" "a parser" } -} -{ $description - "Returns a parser that succeeds if the original parser succeeds, but does not " - "put any result in the AST. Useful for ignoring 'syntax' in the AST." } -{ $code "\"[\" token hide number \"]\" token hide 3array seq" } ; - -HELP: delay -{ $values - { "parser" "a parser" } -} -{ $description - "Delays the construction of a parser until it is actually required to parse. This " - "allows for calling a parser that results in a recursive call to itself. The quotation " +! Copyright (C) 2007 Chris Double. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax ; +IN: peg + +HELP: parse +{ $values + { "input" "a string" } + { "parser" "a parser" } + { "result" "a parse-result or f" } +} +{ $description + "Given the input string, parse it using the given parser. The result is a object if " + "the parse was successful, otherwise it is f." } ; + +HELP: token +{ $values + { "string" "a string" } + { "parser" "a parser" } +} +{ $description + "Returns a parser that matches the given string." } ; + +HELP: satisfy +{ $values + { "quot" "a quotation" } + { "parser" "a parser" } +} +{ $description + "Returns a parser that calls the quotation on the first character of the input string, " + "succeeding if that quotation returns true. The AST is the character from the string." } ; + +HELP: range +{ $values + { "min" "a character" } + { "max" "a character" } + { "parser" "a parser" } +} +{ $description + "Returns a parser that matches a single character that lies within the range of characters given, inclusive." } +{ $examples { $code ": digit ( -- parser ) CHAR: 0 CHAR: 9 range ;" } } ; + +HELP: seq +{ $values + { "seq" "a sequence of parsers" } + { "parser" "a parser" } +} +{ $description + "Returns a parser that calls all parsers in the given sequence, in order. The parser succeeds if " + "all the parsers succeed, otherwise it fails. The AST produced is a sequence of the AST produced by " + "the individual parsers." } ; + +HELP: choice +{ $values + { "seq" "a sequence of parsers" } + { "parser" "a parser" } +} +{ $description + "Returns a parser that will try all the parsers in the sequence, in order, until one succeeds. " + "The resulting AST is that produced by the successful parser." } ; + +HELP: repeat0 +{ $values + { "parser" "a parser" } +} +{ $description + "Returns a parser that parses 0 or more instances of the 'p1' parser. The AST produced is " + "an array of the AST produced by the 'p1' parser. An empty array indicates 0 instances were " + "parsed." } ; + +HELP: repeat1 +{ $values + { "parser" "a parser" } +} +{ $description + "Returns a parser that parses 1 or more instances of the 'p1' parser. The AST produced is " + "an array of the AST produced by the 'p1' parser." } ; + +HELP: optional +{ $values + { "parser" "a parser" } +} +{ $description + "Returns a parser that parses 0 or 1 instances of the 'p1' parser. The AST produced is " + "'f' if 0 instances are parsed the AST produced is 'f', otherwise it is the AST produced by 'p1'." } ; + +HELP: ensure +{ $values + { "parser" "a parser" } +} +{ $description + "Returns a parser that succeeds if the 'p1' parser succeeds but does not add anything to the " + "AST and does not move the location in the input string. This can be used for lookahead and " + "disambiguation, along with the " { $link ensure-not } " word." } +{ $examples { $code "\"0\" token ensure octal-parser" } } ; + +HELP: ensure-not +{ $values + { "parser" "a parser" } +} +{ $description + "Returns a parser that succeeds if the 'p1' parser fails but does not add anything to the " + "AST and does not move the location in the input string. This can be used for lookahead and " + "disambiguation, along with the " { $link ensure } " word." } +{ $code "\"+\" token \"=\" token ensure-not \"+=\" token 3array seq" } ; + +HELP: action +{ $values + { "parser" "a parser" } + { "quot" "a quotation with stack effect ( ast -- ast )" } +} +{ $description + "Returns a parser that calls the 'p1' parser and applies the quotation to the AST resulting " + "from that parse. The result of the quotation is then used as the final AST. This can be used " + "for manipulating the parse tree to produce a AST better suited for the task at hand rather than " + "the default AST." } +{ $code "CHAR: 0 CHAR: 9 range [ to-digit ] action" } ; + +HELP: sp +{ $values + { "parser" "a parser" } +} +{ $description + "Returns a parser that calls the original parser 'p1' after stripping any whitespace " + " from the left of the input string." } ; + +HELP: hide +{ $values + { "parser" "a parser" } +} +{ $description + "Returns a parser that succeeds if the original parser succeeds, but does not " + "put any result in the AST. Useful for ignoring 'syntax' in the AST." } +{ $code "\"[\" token hide number \"]\" token hide 3array seq" } ; + +HELP: delay +{ $values + { "parser" "a parser" } +} +{ $description + "Delays the construction of a parser until it is actually required to parse. This " + "allows for calling a parser that results in a recursive call to itself. The quotation " "should return the constructed parser." } ; \ No newline at end of file diff --git a/extra/visitor/authors.txt b/extra/visitor/authors.txt deleted file mode 100644 index f990dd0ed2..0000000000 --- a/extra/visitor/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Daniel Ehrenberg diff --git a/extra/visitor/summary.txt b/extra/visitor/summary.txt deleted file mode 100644 index 3093ae9a9c..0000000000 --- a/extra/visitor/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Double-dispatch generic words diff --git a/extra/visitor/tags.txt b/extra/visitor/tags.txt deleted file mode 100644 index f4274299b1..0000000000 --- a/extra/visitor/tags.txt +++ /dev/null @@ -1 +0,0 @@ -extensions diff --git a/extra/visitor/visitor-tests.factor b/extra/visitor/visitor-tests.factor deleted file mode 100644 index 8248affaf7..0000000000 --- a/extra/visitor/visitor-tests.factor +++ /dev/null @@ -1,18 +0,0 @@ -USING: visitor math sequences math.parser strings tools.test kernel ; - -VISITOR: ++ ( object object -- object ) -! acts like +, coercing string arguments to a number, unless both arguments are strings, in which case it appends them - -V: number string ++ - string>number + ; -V: string number ++ - >r string>number r> + ; -V: number number ++ - + ; -V: string string ++ - append ; - -[ 3 ] [ 1 2 ++ ] unit-test -[ 3 ] [ "1" 2 ++ ] unit-test -[ 3 ] [ 1 "2" ++ ] unit-test -[ "12" ] [ "1" "2" ++ ] unit-test diff --git a/extra/visitor/visitor.factor b/extra/visitor/visitor.factor deleted file mode 100644 index 10c9fb8717..0000000000 --- a/extra/visitor/visitor.factor +++ /dev/null @@ -1,63 +0,0 @@ -USING: kernel generic.standard syntax words parser assocs -generic quotations sequences effects arrays classes definitions -prettyprint sorting prettyprint.backend shuffle ; -IN: visitor - -: define-visitor ( word -- ) - dup dup reset-word define-simple-generic - dup H{ } clone "visitor-methods" set-word-prop - H{ } clone "visitors" set-word-prop ; - -: VISITOR: - CREATE define-visitor ; parsing - -: record-visitor ( top-class generic method-word -- ) - swap "visitors" word-prop swapd set-at ; - -: define-1generic ( word -- ) - 1 define-generic ; - -: copy-effect ( from to -- ) - swap stack-effect "declared-effect" set-word-prop ; - -: new-vmethod ( method bottom-class top-class generic -- ) - gensym dup define-1generic - 2dup copy-effect - 3dup 1quotation -rot define-method - [ record-visitor ] keep - define-method ; - -: define-visitor-method ( method bottom-class top-class generic -- ) - 4dup >r 2array r> "visitor-methods" word-prop set-at - 2dup "visitors" word-prop at - [ nip define-method ] [ new-vmethod ] ?if ; - -: V: - ! syntax: V: bottom-class top-class generic body... ; - f set-word scan-word scan-word scan-word - parse-definition -roll define-visitor-method ; parsing - -! see instance: -! see must be redone because "methods" doesn't show methods - -PREDICATE: standard-generic visitor "visitors" word-prop ; -PREDICATE: array triple length 3 = ; -PREDICATE: triple visitor-spec - first3 visitor? >r [ class? ] both? r> and ; - -M: visitor-spec definer drop \ V: \ ; ; -M: visitor definer drop \ VISITOR: f ; - -M: visitor-spec synopsis* - ! same as method-spec#synopsis* - dup definer drop pprint-word - [ pprint-word ] each ; - -M: visitor-spec definition - first3 >r 2array r> "visitor-methods" word-prop at ; - -M: visitor see - dup (see) - dup see-class - dup "visitor-methods" word-prop keys natural-sort swap - [ >r first2 r> 3array ] curry map see-all ;