Attachment "ffp.tcl" to
ticket [3ed39a451f]
added by
ssoberni
2017-10-06 13:17:20.
package req nx
package require pt::pgen
## Tiny example from:
##
## Maidl, A. M., Mascarenhas, F., & Ierusalimschy,
## R. (2013). Exception Handling for Error Reporting in Parsing
## Expression Grammars. In: Proc. 17th Brazilian Symposium
## Programming Languages (SBLP 2013) (pp. 1--15). Springer.
##
set grammar {
PEG Tiny (CmdSeq)
CmdSeq <- Cmd SEMICOLON (Cmd SEMICOLON)*;
Cmd <- Skip ((IfCmd / RepeatCmd / AssignCmd / ReadCmd / WriteCmd)) Skip;
IfCmd <- 'if' Exp 'then' CmdSeq ('else' CmdSeq)? 'end';
RepeatCmd <- 'repeat' CmdSeq 'until' Exp;
AssignCmd <- Name ASSIGNMENT Exp;
ReadCmd <- 'read' Skip Name;
WriteCmd <- 'write' Skip Exp;
void: SEMICOLON <- Skip ';' Skip;
leaf: ASSIGNMENT <- Skip ':=' Skip;
Name <- 'n' / 'f';
Exp <- Operand Skip (('*' / '-' / '+' / '>' / '<') Operand)?;
Operand <- Skip (Name / <digit>) Skip;
void: Skip <- <space>*;
END;
}
try [pt::pgen peg $grammar nx -class TinyParser -name TinyGrammar] on return {} {}
proc parse {p} {
set tp [TinyParser new]
try {
set ast [$tp parset $p]
lassign $ast nt start end
puts prefix='[string range $p 0 $end]'
puts suffix='[string range $p [expr {$end+1}] [string length $p]]'
} on error {e} {
puts err='$err'
} on ok {r} {
puts myerror=[$tp eval {set :myerror}]
} finally {
$tp destroy
}
}
# correct tiny prog: 'suffix eq epsilon ("")' equiv 'prefix eq input'
parse {
n := 5;
f := 1;
repeat
f := f * n;
n := n - 1;
until n < 1;
write f;
}
# incorrect tiny prog (missing ';' within 'repeat' block at line 5):
# suffix ne epsilon ("") equiv 'prefix ne input'
parse {
n := 5;
f := 1;
repeat
f := f * n;
n := n - 1
until n < 1;
write f;
}
## -> myerror and suffix are pointing to the beginning of the 'repeat'
## -> statement; rather than the cmd at line 5.
## minimal FFP support
nx::Class create FFP {
:variable ffp [list]
# FFP: available on [complete]
:public method complete {} {
puts FFP=${:ffp}
next
}
# FFP: actual FFP recording in the spirit of "i_error_pop_merge",
# without popping, naturally. At this point, "myerror", if
# available, carries a previously popped error-stack element.
:method updateFFP {} {
if {![llength ${:ffp}]} {
set :ffp ${:myerror}; return
}
if {![llength ${:myerror}]} {
return
}
lassign ${:myerror} currentErrPos currentErrMsg
lassign ${:ffp} prevFfpPos prevFfpMsg
if {$prevFfpPos > $currentErrPos} { return; }
if {$currentErrPos > $prevFfpPos} {
set :ffp ${:myerror}
}
# Equal locations, merge the message lists
set :ffp [list $currentErrPos [lsort -uniq [list {*}$prevFfpMsg {*}$currentErrMsg]]]
}
# Instrumentation (1): end-of-choice
foreach m {si:void_state_merge si:value_state_merge} {
:method $m {} {
:updateFFP
next
}
}
# Instrumentation (2): mid-of-choice
foreach m {si:valuevoid_branch si:valuevalue_branch si:voidvoid_branch si:voidvalue_branch} {
:method $m {} {
try {set r [next]} on return {} {
# caught a backtracking return, update ffp
:updateFFP
return -code return
}
return $r
}
}
}
TinyParser mixins add FFP
parse {
n := 5;
f := 1;
repeat
f := f * n;
n := n - 1
until n < 1;
write f;
}
# -> FFP=63 {{cl *-+><} space {t {;}}}
TinyParser mixins delete FFP