diff -r ee218296d635 -r 028e39e5e8f3 src/Tools/Metis/scripts/mlpp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Tools/Metis/scripts/mlpp	Wed Jun 20 22:07:52 2007 +0200
@@ -0,0 +1,297 @@
+#!/usr/bin/perl
+
+# Copyright (c) 2006 Joe Hurd, All Rights Reserved
+
+use strict;
+use warnings;
+use Pod::Usage;
+use Getopt::Std;
+
+use vars qw($opt_h $opt_c $opt_r);
+
+getopts('hc:r:');
+
+if ($opt_h or scalar @ARGV == 0)
+{
+    pod2usage({-exitval => 2,
+	       -verbose => 2});
+}
+
+if (!$opt_c) { die "mlpp: you must specify the SML compiler\n"; }
+if ($opt_c ne "mosml" && $opt_c ne "mlton" && $opt_c ne "isabelle") {
+    die "mlpp: the SML compiler must be one of {mosml,mlton,isabelle}.\n";
+}
+
+# Autoflush STDIN
+$|++;
+
+sub unquotify {
+    if (scalar @_ == 0) { return; }
+
+    my $pre = "[";
+
+    for my $quote (@_) {
+        my $nl = chomp $quote;
+        my @qs = split (/\^(\w+)/, $quote);
+        my @ps = ();
+
+        for (my $s = 0; 0 < scalar @qs; $s = 1 - $s) {
+            my $q = shift @qs;
+            if ($s == 0) {
+                $q =~ s/\\/\\\\/g;
+                $q =~ s/\"/\\\"/g;
+                push @ps, "QUOTE \"$q\"" unless ($q eq "");
+            }
+            elsif ($s == 1) {
+                push @ps, "ANTIQUOTE $q";
+            }
+            else { die; }
+        }
+
+        if (0 < $nl) {
+            if (0 < scalar @ps) {
+                my $p = pop @ps;
+                if ($p =~ /QUOTE \"(.*)\"/) { push @ps, "QUOTE \"$1\\n\""; }
+                else { push @ps, $p; push @ps, "QUOTE \"\\n\""; }
+            }
+            else { push @ps, "QUOTE \"\\n\""; }
+        }
+        else {
+            (0 < scalar @ps) or die;
+        }
+
+        print STDOUT ($pre . join (", ", @ps));
+        $pre = ",\n";
+    }
+
+    print STDOUT "]";
+}
+
+sub print_normal {
+    (scalar @_ == 1) or die;
+    my $text = shift @_;
+
+    if ($opt_c eq "mosml") {
+        $text =~ s/PP\.ppstream/ppstream/g;
+        $text =~ s/TextIO\.inputLine/TextIO_inputLine/g;
+    }
+
+    print STDOUT $text;
+}
+
+sub process_file {
+    (scalar @_ == 1) or die;
+    my $filename = shift @_;
+    my $line_num = 0;
+
+    if ($opt_c eq "mlton") {
+        print STDOUT "(*#line 0.0 \"$filename\"*)\n";
+    }
+
+    open my $INPUT, "$filename";
+
+    my $state = "normal";
+    my $comment = 0;
+    my $revealed_comment = 0;
+    my @quotes = ();
+
+    while (my $line = <$INPUT>) {
+        (chomp ($line) == 1)
+            or warn "no terminating newline in $filename\nline = '$line'\n";
+
+        while (1) {
+            if ($state eq "quote") {
+                if ($line =~ /(.*?)\`(.*)$/) {
+                    push @quotes, $1;
+                    $line = $2;
+                    unquotify @quotes;
+                    @quotes = ();
+                    $state = "normal";
+                }
+                else {
+                    push @quotes, "$line\n";
+                    last;
+                }
+            }
+            elsif ($state eq "comment") {
+                if ($line =~ /^(.*?)(\(\*|\*\))(.*)$/) {
+                    my $leadup = $1;
+                    my $pat = $2;
+                    $line = $3;
+                    print STDOUT $leadup;
+
+                    if ($pat eq "(*") {
+                        print STDOUT $pat;
+                        ++$comment;
+                    }
+                    elsif ($pat eq "*)") {
+                        print STDOUT $pat;
+                        --$comment;
+                        if ($comment == 0) { $state = "normal"; }
+                    }
+                    else {
+                        die;
+                    }
+                }
+                else {
+                    print STDOUT "$line\n";
+                    last;
+                }
+            }
+            elsif ($state eq "dquote") {
+                if ($line =~ /^(.*?)\"(.*)$/) {
+                    my $leadup = $1;
+                    $line = $2;
+                    print STDOUT ($leadup . "\"");
+
+                    if ($leadup =~ /(\\+)$/ && ((length $1) % 2 == 1)) {
+                        # This is an escaped double quote
+                    }
+                    else {
+                        $state = "normal";
+                    }
+                }
+                else {
+                    die "EOL inside \" quote\n";
+                }
+            }
+            elsif ($state eq "normal") {
+                if ($line =~ /^ *use *\"([^"]+)\" *; *$/) {
+                    my $use_filename = $1;
+                    if ($use_filename !~ /^\// && $filename =~ /^(.*)\//) {
+                        $use_filename = $1 . '/' . $use_filename;
+                    }
+                    process_file ($use_filename);
+                    if ($opt_c eq "mlton") {
+                        print STDOUT "(*#line $line_num.0 \"$filename\"*)\n";
+                    }
+                    print STDOUT "\n";
+                    last;
+                }
+                elsif ($line =~ /^(.*?)(\`|\(\*|\*\)|\")(.*)$/) {
+                    my $leadup = $1;
+                    my $pat = $2;
+                    $line = $3;
+                    print_normal $leadup;
+                    
+                    if ($pat eq "`") {
+                        $state = "quote";
+                    }
+                    elsif ($pat eq "(*") {
+                        my $is_revealed = 0;
+                        if ($line =~ /^([[:alnum:]_-]+)/) {
+                            my $rev = $1;
+                            if ($rev eq $opt_c ||
+                                ($opt_r && $rev =~ /^$opt_r$/)) {
+                                my $rev_len = length $rev;
+                                $line = substr $line, $rev_len;
+                                ++$revealed_comment;
+                                $is_revealed = 1;
+                            }
+                        }
+                        if (!$is_revealed) {
+                            print STDOUT $pat;
+                            $state = "comment";
+                            ++$comment;
+                        }
+                    }
+                    elsif ($pat eq "*)") {
+                        if ($revealed_comment == 0) {
+                            die "Too many comment closers.\n"
+                        }
+                        --$revealed_comment;
+                    }
+                    elsif ($pat eq "\"") {
+                        print STDOUT $pat;
+                        $state = "dquote";
+                    }
+                    else {
+                        die;
+                    }
+                }
+                else {
+                    print_normal "$line\n";
+                    last;
+                }
+            }
+            else {
+                die;
+            }
+        }
+
+        ++$line_num;
+    }
+
+    if ($state eq "quote") {
+        die "EOF inside \` quote\n";
+    }
+    elsif ($state eq "dquote") {
+        die "EOF inside \" quote\n";
+    }
+    elsif ($state eq "comment") {
+        die "EOF inside comment\n";
+    }
+    else {
+        ($state eq "normal") or die;
+    }
+
+    close $INPUT;
+}
+
+while (0 < scalar @ARGV) {
+    my $filename = shift @ARGV;
+    process_file $filename;
+}
+
+__END__
+
+=pod
+
+=head1 NAME
+
+mlpp - preprocesses SML files for compilation
+
+=head1 SYNOPSIS
+
+mlpp [-h] [-c compiler] [-r TAG] sml-file ... > preprocessed-sml-file
+
+=head1 ARGUMENTS
+
+The recognized flags are described below:
+
+=over 2
+
+=item B<-h>
+
+Produce this documentation.
+
+=item B<-c compiler>
+
+Select the SML compiler that will be used.
+
+=item B<-r TAG-REGEX>
+
+Remove all comment brackets tagged like this: (*TAG revealed-code *)
+where the TAG-REGEX matches the TAG.
+
+=back
+
+=head1 DESCRIPTION
+
+Concatenates the input list of SML source files into a single file
+ready to be compiled, by expanding quotations and antiquotations, and
+concatenating into a single file.
+
+=head1 BUGS
+
+Waiting to rear their ugly heads.
+
+=head1 AUTHORS
+
+Joe Hurd <joe@gilith.com>
+
+=head1 SEE ALSO
+
+Perl(1).
+
+=cut