65 lines
1.8 KiB
Factor
65 lines
1.8 KiB
Factor
USING: hashtables assocs sequences locals math accessors multiline delegate strings
|
|
delegate.protocols kernel peg peg.ebnf peg.private lexer namespaces combinators parser
|
|
words ;
|
|
IN: peg-lexer
|
|
|
|
TUPLE: lex-hash hash ;
|
|
CONSULT: assoc-protocol lex-hash hash>> ;
|
|
: <lex-hash> ( a -- lex-hash ) lex-hash boa ;
|
|
|
|
: 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 +
|
|
] ;
|
|
|
|
: store-pos ( v a -- )
|
|
input of prepare-pos
|
|
lexer get [ line<< ] keep column<< ;
|
|
|
|
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 {
|
|
{ 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 ;
|
|
|
|
: with-global-lexer ( quot -- result )
|
|
[
|
|
f lrstack set
|
|
V{ } clone error-stack set H{ } clone \ heads set
|
|
H{ } clone \ packrat set
|
|
] f make-assoc <lex-hash>
|
|
swap bind ; inline
|
|
|
|
: parse* ( parser -- ast )
|
|
compile
|
|
[ execute [ error-stack get first throw ] unless* ] with-global-lexer
|
|
ast>> ; inline
|
|
|
|
: create-bnf ( name parser -- )
|
|
reset-tokenizer [ lexer get skip-blank parse* dup ignore? [ drop ] [ parsed ] if ] curry
|
|
define-syntax word make-inline ;
|
|
|
|
SYNTAX: ON-BNF:
|
|
scan-new-word reset-tokenizer ";ON-BNF" parse-multiline-string parse-ebnf
|
|
main of create-bnf ;
|
|
|
|
! Tokenizer like standard factor lexer
|
|
EBNF: factor
|
|
space = " " | "\n" | "\t"
|
|
spaces = space* => [[ drop ignore ]]
|
|
chunk = (!(space) .)+ => [[ >string ]]
|
|
expr = spaces chunk
|
|
;EBNF
|