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

Merge git://double.co.nz/git/factor

db4
Slava Pestov 2008-03-25 22:34:05 -05:00
parent 2f73edb3a2 de3e4e049f
commit 5319ba1ae1
2 changed files with 45 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3,7 +3,7 @@
USING: kernel compiler.units parser words arrays strings math.parser sequences USING: kernel compiler.units parser words arrays strings math.parser sequences
quotations vectors namespaces math assocs continuations peg quotations vectors namespaces math assocs continuations peg
peg.parsers unicode.categories multiline combinators.lib peg.parsers unicode.categories multiline combinators.lib
splitting ; splitting accessors ;
IN: peg.ebnf IN: peg.ebnf
TUPLE: ebnf-non-terminal symbol ; TUPLE: ebnf-non-terminal symbol ;
@ -16,7 +16,7 @@ TUPLE: ebnf-choice options ;
TUPLE: ebnf-sequence elements ; TUPLE: ebnf-sequence elements ;
TUPLE: ebnf-repeat0 group ; TUPLE: ebnf-repeat0 group ;
TUPLE: ebnf-repeat1 group ; TUPLE: ebnf-repeat1 group ;
TUPLE: ebnf-optional elements ; TUPLE: ebnf-optional group ;
TUPLE: ebnf-rule symbol elements ; TUPLE: ebnf-rule symbol elements ;
TUPLE: ebnf-action parser code ; TUPLE: ebnf-action parser code ;
TUPLE: ebnf rules ; TUPLE: ebnf rules ;
@ -198,7 +198,7 @@ DEFER: 'choice'
: 'rule' ( -- parser ) : 'rule' ( -- parser )
[ [
'non-terminal' [ ebnf-non-terminal-symbol ] action , 'non-terminal' [ symbol>> ] action ,
"=" syntax , "=" syntax ,
'choice' , 'choice' ,
] seq* [ first2 <ebnf-rule> ] action ; ] seq* [ first2 <ebnf-rule> ] action ;
@ -215,49 +215,53 @@ SYMBOL: main
H{ } clone dup dup [ parser set swap (transform) main set ] bind ; H{ } clone dup dup [ parser set swap (transform) main set ] bind ;
M: ebnf (transform) ( ast -- parser ) M: ebnf (transform) ( ast -- parser )
ebnf-rules [ (transform) ] map peek ; rules>> [ (transform) ] map peek ;
M: ebnf-rule (transform) ( ast -- parser ) M: ebnf-rule (transform) ( ast -- parser )
dup ebnf-rule-elements (transform) [ dup elements>> (transform) [
swap ebnf-rule-symbol set swap symbol>> set
] keep ; ] keep ;
M: ebnf-sequence (transform) ( ast -- parser ) M: ebnf-sequence (transform) ( ast -- parser )
ebnf-sequence-elements [ (transform) ] map seq ; elements>> [ (transform) ] map seq ;
M: ebnf-choice (transform) ( ast -- parser ) M: ebnf-choice (transform) ( ast -- parser )
ebnf-choice-options [ (transform) ] map choice ; options>> [ (transform) ] map choice ;
M: ebnf-any-character (transform) ( ast -- parser ) M: ebnf-any-character (transform) ( ast -- parser )
drop any-char ; drop any-char ;
M: ebnf-range (transform) ( ast -- parser ) M: ebnf-range (transform) ( ast -- parser )
ebnf-range-pattern range-pattern ; pattern>> range-pattern ;
: transform-group ( ast -- parser )
#! convert a ast node with groups to a parser for that group
group>> (transform) ;
M: ebnf-ensure (transform) ( ast -- parser ) M: ebnf-ensure (transform) ( ast -- parser )
ebnf-ensure-group (transform) ensure ; transform-group ensure ;
M: ebnf-ensure-not (transform) ( ast -- parser ) M: ebnf-ensure-not (transform) ( ast -- parser )
ebnf-ensure-not-group (transform) ensure-not ; transform-group ensure-not ;
M: ebnf-repeat0 (transform) ( ast -- parser ) M: ebnf-repeat0 (transform) ( ast -- parser )
ebnf-repeat0-group (transform) repeat0 ; transform-group repeat0 ;
M: ebnf-repeat1 (transform) ( ast -- parser ) M: ebnf-repeat1 (transform) ( ast -- parser )
ebnf-repeat1-group (transform) repeat1 ; transform-group repeat1 ;
M: ebnf-optional (transform) ( ast -- parser ) M: ebnf-optional (transform) ( ast -- parser )
ebnf-optional-elements (transform) optional ; transform-group optional ;
M: ebnf-action (transform) ( ast -- parser ) M: ebnf-action (transform) ( ast -- parser )
[ ebnf-action-parser (transform) ] keep [ parser>> (transform) ] keep
ebnf-action-code string-lines [ parse-lines ] with-compilation-unit action ; code>> string-lines [ parse-lines ] with-compilation-unit action ;
M: ebnf-terminal (transform) ( ast -- parser ) M: ebnf-terminal (transform) ( ast -- parser )
ebnf-terminal-symbol token sp ; symbol>> token sp ;
M: ebnf-non-terminal (transform) ( ast -- parser ) M: ebnf-non-terminal (transform) ( ast -- parser )
ebnf-non-terminal-symbol [ symbol>> [
, parser get , \ at , , parser get , \ at ,
] [ ] make delay sp ; ] [ ] make delay sp ;

46
extra/peg/peg.factor
View File

@ -3,7 +3,7 @@
USING: kernel sequences strings namespaces math assocs shuffle USING: kernel sequences strings namespaces math assocs shuffle
vectors arrays combinators.lib math.parser match vectors arrays combinators.lib math.parser match
unicode.categories sequences.lib compiler.units parser unicode.categories sequences.lib compiler.units parser
words quotations effects memoize ; words quotations effects memoize accessors combinators.cleave ;
IN: peg IN: peg
TUPLE: parse-result remaining ast ; TUPLE: parse-result remaining ast ;
@ -52,7 +52,7 @@ MATCH-VARS: ?token ;
] if ; ] if ;
M: token-parser (compile) ( parser -- quot ) M: token-parser (compile) ( parser -- quot )
token-parser-symbol [ parse-token ] curry ; symbol>> [ parse-token ] curry ;
TUPLE: satisfy-parser quot ; TUPLE: satisfy-parser quot ;
@ -72,7 +72,7 @@ MATCH-VARS: ?quot ;
] ; ] ;
M: satisfy-parser (compile) ( parser -- quot ) M: satisfy-parser (compile) ( parser -- quot )
satisfy-parser-quot \ ?quot satisfy-pattern match-replace ; quot>> \ ?quot satisfy-pattern match-replace ;
TUPLE: range-parser min max ; TUPLE: range-parser min max ;
@ -100,12 +100,12 @@ TUPLE: seq-parser parsers ;
: seq-pattern ( -- quot ) : seq-pattern ( -- quot )
[ [
dup [ dup [
dup parse-result-remaining ?quot [ dup remaining>> ?quot [
[ parse-result-remaining swap set-parse-result-remaining ] 2keep [ remaining>> swap (>>remaining) ] 2keep
parse-result-ast dup ignore = [ ast>> dup ignore = [
drop drop
] [ ] [
swap [ parse-result-ast push ] keep swap [ ast>> push ] keep
] if ] if
] [ ] [
drop f drop f
@ -118,7 +118,7 @@ TUPLE: seq-parser parsers ;
M: seq-parser (compile) ( parser -- quot ) M: seq-parser (compile) ( parser -- quot )
[ [
[ V{ } clone <parse-result> ] % [ V{ } clone <parse-result> ] %
seq-parser-parsers [ compiled-parser \ ?quot seq-pattern match-replace % ] each parsers>> [ compiled-parser \ ?quot seq-pattern match-replace % ] each
] [ ] make ; ] [ ] make ;
TUPLE: choice-parser parsers ; TUPLE: choice-parser parsers ;
@ -135,16 +135,16 @@ TUPLE: choice-parser parsers ;
M: choice-parser (compile) ( parser -- quot ) M: choice-parser (compile) ( parser -- quot )
[ [
f , f ,
choice-parser-parsers [ compiled-parser \ ?quot choice-pattern match-replace % ] each parsers>> [ compiled-parser \ ?quot choice-pattern match-replace % ] each
\ nip , \ nip ,
] [ ] make ; ] [ ] make ;
TUPLE: repeat0-parser p1 ; TUPLE: repeat0-parser p1 ;
: (repeat0) ( quot result -- result ) : (repeat0) ( quot result -- result )
2dup parse-result-remaining swap call [ 2dup remaining>> swap call [
[ parse-result-remaining swap set-parse-result-remaining ] 2keep [ remaining>> swap (>>remaining) ] 2keep
parse-result-ast swap [ parse-result-ast push ] keep ast>> swap [ ast>> push ] keep
(repeat0) (repeat0)
] [ ] [
nip nip
@ -158,7 +158,7 @@ TUPLE: repeat0-parser p1 ;
M: repeat0-parser (compile) ( parser -- quot ) M: repeat0-parser (compile) ( parser -- quot )
[ [
[ V{ } clone <parse-result> ] % [ V{ } clone <parse-result> ] %
repeat0-parser-p1 compiled-parser \ ?quot repeat0-pattern match-replace % p1>> compiled-parser \ ?quot repeat0-pattern match-replace %
] [ ] make ; ] [ ] make ;
TUPLE: repeat1-parser p1 ; TUPLE: repeat1-parser p1 ;
@ -166,7 +166,7 @@ TUPLE: repeat1-parser p1 ;
: repeat1-pattern ( -- quot ) : repeat1-pattern ( -- quot )
[ [
[ ?quot ] swap (repeat0) [ [ ?quot ] swap (repeat0) [
dup parse-result-ast empty? [ dup ast>> empty? [
drop f drop f
] when ] when
] [ ] [
@ -177,7 +177,7 @@ TUPLE: repeat1-parser p1 ;
M: repeat1-parser (compile) ( parser -- quot ) M: repeat1-parser (compile) ( parser -- quot )
[ [
[ V{ } clone <parse-result> ] % [ V{ } clone <parse-result> ] %
repeat1-parser-p1 compiled-parser \ ?quot repeat1-pattern match-replace % p1>> compiled-parser \ ?quot repeat1-pattern match-replace %
] [ ] make ; ] [ ] make ;
TUPLE: optional-parser p1 ; TUPLE: optional-parser p1 ;
@ -188,7 +188,7 @@ TUPLE: optional-parser p1 ;
] ; ] ;
M: optional-parser (compile) ( parser -- quot ) M: optional-parser (compile) ( parser -- quot )
optional-parser-p1 compiled-parser \ ?quot optional-pattern match-replace ; p1>> compiled-parser \ ?quot optional-pattern match-replace ;
TUPLE: ensure-parser p1 ; TUPLE: ensure-parser p1 ;
@ -202,7 +202,7 @@ TUPLE: ensure-parser p1 ;
] ; ] ;
M: ensure-parser (compile) ( parser -- quot ) M: ensure-parser (compile) ( parser -- quot )
ensure-parser-p1 compiled-parser \ ?quot ensure-pattern match-replace ; p1>> compiled-parser \ ?quot ensure-pattern match-replace ;
TUPLE: ensure-not-parser p1 ; TUPLE: ensure-not-parser p1 ;
@ -216,7 +216,7 @@ TUPLE: ensure-not-parser p1 ;
] ; ] ;
M: ensure-not-parser (compile) ( parser -- quot ) M: ensure-not-parser (compile) ( parser -- quot )
ensure-not-parser-p1 compiled-parser \ ?quot ensure-not-pattern match-replace ; p1>> compiled-parser \ ?quot ensure-not-pattern match-replace ;
TUPLE: action-parser p1 quot ; TUPLE: action-parser p1 quot ;
@ -225,13 +225,13 @@ MATCH-VARS: ?action ;
: action-pattern ( -- quot ) : action-pattern ( -- quot )
[ [
?quot dup [ ?quot dup [
dup parse-result-ast ?action call dup ast>> ?action call
swap [ set-parse-result-ast ] keep >>ast
] when ] when
] ; ] ;
M: action-parser (compile) ( parser -- quot ) M: action-parser (compile) ( parser -- quot )
{ action-parser-p1 action-parser-quot } get-slots [ compiled-parser ] dip { [ p1>> ] [ quot>> ] } cleave [ compiled-parser ] dip
2array { ?quot ?action } action-pattern match-replace ; 2array { ?quot ?action } action-pattern match-replace ;
: left-trim-slice ( string -- string ) : left-trim-slice ( string -- string )
@ -245,7 +245,7 @@ TUPLE: sp-parser p1 ;
M: sp-parser (compile) ( parser -- quot ) M: sp-parser (compile) ( parser -- quot )
[ [
\ left-trim-slice , sp-parser-p1 compiled-parser , \ left-trim-slice , p1>> compiled-parser ,
] [ ] make ; ] [ ] make ;
TUPLE: delay-parser quot ; TUPLE: delay-parser quot ;
@ -255,7 +255,7 @@ M: delay-parser (compile) ( parser -- quot )
#! This way it is run only once and the #! This way it is run only once and the
#! parser constructed once at run time. #! parser constructed once at run time.
[ [
delay-parser-quot % \ compile , quot>> % \ compile ,
] [ ] make ] [ ] make
{ } { "word" } <effect> memoize-quot { } { "word" } <effect> memoize-quot
[ % \ execute , ] [ ] make ; [ % \ execute , ] [ ] make ;