From: Mark Wooding <mdw@distorted.org.uk>
Date: Fri, 6 Sep 2024 20:58:32 +0000 (+0100)
Subject: dump-to-assgn: Add a script to convert dumps into `read_tree' form.
X-Git-Tag: 0.99.0~99
X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/xyla/commitdiff_plain/a371d5a9f78150676e8bcafd76405b6fadc00987

dump-to-assgn: Add a script to convert dumps into `read_tree' form.

Also pretty-prints `read-tree' format.
---

diff --git a/dump-to-assgn b/dump-to-assgn
new file mode 100755
index 0000000..22db491
--- /dev/null
+++ b/dump-to-assgn
@@ -0,0 +1,81 @@
+#! /usr/bin/perl -w
+
+use autodie;
+use strict;
+
+use Getopt::Std;
+
+our $opt_r;
+getopts "r";
+
+sub node ($) {
+  my ($k) = @_;
+  return { key => $k, left => undef, right => undef, flags => "" };
+}
+
+sub read_tree ($);
+sub read_tree ($) {
+  my ($s) = @_;
+  if ($s =~ /^ \s* _ \s* (.*) $/x) { return undef, $1; }
+  $s =~ /^ \s* \( \s* (.*) $/x or die "bad string";
+  (my $left, $s) = read_tree $1;
+  $s =~ /^ \s* ([*]*) \s* (\d+) \s* (.*) $/x or die "bad string";
+  (my $flags, my $key) = ($1, $2);
+  (my $right, $s) = read_tree $3;
+  $s =~ /^ \s* \) \s* (.*) $/x or die "bad string";
+  my $node = node $key;
+  $node->{left} = $left; $node->{right} = $right; $node->{flags} = $flags;
+  return $node, $1;
+}
+
+my @N = ();
+my @LV = ();
+my $SP = 0;
+
+my $firstp = 1;
+my $tree = undef;
+LINE: while (<>) {
+  chomp;
+
+  if ($firstp && /^\s*[(_]/) {
+    ($tree, my $tail) = read_tree $_;
+    $tail =~ /^ \s* $/x or die "bad string";
+    last LINE;
+  }
+
+  $firstp = 0;
+  m{^ \s+ \#0x[0-9a-f]{8} \s+  \(n \s* = \s* \d+\)
+      (\s+) \(([ *+=-])\) (?: \s+ (0x[0-9a-f]{8} \s* \$)) \s+ (\d+) $}x
+    or die "bad line `$_'";
+  my $lv = length $1;
+  my $sigil = $2;
+  my $weight = $3;
+  my $key = $4;
+
+  my $node = node $key;
+  if ($opt_r && $sigil eq "*") { $node->{flags} .= "*"; }
+  if (defined $weight) { $node->{flags} .= $weight . " "; }
+  my $left = undef;
+  while ($SP && $LV[$SP - 1] > $lv)
+    { $SP--; my $n = $N[$SP]; $n->{right} = $left; $left = $n; }
+  $node->{left} = $left; $N[$SP] = $node; $LV[$SP] = $lv; $SP++;
+}
+while ($SP) { $SP--; my $n = $N[$SP]; $n->{right} = $tree; $tree = $n; }
+
+sub show_tree ($$$$);
+sub show_tree ($$$$) {
+  my ($node, $dp, $lp, $nl) = @_;
+  if ($node->{flags} eq "*") { $dp = ($dp&-2) + 1; }
+  if ($node->{left}) {
+    show_tree $node->{left}, $dp + 1, $lp + 1, $nl;
+    print "\n" . "\t" x $dp . $node->{flags} . $node->{key};
+  } else {
+    print "\n" if $nl;
+    print "\t" x $dp . "(" x $lp . "_ " . $node->{flags} . $node->{key};
+  }
+  if ($node->{right}) { show_tree $node->{right}, $dp + 1, 1, 1; }
+  else { print " _"; }
+  print ")";
+}
+show_tree $tree, 1, 1, 0;
+print "\n";