The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
AUDREYT / Perl6-Pugs-6.2.13 / util / grokprims.pl 
#!/usr/bin/perl
use warnings;
use strict;

while (<>) {
  last if /^initSyms = /;
}

my %assoc = (
    spre  => 'special',
    pre   => 'prefix',
    post  => 'postfix',
    left  =>  'left-associative infix',
    right => 'right-associative infix',
    non   =>   'non-associative infix',
    list  => 'list infix',
    chain => 'chaining infix',
);

my @ops;

while (<>) {
  last unless /^\\\\n[^"]/;
  chomp;

  my (undef, $ret, $assoc, $name, $args) = split ' ', $_, 5;

  $name =~ s/\\(.)/$1/g;

  $args =~ m/\((.*)\)/ or die "Bad args spec";
  $args = $1;

  my @args = split /, *| +/, $args;

  if (exists $assoc{$assoc}) {
    $assoc = $assoc{$assoc};
  } else {
    $assoc = "FIXME: $assoc";
  }

  push @ops, {name=>$name, ret=>$ret, assoc=>$assoc, args=>[@args], line=>$.}
}

print '<?xml version="1.1" encoding="UTF-8" ?><html><body><table border="1">';



foreach my $op (sort 
         {
           $a->{name} cmp $b->{name} or
             $a->{assoc} cmp $b->{assoc} or
               @{$a->{args}} <=> @{$b->{args}}} @ops
        ) {

  my $example;
  
  local $_=$op->{assoc};
  my $name = $op->{name};
  my $a0 = $op->{args}[0];
  my $a1 = $op->{args}[1];
  my $arity = 0+@{$op->{args}};

  if (/prefix/) {
    if (($arity>1 and $a0 =~ s/:$//) or
        $arity==1) {
      $example = "\$$a0.$name(".join(', ', map {"\$$_"} @{$op->{args}}[1..$arity-1]).")<br />";
    }
    $example .= "$name(". join(', ', map {$a=$_; $a=~s/:$//; '$'.$a} @{$op->{args}}) .")";
  } elsif (/(list|chaining) infix/) {
    $example = "\$$a0 $name \$$a0 $name \$$a0";
  } elsif (/left-associative/ and $arity==2) {
    $example = "(\$$a0 $name \$$a1) $name \$$a1";
  } elsif (/left-associative/ and $arity==2) {
    $example = "HUH: left-associative with arity $arity";
  } elsif (/right-associative/) {
    $example = "\$$a0 $name (\$$a0 $name \$$a1)";
  } elsif (/non-associative/) {
    $example = "\$$a0 $name \$$a1";
  } elsif (/postfix/ and $arity == 1) {
    $example = "\$$a0$name";
  } elsif (/special/ and $arity == 1) {
    $example = "$name\$$a0 # ???";
  } else {
    $example = "$_ ($arity)";
  }

  print "   <tr>";
  print "<td><tt>$example</tt></td>";
  print "<td>$op->{assoc}</td>";
  print "<td>$op->{ret}</td>";
  print "<td><tt>$op->{name}</tt></td>";
  print "<td>(</td>";
  print "<td><table border='1' width='100%'><tr>";
  foreach my $arg (@{$op->{args}}) {
    print "<td>$arg</td>";
  }
  print "</td></tr></table>";
  print "<td>)</td>";
#  print "<td>Prim.hs line $op->{line}</td>";
  print "</tr>\n";
}

print "</table></body></html>";