07-fyi-autom4te-small-speed-up.patch

[Akim Demaille]

Index: ChangeLog
from  Akim Demaille  <address@hidden>

        Don't let autom4te compute the `include' traces several times:
        first check that the trace cache file is up to date, and then
        compare its timestamp with that of the output.

        * bin/autom4te.in, bin/autoupdate.in, bin/autoscan.in: Normalize
        the preamble.  Don't require 5.005 as Autom4te::General does it,
        and better yet (use `use', not `require'!).
        * lib/Autom4te/Struct.pm: Rename the last occurrences of
        Class::Struct as Autom4te::Struct.
        * lib/Autom4te/General.pm (File::stat): Use it.
        (&mtime): New, export it.
        * bin/autom4te.in: Use it.
        Declare `$req' is invalid if it is outdated.
        Don't declare it valid before saving it if something went wrong.

Index: bin/autom4te.in
--- bin/autom4te.in Fri, 03 Aug 2001 17:15:29 +0200 akim
+++ bin/autom4te.in Fri, 03 Aug 2001 20:53:02 +0200 akim
@@ -23,25 +23,20 @@
 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 # 02111-1307, USA.

-require 5.005;
-use File::Basename;
-
-my $me = basename ($0);
-
-## --------- ##
-## Request.  ##
-## --------- ##
-
-package Request;

 BEGIN
 {
   my $prefix = "@prefix@";
-  # FIXME: Import Struct into Autoconf.
   my $perllibdir = $ENV{'autom4te_perllibdir'} || "@datadir@";
   unshift @INC, "$perllibdir";
 }

+## --------- ##
+## Request.  ##
+## --------- ##
+
+package Request;
+
 use Data::Dumper;
 use Autom4te::General;
 use Autom4te::Struct;
@@ -62,7 +57,7 @@
   (
    # The key of the cache file.
    'cache' => "\$",
-   # True if the cache file is up to date.
+   # True iff %MACRO contains all the macros we want to trace.
    'valid' => "\$",
    # The include path.
    'path' => '@',
@@ -75,7 +70,11 @@
   );


+# $REQUEST-OBJ
+# retrieve ($SELF, %ATTR)
+# -----------------------
 # Find a request with the same path and source.
+# Private.
 sub retrieve
 {
   my ($self, %attr) = @_;
@@ -97,8 +96,13 @@ sub retrieve
   return undef;
 }

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

@@ -114,27 +118,33 @@ sub register
 }


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

-  my $obj = Request->retrieve (%request) || Request->register (%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 ${$obj->macro}{$_})
+      if (! exists ${$req->macro}{$_})
         {
-         ${$obj->macro}{$_} = 1;
-          $obj->valid (0);
-       }
+          ${$req->macro}{$_} = 1;
+          $req->valid (0);
+        }
     }

-  return $obj;
+  # 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.
@@ -848,23 +858,24 @@ sub handle_traces ($$%)


 # $BOOL
-# up_to_date_p ($REQ, $FILE)
-# --------------------------
-# If $FILE up to date?
-# We need $REQ since we check $FILE against all its dependencies,
-# and we use the traces on `include' to find them.
-sub up_to_date_p ($$)
+# up_to_date_p ($REQ)
+# -------------------
+# Is the cache file 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,
+# it's younger than its dependencies.
+sub up_to_date_p ($)
 {
-  my ($req, $file) = @_;
+  my ($req) = @_;

-  # If STDOUT or doesn't exist, it sure is outdated!
   return 0
-    if $file eq '-' || ! -f $file;
+    if ! $req->valid;

   # We can't answer properly if the traces are not computed since we
   # need to know what other files were included.
+  my $file = "$me.cache/" . $req->cache;
   return 0
-    if ! -f "$me.cache/" . $req->cache;
+    if ! -f $file;

   # We depend at least upon the arguments.
   my @dep = @ARGV;
@@ -875,13 +886,13 @@ sub up_to_date_p ($$)
   handle_traces ($req, "$tmp/dependencies",
                 ('include'    => '$1',
                  'm4_include' => '$1'));
-  my $mtime = (stat ($file))[9];
+  my $mtime = mtime ($file);
   my $deps = new IO::File ("$tmp/dependencies");
   push @dep, map { chomp; find_file ($_) } $deps->getlines;
   foreach (@dep)
     {
       verbose "$file depends on $_";
-      if ($mtime < (stat ($_))[9])
+      if ($mtime < mtime ($_))
        {
          verbose "$file depends on $_ which is more recent";
          return 0;
@@ -912,45 +923,51 @@ sub up_to_date_p ($$)

 # Add the new trace requests.
 my $req = Request->request ('source' => address@hidden,
-                           'path' => address@hidden,
-                           'macro' => [keys %trace, @preselect]);
+                           'path'   => address@hidden,
+                           'macro'  => [keys %trace, @preselect]);

+# If $REQ is not up to date, declare it invalid.
+$req->valid (0)
+  if ! up_to_date_p ($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
-# - for traces
-#   + there is no cache, or
-#   + it does not include the traces we need, or
-#   + it exists but is outdated
-# - for output if it is not /dev/null and
-#   + it doesn't exist, or
-#   + it is outdated
+# We need to run M4 if (i) $REQ is invalid, or (ii) we are expanding
+# (i.e., not tracing) and the output is older than the cache file
+# (since the later is valid if it's older than the dependencies).
+# STDOUT is pretty old.
+my $output_mtime = mtime ($output);
+
 handle_m4 ($req, keys %{$req->macro})
   if (! $req->valid
-      || ! up_to_date_p ($req, "$me.cache/" . $req->cache)
-      || (! %trace && ! up_to_date_p ($req, "$output")));
+      || (! %trace && $output_mtime < mtime ("$me.cache/" . $req->cache)));
+

+# Now output...
 if (%trace)
   {
-    # Producing traces.
-    # Trying to produce the output only when needed is very
-    # error prone here, as you'd have to check that the trace
-    # requests have not changed etc.
+    # 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.
+    # Actual M4 expansion, only if $output is too old.
     handle_output ($output)
-      if ! up_to_date_p ($req, $output);
+      if $output_mtime < mtime ("$me.cache/" . $req->cache);
   }

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

 Request->save ("$me.cache/requests");

Index: bin/autoscan.in
--- bin/autoscan.in Wed, 01 Aug 2001 23:34:52 +0200 akim
+++ bin/autoscan.in Fri, 03 Aug 2001 20:58:25 +0200 akim
@@ -20,12 +20,9 @@

 # Written by David MacKenzie <address@hidden>.

-use 5.005;
-
 BEGIN
 {
   my $prefix = "@prefix@";
-  # FIXME: Import Struct into Autoconf.
   my $perllibdir = $ENV{'autom4te_perllibdir'} || "@datadir@";
   unshift @INC, "$perllibdir";
 }
Index: bin/autoupdate.in
--- bin/autoupdate.in Wed, 01 Aug 2001 23:34:52 +0200 akim
+++ bin/autoupdate.in Fri, 03 Aug 2001 20:21:41 +0200 akim
@@ -21,12 +21,9 @@
 # Originally written by David MacKenzie <address@hidden>.
 # Rewritten by Akim Demaille <address@hidden>.

-use 5.005;
-
 BEGIN
 {
   my $prefix = "@prefix@";
-  # FIXME: Import Struct into Autoconf.
   my $perllibdir = $ENV{'autom4te_perllibdir'} || "@datadir@";
   unshift @INC, "$perllibdir";
 }
Index: lib/Autom4te/General.pm
--- lib/Autom4te/General.pm Wed, 01 Aug 2001 23:34:52 +0200 akim
+++ lib/Autom4te/General.pm Fri, 03 Aug 2001 20:42:31 +0200 akim
@@ -21,12 +21,15 @@
 use 5.005;
 use Exporter;
 use File::Basename;
+use File::stat;
 use Carp;
 use strict;
-use vars qw (@ISA @EXPORT $me);
+
+use vars qw (@ISA @EXPORT);

 @ISA = qw (Exporter);
address@hidden = qw (&find_configure_ac &find_peer &mktmpdir &uniq &verbose 
&xsystem
address@hidden = qw (&find_configure_ac &find_peer &mktmpdir &mtime
+              &uniq &verbose &xsystem
              $me $verbose $debug $tmp);

 # Variable we share with the main package.  Be sure to have a single
@@ -161,6 +164,25 @@ sub mktmpdir ($)

   print STDERR "$me:$$: working in $tmp\n"
     if $debug;
+}
+
+
+# $MTIME
+# MTIME ($FILE)
+# -------------
+# Return the mtime of $FILE.  Missing files, or `-' standing for STDIN
+# or STDOUT are ``obsolete'', i.e., as old as possible.
+sub mtime ($)
+{
+  my ($file) = @_;
+
+  return 0
+    if $file eq '-' || ! -f $file;
+
+  my $stat = stat ($file)
+    or croak "$me: cannot stat $file: $!\n";
+
+  return $stat->mtime;
 }


Index: lib/Autom4te/Struct.pm
--- lib/Autom4te/Struct.pm Wed, 01 Aug 2001 23:34:52 +0200 akim
+++ lib/Autom4te/Struct.pm Fri, 03 Aug 2001 20:54:49 +0200 akim
@@ -16,6 +16,12 @@
 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 # 02111-1307, USA.

+# This file is basically Perl 5.6's Class::Struct, but made compatible
+# with Perl 5.5.  If someday this has to be updated, be sure to rename
+# all the occurrences of Class::Struct into Autom4te::Struct, otherwise
+# if we `use' a Perl module (e.g., File::stat) that uses Class::Struct,
+# we would have two packages defining the same symbols.  Boom.
+
 package Autom4te::Struct;

 ## See POD after __END__
@@ -43,7 +49,7 @@ sub printem {
 }

 {
-    package Class::Struct::Tie_ISA;
+    package Autom4te::Struct::Tie_ISA;

     sub TIEARRAY {
         my $class = shift;
@@ -52,7 +58,7 @@ sub printem {

     sub STORE {
         my ($self, $index, $value) = @_;
-        Class::Struct::_subclass_error();
+        Autom4te::Struct::_subclass_error();
     }

     sub FETCH {
@@ -102,7 +108,7 @@ sub struct {
         address@hidden . '::ISA'};
     };
     _subclass_error() if @$isa;
-    tie @$isa, 'Class::Struct::Tie_ISA';
+    tie @$isa, 'Autom4te::Struct::Tie_ISA';

     # Create constructor.

@@ -244,24 +250,24 @@ sub _subclass_error {

 =head1 NAME

-Class::Struct - declare struct-like datatypes as Perl classes
+Autom4te::Struct - declare struct-like datatypes as Perl classes

 =head1 SYNOPSIS

-    use Class::Struct;
+    use Autom4te::Struct;
             # declare struct, based on array:
     struct( CLASS_NAME => [ ELEMENT_NAME => ELEMENT_TYPE, ... ]);
             # declare struct, based on hash:
     struct( CLASS_NAME => { ELEMENT_NAME => ELEMENT_TYPE, ... });

     package CLASS_NAME;
-    use Class::Struct;
+    use Autom4te::Struct;
             # declare struct, based on array, implicit class name:
     struct( ELEMENT_NAME => ELEMENT_TYPE, ... );


     package Myobj;
-    use Class::Struct;
+    use Autom4te::Struct;
             # declare struct with four types of elements:
     struct( s => '$', a => '@', h => '%', c => 'My_Other_Class' );

@@ -289,7 +295,7 @@ Class::Struct - declare struct-like data

 =head1 DESCRIPTION

-C<Class::Struct> exports a single function, C<struct>.
+C<Autom4te::Struct> exports a single function, C<struct>.
 Given a list of element names and types, and optionally
 a class name, C<struct> creates a Perl 5 class that implements
 a "struct-like" data structure.
@@ -439,7 +445,7 @@ Class::Struct - declare struct-like data
 microseconds), and C<rusage> has two elements, each of which is of
 type C<timeval>.

-    use Class::Struct;
+    use Autom4te::Struct;

     struct( rusage => {
         ru_utime => timeval,  # seconds
@@ -470,7 +476,7 @@ Class::Struct - declare struct-like data
 accessor accordingly.

     package MyObj;
-    use Class::Struct;
+    use Autom4te::Struct;

     # declare the struct
     struct ( 'MyObj', { count => '$', stuff => '%' } );
@@ -510,7 +516,7 @@ Class::Struct - declare struct-like data
 struct's constructor.


-    use Class::Struct;
+    use Autom4te::Struct;

     struct Breed =>
     {
@@ -541,6 +547,12 @@ Class::Struct - declare struct-like data

 =head1 Author and Modification History

+Modified by Akim Demaille, 2001-08-03
+
+    Rename as Autom4te::Struct to avoid name clashes with
+    Class::Struct.
+
+    Make it compatible with Perl 5.5.

 Modified by Damian Conway, 1999-03-05, v0.58.