src/perl6/redspans

   1 #!/usr/local/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use STD;
   7 use utf8;
   8 use feature 'say';
   9
  10 #let us play nice with others
  11 use POSIX qw(nice); nice 19;
  12
  13 my @loc;
  14
  15 sub MAIN {
  16     my $output = 'ast';
  17     my $file = shift;
  18
  19     my $txt = Encode::decode('utf8', `cat $file`);
  20     $loc[length($txt) - 1] = [];
  21
  22     STD->parsefile($file, actions => 'Actions');
  23
  24     my ($last_tree,$buffer) = ("","");
  25     for my $i (0 .. @loc-1) {
  26         say("Undefined $i"),next unless defined $loc[$i];
  27         my $c = substr($txt,$i,1);
  28         my $tree = "";
  29         for my $action_ref (@{$loc[$i]}) {
  30             $tree .= ${$action_ref} . " ";
  31         }
  32         if($tree ne $last_tree) {
  33             say "\n'$buffer'\n$last_tree" if $buffer ne '';
  34             $buffer = $c;
  35         } else {
  36             $buffer .= $c;
  37         }
  38         $last_tree = $tree;
  39     }
  40 }
  41
  42 ###################################################################
  43
  44 { package Actions;
  45
  46     our $AUTOLOAD;
  47     my %actions = ();
  48     sub AUTOLOAD {
  49         my $self = shift;
  50         my $C = shift;
  51         my $F = $C->{_from};
  52         my $P = $C->{_pos};
  53         $AUTOLOAD =~ s/^Actions:://;
  54         $loc[$P] = [] if $loc[$P];      # in case we backtracked to here
  55         my $action = $AUTOLOAD;
  56         my $action_ref = $actions{$action};
  57         if(!$action_ref) {
  58             $actions{$action} = $action_ref = \$action;
  59         }
  60         for ($F..$P-1) {
  61             unshift @{$loc[$_]}, $action_ref;
  62         }
  63     }
  64
  65     sub stdstopper { }
  66     sub terminator { }
  67     sub unitstopper { }
  68     sub comp_unit { }
  69 }
  70
  71 MAIN(@ARGV);
  72
  73 # vim: ts=8 sw=4