autoconf/bin/autom4te.in

#! @PERL@ -w
# -*- perl -*-
# @configure_input@

eval 'exec @PERL@ -S $0 ${1+"$@"}'
    if 0;

# autom4te - Wrapper around M4 libraries.
# Copyright 2001, 2002 Free Software Foundation, Inc.

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA.


BEGIN
{
  my $datadir = ($ENV{'autom4te_perllibdir'} || '@datadir@');
  unshift @INC, "$datadir";
}

## --------- ##
## Request.  ##
## --------- ##

package Request;

use Data::Dumper;
use Autom4te::General;
use Autom4te::Struct;
use Autom4te::XFile;
use Carp;
use strict;

# List of requests.
# We can't declare it `my' as the loading, performed via `do',
# would refer to another scope, and @request would not be updated.
# It used to work with `my' vars, and I don't know whether the current
# behavior (5.6) is wanted or not.
use vars qw(@request);

struct
  (
   # The key of the cache files.
   'id' => "\$",
   # True iff %MACRO contains all the macros we want to trace.
   'valid' => "\$",
   # The include path.
   'path' => '@',
   # The set of input files.
   'input' => '@',
   # The set of macros currently traced.
   'macro' => '%',
  );


# $REQUEST-OBJ
# retrieve ($SELF, %ATTR)
# -----------------------
# Find a request with the same path and input.
# Private.
sub retrieve
{
  my ($self, %attr) = @_;

  foreach (@request)
    {
      # Same path.
      next
	if join ("\n", @{$_->path}) ne join ("\n", @{$attr{path}});

      # Same inputs.
      next
	if join ("\n", @{$_->input}) ne join ("\n", @{$attr{input}});

      # Found it.
      return $_;
    }

  return undef;
}


# $REQUEST-OBJ
# register ($SELF, %ATTR)
# -----------------------
# NEW should not be called directly.
# Private.
sub register ($%)
{
  my ($self, %attr) = @_;

  # path and input are the only ID for a request object.
  my $obj = $self->new ('path'  => $attr{path},
			'input' => $attr{input});
  push @request, $obj;

  # Assign an id for cache file.
  $obj->id ("$#request");

  return $obj;
}


# $REQUEST-OBJ
# request($SELF, %REQUEST)
# ------------------------
# Return a request corresponding to $REQUEST{path} and $REQUEST{input},
# using a cache value if it exists.
sub request ($%)
{
  my ($self, %request) = @_;

  my $req = Request->retrieve (%request) || Request->register (%request);

  # If there are new traces to produce, then we are not valid.
  foreach (@{$request{'macro'}})
    {
      if (! exists ${$req->macro}{$_})
        {
          ${$req->macro}{$_} = 1;
          $req->valid (0);
        }
    }

  # It would be great to have $REQ check that it up to date wrt its
  # dependencies, but that requires gettting traces (to fetch the
  # included files), which is out of the scope of Request
  # (currently?).

  return $req;
}

# Serialize a request or all the current requests.
sub marshall
{
  my ($caller) = @_;
  my $res = '';

  if (ref ($caller))
    {
      # CALLER is an object: instance method.
      my $marshall = Data::Dumper->new ([$caller]);
      $marshall->Indent(2)->Terse(0);
      $res = $marshall->Dump . "\n";
    }
  else
    {
      # CALLER is the package: class method.
      my $marshall = Data::Dumper->new ([\@request], [qw (*request)]);
      $marshall->Indent(2)->Terse(0);
      $res = $marshall->Dump . "\n";
    }

  return $res;
}


# includes_p (@MACRO)
# -------------------
# Does this request covers all the @MACRO.
sub includes_p
{
  my ($self, @macro) = @_;

  foreach (@macro)
    {
      return 0
	if ! exists ${$self->macro}{$_};
    }
  return 1;
}


# SAVE ($FILENAME)
# ----------------
sub save
{
  my ($self, $filename) = @_;

  croak "$me: cannot save a single request\n"
    if ref ($self);

  my $requests = new Autom4te::XFile ("> $filename");
  print $requests
    "# This file was created by $me.\n",
    "# It contains the lists of macros which have been traced.\n",
    "# It can be safely removed.\n",
    "\n",
    $self->marshall;
}


# LOAD ($FILE)
# ------------
sub load
{
  my ($self, $file) = @_;

  croak "$me: cannot load a single request\n"
    if ref ($self);

  (my $return) = do "$file";

  croak "$me: cannot parse $file: $@\n" if $@;
  croak "$me: cannot do $file: $!\n"    if $!;
  croak "$me: cannot run $file\n"       unless $return;
}


## ---------- ##
## Autom4te.  ##
## ---------- ##

package Autom4te;

use Autom4te::General;
use File::Basename;
use Autom4te::XFile;
use strict;

# Configuration file.
my $datadir = $ENV{'AC_MACRODIR'} || '@datadir@';
my $autom4te_cfg = $ENV{'AUTOM4TE_CFG'} || "$datadir/autom4te.cfg";

# $LANGUAGE{LANGUAGE} -- Automatic options for LANGUAGE.
my %language;

my $output = '-';

# Mode of the output file except for traces.
my $mode = "0666";

# If melt, don't use frozen files.
my $melt = 0;

# Names of the cache directory, cache directory index, trace cache
# prefix, and output cache prefix.
my $cache = "$me.cache";
my $icache = "$cache/requests";
my $tcache = "$cache/traces.";
my $ocache = "$cache/output.";

# The macros to trace mapped to their format, as specified by the
# user.
my %trace;

# The macros the user will want to trace in the future.
# We need `include' to get the included file, `m4_pattern_forbid' and
# `m4_pattern_allow' to check the output.
#
# FIXME: What about `sinclude'?
my @preselect = ('include', 'm4_pattern_allow', 'm4_pattern_forbid');

# List of warnings.
my @warning;

# M4 include path.
my @include;

# 0 for EXIT_SUCCESS.
my $exit_status = 0;

# Do we freeze?
my $freeze = 0;

# $M4.
my $m4 = $ENV{"M4"} || '@M4@';
# Some non-GNU m4's don't reject the --help option, so give them /dev/null.
die "$me: need GNU m4 1.4 or later: $m4\n"
  if system "$m4 --help </dev/null 2>&1 | fgrep reload-state >/dev/null";

# Set some high recursion limit as the default limit, 250, has already
# been hit with AC_OUTPUT.  Don't override the user's choice.
$m4 .= ' --nesting-limit=1024'
  if " $m4 " !~ / (--nesting-limit|-L) /;


# @M4_BUILTIN -- M4 builtins and a useful comment.
my @m4_builtin = `echo dumpdef | $m4 2>&1 >/dev/null`;
map { s/:.*//;s/\W// } @m4_builtin;


# %M4_BUILTIN_ALTERNATE_NAME
# --------------------------
# The builtins are renamed, e.g., `define' is renamed `m4_define'.
# So map `define' to `m4_define' and conversely.
# Some macros don't follow this scheme: be sure to properly map to their
# alternate name too.
#
# This is because GNU M4 1.4's tracing of builtins is buggy.  When run on
# this input:
#
# | divert(-1)
# | changequote([, ])
# | define([m4_eval], defn([eval]))
# | eval(1)
# | m4_eval(2)
# | undefine([eval])
# | m4_eval(3)
#
# it behaves this way:
#
# | % m4 input.m4 -da -t eval
# | m4trace: -1- eval(1)
# | m4trace: -1- m4_eval(2)
# | m4trace: -1- m4_eval(3)
# | %
#
# Conversely:
#
# | % m4 input.m4 -da -t m4_eval
# | %
#
# So we will merge them, i.e.  tracing `BUILTIN' or tracing
# `m4_BUILTIN' will be the same: tracing both, but honoring the
# *last* trace specification.
#
# FIXME: This is not enough: in the output `$0' will be `BUILTIN'
# sometimes and `m4_BUILTIN' at others.  We should return a unique name,
# the one specified by the user.
#
# FIXME: To be absolutely rigorous, I would say that given that we
# _redefine_ divert (instead of _copying_ it), divert and the like
# should not be part of this list.
my %m4_builtin_alternate_name;
@m4_builtin_alternate_name{"$_", "m4_$_"} = ("m4_$_", "$_")
  foreach (grep { !/m4wrap|m4exit|dnl|ifelse|__.*__/ } @m4_builtin);
@m4_builtin_alternate_name{"ifelse", "m4_if"}   = ("m4_if", "ifelse");
@m4_builtin_alternate_name{"m4exit", "m4_exit"} = ("m4_exit", "m4exit");
@m4_builtin_alternate_name{"m4wrap", "m4_wrap"} = ("m4_wrap", "m4wrap");


# $HELP
# -----
$help = << "EOF";
Usage: $0 [OPTION] ... [FILES]

Run GNU M4 on the FILES, avoiding useless runs.  Output the traces if tracing,
the frozen file if freezing, otherwise the expansion of the FILES.

If some of the FILES are named \`FILE.m4f\' they are considered to be M4
frozen files of all the previous files (which are therefore not loaded).
If \`FILE.m4f\' is not found, then \`FILE.m4\' will be used, together with
all the previous files.

Some files may be optional, i.e., will only be processed if found in the
include path, but then must end in \`.m4?\';  the question mark is not part of
the actual file name.

Operation modes:
  -h, --help               print this help, then exit
  -V, --version            print version number, then exit
  -v, --verbose            verbosely report processing
  -d, --debug              don\'t remove temporary files
  -o, --output=FILE        save output in FILE (defaults to \`-\', stdout)
  -f, --force              don\'t rely on cached values
  -W, --warnings=CATEGORY  report the warnings falling in CATEGORY
  -l, --language=LANG      specify the set of M4 macros to use
  -m, --mode=OCTAL         change the non trace output file mode (0666)
  -M, --melt               don\'t use M4 frozen files

Languages include:
  \`Autoconf\'   create Autoconf configure scripts
  \`Autotest\'   create Autotest test suites
  \`M4sh\'       create M4sh shell scripts
  \`M4sugar\'    create M4sugar output

Warning categories include:
  \`cross\'         cross compilation issues
  \`obsolete\'      obsolete constructs
  \`syntax\'        dubious syntactic constructs
  \`all\'           all the warnings
  \`no-CATEGORY\'   turn off the warnings on CATEGORY
  \`none\'          turn off all the warnings
  \`error\'         warnings are error

The environment variable \`WARNINGS\' is honored.

Library directories:
  -I, --include=DIR  look for FILES in DIR (cumulative)

Tracing:
  -t, --trace=MACRO      report the MACRO invocations
  -p, --preselect=MACRO  prepare to trace MACRO in a future run

Freezing:
  -F, --freeze   produce an M4 frozen state file for FILES

Report bugs to <bug-autoconf\@gnu.org>.
EOF

# $VERSION
# --------
$version =  <<"EOF";
autom4te (@PACKAGE_NAME@) @VERSION@
Written by Akim Demaille.

Copyright 2002 Free Software Foundation, Inc.
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
EOF


## ---------- ##
## Routines.  ##
## ---------- ##


# load_configuration ()
# ---------------------
# Load the configuration file.
sub load_configuration ()
{
  use Text::ParseWords;

  my $cfg = new Autom4te::XFile ($autom4te_cfg);
  my $lang;
  while ($_ = $cfg->getline)
    {
      chomp;
      # Comments.
      next
	if /^\s*(\#.*)?$/;

      my @words = shellwords ($_);
      my $type = shift @words;
      if ($type eq 'begin-language:')
	{
	  $lang = lc $words[0];
	}
      elsif ($type eq 'end-language:')
	{
	  die "$me: $autom4te_cfg:$.: end-language mismatch: $lang\n"
	    if $lang ne lc $words[0];
	}
      elsif ($type eq 'args:')
	{
	  push @{$language{$lang}}, @words;
	}
      else
	{
	  die "$me: $autom4te_cfg:$.: unknown directive: $type\n";
	}
    }
}


# parse_args ()
# -------------
# Process any command line arguments.
sub parse_args ()
{
  # We want to look for the early options, which should not be found
  # in the configuration file.  Prepend to the user arguments.
  # Perform this repeatedly so that we can use --language in language
  # definitions.  Beware that there can be several --language
  # invocations.
  my @language;
  do {
    @language = ();
    use Getopt::Long;
    Getopt::Long::Configure ("pass_through");
    GetOptions ("l|language=s" => \@language);

    foreach (@language)
      {
	die "$me: unknown language: $_\n"
	  unless exists $language{lc $_};
	unshift @ARGV, @{$language{lc $_}};
      }
  } while @language;

  # Process the arguments for real this time.
  my @trace;
  getopt
    (
     # Operation modes:
     "o|output=s"   => \$output,
     "W|warnings=s" => \@warning,
     "m|mode=s"     => \$mode,
     "M|melt"       => \$melt,

     # Library directories:
     "I|include=s" => \@include,

     # Tracing:
     # Using a hash for traces is seducing.  Unfortunately, upon `-t FOO',
     # instead of mapping `FOO' to undef, Getopt maps it to `1', preventing
     # us from distinguishing `-t FOO' from `-t FOO=1'.  So let's do it
     # by hand.
     "t|trace=s"     => \@trace,
     "p|preselect=s" => \@preselect,

     # Freezing.
     "F|freeze"  => \$freeze,
    );

  die "$me: too few arguments
Try `$me --help' for more information.\n"
    unless @ARGV;

  # Freezing:
  # We cannot trace at the same time (well, we can, but it sounds insane).
  # And it implies melting: there is risk not to update properly using
  # old frozen files, and worse yet: we could load a frozen file and
  # refreeze it!  A sort of caching :)
  die "$me: cannot freeze and trace\n"
    if $freeze && @trace;
  $melt = 1
    if $freeze;

  # Normalize the includes: the first occurrence is enough, several is
  # a pain since it introduces a useless difference in the path which
  # invalidates the cache.  And strip `.' which is implicit and always
  # first.
  @include = grep { !/^\.$/ } uniq (@include);

  # Convert @trace to %trace, and work around the M4 builtins tracing
  # problem.
  # The default format is `$f:$l:$n:$%'.
  foreach (@trace)
    {
      /^([^:]+)(?::(.*))?$/ms;
      $trace{$1} = defined $2 ? $2 : '$f:$l:$n:$%';
      $trace{$m4_builtin_alternate_name{$1}} = $trace{$1}
	if exists $m4_builtin_alternate_name{$1};
    }

  # Work around the M4 builtins tracing problem for @PRESELECT.
  push (@preselect,
	map { $m4_builtin_alternate_name{$_} }
	grep { exists $m4_builtin_alternate_name{$_} } @preselect);

  # If we find frozen files, then all the files before it are
  # discarded: the frozen file is supposed to include them all.
  #
  # We don't want to depend upon m4's --include to find the top level
  # files, so we use `find_file' here.  Try to get a canonical name,
  # as it's part of the key for caching.  And some files are optional
  # (also handled by `find_file').
  my @argv;
  foreach (@ARGV)
    {
      if (/\.m4f$/)
	{
	  # Frozen files are optional => pass a `?' to `find_file'.
	  my $file = find_file ("$_?", @include);
	  if (!$melt && $file)
	    {
	      @argv = ("--reload-state=$file");
	    }
	  else
	    {
	      s/\.m4f$/.m4/;
	      push @argv, find_file ($_, @include);
	    }
	}
      else
	{
	  my $file = find_file ($_, @include);
	  push @argv, $file
	    if $file;
	}
    }
  @ARGV = @argv;
}


# handle_m4 ($REQ, @MACRO)
# ------------------------
# Run m4 on the input files, and save the traces on the @MACRO.
sub handle_m4 ($@)
{
  my ($req, @macro) = @_;

  # The warnings are the concatenation of 1. application's defaults,
  # 2. $WARNINGS, $3 command line options, in that order.
  # Set them in the order expected by the M4 macros: the converse.
  my $m4_warnings =
    lc join (',', reverse (split (',', ($ENV{'WARNINGS'} || '')),
			   map { split /,/ } @warning));

  # GNU m4 appends when using --error-output.
  unlink ($tcache . $req->id . "t");

  # Run m4.
  #
  # Neutralize its stdin, so that GNU M4 1.5 doesn't neutralize SIGINT.
  #
  # Be extremely cautious to reverse the includes when talking to M4:
  # it doesn't speak the same --include as we do.
  #
  # We don't output directly to the cache files, to avoid problems
  # when we are interrupted (that leaves corrupted files).
  my $command = ("$m4"
		 . join (' --include=', '', reverse @include)
		 . " --define=m4_warnings=$m4_warnings"
		 . ' --debug=aflq'
		 . " --error-output=$tcache" . $req->id . "t"
		 . join (' --trace=',   '', sort @macro)
		 . " @ARGV"
		 . ' </dev/null'
		 . " >$ocache" . $req->id . "t");
  verbose "running: $command";
  system $command;
  if ($?)
    {
      verbose "$m4: failed with exit status: " . ($? >> 8) . "\n";
      exit $? >> 8;
    }

  # Everything went ok: preserve the outputs.
  foreach my $file (map { $_ . $req->id } ($tcache, $ocache))
    {
      use File::Copy;
      move ("${file}t", "$file")
	or die "$me: cannot not rename ${file}t as $file: $!\n";
    }
}


# warn_forbidden ($WHERE, $WORD, %FORBIDDEN)
# ------------------------------------------
# $WORD is forbidden.  Warn with a dedicated error message if in
# %FORBIDDEN, otherwise, a simple `error: possibly undefined macro'
# will do.
sub warn_forbidden ($$%)
{
  my ($where, $word, %forbidden) = @_;
  my $message;

  for my $re (sort keys %forbidden)
    {
      if ($word =~ $re)
	{
	  $message = $forbidden{$re};
	  last;
	}
    }
  $message ||= "possibly undefined macro: $word";
  warn "$where: error: $message\n";
}


# handle_output ($REQ, $OUTPUT)
# -----------------------------
# Run m4 on the input files, perform quadrigraphs substitution, check for
# forbidden tokens, and save into $OUTPUT.
sub handle_output ($$)
{
  my ($req, $output) = @_;

  verbose "creating $output";

  # Load the forbidden/allowed patterns.
  handle_traces ($req, "$tmp/patterns",
		 ('m4_pattern_forbid' => 'forbid:$1:$2',
		  'm4_pattern_allow'  => 'allow:$1'));
  my @patterns = new Autom4te::XFile ("$tmp/patterns")->getlines;
  chomp @patterns;
  my %forbidden =
    map { /^forbid:([^:]+):.+$/ => /^forbid:[^:]+:(.+)$/ } @patterns;
  my $forbidden = join ('|', map { /^forbid:([^:]+)/ } @patterns) || "^\$";
  my $allowed   = join ('|', map { /^allow:([^:]+)/  } @patterns) || "^\$";

  verbose "forbidden tokens: $forbidden";
  verbose "forbidden token : $_ => $forbidden{$_}"
    foreach (sort keys %forbidden);
  verbose "allowed   tokens: $allowed";

  # Read the (cached) raw M4 output, produce the actual result.  We
  # have to use the 2nd arg to have Autom4te::XFile honor the third, but then
  # stdout is to be handled by hand :(.  Don't use fdopen as it means
  # we will close STDOUT, which we already do in END.
  my $out = new Autom4te::XFile;
  if ($output eq '-')
    {
      $out->open (">$output");
    }
  else
    {
      $out->open($output, O_CREAT | O_WRONLY | O_TRUNC, oct ($mode));
    }
  die "$me: cannot create $output: $!\n"
    unless $out;
  my $in = new Autom4te::XFile ($ocache . $req->id);

  my %prohibited;
  my $res;
  while ($_ = $in->getline)
    {
      s/\s+$//;
      s/__oline__/$./g;
      s/\@<:\@/[/g;
      s/\@:>\@/]/g;
      s/\@S\|\@/\$/g;
      s/\@%:\@/#/g;

      $res = $_;

      # Don't complain in comments.  Well, until we have something
      # better, don't consider `#include' etc. are comments.
      s/\#.*//
	unless /^\#\s*(if|include|endif|ifdef|ifndef|define)\b/;
      foreach (split (/\W+/))
	{
	  $prohibited{$_} = $.
	    if /$forbidden/o && !/$allowed/o && ! exists $prohibited{$_};
	}

      # Performed *last*: the empty quadrigraph.
      $res =~ s/\@&t\@//g;

      print $out "$res\n";
    }

  # If no forbidden words, we're done.
  return
    if ! %prohibited;

  # Locate the forbidden words in the last input file.
  # This is unsatisfying but...
  my $prohibited = '\b(' . join ('|', keys %prohibited) . ')\b';
  my $file = new Autom4te::XFile ($ARGV[$#ARGV]);
  $exit_status = 1;

  while ($_ = $file->getline)
    {
      # Don't complain in comments.  Well, until we have something
      # better, don't consider `#include' etc. are comments.
      s/\#.*//
	unless /^\#(if|include|endif|ifdef|ifndef|define)\b/;

      # Complain once per word, but possibly several times per line.
      while (/$prohibited/)
	{
	  my $word = $1;
	  warn_forbidden ("$ARGV[$#ARGV]:$.", $word, %forbidden);
	  delete $prohibited{$word};
	  # If we're done, exit.
	  return
	    if ! %prohibited;
	  $prohibited = '\b(' . join ('|', keys %prohibited) . ')\b';
	}
    }
  warn_forbidden ("$output:$prohibited{$_}", $_, %forbidden)
    foreach (sort { $prohibited{$a} <=> $prohibited{$b} } keys %prohibited);
}


## --------------------- ##
## Handling the traces.  ##
## --------------------- ##


# $M4_MACRO
# trace_format_to_m4 ($FORMAT)
# ----------------------------
# Convert a trace $FORMAT into a M4 trace processing macro's body.
sub trace_format_to_m4 ($)
{
  my ($format) = @_;
  my $underscore = $_;
  my %escape = (# File name.
		'f' => '$1',
		# Line number.
		'l' => '$2',
		# Depth.
		'd' => '$3',
		# Name (also available as $0).
		'n' => '$4',
		# Escaped dollar.
		'$' => '$');

  my $res = '';
  $_ = $format;
  while ($_)
    {
      # $n -> $(n + 4)
      if (s/^\$(\d+)//)
	{
	  $res .= "\$" . ($1 + 4);
	}
      # $x, no separator given.
      elsif (s/^\$([fldn\$])//)
        {
	  $res .= $escape{$1};
	}
      # $.x or ${sep}x.
      elsif (s/^\$\{([^}]*)\}([@*%])//
	    || s/^\$(.?)([@*%])//)
	{
	  # $@, list of quoted effective arguments.
	  if ($2 eq '@')
	    {
	      $res .= ']at_at([' . ($1 ? $1 : ',') . '], $@)[';
	    }
	  # $*, list of unquoted effective arguments.
	  elsif ($2 eq '*')
	    {
	      $res .= ']at_star([' . ($1 ? $1 : ',') . '], $@)[';
	    }
	  # $%, list of flattened unquoted effective arguments.
	  elsif ($2 eq '%')
	    {
	      $res .= ']at_percent([' . ($1 ? $1 : ':') . '], $@)[';
	    }
	}
      elsif (/^(\$.)/)
        {
	  die "$me: invalid escape: $1\n";
        }
      else
        {
	  s/^([^\$]+)//;
	  $res .= $1;
        }
    }

  $_ = $underscore;
  return '[[' . $res . ']]';
}


# handle_traces($REQ, $OUTPUT, %TRACE)
# ------------------------------------
# We use M4 itself to process the traces.  But to avoid name clashes when
# processing the traces, the builtins are disabled, and moved into `at_'.
# Actually, all the low level processing macros are in `at_' (and `_at_').
# To avoid clashes between user macros and `at_' macros, the macros which
# implement tracing are in `AT_'.
#
# Having $REQ is needed to neutralize the macros which have been traced,
# but are not wanted now.
sub handle_traces ($$%)
{
  my ($req, $output, %trace) = @_;

  verbose "formatting traces for `$output': ", join (', ', sort keys %trace);

  # Processing the traces.
  my $trace_m4 = new Autom4te::XFile (">$tmp/traces.m4");

  $_ = <<'EOF';
  divert(-1)
  changequote([, ])
  # _at_MODE(SEPARATOR, ELT1, ELT2...)
  # ----------------------------------
  # List the elements, separating then with SEPARATOR.
  # MODE can be:
  #  `at'       -- the elements are enclosed in brackets.
  #  `star'     -- the elements are listed as are.
  #  `percent'  -- the elements are `flattened': spaces are singled out,
  #                and no new line remains.
  define([_at_at],
  [at_ifelse([$#], [1], [],
             [$#], [2], [[[$2]]],
             [[[$2]][$1]$0([$1], at_shift(at_shift($@)))])])

  define([_at_percent],
  [at_ifelse([$#], [1], [],
             [$#], [2], [at_flatten([$2])],
             [at_flatten([$2])[$1]$0([$1], at_shift(at_shift($@)))])])

  define([_at_star],
  [at_ifelse([$#], [1], [],
             [$#], [2], [[$2]],
             [[$2][$1]$0([$1], at_shift(at_shift($@)))])])

  # FLATTEN quotes its result.
  # Note that the second pattern is `newline, tab or space'.  Don't lose
  # the tab!
  define([at_flatten],
  [at_patsubst(at_patsubst(at_patsubst([[[$1]]], [\\\n]),
                           [[\n\t ]+], [ ]),
               [^ *\(.*\) *$], [[\1]])])

  define([at_args],    [at_shift(at_shift(at_shift(at_shift(at_shift($@)))))])
  define([at_at],      [_$0([$1], at_args($@))])
  define([at_percent], [_$0([$1], at_args($@))])
  define([at_star],    [_$0([$1], at_args($@))])

EOF
  s/^  //mg;s/\\t/\t/mg;s/\\n/\n/mg;
  print $trace_m4 $_;

  # If you trace `define', then on `define([m4_exit], defn([m4exit])' you
  # will produce
  #
  #    AT_define([m4sugar.m4], [115], [1], [define], [m4_exit], <m4exit>)
  #
  # Since `<m4exit>' is not quoted, the outer m4, when processing
  # `trace.m4' will exit prematurely.  Hence, move all the builtins to
  # the `at_' name space.

  print $trace_m4 "# Copy the builtins.\n";
  map { print $trace_m4 "define([at_$_], defn([$_]))\n" } @m4_builtin;
  print $trace_m4 "\n";

  print $trace_m4 "# Disable them.\n";
  map { print $trace_m4 "at_undefine([$_])\n" } @m4_builtin;
  print $trace_m4 "\n";


  # Neutralize traces: we don't want traces of cached requests (%REQUEST).
  print $trace_m4
   "## -------------------------------------- ##\n",
   "## By default neutralize all the traces.  ##\n",
   "## -------------------------------------- ##\n",
   "\n";
  print $trace_m4 "at_define([AT_$_], [at_dnl])\n"
    foreach (sort keys %{$req->macro});
  print $trace_m4 "\n";

  # Implement traces for current requests (%TRACE).
  print $trace_m4
    "## ------------------------- ##\n",
    "## Trace processing macros.  ##\n",
    "## ------------------------- ##\n",
    "\n";
  foreach (sort keys %trace)
    {
      # Trace request can be embed \n.
      (my $comment = "Trace $_:$trace{$_}") =~ s/^/\# /;
      print $trace_m4 "$comment\n";
      print $trace_m4 "at_define([AT_$_],\n";
      print $trace_m4 trace_format_to_m4 ($trace{$_}) . ")\n\n";
    }
  print $trace_m4 "\n";

  # Reenable output.
  print $trace_m4 "at_divert(0)at_dnl\n";

  # Transform the traces from m4 into an m4 input file.
  # Typically, transform:
  #
  # | m4trace:configure.ac:3: -1- AC_SUBST([exec_prefix], [NONE])
  #
  # into
  #
  # | AT_AC_SUBST([configure.ac], [3], [1], [AC_SUBST], [exec_prefix], [NONE])
  #
  # Pay attention that the file name might include colons, if under DOS
  # for instance, so we don't use `[^:]+'.
  my $traces = new Autom4te::XFile ($tcache . $req->id);
  while ($_ = $traces->getline)
    {
      # Trace with arguments, as the example above.  We don't try
      # to match the trailing parenthesis as it might be on a
      # separate line.
      s{^m4trace:(.+):(\d+): -(\d+)- ([^(]+)\((.*)$}
       {AT_$4([$1], [$2], [$3], [$4], $5};
      # Traces without arguments, always on a single line.
      s{^m4trace:(.+):(\d+): -(\d+)- ([^)]*)\n$}
       {AT_$4([$1], [$2], [$3], [$4])\n};
      print $trace_m4 "$_";
    }
  $trace_m4->close;

  my $in = new Autom4te::XFile ("$m4 $tmp/traces.m4 |");
  my $out = new Autom4te::XFile (">$output");

  # FIXME: Hm... This is dubious: should we really transform the
  # quadrigraphs in traces?  It might break balanced [ ] etc. in the
  # output.
  while ($_ = $in->getline)
    {
      # It makes no sense to try to transform __oline__.
      s/\@<:\@/[/g;
      s/\@:>\@/]/g;
      s/\@\$\|\@/\$/g;
      s/\@%:\@/#/g;
      print $out $_;
    }
}


# $BOOL
# up_to_date ($REQ)
# -----------------
# Are the cache files of $REQ up to date?
# $REQ is `valid' if it corresponds to the request and exists, which
# does not mean it is up to date.  It is up to date if, in addition,
# its files are younger than its dependencies.
sub up_to_date ($)
{
  my ($req) = @_;

  return 0
    if ! $req->valid;

  my $tfile = $tcache . $req->id;
  my $ofile = $ocache . $req->id;

  # We can't answer properly if the traces are not computed since we
  # need to know what other files were included.  Actually, if any of
  # the cache files is missing, we are not up to date.
  return 0
    if ! -f $tfile || ! -f $ofile;

  # The youngest of the cache files must be older than the oldest of
  # the dependencies.
  my $tmtime = mtime ($tfile);
  my $omtime = mtime ($ofile);
  my ($file, $mtime) = ($tmtime < $omtime
			? ($ofile, $omtime) : ($tfile, $tmtime));

  # We depend at least upon the arguments.
  my @dep = @ARGV;

  # Files may include others.  We can use traces since we just checked
  # if they are available.
  handle_traces ($req, "$tmp/dependencies",
		 ('include'    => '$1',
		  'm4_include' => '$1'));
  my $deps = new Autom4te::XFile ("$tmp/dependencies");
  push @dep, map { chomp; find_file ($_, @include) } $deps->getlines;

  # If $FILE is younger than one of its dependencies, it is outdated.
  return up_to_date_p ($file, @dep);
}


## ---------- ##
## Freezing.  ##
## ---------- ##

# freeze ($OUTPUT)
# ----------------
sub freeze ($)
{
  my ($output) = @_;

  # When processing the file with diversion disabled, there must be no
  # output but comments and empty lines.
  my $command = ("$m4"
		 . ' --fatal-warning'
		 . join (' --include=', '', reverse @include)
		 . ' --define=divert'
		 . " @ARGV"
		 . ' </dev/null');
  verbose "running: $command";
  my $result = `$command`;
  $result =~ s/#.*\n//g;
  $result =~ s/^\n//mg;
  if ($?)
    {
      verbose "$m4: failed with exit status: " . ($? >> 8) . "\n";
      exit $? >> 8;
    }
  if ($result)
    {
      print STDERR "$me: freezing produced output:\n$result";
      exit 1;
    }

  # If freezing produces output, something went wrong: a bad `divert',
  # or an improper paren etc.
  $command = ("$m4"
	      . ' --fatal-warning'
	      . join (' --include=', '', reverse @include)
	      . " --freeze-state=$output"
	      . " @ARGV"
	      . ' </dev/null');
  verbose "running: $command";
  system $command;
  if ($?)
    {
      verbose "$m4: failed with exit status: " . ($? >> 8) . "\n";
      exit $? >> 8;
    }
}

## -------------- ##
## Main program.  ##
## -------------- ##

mktmpdir ('t4');
load_configuration;
parse_args;

# Freezing does not involve the cache.
if ($freeze)
  {
    freeze ($output);
    exit 0;
  }

# We need our cache directory.
if (! -d "$cache")
  {
    mkdir "$cache", 0755
      or die "$me: cannot create $cache: $!\n";
  }

# Read the cache index if available and older than autom4te itself.
# If autom4te is younger, then some structures such as Request, might
# have changed, which would corrupt its processing.
Request->load ($icache)
  if -f $icache && mtime ($icache) > mtime ($0);

# Add the new trace requests.
my $req = Request->request ('input' => \@ARGV,
			    'path'  => \@include,
			    'macro' => [keys %trace, @preselect]);

# If $REQ's cache files are not up to date, declare it invalid.
$req->valid (0)
  if ! up_to_date ($req);

# We now know whether we can trust the Request object.  Say it.
if ($verbose)
  {
    print STDERR "$me: the trace request object is:\n";
    print STDERR $req->marshall;
  }

# We need to run M4 if (i) the users wants it (--force), (ii) $REQ is
# invalid.
handle_m4 ($req, keys %{$req->macro})
  if $force || ! $req->valid;

# Now output...
if (%trace)
  {
    # Always produce traces, since even if the output is young enough,
    # there is no guarantee that the traces use the same *format*
    # (e.g., `-t FOO:foo' and `-t FOO:bar' are both using the same M4
    # traces, hence the M4 traces cache is usable, but its formating
    # will yield different results).
    handle_traces ($req, $output, %trace);
  }
else
  {
    # Actual M4 expansion, only if $output is too old. STDOUT is
    # pretty old.
    handle_output ($req, $output)
      if mtime ($output) < mtime ($ocache . $req->id);
  }

# If all went fine, the cache is valid.
$req->valid (1)
  if $exit_status == 0;

Request->save ($icache);

exit $exit_status;