init

wcmtools/s2/BUGS

@@ -0,0 +1,46 @@
+- precedence/parsing fucked with things like:
+      println (isnull $test ? "It's null" : "not null");
+  have to write:
+      println ((isnull $test) ? "It's null" : "not null");
+
+- HTML backend will escape quotes in tripled quoted
+  TokenStringLiterals that weren't escaped originally
+
+- in a foreach statement when iterating over hash keys,
+  you can extract them as ints or strings, regardless of
+  what they actually are.  for the perl backend, this 
+  doesn't really matter, but a better solution might have
+  to be found sometime.
+
+- builtin functions can't be overridden by S2 functions 
+  in subclasses?  (look into this again)
+
+- Confusing message when trying to interpolate an object without
+  a toString() method:
+      "Right hand side of + operator is Color, not a string or
+       integer at line 28, column 16"
+
+TODO:
+
+- don't make vardecls in foreach stmts require the type.  infer it
+  instead from the listexpr type minus an arrayref
+
+- static variables
+
+- constructors with arguments
+
+- 'readonly' class members
+
+- private functions/members
+
+GOTCHAS:
+
+- this might be considered a bug:
+
+    function foo():string{ print "hi"; }
+
+  won't parse.  the { after 'string' is parsed as part of the return
+  type.  whitespace is required in there.
+
+  UPDATE: mart says this isn't a bug.  :)
+

wcmtools/s2/BUILD.txt

@@ -0,0 +1,4 @@
+You'll need a java compiler and 'jmk' (Make in Java), available here:
+
+http://sourceforge.net/projects/jmk
+

wcmtools/s2/S2.pm

@@ -0,0 +1,497 @@
+#!/usr/bin/perl
+#
+
+package S2;
+
+use strict;
+use vars qw($pout $pout_s %Domains $CurrentDomain);  # public interface:  sub refs to print and print safely
+
+$pout = sub { print @_; };
+$pout_s = sub { print @_; };
+
+## array indexes into $_ctx (which shows up in compiled S2 code)
+use constant VTABLE => 0;
+use constant STATICS => 1;
+use constant PROPS => 2;
+use constant SCRATCH => 3;  # embedder-defined use
+use constant LAYERLIST => 4;  # arrayref of layerids which made the context
+
+%Domains = ();
+$CurrentDomain = 'unset';
+
+sub set_domain
+{
+    my $name = shift;
+    $Domains{ $name } ||= {
+        layer               => undef, # time()
+        layercomp           => undef, # compiled time (when loaded from database)
+        layerinfo           => undef, # key -> value
+        layerset            => undef, # key -> value
+        layerprop           => undef, # prop -> { type/key => "string"/val }
+        layerprops          => undef, # arrayref of hashrefs
+        layerprophide       => undef, # prop -> 1
+        layerfunc           => undef, # funcnum -> sub{}
+        layerclass          => undef, # classname -> hashref
+        layerglobal         => undef, # signature -> hashref
+        layerpropgroups     => undef, # [ group_ident* ]
+        layerpropgroupname  => undef, # group_ident -> text_name
+        layerpropgroupprops => undef, # group_ident -> [ prop_ident* ]
+        funcnum             => undef, # funcID -> funcnum
+        funcnummax          => 0, # maxnum in use already by funcnum, above.
+    };
+
+    $CurrentDomain = $name;
+}
+
+sub get_layer_all
+{
+    my $lid = shift;
+    my $domain = $Domains{$CurrentDomain};
+
+    return undef unless $domain->{layer}{$lid};
+    return {
+        layer          => $domain->{layer}{$lid},
+        info           => $domain->{layerinfo}{$lid},
+        set            => $domain->{layerset}{$lid},
+        prop           => $domain->{layerprop}{$lid},
+        class          => $domain->{layerclass}{$lid},
+        global         => $domain->{layerglobal}{$lid},
+        propgroupname  => $domain->{layerpropgroupname}{$lid},
+        propgroups     => $domain->{layerpropgroups}{$lid},
+        propgroupprops => $domain->{layerpropgroupprops}{$lid},
+    };
+}
+
+# compatibility functions
+sub pout   { $pout->(@_);   }
+sub pout_s { $pout_s->(@_); }
+
+sub get_property_value
+{
+    my ($ctx, $k) = @_;
+    return $ctx->[PROPS]->{$k};
+}
+
+sub get_lang_code
+{
+    return get_property_value($_[0], 'lang_current');
+}
+
+sub make_context
+{
+    my (@lids) = @_;
+    if (ref $lids[0] eq "ARRAY") { @lids = @{$lids[0]}; } # 1st arg can be array ref
+    my $ctx = [];
+    undef $@;
+
+    my $domain = $Domains{$CurrentDomain};
+
+    ## load all the layers & make the vtable
+    foreach my $lid (0, @lids)
+    {
+        ## build the vtable
+        foreach my $fn (keys %{$domain->{layerfunc}{$lid}}) {
+            $ctx->[VTABLE]->{$fn} = $domain->{layerfunc}{$lid}->{$fn};
+        }
+
+        ## ignore further stuff for layer IDs of 0
+        next unless $lid;
+
+        ## FIXME: load the layer if not loaded, using registered
+        ## loader sub.
+
+        ## setup the property values
+        foreach my $p (keys %{$domain->{layerset}{$lid}}) {
+            my $v = $domain->{layerset}{$lid}->{$p};
+
+            # this was the old format, but only used for Color constructors,
+            # so we can change it to the new format:
+            $v = S2::Builtin::Color__Color($v->[0])
+                if (ref $v eq "ARRAY" && scalar(@$v) == 2 &&
+                    ref $v->[1] eq "CODE");
+
+            $ctx->[PROPS]->{$p} = $v;
+        }
+    }
+
+    $ctx->[LAYERLIST] = [ @lids ];
+    return $ctx;
+}
+
+# returns an arrayref of layerids loaded in this context
+sub get_layers {
+    my $ctx = shift;
+    return @{ $ctx->[LAYERLIST] };
+}
+
+sub get_style_modtime
+{
+    my $ctx = shift;
+
+    my $high = 0;
+    foreach (@{$ctx->[LAYERLIST]}) {
+        $high = $Domains{$CurrentDomain}{layercomp}{$_}
+            if $Domains{$CurrentDomain}{layercomp}{$_} > $high;
+    }
+    return $high;
+}
+
+sub register_class
+{
+    my ($lid, $classname, $info) = @_;
+    $Domains{$CurrentDomain}{layerclass}{$lid}{$classname} = $info;
+}
+
+sub register_layer
+{
+    my ($lid) = @_;
+    unregister_layer($lid) if $Domains{$CurrentDomain}{layer}{$lid};
+    $Domains{$CurrentDomain}{layer}{$lid} = time();
+}
+
+sub unregister_layer
+{
+    my ($lid) = @_;
+    my $domain = $Domains{$CurrentDomain};
+
+    delete $domain->{layer}{$lid};
+    delete $domain->{layercomp}{$lid};
+    delete $domain->{layerinfo}{$lid};
+    delete $domain->{layerset}{$lid};
+    delete $domain->{layerprop}{$lid};
+    delete $domain->{layerprops}{$lid};
+    delete $domain->{layerprophide}{$lid};
+    delete $domain->{layerfunc}{$lid};
+    delete $domain->{layerclass}{$lid};
+    delete $domain->{layerglobal}{$lid};
+    delete $domain->{layerpropgroups}{$lid};
+    delete $domain->{layerpropgroupprops}{$lid};
+    delete $domain->{layerpropgroupname}{$lid};
+}
+
+sub load_layer
+{
+    my ($lid, $comp, $comptime) = @_;
+
+    eval $comp;
+    if ($@) {
+        my $err = $@;
+        unregister_layer($lid);
+        die "Layer \#$lid: $err";
+    }
+    $Domains{$CurrentDomain}{layercomp}{$lid} = $comptime;
+    return 1;
+}
+
+sub load_layers_from_db
+{
+    my ($db, @layers) = @_;
+    my $maxtime = 0;
+    my @to_load;
+    my $domain = $Domains{$CurrentDomain};
+
+    foreach my $lid (@layers) {
+        $lid += 0;
+        if (exists $domain->{layer}{$lid}) {
+            $maxtime = $domain->{layercomp}{$lid} if $domain->{layercomp}{$lid} > $maxtime;
+            push @to_load, "(s2lid=$lid AND comptime>$domain->{layercomp}{$lid})";
+        } else {
+            push @to_load, "s2lid=$lid";
+        }
+    }
+    return $maxtime unless @to_load;
+    my $where = join(' OR ', @to_load);
+    my $sth = $db->prepare("SELECT s2lid, compdata, comptime FROM s2compiled WHERE $where");
+    $sth->execute;
+    while (my ($id, $comp, $comptime) = $sth->fetchrow_array) {
+        eval $comp;
+        if ($@) {
+            my $err = $@;
+            unregister_layer($id);
+            die "Layer \#$id: $err";
+        }
+        $domain->{layercomp}{$id} = $comptime;
+        $maxtime = $comptime if $comptime > $maxtime;
+    }
+    return $maxtime;
+}
+
+# returns the modtime of a loaded layer; if a second parameter is specified,
+# that is the maximum age in seconds to consider the layer loaded for.  if a
+# layer is older than that time, it is automatically unloaded and undef is
+# returned to the caller.
+sub layer_loaded
+{
+    my ($id, $maxage) = @_;
+    my $modtime = $Domains{$CurrentDomain}{layercomp}{$id};
+    return $modtime unless $maxage && $modtime;
+
+    # layer must be defined and loaded and we must have a max age at this point
+    my $age = time() - $Domains{$CurrentDomain}{layer}{$id};
+    return $modtime if $age <= $maxage;
+
+    # layer is invalid; unload it and say it's not loaded
+    unregister_layer($id);
+    return undef;
+}
+
+sub set_layer_info
+{
+    my ($lid, $key, $val) = @_;
+    $Domains{$CurrentDomain}{layerinfo}{$lid}->{$key} = $val;
+}
+
+sub get_layer_info
+{
+    my ($lid, $key) = @_;
+    return undef unless $Domains{$CurrentDomain}{layerinfo}{$lid};
+    return $key
+        ? $Domains{$CurrentDomain}{layerinfo}{$lid}->{$key}
+        : %{$Domains{$CurrentDomain}{layerinfo}{$lid}};
+}
+
+sub register_property
+{
+    my ($lid, $propname, $props) = @_;
+    $props->{'name'} = $propname;
+    $Domains{$CurrentDomain}{layerprop}{$lid}->{$propname} = $props;
+    push @{$Domains{$CurrentDomain}{layerprops}{$lid}}, $props;
+}
+
+sub register_property_use
+{
+    my ($lid, $propname) = @_;
+    push @{$Domains{$CurrentDomain}{layerprops}{$lid}}, $propname;
+}
+
+sub register_property_hide
+{
+    my ($lid, $propname) = @_;
+    $Domains{$CurrentDomain}{layerprophide}{$lid}->{$propname} = 1;
+}
+
+sub register_propgroup_name
+{
+    my ($lid, $gname, $name) = @_;
+    $Domains{$CurrentDomain}{layerpropgroupname}{$lid}->{$gname} = $name;
+}
+
+sub register_propgroup_props
+{
+    my ($lid, $gname, $list) = @_;
+    $Domains{$CurrentDomain}{layerpropgroupprops}{$lid}->{$gname} = $list;
+    push @{$Domains{$CurrentDomain}{layerpropgroups}{$lid}}, $gname;
+}
+
+sub is_property_hidden
+{
+    my ($lids, $propname) = @_;
+    foreach (@$lids) {
+        return 1 if $Domains{$CurrentDomain}{layerprophide}{$_}->{$propname};
+    }
+    return 0;
+}
+
+sub get_property
+{
+    my ($lid, $propname) = @_;
+    return $Domains{$CurrentDomain}{layerprop}{$lid}->{$propname};
+}
+
+sub get_properties
+{
+    my ($lid) = @_;
+    return () unless $Domains{$CurrentDomain}{layerprops}{$lid};
+    return @{$Domains{$CurrentDomain}{layerprops}{$lid}};
+}
+
+sub get_property_groups
+{
+    my $lid = shift;
+    return @{$Domains{$CurrentDomain}{layerpropgroups}{$lid} || []};
+}
+
+sub get_property_group_props
+{
+    my ($lid, $group) = @_;
+    return () unless $Domains{$CurrentDomain}{layerpropgroupprops}{$lid};
+    return @{$Domains{$CurrentDomain}{layerpropgroupprops}{$lid}->{$group} || []};
+}
+
+sub get_property_group_name
+{
+    my ($lid, $group) = @_;
+    return unless $Domains{$CurrentDomain}{layerpropgroupname}{$lid};
+    return $Domains{$CurrentDomain}{layerpropgroupname}{$lid}->{$group};
+}
+
+sub register_set
+{
+    my ($lid, $propname, $val) = @_;
+    $Domains{$CurrentDomain}{layerset}{$lid}->{$propname} = $val;
+}
+
+sub get_set
+{
+    my ($lid, $propname) = @_;
+    my $v = $Domains{$CurrentDomain}{layerset}{$lid}->{$propname};
+    return undef unless defined $v;
+    return $v;
+}
+
+# the whole point here is just to get the docstring.
+# attrs is a comma-delimited list of attributes
+sub register_global_function
+{
+    my ($lid, $func, $rtype, $docstring, $attrs) = @_;
+
+    # need to make the signature:  foo(int a, int b) -> foo(int,int)
+    return unless
+        $func =~ /^(.+?\()(.*)\)$/;
+    my ($signature, @args) = ($1, split(/\s*\,\s*/, $2));
+    foreach (@args) { s/\s+\w+$//; } # strip names
+    $signature .= join(",", @args) . ")";
+    $Domains{$CurrentDomain}{layerglobal}{$lid}->{$signature} = {
+        'returntype' => $rtype,
+        'docstring' => $docstring,
+        'args' => $func,
+        'attrs' => $attrs,
+    };
+}
+
+sub register_function
+{
+    my ($lid, $names, $code) = @_;
+
+    # run the code to get the sub back with its closure data filled.
+    my $closure = $code->();
+
+    # now, remember that closure.
+    foreach my $fi (@$names) {
+        my $num = get_func_num($fi);
+        $Domains{$CurrentDomain}{layerfunc}{$lid}->{$num} = $closure;
+    }
+}
+
+sub set_output
+{
+    $pout = shift;
+}
+
+sub set_output_safe
+{
+    $pout_s = shift;
+}
+
+sub function_exists
+{
+    my ($ctx, $func) = @_;
+    my $fnum = get_func_num($func);
+    my $code = $ctx->[VTABLE]->{$fnum};
+    return 1 if ref $code eq "CODE";
+    return 0;
+}
+
+sub run_code
+{
+    my ($ctx, $entry, @args) = @_;
+    run_function($ctx, $entry, @args);
+    return 1;
+}
+
+sub run_function
+{
+    my ($ctx, $entry, @args) = @_;
+    my $fnum = get_func_num($entry);
+    my $code = $ctx->[VTABLE]->{$fnum};
+    unless (ref $code eq "CODE") {
+        die "S2::run_code: Undefined function $entry ($fnum $code)\n";
+    }
+    my $val;
+    eval {
+        local $SIG{__DIE__} = undef;
+        local $SIG{ALRM} = sub { die "Style code didn't finish running in a timely fashion.  ".
+                                     "Possible causes: <ul><li>Infinite loop in style or layer</li>\n".
+                                     "<li>Database busy</li></ul>\n" };
+        alarm 4;
+        $val = $code->($ctx, @args);
+        alarm 0;
+    };
+    if ($@) {
+        die "Died in S2::run_code running $entry: $@\n";
+    }
+    return $val;
+}
+
+sub get_func_num
+{
+    my $name = shift;
+    my $domain = $Domains{$CurrentDomain};
+
+    return $domain->{funcnum}{$name}
+        if exists $domain->{funcnum}{$name};
+    return $domain->{funcnum}{$name} = ++$domain->{funcnummax};
+}
+
+sub get_object_func_num
+{
+    my ($type, $inst, $func, $s2lid, $s2line, $is_super) = @_;
+    if (ref $inst ne "HASH" || $inst->{'_isnull'}) {
+        die "Method called on null $type object at layer \#$s2lid, line $s2line.\n";
+    }
+    $type = $inst->{'_type'} unless $is_super;
+    my $fn = get_func_num("${type}::$func");
+    #Apache->request->log_error("get_object_func_num(${type}::$func) = $fn");
+    return $fn;
+}
+
+# Called by NodeForeachStmt
+sub get_characters
+{
+    my $string = shift;
+    use utf8;
+    return split(//,$string);
+}
+
+sub check_defined {
+    my $obj = shift;
+    return ref $obj eq "HASH" && ! $obj->{'_isnull'};
+}
+
+sub check_elements {
+    my $obj = shift;
+    if (ref $obj eq "ARRAY") {
+        return @$obj ? 1 : 0;
+    } elsif (ref $obj eq "HASH") {
+        return %$obj ? 1 : 0;
+    }
+    return 0;
+}
+
+sub interpolate_object {
+    my ($ctx, $cname, $obj, $method) = @_;
+    return "" unless ref $obj eq "HASH" && ! $obj->{'_isnull'};
+    my $res = eval {
+        # wrap in an eval in case get_object_func_num returns something invalid...
+        return $ctx->[VTABLE]->{get_object_func_num($cname,$obj,$method)}->($ctx, $obj);
+    };
+    return $res unless $@;
+
+    # if we get here, we know something went wrong
+    my $type = $obj->{_type} || $cname || "undef";
+    return "$type::$method call failed.";
+}
+
+sub notags {
+    my $a = shift;
+    $a =~ s/</&lt;/g;
+    $a =~ s/>/&gt;/g;
+    return $a;
+}
+
+package S2::Builtin;
+
+# generic S2 has no built-in functionality
+
+1;
+

wcmtools/s2/S2/BackendHTML.pm

@@ -0,0 +1,75 @@
+#!/usr/bin/perl
+#
+
+package S2::BackendHTML;
+
+use strict;
+
+use vars qw($CommentColor $IdentColor $KeywordColor
+            $StringColor $PunctColor $BracketColor $TypeColor
+            $VarColor $IntegerColor);
+
+$CommentColor = "#008000";
+$IdentColor = "#000000";
+$KeywordColor = "#0000FF";
+$StringColor = "#008080";
+$PunctColor = "#000000";
+$BracketColor = "#800080";
+$TypeColor = "#000080";
+$VarColor = "#000000";
+$IntegerColor = "#000000";
+
+sub new {
+    my ($class, $l) = @_;
+    my $this = {
+        'layer' => $l,
+    };
+    bless $this, $class;
+}
+
+sub output {
+    my ($this, $o) = @_;
+
+    $o->write("<html><head><title>Layer Source</title>\n");
+    $o->write("<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\">\n");
+    $o->write("<style type=\"text/css\">\n");
+    $o->write("body { background: #ffffff none; color: #000000; }\n");
+    $o->write(".c { background: #ffffff none; color: " . $CommentColor . "; }\n");
+    $o->write(".i { background: #ffffff none; color: " . $IdentColor . "; }\n");
+    $o->write(".k { background: #ffffff none; color: " . $KeywordColor . "; }\n");
+    $o->write(".s { background: #ffffff none; color: " . $StringColor . "; }\n");
+    $o->write(".p { background: #ffffff none; color: " . $PunctColor . "; }\n");
+    $o->write(".b { background: #ffffff none; color: " . $BracketColor . "; }\n");
+    $o->write(".t { background: #ffffff none; color: " . $TypeColor . "; }\n");
+    $o->write(".v { background: #ffffff none; color: " . $VarColor . "; }\n");
+    $o->write(".n { background: #ffffff none; color: " . $IntegerColor . "; }\n");
+    $o->write("</style></head>\n<body>\n<pre>");
+    my $nodes = $this->{'layer'}->getNodes();
+    foreach my $n (@$nodes) {
+        my $dbg = "Doing node: " . ref($n);
+        if (ref $n eq "S2::NodeFunction") {
+            $dbg .= " (" . $n->getName() . ")";
+            if ($n->getName() eq "print_body") {
+                #use Data::Dumper;
+                #$dbg .= Dumper($n->{'tokenlist'});
+            }
+        }
+        #Apache->request->log_error($dbg);
+        #print $dbg;
+
+        $n->asHTML($o);
+    }
+    $o->write("</pre></body></html>"); $o->newline();
+}
+
+sub quoteHTML {
+    shift if ref $_[0];
+    my $s = shift;
+    $s =~ s/&/&amp;/g;
+    $s =~ s/</&lt;/g;
+    $s =~ s/>/&gt;/g;
+    $s;
+}
+
+
+1;

wcmtools/s2/S2/BackendPerl.pm

@@ -0,0 +1,62 @@
+#!/usr/bin/perl
+#
+
+package S2::BackendPerl;
+
+use strict;
+use S2::Indenter;
+
+sub new {
+    my ($class, $l, $layerID, $untrusted) = @_;
+    my $this = {
+        'layer' => $l,
+        'layerID' => $layerID,
+        'untrusted' => $untrusted,
+        'package' => '',
+    };
+    bless $this, $class;
+}
+
+sub getBuiltinPackage { shift->{'package'}; }
+sub setBuiltinPackage { my $t = shift; $t->{'package'} = shift; }
+
+sub getLayerID { shift->{'layerID'}; }
+sub getLayerIDString { shift->{'layerID'}; }
+
+sub untrusted { shift->{'untrusted'}; }
+
+sub output {
+    my ($this, $o) = @_;
+    my $io = new S2::Indenter $o, 4;
+
+    $io->writeln("#!/usr/bin/perl");
+    $io->writeln("# auto-generated Perl code from input S2 code"); 
+    $io->writeln("package S2;");
+    $io->writeln("use strict;");
+    $io->writeln("use constant VTABLE => 0;");
+    $io->writeln("use constant STATIC => 1;");
+    $io->writeln("use constant PROPS => 2;");
+    $io->writeln("register_layer($this->{'layerID'});");
+    my $nodes = $this->{'layer'}->getNodes();
+    foreach my $n (@$nodes) {
+        $n->asPerl($this, $io);
+    }
+    $io->writeln("1;");
+    $io->writeln("# end.");
+}
+
+sub quoteString {
+    shift if ref $_[0];
+    my $s = shift;
+    return "\"" . quoteStringInner($s) . "\"";
+}
+
+sub quoteStringInner {
+    my $s = shift;
+    $s =~ s/([\\\$\"\@])/\\$1/g;
+    $s =~ s/\n/\\n/g;
+    return $s;
+}
+
+
+1;

wcmtools/s2/S2/Checker.pm

@@ -0,0 +1,367 @@
+#!/usr/bin/perl
+#
+
+package S2::Checker;
+
+use strict;
+use vars qw($VERSION);
+
+# version should be incremented whenever any internals change.
+# the external mechanisms which serialize checker objects should
+# then include in their hash/db/etc the version, so any change
+# in version invalidates checker caches and forces a full re-compile
+$VERSION = '1.0';
+
+#    // combined (all layers)
+#    private Hashtable classes;      // class name    -> NodeClass
+#    private Hashtable props;        // property name -> Type
+#    private Hashtable funcs;        // FuncID -> return type
+#    private Hashtable funcAttr;     // FuncID -> attr string -> Boolean (has attr)
+#    private LinkedList localblocks; // NodeStmtBlock scopes .. last is deepest (closest)
+#    private Type returnType;
+#    private String funcClass;       // current function class
+#    private Hashtable derclass;     // classname  -> LinkedList<classname>
+#    private boolean inFunction;     // checking in a function now?
+
+#    // per-layer
+#    private Hashtable funcDist;     // FuncID -> [ distance, NodeFunction ]
+#    private Hashtable funcIDs;      // NodeFunction -> Set<FuncID>
+#    private boolean hitFunction;    // true once a function has been declared/defined
+
+#    // per function
+#    private int funcNum = 0;
+#    private Hashtable funcNums;     // FuncID -> Integer(funcnum)
+#    private LinkedList funcNames;   // Strings
+
+sub new
+{
+    my $class = shift;
+    my $this = {
+        'classes' => {},
+        'props' => {},
+        'funcs' => {},
+        'funcAttr' => {},
+        'derclass' => {},   # classname -> arrayref<classname>
+        'localblocks' => [],
+    };
+    bless $this, $class;
+}
+
+sub cleanForFreeze {
+    my $this = shift;
+    delete $this->{'funcDist'};
+    delete $this->{'funcIDs'};
+    delete $this->{'hitFunction'};
+    delete $this->{'funcNum'};
+    delete $this->{'funcNums'};
+    delete $this->{'funcNames'};
+    $this->{'localBlocks'} = [];
+    delete $this->{'returnType'};
+    delete $this->{'funcClass'};
+    delete $this->{'inFunction'};
+    foreach my $nc (values %{$this->{'classes'}}) {
+        $nc->cleanForFreeze();
+    }
+}
+
+sub addClass {
+    my ($this, $name, $nc) = @_;
+    $this->{'classes'}->{$name} = $nc;
+
+    # make sure that the list of classes that derive from 
+    # this one exists.
+    $this->{'derclass'}->{$name} ||= [];
+
+    # and if this class derives from another, add ourselves
+    # to that list
+    my $parent = $nc->getParentName();
+    if ($parent) {
+        my $l = $this->{'derclass'}->{$parent};
+        die "Internal error: can't append to empty list" unless $l;
+        push @$l, $name;
+    }
+}
+
+sub getClass {
+    my ($this, $name) = @_;
+    return undef unless $name;
+    return $this->{'classes'}->{$name};
+}
+
+sub getParentClassName {
+    my ($this, $name) = @_;
+    my $nc = $this->getClass($name);
+    return undef unless $nc;
+    return $nc->getParentName();
+}
+
+sub isValidType {
+    my ($this, $t) = @_;
+    return 0 unless $t;
+    return 1 if $t->isPrimitive();
+    return defined $this->getClass($t->baseType());
+}
+
+# property functions
+sub addProperty {
+    my ($this, $name, $t, $builtin) = @_;
+    $this->{'props'}->{$name} = $t;
+    $this->{'prop_builtin'}->{$name} = 1 if $builtin;
+}
+
+sub propertyType {
+    my ($this, $name) = @_;
+    return $this->{'props'}->{$name};
+}
+
+sub propertyBuiltin {
+    my ($this, $name) = @_;
+    return $this->{'prop_builtin'}->{$name};
+}
+
+# return type functions (undef means no return type)
+sub setReturnType {
+    my ($this, $t) = @_;
+    $this->{'returnType'} = $t;
+}
+
+sub getReturnType {
+    shift->{'returnType'};
+}
+
+# funtion functions
+sub addFunction {
+    my ($this, $funcid, $t, $attrs) = @_;
+    my $existing = $this->functionType($funcid);
+    if ($existing && ! $existing->equals($t)) {
+        S2::error(undef, "Can't override function '$funcid' with new return type.");
+    }
+    $this->{'funcs'}->{$funcid} = $t;
+
+    # enable all attributes specified
+    if (defined $attrs) {
+        die "Internal error.  \$attrs is defined, but not a hashref."
+            if ref $attrs ne "HASH";
+        foreach my $k (keys %$attrs) {
+            $this->{'funcAttr'}->{$funcid}->{$k} = 1;
+        }
+    }
+}
+
+sub functionType {
+    my ($this, $funcid) = @_;
+    $this->{'funcs'}->{$funcid};
+}
+
+sub checkFuncAttr {
+    my ($this, $funcid, $attr) = @_;
+    $this->{'funcAttr'}->{$funcid}->{$attr};
+}
+
+sub isFuncBuiltin {
+    my ($this, $funcid) = @_;
+    return $this->checkFuncAttr($funcid, "builtin");
+}
+
+# returns true if there's a string -> t class constructor
+sub isStringCtor {
+    my ($this, $t) = @_;
+    return 0 unless $t && $t->isSimple();
+    my $cname = $t->baseType();
+    my $ctorid = "${cname}::${cname}(string)";
+    my $rt = $this->functionType($ctorid);
+    return $rt && $rt->isSimple() && $rt->baseType() eq $cname &&
+        $this->isFuncBuiltin($ctorid);
+}
+
+# setting/getting the current function class we're in
+sub setCurrentFunctionClass { my $this = shift; $this->{'funcClass'} = shift; }
+sub getCurrentFunctionClass { shift->{'funcClass'}; }
+
+# setting/getting whether in a function now
+sub setInFunction { my $this = shift; $this->{'inFunction'} = shift; }
+sub getInFunction { shift->{'inFunction'}; }
+
+# variable lookup
+sub pushLocalBlock {
+    my ($this, $nb) = @_;  # nb  = NodeStmtBlock
+    push @{$this->{'localblocks'}}, $nb;
+}
+sub popLocalBlock {
+    my ($this) = @_;
+    pop @{$this->{'localblocks'}};
+}
+
+sub getLocalScope {
+    my $this = shift;
+    return undef unless @{$this->{'localblocks'}};
+    return $this->{'localblocks'}->[-1];
+}
+
+sub localType {
+    my ($this, $local) = @_;
+    return undef unless @{$this->{'localblocks'}};
+    foreach my $nb (reverse @{$this->{'localblocks'}}) {
+        my $t = $nb->getLocalVar($local);
+        return $t if $t;
+    }
+    return undef;
+}
+
+sub memberType {
+    my ($this, $clas, $member) = @_;
+    my $nc = $this->getClass($clas);
+    return undef unless $nc;
+    return $nc->getMemberType($member);
+}
+
+sub setHitFunction { my $this = shift; $this->{'hitFunction'} = shift; }
+sub getHitFunction { shift->{'hitFunction'}; }
+
+sub hasDerClasses {
+    my ($this, $clas) = @_;
+    return scalar @{$this->{'derclass'}->{$clas}};
+}
+
+sub getDerClasses {
+    my ($this, $clas) = @_;
+    return $this->{'derclass'}->{$clas};
+}
+
+sub setFuncDistance {
+    my ($this, $funcID, $df) = @_; # df = hashref with 'dist' and 'nf' key
+
+    my $existing = $this->{'funcDist'}->{$funcID};
+
+    if (! defined $existing || $df->{'dist'} < $existing->{'dist'}) {
+        $this->{'funcDist'}->{$funcID} = $df;
+
+        # keep the funcIDs hashes -> FuncID set up-to-date
+        # removing the existing funcID from the old set first
+        if ($existing) {
+            delete $this->{'funcIDs'}->{$existing->{'nf'}}->{$funcID};
+        }
+        
+        # add to new set
+        $this->{'funcIDs'}->{$df->{'nf'}}->{$funcID} = 1;
+    }
+}
+
+sub getFuncIDs {
+    my ($this, $nf) = @_;
+    return [ sort keys %{$this->{'funcIDs'}->{$nf}} ];
+}
+
+# per function
+sub resetFunctionNums {
+    my $this = shift;
+    $this->{'funcNum'} = 0;
+    $this->{'funcNums'} = {};
+    $this->{'funcNames'} = [];
+}
+
+sub functionNum {
+    my ($this, $funcID) = @_;
+    my $num = $this->{'funcNums'}->{$funcID};
+    unless (defined $num) {
+        $num = ++$this->{'funcNum'};
+        $this->{'funcNums'}->{$funcID} = $num;
+        push @{$this->{'funcNames'}}, $funcID;
+    }
+    return $num;
+}
+
+sub getFuncNums { shift->{'funcNums'}; }
+sub getFuncNames { shift->{'funcNames'}; }
+
+# check if type 't' is a subclass of 'w'
+sub typeIsa {
+    my ($this, $t, $w) = @_;
+    return 0 unless S2::Type->sameMods($t, $w);
+
+    my $is = $t->baseType();
+    my $parent = $w->baseType();
+    while ($is) {
+        return 1 if $is eq $parent;
+        my $nc = $this->getClass($is);
+        $is = $nc ? $nc->getParentName() : undef;
+    }
+    return 0;
+}
+
+# check to see if a class or parents has a "toString()" or "as_string()" method.
+# returns the method name found.
+sub classHasToString {
+    my ($this, $clas) = @_;
+    foreach my $methname (qw(toString as_string)) {
+        my $et = $this->functionType("${clas}::$methname()");
+        return $methname if $et && $et->equals($S2::Type::STRING);
+    }
+    return undef;
+}
+
+# check to see if a class or parents has an "as_string" string member
+sub classHasAsString {
+    my ($this, $clas) = @_;
+    my $et = $this->memberType($clas, "as_string");
+    return $et && $et->equals($S2::Type::STRING);
+}
+
+# ---------------
+
+sub checkLayer {
+    my ($this, $lay) = @_; # lay = Layer
+
+    # initialize layer-specific data structures
+    $this->{'funcDist'} = {};  # funcID -> "derItem" hashref ('dist' scalar and 'nf' NodeFormal)
+    $this->{'funcIDs'} = {};
+    $this->{'hitFunction'} = 0;
+
+    # check to see that they declared the layer type, and that
+    # it isn't bogus.
+    {
+        # what the S2 source says the layer is
+        my $dtype = $lay->getDeclaredType();
+        S2::error(undef, "Layer type not declared") unless $dtype;
+        
+        # what type s2compile thinks it is
+        my $type = $lay->getType();
+
+        S2::error(undef, "Layer is declared $dtype but expecting a $type layer")
+            unless $type eq $dtype;
+
+        # now that we've validated their type is okay
+        $lay->setType($dtype);
+    }
+
+    my $nodes = $lay->getNodes();
+    foreach my $n (@$nodes) {
+        $n->check($lay, $this);
+    }
+
+    if ($lay->getType() eq "core") {
+        my $mv = $lay->getLayerInfo("majorversion");
+        unless (defined $mv) {
+            S2::error(undef, "Core layers must declare 'majorversion' layerinfo.");
+        }
+    }
+}
+
+sub functionID {
+    my ($clas, $func, $o) = @_;
+    my $sb;
+    $sb .= "${clas}::" if $clas;
+    $sb .= "$func(";
+    if (! defined $o) {
+        # do nothing
+    } elsif (ref $o && $o->isa('S2::NodeFormals')) {
+        $sb .= $o->typeList();
+    } else {
+        $sb .= $o;
+    }
+    $sb .= ")";
+    return $sb;
+}
+
+
+1;

wcmtools/s2/S2/Compiler.pm

@@ -0,0 +1,48 @@
+#!/usr/bin/perl
+#
+
+package S2::Compiler;
+
+use strict;
+use S2::Tokenizer;
+use S2::Checker;
+use S2::Layer;
+use S2::Util;
+use S2::BackendPerl;
+use S2::BackendHTML;
+use S2::OutputScalar;
+
+sub new # (fh) class method
+{
+    my ($class, $opts) = @_;
+    $opts->{'checker'} ||= new S2::Checker;
+    bless $opts, $class;
+}
+
+sub compile_source {
+    my ($this, $opts) = @_;
+    $S2::CUR_COMPILER = $this;
+    my $ref = ref $opts->{'source'} ? $opts->{'source'} : \$opts->{'source'};
+    my $toker = S2::Tokenizer->new($ref);
+    my $s2l = S2::Layer->new($toker, $opts->{'type'});
+    my $o = new S2::OutputScalar($opts->{'output'});
+    my $be;
+    $opts->{'format'} ||= "perl";
+    if ($opts->{'format'} eq "html") {
+        $be = new S2::BackendHTML($s2l);
+    } elsif ($opts->{'format'} eq "perl") {
+        $this->{'checker'}->checkLayer($s2l);
+        $be = new S2::BackendPerl($s2l, $opts->{'layerid'}, $opts->{'untrusted'});
+        if ($opts->{'builtinPackage'}) {
+            $be->setBuiltinPackage($opts->{'builtinPackage'});
+        }
+    } else {
+	S2::error("Unknown output type in S2::Compiler");
+    }
+    $be->output($o);
+    undef $S2::CUR_COMPILER;
+    return 1;
+}
+
+
+1;

wcmtools/s2/S2/FilePos.pm

@@ -0,0 +1,37 @@
+#!/usr/bin/perl
+#
+
+package S2::FilePos;
+
+use strict;
+
+sub new
+{
+    my ($class, $l, $c) = @_;
+    my $this = [ $l, $c ];
+    bless $this, $class;
+    return $this;
+}
+
+sub line { shift->[0]; }
+sub col { shift->[1]; }
+
+sub clone
+{
+    my $this = shift;
+    return new S2::FilePos(@$this);
+}
+
+sub locationString
+{
+    my $this = shift;
+    return "line $this->[0], column $this->[1]";
+}
+
+sub toString
+{
+    my $this = shift;
+    return $this->locationString();
+}
+
+1;

wcmtools/s2/S2/Indenter.pm

@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+#
+
+package S2::Indenter;
+
+use strict;
+
+sub new {
+    my ($class, $o, $tabsize) = @_;
+    my $this = {
+        'o' => $o,
+        'tabsize' => $tabsize,
+        'depth' => 0,
+    };
+    bless $this, $class;
+}
+
+sub write {
+    my ($this, $s) = @_;
+    $this->{'o'}->write($s);
+}
+
+sub writeln {
+    my ($this, $s) = @_;
+    $this->{'o'}->writeln($s);
+}
+
+sub tabwrite {
+    my ($this, $s) = @_;
+    $this->{'o'}->write(" "x($this->{'tabsize'}*$this->{'depth'}) . $s);
+}
+
+sub tabwriteln {
+    my ($this, $s) = @_;
+    $this->{'o'}->writeln(" "x($this->{'tabsize'}*$this->{'depth'}) . $s);
+}
+
+sub newline { shift->{'o'}->newline(); }
+
+sub tabIn { shift->{'depth'}++; }
+sub tabOut { shift->{'depth'}--; }
+
+1;

wcmtools/s2/S2/Layer.pm

@@ -0,0 +1,115 @@
+#!/usr/bin/perl
+#
+
+package S2::Layer;
+
+use S2::NodeUnnecessary;
+use S2::NodeLayerInfo;
+use S2::NodeProperty;
+use S2::NodePropGroup;
+use S2::NodeSet;
+use S2::NodeFunction;
+use S2::NodeClass;
+
+sub new
+{
+    my ($class, $toker, $type) = @_;
+    my $this = {
+        'type' => $type,
+        'declaredType' => undef,
+        'nodes' => [],
+        'layerinfo' => {},
+    };
+
+    my $nodes = $this->{'nodes'};
+
+    while (my $t = $toker->peek()) {
+
+        if (S2::NodeUnnecessary->canStart($toker)) {
+            push @$nodes, S2::NodeUnnecessary->parse($toker);
+            next;
+        }
+
+        if (S2::NodeLayerInfo->canStart($toker)) {
+            my $nli = S2::NodeLayerInfo->parse($toker);
+            push @$nodes, $nli;
+            if ($nli->getKey() eq "type") {
+                $this->{'declaredType'} = $nli->getValue();
+            }
+            next;
+        }
+
+        if (S2::NodeProperty->canStart($toker)) {
+            push @$nodes, S2::NodeProperty->parse($toker);
+            next;
+        }
+
+        if (S2::NodePropGroup->canStart($toker)) {
+            push @$nodes, S2::NodePropGroup->parse($toker);
+            next;
+        }
+
+        if (S2::NodeSet->canStart($toker)) {
+            push @$nodes, S2::NodeSet->parse($toker);
+            next;
+        }
+
+        if (S2::NodeFunction->canStart($toker)) {
+            push @$nodes, S2::NodeFunction->parse($toker);
+            next;
+        }
+
+        if (S2::NodeClass->canStart($toker)) {
+            push @$nodes, S2::NodeClass->parse($toker);
+            next;
+        }
+
+        S2::error($t, "Unknown token encountered while parsing layer: " .
+                  $t->toString());
+    }
+
+    bless $this, $class;
+}
+
+sub setLayerInfo {
+    my ($this, $key, $val) = @_;
+    $this->{'layerinfo'}->{$key} = $val;
+}
+
+sub getLayerInfo {
+    my ($this, $key) = @_;
+    $this->{'layerinfo'}->{$key};
+}
+
+sub getLayerInfoKeys {
+    my ($this) = @_;
+    return [ keys %{$this->{'layerinfo'}} ];
+}
+
+sub getType {
+    shift->{'type'};
+}
+
+sub getDeclaredType {
+    shift->{'declaredType'};
+}
+
+sub setType {
+    shift->{'type'} = shift;
+}
+
+sub toString {
+    shift->{'type'};
+}
+
+sub getNodes {
+    return shift->{'nodes'};
+}
+
+sub isCoreOrLayout {
+    my $this = shift;
+    return $this->{'type'} eq "core" ||
+        $this->{'type'} eq "layout";
+}
+
+1;

wcmtools/s2/S2/Node.pm

@@ -0,0 +1,224 @@
+#!/usr/bin/perl
+#
+
+package S2::Node;
+
+use strict;
+
+sub new {
+    my ($class) = @_;
+    my $node = {
+        'startPos' => undef,
+        'tokenlist' => [],
+    };
+    bless $node, $class;
+}
+
+sub cleanForFreeze {
+    my $this = shift;
+    delete $this->{'tokenlist'};
+    delete $this->{'_cache_type'};
+}
+
+sub setStart {
+    my ($this, $arg) = @_;
+
+    if ($arg->isa('S2::Token') || $arg->isa('S2::Node')) {
+        $this->{'startPos'} =
+            $arg->getFilePos()->clone();
+    } elsif ($arg->isa('S2::FilePos')) {
+        $this->{'startPos'} =
+            $arg->clone();
+    } else {
+        die "Unexpected argument.\n";
+    }
+}
+
+sub check {
+    my ($this, $l, $ck) = @_;
+    die "FIXME: check not implemented for $this\n";
+}
+
+sub asHTML {
+    my ($this, $o) = @_;
+    foreach my $el (@{$this->{'tokenlist'}}) {
+        # $el is an S2::Token or S2::Node
+        $el->asHTML($o);
+    }
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $o->tabwriteln("###$this:::asS2###");
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    $o->tabwriteln("###${this}::asPerl###");
+}
+
+sub asPerl_bool {
+    my ($this, $bp, $o) = @_;
+    my $ck = $S2::CUR_COMPILER->{'checker'};
+    my $s2type = $this->getType($ck);
+
+    # already boolean
+    if ($s2type->equals($S2::Type::BOOL) || $s2type->equals($S2::Type::INT)) {
+        $this->asPerl($bp, $o);
+        return;
+    }
+    
+    # S2 semantics and perl semantics differ ("0" is true in S2)
+    if ($s2type->equals($S2::Type::STRING)) {
+        $o->write("((");
+        $this->asPerl($bp, $o);
+        $o->write(") ne '')");
+        return;
+    }
+
+    # is the object defined?
+    if ($s2type->isSimple()) {
+        $o->write("S2::check_defined(");
+        $this->asPerl($bp, $o);
+        $o->write(")");
+        return;
+    }
+
+    # does the array have elements?
+    if ($s2type->isArrayOf() || $s2type->isHashOf()) {
+        $o->write("S2::check_elements(");
+        $this->asPerl($bp, $o);
+        $o->write(")");
+        return;
+    }
+
+    S2::error($this, "Unhandled internal case for NodeTerm::asPerl_bool()");
+}
+
+sub setTokenList {
+    my ($this, $newlist) = @_;
+    $this->{'tokenlist'} = $newlist;
+}
+
+sub getTokenList {
+    my ($this) = @_;
+    $this->{'tokenlist'};
+}
+
+sub addNode {
+    my ($this, $subnode) = @_;
+    push @{$this->{'tokenlist'}}, $subnode;
+}
+
+sub addToken {
+    my ($this, $t) = @_;
+    push @{$this->{'tokenlist'}}, $t;
+}
+
+sub eatToken {
+    my ($this, $toker, $ignoreSpace) = @_;
+    $ignoreSpace = 1 unless defined $ignoreSpace;
+    my $t = $toker->getToken();
+    $this->addToken($t);
+    if ($ignoreSpace) {
+        $this->skipWhite($toker);
+    }
+    return $t;
+}
+
+sub requireToken {
+    my ($this, $toker, $t, $ignoreSpace) = @_;
+    $ignoreSpace = 1 unless defined $ignoreSpace;
+    if ($ignoreSpace) { $this->skipWhite($toker); }
+    
+    my $next = $toker->getToken();
+    S2::error($next, "Unexpected end of file found") unless $next;
+
+    unless ($next == $t) {
+        S2::error(undef, "internal error") unless $t;
+        S2::error($next, "Unexpected token found.  ".
+                  "Expecting: " . $t->toString() . "\nGot: " . $next->toString());
+    }
+    $this->addToken($next);
+    if ($ignoreSpace) { $this->skipWhite($toker); }
+    return $next;
+}
+
+sub getStringLiteral {
+    my ($this, $toker, $ignoreSpace) = @_;
+    $ignoreSpace = 1 unless defined $ignoreSpace;
+    if ($ignoreSpace) { $this->skipWhite($toker); }
+
+    my $t = $toker->getToken();
+    S2::error($t, "Expected string literal")
+        unless $t && $t->isa("S2::TokenStringLiteral");
+    
+    $this->addToken($t);
+    return $t;
+}
+
+sub getIdent {
+    my ($this, $toker, $addToList, $ignoreSpace) = @_;
+    $addToList = 1 unless defined $addToList;
+    $ignoreSpace = 1 unless defined $ignoreSpace;
+    
+    my $id = $toker->peek();
+    unless ($id->isa("S2::TokenIdent")) {
+        S2::error($id, "Expected identifier.");
+    }
+    if ($addToList) {
+        $this->eatToken($toker, $ignoreSpace);
+    }
+    return $id;
+}
+
+sub skipWhite {
+    my ($this, $toker) = @_;
+    while (my $next = $toker->peek()) {
+        return if $next->isNecessary();
+        $this->addToken($toker->getToken());
+    }
+}
+
+sub getFilePos {
+    my ($this) = @_;
+
+    # most nodes should set their position
+    return $this->{'startPos'} if $this->{'startPos'};
+
+    # if the node didn't record its position, try to figure it out
+    # from where the first token is at
+    my $el = $this->{'tokenlist'}->[0];
+    return $el->getFilePos() if $el;
+    return undef;
+}
+
+sub getType {
+    my ($this, $ck, $wanted) = @_;
+    die "FIXME: getType(ck) not implemented in $this\n";
+}
+
+# kinda a crappy part to put this, perhaps.  but all expr
+# nodes don't inherit from NodeExpr.  maybe they should?
+sub isLValue {
+    my ($this) = @_;
+    # hack:  only NodeTerms inside NodeExprs can be true
+    if ($this->isa('S2::NodeExpr')) {
+        my $n = $this->getExpr();
+        if ($n->isa('S2::NodeTerm')) {
+            return $n->isLValue();
+        }
+    }
+    return 0;
+}
+
+sub makeAsString {
+    my ($this, $ck) = @_;
+    return 0;
+}
+
+sub isProperty {
+    0;
+}
+
+1;

wcmtools/s2/S2/NodeArguments.pm

@@ -0,0 +1,63 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeArguments;
+
+use strict;
+use S2::Node;
+use S2::NodeExpr;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class) = @_;
+    my $node = new S2::Node;
+    $node->{'args'} = [];
+    bless $node, $class;
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $n = new S2::NodeArguments;
+
+    $n->setStart($n->requireToken($toker, $S2::TokenPunct::LPAREN));
+    while (1) {
+        my $tp = $toker->peek();
+        if ($tp == $S2::TokenPunct::RPAREN) {
+            $n->eatToken($toker);
+            return $n;
+        }
+
+        my $expr = parse S2::NodeExpr $toker;
+        push @{$n->{'args'}}, $expr;
+        $n->addNode($expr);
+        if ($toker->peek() == $S2::TokenPunct::COMMA) {
+            $n->eatToken($toker);
+        }
+    }
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    die "not ported";
+}
+
+sub asPerl {
+    my ($this, $bp, $o, $doCurlies) = @_;
+    $doCurlies = 1 unless defined $doCurlies;
+    $o->write("(") if $doCurlies;
+    my $didFirst = 0;
+    foreach my $n (@{$this->{'args'}}) {
+        $o->write(", ") if $didFirst++;
+        $n->asPerl($bp, $o);
+    }
+    $o->write(")") if $doCurlies;
+}
+
+sub typeList {
+    my ($this, $ck) = @_;
+    return join(',', map { $_->getType($ck)->toString() }
+                @{$this->{'args'}});
+}

wcmtools/s2/S2/NodeArrayLiteral.pm

@@ -0,0 +1,173 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeArrayLiteral;
+
+use strict;
+use S2::Node;
+use S2::NodeExpr;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class) = @_;
+    my $node = new S2::Node;
+    $node->{'keys'} = [];
+    $node->{'vals'} = [];
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    return $toker->peek() == $S2::TokenPunct::LBRACK ||
+        $toker->peek() == $S2::TokenPunct::LBRACE;
+}
+
+# [ <NodeExpr>? (, <NodeExpr>)* ,? ]
+# { (<NodeExpr> => <NodeExpr> ,)* }
+
+sub parse {
+    my ($this, $toker) = @_;
+
+    my $nal = new S2::NodeArrayLiteral;
+
+    my $t = $toker->peek();	
+    if ($t == $S2::TokenPunct::LBRACK) {
+        $nal->{'isArray'} = 1;
+        $nal->setStart($nal->requireToken($toker, $S2::TokenPunct::LBRACK));
+    } else {
+        $nal->{'isHash'} = 1;
+        $nal->setStart($nal->requireToken($toker, $S2::TokenPunct::LBRACE));
+    }
+        
+    my $need_comma = 0;
+    while (1) {
+        $t = $toker->peek();
+
+        # find the ends
+        if ($nal->{'isArray'} && $t == $S2::TokenPunct::RBRACK) {
+            $nal->requireToken($toker, $S2::TokenPunct::RBRACK);
+            return $nal;
+        }
+        if ($nal->{'isHash'} && $t == $S2::TokenPunct::RBRACE) {
+            $nal->requireToken($toker, $S2::TokenPunct::RBRACE);
+            return $nal;
+        }
+
+        S2::error($t, "Expecting comma") if $need_comma;
+
+        if ($nal->{'isArray'}) {
+            my $ne = S2::NodeExpr->parse($toker);
+            push @{$nal->{'vals'}}, $ne;
+            $nal->addNode($ne);
+        } elsif ($nal->{'isHash'}) {
+            my $ne = S2::NodeExpr->parse($toker);
+            push @{$nal->{'keys'}}, $ne;
+            $nal->addNode($ne);
+
+            $nal->requireToken($toker, $S2::TokenPunct::HASSOC);
+
+            $ne = S2::NodeExpr->parse($toker);
+            push @{$nal->{'vals'}}, $ne;
+            $nal->addNode($ne);
+        }
+
+        $need_comma = 1;
+        if ($toker->peek() == $S2::TokenPunct::COMMA) {
+            $nal->requireToken($toker, $S2::TokenPunct::COMMA);
+            $need_comma = 0;
+        }
+    }
+    
+    
+}
+
+sub getType {
+    my ($this, $ck, $wanted) = @_;
+
+    # in case of empty array [] or hash {}, the type is what they wanted,
+    # if they wanted something, otherwise void[] or void{}
+    my $t;
+    my $vals = scalar @{$this->{'vals'}};
+    unless ($vals) {
+        return $wanted if $wanted;
+        $t = new S2::Type("void");
+        $t->makeArrayOf() if $this->{'isArray'};
+        $t->makeHashOf() if $this->{'isHash'};
+        return $t;
+    }
+
+    $t = $this->{'vals'}->[0]->getType($ck)->clone();
+    for (my $i=1; $i<$vals; $i++) {
+        my $next = $this->{'vals'}->[$i]->getType($ck);
+        next if $t->equals($next);
+        S2::error($this, "Hash/array literal with inconsistent types: ".
+                  "starts with ". $t->toString .", but then has ".
+                  $next->toString);
+    }
+    
+    if ($this->{'isHash'}) {
+        for (my $i=0; $i<$vals; $i++) {
+            my $t = $this->{'keys'}->[$i]->getType($ck);
+            next if $t->equals($S2::Type::STRING) ||
+                $t->equals($S2::Type::INT);
+            S2::error($this, "Hash keys must be strings or ints.");
+        }        
+    }
+
+    $t->makeArrayOf() if $this->{'isArray'};
+    $t->makeHashOf() if $this->{'isHash'};
+    return $t;
+}    
+
+sub asS2 {
+    my ($this, $o) = @_;
+    die "Not ported.";
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+
+    $o->writeln($this->{'isArray'} ? "[" : "{");
+    $o->tabIn();
+
+    my $size = scalar @{$this->{'vals'}};
+    for (my $i=0; $i<$size; $i++) {
+        $o->tabwrite("");
+        if ($this->{'isHash'}) {
+            $this->{'keys'}->[$i]->asPerl($bp, $o);
+            $o->write(" => ");
+        }
+        $this->{'vals'}->[$i]->asPerl($bp, $o);
+        $o->writeln(",");
+    }
+    $o->tabOut();
+    $o->tabwrite($this->{'isArray'} ? "]" : "}");
+}
+
+__END__
+
+    public void asS2 (Indenter o)
+    {
+	o.writeln(isArray ? "[" : "{");
+        o.tabIn();
+        ListIterator liv = vals.listIterator();
+        ListIterator lik = keys.listIterator();
+        Node n;
+        while (liv.hasNext()) {
+            o.tabwrite("");
+            if (isHash) {
+                n = (Node) lik.next();
+                n.asS2(o);
+                o.write(" => ");
+            }
+            n = (Node) liv.next();
+            n.asS2(o);
+            o.writeln(",");
+        }
+        o.tabOut();
+	o.tabwrite(isArray ? "]" : "}");
+    }
+

wcmtools/s2/S2/NodeAssignExpr.pm

@@ -0,0 +1,101 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeAssignExpr;
+
+use strict;
+use S2::Node;
+use S2::NodeCondExpr;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class, $n) = @_;
+    my $node = new S2::Node;
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    S2::NodeCondExpr->canStart($toker);
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $n = new S2::NodeAssignExpr;
+
+    $n->{'lhs'} = parse S2::NodeCondExpr $toker;
+    $n->addNode($n->{'lhs'});
+
+    if ($toker->peek() == $S2::TokenPunct::ASSIGN) {
+        $n->{'op'} = $toker->peek();
+        $n->eatToken($toker);
+    } else {
+        return $n->{'lhs'};
+    }
+
+    $n->{'rhs'} = parse S2::NodeAssignExpr $toker;
+    $n->addNode($n->{'rhs'});
+
+    return $n;
+}
+
+sub getType {
+    my ($this, $ck, $wanted) = @_;
+
+    my $lt = $this->{'lhs'}->getType($ck, $wanted);
+    my $rt = $this->{'rhs'}->getType($ck, $lt);
+
+    if ($lt->isReadOnly()) {
+        S2::error($this, "Left-hand side of assignment is a read-only value.");
+    }
+
+    if (! $this->{'lhs'}->isa('S2::NodeTerm') ||
+        ! $this->{'lhs'}->isLValue()) {
+        S2::error($this, "Left-hand side of assignment must be an lvalue.");
+    }
+
+    if ($this->{'lhs'}->isBuiltinProperty($ck)) {
+        S2::error($this, "Can't assign to built-in properties.");
+    }
+
+    return $lt if $ck->typeIsa($rt, $lt);
+
+    # types don't match, but maybe class for left hand side has
+    # a constructor which takes a string. 
+    if ($rt->equals($S2::Type::STRING) && $ck->isStringCtor($lt)) {
+        $rt = $this->{'rhs'}->getType($ck, $lt);  # FIXME: can remove this line?
+        return $lt if $lt->equals($rt);
+    }
+
+    S2::error($this, "Can't assign type " . $rt->toString . " to " . $lt->toString);
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $this->{'lhs'}->asS2($o);
+    if ($this->{'op'}) {
+        $o->write(" = ");
+        $this->{'rhs'}->asS2($o);
+    }
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    die "INTERNAL ERROR: no op?" unless $this->{'op'};
+
+    $this->{'lhs'}->asPerl($bp, $o);
+
+    my $need_notags = $bp->untrusted() && 
+        $this->{'lhs'}->isProperty() &&
+        $this->{'lhs'}->getType()->equals($S2::Type::STRING);
+
+    $o->write(" = ");
+    $o->write("S2::notags(") if $need_notags;
+    $this->{'rhs'}->asPerl($bp, $o);
+    $o->write(")") if $need_notags;
+
+}
+

wcmtools/s2/S2/NodeClass.pm

@@ -0,0 +1,269 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeClass;
+
+use strict;
+use S2::Node;
+use S2::NodeClassVarDecl;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class) = @_;
+    my $node = new S2::Node;
+    $node->{'vars'} = [];
+    $node->{'functions'} = [];
+    $node->{'varType'} = {};
+    $node->{'funcType'} = {};
+    bless $node, $class;
+}
+
+sub cleanForFreeze {
+    my $this = shift;
+    delete $this->{'tokenlist'};
+    delete $this->{'docstring'};
+    foreach (@{$this->{'functions'}}) { $_->cleanForFreeze(); }
+    foreach (@{$this->{'vars'}}) { $_->cleanForFreeze(); }
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    return $toker->peek() == $S2::TokenKeyword::CLASS;
+}
+
+sub parse {
+    my ($class, $toker, $isDecl) = @_;
+    my $n = new S2::NodeClass;
+
+    # get the function keyword
+    $n->setStart($n->requireToken($toker, $S2::TokenKeyword::CLASS));
+
+    $n->{'name'} = $n->getIdent($toker);
+    
+    if ($toker->peek() == $S2::TokenKeyword::EXTENDS) {
+        $n->eatToken($toker);
+        $n->{'parentName'} = $n->getIdent($toker);
+    }
+
+    # docstring
+    if ($toker->peek()->isa('S2::TokenStringLiteral')) {
+        my $t = $n->eatToken($toker);
+        $n->{'docstring'} = $t->getString();
+    }
+
+    $n->requireToken($toker, $S2::TokenPunct::LBRACE);
+
+    my $t;
+    while (($t = $toker->peek()) && $t->isa('S2::TokenKeyword')) {
+        if ($t == $S2::TokenKeyword::VAR) {
+            my $ncvd = parse S2::NodeClassVarDecl $toker;
+            push @{$n->{'vars'}}, $ncvd;
+            $n->addNode($ncvd);
+        } elsif ($t == $S2::TokenKeyword::FUNCTION) {
+            my $nm = parse S2::NodeFunction $toker, 1;
+            push @{$n->{'functions'}}, $nm;
+            $n->addNode($nm);
+        }
+    }
+    $n->requireToken($toker, $S2::TokenPunct::RBRACE);
+    return $n;
+}
+
+sub getName { shift->{'name'}->getIdent(); }
+
+sub getParentName { 
+    my $this = shift;
+    return undef unless $this->{'parentName'};
+    return $this->{'parentName'}->getIdent();
+}
+
+sub getFunctionType {
+    my ($this, $funcID) = @_;
+    my $t = $this->{'funcType'}->{$funcID};
+    return $t if $t;
+    return undef unless $this->{'parentClass'};
+    return $this->{'parentClass'}->getFunctionType($funcID);
+}
+
+sub getFunctionDeclClass {
+    my ($this, $funcID) = @_;
+    my $t = $this->{'funcType'}->{$funcID};
+    return $this if $t;
+    return undef unless $this->{'parentClass'};
+    return $this->{'parentClass'}->getFunctionDeclClass($funcID);
+}
+
+sub getMemberType {
+    my ($this, $mem) = @_;
+    my $t = $this->{'varType'}->{$mem};
+    return $t if $t;
+    return undef unless $this->{'parentClass'};
+    return $this->{'parentClass'}->getMemberType($mem);
+}
+
+sub getMemberDeclClass {
+    my ($this, $mem) = @_;
+    my $t = $this->{'varType'}->{$mem};
+    return $this if $t;
+    return undef unless $this->{'parentClass'};
+    return $this->{'parentClass'}->getMemberDeclClass($mem);
+}
+
+sub getDerClasses {
+    my ($this, $l, $depth) = @_;
+    $depth ||= 0; $l ||= [];
+    my $myname = $this->getName();
+    push @$l, { 'nc' => $this, 'dist' => $depth};
+    foreach my $cname (@{$this->{'ck'}->getDerClasses($myname)}) {
+        my $c = $this->{'ck'}->getClass($cname);
+        $c->getDerClasses($l, $depth+1);
+    }
+    return $l;
+}
+
+sub check {
+    my ($this, $l, $ck) = @_;
+
+    # keep a reference to the checker for later
+    $this->{'ck'} = $ck;
+
+    # can't declare classes inside of a layer if functions
+    # have already been declared or defined.
+    if ($ck->getHitFunction()) {
+        S2::error($this, "Can't declare a class inside a layer ".
+                  "file after functions have been defined");
+    }
+
+    # if this is an extended class, make sure parent class exists
+    $this->{'parentClass'} = undef;
+    my $pname = $this->getParentName();
+    if (defined $pname) {
+        $this->{'parentClass'} = $ck->getClass($pname);
+        unless ($this->{'parentClass'}) {
+            S2::error($this, "Can't extend non-existent class '$pname'");
+        }
+    }
+
+    # make sure the class isn't already defined.
+    my $cname = $this->{'name'}->getIdent();
+    S2::error($this, "Can't redeclare class '$cname'") if $ck->getClass($cname);
+
+    # register all var and function declarations in hash & check for both
+    # duplicates and masking of parent class's declarations
+
+    # register self.  this needs to be done before checking member
+    # variables so we can have members of our own type.
+    $ck->addClass($cname, $this);
+
+    # member vars
+    foreach my $nnt (@{$this->{'vars'}}) {
+        my $readonly = $nnt->isReadOnly();
+        my $vn = $nnt->getName();
+        my $vt = $nnt->getType();
+        my $et = $this->getMemberType($vn);
+        if ($et) {
+            my $oc = $this->getMemberDeclClass($vn);
+            S2::error($nnt, "Can't declare the variable '$vn' ".
+                      "as '" . $vt->toString . "' in class '$cname' because it's ".
+                      "already defined in class '". $oc->getName() ."' as ".
+                      "type '". $et->toString ."'.");
+        }
+
+        # check to see if type exists
+        unless ($ck->isValidType($vt)) {
+            S2::error($nnt, "Can't declare member variable '$vn' ".
+                      "as unknown type '". $vt->toString ."' in class '$cname'");
+        }
+        
+        $vt->setReadOnly($readonly);
+        $this->{'varType'}->{$vn} = $vt;  # register member variable
+    }
+
+    # all parent class functions need to be inherited:
+    $this->registerFunctions($ck, $cname);
+}
+
+sub registerFunctions {
+    my ($this, $ck, $clas) = @_;
+
+    # register parent's functions first.
+    if ($this->{'parentClass'}) {
+        $this->{'parentClass'}->registerFunctions($ck, $clas);
+    }
+
+    # now do our own
+    foreach my $nf (@{$this->{'functions'}}) {
+        my $rettype = $nf->getReturnType();
+        $nf->registerFunction($ck, $clas);
+    }
+}
+
+
+sub asS2 {
+    my ($this, $o) = @_;
+    die "not done";
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+
+    $o->tabwriteln("register_class(" . $bp->getLayerIDString() .
+                   ", " . $bp->quoteString($this->getName()) . ", {");
+    $o->tabIn();
+    if ($this->{'parentName'}) {
+        $o->tabwriteln("'parent' => " . $bp->quoteString($this->getParentName()) . ",");
+    }
+    if ($this->{'docstring'}) {
+        $o->tabwriteln("'docstring' => " . $bp->quoteString($this->{'docstring'}) . ",");
+    }
+
+    # vars
+    $o->tabwriteln("'vars' => {");
+    $o->tabIn();
+    foreach my $nnt (@{$this->{'vars'}}) {
+        my $vn = $nnt->getName();
+        my $vt = $nnt->getType();
+        my $et = $this->getMemberType($vn);
+        $o->tabwrite($bp->quoteString($vn) . " => { 'type' => " . $bp->quoteString($vt->toString()));
+        if ($vt->isReadOnly()) {
+            $o->write(", 'readonly' => 1");
+        }
+        if ($nnt->getDocString()) {
+            $o->write(", 'docstring' => " . $bp->quoteString($nnt->getDocString()));
+        }
+        $o->writeln(" },");
+    }        
+    $o->tabOut();
+    $o->tabwriteln("},");
+
+    # methods
+    $o->tabwriteln("'funcs' => {");
+    $o->tabIn();
+    foreach my $nf (@{$this->{'functions'}}) {
+        my $name = $nf->getName();
+        my $nfo = $nf->getFormals();
+        my $rt = $nf->getReturnType();
+        $o->tabwrite($bp->quoteString($name . ($nfo ? $nfo->toString() : "()"))
+                                      . " => { 'returntype' => " 
+                                      . $bp->quoteString($rt->toString()));
+        if ($nf->getDocString()) {
+            $o->write(", 'docstring' => " . $bp->quoteString($nf->getDocString()));
+        }
+        if (my $attrs = $nf->attrsJoined) {
+            $o->write(", 'attrs' => " . $bp->quoteString($attrs));
+        }
+        $o->writeln(" },");
+    }        
+    $o->tabOut();
+    $o->tabwriteln("},");
+        
+    $o->tabOut();
+    $o->tabwriteln("});");
+}
+
+__END__
+
+

wcmtools/s2/S2/NodeClassVarDecl.pm

@@ -0,0 +1,75 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeClassVarDecl;
+
+use strict;
+use S2::Node;
+use S2::NodeType;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class, $name, $type) = @_;
+    my $node = new S2::Node;
+    $node->{'name'} = $name;
+    $node->{'type'} = $type;
+    bless $node, $class;
+}
+
+sub cleanForFreeze {
+    my $this = shift;
+    delete $this->{'tokenlist'};
+    delete $this->{'docstring'};
+    $this->{'typenode'}->cleanForFreeze;
+}
+
+sub getType { shift->{'type'}; }
+sub getName { shift->{'name'}; }
+sub getDocString { shift->{'docstring'}; }
+sub isReadOnly { shift->{'readonly'}; }
+
+sub parse {
+    my ($class, $toker) = @_;
+
+    my $n = new S2::NodeClassVarDecl;
+
+    # get the function keyword
+    $n->setStart($n->requireToken($toker, $S2::TokenKeyword::VAR));
+
+    if ($toker->peek() == $S2::TokenKeyword::READONLY) {
+        $n->{'readonly'} = 1;
+        $n->eatToken($toker);
+    }
+
+    $n->{'typenode'} = parse S2::NodeType $toker;
+    $n->{'type'} = $n->{'typenode'}->getType();
+    $n->addNode($n->{'typenode'});
+
+    $n->{'name'} = $n->getIdent($toker)->getIdent();
+
+    # docstring
+    if ($toker->peek()->isa('S2::TokenStringLiteral')) {
+        my $t = $n->eatToken($toker);
+        $n->{'docstring'} = $t->getString();
+    }
+
+    $n->requireToken($toker, $S2::TokenPunct::SCOLON);
+    return $n;
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    die "not done";
+}
+
+sub asString {
+    my $this = shift;
+    return join(' ', $this->{'type'}->toString, $this->{'name'});
+}
+
+__END__
+
+

wcmtools/s2/S2/NodeCondExpr.pm

@@ -0,0 +1,82 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeCondExpr;
+
+use strict;
+use S2::Node;
+use S2::NodeRange;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class, $n) = @_;
+    my $node = new S2::Node;
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    S2::NodeRange->canStart($toker);
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $n = new S2::NodeCondExpr;
+
+    $n->{'test_expr'} = parse S2::NodeRange $toker;
+    $n->addNode($n->{'test_expr'});
+
+    return $n->{'test_expr'} unless
+        $toker->peek() == $S2::TokenPunct::QMARK;
+
+    $n->eatToken($toker);
+
+    $n->{'true_expr'} = parse S2::NodeRange $toker;
+    $n->addNode($n->{'true_expr'});
+    $n->requireToken($toker, $S2::TokenPunct::COLON);
+
+    $n->{'false_expr'} = parse S2::NodeRange $toker;
+    $n->addNode($n->{'false_expr'});
+
+    return $n;
+}
+
+sub getType {
+    my ($this, $ck) = @_;
+
+    my $ctype = $this->{'test_expr'}->getType($ck);
+    unless ($ctype->isBoolable()) {
+        S2::error($this, "Conditional expression not of type boolean.");
+    }
+
+    my $lt = $this->{'true_expr'}->getType($ck);
+    my $rt = $this->{'false_expr'}->getType($ck);
+    unless ($lt->equals($rt)) {
+        S2::error($this, "Types don't match in conditional expression.");
+    }
+    return $lt;
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $this->{'test_expr'}->asS2($o);
+    $o->write(" ? ");
+    $this->{'true_expr'}->asS2($o);
+    $o->write(" : ");
+    $this->{'false_expr'}->asS2($o);
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    $o->write("(");
+    $this->{'test_expr'}->asPerl_bool($bp, $o);
+    $o->write(" ? ");
+    $this->{'true_expr'}->asPerl($bp, $o);
+    $o->write(" : ");
+    $this->{'false_expr'}->asPerl($bp, $o);
+    $o->write(")");
+}
+

wcmtools/s2/S2/NodeDeleteStmt.pm

@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeDeleteStmt;
+
+use strict;
+use S2::Node;
+use S2::NodeVarRef;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class) = @_;
+    my $n = new S2::Node;
+    bless $n, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    return $toker->peek() == $S2::TokenKeyword::DELETE;
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+
+    my $n = new S2::NodeDeleteStmt;
+    my $t = $toker->peek();
+
+    $n->setStart($n->requireToken($toker, $S2::TokenKeyword::DELETE));
+    $n->addNode($n->{'var'} = S2::NodeVarRef->parse($toker));
+    $n->requireToken($toker, $S2::TokenPunct::SCOLON);
+
+    return $n;
+}
+
+sub check {
+    my ($this, $l, $ck) = @_;
+
+    # type check the innards, but we don't care what type 
+    # actually is.
+    $this->{'var'}->getType($ck);
+
+    # but it must be a hash reference
+    unless ($this->{'var'}->isHashElement()) {
+        S2::error($this, "Delete statement argument is not a hash");
+    }
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $o->tabwrite("delete ");
+    $this->{'var'}->asS2($o);
+    $o->writeln(";");
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    $o->tabwrite("delete ");
+    $this->{'var'}->asPerl($bp, $o);
+    $o->writeln(";");
+}
+

wcmtools/s2/S2/NodeEqExpr.pm

@@ -0,0 +1,89 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeEqExpr;
+
+use strict;
+use S2::Node;
+use S2::NodeRelExpr;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class, $n) = @_;
+    my $node = new S2::Node;
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    S2::NodeRelExpr->canStart($toker);
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $n = new S2::NodeEqExpr;
+
+    $n->{'lhs'} = parse S2::NodeRelExpr $toker;
+    $n->addNode($n->{'lhs'});
+
+    return $n->{'lhs'} unless
+        $toker->peek() == $S2::TokenPunct::EQ ||
+        $toker->peek() == $S2::TokenPunct::NE;
+
+    $n->{'op'} = $toker->peek();
+    $n->eatToken($toker);
+
+    $n->{'rhs'} = parse S2::NodeRelExpr $toker;
+    $n->addNode($n->{'rhs'});
+    $n->skipWhite($toker);
+
+    return $n;
+}
+
+sub getType {
+    my ($this, $ck) = @_;
+
+    my $lt = $this->{'lhs'}->getType($ck);
+    my $rt = $this->{'rhs'}->getType($ck);
+
+    if (! $lt->equals($rt)) {
+        S2::error($this, "The types of the left and right hand side of " .
+                  "equality test expression don't match.");
+    }
+
+    $this->{'myType'} = $lt;
+    
+    return $S2::Type::BOOL if $lt->isPrimitive();
+
+    S2::error($this, "Only bool, string, and int types can be tested for equality.");
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $this->{'lhs'}->asS2($o);
+    $o->write(" " . $this->{'op'}->getPunct() . " ");
+    $this->{'rhs'}->asS2($o);
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    $this->{'lhs'}->asPerl($bp, $o);
+    if ($this->{'op'} == $S2::TokenPunct::EQ) {
+        if ($this->{'myType'}->equals($S2::Type::STRING)) {
+            $o->write(" eq ");
+        } else {
+            $o->write(" == ");
+        }
+    } else {
+        if ($this->{'myType'}->equals($S2::Type::STRING)) {
+            $o->write(" ne ");
+        } else {
+            $o->write(" != ");
+        }
+    }
+    $this->{'rhs'}->asPerl($bp, $o);
+}
+

wcmtools/s2/S2/NodeExpr.pm

@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeExpr;
+
+use strict;
+use S2::Node;
+use S2::NodeAssignExpr;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class, $n) = @_;
+    my $node = new S2::Node;
+    $node->{'expr'} = $n;
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    S2::NodeAssignExpr->canStart($toker);
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $n = new S2::NodeExpr;
+    $n->{'expr'} = parse S2::NodeAssignExpr $toker;
+    $n->addNode($n->{'expr'});
+    return $n;
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $this->{'expr'}->asS2($o);
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    $this->{'expr'}->asPerl($bp, $o);
+}
+
+sub getType {
+    my ($this, $ck, $wanted) = @_;
+    $this->{'expr'}->getType($ck, $wanted);
+}
+
+sub makeAsString {
+    my ($this, $ck) = @_;
+    $this->{'expr'}->makeAsString($ck);
+}
+
+sub getExpr {
+    shift->{'expr'};
+}

wcmtools/s2/S2/NodeExprStmt.pm

@@ -0,0 +1,52 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeExprStmt;
+
+use strict;
+use S2::Node;
+use S2::NodeExpr;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class) = @_;
+    my $node = new S2::Node;
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($this, $toker) = @_;
+    return S2::NodeExpr->canStart($toker);
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $n = new S2::NodeExprStmt;
+    $n->addNode($n->{'expr'} = S2::NodeExpr->parse($toker));
+    $n->requireToken($toker, $S2::TokenPunct::SCOLON);
+    return $n;
+}
+
+sub check {
+    my ($this, $l, $ck) = @_;
+    $this->{'expr'}->getType($ck);
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $o->tabwrite("");
+    $this->{'expr'}->asS2($o);
+    $o->writeln(";");
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    $o->tabwrite("");
+    $this->{'expr'}->asPerl($bp, $o);
+    $o->writeln(";");
+}
+
+

wcmtools/s2/S2/NodeForeachStmt.pm

@@ -0,0 +1,134 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeForeachStmt;
+
+use strict;
+use S2::Node;
+use S2::NodeVarDecl;
+use S2::NodeVarRef;
+use S2::NodeExpr;
+use S2::NodeStmtBlock;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class) = @_;
+    my $n = new S2::Node;
+    bless $n, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    return $toker->peek() == $S2::TokenKeyword::FOREACH
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+
+    my $n = new S2::NodeForeachStmt;
+    $n->setStart($n->requireToken($toker, $S2::TokenKeyword::FOREACH));
+
+    if (S2::NodeVarDecl->canStart($toker)) {
+        $n->addNode($n->{'vardecl'} = S2::NodeVarDecl->parse($toker));
+    } else {
+        $n->addNode($n->{'varref'} = S2::NodeVarRef->parse($toker));
+    }
+
+    # expression in parenthesis representing an array to iterate over:
+    $n->requireToken($toker, $S2::TokenPunct::LPAREN);
+    $n->addNode($n->{'listexpr'} = S2::NodeExpr->parse($toker));
+    $n->requireToken($toker, $S2::TokenPunct::RPAREN);
+
+    # and what to do on each element
+    $n->addNode($n->{'stmts'} = S2::NodeStmtBlock->parse($toker));
+
+    return $n;
+}
+
+sub check {
+    my ($this, $l, $ck) = @_;
+
+    my $ltype = $this->{'listexpr'}->getType($ck);
+
+    if ($ltype->isHashOf()) {
+        $this->{'isHash'} = 1;
+    } elsif ($ltype->equals($S2::Type::STRING)) {
+        $this->{'isString'} = 1;
+    } elsif (! $ltype->isArrayOf()) {
+        S2::error($this, "Must use an array, hash, or string in a foreach");
+    }
+
+    my $itype;
+    if ($this->{'vardecl'}) {
+        $this->{'vardecl'}->populateScope($this->{'stmts'});
+        $itype = $this->{'vardecl'}->getType();
+    }
+    $itype = $this->{'varref'}->getType($ck) if $this->{'varref'};
+
+    if ($this->{'isHash'}) {
+        unless ($itype->equals($S2::Type::STRING) ||
+                $itype->equals($S2::Type::INT)) {
+            S2::error($this, "Foreach iteration variable must be a ".
+                      "string or int when interating over the keys ".
+                      "in a hash");
+        }
+    } elsif ($this->{'isString'}) {
+        unless ($itype->equals($S2::Type::STRING)) {
+            S2::error($this, "Foreach iteration variable must be a ".
+                      "string when interating over the characters ".
+                      "in a string");
+        }
+    } else {
+        # iter type must be the same as the list type minus
+        # the final array ref
+        
+        # figure out the desired type
+        my $dtype = $ltype->clone();
+        $dtype->removeMod();
+
+        unless ($dtype->equals($itype)) {
+            S2::error("Foreach iteration variable is of type ".
+                      $itype->toString . ", not the expected type of ".
+                      $dtype->toString);
+        }
+    }
+
+    $ck->pushLocalBlock($this->{'stmts'});
+    $this->{'stmts'}->check($l, $ck);
+    $ck->popLocalBlock();
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    die "unported";
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+
+    $o->tabwrite("foreach ");
+    $this->{'vardecl'}->asPerl($bp, $o) if $this->{'vardecl'};
+    $this->{'varref'}->asPerl($bp, $o) if $this->{'varref'};
+    if ($this->{'isHash'}) {
+        $o->write(" (keys %{");
+    } elsif ($this->{'isString'}) {
+        $o->write(" (S2::get_characters(");
+    } else {
+        $o->write(" (\@{");
+    }
+
+    $this->{'listexpr'}->asPerl($bp, $o);
+
+    if ($this->{'isString'}) {
+        $o->write(")) ");
+    } else {
+        $o->write("}) ");
+    }
+
+    $this->{'stmts'}->asPerl($bp, $o);
+    $o->newline();
+}
+

wcmtools/s2/S2/NodeFormals.pm

@@ -0,0 +1,135 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeFormals;
+
+use strict;
+use S2::Node;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class, $formals) = @_;
+    my $node = new S2::Node;
+    $node->{'listFormals'} = $formals || [];
+    bless $node, $class;
+}
+
+sub cleanForFreeze {
+    my $this = shift;
+    delete $this->{'tokenlist'};
+    foreach (@{$this->{'listFormals'}}) { $_->cleanForFreeze; }
+}
+
+sub parse {
+    my ($class, $toker, $isDecl) = @_;
+    my $n = new S2::NodeFormals;
+    my $count = 0;
+
+    $n->requireToken($toker, $S2::TokenPunct::LPAREN);
+    while ($toker->peek() != $S2::TokenPunct::RPAREN) {
+        $n->requireToken($toker, $S2::TokenPunct::COMMA) if $count;
+        $n->skipWhite($toker);
+
+        my $nf = parse S2::NodeNamedType $toker;
+        push @{$n->{'listFormals'}}, $nf;
+        $n->addNode($nf);
+
+        $n->skipWhite($toker);
+        $count++;
+    }
+    $n->requireToken($toker, $S2::TokenPunct::RPAREN);
+    return $n;
+}
+
+sub check {
+    my ($this, $l, $ck) = @_;
+    my %seen;
+    foreach my $nt (@{$this->{'listFormals'}}) {
+        my $name = $nt->getName();
+        S2::error($nt, "Duplicate argument named $name") if $seen{$name}++;
+        my $t = $nt->getType();
+        unless ($ck->isValidType($t)) {
+            S2::error($nt, "Unknown type " . $t->toString);
+        }
+    }
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    return unless @{$this->{'listFormals'}};
+    $o->write($this->toString());
+}
+
+sub toString {
+    my ($this) = @_;
+    return "(" . join(", ", map { $_->toString } 
+                      @{$this->{'listFormals'}}) . ")";
+}
+
+sub getFormals { shift->{'listFormals'}; }
+
+# static
+sub variations {
+    my ($nf, $ck) = @_;  # NodeFormals, Checker
+    my $l = [];
+    if ($nf) {
+        $nf->getVariations($ck, $l, [], 0);
+    } else {
+        push @$l, new S2::NodeFormals;
+    }
+    return $l;
+}
+
+sub getVariations {
+    my ($this, $ck, $vars, $temp, $col) = @_;
+    my $size = @{$this->{'listFormals'}};
+
+    if ($col == $size) {
+        push @$vars, new S2::NodeFormals($temp);
+        return;
+    }
+    
+    my $nt = $this->{'listFormals'}->[$col]; # NodeNamedType
+    my $t = $nt->getType();
+
+    foreach my $st (@{$t->subTypes($ck)}) {
+        my $newtemp = [ @$temp ];  # hacky clone (not cloning member objects)
+        push @$newtemp, new S2::NodeNamedType($nt->getName(), $st);
+        $this->getVariations($ck, $vars, $newtemp, $col+1);
+    }
+}
+
+sub typeList {
+    my $this = shift;
+    return join(',', map { $_->getType()->toString } 
+                @{$this->{'listFormals'}});
+
+    # debugging implementation:
+    #my @list;
+    #foreach my $nnt (@{$this->{'listFormals'}}) { # NodeNamedType
+    #    my $t = $nnt->getType();
+    #    if (ref $t ne "S2::Type") {
+    #        print STDERR "Is: $t\n";
+    #        S2::error() 
+    #    }
+    #    push @list, $t->toString;
+    #}
+    #return join(',', @list);
+}
+
+
+# adds all these variables to the stmtblock's symbol table
+sub populateScope {
+    my ($this, $nb) = @_;  # NodeStmtBlock
+    foreach my $nt (@{$this->{'listFormals'}}) {
+	$nb->addLocalVar($nt->getName(), $nt->getType());
+     }
+}
+
+
+
+
+

wcmtools/s2/S2/NodeFunction.pm

@@ -0,0 +1,393 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeFunction;
+
+use strict;
+use S2::Node;
+use S2::NodeFormals;
+use S2::NodeStmtBlock;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class) = @_;
+    my $node = new S2::Node;
+    bless $node, $class;
+}
+
+sub cleanForFreeze {
+    my $this = shift;
+    delete $this->{'tokenlist'};
+    delete $this->{'docstring'};
+    $this->{'formals'}->cleanForFreeze() if $this->{'formals'};
+    $this->{'rettype'}->cleanForFreeze() if $this->{'rettype'};
+}
+
+sub getDocString { shift->{'docstring'}; }
+
+sub canStart {
+    my ($class, $toker) = @_;
+    return $toker->peek() == $S2::TokenKeyword::FUNCTION;
+}
+
+sub parse {
+    my ($class, $toker, $isDecl) = @_;
+    my $n = new S2::NodeFunction;
+
+    # get the function keyword
+    $n->setStart($n->requireToken($toker, $S2::TokenKeyword::FUNCTION));
+
+    # is the builtin keyword on?
+    # this is the old way, but still supported.  the new way
+    # is function attributes in brackets.
+    if ($toker->peek() == $S2::TokenKeyword::BUILTIN) {
+        $n->{'attr'}->{'builtin'} = 1;
+        $n->eatToken($toker);
+    }
+
+    # the class name or function name (if no class)
+    $n->{'name'} = $n->getIdent($toker);
+
+    # check for a double colon
+    if ($toker->peek() == $S2::TokenPunct::DCOLON) {
+        # so last ident was the class name
+        $n->{'classname'} = $n->{'name'};
+        $n->eatToken($toker);
+        $n->{'name'} = $n->getIdent($toker);
+    }
+
+    # Argument list is optional.
+    if ($toker->peek() == $S2::TokenPunct::LPAREN) {
+        $n->addNode($n->{'formals'} = S2::NodeFormals->parse($toker));
+    }
+
+    # Attribute list is optional
+    if ($toker->peek() == $S2::TokenPunct::LBRACK) {
+        $n->eatToken($toker);
+        while ($toker->peek() && $toker->peek() != $S2::TokenPunct::RBRACK) {
+            my $t = $n->eatToken($toker);
+            next if $t == $S2::TokenPunct::COMMA;
+            S2::error($t, "Expecting an identifer for an attribute")
+                unless $t->isa("S2::TokenIdent");
+            my $attr = $t->getIdent();
+            unless ($attr eq "builtin" ||   # implemented by system, not in S2
+                    $attr eq "fixed" ||     # can't be overridden in derived or same layers
+                    $attr eq "notags") {    # return from untrusted layers pass through S2::notags()
+                S2::error($t, "Unknown function attribute '$attr'");
+            }
+            $n->{'attr'}->{$attr} = 1;
+        }
+        $n->requireToken($toker, $S2::TokenPunct::RBRACK);
+    }
+
+    # return type is optional too.
+    if ($toker->peek() == $S2::TokenPunct::COLON) {
+        $n->requireToken($toker, $S2::TokenPunct::COLON);
+        $n->addNode($n->{'rettype'} = S2::NodeType->parse($toker));
+    }
+
+    # docstring
+    if ($toker->peek()->isa('S2::TokenStringLiteral')) {
+        $n->{'docstring'} = $n->eatToken($toker)->getString();
+    }
+
+    # if inside a class declaration, only a declaration now.
+    if ($isDecl || $n->{'attr'}->{'builtin'}) {
+        $n->requireToken($toker, $S2::TokenPunct::SCOLON);
+        return $n;
+    }
+    
+    # otherwise, keep parsing the function definition.
+    $n->{'stmts'} = parse S2::NodeStmtBlock $toker;
+    $n->addNode($n->{'stmts'});
+
+    return $n;
+}
+
+sub getFormals { shift->{'formals'}; }
+sub getName { shift->{'name'}->getIdent(); }
+sub getReturnType { 
+    my $this = shift;
+    return $this->{'rettype'} ? $this->{'rettype'}->getType() : $S2::Type::VOID;
+}
+
+sub check {
+    my ($this, $l, $ck) = @_;
+
+    # keep a reference to the checker for later
+    $this->{'ck'} = $ck;
+
+    # reset the functionID -> local funcNum mappings
+    $ck->resetFunctionNums();
+
+    # tell the checker we've seen a function now so it knows
+    # later to complain if it then sees a new class declaration.
+    # (builtin functions are okay)
+    $ck->setHitFunction(1) unless $this->{'attr'}->{'builtin'};
+    
+    my $funcName = $this->{'name'}->getIdent();
+    my $cname = $this->className();
+    my $funcID = S2::Checker::functionID($cname, $funcName, $this->{'formals'});
+    my $t = $this->getReturnType();
+
+    $ck->setInFunction($funcID);
+
+    if ($cname && $cname eq $funcName) {
+        $this->{'isCtor'} = 1;
+    }
+
+    if ($ck->isFuncBuiltin($funcID)) {
+        S2::error($this, "Can't override built-in functions");
+    }
+
+    if ($ck->checkFuncAttr($funcID, "fixed") && $l->getType() ne "core") {
+        S2::error($this, "Can't override functions with the 'fixed' attribute.");
+    }
+
+    if ($this->{'attr'}->{'builtin'} && $l->getType() ne "core") {
+        S2::error($this, "Only core layers can declare builtin functions");
+    }
+
+    # if this function is global, no declaration is done, but if
+    # this is class-scoped, we must check the class exists and
+    # that it declares this function.
+    if ($cname) {
+        my $nc = $ck->getClass($cname);
+        unless ($nc) {
+            S2::error($this, "Can't declare function $funcID for ".
+                      "non-existent class '$cname'");
+        }
+
+        my $et = $ck->functionType($funcID);
+        unless ($et || ($l->getType() eq "layout" &&
+                        $funcName =~ /^lay_/)) {
+            S2::error($this, "Can't define undeclared object function $funcID");
+        }
+
+        # find & register all the derivative names by which this function
+        # could be called.
+        my $dercs = $nc->getDerClasses();
+        my $fvs = S2::NodeFormals::variations($this->{'formals'}, $ck);
+        foreach my $dc (@$dercs) {  # DerItem
+            my $c = $dc->{'nc'}; # NodeClass
+            foreach my $fv (@$fvs) {
+                my $derFuncID = S2::Checker::functionID($c->getName(), $this->getName(), $fv);
+                $ck->setFuncDistance($derFuncID, { 'nf' => $this, 'dist' => $dc->{'dist'} });
+                $ck->addFunction($derFuncID, $t, $this->{'attr'});
+            }
+        }
+    } else {
+        # non-class function.  register all variations of the formals.
+        my $fvs = S2::NodeFormals::variations($this->{'formals'}, $ck);
+        foreach my $fv (@$fvs) {
+            my $derFuncID = S2::Checker::functionID($cname, 
+                                                    $this->getName(), 
+                                                    $fv);
+            $ck->setFuncDistance($derFuncID, { 'nf' => $this, 'dist' => 0 });
+
+            unless ($l->isCoreOrLayout() || $ck->functionType($derFuncID)) {
+                # only core and layout layers can define new functions
+                S2::error($this, "Only core and layout layers can define new functions.");
+            }
+    
+            $ck->addFunction($derFuncID, $t, $this->{'attr'});
+        }
+    }
+	
+    # check the formals
+    $this->{'formals'}->check($l, $ck) if $this->{'formals'};
+
+    
+    # check the statement block
+    if ($this->{'stmts'}) {
+        # prepare stmts to be checked
+        $this->{'stmts'}->setReturnType($t);
+        
+        # make sure $this is accessible in a class method
+        # FIXME: not in static functions, once we have static functions
+        if ($cname) {
+            $this->{'stmts'}->addLocalVar("this", new S2::Type($cname));
+        } else {
+            $this->{'stmts'}->addLocalVar("this", $S2::Type::VOID);  # prevent its use
+        }
+        
+        # make sure $this is accessible in a class method 
+        # that has a parent.
+        my $pname = $ck->getParentClassName($cname); # String
+        if (defined $pname) {
+            $this->{'stmts'}->addLocalVar("super", new S2::Type($pname));
+        } else {
+            $this->{'stmts'}->addLocalVar("super", $S2::Type::VOID);  # prevent its use
+        }
+        
+        $this->{'formals'}->populateScope($this->{'stmts'}) if $this->{'formals'};
+        
+        $ck->setCurrentFunctionClass($cname);   # for $.member lookups
+        $ck->pushLocalBlock($this->{'stmts'});
+        $this->{'stmts'}->check($l, $ck);
+        $ck->popLocalBlock();
+    }
+
+    # remember the funcID -> local funcNum mappings for the backend
+    $this->{'funcNames'} = $ck->getFuncNames();
+    $ck->setInFunction(0);
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    die "not done";
+}
+
+sub attrsJoined {
+    my $this = shift;
+    return join(',', keys %{$this->{'attr'} || {}});
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    unless ($this->{'classname'}) {
+        $o->tabwrite("register_global_function(" .
+                     $bp->getLayerIDString() . "," .
+                     $bp->quoteString($this->{'name'}->getIdent() . ($this->{'formals'} ? $this->{'formals'}->toString() : "()")) . "," .
+                     $bp->quoteString($this->getReturnType()->toString()));
+        $o->write(", " . $bp->quoteString($this->{'docstring'}));
+        $o->write(", " . $bp->quoteString($this->attrsJoined));
+
+        $o->writeln(");");
+    }
+
+    return if $this->{'attr'}->{'builtin'};
+
+    $o->tabwrite("register_function(" . $bp->getLayerIDString() .
+                 ", [");
+
+    # declare all the names by which this function would be called:
+    # its base name, then all derivative classes which aren't already
+    # used.
+    foreach my $funcID (@{$this->{'ck'}->getFuncIDs($this)}) {
+        $o->write($bp->quoteString($funcID) . ", ");
+    }
+     
+    $o->writeln("], sub {");
+    $o->tabIn();
+
+    # the first time register_function is run, it'll find the
+    # funcNames for this session and save those in a list and then
+    # return the sub which is a closure and will have fast access
+    # to that num -> num hash.  (benchmarking showed two
+    # hashlookups on ints was faster than one on strings)
+
+    if (scalar(@{$this->{'funcNames'}})) {
+        $o->tabwriteln("my \@_l2g_func = ( undef, ");
+        $o->tabIn();
+        foreach my $id (@{$this->{'funcNames'}}) {
+            $o->tabwriteln("get_func_num(" .
+                           $bp->quoteString($id) . "),");
+        }
+        $o->tabOut();
+        $o->tabwriteln(");");
+    }
+
+    # now, return the closure
+    $o->tabwriteln("return sub {");
+    $o->tabIn();
+	
+    # setup function argument/ locals
+    $o->tabwrite("my (\$_ctx");
+    if ($this->{'classname'} && ! $this->{'isCtor'}) {
+        $o->write(", \$this");
+    }
+
+    if ($this->{'formals'}) {
+        my $nts = $this->{'formals'}->getFormals();
+        foreach my $nt (@$nts) {
+            $o->write(", \$" . $nt->getName());
+        }
+    }
+
+    $o->writeln(") = \@_;");
+    # end function locals
+    
+    $this->{'stmts'}->asPerl($bp, $o, 0);
+    $o->tabOut();
+    $o->tabwriteln("};");
+    
+    # end the outer sub
+    $o->tabOut();
+    $o->tabwriteln("});");
+}
+
+sub toString {
+    my $this = shift;
+    return $this->className() . "...";
+}
+
+sub isBuiltin { shift->{'builtin'}; }
+
+# private
+sub className {
+    my $this = shift;
+    return undef unless $this->{'classname'};
+    return $this->{'classname'}->getIdent();
+        
+}
+
+# private
+sub totalName {
+    my $this = shift;
+    my $sb;
+    my $clas = $this->className();
+    $sb .= "${clas}::" if $clas;
+    $sb .= $this->{'name'}->getIdent();
+    return $sb;
+}
+
+# called by NodeClass
+sub registerFunction {
+    my ($this, $ck, $cname) = @_;
+
+    my $fname = $this->getName();
+    my $funcID = S2::Checker::functionID($cname, $fname,
+                                         $this->{'formals'});
+    my $et = $ck->functionType($funcID);
+    my $rt = $this->getReturnType();
+
+    # check that function is either currently undefined or 
+    # defined with the same type, otherwise complain
+    if ($et && ! $et->equals($rt)) {
+        S2::error($this, "Can't redefine function '$fname' with return ".
+                  "type of '" . $rt->toString . "' masking ".
+                  "earlier definition of type '". $et->toString ."'.");
+    }
+
+    $ck->addFunction($funcID, $rt, $this->{'attr'});  # Register
+}
+
+__END__
+
+
+    public void asS2 (Indenter o) 
+    {
+	o.tabwrite("function " + totalName());
+	if (formals != null) {
+	    o.write(" ");
+	    formals.asS2(o);
+	}
+	if (rettype != null) {
+	    o.write(" : ");
+	    rettype.asS2(o);
+	}
+	if (stmts != null) {
+	    o.write(" ");
+	    stmts.asS2(o);
+	    o.newline();
+	} else {
+	    o.writeln(";");
+	}
+    }
+
+
+

wcmtools/s2/S2/NodeIfStmt.pm

@@ -0,0 +1,144 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeIfStmt;
+
+use strict;
+use S2::Node;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class) = @_;
+    my $n = new S2::Node;
+    bless $n, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    return $toker->peek() == $S2::TokenKeyword::IF;
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+
+    my $n = new S2::NodeIfStmt;
+    $n->{'elseifblocks'} = [];
+    $n->{'elseifexprs'} = [];
+
+    $n->setStart($n->requireToken($toker, $S2::TokenKeyword::IF));
+    $n->requireToken($toker, $S2::TokenPunct::LPAREN);
+    $n->addNode($n->{'expr'} = S2::NodeExpr->parse($toker));
+    $n->requireToken($toker, $S2::TokenPunct::RPAREN);
+    $n->addNode($n->{'thenblock'} = S2::NodeStmtBlock->parse($toker));
+    
+    while ($toker->peek() == $S2::TokenKeyword::ELSEIF) {
+        $n->eatToken($toker);
+        $n->requireToken($toker, $S2::TokenPunct::LPAREN);
+        my $expr = S2::NodeExpr->parse($toker);
+        $n->addNode($expr);
+        $n->requireToken($toker, $S2::TokenPunct::RPAREN);
+        push @{$n->{'elseifexprs'}}, $expr;
+
+        my $nie = S2::NodeStmtBlock->parse($toker);
+        $n->addNode($nie);
+        push @{$n->{'elseifblocks'}}, $nie;
+    }
+
+    if ($toker->peek() == $S2::TokenKeyword::ELSE) {
+        $n->eatToken($toker);
+        $n->addNode($n->{'elseblock'} =
+                    S2::NodeStmtBlock->parse($toker));
+    }
+
+    return $n;
+}
+
+# returns true if and only if the 'then' stmtblock ends in a
+# return statement, the 'else' stmtblock is non-null and ends
+# in a return statement, and any elseif stmtblocks end in a return
+# statement.
+sub willReturn {
+    my ($this) = @_;
+    return 0 unless $this->{'elseblock'};
+    return 0 unless $this->{'thenblock'}->willReturn();
+    return 0 unless $this->{'elseblock'}->willReturn();
+    foreach (@{$this->{'elseifblocks'}}) {
+        return 0 unless $_->willReturn();
+    }
+    return 1;
+}
+
+sub check {
+    my ($this, $l, $ck) = @_;
+
+    my $expr = $this->{'expr'};
+
+    my $t = $expr->getType($ck);
+    S2::error($this, "Non-boolean if test") unless $t->isBoolable();
+
+    my $check_assign = sub {
+	my $ex = shift;
+	my $innerexpr = $ex->getExpr;
+	if ($innerexpr->isa("S2::NodeAssignExpr")) {
+	    S2::error($ex, "Assignments not allowed bare in conditionals.  Did you mean to use == instead?  If not, wrap assignment in parens.");
+	  }
+    };
+    $check_assign->($expr);
+
+    $ck->pushLocalBlock($this->{'thenblock'});
+    $this->{'thenblock'}->check($l, $ck);
+    $ck->popLocalBlock();
+
+    foreach my $ne (@{$this->{'elseifexprs'}}) {
+        $t = $ne->getType($ck);
+        S2::error($ne, "Non-boolean if test") unless $t->isBoolable();
+	$check_assign->($ne);
+    }
+
+    foreach my $sb (@{$this->{'elseifblocks'}}) {
+        $ck->pushLocalBlock($sb);
+        $sb->check($l, $ck);
+        $ck->popLocalBlock();
+    }
+
+    if ($this->{'elseblock'}) {
+        $ck->pushLocalBlock($this->{'elseblock'});
+        $this->{'elseblock'}->check($l, $ck);
+        $ck->popLocalBlock();
+    }
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    die "Unported";
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+
+    # if
+    $o->tabwrite("if (");
+    $this->{'expr'}->asPerl_bool($bp, $o);
+    $o->write(") ");
+    $this->{'thenblock'}->asPerl($bp, $o);
+	
+    # else-if
+    my $i = 0;
+    foreach my $expr (@{$this->{'elseifexprs'}}) {
+        my $block = $this->{'elseifblocks'}->[$i++];
+        $o->write(" elsif (");
+        $expr->asPerl_bool($bp, $o);
+        $o->write(") ");
+        $block->asPerl($bp, $o);
+    }
+
+    # else
+    if ($this->{'elseblock'}) {
+        $o->write(" else ");
+        $this->{'elseblock'}->asPerl($bp, $o);
+    }
+    $o->newline();
+}

wcmtools/s2/S2/NodeIncExpr.pm

@@ -0,0 +1,88 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeIncExpr;
+
+use strict;
+use S2::Node;
+use S2::NodeTerm;
+use S2::TokenPunct;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class, $n) = @_;
+    my $node = new S2::Node;
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    return $toker->peek() == $S2::TokenPunct::INCR ||
+        $toker->peek() == $S2::TokenPunct::DEC ||
+        S2::NodeTerm->canStart($toker);
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+
+    my $n = new S2::NodeIncExpr;
+
+    if ($toker->peek() == $S2::TokenPunct::INCR ||
+        $toker->peek() == $S2::TokenPunct::DEC) {
+        $n->{'bPre'} = 1;
+        $n->{'op'} = $toker->peek();
+        $n->setStart($n->eatToken($toker));
+        $n->skipWhite($toker);
+    }
+
+    my $expr = parse S2::NodeTerm $toker;
+    $n->addNode($expr);
+    
+    if ($toker->peek() == $S2::TokenPunct::INCR ||
+        $toker->peek() == $S2::TokenPunct::DEC) {
+        if ($n->{'bPre'}) {
+            S2::error($toker->peek(), "Unexpected " . $toker->peek()->getPunct());
+        }
+        $n->{'bPost'} = 1;
+        $n->{'op'} = $toker->peek();
+        $n->eatToken($toker);
+        $n->skipWhite($toker);
+    }
+
+    if ($n->{'bPre'} || $n->{'bPost'}) {
+        $n->{'expr'} = $expr;
+        return $n;
+    }
+
+    return $expr;
+}
+
+sub getType {
+    my ($this, $ck, $wanted) = @_;
+    my $t = $this->{'expr'}->getType($ck);
+
+    unless ($this->{'expr'}->isLValue() &&
+            $t->equals($S2::Type::INT)) {
+        S2::error($this->{'expr'}, "Post/pre-increment must operate on an integer lvalue");
+    }
+
+    return $t;
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    if ($this->{'bPre'}) { $o->write($this->{'op'}->getPunct()); }
+    $this->{'expr'}->asS2($o);
+    if ($this->{'bPost'}) { $o->write($this->{'op'}->getPunct()); }
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    if ($this->{'bPre'}) { $o->write($this->{'op'}->getPunct()); }
+    $this->{'expr'}->asPerl($bp, $o);
+    if ($this->{'bPost'}) { $o->write($this->{'op'}->getPunct()); }
+}
+

wcmtools/s2/S2/NodeLayerInfo.pm

@@ -0,0 +1,69 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeLayerInfo;
+
+use strict;
+use S2::Node;
+use S2::NodeText;
+use S2::TokenKeyword;
+use S2::TokenPunct;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class) = @_;
+    my $node = new S2::Node;
+    bless $node, $class;
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $n = new S2::NodeLayerInfo;
+
+    my ($nkey, $nval);
+
+    $n->requireToken($toker, $S2::TokenKeyword::LAYERINFO);
+    $n->addNode($nkey = S2::NodeText->parse($toker));
+    $n->requireToken($toker, $S2::TokenPunct::ASSIGN);
+    $n->addNode($nval = S2::NodeText->parse($toker));
+    $n->requireToken($toker, $S2::TokenPunct::SCOLON);
+
+    $n->{'key'} = $nkey->getText();
+    $n->{'val'} = $nval->getText();
+
+    return $n;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    return $toker->peek() == $S2::TokenKeyword::LAYERINFO;
+}
+
+sub getKey { shift->{'key'}; }
+sub getValue { shift->{'val'}; }
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $o->tabwrite("layerinfo ");
+    $o->write(S2::Backend::quoteString($this->{'key'}));
+    $o->write(" = ");
+    $o->write(S2::Backend::quoteString($this->{'val'}));
+    $o->writeln(";");
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    $o->tabwriteln("set_layer_info(" .
+                   $bp->getLayerIDString() . "," .
+                   $bp->quoteString($this->{'key'}) . "," .
+                   $bp->quoteString($this->{'val'}) . ");");
+}
+
+sub check {
+    my ($this, $l, $ck) = @_;
+    $l->setLayerInfo($this->{'key'}, $this->{'val'});
+}
+

wcmtools/s2/S2/NodeLogAndExpr.pm

@@ -0,0 +1,70 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeLogAndExpr;
+
+use strict;
+use S2::Node;
+use S2::NodeEqExpr;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class, $n) = @_;
+    my $node = new S2::Node;
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    S2::NodeEqExpr->canStart($toker);
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $n = new S2::NodeLogAndExpr;
+
+    $n->{'lhs'} = parse S2::NodeEqExpr $toker;
+    $n->addNode($n->{'lhs'});
+
+    return $n->{'lhs'} unless
+        $toker->peek() == $S2::TokenKeyword::AND;
+
+    $n->eatToken($toker);
+
+    $n->{'rhs'} = parse S2::NodeLogAndExpr $toker;
+    $n->addNode($n->{'rhs'});
+
+    return $n;
+}
+
+sub getType {
+    my ($this, $ck) = @_;
+
+    my $lt = $this->{'lhs'}->getType($ck);
+    my $rt = $this->{'rhs'}->getType($ck);
+
+    if (! $lt->equals($rt) || ! $lt->isBoolable()) {
+        S2::error($this, "The left and right side of the 'or' expression must ".
+                  "both be of either type bool or int.");
+    }
+
+    return $S2::Type::BOOL;
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $this->{'lhs'}->asS2($o);
+    $o->write(" and ");
+    $this->{'rhs'}->asS2($o);
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    $this->{'lhs'}->asPerl($bp, $o);
+    $o->write(" && ");
+    $this->{'rhs'}->asPerl($bp, $o);
+}
+

wcmtools/s2/S2/NodeLogOrExpr.pm

@@ -0,0 +1,70 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeLogOrExpr;
+
+use strict;
+use S2::Node;
+use S2::NodeLogAndExpr;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class, $n) = @_;
+    my $node = new S2::Node;
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    S2::NodeLogAndExpr->canStart($toker);
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $n = new S2::NodeLogOrExpr;
+
+    $n->{'lhs'} = parse S2::NodeLogAndExpr $toker;
+    $n->addNode($n->{'lhs'});
+
+    return $n->{'lhs'} unless
+        $toker->peek() == $S2::TokenKeyword::OR;
+
+    $n->eatToken($toker);
+
+    $n->{'rhs'} = parse S2::NodeLogOrExpr $toker;
+    $n->addNode($n->{'rhs'});
+
+    return $n;
+}
+
+sub getType {
+    my ($this, $ck) = @_;
+
+    my $lt = $this->{'lhs'}->getType($ck);
+    my $rt = $this->{'rhs'}->getType($ck);
+
+    if (! $lt->equals($rt) || ! $lt->isBoolable()) {
+        S2::error($this, "The left and right side of the 'or' expression must ".
+                  "both be of either type bool or int.");
+    }
+
+    return $S2::Type::BOOL;
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $this->{'lhs'}->asS2($o);
+    $o->write(" or ");
+    $this->{'rhs'}->asS2($o);
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    $this->{'lhs'}->asPerl($bp, $o);
+    $o->write(" || ");
+    $this->{'rhs'}->asPerl($bp, $o);
+}
+

wcmtools/s2/S2/NodeNamedType.pm

@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeNamedType;
+
+use strict;
+use S2::Node;
+use S2::NodeType;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class, $name, $type) = @_;
+    my $node = new S2::Node;
+    $node->{'name'} = $name;
+    $node->{'type'} = $type;
+    bless $node, $class;
+}
+
+sub cleanForFreeze {
+    my $this = shift;
+    delete $this->{'tokenlist'};
+    $this->{'typenode'}->cleanForFreeze();
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $n = new S2::NodeNamedType;
+
+    $n->{'typenode'} = S2::NodeType->parse($toker);
+    $n->{'type'} = $n->{'typenode'}->getType();
+
+    $n->addNode($n->{'typenode'});
+    $n->{'name'} = $n->getIdent($toker)->getIdent();
+
+    return $n;
+}
+
+sub getType { shift->{'type'}; }
+sub getName { shift->{'name'}; }
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $this->{'typenode'}->asS2($o);
+}
+
+sub toString {
+    my ($this, $l, $ck) = @_;
+    $this->{'type'}->toString() . " $this->{'name'}";
+}
+

wcmtools/s2/S2/NodePrintStmt.pm

@@ -0,0 +1,82 @@
+#!/usr/bin/perl
+#
+
+package S2::NodePrintStmt;
+
+use strict;
+use S2::Node;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class) = @_;
+    my $n = new S2::Node;
+    bless $n, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    my $p = $toker->peek();
+    return
+        $p->isa('S2::TokenStringLiteral') ||
+        $p == $S2::TokenKeyword::PRINT ||
+        $p == $S2::TokenKeyword::PRINTLN;
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+
+    my $n = new S2::NodePrintStmt;
+    my $t = $toker->peek();
+
+    if ($t == $S2::TokenKeyword::PRINT) {
+        $n->setStart($n->eatToken($toker));
+    }
+    if ($t == $S2::TokenKeyword::PRINTLN) {
+        $n->setStart($n->eatToken($toker));
+        $n->{'doNewline'} = 1;
+    }
+
+    $t = $toker->peek();
+    if ($t->isa("S2::TokenIdent") && $t->getIdent() eq "safe") {
+        $n->{'safe'} = 1;
+        $n->eatToken($toker);
+    }
+
+    $n->addNode($n->{'expr'} = S2::NodeExpr->parse($toker));
+    $n->requireToken($toker, $S2::TokenPunct::SCOLON);
+    return $n;
+}
+
+sub check {
+    my ($this, $l, $ck) = @_;
+    my $t = $this->{'expr'}->getType($ck);
+    return if $t->equals($S2::Type::INT) ||
+        $t->equals($S2::Type::STRING);
+    unless ($this->{'expr'}->makeAsString($ck)) {
+        S2::error($this, "Print statement must print an expression of type int or string, not " .
+                  $t->toString);
+    }
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $o->tabwrite($this->{'doNewline'} ? "println " : "print ");
+    $this->{'expr'}->asS2($o);
+    $o->writeln(";");
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    if ($bp->untrusted() || $this->{'safe'}) {
+        $o->tabwrite("\$S2::pout_s->(");
+    } else {
+        $o->tabwrite("\$S2::pout->(");
+    }
+    $this->{'expr'}->asPerl($bp, $o);
+    $o->write(" . \"\\n\"") if $this->{'doNewline'};
+    $o->writeln(");");
+}
+

wcmtools/s2/S2/NodeProduct.pm

@@ -0,0 +1,101 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeProduct;
+
+use strict;
+use S2::Node;
+use S2::NodeUnaryExpr;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class, $n) = @_;
+    my $node = new S2::Node;
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    S2::NodeUnaryExpr->canStart($toker);
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+
+    my $lhs = parse S2::NodeUnaryExpr $toker;
+
+    while ($toker->peek() == $S2::TokenPunct::MULT ||
+           $toker->peek() == $S2::TokenPunct::DIV ||
+           $toker->peek() == $S2::TokenPunct::MOD) {
+        $lhs = parseAnother($toker, $lhs);
+    }
+
+    return $lhs;
+}
+
+sub parseAnother {
+    my ($toker, $lhs) = @_;
+
+    my $n = new S2::NodeProduct();
+
+    $n->{'lhs'} = $lhs;
+    $n->addNode($n->{'lhs'});
+
+    $n->{'op'} = $toker->peek();
+    $n->eatToken($toker);
+    $n->skipWhite($toker);
+
+    $n->{'rhs'} = parse S2::NodeUnaryExpr $toker;
+    $n->addNode($n->{'rhs'});
+    $n->skipWhite($toker);
+
+    return $n;
+}
+
+sub getType {
+    my ($this, $ck, $wanted) = @_;
+
+    my $lt = $this->{'lhs'}->getType($ck, $wanted);
+    my $rt = $this->{'rhs'}->getType($ck, $wanted);
+
+    unless ($lt->equals($S2::Type::INT)) {
+        S2::error($this->{'lhs'}, "Left hand side of " . $this->{'op'}->getPunct() . " operator is " .
+                  $lt->toString() . ", not an integer.");
+    }
+
+    unless ($rt->equals($S2::Type::INT)) {
+        S2::error($this->{'rhs'}, "Right hand side of " . $this->{'op'}->getPunct() . " operator is " .
+                  $rt->toString() . ", not an integer.");
+    }
+
+    return $S2::Type::INT;
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $this->{'lhs'}->asS2($o);
+    $o->write(" " . $this->{'op'}->getPunct() . " ");
+    $this->{'rhs'}->asS2($o);
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+
+    $o->write("int(") if $this->{'op'} == $S2::TokenPunct::DIV;
+    $this->{'lhs'}->asPerl($bp, $o);
+
+    if ($this->{'op'} == $S2::TokenPunct::MULT) {
+        $o->write(" * ");
+    } elsif ($this->{'op'} == $S2::TokenPunct::DIV) {
+        $o->write(" / ");
+    } elsif ($this->{'op'} == $S2::TokenPunct::MOD) {
+        $o->write(" % ");
+    }
+    
+    $this->{'rhs'}->asPerl($bp, $o);
+    $o->write(")") if $this->{'op'} == $S2::TokenPunct::DIV;     
+}
+

wcmtools/s2/S2/NodePropGroup.pm

@@ -0,0 +1,106 @@
+#!/usr/bin/perl
+#
+
+package S2::NodePropGroup;
+
+use strict;
+use S2::Node;
+use S2::NodeProperty;
+use S2::NodeSet;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class) = @_;
+    my $node = new S2::Node;
+    $node->{'groupident'} = "";
+    $node->{'set_list'} = 0;  # true if setting a propgroup list
+    $node->{'list_props'} = []; # array of NodeProperty 
+    $node->{'list_sets'} = []; # array of NodeSet
+    $node->{'set_name'} = 0;  # true if setting the propgroup name
+    $node->{'name'} = undef;
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    return $toker->peek() == $S2::TokenKeyword::PROPGROUP;
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $n = new S2::NodePropGroup;
+
+    $n->setStart($n->requireToken($toker, $S2::TokenKeyword::PROPGROUP));
+    my $ident = $n->getIdent($toker);
+    $n->{'groupident'} = $ident->getIdent();
+    
+    if ($toker->peek() == $S2::TokenPunct::LBRACE) {
+        $n->{'set_list'} = 1;
+        $n->requireToken($toker, $S2::TokenPunct::LBRACE);
+        while ($toker->peek() && $toker->peek() != $S2::TokenPunct::RBRACE)
+        {
+	    my $node;
+            if (S2::NodeProperty->canStart($toker)) {
+                $node = S2::NodeProperty->parse($toker);
+                push @{$n->{'list_props'}}, $node;
+            }
+            elsif (S2::NodeSet->canStart($toker)) {
+                $node = S2::NodeSet->parse($toker);
+                push @{$n->{'list_sets'}}, $node;
+            }
+            else {
+                my $offender = $toker->peek();
+                S2::error($offender, "Unexpected " . $offender->toString());
+            }
+            $n->addNode($node);
+        }
+        $n->requireToken($toker, $S2::TokenPunct::RBRACE);
+    } else {
+        $n->{'set_name'} = 1;
+        $n->requireToken($toker, $S2::TokenPunct::ASSIGN);
+        my $sl = $n->getStringLiteral($toker);
+        $n->{'name'} = $sl->getString();
+        $n->requireToken($toker, $S2::TokenPunct::SCOLON);
+    }
+
+    return $n;
+}
+
+sub check {
+    my ($this, $l, $ck) = @_;
+
+    if ($this->{'set_list'}) {
+        foreach my $prop (@{$this->{'list_props'}}, @{$this->{'list_sets'}}) {
+            $prop->check($l, $ck);
+        }
+    }
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+
+    if ($this->{'set_name'}) {
+        $o->tabwriteln("register_propgroup_name(" .
+                       $bp->getLayerIDString() . "," .
+                       "'$this->{groupident}', " .
+                       $bp->quoteString($this->{'name'}) . ");");
+        return;
+    }
+
+    foreach (@{$this->{'list_props'}}, @{$this->{'list_sets'}}) {
+        $_->asPerl($bp, $o);
+    }
+    
+    $o->tabwriteln("register_propgroup_props(" . 
+                   $bp->getLayerIDString() . "," .
+                   "'$this->{groupident}', [".
+                   join(', ', map { $bp->quoteString($_->getName) } @{$this->{'list_props'}}) .
+                   "]);");
+}

wcmtools/s2/S2/NodeProperty.pm

@@ -0,0 +1,191 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeProperty;
+
+use strict;
+use S2::Node;
+use S2::NodeNamedType;
+use S2::NodePropertyPair;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class) = @_;
+    my $node = new S2::Node;
+    $node->{'nt'} = undef;
+    $node->{'pairs'} = [];
+    $node->{'builtin'} = 0;
+    $node->{'use'} = 0;
+    $node->{'hide'} = 0;
+    $node->{'uhName'} = undef; # if use or hide, then this is property to use/hide
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    return $toker->peek() == $S2::TokenKeyword::PROPERTY;
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $n = new S2::NodeProperty;
+    $n->{'pairs'} = [];
+
+    $n->setStart($n->requireToken($toker, $S2::TokenKeyword::PROPERTY));
+    
+    if ($toker->peek() == $S2::TokenKeyword::BUILTIN) {
+        $n->{'builtin'} = 1;
+        $n->eatToken($toker);
+    }
+
+    # parse the use/hide case
+    if ($toker->peek()->isa('S2::TokenIdent')) {
+        my $ident = $toker->peek()->getIdent();
+        if ($ident eq "use" || $ident eq "hide") {
+            $n->{'use'} = 1 if $ident eq "use";
+            $n->{'hide'} = 1 if $ident eq "hide";
+            $n->eatToken($toker);
+
+            my $t = $toker->peek();
+            unless ($t->isa('S2::TokenIdent')) {
+                S2::error($t, "Expecting identifier after $ident");
+            }
+            
+            $n->{'uhName'} = $t->getIdent();
+            $n->eatToken($toker);
+            $n->requireToken($toker, $S2::TokenPunct::SCOLON);
+            return $n;
+        }
+    }
+
+    $n->addNode($n->{'nt'} = S2::NodeNamedType->parse($toker));
+    
+    my $t = $toker->peek();
+    if ($t == $S2::TokenPunct::SCOLON) {
+        $n->eatToken($toker);
+        return $n;
+    }
+
+    $n->requireToken($toker, $S2::TokenPunct::LBRACE);
+    while (S2::NodePropertyPair->canStart($toker)) {
+        my $pair = S2::NodePropertyPair->parse($toker);
+        push @{$n->{'tokenlist'}}, $pair;
+        push @{$n->{'pairs'}}, $pair;
+    }
+    $n->requireToken($toker, $S2::TokenPunct::RBRACE);
+
+    return $n;
+}
+
+sub check {
+    my ($this, $l, $ck) = @_;
+
+    if ($this->{'use'}) {
+        unless ($l->getType() eq "layout") {
+            S2::error($this, "Can't declare property usage in non-layout layer");
+        }
+        unless ($ck->propertyType($this->{'uhName'})) {
+            S2::error($this, "Can't declare usage of non-existent property");
+        }
+        return;
+    }
+
+    if ($this->{'hide'}) {
+        unless ($ck->propertyType($this->{'uhName'})) {
+            S2::error($this, "Can't hide non-existent property");
+        }
+        return;
+    }
+
+    my $name = $this->{'nt'}->getName();
+    my $type = $this->{'nt'}->getType();
+
+    if ($l->getType() eq "i18n") {
+        # FIXME: as a special case, allow an i18n layer to
+        # to override the 'des' property of a property, so
+        # that stuff can be translated
+        return;
+    }
+
+    # only core and layout layers can define properties
+    unless ($l->isCoreOrLayout()) {
+        S2::error($this, "Only core and layout layers can define new properties.");
+    }
+
+    # make sure they aren't overriding a property from a lower layer
+    my $existing = $ck->propertyType($name);
+    if ($existing && ! $type->equals($existing)) {
+      S2::error($this, "Can't override property '$name' of type " .
+                $existing->toString . " with new type " . 
+                $type->toString . ".");
+    }
+
+    my $basetype = $type->baseType;
+    if (! S2::Type::isPrimitive($basetype) && ! defined $ck->getClass($basetype)) {
+        S2::error($this, "Can't define a property of an unknown class");
+    }
+
+    # all is well, so register this property with its type
+    $ck->addProperty($name, $type, $this->{'builtin'});
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $o->tabwrite("property ");
+    $o->write("builtin ") if $this->{'builtin'};
+    if ($this->{'use'} || $this->{'hide'}) {
+        $o->write("use ") if $this->{'use'};
+        $o->write("hide ") if $this->{'hide'};
+        $o->writeln("$this->{'uhName'};");
+        return;
+    }
+    if (@{$this->{'pairs'}}) {
+        $o->writeln(" {");
+        $o->tabIn();
+        foreach my $pp (@{$this->{'pairs'}}) {
+            $pp->asS2($o);
+        }
+        $o->tabOut();
+        $o->writeln("}");
+    } else {
+        $o->writeln(";");
+    }
+}
+
+sub getName {
+    my $this = shift;
+    $this->{'uhName'} || $this->{'nt'}->getName();
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+
+    if ($this->{'use'}) {
+        $o->tabwriteln("register_property_use(" .
+                       $bp->getLayerIDString() . "," .
+                       $bp->quoteString($this->{'uhName'}) . ");");
+        return;
+    }
+
+    if ($this->{'hide'}) {
+        $o->tabwriteln("register_property_hide(" .
+                       $bp->getLayerIDString() . "," .
+                       $bp->quoteString($this->{'uhName'}) . ");");
+        return;
+    }
+
+    $o->tabwriteln("register_property(" .
+                   $bp->getLayerIDString() . "," .
+                   $bp->quoteString($this->{'nt'}->getName()) . ",{");
+    $o->tabIn();
+    $o->tabwriteln("\"type\"=>" . $bp->quoteString($this->{'nt'}->getType->toString) . ",");
+    foreach my $pp (@{$this->{'pairs'}}) {
+        $o->tabwriteln($bp->quoteString($pp->getKey()) . "=>" .
+                       $bp->quoteString($pp->getVal()) . ",");
+    }    
+    $o->tabOut();
+    $o->writeln("});");
+}

wcmtools/s2/S2/NodePropertyPair.pm

@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+#
+
+package S2::NodePropertyPair;
+
+use strict;
+use S2::Node;
+use S2::NodeText;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class) = @_;
+    my $node = new S2::Node;
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    return S2::NodeText->canStart($toker);
+}
+
+sub getKey { shift->{'key'}->getText(); }
+sub getVal { shift->{'val'}->getText(); }
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $n = new S2::NodePropertyPair;
+    $n->addNode($n->{'key'} = S2::NodeText->parse($toker));
+    $n->requireToken($toker, $S2::TokenPunct::ASSIGN);
+    $n->addNode($n->{'val'} = S2::NodeText->parse($toker));
+    $n->requireToken($toker, $S2::TokenPunct::SCOLON);
+    return $n;
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $o->tabwrite("");
+    $this->{'key'}->asS2($o);
+    $o->write(" = ");
+    $this->{'val'}->asS2($o);
+    $o->write(";");
+}

wcmtools/s2/S2/NodeRange.pm

@@ -0,0 +1,78 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeRange;
+
+use strict;
+use S2::Node;
+use S2::NodeLogOrExpr;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class, $n) = @_;
+    my $node = new S2::Node;
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    S2::NodeLogOrExpr->canStart($toker);
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $n = new S2::NodeRange;
+
+    $n->{'lhs'} = parse S2::NodeLogOrExpr $toker;
+    $n->addNode($n->{'lhs'});
+
+    return $n->{'lhs'} unless
+        $toker->peek() == $S2::TokenPunct::DOTDOT;
+
+    $n->eatToken($toker);
+
+    $n->{'rhs'} = parse S2::NodeLogOrExpr $toker;
+    $n->addNode($n->{'rhs'});
+
+    return $n;
+}
+
+sub getType {
+    my ($this, $ck, $wanted) = @_;
+
+    my $lt = $this->{'lhs'}->getType($ck, $wanted);
+    my $rt = $this->{'rhs'}->getType($ck, $wanted);
+
+    unless ($lt->equals($S2::Type::INT)) {
+        die "Left operand of range operator is not an integer at ".
+            $this->getFilePos->toString . "\n";
+    }
+    unless ($rt->equals($S2::Type::INT)) {
+        die "Right operand of range operator is not an integer at ".
+            $this->getFilePos->toString . "\n";
+    }
+
+    my $ret = new S2::Type "int";
+    $ret->makeArrayOf();
+    return $ret;
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $this->{'lhs'}->asS2($o);
+    $o->write(" .. ");
+    $this->{'rhs'}->asS2($o);
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    $o->write("[");
+    $this->{'lhs'}->asPerl($bp, $o);
+    $o->write(" .. ");
+    $this->{'rhs'}->asPerl($bp, $o);
+    $o->write("]");
+}
+

wcmtools/s2/S2/NodeRelExpr.pm

@@ -0,0 +1,106 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeRelExpr;
+
+use strict;
+use S2::Node;
+use S2::NodeSum;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class, $n) = @_;
+    my $node = new S2::Node;
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    S2::NodeSum->canStart($toker);
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $n = new S2::NodeRelExpr;
+
+    $n->{'lhs'} = parse S2::NodeSum $toker;
+    $n->addNode($n->{'lhs'});
+
+    return $n->{'lhs'} unless
+        $toker->peek() == $S2::TokenPunct::LT ||
+        $toker->peek() == $S2::TokenPunct::LTE ||
+        $toker->peek() == $S2::TokenPunct::GT ||
+        $toker->peek() == $S2::TokenPunct::GTE;
+
+    $n->{'op'} = $toker->peek();
+    $n->eatToken($toker);
+
+    $n->{'rhs'} = parse S2::NodeSum $toker;
+    $n->addNode($n->{'rhs'});
+
+    return $n;
+}
+
+sub getType {
+    my ($this, $ck) = @_;
+
+    my $lt = $this->{'lhs'}->getType($ck);
+    my $rt = $this->{'rhs'}->getType($ck);
+
+    if (! $lt->equals($rt)) {
+        S2::error($this, "The types of the left and right hand side of " .
+                  "equality test expression don't match.");
+    }
+
+    if ($lt->equals($S2::Type::STRING) ||
+        $lt->equals($S2::Type::INT)) {
+        $this->{'myType'} = $lt;
+        return $S2::Type::BOOL;
+    }
+
+    S2::error($this, "Only string and int types can be compared>");
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $this->{'lhs'}->asS2($o);
+    $o->write(" " . $this->{'op'}->getPunct() . " ");
+    $this->{'rhs'}->asS2($o);
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    $this->{'lhs'}->asPerl($bp, $o);
+
+    if ($this->{'op'} == $S2::TokenPunct::LT) {
+        if ($this->{'myType'}->equals($S2::Type::STRING)) {
+            $o->write(" lt ");
+        } else {
+            $o->write(" < ");
+        }
+    } elsif ($this->{'op'} == $S2::TokenPunct::LTE) {
+        if ($this->{'myType'}->equals($S2::Type::STRING)) {
+            $o->write(" le ");
+        } else {
+            $o->write(" <= ");
+        }
+    } elsif ($this->{'op'} == $S2::TokenPunct::GT) {
+        if ($this->{'myType'}->equals($S2::Type::STRING)) {
+            $o->write(" gt ");
+        } else {
+            $o->write(" > ");
+        }
+    } elsif ($this->{'op'} == $S2::TokenPunct::GTE) {
+        if ($this->{'myType'}->equals($S2::Type::STRING)) {
+            $o->write(" ge ");
+        } else {
+            $o->write(" >= ");
+        }
+    }
+    
+    $this->{'rhs'}->asPerl($bp, $o);
+}
+

wcmtools/s2/S2/NodeReturnStmt.pm

@@ -0,0 +1,72 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeReturnStmt;
+
+use strict;
+use S2::Node;
+use S2::NodeExpr;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub canStart {
+    my ($class, $toker) = @_;
+    return $toker->peek() == $S2::TokenKeyword::RETURN;
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $n = new S2::NodeReturnStmt;
+    $n->setStart($n->requireToken($toker, $S2::TokenKeyword::RETURN));
+
+    # optional return expression
+    if (S2::NodeExpr->canStart($toker)) {
+        $n->addNode($n->{'expr'} = S2::NodeExpr->parse($toker));
+    }
+
+    $n->requireToken($toker, $S2::TokenPunct::SCOLON);
+    return $n;
+}
+
+sub check {
+    my ($this, $l, $ck) = @_;
+
+    my $exptype = $ck->getReturnType();
+    my $rettype = $this->{'expr'} ?
+        $this->{'expr'}->getType($ck) : 
+        $S2::Type::VOID;
+
+    if ($ck->checkFuncAttr($ck->getInFunction(), "notags")) {
+        $this->{'notags_func'} = 1;
+    }
+    
+    unless ($ck->typeIsa($rettype, $exptype)) {
+        S2::error($this, "Return type of " . $rettype->toString . " doesn't match expected type of " . $exptype->toString);
+      }
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $o->tabwrite("return");
+    if ($this->{'expr'}) {
+        $o->write(" ");
+        $this->{'expr'}->asS2($o);
+    }
+    $o->writeln(";");
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    $o->tabwrite("return");
+    if ($this->{'expr'}) {
+        my $need_notags = $bp->untrusted() && $this->{'notags_func'};
+        $o->write(" ");
+        $o->write("S2::notags(") if $need_notags;
+        $this->{'expr'}->asPerl($bp, $o);
+        $o->write(")") if $need_notags;
+    }
+    $o->writeln(";");
+}
+

wcmtools/s2/S2/NodeSet.pm

@@ -0,0 +1,101 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeSet;
+
+use strict;
+use S2::Node;
+use S2::NodeExpr;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class) = @_;
+    my $node = new S2::Node;
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    return $toker->peek() == $S2::TokenKeyword::SET;
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+
+    my $nkey; # NodeText
+    my $ns = new S2::NodeSet;
+
+    $ns->setStart($ns->requireToken($toker, $S2::TokenKeyword::SET));
+    
+    $nkey = parse S2::NodeText $toker;
+    $ns->addNode($nkey);
+    $ns->{'key'} = $nkey->getText();
+
+    $ns->requireToken($toker, $S2::TokenPunct::ASSIGN);
+
+    $ns->{'value'} = parse S2::NodeExpr $toker;
+    $ns->addNode($ns->{'value'});
+    
+    $ns->requireToken($toker, $S2::TokenPunct::SCOLON);
+    return $ns;
+}
+
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $o->tabwrite("set ");
+    $o->write(S2::Backend->quoteString($this->{'key'}));
+    $o->write(" = ");
+    $this->{'value'}->asS2($o);
+    $o->writeln(";");
+}
+
+sub check {
+    my ($this, $l, $ck) = @_;
+
+    my $ltype = $ck->propertyType($this->{'key'});
+    $ck->setInFunction(0);
+
+    unless ($ltype) {
+        S2::error($this, "Can't set non-existent property '$this->{'key'}'");
+    }
+
+    my $rtype = $this->{'value'}->getType($ck, $ltype);
+    
+    unless ($ltype->equals($rtype)) {
+        my $lname = $ltype->toString;
+        my $rname = $rtype->toString;
+        S2::error($this, "Property value is of wrong type.  Expecting $lname but got $rname.");
+    }
+
+    if ($ck->propertyBuiltin($this->{'key'})) {
+        S2::error($this, "Can't set built-in properties");
+    }
+
+    # simple case... assigning a primitive
+    if ($ltype->isPrimitive()) {
+        # TODO: check that value.isLiteral()
+        # TODO: check value's type matches
+        return;
+    }
+
+    my $base = new S2::Type $ltype->baseType();
+    if ($base->isPrimitive()) {
+        return;
+    } elsif (! defined $ck->getClass($ltype->baseType())) {
+        S2::error($this, "Can't set property of unknown type");
+    }
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    $o->tabwrite("register_set(" .
+                 $bp->getLayerIDString() . "," .
+                 $bp->quoteString($this->{'key'}) . ",");
+    $this->{'value'}->asPerl($bp, $o);
+    $o->writeln(");");
+    return;
+}

wcmtools/s2/S2/NodeStmt.pm

@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeStmt;
+
+use strict;
+use S2::Node;
+use S2::NodePrintStmt;
+use S2::NodeIfStmt;
+use S2::NodeReturnStmt;
+use S2::NodeDeleteStmt;
+use S2::NodeForeachStmt;
+use S2::NodeVarDeclStmt;
+use S2::NodeExprStmt;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub canStart {
+    my ($class, $toker) = @_;
+    return
+        S2::NodePrintStmt->canStart($toker) ||
+        S2::NodeIfStmt->canStart($toker) ||
+        S2::NodeReturnStmt->canStart($toker) ||
+        S2::NodeDeleteStmt->canStart($toker) ||
+        S2::NodeForeachStmt->canStart($toker) ||
+        S2::NodeVarDeclStmt->canStart($toker) ||
+        S2::NodeExprStmt->canStart($toker);
+}
+
+sub parse {
+    my ($class, $toker, $isDecl) = @_;
+
+    return S2::NodePrintStmt->parse($toker)
+        if S2::NodePrintStmt->canStart($toker);
+
+    return S2::NodeIfStmt->parse($toker)
+        if S2::NodeIfStmt->canStart($toker);
+
+    return S2::NodeReturnStmt->parse($toker)
+        if S2::NodeReturnStmt->canStart($toker);
+
+    return S2::NodeDeleteStmt->parse($toker)
+        if S2::NodeDeleteStmt->canStart($toker);
+
+    return S2::NodeForeachStmt->parse($toker)
+        if S2::NodeForeachStmt->canStart($toker);
+
+    return S2::NodeVarDeclStmt->parse($toker)
+        if S2::NodeVarDeclStmt->canStart($toker);
+    
+    # important that this is last:
+    # (otherwise idents would be seen as function calls)
+    return S2::NodeExprStmt->parse($toker)
+        if S2::NodeExprStmt->canStart($toker);
+
+    S2::error($toker->peek(), "Don't know how to parse this type of statement");
+}
+

wcmtools/s2/S2/NodeStmtBlock.pm

@@ -0,0 +1,142 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeStmtBlock;
+
+use strict;
+use S2::Node;
+use S2::NodeStmt;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class) = @_;
+    my $node = new S2::Node;
+    $node->{'stmtlist'} = [];
+    $node->{'returnType'} = undef;
+    $node->{'localvars'} = {}; # string -> Type
+    bless $node, $class;
+}
+
+sub parse {
+    my ($class, $toker, $isDecl) = @_;
+    my $ns = new S2::NodeStmtBlock;
+    $ns->setStart($ns->requireToken($toker, $S2::TokenPunct::LBRACE));
+
+    my $loop = 1;
+    my $closed = 0;
+
+    do {
+        $ns->skipWhite($toker);
+        my $p = $toker->peek();
+
+        if (! defined $p) {
+            $loop = 0;
+        } elsif ($p == $S2::TokenPunct::RBRACE) {
+            $ns->eatToken($toker);
+            $closed = 1;
+            $loop = 0;
+        } elsif (S2::NodeStmt->canStart($toker)) {
+            my $s = parse S2::NodeStmt $toker;
+            push @{$ns->{'stmtlist'}}, $s;
+            $ns->addNode($s);
+        } else {
+            S2::error($p, "Unexpected token parsing statement block");
+        }
+
+    } while ($loop);
+
+    S2::error($ns, "Didn't find closing brace in statement block")
+        unless $closed;
+
+    return $ns;
+}
+
+sub addLocalVar {
+    my ($this, $v, $t) = @_;
+    $this->{'localvars'}->{$v} = $t;
+}
+
+sub getLocalVar {
+    my ($this, $v) = @_;
+    $this->{'localvars'}->{$v};
+}
+
+sub setReturnType {
+    my ($this, $t) = @_;
+    $this->{'returnType'} = $t;
+}
+
+sub willReturn {
+    my ($this) = @_;
+
+    return 0 unless @{$this->{'stmtlist'}};
+    my $ns = $this->{'stmtlist'}->[-1];
+
+    # a return statement obviously returns
+    return 1 if $ns->isa('S2::NodeReturnStmt');
+
+    # and if statement at the end of a function returns
+    # if all paths return, so ask the ifstatement
+    if ($ns->isa('S2::NodeIfStmt')) {
+        return $ns->willReturn();
+    }
+
+    # all other types don't return
+    return 0;
+}
+
+sub check {
+    my ($this, $l, $ck) = @_;
+    
+    # set the return type for any returnstmts that need it.
+    # NOTE: the returnType is non-null if and only if it's
+    # attached to a function.
+    $ck->setReturnType($this->{'returnType'}) 
+        if $this->{'returnType'};
+    
+    foreach my $ns (@{$this->{'stmtlist'}}) {
+        $ns->check($l, $ck);
+    }
+
+    if ($this->{'returnType'} && 
+        ! $this->{'returnType'}->equals($S2::Type::VOID) &&
+        ! $this->willReturn()) {
+        S2::error($this, "Statement block isn't guaranteed to return (should return " .
+                  $this->{'returnType'}->toString . ")");
+    }
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $o->writeln("{");
+    $o->tabIn();
+    foreach my $ns (@{$this->{'stmtlist'}}) {
+        $ns->asS2($o);
+    }
+    $o->tabOut();
+    $o->tabwrite("}");
+}
+
+sub asPerl {
+    my ($this, $bp, $o, $doCurlies) = @_;
+    $doCurlies = 1 unless defined $doCurlies;
+
+    if ($doCurlies) {
+        $o->writeln("{");
+        $o->tabIn();
+    }
+
+    foreach my $ns (@{$this->{'stmtlist'}}) {
+        $ns->asPerl($bp, $o);
+    }
+
+    if ($doCurlies) {
+        $o->tabOut();
+        $o->tabwrite("}");
+    }
+}
+
+

wcmtools/s2/S2/NodeSum.pm

@@ -0,0 +1,124 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeSum;
+
+use strict;
+use S2::Node;
+use S2::NodeProduct;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class, $lhs, $op, $rhs) = @_;
+    my $node = new S2::Node;
+    $node->{'lhs'} = $lhs;
+    $node->{'op'} = $op;
+    $node->{'rhs'} = $rhs;
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    S2::NodeProduct->canStart($toker);
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+
+    my $lhs = parse S2::NodeProduct $toker;
+    $lhs->skipWhite($toker);
+
+    while ($toker->peek() == $S2::TokenPunct::PLUS ||
+           $toker->peek() == $S2::TokenPunct::MINUS) {
+        $lhs = parseAnother($toker, $lhs);
+    }
+
+    return $lhs;
+}
+
+sub parseAnother {
+    my ($toker, $lhs) = @_;
+
+    my $n = new S2::NodeSum();
+
+    $n->{'lhs'} = $lhs;
+    $n->addNode($n->{'lhs'});
+
+    $n->{'op'} = $toker->peek();
+    $n->eatToken($toker);
+    $n->skipWhite($toker);
+
+    $n->{'rhs'} = parse S2::NodeProduct $toker;
+    $n->addNode($n->{'rhs'});
+    $n->skipWhite($toker);
+
+    return $n;
+}
+
+sub getType {
+    my ($this, $ck, $wanted) = @_;
+
+    my $lt = $this->{'lhs'}->getType($ck, $wanted);
+    my $rt = $this->{'rhs'}->getType($ck, $wanted);
+
+    unless ($lt->equals($S2::Type::INT) || 
+            $lt->equals($S2::Type::STRING))
+    {
+        if ($this->{'lhs'}->makeAsString($ck)) {
+            $lt = $S2::Type::STRING;
+        } else {
+            S2::error($this->{'lhs'}, "Left hand side of " . $this->{'op'}->getPunct() . 
+                      " operator is " . $lt->toString() . ", not a string or integer");
+        }
+    }
+
+    unless ($rt->equals($S2::Type::INT) || 
+            $rt->equals($S2::Type::STRING))
+    {
+        if ($this->{'rhs'}->makeAsString($ck)) {
+            $rt = $S2::Type::STRING;
+        } else {
+            S2::error($this->{'rhs'}, "Right hand side of " . $this->{'op'}->getPunct() . 
+                      " operator is " . $rt->toString() . ", not a string or integer");
+        }
+    }
+
+    if ($this->{'op'} == $S2::TokenPunct::MINUS && 
+        ($lt->equals($S2::Type::STRING) || 
+         $rt->equals($S2::Type::STRING))) {
+        S2::error($this->{'rhs'}, "Can't substract strings.");
+    }
+
+    if ($lt->equals($S2::Type::STRING) || 
+        $rt->equals($S2::Type::STRING)) {
+        return $this->{'myType'} = $S2::Type::STRING;
+    }
+
+    return $this->{'myType'} = $S2::Type::INT;
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $this->{'lhs'}->asS2($o);
+    $o->write(" " . $this->{'op'}->getPunct() . " ");
+    $this->{'rhs'}->asS2($o);
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    $this->{'lhs'}->asPerl($bp, $o);
+
+    if ($this->{'myType'} == $S2::Type::STRING) {
+        $o->write(" . ");
+    } elsif ($this->{'op'} == $S2::TokenPunct::PLUS) {
+        $o->write(" + ");
+    } elsif ($this->{'op'} == $S2::TokenPunct::MINUS) {
+        $o->write(" - ");
+    }
+     
+    $this->{'rhs'}->asPerl($bp, $o);
+}
+

wcmtools/s2/S2/NodeTerm.pm

@@ -0,0 +1,666 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeTerm;
+
+use strict;
+use S2::Node;
+use S2::NodeExpr;
+use S2::NodeArrayLiteral;
+use S2::NodeArguments;
+
+use vars qw($VERSION @ISA
+            $INTEGER $STRING $BOOL $VARREF $SUBEXPR
+            $DEFINEDTEST $SIZEFUNC $REVERSEFUNC $ISNULLFUNC
+            $NEW $NEWNULL $FUNCCALL $METHCALL $ARRAY $OBJ_INTERPOLATE);
+
+$VERSION = '1.0';
+@ISA = qw(S2::NodeExpr);
+
+$INTEGER = 1;
+$STRING = 2;
+$BOOL = 3;
+$VARREF = 4;
+$SUBEXPR = 5;
+$DEFINEDTEST = 6;
+$SIZEFUNC = 7;
+$REVERSEFUNC = 8;
+$ISNULLFUNC = 12;
+$NEW = 9;
+$NEWNULL = 13;
+$FUNCCALL = 10;
+$METHCALL = 11;
+$ARRAY = 14;
+$OBJ_INTERPOLATE = 15;
+
+sub new {
+    my ($class, $n) = @_;
+    my $node = new S2::NodeExpr;
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    my $t = $toker->peek();
+
+    return $t->isa('S2::TokenIntegerLiteral') ||
+        $t->isa('S2::TokenStringLiteral') ||
+        $t->isa('S2::TokenIdent') ||
+        $t == $S2::TokenPunct::DOLLAR ||
+        $t == $S2::TokenPunct::LPAREN ||
+        $t == $S2::TokenPunct::LBRACK ||
+        $t == $S2::TokenPunct::LBRACE ||
+        $t == $S2::TokenKeyword::DEFINED ||
+        $t == $S2::TokenKeyword::TRUE ||
+        $t == $S2::TokenKeyword::FALSE ||
+        $t == $S2::TokenKeyword::NEW ||
+        $t == $S2::TokenKeyword::SIZE ||
+        $t == $S2::TokenKeyword::REVERSE ||
+        $t == $S2::TokenKeyword::ISNULL ||
+        $t == $S2::TokenKeyword::NULL;
+}
+
+sub getType {
+    my ($this, $ck, $wanted) = @_;
+    return $this->{'_cache_type'} if exists $this->{'_cache_type'};
+    $this->{'_cache_type'} = _getType($this, $ck, $wanted);
+}
+
+sub _getType {
+    my ($this, $ck, $wanted) = @_;
+    my $type = $this->{'type'};
+
+    if ($type == $INTEGER) { return $S2::Type::INT; }
+
+    if ($type == $STRING) {
+        return $this->{'nodeString'}->getType($ck, $S2::Type::STRING)
+            if $this->{'nodeString'};
+        if ($ck->isStringCtor($wanted)) {
+            $this->{'ctorclass'} = $wanted->baseType();
+            return $wanted;
+        }
+        return $S2::Type::STRING;
+    }
+    
+    if ($type == $SUBEXPR) { return $this->{'subExpr'}->getType($ck, $wanted); }
+
+    if ($type == $BOOL) { return $S2::Type::BOOL; }
+
+    if ($type == $SIZEFUNC) {
+        $this->{'subType'} = $this->{'subExpr'}->getType($ck);
+        return $S2::Type::INT if
+            $this->{'subType'}->isArrayOf() ||
+            $this->{'subType'}->isHashOf() ||
+            $this->{'subType'}->equals($S2::Type::STRING);
+        S2::error($this, "Can't use size on expression that's not a string, hash or array.");
+    }
+
+    if ($type == $REVERSEFUNC) {
+        $this->{'subType'} = $this->{'subExpr'}->getType($ck);
+
+        # reverse a string
+        return $S2::Type::STRING if 
+            $this->{'subType'}->equals($S2::Type::STRING);
+
+        # reverse an array
+        return $this->{'subType'} if
+            $this->{'subType'}->isArrayOf();
+
+        S2::error($this, "Can't reverse on expression that's not a string or array.");
+    }
+
+    if ($type == $ISNULLFUNC || $type == $DEFINEDTEST) {
+        my $op = ($type == $ISNULLFUNC) ? "isnull" : "defined";
+        $this->{'subType'} = $this->{'subExpr'}->getType($ck);
+
+        if ($this->{'subExpr'}->isa('S2::NodeTerm')) {
+            my $nt = $this->{'subExpr'};
+            if ($nt->{'type'} != $VARREF && $nt->{'type'} != $FUNCCALL &&
+                $nt->{'type'} != $METHCALL) {
+                S2::error($this, "$op must only be used on an object variable, ".
+                          "function call or method call.");
+            }
+        } else {
+            S2::error($this, "$op must only be used on an object variable, ".
+                      "function call or method call.");
+        }
+
+        # can't be used on arrays and hashes
+        unless ($this->{'subType'}->isSimple()) {
+            S2::error($this, "Can't use $op on an array or hash.");
+        }
+        
+        # not primitive types either
+        if ($this->{'subType'}->isPrimitive()) {
+            S2::error($this, "Can't use $op on primitive types.");
+        }
+        
+        # nor void
+        if ($this->{'subType'}->equals($S2::Type::VOID)) {
+            S2::error($this, "Can't use $op on a void value.");
+        }
+        
+        return $S2::Type::BOOL;
+    }
+
+    if ($type == $NEW || $type == $NEWNULL) {
+        my $clas = $this->{'newClass'}->getIdent();
+        if ($clas eq "int" || $clas eq "string") {
+            S2::error($this, "Can't use 'new' with primitive type '$clas'");
+        }
+        my $nc = $ck->getClass($clas);
+        unless ($nc) {
+            S2::error($this, "Can't instantiate unknown class.");
+        }
+        return new S2::Type $clas;
+    }
+
+    if ($type == $VARREF) {
+        unless ($ck->getInFunction()) {
+            S2::error($this, "Can't reference a variable outside of a function.");
+        }
+        return $this->{'var'}->getType($ck, $wanted);
+    }
+
+    if ($type == $METHCALL || $type == $FUNCCALL) {
+        S2::error($this, "Can't call a function or method outside of a function")
+            unless $ck->getInFunction();
+
+        if ($type == $METHCALL) {
+            my $vartype = $this->{'var'}->getType($ck, $wanted);
+            S2::error($this, "Cannot call a method on an array or hash")
+                unless $vartype->isSimple();
+
+            $this->{'funcClass'} = $vartype->toString;
+            
+            my $methClass = $ck->getClass($this->{'funcClass'});
+            S2::error($this, "Can't call a method on an instance of an undefined class")
+                unless $methClass;
+        }
+
+          $this->{'funcID'} = 
+              S2::Checker::functionID($this->{'funcClass'},
+                                      $this->{'funcIdent'}->getIdent(),
+                                      $this->{'funcArgs'}->typeList($ck));
+          $this->{'funcBuiltin'} = $ck->isFuncBuiltin($this->{'funcID'});
+
+          $this->{'funcID_noclass'} = 
+              S2::Checker::functionID(undef,
+                                      $this->{'funcIdent'}->getIdent(),
+                                      $this->{'funcArgs'}->typeList($ck));
+          
+          my $t = $ck->functionType($this->{'funcID'});
+          $this->{'funcNum'} = $ck->functionNum($this->{'funcID'})
+              unless $this->{'funcBuiltin'};
+          
+          S2::error($this, "Unknown function $this->{'funcID'}")
+              unless $t;
+          
+          return $t;
+    }
+
+    if ($type == $ARRAY) {
+        return $this->{'subExpr'}->getType($ck, $wanted);
+    }
+
+    S2::error($this, "Unknown NodeTerm type");
+}
+
+sub isLValue {
+    my $this = shift;
+    return 1 if $this->{'type'} == $VARREF;
+    return $this->{'subExpr'}->isLValue()
+        if $this->{'type'} == $SUBEXPR;
+    return 0;
+}
+
+# make the object interpolate in a string
+sub makeAsString {
+    my ($this, $ck) = @_;
+
+    if ($this->{'type'} == $STRING) {
+        return $this->{'nodeString'}->makeAsString($ck);
+    }
+    return 0 unless $this->{'type'} == $VARREF;
+
+    my $t = $this->{'var'}->getType($ck);
+    return 0 unless $t->isSimple();
+    
+    my $bt = $t->baseType;
+    
+    # class has .toString() or .as_string() method?
+    if (my $methname = $ck->classHasToString($bt)) {
+        # let's change this VARREF into a METHCALL!
+        # warning: ugly hacks ahead...
+        my $funcID = "${bt}::$methname()";
+        if ($ck->isFuncBuiltin($funcID)) {
+            # builtins map to a normal function call.
+            # the builtin function is responsible for checking if the
+            # object is S2::check_defined() and then returning nothing.
+            $this->{'type'} = $METHCALL;
+            $this->{'funcIdent'} = new S2::TokenIdent $methname;
+            $this->{'funcClass'} = $bt;
+            $this->{'funcArgs'} = new S2::NodeArguments; # empty
+            $this->{'funcID_noclass'} = "$methname()";
+            $this->{'funcID'} = $funcID;
+            $this->{'funcBuiltin'} = 1;
+        } else {
+            # if it's S2-level as_string(), then we call
+            # S2::interpolate_object($ctx, "ClassName", $obj, $methname)
+            $this->{'type'} = $OBJ_INTERPOLATE;
+            $this->{'funcClass'} = $bt;
+            $this->{'objint_method'} = $methname;
+
+        }
+        return 1;
+    }
+
+    # class has $.as_string string member?
+    if ($ck->classHasAsString($bt)) {
+        $this->{'var'}->useAsString();
+        return 1;
+    }
+    
+    return 0;    
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $nt = new S2::NodeTerm;
+    my $t = $toker->peek();
+
+    # integer literal
+    if ($t->isa('S2::TokenIntegerLiteral')) {
+        $nt->{'type'} = $INTEGER;
+        $nt->{'tokInt'} = $nt->eatToken($toker);
+        return $nt;
+    }
+
+    # boolean literal
+    if ($t == $S2::TokenKeyword::TRUE ||
+        $t == $S2::TokenKeyword::FALSE) {
+        $nt->{'type'} = $BOOL;
+        $nt->{'boolValue'} = $t == $S2::TokenKeyword::TRUE;
+        $nt->eatToken($toker);
+        return $nt;
+    }
+
+    # string literal
+    if ($t->isa('S2::TokenStringLiteral')) {
+        my $ts = $t;
+        my $ql = $ts->getQuotesLeft();
+        my $qr = $ts->getQuotesRight();
+
+        if ($qr) {
+            # whole string literal
+            $nt->{'type'} = $STRING;
+            $nt->{'tokStr'} = $nt->eatToken($toker);
+            $nt->setStart($nt->{'tokStr'});
+            return $nt;
+        }
+
+        # interpolated string literal (turn into a subexpr)
+        my $toklist = [];
+        $toker->pushInString($ql);
+        
+        $nt->{'type'} = $STRING;
+        $nt->{'tokStr'} = $nt->eatToken($toker);
+        push @$toklist, $nt->{'tokStr'}->clone();
+        $nt->{'tokStr'}->setQuotesRight($ql);
+        
+        my $lhs = $nt;
+        my $filepos = $nt->{'tokStr'}->getFilePos();
+        
+        my $loop = 1;
+        while ($loop) {
+            my $rhs = undef;
+            my $tok = $toker->peek();
+            unless ($tok) {
+                S2::error($tok, "Unexpected end of file.  Unclosed string literal?");
+            }
+            if ($tok->isa('S2::TokenStringLiteral')) {
+                $rhs = new S2::NodeTerm;
+                $ts = $tok;
+                $rhs->{'type'} = $STRING;
+                $rhs->{'tokStr'} = $rhs->eatToken($toker);
+                push @$toklist, $rhs->{'tokStr'}->clone();
+
+                $loop = 0 if $ts->getQuotesRight() == $ql;
+                $ts->setQuotesRight($ql);
+                $ts->setQuotesLeft($ql);
+            } elsif ($tok == $S2::TokenPunct::DOLLAR) {
+                $rhs = parse S2::NodeTerm $toker;
+                push @$toklist, @{$rhs->getTokenList()};
+            } else {
+                S2::error($tok, "Error parsing interpolated string: " . $tok->toString);
+            }
+            
+            # don't make a sum out of a blank string on either side
+            my $join = 1;
+            if ($lhs->isa('S2::NodeTerm') &&
+                $lhs->{'type'} == $STRING &&
+                length($lhs->{'tokStr'}->getString()) == 0) 
+            {
+                $lhs = $rhs;
+                $join = 0;
+            }
+            if ($rhs->isa('S2::NodeTerm') &&
+                $rhs->{'type'} == $STRING &&
+                length($rhs->{'tokStr'}->getString()) == 0)
+            {
+                $join = 0;
+            }
+
+            if ($join) {
+                $lhs = S2::NodeSum->new($lhs, $S2::TokenPunct::PLUS, $rhs);
+            }
+        }
+        
+        $toker->popInString();
+
+        $lhs->setTokenList($toklist);
+        $lhs->setStart($filepos);
+        
+        my $rnt = new S2::NodeTerm;
+        $rnt->{'type'} = $STRING;
+        $rnt->{'nodeString'} = $lhs;
+        $rnt->addNode($lhs);
+
+        return $rnt;
+    }
+    
+    # Sub-expression (in parenthesis)
+    if ($t == $S2::TokenPunct::LPAREN) {
+        $nt->{'type'} = $SUBEXPR;
+        $nt->setStart($nt->eatToken($toker));
+
+        $nt->{'subExpr'} = parse S2::NodeExpr $toker;
+        $nt->addNode($nt->{'subExpr'});
+
+        $nt->requireToken($toker, $S2::TokenPunct::RPAREN);
+        return $nt;
+    }
+
+    # defined test
+    if ($t == $S2::TokenKeyword::DEFINED) {
+        $nt->{'type'} = $DEFINEDTEST;
+        $nt->setStart($nt->eatToken($toker));
+        $nt->{'subExpr'} = parse S2::NodeTerm $toker;
+        $nt->addNode($nt->{'subExpr'});
+        return $nt;
+    }
+
+    # reverse function
+    if ($t == $S2::TokenKeyword::REVERSE) {
+        $nt->{'type'} = $REVERSEFUNC;
+        $nt->eatToken($toker);
+        $nt->{'subExpr'} = parse S2::NodeTerm $toker;
+        $nt->addNode($nt->{'subExpr'});
+        return $nt;
+    }
+
+    # size function
+    if ($t == $S2::TokenKeyword::SIZE) {
+        $nt->{'type'} = $SIZEFUNC;
+        $nt->eatToken($toker);
+        $nt->{'subExpr'} = parse S2::NodeTerm $toker;
+        $nt->addNode($nt->{'subExpr'});
+        return $nt;
+    }
+
+    # isnull function
+    if ($t == $S2::TokenKeyword::ISNULL) {
+        $nt->{'type'} = $ISNULLFUNC;
+        $nt->eatToken($toker);
+        $nt->{'subExpr'} = parse S2::NodeTerm $toker;
+        $nt->addNode($nt->{'subExpr'});
+        return $nt;
+    }
+
+    # new andnull
+    if ($t == $S2::TokenKeyword::NEW ||
+        $t == $S2::TokenKeyword::NULL) {
+        $nt->{'type'} = $t == $S2::TokenKeyword::NEW ? $NEW : $NEWNULL;
+        $nt->eatToken($toker);
+        $nt->{'newClass'} = $nt->getIdent($toker);
+        return $nt;
+    }
+
+    # VarRef
+    if ($t == $S2::TokenPunct::DOLLAR) {
+        $nt->{'type'} = $VARREF;
+        $nt->{'var'} = parse S2::NodeVarRef $toker;
+        $nt->addNode($nt->{'var'});
+
+        # check for -> after, like: $object->method(arg1, arg2, ...)
+        if ($toker->peek() == $S2::TokenPunct::DEREF) {
+            $nt->{'derefLine'} = $toker->peek()->getFilePos()->line;
+            $nt->eatToken($toker);
+            $nt->{'type'} = $METHCALL;
+            # don't return... parsing continues below.
+        } else {
+            return $nt;
+        }
+    }
+
+    # function/method call
+    if ($nt->{'type'} == $METHCALL || $t->isa('S2::TokenIdent')) {
+        $nt->{'type'} = $FUNCCALL unless $nt->{'type'} == $METHCALL;
+        $nt->{'funcIdent'} = $nt->getIdent($toker);
+        $nt->{'funcArgs'} = parse S2::NodeArguments $toker;
+        $nt->addNode($nt->{'funcArgs'});
+        return $nt;
+    }
+
+    # array/hash literal
+    if (S2::NodeArrayLiteral->canStart($toker)) {
+        $nt->{'type'} = $ARRAY;
+        $nt->{'subExpr'} = parse S2::NodeArrayLiteral $toker;
+        $nt->addNode($nt->{'subExpr'});
+        return $nt;
+    }
+    
+    S2::error($toker->peek(), "Can't finish parsing NodeTerm");
+}
+
+
+sub asS2 {
+    my ($this, $o) = @_;
+    die "NodeTerm::asS2(): not implemented";
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    my $type = $this->{'type'};
+
+    if ($type == $INTEGER) {
+        $this->{'tokInt'}->asPerl($bp, $o);
+        return;
+    }
+
+    if ($type == $STRING) {
+        if (defined $this->{'nodeString'}) {
+            $o->write("(");
+            $this->{'nodeString'}->asPerl($bp, $o);
+            $o->write(")");
+            return;
+        }
+        if ($this->{'ctorclass'}) {
+            my $pkg = $bp->getBuiltinPackage() || "S2::Builtin";
+            $o->write("${pkg}::$this->{'ctorclass'}__$this->{'ctorclass'}(");
+        }
+        $this->{'tokStr'}->asPerl($bp, $o);
+        $o->write(")") if $this->{'ctorclass'};
+        return;
+    }
+
+    if ($type == $BOOL) {
+        $o->write($this->{'boolValue'} ? "1" : "0");
+        return;
+    }
+
+    if ($type == $SUBEXPR) {
+        $o->write("(");
+        $this->{'subExpr'}->asPerl($bp, $o);
+        $o->write(")");
+        return;
+    }
+
+    if ($type == $ARRAY) {
+        $this->{'subExpr'}->asPerl($bp, $o);
+        return;
+    }
+
+    if ($type == $NEW) {
+        $o->write("{'_type'=>" .
+                  $bp->quoteString($this->{'newClass'}->getIdent()) .
+                  "}");
+        return;
+    }
+
+    if ($type == $NEWNULL) {
+        $o->write("{'_type'=>" .
+                  $bp->quoteString($this->{'newClass'}->getIdent()) .
+                  ", '_isnull'=>1}");
+        return;
+    }
+
+    if ($type == $REVERSEFUNC) {
+        if ($this->{'subType'}->isArrayOf()) {
+            $o->write("[reverse(\@{");
+            $this->{'subExpr'}->asPerl($bp, $o);
+            $o->write("})]");
+        } elsif ($this->{'subType'}->equals($S2::Type::STRING)) {
+            $o->write("reverse(");
+            $this->{'subExpr'}->asPerl($bp, $o);
+            $o->write(")");
+        }
+        return;
+    }
+
+    if ($type == $SIZEFUNC) {
+        if ($this->{'subType'}->isArrayOf()) {
+            $o->write("scalar(\@{");
+            $this->{'subExpr'}->asPerl($bp, $o);
+            $o->write("})");
+        } elsif ($this->{'subType'}->isHashOf()) {
+            $o->write("scalar(keys \%{");
+            $this->{'subExpr'}->asPerl($bp, $o);
+            $o->write("})");
+        } elsif ($this->{'subType'}->equals($S2::Type::STRING)) {
+            $o->write("length(");
+            $this->{'subExpr'}->asPerl($bp, $o);
+            $o->write(")");
+        }
+        return;
+    }
+
+    if ($type == $DEFINEDTEST) {
+        $o->write("S2::check_defined(");
+        $this->{'subExpr'}->asPerl($bp, $o);
+        $o->write(")");
+        return;
+    }
+
+    if ($type == $ISNULLFUNC) {
+        $o->write("(ref ");
+        $this->{'subExpr'}->asPerl($bp, $o);
+        $o->write(" ne \"HASH\" || ");
+        $this->{'subExpr'}->asPerl($bp, $o);
+        $o->write("->{'_isnull'})");
+        return;
+    }
+
+    if ($type == $VARREF) {
+        $this->{'var'}->asPerl($bp, $o);
+        return;
+    }
+
+    if ($type == $OBJ_INTERPOLATE) {
+        $o->write("S2::interpolate_object(\$_ctx, '$this->{'funcClass'}', ");
+        $this->{'var'}->asPerl($bp, $o);
+        $o->write(", '$this->{'objint_method'}()')");
+        return;
+    }
+
+    if ($type == $FUNCCALL || $type == $METHCALL) {
+
+        # builtin functions can be optimized.
+        if ($this->{'funcBuiltin'}) {
+            # these built-in functions can be inlined.
+            if ($this->{'funcID'} eq "string(int)") {
+                $this->{'funcArgs'}->asPerl($bp, $o, 0);
+                return;
+            }
+            if ($this->{'funcID'} eq "int(string)") {
+                # cast from string to int by adding zero to it
+                $o->write("int(");
+                $this->{'funcArgs'}->asPerl($bp, $o, 0);
+                $o->write(")");
+                return;
+            }
+
+            # otherwise, call the builtin function (avoid a layer
+            # of indirection), unless it's for a class that has
+            # children (won't know until run-time which class to call)
+            my $pkg = $bp->getBuiltinPackage() || "S2::Builtin";
+            $o->write("${pkg}::");
+            if ($this->{'funcClass'}) {
+                $o->write("$this->{'funcClass'}__");
+            }
+            $o->write($this->{'funcIdent'}->getIdent());
+        } else {
+            if ($type == $METHCALL && $this->{'funcClass'} ne "string") {
+                $o->write("\$_ctx->[VTABLE]->{get_object_func_num(");
+                $o->write($bp->quoteString($this->{'funcClass'}));
+                $o->write(",");
+                $this->{'var'}->asPerl($bp, $o);
+                $o->write(",");
+                $o->write($bp->quoteString($this->{'funcID_noclass'}));
+                $o->write(",");
+                $o->write($bp->getLayerID());
+                $o->write(",");
+                $o->write($this->{'derefLine'}+0);
+                if ($this->{'var'}->isSuper()) {
+                    $o->write(",1");
+                }
+                $o->write(")}->");
+            } elsif ($type == $METHCALL) {
+                $o->write("\$_ctx->[VTABLE]->{get_func_num(");
+                $o->write($bp->quoteString($this->{'funcID'}));
+                $o->write(")}->");
+            } else {
+                $o->write("\$_ctx->[VTABLE]->{\$_l2g_func[$this->{'funcNum'}]}->");
+            }
+        }
+
+        $o->write("(\$_ctx, ");
+        
+        # this pointer
+        if ($type == $METHCALL) {
+            $this->{'var'}->asPerl($bp, $o);
+            $o->write(", ");
+        }
+        
+        $this->{'funcArgs'}->asPerl($bp, $o, 0);
+        
+        $o->write(")");
+        return;
+    }
+
+    die "Unknown term type";
+}
+
+sub isProperty {
+    my $this = shift;
+    return 0 unless $this->{'type'} == $VARREF;
+    return $this->{'var'}->isProperty();
+}
+
+sub isBuiltinProperty {
+    my ($this, $ck) = @_;
+    return 0 unless $this->{'type'} == $VARREF;
+    return 0 unless $this->{'var'}->isProperty();
+    my $name = $this->{'var'}->propName();
+    return $ck->propertyBuiltin($name);
+}

wcmtools/s2/S2/NodeText.pm

@@ -0,0 +1,59 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeText;
+
+use strict;
+use S2::Node;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class) = @_;
+    my $node = new S2::Node;
+    bless $node, $class;
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $nt = new S2::NodeText;
+
+    $nt->skipWhite($toker);
+    my $t = $toker->peek();
+
+    if ($t->isa('S2::TokenIdent')) {
+        my $ti = $toker->getToken();
+        $nt->addToken($ti);
+        $nt->{'text'} = $ti->getIdent();
+        $ti->setType($S2::TokenIdent::STRING);
+    } elsif ($t->isa('S2::TokenIntegerLiteral')) {
+        $nt->addToken($toker->getToken());
+        $nt->{'text'} = $t->getInteger();
+    } elsif ($t->isa('S2::TokenStringLiteral')) {
+        $nt->addToken($toker->getToken());
+        $nt->{'text'} = $t->getString();
+    } else {
+        S2::error($t, "Expecting text (integer, string, or identifer)");
+    }
+
+    return $nt;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    my $t = $toker->peek();
+    return $t->isa("S2::TokenIdent") ||
+        $t->isa("S2::TokenIntegerLiteral") ||
+        $t->isa("S2::TokenStringLiteral");
+}
+
+sub getText { shift->{'text'}; }
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $o->write(S2::Backend::quoteString($this->{'text'}));
+}
+
+

wcmtools/s2/S2/NodeType.pm

@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeType;
+
+use strict;
+use S2::Node;
+use S2::Type;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class, $name, $type) = @_;
+    my $node = new S2::Node;
+    $node->{'type'} = undef;
+    bless $node, $class;
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $n = new S2::NodeType;
+    
+    my $base = $n->getIdent($toker, 1, 0);
+    $base->setType($S2::TokenIdent::TYPE);
+
+    $n->{'type'} = S2::Type->new($base->getIdent());
+    while ($toker->peek() == $S2::TokenPunct::LBRACK ||
+           $toker->peek() == $S2::TokenPunct::LBRACE) {
+        my $t = $toker->peek();
+        $n->eatToken($toker, 0);
+        
+        if ($t == $S2::TokenPunct::LBRACK) {
+            $n->requireToken($toker, $S2::TokenPunct::RBRACK, 0);
+            $n->{'type'}->makeArrayOf();
+        } elsif ($t == $S2::TokenPunct::LBRACE) {
+            $n->requireToken($toker, $S2::TokenPunct::RBRACE, 0);
+            $n->{'type'}->makeHashOf();
+        }
+    }
+
+    # If the type was a simple type, we have to remove whitespace,
+    # since we explictly said not to above.
+    $n->skipWhite($toker);
+    return $n;
+}
+
+sub getType { shift->{'type'}; }
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $o->write($this->{'type'}->toString());
+}
+
+

wcmtools/s2/S2/NodeUnaryExpr.pm

@@ -0,0 +1,84 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeUnaryExpr;
+
+use strict;
+use S2::Node;
+use S2::NodeIncExpr;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class, $n) = @_;
+    my $node = new S2::Node;
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    return $toker->peek() == $S2::TokenPunct::MINUS ||
+        $toker->peek() == $S2::TokenPunct::NOT ||
+        S2::NodeIncExpr->canStart($toker);
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+
+    my $n = new S2::NodeUnaryExpr();
+
+    if ($toker->peek() == $S2::TokenPunct::MINUS) {
+        $n->{'bNegative'} = 1;
+        $n->eatToken($toker);
+    } elsif ($toker->peek() == $S2::TokenKeyword::NOT) {
+        $n->{'bNot'} = 1;
+        $n->eatToken($toker);
+    }
+
+    my $expr = parse S2::NodeIncExpr $toker;
+    
+    if ($n->{'bNegative'} || $n->{'bNot'}) {
+        $n->{'expr'} = $expr;
+        $n->addNode($n->{'expr'});
+        return $n;
+    }
+
+    return $expr;
+}
+
+sub getType {
+    my ($this, $ck, $wanted) = @_;
+
+    my $t = $this->{'expr'}->getType($ck);
+
+    if ($this->{'bNegative'}) {
+        unless ($t->equals($S2::Type::INT)) {
+            S2::error($this->{'expr'}, "Can't use unary minus on non-integer.");
+        }
+        return $S2::Type::INT;
+    }
+    if ($this->{'bNot'}) {
+        unless ($t->equals($S2::Type::BOOL)) {
+            S2::error($this->{'expr'}, "Can't use negation operator on boolean-integer.");
+        }
+        return $S2::Type::BOOL;
+    }
+    return undef
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    if ($this->{'bNot'}) { $o->write("not "); }
+    if ($this->{'bNegative'}) { $o->write("-"); }
+    $this->{'expr'}->asS2($o);
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    if ($this->{'bNot'}) { $o->write("! "); }
+    if ($this->{'bNegative'}) { $o->write("-"); }
+    $this->{'expr'}->asPerl($bp, $o);
+}
+

wcmtools/s2/S2/NodeUnnecessary.pm

@@ -0,0 +1,46 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeUnnecessary;
+
+use strict;
+use S2::Node;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class) = @_;
+    my $node = new S2::Node;
+    bless $node, $class;
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $n = new S2::NodeUnnecessary;
+    $n->skipWhite($toker);
+    return $n;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    return ! $toker->peek()->isNecessary();
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    # do nothing when making the canonical S2 (the
+    # nodes write their whitespace)
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    # do nothing when making the perl output
+}
+
+sub check {
+    my ($this, $l, $ck) = @_;
+    # nothing can be wrong with whitespace and comments
+}
+

wcmtools/s2/S2/NodeVarDecl.pm

@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeVarDecl;
+
+use strict;
+use S2::Node;
+use S2::NodeNamedType;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class) = @_;
+    my $node = new S2::Node;
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($this, $toker) = @_;
+    return $toker->peek() == $S2::TokenKeyword::VAR;
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $n = new S2::NodeVarDecl;
+    
+    $n->setStart($n->requireToken($toker, $S2::TokenKeyword::VAR));
+    $n->addNode($n->{'nt'} = S2::NodeNamedType->parse($toker));
+    return $n;
+}
+
+sub getType { shift->{'nt'}->getType; }
+sub getName { shift->{'nt'}->getName; }
+
+sub populateScope {
+    my ($this, $nb) = @_;  # NodeStmtBlock
+    my $name = $this->{'nt'}->getName;
+    my $et = $nb->getLocalVar($name);
+    S2::error("Can't mask local variable '$name'") if $et;
+    $nb->addLocalVar($name, $this->{'nt'}->getType());
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $o->write("var ");
+    $this->{'nt'}->asS2($o);
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    $o->write("my \$" . $this->{'nt'}->getName());
+}
+
+

wcmtools/s2/S2/NodeVarDeclStmt.pm

@@ -0,0 +1,94 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeVarDeclStmt;
+
+use strict;
+use S2::Node;
+use S2::NodeVarDecl;
+use S2::NodeExpr;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class) = @_;
+    my $node = new S2::Node;
+    bless $node, $class;
+}
+
+sub canStart {
+    my ($this, $toker) = @_;
+    return S2::NodeVarDecl->canStart($toker);
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+    my $n = new S2::NodeVarDeclStmt;
+    
+    $n->addNode($n->{'nvd'} = S2::NodeVarDecl->parse($toker));
+    if ($toker->peek() == $S2::TokenPunct::ASSIGN) {
+        $n->eatToken($toker);
+        $n->addNode($n->{'expr'} = S2::NodeExpr->parse($toker));
+    }
+    $n->requireToken($toker, $S2::TokenPunct::SCOLON);
+    return $n;
+}
+
+sub check {
+    my ($this, $l, $ck) = @_;
+
+    $this->{'nvd'}->populateScope($ck->getLocalScope());
+
+    # check that the variable type is a known class
+    my $t = $this->{'nvd'}->getType();
+    my $bt = $t->baseType();
+
+    S2::error($this, "Unknown type or class '$bt'") 
+        unless S2::Type::isPrimitive($bt) || $ck->getClass($bt);
+
+    my $vname = $this->{'nvd'}->getName();
+
+    if ($this->{'expr'}) {
+        my $et = $this->{'expr'}->getType($ck, $t);
+        S2::error($this, "Can't initialize variable '$vname' " .
+                  "of type " . $t->toString . " with expression of type " .
+                  $et->toString())
+            unless $ck->typeIsa($et, $t);
+    }
+
+    S2::error($this, "Reserved variable name") if $vname eq "_ctx";
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    $o->tabwrite("");
+    $this->{'nvd'}->asS2($o);
+    if ($this->{'expr'}) {
+        $o->write(" = ");
+        $this->{'expr'}->asS2($o);
+    }
+    $o->writeln(";");
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    $o->tabwrite("");
+    $this->{'nvd'}->asPerl($bp, $o);
+    if ($this->{'expr'}) {
+        $o->write(" = ");
+        $this->{'expr'}->asPerl($bp, $o);
+    } else {
+        my $t = $this->{'nvd'}->getType();
+        if ($t->equals($S2::Type::STRING)) {
+            $o->write(" = \"\"");
+        } elsif ($t->equals($S2::Type::BOOL) ||
+                 $t->equals($S2::Type::INT)) {
+            $o->write(" = 0");
+        }
+    }
+    $o->writeln(";");
+}
+
+

wcmtools/s2/S2/NodeVarRef.pm

@@ -0,0 +1,301 @@
+#!/usr/bin/perl
+#
+
+package S2::NodeVarRef;
+
+use strict;
+use S2::Node;
+use S2::NodeExpr;
+use S2::Type;
+use vars qw($VERSION @ISA $LOCAL $OBJECT $PROPERTY);
+
+$LOCAL = 1;
+$OBJECT = 2;
+$PROPERTY = 3;
+$VERSION = '1.0';
+@ISA = qw(S2::Node);
+
+sub new {
+    my ($class) = @_;
+    my $n = new S2::Node;
+    bless $n, $class;
+}
+
+sub canStart {
+    my ($class, $toker) = @_;
+    return $toker->peek() == $S2::TokenPunct::DOLLAR;
+}
+
+sub parse {
+    my ($class, $toker) = @_;
+
+    my $n = new S2::NodeVarRef();
+    $n->{'levels'} = [];
+    $n->{'type'} = $LOCAL;
+
+    # voo-doo so tokenizer won't continue parsing a string
+    # if we're in a string and trying to parse interesting things
+    # involved in a VarRef:
+    
+    $n->setStart($n->requireToken($toker, $S2::TokenPunct::DOLLAR, 0));
+
+    $toker->pushInString(0);  # pretend we're not, even if we are.
+	
+    if ($toker->peekChar() eq "{") {
+        $n->requireToken($toker, $S2::TokenPunct::LBRACE, 0);
+        $n->{'braced'} = 1;
+    } else {
+        $n->{'braced'} = 0;
+    }
+
+    if ($toker->peekChar() eq ".") {
+        $n->requireToken($toker, $S2::TokenPunct::DOT, 0);
+        $n->{'type'} = $OBJECT;
+    } elsif ($toker->peekChar() eq "*") {
+        $n->requireToken($toker, $S2::TokenPunct::MULT, 0);
+        $n->{'type'} = $PROPERTY;
+    } 
+
+    my $requireDot = 0;
+	
+    # only peeking at characters, not tokens, otherwise
+    # we could force tokens could be created in the wrong 
+    # context.  
+    while ($toker->peekChar() =~ /[a-zA-Z\_\.]/)
+    {
+        if ($requireDot) {
+            $n->requireToken($toker, $S2::TokenPunct::DOT, 0);
+        } else {
+            $requireDot = 1;
+        }
+        
+        my $ident = $n->getIdent($toker, 1, 0);
+
+        my $vl = {
+            'var' => $ident->getIdent(),
+            'derefs' => [],
+        };
+
+        # more preventing of token peeking:
+        while ($toker->peekChar() eq '[' ||
+               $toker->peekChar() eq '{') 
+        {
+            my $dr = {}; # Deref, 'type', 'expr'
+            my $t = $n->eatToken($toker, 0);
+		
+            if ($t == $S2::TokenPunct::LBRACK) {
+                $dr->{'type'} = '[';
+                $n->addNode($dr->{'expr'} = S2::NodeExpr->parse($toker));
+                $n->requireToken($toker, $S2::TokenPunct::RBRACK, 0);
+            } elsif ($t == $S2::TokenPunct::LBRACE) {
+                $dr->{'type'} = '{';
+                $n->addNode($dr->{'expr'} = S2::NodeExpr->parse($toker));
+                $n->requireToken($toker, $S2::TokenPunct::RBRACE, 0);
+            } else {
+                die;
+            }
+            
+            push @{$vl->{'derefs'}}, $dr;
+        }
+        
+        push @{$n->{'levels'}}, $vl;
+    } # end while
+
+    # did we parse just $ ?
+    S2::error($n, "Malformed variable reference") unless
+        @{$n->{'levels'}};    
+
+    if ($n->{'braced'}) {
+        # false argument necessary to prevent peeking at token
+        # stream while it's in the interpolated variable parsing state,
+        # else the string text following the variable would be
+        # treated as if it were outside the string.
+        $n->requireToken($toker, $S2::TokenPunct::RBRACE, 0);
+    }
+
+    $toker->popInString();  # back to being in a string if we were
+    
+    # now we must skip white space that requireToken above would've
+    # done had we not told it not to, but not if the main tokenizer
+    # is in a quoted string
+    if ($toker->{'inString'} == 0) {
+        $n->skipWhite($toker);
+    }
+    return $n;
+}
+
+# if told by NodeTerm.java, add another varlevel to point to
+# this object's $.as_string
+sub useAsString {
+    my $this = shift;
+    push @{$this->{'levels'}}, {
+        'var' => 'as_string',
+        'derefs' => [],
+    };
+}
+
+sub isHashElement {
+    my $this = 0;
+
+    return 0 unless @{$this->{'levels'}};
+    my $l = $this->{'levels'}->[-1];
+    return 0 unless @$l;
+    my $d = $l->[-1];
+    return $d->{'type'} eq "{";
+}
+
+sub getType {
+    my ($this, $ck, $wanted) = @_;
+
+    if (defined $wanted) {
+        my $t = getType($this, $ck);
+        return $t unless
+            $wanted->equals($S2::Type::STRING);
+        my $type = $t->toString();
+        if ($ck->classHasAsString($type)) {
+            $this->{'useAsString'} = 1;
+            return $S2::Type::STRING;
+        }
+    }
+
+    # must have at least reference something.
+    return undef unless @{$this->{'levels'}};
+
+    my @levs = @{$this->{'levels'}};
+    my $lev = shift @levs;  # VarLevel
+    my $vart = undef;  # Type
+
+    # properties
+    if ($this->{'type'} == $PROPERTY) {
+        $vart = $ck->propertyType($lev->{'var'});
+        S2::error($this, "Unknown property") unless $vart;
+        $vart = $vart->clone();
+    }
+
+    # local variables.
+    if ($this->{'type'} == $LOCAL) {
+        $vart = $ck->localType($lev->{'var'});
+        S2::error($this, "Unknown local variable \$$lev->{'var'}") unless $vart;
+    }
+
+    # properties & locals
+    if ($this->{'type'} == $PROPERTY ||
+        $this->{'type'} == $LOCAL) 
+    {
+        $vart = $vart->clone();
+        
+        # dereference [] and {} stuff
+        $this->doDerefs($ck, $lev->{'derefs'}, $vart);
+        
+        # if no more levels, return now.  otherwise deferencing
+        # happens below.
+        return $vart unless @levs;
+        $lev = shift @levs;
+    }
+     
+    # initialize the name of the current object
+    if ($this->{'type'} == $OBJECT) {
+        my $curclass = $ck->getCurrentFunctionClass();
+        S2::error($this, "Can't reference member variable in non-class function") unless $curclass;
+        $vart = new S2::Type($curclass);
+    }
+        
+    while ($lev) {
+        my $nc = $ck->getClass($vart->toString());
+        S2::error($this, "Can't use members of an undefined class") unless $nc;
+        $vart = $nc->getMemberType($lev->{'var'});
+        S2::error($this, "Can't find member '$lev->{'var'}' in " . $nc->getName()) unless $vart;
+        $vart = $vart->clone();
+        
+        # dereference [] and {} stuff 
+        $this->doDerefs($ck, $lev->{'derefs'}, $vart);
+        $lev = shift @levs;
+    }
+    return $vart;
+}
+
+# private
+sub doDerefs {
+    my ($this, $ck, $derefs, $vart) = @_;
+    foreach my $d (@{$derefs}) {
+        my $et = $d->{'expr'}->getType($ck);
+        if ($d->{'type'} eq "{") {
+            S2::error($this, "Can't dereference a non-hash as a hash")
+                unless $vart->isHashOf();
+            S2::error($this, "Must dereference a hash with a string or int")
+                unless ($et->equals($S2::Type::STRING) ||
+                        $et->equals($S2::Type::INT));
+            $vart->removeMod();  # not a hash anymore
+        } elsif ($d->{'type'} eq "[") {
+            S2::error($this, "Can't dereference a non-array as an array ")
+                unless $vart->isArrayOf();
+            S2::error($this, "Must dereference an array with an int")
+                unless $et->equals($S2::Type::INT);
+            $vart->removeMod();  # not an array anymore
+        }
+    }
+}
+
+# is this variable $super ?
+sub isSuper {
+    my ($this) = @_;
+    return 0 if $this->{'type'} != $LOCAL;
+    return 0 if @{$this->{'levels'}} > 1;
+    my $v = $this->{'levels'}->[0];
+    return ($v->{'var'} eq "super" &&
+            @{$v->{'derefs'}} == 0);
+}
+
+sub asS2 {
+    my ($this, $o) = @_;
+    die "Unported";
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_;
+    my $first = 1;
+
+    if ($this->{'type'} == $LOCAL) {
+        $o->write("\$");
+    } elsif ($this->{'type'} == $OBJECT) {
+        $o->write("\$this");
+    } elsif ($this->{'type'} == $PROPERTY) {
+        $o->write("\$_ctx->[PROPS]");
+        $first = 0;
+    }
+
+    foreach my $lev (@{$this->{'levels'}}) {
+        if (! $first || $this->{'type'} == $OBJECT) {
+            $o->write("->{'$lev->{'var'}'}");
+        } else {
+            my $v = $lev->{'var'};
+            if ($first && $this->{'type'} == $LOCAL &&
+                $v eq "super") {
+                $v = "this";
+            }
+            $o->write($v);
+            $first = 0;
+        }
+
+        foreach my $d (@{$lev->{'derefs'}}) {
+            $o->write("->$d->{'type'}"); # [ or {
+            $d->{'expr'}->asPerl($bp, $o);
+            $o->write($d->{'type'} eq "[" ? "]" : "}");
+        }
+    } # end levels
+
+    if ($this->{'useAsString'}) {
+        $o->write("->{'as_string'}");
+    }
+}
+
+sub isProperty {
+    my $this = shift;
+    return $this->{'type'} == $PROPERTY;
+}
+
+sub propName {
+    my $this = shift;
+    return "" unless $this->{'type'} == $PROPERTY;
+    return $this->{'levels'}->[0]->{'var'};
+}

wcmtools/s2/S2/OutputConsole.pm

@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+#
+
+package S2::OutputConsole;
+
+use strict;
+
+sub new {
+    my $class = shift;
+    my $this = {};
+    bless $this, $class;
+}
+
+sub write {
+    print $_[1];
+}
+
+sub writeln {
+    print $_[1], "\n";
+}
+
+sub newline {
+    print "\n";
+}
+
+sub flush { }
+
+
+1;

wcmtools/s2/S2/OutputScalar.pm

@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+#
+
+package S2::OutputScalar;
+
+use strict;
+
+sub new {
+    my ($class, $scalar) = @_;
+    my $ref = [ $scalar ];
+    bless $ref, $class;
+}
+
+sub write {
+    ${$_[0]->[0]} .= $_[1];
+}
+
+sub writeln {
+    ${$_[0]->[0]} .= $_[1] . "\n";
+}
+
+sub newline {
+    ${$_[0]->[0]} .= "\n";
+}
+
+sub flush { }
+
+
+1;

wcmtools/s2/S2/Token.pm

@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+#
+
+package S2::Token;
+
+use strict;
+
+sub getFilePos {
+    return $_[0]->{'pos'};
+}
+
+sub isNecessary { 1; }
+
+sub toString {
+    die "Abstract! " . Data::Dumper::Dumper(@_);
+}
+
+sub asHTML {
+    my $this = shift;
+    die "No asHTML defined for " . ref $this;
+}
+
+sub asS2 {
+    my ($this, $o) = @_; # Indenter o
+    $o->write("##Token::asS2##");
+}
+
+sub asPerl {
+    my ($this, $bp, $o) = @_; # BackendPerl bp, Indenter o
+    $o->write("##Token::asPerl##");
+}
+
+
+
+
+1;

wcmtools/s2/S2/TokenComment.pm

@@ -0,0 +1,40 @@
+#!/usr/bin/perl
+#
+
+package S2::TokenComment;
+
+use strict;
+use S2::Token;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Token);
+
+sub new
+{
+    my ($class, $com) = @_;
+    bless {
+        'chars' => $com,
+    }, $class;
+}
+
+sub getComment
+{
+    shift->{'chars'};
+}
+
+sub toString
+{
+    "[TokenComment]";
+}
+
+sub isNecessary { return 0; }
+
+sub asHTML
+{
+    my ($this, $o) = @_;
+    $o->write("<span class=\"c\">" . S2::BackendHTML::quoteHTML($this->{'chars'}) . "</span>");
+}
+
+1;
+

wcmtools/s2/S2/TokenIdent.pm

@@ -0,0 +1,57 @@
+#!/usr/bin/perl
+#
+
+package S2::TokenIdent;
+
+use strict;
+use S2::Token;
+use S2::TokenKeyword;
+use vars qw($VERSION @ISA $DEFAULT $TYPE $STRING);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Token);
+
+# numeric values for $this->{'type'}
+$DEFAULT = 0;
+$TYPE    = 1;
+$STRING  = 2;
+
+sub new 
+{
+    my ($class, $ident) = @_;
+    my $kwtok = S2::TokenKeyword->tokenFromString($ident);
+    return $kwtok if $kwtok;
+    bless {
+        'chars' => $ident,
+    }, $class;
+}
+
+sub getIdent {
+    shift->{'chars'};
+}
+
+sub toString {
+    my $this = shift;
+    "[TokenIdent] = $this->{'chars'}";
+}
+
+sub setType {
+    my ($this, $type) = @_;
+    $this->{'type'} = $type;
+}
+
+sub asHTML {
+    my ($this, $o) = @_;
+    my $ident = $this->{'chars'};
+    # FIXME: TODO: Don't hardcode internal types, intelligently recognise
+    #              places where types and class references occur and
+    #              make them class="t"
+    if ($ident =~ /^(int|string|void|bool)$/) {
+        $o->write("<span class=\"t\">$ident</span>");
+    } else {
+        $o->write("<span class=\"i\">$ident</span>");
+    }
+}
+
+1;
+

wcmtools/s2/S2/TokenIntegerLiteral.pm

@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+#
+
+package S2::TokenIntegerLiteral;
+
+use strict;
+use S2::Token;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Token);
+
+sub new
+{
+    my ($class, $val) = @_;
+    bless {
+        'chars' => $val+0,
+    };
+}
+
+sub getInteger
+{
+    my $this = shift;
+    $this->{'chars'};
+}
+
+sub asS2
+{
+    my ($this, $o) = @_;
+    $o->write($this->{'chars'});
+}
+
+sub asHTML
+{
+    my ($this, $o) = @_;
+    $o->write("<span class=\"n\">$this->{'chars'}</span>");
+}
+
+sub asPerl
+{
+    my ($this, $bp, $o) = @_;
+    $o->write($this->{'chars'});
+}
+
+sub toString
+{
+    my $this = shift;
+    "[TokenIntegerLiteral] = $this->{'chars'}";
+}
+
+
+1;
+

wcmtools/s2/S2/TokenKeyword.pm

@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+#
+
+package S2::TokenKeyword;
+
+use strict;
+use S2::Token;
+use vars qw($VERSION @ISA %keywords);
+
+$VERSION = '1.0';
+@ISA = qw(S2::TokenIdent);
+
+%keywords = ();
+foreach my $kw (qw(class else elseif function if builtin
+                   property propgroup set static var while foreach print
+                   println not and or xor layerinfo extends
+                   return delete defined new true false reverse
+                   size isnull null readonly)) {
+    my $uc = uc($kw);
+    eval "use vars qw(\$$uc); \$keywords{\"$kw\"} = \$$uc = S2::TokenKeyword->new(\"$kw\");";
+}
+
+sub new
+{
+    my ($class, $ident) = @_;
+    bless {
+        'chars' => $ident,
+    }, $class;
+}
+
+sub tokenFromString
+{
+    my ($class, $ident) = @_;
+    return $keywords{$ident};
+}
+
+sub toString
+{
+    my $this = shift;
+    "[TokenKeyword] = $this->{'chars'}";
+}
+
+sub asHTML
+{
+    my ($this, $o) = @_;
+    $o->write("<span class=\"k\">$this->{'chars'}</span>");
+}
+
+1;
+

wcmtools/s2/S2/TokenPunct.pm

@@ -0,0 +1,90 @@
+#!/usr/bin/perl
+#
+
+package S2::TokenPunct;
+
+use strict;
+use S2::Token;
+use vars qw($VERSION @ISA
+            $LT $LTE $GTE $GT $EQ $NE $ASSIGN $INCR $PLUS
+            $DEC $MINUS $DEREF $SCOLON $COLON $DCOLON $LOGAND
+            $BITAND $LOGOR $BITOR $MULT $DIV $MOD $NOT $DOT
+            $DOTDOT $LBRACE $RBRACE $LBRACK $RBRACK $LPAREN
+            $RPAREN $COMMA $QMARK $DOLLAR $HASSOC
+            %finals
+            );
+
+$VERSION = '1.0';
+@ISA = qw(S2::Token);
+
+$LTE    = new S2::TokenPunct '<=', 1;
+$LT     = new S2::TokenPunct '<', 1;
+$GTE    = new S2::TokenPunct '>=', 1;
+$GT     = new S2::TokenPunct '>', 1;
+$EQ     = new S2::TokenPunct "==", 1;
+$HASSOC = new S2::TokenPunct "=>", 1;
+$ASSIGN = new S2::TokenPunct "=", 1;
+$NE     = new S2::TokenPunct "!=", 1;
+$INCR   = new S2::TokenPunct "++", 1;
+$PLUS   = new S2::TokenPunct "+", 1;
+$DEC    = new S2::TokenPunct "--", 1;
+$MINUS  = new S2::TokenPunct "-", 1;
+$DEREF  = new S2::TokenPunct "->", 1;
+$SCOLON = new S2::TokenPunct ";", 1;
+$DCOLON = new S2::TokenPunct "::", 1;
+$COLON  = new S2::TokenPunct ":", 1;
+$LOGAND = new S2::TokenPunct "&&", 1;
+$BITAND = new S2::TokenPunct "&", 1;
+$LOGOR  = new S2::TokenPunct "||", 1;
+$BITOR  = new S2::TokenPunct "|", 1;
+$MULT   = new S2::TokenPunct "*", 1;
+$DIV    = new S2::TokenPunct "/", 1;
+$MOD    = new S2::TokenPunct "%", 1;
+$NOT    = new S2::TokenPunct "!", 1;
+$DOT    = new S2::TokenPunct ".", 1;
+$DOTDOT = new S2::TokenPunct "..", 1;
+$LBRACE = new S2::TokenPunct "{", 1;
+$RBRACE = new S2::TokenPunct "}", 1;
+$LBRACK = new S2::TokenPunct "[", 1;
+$RBRACK = new S2::TokenPunct "]", 1;
+$LPAREN = new S2::TokenPunct "(", 1;
+$RPAREN = new S2::TokenPunct ")", 1;
+$COMMA  = new S2::TokenPunct ",", 1;
+$QMARK  = new S2::TokenPunct "?", 1;
+$DOLLAR = new S2::TokenPunct '$', 1;
+
+sub new
+{
+    my ($class, $punct, $final) = @_;
+    return $finals{$punct} if defined $finals{$punct};
+    my $this = { 'chars' => $punct };
+    $finals{$punct} = $this if $final;
+    bless $this, $class;
+}
+
+sub getPunct { shift->{'chars'}; }
+
+sub asHTML
+{
+    my ($this, $o) = @_;
+    if ($this->{'chars'} =~ m![\[\]\(\)\{\}]!) {
+        $o->write("<span class=\"b\">$this->{'chars'}</span>");
+    } else {
+        $o->write("<span class=\"p\">" . S2::BackendHTML::quoteHTML($this->{'chars'}) . "</span>");
+    }
+}
+
+sub asS2
+{
+    my ($this, $o) = @_;
+    $o->write($this->{'chars'});
+}
+
+sub toString
+{
+    my $this = shift;
+    "[TokenPunct] = $this->{'chars'}";
+}
+
+1;
+

wcmtools/s2/S2/TokenStringLiteral.pm

@@ -0,0 +1,201 @@
+#!/usr/bin/perl
+#
+
+package S2::TokenStringLiteral;
+
+use strict;
+use S2::Token;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Token);
+
+#    int quotesLeft;
+#    int quotesRight;
+#    String text;
+#    String source;
+
+sub new
+{
+    my $class = shift;
+    my ($text, $source, $ql, $qr);
+    if (@_ == 1) {
+        $text = shift;
+        ($ql, $qr) = (1, 1);
+        $source = $text;
+    } elsif (@_ == 3) {
+        ($text, $ql, $qr) = @_;
+        $source = $text;
+    } elsif (@_ == 4) {
+        ($text, $source, $ql, $qr) = @_;
+        unless (defined $text) {
+            $text = $source;
+            $text =~ s/\\n/\n/g;
+            $text =~ s/\\\"/\"/g;
+            $text =~ s/\\\$/\$/g;
+            $text =~ s/\\\\/\\/g;
+        }
+    } else {
+        die;
+    }
+    
+    bless {
+        'text' => $text,
+        'chars' => $source,
+        'quotesLeft' => $ql,
+        'quotesRight' => $qr,
+    }, $class;
+}
+
+sub getQuotesLeft { shift->{'quotesLeft'}; }
+sub getQuotesRight { shift->{'quotesRight'}; }
+sub setQuotesLeft { my $this = shift; $this->{'quotesLeft'} = shift; }
+sub setQuotesRight { my $this = shift; $this->{'quotesRight'} = shift; }
+
+sub clone {
+    my $this = shift;
+    return S2::TokenStringLiteral->new($this->{'text'},
+                                       $this->{'chars'},
+                                       $this->{'quotesLeft'},
+                                       $this->{'quotesRight'});
+}
+
+sub getString
+{
+    shift->{'text'};
+}
+
+sub toString
+{
+    my $this = shift;
+    my $buf = "[TokenStringLiteral] = ";
+    if ($this->{'quotesLeft'} == 0) { $buf .= "("; }
+    elsif ($this->{'quotesLeft'} == 1) { $buf .= "<"; }
+    elsif ($this->{'quotesLeft'} == 3) { $buf .= "<<"; }
+    else { die; }
+    $buf .= $this->{'text'};
+    if ($this->{'quotesRight'} == 0) { $buf .= ")"; }
+    elsif ($this->{'quotesRight'} == 1) { $buf .= ">"; }
+    elsif ($this->{'quotesRight'} == 3) { $buf .= ">>"; }
+    else { die; }
+    return $buf;
+}
+
+sub asHTML
+{
+    my ($this, $o) = @_;
+    my $ret;
+    $ret .= makeQuotes($this->{'quotesLeft'});
+    $ret .= $this->{'chars'};
+    $ret .= makeQuotes($this->{'quotesRight'});
+    $o->write("<span class=\"s\">" . S2::BackendHTML::quoteHTML($ret) . "</span>");
+}
+
+sub scan
+{
+    my ($class, $t) = @_;
+
+    my $inTriple = 0;
+    my $continued = 0;
+    my $pos = $t->getPos();
+
+    if ($t->{'inString'} == 0) {
+        # see if this is a triple quoted string,
+        # like python.  if so, don't need to escape quotes
+        $t->getRealChar();                # 1
+        if ($t->peekChar() eq '"') {
+            $t->getChar();                # 2
+            if ($t->peekChar() eq '"') {
+                $t->getChar();            # 3
+                $inTriple = 1;
+            } else {
+                $t->{'inString'} = 0;
+                return S2::TokenStringLiteral->new("", 1, 1);
+            }
+        }
+    } elsif ($t->{'inString'} == 3) {
+        $continued = 1;
+        $inTriple = 1;
+    } elsif ($t->{'inString'} == 1) {
+        $continued = 1;
+    }
+    
+    my $tbuf;  # text buffer (escaped)
+    my $sbuf;  # source buffer
+    
+    while (1) {
+        my $peekchar = $t->peekChar();
+        if (! defined $peekchar) {
+            die "Run-away string.  Check for unbalanced quotes on string literals.\n";
+        } elsif ($peekchar eq '"') {
+            if (! $inTriple) {
+                $t->getChar();
+                $t->{'inString'} = 0;
+                return S2::TokenStringLiteral->new($tbuf, $sbuf, $continued ? 0 : 1, 1);
+            } else {
+                $t->getChar();                    # 1
+                if ($t->peekChar() eq '"') {
+                    $t->getChar();                # 2
+                    if ($t->peekChar() eq '"') {
+                        $t->getChar();            # 3
+                        $t->{'inString'} = 0;
+                        return S2::TokenStringLiteral->new($tbuf, $sbuf, $continued ? 0 : 3, 3);
+                    } else {
+                        $tbuf .= '""';
+                        $sbuf .= '""';
+                    }
+                } else {
+                    $tbuf .= '"';
+                    $sbuf .= '"';
+                }
+            }
+        } else {
+            if ($t->peekChar() eq '$') {
+                $t->{'inString'} = $inTriple ? 3 : 1;
+                return S2::TokenStringLiteral->new($tbuf, $sbuf,
+                           $continued ? 0 : ($inTriple ? 3 : 1),
+                           0);
+            }
+            
+            if ($t->peekChar() eq "\\") {
+                $sbuf .= $t->getRealChar(); # skip the backslash.  next thing will be literal.
+                $sbuf .= $t->peekChar();
+                if ($t->peekChar() eq 'n') {
+                    $t->forceNextChar("\n");
+                }
+                $tbuf .= $t->getRealChar();
+            } else {
+                my $c = $t->getRealChar();
+                $tbuf .= $c;
+                $sbuf .= $c;
+            }
+        }
+    }
+}
+
+sub asS2
+{
+    my ($this, $o) = @_;
+    $o->write(makesQuote($this->{'quotesLeft'}));
+    $o->write(S2::Backend::quoteStringInner($this->{'text'}));
+    $o->write(makesQuote($this->{'quotesRight'}));
+}
+
+sub asPerl
+{
+    my ($this, $bp, $o) = @_;
+    $o->write($bp->quoteString($this->{'text'}));
+}
+
+sub makeQuotes
+{
+    my $i = shift;
+    return "" if $i == 0;
+    return "\"" if $i == 1;
+    return "\"\"\"" if $i == 3;
+    return "XXX";
+}
+                
+
+1;
+

wcmtools/s2/S2/TokenWhitespace.pm

@@ -0,0 +1,38 @@
+#!/usr/bin/perl
+#
+
+package S2::TokenWhitespace;
+
+use strict;
+use S2::Token;
+use vars qw($VERSION @ISA);
+
+$VERSION = '1.0';
+@ISA = qw(S2::Token);
+
+sub new {
+    my ($class, $ws) = @_;
+    my $this = {
+        'chars' => $ws,
+    };
+    bless $this, $class;
+}
+
+sub isNecessary { 0; }
+
+sub getWhiteSpace { 
+    my $this = shift;
+    $this->{'chars'};
+}
+
+sub toString {
+    return "[TokenWhitespace]";
+}
+
+sub asHTML {
+    my ($this, $o) = @_;
+    $o->write($this->{'chars'});
+}
+
+1;
+

wcmtools/s2/S2/Tokenizer.pm

@@ -0,0 +1,189 @@
+#!/usr/bin/perl
+#
+
+use strict;
+use S2::FilePos;
+use S2::TokenPunct;
+use S2::TokenWhitespace;
+use S2::TokenIdent;
+use S2::TokenIntegerLiteral;
+use S2::TokenPunct;
+use S2::TokenComment;
+use S2::TokenStringLiteral;
+
+package S2::Tokenizer;
+
+sub new # (fh) class method
+{
+    my ($class, $content) = @_;
+
+    my $this = {};
+    bless $this, $class;
+    
+    if (ref $content eq "SCALAR") {
+        $this->{'content'} = $content;
+        $this->{'length'} = length $$content;
+    }
+    $this->{'pos'} = 0;
+    $this->{'line'} = 1;
+    $this->{'col'} = 1;
+    $this->{'inString'} = 0;  # (accessed directly elsewhere)
+    $this->{'inStringStack'} = [];
+    $this->{'peekedToken'} = undef;
+    return $this;
+}
+
+sub pushInString {
+    my ($this, $val) = @_;
+    push @{$this->{'inStringStack'}}, $this->{'inString'};
+    $this->{'inString'} = $val;
+    #print STDERR "PUSH: $val Stack: @{$this->{'inStringStack'}}\n";
+}
+
+sub popInString {
+    my ($this) = @_;
+    my $was = $this->{'inString'};
+    $this->{'inString'} = pop @{$this->{'inStringStack'}};
+    #print STDERR "POP: $this->{'inString'} Stack: @{$this->{'inStringStack'}}\n";
+    if ($was != $this->{'inString'} && $this->{'peekedToken'}) {
+        # back tokenizer up and discard our peeked token
+        pos(${$this->{'content'}}) = $this->{'peekedToken'}->{'pos_re'};
+        $this->{'peekedToken'} = undef;
+    }
+}
+
+sub peek # () method : Token
+{
+    $_[0]->{'peekedToken'} ||= $_[0]->getToken(1);
+}
+
+sub getToken # () method : Token
+{
+    my ($this, $just_peek) = @_;
+
+    # return peeked token if we have one
+    if (my $t = $this->{'peekedToken'}) {
+        $this->{'peekedToken'} = undef;
+        $this->moveLineCol($t) unless $just_peek;
+        return $t;
+    }
+
+    my $pos = $this->getPos();
+    my $pos_re = pos(${$this->{'content'}});
+    my $nxtoken = $this->makeToken();
+    if ($nxtoken) {
+        $nxtoken->{'pos'} = $pos;
+        $nxtoken->{'pos_re'} = $pos_re;
+        $this->moveLineCol($nxtoken) unless $just_peek;
+    }
+#    print STDERR "Token: ", $nxtoken->toString, "\n";
+    return $nxtoken;
+}
+
+sub getPos # () method : FilePos
+{
+    return new S2::FilePos($_[0]->{'line'},
+                           $_[0]->{'col'});
+}
+
+sub moveLineCol {
+    my ($this, $t) = @_;
+    if (my $newlines = ($t->{'chars'} =~ tr/\n/\n/)) {
+#        print STDERR "Chars: $t [$t->{'chars'}] Lines: $newlines\n";
+        $this->{'line'} += $newlines;
+        $t->{'chars'} =~ /\n(.+)$/m;
+        $this->{'col'} = 1 + length $1;
+    } else {
+#        print STDERR "Chars: $t [$t->{'chars'}]\n";
+        $this->{'col'} += length $t->{'chars'};
+    }
+}
+
+sub makeToken # () method private : Token
+{
+    my $this = shift;
+    my $c = $this->{'content'};
+
+    # finishing or trying to finish an open quoted string
+    if ($this->{'inString'} == 1 &&
+        $$c =~ /\G((\\[\\\"\$]|[^\"\$])*)(\")?/sgc) {
+        my $source = $1;
+        my $closed = $3 ? 1 : 0;
+        return S2::TokenStringLiteral->new(undef, $source, 0, $closed);
+    }
+
+    # finishing a triple quoted string
+    if ($this->{'inString'} == 3) {
+        if ($$c =~ /\G((\\[\\\"\$]|[^\$])*?)\"\"\"/sgc) {
+            my $source = $1;
+            return S2::TokenStringLiteral->new(undef, $source, 0, 3);
+        }
+
+        # not finishing a triple quoted string (end in $)
+        if ($$c =~ /\G((\\[\\\"\$]|[^\$])*)/sgc) {
+            my $source = $1;
+            return S2::TokenStringLiteral->new(undef, $source, 0, 0);
+        }
+    }
+
+    # not in a string, but one's starting
+    if ($this->{'inString'} == 0 && $$c =~ /\G\"/gc) {
+        # triple start and triple end
+        if ($$c =~ /\G\"\"((\\[\\\"\$]|[^\$])*?)\"\"\"/gc) {
+            my $source = $1;
+            return S2::TokenStringLiteral->new(undef, $source, 3, 3);
+        }
+        
+        # triple start and variable end
+        if ($$c =~ /\G\"\"((\\[\\\"\$]|[^\$])*)/gc) {
+            my $source = $1;
+            return S2::TokenStringLiteral->new(undef, $source, 3, 0);
+        }
+        
+        # single start and maybe end
+        if ($$c =~ /\G((\\[\\\"\$]|[^\"\$])*)(\")?/gc) {
+            my $source = $1;
+            my $closed = $3 ? 1 : 0;
+            return S2::TokenStringLiteral->new(undef, $source, 1, $closed);
+        }
+    }
+
+    if ($$c =~ /\G\s+/gc) {
+        my $ws = $&;
+        return S2::TokenWhitespace->new($ws);
+    }
+
+    if ($$c =~ /\G(<=?|>=?|==|=>?|!=|\+\+?|->|--?|;|::?|&&?|\|\|?|\*|\/|%|!|\.\.?|\{|\}|\[|\]|\(|\)|,|\?|\$)/gc) {
+        return S2::TokenPunct->new($1);
+    }
+
+    if ($$c =~ /\G[a-zA-Z\_]\w*/gc) {
+        my $ident = $&;
+        return S2::TokenIdent->new($ident);
+    }
+
+    if ($$c =~ /\G(\d+)/gc) {
+        my $iv = $1;
+        return S2::TokenIntegerLiteral->new($iv);
+    }
+    
+    if ($$c =~ /\G\#.*\n?/gc) {
+        return S2::TokenComment->new($&);
+    }
+
+    if ($$c =~ /.+/gc) {
+        S2::error($this->getPos(), "Parse error!  Unknown token.  ($&)");
+    }
+    
+    return undef;
+}
+
+sub peekChar {
+    my $this = shift;
+    my $pos = pos(${$this->{'content'}});
+    my $ch = substr(${$this->{'content'}}, $pos, 1);
+    #print STDERR "pos = $pos, char = $ch\n";
+    return $ch;
+}
+
+1;

wcmtools/s2/S2/Type.pm

@@ -0,0 +1,149 @@
+#!/usr/bin/perl
+#
+
+package S2::Type;
+
+use strict;
+use S2::Node;
+use S2::Type;
+use vars qw($VOID $STRING $INT $BOOL);
+
+$VOID   = new S2::Type("void", 1);
+$STRING = new S2::Type("string", 1);
+$INT    = new S2::Type("int", 1);
+$BOOL   = new S2::Type("bool", 1);
+
+sub new {
+    my ($class, $base, $final) = @_;
+    my $this = {
+        'baseType' => $base,
+        'typeMods' => "",
+    };
+    $this->{'final'} = 1 if $final;
+    bless $this, $class;
+}
+
+sub clone {
+    my $this = shift;
+    my $nt = S2::Type->new($this->{'baseType'});
+    $nt->{'typeMods'} = $this->{'typeMods'};
+    $nt->{'readOnly'} = $this->{'readOnly'};
+    return $nt;
+}
+
+# return true if the type can be interpretted in a boolean context
+sub isBoolable {
+    my $this = shift;
+
+    # everything is boolable but void
+    #    int:  != 0
+    #    bool:  obvious
+    #    string:  != ""
+    #    Object:  defined
+    #    array:  elements > 0
+    #    hash:  elements > 0
+
+    return ! $this->equals($VOID);
+}
+
+sub subTypes {
+    my ($this, $ck) = @_;
+    my $l = [];
+
+    my $nc = $ck->getClass($this->{'baseType'});
+    unless ($nc) {
+        # no sub-classes.  just return our type.
+        push @$l, $this;
+        return $l;
+    }
+
+    foreach my $der (@{$nc->getDerClasses()}) {
+        # add a copy of this type to the list, but with
+        # the derivative class type.  that way it
+        # saves the varlevels:  A[] .. B[] .. C[], etc
+        my $c = $der->{'nc'}->getName();
+        my $newt = $this->clone();
+        $newt->{'baseType'} = $c;
+        push @$l, $newt;
+    }
+
+    return $l;
+}
+
+sub equals {
+    my ($this, $o) = @_;
+    return unless $o->isa('S2::Type');
+    return $o->{'baseType'} eq $this->{'baseType'} &&
+        $o->{'typeMods'} eq $this->{'typeMods'};
+}
+
+sub sameMods {
+    my ($class, $a, $b) = @_;
+    return $a->{'typeMods'} eq $b->{'typeMods'};
+}
+
+sub makeArrayOf {
+    my ($this) = @_;
+    S2::error('', "Internal error") if $this->{'final'};
+    $this->{'typeMods'} .= "[]";
+}
+
+sub makeHashOf {
+    my ($this) = @_;
+    S2::error('', "Internal error") if $this->{'final'};
+    $this->{'typeMods'} .= "{}";
+}
+
+sub removeMod {
+    my ($this) = @_;
+    S2::error('', "Internal error") if $this->{'final'};
+    $this->{'typeMods'} =~ s/..$//;
+}
+
+sub isSimple {
+    my ($this) = @_;
+    return ! length $this->{'typeMods'};
+}
+
+sub isHashOf {
+    my ($this) = @_;
+    return $this->{'typeMods'} =~ /\{\}$/;
+}
+
+sub isArrayOf {
+    my ($this) = @_;
+    return $this->{'typeMods'} =~ /\[\]$/;
+}
+
+sub baseType {
+    shift->{'baseType'};
+}
+
+sub toString {
+    my $this = shift;
+    "$this->{'baseType'}$this->{'typeMods'}";
+}
+
+sub isPrimitive {
+    my $arg = shift;
+    my $t;
+    if (ref $arg) { $t = $arg; }
+    else {
+        $t = S2::Type->new($arg);
+    }
+    return $t->equals($STRING) ||
+        $t->equals($INT) ||
+        $t->equals($BOOL);
+}
+
+sub isReadOnly {
+    shift->{'readOnly'};
+}
+
+sub setReadOnly {
+    my ($this, $v) = @_;
+    S2::error('', "Internal error") if $this->{'final'};
+    $this->{'readOnly'} = $v;
+}
+
+

wcmtools/s2/S2/Util.pm

@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+#
+
+package S2;
+
+sub error {
+    my ($where, $msg) = @_;
+    if (ref $where && ($where->isa('S2::Token') ||
+                       $where->isa('S2::Node'))) {
+        $where = $where->getFilePos();
+    }
+    if (ref $where eq "S2::FilePos") {
+        $where = $where->locationString;
+    }
+
+    my $i = 0;
+    my $errmsg = "$where: $msg\n";
+    while (my ($p, $f, $l) = caller($i++)) {
+        $errmsg .= "  $p, $f, $l\n";
+    }
+    undef $S2::CUR_COMPILER;
+    die $errmsg;
+}
+
+
+1;

wcmtools/s2/danga/s2/Backend.java

@@ -0,0 +1,32 @@
+package danga.s2;
+
+public abstract class Backend {
+    
+    Layer layer;
+
+    public abstract void output (Output o);
+
+    public static String quoteString (String s)
+    {
+	int len = s.length();
+	StringBuffer sb = new StringBuffer(len + 20);
+	sb.append("\"");
+	sb.append(quoteStringInner(s));
+	sb.append("\"");
+	return sb.toString();
+    }
+
+    public static String quoteStringInner (String s)
+    {
+	int len = s.length();
+	StringBuffer sb = new StringBuffer(len + 20);
+	for (int i=0; i<len; i++) {
+	    char c = s.charAt(i);
+	    if (c=='\\' || c=='$' || c=='"') 
+		sb.append('\\');
+	    sb.append(c);
+	}
+	return sb.toString();
+    }
+
+};

wcmtools/s2/danga/s2/BackendHTML.java

@@ -0,0 +1,69 @@
+package danga.s2;
+
+import java.util.LinkedList;
+import java.util.ListIterator;
+
+public class BackendHTML extends Backend {
+
+    public final static boolean addBreaks    = false;
+    public final static String CommentColor  = new String("#008000");
+    public final static String IdentColor    = new String("#000000");
+    public final static String KeywordColor  = new String("#0000FF");
+    public final static String StringColor   = new String("#008080");
+    public final static String PunctColor    = new String("#000000");
+    public final static String BracketColor  = new String("#800080");
+    public final static String TypeColor     = new String("#000080");
+    public final static String VarColor      = new String("#000000");
+    public final static String IntegerColor  = new String("#000000");
+
+    public BackendHTML (Layer l) {
+	layer = l;
+    }
+
+    public void output (Output o) {
+	String layername = (s2compile.topLayerName == null ?
+	                    "untitled layer" :
+	                    s2compile.topLayerName);
+
+        o.write("<html><head><title>Source for "+layername+"</title>\n");
+        o.write("<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\">\n");
+        o.write("<style type=\"text/css\">\n");
+        o.write("body { background: #ffffff none; color: #000000; }\n");
+        o.write(".c { background: #ffffff none; color: "+CommentColor+"; }\n");
+        o.write(".i { background: #ffffff none; color: "+IdentColor+"; }\n");
+        o.write(".k { background: #ffffff none; color: "+KeywordColor+"; }\n");
+        o.write(".s { background: #ffffff none; color: "+StringColor+"; }\n");
+        o.write(".p { background: #ffffff none; color: "+PunctColor+"; }\n");
+        o.write(".b { background: #ffffff none; color: "+BracketColor+"; }\n");
+        o.write(".t { background: #ffffff none; color: "+TypeColor+"; }\n");
+        o.write(".v { background: #ffffff none; color: "+VarColor+"; }\n");
+        o.write(".n { background: #ffffff none; color: "+IntegerColor+"; }\n");
+	o.write("</style></head>\n<body>\n<pre>");
+	LinkedList nodes = layer.getNodes();
+	ListIterator li = nodes.listIterator();
+	while (li.hasNext()) {
+	    Node n = (Node) li.next();
+	    n.asHTML(o);
+	}
+	o.write("</pre></body></html>"); o.newline();
+    }
+
+    public static String quoteHTML (String s)
+    {
+	int len = s.length();
+	StringBuffer sb = new StringBuffer(len + len / 10);
+	for (int i=0; i<len; i++) {
+	    char c = s.charAt(i);
+	    if (c=='<')
+		sb.append("&lt;");
+	    else if (c=='>')
+		sb.append("&gt;");
+	    else if (c=='&')
+		sb.append("&amp;");
+	    else
+		sb.append(c);
+	}
+	return sb.toString();
+    }
+
+};

wcmtools/s2/danga/s2/BackendPerl.java

@@ -0,0 +1,67 @@
+package danga.s2;
+
+import java.util.LinkedList;
+import java.util.ListIterator;
+
+public class BackendPerl extends Backend {
+    
+    int layerID;
+
+    public BackendPerl (Layer l, int layerID) {
+	layer = l;
+	this.layerID = layerID;
+    }
+
+    public int getLayerID () { return layerID; }
+    public String getLayerIDString () { 
+	return (new Integer(layerID)).toString(); 
+    }
+    
+    public void output (Output o) {
+	Indenter io = new Indenter(o, 4);
+	io.writeln("#!/usr/bin/perl");
+	io.writeln("# auto-generated Perl code from input S2 code"); 
+	io.writeln("package S2;");
+	io.writeln("use strict;");
+	io.writeln("use constant VTABLE => 0;");
+	io.writeln("use constant STATIC => 1;");
+	io.writeln("use constant PROPS => 2;");
+	io.writeln("register_layer("+layerID+");");
+	LinkedList nodes = layer.getNodes();
+	ListIterator li = nodes.listIterator();
+	while (li.hasNext()) {
+	    Node n = (Node) li.next();
+	    n.asPerl(this, io);
+	}
+	io.writeln("1;");
+	io.writeln("# end.");
+    }
+
+    public static String quoteString (String s)
+    {
+	int len = s.length();
+	StringBuffer sb = new StringBuffer(len + 20);
+	sb.append("\"");
+	sb.append(quoteStringInner(s));
+	sb.append("\"");
+	return sb.toString();
+    }
+
+    public static String quoteStringInner (String s)
+    {
+	int len = s.length();
+	StringBuffer sb = new StringBuffer(len + 20);
+	for (int i=0; i<len; i++) {
+	    char c = s.charAt(i);
+	    if (c=='\n') {
+		sb.append("\\n");
+	    } else {
+		if (c=='\\' || c=='$' || c=='"' || c=='@') 
+		    sb.append('\\');
+		sb.append(c);
+	    }
+	}
+	return sb.toString();
+    }
+
+};

wcmtools/s2/danga/s2/BackendS2.java

@@ -0,0 +1,29 @@
+package danga.s2;
+
+import java.util.LinkedList;
+import java.util.ListIterator;
+
+public class BackendS2 extends Backend {
+
+    private final static boolean MANY_QUOTES = false;
+    
+    public BackendS2 (Layer l) {
+	layer = l;
+    }
+    
+    public void output (Output o) 
+    {
+	Indenter io = new Indenter(o, 4);
+	io.writeln("# auto-generated S2 code from input S2 code"); 
+	LinkedList nodes = layer.getNodes();
+	ListIterator li = nodes.listIterator();
+	while (li.hasNext()) {
+	    Node n = (Node) li.next();
+	    n.asS2(io);
+	}
+    }
+
+    public static void LParen (Indenter o) { if (MANY_QUOTES) o.write("("); }
+    public static void RParen (Indenter o) { if (MANY_QUOTES) o.write(")"); }
+
+};

wcmtools/s2/danga/s2/BufferedIndenter.java

@@ -0,0 +1,19 @@
+package danga.s2;
+
+// NOTE: wrote this, used it for awhile, then decided not to use it.
+//       it works, but it'll probably bit rot.
+
+public class BufferedIndenter extends Indenter
+{
+    public BufferedIndenter (Indenter i) {
+	depth = i.depth;
+	tabsize = i.tabsize;
+	makeSpaces();
+	o = new OutputStringBuffer();
+    }
+
+    public void writeTo (Indenter i) {
+	OutputStringBuffer osb = (OutputStringBuffer) o;
+	osb.writeTo(i);
+    }
+}

wcmtools/s2/danga/s2/Checker.java

@@ -0,0 +1,367 @@
+package danga.s2;
+
+import java.util.Hashtable;
+import java.util.ListIterator;
+import java.util.LinkedList;
+import java.util.Set;
+import java.util.Collections;
+import java.util.TreeSet;
+import java.util.Iterator;
+
+public class Checker
+{
+    // combined (all layers)
+    private Hashtable classes;      // class name    -> NodeClass
+    private Hashtable props;        // property name -> Type
+    private Hashtable funcs;        // FuncID -> return type
+    private Hashtable funcBuiltin;  // FuncID -> Boolean (is builtin)
+    private LinkedList localblocks; // NodeStmtBlock scopes .. last is deepest (closest)
+    private Type returnType;
+    private String funcClass;       // current function class
+    private Hashtable derclass;     // classname  -> LinkedList<classname>
+    private boolean inFunction;     // checking in a function now?
+
+    // per-layer
+    private Hashtable funcDist;     // FuncID -> [ distance, NodeFunction ]
+    private Hashtable funcIDs;      // NodeFunction -> Set<FuncID>
+    private boolean hitFunction;    // true once a function has been declared/defined
+
+    // per function
+    private int funcNum = 0;
+    private Hashtable funcNums;     // FuncID -> Integer(funcnum)
+    private LinkedList funcNames;   // Strings
+    
+    public Checker ()
+    {
+	classes = new Hashtable();
+	props = new Hashtable();
+	funcs = new Hashtable();
+	funcBuiltin = new Hashtable();
+	derclass = new Hashtable();
+	localblocks = new LinkedList();
+    }
+    
+    // class functions
+    public void addClass (String name, NodeClass nc) {
+	classes.put(name, nc);
+	
+	// make sure that the list of classes that derive from this
+	// one exists.
+	if (derclass.get(name) == null) {
+	    derclass.put(name, new LinkedList());
+	}
+
+	// and if this class derives from another, add ourselves
+	// to that list.
+	String parent = nc.getParentName();
+	if (parent != null) {
+	    LinkedList l = (LinkedList) derclass.get(parent);
+	    l.add(name);
+	}
+    }
+    public NodeClass getClass (String name) {
+        if (name == null) return null;
+	return (NodeClass) classes.get(name);
+    }
+
+    public String getParentClassName (String name) {
+        NodeClass nc = getClass(name);
+        if (nc == null) return null;
+        return nc.getParentName();
+    }
+
+    public boolean isValidType (Type t) {
+        if (t == null) return false;
+        if (t.isPrimitive()) return true;
+        if (getClass(t.baseType()) != null) return true;
+        return false;
+    }
+
+    // property functions
+    public void addProperty (String name, Type t) {
+	props.put(name, t);
+    }
+    public Type propertyType (String name) {
+	return (Type) props.get(name);
+    }
+
+    // return type of null means no return type.
+    public void setReturnType (Type t) {
+	returnType = t;
+    }
+    public Type getReturnType () {
+	return returnType;
+    }
+
+    // function functions
+    public void addFunction (String funcid, Type t, boolean builtin) 
+	throws Exception 
+    {
+	// make sure function doesn't mask a lower one with a different type
+	Type existing = functionType(funcid);
+	if (existing != null && ! existing.equals(t)) {
+	    throw new Exception("Can't override function '" + funcid + "' with new "+
+				"return type.");
+	}
+	funcs.put(funcid, t);
+	funcBuiltin.put(funcid, new Boolean(builtin));
+    }
+    public Type functionType (String funcid) {
+	return (Type) funcs.get(funcid);
+    }
+    public boolean isFuncBuiltin (String funcid) {
+	Boolean b = (Boolean)funcBuiltin.get(funcid);
+	return b == null ? false : b.booleanValue();
+    }
+
+    // returns true if there's a string -> t class constructor
+    public boolean isStringCtor (Type t) {
+        if (t == null) return false;
+        if (! t.isSimple()) return false;
+        String cname = t.baseType();
+        String ctorid = cname+"::"+cname+"(string)";
+        Type rt = functionType(ctorid);
+        if (rt == null || ! rt.isSimple() || ! rt.baseType().equals(cname) ||
+            ! isFuncBuiltin(ctorid))
+            return false;
+        return true;
+    }
+
+    // setting/getting the current function class we're in
+    public void setCurrentFunctionClass (String f) {
+	funcClass = f;
+    }
+    public String getCurrentFunctionClass () {
+	return funcClass;
+    }
+
+    // setting/getting whether in a function now
+    public void setInFunction (boolean in) {
+	inFunction = in;
+    }
+    public boolean getInFunction () {
+        return inFunction;
+    }
+
+    // variable lookup
+    public void pushLocalBlock (NodeStmtBlock nb) {
+	localblocks.addLast(nb);
+    }
+    public void popLocalBlock () {
+	localblocks.removeLast();
+    }
+    public NodeStmtBlock getLocalScope () {
+	if (localblocks.size() == 0) 
+	    return null;
+	return (NodeStmtBlock) localblocks.getLast();
+    }
+    
+    public Type localType (String local) 
+    {
+	if (localblocks.size() == 0) 
+	    return null;
+
+	ListIterator li = localblocks.listIterator(localblocks.size());
+	while (li.hasPrevious()) {
+	    NodeStmtBlock nb = (NodeStmtBlock) li.previous();
+	    Type t = nb.getLocalVar(local);
+	    if (t != null)
+		return t;
+	}
+	return null;
+    }
+    public Type memberType (String clas, String member) 
+    {
+	NodeClass nc = getClass(clas);
+	if (nc == null) return null;
+	return nc.getMemberType(member);
+    }
+
+    public void setHitFunction (boolean b) {
+	hitFunction = b;
+    }
+    public boolean getHitFunction () {
+	return hitFunction;
+    }
+
+    public boolean hasDerClasses (String clas) {
+	LinkedList l = (LinkedList) derclass.get(clas);
+	return l.size() > 0;
+    }
+
+    public ListIterator getDerClassesIter (String clas) {
+	LinkedList l = (LinkedList) derclass.get(clas);
+	return l.listIterator();
+    }
+
+    public void setFuncDistance (String funcID, DerItem df) 
+    {
+	//System.err.println("setFuncDistance(\""+funcID+"\", "+df+")");
+
+	DerItem existing = (DerItem) funcDist.get(funcID);
+	if (existing == null || df.dist < existing.dist) {
+	    funcDist.put(funcID, df);
+
+	    ///// keep the funcIDs hashes -> FuncID set up-to-date
+	    // removing the existing funcID from the old set first
+	    if (existing != null) {
+		Set oldset = (Set) funcIDs.get(existing.nf);
+		oldset.remove(funcID);
+	    }
+
+	    // first, make sure the set exists
+	    Set idset = (Set) funcIDs.get(df.nf);
+	    if (idset == null) {
+		idset = Collections.synchronizedSortedSet(new TreeSet());
+		funcIDs.put(df.nf, idset);
+	    }
+
+	    // now, insert this funcID for this function.
+	    idset.add(funcID);
+	}
+    }
+
+    public Iterator getFuncIDsIter (NodeFunction nf)
+    {
+	Set s = (Set) funcIDs.get(nf);
+	if (s == null) {
+	    System.err.println("WARN: no funcids for nf="+nf);
+	    return null;
+	}
+	return s.iterator();
+    }
+
+    // per function
+    public void resetFunctionNums () {
+	funcNum = 0;
+	funcNums = new Hashtable();
+        funcNames = new LinkedList();
+    }
+    public int functionNum (String funcID) {
+	Integer num = (Integer) funcNums.get(funcID);
+	if (num == null) {
+	    num = new Integer(++funcNum);
+	    funcNums.put(funcID, num);
+            funcNames.add(funcID);
+	}
+	return num.intValue();
+    }
+    public Hashtable getFuncNums () {
+	return funcNums;
+    }
+    public LinkedList getFuncNames () {
+	return funcNames;
+    }
+
+    // check if type 't' is a subclass of 'w'
+    public boolean typeIsa (Type t, Type w) 
+    {
+	if (! Type.sameMods(t, w))
+	    return false;
+	
+	String is = t.baseType();
+	String parent = w.baseType();
+	while (is != null) {
+	    if (is.equals(parent))
+		return true;
+
+	    NodeClass nc = getClass(is);
+	    is = nc != null ? nc.getParentName() : null;
+	};
+	return false ;
+    }
+
+    // check to see if a class or parents has a
+    // "toString()" method
+    public boolean classHasToString (String clas) {
+	Type et = functionType(clas+"::toString()");
+	if (et != null && et.equals(Type.STRING))
+	    return true;
+	return false;
+    }
+
+    // check to see if a class or parents has an
+    // "as_string" string member
+    public boolean classHasAsString (String clas) {
+	Type et = memberType(clas, "as_string");
+	if (et != null && et.equals(Type.STRING))
+	    return true;
+	return false;
+    }
+
+    // ------
+
+    public void checkLayer (Layer lay) throws Exception
+    {
+	// initialize layer-specific data structures
+	funcDist = new Hashtable();
+	funcIDs = new Hashtable();
+	hitFunction = false;
+
+	// check to see that they declared the layer type, and that
+	// it isn't bogus.
+	{
+	    // what the S2 source says the layer is
+	    String dtype = lay.getDeclaredType();
+	    if (dtype == null)
+		throw new Exception("Layer type not declared.");
+
+	    // what type s2compile thinks it is
+	    String type = lay.getType();
+
+            if (! dtype.equals(type)) {
+                throw new Exception("Layer is declared " + dtype +
+                                    " but expecting a "+type+" layer.");
+            }
+
+	    // now that we've validated their type is okay
+	    lay.setType(dtype);
+	}
+
+	LinkedList nodes = lay.getNodes();
+	ListIterator li = nodes.listIterator();
+	while (li.hasNext()) {
+	    Node n = (Node) li.next();
+	    n.check(lay, this);
+	}
+
+        if (lay.getType().equals("core")) {
+            String mv = lay.getLayerInfo("majorversion");
+            if (mv == null) {
+                throw new Exception("Core layers must declare 'majorversion' layerinfo.");
+            }
+        }
+    }
+
+
+    // static stuff
+
+    // returns the signature of a function and its arguments, in the form
+    // of:   Classname::funcName(String,UserPage,int)
+    public static String functionID (String clas, String func, Object o)
+    {
+	StringBuffer sb = new StringBuffer(70);
+
+	if (clas != null) {
+	    sb.append(clas); sb.append("::");
+	}
+	sb.append(func);
+	sb.append("(");
+
+	// where Object can be a NodeFormals or FIXME: other stuff
+	if (o == null) {
+	    // do nothing.
+	} else if (o instanceof NodeFormals) {
+	    NodeFormals nf = (NodeFormals) o;
+	    sb.append(nf.typeList());
+	} else if (o instanceof String) {
+	    String s = (String) o;
+	    sb.append(s);
+	} else {
+	    sb.append("[-----]");
+	}
+
+	sb.append(")");
+	return sb.toString();	
+    }
+}

wcmtools/s2/danga/s2/DerItem.java

@@ -0,0 +1,22 @@
+package danga.s2;
+
+public class DerItem
+{
+    public int dist;
+    public NodeClass nc;
+    public NodeFunction nf;
+
+    public DerItem (NodeClass nc, int dist) {
+	this.dist = dist;
+	this.nc = nc;
+    }
+
+    public DerItem (NodeFunction nf, int dist) {
+	this.dist = dist;
+	this.nf = nf;
+    }
+
+    public String toString () {
+	return (nc != null ? nc.toString() : nf.toString()) + "-@" + dist;
+    }
+}

wcmtools/s2/danga/s2/FilePos.java

@@ -0,0 +1,24 @@
+package danga.s2;
+
+public class FilePos implements Cloneable
+{
+    public int line;
+    public int col;
+
+    public FilePos (int l, int c) {
+	line = l;
+	col = c;
+    }
+
+    public Object clone () {
+	return new FilePos(line, col);
+    }
+
+    public String locationString () {
+	return ("line " + line + ", column " + col);
+    }
+    public String toString () {
+	return locationString();
+    }
+
+}

wcmtools/s2/danga/s2/Indenter.java

@@ -0,0 +1,49 @@
+package danga.s2;
+
+public class Indenter
+{
+    int depth = 0;
+    int tabsize = 4;
+    Output o;
+
+    String spaces;
+
+    public Indenter () {
+	o = new OutputConsole();
+    }
+
+    public Indenter (Output o, int tabsize) {
+	this.tabsize = tabsize;
+	this.o = o;
+	makeSpaces();
+    }
+
+    public void write (String s) { o.write(s); }
+    public void writeln (String s) { o.writeln(s); }
+
+    public void write (int i) { o.write(i); }
+    public void writeln (int i) { o.writeln(i); }
+
+    public void tabwrite (String s) { doTab(); o.write(s); }
+    public void tabwriteln (String s) { doTab(); o.writeln(s); }
+
+    public void newline () { o.newline(); }
+
+    public void tabIn () { depth++; makeSpaces(); }
+    public void tabOut () { depth--; makeSpaces(); }
+
+    protected void makeSpaces () {
+	int tsize = depth * tabsize;
+	char[] spaces = new char[tsize];
+	for (int i=0; i<tsize; i++) {
+	    spaces[i] = ' ';
+	}
+	this.spaces = new String(spaces);
+    }
+
+    public void doTab () {
+	o.write(spaces);
+    }
+
+
+}

wcmtools/s2/danga/s2/Layer.java

@@ -0,0 +1,81 @@
+package danga.s2;
+
+import java.util.LinkedList;
+import java.util.ListIterator;
+import java.util.Hashtable;
+import java.util.Enumeration;
+
+public class Layer
+{
+    String type;
+    String declaredType;
+    LinkedList nodes = new LinkedList();
+    Hashtable layerinfo = new Hashtable();
+    
+    public Layer (Tokenizer toker, String type) throws Exception 
+    {
+	this.type = type;
+
+	Node n;
+	Token t;
+
+	while ((t=toker.peek()) != null) {
+	    if (NodeUnnecessary.canStart(toker)) {
+		nodes.add(NodeUnnecessary.parse(toker));
+		continue;
+	    }
+
+	    if (NodeLayerInfo.canStart(toker)) {
+		NodeLayerInfo nli = (NodeLayerInfo) NodeLayerInfo.parse(toker);
+		nodes.add(nli);
+		
+		// Remember the 'type' layerinfo value for checking later:
+		if (nli.getKey().equals("type")) {
+		    declaredType = nli.getValue();
+		}
+		continue;
+	    }
+
+	    if (NodeSet.canStart(toker)) {
+		nodes.add(NodeSet.parse(toker));
+		continue;
+	    }
+		
+	    if (NodeProperty.canStart(toker)) {
+		nodes.add(NodeProperty.parse(toker));
+		continue;
+	    }
+
+	    if (NodeFunction.canStart(toker)) {
+		nodes.add(NodeFunction.parse(toker, false));
+		continue;
+	    }
+		
+	    if (NodeClass.canStart(toker)) {
+		nodes.add(NodeClass.parse(toker));
+		continue;
+	    }
+
+	    throw new Exception("Unknown token encountered while parsing layer: "+
+				t.toString());
+	    
+	}
+    }
+
+    public void setLayerInfo (String key, String val) {
+	layerinfo.put(key, val);
+    }
+    public String getLayerInfo (String key) {
+	return (String) layerinfo.get(key);
+    }
+    public Enumeration getLayerInfoKeys () { return layerinfo.keys();  }
+    public String getType () { return type; }
+    public String getDeclaredType () { return declaredType; }
+    public void setType (String newtype) { type = newtype; }
+    public String toString () { return type;  }
+    public LinkedList getNodes() { return nodes; }
+    public boolean isCoreOrLayout () {
+	return (type.equals("core") || type.equals("layout"));
+    }
+
+}

wcmtools/s2/danga/s2/Node.java

@@ -0,0 +1,222 @@
+package danga.s2;
+
+import java.util.LinkedList;
+import java.util.ListIterator;
+
+public abstract class Node
+{
+    protected FilePos startPos;
+    protected LinkedList tokenlist = new LinkedList ();
+    
+    public void setStart (Token t) {
+	startPos = (FilePos) t.getFilePos().clone();
+    }
+
+    public void setStart (FilePos p) {
+	startPos = (FilePos) p.clone();
+    }
+
+    public void check (Layer l, Checker ck) throws Exception {
+	System.err.println("FIXME: check not implemented for " + this.toString());
+    }
+    
+    public void asHTML (Output o) {
+	ListIterator li = tokenlist.listIterator(0);
+	while (li.hasNext()) {
+	    Object el = li.next();
+	    if (el instanceof Token) {
+		Token t = (Token) el;
+		t.asHTML(o);
+	    } else if (el instanceof Node) {
+		Node n = (Node) el;
+		n.asHTML(o);
+	    }
+	}
+    }
+
+    public void asS2 (Indenter o) {
+	o.tabwriteln("###Node::asS2###");
+	return;
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o) {
+	o.tabwriteln("###"+this+"::asPerl###");
+	
+	/*
+	ListIterator li = tokenlist.listIterator(0);
+	while (li.hasNext()) {
+	    Object el = li.next();
+	    if (el instanceof Token) {
+		Token t = (Token) el;
+		t.asPerl(o);
+	    } else if (el instanceof Node) {
+		Node n = (Node) el;
+		n.asPerl(o);
+	    }
+	}
+	*/
+    }
+
+    public void setTokenList (LinkedList newlist) {
+	tokenlist = newlist;
+    }
+
+    public void addNode (Node subnode) {
+	tokenlist.add(subnode);
+    }
+
+    public void addToken (Token t) {
+	tokenlist.add(t);
+    }
+
+    public Token eatToken (Tokenizer toker, boolean ignoreSpace) throws Exception {
+	Token t = toker.getToken();
+	tokenlist.add(t);
+	if (ignoreSpace) skipWhite(toker);
+	return t;
+    }
+
+    public Token eatToken (Tokenizer toker) throws Exception {
+	return eatToken(toker, true);
+    }
+    
+    public Token requireToken (Tokenizer toker, Token t) throws Exception {
+	return requireToken(toker, t, true);
+    }
+
+    public Token requireToken (Tokenizer toker, Token t, boolean ignoreSpace) 
+	throws Exception 
+    {
+	if (ignoreSpace) skipWhite(toker);
+
+	Token next = toker.getToken();
+	if (next == null) {
+	    throw new Exception("Unexpected end of file found");
+	}
+	if (! next.equals(t)) {
+	    System.err.println("Expecting: " + t.toString());
+	    System.err.println("Got: " + next.toString());
+	    throw new Exception("Unexpected token found at " + toker.locationString());
+	}
+	tokenlist.add(next);
+
+	if (ignoreSpace) skipWhite(toker);
+
+	return next;
+    }
+
+    public TokenStringLiteral 
+	getStringLiteral (Tokenizer toker)
+	throws Exception 
+    {
+	return getStringLiteral(toker, true);
+    }
+
+    public TokenStringLiteral
+	getStringLiteral (Tokenizer toker, boolean ignoreSpace)
+	throws Exception 
+    {
+	if (ignoreSpace) skipWhite(toker);
+
+	if (! (toker.peek() instanceof TokenStringLiteral)) {
+	    throw new Exception("Expected string literal");
+	}
+	tokenlist.add(toker.peek());
+	return (TokenStringLiteral) toker.getToken();
+    }
+
+    public TokenIdent getIdent (Tokenizer toker) throws Exception {
+	return getIdent(toker, true, true);
+    }
+
+    public TokenIdent getIdent (Tokenizer toker, boolean addToList) throws Exception  {
+	return getIdent(toker, addToList, true);
+    }
+
+
+    public TokenIdent getIdent (Tokenizer toker, 
+				boolean addToList,
+				boolean ignoreSpace) throws Exception 
+    {
+	Token id = toker.peek();
+	if (! (id instanceof TokenIdent)) {
+	    throw new Exception("Expected identifer at " + toker.locationString());
+	}
+	if (addToList) {
+	    eatToken(toker, ignoreSpace);
+	}
+	return (TokenIdent) id;
+    }
+
+    
+    public void skipWhite (Tokenizer toker) throws Exception {
+	Token next;
+	while ((next=toker.peek()) != null) {
+	    if (next.isNecessary()) {
+		return;
+	    }
+	    tokenlist.add(toker.getToken());
+	}
+    }
+
+    public FilePos getFilePos () 
+    {
+	// most nodes should set their position
+	if (startPos != null)
+	    return startPos;
+
+	// if the node didn't record its position, try to figure it out
+	// from where the first token is at
+    	ListIterator li = tokenlist.listIterator(0);
+	if (li.hasNext()) {
+	    Object el = li.next();
+
+	    // usually tokenlist is tokens, but can also be nodes:
+	    if (el instanceof Node) {
+		Node eln = (Node) el;
+		return eln.getFilePos();
+	    }
+
+	    Token elt = (Token) el;
+	    return elt.getFilePos();
+
+	}
+	return null;
+    }
+
+    protected static void dbg (String s) {
+	System.err.println(s);
+    }
+
+    public Type getType (Checker ck) throws Exception
+    {
+	throw new Exception("FIXME: getType(ck) not implemented in "+this);
+    }    
+
+    public Type getType (Checker ck, Type wanted) throws Exception
+    {
+	return getType(ck);
+    }    
+
+    // kinda a crappy part to put this, perhaps.  but all expr
+    // nodes don't inherit from NodeExpr.  maybe they should?
+    public boolean isLValue () 
+    {
+	// hack:  only NodeTerms inside NodeExprs can be true
+	if (this instanceof NodeExpr) {
+	    NodeExpr ne = (NodeExpr) this;
+	    Node n = ne.getExpr();
+	    if (n instanceof NodeTerm) {
+		NodeTerm nt = (NodeTerm) n;
+		return nt.isLValue();
+	    }
+	}
+	return false;
+    }
+
+    public boolean makeAsString(Checker ck)
+    {
+	System.err.println("Node::makeAsString() on "+this);
+	return false;
+    }
+};

wcmtools/s2/danga/s2/NodeArguments.java

@@ -0,0 +1,106 @@
+package danga.s2;
+
+import java.util.LinkedList;
+import java.util.ListIterator;
+
+public class NodeArguments extends Node
+{
+    public LinkedList args = new LinkedList();
+
+    public static NodeArguments makeEmptyArgs () 
+    {
+	NodeArguments n = new NodeArguments();
+	n.args = new LinkedList();
+	return n;
+    }
+
+    public void addArg (NodeExpr ne) {
+	args.add(ne);
+    }
+
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeArguments n = new NodeArguments();
+	
+	n.setStart(n.requireToken(toker, TokenPunct.LPAREN));
+	boolean loop = true;
+	while (loop) {
+	    Token tp = toker.peek();
+	    if (tp.equals(TokenPunct.RPAREN)) {
+		n.eatToken(toker);
+		loop = false;
+	    } else {
+		Node expr = NodeExpr.parse(toker);
+		n.args.add(expr);
+		n.addNode(expr);
+		
+		if (toker.peek().equals(TokenPunct.COMMA)) {
+		    n.eatToken(toker);
+		}
+	    }
+	}
+
+	return n;
+    }
+
+    public void asS2 (Indenter o) 
+    {
+	o.write("(");
+
+	ListIterator li = args.listIterator(0);
+	boolean didFirst = false;
+	while (li.hasNext()) {
+	    Node n = (Node) li.next();
+	    if (didFirst) {
+		o.write(", ");
+	    } else {
+		didFirst = true;
+	    }
+	    n.asS2(o);
+	}
+	o.write(")");	    
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o) {
+	asPerl(bp, o, true);
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o, boolean doCurlies) 
+    {
+	if (doCurlies)
+	    o.write("(");
+
+	ListIterator li = args.listIterator(0);
+	boolean didFirst = false;
+	while (li.hasNext()) {
+	    Node n = (Node) li.next();
+	    if (didFirst) {
+		o.write(", ");
+	    } else {
+		didFirst = true;
+	    }
+	    n.asPerl(bp, o);
+	}
+
+	if (doCurlies)
+	    o.write(")");	    
+    }
+
+    public String typeList (Checker ck) throws Exception
+    {
+	StringBuffer sb = new StringBuffer(50);
+	if (args.size() == 0) return sb.toString();
+
+	ListIterator li = args.listIterator();
+	boolean first = true;
+	while (li.hasNext()) {
+	    NodeExpr n = (NodeExpr) li.next();
+	    if (! first) sb.append(",");
+	    first = false;
+	    sb.append(n.getType(ck).toString());
+	}
+
+	return sb.toString();
+    }
+
+};

wcmtools/s2/danga/s2/NodeArrayLiteral.java

@@ -0,0 +1,161 @@
+package danga.s2;
+
+import java.util.LinkedList;
+import java.util.ListIterator;
+
+// [ <NodeExpr>? (, <NodeExpr>)* ,? ]
+// { (<NodeExpr> => <NodeExpr> ,)* }
+
+public class NodeArrayLiteral extends NodeExpr
+{
+    boolean isHash = false;
+    boolean isArray = false;
+
+    LinkedList keys = new LinkedList();
+    LinkedList vals = new LinkedList();
+    
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {
+	return (toker.peek().equals(TokenPunct.LBRACK) ||
+                toker.peek().equals(TokenPunct.LBRACE));
+    }
+
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeArrayLiteral nal = new NodeArrayLiteral();
+
+        Token t = toker.peek();	
+        if (t.equals(TokenPunct.LBRACK)) {
+            nal.isArray = true;
+            nal.setStart(nal.requireToken(toker, TokenPunct.LBRACK));
+        } else {
+            nal.isHash = true;
+            nal.setStart(nal.requireToken(toker, TokenPunct.LBRACE));
+        }
+        
+        boolean need_comma = false;
+        while (true) {
+            t = toker.peek();
+
+            // find the ends
+            if (nal.isArray && t.equals(TokenPunct.RBRACK)) {
+                nal.requireToken(toker, TokenPunct.RBRACK);
+                return nal;
+            }
+            if (nal.isHash && t.equals(TokenPunct.RBRACE)) {
+                nal.requireToken(toker, TokenPunct.RBRACE);
+                return nal;
+            }
+
+            if (need_comma) {
+                throw new Exception("Expecting comma at "+toker.getPos());
+            }
+
+            if (nal.isArray) {
+                NodeExpr ne = (NodeExpr) NodeExpr.parse(toker);
+                nal.vals.add(ne);
+                nal.addNode(ne);
+            }
+            if (nal.isHash) {
+                NodeExpr ne = (NodeExpr) NodeExpr.parse(toker);
+                nal.keys.add(ne);
+                nal.addNode(ne);
+
+                nal.requireToken(toker, TokenPunct.HASSOC);
+
+                ne = (NodeExpr) NodeExpr.parse(toker);
+                nal.vals.add(ne);
+                nal.addNode(ne);
+            }
+
+            need_comma = true;
+            if (toker.peek().equals(TokenPunct.COMMA)) {
+                nal.requireToken(toker, TokenPunct.COMMA);
+                need_comma = false;
+            }
+        }
+    }
+
+    public void asS2 (Indenter o)
+    {
+	o.writeln(isArray ? "[" : "{");
+        o.tabIn();
+        ListIterator liv = vals.listIterator();
+        ListIterator lik = keys.listIterator();
+        Node n;
+        while (liv.hasNext()) {
+            o.tabwrite("");
+            if (isHash) {
+                n = (Node) lik.next();
+                n.asS2(o);
+                o.write(" => ");
+            }
+            n = (Node) liv.next();
+            n.asS2(o);
+            o.writeln(",");
+        }
+        o.tabOut();
+	o.tabwrite(isArray ? "]" : "}");
+    }
+
+    public Type getType (Checker ck, Type wanted) throws Exception
+    {
+        // in case of empty array [] or hash {}, the type is what they wanted,
+        // if they wanted something, otherwise void[] or void{}
+        Type t;
+	if (vals.size() == 0) {
+            if (wanted != null) return wanted;
+            t = new Type("void");
+            if (isArray) t.makeArrayOf();
+            if (isHash) t.makeHashOf();
+            return t;
+        }
+
+        ListIterator liv = vals.listIterator();
+        ListIterator lik = keys.listIterator();
+        
+        t = (Type) ((Node) liv.next()).getType(ck).clone();
+        while (liv.hasNext()) {
+            Node n = (Node) liv.next();
+            Type next = n.getType(ck);
+            if (! t.equals(next)) {
+                throw new Exception("Array literal with inconsistent types: "+
+                                    "starts with "+t+", but then has "+next+" at "+
+                                    n.getFilePos());
+            }
+        }
+
+        if (isArray) t.makeArrayOf();
+        if (isHash) t.makeHashOf();
+        return t;
+    }    
+
+    public Type getType (Checker ck) throws Exception
+    {
+	return getType(ck, null);
+    }    
+
+    public void asPerl (BackendPerl bp, Indenter o)
+    {
+	o.writeln(isArray ? "[" : "{");
+        o.tabIn();
+        ListIterator liv = vals.listIterator();
+        ListIterator lik = keys.listIterator();
+        Node n;
+        while (liv.hasNext()) {
+            o.tabwrite("");
+            if (isHash) {
+                n = (Node) lik.next();
+                n.asPerl(bp, o);
+                o.write(" => ");
+            }
+            n = (Node) liv.next();
+            n.asPerl(bp, o);
+            o.writeln(",");
+        }
+        o.tabOut();
+	o.tabwrite(isArray ? "]" : "}");
+
+    }
+
+};

wcmtools/s2/danga/s2/NodeAssignExpr.java

@@ -0,0 +1,87 @@
+package danga.s2;
+
+public class NodeAssignExpr extends Node
+{
+    Node lhs;
+    TokenPunct op;
+    Node rhs;
+
+    boolean builtin;
+    String baseType;    
+    
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {
+	return NodeCondExpr.canStart(toker);
+    }
+    
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeAssignExpr n = new NodeAssignExpr();
+
+	n.lhs = NodeCondExpr.parse(toker);
+	n.addNode(n.lhs);
+
+	if (toker.peek().equals(TokenPunct.ASSIGN)) {
+	    n.op = (TokenPunct) toker.peek();
+	    n.eatToken(toker);
+	    n.skipWhite(toker);
+	} else {
+	    return n.lhs;
+	}
+
+	n.rhs = NodeAssignExpr.parse(toker);
+	n.addNode(n.rhs);
+
+	return n;
+    }
+
+    public Type getType (Checker ck, Type wanted) throws Exception 
+    {
+	Type lt = lhs.getType(ck, wanted);
+	Type rt = rhs.getType(ck, lt);
+
+        if (lt.isReadOnly()) {
+	    throw new Exception("Left-hand side of assignment at "+getFilePos()+
+				" is a read-only value.");
+        }
+
+	if (! (lhs instanceof NodeTerm) ||
+	    ! lhs.isLValue()) {
+	    throw new Exception("Left-hand side of assignment at "+getFilePos()+
+				" must be an lvalue.");
+	}
+
+	if (ck.typeIsa(rt, lt))
+            return lt;
+
+        // types don't match, but maybe class for left hand side has
+        // a constructor which takes a string.
+        if (rt.equals(Type.STRING) && ck.isStringCtor(lt)) {
+            rt = rhs.getType(ck, lt);
+            if (lt.equals(rt)) return lt;
+        }
+        
+        throw new Exception("Can't assign type "+rt+" to "+lt+" at "+
+                            getFilePos());
+    }
+
+    public void asS2 (Indenter o) 
+    {
+	lhs.asS2(o);
+	if (op != null) {
+	    o.write(" = ");
+	    rhs.asS2(o);
+	}
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o)
+    {
+	lhs.asPerl(bp, o);
+	if (op != null) {
+	    o.write(" = ");
+            rhs.asPerl(bp, o);
+	}
+    }
+
+}
+

wcmtools/s2/danga/s2/NodeClass.java

@@ -0,0 +1,296 @@
+package danga.s2;
+
+import java.util.LinkedList;
+import java.util.ListIterator;
+import java.util.Hashtable;
+
+public class NodeClass extends Node
+{
+    TokenIdent name;
+    TokenIdent parentName;
+    
+    String docstring;
+
+    LinkedList vars = new LinkedList();      // NodeNamedType
+    Hashtable varType = new Hashtable();     // token String -> Type
+	
+    LinkedList functions = new LinkedList(); // NodeFunction
+    Hashtable funcType = new Hashtable();    // funcID String -> Type
+
+    NodeClass  parentClass;  // Not set until check() is run
+
+    // this is kinda ugly, keeping a reference to the checker for use
+    // later, but there's only ever one checker, so it's okay.
+    Checker ck;
+
+    public String getParentName() {
+	if (parentName == null) return null;
+	return parentName.getIdent();
+    }
+
+    public static boolean canStart (Tokenizer toker) throws Exception {
+	if (toker.peek().equals(TokenKeyword.CLASS)) 
+	    return true;
+	return false;
+    }
+
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeClass n = new NodeClass();
+
+	n.setStart(n.requireToken(toker, TokenKeyword.CLASS));
+
+	n.name = n.getIdent(toker);
+
+	if (toker.peek().equals(TokenKeyword.EXTENDS)) {
+	    n.eatToken(toker);
+	    n.parentName = n.getIdent(toker);
+	}
+
+        // docstring
+        if (toker.peek() instanceof TokenStringLiteral) {
+            TokenStringLiteral t = (TokenStringLiteral) n.eatToken(toker);
+            n.docstring = t.getString();
+        }
+
+	n.requireToken(toker, TokenPunct.LBRACE);
+
+	while (toker.peek() != null && toker.peek() instanceof TokenKeyword) {
+	    if (toker.peek().equals(TokenKeyword.VAR)) {
+		NodeClassVarDecl ncvd = (NodeClassVarDecl) NodeClassVarDecl.parse(toker);
+		n.vars.add(ncvd);
+		n.addNode(ncvd);
+	    } else if (toker.peek().equals(TokenKeyword.FUNCTION)) {
+		NodeFunction nm = (NodeFunction) NodeFunction.parse(toker, true);
+		n.functions.add(nm);
+		n.addNode(nm);
+	    }
+	}
+
+	n.requireToken(toker, TokenPunct.RBRACE);
+	return n;
+    }
+
+    public String getName () {
+	return name.getIdent();
+    }
+    public Type getFunctionType (String funcID) {
+	Type t = (Type) funcType.get(funcID);
+	if (t != null) return t;
+	if (parentClass != null)
+	    return parentClass.getFunctionType(funcID);
+	return null;
+    }
+    public NodeClass getFunctionDeclClass (String funcID) {
+	Type t = (Type) funcType.get(funcID);
+	if (t != null) return this;
+	if (parentClass != null)
+	    return parentClass.getFunctionDeclClass(funcID);
+	return null;
+    }
+
+    public Type getMemberType (String mem) {
+	Type t = (Type) varType.get(mem);
+	if (t != null) return t;
+	if (parentClass != null) {
+	    return parentClass.getMemberType(mem);
+	}
+	return null;
+    }
+
+    // returns LinkedList<DerClass> from the current class down to
+    // all children classes.
+    public LinkedList getDerClasses () {
+	return getDerClasses(null, 0);
+    }
+
+    private LinkedList getDerClasses (LinkedList l, int depth) {
+	if (l == null) l = new LinkedList();
+	l.add(new DerItem(this, depth));
+	ListIterator li = ck.getDerClassesIter(getName());
+	while (li.hasNext()) {
+	    String cname = (String) li.next();
+	    NodeClass c = ck.getClass(cname);
+	    c.getDerClasses(l, depth+1);
+	}
+	return l;
+    }
+
+    // returns the class/parent-class the named member variable was
+    // defined in.
+    public NodeClass getMemberDeclClass (String mem) {
+	Type t = (Type) varType.get(mem);
+	if (t != null) return this;
+	if (parentClass != null) {
+	    return parentClass.getMemberDeclClass(mem);
+	}
+	return null;
+    }
+
+    public void check (Layer l, Checker ck) throws Exception 
+    {
+	ListIterator li;
+	this.ck = ck;
+
+	// can't declare classes inside of a layer if functions
+	// have already been declared or defined.
+	if (ck.getHitFunction()) {
+	    throw new Exception("Can't declare a class inside a layer "+
+				"file after functions have been defined at "+
+				getFilePos());
+	}
+
+	// if this is an extended class, make sure parent class exists
+	parentClass = null;
+	if (parentName != null) {
+	    String pname = parentName.getIdent();
+	    parentClass = ck.getClass(pname);
+	    if (parentClass == null) {
+		throw new Exception("Can't extend non-existent class '"+
+				    pname+"' at "+getFilePos());
+	    }
+	}
+
+	// make sure the class isn't already defined.
+	String cname = name.getIdent();
+	if (ck.getClass(cname) != null) {
+	    throw new Exception("Can't redeclare class '"+cname+"' at "+
+				getFilePos());
+	}
+
+	// register all var and function declarations in hash & check for both
+	// duplicates and masking of parent class's declarations
+
+	// register self.  this needs to be done before checking member
+        // variables so we can have members of our own type.
+	ck.addClass(cname, this);
+
+	// member vars
+	for (li = vars.listIterator(); li.hasNext(); )  {
+	    NodeClassVarDecl nnt = (NodeClassVarDecl) li.next();
+            boolean readonly = nnt.isReadOnly();
+	    String vn = nnt.getName();
+	    Type vt = nnt.getType();
+	    Type et = getMemberType(vn);
+	    if (et != null) {
+		NodeClass oc = getMemberDeclClass(vn);
+		throw new Exception("Can't declare the variable '"+vn+"' "+
+				    "as '"+vt+"' in class '"+cname+"' at "+
+				    nnt.getFilePos()+" because it's "+
+				    "already defined in class '"+oc.getName()+"' as "+
+				    "type '"+et+"'.");
+	    }
+
+            // check to see if type exists
+            if (ck.isValidType(vt) != true) {
+                throw new Exception("Can't declare member variable '"+vn+"' "+
+                                    "as unknown type '"+vt+"' in class '"+cname+"' at "+
+                                    nnt.getFilePos());
+            }
+
+            vt.setReadOnly(readonly);
+	    varType.put(vn, vt);  // register member variable
+	}
+
+	// all parent class functions need to be inherited:
+	registerFunctions(ck, cname);
+    }
+
+    private void registerFunctions (Checker ck, String clas) throws Exception
+    {
+	// register parent's functions first.
+	if (parentClass != null)
+	    parentClass.registerFunctions(ck, clas);
+
+	// now do our own
+	for (ListIterator li = functions.listIterator(); li.hasNext(); )  {
+	    NodeFunction nf = (NodeFunction) li.next();
+	    Type rettype = nf.getReturnType();
+	    nf.registerFunction(ck, clas);
+	}
+    }
+
+    public void asS2 (Indenter o) 
+    {
+	ListIterator li;
+
+	o.tabwrite("class " + name.getIdent() + " ");
+	if (parentName != null) {
+	    o.write("extends " + parentName.getIdent() + " ");
+	}
+	o.writeln("{");
+	o.tabIn();
+
+	// vars
+	for (li = vars.listIterator(0); li.hasNext(); )  {
+	    NodeClassVarDecl vd = (NodeClassVarDecl) li.next();
+	    vd.asS2(o);
+	}
+
+	// functions
+	for (li = functions.listIterator(0); li.hasNext(); )  {
+	    NodeFunction nf = (NodeFunction) li.next();
+	    nf.asS2(o);
+	}
+	
+	o.tabOut();
+	o.writeln("}");
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o) {
+	o.tabwriteln("register_class(" + bp.getLayerIDString() +
+                     ", " + bp.quoteString(name.getIdent()) + ", {");
+        o.tabIn();
+        if (parentName != null) {
+            o.tabwriteln("'parent' => " + bp.quoteString(parentName.getIdent()) + ",");
+        }
+        if (docstring != null) {
+            o.tabwriteln("'docstring' => " + bp.quoteString(docstring) + ",");
+        }
+
+        // vars
+        o.tabwriteln("'vars' => {");
+        o.tabIn();
+	for (ListIterator li = vars.listIterator(); li.hasNext(); )  {
+	    NodeClassVarDecl nnt = (NodeClassVarDecl) li.next();
+	    String vn = nnt.getName();
+	    Type vt = nnt.getType();
+	    Type et = getMemberType(vn);
+            o.tabwrite(bp.quoteString(vn) + " => { 'type' => " + bp.quoteString(vt.toString()));
+            if (vt.isReadOnly()) {
+                o.write(", 'readonly' => 1");
+            }
+            if (nnt.getDocString() != null) {
+                o.write(", 'docstring' => " + bp.quoteString(nnt.getDocString()));
+            }
+            o.writeln(" },");
+        }        
+        o.tabOut();
+        o.tabwriteln("},");
+
+        // methods
+        o.tabwriteln("'funcs' => {");
+        o.tabIn();
+	for (ListIterator li = functions.listIterator(); li.hasNext(); )  {
+	    NodeFunction nf = (NodeFunction) li.next();
+	    String name = nf.getName();
+            NodeFormals nfo = nf.getFormals();
+	    Type rt = nf.getReturnType();
+            o.tabwrite(bp.quoteString(name + ((nfo != null) ? nfo.toString() : "()"))
+                                      + " => { 'returntype' => " 
+                                      + bp.quoteString(rt.toString()));
+            if (nf.getDocString() != null) {
+                o.write(", 'docstring' => " + bp.quoteString(nf.getDocString()));
+            }
+            o.writeln(" },");
+        }        
+        o.tabOut();
+        o.tabwriteln("},");
+        
+
+        o.tabOut();
+        o.tabwriteln("});");
+        
+    }
+
+};

wcmtools/s2/danga/s2/NodeClassVarDecl.java

@@ -0,0 +1,80 @@
+package danga.s2;
+
+public class NodeClassVarDecl extends Node
+{
+    public Type type;
+    public NodeType typenode;
+    public String name;
+    public String docstring;
+
+    boolean readonly = false;
+
+    public Type getType () {
+	return type;
+    }
+    public String getName () {
+	return name;
+    }
+
+    public String getDocString () {
+        return docstring;
+    }
+
+    public boolean isReadOnly () {
+        return readonly;
+    }
+
+    public NodeClassVarDecl () {
+    }
+
+    public NodeClassVarDecl (String name, Type type) {
+	this.name = name;
+	this.type = type;
+    }
+
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeClassVarDecl n = new NodeClassVarDecl();
+
+        n.setStart(n.requireToken(toker, TokenKeyword.VAR));
+        
+        if (toker.peek() == TokenKeyword.READONLY) {
+            n.readonly = true;
+            n.eatToken(toker);
+        }
+
+	n.typenode = (NodeType) NodeType.parse(toker);
+	n.type = n.typenode.getType();
+	n.addNode(n.typenode);
+
+	n.name = n.getIdent(toker).getIdent();
+
+        // docstring
+        if (toker.peek() instanceof TokenStringLiteral) {
+            TokenStringLiteral t = (TokenStringLiteral) n.eatToken(toker);
+            n.docstring = t.getString();
+        }
+
+        n.requireToken(toker, TokenPunct.SCOLON);
+
+	return n;
+    }
+
+    public void asS2 (Indenter o) 
+    {
+        o.tabwrite("var ");
+        if (readonly) o.write("readonly ");
+	typenode.asS2(o);
+	o.write(" " + name);
+        if (docstring != null) {
+            o.write(BackendPerl.quoteString(" " + docstring));
+        }
+        o.writeln(";");
+    }
+
+    public String asString () 
+    {
+	return type.toString() + " " + name;
+    }
+
+};

wcmtools/s2/danga/s2/NodeCondExpr.java

@@ -0,0 +1,78 @@
+package danga.s2;
+
+public class NodeCondExpr extends Node
+{
+    Node test_expr;
+    Node true_expr;
+    Node false_expr;
+    
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {
+	return NodeRange.canStart(toker);
+    }
+    
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeCondExpr n = new NodeCondExpr();
+
+	n.test_expr = NodeRange.parse(toker);
+	n.addNode(n.test_expr);
+
+	if (toker.peek().equals(TokenPunct.QMARK)) {
+	    n.eatToken(toker);
+	    n.skipWhite(toker);
+	} else {
+	    return n.test_expr;
+	}
+
+	n.true_expr = NodeRange.parse(toker);
+	n.addNode(n.true_expr);
+	n.requireToken(toker, TokenPunct.COLON);
+
+	n.false_expr = NodeRange.parse(toker);
+	n.addNode(n.false_expr);
+
+	return n;
+    }
+
+    public Type getType (Checker ck) throws Exception
+    {
+	Type ctype = test_expr.getType(ck);
+	if (! ctype.isBoolable()) {
+	    throw new Exception("Conditional expression not a boolean at "+
+				getFilePos());
+	}
+	Type lt = true_expr.getType(ck);
+	Type rt = false_expr.getType(ck);
+	if (! lt.equals(rt)) {
+	    throw new Exception("Types must match in condition expression at "+
+				getFilePos());
+	}
+	return lt;
+    }
+
+    public void asS2 (Indenter o) 
+    {
+	test_expr.asS2(o);
+	if (true_expr != null) {
+	    o.write(" ? ");
+	    true_expr.asS2(o);
+	    o.write(" : ");
+	    false_expr.asS2(o);
+	}
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o) 
+    {
+	test_expr.asPerl(bp, o);
+	if (true_expr != null) {
+	    o.write(" ? ");
+	    true_expr.asPerl(bp, o);
+	    o.write(" : ");
+	    false_expr.asPerl(bp, o);
+	}
+    }
+
+    
+
+}

wcmtools/s2/danga/s2/NodeDeleteStmt.java

@@ -0,0 +1,52 @@
+package danga.s2;
+
+public class NodeDeleteStmt extends Node
+{
+    NodeVarRef var;
+
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {	
+	if (toker.peek().equals(TokenKeyword.DELETE))
+	    return true;
+	return false;
+    }
+    
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeDeleteStmt n = new NodeDeleteStmt();
+	Token t = toker.peek();
+
+	n.requireToken(toker, TokenKeyword.DELETE);
+	n.addNode(n.var = (NodeVarRef) NodeVarRef.parse(toker));
+	n.requireToken(toker, TokenPunct.SCOLON);
+	
+	return n;
+    }
+
+    public void check (Layer l, Checker ck) throws Exception
+    {
+	// type check the innards, but we don't care what type it
+	// actually is.
+	var.getType(ck);
+	
+	// but it must be a hash reference
+	if (! var.isHashElement()) {
+	    throw new Exception("Delete statement argument is not a hash at "+
+				var.getFilePos());
+	}
+    }
+
+    public void asS2 (Indenter o)
+    {
+	o.tabwrite("delete ");
+	var.asS2(o);
+	o.writeln(";");
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o)
+    {
+	o.tabwrite("delete ");
+	var.asPerl(bp, o);
+	o.writeln(";");
+    }
+};

wcmtools/s2/danga/s2/NodeEqExpr.java

@@ -0,0 +1,85 @@
+package danga.s2;
+
+public class NodeEqExpr extends Node
+{
+    Node lhs;
+    TokenPunct op;
+    Node rhs;
+
+    // use this for the backend to decide which add operator to use
+    private Type myType;
+
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {
+	return NodeRelExpr.canStart(toker);
+    }
+
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeEqExpr n = new NodeEqExpr();
+
+	n.lhs = NodeRelExpr.parse(toker);
+	n.addNode(n.lhs);
+
+	Token t = toker.peek();
+
+	if (t.equals(TokenPunct.EQ) || t.equals(TokenPunct.NE)) {
+	    n.op = (TokenPunct) t;
+	    n.eatToken(toker);
+	    n.skipWhite(toker);
+	} else {
+	    return n.lhs;
+	}
+
+	n.rhs = NodeRelExpr.parse(toker);
+        n.addNode(n.rhs);
+	n.skipWhite(toker);   
+
+	return n;
+    }
+
+    public Type getType (Checker ck) throws Exception
+    {
+	Type lt = lhs.getType(ck);
+	Type rt = rhs.getType(ck);
+	if (! lt.equals(rt))
+	    throw new Exception("The types of the left and right hand side of "+
+				"equality test expression don't match at "+getFilePos());
+	myType = lt;
+	if (lt.equals(Type.BOOL) || lt.equals(Type.STRING) || lt.equals(Type.INT)) {
+	    return Type.BOOL;
+	}
+	throw new Exception ("Only bool, string, and int types can be tested for "+
+			     "equality at "+getFilePos());
+    }
+
+    public void asS2 (Indenter o)
+    {
+	lhs.asS2(o);
+	if (op != null) {
+	    o.write(" " + op.getPunct() + " ");
+	    rhs.asS2(o);
+	}
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o)
+    {
+	lhs.asPerl(bp, o);
+	if (op != null) {
+	    if (op.equals(TokenPunct.EQ)) {
+		if (myType.equals(Type.STRING))
+		    o.write(" eq ");
+		else
+		    o.write(" == ");
+	    } else {
+		if (myType.equals(Type.STRING))
+		    o.write(" ne ");
+		else
+		    o.write(" != ");
+	    }
+	    rhs.asPerl(bp, o);
+	}
+    }
+
+
+}

wcmtools/s2/danga/s2/NodeExpr.java

@@ -0,0 +1,49 @@
+package danga.s2;
+
+public class NodeExpr extends Node
+{
+    Node expr;
+
+    public NodeExpr () { }
+
+    public NodeExpr (Node n) {
+	expr = n;
+    }
+
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {
+	return NodeAssignExpr.canStart(toker);
+    }
+
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeExpr n = new NodeExpr();
+	n.expr = NodeAssignExpr.parse(toker);
+	n.addNode(n.expr);
+	return n;     // Note: always return a NodeExpr here
+    }
+
+    public void asS2 (Indenter o) 
+    {
+	expr.asS2(o);
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o)
+    {
+	expr.asPerl(bp, o);
+    }
+
+    public Type getType (Checker ck) throws Exception
+    {
+	return expr.getType(ck, null);
+    }
+
+    public Type getType (Checker ck, Type wanted) throws Exception
+    {
+	return expr.getType(ck, wanted);
+    }
+
+    public Node getExpr () {
+	return expr;
+    }
+}

wcmtools/s2/danga/s2/NodeExprStmt.java

@@ -0,0 +1,42 @@
+package danga.s2;
+
+public class NodeExprStmt extends Node
+{
+    NodeExpr expr;
+
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {	
+	return NodeExpr.canStart(toker);
+    }
+    
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeExprStmt n = new NodeExprStmt();
+
+	n.addNode(n.expr = (NodeExpr) NodeExpr.parse(toker));
+	n.requireToken(toker, TokenPunct.SCOLON);
+
+	return n;
+    }
+
+    public void check (Layer l, Checker ck) throws Exception
+    {
+	Type t = expr.getType(ck);  // checks the type
+    }
+
+    public void asS2 (Indenter o)
+    {
+	o.doTab();
+	expr.asS2(o);
+	o.writeln(";");
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o)
+    {
+	o.doTab();
+	expr.asPerl(bp, o);
+	o.writeln(";");
+    }
+ 
+
+};

wcmtools/s2/danga/s2/NodeForeachStmt.java

@@ -0,0 +1,136 @@
+package danga.s2;
+
+public class NodeForeachStmt extends Node
+{
+    NodeExpr listexpr;
+    NodeStmtBlock stmts;
+    NodeVarDecl vardecl;
+    NodeVarRef varref;
+    boolean isHash;   // otherwise it's an array or a string
+    boolean isString;
+
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {
+	if (toker.peek().equals(TokenKeyword.FOREACH))
+	    return true;
+	return false;
+    }
+
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeForeachStmt n = new NodeForeachStmt();
+
+	n.requireToken(toker, TokenKeyword.FOREACH);
+
+	if (NodeVarDecl.canStart(toker)) {
+	    n.addNode(n.vardecl = (NodeVarDecl) NodeVarDecl.parse(toker));
+	} else {
+	    n.addNode(n.varref = (NodeVarRef) NodeVarRef.parse(toker));
+	}
+
+	// expression in parenthesis representing an array to iterate over:
+	n.requireToken(toker, TokenPunct.LPAREN);
+	n.addNode(n.listexpr = (NodeExpr) NodeExpr.parse(toker));
+	n.requireToken(toker, TokenPunct.RPAREN);
+
+	// and what to do on each element
+	n.addNode(n.stmts = (NodeStmtBlock) NodeStmtBlock.parse(toker));
+
+	return n;
+    }
+
+    public void check (Layer l, Checker ck) throws Exception
+    {
+	Type ltype = listexpr.getType(ck);
+	isHash = false;
+
+	if (ltype.isHashOf()) {
+	    isHash = true;
+	} else if (ltype.equals(Type.STRING)) { // Iterate over characters in a string
+            isString = true;
+        } else if (! ltype.isArrayOf()) {
+	    throw new Exception("Must use an array, hash or string in foreach statement at "+
+				listexpr.getFilePos());
+	}
+
+	Type itype = null;
+	if (vardecl != null) {
+	    vardecl.populateScope(stmts);
+	    itype = vardecl.getType();
+	}
+	if (varref != null) {
+	    itype = varref.getType(ck);
+	}
+
+	if (isHash) {
+	    // then iter type must be a string or int
+	    if (! itype.equals(Type.STRING) && ! itype.equals(Type.INT)) {
+		throw new Exception("Foreach iteration variable must be a "+
+				    "string or int when interating over the keys "+
+				    "in a hash at "+getFilePos());
+	    }
+	} else if (isString) {
+            if (! itype.equals(Type.STRING)) {
+                throw new Exception("Foreach iteration variable must be a "+
+                                    "string when interating over the characters "+
+                                    "in a string at "+getFilePos());
+            }
+        } else {
+	    // iter type must be the same as the list type minus
+	    // the final array ref
+
+            // figure out the desired type
+            Type dtype = (Type) ltype.clone();
+            dtype.removeMod();
+
+	    if (! dtype.equals(itype)) {
+		throw new Exception("Foreach iteration variable is of type "+
+				    itype+", not the expected type of "+dtype+" at "+
+				    getFilePos());
+	    }
+	}
+
+	ck.pushLocalBlock(stmts);
+	stmts.check(l, ck);
+	ck.popLocalBlock();
+    }
+
+    public void asS2 (Indenter o)
+    {
+	o.tabwrite("foreach ");
+	if (vardecl != null)
+	    vardecl.asS2(o);
+	if (varref != null)
+	    varref.asS2(o);
+	o.write(" (");
+	listexpr.asS2(o);
+	o.write(") ");
+	stmts.asS2(o);
+	o.newline();
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o)
+    {
+	o.tabwrite("foreach ");
+	if (vardecl != null)
+	    vardecl.asPerl(bp, o);
+	if (varref != null)
+	    varref.asPerl(bp, o);
+	if (isHash) {
+	    o.write(" (keys %{");
+	} else if (isString) {
+            o.write(" (S2::get_characters(");
+        } else {
+	    o.write(" (@{");
+	}
+	listexpr.asPerl(bp, o);
+        if (isString) {
+            o.write(")) ");
+        } else {
+            o.write("}) ");
+        }
+	stmts.asPerl(bp, o);
+	o.newline();
+    }
+
+};

wcmtools/s2/danga/s2/NodeFormals.java

@@ -0,0 +1,148 @@
+package danga.s2;
+
+import java.util.LinkedList;
+import java.util.ListIterator;
+import java.util.Hashtable;
+
+public class NodeFormals extends Node
+{
+    public LinkedList listFormals = new LinkedList(); // NodeNamedType
+
+    public NodeFormals () { }
+    public NodeFormals (LinkedList formals) {
+	listFormals = formals;
+    }
+    
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeFormals n = new NodeFormals();
+	int count = 0;
+
+	n.requireToken(toker, TokenPunct.LPAREN);
+	while (toker.peek() != null && ! toker.peek().equals(TokenPunct.RPAREN)) {
+	    if (count > 0) {
+		n.requireToken(toker, TokenPunct.COMMA);
+	    }
+	    n.skipWhite(toker);
+
+	    NodeNamedType nf = (NodeNamedType) NodeNamedType.parse(toker);
+	    n.listFormals.add(nf);
+	    n.tokenlist.add(nf);
+
+	    n.skipWhite(toker);
+	    count++;
+	}
+	n.requireToken(toker, TokenPunct.RPAREN);
+
+	return n;
+    }
+
+    public void check (Layer l, Checker ck) throws Exception
+    {
+	Hashtable h = new Hashtable();
+	ListIterator li = listFormals.listIterator();
+	while (li.hasNext()) {
+	    NodeNamedType nt = (NodeNamedType) li.next();
+	    String name = nt.getName();
+	    if (h.get(name) != null)
+		throw new Exception("Duplicate argument named '" + name + "' at "+
+				    nt.getFilePos());
+            h.put(name, name);
+
+            Type t = nt.getType();
+            if (! ck.isValidType(t)) 
+                throw new Exception("Unknown type '" + t + "' at "+nt.getFilePos());
+	}
+    }
+
+    public void asS2 (Indenter o) {
+	if (listFormals.size() == 0) return; // no empty parens necessary in S2
+	o.write(toString());
+    }
+
+    public String toString () {
+        StringBuffer sb = new StringBuffer("(");
+	ListIterator li = listFormals.listIterator();
+	boolean first = true;
+	while (li.hasNext()) {
+	    NodeNamedType nf = (NodeNamedType) li.next();
+	    if (! first) {
+		sb.append(", ");
+	    }
+	    first = false;
+
+	    sb.append(nf.toString());
+	}
+
+        sb.append(")");
+        return sb.toString();
+    }
+
+    // returns a ListIterator returning variations of this NodeFormal
+    // object using derived classes as well.
+    public static ListIterator variationIterator (NodeFormals nf, Checker ck)
+    {
+	LinkedList l = new LinkedList();
+	if (nf == null) {
+	    l.add(new NodeFormals(new LinkedList()));
+	} else {
+	    nf.getVariations(ck, l, new LinkedList(), 0);
+	}
+	return l.listIterator();
+    }
+
+    private void getVariations (Checker ck, 
+				LinkedList vars, 
+				LinkedList temp,
+				int col)
+    {
+	if (col == listFormals.size()) {
+	    vars.add(new NodeFormals(temp));
+	    return;
+	}
+	
+	NodeNamedType nt = (NodeNamedType) listFormals.get(col);
+	Type t = nt.getType();
+
+	for (ListIterator li = t.subTypesIter(ck); li.hasNext(); ) {
+	    t = (Type) li.next();
+	    LinkedList newtemp = (LinkedList) temp.clone();
+	    newtemp.add(new NodeNamedType(nt.getName(), t));
+	    getVariations(ck, vars, newtemp, col+1);
+	}
+    }
+
+    public String typeList () 
+    {
+	StringBuffer sb = new StringBuffer(50);
+	if (listFormals.size() == 0) return sb.toString();
+
+	ListIterator li = listFormals.listIterator();
+	boolean first = true;
+	while (li.hasNext()) {
+	    NodeNamedType nt = (NodeNamedType) li.next();
+	    if (! first) sb.append(",");
+	    first = false;
+
+	    sb.append(nt.getType().toString());
+	}
+
+	return sb.toString();
+    }
+
+    // adds all these variables to the stmtblock's symbol table
+    public void populateScope (NodeStmtBlock nb)
+    {
+	if (listFormals.size() == 0) return;
+	
+	ListIterator li = listFormals.listIterator();
+	while (li.hasNext()) {
+	    NodeNamedType nt = (NodeNamedType) li.next();
+	    nb.addLocalVar(nt.getName(), nt.getType());
+	}
+     }
+
+    public ListIterator iterator() {
+	return listFormals.listIterator();
+    }
+};

wcmtools/s2/danga/s2/NodeFunction.java

@@ -0,0 +1,364 @@
+package danga.s2;
+
+import java.util.LinkedList;
+import java.util.ListIterator;
+import java.util.Iterator;
+import java.util.Hashtable;
+import java.util.Enumeration;
+
+public class NodeFunction extends Node
+{
+    TokenIdent classname;
+    TokenIdent name;
+    NodeType rettype;
+    NodeFormals formals;
+    NodeStmtBlock stmts;
+    boolean builtin = false;
+    boolean isCtor = false;
+    LinkedList funcNames = null;
+    
+    Checker ck;
+
+    String docstring;
+
+    public String getDocString () {
+        return docstring;
+    }
+
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {
+	if (toker.peek().equals(TokenKeyword.FUNCTION))
+	    return true;
+	return false;
+    }
+
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	return parse(toker, false);
+    }
+    
+    public static Node parse (Tokenizer toker,  boolean isDecl) throws Exception
+    {
+	NodeFunction n = new NodeFunction();
+
+	// get the function keyword
+	n.setStart(n.requireToken(toker, TokenKeyword.FUNCTION));
+
+	// is the builtin keyword on?
+	if (toker.peek().equals(TokenKeyword.BUILTIN)) {
+	    n.builtin = true;
+	    n.eatToken(toker);
+	}
+
+	// and the class name or function name (if no class)
+	n.name = n.getIdent(toker);
+
+	// check for a double colon
+	if (toker.peek().equals(TokenPunct.DCOLON)) {
+	    // so last ident was the class name
+	    n.classname = n.name;
+	    n.eatToken(toker);
+	    n.name = n.getIdent(toker);
+	} 
+
+	// Argument list is optional.
+	if (toker.peek().equals(TokenPunct.LPAREN)) {
+	    n.addNode(n.formals = (NodeFormals) NodeFormals.parse(toker));
+	}
+
+	// return type is optional too.
+	if (toker.peek().equals(TokenPunct.COLON)) {
+	    n.requireToken(toker, TokenPunct.COLON);
+	    n.addNode(n.rettype = (NodeType) NodeType.parse(toker));
+	} 
+
+        // docstring
+        if (toker.peek() instanceof TokenStringLiteral) {
+            TokenStringLiteral t = (TokenStringLiteral) n.eatToken(toker);
+            n.docstring = t.getString();
+        }
+	
+	// if inside a class declaration, only a declaration now.
+	if (isDecl || n.builtin) {
+	    n.requireToken(toker, TokenPunct.SCOLON);
+	    return n;
+	} 
+
+	// otherwise, parsing the function definition.
+	n.stmts = (NodeStmtBlock) NodeStmtBlock.parse(toker);
+	n.addNode(n.stmts);
+	
+	return n;
+    }
+
+    public void check (Layer l, Checker ck) throws Exception
+    {
+	// keep a reference to the checker for later
+	this.ck = ck;
+        ck.setInFunction(true);
+
+	// reset the functionID -> local funcNum mappings
+	ck.resetFunctionNums();
+
+	// only core and layout layers can define functions
+	if (! l.isCoreOrLayout()) {
+	    throw new Exception("Only core and layout layers can define new functions.");
+	}
+
+	// tell the checker we've seen a function now so it knows
+	// later to complain if it then sees a new class declaration.
+	// (builtin functions are okay)
+	if (! builtin) 
+	    ck.setHitFunction(true);    
+
+	String cname = className();
+	String funcID = Checker.functionID(cname, name.getIdent(), formals);
+	Type t = getReturnType();
+
+	if (cname != null && cname.equals(name.getIdent())) {
+	    isCtor = true;
+	}
+
+	// if this function is global, no declaration is done, but if
+	// this is class-scoped, we must check the class exists and
+	// that it declares this function.
+	if (cname != null) {
+	    NodeClass nc = ck.getClass(cname);
+	    if (nc == null) {
+		throw new Exception("Can't declare function "+funcID+" for "+
+				    "non-existent class '"+cname+"' at "+
+				    getFilePos());
+	    }
+
+	    Type et = ck.functionType(funcID);
+	    if (et == null) {
+		throw new Exception("Can't define undeclared object function "+funcID+" at "+
+				    getFilePos());
+	    }
+
+	    // find & register all the derivative names by which this function
+	    // could be called.
+	    ListIterator li = nc.getDerClasses().listIterator();
+	    while (li.hasNext()) {
+		DerItem dc = (DerItem) li.next();
+		NodeClass c = dc.nc;
+		
+		ListIterator fi = NodeFormals.variationIterator(formals, ck);
+		while (fi.hasNext()) {
+		    NodeFormals fv = (NodeFormals) fi.next();
+		    String derFuncID = Checker.functionID(c.getName(), getName(), fv);
+		    ck.setFuncDistance(derFuncID, new DerItem(this, dc.dist));
+		    ck.addFunction(derFuncID, t, builtin);
+		}
+	    }
+	} else {
+	    // non-class function.  register all variations of the formals.
+	    ListIterator fi = NodeFormals.variationIterator(formals, ck);
+	    while (fi.hasNext()) {
+		NodeFormals fv = (NodeFormals) fi.next();
+		String derFuncID = Checker.functionID(cname, getName(), fv);
+		ck.setFuncDistance(derFuncID, new DerItem(this, 0));
+		ck.addFunction(derFuncID, t, builtin);
+	    }
+	}
+	
+	// check the formals
+	if (formals != null) 
+	    formals.check(l, ck);
+	
+	// check the statement block
+	if (stmts != null) {
+	    // prepare stmts to be checked
+	    stmts.setReturnType(t);
+
+	    // make sure $this is accessible in a class method
+	    // FIXME: not in static functions, once we have static functions
+	    if (cname != null) {
+		stmts.addLocalVar("this", new Type(cname));
+	    } else {
+		stmts.addLocalVar("this", Type.VOID);  // prevent its use
+	    }
+
+            // make sure $this is accessible in a class method 
+            // that has a parent.
+            String pname = ck.getParentClassName(cname);
+            if (pname != null) {
+		stmts.addLocalVar("super", new Type(pname));
+	    } else {
+		stmts.addLocalVar("super", Type.VOID);  // prevent its use
+            }
+
+	    if (formals != null) 
+		formals.populateScope(stmts);
+	    
+	    ck.setCurrentFunctionClass(cname);   // for $.member lookups
+	    ck.pushLocalBlock(stmts);
+	    stmts.check(l, ck);
+	    ck.popLocalBlock();
+	}
+
+	// remember the funcID -> local funcNum mappings for the backend
+	funcNames = ck.getFuncNames();
+    }
+
+    // called by NodeClass
+    public void registerFunction (Checker ck, String cname)
+	throws Exception
+    {
+	String funcID = Checker.functionID(cname, getName(), formals);
+	Type et = ck.functionType(funcID);
+	Type rt = getReturnType();
+
+	// check that function is either currently undefined or 
+	// defined with the same type, otherwise complain
+	if (et == null || et.equals(rt)) {
+	    ck.addFunction(funcID, rt, builtin);  // Register
+	} else {
+	    throw new Exception("Can't redefine function '"+getName()+"' with return "+
+				"type of '"+rt+"' at "+getFilePos()+" masking "+
+				"earlier definition of type '"+et+"'.");
+	}
+    }
+
+    public NodeFormals getFormals () {
+	return formals;
+    }
+
+    public String getName () {
+	return name.getIdent();
+    }
+
+    public Type getReturnType () {
+    	return (rettype != null ? rettype.getType() : Type.VOID);
+    }
+
+    public void asS2 (Indenter o) 
+    {
+	o.tabwrite("function " + totalName());
+	if (formals != null) {
+	    o.write(" ");
+	    formals.asS2(o);
+	}
+	if (rettype != null) {
+	    o.write(" : ");
+	    rettype.asS2(o);
+	}
+	if (stmts != null) {
+	    o.write(" ");
+	    stmts.asS2(o);
+	    o.newline();
+	} else {
+	    o.writeln(";");
+	}
+    }
+
+
+    public void asPerl (BackendPerl bp, Indenter o) 
+    {
+        if (classname == null) {
+            o.tabwrite("register_global_function(" +
+                       bp.getLayerIDString() + "," +
+                       bp.quoteString(name.getIdent() + (formals != null ? formals.toString() : "()")) + "," +
+                       bp.quoteString(getReturnType().toString()));
+            if (docstring != null)
+                o.write(", " + bp.quoteString(docstring));
+            o.writeln(");");
+        }
+
+        if (builtin) return;
+
+	o.tabwrite("register_function(" + bp.getLayerIDString() +
+		   ", [");
+
+	// declare all the names by which this function would be called:
+	// its base name, then all derivative classes which aren't already
+	// used.
+	Iterator i = ck.getFuncIDsIter(this);
+	while (i.hasNext()) {
+	    String funcID = (String) i.next();
+	    o.write(bp.quoteString(funcID) + ", ");	    
+	}
+
+	o.writeln("], sub {");
+	o.tabIn();
+
+	// the first time register_function is run, it'll find the
+	// funcNames for this session and save those in a list and then
+	// return the sub which is a closure and will have fast access
+	// to that num -> num hash.  (benchmarking showed two
+	// hashlookups on ints was faster than one on strings)
+
+	if (funcNames.size() > 0) {
+	    o.tabwriteln("my @_l2g_func = ( undef, ");
+	    o.tabIn();
+            ListIterator li = funcNames.listIterator();
+            while (li.hasNext()) {
+                String id = (String) li.next();
+		o.tabwriteln("get_func_num(" +
+			     BackendPerl.quoteString(id) + "),");
+	    }
+	    o.tabOut();
+	    o.tabwriteln(");");
+	}
+
+	// now, return the closure
+	o.tabwriteln("return sub {");
+	o.tabIn();
+	
+	// setup function argument/ locals
+	o.tabwrite("my ($_ctx");
+	if (classname != null && ! isCtor) {
+	    o.write(", $this");
+	}
+	if (formals != null) {
+	    ListIterator li = formals.iterator();
+	    while (li.hasNext()) {
+		NodeNamedType nt = (NodeNamedType) li.next();
+		o.write(", $"+nt.getName());
+	    }
+	}
+	o.writeln(") = @_;");
+	// end function locals
+
+	stmts.asPerl(bp, o, false);
+	o.tabOut();
+	o.tabwriteln("};");
+
+	// end the outer sub
+	o.tabOut();
+	o.tabwriteln("});");
+    }
+
+    public String toString ()
+    {
+	return (className() + "...");
+    }
+
+    public boolean isBuiltin () {
+	return builtin;
+    }
+
+    //-----------------------------
+
+    private String className () 
+    {
+	if (classname != null)
+	    return classname.getIdent();
+	return null;
+    }
+
+    private String totalName ()
+    {
+	StringBuffer sb = new StringBuffer(50);
+
+	String clas = className(); 
+	if (clas != null) {
+	    sb.append(clas);
+	    sb.append("::");
+	}
+	sb.append(name.getIdent());
+
+	return sb.toString();
+    }
+
+};

wcmtools/s2/danga/s2/NodeIfStmt.java

@@ -0,0 +1,169 @@
+package danga.s2;
+
+import java.util.LinkedList;
+import java.util.ListIterator;
+
+public class NodeIfStmt extends Node
+{
+    NodeExpr expr;
+    NodeStmtBlock thenblock;
+    NodeStmtBlock elseblock;
+    LinkedList elseifexprs;
+    LinkedList elseifblocks;
+    
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {	
+	if (toker.peek().equals(TokenKeyword.IF))
+	    return true;
+	return false;
+    }
+    
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeIfStmt n = new NodeIfStmt();
+	n.elseifblocks = new LinkedList();
+	n.elseifexprs = new LinkedList();
+
+	n.setStart(n.requireToken(toker, TokenKeyword.IF));
+	n.requireToken(toker, TokenPunct.LPAREN);
+	n.addNode(n.expr = (NodeExpr) NodeExpr.parse(toker));
+	n.requireToken(toker, TokenPunct.RPAREN);
+	n.addNode(n.thenblock = (NodeStmtBlock) NodeStmtBlock.parse(toker));
+
+	while (toker.peek().equals(TokenKeyword.ELSEIF)) {
+	    n.eatToken(toker);
+
+	    // get the expression.
+	    n.requireToken(toker, TokenPunct.LPAREN);
+	    Node expr = NodeExpr.parse(toker);
+	    n.addNode(expr);
+	    n.requireToken(toker, TokenPunct.RPAREN);
+	    n.elseifexprs.add(expr);
+
+	    // and the block
+	    Node nie = NodeStmtBlock.parse(toker);
+	    n.addNode(nie);
+	    n.elseifblocks.add(nie);
+	}
+
+	if (toker.peek().equals(TokenKeyword.ELSE)) {
+	    n.eatToken(toker);
+	    n.addNode(n.elseblock = (NodeStmtBlock) NodeStmtBlock.parse(toker));
+	}
+
+	return n;
+    }
+
+    // returns true if and only if the 'then' stmtblock ends in a
+    // return statement, the 'else' stmtblock is non-null and ends
+    // in a return statement, and any elseif stmtblocks end in a return
+    // statement.
+    public boolean willReturn () 
+    {
+	// there must be an else block.
+	if (elseblock == null) return false;
+
+	// both the 'then' and 'else' blocks must return
+	if (! thenblock.willReturn()) return false;
+	if (! elseblock.willReturn()) return false;
+
+	// if there are elseif blocks, all those must return
+	ListIterator li = elseifblocks.listIterator();
+	while (li.hasNext()) {
+	    NodeStmtBlock sb = (NodeStmtBlock) li.next();
+	    if (! sb.willReturn()) return false;
+	}
+
+	// else, it does return.
+	return true;
+    }
+
+    public void check (Layer l, Checker ck) throws Exception
+    {
+	Type t = expr.getType(ck);
+	if (! t.equals(Type.BOOL) && ! t.equals(Type.INT)) {
+	    throw new Exception("Non-boolean if test at "+getFilePos());
+	}
+	thenblock.check(l, ck);
+
+	ListIterator li;
+
+	li = elseifexprs.listIterator();
+	while (li.hasNext()) {
+	    NodeExpr ne = (NodeExpr) li.next();
+	    t = ne.getType(ck);
+	    if (! t.equals(Type.BOOL) && ! t.equals(Type.INT))
+		throw new Exception("Non-boolean elseif test at "+ne.getFilePos());
+	}
+
+	li = elseifblocks.listIterator();
+	while (li.hasNext()) {
+	    NodeStmtBlock sb = (NodeStmtBlock) li.next();
+	    sb.check(l, ck);
+	}
+	
+	if (elseblock != null)
+	    elseblock.check(l, ck);
+    }
+
+    public void asS2 (Indenter o)
+    {
+	// if
+	o.tabwrite("if (");
+	expr.asS2(o);
+	o.write(") ");
+	thenblock.asS2(o);
+	
+	// else-if
+	ListIterator li = elseifexprs.listIterator(0);
+	ListIterator lib = elseifblocks.listIterator(0);
+	while (li.hasNext()) {
+	    NodeExpr expr = (NodeExpr) li.next();
+	    NodeStmtBlock block = (NodeStmtBlock) lib.next();
+
+	    o.write(" elseif (");
+	    expr.asS2(o);
+	    o.write(") ");
+	    block.asS2(o);
+	}
+	
+
+	// else
+	if (elseblock != null) {
+	    o.write(" else ");
+	    elseblock.asS2(o);
+	}
+	o.newline();
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o)
+    {
+	// if
+	o.tabwrite("if (");
+	expr.asPerl(bp, o);
+	o.write(") ");
+	thenblock.asPerl(bp, o);
+	
+	// else-if
+	ListIterator li = elseifexprs.listIterator(0);
+	ListIterator lib = elseifblocks.listIterator(0);
+	while (li.hasNext()) {
+	    NodeExpr expr = (NodeExpr) li.next();
+	    NodeStmtBlock block = (NodeStmtBlock) lib.next();
+	    o.write(" elsif (");
+	    expr.asPerl(bp, o);
+	    o.write(") ");
+	    block.asPerl(bp, o);
+	}
+	
+
+	// else
+	if (elseblock != null) {
+	    o.write(" else ");
+	    elseblock.asPerl(bp, o);
+	}
+	o.newline();
+    }
+
+};
+

wcmtools/s2/danga/s2/NodeIncExpr.java

@@ -0,0 +1,70 @@
+package danga.s2;
+
+public class NodeIncExpr extends Node
+{
+    Node expr;
+    TokenPunct op;
+    boolean bPre = false;
+    boolean bPost = false;
+    
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {
+	return (toker.peek().equals(TokenPunct.INC) ||
+		toker.peek().equals(TokenPunct.DEC) ||
+		NodeTerm.canStart(toker));
+    }
+    
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeIncExpr n = new NodeIncExpr();
+
+	if (toker.peek().equals(TokenPunct.INC) ||
+	    toker.peek().equals(TokenPunct.DEC)) {
+	    n.bPre = true;
+	    n.op = (TokenPunct) toker.peek();
+	    n.setStart(n.eatToken(toker));
+	    n.skipWhite(toker);
+	}
+
+	Node expr = NodeTerm.parse(toker);
+
+	if (toker.peek().equals(TokenPunct.INC) ||
+	    toker.peek().equals(TokenPunct.DEC)) {
+	    if (n.bPre) throw new Exception("Unexpected -- or ++");
+	    n.bPost = true;
+	    n.op = (TokenPunct) toker.peek();
+	    n.eatToken(toker);
+	    n.skipWhite(toker);
+	}
+	
+	if (n.bPre || n.bPost) {
+	    n.expr = expr;
+	    return n;
+	}
+	return expr;
+    }
+
+    public Type getType (Checker ck) throws Exception
+    {
+	if (! expr.isLValue()) {
+	    throw new Exception("Post/pre-increment must operate on lvalue at "+
+				expr.getFilePos());
+	}
+	return expr.getType(ck);
+    }
+
+    public void asS2 (Indenter o)
+    {
+	if (bPre) { o.write(op.getPunct()); }
+	expr.asS2(o);
+	if (bPost) { o.write(op.getPunct()); }
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o)
+    {
+	if (bPre) { o.write(op.getPunct()); }
+	expr.asPerl(bp, o);
+	if (bPost) { o.write(op.getPunct()); }
+    }
+
+}

wcmtools/s2/danga/s2/NodeLayerInfo.java

@@ -0,0 +1,64 @@
+package danga.s2;
+
+import java.util.LinkedList;
+
+public class NodeLayerInfo extends Node
+{
+    String key;
+    String val;
+
+    public String getKey () { return key; }
+    public String getValue () { return val; }
+
+
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {
+	if (toker.peek().equals(TokenKeyword.LAYERINFO))
+	    return true;
+	return false;
+    }
+
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeLayerInfo n = new NodeLayerInfo();
+
+	NodeText nkey, nval;
+
+	n.requireToken(toker, TokenKeyword.LAYERINFO);
+	n.addNode(nkey = (NodeText) NodeText.parse(toker));
+	n.requireToken(toker, TokenPunct.ASSIGN);
+	n.addNode(nval = (NodeText) NodeText.parse(toker));
+	n.requireToken(toker, TokenPunct.SCOLON);
+
+	n.key = nkey.getText();
+	n.val = nval.getText();
+
+	return n;
+    }
+
+    public void asS2 (Indenter o)
+    {
+	o.tabwrite("layerinfo ");
+	o.write(Backend.quoteString(key));
+	o.write(" = ");
+	o.write(Backend.quoteString(val));
+	o.writeln(";");
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o)
+    {
+	o.tabwriteln("set_layer_info("+
+		     bp.getLayerIDString() + "," +
+		     bp.quoteString(key) + "," +
+		     bp.quoteString(val) + ");");
+    }
+
+    public void check (Layer l, Checker ck) throws Exception 
+    {
+	l.setLayerInfo(key, val);
+    } 
+
+
+};
+
+

wcmtools/s2/danga/s2/NodeLogAndExpr.java

@@ -0,0 +1,60 @@
+package danga.s2;
+
+public class NodeLogAndExpr extends Node
+{
+    Node lhs;
+    Node rhs;
+    
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {
+	return NodeEqExpr.canStart(toker);
+    }
+    
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeLogAndExpr n = new NodeLogAndExpr();
+
+	n.lhs = NodeEqExpr.parse(toker);
+	n.addNode(n.lhs);
+
+	Token t = toker.peek();
+	if (t.equals(TokenKeyword.AND)) {
+	    n.eatToken(toker);
+	} else {
+	    return n.lhs;
+	}
+
+	n.rhs = NodeEqExpr.parse(toker);
+	n.addNode(n.rhs);
+	
+	return n;
+    }
+
+    public Type getType (Checker ck) throws Exception
+    {
+	Type lt = lhs.getType(ck);
+	Type rt = rhs.getType(ck);
+	if (! lt.equals(rt) || ! lt.isBoolable()) 
+	    throw new Exception("The left and right side of the 'and' expression must "+
+				"both be of either type bool or int at "+getFilePos());
+	return lt;
+    }
+
+
+    public void asS2 (Indenter o) {
+	lhs.asS2(o);
+	if (rhs != null) {
+	    o.write(" and ");
+	    rhs.asS2(o);
+	}
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o) {
+	lhs.asPerl(bp, o);
+	if (rhs != null) {
+	    o.write(" && ");
+	    rhs.asPerl(bp, o);
+	}
+    }
+
+}

wcmtools/s2/danga/s2/NodeLogOrExpr.java

@@ -0,0 +1,61 @@
+package danga.s2;
+
+public class NodeLogOrExpr extends Node
+{
+    Node lhs;
+    TokenKeyword op;
+    Node rhs;
+    
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {
+	return NodeLogAndExpr.canStart(toker);
+    }
+    
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeLogOrExpr n = new NodeLogOrExpr();
+
+	n.lhs = NodeLogAndExpr.parse(toker);
+	n.addNode(n.lhs);
+
+	Token t = toker.peek();
+
+	if (t.equals(TokenKeyword.OR) || t.equals(TokenKeyword.XOR)) {
+	    n.op = (TokenKeyword) t;
+	    n.eatToken(toker);
+	} else {
+	    return n.lhs;
+	}
+
+	n.rhs = NodeLogOrExpr.parse(toker);
+	n.addNode(n.rhs);
+
+	return n;
+    }
+
+    public Type getType (Checker ck) throws Exception
+    {
+	Type lt = lhs.getType(ck);
+	Type rt = rhs.getType(ck);
+	if (! lt.equals(rt) || ! lt.isBoolable()) 
+	    throw new Exception("The left and right side of the 'or' expression must "+
+				"both be of either type bool or int at "+getFilePos());
+	return lt;
+    }
+
+    public void asS2 (Indenter o) {
+	lhs.asS2(o);
+	if (rhs != null) {
+	    o.write(" " + op.getIdent() + " ");
+	    rhs.asS2(o);
+	}
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o) {
+	lhs.asPerl(bp, o);
+	if (rhs != null) {
+	    o.write(" || ");
+	    rhs.asPerl(bp, o);
+	}
+    }
+}

wcmtools/s2/danga/s2/NodeNamedType.java

@@ -0,0 +1,48 @@
+package danga.s2;
+
+public class NodeNamedType extends Node
+{
+    public Type type;
+    public NodeType typenode;
+    public String name;
+
+    public Type getType () {
+	return type;
+    }
+    public String getName () {
+	return name;
+    }
+
+    public NodeNamedType () {
+    }
+
+    public NodeNamedType (String name, Type type) {
+	this.name = name;
+	this.type = type;
+    }
+
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeNamedType n = new NodeNamedType();
+
+	n.typenode = (NodeType) NodeType.parse(toker);
+	n.type = n.typenode.getType();
+
+	n.addNode(n.typenode);
+	n.name = n.getIdent(toker).getIdent();
+
+	return n;
+    }
+
+    public void asS2 (Indenter o) 
+    {
+	typenode.asS2(o);
+	o.write(" " + name);
+    }
+
+    public String toString ()  // was asString
+    {
+	return type.toString() + " " + name;
+    }
+
+};

wcmtools/s2/danga/s2/NodePrintStmt.java

@@ -0,0 +1,66 @@
+package danga.s2;
+
+public class NodePrintStmt extends Node
+{
+    NodeExpr expr;
+    boolean doNewline = false;
+
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {	
+	if (toker.peek().equals(TokenKeyword.PRINT) ||
+	    toker.peek().equals(TokenKeyword.PRINTLN) ||
+	    toker.peek() instanceof TokenStringLiteral)
+	    return true;
+	return false;
+    }
+    
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodePrintStmt n = new NodePrintStmt();
+	Token t = toker.peek();
+
+	if (t.equals(TokenKeyword.PRINT)) {
+	    n.setStart(n.eatToken(toker));
+	}
+	if (t.equals(TokenKeyword.PRINTLN)) {
+	    n.setStart(n.eatToken(toker));
+	    n.doNewline = true;
+	}
+
+	n.addNode(n.expr = (NodeExpr) NodeExpr.parse(toker));
+	n.requireToken(toker, TokenPunct.SCOLON);
+
+	return n;
+    }
+
+    public void check (Layer l, Checker ck) throws Exception
+    {
+        Type t = expr.getType(ck);
+        if (t.equals(Type.INT) || t.equals(Type.STRING)) {
+	    return;
+	}
+	throw new Exception("Print statement must print an expression of type "
+			    +"int or string, not "+t+" at "+expr.getFilePos());
+    }
+
+    public void asS2 (Indenter o)
+    {
+	if (doNewline) 
+	    o.tabwrite("println ");
+	else 
+	    o.tabwrite("print ");
+	expr.asS2(o);
+	o.writeln(";");
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o)
+    {
+	o.tabwrite("pout(");
+	expr.asPerl(bp, o);
+	if (doNewline) {
+	    o.write(" . \"\\n\"");
+	}
+	o.writeln(");");
+    }
+
+};

wcmtools/s2/danga/s2/NodeProduct.java

@@ -0,0 +1,89 @@
+package danga.s2;
+
+public class NodeProduct extends Node
+{
+    Node lhs;
+    TokenPunct op;
+    Node rhs;
+
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {
+	return NodeUnaryExpr.canStart(toker);
+    }
+    
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	Node lhs = NodeUnaryExpr.parse(toker);
+
+	while (toker.peek().equals(TokenPunct.MULT) ||
+	       toker.peek().equals(TokenPunct.DIV) ||
+               toker.peek().equals(TokenPunct.MOD)) {
+	    lhs = parseAnother(toker, lhs);
+	}
+	return lhs;
+    }
+
+    private static Node parseAnother (Tokenizer toker, Node lhs) throws Exception
+    {
+	NodeProduct n = new NodeProduct();	
+
+	n.lhs = lhs;
+	n.addNode(n.lhs);
+	
+	n.op = (TokenPunct) toker.peek();
+	n.eatToken(toker);
+	n.skipWhite(toker);
+
+	n.rhs = NodeUnaryExpr.parse(toker);
+	n.addNode(n.rhs);
+	n.skipWhite(toker);
+
+	return n;
+    }
+
+    public Type getType (Checker ck) throws Exception
+    {
+	Type lt = lhs.getType(ck);
+	Type rt = rhs.getType(ck);
+	if (! rt.equals(Type.INT)) {
+	    throw new Exception("Right hand side of " + op.getPunct() + " operator is not an integer at "+
+				rhs.getFilePos());
+	}
+	if (! lt.equals(Type.INT)) {
+	    throw new Exception("Left hand side of " + op.getPunct() + " operator is not an integer at "+
+				lhs.getFilePos());
+	}
+	
+	return Type.INT;
+    }
+
+    public void asS2 (Indenter o) 
+    {
+	BackendS2.LParen(o);
+	lhs.asS2(o);
+	if (op != null) {
+	    o.write(" " + op.getPunct() + " ");
+	    rhs.asS2(o);
+	}
+	BackendS2.RParen(o);
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o) 
+    {
+        if (op == TokenPunct.DIV)
+            o.write("int(");
+	lhs.asPerl(bp, o);
+	if (op != null) {
+            if (op == TokenPunct.MULT)
+                o.write(" * ");
+            else if (op == TokenPunct.DIV)
+                o.write(" / ");
+            else if (op == TokenPunct.MOD)
+                o.write(" % ");
+	    rhs.asPerl(bp, o);
+            if (op == TokenPunct.DIV)
+                o.write(")");
+	}
+    }
+
+}

wcmtools/s2/danga/s2/NodeProperty.java

@@ -0,0 +1,189 @@
+package danga.s2;
+
+import java.util.LinkedList;
+import java.util.ListIterator;
+
+public class NodeProperty extends Node
+{
+    NodeNamedType nt;
+    LinkedList pairs;
+    boolean builtin = false, use = false, hide = false;
+    String uhName;    // if use or hide, then this is property to use/hide
+
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {
+	if (toker.peek().equals(TokenKeyword.PROPERTY))
+	    return true;
+	return false;
+    }
+
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeProperty n = new NodeProperty();
+	n.pairs = new LinkedList();
+
+	n.setStart(n.requireToken(toker, TokenKeyword.PROPERTY));
+
+	if (toker.peek().equals(TokenKeyword.BUILTIN)) {
+	    n.builtin = true;
+	    n.eatToken(toker);
+	}
+
+        // parse the use/hide case
+        if (toker.peek() instanceof TokenIdent) {
+            String ident = ((TokenIdent) toker.peek()).getIdent();
+            if (ident.equals("use") || ident.equals("hide")) {
+                if (ident.equals("use")) n.use = true;
+                if (ident.equals("hide")) n.hide = true;
+                n.eatToken(toker);
+                
+                Token t = toker.peek();
+                if (! (t instanceof TokenIdent)) {
+                    throw new Exception("Expecting identifer after "+ident+" at "+t.getFilePos());
+                }
+                n.uhName = ((TokenIdent) toker.peek()).getIdent();
+                n.eatToken(toker);
+                n.requireToken(toker, TokenPunct.SCOLON);
+                return n;
+            }
+        }
+
+	n.addNode(n.nt = (NodeNamedType) NodeNamedType.parse(toker));
+
+	Token t = toker.peek();
+	if (t.equals(TokenPunct.SCOLON)) {
+	    n.eatToken(toker);
+	    return n;
+	}
+
+	n.requireToken(toker, TokenPunct.LBRACE);
+	while (NodePropertyPair.canStart(toker)) {
+	    Node pair = NodePropertyPair.parse(toker);
+	    n.tokenlist.add(pair);
+	    n.pairs.add(pair);
+	}
+	n.requireToken(toker, TokenPunct.RBRACE);
+
+	return n;
+    }
+
+    public void check (Layer l, Checker ck) throws Exception 
+    {
+        if (use) {
+            if (! l.getType().equals("layout")) {
+                throw new Exception("Can't declare property usage in non-layout layer at"
+                                    + getFilePos());
+            }
+            if (ck.propertyType(uhName) == null) {
+                throw new Exception("Can't declare usage of non-existent property at"
+                                    + getFilePos());
+            }
+            return;
+        }
+
+        if (hide) {
+            if (ck.propertyType(uhName) == null) {
+                throw new Exception("Can't hide non-existent property at"
+                                    + getFilePos());
+            }
+            return;
+        }
+
+	String name = nt.getName();
+	Type type = nt.getType();
+
+	if (l.getType().equals("i18n")) {
+	    // FIXME: as a special case, allow an i18n layer to
+	    // to override the 'des' property of a property, so
+	    // that stuff can be translated
+	    return;
+	}
+
+	// only core and layout layers can define properties
+	if (! l.isCoreOrLayout()) {
+	    throw new Exception("Only core and layout layers can define new properties.");
+	}
+
+	// make sure they aren't overriding a property from a lower layer
+        Type existing = ck.propertyType(name);
+        if (existing != null && ! type.equals(existing)) {
+	    throw new Exception("Can't override property '" + name + 
+				"' at " + getFilePos() + " of type "+existing+
+                                " with new type "+type+".");
+	}
+
+        String basetype = type.baseType();
+        if (! Type.isPrimitive(basetype) && ck.getClass(basetype) == null) {
+            throw new Exception("Can't define a property of an unknown class "+
+                                "at "+nt.getFilePos());
+        }
+	
+	// all is well, so register this property with its type
+	ck.addProperty(name, type);	
+	
+    } 
+
+
+    public void asS2 (Indenter o)
+    {
+	o.tabwrite("property ");
+	if (builtin) { o.write("builtin "); }
+        if (use || hide) {
+            if (use) o.write("use ");
+            if (hide) o.write("hide ");
+            o.write(uhName);
+            o.writeln(";");
+            return;               
+        }
+	nt.asS2(o);
+	if (pairs.size() > 0) {
+	    o.writeln(" {");
+	    o.tabIn();
+	    ListIterator li = pairs.listIterator(0);
+	    while (li.hasNext()) {
+		NodePropertyPair pp = (NodePropertyPair) li.next();
+		pp.asS2(o);
+	    }
+	    o.tabOut();
+	    o.writeln("}");
+	} else {
+	    o.writeln(";");
+	}
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o)
+    {
+        if (use) {
+            o.tabwriteln("register_property_use("+
+                         bp.getLayerIDString() + "," +
+                         bp.quoteString(uhName) + ");");
+            return;               
+        }
+
+        if (hide) {
+            o.tabwriteln("register_property_hide("+
+                         bp.getLayerIDString() + "," +
+                         bp.quoteString(uhName) + ");");
+            return;               
+        }
+
+	o.tabwriteln("register_property("+
+		     bp.getLayerIDString() + "," +
+		     bp.quoteString(nt.getName()) + ",{");
+	o.tabIn();
+        o.tabwriteln("\"type\"=>" +
+		     bp.quoteString(nt.getType().toString())+",");
+
+	ListIterator li = pairs.listIterator();
+
+	while (li.hasNext()) {
+	    NodePropertyPair pp = (NodePropertyPair) li.next();
+	    o.tabwriteln(bp.quoteString(pp.getKey()) + "=>" +
+			 bp.quoteString(pp.getVal()) + ",");
+	    
+	}
+	o.tabOut();
+	o.writeln("});");
+    }
+
+};

wcmtools/s2/danga/s2/NodePropertyPair.java

@@ -0,0 +1,40 @@
+package danga.s2;
+
+public class NodePropertyPair extends Node
+{
+    NodeText key;
+    NodeText val;
+
+    public String getKey () { return key.getText(); }
+    public String getVal () { return val.getText(); }
+
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {
+	if (NodeText.canStart(toker))
+	    return true;
+	return false;
+    }
+
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodePropertyPair n = new NodePropertyPair();
+	
+	n.addNode(n.key = (NodeText) NodeText.parse(toker));
+	n.requireToken(toker, TokenPunct.ASSIGN);
+	n.addNode(n.val = (NodeText) NodeText.parse(toker));
+	n.requireToken(toker, TokenPunct.SCOLON);
+	
+	return n;
+    }
+
+    public void asS2 (Indenter o) 
+    {
+	o.doTab();
+	key.asS2(o);
+	o.write(" = ");
+	val.asS2(o);
+	o.writeln(";");
+    }
+
+
+};

wcmtools/s2/danga/s2/NodeRange.java

@@ -0,0 +1,77 @@
+package danga.s2;
+
+public class NodeRange extends Node
+{
+    Node lhs;
+    Node rhs;
+
+    public NodeRange() {
+    }
+    public NodeRange(Node start, Node end) {
+	this.lhs = start;
+	this.rhs = end;
+    }
+
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {
+	return NodeLogOrExpr.canStart(toker);
+    }
+
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeRange n = new NodeRange();
+
+	n.lhs = NodeLogOrExpr.parse(toker);
+	n.addNode(n.lhs);
+
+	if (toker.peek().equals(TokenPunct.DOTDOT)) {
+	    n.eatToken(toker);
+	    n.skipWhite(toker);
+	} else {
+	    return n.lhs;
+	}
+
+	n.rhs = NodeLogOrExpr.parse(toker);
+	n.addNode(n.rhs);
+
+	return n;
+    }
+
+    public Type getType (Checker ck) throws Exception
+    {
+        return getType(ck, null);
+    }
+
+    public Type getType (Checker ck, Type wanted) throws Exception
+    {
+	Type lt = lhs.getType(ck, wanted);
+	Type rt = rhs.getType(ck, wanted);
+
+        if (! lt.equals(Type.INT)) {
+	    throw new Exception("Left operand of '..' range operator is not int at "+lhs.getFilePos());
+	}
+        if (! rt.equals(Type.INT)) {
+	    throw new Exception("Right operand of '..' range operator is not int at "+rhs.getFilePos());
+	}
+        Type ret = new Type("int");
+        ret.makeArrayOf();
+        return ret;
+    }
+
+    public void asS2 (Indenter o)
+    {
+	lhs.asS2(o);
+        o.write(" .. ");
+        rhs.asS2(o);
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o)
+    {
+        o.write("[");
+	lhs.asPerl(bp, o);
+        o.write(" .. ");
+        rhs.asPerl(bp, o);
+        o.write("]");
+    }
+
+}

wcmtools/s2/danga/s2/NodeRelExpr.java

@@ -0,0 +1,93 @@
+package danga.s2;
+
+public class NodeRelExpr extends Node
+{
+    Node lhs;
+    TokenPunct op;
+    Node rhs;
+
+    private Type myType;  // for backend later
+    
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {
+	return NodeSum.canStart(toker);
+    }
+    
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeRelExpr n = new NodeRelExpr();
+
+	n.lhs = NodeSum.parse(toker);
+	n.addNode(n.lhs);
+
+	Token t = toker.peek();
+
+	if (t.equals(TokenPunct.LT) || t.equals(TokenPunct.LTE) ||
+	    t.equals(TokenPunct.GT) || t.equals(TokenPunct.GTE)) {
+	    n.op = (TokenPunct) t;
+	    n.eatToken(toker);
+	    n.skipWhite(toker);
+	} else {
+	    return n.lhs;
+	}
+
+	n.rhs = NodeSum.parse(toker);
+	n.skipWhite(toker);   
+
+	return n;
+    }
+
+    public Type getType (Checker ck) throws Exception
+    {
+	Type lt = lhs.getType(ck);
+	Type rt = rhs.getType(ck);
+	if (! lt.equals(rt)) 
+	    throw new Exception("The types of the left and right hand side of "+
+				"comparision test expression don't match at "+getFilePos());
+	if (lt.equals(Type.STRING) || lt.equals(Type.INT)) {
+	    myType = lt;
+	    return Type.BOOL;
+	}
+	throw new Exception ("Only string and int types can be compared at "+
+			     getFilePos());
+    }
+    
+    public void asS2 (Indenter o) 
+    {
+	lhs.asS2(o);
+	if (op != null) {
+	    o.write(" " + op.getPunct() + " ");
+	    rhs.asS2(o);
+	}
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o)
+    {
+	lhs.asPerl(bp, o);
+	if (op != null) {
+	    if (op.equals(TokenPunct.LT)) {
+		if (myType.equals(Type.STRING))
+		    o.write(" lt ");
+		else 
+		    o.write(" < ");
+	    } else if (op.equals(TokenPunct.LTE)) {
+		if (myType.equals(Type.STRING))
+		    o.write(" le ");
+		else 
+		    o.write(" <= ");
+	    } else if (op.equals(TokenPunct.GT)) {
+		if (myType.equals(Type.STRING))
+		    o.write(" gt ");
+		else 
+		    o.write(" > ");
+	    } else if (op.equals(TokenPunct.GTE)) {
+		if (myType.equals(Type.STRING))
+		    o.write(" ge ");
+		else 
+		    o.write(" >= ");
+	    }
+	    rhs.asPerl(bp, o);
+	}
+    }
+
+}

wcmtools/s2/danga/s2/NodeReturnStmt.java

@@ -0,0 +1,63 @@
+package danga.s2;
+
+public class NodeReturnStmt extends Node
+{
+    NodeExpr expr;
+
+    public static boolean canStart (Tokenizer toker) throws Exception
+    {	
+	if (toker.peek().equals(TokenKeyword.RETURN))
+	    return true;
+	return false;
+    }
+    
+    public static Node parse (Tokenizer toker) throws Exception
+    {
+	NodeReturnStmt n = new NodeReturnStmt();
+
+	n.setStart(n.requireToken(toker, TokenKeyword.RETURN));
+
+	// optional return expression
+	if (NodeExpr.canStart(toker)) {
+	    n.addNode(n.expr = (NodeExpr) NodeExpr.parse(toker));
+	}
+
+	n.requireToken(toker, TokenPunct.SCOLON);
+
+	return n;
+    }
+
+    public void check (Layer l, Checker ck) throws Exception
+    {
+	Type exptype = ck.getReturnType();
+	Type rettype = expr != null ? expr.getType(ck) : Type.VOID;
+
+	if (! ck.typeIsa(rettype, exptype)) {
+	    throw new Exception("Return type of "+rettype+" at "+
+				getFilePos()+" doesn't match expected type of "+
+				exptype+" for this function.");
+	}
+    }
+
+    public void asS2 (Indenter o)
+    {
+	o.tabwrite("return");
+	if (expr != null) {
+	    o.write(" ");
+	    expr.asS2(o);
+	}
+	o.writeln(";");
+    }
+
+    public void asPerl (BackendPerl bp, Indenter o)
+    {
+	o.tabwrite("return");
+	if (expr != null) {
+	    o.write(" ");
+	    expr.asPerl(bp, o);
+	}
+	o.writeln(";");
+    }
+
+
+};