while (prefixMappings[i]) {
            if (strcmp (prefix, prefixMappings[i]) == 0) {
                return prefixMappings[i+1];
            }
            i += 2;
        }
    }
    if (node) {
        ns = domLookupPrefix (node, prefix);
        if (ns) return ns->uri;
    }
    return NULL;
}

/*---------------------------------------------------------------------------
|   domLookupPrefix
|
\--------------------------------------------------------------------------*/
domNS *

    if (cp->namespace) {                                \
        Tcl_SetStringObj (rObj, cp->namespace, -1);     \
        Tcl_AppendToObj (rObj, ":", 1);                 \
    }                                                   \
    Tcl_AppendToObj (rObj, cp->name, -1);

#define S(str)  str, sizeof (str) -1

#define getKeyState(ks) \
    if (sdata->keyStatePool) { \
        ks = sdata->keyStatePool; \
        sdata->keyStatePool = ks->next; \
    } else { \
        ks = TMALLOC (KeyState); \
    }

static SchemaCP*
initSchemaCP (
    Schema_CP_Type type,
    void *namespace,
    char *name
    )

    }
    fprintf (stderr, "++++ Stack bottom\n");
}
)

/* DBG end */

static void freeKeyConstraints (
    KeyConstraint *kc
    )
{
    KeyConstraint *knext;
    KeyStep *step, *snext, *child, *nchild;
    int i;

    while (kc) {
        knext = kc->next;
        if (kc->name) FREE (kc->name);
        step = kc->selector;
        while (step) {
            snext = step->next;
            child = step;
            while (child) {
                nchild = child->child;
                FREE (child);
                child = nchild;
            }
            step = snext;
        }
        for (i = 0; i < kc->nrFields; i++) {
            step = kc->fields[i];
            while (step) {
                snext = step->next;
                child = step;
                while (child) {
                    nchild = child->child;
                    FREE (child);
                    child = nchild;
                }
                step = snext;
            }
        }
        FREE (kc->fields);
        FREE (kc);
        kc = knext;
    }
}


static void freedomKeyConstraints (
    domKeyConstraint *kc
    )
{
    domKeyConstraint *knext;
    int i;

        FREE (pattern->quants);
        if (pattern->attrs) {
            for (i = 0; i < pattern->numAttr; i++) {
                FREE (pattern->attrs[i]);
            }
            FREE (pattern->attrs);
        }
        freeKeyConstraints (pattern->localkeys);
        freedomKeyConstraints (pattern->domKeys);
        break;
    }
    FREE (pattern);
}

static SchemaData*

{
    SchemaData *sdata = (SchemaData *) clientData;
    unsigned int i;
    SchemaValidationStack *down;
    Tcl_HashEntry *h;
    Tcl_HashSearch search;
    SchemaDocKey *dk;
    KeyState *ks, *nextks;
    KeyTable *kt, *nextkt;

    /* Protect the clientData to be freed inside (even nested)
     * Tcl_Eval*() calls to avoid invalid mem access and postpone the
     * cleanup until the Tcl_Eval*() calls are finished (done in
     * schemaInstanceCmd(). */
    if (sdata->currentEvals) {
        sdata->cleanupAfterEval = 1;

         h != NULL;
         h = Tcl_NextHashEntry (&search)) {
        dk = Tcl_GetHashValue (h);
        Tcl_DeleteHashTable (&dk->ids);
        FREE (dk);
    }
    Tcl_DeleteHashTable (&sdata->idTables);
    ks = sdata->keyStatePool;
    while (ks) {
        nextks = ks->next;
        FREE (ks);
        ks = nextks;
    }
    kt = sdata->keyTablePool;
    while (kt) {
        nextkt = kt->next;
        FREE (kt);
        kt = nextkt;
    }
    FREE (sdata);
}

static void
cleanupLastPattern (
    SchemaData *sdata,
    unsigned int from

static void
pushToStack (
    SchemaData *sdata,
    SchemaCP *pattern
    )
{
    SchemaValidationStack *stackElm, *se;
    KeyConstraint *kc;
    KeyState *ks, *newks;
    KeyTable *kt;
    
    DBG(fprintf(stderr, "push to Stack:\n");serializeCP(pattern));
    if (sdata->stackPool) {
        stackElm = sdata->stackPool;
        sdata->stackPool = stackElm->down;
    } else {
        stackElm = TMALLOC (SchemaValidationStack);
    }
    memset (stackElm, 0, sizeof (SchemaValidationStack));
    se = sdata->stack;
    stackElm->down = se;
    stackElm->pattern = pattern;
    if (pattern->type == SCHEMA_CTYPE_INTERLEAVE) {
        stackElm->interleaveState = MALLOC (sizeof (int) * pattern->nc);
        memset (stackElm->interleaveState, 0, sizeof (int) * pattern->nc);
    }
    if (pattern->type == SCHEMA_CTYPE_NAME && se) {
        /* Handle local key contraint matches */
        ks = se->keyState;
        while (ks) {
            if (ks->selector->name != pattern->name
                || ks->selector->ns != pattern->namespace) {
                ks = ks->next;
                continue;
            }
            if (ks->selector->child) {
                getKeyState(newks);
                newks->keyTable = ks->keyTable;
                newks->ownTable = 0;
                newks->selector = ks->selector->child;
                newks->fields = ks->fields;
                newks->next = stackElm->keyState;
                stackElm->keyState = newks;
                if (ks->type == SCHEMA_STEP_DESCENDANT_ELEMENT) {
                    getKeyState(newks);
                    newks->keyTable = ks->keyTable;
                    newks->ownTable = 0;
                    newks->selector = ks->selector;
                    newks->fields = ks->fields;
                    newks->next = stackElm->keyState;
                    stackElm->keyState = newks;                    
                }
            } else {
                /* Selector has matched, grab the fields */
            }
        }
        
        /* And open new local key contraints, if necessary. */
        kc = pattern->localkeys;
        while (kc) {
            getKeyState (ks);
            if (sdata->keyTablePool) {
                kt = sdata->keyTablePool;
                sdata->keyTablePool = kt->next;
            } else {
                kt = TMALLOC (KeyTable);
            }
            Tcl_InitHashTable (&kt->values, TCL_STRING_KEYS);
            ks->keyTable = kt;
            ks->ownTable = 1;
            ks->type = kc->type;
            ks->selector = kc->selector;
            ks->fields = kc->fields;
            ks->next = stackElm->keyState;
            stackElm->keyState = ks;
            kc = kc->next;
        }
    }
    sdata->stack = stackElm;
}

static void
popStack (
    SchemaData *sdata
    )
{
    SchemaValidationStack *se;
    KeyState *ks, *nextks;
    DBG(fprintf(stderr, "pop from Stack:\n");serializeCP(sdata->stack->pattern));
    if (sdata->stack->interleaveState) {
        FREE (sdata->stack->interleaveState);
        sdata->stack->interleaveState = NULL;
    }
    if (sdata->stack->pattern->type == SCHEMA_CTYPE_NAME) {
        /* Check and cleanup local key contraints */
        ks = sdata->stack->keyState;
        while (ks) {
            nextks = ks->next;
            if (ks->ownTable) {
                ks->keyTable->next = sdata->keyTablePool;
                sdata->keyTablePool = ks->keyTable;
                Tcl_DeleteHashTable (&ks->keyTable->values);
            }
            ks->next = sdata->keyStatePool;
            sdata->keyStatePool = ks;
            ks = nextks;
        }
    }
    se = sdata->stack->down;
    sdata->stack->down = sdata->stackPool;
    sdata->stackPool = sdata->stack;
    sdata->stack = se;
}

        pattern->content[i-1] = (SchemaCP *) objv[i];
        Tcl_IncrRefCount (objv[i]);
    }
    pattern->nc = objc;
    addToContent (sdata, pattern, SCHEMA_CQUANT_ONE, 0, 0);
    return TCL_OK;
}

extern void printAst (int depth, ast t);

static int
processSchemaXPath (
    Tcl_Interp *interp,
    SchemaData *sdata,
    KeyConstraint *kc,
    StepType nextType,
    ast t,
    int field,
    int toplevel
    )
{
    ast child, savedt;
    KeyStep *step, *curstep;
    Tcl_HashTable *table;
    Tcl_HashEntry *h;
    int rc, hnew;
    SchemaCP *cp;
    
    /* if (toplevel) printAst (0, t); */
    while (t) {
        switch (t->type) {
        case GetContextNode:
            t = t->next;
            continue;
        case CombineSets:
            child = t->child;
            if (child->type == EvalSteps) {
                savedt = NULL;
                child = child->child;
            } else {
                savedt = child->next;
                child->next = NULL;
            }
            if (field) {
                step = kc->fields[field-1];
                kc->fields[field-1] = NULL;
            } else {
                step = kc->selector;
                kc->selector = NULL;
            }
            if (!processSchemaXPath (interp, sdata, kc, SCHEMA_STEP_NONE,
                                     child, field, toplevel)) {
                if (savedt) child->next = savedt;
                if (field) kc->fields[field-1] = step;
                else kc->selector = step;
                return 0;
            }
            if (step) {
                if (field) {
                    curstep = step;
                    while (curstep->next) curstep = curstep->next;
                    curstep->next = kc->fields[field-1];
                } else {
                    curstep = step;
                    while (curstep->next) curstep = curstep->next;
                    step->next = kc->selector;
                }
            } else {
                if (field) {
                    step = kc->fields[field-1];
                } else {
                    step = kc->selector;
                }
            }
            if (field) kc->fields[field-1] = NULL;
            else kc->selector = NULL;
            if (savedt) child->next = savedt;
            child = t->child->next;
            if (child->type == EvalSteps) child = child->child;
            rc = processSchemaXPath (interp, sdata, kc, SCHEMA_STEP_NONE,
                                     child, field, toplevel);
            if (field) {
                if (kc->fields[field-1]) {
                    curstep = step;
                    while (curstep->next) curstep = curstep->next;
                    curstep->next = kc->fields[field-1];
                }
                kc->fields[field-1] = step;
            } else {
                if (kc->selector) {
                    curstep = step;
                    while (curstep->next) curstep = curstep->next;
                    curstep->next = kc->selector;
                }
                kc->selector = step;
            }
            return rc;
        case AxisDescendant:
            if (!toplevel) {
                SetResult ("Not a reduced XPath expression.");
                return 0;
            }
            nextType = SCHEMA_STEP_DESCENDANT_ELEMENT;
            break;
        case IsNSAttr:
        case IsAttr:
            if (!field) {
                SetResult ("Attribute selection is only possible in reduced "
                           "XPath expression for field selectors.");
                return 0;
            }
            /* Fall through */
        case IsElement:
        case IsFQElement:
        case IsNSElement:
            savedt = t;
            step = TMALLOC (KeyStep);
            memset (step, 0, sizeof (KeyStep));
            step->type = nextType;
            if (t->type == IsAttr || t->type == IsNSAttr) {
                table = &sdata->attrNames;
            } else {
                table = &sdata->element;
            }
            if (t->type == IsFQElement || t->type == IsNSAttr) {
                h = Tcl_CreateHashEntry (&sdata->namespace, t->strvalue,
                                         &hnew);
                step->ns = Tcl_GetHashKey (&sdata->namespace, h);
                t = t->child;
            }
            h = Tcl_CreateHashEntry (table, t->strvalue, &hnew);
            if (hnew && (table == &sdata->element)) {
                cp = initSchemaCP (SCHEMA_CTYPE_NAME, step->ns,
                                   Tcl_GetHashKey (&sdata->element, h));
                cp->flags |= PLACEHOLDER_PATTERN_DEF;
                REMEMBER_PATTERN (cp);
                Tcl_SetHashValue (h, cp);
            }
            step->name = Tcl_GetHashKey (table, h);
            if (field) {
                if (kc->fields[field-1]) {
                    curstep = kc->fields[field-1];
                    while (curstep->child) curstep = curstep->child;
                    curstep->child = step;
                } else {
                    kc->fields[field-1] = step;
                }
            } else {
                if (kc->selector) {
                    curstep = kc->selector;
                    while (curstep->child) curstep = curstep->child;
                    curstep->child = step;
                } else {
                    kc->selector = step;
                }
            }
            t = savedt;
            break;
        case AxisAttribute:
            if (!field) {
                SetResult ("Attribute selection is only possible in reduced "
                           "XPath expression for field selectors.");
                return 0;
            }
            /* Fall through */
        case AxisChild:
            if (t->type == AxisChild) nextType = SCHEMA_STEP_ELEMENT;
            else nextType = SCHEMA_STEP_ATTRIBUTE;
            if (!processSchemaXPath (interp, sdata, kc, nextType,
                                     t->child, field, 0)) {
                return 0;
            }
            break;
        default:
            SetResult ("Not a reduced XPath expression.");
            return 0;
        }
        toplevel = 0;
        t = t->next;
    }
    return 1;
}

static int
uniquePatternCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
    )
{
    SchemaData *sdata = GETASI;
    ast t;
    char *errMsg = NULL;
    KeyConstraint *kc, *kc1;
    int i, nrFields;
    Tcl_Obj *elm;

    CHECK_SI
    CHECK_TOPLEVEL
    checkNrArgs (3,4,"Expected: <selector> <fieldlist> ?<name>?");
    if (sdata->cp->type != SCHEMA_CTYPE_NAME) {
        SetResult ("The unique schema definition command is only "
                   "allowed as direct child of an element.");
    }
    
    if (xpathParse (Tcl_GetString (objv[1]), NULL, XPATH_EXPR,
                    sdata->prefixns, NULL, &t, &errMsg) < 0) {
        SetResult3 ("Error in selector xpath: '", errMsg, "");
        FREE (errMsg);
        return TCL_ERROR;
    }

    if (Tcl_ListObjLength (interp, objv[2], &nrFields) != TCL_OK) {
        SetResult ("The <fieldlist> argument must be a valid tcl list");
        xpathFreeAst (t);
        return TCL_ERROR;
    }
    if (nrFields == 0) {
        SetResult ("Non empty fieldlist arugment expected.");
        xpathFreeAst (t);
        return TCL_ERROR;
    }
    
    kc = TMALLOC (KeyConstraint);
    memset (kc, 0, sizeof (KeyConstraint));
    kc->fields = MALLOC (sizeof (KeyStep*) * nrFields);
    memset (kc->fields, 0, sizeof (KeyStep*) * nrFields);
    kc->nrFields = nrFields;
    
    if (!processSchemaXPath (interp, sdata, kc, SCHEMA_STEP_NONE, t,
                             0, 1)) {
        xpathFreeAst (t);
        freeKeyConstraints (kc);
        return TCL_ERROR;
    }
    xpathFreeAst (t);

    for (i = 0; i < nrFields; i++) {
        Tcl_ListObjIndex (interp, objv[2], i, &elm);
        if (xpathParse (Tcl_GetString (elm), NULL, XPATH_EXPR,
                        sdata->prefixns, NULL, &t, &errMsg) < 0) {
            SetResult3 ("Error in field xpath: '", errMsg, "");
            FREE (errMsg);
            xpathFreeAst (t);
            freeKeyConstraints (kc);
            return TCL_ERROR;
        }
        if (!processSchemaXPath (interp, sdata, kc, SCHEMA_STEP_NONE, t,
                                 i+1, 1)) {
            xpathFreeAst (t);
            freeKeyConstraints (kc);
            return TCL_ERROR;
        }
        xpathFreeAst (t);
    }
    if (objc == 4) {
        kc->name = tdomstrdup (Tcl_GetString (objv[3]));
    }
    if (sdata->cp->localkeys) {
        kc1 = sdata->cp->localkeys;
        while (kc1->next) kc1 = kc1->next;
        kc1->next = kc;
    } else {
        sdata->cp->localkeys = kc;
    }
    return TCL_OK;
}

static int
domuniquePatternCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]

    Tcl_CreateObjCommand (interp, "tdom::schema::text",
                          TextPatternObjCmd, NULL, NULL);

    /* The 'virtual' "tcl" definition command */
    Tcl_CreateObjCommand (interp, "tdom::schema::tcl",
                          VirtualPatternObjCmd, NULL, NULL);

    /* Identity definition commands */
    Tcl_CreateObjCommand (interp,"tdom::schema::unique",
                          uniquePatternCmd, NULL, NULL);
    /* XPath contraints for DOM validation */
    Tcl_CreateObjCommand (interp,"tdom::schema::domunique",
                          domuniquePatternCmd, NULL, NULL);
    
    /* The text constraint commands */
    Tcl_CreateObjCommand (interp,"tdom::schema::text::integer",
                          integerTCObjCmd, NULL, NULL);

|   License for the specific language governing rights and limitations
|   under the License.
|
|   Contributor(s):
|
|
|   written by Rolf Ade
|   2018-2019
|
\---------------------------------------------------------------------------*/

#ifndef __SCHEMA_H__
#define __SCHEMA_H__

#include <tcldom.h>

typedef enum {
  SCHEMA_CQUANT_ONE,
  SCHEMA_CQUANT_OPT,
  SCHEMA_CQUANT_REP,
  SCHEMA_CQUANT_PLUS,
  SCHEMA_CQUANT_NM,
  SCHEMA_CQUANT_ERROR
} SchemaQuant;

typedef int (*SchemaConstraintFunc) (Tcl_Interp *interp,
                                     void *constraintData, char *text);
typedef void (*SchemaConstraintFreeFunc) (void *constraintData);

typedef struct 

    ast    selector;
    ast   *fields;
    int    nrFields;
    int    flags;
    struct domKeyConstraint *next;
} domKeyConstraint;


typedef enum {
  SCHEMA_KEY_UNIQUE,
  SCHEMA_KEY_KEY,
  SCHEMA_KEY_KEYREF
} KeyType;

typedef enum {
  SCHEMA_STEP_NONE,
  SCHEMA_STEP_ELEMENT,
  SCHEMA_STEP_DESCENDANT_ELEMENT,
  SCHEMA_STEP_ATTRIBUTE,
  SCHEMA_STEP_WILDCARD,
  SCHEMA_STEP_NSWILDCARD,
} StepType;

typedef struct KeyStep 
{
    StepType type;
    char    *name;
    char    *ns;
    struct KeyStep *next;
    struct KeyStep *child;
} KeyStep;

typedef struct KeyConstraint {
    char     *name;
    KeyType   type;
    KeyStep  *selector;
    KeyStep **fields;
    int       nrFields;
    struct KeyConstraint *next;
} KeyConstraint;

typedef struct KeyTable {
    struct KeyTable *next;
    Tcl_HashTable    values;
} KeyTable;

typedef struct KeyState 
{
    struct KeyState *next;
    StepType         type;
    KeyStep         *selector;
    KeyStep        **fields;
    int              ownTable;
    KeyTable        *keyTable;
} KeyState;

typedef struct SchemaCP
{
    Schema_CP_Type    type;
    char             *namespace;
    char             *name;
    struct SchemaCP  *next;
    SchemaFlags       flags;
    struct SchemaCP **content;
    SchemaQuant      *quants;
    unsigned int      nc;
    SchemaAttr      **attrs;
    unsigned int      numAttr;
    unsigned int      numReqAttr;
    KeyConstraint    *localkeys;
    domKeyConstraint *domKeys;
} SchemaCP;

typedef struct SchemaValidationStack
{
    SchemaCP *pattern;
    struct SchemaValidationStack *next;
    struct SchemaValidationStack *down;
    int               activeChild;
    int               hasMatched;
    int              *interleaveState;
    KeyState         *keyState;
} SchemaValidationStack;

typedef enum {
    VALIDATION_READY,
    VALIDATION_STARTED,
    VALIDATION_ERROR,
    VALIDATION_FINISHED

    unsigned int contentSize;
    SchemaAttr **currentAttrs;
    unsigned int numAttr;
    unsigned int numReqAttr;
    unsigned int attrSize;
    SchemaValidationStack *stack;
    SchemaValidationStack *stackPool;
    KeyState *keyStatePool;
    KeyTable *keyTablePool;
    ValidationState validationState;
    unsigned int skipDeep;
    Tcl_DString *cdata;
    Tcl_HashTable ids;
    int unknownIDrefs;
    Tcl_HashTable idTables;
} SchemaData;

        }
    } errMsg]
    lappend result $errMsg
    s delete
    set result
} {1 {Command only allowed at lop level} 1 {Command only allowed at lop level} 1 {Method not allowed in nested schema define script} 1 {This recursive call is not allowed}}

test schema-1.27 {define} {
    tdom::schema create s
    set result ""
    s define {
        set ::result "from inside define"
        append ::result " " [expr {2+2}]
    }
    s delete
    set result
} {from inside define 4}
    
test schema-2.1 {grammar definition: ref} {
    tdom::schema create grammar
    grammar defpattern thisPattern {
        element a
        element b
    }
    grammar defpattern thatPattern {

proc postValidation {g xml} {
    set doc [dom parse $xml]
    set rc [$g domvalidate $doc errMsg]
    $doc delete
    return $rc
}

test schema-19.1 {unique} {
    tdom::schema s
    s define {
        defelement doc {
            element a *
            element b *
            unique a @ref
        }
        defelement a {
            attribute ref
        }
        defelement b {
            attribute ref ?
        }
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc><b/></doc>
        <doc><a/></doc>
        {<doc><a ref="1"/><a ref="foo"/></doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 0 1}


test schema-19.2 {unique} {
    set schema {
        prefixns {ns1 http://tdom.org/test}
        defelement doc {
            unique ${::schema-19.2} @ref
        }
    }
    set result [list]
    foreach ::schema-19.2 {
        a
        ./../a
        /foo
        a/b
        {a | b}
        a|b
        (a|b)
        {a/b/c | b/c/d | c/d/e}
        .//a
        //a
        a/@ref
        a/b/c
        a//b/c
        (.//b|a)/c
        ns1:a
        a/.//b/c
        {}
        {    }
        "
                "
        ./item/./foo/.
        .
    } {
        tdom::schema s
        lappend result [catch {s define $schema}]
        s delete
    }
    set result
} {0 1 1 0 0 0 1 0 0 1 1 0 1 1 0 1 1 1 1 0 0}

test schema-19.2a {unique} {
    set schema {
        prefixns {ns1 http://tdom.org/test}
        defelement doc {
            unique ${::schema-19.2} {{@ref | div/@id} @lang}
        }
    }
    set result [list]
    foreach ::schema-19.2 {
        {e/b | a/b | e/f }
    } {
        tdom::schema s
        lappend result [catch {s define $schema}]
        s delete
    }
    set result
} 0

test schema-19.3 {unique} {
    tdom::schema s
    s define {
        defelement doc {
            unique item @lang
            element item * {
                attribute lang
            }
        }
    }
    set result [list]
    foreach xml {
        {<doc><item lang="de"/><item lang="en"/><item lang="fr"/></doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1}

test schema-19.4 {unique} {
    tdom::schema s
    s define {
        defelement doc {
            unique item {@lang @sub} "Combined field unique constraint"
            element item * {
                attribute lang
            }
        }
    }
    set result [list]
    foreach xml {
        {<doc><item lang="de"/><item lang="en"/><item lang="fr"/></doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1}

test schema-20.1 {domunique} {
    set schema {
        prefixns {ns1 http://tdom.org/test}
        defelement doc {
            domunique ${::schema-20.1} @ref
        }

        {<doc><item ref="1" id="a"/><item ref="1" id="b"/></doc>}
    } {
        lappend result [postValidation s $xml]
    }
    s delete
    set result
} {1 0 1 0 1}

}