steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge git://factorcode.org/git/factor

db4
Doug Coleman 2008-01-13 07:52:24 -10:00
parent 0613d01fcc 240217f39e
commit 7d6cb82b11
7 changed files with 325 additions and 408 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

366
extra/peg/ebnf/ebnf.factor
View File

@ -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> ebnf-non-terminal
C: <ebnf-terminal> ebnf-terminal
C: <ebnf-choice> ebnf-choice
C: <ebnf-sequence> ebnf-sequence
C: <ebnf-repeat0> ebnf-repeat0
C: <ebnf-optional> ebnf-optional
C: <ebnf-rule> ebnf-rule
C: <ebnf-action> ebnf-action
C: <ebnf> 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 <ebnf-non-terminal> ] action ;
: 'terminal' ( -- parser )
"'" token hide [ CHAR: ' = not ] satisfy repeat1 "'" token hide 3array seq [ first >string <ebnf-terminal> ] 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 <ebnf-repeat0> ] action ;
: 'optional' ( -- parser )
"[" token sp hide
[ 'choice' sp ] delay
"]" token sp hide
3array seq [ first <ebnf-optional> ] action ;
: 'sequence' ( -- parser )
[
'element' sp ,
'group' sp ,
'repeat0' sp ,
'optional' sp ,
] { } make choice
repeat1 [
dup length 1 = [ first ] [ <ebnf-sequence> ] if
] action ;
: 'choice' ( -- parser )
'sequence' sp "|" token sp list-of [
dup length 1 = [ first ] [ <ebnf-choice> ] if
] action ;
: 'action' ( -- parser )
"=>" token hide
[ blank? ] satisfy ensure-not [ drop t ] satisfy 2array seq [ first ] action repeat1 [ >string ] action sp
2array seq [ first <ebnf-action> ] 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 <ebnf-rule> ] action ;
: 'ebnf' ( -- parser )
'rule' sp "." token sp hide list-of [ <ebnf> ] 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> ebnf-non-terminal
C: <ebnf-terminal> ebnf-terminal
C: <ebnf-choice> ebnf-choice
C: <ebnf-sequence> ebnf-sequence
C: <ebnf-repeat0> ebnf-repeat0
C: <ebnf-optional> ebnf-optional
C: <ebnf-rule> ebnf-rule
C: <ebnf-action> ebnf-action
C: <ebnf> 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 <ebnf-non-terminal> ] action ;
: 'terminal' ( -- parser )
"'" token hide [ CHAR: ' = not ] satisfy repeat1 "'" token hide 3array seq [ first >string <ebnf-terminal> ] 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 <ebnf-repeat0> ] action ;
: 'optional' ( -- parser )
"[" token sp hide
[ 'choice' sp ] delay
"]" token sp hide
3array seq [ first <ebnf-optional> ] action ;
: 'sequence' ( -- parser )
[
'element' sp ,
'group' sp ,
'repeat0' sp ,
'optional' sp ,
] { } make choice
repeat1 [
dup length 1 = [ first ] [ <ebnf-sequence> ] if
] action ;
: 'choice' ( -- parser )
'sequence' sp "|" token sp list-of [
dup length 1 = [ first ] [ <ebnf-choice> ] if
] action ;
: 'action' ( -- parser )
"=>" token hide
[ blank? ] satisfy ensure-not [ drop t ] satisfy 2array seq [ first ] action repeat1 [ >string ] action sp
2array seq [ first <ebnf-action> ] 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 <ebnf-rule> ] action ;
: 'ebnf' ( -- parser )
'rule' sp "." token sp hide list-of [ <ebnf> ] 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* ;
: <EBNF "EBNF>" parse-tokens " " join ebnf>quot call ; parsing

283
extra/peg/peg-docs.factor
View File

@ -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 <parse-result> 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 <parse-result> 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." } ;

1
extra/visitor/authors.txt
View File

@ -1 +0,0 @@
Daniel Ehrenberg

1
extra/visitor/summary.txt
View File

@ -1 +0,0 @@
Double-dispatch generic words

1
extra/visitor/tags.txt
View File

@ -1 +0,0 @@
extensions

18
extra/visitor/visitor-tests.factor
View File

@ -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

63
extra/visitor/visitor.factor
View File

@ -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 <standard-combination> 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 ;