This repository has been archived by the owner on Feb 1, 2020. It is now read-only.
forked from haskell-pkg-janitors/vacuum
-
Notifications
You must be signed in to change notification settings - Fork 4
/
gen-closuretype.pl
executable file
·104 lines (83 loc) · 2.6 KB
/
gen-closuretype.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
#!/usr/bin/env perl
use feature 'say', 'switch';
use warnings;
use strict;
# -- Auxiliary functions -----------
# Do any version-specific preprocessing
sub strip_per_version {
my $hcver = shift;
my @data = @_;
my @res;
given ($hcver) {
when(/7\.[0-4]{1}\.*/) {
@res = grep(/#define/, @data);
@res = grep(!/#define RTS_STORAGE_CLOSURETYPES_H/, @res);
}
default { die "strip version: GHC version unsupported!" }
}
#
# WARNING WARNING WARNING
#
# @res at this point should contain only lines which begin with '#define'
# which define all the necessary closures types for that version of GHC.
# Weird things will probably happen otherwise
#
my @finalresults; # yes these variables are named terribly...
foreach (@res) {
my ($prefix, $nm, $val) = split;
$finalresults[$val] = $nm;
}
return @finalresults;
}
sub output_hs {
my $ver = shift;
my @verdots = split(/./, $ver);
my $modname;
given($ver) {
when(/7\.([0-4]{1})\.*/) { $modname = "V70$1"; }
default { die "output_hs: GHC version unsupported!"; }
}
my $modprefix = <<END;
module GHC.Vacuum.ClosureType.$modname ( ClosureType(..) ) where
END
my $datadecl = "data ClosureType\n ";
my $instancetop = "instance Enum ClosureType where";
my $toenum = "";
my $fromenum = "";
my $i = 0;
foreach (@_) {
my $prefix = ($i == 0) ? "=": "|";
$datadecl .= "$prefix $_[$i]\n ";
$fromenum .= " fromEnum $_[$i] = $i\n";
$toenum .= " toEnum $i = $_[$i]\n";
$i++;
}
$datadecl .= "deriving (Eq, Ord, Show, Read)\n";
$toenum .= " toEnum n = error (\"toEnum: ClosureType: invalid ClosureType: \" ++ show n)\n";
# And now output all the things!
say $modprefix;
say $datadecl;
say $instancetop;
say $fromenum;
say $toenum;
}
# -- Main --------------------------
# Find GHC binary, version, and ClosureTypes.h
my $hc;
if(defined($ARGV[0])) {
$hc = $ARGV[0]; chomp($hc);
}
else {
$hc = "ghc";
}
my $hcver = `$hc --numeric-version`; chomp($hcver);
my $hclibdir = `$hc --print-libdir`; chomp($hclibdir);
my $closuretypesf = $hclibdir . "/include/rts/storage/ClosureTypes.h";
die "ERR: couldn't locate ClosureTypes.h!" unless (-e $closuretypesf);
#say "Located $closuretypesf (version $hcver)";
# Open file, filter it, and print out the results
open(CLOSURETYPES, $closuretypesf) or die "Couldn't open ClosureTypes.h!";
my @closuretypesd = <CLOSURETYPES>;
close(CLOSURETYPES);
my @results = strip_per_version($hcver, @closuretypesd);
output_hs($hcver, @results);