diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 8940fc87c6..7fa1fb90e5 100644 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Chris Double. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences strings namespaces math assocs shuffle - vectors arrays combinators.lib ; + vectors arrays combinators.lib memoize ; IN: peg TUPLE: parse-result remaining ast ; @@ -12,6 +12,10 @@ GENERIC: (parse) ( state parser -- result ) SYMBOL: packrat-cache SYMBOL: ignore +SYMBOL: not-in-cache + +: not-in-cache? ( result -- ? ) + not-in-cache = ; : ( remaining ast -- parse-result ) parse-result construct-boa ; @@ -30,7 +34,9 @@ TUPLE: parser id ; dup slice? [ slice-from ] [ drop 0 ] if ; : 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 -- ) parser-id dup packrat-cache get at [ @@ -44,9 +50,17 @@ PRIVATE> : parse ( input parser -- result ) 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 - ] unless* + ] [ +! "cache hit: " write over parser-id number>string write " - " write nl ! pick . + 2nip + ] if ] [ (parse) ] if ; @@ -207,13 +221,13 @@ M: delay-parser (parse) ( state parser -- result ) PRIVATE> -: token ( string -- parser ) +MEMO: token ( string -- parser ) token-parser construct-boa init-parser ; : satisfy ( quot -- parser ) satisfy-parser construct-boa init-parser ; -: range ( min max -- parser ) +MEMO: range ( min max -- parser ) range-parser construct-boa init-parser ; : seq ( seq -- parser ) @@ -222,32 +236,32 @@ PRIVATE> : choice ( seq -- parser ) choice-parser construct-boa init-parser ; -: repeat0 ( parser -- parser ) +MEMO: repeat0 ( parser -- parser ) repeat0-parser construct-boa init-parser ; -: repeat1 ( parser -- parser ) +MEMO: repeat1 ( parser -- parser ) repeat1-parser construct-boa init-parser ; -: optional ( parser -- parser ) +MEMO: optional ( parser -- parser ) optional-parser construct-boa init-parser ; -: ensure ( parser -- parser ) +MEMO: ensure ( parser -- parser ) ensure-parser construct-boa init-parser ; -: ensure-not ( parser -- parser ) +MEMO: ensure-not ( parser -- parser ) ensure-not-parser construct-boa init-parser ; : action ( parser quot -- parser ) action-parser construct-boa init-parser ; -: sp ( parser -- parser ) +MEMO: sp ( parser -- parser ) sp-parser construct-boa init-parser ; -: hide ( parser -- parser ) +MEMO: hide ( parser -- parser ) [ drop ignore ] action ; -: delay ( parser -- parser ) +MEMO: delay ( parser -- 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 ; diff --git a/extra/peg/pl0/pl0.factor b/extra/peg/pl0/pl0.factor index b37009238d..b6b030f56c 100644 --- a/extra/peg/pl0/pl0.factor +++ b/extra/peg/pl0/pl0.factor @@ -1,15 +1,15 @@ ! Copyright (C) 2007 Chris Double. ! 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 #! 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 2array choice repeat1 [ >string ] action ; -: number ( -- parser ) +MEMO: number ( -- parser ) CHAR: 0 CHAR: 9 range repeat1 [ string>number ] action ;