#!/usr/bin/perl
#Copyright Massachusetts Institute of technology, 2003.
#Written by Eric Prud'hommeaux for the World Wide Web Consortium
#This file is PUBLIC DOMAIN.

# RdalCompileTree.pm -- Object definitions for populating an rdal parse tree.
# 
# $Id: RdalCompileTree.pm,v 1.14 2004/06/07 02:48:07 eric Exp $

use strict;
package W3C::Rdf::RdalCompileTree;
require Exporter;

@W3C::Rdf::RdalCompileTree::ISA = qw(Exporter);
@W3C::Rdf::RdalCompileTree::Var::ISA = qw(W3C::Rdf::RdalCompileTree::Stuff);
@W3C::Rdf::RdalCompileTree::Spot::ISA = qw(W3C::Rdf::RdalCompileTree::Stuff);
@W3C::Rdf::RdalCompileTree::Arg::ISA = qw(W3C::Rdf::RdalCompileTree::Stuff);
@W3C::Rdf::RdalCompileTree::Attribute::ISA = qw(W3C::Rdf::RdalCompileTree::Stuff);
@W3C::Rdf::RdalCompileTree::QName::ISA = qw(W3C::Rdf::RdalCompileTree::Stuff);
@W3C::Rdf::RdalCompileTree::AxisTest::ISA = qw(W3C::Rdf::RdalCompileTree::Stuff);
@W3C::Rdf::RdalCompileTree::Condition::ISA = qw(W3C::Rdf::RdalCompileTree::Stuff);
@W3C::Rdf::RdalCompileTree::Assign::ISA = qw(W3C::Rdf::RdalCompileTree::Stuff);
@W3C::Rdf::RdalCompileTree::GlobalDecl::ISA = qw(W3C::Rdf::RdalCompileTree::Assign);
@W3C::Rdf::RdalCompileTree::Ne::ISA = qw(W3C::Rdf::RdalCompileTree::Stuff);
@W3C::Rdf::RdalCompileTree::FuncCall::ISA = qw(W3C::Rdf::RdalCompileTree::Stuff);
@W3C::Rdf::RdalCompileTree::FuncDecl::ISA = qw(W3C::Rdf::RdalCompileTree::FuncCall);

sub format {
    my ($in, $add) = @_;
    my @lines = split("\n", $in);
    return join ("\n", $lines[0], map {"$add$_"} @lines[1..@lines-1]);
}
# The whole rdal request structure.

package W3C::Rdf::RdalCompileTree::Stuff;
use W3C::Util::Exception;

sub new {
    my ($proto, $parser) = @_;
    my $class = ref($proto) || $proto;
    if (!$parser || !UNIVERSAL::isa($parser, 'W3C::Rdf::RdalParser')) {&throw()}
    my $self = {PARSER => $parser, RDAL_HANDLER => $parser->YYData->{RDAL_HANDLER}, 
		PARSE_STATE => $parser->ErrorStrArgs};
    bless ($self, $class);
    return $self;
}

package W3C::Rdf::RdalCompileTree::Literal;
@W3C::Rdf::RdalCompileTree::Literal::ISA = qw(W3C::Rdf::RdalCompileTree::Stuff);
sub new {
    my ($proto, $val, @STUFFARGS) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@STUFFARGS);
    $self->{VAL} = $val;
    return $self;
}
sub neededVars {{}}
sub toXPath {
    my ($self) = @_;
    return "'$self->{VAL}'";
}

package W3C::Rdf::RdalCompileTree::QName;
sub new {
    my ($proto, $prefix, $localName, @exprParms) = @_;
    my $class = ref($proto) || $proto;
    # $exprParms->[0]->foo($qname);
    my $self = $class->SUPER::new(@exprParms);
    my $qname = "${prefix}:$localName";
    my ($ns, $localName, $prefix) = $self->{RDAL_HANDLER}->mapNamespace($qname);
    $self->{QNAME} = $qname;
    $self->{URL} = "$ns$localName";
    return $self;
}

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

package W3C::Rdf::RdalCompileTree::AxisTest;
sub new {
    my ($proto, $axis, $test, @exprParms) = @_;
    my $class = ref($proto) || $proto;
    # $exprParms->[0]->foo($qname);
    my $self = $class->SUPER::new(@exprParms);
    $self->{AXIS} = $axis;
    $self->{TEST} = $test;
    return $self;
}
sub toXPath {
    my ($self, $annotHandler) = @_;
    my $test = $self->{TEST}->toXPath($annotHandler);
    return "$self->{AXIS}::$test";
}

package W3C::Rdf::RdalCompileTree::Condition;
sub new {
    my ($proto, $test, $exprs, @exprParms) = @_;
    my $class = ref($proto) || $proto;
    # $exprParms->[0]->foo($qname);
    my $self = $class->SUPER::new(@exprParms);
    $self->{TEST} = $test;
    $self->{EXPRS} = $exprs;
    return $self;
}

sub toXsl {
    my ($self, $annotHandler) = @_;
    my @ret;
    my $condition = $self->{TEST}->toXPath($annotHandler);
    push (@ret, "<xsl:choose>\n", 
	  "  <xsl:when test=\"$condition\">\n");

    push (@ret, map {map {"    $_"} $_->toXsl($annotHandler)} @{$self->{EXPRS}});

    push (@ret, "  </xsl:when>\n", 
	  "</xsl:choose>\n");
    return @ret;
}

package W3C::Rdf::RdalCompileTree::Var;
use W3C::Util::Exception;
sub new {
    my ($proto, $name, $create, @exprParms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@exprParms);
    $self->{VARNAME} = $name;
    $self->{NEWSYMBOL} = 0;
    my $resultSet = $self->{RDAL_HANDLER}->getResultSet;
    $self->{VARINDEX} = $resultSet->getIndex($name);
    if (!defined $self->{VARINDEX}) {
	if ($create) {
	    $self->{VARINDEX} = $resultSet->bindSymbol($name);
	    $self->{NEWSYMBOL} = 1;
	} else {
	    &throw(new W3C::Util::Exception(-message => "no bindings for $self->{VARNAME}"));
	}
    }
    return $self;
}

package W3C::Rdf::RdalCompileTree::Spot;
use W3C::Util::Exception;
sub new {
    my ($proto, @exprParms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@exprParms);
}
sub neededVars {{}}

sub toXPath {
    my ($self) = @_;
    return ".";
}

package W3C::Rdf::RdalCompileTree::Arg;

sub new {
    my ($proto, $name, @exprParms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@exprParms);
    $self->{VARNAME} = $name;
    return $self;
}

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

sub toXPath {
    my ($self) = @_;
    return "\$$self->{VARNAME}";
}

sub getName {
    my ($self) = @_;
    return $self->{VARNAME};
}

package W3C::Rdf::RdalCompileTree::Attribute;
use W3C::Rdf::Atoms qw($ATTRIB_GroundFact);

sub new {
    my ($proto, $name, @exprParms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@exprParms);
    $self->{VARNAME} = $name;
    return $self;
}

sub neededVars {{}}

sub toXPath {
    my ($self) = @_;
    return '@'.$self->{VARNAME}->toXPath();
}

my $CLASS_Assign = 'W3C::Rdf::RdalCompileTree::Assign';
package W3C::Rdf::RdalCompileTree::Assign;
sub new {
    my ($proto, $L, $R, @exprParms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@exprParms);
    $self->{L} = $L;
    $self->{R} = $R;
    return $self;
}

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

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

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

sub toXsl {
    my ($self) = @_;
    my $name = $self->getLValue;
    my $value = $self->getRValue;
    return "<xsl:param name=\"$name\" select=\"$value\"/>";
}

package W3C::Rdf::RdalCompileTree::Ne;
sub new {
    my ($proto, $L, $R, @exprParms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@exprParms);
    $self->{L} = $L;
    $self->{R} = $R;
    return $self;
}

sub toXPath {
    my ($self) = @_;
    my $l = $self->{L}->toXPath();
    my $r = $self->{R}->toXPath();
    return "$l!=$r";
}


package W3C::Rdf::RdalCompileTree::FuncCall;

sub new {
    my ($proto, $name, $args, @exprParms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@exprParms);
    $self->{NAME} = $name;
    $self->{ARGS} = $args;
    return $self;
}
sub toXsl {
    my ($self, $annotHandler) = @_;
    my @ret;
    my $target = $self->{NAME};
    if (my $parmNames = $annotHandler->getParmNames($target)) {

	# Declared function so it's called as a template.
	push (@ret, "<xsl:call-template name=\"$target\">\n");

	my $parms = $self->{ARGS};
	if (@$parmNames != @$parms) {
	    my $parmNameStr = join(', ', @$parmNames);
	    my $parmsStr = join(', ', map {$_->toXsl} @$parms);
	    &throw(new W3C::Util::Exception(-message => "$target($parmNameStr) invoked with ($parmsStr)"));
	}
	for (my $i = 0; $i < @$parms; $i++) {
	    my $parm = $parms->[$i];
	    my $name = $parmNames->[$i];$name =~ s/^\$//; # !!!
	    my $value = $parm->toXPath();
	    push (@ret, "  <xsl:with-param name=\"$name\" select=\"$value\"/>\n");
	}
	push (@ret, "</xsl:call-template>\n");
    } else {
	# Not declared -- assume it's an XPath function.
	push (@ret, $self->toXPath());
    }
    return @ret;
}
sub neededVars {
    my ($self) = @_;
    my $ret = {};
    foreach my $arg (@{$self->{ARGS}}) {
	$ret = {%$ret, %{$arg->neededVars}};
    }
    return $ret;
}

sub toXPath {
    my ($self) = @_;
    my $argStr = join (', ', map {$_->toXPath()} @{$self->{ARGS}});
    return "$self->{NAME}($argStr)";
}

package W3C::Rdf::RdalCompileTree::FuncDecl;

sub getFuncDecls {
    my ($self) = @_;
    return [$self->{NAME}, $self->{ARGS}];
}

package W3C::Rdf::RdalCompileTree::XQueryExpr;
@W3C::Rdf::RdalCompileTree::XQueryExpr::ISA = qw(W3C::Rdf::RdalCompileTree::Stuff);
use W3C::Util::Exception;

sub new {
    my ($proto, $exprs, @STUFFARGS) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@STUFFARGS);
    $self->{EXPRS} = $exprs;
    return $self;
}

sub neededVars {
    my ($self) = @_;
    my $ret = {};
    foreach my $expr (@{$self->{EXPRS}}) {
	$ret = {%$ret, %{$expr->neededVars}};
    }
    return $ret;
}

sub getLValue {
    my ($self) = @_;
    return $self->{EXPRS}[0]->getLValue;
}

sub getRValue {
    my ($self) = @_;
    return $self->{EXPRS}[0]->getRValue;
}

sub expectAssignments {
    my ($self) = @_;
    my $ret = [];
    foreach my $expr (@{$self->{EXPRS}}) {
	if ($expr->isa($CLASS_Assign)) {
	    push (@$ret, $expr);
	} else {
	    &throw(new W3C::Util::Exception(-message => "$CLASS_Assign expected instead of $expr"));
	}
    }
    return $ret;
}

sub getFuncDecls {
    my ($self) = @_;
    return [map {$_->getFuncDecls} @{$self->{EXPRS}}];
}

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

1;

#  perl -MW3C::Rdf::RdalParser -e '(new W3C::Rdf::RdalParser)->parseARGV' 'asdf/asdf/qwre.@#$%#'
#  perl -MW3C::Rdf::RdalParser -e '&W3C::Util::Exception::watch(sub {(new W3C::Rdf::RdalParser())->parse})' 'asdf'

__END__

=head1 NAME

W3C::Rdf::RdalCompileTree - Compile tree for RDAL Parser.

=head1 SYNOPSIS

  use W3C::Rdf::RdalDataTypes;
  new W3C::Rdf::RdalCompileTree::FuncDecl(...);

=head1 DESCRIPTION

B<RdalCompileTree> provides a set of objects for storing RDAL schema
annotations. These annotations define semantic actions associated
with productions in a schema laguage

This module is undocumented. See RdalParser.yp for example invocations.

=head1 CLASS HIERARCHY

The isa2dot program will produce a cool graphic for viewing this hierarchy:

  isa2dot -o TB -f s/W3C::Rdf::Rdal:://ignore > sv.dot

This module is part of the W3C::Rdf CPAN module.

=head1 AUTHOR

Eric Prud'hommeaux <eric@w3.org>

=head1 SEE ALSO

L<W3C::Rdf::RdalParser>

=cut
