# -*- tcl -*-
#
# Copyright (c) 2009-2015 by Andreas Kupries <andreas_kupries@users.sourceforge.net>

# # ## ### ##### ######## ############# #####################
## Package description

## Implementation of the PackRat Machine (PARAM), a virtual machine on
## top of which parsers for Parsing Expression Grammars (PEGs) can be
## realized. This implementation is tied to Tcl for control flow. We
## (will) have alternate implementations written in TclOO, and critcl,
## all exporting the same API.
#
## RD stands for Recursive Descent.

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5 9
package require TclOO
package require struct::stack 1.5 ; # Requiring peekr, getr, get, trim* methods
package require pt::ast
package require pt::pe

# # ## ### ##### ######## ############# #####################
## Support narrative tracing.

package require debug
debug level  pt/rdengine
debug prefix pt/rdengine {}


# # ## ### ##### ######## ############# #####################
## Implementation

oo::class create ::pt::rde::oo {
    # # ## ### ##### ######## ############# #####################
    ## Instruction counter for tracing. Unused else. Plus other helpers.

    method TraceInitialization {} {
	# Creation of the tracing support procedures.
	# Conditional on debug tag "pt/rdengine".
	# The instance namespace is the current context.
	# This is where the procedures go.

	proc Instruction {label {a {}} {b {}}} {
	    upvar 1 mytracecounter mytracecounter myok myok myloc myloc mycurrent mycurrent mysvalue mysvalue myerror myerror __inst theinst
	    set theinst [list $label $a $b]
	    return "[uplevel 1 self] <<[format %08d [incr mytracecounter]]>> START I:[format %-30s $label] [format %-10s $a] [format %-10s $b] :: [State]"
	}

	proc InstReturn {} {
	    upvar 1 mytracecounter mytracecounter myok myok myloc myloc mycurrent mycurrent mysvalue mysvalue myerror myerror __inst theinst
	    lassign $theinst label a b
	    return "[uplevel 1 self] <<[format %08d $mytracecounter]>> END__ I:[format %-30s $label] [format %-10s $a] [format %-10s $b] :: [State]"
	}

	proc State {} {
	    upvar 1 myok myok myloc myloc mycurrent mycurrent mysvalue mysvalue myerror myerror
	    set sv [expr {[info exists mysvalue] ? $mysvalue : ""}]
	    return "ST $myok CL $myloc CC ($mycurrent) SV ($sv) ER ($myerror)"
	}

	proc TraceSetupStacks {} {
	    set selfns [namespace current]

	    # Move stack instances aside.
	    rename ${selfns}::LOC   ${selfns}::LOC__
	    rename ${selfns}::ERR   ${selfns}::ERR__
	    rename ${selfns}::AST   ${selfns}::AST__
	    rename ${selfns}::MARK  ${selfns}::MRK__

	    # Create procedures doing tracing, and forwarding to
	    # the renamed actual instances.

	    interp alias {} ${selfns}::LOC  {} ${selfns}::WRAP LS  LOC__
	    interp alias {} ${selfns}::ERR  {} ${selfns}::WRAP ES  ERR__
	    interp alias {} ${selfns}::AST  {} ${selfns}::WRAP ARS AST__
	    interp alias {} ${selfns}::MARK {} ${selfns}::WRAP ASM MRK__

	    proc WRAP {label stack args} {
		debug.pt/rdengine {    $label ___ $args}
		set res [$stack {*}$args]

		# Show state state after the op
		set n [$stack size]
		if {!$n} {
		    set c {()}
		} elseif {$n == 1} {
		    set c <<[$stack peek $n]>>
		} else {
		    set c <<[join [$stack peek $n] {>> <<}]>>
		}
		debug.pt/rdengine {    $label ==  ($n):$c}

		# And op return
		debug.pt/rdengine {    $label ==> ($res)}
		return $res
	    }
	    return
	}

	return
    }

    # # ## ### ##### ######## ############# #####################
    ## API - Lifecycle

    constructor {} {
	debug.pt/rdengine {[my TraceInitialization][self] constructor}

	#set selfns [self namespace]

	set mystackloc  [struct::stack LOC]  ; # LS
	set mystackerr  [struct::stack ERR]  ; # ES
	set mystackast  [struct::stack AST]  ; # ARS/AS
	set mystackmark [struct::stack MARK] ; # s.a.

	debug.pt/rdengine {[TraceSetupStacks][self] constructor /done}
	my reset {}
	return
    }

    method reset {chan} {
	debug.pt/rdengine {[self] reset ($chan)}

	set mychan    $chan      ; # IN
	set mycurrent {}         ; # CC
	set myloc     -1         ; # CL
	set myok      0          ; # ST
	set msvalue   {}         ; # SV
	set myerror   {}         ; # ER
	set mytoken   {}         ; # TC (string)
	array unset   mysymbol * ; # NC

	$mystackloc  clear
	$mystackerr  clear
	$mystackast  clear
	$mystackmark clear

	debug.pt/rdengine {[self] reset /done}
	return
    }

    method complete {} {
	debug.pt/rdengine {[self] complete [State]}

	if {$myok} {
	    set n [$mystackast size]
	    debug.pt/rdengine {[self] complete ast $n}
	    if {$n > 1} {
		# Multiple ASTs left, reduce into single containing them.
		set  pos [$mystackloc peek]
		incr pos
		set children [$mystackast peekr [$mystackast size]]     ; # SaveToMark
		set ast [pt::ast new {} $pos $myloc {*}$children] ; # Reduce ALL

		debug.pt/rdengine {[self] complete n ==> ($ast)}
		return $ast
	    } elseif {$n == 0} {
		# Match, but no AST. This is possible if the grammar
		# consists of only the start expression.

		debug.pt/rdengine {[self] complete 0 ==> ()}
		return {}
	    } else {
		# Match, with AST.
		set ast [$mystackast peek]
		debug.pt/rdengine {[self] complete 1 ==> ($ast)}
		return $ast
	    }
	} else {
	    lassign $myerror loc messages
	    return -code error \
		-errorcode {PT RDE SYNTAX} \
		[list pt::rde $loc $messages]
	}
    }

    # # ## ### ##### ######## ############# #####################
    ## API - State accessors

    method chan   {} { debug.pt/rdengine {[self] chan} ; return $mychan }

    # - - -- --- ----- --------

    method current  {} { debug.pt/rdengine {[self] current}  ; return $mycurrent }
    method location {} { debug.pt/rdengine {[self] location} ; return $myloc }
    method lmarked  {} { debug.pt/rdengine {[self] lmarked}  ; return [$mystackloc getr] }

    # - - -- --- ----- --------

    method ok      {} { debug.pt/rdengine {[self] ok}      ; return $myok      }
    method value   {} { debug.pt/rdengine {[self] value}   ; return $mysvalue  }
    method error   {} { debug.pt/rdengine {[self] error}   ; return $myerror   }
    method emarked {} { debug.pt/rdengine {[self] emarked} ; return [$mystackerr getr] }

    # - - -- --- ----- --------

    method tokens {{from {}} {to {}}} {
	debug.pt/rdengine {[self] tokens ($from) ($to)}
	switch -exact [llength [info level 0]] {
	    4 { return $mytoken }
	    5 { return [string range $mytoken $from $from] }
	    6 { return [string range $mytoken $from $to] }
	}
    }

    method symbols {} {
	debug.pt/rdengine {[self] symbols}
	return [array get mysymbol]
    }

    method scached {} {
	debug.pt/rdengine {[self] scached}
	return [array names mysymbol]
    }

    # - - -- --- ----- --------

    method asts    {} { debug.pt/rdengine {[self] asts}    ; return [$mystackast  getr] }
    method amarked {} { debug.pt/rdengine {[self] amarked} ; return [$mystackmark getr] }
    method ast     {} { debug.pt/rdengine {[self] ast}     ; return [$mystackast  peek] }

    # # ## ### ##### ######## ############# #####################
    ## API - Preloading the token cache.

    method data {string} {
	debug.pt/rdengine {[self] data +[string length $string]}
	append mytoken $string
	return
    }

    # # ## ### ##### ######## ############# #####################
    ## Common instruction sequences

    method si:void_state_push {} {
	debug.pt/rdengine {[Instruction si:void_state_push]}
	# i_loc_push
	# i_error_clear_push
	$mystackloc push $myloc
	set myerror {}
	$mystackerr push {}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:void2_state_push {} {
	debug.pt/rdengine {[Instruction si:void2_state_push]}
	# i_loc_push
	# i_error_push
	$mystackloc push $myloc
	$mystackerr push {}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:value_state_push {} {
	debug.pt/rdengine {[Instruction si:value_state_push]}
	# i_ast_push
	# i_loc_push
	# i_error_clear_push
	$mystackmark push [$mystackast size]
	$mystackloc push $myloc
	set myerror {}
	$mystackerr push {}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    # - -- --- ----- -------- ------------- ---------------------

    method si:void_state_merge {} {
	debug.pt/rdengine {[Instruction si:void_state_merge]}
	# i_error_pop_merge
	# i_loc_pop_rewind/discard

	set olderror [$mystackerr pop]
	# We have either old or new error data, keep it.
	if {![llength $myerror]}  {
	    set myerror $olderror
	} elseif {[llength $olderror]} {
	    # If one of the errors is further on in the input choose
	    # that as the information to propagate.

	    lassign $myerror  loe msgse
	    lassign $olderror lon msgsn

	    if {$lon > $loe} {
		set myerror $olderror
	    } elseif {$loe == $lon} {
		# Equal locations, merge the message lists, set-like.
		set myerror [list $loe [lsort -uniq [list {*}$msgse {*}$msgsn]]]
	    }
	}

	set last [$mystackloc pop]
	if {!$myok} {
	    set myloc $last
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:void_state_merge_ok {} {
	debug.pt/rdengine {[Instruction si:void_state_merge_ok]}
	# i_error_pop_merge
	# i_loc_pop_rewind/discard
	# i_status_ok

	set olderror [$mystackerr pop]
	# We have either old or new error data, keep it.
	if {![llength $myerror]}  {
	    set myerror $olderror
	} elseif {[llength $olderror]} {
	    # If one of the errors is further on in the input choose
	    # that as the information to propagate.

	    lassign $myerror  loe msgse
	    lassign $olderror lon msgsn

	    if {$lon > $loe} {
		set myerror $olderror
	    } elseif {$loe == $lon} {
		# Equal locations, merge the message lists, set-like.
		set myerror [list $loe [lsort -uniq [list {*}$msgse {*}$msgsn]]]
	    }
	}

	set last [$mystackloc pop]
	if {!$myok} {
	    set myloc $last
	    set myok 1
	}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:value_state_merge {} {
	debug.pt/rdengine {[Instruction si:value_state_merge]}
	# i_error_pop_merge
	# i_ast_pop_rewind/discard
	# i_loc_pop_rewind/discard

	set olderror [$mystackerr pop]
	# We have either old or new error data, keep it.
	if {![llength $myerror]}  {
	    set myerror $olderror
	} elseif {[llength $olderror]} {
	    # If one of the errors is further on in the input choose
	    # that as the information to propagate.

	    lassign $myerror  loe msgse
	    lassign $olderror lon msgsn

	    if {$lon > $loe} {
		set myerror $olderror
	    } elseif {$loe == $lon} {
		# Equal locations, merge the message lists, set-like.
		set myerror [list $loe [lsort -uniq [list {*}$msgse {*}$msgsn]]]
	    }
	}

	set mark [$mystackmark pop]
	set last [$mystackloc pop]
	if {!$myok} {
	    $mystackast trim* $mark
	    set myloc $last
	}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    # - -- --- ----- -------- ------------- ---------------------

    method si:value_notahead_start {} {
	debug.pt/rdengine {[Instruction si:value_notahead_start]}
	# i_loc_push
	# i_ast_push

	$mystackloc  push $myloc
	$mystackmark push [$mystackast size]

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:void_notahead_exit {} {
	debug.pt/rdengine {[Instruction si:void_notahead_exit]}
	# i_loc_pop_rewind
	# i_status_negate

	set myloc [$mystackloc pop]
	set myok [expr {!$myok}]

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:value_notahead_exit {} {
	debug.pt/rdengine {[Instruction si:value_notahead_exit]}
	# i_ast_pop_discard/rewind
	# i_loc_pop_rewind
	# i_status_negate

	set mark [$mystackmark pop]
	if {$myok} {
	    $mystackast trim* $mark
	}
	set myloc [$mystackloc pop]
	set myok [expr {!$myok}]

	debug.pt/rdengine {[InstReturn]}
	return
    }

    # - -- --- ----- -------- ------------- ---------------------

    method si:kleene_abort {} {
	debug.pt/rdengine {[Instruction si:kleene_abort]}
	# i_loc_pop_rewind/discard
	# i:fail_return

	set last [$mystackloc pop]
	if {$myok} {
	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set myloc $last
	debug.pt/rdengine {[InstReturn]}
	return -code return
    }

    method si:kleene_close {} {
	debug.pt/rdengine {[Instruction si:kleene_close]}
	# i_error_pop_merge
	# i_loc_pop_rewind/discard
	# i:fail_status_ok
	# i:fail_return

	set olderror [$mystackerr pop]
	# We have either old or new error data, keep it.
	if {![llength $myerror]}  {
	    set myerror $olderror
	} elseif {[llength $olderror]} {
	    # If one of the errors is further on in the input choose
	    # that as the information to propagate.

	    lassign $myerror  loe msgse
	    lassign $olderror lon msgsn

	    if {$lon > $loe} {
		set myerror $olderror
	    } elseif {$loe == $lon} {
		# Equal locations, merge the message lists, set-like.
		set myerror [list $loe [lsort -uniq [list {*}$msgse {*}$msgsn]]]
	    }
	}

	set last [$mystackloc pop]
	if {$myok} {
	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set myok 1
	set myloc $last

	debug.pt/rdengine {[InstReturn]}
	return -code return
    }

    # - -- --- ----- -------- ------------- ---------------------

    method si:voidvoid_branch {} {
	debug.pt/rdengine {[Instruction si:voidvoid_branch]}
	# i_error_pop_merge
	# i:ok_loc_pop_discard
	# i:ok_return
	# i_loc_rewind
	# i_error_push

	set olderror [$mystackerr pop]
	# We have either old or new error data, keep it.
	if {![llength $myerror]}  {
	    set myerror $olderror
	} elseif {[llength $olderror]} {
	    # If one of the errors is further on in the input choose
	    # that as the information to propagate.

	    lassign $myerror  loe msgse
	    lassign $olderror lon msgsn

	    if {$lon > $loe} {
		set myerror $olderror
	    } elseif {$loe == $lon} {
		# Equal locations, merge the message lists, set-like.
		set myerror [list $loe [lsort -uniq [list {*}$msgse {*}$msgsn]]]
	    }
	}

	if {$myok} {
	    $mystackloc pop
	    debug.pt/rdengine {[InstReturn]}
	    return -code return
	}
	set myloc [$mystackloc peek]
	$mystackerr push $myerror

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:voidvalue_branch {} {
	debug.pt/rdengine {[Instruction si:voidvalue_branch]}
	# i_error_pop_merge
	# i:ok_loc_pop_discard
	# i:ok_return
	# i_ast_push
	# i_loc_rewind
	# i_error_push

	set olderror [$mystackerr pop]
	# We have either old or new error data, keep it.
	if {![llength $myerror]}  {
	    set myerror $olderror
	} elseif {[llength $olderror]} {
	    # If one of the errors is further on in the input choose
	    # that as the information to propagate.

	    lassign $myerror  loe msgse
	    lassign $olderror lon msgsn

	    if {$lon > $loe} {
		set myerror $olderror
	    } elseif {$loe == $lon} {
		# Equal locations, merge the message lists, set-like.
		set myerror [list $loe [lsort -uniq [list {*}$msgse {*}$msgsn]]]
	    }
	}

	if {$myok} {
	    $mystackloc pop
	    debug.pt/rdengine {[InstReturn]}
	    return -code return
	}
	$mystackmark push [$mystackast size]
	set myloc [$mystackloc peek]
	$mystackerr push $myerror

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:valuevoid_branch {} {
	debug.pt/rdengine {[Instruction si:valuevoid_branch]}
	# i_error_pop_merge
	# i_ast_pop_rewind/discard
	# i:ok_loc_pop_discard
	# i:ok_return
	# i_loc_rewind
	# i_error_push

	set olderror [$mystackerr pop]
	# We have either old or new error data, keep it.
	if {![llength $myerror]}  {
	    set myerror $olderror
	} elseif {[llength $olderror]} {
	    # If one of the errors is further on in the input choose
	    # that as the information to propagate.

	    lassign $myerror  loe msgse
	    lassign $olderror lon msgsn

	    if {$lon > $loe} {
		set myerror $olderror
	    } elseif {$loe == $lon} {
		# Equal locations, merge the message lists, set-like.
		set myerror [list $loe [lsort -uniq [list {*}$msgse {*}$msgsn]]]
	    }
	}
	set mark [$mystackmark pop]
	if {$myok} {
	    $mystackloc pop
	    debug.pt/rdengine {[InstReturn]}
	    return -code return
	}
	$mystackast trim* $mark
	set myloc [$mystackloc peek]
	$mystackerr push $myerror

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:valuevalue_branch {} {
	debug.pt/rdengine {[Instruction si:valuevalue_branch]}
	# i_error_pop_merge
	# i_ast_pop_discard
	# i:ok_loc_pop_discard
	# i:ok_return
	# i_ast_rewind
	# i_loc_rewind
	# i_error_push

	set olderror [$mystackerr pop]
	# We have either old or new error data, keep it.
	if {![llength $myerror]}  {
	    set myerror $olderror
	} elseif {[llength $olderror]} {
	    # If one of the errors is further on in the input choose
	    # that as the information to propagate.

	    lassign $myerror  loe msgse
	    lassign $olderror lon msgsn

	    if {$lon > $loe} {
		set myerror $olderror
	    } elseif {$loe == $lon} {
		# Equal locations, merge the message lists, set-like.
		set myerror [list $loe [lsort -uniq [list {*}$msgse {*}$msgsn]]]
	    }
	}
	if {$myok} {
	    $mystackmark pop
	    $mystackloc pop

	    debug.pt/rdengine {[InstReturn]}
	    return -code return
	}
	$mystackast trim* [$mystackmark peek]
	set myloc [$mystackloc peek]
	$mystackerr push $myerror

	debug.pt/rdengine {[InstReturn]}
	return
    }

    # - -- --- ----- -------- ------------- ---------------------

    method si:voidvoid_part {} {
	debug.pt/rdengine {[Instruction si:voidvoid_part]}
	# i_error_pop_merge
	# i:fail_loc_pop_rewind
	# i:fail_return
	# i_error_push

	set olderror [$mystackerr pop]
	# We have either old or new error data, keep it.
	if {![llength $myerror]}  {
	    set myerror $olderror
	} elseif {[llength $olderror]} {
	    # If one of the errors is further on in the input choose
	    # that as the information to propagate.

	    lassign $myerror  loe msgse
	    lassign $olderror lon msgsn

	    if {$lon > $loe} {
		set myerror $olderror
	    } elseif {$loe == $lon} {
		# Equal locations, merge the message lists, set-like.
		set myerror [list $loe [lsort -uniq [list {*}$msgse {*}$msgsn]]]
	    }
	}
	if {!$myok} {
	    set myloc [$mystackloc pop]
	    debug.pt/rdengine {[InstReturn]}
	    return -code return
	}
	$mystackerr push $myerror

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:voidvalue_part {} {
	debug.pt/rdengine {[Instruction si:voidvalue_part]}
	# i_error_pop_merge
	# i:fail_loc_pop_rewind
	# i:fail_return
	# i_ast_push
	# i_error_push

	set olderror [$mystackerr pop]
	# We have either old or new error data, keep it.
	if {![llength $myerror]}  {
	    set myerror $olderror
	} elseif {[llength $olderror]} {
	    # If one of the errors is further on in the input choose
	    # that as the information to propagate.

	    lassign $myerror  loe msgse
	    lassign $olderror lon msgsn

	    if {$lon > $loe} {
		set myerror $olderror
	    } elseif {$loe == $lon} {
		# Equal locations, merge the message lists, set-like.
		set myerror [list $loe [lsort -uniq [list {*}$msgse {*}$msgsn]]]
	    }
	}
	if {!$myok} {
	    set myloc [$mystackloc pop]
	    debug.pt/rdengine {[InstReturn]}
	    return -code return
	}
	$mystackmark push [$mystackast size]
	$mystackerr push $myerror

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:valuevalue_part {} {
	debug.pt/rdengine {[Instruction si:valuevalue_part]}
	# i_error_pop_merge
	# i:fail_ast_pop_rewind
	# i:fail_loc_pop_rewind
	# i:fail_return
	# i_error_push

	set olderror [$mystackerr pop]
	# We have either old or new error data, keep it.
	if {![llength $myerror]}  {
	    set myerror $olderror
	} elseif {[llength $olderror]} {
	    # If one of the errors is further on in the input choose
	    # that as the information to propagate.

	    lassign $myerror  loe msgse
	    lassign $olderror lon msgsn

	    if {$lon > $loe} {
		set myerror $olderror
	    } elseif {$loe == $lon} {
		# Equal locations, merge the message lists, set-like.
		set myerror [list $loe [lsort -uniq [list {*}$msgse {*}$msgsn]]]
	    }
	}
	if {!$myok} {
	    $mystackast trim* [$mystackmark pop]
	    set myloc [$mystackloc pop]

	    debug.pt/rdengine {[InstReturn]}
	    return -code return
	}
	$mystackerr push $myerror

	debug.pt/rdengine {[InstReturn]}
	return
    }

    # - -- --- ----- -------- ------------- ---------------------

    method si:next_str {tok} {
	debug.pt/rdengine {[Instruction si:next_str $tok]}
	# String = sequence of characters.
	# No need for all the intermediate stack churn.

	set n    [string length $tok]
	set last [expr {$myloc + $n}]
	set max  [string length $mytoken]

	incr myloc
	if {($last >= $max) && ![my ExtendTCN [expr {$last - $max + 1}]]} {
	    set myok    0
	    set myerror [list $myloc [list [list str $tok]]]
	    # i:fail_return
	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set lex       [string range $mytoken $myloc $last]
	set mycurrent [string index $mytoken $last]

	# ATTENTION: The error output of this instruction is different
	# from a regular sequence of si:next_char instructions. The
	# error location will be the start of the string token we
	# wanted to match, and the message will contain the entire
	# string token. In the regular sequence we would see the exact
	# point of the mismatch instead, with the message containing
	# the expected character.

	if {$tok eq $lex} {
	    set myok 1
	    set myloc $last
	    set myerror {}
	} else {
	    set myok 0
	    set myerror [list $myloc [list [list str $tok]]]
	    incr myloc -1
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:next_class {tok} {
	debug.pt/rdengine {[Instruction si:next_class $tok]}
	# Class = Choice of characters. No need for stack churn.

	# i_input_next "\{t $c\}"
	# i:fail_return
	# i_test_<user class>

	incr myloc
	if {($myloc >= [string length $mytoken]) && ![my ExtendTC]} {
	    set myok    0
	    set myerror [list $myloc [list [list cl $tok]]]
	    # i:fail_return
	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set mycurrent [string index $mytoken $myloc]

	# Note what is needle versus hay. The token, i.e. the string
	# of allowed characters is the hay in which the current
	# character is looked, making it the needle.

	if {[string first $mycurrent $tok] >= 0} {
	    set myok 1
	    set myerror {}
	} else {
	    set myok 0
	    set myerror [list $myloc [list [list cl $tok]]]
	    incr myloc -1
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:next_char {tok} {
	debug.pt/rdengine {[Instruction si:next_char $tok]}
	# i_input_next "\{t $c\}"
	# i:fail_return
	# i_test_char $c

	incr myloc
	if {($myloc >= [string length $mytoken]) && ![my ExtendTC]} {
	    set myok    0
	    set myerror [list $myloc [list [list t $tok]]]
	    # i:fail_return
	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set mycurrent [string index $mytoken $myloc]

	if {$tok eq $mycurrent} {
	    set myok 1
	    set myerror {}
	} else {
	    set myok 0
	    set myerror [list $myloc [list [list t $tok]]]
	    incr myloc -1
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:next_range {toks toke} {
	debug.pt/rdengine {[Instruction si:next_range $toks $toke]}
	#Asm::Ins i_input_next "\{.. $s $e\}"
	#Asm::Ins i:fail_return
	#Asm::Ins i_test_range $s $e

	incr myloc
	if {($myloc >= [string length $mytoken]) && ![my ExtendTC]} {
	    set myok    0
	    set myerror [list $myloc [list [list .. $toks $toke]]]
	    # i:fail_return
	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set mycurrent [string index $mytoken $myloc]

	if {([string compare $toks $mycurrent] <= 0) &&
	    ([string compare $mycurrent $toke] <= 0)} {
	    set myok 1
	    set myerror {}
	} else {
	    set myok 0
	    set myerror [list $myloc [list [pt::pe range $toks $toke]]]
	    incr myloc -1
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    # - -- --- ----- -------- ------------- ---------------------

    method si:next_alnum {} {
	debug.pt/rdengine {[Instruction si:next_alnum]}
	#Asm::Ins i_input_next alnum
	#Asm::Ins i:fail_return
	#Asm::Ins i_test_alnum

	incr myloc
	if {($myloc >= [string length $mytoken]) && ![my ExtendTC]} {
	    set myok    0
	    set myerror [list $myloc [list alnum]]
	    # i:fail_return
	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set mycurrent [string index $mytoken $myloc]

	set myok [string is alnum -strict $mycurrent]
	if {!$myok} {
	    set myerror [list $myloc [list alnum]]
	    incr myloc -1
	} else {
	    set myerror {}
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:next_alpha {} {
	debug.pt/rdengine {[Instruction si:next_alpha]}
	#Asm::Ins i_input_next alpha
	#Asm::Ins i:fail_return
	#Asm::Ins i_test_alpha

	incr myloc
	if {($myloc >= [string length $mytoken]) && ![my ExtendTC]} {
	    set myok    0
	    set myerror [list $myloc [list alpha]]
	    # i:fail_return
	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set mycurrent [string index $mytoken $myloc]

	set myok [string is alpha -strict $mycurrent]
	if {!$myok} {
	    set myerror [list $myloc [list alpha]]
	    incr myloc -1
	} else {
	    set myerror {}
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:next_ascii {} {
	debug.pt/rdengine {[Instruction si:next_ascii]}
	#Asm::Ins i_input_next ascii
	#Asm::Ins i:fail_return
	#Asm::Ins i_test_ascii

	incr myloc
	if {($myloc >= [string length $mytoken]) && ![my ExtendTC]} {
	    set myok    0
	    set myerror [list $myloc [list ascii]]
	    # i:fail_return
	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set mycurrent [string index $mytoken $myloc]

	set myok [string is ascii -strict $mycurrent]
	if {!$myok} {
	    set myerror [list $myloc [list ascii]]
	    incr myloc -1
	} else {
	    set myerror {}
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:next_control {} {
	debug.pt/rdengine {[Instruction si:next_control]}
	#Asm::Ins i_input_next control
	#Asm::Ins i:fail_return
	#Asm::Ins i_test_control

	incr myloc
	if {($myloc >= [string length $mytoken]) && ![my ExtendTC]} {
	    set myok    0
	    set myerror [list $myloc [list control]]
	    # i:fail_return
	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set mycurrent [string index $mytoken $myloc]

	set myok [string is control -strict $mycurrent]
	if {!$myok} {
	    set myerror [list $myloc [list control]]
	    incr myloc -1
	} else {
	    set myerror {}
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:next_ddigit {} {
	debug.pt/rdengine {[Instruction si:next_ddigit]}
	#Asm::Ins i_input_next ddigit
	#Asm::Ins i:fail_return
	#Asm::Ins i_test_ddigit

	incr myloc
	if {($myloc >= [string length $mytoken]) && ![my ExtendTC]} {
	    set myok    0
	    set myerror [list $myloc [list ddigit]]
	    # i:fail_return
	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set mycurrent [string index $mytoken $myloc]

	set myok [string match {[0-9]} $mycurrent]
	if {!$myok} {
	    set myerror [list $myloc [list ddigit]]
	    incr myloc -1
	} else {
	    set myerror {}
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:next_digit {} {
	debug.pt/rdengine {[Instruction si:next_digit]}
	#Asm::Ins i_input_next digit
	#Asm::Ins i:fail_return
	#Asm::Ins i_test_digit

	incr myloc
	if {($myloc >= [string length $mytoken]) && ![my ExtendTC]} {
	    set myok    0
	    set myerror [list $myloc [list digit]]
	    # i:fail_return
	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set mycurrent [string index $mytoken $myloc]

	set myok [string is digit -strict $mycurrent]
	if {!$myok} {
	    set myerror [list $myloc [list digit]]
	    incr myloc -1
	} else {
	    set myerror {}
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:next_graph {} {
	debug.pt/rdengine {[Instruction si:next_graph]}
	#Asm::Ins i_input_next graph
	#Asm::Ins i:fail_return
	#Asm::Ins i_test_graph

	incr myloc
	if {($myloc >= [string length $mytoken]) && ![my ExtendTC]} {
	    set myok    0
	    set myerror [list $myloc [list graph]]
	    # i:fail_return
	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set mycurrent [string index $mytoken $myloc]

	set myok [string is graph -strict $mycurrent]
	if {!$myok} {
	    set myerror [list $myloc [list graph]]
	    incr myloc -1
	} else {
	    set myerror {}
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:next_lower {} {
	debug.pt/rdengine {[Instruction si:next_lower]}
	#Asm::Ins i_input_next lower
	#Asm::Ins i:fail_return
	#Asm::Ins i_test_lower

	incr myloc
	if {($myloc >= [string length $mytoken]) && ![my ExtendTC]} {
	    set myok    0
	    set myerror [list $myloc [list lower]]
	    # i:fail_return
	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set mycurrent [string index $mytoken $myloc]

	set myok [string is lower -strict $mycurrent]
	if {!$myok} {
	    set myerror [list $myloc [list lower]]
	    incr myloc -1
	} else {
	    set myerror {}
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:next_print {} {
	debug.pt/rdengine {[Instruction si:next_print]}
	#Asm::Ins i_input_next print
	#Asm::Ins i:fail_return
	#Asm::Ins i_test_print

	incr myloc
	if {($myloc >= [string length $mytoken]) && ![my ExtendTC]} {
	    set myok    0
	    set myerror [list $myloc [list print]]
	    # i:fail_return
	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set mycurrent [string index $mytoken $myloc]

	set myok [string is print -strict $mycurrent]
	if {!$myok} {
	    set myerror [list $myloc [list print]]
	    incr myloc -1
	} else {
	    set myerror {}
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:next_punct {} {
	debug.pt/rdengine {[Instruction si:next_punct]}
	#Asm::Ins i_input_next punct
	#Asm::Ins i:fail_return
	#Asm::Ins i_test_punct

	incr myloc
	if {($myloc >= [string length $mytoken]) && ![my ExtendTC]} {
	    set myok    0
	    set myerror [list $myloc [list punct]]
	    # i:fail_return
	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set mycurrent [string index $mytoken $myloc]

	set myok [string is punct -strict $mycurrent]
	if {!$myok} {
	    set myerror [list $myloc [list punct]]
	    incr myloc -1
	} else {
	    set myerror {}
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:next_space {} {
	debug.pt/rdengine {[Instruction si:next_space]}
	#Asm::Ins i_input_next space
	#Asm::Ins i:fail_return
	#Asm::Ins i_test_space

	incr myloc
	if {($myloc >= [string length $mytoken]) && ![my ExtendTC]} {
	    set myok    0
	    set myerror [list $myloc [list space]]
	    # i:fail_return
	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set mycurrent [string index $mytoken $myloc]

	set myok [string is space -strict $mycurrent]
	if {!$myok} {
	    set myerror [list $myloc [list space]]
	    incr myloc -1
	} else {
	    set myerror {}
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:next_upper {} {
	debug.pt/rdengine {[Instruction si:next_upper]}
	#Asm::Ins i_input_next upper
	#Asm::Ins i:fail_return
	#Asm::Ins i_test_upper

	incr myloc
	if {($myloc >= [string length $mytoken]) && ![my ExtendTC]} {
	    set myok    0
	    set myerror [list $myloc [list upper]]
	    # i:fail_return
	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set mycurrent [string index $mytoken $myloc]

	set myok [string is upper -strict $mycurrent]
	if {!$myok} {
	    set myerror [list $myloc [list upper]]
	    incr myloc -1
	} else {
	    set myerror {}
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:next_wordchar {} {
	debug.pt/rdengine {[Instruction si:next_wordchar]}
	#Asm::Ins i_input_next wordchar
	#Asm::Ins i:fail_return
	#Asm::Ins i_test_wordchar

	incr myloc
	if {($myloc >= [string length $mytoken]) && ![my ExtendTC]} {
	    set myok    0
	    set myerror [list $myloc [list wordchar]]
	    # i:fail_return
	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set mycurrent [string index $mytoken $myloc]

	set myok [string is wordchar -strict $mycurrent]
	if {!$myok} {
	    set myerror [list $myloc [list wordchar]]
	    incr myloc -1
	} else {
	    set myerror {}
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:next_xdigit {} {
	debug.pt/rdengine {[Instruction si:next_xdigit]}
	#Asm::Ins i_input_next xdigit
	#Asm::Ins i:fail_return
	#Asm::Ins i_test_xdigit

	incr myloc
	if {($myloc >= [string length $mytoken]) && ![my ExtendTC]} {
	    set myok    0
	    set myerror [list $myloc [list xdigit]]
	    # i:fail_return
	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set mycurrent [string index $mytoken $myloc]

	set myok [string is xdigit -strict $mycurrent]
	if {!$myok} {
	    set myerror [list $myloc [list xdigit]]
	    incr myloc -1
	} else {
	    set myerror {}
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    # - -- --- ----- -------- ------------- ---------------------

    method si:value_symbol_start {symbol} {
	debug.pt/rdengine {[Instruction si:value_symbol_start $symbol]}
	# if @runtime@ i_symbol_restore $symbol
	# i:found:ok_ast_value_push
	# i:found_return
	# i_loc_push
	# i_ast_push

	set k [list $myloc $symbol]
	if {[info exists mysymbol($k)]} { 
	    lassign $mysymbol($k) myloc myok myerror mysvalue
	    if {$myok} {
		$mystackast push $mysvalue
	    }
	    debug.pt/rdengine {[InstReturn]}
	    return -code return
	}
	$mystackloc  push $myloc
	$mystackmark push [$mystackast size]

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:value_void_symbol_start {symbol} {
	debug.pt/rdengine {[Instruction si:value_void_symbol_start $symbol]}
	# if @runtime@ i_symbol_restore $symbol
	# i:found_return
	# i_loc_push
	# i_ast_push

	set k [list $myloc $symbol]
	if {[info exists mysymbol($k)]} { 
	    lassign $mysymbol($k) myloc myok myerror mysvalue
	    debug.pt/rdengine {[InstReturn]}
	    return -code return
	}
	$mystackloc  push $myloc
	$mystackmark push [$mystackast size]

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:void_symbol_start {symbol} {
	debug.pt/rdengine {[Instruction si:void_symbol_start $symbol]}
	# if @runtime@ i_symbol_restore $symbol
	# i:found:ok_ast_value_push
	# i:found_return
	# i_loc_push

	set k [list $myloc $symbol]
	if {[info exists mysymbol($k)]} { 
	    lassign $mysymbol($k) myloc myok myerror mysvalue
	    if {$myok} {
		$mystackast push $mysvalue
	    }
	    debug.pt/rdengine {[InstReturn]}
	    return -code return
	}
	$mystackloc push $myloc

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:void_void_symbol_start {symbol} {
	debug.pt/rdengine {[Instruction si:void_void_symbol_start $symbol]}
	# if @runtime@ i_symbol_restore $symbol
	# i:found_return
	# i_loc_push

	set k [list $myloc $symbol]
	if {[info exists mysymbol($k)]} { 
	    lassign $mysymbol($k) myloc myok myerror mysvalue
	    debug.pt/rdengine {[InstReturn]}
	    return -code return
	}
	$mystackloc push $myloc

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:reduce_symbol_end {symbol} {
	debug.pt/rdengine {[Instruction si:reduce_symbol_end $symbol]}
	# i_value_clear/reduce $symbol
	# i_symbol_save       $symbol
	# i_error_nonterminal $symbol
	# i_ast_pop_rewind
	# i_loc_pop_discard
	# i:ok_ast_value_push

	set mysvalue {}
	set at [$mystackloc pop]

	if {$myok} {
	    set  mark [$mystackmark peek];# Old size of stack before current nt pushed more.
	    set  newa [expr {[$mystackast size] - $mark}]
	    set  pos  $at
	    incr pos

	    if {!$newa} {
		set mysvalue {}
	    } elseif {$newa == 1} {
		# peek 1 => single element comes back
		set mysvalue [list [$mystackast peek]]     ; # SaveToMark
	    } else {
		# peek n > 1 => list of elements comes back
		set mysvalue [$mystackast peekr $newa]     ; # SaveToMark
	    }

	    if {$at == $myloc} {
		# The symbol did not process any input. As this is
		# signaled to be ok (*) we create a node covering an
		# empty range. (Ad *): Can happen for a RHS using
		# toplevel operators * or ?.
		set mysvalue [pt::ast new0 $symbol $pos {*}$mysvalue]
	    } else {
		set mysvalue [pt::ast new $symbol $pos $myloc {*}$mysvalue] ; # Reduce $symbol
	    }
	}

	set k  [list $at $symbol]
	set mysymbol($k) [list $myloc $myok $myerror $mysvalue]

	# si:reduce_symbol_end / i_error_nonterminal -- inlined -- disabled
	if {0} {if {[llength $myerror]} {
	    set  pos $at
	    incr pos
	    lassign $myerror loc messages
	    if {$loc == $pos} {
		set myerror [list $loc [list [list n $symbol]]]
	    }
	}}

	$mystackast trim* [$mystackmark pop]
	if {$myok} {
	    $mystackast push $mysvalue
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:void_leaf_symbol_end {symbol} {
	debug.pt/rdengine {[Instruction si:void_leaf_symbol_end $symbol]}
	# i_value_clear/leaf $symbol
	# i_symbol_save       $symbol
	# i_error_nonterminal $symbol
	# i_loc_pop_discard
	# i:ok_ast_value_push

	set mysvalue {}
	set at [$mystackloc pop]

	if {$myok} {
	    set  pos $at
	    incr pos
	    if {$at == $myloc} {
		# The symbol did not process any input. As this is
		# signaled to be ok (*) we create a node covering an
		# empty range. (Ad *): Can happen for a RHS using
		# toplevel operators * or ?.
		set mysvalue [pt::ast new0 $symbol $pos]
	    } else {
		set mysvalue [pt::ast new $symbol $pos $myloc]
	    }
	}

	set k  [list $at $symbol]
	set mysymbol($k) [list $myloc $myok $myerror $mysvalue]

	# si:void_leaf_symbol_end / i_error_nonterminal -- inlined -- disabled
	if {0} {if {[llength $myerror]} {
	    set  pos $at
	    incr pos
	    lassign $myerror loc messages
	    if {$loc == $pos} {
		set myerror [list $loc [list [list n $symbol]]]
	    }
	}}

	if {$myok} {
	    $mystackast push $mysvalue
	}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:value_leaf_symbol_end {symbol} {
	debug.pt/rdengine {[Instruction si:value_leaf_symbol_end $symbol]}
	# i_value_clear/leaf $symbol
	# i_symbol_save       $symbol
	# i_error_nonterminal $symbol
	# i_loc_pop_discard
	# i_ast_pop_rewind
	# i:ok_ast_value_push

	set mysvalue {}
	set at [$mystackloc pop]

	if {$myok} {
	    set  pos $at
	    incr pos
	    if {$at == $myloc} {
		# The symbol did not process any input. As this is
		# signaled to be ok (*) we create a node covering an
		# empty range. (Ad *): Can happen for a RHS using
		# toplevel operators * or ?.
		set mysvalue [pt::ast new0 $symbol $pos]
	    } else {
		set mysvalue [pt::ast new $symbol $pos $myloc]
	    }
	}

	set k  [list $at $symbol]
	set mysymbol($k) [list $myloc $myok $myerror $mysvalue]

	# si:value_leaf_symbol_end / i_error_nonterminal -- inlined -- disabled
	if {0} {if {[llength $myerror]} {
	    set  pos $at
	    incr pos
	    lassign $myerror loc messages
	    if {$loc == $pos} {
		set myerror [list $loc [list [list n $symbol]]]
	    }
	}}

	$mystackast trim* [$mystackmark pop]
	if {$myok} {
	    $mystackast push $mysvalue
	}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:value_clear_symbol_end {symbol} {
	debug.pt/rdengine {[Instruction si:value_clear_symbol_end $symbol]}
	# i_value_clear
	# i_symbol_save       $symbol
	# i_error_nonterminal $symbol
	# i_loc_pop_discard
	# i_ast_pop_rewind

	set mysvalue {}
	set at [$mystackloc pop]

	set k  [list $at $symbol]
	set mysymbol($k) [list $myloc $myok $myerror $mysvalue]

	# si:value_clear_symbol_end / i_error_nonterminal -- inlined -- disabled
	if {0} {if {[llength $myerror]} {
	    set  pos $at
	    incr pos
	    lassign $myerror loc messages
	    if {$loc == $pos} {
		set myerror [list $loc [list [list n $symbol]]]
	    }
	}}

	$mystackast trim* [$mystackmark pop]
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method si:void_clear_symbol_end {symbol} {
	debug.pt/rdengine {[Instruction si:void_clear_symbol_end $symbol]}
	# i_value_clear
	# i_symbol_save       $symbol
	# i_error_nonterminal $symbol
	# i_loc_pop_discard

	set mysvalue {}
	set at [$mystackloc pop]

	set k  [list $at $symbol]
	set mysymbol($k) [list $myloc $myok $myerror $mysvalue]

	# si:void_clear_symbol_end / i_error_nonterminal -- inlined -- disabled
	if {0} {if {[llength $myerror]} {
	    set  pos $at
	    incr pos
	    lassign $myerror loc messages
	    if {$loc == $pos} {
		set myerror [list $loc [list [list n $symbol]]]
	    }
	}}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    # # ## ### ##### ######## ############# #####################
    ## API - Instructions - Control flow

    method i:ok_continue {} {
	debug.pt/rdengine {[Instruction i:ok_continue]}
	if {!$myok} return
	return -code continue
    }

    method i:fail_continue {} {
	debug.pt/rdengine {[Instruction i:fail_continue]}
	if {$myok} return
	return -code continue
    }

    method i:fail_return {} {
	debug.pt/rdengine {[Instruction i:fail_return]}
	if {$myok} return
	return -code return
    }

    method i:ok_return {} {
	debug.pt/rdengine {[Instruction i:ok_return]}
	if {!$myok} return
	return -code return
    }

    # # ## ### ##### ######## ############# #####################
    ##  API - Instructions - Unconditional matching.

    method i_status_ok {} {
	debug.pt/rdengine {[Instruction i_status_ok]}
	set myok 1
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_status_fail {} {
	debug.pt/rdengine {[Instruction i_status_fail]}
	set myok 0
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_status_negate {} {
	debug.pt/rdengine {[Instruction i_status_negate]}
	set myok [expr {!$myok}]
	debug.pt/rdengine {[InstReturn]}
	return
    }

    # # ## ### ##### ######## ############# #####################
    ##  API - Instructions - Error handling.

    method i_error_clear {} {
	debug.pt/rdengine {[Instruction i_error_clear]}
	set myerror {}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_error_push {} {
	debug.pt/rdengine {[Instruction i_error_push]}
	$mystackerr push $myerror
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_error_clear_push {} {
	debug.pt/rdengine {[Instruction i_error_clear_push]}
	set myerror {}
	$mystackerr push {}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_error_pop_merge {} {
	debug.pt/rdengine {[Instruction i_error_pop_merge]}
	set olderror [$mystackerr pop]

	# We have either old or new error data, keep it.

	if {![llength $myerror]}  { set myerror $olderror ; debug.pt/rdengine {[InstReturn]} ; return }
	if {![llength $olderror]} { debug.pt/rdengine {[InstReturn]} ; return }

	# If one of the errors is further on in the input choose that as
	# the information to propagate.

	lassign $myerror  loe msgse
	lassign $olderror lon msgsn

	if {$lon > $loe} { set myerror $olderror ; debug.pt/rdengine {[InstReturn]} ; return }
	if {$loe > $lon} { debug.pt/rdengine {[InstReturn]} ; return }

	# Equal locations, merge the message lists.
	set myerror [list $loe [lsort -uniq [list {*}$msgse {*}$msgsn]]]
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_error_nonterminal {symbol} {
	debug.pt/rdengine {[Instruction i_error_nonterminal $symbol]}
	#  i_error_nonterminal -- Disabled. Generate only low-level
	#  i_error_nonterminal -- errors until we have worked out how
	#  i_error_nonterminal -- to integrate symbol information with
	#  i_error_nonterminal -- them. Do not forget where this
	#  i_error_nonterminal -- instruction is inlined.
	return

	# Inlined: Errors, Expected.
	if {![llength $myerror]} {
	    debug.pt/rdengine {no error}
	    return
	}
	set pos [$mystackloc peek]
	incr pos
	lassign $myerror loc messages
	if {$loc != $pos} {
	    debug.pt/rdengine {my $myerror != pos $pos}
	    return
	}
	set myerror [list $loc [list [list n $symbol]]]

	debug.pt/rdengine {::= ($myerror)}
	return
    }

    # # ## ### ##### ######## ############# #####################
    ##  API - Instructions - Basic input handling and tracking

    method i_loc_pop_rewind/discard {} {
	debug.pt/rdengine {[Instruction i_loc_pop_rewind/discard]}
	#$myparser i:fail_loc_pop_rewind
	#$myparser i:ok_loc_pop_discard
	#return
	set last [$mystackloc pop]
	if {!$myok} {
	    set myloc $last
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_loc_pop_discard {} {
	debug.pt/rdengine {[Instruction i_loc_pop_discard]}
	$mystackloc pop
	debug.pt/rdengine {[InstReturn]}
	return
    }

    # i:ok_loc_pop_discard - all uses inlined

    method i_loc_pop_rewind {} {
	debug.pt/rdengine {[Instruction i_loc_pop_rewind]}
	set myloc [$mystackloc pop]
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i:fail_loc_pop_rewind {} {
	debug.pt/rdengine {[Instruction i:fail_loc_pop_rewind]}
	if {!$myok} {
	    set myloc [$mystackloc pop]
	}
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_loc_push {} {
	debug.pt/rdengine {[Instruction i_loc_push]}
	$mystackloc push $myloc
	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_loc_rewind {} {
	debug.pt/rdengine {[Instruction i_loc_rewind]}
	# i_loc_pop_rewind - set myloc [$mystackloc pop]
	# i_loc_push       - $mystackloc push $myloc    
	set myloc [$mystackloc peek]
	debug.pt/rdengine {[InstReturn]}
	return
    }

    # # ## ### ##### ######## ############# #####################
    ##  API - Instructions - AST stack handling

    method i_ast_pop_rewind/discard {} {
	debug.pt/rdengine {[Instruction i_ast_pop_rewind/discard]}
	#$myparser i:fail_ast_pop_rewind
	#$myparser i:ok_ast_pop_discard
	#return
	set mark [$mystackmark pop]
	if {!$myok} {
	    $mystackast trim* $mark
	}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_ast_pop_discard/rewind {} {
	debug.pt/rdengine {[Instruction i_ast_pop_discard/rewind]}
	#$myparser i:ok_ast_pop_rewind
	#$myparser i:fail_ast_pop_discard
	#return
	set mark [$mystackmark pop]
	if {$myok} {
	    $mystackast trim* $mark
	}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_ast_pop_discard {} {
	debug.pt/rdengine {[Instruction i_ast_pop_discard]}
	$mystackmark pop

	debug.pt/rdengine {[InstReturn]}
	return
    }

    # i:ok_ast_pop_discard - all uses inlined

    method i_ast_pop_rewind {} {
	debug.pt/rdengine {[Instruction i_ast_pop_rewind]}
	$mystackast trim* [$mystackmark pop]

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i:fail_ast_pop_rewind {} {
	debug.pt/rdengine {[Instruction i:fail_ast_pop_rewind]}
	if {!$myok} {
	    $mystackast trim* [$mystackmark pop]
	}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_ast_push {} {
	debug.pt/rdengine {[Instruction i_ast_push]}
	$mystackmark push [$mystackast size]

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i:ok_ast_value_push {} {
	debug.pt/rdengine {[Instruction i:ok_ast_value_push]}
	if {$myok} {
	    $mystackast push $mysvalue
	}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    # i_ast_rewind - all uses inlined

    # # ## ### ##### ######## ############# #####################
    ## API - Instructions - Nonterminal cache

    method i_symbol_restore {symbol} {
	debug.pt/rdengine {[Instruction i_symbol_restore $symbol]}
	# Satisfy from cache if possible.
	set k [list $myloc $symbol]
	if {![info exists mysymbol($k)]} {
	    debug.pt/rdengine {[InstReturn]}
	    return 0
	}
	lassign $mysymbol($k) myloc myok myerror mysvalue
	# We go forward, as the nonterminal matches (or not).
	debug.pt/rdengine {[InstReturn]}
	return 1
    }

    method i_symbol_save {symbol} {
	debug.pt/rdengine {[Instruction i_symbol_save $symbol]}
	# Store not only the value, but also how far
	# the match went (if it was a match).
	set at [$mystackloc peek]
	set k  [list $at $symbol]
	set mysymbol($k) [list $myloc $myok $myerror $mysvalue]

	debug.pt/rdengine {[InstReturn]}
	return
    }

    # # ## ### ##### ######## ############# #####################
    ##  API - Instructions - Semantic values.

    method i_value_clear {} {
	debug.pt/rdengine {[Instruction i_value_clear]}
	set mysvalue {}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_value_clear/leaf {symbol} {
	debug.pt/rdengine {[Instruction i_value_clear/leaf $symbol] :: ([expr {[$mystackloc peek]+1}])-@$myloc)}

	# not quite value_lead (guarded, and clear on fail)
	# Inlined clear, reduce, and optimized.
	# Clear ; if {$ok} {Reduce $symbol}
	set mysvalue {}
        if {$myok} {
	    set  pos [$mystackloc peek]
	    incr pos

	    if {($pos - 1) == $myloc} {
		# The symbol did not process any input. As this is
		# signaled to be ok (*) we create a node covering an
		# empty range. (Ad *): Can happen for a RHS using
		# toplevel operators * or ?.
		set mysvalue [pt::ast new0 $symbol $pos]
	    } else {
		set mysvalue [pt::ast new $symbol $pos $myloc]
	    }
	}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_value_clear/reduce {symbol} {
	debug.pt/rdengine {[Instruction i_value_clear/reduce $symbol]}
	set mysvalue {}
        if {$myok} {
	    set  mark [$mystackmark peek];# Old size of stack before current nt pushed more.
	    set  newa [expr {[$mystackast size] - $mark}]

	    set  pos  [$mystackloc  peek]
	    incr pos

	    if {!$newa} {
		set mysvalue {}
	    } elseif {$newa == 1} {
		# peek 1 => single element comes back
		set mysvalue [list [$mystackast peek]]     ; # SaveToMark
	    } else {
		# peek n > 1 => list of elements comes back
		set mysvalue [$mystackast peekr $newa]     ; # SaveToMark
	    }

	    if {($pos - 1) == $myloc} {
		# The symbol did not process any input. As this is
		# signaled to be ok (*) we create a node covering an
		# empty range. (Ad *): Can happen for a RHS using
		# toplevel operators * or ?.
		set mysvalue [pt::ast new0 $symbol $pos {*}$mysvalue]
	    } else {
		set mysvalue [pt::ast new $symbol $pos $myloc {*}$mysvalue] ; # Reduce $symbol
	    }
	}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    # # ## ### ##### ######## ############# #####################
    ## API - Instructions - Terminal matching

    method i_input_next {msg} {
	debug.pt/rdengine {[Instruction i_input_next $msg]}
	# Inlined: Getch, Expected, ClearErrors
	# Satisfy from input cache if possible.

	incr myloc
	# May read from the input (ExtendTC), and remember the
	# information. Note: We are implicitly incrementing the
	# location!
	if {($myloc >= [string length $mytoken]) && ![my ExtendTC]} {
	    set myok    0
	    set myerror [list $myloc [list $msg]]

	    debug.pt/rdengine {[InstReturn]}
	    return
	}
	set mycurrent [string index $mytoken $myloc]

	set myok    1
	set myerror {}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_test_char {tok} {
	debug.pt/rdengine {[Instruction i_test_char $tok] :: ok [expr {$tok eq $mycurrent}], [expr {$tok eq $mycurrent ? "@$myloc" : "back@[expr {$myloc-1}]"}]}
	set myok [expr {$tok eq $mycurrent}]
	my OkFailD {pt::pe terminal $tok}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_test_range {toks toke} {
	debug.pt/rdengine {[Instruction i_test_range $toks $toke]}
	set myok [expr {
			([string compare $toks $mycurrent] <= 0) &&
			([string compare $mycurrent $toke] <= 0)
		    }] ; # {}
	my OkFailD {pt::pe range $toks $toke}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_test_alnum {} {
	debug.pt/rdengine {[Instruction i_test_alnum]}
	set myok [string is alnum -strict $mycurrent]
	my OkFailD {pt::pe alnum}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_test_alpha {} {
	debug.pt/rdengine {[Instruction i_test_alpha]}
	set myok [string is alpha -strict $mycurrent]
	my OkFailD {pt::pe alpha}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_test_ascii {} {
	debug.pt/rdengine {[Instruction i_test_ascii]}
	set myok [string is ascii -strict $mycurrent]
	my OkFailD {pt::pe ascii}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_test_control {} {
	debug.pt/rdengine {[Instruction i_test_control]}
	set myok [string is control -strict $mycurrent]
	my OkFailD {pt::pe control}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_test_ddigit {} {
	debug.pt/rdengine {[Instruction i_test_ddigit]}
	set myok [string match {[0-9]} $mycurrent]
	my OkFailD {pt::pe ddigit}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_test_digit {} {
	debug.pt/rdengine {[Instruction i_test_digit]}
	set myok [string is digit -strict $mycurrent]
	my OkFailD {pt::pe digit}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_test_graph {} {
	debug.pt/rdengine {[Instruction i_test_graph]}
	set myok [string is graph -strict $mycurrent]
	my OkFailD {pt::pe graph}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_test_lower {} {
	debug.pt/rdengine {[Instruction i_test_lower]}
	set myok [string is lower -strict $mycurrent]
	my OkFailD {pt::pe lower}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_test_print {} {
	debug.pt/rdengine {[Instruction i_test_print]}
	set myok [string is print -strict $mycurrent]
	my OkFailD {pt::pe printable}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_test_punct {} {
	debug.pt/rdengine {[Instruction i_test_punct]}
	set myok [string is punct -strict $mycurrent]
	my OkFailD {pt::pe punct}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_test_space {} {
	debug.pt/rdengine {[Instruction i_test_space]}
	set myok [string is space -strict $mycurrent]
	my OkFailD {pt::pe space}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_test_upper {} {
	debug.pt/rdengine {[Instruction i_test_upper]}
	set myok [string is upper -strict $mycurrent]
	my OkFailD {pt::pe upper}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_test_wordchar {} {
	debug.pt/rdengine {[Instruction i_test_wordchar]}
	set myok [string is wordchar -strict $mycurrent]
	my OkFailD {pt::pe wordchar}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    method i_test_xdigit {} {
	debug.pt/rdengine {[Instruction i_test_xdigit]}
	set myok [string is xdigit -strict $mycurrent]
	my OkFailD {pt::pe xdigit}

	debug.pt/rdengine {[InstReturn]}
	return
    }

    # # ## ### ##### ######## ############# #####################
    ## Internals

    method ExtendTC {} {
	if {($mychan eq {}) ||
	    [eof $mychan]} {return 0}

	set ch [read $mychan 1]
	if {$ch eq {}} {
	    return 0
	}

	append mytoken $ch
	return 1
    }

    method ExtendTCN {n} {
	if {($mychan eq {}) ||
	    [eof $mychan]} {return 0}

	set str [read $mychan $n]
	set k   [string length $str]

	append mytoken $str
	if {$k < $n} {
	    return 0
	}

	return 1
    }

    method OkFailD {msgcmd} {
	# Inlined: Expected, Unget, ClearErrors
	if {!$myok} {
	    set myerror [list $myloc [list [uplevel 1 $msgcmd]]]
	    incr myloc -1
	} else {
	    set myerror {}
	}
	return
    }

    # # ## ### ##### ######## ############# #####################
    ## Data structures.
    ## Mainly the architectural state of the instance's PARAM.

    variable \
	mychan mycurrent myloc mystackloc \
	myok mysvalue myerror mystackerr \
	mytoken mysymbol mystackast mystackmark \
	mytracecounter

    # Parser Input (channel, location (line, column)) ...........
    # Token, current parsing location, stack of locations .......
    # Match state .  ........ ............. .....................
    # Caches for tokens and nonterminals .. .....................
    # Abstract syntax tree (AST) .......... .....................

    # # ## ### ##### ######## ############# #####################
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide pt::rde::oo 1.2
return
