Use new slots in peg
parent
b1561de0f6
commit
8569d18068
|
@ -3,7 +3,7 @@
|
||||||
USING: kernel sequences strings namespaces math assocs shuffle
|
USING: kernel sequences strings namespaces math assocs shuffle
|
||||||
vectors arrays combinators.lib math.parser match
|
vectors arrays combinators.lib math.parser match
|
||||||
unicode.categories sequences.lib compiler.units parser
|
unicode.categories sequences.lib compiler.units parser
|
||||||
words quotations effects memoize ;
|
words quotations effects memoize accessors ;
|
||||||
IN: peg
|
IN: peg
|
||||||
|
|
||||||
TUPLE: parse-result remaining ast ;
|
TUPLE: parse-result remaining ast ;
|
||||||
|
@ -52,7 +52,7 @@ MATCH-VARS: ?token ;
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
M: token-parser (compile) ( parser -- quot )
|
M: token-parser (compile) ( parser -- quot )
|
||||||
token-parser-symbol [ parse-token ] curry ;
|
symbol>> [ parse-token ] curry ;
|
||||||
|
|
||||||
TUPLE: satisfy-parser quot ;
|
TUPLE: satisfy-parser quot ;
|
||||||
|
|
||||||
|
@ -72,7 +72,7 @@ MATCH-VARS: ?quot ;
|
||||||
] ;
|
] ;
|
||||||
|
|
||||||
M: satisfy-parser (compile) ( parser -- quot )
|
M: satisfy-parser (compile) ( parser -- quot )
|
||||||
satisfy-parser-quot \ ?quot satisfy-pattern match-replace ;
|
quot>> \ ?quot satisfy-pattern match-replace ;
|
||||||
|
|
||||||
TUPLE: range-parser min max ;
|
TUPLE: range-parser min max ;
|
||||||
|
|
||||||
|
@ -100,12 +100,12 @@ TUPLE: seq-parser parsers ;
|
||||||
: seq-pattern ( -- quot )
|
: seq-pattern ( -- quot )
|
||||||
[
|
[
|
||||||
dup [
|
dup [
|
||||||
dup parse-result-remaining ?quot [
|
dup remaining>> ?quot [
|
||||||
[ parse-result-remaining swap set-parse-result-remaining ] 2keep
|
[ remaining>> swap (>>remaining) ] 2keep
|
||||||
parse-result-ast dup ignore = [
|
ast>> dup ignore = [
|
||||||
drop
|
drop
|
||||||
] [
|
] [
|
||||||
swap [ parse-result-ast push ] keep
|
swap [ ast>> push ] keep
|
||||||
] if
|
] if
|
||||||
] [
|
] [
|
||||||
drop f
|
drop f
|
||||||
|
@ -118,7 +118,7 @@ TUPLE: seq-parser parsers ;
|
||||||
M: seq-parser (compile) ( parser -- quot )
|
M: seq-parser (compile) ( parser -- quot )
|
||||||
[
|
[
|
||||||
[ V{ } clone <parse-result> ] %
|
[ V{ } clone <parse-result> ] %
|
||||||
seq-parser-parsers [ compiled-parser \ ?quot seq-pattern match-replace % ] each
|
parsers>> [ compiled-parser \ ?quot seq-pattern match-replace % ] each
|
||||||
] [ ] make ;
|
] [ ] make ;
|
||||||
|
|
||||||
TUPLE: choice-parser parsers ;
|
TUPLE: choice-parser parsers ;
|
||||||
|
@ -135,16 +135,16 @@ TUPLE: choice-parser parsers ;
|
||||||
M: choice-parser (compile) ( parser -- quot )
|
M: choice-parser (compile) ( parser -- quot )
|
||||||
[
|
[
|
||||||
f ,
|
f ,
|
||||||
choice-parser-parsers [ compiled-parser \ ?quot choice-pattern match-replace % ] each
|
parsers>> [ compiled-parser \ ?quot choice-pattern match-replace % ] each
|
||||||
\ nip ,
|
\ nip ,
|
||||||
] [ ] make ;
|
] [ ] make ;
|
||||||
|
|
||||||
TUPLE: repeat0-parser p1 ;
|
TUPLE: repeat0-parser p1 ;
|
||||||
|
|
||||||
: (repeat0) ( quot result -- result )
|
: (repeat0) ( quot result -- result )
|
||||||
2dup parse-result-remaining swap call [
|
2dup remaining>> swap call [
|
||||||
[ parse-result-remaining swap set-parse-result-remaining ] 2keep
|
[ remaining>> swap (>>remaining) ] 2keep
|
||||||
parse-result-ast swap [ parse-result-ast push ] keep
|
ast>> swap [ ast>> push ] keep
|
||||||
(repeat0)
|
(repeat0)
|
||||||
] [
|
] [
|
||||||
nip
|
nip
|
||||||
|
@ -158,7 +158,7 @@ TUPLE: repeat0-parser p1 ;
|
||||||
M: repeat0-parser (compile) ( parser -- quot )
|
M: repeat0-parser (compile) ( parser -- quot )
|
||||||
[
|
[
|
||||||
[ V{ } clone <parse-result> ] %
|
[ V{ } clone <parse-result> ] %
|
||||||
repeat0-parser-p1 compiled-parser \ ?quot repeat0-pattern match-replace %
|
p1>> compiled-parser \ ?quot repeat0-pattern match-replace %
|
||||||
] [ ] make ;
|
] [ ] make ;
|
||||||
|
|
||||||
TUPLE: repeat1-parser p1 ;
|
TUPLE: repeat1-parser p1 ;
|
||||||
|
@ -166,7 +166,7 @@ TUPLE: repeat1-parser p1 ;
|
||||||
: repeat1-pattern ( -- quot )
|
: repeat1-pattern ( -- quot )
|
||||||
[
|
[
|
||||||
[ ?quot ] swap (repeat0) [
|
[ ?quot ] swap (repeat0) [
|
||||||
dup parse-result-ast empty? [
|
dup ast>> empty? [
|
||||||
drop f
|
drop f
|
||||||
] when
|
] when
|
||||||
] [
|
] [
|
||||||
|
@ -177,7 +177,7 @@ TUPLE: repeat1-parser p1 ;
|
||||||
M: repeat1-parser (compile) ( parser -- quot )
|
M: repeat1-parser (compile) ( parser -- quot )
|
||||||
[
|
[
|
||||||
[ V{ } clone <parse-result> ] %
|
[ V{ } clone <parse-result> ] %
|
||||||
repeat1-parser-p1 compiled-parser \ ?quot repeat1-pattern match-replace %
|
p1>> compiled-parser \ ?quot repeat1-pattern match-replace %
|
||||||
] [ ] make ;
|
] [ ] make ;
|
||||||
|
|
||||||
TUPLE: optional-parser p1 ;
|
TUPLE: optional-parser p1 ;
|
||||||
|
@ -188,7 +188,7 @@ TUPLE: optional-parser p1 ;
|
||||||
] ;
|
] ;
|
||||||
|
|
||||||
M: optional-parser (compile) ( parser -- quot )
|
M: optional-parser (compile) ( parser -- quot )
|
||||||
optional-parser-p1 compiled-parser \ ?quot optional-pattern match-replace ;
|
p1>> compiled-parser \ ?quot optional-pattern match-replace ;
|
||||||
|
|
||||||
TUPLE: ensure-parser p1 ;
|
TUPLE: ensure-parser p1 ;
|
||||||
|
|
||||||
|
@ -202,7 +202,7 @@ TUPLE: ensure-parser p1 ;
|
||||||
] ;
|
] ;
|
||||||
|
|
||||||
M: ensure-parser (compile) ( parser -- quot )
|
M: ensure-parser (compile) ( parser -- quot )
|
||||||
ensure-parser-p1 compiled-parser \ ?quot ensure-pattern match-replace ;
|
p1>> compiled-parser \ ?quot ensure-pattern match-replace ;
|
||||||
|
|
||||||
TUPLE: ensure-not-parser p1 ;
|
TUPLE: ensure-not-parser p1 ;
|
||||||
|
|
||||||
|
@ -216,7 +216,7 @@ TUPLE: ensure-not-parser p1 ;
|
||||||
] ;
|
] ;
|
||||||
|
|
||||||
M: ensure-not-parser (compile) ( parser -- quot )
|
M: ensure-not-parser (compile) ( parser -- quot )
|
||||||
ensure-not-parser-p1 compiled-parser \ ?quot ensure-not-pattern match-replace ;
|
p1>> compiled-parser \ ?quot ensure-not-pattern match-replace ;
|
||||||
|
|
||||||
TUPLE: action-parser p1 quot ;
|
TUPLE: action-parser p1 quot ;
|
||||||
|
|
||||||
|
@ -225,13 +225,13 @@ MATCH-VARS: ?action ;
|
||||||
: action-pattern ( -- quot )
|
: action-pattern ( -- quot )
|
||||||
[
|
[
|
||||||
?quot dup [
|
?quot dup [
|
||||||
dup parse-result-ast ?action call
|
dup ast>> ?action call
|
||||||
swap [ set-parse-result-ast ] keep
|
>>ast
|
||||||
] when
|
] when
|
||||||
] ;
|
] ;
|
||||||
|
|
||||||
M: action-parser (compile) ( parser -- quot )
|
M: action-parser (compile) ( parser -- quot )
|
||||||
{ action-parser-p1 action-parser-quot } get-slots [ compiled-parser ] dip
|
{ p1>> quot>> } get-slots [ compiled-parser ] dip
|
||||||
2array { ?quot ?action } action-pattern match-replace ;
|
2array { ?quot ?action } action-pattern match-replace ;
|
||||||
|
|
||||||
: left-trim-slice ( string -- string )
|
: left-trim-slice ( string -- string )
|
||||||
|
@ -245,7 +245,7 @@ TUPLE: sp-parser p1 ;
|
||||||
|
|
||||||
M: sp-parser (compile) ( parser -- quot )
|
M: sp-parser (compile) ( parser -- quot )
|
||||||
[
|
[
|
||||||
\ left-trim-slice , sp-parser-p1 compiled-parser ,
|
\ left-trim-slice , p1>> compiled-parser ,
|
||||||
] [ ] make ;
|
] [ ] make ;
|
||||||
|
|
||||||
TUPLE: delay-parser quot ;
|
TUPLE: delay-parser quot ;
|
||||||
|
@ -255,7 +255,7 @@ M: delay-parser (compile) ( parser -- quot )
|
||||||
#! This way it is run only once and the
|
#! This way it is run only once and the
|
||||||
#! parser constructed once at run time.
|
#! parser constructed once at run time.
|
||||||
[
|
[
|
||||||
delay-parser-quot % \ compile ,
|
quot>> % \ compile ,
|
||||||
] [ ] make
|
] [ ] make
|
||||||
{ } { "word" } <effect> memoize-quot
|
{ } { "word" } <effect> memoize-quot
|
||||||
[ % \ execute , ] [ ] make ;
|
[ % \ execute , ] [ ] make ;
|
||||||
|
|
Loading…
Reference in New Issue