Tcl Library Source Code

2014-01-22  Andreas Kupries  <aku@hephaistos>

	* pt_peg_from_peg.man: Fixed handling of empty strings in a
	* pt_peg_from_peg.tcl: PEG. Treat as <epsilon>. Bumped to 1.0.2
	* pt_peg_to_peg.man: Fixed generation of PEG from
	* pt_peg_to_peg.tcl: <epsilon>. Produce a proper empty
	  string. Bumped to 1.0.1

	* tests/data/ok/peg_container-bulk/11_epsilon: New files to test
	* tests/data/ok/peg_container-incremental/11_epsilon: handling of
	* tests/data/ok/peg_container-templated-bulk/11_epsilon: <epsilon>
	* tests/data/ok/peg_container-templated-incremental/11_epsilon: and
	* tests/data/ok/peg_cparam/11_epsilon: empty strings across the board.
	* tests/data/ok/peg_cparam-critcl/11_epsilon:
	* tests/data/ok/peg_json-indalign/11_epsilon:
	* tests/data/ok/peg_json-indented/11_epsilon:
	* tests/data/ok/peg_json-ultracompact/11_epsilon:
	* tests/data/ok/peg_param/11_epsilon:
	* tests/data/ok/peg_param-compact/11_epsilon:
	* tests/data/ok/peg_param-inlined/11_epsilon:
	* tests/data/ok/peg_param-unopt/11_epsilon:
	* tests/data/ok/peg_peg/11_epsilon:
	* tests/data/ok/peg_peg-ast/11_epsilon:
	* tests/data/ok/peg_peg-ast-fused/11_epsilon:
	* tests/data/ok/peg_peg-ast-templated/11_epsilon:
	* tests/data/ok/peg_peg-ast-templated-fused/11_epsilon:
	* tests/data/ok/peg_peg-fused/11_epsilon:
	* tests/data/ok/peg_peg-templated/11_epsilon:
	* tests/data/ok/peg_peg-templated-fused/11_epsilon:
	* tests/data/ok/peg_serial/11_epsilon:
	* tests/data/ok/peg_serial-canonical/11_epsilon:
	* tests/data/ok/peg_serial-print/11_epsilon:
	* tests/data/ok/peg_tclparam/11_epsilon:
	* tests/data/ok/peg_tclparam-snit/11_epsilon:
	* tests/data/ok/peg_tclparam-tcloo/11_epsilon:

2013-12-17  Andreas Kupries <[email protected]>

	* pt_parse_peg.man: Added missing documentation for the PEG parser
	  package.
	* pt_peg_op.man: Added missing documentation for this utility package.
	* pt_peg_op.tcl: Exported 'minimize'.

package ifneeded pt::peg::import::peg       1 [list source [file join $dir pt_peg_import_peg.tcl]]

# Export core functionality: Conversion from PEG to a specific format.
package ifneeded pt::peg::to::container 1 [list source [file join $dir pt_peg_to_container.tcl]]
package ifneeded pt::peg::to::cparam    1.0.1 [list source [file join $dir pt_peg_to_cparam.tcl]]
package ifneeded pt::peg::to::json      1 [list source [file join $dir pt_peg_to_json.tcl]]
package ifneeded pt::peg::to::param     1 [list source [file join $dir pt_peg_to_param.tcl]]
package ifneeded pt::peg::to::peg   1.0.1 [list source [file join $dir pt_peg_to_peg.tcl]]
package ifneeded pt::peg::to::tclparam  1 [list source [file join $dir pt_peg_to_tclparam.tcl]]

# Import core functionality: Conversion from a specific format to PEG.
package ifneeded pt::peg::from::json      1 [list source [file join $dir pt_peg_from_json.tcl]]
package ifneeded pt::peg::from::peg   1.0.2 [list source [file join $dir pt_peg_from_peg.tcl]]

# PARAM runtime.
package ifneeded pt::rde      1.0.2 [list source [file join $dir pt_rdengine.tcl]]
package ifneeded pt::rde::oo  1.0.2 [list source [file join $dir pt_rdengine_oo.tcl]]

# PEG grammar specification, as CONTAINER
package ifneeded pt::peg::container::peg 1 [list source [file join $dir pt_peg_container_peg.tcl]]

[comment {--- doctools ---}]
[vset PACKAGE peg]
[vset NAME    PEG]
[vset REQUIRE peg]
[vset CONFIG  peg]
[vset VERSION 1.0.2]
[include include/import/from.inc]

}

proc pt::peg::from::peg::GEN::LOWER {s e} {
    return [pt::pe lower]
}

proc pt::peg::from::peg::GEN::Literal {s e args} {
    set n [llength $args]
    if {$n == 1} {
	# integrated pe::op flatten, return just the char.
	return [lindex $args 0]
    } elseif {$n == 0} {
	# No chars, empty string, IOW epsilon.
	return [pt::pe epsilon]
    } else {
	# Series of chars -> Primary
	return [pt::pe sequence {*}$args]
    }
}

proc pt::peg::from::peg::GEN::NOT {s e} {
    return [pt::pe notahead [pt::pe dot]] ; # -> Prefix (dot is placeholder)
}

proc pt::peg::from::peg::GEN::XDIGIT {s e} {
    return [pt::pe xdigit]  
}

# ### ### ### ######### ######### #########
## Ready

package provide pt::peg::from::peg 1.0.2
return

[comment {--- doctools ---}]
[vset PACKAGE peg]
[vset NAME    PEG]
[vset REQUIRE peg]
[vset CONFIG  peg]
[vset VERSION 1.0.1]
[include include/export/to.inc]

	    return [list <$operator> $pe]
	}
	dot {
	    # Special form ...
	    return [list "." $pe]
	}
	epsilon {
	    # Special form, represented by the empty string ...
	    return [list "''" $pe]
	}
	t {
	    # Character ...
	    lassign $arguments char
	    return [list "'[Char ${char}]'" $pe]
	}
	.. {

	? 3  alpha   4  space 4
    }
}

# ### ### ### ######### ######### #########
## Ready

package provide pt::peg::to::peg 1.0.1
return

snit::type a_pe_grammar {
    constructor {} {
        install myg using pt::peg::container ${selfns}::G
        $myg start {/ {t a} epsilon}
    }

    component myg
    delegate method * to myg
}

snit::type a_pe_grammar {
    constructor {} {
        install myg using pt::peg::container ${selfns}::G
        $myg start {/ {t a} epsilon}
    }

    component myg
    delegate method * to myg
}

# -*- tcl -*-
# Parsing Expression Grammar 'TEMPLATE'.
# Generated for unknown, from file 'TEST'

package require Tcl 8.5
package require snit
package require pt::peg::container

snit::type TEMPLATE {
    constructor {} {
        install myg using pt::peg::container ${selfns}::G
        $myg start {/ {t a} epsilon}
    }

    component myg
    delegate method * to myg
}

package provide TEMPLATE
return

# -*- tcl -*-
# Parsing Expression Grammar 'TEMPLATE'.
# Generated for unknown, from file 'TEST'

package require Tcl 8.5
package require snit
package require pt::peg::container

snit::type TEMPLATE {
    constructor {} {
        install myg using pt::peg::container ${selfns}::G
        $myg start {/ {t a} epsilon}
    }

    component myg
    delegate method * to myg
}

package provide TEMPLATE
return

## -*- tcl -*-
##
## Critcl-based C/PARAM implementation of the parsing
## expression grammar
##
##	TEMPLATE
##
## Generated from file	TEST
##            for user  unknown
##
# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.4
package require critcl
# @sak notprovided PACKAGE
package provide    PACKAGE 1

# Note: The implementation of the PARAM virtual machine
#       underlying the C/PARAM code used below is inlined
#       into the generated parser, allowing for direct access
#       and manipulation of the RDE state, instead of having
#       to dispatch through the Tcl interpreter.

# # ## ### ##### ######## ############# #####################
##

namespace eval ::PARSER {
    # # ## ### ##### ######## ############# #####################
    ## Supporting code for the main command.

    catch {
	#critcl::cheaders -g
	#critcl::debug memory symbols
    }

    # # ## ### ###### ######## #############
    ## RDE runtime, inlined, and made static.

    # This is the C code for the RDE, i.e. the implementation
    # of pt::rde. Only the low-level engine is imported, the
    # Tcl interface layer is ignored.  This generated parser
    # provides its own layer for that.

    critcl::ccode {
	/* -*- c -*- */

	#include <string.h>
	#define SCOPE static

#line 1 "rde_critcl/util.h"

	#ifndef _RDE_UTIL_H
	#define _RDE_UTIL_H 1
	#ifndef SCOPE
	#define SCOPE
	#endif
	#define ALLOC(type)    (type *) ckalloc (sizeof (type))
	#define NALLOC(n,type) (type *) ckalloc ((n) * sizeof (type))
	#undef  RDE_DEBUG
	#define RDE_DEBUG 1
	#undef  RDE_TRACE
	#ifdef RDE_DEBUG
	#define STOPAFTER(x) { static int count = (x); count --; if (!count) { Tcl_Panic ("stop"); } }
	#define XSTR(x) #x
	#define STR(x) XSTR(x)
	#define RANGEOK(i,n) ((0 <= (i)) && (i < (n)))
	#define ASSERT(x,msg) if (!(x)) { Tcl_Panic (msg " (" #x "), in file " __FILE__ " @line " STR(__LINE__));}
	#define ASSERT_BOUNDS(i,n) ASSERT (RANGEOK(i,n),"array index out of bounds: " STR(i) " >= " STR(n))
	#else
	#define STOPAFTER(x)
	#define ASSERT(x,msg)
	#define ASSERT_BOUNDS(i,n)
	#endif
	#ifdef RDE_TRACE
	SCOPE void trace_enter (const char* fun);
	SCOPE void trace_return (const char *pat, ...);
	SCOPE void trace_printf (const char *pat, ...);
	#define ENTER(fun)          trace_enter (fun)
	#define RETURN(format,x)    trace_return (format,x) ; return x
	#define RETURNVOID          trace_return ("%s","(void)") ; return
	#define TRACE0(x)           trace_printf0 x
	#define TRACE(x)            trace_printf x
	#else
	#define ENTER(fun)
	#define RETURN(f,x) return x
	#define RETURNVOID  return
	#define TRACE0(x)
	#define TRACE(x)
	#endif
	#endif 
	

#line 1 "rde_critcl/stack.h"

	#ifndef _RDE_DS_STACK_H
	#define _RDE_DS_STACK_H 1
	typedef void (*RDE_STACK_CELL_FREE) (void* cell);
	typedef struct RDE_STACK_* RDE_STACK;
	static const int RDE_STACK_INITIAL_SIZE = 256;
	#endif 
	

#line 1 "rde_critcl/tc.h"

	#ifndef _RDE_DS_TC_H
	#define _RDE_DS_TC_H 1
	typedef struct RDE_TC_* RDE_TC;
	#endif 
	

#line 1 "rde_critcl/param.h"

	#ifndef _RDE_DS_PARAM_H
	#define _RDE_DS_PARAM_H 1
	typedef struct RDE_PARAM_* RDE_PARAM;
	typedef struct ERROR_STATE {
	    int       refCount;
	    long int  loc;
	    RDE_STACK msg; 
	} ERROR_STATE;
	typedef struct NC_STATE {
	    long int     CL;
	    long int     ST;
	    Tcl_Obj*     SV;
	    ERROR_STATE* ER;
	} NC_STATE;
	#endif 
	

#line 1 "rde_critcl/util.c"

	#ifdef RDE_TRACE
	typedef struct F_STACK {
	    const char*     str;
	    struct F_STACK* down;
	} F_STACK;
	static F_STACK* top   = 0;
	static int      level = 0;
	static void
	push (const char* str)
	{
	    F_STACK* new = ALLOC (F_STACK);
	    new->str = str;
	    new->down = top;
	    top = new;
	    level += 4;
	}
	static void
	pop (void)
	{
	    F_STACK* next = top->down;
	    level -= 4;
	    ckfree ((char*)top);
	    top = next;
	}
	static void
	indent (void)
	{
	    int i;
	    for (i = 0; i < level; i++) {
		fwrite(" ", 1, 1, stdout);
		fflush           (stdout);
	    }
	    if (top) {
		fwrite(top->str, 1, strlen(top->str), stdout);
		fflush                               (stdout);
	    }
	    fwrite(" ", 1, 1, stdout);
	    fflush           (stdout);
	}
	SCOPE void
	trace_enter (const char* fun)
	{
	    push (fun);
	    indent();
	    fwrite("ENTER\n", 1, 6, stdout);
	    fflush                 (stdout);
	}
	static char msg [1024*1024];
	SCOPE void
	trace_return (const char *pat, ...)
	{
	    int len;
	    va_list args;
	    indent();
	    fwrite("RETURN = ", 1, 9, stdout);
	    fflush                   (stdout);
	    va_start(args, pat);
	    len = vsprintf(msg, pat, args);
	    va_end(args);
	    msg[len++] = '\n';
	    msg[len] = '\0';
	    fwrite(msg, 1, len, stdout);
	    fflush             (stdout);
	    pop();
	}
	SCOPE void
	trace_printf (const char *pat, ...)
	{
	    int len;
	    va_list args;
	    indent();
	    va_start(args, pat);
	    len = vsprintf(msg, pat, args);
	    va_end(args);
	    msg[len++] = '\n';
	    msg[len] = '\0';
	    fwrite(msg, 1, len, stdout);
	    fflush             (stdout);
	}
	SCOPE void
	trace_printf0 (const char *pat, ...)
	{
	    int len;
	    va_list args;
	    va_start(args, pat);
	    len = vsprintf(msg, pat, args);
	    va_end(args);
	    msg[len++] = '\n';
	    msg[len] = '\0';
	    fwrite(msg, 1, len, stdout);
	    fflush             (stdout);
	}
	#endif
	

#line 1 "rde_critcl/stack.c"

	typedef struct RDE_STACK_ {
	    long int            max;   
	    long int            top;   
	    RDE_STACK_CELL_FREE freeCellProc; 
	    void**              cell;  
	} RDE_STACK_;
	
	SCOPE RDE_STACK
	rde_stack_new (RDE_STACK_CELL_FREE freeCellProc)
	{
	    RDE_STACK s = ALLOC (RDE_STACK_);
	    s->cell = NALLOC (RDE_STACK_INITIAL_SIZE, void*);
	    s->max  = RDE_STACK_INITIAL_SIZE;
	    s->top  = 0;
	    s->freeCellProc = freeCellProc;
	    return s;
	}
	SCOPE void
	rde_stack_del (RDE_STACK s)
	{
	    if (s->freeCellProc && s->top) {
		long int i;
		for (i=0; i < s->top; i++) {
		    ASSERT_BOUNDS(i,s->max);
		    s->freeCellProc ( s->cell [i] );
		}
	    }
	    ckfree ((char*) s->cell);
	    ckfree ((char*) s);
	}
	SCOPE void
	rde_stack_push (RDE_STACK s, void* item)
	{
	    if (s->top >= s->max) {
		long int new  = s->max ? (2 * s->max) : RDE_STACK_INITIAL_SIZE;
		void**   cell = (void**) ckrealloc ((char*) s->cell, new * sizeof(void*));
		ASSERT (cell,"Memory allocation failure for RDE stack");
		s->max  = new;
		s->cell = cell;
	    }
	    ASSERT_BOUNDS(s->top,s->max);
	    s->cell [s->top] = item;
	    s->top ++;
	}
	SCOPE void*
	rde_stack_top (RDE_STACK s)
	{
	    ASSERT_BOUNDS(s->top-1,s->max);
	    return s->cell [s->top - 1];
	}
	SCOPE void
	rde_stack_pop (RDE_STACK s, long int n)
	{
	    ASSERT (n >= 0, "Bad pop count");
	    if (n == 0) return;
	    if (s->freeCellProc) {
		while (n) {
		    s->top --;
		    ASSERT_BOUNDS(s->top,s->max);
		    s->freeCellProc ( s->cell [s->top] );
		    n --;
		}
	    } else {
		s->top -= n;
	    }
	}
	SCOPE void
	rde_stack_trim (RDE_STACK s, long int n)
	{
	    ASSERT (n >= 0, "Bad trimsize");
	    if (s->freeCellProc) {
		while (s->top > n) {
		    s->top --;
		    ASSERT_BOUNDS(s->top,s->max);
		    s->freeCellProc ( s->cell [s->top] );
		}
	    } else {
		s->top = n;
	    }
	}
	SCOPE void
	rde_stack_drop (RDE_STACK s, long int n)
	{
	    ASSERT (n >= 0, "Bad pop count");
	    if (n == 0) return;
	    s->top -= n;
	}
	SCOPE void
	rde_stack_move (RDE_STACK dst, RDE_STACK src)
	{
	    ASSERT (dst->freeCellProc == src->freeCellProc, "Ownership mismatch");
	    
	    while (src->top > 0) {
		src->top --;
		ASSERT_BOUNDS(src->top,src->max);
		rde_stack_push (dst, src->cell [src->top] );
	    }
	}
	SCOPE void
	rde_stack_get (RDE_STACK s, long int* cn, void*** cc)
	{
	    *cn = s->top;
	    *cc = s->cell;
	}
	SCOPE long int
	rde_stack_size (RDE_STACK s)
	{
	    return s->top;
	}
	

#line 1 "rde_critcl/tc.c"

	typedef struct RDE_TC_ {
	    int       max;   
	    int       num;   
	    char*     str;   
	    RDE_STACK off;   
	} RDE_TC_;
	
	SCOPE RDE_TC
	rde_tc_new (void)
	{
	    RDE_TC tc = ALLOC (RDE_TC_);
	    tc->max   = RDE_STACK_INITIAL_SIZE;
	    tc->num   = 0;
	    tc->str   = NALLOC (RDE_STACK_INITIAL_SIZE, char);
	    tc->off   = rde_stack_new (NULL);
	    return tc;
	}
	SCOPE void
	rde_tc_del (RDE_TC tc)
	{
	    rde_stack_del (tc->off);
	    ckfree (tc->str);
	    ckfree ((char*) tc);
	}
	SCOPE long int
	rde_tc_size (RDE_TC tc)
	{
	    return rde_stack_size (tc->off);
	}
	SCOPE void
	rde_tc_clear (RDE_TC tc)
	{
	    tc->num   = 0;
	    rde_stack_trim (tc->off,  0);
	}
	SCOPE char*
	rde_tc_append (RDE_TC tc, char* string, long int len)
	{
	    long int base = tc->num;
	    long int off  = tc->num;
	    char* ch;
	    int clen;
	    Tcl_UniChar uni;
	    if (len < 0) {
		len = strlen (ch);
	    }
	    
	    if ((tc->num + len) >= tc->max) {
		int   new = len + (tc->max ? (2 * tc->max) : RDE_STACK_INITIAL_SIZE);
		char* str = ckrealloc (tc->str, new * sizeof(char));
		ASSERT (str,"Memory allocation failure for token character array");
		tc->max = new;
		tc->str = str;
	    }
	    tc->num += len;
	    ASSERT_BOUNDS(tc->num,tc->max);
	    ASSERT_BOUNDS(off,tc->max);
	    ASSERT_BOUNDS(off+len-1,tc->max);
	    ASSERT_BOUNDS(off+len-1,tc->num);
	    memcpy (tc->str + off, string, len);
	    
	    ch = string;
	    while (ch < (string + len)) {
		ASSERT_BOUNDS(off,tc->num);
		rde_stack_push (tc->off,  (void*) off);
		clen = Tcl_UtfToUniChar (ch, &uni);
		off += clen;
		ch  += clen;
	    }
	    return tc->str + base;
	}
	SCOPE void
	rde_tc_get (RDE_TC tc, int at, char** ch, long int* len)
	{
	    long int  oc, off, top, end;
	    long int* ov;
	    rde_stack_get (tc->off, &oc, (void***) &ov);
	    ASSERT_BOUNDS(at,oc);
	    off = ov [at];
	    if ((at+1) == oc) {
		end = tc->num;
	    } else {
		end = ov [at+1];
	    }
	    TRACE (("rde_tc_get (RDE_TC %p, @ %d) => %d.[%d ... %d]/%d",tc,at,end-off,off,end-1,tc->num));
	    ASSERT_BOUNDS(off,tc->num);
	    ASSERT_BOUNDS(end-1,tc->num);
	    *ch = tc->str + off;
	    *len = end - off;
	}
	SCOPE void
	rde_tc_get_s (RDE_TC tc, int at, int last, char** ch, long int* len)
	{
	    long int  oc, off, top, end;
	    long int* ov;
	    rde_stack_get (tc->off, &oc, (void***) &ov);
	    ASSERT_BOUNDS(at,oc);
	    ASSERT_BOUNDS(last,oc);
	    off = ov [at];
	    if ((last+1) == oc) {
		end = tc->num;
	    } else {
		end = ov [last+1];
	    }
	    TRACE (("rde_tc_get_s (RDE_TC %p, @ %d .. %d) => %d.[%d ... %d]/%d",tc,at,last,end-off,off,end-1,tc->num));
	    ASSERT_BOUNDS(off,tc->num);
	    ASSERT_BOUNDS(end-1,tc->num);
	    *ch = tc->str + off;
	    *len = end - off;
	}
	

#line 1 "rde_critcl/param.c"

	typedef struct RDE_PARAM_ {
	    Tcl_Channel   IN;
	    Tcl_Obj*      readbuf;
	    char*         CC; 
	    long int      CC_len;
	    RDE_TC        TC;
	    long int      CL;
	    RDE_STACK     LS; 
	    ERROR_STATE*  ER;
	    RDE_STACK     ES; 
	    long int      ST;
	    Tcl_Obj*      SV;
	    Tcl_HashTable NC;
	    
	    RDE_STACK    ast  ; 
	    RDE_STACK    mark ; 
	    
	    long int numstr; 
	    char**  string;
	    
	    ClientData clientData;
	} RDE_PARAM_;
	typedef int (*UniCharClass) (int);
	typedef enum test_class_id {
	    tc_alnum,
	    tc_alpha,
	    tc_ascii,
	    tc_ddigit,
	    tc_digit,
	    tc_graph,
	    tc_lower,
	    tc_printable,
	    tc_punct,
	    tc_space,
	    tc_upper,
	    tc_wordchar,
	    tc_xdigit
	} test_class_id;
	static void ast_node_free    (void* n);
	static void error_state_free (void* es);
	static void error_set        (RDE_PARAM p, int s);
	static void nc_clear         (RDE_PARAM p);
	static int UniCharIsAscii    (int character);
	static int UniCharIsHexDigit (int character);
	static int UniCharIsDecDigit (int character);
	static void test_class (RDE_PARAM p, UniCharClass class, test_class_id id);
	static int  er_int_compare (const void* a, const void* b);
	#define SV_INIT(p)             \
	    p->SV = NULL; \
	    TRACE (("SV_INIT (%p => %p)", (p), (p)->SV))
	#define SV_SET(p,newsv)             \
	    if (((p)->SV) != (newsv)) { \
	        TRACE (("SV_CLEAR/set (%p => %p)", (p), (p)->SV)); \
	        if ((p)->SV) {                  \
		    Tcl_DecrRefCount ((p)->SV); \
	        }				    \
	        (p)->SV = (newsv);		    \
	        TRACE (("SV_SET       (%p => %p)", (p), (p)->SV)); \
	        if ((p)->SV) {                  \
		    Tcl_IncrRefCount ((p)->SV); \
	        } \
	    }
	#define SV_CLEAR(p)                 \
	    TRACE (("SV_CLEAR (%p => %p)", (p), (p)->SV)); \
	    if ((p)->SV) {                  \
		Tcl_DecrRefCount ((p)->SV); \
	    }				    \
	    (p)->SV = NULL
	#define ER_INIT(p)             \
	    p->ER = NULL; \
	    TRACE (("ER_INIT (%p => %p)", (p), (p)->ER))
	#define ER_CLEAR(p)             \
	    error_state_free ((p)->ER);	\
	    (p)->ER = NULL
	SCOPE RDE_PARAM
	rde_param_new (long int nstr, char** strings)
	{
	    RDE_PARAM p;
	    ENTER ("rde_param_new");
	    TRACE (("\tINT %d strings @ %p", nstr, strings));
	    p = ALLOC (RDE_PARAM_);
	    p->numstr = nstr;
	    p->string = strings;
	    p->readbuf = Tcl_NewObj ();
	    Tcl_IncrRefCount (p->readbuf);
	    TRACE (("\tTcl_Obj* readbuf %p used %d", p->readbuf,p->readbuf->refCount));
	    Tcl_InitHashTable (&p->NC, TCL_ONE_WORD_KEYS);
	    p->IN   = NULL;
	    p->CL   = -1;
	    p->ST   = 0;
	    ER_INIT (p);
	    SV_INIT (p);
	    p->CC   = NULL;
	    p->CC_len = 0;
	    p->TC   = rde_tc_new ();
	    p->ES   = rde_stack_new (error_state_free);
	    p->LS   = rde_stack_new (NULL);
	    p->ast  = rde_stack_new (ast_node_free);
	    p->mark = rde_stack_new (NULL);
	    RETURN ("%p", p);
	}
	SCOPE void 
	rde_param_del (RDE_PARAM p)
	{
	    ENTER ("rde_param_del");
	    TRACE (("RDE_PARAM %p",p));
	    ER_CLEAR (p);                 TRACE (("\ter_clear"));
	    SV_CLEAR (p);                 TRACE (("\tsv_clear"));
	    nc_clear (p);                 TRACE (("\tnc_clear"));
	    Tcl_DeleteHashTable (&p->NC); TRACE (("\tnc hashtable delete"));
	    rde_tc_del    (p->TC);        TRACE (("\ttc clear"));
	    rde_stack_del (p->ES);        TRACE (("\tes clear"));
	    rde_stack_del (p->LS);        TRACE (("\tls clear"));
	    rde_stack_del (p->ast);       TRACE (("\tast clear"));
	    rde_stack_del (p->mark);      TRACE (("\tmark clear"));
	    TRACE (("\tTcl_Obj* readbuf %p used %d", p->readbuf,p->readbuf->refCount));
	    Tcl_DecrRefCount (p->readbuf);
	    ckfree ((char*) p);
	    RETURNVOID;
	}
	SCOPE void 
	rde_param_reset (RDE_PARAM p, Tcl_Channel chan)
	{
	    ENTER ("rde_param_reset");
	    TRACE (("RDE_PARAM   %p",p));
	    TRACE (("Tcl_Channel %p",chan));
	    p->IN  = chan;
	    p->CL  = -1;
	    p->ST  = 0;
	    p->CC  = NULL;
	    p->CC_len = 0;
	    ER_CLEAR (p);
	    SV_CLEAR (p);
	    nc_clear (p);
	    rde_tc_clear   (p->TC);
	    rde_stack_trim (p->ES,   0);
	    rde_stack_trim (p->LS,   0);
	    rde_stack_trim (p->ast,  0);
	    rde_stack_trim (p->mark, 0);
	    TRACE (("\tTcl_Obj* readbuf %p used %d", p->readbuf,p->readbuf->refCount));
	    RETURNVOID;
	}
	SCOPE void
	rde_param_update_strings (RDE_PARAM p, long int nstr, char** strings)
	{
	    ENTER ("rde_param_update_strings");
	    TRACE (("RDE_PARAM %p", p));
	    TRACE (("INT       %d strings", nstr));
	    p->numstr = nstr;
	    p->string = strings;
	    RETURNVOID;
	}
	SCOPE void
	rde_param_data (RDE_PARAM p, char* buf, long int len)
	{
	    (void) rde_tc_append (p->TC, buf, len);
	}
	SCOPE void
	rde_param_clientdata (RDE_PARAM p, ClientData clientData)
	{
	    p->clientData = clientData;
	}
	static void
	nc_clear (RDE_PARAM p)
	{
	    Tcl_HashSearch hs;
	    Tcl_HashEntry* he;
	    Tcl_HashTable* tablePtr;
	    for(he = Tcl_FirstHashEntry(&p->NC, &hs);
		he != NULL;
		he = Tcl_FirstHashEntry(&p->NC, &hs)) {
		Tcl_HashSearch hsc;
		Tcl_HashEntry* hec;
		tablePtr = (Tcl_HashTable*) Tcl_GetHashValue (he);
		for(hec = Tcl_FirstHashEntry(tablePtr, &hsc);
		    hec != NULL;
		    hec = Tcl_NextHashEntry(&hsc)) {
		    NC_STATE* scs = Tcl_GetHashValue (hec);
		    error_state_free (scs->ER);
		    if (scs->SV) { Tcl_DecrRefCount (scs->SV); }
		    ckfree ((char*) scs);
		}
		Tcl_DeleteHashTable (tablePtr);
		ckfree ((char*) tablePtr);
		Tcl_DeleteHashEntry (he);
	    }
	}
	SCOPE ClientData
	rde_param_query_clientdata (RDE_PARAM p)
	{
	    return p->clientData;
	}
	SCOPE void
	rde_param_query_amark (RDE_PARAM p, long int* mc, long int** mv)
	{
	    rde_stack_get (p->mark, mc, (void***) mv);
	}
	SCOPE void
	rde_param_query_ast (RDE_PARAM p, long int* ac, Tcl_Obj*** av)
	{
	    rde_stack_get (p->ast, ac, (void***) av);
	}
	SCOPE const char*
	rde_param_query_in (RDE_PARAM p)
	{
	    return p->IN
		? Tcl_GetChannelName (p->IN)
		: "";
	}
	SCOPE const char*
	rde_param_query_cc (RDE_PARAM p, long int* len)
	{
	    *len = p->CC_len;
	    return p->CC;
	}
	SCOPE int
	rde_param_query_cl (RDE_PARAM p)
	{
	    return p->CL;
	}
	SCOPE const ERROR_STATE*
	rde_param_query_er (RDE_PARAM p)
	{
	    return p->ER;
	}
	SCOPE Tcl_Obj*
	rde_param_query_er_tcl (RDE_PARAM p, const ERROR_STATE* er)
	{
	    Tcl_Obj* res;
	    if (!er) {
		
		res = Tcl_NewStringObj ("", 0);
	    } else {
		Tcl_Obj* ov [2];
		Tcl_Obj** mov;
		long int  mc, i, j;
		long int* mv;
		int lastid;
		const char* msg;
		rde_stack_get (er->msg, &mc, (void***) &mv);
		
		qsort (mv, mc, sizeof (long int), er_int_compare);
		
		mov = NALLOC (mc, Tcl_Obj*);
		lastid = -1;
		for (i=0, j=0; i < mc; i++) {
		    ASSERT_BOUNDS (i,mc);
		    if (mv [i] == lastid) continue;
		    lastid = mv [i];
		    ASSERT_BOUNDS(mv[i],p->numstr);
		    msg = p->string [mv[i]]; 
		    ASSERT_BOUNDS (j,mc);
		    mov [j] = Tcl_NewStringObj (msg, -1);
		    j++;
		}
		
		ov [0] = Tcl_NewIntObj  (er->loc);
		ov [1] = Tcl_NewListObj (j, mov);
		res = Tcl_NewListObj (2, ov);
		ckfree ((char*) mov);
	    }
	    return res;
	}
	SCOPE void
	rde_param_query_es (RDE_PARAM p, long int* ec, ERROR_STATE*** ev)
	{
	    rde_stack_get (p->ES, ec, (void***) ev);
	}
	SCOPE void
	rde_param_query_ls (RDE_PARAM p, long int* lc, long int** lv)
	{
	    rde_stack_get (p->LS, lc, (void***) lv);
	}
	SCOPE Tcl_HashTable*
	rde_param_query_nc (RDE_PARAM p)
	{
	    return &p->NC;
	}
	SCOPE int
	rde_param_query_st (RDE_PARAM p)
	{
	    return p->ST;
	}
	SCOPE Tcl_Obj*
	rde_param_query_sv (RDE_PARAM p)
	{
	    TRACE (("SV_QUERY %p => (%p)", (p), (p)->SV)); \
	    return p->SV;
	}
	SCOPE long int
	rde_param_query_tc_size (RDE_PARAM p)
	{
	    return rde_tc_size (p->TC);
	}
	SCOPE void
	rde_param_query_tc_get_s (RDE_PARAM p, long int at, long int last, char** ch, long int* len)
	{
	    rde_tc_get_s (p->TC, at, last, ch, len);
	}
	SCOPE const char*
	rde_param_query_string (RDE_PARAM p, long int id)
	{
	    TRACE (("rde_param_query_string (RDE_PARAM %p, %d/%d)", p, id, p->numstr));
	    ASSERT_BOUNDS(id,p->numstr);
	    return p->string [id];
	}
	SCOPE void
	rde_param_i_ast_pop_discard (RDE_PARAM p)
	{
	    rde_stack_pop (p->mark, 1);
	}
	SCOPE void
	rde_param_i_ast_pop_rewind (RDE_PARAM p)
	{
	    long int trim = (long int) rde_stack_top (p->mark);
	    ENTER ("rde_param_i_ast_pop_rewind");
	    TRACE (("RDE_PARAM %p",p));
	    rde_stack_pop  (p->mark, 1);
	    rde_stack_trim (p->ast, (int) trim);
	    TRACE (("SV = (%p rc%d '%s')",
		    p->SV,
		    p->SV ? p->SV->refCount       : -1,
		    p->SV ? Tcl_GetString (p->SV) : ""));
	    RETURNVOID;
	}
	SCOPE void
	rde_param_i_ast_rewind (RDE_PARAM p)
	{
	    long int trim = (long int) rde_stack_top (p->mark);
	    ENTER ("rde_param_i_ast_rewind");
	    TRACE (("RDE_PARAM %p",p));
	    rde_stack_trim (p->ast, (int) trim);
	    TRACE (("SV = (%p rc%d '%s')",
		    p->SV,
		    p->SV ? p->SV->refCount       : -1,
		    p->SV ? Tcl_GetString (p->SV) : ""));
	    RETURNVOID;
	}
	SCOPE void
	rde_param_i_ast_push (RDE_PARAM p)
	{
	    rde_stack_push (p->mark, (void*) rde_stack_size (p->ast));
	}
	SCOPE void
	rde_param_i_ast_value_push (RDE_PARAM p)
	{
	    ENTER ("rde_param_i_ast_value_push");
	    TRACE (("RDE_PARAM %p",p));
	    ASSERT(p->SV,"Unable to push undefined semantic value");
	    TRACE (("rde_param_i_ast_value_push %p => (%p)", p, p->SV));
	    TRACE (("SV = (%p rc%d '%s')", p->SV, p->SV->refCount, Tcl_GetString (p->SV)));
	    rde_stack_push (p->ast, p->SV);
	    Tcl_IncrRefCount (p->SV);
	    RETURNVOID;
	}
	static void
	ast_node_free (void* n)
	{
	    Tcl_DecrRefCount ((Tcl_Obj*) n);
	}
	SCOPE void
	rde_param_i_error_clear (RDE_PARAM p)
	{
	    ER_CLEAR (p);
	}
	SCOPE void
	rde_param_i_error_nonterminal (RDE_PARAM p, int s)
	{
	    long int pos;
	    if (!p->ER) return;
	    pos = 1 + (long int) rde_stack_top (p->LS);
	    if (p->ER->loc != pos) return;
	    error_set (p, s);
	    p->ER->loc = pos;
	}
	SCOPE void
	rde_param_i_error_pop_merge (RDE_PARAM p)
	{
	    ERROR_STATE* top = (ERROR_STATE*) rde_stack_top (p->ES);
	    
	    if (top == p->ER) {
		rde_stack_pop (p->ES, 1);
		return;
	    }
	    
	    if (!top) {
		rde_stack_pop (p->ES, 1);
		return;
	    }
	    
	    if (!p->ER) {
		rde_stack_drop (p->ES, 1);
		p->ER = top;
		
		return;
	    }
	    
	    if (top->loc < p->ER->loc) {
		rde_stack_pop (p->ES, 1);
		return;
	    }
	    
	    if (top->loc > p->ER->loc) {
		rde_stack_drop (p->ES, 1);
		error_state_free (p->ER);
		p->ER = top;
		
		return;
	    }
	    
	    rde_stack_move (p->ER->msg, top->msg);
	    rde_stack_pop  (p->ES, 1);
	}
	SCOPE void
	rde_param_i_error_push (RDE_PARAM p)
	{
	    rde_stack_push (p->ES, p->ER);
	    if (p->ER) { p->ER->refCount ++; }
	}
	static void
	error_set (RDE_PARAM p, int s)
	{
	    error_state_free (p->ER);
	    p->ER = ALLOC (ERROR_STATE);
	    p->ER->refCount = 1;
	    p->ER->loc      = p->CL;
	    p->ER->msg      = rde_stack_new (NULL);
	    ASSERT_BOUNDS(s,p->numstr);
	    rde_stack_push (p->ER->msg, (void*) s);
	}
	static void
	error_state_free (void* esx)
	{
	    ERROR_STATE* es = esx;
	    if (!es) return;
	    es->refCount --;
	    if (es->refCount > 0) return;
	    rde_stack_del (es->msg);
	    ckfree ((char*) es);
	}
	SCOPE void
	rde_param_i_loc_pop_discard (RDE_PARAM p)
	{
	    rde_stack_pop (p->LS, 1);
	}
	SCOPE void
	rde_param_i_loc_pop_rewind (RDE_PARAM p)
	{
	    p->CL = (long int) rde_stack_top (p->LS);
	    rde_stack_pop (p->LS, 1);
	}
	SCOPE void
	rde_param_i_loc_push (RDE_PARAM p)
	{
	    rde_stack_push (p->LS, (void*) p->CL);
	}
	SCOPE void
	rde_param_i_loc_rewind (RDE_PARAM p)
	{
	    p->CL = (long int) rde_stack_top (p->LS);
	}
	SCOPE void
	rde_param_i_input_next (RDE_PARAM p, int m)
	{
	    int leni;
	    char* ch;
	    ASSERT_BOUNDS(m,p->numstr);
	    p->CL ++;
	    if (p->CL < rde_tc_size (p->TC)) {
		
		rde_tc_get (p->TC, p->CL, &p->CC, &p->CC_len);
		ASSERT_BOUNDS (p->CC_len, TCL_UTF_MAX);
		p->ST = 1;
		ER_CLEAR (p);
		return;
	    }
	    if (!p->IN || 
		Tcl_Eof (p->IN) ||
		(Tcl_ReadChars (p->IN, p->readbuf, 1, 0) <= 0)) {
		
		p->ST = 0;
		error_set (p, m);
		return;
	    }
	    
	    ch = Tcl_GetStringFromObj (p->readbuf, &leni);
	    ASSERT_BOUNDS (leni, TCL_UTF_MAX);
	    p->CC = rde_tc_append (p->TC, ch, leni);
	    p->CC_len = leni;
	    p->ST = 1;
	    ER_CLEAR (p);
	}
	SCOPE void
	rde_param_i_status_fail (RDE_PARAM p)
	{
	    p->ST = 0;
	}
	SCOPE void
	rde_param_i_status_ok (RDE_PARAM p)
	{
	    p->ST = 1;
	}
	SCOPE void
	rde_param_i_status_negate (RDE_PARAM p)
	{
	    p->ST = !p->ST;
	}
	SCOPE int 
	rde_param_i_symbol_restore (RDE_PARAM p, int s)
	{
	    NC_STATE*      scs;
	    Tcl_HashEntry* hPtr;
	    Tcl_HashTable* tablePtr;
	    
	    hPtr = Tcl_FindHashEntry (&p->NC, (char*) p->CL);
	    if (!hPtr) { return 0; }
	    tablePtr = (Tcl_HashTable*) Tcl_GetHashValue (hPtr);
	    hPtr = Tcl_FindHashEntry (tablePtr, (char*) s);
	    if (!hPtr) { return 0; }
	    
	    scs = Tcl_GetHashValue (hPtr);
	    p->CL = scs->CL;
	    p->ST = scs->ST;
	    error_state_free (p->ER);
	    p->ER = scs->ER;
	    if (p->ER) { p->ER->refCount ++; }
	    TRACE (("SV_RESTORE (%p) '%s'",scs->SV, scs->SV ? Tcl_GetString (scs->SV):""));
	    SV_SET (p, scs->SV);
	    return 1;
	}
	SCOPE void
	rde_param_i_symbol_save (RDE_PARAM p, int s)
	{
	    long int       at = (long int) rde_stack_top (p->LS);
	    NC_STATE*      scs;
	    Tcl_HashEntry* hPtr;
	    Tcl_HashTable* tablePtr;
	    int            isnew;
	    ENTER ("rde_param_i_symbol_save");
	    TRACE (("RDE_PARAM %p",p));
	    TRACE (("INT       %d",s));
	    
	    hPtr = Tcl_CreateHashEntry (&p->NC, (char*) at, &isnew);
	    if (isnew) {
		tablePtr = ALLOC (Tcl_HashTable);
		Tcl_InitHashTable (tablePtr, TCL_ONE_WORD_KEYS);
		Tcl_SetHashValue (hPtr, tablePtr);
	    } else {
		tablePtr = (Tcl_HashTable*) Tcl_GetHashValue (hPtr);
	    }
	    hPtr = Tcl_CreateHashEntry (tablePtr, (char*) s, &isnew);
	    if (isnew) {
		
		scs = ALLOC (NC_STATE);
		scs->CL = p->CL;
		scs->ST = p->ST;
		TRACE (("SV_CACHE (%p '%s')", p->SV, p->SV ? Tcl_GetString(p->SV) : ""));
		scs->SV = p->SV;
		if (scs->SV) { Tcl_IncrRefCount (scs->SV); }
		scs->ER = p->ER;
		if (scs->ER) { scs->ER->refCount ++; }
		Tcl_SetHashValue (hPtr, scs);
	    } else {
		
		scs = (NC_STATE*) Tcl_GetHashValue (hPtr);
		scs->CL = p->CL;
		scs->ST = p->ST;
		TRACE (("SV_CACHE/over (%p '%s')", p->SV, p->SV ? Tcl_GetString(p->SV) : "" ));
		if (scs->SV) { Tcl_DecrRefCount (scs->SV); }
		scs->SV = p->SV;
		if (scs->SV) { Tcl_IncrRefCount (scs->SV); }
		error_state_free (scs->ER);
		scs->ER = p->ER;
		if (scs->ER) { scs->ER->refCount ++; }
	    }
	    TRACE (("SV = (%p rc%d '%s')",
		    p->SV,
		    p->SV ? p->SV->refCount       : -1,
		    p->SV ? Tcl_GetString (p->SV) : ""));
	    RETURNVOID;
	}
	SCOPE void
	rde_param_i_test_alnum (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsAlnum, tc_alnum);
	}
	SCOPE void
	rde_param_i_test_alpha (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsAlpha, tc_alpha);
	}
	SCOPE void
	rde_param_i_test_ascii (RDE_PARAM p)
	{
	    test_class (p, UniCharIsAscii, tc_ascii);
	}
	SCOPE void
	rde_param_i_test_char (RDE_PARAM p, char* c, int msg)
	{
	    ASSERT_BOUNDS(msg,p->numstr);
	    p->ST = Tcl_UtfNcmp (p->CC, c, 1) == 0;
	    if (p->ST) {
		ER_CLEAR (p);
	    } else {
		error_set (p, msg);
		p->CL --;
	    }
	}
	SCOPE void
	rde_param_i_test_ddigit (RDE_PARAM p)
	{
	    test_class (p, UniCharIsDecDigit, tc_ddigit);
	}
	SCOPE void
	rde_param_i_test_digit (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsDigit, tc_digit);
	}
	SCOPE void
	rde_param_i_test_graph (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsGraph, tc_graph);
	}
	SCOPE void
	rde_param_i_test_lower (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsLower, tc_lower);
	}
	SCOPE void
	rde_param_i_test_print (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsPrint, tc_printable);
	}
	SCOPE void
	rde_param_i_test_punct (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsPunct, tc_punct);
	}
	SCOPE void
	rde_param_i_test_range (RDE_PARAM p, char* s, char* e, int msg)
	{
	    ASSERT_BOUNDS(msg,p->numstr);
	    p->ST =
		(Tcl_UtfNcmp (s, p->CC, 1) <= 0) &&
		(Tcl_UtfNcmp (p->CC, e, 1) <= 0);
	    if (p->ST) {
		ER_CLEAR (p);
	    } else {
		error_set (p, msg);
		p->CL --;
	    }
	}
	SCOPE void
	rde_param_i_test_space (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsSpace, tc_space);
	}
	SCOPE void
	rde_param_i_test_upper (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsUpper, tc_upper);
	}
	SCOPE void
	rde_param_i_test_wordchar (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsWordChar, tc_wordchar);
	}
	SCOPE void
	rde_param_i_test_xdigit (RDE_PARAM p)
	{
	    test_class (p, UniCharIsHexDigit, tc_xdigit);
	}
	static void
	test_class (RDE_PARAM p, UniCharClass class, test_class_id id)
	{
	    Tcl_UniChar ch;
	    Tcl_UtfToUniChar(p->CC, &ch);
	    ASSERT_BOUNDS(id,p->numstr);
	    p->ST = !!class (ch);
	    
	    if (p->ST) {
		ER_CLEAR (p);
	    } else {
		error_set (p, id);
		p->CL --;
	    }
	}
	static int
	UniCharIsAscii (int character)
	{
	    return (character >= 0) && (character < 0x80);
	}
	static int
	UniCharIsHexDigit (int character)
	{
	    return (character >= 0) && (character < 0x80) && isxdigit(character);
	}
	static int
	UniCharIsDecDigit (int character)
	{
	    return (character >= 0) && (character < 0x80) && isdigit(character);
	}
	SCOPE void
	rde_param_i_value_clear (RDE_PARAM p)
	{
	    SV_CLEAR (p);
	}
	SCOPE void
	rde_param_i_value_leaf (RDE_PARAM p, int s)
	{
	    Tcl_Obj* newsv;
	    Tcl_Obj* ov [3];
	    long int pos = 1 + (long int) rde_stack_top (p->LS);
	    ASSERT_BOUNDS(s,p->numstr);
	    ov [0] = Tcl_NewStringObj (p->string[s], -1);
	    ov [1] = Tcl_NewIntObj (pos);
	    ov [2] = Tcl_NewIntObj (p->CL);
	    newsv = Tcl_NewListObj (3, ov);
	    TRACE (("rde_param_i_value_leaf => '%s'",Tcl_GetString (newsv)));
	    SV_SET (p, newsv);
	}
	SCOPE void
	rde_param_i_value_reduce (RDE_PARAM p, int s)
	{
	    Tcl_Obj*  newsv;
	    int       oc, i, j;
	    Tcl_Obj** ov;
	    long int  ac;
	    Tcl_Obj** av;
	    long int pos   = 1 + (long int) rde_stack_top (p->LS);
	    long int mark  = (long int) rde_stack_top (p->mark);
	    long int asize = rde_stack_size (p->ast);
	    long int new   = asize - mark;
	    ASSERT (new >= 0, "Bad number of elements to reduce");
	    ov = NALLOC (3+new, Tcl_Obj*);
	    ASSERT_BOUNDS(s,p->numstr);
	    ov [0] = Tcl_NewStringObj (p->string[s], -1);
	    ov [1] = Tcl_NewIntObj (pos);
	    ov [2] = Tcl_NewIntObj (p->CL);
	    rde_stack_get (p->ast, &ac, (void***) &av);
	    for (i = 3, j = mark; j < asize; i++, j++) {
		ASSERT_BOUNDS (i, 3+new);
		ASSERT_BOUNDS (j, ac);
		ov [i] = av [j];
	    }
	    ASSERT (i == 3+new, "Reduction result incomplete");
	    newsv = Tcl_NewListObj (3+new, ov);
	    TRACE (("rde_param_i_value_reduce => '%s'",Tcl_GetString (newsv)));
	    SV_SET (p, newsv);
	    ckfree ((char*) ov);
	}
	static int
	er_int_compare (const void* a, const void* b)
	{
	    long int ai = *((long int*) a);
	    long int bi = *((long int*) b);
	    if (ai < bi) { return -1; }
	    if (ai > bi) { return  1; }
	    return 0;
	}
	SCOPE int
	rde_param_i_symbol_start (RDE_PARAM p, int s)
	{
	    if (rde_param_i_symbol_restore (p, s)) {
		if (p->ST) {
		    rde_stack_push (p->ast, p->SV);
		    Tcl_IncrRefCount (p->SV);
		}
		return 1;
	    }
	    rde_stack_push (p->LS, (void*) p->CL);
	    return 0;
	}
	SCOPE int
	rde_param_i_symbol_start_d (RDE_PARAM p, int s)
	{
	    if (rde_param_i_symbol_restore (p, s)) {
		if (p->ST) {
		    rde_stack_push (p->ast, p->SV);
		    Tcl_IncrRefCount (p->SV);
		}
		return 1;
	    }
	    rde_stack_push (p->LS,   (void*) p->CL);
	    rde_stack_push (p->mark, (void*) rde_stack_size (p->ast));
	    return 0;
	}
	SCOPE int
	rde_param_i_symbol_void_start (RDE_PARAM p, int s)
	{
	    if (rde_param_i_symbol_restore (p, s)) return 1;
	    rde_stack_push (p->LS, (void*) p->CL);
	    return 0;
	}
	SCOPE int
	rde_param_i_symbol_void_start_d (RDE_PARAM p, int s)
	{
	    if (rde_param_i_symbol_restore (p, s)) return 1;
	    rde_stack_push (p->LS,   (void*) p->CL);
	    rde_stack_push (p->mark, (void*) rde_stack_size (p->ast));
	    return 0;
	}
	SCOPE void
	rde_param_i_symbol_done_d_reduce (RDE_PARAM p, int s, int m)
	{
	    if (p->ST) {
		rde_param_i_value_reduce (p, s);
	    } else {
		SV_CLEAR (p);
	    }
	    rde_param_i_symbol_save       (p, s);
	    rde_param_i_error_nonterminal (p, m);
	    rde_param_i_ast_pop_rewind    (p);
	    rde_stack_pop (p->LS, 1);
	    if (p->ST) {
		rde_stack_push (p->ast, p->SV);
		Tcl_IncrRefCount (p->SV);
	    }
	}
	SCOPE void
	rde_param_i_symbol_done_leaf (RDE_PARAM p, int s, int m)
	{
	    if (p->ST) {
		rde_param_i_value_leaf (p, s);
	    } else {
		SV_CLEAR (p);
	    }
	    rde_param_i_symbol_save       (p, s);
	    rde_param_i_error_nonterminal (p, m);
	    rde_stack_pop (p->LS, 1);
	    if (p->ST) {
		rde_stack_push (p->ast, p->SV);
		Tcl_IncrRefCount (p->SV);
	    }
	}
	SCOPE void
	rde_param_i_symbol_done_d_leaf (RDE_PARAM p, int s, int m)
	{
	    if (p->ST) {
		rde_param_i_value_leaf (p, s);
	    } else {
		SV_CLEAR (p);
	    }
	    rde_param_i_symbol_save       (p, s);
	    rde_param_i_error_nonterminal (p, m);
	    rde_param_i_ast_pop_rewind    (p);
	    rde_stack_pop (p->LS, 1);
	    if (p->ST) {
		rde_stack_push (p->ast, p->SV);
		Tcl_IncrRefCount (p->SV);
	    }
	}
	SCOPE void
	rde_param_i_symbol_done_void (RDE_PARAM p, int s, int m)
	{
	    SV_CLEAR (p);
	    rde_param_i_symbol_save       (p, s);
	    rde_param_i_error_nonterminal (p, m);
	    rde_stack_pop (p->LS, 1);
	}
	SCOPE void
	rde_param_i_symbol_done_d_void (RDE_PARAM p, int s, int m)
	{
	    SV_CLEAR (p);
	    rde_param_i_symbol_save       (p, s);
	    rde_param_i_error_nonterminal (p, m);
	    rde_param_i_ast_pop_rewind    (p);
	    rde_stack_pop (p->LS, 1);
	}
	SCOPE void
	rde_param_i_next_char (RDE_PARAM p, char* c, int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_char (p, c, m);
	}
	SCOPE void
	rde_param_i_next_range (RDE_PARAM p, char* s, char* e, int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_range (p, s, e, m);
	}
	SCOPE void
	rde_param_i_next_alnum (RDE_PARAM p, int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_alnum (p);
	}
	SCOPE void
	rde_param_i_next_alpha (RDE_PARAM p, int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_alpha (p);
	}
	SCOPE void
	rde_param_i_next_ascii (RDE_PARAM p, int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_ascii (p);
	}
	SCOPE void
	rde_param_i_next_ddigit (RDE_PARAM p, int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_ddigit (p);
	}
	SCOPE void
	rde_param_i_next_digit (RDE_PARAM p, int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_digit (p);
	}
	SCOPE void
	rde_param_i_next_graph (RDE_PARAM p, int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_graph (p);
	}
	SCOPE void
	rde_param_i_next_lower (RDE_PARAM p, int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_lower (p);
	}
	SCOPE void
	rde_param_i_next_print (RDE_PARAM p, int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_print (p);
	}
	SCOPE void
	rde_param_i_next_punct (RDE_PARAM p, int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_punct (p);
	}
	SCOPE void
	rde_param_i_next_space (RDE_PARAM p, int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_space (p);
	}
	SCOPE void
	rde_param_i_next_upper (RDE_PARAM p, int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_upper (p);
	}
	SCOPE void
	rde_param_i_next_wordchar (RDE_PARAM p, int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_wordchar (p);
	}
	SCOPE void
	rde_param_i_next_xdigit (RDE_PARAM p, int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_xdigit (p);
	}
	SCOPE void
	rde_param_i_notahead_start_d (RDE_PARAM p)
	{
	    rde_stack_push (p->LS, (void*) p->CL);
	    rde_stack_push (p->mark, (void*) rde_stack_size (p->ast));
	}
	SCOPE void
	rde_param_i_notahead_exit_d (RDE_PARAM p)
	{
	    if (p->ST) {
		rde_param_i_ast_pop_rewind (p); 
	    } else {
		rde_stack_pop (p->mark, 1);
	    }
	    p->CL = (long int) rde_stack_top (p->LS);
	    rde_stack_pop (p->LS, 1);
	    p->ST = !p->ST;
	}
	SCOPE void
	rde_param_i_notahead_exit (RDE_PARAM p)
	{
	    p->CL = (long int) rde_stack_top (p->LS);
	    rde_stack_pop (p->LS, 1);
	    p->ST = !p->ST;
	}
	SCOPE void
	rde_param_i_state_push_2 (RDE_PARAM p)
	{
	    
	    rde_stack_push (p->LS, (void*) p->CL);
	    rde_stack_push (p->ES, p->ER);
	    if (p->ER) { p->ER->refCount ++; }
	}
	SCOPE void
	rde_param_i_state_push_void (RDE_PARAM p)
	{
	    rde_stack_push (p->LS, (void*) p->CL);
	    ER_CLEAR (p);
	    rde_stack_push (p->ES, p->ER);
	    
	}
	SCOPE void
	rde_param_i_state_push_value (RDE_PARAM p)
	{
	    rde_stack_push (p->mark, (void*) rde_stack_size (p->ast));
	    rde_stack_push (p->LS, (void*) p->CL);
	    ER_CLEAR (p);
	    rde_stack_push (p->ES, p->ER);
	    
	}
	SCOPE void
	rde_param_i_state_merge_ok (RDE_PARAM p)
	{
	    rde_param_i_error_pop_merge (p);
	    if (!p->ST) {
		p->ST = 1;
		p->CL = (long int) rde_stack_top (p->LS);
	    }
	    rde_stack_pop (p->LS, 1);
	}
	SCOPE void
	rde_param_i_state_merge_void (RDE_PARAM p)
	{
	    rde_param_i_error_pop_merge (p);
	    if (!p->ST) {
		p->CL = (long int) rde_stack_top (p->LS);
	    }
	    rde_stack_pop (p->LS, 1);
	}
	SCOPE void
	rde_param_i_state_merge_value (RDE_PARAM p)
	{
	    rde_param_i_error_pop_merge (p);
	    if (!p->ST) {
		long int trim = (long int) rde_stack_top (p->mark);
		rde_stack_trim (p->ast, (int) trim);
		p->CL = (long int) rde_stack_top (p->LS);
	    }
	    rde_stack_pop (p->mark, 1);
	    rde_stack_pop (p->LS, 1);
	}
	SCOPE int
	rde_param_i_kleene_close (RDE_PARAM p)
	{
	    int stop = !p->ST;
	    rde_param_i_error_pop_merge (p);
	    if (stop) {
		p->ST = 1;
		p->CL = (long int) rde_stack_top (p->LS);
	    }
	    rde_stack_pop (p->LS, 1);
	    return stop;
	}
	SCOPE int
	rde_param_i_kleene_abort (RDE_PARAM p)
	{
	    int stop = !p->ST;
	    if (stop) {
		p->CL = (long int) rde_stack_top (p->LS);
	    }
	    rde_stack_pop (p->LS, 1);
	    return stop;
	}
	SCOPE int
	rde_param_i_seq_void2void (RDE_PARAM p)
	{
	    rde_param_i_error_pop_merge (p);
	    if (p->ST) {
		rde_stack_push (p->ES, p->ER);
		if (p->ER) { p->ER->refCount ++; }
		return 0;
	    } else {
		p->CL = (long int) rde_stack_top (p->LS);
		rde_stack_pop (p->LS, 1);
		return 1;
	    }
	}
	SCOPE int
	rde_param_i_seq_void2value (RDE_PARAM p)
	{
	    rde_param_i_error_pop_merge (p);
	    if (p->ST) {
		rde_stack_push (p->mark, (void*) rde_stack_size (p->ast));
		rde_stack_push (p->ES, p->ER);
		if (p->ER) { p->ER->refCount ++; }
		return 0;
	    } else {
		p->CL = (long int) rde_stack_top (p->LS);
		rde_stack_pop (p->LS, 1);
		return 1;
	    }
	}
	SCOPE int
	rde_param_i_seq_value2value (RDE_PARAM p)
	{
	    rde_param_i_error_pop_merge (p);
	    if (p->ST) {
		rde_stack_push (p->ES, p->ER);
		if (p->ER) { p->ER->refCount ++; }
		return 0;
	    } else {
		long int trim = (long int) rde_stack_top (p->mark);
		rde_stack_pop  (p->mark, 1);
		rde_stack_trim (p->ast, (int) trim);
		p->CL = (long int) rde_stack_top (p->LS);
		rde_stack_pop (p->LS, 1);
		return 1;
	    }
	}
	SCOPE int
	rde_param_i_bra_void2void (RDE_PARAM p)
	{
	    rde_param_i_error_pop_merge (p);
	    if (p->ST) {
		rde_stack_pop (p->LS, 1);
	    } else {
		p->CL = (long int) rde_stack_top (p->LS);
		rde_stack_push (p->ES, p->ER);
		if (p->ER) { p->ER->refCount ++; }
	    }
	    return p->ST;
	}
	SCOPE int
	rde_param_i_bra_void2value (RDE_PARAM p)
	{
	    rde_param_i_error_pop_merge (p);
	    if (p->ST) {
		rde_stack_pop (p->LS, 1);
	    } else {
		rde_stack_push (p->mark, (void*) rde_stack_size (p->ast));
		p->CL = (long int) rde_stack_top (p->LS);
		rde_stack_push (p->ES, p->ER);
		if (p->ER) { p->ER->refCount ++; }
	    }
	    return p->ST;
	}
	SCOPE int
	rde_param_i_bra_value2void (RDE_PARAM p)
	{
	    rde_param_i_error_pop_merge (p);
	    if (p->ST) {
		rde_stack_pop (p->mark, 1);
		rde_stack_pop (p->LS, 1);
	    } else {
		long int trim = (long int) rde_stack_top (p->mark);
		rde_stack_pop  (p->mark, 1);
		rde_stack_trim (p->ast, (int) trim);
		p->CL = (long int) rde_stack_top (p->LS);
		rde_stack_push (p->ES, p->ER);
		if (p->ER) { p->ER->refCount ++; }
	    }
	    return p->ST;
	}
	SCOPE int
	rde_param_i_bra_value2value (RDE_PARAM p)
	{
	    rde_param_i_error_pop_merge (p);
	    if (p->ST) {
		rde_stack_pop (p->mark, 1);
		rde_stack_pop (p->LS, 1);
	    } else {
		long int trim = (long int) rde_stack_top (p->mark);
		rde_stack_trim (p->ast, (int) trim);
		p->CL = (long int) rde_stack_top (p->LS);
		rde_stack_push (p->ES, p->ER);
		if (p->ER) { p->ER->refCount ++; }
	    }
	    return p->ST;
	}
	SCOPE void
	rde_param_i_next_str (RDE_PARAM p, char* str, int m)
	{
	    int at = p->CL;
	    while (*str) {
		rde_param_i_input_next (p, m);
		if (!p->ST) {
		    p->CL = at;
		    return;
		}
		rde_param_i_test_char (p, str, m);
		if (!p->ST) {
		    p->CL = at;
		    return;
		}
		str = Tcl_UtfNext (str);
	    }
	}
	SCOPE void
	rde_param_i_next_class (RDE_PARAM p, char* class, int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    while (*class) {
		p->ST = Tcl_UtfNcmp (p->CC, class, 1) == 0;
		if (p->ST) {
		    ER_CLEAR (p);
		    return;
		}
		class = Tcl_UtfNext (class);
	    }
	    error_set (p, m);
	    p->CL --;
	}
	

    }

    # # ## ### ###### ######## #############
    ## BEGIN of GENERATED CODE. DO NOT EDIT.

    critcl::ccode {
	/* -*- c -*- */

        /*
         * Declaring the parse functions
         */
        
        static void choice_3 (RDE_PARAM p);
        
        /*
         * Precomputed table of strings (symbols, error messages, etc.).
         */
        
        static char const* p_string [1] = {
            /*        0 = */   "t a"
        };
        
        /*
         * Grammar Start Expression
         */
        
        static void MAIN (RDE_PARAM p) {
            choice_3 (p);
            return;
        }
        
        static void choice_3 (RDE_PARAM p) {
           /*
            * /
            *     'a'
            *     <epsilon>
            */
        
            rde_param_i_state_push_void (p);
            rde_param_i_next_char (p, "a", 0);
            if (rde_param_i_bra_void2void(p)) return;
            rde_param_i_status_ok (p);
            rde_param_i_state_merge_void (p);
            return;
        }
        
    }

    ## END of GENERATED CODE. DO NOT EDIT.
    # # ## ### ###### ######## #############

    # # ## ### ###### ######## #############
    ## Global PARSER management, per interp

    critcl::ccode {
	/* -*- c -*- */

	typedef struct PARSERg {
	    long int counter;
	    char     buf [50];
	} PARSERg;

	static void
	PARSERgRelease (ClientData cd, Tcl_Interp* interp)
	{
	    ckfree((char*) cd);
	}

	static const char*
	PARSERnewName (Tcl_Interp* interp)
	{
#define KEY "tcllib/parser/PACKAGE/critcl"

	    Tcl_InterpDeleteProc* proc = PARSERgRelease;
	    PARSERg*                  parserg;

	    parserg = Tcl_GetAssocData (interp, KEY, &proc);
	    if (parserg  == NULL) {
		parserg = (PARSERg*) ckalloc (sizeof (PARSERg));
		parserg->counter = 0;

		Tcl_SetAssocData (interp, KEY, proc,
				  (ClientData) parserg);
	    }

	    parserg->counter ++;
	    sprintf (parserg->buf, "PARSER%d", parserg->counter);
	    return parserg->buf;
#undef  KEY
	}

	static void
	PARSERdeleteCmd (ClientData clientData)
	{
	    /*
	     * Release the whole PARSER
	     * (Low-level engine only actually).
	     */
	    rde_param_del ((RDE_PARAM) clientData);
	}
    }

    # # ## ### ##### ######## #############
    ## Functions implementing the object methods, and helper.

    critcl::ccode {
	static int  COMPLETE (RDE_PARAM p, Tcl_Interp* interp);

	static int parser_PARSE  (RDE_PARAM p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv)
	{
	    int mode;
	    Tcl_Channel chan;

	    if (objc != 3) {
		Tcl_WrongNumArgs (interp, 2, objv, "chan");
		return TCL_ERROR;
	    }

	    chan = Tcl_GetChannel(interp,
				  Tcl_GetString (objv[2]),
				  &mode);

	    if (!chan) {
		return TCL_ERROR;
	    }

	    rde_param_reset (p, chan);
	    MAIN (p) ; /* Entrypoint for the generated code. */
	    return COMPLETE (p, interp);
	}

	static int parser_PARSET (RDE_PARAM p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv)
	{
	    char* buf;
	    int   len;

	    if (objc != 3) {
		Tcl_WrongNumArgs (interp, 2, objv, "text");
		return TCL_ERROR;
	    }

	    buf = Tcl_GetStringFromObj (objv[2], &len);

	    rde_param_reset (p, NULL);
	    rde_param_data  (p, buf, len);
	    MAIN (p) ; /* Entrypoint for the generated code. */
	    return COMPLETE (p, interp);
	}

	static int COMPLETE (RDE_PARAM p, Tcl_Interp* interp)
	{
	    if (rde_param_query_st (p)) {
		long int  ac;
		Tcl_Obj** av;

		rde_param_query_ast (p, &ac, &av);

		if (ac > 1) {
		    long int  lsc;
		    long int* lsv;
		    Tcl_Obj** lv = NALLOC (3+ac, Tcl_Obj*);

		    rde_param_query_ls (p, &lsc, &lsv);

		    memcpy(lv + 3, av, ac * sizeof (Tcl_Obj*));
		    lv [0] = Tcl_NewObj ();
		    lv [1] = Tcl_NewIntObj (1 + lsv [lsc-1]);
		    lv [2] = Tcl_NewIntObj (rde_param_query_cl (p));

		    Tcl_SetObjResult (interp, Tcl_NewListObj (3, lv));
		    ckfree ((char*) lv);
		} else {
		    Tcl_SetObjResult (interp, av [0]);
		}

		return TCL_OK;
	    } else {
		Tcl_Obj* xv [1];
		const ERROR_STATE* er = rde_param_query_er (p);
		Tcl_Obj* res = rde_param_query_er_tcl (p, er);

		xv [0] = Tcl_NewStringObj ("pt::rde",-1);
		Tcl_ListObjReplace(interp, res, 0, 1, 1, xv);

		Tcl_SetObjResult (interp, res);
		return TCL_ERROR;
	    }
	}
    }

    # # ## ### ##### ######## #############
    ## Object command, method dispatch.

    critcl::ccode {
	static int parser_objcmd (ClientData cd, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv)
	{
	    RDE_PARAM p = (RDE_PARAM) cd;
	    int m, res;

	    static CONST char* methods [] = {
		"destroy", "parse", "parset", NULL
	    };
	    enum methods {
		M_DESTROY, M_PARSE, M_PARSET
	    };

	    if (objc < 2) {
		Tcl_WrongNumArgs (interp, objc, objv, "option ?arg arg ...?");
		return TCL_ERROR;
	    } else if (Tcl_GetIndexFromObj (interp, objv [1], methods, "option",
					    0, &m) != TCL_OK) {
		return TCL_ERROR;
	    }

	    /* Dispatch to methods. They check the #args in
	     * detail before performing the requested
	     * functionality
	     */

	    switch (m) {
		case M_DESTROY:
		    if (objc != 2) {
			Tcl_WrongNumArgs (interp, 2, objv, NULL);
			return TCL_ERROR;
		    }

		Tcl_DeleteCommandFromToken(interp, (Tcl_Command) rde_param_query_clientdata (p));
		return TCL_OK;

		case M_PARSE:	res = parser_PARSE  (p, interp, objc, objv); break;
		case M_PARSET:	res = parser_PARSET (p, interp, objc, objv); break;
		default:
		/* Not coming to this place */
		ASSERT (0,"Reached unreachable location");
	    }

	    return res;
	}
    }

    # # ## ### ##### ######## #############
    # Class command, i.e. object construction.

    critcl::ccommand PARSER_critcl {dummy interp objc objv} {
	/*
	 * Syntax: No arguments beyond the name
	 */

	RDE_PARAM   parser;
	CONST char* name;
	Tcl_Obj*    fqn;
	Tcl_CmdInfo ci;
	Tcl_Command c;

#define USAGE "?name?"

	if ((objc != 2) && (objc != 1)) {
	    Tcl_WrongNumArgs (interp, 1, objv, USAGE);
	    return TCL_ERROR;
	}

	if (objc < 2) {
	    name = PARSERnewName (interp);
	} else {
	    name = Tcl_GetString (objv [1]);
	}

	if (!Tcl_StringMatch (name, "::*")) {
	    /* Relative name. Prefix with current namespace */

	    Tcl_Eval (interp, "namespace current");
	    fqn = Tcl_GetObjResult (interp);
	    fqn = Tcl_DuplicateObj (fqn);
	    Tcl_IncrRefCount (fqn);

	    if (!Tcl_StringMatch (Tcl_GetString (fqn), "::")) {
		Tcl_AppendToObj (fqn, "::", -1);
	    }
	    Tcl_AppendToObj (fqn, name, -1);
	} else {
	    fqn = Tcl_NewStringObj (name, -1);
	    Tcl_IncrRefCount (fqn);
	}
	Tcl_ResetResult (interp);

	if (Tcl_GetCommandInfo (interp,
				Tcl_GetString (fqn),
				&ci)) {
	    Tcl_Obj* err;

	    err = Tcl_NewObj ();
	    Tcl_AppendToObj    (err, "command \"", -1);
	    Tcl_AppendObjToObj (err, fqn);
	    Tcl_AppendToObj    (err, "\" already exists", -1);

	    Tcl_DecrRefCount (fqn);
	    Tcl_SetObjResult (interp, err);
	    return TCL_ERROR;
	}

	parser = rde_param_new (sizeof(p_string)/sizeof(char*), (char**) p_string);
	c = Tcl_CreateObjCommand (interp, Tcl_GetString (fqn),
				  parser_objcmd, (ClientData) parser,
				  PARSERdeleteCmd);
	rde_param_clientdata (parser, (ClientData) c);
	Tcl_SetObjResult (interp, fqn);
	Tcl_DecrRefCount (fqn);
	return TCL_OK;
    }

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

# # ## ### ##### ######## ############# #####################
## Ready (Note: Our package provide is at the top).
return

/*
 * -*- tcl -*-
 * Parsing Expression Grammar 'TEMPLATE'.
 * Generated for unknown, from file 'TEST'
 */

/*
 * Declaring the parse functions
 */

<<attributes>> void <<ns>>choice_3 (<<STATE>> <<state>>);

/*
 * Precomputed table of strings (symbols, error messages, etc.).
 */

static char const* <<string-table>> [1] = {
    /*        0 = */   "t a"
};

/*
 * Grammar Start Expression
 */

<<attributes>> void <<ns>><<main>> (<<STATE>> <<state>>) { <<prelude>>
    <<self>> <<ns>>choice_3 (<<state>>);
    return;
}

<<attributes>> void <<ns>>choice_3 (<<STATE>> <<state>>) { <<prelude>>
   /*
    * /
    *     'a'
    *     <epsilon>
    */

    rde_param_i_state_push_void (<<state>>);
    rde_param_i_next_char (<<state>>, "a", 0);
    if (rde_param_i_bra_void2void(<<state>>)) return;
    rde_param_i_status_ok (<<state>>);
    rde_param_i_state_merge_void (<<state>>);
    return;
}

/*
 */

{
    "pt::grammar::peg" : {
        "rules" : {},
        "start" : "/ {t a} epsilon"
    }
}

{
    "pt::grammar::peg" : {
        "rules" : {},
        "start" : "/ {t a} epsilon"
    }
}

{"pt::grammar::peg":{"rules":{},"start":"/ {t a} epsilon"}}

# -*- text -*-
# Parsing Expression Grammar 'TEMPLATE'.
# Generated for unknown, from file 'TEST'

#
# Grammar Start Expression
#

<<MAIN>>:
         call              choice_5
         halt


choice_5:
# /
#     'a'
#     <epsilon>

         error_clear

         loc_push
         error_push

         call              char_1

         error_pop_merge
     ok! jump              oknoast_4

         loc_pop_rewind
         loc_push
         error_push

         status_ok

         error_pop_merge
     ok! jump              oknoast_4

         loc_pop_rewind
         status_fail
         return

oknoast_4:
         loc_pop_discard
         return

char_1:
# 'a'

         input_next        "t a"
     ok! test_char         "a"
         return

#
#

# -*- text -*-
# Parsing Expression Grammar 'TEMPLATE'.
# Generated for unknown, from file 'TEST'

#
# Grammar Start Expression
#

<<MAIN>>:
         call              choice_4
         halt


choice_4:
# /
#     'a'
#     <epsilon>

         error_clear

         loc_push
         error_push

         input_next        "t a"
     ok! test_char         "a"

         error_pop_merge
     ok! jump              oknoast_3

         loc_pop_rewind
         loc_push
         error_push

         status_ok

         error_pop_merge
     ok! jump              oknoast_3

         loc_pop_rewind
         status_fail
         return

oknoast_3:
         loc_pop_discard
         return

#
#

# -*- text -*-
# Parsing Expression Grammar 'TEMPLATE'.
# Generated for unknown, from file 'TEST'

#
# Grammar Start Expression
#

<<MAIN>>:
         call              choice_5
         halt


choice_5:
# /
#     'a'
#     <epsilon>

         error_clear

         loc_push
         error_push

         call              char_1

         error_pop_merge
     ok! jump              oknoast_4

         loc_pop_rewind
         loc_push
         error_push

         status_ok

         error_pop_merge
     ok! jump              oknoast_4

         loc_pop_rewind
         status_fail
         return

oknoast_4:
         loc_pop_discard
         return

char_1:
# 'a'

         input_next        "t a"
     ok! test_char         "a"
         return

#
#

# -*- text -*-
# Parsing Expression Grammar 'TEMPLATE'.
# Generated for unknown, from file 'TEST'

#
# Grammar Start Expression
#

<<MAIN>>:
         call              choice_4
         halt


choice_4:
# /
#     'a'
#     <epsilon>

         error_clear

         loc_push
         error_push

         input_next        "t a"
     ok! test_char         "a"

         error_pop_merge
     ok! jump              oknoast_3

         loc_pop_rewind
         loc_push
         error_push

         status_ok

         error_pop_merge
     ok! jump              oknoast_3

         loc_pop_rewind
         status_fail
         return

oknoast_3:
         loc_pop_discard
         return

#
#

<Grammar> :: 0 32
    <Header> :: 0 27
        <Identifier> :: 4 16
            <Ident> :: 4 15
        <StartExpr> :: 17 27
            <Expression> :: 18 25
                <Sequence> :: 18 21
                    <Prefix> :: 18 21
                        <Suffix> :: 18 21
                            <Primary> :: 18 21
                                <Literal> :: 18 21
                                    <Char> :: 19 19
                                        <CharUnescaped> :: 19 19
                <Sequence> :: 24 25
                    <Prefix> :: 24 25
                        <Suffix> :: 24 25
                            <Primary> :: 24 25
                                <Literal> :: 24 25

<Grammar> :: 0 132
    <Header> :: 99 122
        <Identifier> :: 103 111
            <Ident> :: 103 110
        <StartExpr> :: 112 122
            <Expression> :: 113 120
                <Sequence> :: 113 116
                    <Prefix> :: 113 116
                        <Suffix> :: 113 116
                            <Primary> :: 113 116
                                <Literal> :: 113 116
                                    <Char> :: 114 114
                                        <CharUnescaped> :: 114 114
                <Sequence> :: 119 120
                    <Prefix> :: 119 120
                        <Suffix> :: 119 120
                            <Primary> :: 119 120
                                <Literal> :: 119 120

<Grammar> :: 0 132
    <Header> :: 99 122
        <Identifier> :: 103 111
            <Ident> :: 103 110
        <StartExpr> :: 112 122
            <Expression> :: 113 120
                <Sequence> :: 113 116
                    <Prefix> :: 113 116
                        <Suffix> :: 113 116
                            <Primary> :: 113 116
                                <Literal> :: 113 116
                                    <Char> :: 114 114
                                        <CharUnescaped> :: 114 114
                <Sequence> :: 119 120
                    <Prefix> :: 119 120
                        <Suffix> :: 119 120
                            <Primary> :: 119 120
                                <Literal> :: 119 120

<Grammar> :: 0 32
    <Header> :: 0 27
        <Identifier> :: 4 16
            <Ident> :: 4 15
        <StartExpr> :: 17 27
            <Expression> :: 18 25
                <Sequence> :: 18 21
                    <Prefix> :: 18 21
                        <Suffix> :: 18 21
                            <Primary> :: 18 21
                                <Literal> :: 18 21
                                    <Char> :: 19 19
                                        <CharUnescaped> :: 19 19
                <Sequence> :: 24 25
                    <Prefix> :: 24 25
                        <Suffix> :: 24 25
                            <Primary> :: 24 25
                                <Literal> :: 24 25

PEG a_pe_grammar ('a' / '')
END;

# -*- text -*-
# Parsing Expression Grammar 'TEMPLATE'.
# Generated for unknown, from file 'TEST'

PEG TEMPLATE ('a' / '')
END;

#
#

# -*- text -*-
# Parsing Expression Grammar 'TEMPLATE'.
# Generated for unknown, from file 'TEST'

PEG TEMPLATE ('a' / '')
END;

#
#

PEG a_pe_grammar ('a' / '')
END;

pt::grammar::peg {rules {} start {/ {t a} epsilon}}

pt::grammar::peg
    start := /
                 'a'
                 <epsilon>
    rules

pt::grammar::peg {
    rules {}
    start {/ {t a} epsilon}
}

## -*- tcl -*-
##
## Snit-based Tcl/PARAM implementation of the parsing
## expression grammar
##
##	TEMPLATE
##
## Generated from file	TEST
##            for user  unknown
##
# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.5
package require snit
package require pt::rde ; # Implementation of the PARAM
			  # virtual machine underlying the
			  # Tcl/PARAM code used below.

# # ## ### ##### ######## ############# #####################
##

snit::type ::PARSER {
    # # ## ### ##### ######## #############
    ## Public API

    constructor {} {
	# Create the runtime supporting the parsing process.
	set myparser [pt::rde ${selfns}::ENGINE]
	return
    }

    method parse {channel} {
	$myparser reset $channel
	MAIN ; # Entrypoint for the generated code.
	return [$myparser complete]
    }

    method parset {text} {
	$myparser reset
	$myparser data $text
	MAIN ; # Entrypoint for the generated code.
	return [$myparser complete]
    }

    # # ## ### ###### ######## #############
    ## Configuration

    pragma -hastypeinfo    0
    pragma -hastypemethods 0
    pragma -hasinfo        0
    pragma -simpledispatch 1

    # # ## ### ###### ######## #############
    ## Data structures.

    variable myparser {} ; # Our instantiation of the PARAM.

    # # ## ### ###### ######## #############
    ## BEGIN of GENERATED CODE. DO NOT EDIT.

    #
    # Grammar Start Expression
    #
    
    proc MAIN {} { upvar 1 myparser myparser
        choice_3
        return
    }
    
    proc choice_3 {} { upvar 1 myparser myparser
        # /
        #     'a'
        #     <epsilon>
    
        $myparser si:void_state_push
        $myparser si:next_char a
        $myparser si:voidvoid_branch
        $myparser i_status_ok
        $myparser si:void_state_merge
        return
    }
    
    ## END of GENERATED CODE. DO NOT EDIT.
    # # ## ### ###### ######## #############
}

# # ## ### ##### ######## ############# #####################
## Ready

package provide SNIT_PACKAGE 1
return

    method parse {channel} {
	my reset $channel
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    method parset {text} {
	my reset {}
	my data $text
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    # # ## ### ###### ######## #############
    ## BEGIN of GENERATED CODE. DO NOT EDIT.

    method parse {channel} {
	my reset $channel
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    method parset {text} {
	my reset {}
	my data $text
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    # # ## ### ###### ######## #############
    ## BEGIN of GENERATED CODE. DO NOT EDIT.

## -*- tcl -*-
##
## OO-based Tcl/PARAM implementation of the parsing
## expression grammar
##
##	TEMPLATE
##
## Generated from file	TEST
##            for user  unknown
##
# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.5
package require TclOO
package require pt::rde::oo ; # OO-based implementation of the
			      # PARAM virtual machine
			      # underlying the Tcl/PARAM code
			      # used below.

# # ## ### ##### ######## ############# #####################
##

oo::class create PARSER {
    # # ## ### ##### ######## #############
    ## Public API

    superclass pt::rde::oo ; # TODO - Define this class.
                             # Or can we inherit from a snit
                             # class too ?

    method parse {channel} {
	my reset $channel
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    method parset {text} {
	my reset {}
	my data $text
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    # # ## ### ###### ######## #############
    ## BEGIN of GENERATED CODE. DO NOT EDIT.

    #
    # Grammar Start Expression
    #
    
    method MAIN {} {
        my choice_3
        return
    }
    
    method choice_3 {} {
        # /
        #     'a'
        #     <epsilon>
    
        my si:void_state_push
        my si:next_char a
        my si:voidvoid_branch
        my i_status_ok
        my si:void_state_merge
        return
    }
    
    ## END of GENERATED CODE. DO NOT EDIT.
    # # ## ### ###### ######## #############
}

# # ## ### ##### ######## ############# #####################
## Ready

package provide OO_PACKAGE 1
return

    method parse {channel} {
	my reset $channel
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    method parset {text} {
	my reset {}
	my data $text
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    # # ## ### ###### ######## #############
    ## BEGIN of GENERATED CODE. DO NOT EDIT.

    method parse {channel} {
	my reset $channel
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    method parset {text} {
	my reset {}
	my data $text
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    # # ## ### ###### ######## #############
    ## BEGIN of GENERATED CODE. DO NOT EDIT.

    method parse {channel} {
	my reset $channel
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    method parset {text} {
	my reset {}
	my data $text
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    # # ## ### ###### ######## #############
    ## BEGIN of GENERATED CODE. DO NOT EDIT.

    method parse {channel} {
	my reset $channel
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    method parset {text} {
	my reset {}
	my data $text
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    # # ## ### ###### ######## #############
    ## BEGIN of GENERATED CODE. DO NOT EDIT.

    method parse {channel} {
	my reset $channel
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    method parset {text} {
	my reset {}
	my data $text
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    # # ## ### ###### ######## #############
    ## BEGIN of GENERATED CODE. DO NOT EDIT.

    method parse {channel} {
	my reset $channel
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    method parset {text} {
	my reset {}
	my data $text
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    # # ## ### ###### ######## #############
    ## BEGIN of GENERATED CODE. DO NOT EDIT.

    method parse {channel} {
	my reset $channel
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    method parset {text} {
	my reset {}
	my data $text
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    # # ## ### ###### ######## #############
    ## BEGIN of GENERATED CODE. DO NOT EDIT.

    method parse {channel} {
	my reset $channel
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    method parset {text} {
	my reset {}
	my data $text
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    # # ## ### ###### ######## #############
    ## BEGIN of GENERATED CODE. DO NOT EDIT.

    method parse {channel} {
	my reset $channel
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    method parset {text} {
	my reset {}
	my data $text
	my MAIN ; # Entrypoint for the generated code.
	return [my complete]
    }

    # # ## ### ###### ######## #############
    ## BEGIN of GENERATED CODE. DO NOT EDIT.

# -*- tcl -*-
# Parsing Expression Grammar 'TEMPLATE'.
# Generated for unknown, from file 'TEST'

#
# Grammar Start Expression
#

<<def>> <<ns>><<main>> {} {
    <<self>> choice_3
    return
}

<<def>> <<ns>>choice_3 {} {
    # /
    #     'a'
    #     <epsilon>

    <<runtime>> si:void_state_push
    <<runtime>> si:next_char a
    <<runtime>> si:voidvoid_branch
    <<runtime>> i_status_ok
    <<runtime>> si:void_state_merge
    return
}

#
#

}

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

TestFilesProcess $mytestdir ok ast_serial ast_serial-print -> n label input data expected {
    # The 'expected' data is irrelevant here, only used to satisfy
    # TestFilesProcess' syntax.
    test pt-ast-10.$n "verify, $label, ok :- $input" -body {
	pt::ast verify $data
    } -result {}

    test pt-ast-11.$n "verify, $label, ok :- $input" -body {
	pt::ast verify $data IGNORED
    } -result {}
}

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

TestFilesProcess $mytestdir ok ast_serial ast_serial-print -> n label input data expected {
    # The 'expected' data is irrelevant here, only used to satisfy
    # TestFilesProcess' syntax.
    test pt-ast-12.$n "print, $label :- $input" -body {
	pt::ast print $data
    } -result $expected
}

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

TestFilesProcess $mytestdir ok ast_serial ast_serial-tddump -> n label input data expected {
    # The 'expected' data is irrelevant here, only used to satisfy
    # TestFilesProcess' syntax.
    test pt-ast-13.$n "topdown, $label :- $input" -setup {
	proc DUMP {ast} { global res ; lappend res $ast }
	set res {}
    } -body {
	pt::ast topdown DUMP $data
	join $res \n
    } -cleanup {
	rename DUMP {}
	unset res
    } -result $expected
}

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

TestFilesProcess $mytestdir ok ast_serial ast_serial-budump -> n label input data expected {
    # The 'expected' data is irrelevant here, only used to satisfy
    # TestFilesProcess' syntax.
    test pt-ast-14.$n "bottomup, $label :- $input" -setup {
	proc DUMP {ast} { global res ; lappend res $ast ; return $ast }
	set res {}
    } -body {
	pt::ast bottomup DUMP $data
	join $res \n
    } -cleanup {
	rename DUMP {}

# TODO :: Tests missing for: configure/cget, reset

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

# Testing the generation of tcl/param output configured for critcl.

TestFilesProcess $mytestdir ok peg_serial-canonical peg_cparam-critcl -> n label input data expected {
    test pt-cparam-config-critcl-3.$n "pt::cparam::configuration::critcl, $label, ok :- $input" -setup {

	pt::peg::to::cparam reset
	pt::peg::to::cparam configure -name     TEMPLATE
	pt::peg::to::cparam configure -file     TEST

	pt::cparam::configuration::critcl def \
	    PARSER PACKAGE \

foreach {k section} {
    0 {}
    1 -fused
    2 -templated
    3 -templated-fused
} {
    TestFilesProcess $mytestdir ok peg_peg$section peg_peg-ast$section -> n label input data expected {
	test pt-parse-peg-parse:${parseimpl}-rde:${rdeimpl}-stack:${stackimpl}-2.$k.$n "pt::parse::peg /text, $label$section, ok :- $input" -setup {
	    set p [pt::parse::peg]
	} -body {
	    pt::ast print [$p parset $data]
	} -cleanup {
	    $p destroy
	} -result $expected

	test pt-parse-peg-parse:${parseimpl}-rde:${rdeimpl}-stack:${stackimpl}-3.$k.$n "pt::parse::peg /file, $label$section, ok :- $input" -setup {
	    set p [pt::parse::peg]
	    set chan [open $input]
	} -body {
	    pt::ast print [$p parse $chan]
	} -cleanup {
	    close $chan
	    $p destroy

# for all possible configurations of this plugin.

foreach {k mode section} {
    0 incremental -incremental
    1 bulk        -bulk
} {
    TestFilesProcess $mytestdir ok peg_serial-canonical peg_container$section -> n label input data expected {
	test pt-peg-export-container-set:${setimpl}-2.$k.$n "pt::peg::export::container, $label$section, ok :- $input" -setup {
	    set configuration [list -mode $mode -user unknown]
	} -body {
	    export $data $configuration
	} -cleanup {
	    unset configuration
	} -result $expected
    }

    TestFilesProcess $mytestdir ok peg_serial-canonical peg_container-templated$section -> n label input data expected {
	test pt-peg-export-container-set:${setimpl}-3.$k.$n "pt::peg::export::container, $label$section, ok :- $input" -setup {
	    text::write reset
	    text::write field   # -*- tcl -*-                              ; text::write /line
	    text::write field   # Parsing Expression Grammar '@name@'.     ; text::write /line
	    text::write field   # Generated for @user@, from file '@file@' ; text::write /line
	    text::write /line
	    text::write field   package require Tcl 8.5                    ; text::write /line
	    text::write field   package require snit                       ; text::write /line

foreach {k in al section} {
    0 0 0 -ultracompact
    1 1 0 -indented
    2 0 1 -indalign
    3 1 1 -indalign
} {
    TestFilesProcess $mytestdir ok peg_serial-canonical peg_json$section -> n label input data expected {
	test pt-peg-export-json-set:${setimpl}-2.$k.$n "pt::peg::export::json, $label$section, ok :- $input" -setup {
	    set configuration [list -indented $in -aligned $al]
	} -body {
	    export $data $configuration
	} -cleanup {
	    unset configuration
	} -result $expected
    }

# for all possible configurations of this plugin.

foreach {k fused section} {
    0 0 {}
    1 1 -fused
} {
    TestFilesProcess $mytestdir ok peg_serial-canonical peg_peg$section -> n label input data expected {
	test pt-peg-export-peg-set:${setimpl}-2.$k.$n "pt::peg::export::peg, $label$section, ok :- $input" -setup {
	    set configuration [list -fused $fused]
	} -body {
	    export $data $configuration
	} -cleanup {
	    unset configuration
	} -result $expected
    }

    TestFilesProcess $mytestdir ok peg_serial-canonical peg_peg-templated$section -> n label input data expected {
	test pt-peg-export-peg-set:${setimpl}-3.$k.$n "pt::peg::export::peg, $label$section, ok :- $input" -setup {

	    text::write reset
	    text::write field   # -*- text -*-                              ; text::write /line
	    text::write field   # Parsing Expression Grammar '@name@'.      ; text::write /line
	    text::write field   # Generated for @user@, from file '@file@'  ; text::write /line
	    text::write /line
	    text::write field   @code@                                      ; text::write /line

# TODO :: templating

foreach {k fused section} {
    0 0 {}
    1 1 -fused
} {
    TestFilesProcess $mytestdir ok peg_serial-canonical peg_peg$section -> n label input data expected {
	test pt-peg-export-plugin-peg-set:${setimpl}-21.$k.$n "pt::peg::export /peg, $label$section, ok :- $input" -setup {
	    pt::peg::export OUT
	    OUT configuration set -fused $fused
	} -body {
	    OUT export serial $data peg
	} -cleanup {
	    OUT destroy
	} -result $expected

foreach {k in al section} {
    0 0 0 -ultracompact
    1 1 0 -indented
    2 0 1 -indalign
    3 1 1 -indalign
} {
    TestFilesProcess $mytestdir ok peg_serial-canonical peg_json$section -> n label input data expected {
	test pt-peg-export-plugin-json-set:${setimpl}-22.$k.$n "pt::peg::export /json, $label$section, ok :- $input" -setup {
	    pt::peg::export OUT
	    OUT configuration set -indented $in
	    OUT configuration set -aligned  $al
	} -body {
	    OUT export serial $data json
	} -cleanup {
	    OUT destroy

# TODO :: templating

foreach {k mode section} {
    0 incremental -incremental
    1 bulk        -bulk
} {
    TestFilesProcess $mytestdir ok peg_serial-canonical peg_container$section -> n label input data expected {
	test pt-peg-export-plugin-container-set:${setimpl}-23.$k.$n "pt::peg::export /container, $label$section, ok :- $input" -setup {
	    pt::peg::export OUT
	    OUT configuration set -mode $mode
	} -body {
	    OUT export serial $data container
	} -cleanup {
	    OUT destroy
	} -result $expected

foreach {k nl in section} {
    0 0 0 -ultracompact
    1 0 1 -indented
    2 1 0 -compact
    3 1 1 -indented
} {
    TestFilesProcess $mytestdir ok serial html$section -> n label input data expected {
	test pt-peg-export-plugin-html-set:${setimpl}-24.$k.$n "pt::peg::export /html, $label$section, ok :- $input" -setup {
	    pt::peg::export OUT
	    OUT configuration set -newlines $nl
	    OUT configuration set -indented $in
	    OUT configuration set -user _dummy_
	} -body {
	    striphtmlcomments [OUT export serial $data html] 3
	} -cleanup {
	    OUT destroy
	} -result $expected
    }
}

# -------------------------------------------------------------------------
# -------------------------------------------------------------------------
# wiki markup

TestFilesProcess $mytestdir ok serial wiki -> n label input data expected {
    test pt-peg-export-plugin-wiki-set:${setimpl}-25.$n "pt::peg::export /wiki, $label, ok :- $input" -setup {
	pt::peg::export OUT
    } -body {
	OUT export serial $data wiki
    } -cleanup {
	OUT destroy
    } -result $expected
}

# -------------------------------------------------------------------------
# -------------------------------------------------------------------------
# nroff markup

foreach {k inline section} {
    0 0 -external
    1 1 -inlined
} {
    TestFilesProcess $mytestdir ok serial nroff$section -> n label input data expected {
	test pt-peg-export-plugin-nroff-set:${setimpl}-25.$k.$n "pt::peg::export /nroff, $label$section, ok :- $input" -setup {
	    pt::peg::export OUT
	    OUT configuration set -inline $inline
	} -body {
	    stripnroffcomments [stripmanmacros [OUT export serial $data nroff]]
	} -cleanup {
	    OUT destroy
	} -result $expected
    }
}}

# -------------------------------------------------------------------------
unset mytestdir n label input data expected
return

foreach {k section} {
    0 -ultracompact
    1 -indented
    2 -indalign
} {
    TestFilesProcess $mytestdir ok peg_json$section peg_serial-canonical -> n label input data expected {
	test pt-peg-from-json-2.$k.$n "pt::peg::from::json, $label$section, ok :- $input" -body {
	    pt::peg::from::json convert $data
	} -result $expected
    }
}

#----------------------------------------------------------------------
unset n label input data expected

	G start [pt::pe::op flatten [G start]]
	foreach s [G nonterminals] {
	    G rule $s [pt::pe::op flatten [G rule $s]]
	}
	set expected [G serialize]
	G destroy

	test pt-peg-from-peg-parse:${parseimpl}-rde:${rdeimpl}-stack:${stackimpl}-2.$k.$n "pt::peg::from::peg /text, $label$section, ok :- $input" -body {
	    pt::peg::from::peg convert $data
	} -result $expected

	test pt-peg-from-peg-parse:${parseimpl}-rde:${rdeimpl}-stack:${stackimpl}-3.$k.$n "pt::peg::from::peg /file, $label$section, ok :- $input" -body {
	    pt::peg::from::peg convert-file $input
	} -result $expected
    }
}

#----------------------------------------------------------------------
unset n label input data expected

foreach {k section} {
    0 -ultracompact
    1 -indented
    2 -indalign
} {
    TestFilesProcess $mytestdir ok peg_json$section peg_serial-canonical -> n label input data expected {
	test pt-peg-import-json-2.$k.$n "pt::peg::import::json, $label$section, ok :- $input" -body {
	    import $data
	} -result $expected
    }
}

# TODO :: Should test handling of failures as well, for various forms
# of malformed json input (essentially bad serializations).

	G start [pt::pe::op flatten [G start]]
	foreach s [G nonterminals] {
	    G rule $s [pt::pe::op flatten [G rule $s]]
	}
	set expected [G serialize]
	G destroy

	test pt-peg-import-parse:${parseimpl}-rde:${rdeimpl}-stack:${stackimpl}-2.$k.$n "pt::peg::import::peg, $label$section, ok :- $input" -body {
	    import $data
	} -result $expected
    }
}

# TODO :: Should test handling of failures as well, for various forms
# of malformed peg input (essentially bad serializations).

    1 -ultracompact
    2 -compact
    3 -indented
    4 -aligned
    5 -indalign
} {
    TestFilesProcess $mytestdir ok doctoc$section serial-print -> n label input data expected {
	test pt-peg-import-plugin-doctoc-20.$k.$n "pt::peg::import text /doctoc, $label$section, ok :- $input" -setup {
	    pt::peg::import I
	    foreach {n v} $mytestconfig { I config set $n $v }
	    foreach p $mytestincludes   { I include add $p }
	} -body {
	    pt::peg::structure print [I import text $data doctoc]
	} -cleanup {
	    I destroy
	} -result $expected
    }

    TestFilesProcess $mytestdir ok doctoc$section serial-print -> n label input data expected {
	test pt-peg-import-plugin-doctoc-21.$k.$n "pt::peg::import file /doctoc, $label$section, ok :- $input" -setup {
	    pt::peg::import I
	    foreach {n v} $mytestconfig { I config set $n $v }
	    foreach p $mytestincludes   { I include add $p }
	} -body {
	    pt::peg::structure print [I import file $input doctoc]
	} -cleanup {
	    I destroy
	} -result $expected
    }
}

# We test the error messages and codes thrown by the parser for a
# variety of failure possibilities.

TestFilesProcess $mytestdir fail doctoc emsg -> n label input data expected {
    test pt-peg-import-plugin-doctoc-22.$n "pt::peg::import text /doctoc, $label, error message :- $input" -setup {
	pt::peg::import I
	foreach {n v} $mytestconfig { I config set $n $v }
	foreach p $mytestincludes   { I include add $p }
    } -body {
	I import text $data doctoc
    } -cleanup {
	I destroy
    } -returnCodes error -result $expected
}

TestFilesProcess $mytestdir fail doctoc ecode -> n label input data expected {
    test pt-peg-import-plugin-doctoc-23.$n "pt::peg::import text /doctoc, $label, error code :- $input" -setup {
	pt::peg::import I
	foreach {n v} $mytestconfig { I config set $n $v }
	foreach p $mytestincludes   { I include add $p }
    } -body {
	# Catch and rethrow using the error code as new message.
	catch {	I import text $data doctoc }
	set ::errorCode
    } -cleanup {
	I destroy
    } -result $expected
}

TestFilesProcess $mytestdir fail doctoc emsg -> n label input data expected {
    test pt-peg-import-plugin-doctoc-24.$n "pt::peg::import file /doctoc, $label, error message :- $input" -setup {
	pt::peg::import I
	foreach {n v} $mytestconfig { I config set $n $v }
	foreach p $mytestincludes   { I include add $p }
    } -body {
	I import file $input doctoc
    } -cleanup {
	I destroy
    } -returnCodes error -result $expected
}

TestFilesProcess $mytestdir fail doctoc ecode -> n label input data expected {
    test pt-peg-import-plugin-doctoc-25.$n "pt::peg::import file /doctoc, $label, error code :- $input" -setup {
	pt::peg::import I
	foreach {n v} $mytestconfig { I config set $n $v }
	foreach p $mytestincludes   { I include add $p }
    } -body {
	# Catch and rethrow using the error code as new message.
	catch {	I import file $input doctoc }
	set ::errorCode

foreach {k section} {
    0 -ultracompact
    1 -indented
    2 -indalign
} {
    TestFilesProcess $mytestdir ok peg_json$section peg_serial-canonical -> n label input data expected {
	test pt-peg-import-plugin-json-26.$k.$n "pt::peg::import text /json, $label$section, ok :- $input" -setup {
	    pt::peg::import I
	} -body {
	    I import text $data json
	} -cleanup {
	    I destroy
	} -result $expected
    }

    TestFilesProcess $mytestdir ok peg_json$section peg_serial-canonical -> n label input data expected {
	test pt-peg-import-plugin-json-27.$k.$n "pt::peg::import file /json, $label$section, ok :- $input" -setup {
	    pt::peg::import I
	} -body {
	    I import file $input json
	} -cleanup {
	    I destroy
	} -result $expected
    }
}

# -------------------------------------------------------------------------
if 0 {
# We test the error messages and codes thrown by the parser for a
# variety of failure possibilities.

TestFilesProcess $mytestdir fail json json-emsg -> n label input data expected {
    test pt-peg-import-plugin-json-28.$n "pt::peg::import text /json, $label, error message :- $input" -setup {
	pt::peg::import I
    } -body {
	I import text $data json
    } -cleanup {
	I destroy
    } -returnCodes error -result $expected
}
}
# -------------------------------------------------------------------------
unset mytestdir n label input data expected
return

foreach {k section} {
    0 {}
    1 -fused
    2 -templated
    3 -templated-fused
} {
    TestFilesProcess $mytestdir ok peg_peg$section peg_peg-ast$section -> n label input data expected {
	test pt-peg-interp-rde:${rdeimpl}-stack:${stackimpl}-2.$k.$n "pt::peg::interp /text, $label$section, ok :- $input" -setup {
	    set g [pt::peg::container::peg]
	    set p [pt::peg::interp]
	    $p use $g
	} -body {
	    pt::ast print [$p parset $data]
	} -cleanup {
	    $g destroy
	    $p destroy
	} -result $expected

	test pt-peg-interp-rde:${rdeimpl}-stack:${stackimpl}-3.$k.$n "pt::peg::interp /file, $label$section, ok :- $input" -setup {
	    set g [pt::peg::container::peg]
	    set p [pt::peg::interp]
	    $p use $g
	    set chan [open $input]
	} -body {
	    pt::ast print [$p parse $chan]
	} -cleanup {

# serialization, for most configurations of the converter package.

foreach {k mode section} {
    0 incremental -incremental
    1 bulk        -bulk
} {
    TestFilesProcess $mytestdir ok peg_serial-canonical peg_container$section -> n label input data expected {
	test pt-peg-to-container-set:${setimpl}-3.$k.$n "pt::peg::to::container, $label$section, ok :- $input" -setup {
	    pt::peg::to::container reset
	    pt::peg::to::container configure -mode $mode
	} -body {
	    pt::peg::to::container convert $data
	} -cleanup {
	    pt::peg::to::container reset
	} -result $expected
    }

    TestFilesProcess $mytestdir ok peg_serial-canonical peg_container-templated$section -> n label input data expected {
	test pt-peg-to-container-set:${setimpl}-4.$k.$n "pt::peg::to::container, $label$section, ok :- $input" -setup {
	    text::write reset
	    text::write field   # -*- tcl -*-                               ; text::write /line
	    text::write field   # Parsing Expression Grammar '@name@'.      ; text::write /line
	    text::write field   # Generated for @user@, from file '@file@'  ; text::write /line
	    text::write /line
	    text::write field   package require Tcl 8.5                     ; text::write /line
	    text::write field   package require snit                        ; text::write /line

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

# Testing the generation of peg output, from grammar serialization,
# for all possible configurations of this plugin.

TestFilesProcess $mytestdir ok peg_serial-canonical peg_cparam -> n label input data expected {
    test pt-peg-to-cparam-3.$n "pt::peg::to::cparam, $label, ok :- $input" -setup {

	text::write reset
	text::write field   {/*}                                           ; text::write /line
	text::write field   { *} -*- tcl -*-                               ; text::write /line
	text::write field   { *} Parsing Expression Grammar '@name@'.      ; text::write /line
	text::write field   { *} Generated for @user@, from file '@file@'  ; text::write /line
	text::write field   { */}                                          ; text::write /line

foreach {k in al section} {
    0 0 0 -ultracompact
    1 1 0 -indented
    2 0 1 -indalign
    3 1 1 -indalign
} {
    TestFilesProcess $mytestdir ok peg_serial-canonical peg_json$section -> n label input data expected {
	test pt-peg-to-json-3.$k.$n "pt::peg::to::json, $label$section, ok :- $input" -setup {
	    pt::peg::to::json reset
	    pt::peg::to::json configure -indented $in
	    pt::peg::to::json configure -aligned  $al
	} -body {
	    pt::peg::to::json convert $data
	} -cleanup {
	    pt::peg::to::json reset

foreach {k c i section} {
    0 1 1 {}
    1 1 0 -compact
    2 0 1 -inlined
    3 0 0 -unopt
} {
    TestFilesProcess $mytestdir ok peg_serial-canonical peg_param$section -> n label input data expected {
	test pt-peg-to-param-3.$k.$n "pt::peg::to::param, $label$section, ok :- $input" -setup {

	    text::write reset
	    text::write field   # -*- text -*-                              ; text::write /line
	    text::write field   # Parsing Expression Grammar '@name@'.      ; text::write /line
	    text::write field   # Generated for @user@, from file '@file@'  ; text::write /line
	    text::write /line
	    text::write field   @code@                                      ; text::write /line

# for all possible configurations of this plugin.

foreach {k fused section} {
    0 0 {}
    1 1 -fused
} {
    TestFilesProcess $mytestdir ok peg_serial-canonical peg_peg$section -> n label input data expected {
	test pt-peg-to-peg-set:${setimpl}-3.$k.$n "pt::peg::to::peg, $label$section, ok :- $input" -setup {
	    pt::peg::to::peg reset
	    pt::peg::to::peg configure -fused $fused
	} -body {
	    pt::peg::to::peg convert $data
	} -cleanup {
	    pt::peg::to::peg reset
	} -result $expected
    }

    TestFilesProcess $mytestdir ok peg_serial-canonical peg_peg-templated$section -> n label input data expected {
	test pt-peg-to-peg-set:${setimpl}-4.$k.$n "pt::peg::to::peg, $label$section, ok :- $input" -setup {

	    text::write reset
	    text::write field   # -*- text -*-                              ; text::write /line
	    text::write field   # Parsing Expression Grammar '@name@'.      ; text::write /line
	    text::write field   # Generated for @user@, from file '@file@'  ; text::write /line
	    text::write /line
	    text::write field   @code@                                      ; text::write /line

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

# Testing the generation of peg output, from grammar serialization,
# for all possible configurations of this plugin.

TestFilesProcess $mytestdir ok peg_serial-canonical peg_tclparam -> n label input data expected {
    test pt-peg-to-tclparam-3.$n "pt::peg::to::tclparam, $label, ok :- $input" -setup {

	text::write reset
	text::write field   # -*- tcl -*-                               ; text::write /line
	text::write field   # Parsing Expression Grammar '@name@'.      ; text::write /line
	text::write field   # Generated for @user@, from file '@file@'  ; text::write /line
	text::write /line
	text::write field   @code@                                      ; text::write /line

}

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

TestFilesProcess $mytestdir ok peg_serial peg_serial-print -> n label input data expected {
    # The 'expected' data is irrelevant here, only used to satisfy
    # TestFilesProcess' syntax.
    test pt-peg-6.$n "pt::peg verify, $label, ok :- $input" -body {
	pt::peg verify $data
    } -result {}
}

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

TestFilesProcess $mytestdir ok peg_serial peg_serial-print -> n label input data expected {
    # The 'expected' data is irrelevant here, only used to satisfy
    # TestFilesProcess' syntax.
    test pt-peg-7.$n "pt::peg print, $label :- $input" -body {
	pt::peg print $data
    } -result $expected
}

#----------------------------------------------------------------------
# Merge ...

test pt-peg-11.3 {merge, wrong#args} -body {
    pt::peg merge PE PEB XXX
} -returnCodes error -result {wrong # args: should be "pt::peg merge seriala serialb"}

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

TestFilesProcess $mytestdir ok peg_serial peg_serial-canonical -> n label input data expected {
    test pt-peg-12.$n "pt::peg canonicalize, $label :- $input" -body {
	pt::peg canonicalize $data
    } -result $expected
}

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

TestFilesProcess $mytestdir ok peg_serial-canonical peg_serial-print -> n label input data expected {
    # The 'expected' data is irrelevant here, only used to satisfy
    # TestFilesProcess' syntax.
    test pt-peg-13.$n "pt::peg verify-as-canonical, $label, ok :- $input" -body {
	pt::peg verify-as-canonical $data
    } -result {}
}

#----------------------------------------------------------------------
unset n badserial expected label input data

}

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

TestFilesProcess $mytestdir ok pe_serial pe_serial-print -> n label input data expected {
    # The 'expected' data is irrelevant here, only used to satisfy
    # TestFilesProcess' syntax.
    test pt-pe-7.$n "pt::pe verify, $label, ok :- $input" -body {
	pt::pe verify $data
    } -result {}

    test pt-pe-7.$n "pt::pe verify, $label, ok :- $input" -body {
	pt::pe verify $data IGNORED
    } -result {}
}

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

TestFilesProcess $mytestdir ok pe_serial pe_serial-print -> n label input data expected {
    # The 'expected' data is irrelevant here, only used to satisfy
    # TestFilesProcess' syntax.
    test pt-pe-8.$n "pt::pe print, $label :- $input" -body {
	pt::pe print $data
    } -result $expected
}

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

TestFilesProcess $mytestdir ok pe_serial pe_serial-tddump -> n label input data expected {
    # The 'expected' data is irrelevant here, only used to satisfy
    # TestFilesProcess' syntax.
    test pt-pe-11.$n "pt::pe topdown, $label :- $input" -setup {
	proc DUMP {pe args} { global res ; lappend res $pe }
	set res {}
    } -body {
	pt::pe topdown DUMP $data
	join $res \n
    } -cleanup {
	rename DUMP {}
	unset res
    } -result $expected
}

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

TestFilesProcess $mytestdir ok pe_serial pe_serial-budump -> n label input data expected {
    # The 'expected' data is irrelevant here, only used to satisfy
    # TestFilesProcess' syntax.
    test pt-pe-12.$n "pt::pe bottomup, $label :- $input" -setup {
	proc DUMP {pe args} { global res ; lappend res $pe ; return $pe }
	set res {}
    } -body {
	pt::pe bottomup DUMP $data
	join $res \n
    } -cleanup {
	rename DUMP {}

# TODO :: Tests missing for: configure/cget, reset

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

# Testing the generation of tcl/param output configured for snit.

TestFilesProcess $mytestdir ok peg_serial-canonical peg_tclparam-snit -> n label input data expected {
    test pt-tclparam-config-snit-3.$n "pt::tclparam::configuration::snit, $label, ok :- $input" -setup {

	pt::peg::to::tclparam reset
	pt::peg::to::tclparam configure -name     TEMPLATE
	pt::peg::to::tclparam configure -file     TEST

	pt::tclparam::configuration::snit def \
	    PARSER SNIT_PACKAGE \

# TODO :: Tests missing for: configure/cget, reset

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

# Testing the generation of tcl/param output configured for tcloo.

TestFilesProcess $mytestdir ok peg_serial-canonical peg_tclparam-tcloo -> n label input data expected {
    test pt-tclparam-config-tcloo-3.$n "pt::tclparam::configuration::tcloo, $label, ok :- $input" -setup {

	pt::peg::to::tclparam reset
	pt::peg::to::tclparam configure -name     TEMPLATE
	pt::peg::to::tclparam configure -file     TEST

	pt::tclparam::configuration::tcloo def \
	    PARSER OO_PACKAGE \