chiark - git - mdw - xyla/blob - dump-to-assgn

   1 #! /usr/bin/perl -w
   2
   3 use autodie;
   4 use strict;
   5
   6 use Getopt::Std;
   7
   8 our $opt_r;
   9 getopts "r";
  10
  11 sub node ($) {
  12   my ($k) = @_;
  13   return { key => $k, left => undef, right => undef, flags => "" };
  14 }
  15
  16 sub read_tree ($);
  17 sub read_tree ($) {
  18   my ($s) = @_;
  19   if ($s =~ /^ \s* _ \s* (.*) $/x) { return undef, $1; }
  20   $s =~ /^ \s* \( \s* (.*) $/x or die "bad string";
  21   (my $left, $s) = read_tree $1;
  22   $s =~ /^ \s* ([*]*) \s* (\d+) \s* (.*) $/x or die "bad string";
  23   (my $flags, my $key) = ($1, $2);
  24   (my $right, $s) = read_tree $3;
  25   $s =~ /^ \s* \) \s* (.*) $/x or die "bad string";
  26   my $node = node $key;
  27   $node->{left} = $left; $node->{right} = $right; $node->{flags} = $flags;
  28   return $node, $1;
  29 }
  30
  31 my @N = ();
  32 my @LV = ();
  33 my $SP = 0;
  34
  35 my $firstp = 1;
  36 my $tree = undef;
  37 LINE: while (<>) {
  38   chomp;
  39
  40   if ($firstp && /^\s*[(_]/) {
  41     ($tree, my $tail) = read_tree $_;
  42     $tail =~ /^ \s* $/x or die "bad string";
  43     last LINE;
  44   }
  45
  46   $firstp = 0;
  47   m{^ \s+ \#0x[0-9a-f]{8} \s+  \(n \s* = \s* \d+\)
  48       (\s+) \(([ *+=-])\) (?: \s+ (0x[0-9a-f]{8} \s* \$)) \s+ (\d+) $}x
  49     or die "bad line `$_'";
  50   my $lv = length $1;
  51   my $sigil = $2;
  52   my $weight = $3;
  53   my $key = $4;
  54
  55   my $node = node $key;
  56   if ($opt_r && $sigil eq "*") { $node->{flags} .= "*"; }
  57   if (defined $weight) { $node->{flags} .= $weight . " "; }
  58   my $left = undef;
  59   while ($SP && $LV[$SP - 1] > $lv)
  60     { $SP--; my $n = $N[$SP]; $n->{right} = $left; $left = $n; }
  61   $node->{left} = $left; $N[$SP] = $node; $LV[$SP] = $lv; $SP++;
  62 }
  63 while ($SP) { $SP--; my $n = $N[$SP]; $n->{right} = $tree; $tree = $n; }
  64
  65 sub show_tree ($$$$);
  66 sub show_tree ($$$$) {
  67   my ($node, $dp, $lp, $nl) = @_;
  68   if ($node->{flags} eq "*") { $dp = ($dp&-2) + 1; }
  69   if ($node->{left}) {
  70     show_tree $node->{left}, $dp + 1, $lp + 1, $nl;
  71     print "\n" . "\t" x $dp . $node->{flags} . $node->{key};
  72   } else {
  73     print "\n" if $nl;
  74     print "\t" x $dp . "(" x $lp . "_ " . $node->{flags} . $node->{key};
  75   }
  76   if ($node->{right}) { show_tree $node->{right}, $dp + 1, 1, 1; }
  77   else { print " _"; }
  78   print ")";
  79 }
  80 show_tree $tree, 1, 1, 0;
  81 print "\n";