remove parse-state from peg
Chris Double
parent
b62b59687c
commit
6476eb765e
|
|
@ -8,144 +8,132 @@ IN: temporary
|
|||
0 next-id set-global get-next-id get-next-id get-next-id
|
||||
] unit-test
|
||||
|
||||
{ "0123456789" } [
|
||||
"0123456789" 0 <parse-state> 0 state-tail parse-state-input >string
|
||||
] unit-test
|
||||
|
||||
{ "56789" } [
|
||||
"0123456789" 5 <parse-state> 0 state-tail parse-state-input >string
|
||||
] unit-test
|
||||
|
||||
{ "789" } [
|
||||
"0123456789" 5 <parse-state> 2 state-tail parse-state-input >string
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
"endbegin" 0 <parse-state> "begin" token parse
|
||||
"endbegin" "begin" token parse
|
||||
] unit-test
|
||||
|
||||
{ "begin" "end" } [
|
||||
"beginend" 0 <parse-state> "begin" token parse
|
||||
"beginend" "begin" token parse
|
||||
{ parse-result-ast parse-result-remaining } get-slots
|
||||
parse-state-input >string
|
||||
>string
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
"" 0 <parse-state> CHAR: a CHAR: z range parse
|
||||
"" CHAR: a CHAR: z range parse
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
"1bcd" 0 <parse-state> CHAR: a CHAR: z range parse
|
||||
"1bcd" CHAR: a CHAR: z range parse
|
||||
] unit-test
|
||||
|
||||
{ CHAR: a } [
|
||||
"abcd" 0 <parse-state> CHAR: a CHAR: z range parse parse-result-ast
|
||||
"abcd" CHAR: a CHAR: z range parse parse-result-ast
|
||||
] unit-test
|
||||
|
||||
{ CHAR: z } [
|
||||
"zbcd" 0 <parse-state> CHAR: a CHAR: z range parse parse-result-ast
|
||||
"zbcd" CHAR: a CHAR: z range parse parse-result-ast
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
"bad" 0 <parse-state> "a" token "b" token 2array seq parse
|
||||
"bad" "a" token "b" token 2array seq parse
|
||||
] unit-test
|
||||
|
||||
{ V{ "g" "o" } } [
|
||||
"good" 0 <parse-state> "g" token "o" token 2array seq parse parse-result-ast
|
||||
"good" "g" token "o" token 2array seq parse parse-result-ast
|
||||
] unit-test
|
||||
|
||||
{ "a" } [
|
||||
"abcd" 0 <parse-state> "a" token "b" token 2array choice parse parse-result-ast
|
||||
"abcd" "a" token "b" token 2array choice parse parse-result-ast
|
||||
] unit-test
|
||||
|
||||
{ "b" } [
|
||||
"bbcd" 0 <parse-state> "a" token "b" token 2array choice parse parse-result-ast
|
||||
"bbcd" "a" token "b" token 2array choice parse parse-result-ast
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
"cbcd" 0 <parse-state> "a" token "b" token 2array choice parse
|
||||
"cbcd" "a" token "b" token 2array choice parse
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
"" 0 <parse-state> "a" token "b" token 2array choice parse
|
||||
"" "a" token "b" token 2array choice parse
|
||||
] unit-test
|
||||
|
||||
{ 0 } [
|
||||
"" 0 <parse-state> "a" token repeat0 parse parse-result-ast length
|
||||
"" "a" token repeat0 parse parse-result-ast length
|
||||
] unit-test
|
||||
|
||||
{ 0 } [
|
||||
"b" 0 <parse-state> "a" token repeat0 parse parse-result-ast length
|
||||
"b" "a" token repeat0 parse parse-result-ast length
|
||||
] unit-test
|
||||
|
||||
{ V{ "a" "a" "a" } } [
|
||||
"aaab" 0 <parse-state> "a" token repeat0 parse parse-result-ast
|
||||
"aaab" "a" token repeat0 parse parse-result-ast
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
"" 0 <parse-state> "a" token repeat1 parse
|
||||
"" "a" token repeat1 parse
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
"b" 0 <parse-state> "a" token repeat1 parse
|
||||
"b" "a" token repeat1 parse
|
||||
] unit-test
|
||||
|
||||
{ V{ "a" "a" "a" } } [
|
||||
"aaab" 0 <parse-state> "a" token repeat1 parse parse-result-ast
|
||||
"aaab" "a" token repeat1 parse parse-result-ast
|
||||
] unit-test
|
||||
|
||||
{ V{ "a" "b" } } [
|
||||
"ab" 0 <parse-state> "a" token optional "b" token 2array seq parse parse-result-ast
|
||||
"ab" "a" token optional "b" token 2array seq parse parse-result-ast
|
||||
] unit-test
|
||||
|
||||
{ V{ f "b" } } [
|
||||
"b" 0 <parse-state> "a" token optional "b" token 2array seq parse parse-result-ast
|
||||
"b" "a" token optional "b" token 2array seq parse parse-result-ast
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
"cb" 0 <parse-state> "a" token optional "b" token 2array seq parse
|
||||
"cb" "a" token optional "b" token 2array seq parse
|
||||
] unit-test
|
||||
|
||||
{ V{ CHAR: a CHAR: b } } [
|
||||
"ab" 0 <parse-state> "a" token ensure CHAR: a CHAR: z range dup 3array seq parse parse-result-ast
|
||||
"ab" "a" token ensure CHAR: a CHAR: z range dup 3array seq parse parse-result-ast
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
"bb" 0 <parse-state> "a" token ensure CHAR: a CHAR: z range 2array seq parse
|
||||
"bb" "a" token ensure CHAR: a CHAR: z range 2array seq parse
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"a+b" 0 <parse-state>
|
||||
"a+b"
|
||||
"a" token "+" token dup ensure-not 2array seq "++" token 2array choice "b" token 3array seq
|
||||
parse [ t ] [ f ] if
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"a++b" 0 <parse-state>
|
||||
"a++b"
|
||||
"a" token "+" token dup ensure-not 2array seq "++" token 2array choice "b" token 3array seq
|
||||
parse [ t ] [ f ] if
|
||||
] unit-test
|
||||
|
||||
{ t } [
|
||||
"a+b" 0 <parse-state>
|
||||
"a+b"
|
||||
"a" token "+" token "++" token 2array choice "b" token 3array seq
|
||||
parse [ t ] [ f ] if
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
"a++b" 0 <parse-state>
|
||||
"a++b"
|
||||
"a" token "+" token "++" token 2array choice "b" token 3array seq
|
||||
parse [ t ] [ f ] if
|
||||
] unit-test
|
||||
|
||||
{ 1 } [
|
||||
"a" 0 <parse-state> "a" token [ drop 1 ] action parse parse-result-ast
|
||||
"a" "a" token [ drop 1 ] action parse parse-result-ast
|
||||
] unit-test
|
||||
|
||||
{ V{ 1 1 } } [
|
||||
"aa" 0 <parse-state> "a" token [ drop 1 ] action dup 2array seq parse parse-result-ast
|
||||
"aa" "a" token [ drop 1 ] action dup 2array seq parse parse-result-ast
|
||||
] unit-test
|
||||
|
||||
{ f } [
|
||||
"b" 0 <parse-state> "a" token [ drop 1 ] action parse
|
||||
"b" "a" token [ drop 1 ] action parse
|
||||
] unit-test
|
||||
|
|
@ -5,23 +5,6 @@ IN: peg
|
|||
|
||||
SYMBOL: ignore
|
||||
|
||||
TUPLE: parse-state input cache ;
|
||||
|
||||
: <parse-state> ( input index -- state )
|
||||
tail-slice { set-parse-state-input } parse-state construct ;
|
||||
|
||||
: get-cached ( pid state -- result )
|
||||
tuck parse-state-cache at [
|
||||
swap parse-state-input slice-from swap nth
|
||||
] [
|
||||
drop f
|
||||
] if* ;
|
||||
|
||||
: state-tail ( state n -- state )
|
||||
dupd [ parse-state-cache ] dipd
|
||||
[ parse-state-input ] dip tail-slice
|
||||
{ set-parse-state-cache set-parse-state-input } parse-state construct ;
|
||||
|
||||
TUPLE: parse-result remaining ast ;
|
||||
|
||||
: <parse-result> ( remaining ast -- parse-result )
|
||||
|
|
@ -42,8 +25,8 @@ GENERIC: parse ( state parser -- result )
|
|||
TUPLE: token-parser symbol ;
|
||||
|
||||
M: token-parser parse ( state parser -- result )
|
||||
token-parser-symbol 2dup >r parse-state-input r> head? [
|
||||
dup >r length state-tail r> <parse-result>
|
||||
token-parser-symbol 2dup head? [
|
||||
dup >r length tail-slice r> <parse-result>
|
||||
] [
|
||||
2drop f
|
||||
] if ;
|
||||
|
|
@ -54,12 +37,12 @@ M: token-parser parse ( state parser -- result )
|
|||
TUPLE: range-parser min max ;
|
||||
|
||||
M: range-parser parse ( state parser -- result )
|
||||
over parse-state-input empty? [
|
||||
over empty? [
|
||||
2drop f
|
||||
] [
|
||||
0 pick parse-state-input nth dup rot
|
||||
0 pick nth dup rot
|
||||
{ range-parser-min range-parser-max } get-slots between? [
|
||||
[ 1 state-tail ] dip <parse-result>
|
||||
[ 1 tail-slice ] dip <parse-result>
|
||||
] [
|
||||
2drop f
|
||||
] if
|
||||
|
|
|
|||
Loading…
Reference in New Issue