util/lang-compress.pl

   1 #! /usr/bin/env perl
   2 #
   3 # C source compressor.  This:
   4 #
   5 # - merges continuation lines
   6 # - removes comments (not in strings)
   7 # - removes empty lines (not in strings)
   8
   9 use strict;
  10 use warnings;
  11
  12 my $debug = defined $ENV{DEBUG};
  13 my $lang = shift @ARGV;
  14
  15 # Slurp the file
  16 $/ = undef;
  17 $_ = <>;
  18
  19 if ($lang eq 'C') {
  20     # Merge continuation lines
  21     s{\\\n}{}g;
  22
  23     # Regexp for things that should be preserved
  24     my $preserved =
  25         qr{
  26               (?:
  27                   "                 # String start
  28                   (?: \\. | [^\"])* # Any character, including escaped ones
  29                   "                 # String end
  30               )
  31
  32           |                         # OR
  33
  34               (?:
  35                   '                 # Character start (multi-chars supported)
  36                   (?: \\. | [^\'])+ # Any character, including escaped ones
  37                   '                 # String end
  38               )
  39         }x;
  40
  41     # Remove comments while preserving strings
  42     s{
  43          (?|                        # All things preserved end up in $1
  44
  45              /\*                    # C comment start
  46              .*?                    # Contents up until
  47              \*/                    # C comment end
  48
  49          |                          # OR
  50
  51              (                      # Grouping for the replacement
  52                  $preserved
  53              )
  54
  55          )
  56     }{
  57         if ($debug) {
  58             print STDERR "DEBUG: '$&' => '$1'\n" if defined $1;
  59             print STDERR "DEBUG: '$&' removed\n" unless defined $1;
  60         }
  61         defined $1 ? $1 : ""
  62     }gsxe;
  63
  64     # Remove empty lines
  65     s{
  66          (?|                        # All things preserved end up in $1
  67
  68              (^|\n)(?:\s*(?:\n|$))+ # Empty lines, preserve one newline
  69
  70          |                          # OR
  71
  72              (                      # Grouping for the replacement
  73                  $preserved
  74              )
  75
  76          )
  77     }{$1}gsx;
  78
  79     # Remove extra spaces
  80     s{
  81          (?|                        # All things preserved end up in $1
  82
  83              \h+                    # Horizontal spaces replaced with one
  84
  85          |                          # OR
  86
  87              (                      # Grouping for the replacement
  88                  $preserved
  89              )
  90
  91          )
  92     }{
  93         if ($debug) {
  94             print STDERR "DEBUG: '$&' => '$1'\n" if defined $1;
  95             print STDERR "DEBUG: '$&' => ' '\n" unless defined $1;
  96         }
  97         defined $1 ? $1 : " "
  98     }gsxe;
  99
 100     # Clean up spaces at start and end of lines
 101     s/^ //mg;
 102     s/ $//mg;
 103 } elsif ($lang eq 'S') {
 104     # Because we use C++ style comments in our .S files, all we can do
 105     # is to drop them
 106     s{
 107          ^([^\n]*?)//[^\n]*?$   # Any line with a // comment
 108     }{
 109         if ($debug) {
 110             print STDERR "DEBUG: '$&' => '$1'\n" if defined $1;
 111             print STDERR "DEBUG: '$&' removed\n" unless defined $1;
 112         }
 113         defined $1 ? $1 : ""
 114     }mgsxe;
 115
 116     # Drop all empty lines
 117     s{
 118          (^|\n)(?:\s*(?:\n|$))+ # Empty lines, preserve one newline
 119     }{$1}gsx;
 120 } elsif ($lang eq 'perl') {
 121     # Merge continuation lines
 122     s{\\\n}{}g;
 123
 124     # Regexp for things that should be preserved
 125     my $preserved =
 126         qr{
 127               (?:
 128                   <<["']?(\w+)["']? # HERE document start
 129                   .*?               # Its contents
 130                   ^\g{-1}$
 131               )
 132           |
 133               (?:
 134                   "                 # Double quoted string start
 135                   (?: \\. | [^\"])* # Any character, including escaped ones
 136                   "                 # Double quoted string end
 137               )
 138
 139           |                         # OR
 140
 141               (?:
 142                   '                 # Single quoted string start
 143                   [^\']*            # Any character
 144                   '                 # Single quoted string end
 145               )
 146         }msx;
 147
 148     # Remove comments while preserving strings
 149     s{
 150          (?|                        # All things preserved end up in $1
 151
 152              \#.*?(\n|$)            # Perl comments
 153
 154          |                          # OR
 155
 156              (                      # Grouping for the replacement
 157                  $preserved
 158              )
 159
 160          )
 161     }{
 162         if ($debug) {
 163             print STDERR "DEBUG: '$&' => '$1'\n" if defined $1;
 164             print STDERR "DEBUG: '$&' removed\n" unless defined $1;
 165         }
 166         defined $1 ? $1 : ""
 167     }gsxe;
 168
 169     # Remove empty lines
 170     s{
 171          (?|                        # All things preserved end up in $1
 172
 173              (^|\n)(?:\s*(?:\n|$))+ # Empty lines, preserve one newline
 174
 175          |                          # OR
 176
 177              (                      # Grouping for the replacement
 178                  $preserved
 179              )
 180
 181          )
 182     }{$1}gsx;
 183 }
 184
 185 print;