drop \r
] [ \r
[\r
- "FROM: locals => [let* ; FROM: sequences => nth ; [let* | " %\r
- dup length swap [\r
- dup ebnf-var? [\r
+ "FROM: locals => [let ; FROM: sequences => nth ; [let " %\r
+ dup length [\r
+ over ebnf-var? [\r
+ " " % # " over nth :> " %\r
name>> % \r
- " [ " % # " over nth ] " %\r
] [\r
2drop\r
] if\r
] 2each\r
- " | " %\r
+ " " %\r
% \r
" nip ]" % \r
] "" make \r
\r
M: ebnf-var build-locals ( code ast -- )\r
[\r
- "FROM: locals => [let* ; FROM: kernel => dup nip ; [let* | " %\r
- name>> % " [ dup ] " %\r
- " | " %\r
+ "FROM: locals => [let ; FROM: kernel => dup nip ; [let " %\r
+ " dup :> " % name>> %\r
+ " " %\r
% \r
" nip ]" % \r
] "" make ;\r
l lrstack get (setup-lr) ;
:: lr-answer ( r p m -- ast )
- [let* |
- h [ m ans>> head>> ]
- |
+ m ans>> head>> :> h
h rule-id>> r rule-id eq? [
m ans>> seed>> m (>>ans)
m ans>> failed? [
] if
] [
m ans>> seed>>
- ] if
- ] ; inline
+ ] if ; inline
:: recall ( r p -- memo-entry )
- [let* |
- m [ p r rule-id memo ]
- h [ p heads at ]
- |
+ p r rule-id memo :> m
+ p heads at :> h
h [
m r rule-id h involved-set>> h rule-id>> suffix member? not and [
fail p memo-entry boa
] if
] [
m
- ] if
- ] ; inline
+ ] if ; inline
:: apply-non-memo-rule ( r p -- ast )
- [let* |
- lr [ fail r rule-id f lrstack get left-recursion boa ]
- m [ lr lrstack set lr p memo-entry boa dup p r rule-id set-memo ]
- ans [ r eval-rule ]
- |
+ fail r rule-id f lrstack get left-recursion boa :> lr
+ lr lrstack set lr p memo-entry boa dup p r rule-id set-memo :> m
+ r eval-rule :> ans
lrstack get next>> lrstack set
pos get m (>>pos)
lr head>> [
] [
ans m (>>ans)
ans
- ] if
- ] ; inline
+ ] if ; inline
: apply-memo-rule ( r m -- ast )
[ ans>> ] [ pos>> ] bi pos set
ERROR: parse-failed input word ;
SYNTAX: PEG:
- (:)
- [let | effect [ ] def [ ] word [ ] |
+ (:) :> effect :> def :> word
[
[
- [let | compiled-def [ def call compile ] |
- [
- dup compiled-def compiled-parse
- [ ast>> ] [ word parse-failed ] ?if
- ]
- word swap effect define-declared
+ def call compile :> compiled-def
+ [
+ dup compiled-def compiled-parse
+ [ ast>> ] [ word parse-failed ] ?if
]
+ word swap effect define-declared
] with-compilation-unit
- ] over push-all
- ] ;
+ ] over push-all ;
USING: vocabs vocabs.loader ;