#!/usr/local/perl5.002/bin/perl

# comment the next line if the modules are in the working directory.
# make sure the directory matches ADAPTDIR in the Makefile.
use lib '/b/poe/lib/adapt';

# adapt - main program of the Adaptive Perl compiler
# Copyright (C) 1996 Peter Orbaek <poe@daimi.aau.dk>
# This code is freely re-distributable under the GNU General Public License
# Version 1.0 11-May-96

=pod

=head1 NAME

adapt - adapt an Adaptive Perl program to a class specification

=head1 SYNOPSIS

adapt [B<-go>] I<classfile> I<programfile>

=head1 DESCRIPTION

The B<adapt> program compiles a Adaptive Perl program (in
I<programfile>) and a class description (in I<classfile>) to a Perl 5
module named I<programfile>C<.pm>. 

=head2 Version

This is version 1.0 of the Adaptive Perl "compiler". 

=head1 OPTIONS

The B<-g> causes Perl code to be generated for the class inheritance
hierarchy. The B<-o> option causes code for the common ancestor class
C<Object> to be generated. This class provides an inheritable C<new>
constructor and initializer and an inhertiable C<display> method that
be used to dump objects to a filehandle. These methods can be used as:

  @MyClass::ISA = qw(Object);  # typically generated from classfile
  $obj = new MyClass (field1 => 2, field2 => 3);
  $obj->display(\*STDOUT);

=head1 CLASS DEFINITION SYNTAX

Class definitions are written in the following BNF syntax.  Comment
are indicated by "#" and extend to the end of the line.

  ClassFile ::= ClassSpec* "*EOF*"

  ClassSpec ::= "class" ClassName Inherits? Data? "endclass"

  Inherits ::= "inherits" ClassNameList

  ClassNameList ::= ClassName | ClassName "," ClassNameList

  Data ::= "is" FieldSpec*

  FieldSpec ::= FieldNameList ":" ClassName

  FieldNameList ::= FieldName | FieldName "," FieldNameList

  FieldName ::= [_\w][_\{\}\[\]\w\d]*

  ClassName ::= [_\w][_\w\d]*

Here's an example of some class definitions:

  class Exp inherits Object is
    exp_flag: Flag
  endclass

  class If inherits Exp is
    c,t,e: Exp
  endclass

  class Var inherits Exp is
    s: Str
  endclass

  class Comb inherits Exp is
    l,r: Exp
    comb_flag: Flag
  endclass

  # this is just to test and show that multiple inheritance is supported
  class Derived inherits Comb,If is
    field: Str
  endclass

Semi-colons are treated as white-space in class definition files to
allow C++ programmers to write them after classnames.

C<Object> is the name of the top-level most general class. Class names
can be used in class definitions without being defined, just as
C<Flag> is here. It just means that objects of class C<Flag> are to be
implemented in ordinary Perl 5 on the side. This also provides a large
degree of interoperability between plain Perl 5 and Adaptive
Perl. Most real programs will not be written entirely in Adaptive
Perl, but will contain some parts of Adaptive Perl and some parts of
Perl 5.

=head1 PROGRAM SYNTAX

Programs in Adaptive Perl are traversal specifications. Comments
written the same way as in class definitions.

  ProgFile ::= Traversal*

  Traversal ::= "traversal" TraversalName Param? TravSpec

  Param ::= "(" [^\)]* ")"

  TravSpec ::= "from" ClassName "to" ClassNameList ForSpec* "do" 
                DoSpec* "endtraversal"

  ForSpec ::= "for" ClassNameList "only" FieldNameList
            | "for" ClassNameList "not" FieldNameList

  DoSpec ::= ^ClassName "." (pre|post|fixed) ":" Code
           | initialize ":" Code
           | finalize ":" Code

C<Code> stands for ordinary Perl 5 code.  Here's an example program
with a single traversal specification:

  # compute assoc of free vars in the expression and print it

  traversal freevars($set)
  from Exp to Var
    for If,Derived only t,e
  do

  initialize:
	%$set = ();
  Var.post:
	$set->{$self->{s}}++;
  Lambda.post:
	delete $set->{$self->{var}};
  finalize:
	my ($x);
	foreach $x (keys %$set) {
		print "free variable: $x\n";
	}
  endtraversal

The code fragments for different classes are separated by looking for
a class name at the beginning of a line with a dot and a placement
(C<pre>, C<post>, or C<fixed>) followed immediately by a colon, or the
strings "C<initialize:>" or "C<finalize:>" at the beginning of a line.
See the example programs for more information.

You can intersperse Perl code between traversal specifications, like this:

  package MyPack;
  my ($variable);

  traversal foo from A to B do
	...
  endtraversal

  $variable = new A;
  $variable->foo;

=head1 REQUIREMENTS

Adaptive Perl builds upon Perl 5.002 or later and is written in Perl
5.

=head1 AUTHOR

Peter Orbaek, C<poe@daimi.aau.dk>

=head1 BUGS

Probably some.

=cut

#---------------------------------------------------------------------------
require 5.002;
use vars qw($opt_g $opt_o);
use strict 'vars', 'subs';
use Carp;
use ClassParser qw(parseClassFile);
use ProgParser qw(parseProgFile);
require Codegen;
use Getopt::Std;

if (!&getopts('og') or @ARGV != 2) {
    print <<EOUSAGE;
Usage: $0 [-og] <classfile> <programfile>
  The adapted Perl 5 program will be written out to <programfile>.pm.
  Specifying option -o generates the Object class code.
  Specifying -g generates of the class inheritance hierarchy.
EOUSAGE
    exit(1);
}

my ($stem) = $ARGV[1];
$stem =~ s/\.[^\.]*$//;   # remove extension from program file name

# parse the class file and build %classes hash
parseClassFile($ARGV[0]) or croak "Parse errors.\n";

# temp file setup
Codegen::init("$stem.pm");

# generate class defs and some common methods
&Codegen::genobject if $opt_o;
&Codegen::genclasses if $opt_g;

# read and parse the program file building Perl code on the fly
if (parseProgFile $ARGV[1]) {
    # commit to the changes is all went well, ie. move tempfile to target
    &Codegen::commit;
} else {
    # parse error: forget about the tempfile and remove it
    &Codegen::rollback;
    exit(1);
}

exit(0);