#!/usr/bin/perl
#BEGIN {unshift@INC,('../../..');}
use strict;
use W3C::Util::Exception;
use W3C::XML::RelaxNGParser;
my $REVISION = '$Id: rngSerializer,v 1.44 2004/07/26 14:22:26 eric Exp $';
my $PATH_PARAM_NAME = '__PATH';

package RdalAnnotation;

sub new {
    my ($proto, $annotation, $element) = @_;
    my $class = ref($proto) || $proto;
    my $self = {ANNOTATION => $annotation, ELEMENT => $element};
    bless ($self, $class);
    return $self;
}

package RdalAssignmentAnnotation;
@RdalAssignmentAnnotation::ISA = qw(RdalAnnotation);

sub getLValue {
    my ($self) = @_;
    return $self->{ANNOTATION}->getLValue;
}

sub getRValue {
    my ($self) = @_;
    return $self->{ANNOTATION}->getRValue;
}

sub neededVars {
    my ($self) = @_;
    return $self->{ANNOTATION}->neededVars;
}

package RdalActionAnnotation;
@RdalActionAnnotation::ISA = qw(RdalAnnotation);

sub toXsl_action {
   my ($self, $annotHandler) = @_;
   return $self->{ANNOTATION}->toXsl($annotHandler);
}

sub neededVars {
    my ($self) = @_;
    return $self->{ANNOTATION}->neededVars;
}

package RdalHandler;
use W3C::Util::Exception;
use W3C::Rdf::RdalParser;
use W3C::XML::SchemaValidatorDataTypes; # @@@ for &pt
use W3C::Rdf::Atoms;

my $Ns = 'http://www.w3.org/2002/12/26-XMLgrammer2RDFdb/annot#';

sub new {
    my ($proto, $validator) = @_;
    my $class = ref($proto) || $proto;
    my $self = {VALIDATOR => $validator, 
		ELEMENT => undef, 
		GLOBALS => [], 
		PROTOTYPES => {}, 
		-atomDictionary => new W3C::Rdf::Atoms};
    bless ($self, $class);
    $validator->registerAnnotationHandler($Ns, $self);
    return $self;
}

sub mapNamespace {
    my ($self, $toMap) = @_;
    return $self->{VALIDATOR}->mapNamespace($toMap);
}

sub parse {
    my ($self, $element) = @_;
    my $lname = $element->getLocalName();

    # Make sure we've been called with known semantics.
    # The exception enforces the extensibility policy for RDAL.
    if ($lname eq 'prototype') {
    } elsif ($lname eq 'globals') {
    } elsif ($lname eq 'default') {
    } elsif ($lname eq 'assignment') {
    } elsif ($lname eq 'action') {
    } elsif ($lname eq 'recursive') {
    } elsif ($lname eq 'noop') {
	return;
    } else {
	&throw(new W3C::Util::Exception(-message => "no support for \"$lname\""));
    }

    # Parse the expected first literal.
    my $literal = $element->getFirstChild();
    my $parseMe = $literal->getVal();

    my $p = new W3C::Rdf::RdalParser($parseMe, $self, $element);
    my $actions = $p->parse();
    if ($lname eq 'prototype') {
	foreach my $decl (@{$actions->getFuncDecls()}) {
	    my ($fname, $args) = @$decl;
	    $self->{PROTOTYPES}{$fname} = [map {$_->toXPath()} @$args];
	}
    } elsif ($lname eq 'globals') {
	my $assignments = $actions->expectAssignments();
	foreach my $global (@$assignments) {
	    my ($lvalue, $rvalue) = ($global->getLValue, $global->getRValue);
	    if (my $underride = $self->{GLOBAL_IDX}{$lvalue}) {
		#my $msg = "$lvalue assignment to $rvalue overrides $underride";
		#warn(new W3C::Util::Exception(-message => $msg)->toString);
		warn "$lvalue assignment to $rvalue overrides $underride\n";
	    }
	    $self->{GLOBAL_IDX}{$lvalue} = $rvalue;
	    push (@{$self->{GLOBALS}}, [$lvalue, $rvalue]);
	}
    }
    my $ob = $lname eq 'assignment' || $lname eq 'default' ? new RdalAssignmentAnnotation($actions, $element) : 
	$lname eq 'action' ? new RdalActionAnnotation($actions, $element) : 
	new RdalAnnotation($actions, $element);
    $element->setCompiled($ob)
}

sub dispatch {
    my ($self, $element) = @_;
    1;
}

sub getPrototypes {$_[0]->{PROTOTYPES}}
sub getParmNames {$_[0]->{PROTOTYPES}{$_[1]}}
sub getGlobals {$_[0]->{GLOBALS}}
sub isGlobal {exists $_[0]->{GLOBAL_IDX}{$_[1]}}

package W3C::XML::SchemaValidator::Element;
use W3C::XML::SchemaValidatorDataTypes qw($COMP_NOT $COMP_MAY $COMP_MUST); # @@@ for &pt

sub new {
    my ($proto, $parser, $nameClass, $pattern, $nameAnnotOpt, $patternAnnotOpt, @EXPRARGS) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($parser, $nameClass, $pattern, $nameAnnotOpt, $patternAnnotOpt, @EXPRARGS);
    $self->{NEXT} = [];
    $self->{POSITIVES} = [];
    $self->{PRODUCTION} = undef;
    $self->{CALLERS} = {};
    $self->{CALLER_ORDER} = [];
    $self->{BASENAME} = undef;
    $self->{STATE} = 0;
    return $self;
}

# <Option Calculus>
sub _addKnownElement {
    my ($self, $element, $mayMustNot) = @_;
    $self->_addKnownComponent($element, $mayMustNot, 'ELEMENTS');
}

sub _addKnownAttribute {
    my ($self, $attribute, $mayMustNot) = @_;
    $self->_addKnownComponent($attribute, $mayMustNot, 'ATTRIBUTES');
}

sub _addKnownComponent {
    my ($self, $elAttr, $mayMustNot, $typeKey) = @_;
    my $addMe = $elAttr->toString();
    if ($mayMustNot == $COMP_NOT) {
	if ($self->{$COMP_MAY}{$typeKey}{$addMe} || 
	    $self->{$COMP_MUST}{$typeKey}{$addMe}) {
	    return;
	}
    } elsif ($mayMustNot == $COMP_MAY) {
	if ($self->{$COMP_MUST}{$typeKey}{$addMe}) {
	    return;
	} elsif ($self->{$COMP_NOT}{$typeKey}{$addMe}) {
	    delete $self->{$COMP_NOT}{$typeKey}{$addMe};
	}
    } elsif ($mayMustNot == $COMP_MUST) {
	if ($self->{$COMP_NOT}{$typeKey}{$addMe}) {
	    delete $self->{$COMP_NOT}{$typeKey}{$addMe};
	} elsif ($self->{$COMP_MAY}{$typeKey}{$addMe}) {
	    delete $self->{$COMP_MAY}{$typeKey}{$addMe};
	}
    } else {&throw(new W3C::Util::Exception(-message => "$mayMustNot vs ($COMP_NOT, $COMP_MAY, $COMP_MUST)"));}
    if ($self->{$mayMustNot}{$typeKey}{$addMe}) {
	&throw();
    } else {
	$self->{$mayMustNot}{$typeKey}{$addMe} = $addMe;
    }
}

sub _distinguish {
    my ($self, $generation) = @_;
    my ($sum, @comps);
    foreach my $mustEl (values %{$self->{$COMP_MUST}{ELEMENTS}}) {
	push (@comps, $generation.$mustEl);
    }
    foreach my $notEl (values %{$self->{$COMP_NOT}{ELEMENTS}}) {
	push (@comps, "not $generation".$notEl);
    }
    my $attrGeneration = &_nextGen($generation);
    foreach my $mustAttr (values %{$self->{$COMP_MUST}{ATTRIBUTES}}) {
	push (@comps, "\@$attrGeneration".$mustAttr);
    }
    foreach my $notAttr (values %{$self->{$COMP_NOT}{ATTRIBUTES}}) {
	push (@comps, "not \@$attrGeneration".$notAttr);
    }
    $sum = join (' ', sort @comps);
    return ($sum, join (' and ', @comps));
}

sub _checkUndistinguished { # static
    my ($undistinguished, $generation, $visited) = @_;
    my $prodSelectors = {};
    my $collidingSums = {};

    my $strToOb = {}; # Perl hash keys aren't objects (yet?)!

    my $knownSums = {};
    foreach my $caller (@$undistinguished) {
	foreach my $callee (@{$caller->{NEXT}}) {
	    my ($sum, $str) = $callee->_distinguish($generation);
	    $prodSelectors->{$callee} = $str;

	    if (exists $knownSums->{$sum}) {
		push (@{$knownSums->{$sum}}, $callee);
		$collidingSums->{$caller}{$sum} = [@{$knownSums->{$sum}}];
		$strToOb->{$caller} = $caller; # arg!
	    } else {
		$knownSums->{$sum} = [$callee];
	    }
	}
    }

    foreach my $caller (keys %$collidingSums) {
	foreach my $sum (keys %{$collidingSums->{$caller}}) {
	    if ($visited->{$caller}) {
		my ($name, $distinguishingStr) = &_distinguishingStr($caller, $sum, $collidingSums, $strToOb);

		# Note: this could be deferred to eval time by putting in an
		# early condition for the ambiguous case and having it call an
		# error. This would enable rngSerializer to generate templates
		# for non-ambiguous documents even if certain documents could be
		# ambiguous.

		&throw(new W3C::Util::FooException(-message => "$name -- unable to disambiguate from $distinguishingStr"));
	    }
	    $visited->{$caller} = $caller; # could be undef after done debugging;
	    my $nextGen = &_nextGen($generation);
	    eval {
		my $subProdSelectors = &_checkUndistinguished($collidingSums->{$caller}{$sum}, $nextGen, $visited);
		$prodSelectors->{$caller} .= ' and ('.join(' or ', values %$subProdSelectors).')';
	    }; if ($@) {
		if (my $ex = &catch('W3C::Util::Exception')) {
		    if ($ex->isa('W3C::Util::FooException')) {
			my ($name, $distinguishingStr) = &_distinguishingStr($caller, $sum, $collidingSums, $strToOb);
			$ex->{-message} = "$name -> $ex->{-message} from $distinguishingStr";
		    }
		    &throw($ex);
		} else {
		    &throw(new W3C::Util::PerlException());
		}
	    }
	}
    }
    return $prodSelectors;
}

sub _distinguishingStr {
    my ($caller, $sum, $collidingSums, $strToOb) = @_;
    my $name = $strToOb->{$caller}->_getName();
    my @others;
    foreach my $key (keys %{$collidingSums->{$caller}}) {
	if ($key ne $sum) {
	    push (@others, $strToOb->{$key}->_getName());
	}
    }
    return $name, join(' ', @others);
}

# </Option Calculus>

sub _nextGen {
    my ($generation) = @_;
    return $generation eq 'self::' ? '' : $generation eq '' ? "*/" : "$generation*/";
}

sub _setNext {
    my ($self, $next) = @_;
    push (@{$self->{NEXT}}, @$next); # ? $next eq '<MIXED>' ? 'MIXED' : $next->_getName() : undef;
}

sub _addPositive {
    my ($self, $positive, $values, $productions) = @_;
    push (@{$self->{POSITIVES}}, [$positive, $values, $productions]);
}

sub _addCaller {
    my ($self, $caller, $productions) = @_;
    if ($self->{CALLERS}{$caller}) {
	&throw(new W3C::Util::Exception(-message => 
					"$caller -> $self alread known"));
    }
    if (@$productions) {
	if (defined $self->{PRODUCTION}) {
	    if ($self->{PRODUCTION} ne $productions->[-1]) {
		&throw(new W3C::Util::Exception(-message => 
						"$$self->{PRODUCTION} -> $productions->[-1]"));
	    }
	} else {
	    $self->{PRODUCTION} = $productions->[-1];
	    for (my $i = @$productions-1; $i >= 0; $i--) {
		my $newBit = $productions->[$i]->prodStackEnt_toString;
		$self->{BASENAME} = $self->{BASENAME} ? "${newBit}_$self->{BASENAME}" : $newBit;
		if ($productions->[$i]->isa('W3C::XML::SchemaValidator::PatternQualifier')) {
		    1;
		} else {
		    last;
		}
	    }
	}
    }
    $self->{CALLERS}{$caller} = [$caller, $productions];
    push (@{$self->{CALLER_ORDER}}, $caller);
}

sub _uniqueName {
    my ($self, $known) = @_;
    if (!defined $self->{BASENAME}) {
	my $baseName;
	$baseName = $self->toXPath('');
	$baseName =~ s/^self:://;
	$baseName =~ s/:/_/g;
	$self->{BASENAME} = $baseName;;
    }
    my $i = 0;
    my $suffix = '';
    while ($known->{"$self->{BASENAME}$suffix"}) {
	$suffix = "$i";
	$i++;
    }
    $self->{BASENAME} = "$self->{BASENAME}$suffix";
    $known->{$self->{BASENAME}} = $self;
}

sub _getName {
    my ($self) = @_;
    return "$self->{BASENAME}_$self->{STATE}";
}

sub _neededParms {
    my ($self, $annotHandler) = @_;
    if (my $annotations = $self->getPatternAnnotation()) {
	foreach my $sAnnotation (@$annotations) {
	    my $annotation = $sAnnotation->getCompiled;
	    my $nv = $annotation->neededVars;
	    foreach my $needed (keys %$nv) {
		if (!$annotHandler->isGlobal($needed)) {
		    $self->_inScope($needed, $nv->{$needed});
		}
	    }
	}
    }
}

# Tell all calling templates what variables are in scope.
sub _inScope {
    my ($self, $name, $whatever) = @_;
    if (!$self->{IN_SCOPE}{$name}) {
	$self->{IN_SCOPE}{$name} = $whatever;
	foreach my $caller (@{$self->{CALLER_ORDER}}) {
	    my ($template, $productions) = @{$self->{CALLERS}{$caller}};
	    $template->_inScope($name, $whatever);
	}
    }
}

sub _passedParms {
    my ($self) = @_;
    return map {"    <$W3C::XSL_prefix:param name=\"$_\"/>\n"} ($PATH_PARAM_NAME, keys %{$self->{IN_SCOPE}});
}

sub toXsl {
    my ($self, $xslWriter, $annotHandler) = @_;
    my $nameStr = $self->_sanitize($self->_getName());
    my $matchStr = $self->_sanitize($self->toXPath('self::'));
    my $summaryStr = $self->_sanitize($self->_toSummary);

    # Store results in @ret;
    my @ret;

    my $productionAnnotation = [];

    # Walk through list of callers
    foreach my $caller (@{$self->{CALLER_ORDER}}) {
	my ($template, $productions) = @{$self->{CALLERS}{$caller}};

	# Add comments to say how we got here.
	my $productionsStr = join (' ', map {$_->prodStackEnt_toString()} @$productions);
	my $templateStr = $template->_getName;

	my $labelStr = $self->_sanitize("$templateStr: $productionsStr");
	$labelStr =~ s/--/-_/sxg; # additional XML comment restriction
	push (@ret, "  <!-- $labelStr -->\n");

	# Look for annotations associated with productions.
	my $annotations = [];
	foreach my $production (@$productions) {
	    if (my $prodAnnots = $production->prodStackEnt_getFollowAnnots()) {
		foreach my $prodAnnot (@$prodAnnots) {
		    my $compiled = $prodAnnot->getCompiled();
		    if ($compiled->isa('RdalActionAnnotation')) {
			push (@$annotations, $compiled);
		    }
		}
	    }
	}
	if (@$annotations) {
	    push (@$productionAnnotation, [$productionsStr, $annotations]);
	}
    }

    # Start the current template.
    push (@ret, "  <$W3C::XSL_prefix:template name=\"$nameStr\">\n");
    push (@ret, $self->_passedParms);

    # Validate the current element.
    if ($matchStr) {
	push (@ret, "    <$W3C::XSL_prefix:choose>
      <$W3C::XSL_prefix:when test=\"$matchStr\">\n\n");
    } else {
	push (@ret, "    <!-- allow any element name except... @@@ -->\n");
    }

    # Validate the attributes.
    my $positivesStr = ''; # $self->_sanitize(join (', ', map {"\@$_"} @{$self->{POSITIVES}}));
    if (@{$self->{POSITIVES}}) { # @@@ converge with option calculus.
	my @whens;
	foreach my $positive (@{$self->{POSITIVES}}) {
	    my ($attributeObs, $values, $productions) = @$positive;
	    my $attribute;
	    if (@$attributeObs != 1) {&throw(new W3C::Util::NotImplementedException());}
	    if ($attributeObs->[0]->isa('W3C::XML::SchemaValidator::NCName')) {
		$attribute = $attributeObs->[0]->toString;
	    } elsif ($attributeObs->[0]->isa('W3C::XML::SchemaValidator::AnyNameExcept')) {
		$attribute = '!!'.$attributeObs->[0]->toString.'!!';
	    } else {
		&throw(new W3C::Util::Exception(-message => "unknown attribute type $attributeObs->[0]"));
	    }
	    my @attrWhens; # whens for this attribute
	    foreach my $value (@$values) {
		if ($value->isa('W3C::XML::SchemaValidator::Text')) {
		} elsif ($value->isa('W3C::XML::SchemaValidator::NCName')) {
		} elsif ($value->isa('W3C::XML::SchemaValidator::NameOptDTV')) {
		    push (@attrWhens, "$attribute=".$value->toString);
		} elsif ($value->isa('W3C::XML::SchemaValidator::String')) {
		} else {
		    &throw(new W3C::Util::Exception(-message => "unknown value type $value"));
		}
	    }
	    if (@attrWhens) {
		push (@whens, @attrWhens);
	    } else {
		push (@whens, $attribute);
	    }
	}
	$positivesStr = join (', ', @whens);
	push (@ret, "        <!-- expect only attributes: $positivesStr -->
        <$W3C::XSL_prefix:for-each select=\"./\@*\">
          <$W3C::XSL_prefix:choose>\n");
	foreach my $when (@whens) {
	    push (@ret, "            <$W3C::XSL_prefix:when test=\"self::$when\"/>\n");
	}
	push (@ret, "            <$W3C::XSL_prefix:otherwise>
              <$W3C::XSL_prefix:call-template name=\"error\">
                <$W3C::XSL_prefix:with-param name=\"hint\" select=\"'unexpected $nameStr attribute'\"/>
                <$W3C::XSL_prefix:with-param name=\"expected\" select=\"'$summaryStr'\"/>
              </$W3C::XSL_prefix:call-template>
            </$W3C::XSL_prefix:otherwise>
          </$W3C::XSL_prefix:choose>
        </$W3C::XSL_prefix:for-each>\n\n");
    }

    # Close validating the current element.
    if ($matchStr) {
	push (@ret, "      </$W3C::XSL_prefix:when>

      <!-- didn't match any productions -->
      <$W3C::XSL_prefix:otherwise>
        <$W3C::XSL_prefix:call-template name=\"error\">
          <$W3C::XSL_prefix:with-param name=\"hint\" select=\"'unexpected $nameStr element'\"/>
          <$W3C::XSL_prefix:with-param name=\"expected\" select=\"'$summaryStr'\"/>
        </$W3C::XSL_prefix:call-template>
      </$W3C::XSL_prefix:otherwise>
    </$W3C::XSL_prefix:choose>\n\n");
    }

    # Execute the productionAnnotations encountered by the callers.
    if (@$productionAnnotation) {
	push (@ret, "    <!-- call actions for annotations on calling productions -->
    <$W3C::XSL_prefix:choose>\n");
	foreach my $set (@$productionAnnotation) {
	    my ($pathStr, $annotations) = @$set;
	    foreach my $annotation (@$annotations) {
		push (@ret, "      <$W3C::XSL_prefix:when test=\"\$$PATH_PARAM_NAME = '$pathStr'\">\n");
		push (@ret, map {"        $_"} $annotation->toXsl_action($annotHandler));
		push (@ret, "      </$W3C::XSL_prefix:when>\n");
	    }
	}
	push (@ret, "    </$W3C::XSL_prefix:choose>\n");
    }

    # Execute pattern annotations.
    if (my $annotations = $self->getPatternAnnotation()) {
	foreach my $sAnnotation (@$annotations) {
	    my $annotation = $sAnnotation->getCompiled;
	    if ($annotation->isa('RdalAssignmentAnnotation')) {

		# Assignments dictate creating a new (friggin') template.
		my $oldNameStr = $nameStr;
		$self->{STATE}++;
		$nameStr = $self->_sanitize($self->_getName());
		my $lvalue = $annotation->getLValue;
		my $rvalue = $annotation->getRValue;
		push (@ret, "    <$W3C::XSL_prefix:call-template name=\"$nameStr\">
      <$W3C::XSL_prefix:with-param name=\"$PATH_PARAM_NAME\" select=\"\$$PATH_PARAM_NAME\"/>
      <$W3C::XSL_prefix:with-param name=\"$lvalue\" select=\"$rvalue\"/>\n");
		foreach my $inScope (keys %{$self->{IN_SCOPE}}) {
		    if ($inScope ne $lvalue) {
			push (@ret, "      <$W3C::XSL_prefix:with-param name=\"$inScope\" select=\"\$$inScope\"/>\n");
		    }
		}
		push (@ret, "    </$W3C::XSL_prefix:call-template>
  </$W3C::XSL_prefix:template><!-- end $oldNameStr -->

  <!-- chained template to assign $lvalue -->
  <$W3C::XSL_prefix:template name=\"$nameStr\">\n");
		push (@ret, $self->_passedParms);
		push (@ret, "\n");
	    } elsif ($annotation->isa('RdalActionAnnotation')) {
		push (@ret, map {"    $_"} $annotation->toXsl_action($annotHandler));
	    } else {
		&throw();
		push (@ret, map {"    $_\n"} @{$annotation->toXsl});
	    }
	}
    }

    # Call template for nested elements.
    if (@{$self->{NEXT}}) {
	# Since XSLT templates can't give return codes, we must pre-inspect the
	# template alternatives to decide which we will call. This produces
	# redundant tests as some of the same inspection will happen as the
	# template validates.

	# We must identify tests that distinguish the alternatives. For now,
	# we optimistically get the attributes and first nested element for
	# each option. We also do NOT yet check to see if that is sufficient.
	my $orderedNext = [@{$self->{NEXT}}];
	push (@ret, "    <!-- call productions for nested elements -->
    <$W3C::XSL_prefix:for-each select=\"*\">
      <$W3C::XSL_prefix:choose>\n");

	# Productions from this template.
	my $prodSelectors = &_checkUndistinguished([$self], 'self::', {});

	foreach my $next (@{$self->{NEXT}}) {
	    my $xpathStr = $prodSelectors->{$next};
	    my $nextCall = $next eq '<MIXED>' ? '_res_mixed' : $next->_getName;

	    # Get a test string from schema for element.
	    #my $testStr = $next eq '<MIXED>' ? 'text() or *' : $self->_sanitize($next->{ELEMENT}->getUniqueMatch());
	    my $testStr = $next eq '<MIXED>' ? 'text() or *' : $self->_sanitize($xpathStr);
	    push (@ret, "        <$W3C::XSL_prefix:when test=\"$testStr\">
          <$W3C::XSL_prefix:call-template name=\"$nextCall\">\n");
	    my $productionPath = $next->{CALLERS}{$self}[1];
	    my $pathStr = join (' ', map {$_->prodStackEnt_toString()} @$productionPath);

	    push (@ret, "            <$W3C::XSL_prefix:with-param name=\"$PATH_PARAM_NAME\" select=\"'$pathStr'\"/>\n");
	    foreach my $inScope (keys %{$next->{IN_SCOPE}}) {
		push (@ret, "            <$W3C::XSL_prefix:with-param name=\"$inScope\" select=\"\$$inScope\"/>\n");
	    }
	    push (@ret, "          </$W3C::XSL_prefix:call-template>
        </$W3C::XSL_prefix:when>\n");
	}
	push (@ret, "        <$W3C::XSL_prefix:otherwise>
          <$W3C::XSL_prefix:call-template name=\"error\">
            <$W3C::XSL_prefix:with-param name=\"hint\" select=\"'no matching $nameStr production'\"/>
            <$W3C::XSL_prefix:with-param name=\"expected\" select=\"'$summaryStr'\"/>
          </$W3C::XSL_prefix:call-template>
        </$W3C::XSL_prefix:otherwise>
      </$W3C::XSL_prefix:choose>
    </$W3C::XSL_prefix:for-each>\n\n");
    } else {
	# There should be no nested elements.
	push (@ret, "
    <!-- expect no nested elements -->
    <$W3C::XSL_prefix:for-each select=\"*\">
      <$W3C::XSL_prefix:call-template name=\"error\">
        <$W3C::XSL_prefix:with-param name=\"hint\" select=\"'unexpected $nameStr'\"/>
        <$W3C::XSL_prefix:with-param name=\"expected\" select=\"'no elements'\"/>
      </$W3C::XSL_prefix:call-template>
    </$W3C::XSL_prefix:for-each>
");
    }

    # End template.
    push (@ret, "  </$W3C::XSL_prefix:template><!-- end $nameStr -->\n\n");
    return join('', @ret);
}

sub _sanitize {
    my ($self, $str) = @_;
    $str =~ s/\&/&amp;/sxg;
    $str =~ s/\</&lt;/sxg;
    $str =~ s/\>/&gt;/sxg;
    $str =~ s/\"/&quot;/sxg;
    return $str;
}

package W3C::XML::SchemaValidator::Start;

sub new {
    my ($proto, $parser, $id, $val, @EXPRARGS) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($parser, $id, $val, @EXPRARGS);
    $self->{NEXT} = [];
    $self->{POSITIVES} = [];
    $self->{STATE} = 0;
    return $self;
}

sub _checkUndistinguished { # static
    my ($undistinguished, $generation, $visited) = @_;
    my $prodSelectors = {};
    my $collidingSums = {};

    my $strToOb = {}; # Perl hash keys aren't objects (yet?)!

    my $knownSums = {};
    foreach my $caller (@$undistinguished) {
	foreach my $callee (@{$caller->{NEXT}}) {
	    my ($sum, $str) = $callee->_distinguish($generation);
	    $prodSelectors->{$callee} = $str;

	    if (exists $knownSums->{$sum}) {
		push (@{$knownSums->{$sum}}, $callee);
		$collidingSums->{$caller}{$sum} = [@{$knownSums->{$sum}}];
		$strToOb->{$caller} = $caller; # arg!
	    } else {
		$knownSums->{$sum} = [$callee];
	    }
	}
    }

    foreach my $caller (keys %$collidingSums) {
	foreach my $sum (keys %{$collidingSums->{$caller}}) {
	    if ($visited->{$caller}) {
		my ($name, $distinguishingStr) = &_distinguishingStr($caller, $sum, $collidingSums, $strToOb);

		# Note: this could be deferred to eval time by putting in an
		# early condition for the ambiguous case and having it call an
		# error. This would enable rngSerializer to generate templates
		# for non-ambiguous documents even if certain documents could be
		# ambiguous.

		&throw(new W3C::Util::FooException(-message => "$name -- unable to disambiguate from $distinguishingStr"));
	    }
	    $visited->{$caller} = $caller; # could be undef after done debugging;
	    my $nextGen = &_nextGen($generation);
	    eval {
		my $subProdSelectors = &_checkUndistinguished($collidingSums->{$caller}{$sum}, $nextGen, $visited);
		$prodSelectors->{$caller} .= ' and ('.join(' or ', values %$subProdSelectors).')';
	    }; if ($@) {
		if (my $ex = &catch('W3C::Util::Exception')) {
		    if ($ex->isa('W3C::Util::FooException')) {
			my ($name, $distinguishingStr) = &_distinguishingStr($caller, $sum, $collidingSums, $strToOb);
			$ex->{-message} = "$name -> $ex->{-message} from $distinguishingStr";
		    }
		    &throw($ex);
		} else {
		    &throw(new W3C::Util::PerlException());
		}
	    }
	}
    }
    return $prodSelectors;
}

sub _distinguishingStr {
    my ($caller, $sum, $collidingSums, $strToOb) = @_;
    my $name = $strToOb->{$caller}->_getName();
    my @others;
    foreach my $key (keys %{$collidingSums->{$caller}}) {
	if ($key ne $sum) {
	    push (@others, $strToOb->{$key}->_getName());
	}
    }
    return $name, join(' ', @others);
}

sub _setNext {
    my ($self, $next) = @_;
    push (@{$self->{NEXT}}, @$next); # ? $next eq '<MIXED>' ? 'MIXED' : $next->_getName() : undef;
}

sub _uniqueName {
    my ($self, $known) = @_;
    $known->{$self->_getName()} = $self;
}

sub _getName {'root'}

sub _neededParms {
    my ($self, $annotHandler) = @_;
    if (my $annotations = $self->getPatternAnnotation()) {
	foreach my $sAnnotation (@$annotations) {
	    my $annotation = $sAnnotation->getCompiled;
	    my $nv = $annotation->neededVars;
	    foreach my $needed (keys %$nv) {
		if (!$annotHandler->isGlobal($needed)) {
		    $self->_inScope($needed, $nv->{$needed});
		}
	    }
	}
    }
}

sub _inScope {
    my ($self, $name, $whatever) = @_;
    if (!$self->{IN_SCOPE}{$name}) {
	$self->{IN_SCOPE}{$name} = $whatever;
	foreach my $caller (@{$self->{CALLER_ORDER}}) {
	    my ($template, $productions) = @{$self->{CALLERS}{$caller}};
	    $template->_inScope($name, $whatever);
	}
    }
}

sub _passedParms {
    my ($self) = @_;
    return map {"    <$W3C::XSL_prefix:param name=\"$_\"/>\n"} ($PATH_PARAM_NAME, keys %{$self->{IN_SCOPE}});
}

sub toXsl {
    my ($self, $xslWriter, $annotHandler) = @_;
    my $nameStr = $self->_sanitize($self->_getName());
    my $matchStr = $self->_sanitize($self->getMatch());
    my $summaryStr = $self->_sanitize($self->_toSummary);

    # Store results in @ret;
    my @ret;

    my $productionAnnotation = [];

    # Walk through list of callers
    foreach my $caller (@{$self->{CALLER_ORDER}}) {
	my ($template, $productions) = @{$self->{CALLERS}{$caller}};

	# Add comments to say how we got here.
	my $productionsStr = join (' ', map {$_->prodStackEnt_toString()} @$productions);
	my $templateStr = $template->_getName;

	my $labelStr = $self->_sanitize("$templateStr: $productionsStr");
	$labelStr =~ s/--/-_/sxg; # additional XML comment restriction
	push (@ret, "  <!-- $labelStr -->\n");

	# Look for annotations associated with productions.
	my $annotations = [];
	foreach my $production (@$productions) {
	    if (my $prodAnnots = $production->prodStackEnt_getFollowAnnots()) {
		foreach my $prodAnnot (@$prodAnnots) {
		    my $compiled = $prodAnnot->getCompiled();
		    if ($compiled->isa('RdalActionAnnotation')) {
			push (@$annotations, $compiled);
		    }
		}
	    }
	}
	if (@$annotations) {
	    push (@$productionAnnotation, [$productionsStr, $annotations]);
	}
    }

    # Start the current template.
    push (@ret, "  <$W3C::XSL_prefix:template name=\"$nameStr\">\n");
    push (@ret, $self->_passedParms);

    # Validate the current element.
    if ($matchStr) {
	push (@ret, "    <$W3C::XSL_prefix:choose>
      <$W3C::XSL_prefix:when test=\"$matchStr\">\n\n");
    } else {
	push (@ret, "    <!-- allow any element name except... @@@ -->\n");
    }

    # Validate the attributes.
    my $positivesStr = ''; # $self->_sanitize(join (', ', map {"\@$_"} @{$self->{POSITIVES}}));
    if (@{$self->{POSITIVES}}) { # @@@ converge with option calculus.
	my @whens;
	foreach my $positive (@{$self->{POSITIVES}}) {
	    my ($attributeObs, $values, $productions) = @$positive;
	    my $attribute;
	    if (@$attributeObs != 1) {&throw(new W3C::Util::NotImplementedException());}
	    if ($attributeObs->[0]->isa('W3C::XML::SchemaValidator::NCName')) {
		$attribute = $attributeObs->[0]->toString;
	    } elsif ($attributeObs->[0]->isa('W3C::XML::SchemaValidator::AnyNameExcept')) {
		$attribute = '!!'.$attributeObs->[0]->toString.'!!';
	    } else {
		&throw(new W3C::Util::Exception(-message => "unknown attribute type $attributeObs->[0]"));
	    }
	    my @attrWhens; # whens for this attribute
	    foreach my $value (@$values) {
		if ($value->isa('W3C::XML::SchemaValidator::Text')) {
		} elsif ($value->isa('W3C::XML::SchemaValidator::NCName')) {
		} elsif ($value->isa('W3C::XML::SchemaValidator::NameOptDTV')) {
		    push (@attrWhens, "$attribute=".$value->toString);
		} elsif ($value->isa('W3C::XML::SchemaValidator::String')) {
		} else {
		    &throw(new W3C::Util::Exception(-message => "unknown value type $value"));
		}
	    }
	    if (@attrWhens) {
		push (@whens, @attrWhens);
	    } else {
		push (@whens, $attribute);
	    }
	}
	$positivesStr = join (', ', @whens);
	push (@ret, "        <!-- expect only attributes: $positivesStr -->
        <$W3C::XSL_prefix:for-each select=\"./\@*\">
          <$W3C::XSL_prefix:choose>\n");
	foreach my $when (@whens) {
	    push (@ret, "            <$W3C::XSL_prefix:when test=\"self::$when\"/>\n");
	}
	push (@ret, "            <$W3C::XSL_prefix:otherwise>
              <$W3C::XSL_prefix:call-template name=\"error\">
                <$W3C::XSL_prefix:with-param name=\"hint\" select=\"'unexpected $nameStr attribute'\"/>
                <$W3C::XSL_prefix:with-param name=\"expected\" select=\"'$summaryStr'\"/>
              </$W3C::XSL_prefix:call-template>
            </$W3C::XSL_prefix:otherwise>
          </$W3C::XSL_prefix:choose>
        </$W3C::XSL_prefix:for-each>\n\n");
    }

    # Close validating the current element.
    if ($matchStr) {
	push (@ret, "      </$W3C::XSL_prefix:when>

      <!-- didn't match any productions -->
      <$W3C::XSL_prefix:otherwise>
        <$W3C::XSL_prefix:call-template name=\"error\">
          <$W3C::XSL_prefix:with-param name=\"hint\" select=\"'unexpected $nameStr element'\"/>
          <$W3C::XSL_prefix:with-param name=\"expected\" select=\"'$summaryStr'\"/>
        </$W3C::XSL_prefix:call-template>
      </$W3C::XSL_prefix:otherwise>
    </$W3C::XSL_prefix:choose>\n\n");
    }

    # Execute the productionAnnotations encountered by the callers.
    if (@$productionAnnotation) {
	push (@ret, "    <!-- call actions for annotations on calling productions -->
    <$W3C::XSL_prefix:choose>\n");
	foreach my $set (@$productionAnnotation) {
	    my ($pathStr, $annotations) = @$set;
	    foreach my $annotation (@$annotations) {
		push (@ret, "      <$W3C::XSL_prefix:when test=\"\$$PATH_PARAM_NAME = '$pathStr'\">\n");
		push (@ret, map {"        $_"} $annotation->toXsl_action($annotHandler));
		push (@ret, "      </$W3C::XSL_prefix:when>\n");
	    }
	}
	push (@ret, "    </$W3C::XSL_prefix:choose>\n");
    }

    # Execute pattern annotations.
    if (my $annotations = $self->getPatternAnnotation()) {
	foreach my $sAnnotation (@$annotations) {
	    my $annotation = $sAnnotation->getCompiled;
	    if ($annotation->isa('RdalAssignmentAnnotation')) {

		# Assignments dictate creating a new (friggin') template.
		my $oldNameStr = $nameStr;
		$self->{STATE}++;
		$nameStr = $self->_sanitize($self->_getName());
		my $lvalue = $annotation->getLValue;
		my $rvalue = $annotation->getRValue;
		push (@ret, "    <$W3C::XSL_prefix:call-template name=\"$nameStr\">
      <$W3C::XSL_prefix:with-param name=\"$PATH_PARAM_NAME\" select=\"\$$PATH_PARAM_NAME\"/>
      <$W3C::XSL_prefix:with-param name=\"$lvalue\" select=\"$rvalue\"/>\n");
		foreach my $inScope (keys %{$self->{IN_SCOPE}}) {
		    if ($inScope ne $lvalue) {
			push (@ret, "      <$W3C::XSL_prefix:with-param name=\"$inScope\" select=\"\$$inScope\"/>\n");
		    }
		}
		push (@ret, "    </$W3C::XSL_prefix:call-template>
  </$W3C::XSL_prefix:template><!-- end $oldNameStr -->

  <!-- chained template to assign $lvalue -->
  <$W3C::XSL_prefix:template name=\"$nameStr\">\n");
		push (@ret, $self->_passedParms);
		push (@ret, "\n");
	    } elsif ($annotation->isa('RdalActionAnnotation')) {
		push (@ret, map {"    $_"} $annotation->toXsl_action($annotHandler));
	    } else {
		&throw();
		push (@ret, map {"    $_\n"} @{$annotation->toXsl});
	    }
	}
    }

    # Call template for nested elements.
    if (@{$self->{NEXT}}) {
	# Since XSLT templates can't give return codes, we must pre-inspect the
	# template alternatives to decide which we will call. This produces
	# redundant tests as some of the same inspection will happen as the
	# template validates.

	# We must identify tests that distinguish the alternatives. For now,
	# we optimistically get the attributes and first nested element for
	# each option. We also do NOT yet check to see if that is sufficient.
	my $orderedNext = [@{$self->{NEXT}}];
	push (@ret, "    <!-- call productions for nested elements -->
    <$W3C::XSL_prefix:for-each select=\"*\">
      <$W3C::XSL_prefix:choose>\n");

	# Productions from this template.
	my $prodSelectors = &_checkUndistinguished([$self], 'self::', {});

	foreach my $next (@{$self->{NEXT}}) {
	    my $xpathStr = $prodSelectors->{$next};
	    my $nextCall = $next eq '<MIXED>' ? '_res_mixed' : $next->_getName;

	    # Get a test string from schema for element.
	    #my $testStr = $next eq '<MIXED>' ? 'text() or *' : $self->_sanitize($next->{ELEMENT}->getUniqueMatch());
	    my $testStr = $next eq '<MIXED>' ? 'text() or *' : $self->_sanitize($xpathStr);
	    push (@ret, "        <$W3C::XSL_prefix:when test=\"$testStr\">
          <$W3C::XSL_prefix:call-template name=\"$nextCall\">\n");
	    my $productionPath = $next->{CALLERS}{$self}[1];
	    my $pathStr = join (' ', map {$_->prodStackEnt_toString()} @$productionPath);

	    push (@ret, "            <$W3C::XSL_prefix:with-param name=\"$PATH_PARAM_NAME\" select=\"'$pathStr'\"/>\n");
	    foreach my $inScope (keys %{$next->{IN_SCOPE}}) {
		push (@ret, "            <$W3C::XSL_prefix:with-param name=\"$inScope\" select=\"\$$inScope\"/>\n");
	    }
	    push (@ret, "          </$W3C::XSL_prefix:call-template>
        </$W3C::XSL_prefix:when>\n");
	}
	push (@ret, "        <$W3C::XSL_prefix:otherwise>
          <$W3C::XSL_prefix:call-template name=\"error\">
            <$W3C::XSL_prefix:with-param name=\"hint\" select=\"'no matching $nameStr production'\"/>
            <$W3C::XSL_prefix:with-param name=\"expected\" select=\"'$summaryStr'\"/>
          </$W3C::XSL_prefix:call-template>
        </$W3C::XSL_prefix:otherwise>
      </$W3C::XSL_prefix:choose>
    </$W3C::XSL_prefix:for-each>\n\n");
    } else {
	# There should be no nested elements.
	push (@ret, "
    <!-- expect no nested elements -->
    <$W3C::XSL_prefix:for-each select=\"*\">
      <$W3C::XSL_prefix:call-template name=\"error\">
        <$W3C::XSL_prefix:with-param name=\"hint\" select=\"'unexpected $nameStr'\"/>
        <$W3C::XSL_prefix:with-param name=\"expected\" select=\"'no elements'\"/>
      </$W3C::XSL_prefix:call-template>
    </$W3C::XSL_prefix:for-each>
");
    }

    # End template.
    push (@ret, "  </$W3C::XSL_prefix:template><!-- end $nameStr -->\n\n");
    return join('', @ret);
}

sub _sanitize {
    my ($self, $str) = @_;
    $str =~ s/\&/&amp;/sxg;
    $str =~ s/\</&lt;/sxg;
    $str =~ s/\>/&gt;/sxg;
    $str =~ s/\"/&quot;/sxg;
    return $str;
}

package XslWriter;
use W3C::Util::Exception;

sub new {
    my ($proto, $annotations, $outputLib, $grammar) = @_;
    my $class = ref($proto) || $proto;
    my $self = {ANNOTATIONS => $annotations, OUTPUT_LIB => $outputLib, 
		GRAMMAR => $grammar, ORDER => []};
    bless ($self, $class);
    my $rootProduction = $grammar->getReferers($self);
    return $self;
}

sub rootTemplate {
    my ($self, $node) = @_;
    push (@{$self->{ORDER}}, $node);
}

sub getTemplate {
    my ($self, $productions, $element) = @_;
    push (@{$self->{ORDER}}, $element);
}

sub toString {
    my ($self) = @_;
    my @ret;

    # Find a free namespace for xsl.
    local $W3C::XSL_prefix = 'xsl';
    if (0) {
	$W3C::XSL_prefix = 'xsl2';
    }

    my $knownNames = {};
    foreach my $obj (@{$self->{ORDER}}) {
	# Calculate template names.
	$obj->_uniqueName($knownNames);
	# Calculate needed parameters.
	$obj->_neededParms($self->{ANNOTATIONS});
    }

    $self->{GRAMMAR}->ns_decl($W3C::XSL_prefix, 'http://www.w3.org/1999/XSL/Transform');

    my $nsDeclsStr = $self->{GRAMMAR}->ns_toXsl(); # join ("\n ", map {"xmlns:$_->[0]=\"$_->[1]\""} @{$self->{NAMESPACES}});
    
    push (@ret, "<!-- 
Created by: $REVISION -->

<$W3C::XSL_prefix:transform version=\"1.0\"
 $nsDeclsStr>

  <!-- You must manually set your output library here 'cause
       XSLT won't allow parameter definition before an import.
       I would prefer
xsltproc - -stringparam output RdfXStoNTriple.xsl RDFXMLtoRdfXS.xsl test.rdf
  -->
  <$W3C::XSL_prefix:import href=\"$self->{OUTPUT_LIB}\"/>
  <$W3C::XSL_prefix:output method=\"text\"/>\n\n");
    foreach my $global (@{$self->{ANNOTATIONS}->getGlobals}) {
	my ($lvalue, $rvalue) = @$global;
	push (@ret, "  <$W3C::XSL_prefix:param name=\"$lvalue\" select=\"$rvalue\"/>");
    }
    push (@ret, 
"
<!-- $W3C::XSL_prefix:value-of select=\"concat('/ at:', local-name(.), '&#xA;')\"/ -->

  <$W3C::XSL_prefix:template match=\"/\">
    <$W3C::XSL_prefix:call-template name=\"startDocument\"/>
    <$W3C::XSL_prefix:call-template name=\"root\">
      <$W3C::XSL_prefix:with-param name=\"$PATH_PARAM_NAME\" select=\"'root'\"/>
    </$W3C::XSL_prefix:call-template>
    <$W3C::XSL_prefix:call-template name=\"endDocument\"/>
  </$W3C::XSL_prefix:template>\n\n");

    foreach my $obj (@{$self->{ORDER}}) {
	push (@ret, $obj->toXsl($self, $self->{ANNOTATIONS}));
    }

    push (@ret, "</$W3C::XSL_prefix:transform>");
    return join ('', @ret);
}

sub getAnnotHandler {$_[0]->{ANNOTATIONS}}

package DotWriter;
my $MaxPropLabel = 200;
my $Orientation = 'LR'; # LR or TB

use W3C::Util::Exception;

sub new {
    my ($proto, $interestingAttrs) = @_;
    my $class = ref($proto) || $proto;
    my $self = {NODES => {}, NODE_ORDER => [], ARCS => {}, ARC_ORDER => [], 
		COMMENTS => [], INTERESTING_ATTRS => $interestingAttrs};
    bless ($self, $class);
    return $self;
}

sub getInterestingAttrs {$_[0]->{INTERESTING_ATTRS}}

sub addNode {
    my ($self, $name, $attributes) = @_;
    if (exists $self->{NODES}{$name}) {
	$self->{NODES}{$name} = {%{$self->{NODES}{$name}}, %$attributes};
    } else {
	push (@{$self->{NODE_ORDER}}, $name);
	$self->{NODES}{$name} = {%$attributes};
    }
}

sub addArc {
    my ($self, $from, $to, $attributes) = @_;
    my $name = "$from $to";
    if (exists $self->{ARCS}{$name}) {
	$self->{ARCS}{$name}[2] = {%{$self->{ARCS}{$name}[2]}, %$attributes};
    } else {
	push (@{$self->{ARC_ORDER}}, $name);
	$self->{ARCS}{$name} = [$from, $to, {%$attributes}];
    }
}

sub addComment {
    my ($self, $comment) = @_;
    push (@{$self->{COMMENTS}}, $comment);
}

sub toString {
    my ($self) = @_;
    my @ret;
    push (@ret, "digraph dotfile{ 
node [fontname=arial,fontsize=10,color=Black,fontcolor=Blue];
edge [fontname=arial,fontsize=10,color=Darkgreen,fontcolor=Red];
rankdir=$Orientation;
");

    foreach my $comment (@{$self->{COMMENTS}}) {
	push (@ret, "// $comment");
    }

    foreach my $name (@{$self->{NODE_ORDER}}) {
	my $attrs = $self->{NODES}{$name};
	my $attrString = join (',', map {&_sanitize($_).'="'.&_sanitize($attrs->{$_}).'"'} keys %$attrs);
	push (@ret, "\"$name\" [$attrString];");
    }

    foreach my $name (@{$self->{ARC_ORDER}}) {
	my ($from, $to, $attrs) = @{$self->{ARCS}{$name}};
	my $attrString = join (',', map {$_ eq 'label' ? "label=\"".&_sanitize(substr($attrs->{'label'}, -$MaxPropLabel))."\"" : &_sanitize($_).'="'.&_sanitize($attrs->{$_}).'"'} keys %$attrs);
	push (@ret, "\"$from\" -> \"$to\" [$attrString];");
    }

    push (@ret, "}");
    return join ("\n", @ret);
}

sub _sanitize {
    my ($nodeStr) = @_;
    $nodeStr =~ s/\n/\\n/sxg;
    $nodeStr =~ s/\"/\\\"/sxg;
    return $nodeStr;
}

package main;
use Pod::Usage;
use W3C::Util::Exception qw(&DieHandler);
use W3C::Util::Scriptopt;

# Getopt flags:
$main::yydebug = 0x00;
my ($help, $man);
my $OutputMode = 'xsl';
my $OutputLib = 'RdfXStoNTriple.xsl';
my $ArgsProcessed = 0;
my $InterestingAttrs;
my $IntOptionSpec = $Getopt::Long::VERSION >= 2.3 ? 'o' : 'i';

# Use Getopt.
my $res = &GetOptionsScript("d=$IntOptionSpec" => \$main::yydebug, 
			    'm=s' => \&setMode, 
			    'l=s' => \$OutputLib, 
			    'a=s@' => \$InterestingAttrs, 
			    'help|?' => \$help, 
			    'man' => \$man, 
			    '<>' => \&processFile);

&pod2usage(-exitstatus => 0, -verbose => 1) if $help;
&pod2usage(-exitstatus => 0, -verbose => 2) if $man;
&pod2usage(-exitstatus => 1, -verbose => 1, 
	   -message => "No files processed.") if ($ArgsProcessed == 0);

# Getopt callbacks:
sub setMode {
    my ($flag, $value) = @_;
    pod2usage(-exitstatus => 1, 
	      -verbose => 1, 
	      -message => "\"$value\" is an invalid output mode.")
	if ($value !~ m/^(xsl|dot|perlSAX)$/);
    $OutputMode = $value;
}

sub processFile () {
    my ($rnc) = @_;
    local($SIG{"__DIE__"}) = \&DieHandler;
    eval {
	$ArgsProcessed++;

	# Set up parser,
	my $parser = new W3C::XML::RelaxNGParser();
	my $rdal = new RdalHandler($parser);
	my $grammar;

	# Scoop up RNC schema.
	open (FH, $rnc) || die "argument should be a RelaxNG Compact Syntax schema (not \"$rnc\").";
	close FH;

	# Parse schema.
	eval {
	    $grammar = $parser->Run($rnc);
	}; if ($@) {
	    my $message;
	    if (my $ex = &catch('W3C::Util::Exception')) {
		$message = $ex->toString;
	    } else {
		$message = $@;
	    }
	    my $parseState = $parser->ErrorStrArgs;
	    $message .= $parser->ErrorStr(@$parseState);
	    &throw(new W3C::Util::Exception(-message => $message));
	}

	# 2nd pass to resolve references.
	$parser->_resolveReferencePatterns;
	# print "entry production: $rootProduction\n";
	# print $grammar->toString(), "\n";

	# Transform to requested format.
	my $writer;
	if ($OutputMode eq 'dot') {
	    my $interestingAttrs = $InterestingAttrs ? [split(/,/, join(',', @$InterestingAttrs))] : undef;
	    $writer = new DotWriter($interestingAttrs, $rdal);
	    $grammar->toDot($writer);
	} elsif ($OutputMode eq 'xsl') {
	    $writer = new XslWriter($rdal, $OutputLib, $grammar);
	} elsif ($OutputMode eq 'perlSAX') {
	    $writer = new PerlSAXWriter($rdal, $grammar);
	} else {&throw();}
	print $writer->toString(), "\n";
    }; if ($@) {if (my $ex = &catch('W3C::Util::Exception')) {
	die $ex->toString;
    } else {
	die $@;
    }}
}

__END__

=head1 NAME

rngSerializer - Parse a schema in RelaxNG Compact Syntax and render it.

=head1 SYNOPSIS

rngSerializer [options] [file ...]

=head1 OPTIONS

=over 8

=item B<-d>

Set the Yapp::Parser debugging flag $main::yydebug (0x1f is most verbose). See perldoc Yapp::Parser for details.

=item B<-m>

Output mode: must be one of xsl | dot | perlSAX. B<xsl> is the default.

=item B<-l>

Output library for xsl output. B<RdfXStoNTriple.xsl> is the default.

=item B<-a>

Interesting Attributes: when the output mode is dot, only attributes listed as "interesting" will appear on production nodes.

=item B<-help>

Print a brief help message and exit.

=item B<-man>

Send the manual page to the $PAGER and exit.

=item B<file>

Parse B<file> as a RelaxNG Compact Syntax Schema and output in the current B<output mode>.

=back

=head1 DESCRIPTION

B<rngSerializer> will read RNC input file(s) and render them according to the B<output mode>.

=head1 ALGORITHM

=head2 XSL

Each template in the XSL output corresponds to an element in the RNC. These validate themselves by testing the element name and attributes names and values. The challenge comes in calling the correct template. Here are some challenges to the process:

=head3 expressivity mismatch

RelaxNG has some precedence rules aroung negative matches that don't translate directly to XPath. For instance,
  element elt {
    attribute * - ( foo | bar | baz ) { text }*, 
    attribute foo { text }?
    attribute bar { text }
  }

is a legal way to write that any attribute except baz is allowed on a elt element. It does not work to translate this directly to XPath as

  <xsl:when match="elt and not @elt/bar and not @elt/baz and @elt/bar"/>

expresses very different constraints, in part because the semantics of B<*> are lost, and in part because I<bar> has already been labeled illegal by the I<* - ( bar | baz )> when it is re-legalized by the attribute I<bar>. The RNC expression can be approximated by creating a B<synopsis> of determining components (attributes, elements, PIs, ...). This synopsis is a list of all the mandatory B<MUST> and specifically prohibited B<NOT> components and listing them in the test. In the process, a B<MAY> list is created to remove overridden B<NOT>s (like the I<foo> attribute). The template for the above example would have the following attribute synopsis:
  NOT: baz
  MAY: foo
  MUST: bar

The precedence for these is: @@@check@@@ a MAY or MUST removes a NOT; a MUST removes a MAY. ie, 
  element elt {
    attribute joe { text }?
    attribute joe { text }
  }

means

  element elt {
    attribute joe { text }
  }

The test for the elt production would then be:
  <xsl:when test="elt and @elt/bar and not(@elt/baz)"/>

This implementation limitation means that a template calling templates for certain context free grammars won't select the correct one. This seems solvable by re-expressing negative matches (everything except (a:b | c:d)) in terms of the known names from all other templates at the same depth from the testing template.

Note: attributes must also carry their assigned values as often productions vary by the value of some attribute. An example from RDFXML is they B<parseType> attribute which determines four productions based on the values "Literal", "Resource", "Collection", and any other value:

  <xsl:when match="@*/parseType='Literal'/>
  <xsl:when match="@*/parseType='Resource'/>
  <xsl:when match="@*/parseType='Collection'/>
  <xsl:when match="@*/parseType and 
                   not(@*/parseType='Literal' or 
                       @*/parseType='Resource' or 
                       @*/parseType='Collection')"/>

=head3 context sensitive grammars

RelaxNG is context sensitive and thusly may have productions that are differentiated but looking further down the tree than the current element and its attributes. For example the following excerpt from the RDFXML RNC schema:

  propertyElt = 
    resourcePropertyElt | 
    literalPropertyElt | 
  # parseType=foo options ommited in this example for simplicity.
    emptyPropertyElt

  resourcePropertyElt = 
    element * {
        attribute rdf:ID { xsd:NMTOKEN }?, 
        element * { propertyElt }
    }

  literalPropertyElt = 
    element * {
        attribute rdf:ID { xsd:NMTOKEN }?, 
        text
    }

  emptyPropertyElt =
     element * {
        attribute rdf:ID { xsd:NMTOKEN }?, 
        attribute * - ( rdf:ID | rdf:parseType ) { string }*
     }

The logical way to select between the resourcePropertyElt, literalPropertyElt and  emptyPropertyElt templates is:

  <xsl:when test="not @parseType and */*">
    <xsl:call-tempate name="resourcePropertyElt"/>
  </xsl:when>
  <xsl:when test="not @parseType and */text()">
    <xsl:call-tempate name="literalPropertyElt"/>
  </xsl:when>
  <xsl:when test="not @parseType and not(*/*) and not(*/text())">
    <xsl:call-tempate name="emptyPropertyElt"/>
  </xsl:when>
  <xsl:otherwise>
    <xsl:call-tempate name="_noMatchingProduction"/>
  </xsl:otherwise>

This requires looking further down the tree. In order to see how far down the tree to go, a hash of the B<MUST> and B<NOT> determining components is calculated for each callable production. Those whith an identical hash are insufficiently differentiated. For these, another generation is included in the selection criteria. If this selection is not suficient, another generation is included. During this process, a hash of visited productions keeps two undifferentiable recursive productions from eating their own tails. If including a generation causes more than one undiferentiated production to recurse into a production it has already visited, an exception signals that the algorithm will not be able to reliably resolve those productions.

=head1 junk

An expressivity mismatch exists between XPath and RNC productions. XPath can't express I<* - (foo:bar)> (anything except foo:bar) as a positive test while that is the principle advantage of RelaxNG. This makes it difficule to express the

This is obtained by separating the B<attributes> into mandatory, optional, and explicity prohibited. The same is actually done for B<elements>, B<text>, B<mixed> and B<any>. Production selection is based on the mandatory and the prohibited components.

=cut