From: sof Date: Tue, 12 May 1998 15:08:57 +0000 (+0000) Subject: [project @ 1998-05-12 15:08:57 by sof] X-Git-Tag: Approx_2487_patches~705 X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=ee1fdf9bd21bf6cfa2889854e253f3a661d692fe [project @ 1998-05-12 15:08:57 by sof] Removed -genSPECS magic (no longer used.) --- diff --git a/ghc/utils/hscpp/hscpp.prl b/ghc/utils/hscpp/hscpp.prl index c08080d..12d4038 100644 --- a/ghc/utils/hscpp/hscpp.prl +++ b/ghc/utils/hscpp/hscpp.prl @@ -1,74 +1,19 @@ # -#eval "exec perl -S $0 $*" -# if $running_under_some_random_shell; -# # reads CPP output and turns #line things into appropriate Haskell # pragmas # # considered to be GHC-project specific # -# OPTIONALLY processes GENERATE_SPECS pragmas -# when give flag -genSPECS -# -# EXAMPLE: -# -# {-# GENERATE_SPECS a b #-} -# fn :: type -# -#==>> -# -# fn :: type -# {-# SPECIALIZE fn :: type[ a/a,u1/b] #-} -# {-# SPECIALIZE fn :: type[ a/a,u2/b] #-} -# {-# SPECIALIZE fn :: type[u1/a, b/b] #-} -# {-# SPECIALIZE fn :: type[u1/a,u1/b] #-} -# {-# SPECIALIZE fn :: type[u1/a,u2/b] #-} -# {-# SPECIALIZE fn :: type[u2/a, b/b] #-} -# {-# SPECIALIZE fn :: type[u2/a,u1/b] #-} -# {-# SPECIALIZE fn :: type[u2/a,u2/b] #-} -# -# where the u's are extracted from a predetermined -# set of unboxed types $SpecingString -# -# The types to substitute can be specified explicitly in { }s following -# the type variable -# -# EXAMPLES: -# -# {-# GENERATE_SPECS a{ty1,ty2...} b{+,ty1,ty2...} c{~,ty1,ty2,...} d{~,+,ty1,ty2,...} #-} -# fn :: type -# -# where -# ~ indicates that no specialisations are to be left polymorhphic in this type variable -# (this is required for overloaded tyvars which must have ground specialisations) -# + indicates that the predetermined types are to be added to the list -# -# Note: There must be no white space between { }s -# Use ( )s around type names when separation is required -# # # NOTE: this script needs RAWCPP set in order to do something # useful: # -#$RAWCPP=''; -# $Verbose = 0; -$DoGenSpecs = 0; -$DoGenSpecsUnboxed = 0; -@SpecingTypes = (); - -while ($#ARGV >= 0 && $ARGV[0] eq '-v' || $ARGV[0] =~ /^-genSPECS/) { +while ( $#ARGV >= 0 && $ARGV[0] eq '-v' ) { if ($ARGV[0] eq '-v') { $Verbose = 1; - } elsif ($ARGV[0] eq '-genSPECS') { - $DoGenSpecs = 1; - } elsif ($ARGV[0] eq '-genSPECSunboxed') { - $DoGenSpecs = 1; - $DoGenSpecsUnboxed = 1; - $SpecingString = "Char#,Int#,Double#"; - @SpecingTypes = split(/,/, $SpecingString); } else { die "hscpp: unrecognised argument: $$ARGV[0]\n"; } @@ -106,140 +51,9 @@ while () { s/^#\s*line\s+(\d+)\s+(\".+\")$/\{\-# LINE \1 \2 \-\}/; s/^#\s*(\d+)\s+(\".*\").*/\{\-# LINE \1 \2 \-\}/; -# genSPEC processing: - if ( /^\s*\{-#\s*GENERATE_SPECS/ ) { - if ( $DoGenSpecs ) { - $line = $_; - $data_or_inst = 0; - $data_inst_str = ""; - $remove_poly = 1; - $space = ""; - - if ( /^\s*\{-#\s*GENERATE_SPECS\s+(data)\s+(\S.*)\s*::(.*)#-\}\s*$/ ) { - $data_or_inst = 1; - $data_inst_str = $1; - $vars = $2; - $type = $3; - } elsif ( /^\s*\{-#\s*GENERATE_SPECS\s+(instance)\s+(\S.*)\s*::(.*)#-\}\s*$/ ) { - $data_or_inst = 1; - $data_inst_str = $1; - $vars = $2; - $type = $3; - } elsif ( /^(\s*)\{-#\s*GENERATE_SPECS\s+(\S+)\s+(.*)\s*#-\}\s*$/ ) { - $space = $1; - $fun = $2; - $vars = $3; - - $tysig = ; - while ( $tysig =~ /^\s*$/ ) { - print $tysig; - $tysig = ; - } - $funpat = $fun; # quote non alphanumeric characters in pattern - $funpat =~ s/(\W)/\\\1/g; - $tysig =~ /^\s*$funpat\s*::(.*)$/ || die "Error: GENERATE_SPECS not followed by type signature for $fun:\n$line$tysig\n"; - $type = $1; - $type =~ s/^(.*)=>//; # remove context from type - } else { - die "Error: invlaid GENERATE_SPECS pragma:\n $_"; - } - - @tyvars = split(/\s+/, $vars); - @tospec = ($type); - foreach $var (@tyvars) { - @specing = @tospec; - - if ( $var =~ /^(\w+)\{(.*)\}$/ ) { - $var = $1; - @specing_types = &split_types($2); - if ($specing_types[0] eq '~') { - shift(@specing_types); - @tospec = (); # remove specs polymorphic in this tyvar - $remove_poly = 0; - } - if ($specing_types[0] eq '+') { - shift(@specing_types); - unshift(@specing_types, @SpecingTypes); - } - } else { - @specing_types = @SpecingTypes; - } - - # If not $DoGenSpecsUnboxed we remove any unboxed types - # (i.e. types containing a #) from the specing_types - - @specing_types = grep(!/#/, @specing_types) if ! $DoGenSpecsUnboxed; - - foreach $uty (@specing_types) { - @speced = @specing; - foreach $i (0..$#speced) { - $speced[$i] =~ s/\b$var\b/$uty/g ; - } - push(@tospec, @speced); - } - } - shift(@tospec) if $remove_poly; # remove fully polymorphic spec - - if ($#tospec >= 0) { - $specty = shift(@tospec); - print ($data_or_inst ? "\{-# SPECIALIZE $data_inst_str $specty #-\}" : "$space\{-# SPECIALIZE $fun :: $specty"); - while ($#tospec >= 0) { - $specty = shift(@tospec); - print ($data_or_inst ? "; \{-# SPECIALIZE $data_inst_str $specty #-\}" : ", $specty"); - } - print ($data_or_inst ? "\n" : " #-}\n"); - } else { - print "\{- NO_SPECS_GENERATED ", $data_or_inst ? $specty : $fun, " -\}\n"; - print STDERR "Warning: No specs for GENERATE_SPECS pre-processing pragma:\n $_"; - } - print $tysig if ! $data_or_inst; - } else { - print STDERR "Warning: GENERATE_SPECS pre-processing pragma ignored:\n $_"; - print $_; - } - } else { - print $_; - } + print $_; } close(INPIPE) || exit(1); # exit is so we reflect any errors. exit(0); - - -# splits a list of types seperated by ,s but allowing ,s within ()s - - -sub split_types { - local($type_str) = @_; - - local(@chars) = split(//,$type_str); - local($depth) = 0; - local($start) = 0; - local($cur) = 0; - local($char); - - local(@types) = (); - - while ($char = $chars[$cur]) { - if ($char eq ',' && $depth == 0) { - push(@types, join('', @chars[$start .. $cur-1])) if ($start < $cur); - $start = $cur+1; - } elsif ($char eq '(') { - $depth++; - } elsif ($char eq ')') { - $depth--; - } - $cur++; - } - if ($depth == 0) { - push(@types, join('', @chars[$start .. $cur-1])) if ($start < $cur); - } else { - print STDERR "Error: GENERATE_SPECS pre-processing pragma has unbalanced ( )s\n$line\n"; - exit(1); - } - return(@types); -} - - -