Perl6-Pugs/util/drift.pl
#!/usr/bin/perl
use IPC::Open2;
use Config;
use File::Spec;
use FindBin qw<$Bin>;
my $drift_exe = File::Spec->catfile($Bin, "DrIFT$Config{_exe}");
-e "$Bin/../../DrIFT/src/DrIFT.hs" or exit;
# XXX - This is not at all portable.
$ENV{DERIVEPATH} = "$Bin/../src";
my ($in) = @ARGV or exit;
my ($dir) = $in =~ /^(.*)\.hs/;
mkdir $dir unless -d $dir;
my $out = $dir."/Instances.hs";
open TMP, "> $in.tmp" or die "Cannot open $out: $!";
open IN, $in or die $!;
while (<IN>) {
if (/\{-!\s*global/) {
print TMP $_;
next;
}
if(/<DrIFT>/../<\/DrIFT>/) { next }
# "EvalT m a" is not handled by DrIFT yet
/^(?:data|newtype)\b(?!\s+\w+\s+\w+\s+\w+)(?!.*\bwhere)/ ... (/^(?![ \t]|--|data\b|newtype\b)/) or next;
s/^newtype\b/data/;
s/--.*$//;
/\S/ or next;
print TMP $_;
}
close IN;
close TMP;
my ($rh, $wh);
system(
'ghc',
'--make',
'-o' => $drift_exe,
"-i$Bin/../src/DrIFT",
"-i$Bin/../../DrIFT/src",
"$Bin/../../DrIFT/src/DrIFT.hs",
);
my $pid = open2(
$rh, $wh, $drift_exe, "$in.tmp"
);
my @program = do { <$rh> };
waitpid($pid, 0);
exit unless @program;
# Rearrange the DrIFT header
@program[0..2] = @program[2,0,1];
my @scary_header = split /^/m, << "SCARY";
{-
-- WARNING WARNING WARNING --
This is an autogenerated file from $in.
Do not edit this file.
All changes made here will be lost!
-- WARNING WARNING WARNING --
-}
#ifndef HADDOCK
SCARY
# splice(@program, 2, 0, @scary_header);
open IN, $in or die $!;
open OUT, "> $out" or die $!;
while (<IN>) {
/OPTION/ or last;
s{\Q../}{../../}; # Hack to fix includes (It's stupid!)
print OUT $_;
}
print OUT @scary_header;
my $module;
while (<IN>) {
if (/^module \s+ (\S*)/x) {
$module = $1;
last;
}
}
print OUT <<".";
module $module.Instances ()
where
import $module
import Data.Yaml.Syck
import DrIFT.YAML
import DrIFT.JSON
import DrIFT.Perl5
import DrIFT.Perl6Class
import Control.Monad
import qualified Data.ByteString as Buf
.
while (<IN>) {
if(/<DrIFT>/../<\/DrIFT>/) {
next if (/DrIFT/);
print OUT;
}
}
close IN;
shift(@program) until $program[0] =~ /Look, but Don't Touch/;
print OUT @program;
print OUT <<".";
type Buf = Buf.ByteString
#endif
.
close OUT;
unlink "$in.tmp";