75 lines
1.9 KiB
Perl
75 lines
1.9 KiB
Perl
#! /usr/bin/perl
|
|
#
|
|
# Copyright 2014, General Dynamics C4 Systems
|
|
#
|
|
# This software may be distributed and modified according to the terms of
|
|
# the GNU General Public License version 2. Note that NO WARRANTY is provided.
|
|
# See "LICENSE_GPLv2.txt" for details.
|
|
#
|
|
# @TAG(GD_GPL)
|
|
#
|
|
|
|
$literate = 0;
|
|
$literate = 1 if $ARGV[0] eq "-l";
|
|
|
|
$prefix = $literate ? "> " : "";
|
|
|
|
# read the entire input
|
|
$/ = undef;
|
|
$input = <STDIN>;
|
|
|
|
# find the module name
|
|
$input =~ /module\s+([A-Z][a-zA-Z0-9.]*)/m or die "no module";
|
|
$modname = $1;
|
|
|
|
# find the lists of hs-boot imports and exports
|
|
$input =~ /{-# BOOT-IMPORTS:((\s+#?[A-Z][a-zA-Z0-9.]+(\(.*?\))?)*) #-}/
|
|
or die "no imports";
|
|
$imports = $1;
|
|
|
|
$input =~ /{-# BOOT-EXPORTS:((\s+#?[a-zA-Z][a-zA-Z0-9']+(\(.*?\))?)*) #-}/
|
|
or die "no exports";
|
|
$exports = $1;
|
|
|
|
# transform the import list to import statements
|
|
$imports =~ s/\s+/\n${prefix}import /g;
|
|
$imports =~ s/#/{-# SOURCE #-} /g;
|
|
|
|
# create the export list
|
|
$explist = $exports;
|
|
$explist =~ s/\s#\w+//g;
|
|
$explist =~ s/(\w|\))\s/\1, /g;
|
|
|
|
# print the module & import statements
|
|
print "${prefix}-- this file is automatically generated, do not edit\n";
|
|
print "${prefix}module $modname($explist) where\n$imports\n\n";
|
|
|
|
$exports =~ s/#//g;
|
|
$exports =~ s/\(.*?\)//g;
|
|
|
|
# find and print all the type definitions...
|
|
while($exports =~ / ([A-Z][a-zA-Z0-9']*)/g) {
|
|
$name = $1;
|
|
|
|
if (not $literate and
|
|
$input =~ /^((type|newtype|data|class)\s+([A-Z][a-zA-Z0-9' ]*=>\s+)?$name\W.*?)^\S/ms)
|
|
{
|
|
print "$1";
|
|
} elsif ($literate and
|
|
$input =~ /^(> (type|newtype|data|class)\s+([A-Z][a-zA-Z0-9' ]*=>\s+)?$name\W.*?)^> \S/ms)
|
|
{
|
|
print "$1";
|
|
}
|
|
}
|
|
|
|
# ...and the type signatures
|
|
while($exports =~ / ([a-z][a-zA-Z0-9']*)/g) {
|
|
$name = $1;
|
|
|
|
if (not $literate and $input =~ /^($name\s+::.*?)^\S/ms) {
|
|
print "$1";
|
|
} elsif ($literate and $input =~ /^(> $name\s+::.*?)^> \S/ms) {
|
|
print "$1";
|
|
}
|
|
}
|
|
|