Rewrite boot in Python

One step closer to being able to drop the Windows Perl tarball. We
previously attempted to do this in D3567 but were forced to revert due
to Windows problems.

Acknowledgements:
 * @Phyx kindly contributed the codepath allowing this to work on
Windows.

Test Plan: Validate

Reviewers: hvr, austin, Phyx

Subscribers: erikd, thomie, rwbarton

Differential Revision: https://phabricator.haskell.org/D3918

5 files changed, 178 insertions, 236 deletions

diff --git a/INSTALL.md b/INSTALL.md
index 3ae9186874..42bbc1e63d 100644
--- a/INSTALL.md
+++ b/INSTALL.md
@@ -18,7 +18,7 @@ XeLaTex (only for PDF output).
 
 Quick start:  the following gives you a default build:
 
-    $ perl boot
+    $ python3 boot
     $ ./configure
     $ make
     $ make install
@@ -31,9 +31,9 @@ Quick start:  the following gives you a default build:
 You can use Make's `-jN` option to parallelize the build. It's generally best
 to set `N` somewhere around the core count of the build machine.
 
-The `perl boot` step is only necessary if this is a tree checked out
-from git.  For source distributions downloaded from GHC's web site,
-this step has already been performed.
+The `python3 boot` step is only necessary if this is a tree checked out from
+git. For source distributions downloaded from GHC's web site, this step has
+already been performed.
 
 These steps give you the default build, which includes everything
 optimised and built in various ways (eg. profiling libs are built).
diff --git a/MAKEHELP.md b/MAKEHELP.md
index 233298478e..819da9754b 100644
--- a/MAKEHELP.md
+++ b/MAKEHELP.md
@@ -48,7 +48,7 @@ Common commands:
 
     Various levels of cleaning: "clean" restores the tree to the
     state after "./configure", "distclean" restores to the state
-    after "perl boot", and maintainer-clean restores the tree to the
+    after "python3 boot", and maintainer-clean restores the tree to the
     completely clean checked-out state.
 
 Using `make` in subdirectories
diff --git a/boot b/boot
index 45f5bf06c2..b6ecc09f28 100755
--- a/boot
+++ b/boot
@@ -1,243 +1,185 @@
-#!/usr/bin/env perl
-
-use warnings;
-use strict;
-
-use Cwd;
-use File::Path 'rmtree';
-use File::Basename;
-
-my %required_tag;
-my $validate;
-my $curdir;
-
-# See Trac #11530
-$ENV{GREP_OPTIONS} = '';
-
-$required_tag{"-"} = 1;
-$validate = 0;
-
-$curdir = &cwd()
-    or die "Can't find current directory: $!";
-
-while ($#ARGV ne -1) {
-    my $arg = shift @ARGV;
-
-    if ($arg =~ /^--required-tag=(.*)/) {
-        $required_tag{$1} = 1;
-    }
-    elsif ($arg =~ /^--validate$/) {
-        $validate = 1;
-    }
-    else {
-        die "Bad arg: $arg";
-    }
-}
-
-sub sanity_check_line_endings {
-    local $/ = undef;
-    open FILE, "packages" or die "Couldn't open file: $!";
-    binmode FILE;
-    my $string = <FILE>;
-    close FILE;
-
-    if ($string =~ /\r/) {
-        print STDERR <<EOF;
-Found ^M in packages.
-Perhaps you need to run
-    git config --global core.autocrlf false
-and re-check out the tree?
-EOF
-        exit 1;
-    }
-}
-
-sub sanity_check_tree {
-    my $tag;
-    my $dir;
-
-    if (-d ".git"  &&
-        system("git config remote.origin.url | grep github.com > /dev/null") == 0 &&
-        system("git config --get-regexp '^url.*github.com/.*/packages-.insteadOf' > /dev/null") != 0) {
+#!/usr/bin/env python3
+
+import glob
+import os
+import os.path
+import sys
+import argparse
+from textwrap import dedent
+import subprocess
+import re
+
+cwd = os.getcwd()
+
+parser = argparse.ArgumentParser()
+parser.add_argument('--validate', action='store_true', help='Run in validate mode')
+parser.add_argument('--required-tag', type=str, action='append', default=set())
+args = parser.parse_args()
+
+def print_err(s):
+    print(dedent(s), file=sys.stderr)
+
+def die(mesg):
+    print_err(mesg)
+    sys.exit(1)
+
+def check_for_url_rewrites():
+    if os.path.isdir('.git') and \
+       subprocess.check_output('git config remote.origin.url'.split()).find(b'github.com') != -1 and \
+       subprocess.call(['git', 'config', '--get-regexp', '^url.*github.com/.*/packages-.insteadOf']) != 0:
         # If we cloned from github, make sure the url rewrites are set.
         # Otherwise 'git submodule update --init' prints confusing errors.
-        die <<EOF;
-It seems you cloned this repository from GitHub. But your git config files
-don't contain the url rewrites that are needed to make this work (GitHub
-doesn't support '/' in repository names, so we use a different naming scheme
-for the submodule repositories there).
+        die("""\
+            It seems you cloned this repository from GitHub. But your git config files
+            don't contain the url rewrites that are needed to make this work (GitHub
+            doesn't support '/' in repository names, so we use a different naming scheme
+            for the submodule repositories there).
 
-Please run the following commands first:
+            Please run the following commands first:
 
-  git config --global url."git://github.com/ghc/packages-".insteadOf     git://github.com/ghc/packages/
-  git config --global url."http://github.com/ghc/packages-".insteadOf    http://github.com/ghc/packages/
-  git config --global url."https://github.com/ghc/packages-".insteadOf   https://github.com/ghc/packages/
-  git config --global url."ssh://git\@github.com/ghc/packages-".insteadOf ssh://git\@github.com/ghc/packages/
-  git config --global url."git\@github.com:/ghc/packages-".insteadOf      git\@github.com:/ghc/packages/
+              git config --global url."git://github.com/ghc/packages-".insteadOf     git://github.com/ghc/packages/
+              git config --global url."http://github.com/ghc/packages-".insteadOf    http://github.com/ghc/packages/
+              git config --global url."https://github.com/ghc/packages-".insteadOf   https://github.com/ghc/packages/
+              git config --global url."ssh://git\@github.com/ghc/packages-".insteadOf ssh://git\@github.com/ghc/packages/
+              git config --global url."git\@github.com:/ghc/packages-".insteadOf      git\@github.com:/ghc/packages/
 
-And then:
+            And then:
 
-  git submodule update --init
-  ./boot
+              git submodule update --init
+              ./boot
 
-Or start over, and clone the GHC repository from the haskell server:
+            Or start over, and clone the GHC repository from the haskell server:
 
-  git clone --recursive git://git.haskell.org/ghc.git
+              git clone --recursive git://git.haskell.org/ghc.git
 
-For more information, see:
-  * https://ghc.haskell.org/trac/ghc/wiki/Newcomers or
-  * https://ghc.haskell.org/trac/ghc/wiki/Building/GettingTheSources#CloningfromGitHub
-EOF
-    }
+            For more information, see:
+              * https://ghc.haskell.org/trac/ghc/wiki/Newcomers or
+              * https://ghc.haskell.org/trac/ghc/wiki/Building/GettingTheSources#CloningfromGitHub
+        """)
 
+def check_boot_packages():
     # Check that we have all boot packages.
-    open PACKAGES, "< packages";
-    while (<PACKAGES>) {
-        if (/^#/) {
-            # Comment; do nothing
-        }
-        elsif (/^([a-zA-Z0-9\/.-]+) +([^ ]+) +[^ ]+ +[^ ]+$/) {
-            $dir = $1;
-            $tag = $2;
-
-            # If $tag is not "-" then it is an optional repository, so its
-            # absence isn't an error.
-            if (defined($required_tag{$tag})) {
-                # We would like to just check for a .git directory here,
-                # but in an lndir tree we avoid making .git directories,
-                # so it doesn't exist. We therefore require that every repo
-                # has a LICENSE file instead.
-                if (! -f "$dir/LICENSE") {
-                    print STDERR "Error: $dir/LICENSE doesn't exist.\n";
-                    die "Maybe you haven't done 'git submodule update --init'?";
-                }
-            }
-        }
-        else {
-            die "Bad line in packages file: $_";
-        }
-    }
-    close PACKAGES;
-}
+    import re
+    for l in open('packages', 'r'):
+        if l.startswith('#'):
+            continue
+
+        parts = l.split(' ')
+        if len(parts) != 4:
+            die("Error: Bad line in packages file: " + l)
+
+        dir_ = parts[0]
+        tag = parts[1]
+
+        # If $tag is not "-" then it is an optional repository, so its
+        # absence isn't an error.
+        if tag in args.required_tag:
+            # We would like to just check for a .git directory here,
+            # but in an lndir tree we avoid making .git directories,
+            # so it doesn't exist. We therefore require that every repo
+            # has a LICENSE file instead.
+            license_path = os.path.join(dir_, 'LICENSE')
+            if not os.path.isfile(license_path):
+                die("""\
+                    Error: %s doesn't exist" % license_path)
+                    Maybe you haven't run 'git submodule update --init'?
+                    """)
 
 # Create libraries/*/{ghc.mk,GNUmakefile}
-sub boot_pkgs {
-    my @library_dirs = ();
-
-    my $package;
-
-    for $package (glob "libraries/*/") {
-        $package =~ s/\/$//;
-        my $pkgs = "$package/ghc-packages";
-        if (-f $pkgs) {
-            open PKGS, "< $pkgs"
-                or die "Failed to open $pkgs: $!";
-            while (<PKGS>) {
-                chomp;
-                s/\r//g;
-                if (/.+/) {
-                    push @library_dirs, "$package/$_";
-                }
-            }
-        }
-        else {
-            push @library_dirs, $package;
-        }
-    }
-
-    for $package (@library_dirs) {
-        my $dir = &basename($package);
-        my @cabals = glob("$package/*.cabal.in");
-        if ($#cabals < 0) {
-            @cabals = glob("$package/*.cabal");
-        }
-        if ($#cabals > 0) {
-            die "Too many .cabal file in $package\n";
-        }
-        if ($#cabals eq 0) {
-            my $cabal = $cabals[0];
-            my $pkg;
-            my $top;
-            if (-f $cabal) {
-                $pkg = $cabal;
-                $pkg =~ s#.*/##;
-                $pkg =~ s/\.cabal.in$//;
-                $pkg =~ s/\.cabal$//;
-                $top = $package;
-                $top =~ s#[^/]+#..#g;
-                $dir = $package;
-                $dir =~ s#^libraries/##g;
-
-                print "Creating $package/ghc.mk\n";
-                open GHCMK, "> $package/ghc.mk"
-                    or die "Opening $package/ghc.mk failed: $!";
-                print GHCMK "${package}_PACKAGE = ${pkg}\n";
-                print GHCMK "${package}_dist-install_GROUP = libraries\n";
-                print GHCMK "\$(if \$(filter ${dir},\$(PACKAGES_STAGE0)),\$(eval \$(call build-package,${package},dist-boot,0)))\n";
-                print GHCMK "\$(if \$(filter ${dir},\$(PACKAGES_STAGE1)),\$(eval \$(call build-package,${package},dist-install,1)))\n";
-                print GHCMK "\$(if \$(filter ${dir},\$(PACKAGES_STAGE2)),\$(eval \$(call build-package,${package},dist-install,2)))\n";
-                close GHCMK
-                    or die "Closing $package/ghc.mk failed: $!";
-
-                print "Creating $package/GNUmakefile\n";
-                open GNUMAKEFILE, "> $package/GNUmakefile"
-                    or die "Opening $package/GNUmakefile failed: $!";
-                print GNUMAKEFILE "dir = ${package}\n";
-                print GNUMAKEFILE "TOP = ${top}\n";
-                print GNUMAKEFILE "include \$(TOP)/mk/sub-makefile.mk\n";
-                print GNUMAKEFILE "FAST_MAKE_OPTS += stage=0\n";
-                close GNUMAKEFILE
-                    or die "Closing $package/GNUmakefile failed: $!";
-            }
-        }
-    }
-}
-
-# autoreconf everything that needs it.
-sub autoreconf {
-    my $dir;
-    my $fail;
-
-    foreach $dir (".", glob("libraries/*/")) {
-        if (-f "$dir/configure.ac") {
-            next if (my $pid = fork);
-            die "fork failed: $!" if (! defined $pid);
-            print "Booting $dir\n";
-            chdir $dir or die "can't change to $dir: $!";
-            exec("autoreconf");
-            exit 1;
-        }
-    }
+def boot_pkgs():
+    library_dirs = []
+
+    for package in glob.glob("libraries/*/"):
+        packages_file = os.path.join(package, 'ghc-packages')
+        if os.path.isfile(packages_file):
+            for subpkg in open(packages_file, 'r'):
+                library_dirs.append(os.path.join(package, subpkg.strip()))
+        else:
+            library_dirs.append(package)
+
+    print(library_dirs)
+    for package in library_dirs:
+        if package[-1] == '/':
+            # drop trailing '/'
+            package = package[:-1]
+
+        dir_ = os.path.relpath(package, 'libraries')
+        cabals = glob.glob(os.path.join(package, '*.cabal.in'))
+        if len(cabals) == 0:
+            cabals = glob.glob(os.path.join(package, '*.cabal'))
+
+        if len(cabals) > 1:
+            die('Too many .cabal files in %s' % package)
+        elif len(cabals) == 1:
+            cabal = cabals[0]
+
+            if os.path.isfile(cabal):
+                # strip both .cabal and .in
+                pkg = os.path.splitext(os.path.splitext(os.path.basename(cabal))[0])[0]
+                top = package
+
+                ghc_mk = os.path.join(package, 'ghc.mk')
+                print('Creating %s' % ghc_mk)
+                with open(ghc_mk, 'w') as f:
+                    f.write(dedent(
+                        """\
+                        {package}_PACKAGE = {pkg}
+                        {package}_dist-install_GROUP = libraries
+                        $(if $(filter {dir},$(PACKAGES_STAGE0)),$(eval $(call build-package,{package},dist-boot,0)))
+                        $(if $(filter {dir},$(PACKAGES_STAGE1)),$(eval $(call build-package,{package},dist-install,1)))
+                        $(if $(filter {dir},$(PACKAGES_STAGE2)),$(eval $(call build-package,{package},dist-install,2)))
+                        """.format(package = package,
+                                pkg = pkg,
+                                dir = dir_)))
+
+
+def autoreconf():
+    # Run autoreconf on everything that needs it.
+    processes = {}
+    if os.name == 'nt':
+        # Get the normalized ACLOCAL_PATH for Windows
+        # This is necessary since on Windows this will be a Windows
+        # path, which autoreconf doesn't know doesn't know how to handle.
+        ac_local = os.environ['ACLOCAL_PATH']
+        ac_local_arg = re.sub(r';', r':', ac_local)
+        ac_local_arg = re.sub(r'\\', r'/', ac_local_arg)
+        ac_local_arg = re.sub(r'(\w):/', r'/\1/', ac_local_arg)
+        reconf_cmd = 'ACLOCAL_PATH=%s autoreconf' % ac_local_arg
+    else:
+        reconf_cmd = 'autoreconf'
+
+    for dir_ in ['.'] + glob.glob('libraries/*/'):
+        if os.path.isfile(os.path.join(dir_, 'configure.ac')):
+            print("Booting %s" % dir_)
+            processes[dir_] = subprocess.Popen(['sh', '-c', reconf_cmd], cwd=dir_)
 
     # Wait for all child processes to finish.
-    while (wait() != -1) {
-        $fail = 1 if $?;
-    }
-
-    die "Running autoreconf failed" if $fail;
-}
-
-sub checkBuildMk {
-    if ($validate eq 0 && ! -f "mk/build.mk") {
-        print <<EOF;
-
-WARNING: You don't have a mk/build.mk file.
-
-By default a standard GHC build will be done, which uses optimisation
-and builds the profiling libraries. This will take a long time, so may
-not be what you want if you are developing GHC or the libraries, rather
-than simply building it to use it.
-
-For information on creating a mk/build.mk file, please see:
-    http://ghc.haskell.org/trac/ghc/wiki/Building/Using#Buildconfiguration
-
-EOF
-    }
-}
-
-&sanity_check_line_endings();
-&sanity_check_tree();
-&boot_pkgs();
-&autoreconf();
-&checkBuildMk();
-
+    fail = False
+    for k,v in processes.items():
+        code = v.wait()
+        if code != 0:
+            print_err('autoreconf in %s failed with exit code %d' % (k, code))
+            fail = True
+
+    if fail:
+        sys.exit(1)
+
+def check_build_mk():
+    if not args.validate and not os.path.isfile("mk/build.mk"):
+        print(dedent(
+            """
+            WARNING: You don't have a mk/build.mk file.
+
+            By default a standard GHC build will be done, which uses optimisation
+            and builds the profiling libraries. This will take a long time, so may
+            not be what you want if you are developing GHC or the libraries, rather
+            than simply building it to use it.
+
+            For information on creating a mk/build.mk file, please see:
+                http://ghc.haskell.org/trac/ghc/wiki/Building/Using#Buildconfiguration
+            """))
+
+check_for_url_rewrites()
+boot_pkgs()
+autoreconf()
+check_build_mk()
diff --git a/configure.ac b/configure.ac
index 009bea0c58..0416e83be2 100644
--- a/configure.ac
+++ b/configure.ac
@@ -27,7 +27,7 @@ AC_INIT([The Glorious Glasgow Haskell Compilation System], [8.3], [glasgow-haske
 # when the source distribution was created.
 
 if test ! -f mk/config.h.in; then
-   echo "mk/config.h.in doesn't exist: perhaps you haven't run 'perl boot'?"
+   echo "mk/config.h.in doesn't exist: perhaps you haven't run 'python3 boot'?"
    exit 1
 fi
 
diff --git a/validate b/validate
index d885bd76ba..77bc002fb2 100755
--- a/validate
+++ b/validate
@@ -181,9 +181,9 @@ if [ $no_clean -eq 0 ]; then
     INSTDIR="$thisdir/inst"
 
     if [ $use_dph -eq 1 ]; then
-        perl -w boot --validate --required-tag=dph
+        python3 ./boot --validate --required-tag=dph
     else
-        perl -w boot --validate
+        python3 ./boot --validate
     fi
     ./configure --prefix="$INSTDIR" $config_args
 fi