Merge commit 'doublec/master'
commit
e078fc2b2b
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2007 Chris Double.
|
! Copyright (C) 2007 Chris Double.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel sequences strings namespaces math assocs shuffle
|
USING: kernel sequences strings namespaces math assocs shuffle
|
||||||
vectors arrays combinators.lib ;
|
vectors arrays combinators.lib memoize ;
|
||||||
IN: peg
|
IN: peg
|
||||||
|
|
||||||
TUPLE: parse-result remaining ast ;
|
TUPLE: parse-result remaining ast ;
|
||||||
|
@ -12,6 +12,10 @@ GENERIC: (parse) ( state parser -- result )
|
||||||
|
|
||||||
SYMBOL: packrat-cache
|
SYMBOL: packrat-cache
|
||||||
SYMBOL: ignore
|
SYMBOL: ignore
|
||||||
|
SYMBOL: not-in-cache
|
||||||
|
|
||||||
|
: not-in-cache? ( result -- ? )
|
||||||
|
not-in-cache = ;
|
||||||
|
|
||||||
: <parse-result> ( remaining ast -- parse-result )
|
: <parse-result> ( remaining ast -- parse-result )
|
||||||
parse-result construct-boa ;
|
parse-result construct-boa ;
|
||||||
|
@ -30,7 +34,9 @@ TUPLE: parser id ;
|
||||||
dup slice? [ slice-from ] [ drop 0 ] if ;
|
dup slice? [ slice-from ] [ drop 0 ] if ;
|
||||||
|
|
||||||
: get-cached ( input parser -- result )
|
: get-cached ( input parser -- result )
|
||||||
[ from ] dip parser-id packrat-cache get at at ;
|
[ from ] dip parser-id packrat-cache get at at* [
|
||||||
|
drop not-in-cache
|
||||||
|
] unless ;
|
||||||
|
|
||||||
: put-cached ( result input parser -- )
|
: put-cached ( result input parser -- )
|
||||||
parser-id dup packrat-cache get at [
|
parser-id dup packrat-cache get at [
|
||||||
|
@ -44,9 +50,17 @@ PRIVATE>
|
||||||
|
|
||||||
: parse ( input parser -- result )
|
: parse ( input parser -- result )
|
||||||
packrat-cache get [
|
packrat-cache get [
|
||||||
2dup get-cached [
|
2dup get-cached dup not-in-cache? [
|
||||||
|
! "cache missed: " write over parser-id number>string write " - " write nl ! pick .
|
||||||
|
drop
|
||||||
|
#! Protect against left recursion blowing the callstack
|
||||||
|
#! by storing a failed parse in the cache.
|
||||||
|
[ f ] dipd [ put-cached ] 2keep
|
||||||
[ (parse) dup ] 2keep put-cached
|
[ (parse) dup ] 2keep put-cached
|
||||||
] unless*
|
] [
|
||||||
|
! "cache hit: " write over parser-id number>string write " - " write nl ! pick .
|
||||||
|
2nip
|
||||||
|
] if
|
||||||
] [
|
] [
|
||||||
(parse)
|
(parse)
|
||||||
] if ;
|
] if ;
|
||||||
|
@ -207,13 +221,13 @@ M: delay-parser (parse) ( state parser -- result )
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: token ( string -- parser )
|
MEMO: token ( string -- parser )
|
||||||
token-parser construct-boa init-parser ;
|
token-parser construct-boa init-parser ;
|
||||||
|
|
||||||
: satisfy ( quot -- parser )
|
: satisfy ( quot -- parser )
|
||||||
satisfy-parser construct-boa init-parser ;
|
satisfy-parser construct-boa init-parser ;
|
||||||
|
|
||||||
: range ( min max -- parser )
|
MEMO: range ( min max -- parser )
|
||||||
range-parser construct-boa init-parser ;
|
range-parser construct-boa init-parser ;
|
||||||
|
|
||||||
: seq ( seq -- parser )
|
: seq ( seq -- parser )
|
||||||
|
@ -222,32 +236,32 @@ PRIVATE>
|
||||||
: choice ( seq -- parser )
|
: choice ( seq -- parser )
|
||||||
choice-parser construct-boa init-parser ;
|
choice-parser construct-boa init-parser ;
|
||||||
|
|
||||||
: repeat0 ( parser -- parser )
|
MEMO: repeat0 ( parser -- parser )
|
||||||
repeat0-parser construct-boa init-parser ;
|
repeat0-parser construct-boa init-parser ;
|
||||||
|
|
||||||
: repeat1 ( parser -- parser )
|
MEMO: repeat1 ( parser -- parser )
|
||||||
repeat1-parser construct-boa init-parser ;
|
repeat1-parser construct-boa init-parser ;
|
||||||
|
|
||||||
: optional ( parser -- parser )
|
MEMO: optional ( parser -- parser )
|
||||||
optional-parser construct-boa init-parser ;
|
optional-parser construct-boa init-parser ;
|
||||||
|
|
||||||
: ensure ( parser -- parser )
|
MEMO: ensure ( parser -- parser )
|
||||||
ensure-parser construct-boa init-parser ;
|
ensure-parser construct-boa init-parser ;
|
||||||
|
|
||||||
: ensure-not ( parser -- parser )
|
MEMO: ensure-not ( parser -- parser )
|
||||||
ensure-not-parser construct-boa init-parser ;
|
ensure-not-parser construct-boa init-parser ;
|
||||||
|
|
||||||
: action ( parser quot -- parser )
|
: action ( parser quot -- parser )
|
||||||
action-parser construct-boa init-parser ;
|
action-parser construct-boa init-parser ;
|
||||||
|
|
||||||
: sp ( parser -- parser )
|
MEMO: sp ( parser -- parser )
|
||||||
sp-parser construct-boa init-parser ;
|
sp-parser construct-boa init-parser ;
|
||||||
|
|
||||||
: hide ( parser -- parser )
|
MEMO: hide ( parser -- parser )
|
||||||
[ drop ignore ] action ;
|
[ drop ignore ] action ;
|
||||||
|
|
||||||
: delay ( parser -- parser )
|
MEMO: delay ( parser -- parser )
|
||||||
delay-parser construct-boa init-parser ;
|
delay-parser construct-boa init-parser ;
|
||||||
|
|
||||||
: list-of ( items separator -- parser )
|
MEMO: list-of ( items separator -- parser )
|
||||||
hide over 2array seq repeat0 [ concat ] action 2array seq [ unclip 1vector swap first append ] action ;
|
hide over 2array seq repeat0 [ concat ] action 2array seq [ unclip 1vector swap first append ] action ;
|
||||||
|
|
|
@ -1,15 +1,15 @@
|
||||||
! Copyright (C) 2007 Chris Double.
|
! Copyright (C) 2007 Chris Double.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel arrays strings math.parser sequences peg peg.ebnf ;
|
USING: kernel arrays strings math.parser sequences peg peg.ebnf memoize ;
|
||||||
IN: peg.pl0
|
IN: peg.pl0
|
||||||
|
|
||||||
#! Grammar for PL/0 based on http://en.wikipedia.org/wiki/PL/0
|
#! Grammar for PL/0 based on http://en.wikipedia.org/wiki/PL/0
|
||||||
: ident ( -- parser )
|
MEMO: ident ( -- parser )
|
||||||
CHAR: a CHAR: z range
|
CHAR: a CHAR: z range
|
||||||
CHAR: A CHAR: Z range 2array choice repeat1
|
CHAR: A CHAR: Z range 2array choice repeat1
|
||||||
[ >string ] action ;
|
[ >string ] action ;
|
||||||
|
|
||||||
: number ( -- parser )
|
MEMO: number ( -- parser )
|
||||||
CHAR: 0 CHAR: 9 range repeat1 [ string>number ] action ;
|
CHAR: 0 CHAR: 9 range repeat1 [ string>number ] action ;
|
||||||
|
|
||||||
<EBNF
|
<EBNF
|
||||||
|
|
Loading…
Reference in New Issue