From 362f2d34360c03ba2bb4caa056edfa737c5a07bd Mon Sep 17 00:00:00 2001 From: Chris Double Date: Thu, 29 Nov 2007 23:42:46 +1300 Subject: [PATCH 1/3] Fix packrat caching issue --- extra/peg/peg.factor | 18 ++++++++++++++---- extra/peg/pl0/pl0.factor | 6 +++--- 2 files changed, 17 insertions(+), 7 deletions(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 8940fc87c6..247d52a19c 100644 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -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,13 @@ PRIVATE> : parse ( input parser -- result ) packrat-cache get [ - 2dup get-cached [ - [ (parse) dup ] 2keep put-cached - ] unless* + 2dup get-cached dup not-in-cache? [ +! "cache missed: " write over parser-id number>string write " - " write nl ! pick . + drop [ (parse) dup ] 2keep put-cached + ] [ +! "cache hit: " write over parser-id number>string write " - " write nl ! pick . + 2nip + ] if ] [ (parse) ] if ; 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 ; Date: Thu, 29 Nov 2007 23:49:34 +1300 Subject: [PATCH 2/3] Make some parsers uses MEMO: --- extra/peg/peg.factor | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 247d52a19c..39aacd974e 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 ; @@ -217,13 +217,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 ) @@ -232,32 +232,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 ; From 38beaac7209db3ca80754ad73eed71cbc5d3ddd0 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Fri, 30 Nov 2007 00:01:03 +1300 Subject: [PATCH 3/3] Infinite left recursion now causes a failed parser rather than a call stack error --- extra/peg/peg.factor | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 39aacd974e..7fa1fb90e5 100644 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -52,7 +52,11 @@ PRIVATE> packrat-cache get [ 2dup get-cached dup not-in-cache? [ ! "cache missed: " write over parser-id number>string write " - " write nl ! pick . - drop [ (parse) dup ] 2keep put-cached + 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 ] [ ! "cache hit: " write over parser-id number>string write " - " write nl ! pick . 2nip