ApplicativeDo transformation
[ghc.git] / boot
1 #!/usr/bin/env perl
2
3 use warnings;
4 use strict;
5
6 use Cwd;
7 use File::Path 'rmtree';
8 use File::Basename;
9
10 my %required_tag;
11 my $validate;
12 my $curdir;
13
14 $required_tag{"-"} = 1;
15 $validate = 0;
16
17 $curdir = &cwd()
18     or die "Can't find current directory: $!";
19
20 while ($#ARGV ne -1) {
21     my $arg = shift @ARGV;
22
23     if ($arg =~ /^--required-tag=(.*)/) {
24         $required_tag{$1} = 1;
25     }
26     elsif ($arg =~ /^--validate$/) {
27         $validate = 1;
28     }
29     else {
30         die "Bad arg: $arg";
31     }
32 }
33
34 sub sanity_check_line_endings {
35     local $/ = undef;
36     open FILE, "packages" or die "Couldn't open file: $!";
37     binmode FILE;
38     my $string = <FILE>;
39     close FILE;
40
41     if ($string =~ /\r/) {
42         print STDERR <<EOF;
43 Found ^M in packages.
44 Perhaps you need to run
45     git config --global core.autocrlf false
46 and re-check out the tree?
47 EOF
48         exit 1;
49     }
50 }
51
52 sub sanity_check_tree {
53     my $tag;
54     my $dir;
55
56     if (-d ".git"  &&
57         system("git config remote.origin.url | grep github.com > /dev/null") == 0 &&
58         system("git config --get-regexp '^url.*github.com/.*/packages-.insteadOf' > /dev/null") != 0) {
59         # If we cloned from github, make sure the url rewrites are set.
60         # Otherwise 'git submodule update --init' prints confusing errors.
61         die <<EOF;
62 It seems you cloned this repository from GitHub. But your git config files
63 don't contain the url rewrites that are needed to make this work (GitHub
64 doesn't support '/' in repository names, so we use a different naming scheme
65 for the submodule repositories there).
66
67 Please run the following commands first:
68
69   git config --global url."git://github.com/ghc/packages-".insteadOf     git://github.com/ghc/packages/
70   git config --global url."http://github.com/ghc/packages-".insteadOf    http://github.com/ghc/packages/
71   git config --global url."https://github.com/ghc/packages-".insteadOf   https://github.com/ghc/packages/
72   git config --global url."ssh://git\@github.com/ghc/packages-".insteadOf ssh://git\@github.com/ghc/packages/
73   git config --global url."git\@github.com:/ghc/packages-".insteadOf      git\@github.com:/ghc/packages/
74
75 And then:
76
77   git submodule update --init
78   ./boot
79
80 Or start over, and clone the GHC repository from the haskell server:
81
82   git clone --recursive git://git.haskell.org/ghc.git
83
84 For more information, see:
85   * https://ghc.haskell.org/trac/ghc/wiki/Newcomers or
86   * https://ghc.haskell.org/trac/ghc/wiki/Building/GettingTheSources#CloningfromGitHub
87 EOF
88     }
89
90     # Check that we have all boot packages.
91     open PACKAGES, "< packages";
92     while (<PACKAGES>) {
93         if (/^#/) {
94             # Comment; do nothing
95         }
96         elsif (/^([a-zA-Z0-9\/.-]+) +([^ ]+) +[^ ]+ +[^ ]+$/) {
97             $dir = $1;
98             $tag = $2;
99
100             # If $tag is not "-" then it is an optional repository, so its
101             # absence isn't an error.
102             if (defined($required_tag{$tag})) {
103                 # We would like to just check for a .git directory here,
104                 # but in an lndir tree we avoid making .git directories,
105                 # so it doesn't exist. We therefore require that every repo
106                 # has a LICENSE file instead.
107                 if (! -f "$dir/LICENSE") {
108                     print STDERR "Error: $dir/LICENSE doesn't exist.\n";
109                     die "Maybe you haven't done 'git submodule update --init'?";
110                 }
111             }
112         }
113         else {
114             die "Bad line in packages file: $_";
115         }
116     }
117     close PACKAGES;
118 }
119
120 # Create libraries/*/{ghc.mk,GNUmakefile}
121 sub boot_pkgs {
122     my @library_dirs = ();
123
124     my $package;
125
126     for $package (glob "libraries/*/") {
127         $package =~ s/\/$//;
128         my $pkgs = "$package/ghc-packages";
129         if (-f $pkgs) {
130             open PKGS, "< $pkgs"
131                 or die "Failed to open $pkgs: $!";
132             while (<PKGS>) {
133                 chomp;
134                 s/\r//g;
135                 if (/.+/) {
136                     push @library_dirs, "$package/$_";
137                 }
138             }
139         }
140         else {
141             push @library_dirs, $package;
142         }
143     }
144
145     for $package (@library_dirs) {
146         my $dir = &basename($package);
147         my @cabals = glob("$package/*.cabal");
148         if ($#cabals > 0) {
149             die "Too many .cabal file in $package\n";
150         }
151         if ($#cabals eq 0) {
152             my $cabal = $cabals[0];
153             my $pkg;
154             my $top;
155             if (-f $cabal) {
156                 $pkg = $cabal;
157                 $pkg =~ s#.*/##;
158                 $pkg =~ s/\.cabal$//;
159                 $top = $package;
160                 $top =~ s#[^/]+#..#g;
161                 $dir = $package;
162                 $dir =~ s#^libraries/##g;
163
164                 print "Creating $package/ghc.mk\n";
165                 open GHCMK, "> $package/ghc.mk"
166                     or die "Opening $package/ghc.mk failed: $!";
167                 print GHCMK "${package}_PACKAGE = ${pkg}\n";
168                 print GHCMK "${package}_dist-install_GROUP = libraries\n";
169                 print GHCMK "\$(if \$(filter ${dir},\$(PACKAGES_STAGE0)),\$(eval \$(call build-package,${package},dist-boot,0)))\n";
170                 print GHCMK "\$(if \$(filter ${dir},\$(PACKAGES_STAGE1)),\$(eval \$(call build-package,${package},dist-install,1)))\n";
171                 print GHCMK "\$(if \$(filter ${dir},\$(PACKAGES_STAGE2)),\$(eval \$(call build-package,${package},dist-install,2)))\n";
172                 close GHCMK
173                     or die "Closing $package/ghc.mk failed: $!";
174
175                 print "Creating $package/GNUmakefile\n";
176                 open GNUMAKEFILE, "> $package/GNUmakefile"
177                     or die "Opening $package/GNUmakefile failed: $!";
178                 print GNUMAKEFILE "dir = ${package}\n";
179                 print GNUMAKEFILE "TOP = ${top}\n";
180                 print GNUMAKEFILE "include \$(TOP)/mk/sub-makefile.mk\n";
181                 print GNUMAKEFILE "FAST_MAKE_OPTS += stage=0\n";
182                 close GNUMAKEFILE
183                     or die "Closing $package/GNUmakefile failed: $!";
184             }
185         }
186     }
187 }
188
189 # autoreconf everything that needs it.
190 sub autoreconf {
191     my $dir;
192     my $fail;
193
194     foreach $dir (".", glob("libraries/*/")) {
195         if (-f "$dir/configure.ac") {
196             next if (my $pid = fork);
197             die "fork failed: $!" if (! defined $pid);
198             print "Booting $dir\n";
199             chdir $dir or die "can't change to $dir: $!";
200             exec("autoreconf");
201             exit 1;
202         }
203     }
204
205     # Wait for all child processes to finish.
206     while (wait() != -1) {
207         $fail = 1 if $?;
208     }
209
210     die "Running autoreconf failed" if $fail;
211 }
212
213 sub checkBuildMk {
214     if ($validate eq 0 && ! -f "mk/build.mk") {
215         print <<EOF;
216
217 WARNING: You don't have a mk/build.mk file.
218
219 By default a standard GHC build will be done, which uses optimisation
220 and builds the profiling libraries. This will take a long time, so may
221 not be what you want if you are developing GHC or the libraries, rather
222 than simply building it to use it.
223
224 For information on creating a mk/build.mk file, please see:
225     http://ghc.haskell.org/trac/ghc/wiki/Building/Using#Buildconfiguration
226
227 EOF
228     }
229 }
230
231 &sanity_check_line_endings();
232 &sanity_check_tree();
233 &boot_pkgs();
234 &autoreconf();
235 &checkBuildMk();
236