From 1c6882b32cc54d57c36296168e4db339a86560c3 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Fri, 21 Mar 2008 01:25:45 +1300 Subject: [PATCH] Rip out packrat stuff It was broken since the transition to generating compiled quotations. As far as I know, no one was using packrat-parse anyway. Rework in progress... --- extra/peg/parsers/parsers.factor | 38 +++++------ extra/peg/peg-tests.factor | 4 -- extra/peg/peg.factor | 106 ++++++++----------------------- 3 files changed, 44 insertions(+), 104 deletions(-) diff --git a/extra/peg/parsers/parsers.factor b/extra/peg/parsers/parsers.factor index 63e9e9a336..3ccb1e7d10 100755 --- a/extra/peg/parsers/parsers.factor +++ b/extra/peg/parsers/parsers.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007, 2008 Chris Double, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences strings namespaces math assocs shuffle - vectors arrays combinators.lib memoize math.parser match + vectors arrays combinators.lib math.parser match unicode.categories sequences.deep peg peg.private peg.search math.ranges ; IN: peg.parsers @@ -19,26 +19,26 @@ TUPLE: just-parser p1 ; M: just-parser compile ( parser -- quot ) just-parser-p1 compile just-pattern append ; -MEMO: just ( parser -- parser ) - just-parser construct-boa init-parser ; +: just ( parser -- parser ) + just-parser construct-boa ; -MEMO: 1token ( ch -- parser ) 1string token ; +: 1token ( ch -- parser ) 1string token ; r over 2seq r> [ repeat1 ] [ repeat0 ] if [ concat ] action 2seq [ unclip 1vector swap first append ] action ; PRIVATE> -MEMO: list-of ( items separator -- parser ) +: list-of ( items separator -- parser ) hide f (list-of) ; -MEMO: list-of-many ( items separator -- parser ) +: list-of-many ( items separator -- parser ) hide t (list-of) ; -MEMO: epsilon ( -- parser ) V{ } token ; +: epsilon ( -- parser ) V{ } token ; -MEMO: any-char ( -- parser ) [ drop t ] satisfy ; +: any-char ( -- parser ) [ drop t ] satisfy ; -MEMO: exactly-n ( parser n -- parser' ) +: exactly-n ( parser n -- parser' ) swap seq ; -MEMO: at-most-n ( parser n -- parser' ) +: at-most-n ( parser n -- parser' ) dup zero? [ 2drop epsilon ] [ @@ -58,27 +58,27 @@ MEMO: at-most-n ( parser n -- parser' ) -rot 1- at-most-n 2choice ] if ; -MEMO: at-least-n ( parser n -- parser' ) +: at-least-n ( parser n -- parser' ) dupd exactly-n swap repeat0 2seq [ flatten-vectors ] action ; -MEMO: from-m-to-n ( parser m n -- parser' ) +: from-m-to-n ( parser m n -- parser' ) >r [ exactly-n ] 2keep r> swap - at-most-n 2seq [ flatten-vectors ] action ; -MEMO: pack ( begin body end -- parser ) +: pack ( begin body end -- parser ) >r >r hide r> r> hide 3seq [ first ] action ; -MEMO: surrounded-by ( parser begin end -- parser' ) +: surrounded-by ( parser begin end -- parser' ) [ token ] 2apply swapd pack ; -MEMO: 'digit' ( -- parser ) +: 'digit' ( -- parser ) [ digit? ] satisfy [ digit> ] action ; -MEMO: 'integer' ( -- parser ) +: 'integer' ( -- parser ) 'digit' repeat1 [ 10 digits>integer ] action ; -MEMO: 'string' ( -- parser ) +: 'string' ( -- parser ) [ [ CHAR: " = ] satisfy hide , [ CHAR: " = not ] satisfy repeat0 , @@ -97,7 +97,7 @@ MEMO: 'string' ( -- parser ) ] action replace ; -MEMO: range-pattern ( pattern -- parser ) +: range-pattern ( pattern -- parser ) #! 'pattern' is a set of characters describing the #! parser to be produced. Any single character in #! the pattern matches that character. If the pattern diff --git a/extra/peg/peg-tests.factor b/extra/peg/peg-tests.factor index 7a1ce99883..89cc243863 100644 --- a/extra/peg/peg-tests.factor +++ b/extra/peg/peg-tests.factor @@ -4,10 +4,6 @@ USING: kernel tools.test strings namespaces arrays sequences peg peg.private ; IN: peg.tests -{ 0 1 2 } [ - 0 next-id set-global get-next-id get-next-id get-next-id -] unit-test - { f } [ "endbegin" "begin" token parse ] unit-test diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 16cf40f884..b3200ec5eb 100755 --- 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 memoize math.parser match + vectors arrays combinators.lib math.parser match unicode.categories sequences.lib compiler.units parser words ; IN: peg @@ -10,70 +10,14 @@ TUPLE: parse-result remaining ast ; GENERIC: compile ( parser -- quot ) -: (parse) ( state parser -- result ) +: parse ( state parser -- result ) compile call ; - - ( remaining ast -- parse-result ) parse-result construct-boa ; -SYMBOL: next-id - -: get-next-id ( -- number ) - next-id get-global 0 or dup 1+ next-id set-global ; - -TUPLE: parser id ; - -: init-parser ( parser -- parser ) - get-next-id parser construct-boa over set-delegate ; - -: from ( slice-or-string -- index ) - dup slice? [ slice-from ] [ drop 0 ] if ; - -: get-cached ( input parser -- result ) - [ 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 [ - nip - ] [ - H{ } clone dup >r swap packrat-cache get set-at r> - ] if* - [ from ] dip set-at ; - -PRIVATE> - -: parse ( input parser -- result ) - packrat-cache get [ - 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 - ] [ -! "cache hit: " write over parser-id number>string write " - " write nl ! pick . - 2nip - ] if - ] [ - (parse) - ] if ; - -: packrat-parse ( input parser -- result ) - H{ } clone packrat-cache [ parse ] with-variable ; - -MEMO: token ( string -- parser ) - token-parser construct-boa init-parser ; +: token ( string -- parser ) + token-parser construct-boa ; : satisfy ( quot -- parser ) - satisfy-parser construct-boa init-parser ; + satisfy-parser construct-boa ; -MEMO: range ( min max -- parser ) - range-parser construct-boa init-parser ; +: range ( min max -- parser ) + range-parser construct-boa ; : seq ( seq -- parser ) - seq-parser construct-boa init-parser ; + seq-parser construct-boa ; : 2seq ( parser1 parser2 -- parser ) 2array seq ; @@ -320,7 +264,7 @@ MEMO: range ( min max -- parser ) { } make seq ; inline : choice ( seq -- parser ) - choice-parser construct-boa init-parser ; + choice-parser construct-boa ; : 2choice ( parser1 parser2 -- parser ) 2array choice ; @@ -334,32 +278,32 @@ MEMO: range ( min max -- parser ) : choice* ( quot -- paser ) { } make choice ; inline -MEMO: repeat0 ( parser -- parser ) - repeat0-parser construct-boa init-parser ; +: repeat0 ( parser -- parser ) + repeat0-parser construct-boa ; -MEMO: repeat1 ( parser -- parser ) - repeat1-parser construct-boa init-parser ; +: repeat1 ( parser -- parser ) + repeat1-parser construct-boa ; -MEMO: optional ( parser -- parser ) - optional-parser construct-boa init-parser ; +: optional ( parser -- parser ) + optional-parser construct-boa ; -MEMO: ensure ( parser -- parser ) - ensure-parser construct-boa init-parser ; +: ensure ( parser -- parser ) + ensure-parser construct-boa ; -MEMO: ensure-not ( parser -- parser ) - ensure-not-parser construct-boa init-parser ; +: ensure-not ( parser -- parser ) + ensure-not-parser construct-boa ; : action ( parser quot -- parser ) - action-parser construct-boa init-parser ; + action-parser construct-boa ; -MEMO: sp ( parser -- parser ) - sp-parser construct-boa init-parser ; +: sp ( parser -- parser ) + sp-parser construct-boa ; -MEMO: hide ( parser -- parser ) +: hide ( parser -- parser ) [ drop ignore ] action ; -MEMO: delay ( quot -- parser ) - delay-parser construct-boa init-parser ; +: delay ( quot -- parser ) + delay-parser construct-boa ; : PEG: (:) [