#!/usr/local/bin/perl

$linelen = 72;

if ($ARGV[0] eq "-n") {
  $linelen = $ARGV[1];
  shift;
  shift;
}

# First pass: extract the Caml phrases to evaluate

open(ML, "> .input.ml") || die("Cannot create .input.ml : $!");

foreach $infile (@ARGV) {
  open(IN, $infile) || die("Cannot open $infile : $!");
  while(<IN>) {
    if (m/^\\begin{caml_(example|eval)}\s*$/) {
      while(<IN>) {
        last if m/^\\end{caml_(example|eval)}\s*$/;
        print ML $_;
      }
    }
  }
  close(IN);
}

close(ML);

# Feed the phrases to a Caml toplevel

open(TOPLEVEL, "camllight 2>&1 < .input.ml |") ||
       die("Cannot start camllight : $!");

<TOPLEVEL>; <TOPLEVEL>;		# skip the banner
$lastread = <TOPLEVEL>;
$lastread =~ s/^#//;

# Second pass: shuffle the TeX source and the output of the toplevel

foreach $infile (@ARGV) {
  open(IN, $infile) || die("Cannot open $infile : $!");
  $outfile = $infile;
  $outfile =~ s/\.tex$//;
  open(OUT, "> $outfile.ml.tex") || die("Cannot create $outfile.ml.tex : $!");
  while(<IN>) {
    if (m/^\\begin{caml_example}\s*$/) {
      print OUT "\\caml\n";
      $severalphrases = 0;
      while(<IN>) {
        last if m/\\end{caml_example}\s*$/;
        print OUT "\\;" if ($severalphrases);
        while(1) {
          s/\\/\\\\/g;
          print OUT "\\?", $_;
          last if m/;;\s*$/;
          $_ = <IN>;
        }
        while($lastread) {
          last if $lastread =~ s/^#//;
          print $lastread;
          while (length($lastread) > $linelen) {
            $line = substr($lastread, 0, $linelen);
            $line =~ s/\\/\\\\/g;
            print OUT "\\:", $line, "\n";
            $lastread = substr($lastread, $linelen,
                               length($lastread) - $linelen);
          }
          $lastread =~ s/\\/\\\\/g;
          print OUT "\\:", $lastread;
          $lastread = <TOPLEVEL>;
        }
        $severalphrases = 1;
      }
      print OUT "\\endcaml\n";
    }
    elsif (m/^\\begin{caml_eval}\s*$/) {
      while(<IN>) {
        last if m/^\\end{caml_eval}\s*$/;
        if (m/;;\s*$/) {
          while($lastread) {
            last if $lastread =~ s/^#//;
            print $lastread;
            $lastread = <TOPLEVEL>;
          }
        }
      }
    }
    else {
      print OUT $_;
    }
  }
  close(IN);
  close(OUT);
}

close(TOPLEVEL);
unlink(".input.ml");
