d-bindings code moved into trunk's misc directory for storage - closing branch for now as it is inactive. If work resumes branch can be revived. (svn branch delete)

svn:revision:68381
svn:branch:d-binding
svn:account:starseeker

.gitignore

@@ -1,3 +0,0 @@
-/bin
-/lib
-/build

misc/d-bindings/BP.pm

@@ -0,0 +1,134 @@
+package BP; # BRL-CAD paths and associated info
+
+use strict;
+use warnings;
+
+use Readonly;
+use File::Find;
+use File::Basename;
+
+# The following defs are for use just during the experimental
+# phase. They will have to be handled differently during devlopment
+# and installation.  For instance, the final .d files may be installed
+# as both source (maybe in a sub-dir of the normal include dir) and as
+# dmd-compiled versions (say in a 'dmd-obj' installed sub-dir).
+
+# the root dir of the installed BRL-CAD package
+Readonly our $RDIR => '/usr/brlcad/rel-7.25.0';
+
+# the source dir of the installed BRL-CAD include files
+Readonly our $IDIR => "$RDIR/include/brlcad";
+
+# the source dirs of some other installed BRL-CAD include files
+Readonly our $IDIR2 => "$RDIR/include";
+
+# the location for the D interface files
+Readonly our $DIDIR => './di';
+
+# used during collecting info and writing modules
+our $debug = 0;
+my %seen = ();
+my %dir  = ();
+
+# need absolute paths
+
+# list of BRL-CAD installed headers
+#   key: basename
+#   val: path
+my $tfil  = '/usr/src/tbrowde/brlcad-svn-d-binding/misc/d-bindings/BH.pm.new';
+
+# list of BRL-CAD external headers called by the installed headers
+#   key: basename <X/Y/Z>
+#   val: path
+my $tfil2 = '/usr/src/tbrowde/brlcad-svn-d-binding/misc/d-bindings/BE.pm.new';
+
+=pod
+
+sub get_brlcad_ext_inc_data {
+  # get all external include paths and files called by the BRL-CAD headers
+  use BH;
+  my $oref  = shift @_;
+  my $debug = shift @_;
+  $BP::debug = (defined $debug && $debug) ? 1 : 0;
+
+} # get_brlcad_ext_inc_data
+
+=cut
+
+sub get_brlcad_inc_data {
+  # get all include paths and files under the $RDIR/include directory
+  my $oref  = shift @_;
+  my $debug = shift @_;
+  $BP::debug = (defined $debug && $debug)? 1 : 0;
+
+  # initialize the module
+  open my $fp, '>', "$tfil"
+    or die "$tfil: $!";
+  print $fp "package BH;\n\n";
+  print $fp "# WARNING:  This file is auto-generated: edits will be lost!!\n\n";
+  print $fp "# Following is a list of all public and private\n";
+  print $fp "# headers found in the installed BRL-CAD package.\n\n";
+  print $fp "our %hdr = (\n";
+  close $fp;
+
+  find(\&_process_file, ("$RDIR/include"));
+
+  # finalize the module
+  open $fp, '>>', $tfil
+    or die "$tfil: $!";
+
+  # end the hdr hash
+  print $fp ");\n\n";
+
+  # write the path hash
+  print $fp "our %hdr = (\n";
+  foreach my $d (keys %dir) {
+  }
+
+  print $fp "# mandatory true return for a Perl module\n";
+  print $fp "1;\n";
+
+  close $fp;
+
+  push @{$oref}, basename($tfil);
+
+  #print "See file '$tfil'\n"; die "debug exit";
+
+} # get_brlcad_inc_data
+
+sub _process_file {
+  my $path = $File::Find::name; # full path
+  my $fdir = $File::Find::dir;
+  my $fnam = $_;
+
+  if (-d $fnam) {
+      $dir{$path} = $fnam;
+  }
+  else {
+    if ($BP::debug) {
+      print "=== in dir '$fdir'\n";
+      print "   path: '$path'\n";
+      print "   file: '$fnam'\n";
+    }
+
+    # check for dups
+    if (!exists $seen{$fnam}) {
+      $seen{$fnam} = $path;
+    }
+    else {
+      print "WARNING:  File: '$fnam'\n";
+      print "                '$path' is a dup\n";
+      print "          Prev: '$seen{$fnam}'\n";
+    }
+
+    # save data
+    open my $fp, '>>', $tfil
+      or die "$tfil: $!";
+    print $fp "  '$fnam' => '$path',\n";
+    close $fp;
+  }
+
+} # _process_file
+
+# mandatory true return from a Perl module
+1;

misc/d-bindings/CExtract.pm

@@ -0,0 +1,482 @@
+package CExtract;
+
+use strict;
+use warnings;
+
+use ParsePPCHeader;
+
+my $_WARNED = 0;
+
+# official C reserved words (from 'c-grammar.txt')
+our %crw
+  = (
+     'char'     => {},
+     'double'   => {},
+     'float'    => {},
+     'int'      => {},
+     'short'    => {},
+     'auto'     => {},
+     'break'    => {},
+     'case'     => {},
+     'const'    => {},
+     'continue' => {},
+     'default'  => {},
+     'do'       => {},
+     'enum'     => {},
+     'extern'   => {},
+     'for'      => {},
+     'goto'     => {},
+     'if'       => {},
+     'long'     => {},
+     'register' => {},
+     'return'   => {},
+     'signed'   => {},
+     'sizeof'   => {},
+     'static'   => {},
+     'struct'   => {},
+     'switch'   => {},
+     'typedef'  => {},
+     'union'    => {},
+     'unsigned' => {},
+     'void'     => {},
+     'volatile' => {},
+     'while'    => {},
+    );
+
+# keywords used as types in BRL-CAD headers
+our @bkw
+  = (
+     'BU_RB_WALK_ORDER',
+     'ClientData',
+     'FILE',
+     'TclPlatStubs',
+     'TclStubs',
+     'Tcl_AsyncHandler',
+     'Tcl_Channel',
+     'Tcl_ChannelType',
+     'Tcl_ChannelTypeVersion',
+     'Tcl_Command',
+     'Tcl_DecrRefCount',
+     'Tcl_DriverBlockModeProc',
+     'Tcl_DriverClose2Proc',
+     'Tcl_DriverCloseProc',
+     'Tcl_DriverFlushProc',
+     'Tcl_DriverGetHandleProc',
+     'Tcl_DriverGetOptionProc',
+     'Tcl_DriverHandlerProc',
+     'Tcl_DriverInputProc',
+     'Tcl_DriverOutputProc',
+     'Tcl_DriverSeekProc',
+     'Tcl_DriverSetOptionProc',
+     'Tcl_DriverThreadActionProc',
+     'Tcl_DriverTruncateProc',
+     'Tcl_DriverWatchProc',
+     'Tcl_DriverWideSeekProc',
+     'Tcl_Encoding',
+     'Tcl_Event',
+     'Tcl_ExitProc',
+     'Tcl_Filesystem',
+     'Tcl_HashEntry',
+     'Tcl_HashKeyType',
+     'Tcl_HashTable',
+     'Tcl_IncrRefCount',
+     'Tcl_Interp',
+     'Tcl_InterpState',
+     'Tcl_IsShared',
+     'Tcl_Mutex',
+     'Tcl_Namespace',
+     'Tcl_Obj',
+     'Tcl_ObjType',
+     'Tcl_PathType',
+     'Tcl_PathType',
+     'Tcl_Pid',
+     'Tcl_RegExp',
+     'Tcl_StatBuf',
+     'Tcl_ThreadId',
+     'Tcl_TimerToken',
+     'Tcl_Trace',
+     'Tcl_UniChar',
+     'Tcl_WideInt',
+     '_G_fpos_t',
+     '_IO_FILE',
+     '_IO_FILE_plus;',
+     '_IO_jump_t;',
+     '_IO_marker',
+     '__blkcnt_t',
+     '__blksize_t',
+     '__builtin_va_list',
+     '__caddr_t',
+     '__clock_t',
+     '__clockid_t',
+     '__codecvt_result',
+     '__const',
+     '__daddr_t',
+     '__dev_t',
+     '__fd_mask',
+     '__fsblkcnt_t',
+     '__fsfilcnt_t',
+     '__fsid_t',
+     '__gid_t',
+     '__gnuc_va_list',
+     '__id_t',
+     '__ino_t',
+     '__jmp_buf_tag',
+     '__key_t',
+     '__loff_t',
+     '__mode_t',
+     '__nlink_t',
+     '__off64_t',
+     '__off_t',
+     '__pid_t',
+     '__quad_t',
+     '__sigset_t',
+     '__ssize_t',
+     '__suseconds_t',
+     '__time_t',
+     '__timer_t',
+     '__u_char',
+     '__u_int',
+     '__u_long',
+     '__u_quad_t',
+     '__u_short',
+     '__uid_t',
+     'bu_attribute_value_pair',
+     'bu_attribute_value_set',
+     'bu_bitv',
+     'bu_color',
+     'bu_endian_t',
+     'bu_external',
+     'bu_hash_entry',
+     'bu_hash_record',
+     'bu_hash_tbl',
+     'bu_heap_func_t',
+     'bu_hist',
+     'bu_hook_list',
+     'bu_lex_key',
+     'bu_lex_t_dbl',
+     'bu_lex_t_id',
+     'bu_lex_t_int',
+     'bu_lex_t_key',
+     'bu_lex_token',
+     'bu_list',
+     'bu_mapped_file',
+     'bu_observer',
+     'bu_ptbl',
+     'bu_rb_list',
+     'bu_rb_node',
+     'bu_rb_package',
+     'bu_rb_tree',
+     'bu_structparse',
+     'bu_utctime(struct',
+     'bu_vlb',
+     'bu_vls',
+     'char',
+     'const',
+     'div_t',
+     'double',
+     'drand48_data',
+     'enum',
+     'extern',
+     'float',
+     'genptr_t',
+     'int',
+     'int64_t',
+     'jmp_buf',
+     'ldiv_t',
+     'long',
+     'off_t',
+     'random_data',
+     'short',
+     'signed',
+     'size_t',
+     'struct',
+     'timespec',
+     'timeval',
+     'typedef',
+     'union',
+     'unsigned',
+     'utimbuf;',
+     'void',
+     'volatile',
+     'wait',
+    );
+our %bkw;
+@bkw{@bkw} = ();
+
+sub extract_object {
+  my $argref = shift @_;
+  my $r = ref $argref;
+  die "FATAL:  \$argref is not a 'HASH' ref, it's a '$r'."
+    if $r ne 'HASH';
+
+  # the input lines
+  my $lines_aref  = $argref->{lines_aref};  # \@ilines
+
+  # the current index
+  my $i           = $argref->{curr_index};  # $i - current @lines index
+
+  # a new object instance to fill
+  my $obj         = $argref->{obj};
+
+=pod
+
+  my $olines_raw_aref = $argref->{olines_raw_aref}; # shift @_; # \@olines_raw
+  my $olines_cmt_aref = $argref->{olines_cmt_aref}; # shift @_; # \@olines_cmt
+
+  my $ofils_aref  = $argref->{ofils_aref};  # shift @_; # \@ofils
+  my $tfils_aref  = $argref->{tfils_aref};  # shift @_; # \@tmpfils
+
+  my $chunk_num   = $argref->{chunk_num};   # shift @_; # $nchunks
+
+=cut
+
+  my $nl = scalar @{$lines_aref};
+
+  # we're at the first line of the unknown object
+  # get all lines til the last
+  # temp output lines
+  my @olines = ();
+
+  # track '{}', '()', '[]' levels
+  my $clevel = 0; # curly braces
+  my $plevel = 0; # parentheses
+  my $slevel = 0; # square brackets
+
+  my $first_index = $i;
+  my $last_index  = $i;
+
+  my $nactual_lines = 0;
+
+ LINE:
+  for (; $i < $nl; ++$i) {
+    my $lnum = $i + 1;
+    my $line = $lines_aref->[$i];
+    chomp $line;
+
+    # skip blank lines
+    next LINE if ($line !~ /\S+/);
+
+    ++$nactual_lines;
+
+    my $len = length $line;
+    for (my $j = 0; $j < $len; ++$j) {
+      my $c = substr $line, $j, 1;
+      if ($c eq '{') {
+	++$clevel;
+      }
+      elsif ($c eq '}') {
+	--$clevel;
+      }
+
+      elsif ($c eq '(') {
+	++$plevel;
+      }
+      elsif ($c eq ')') {
+	--$plevel;
+      }
+
+      elsif ($c eq '[') {
+	++$slevel;
+      }
+      elsif ($c eq ']') {
+	--$slevel;
+      }
+
+      elsif ($c eq ';'
+	     && $clevel == 0
+	     && $plevel == 0
+	     && $slevel == 0
+	    ) {
+	push @olines, $line;
+	$last_index = $i;
+	last LINE;
+      }
+    }
+    push @olines, $line;
+  }
+
+  my $norig_lines = $last_index - $first_index + 1;
+
+  # do some rudimentary analysis
+  # make lines one string
+  my $s = join ' ', @olines;
+
+  # add spaces around some items
+  my @ch = ('{', '(', '[', ']', ')', '}', ';', '*');
+  my %ch;
+  @ch{@ch} = ();
+
+  my $slen = length $s;
+
+  my $ss = '';
+  for (my $i = 0; $i < $slen; ++$i) {
+    my $c = substr $s, $i, 1;
+    if (!exists $ch{$c}) {
+      $ss .= $c;
+      next;
+    }
+
+    $ss .= ' ';
+    $ss .= $c;
+    $ss .= ' ';
+  }
+
+  # now close up adjacent asterisks ('*')
+  while ($ss =~ s{\*[\s]+\*}{\*\*}) {
+    ; # noopt
+  }
+
+  # trim leading and trailing white space
+  $ss =~ s{\A \s*}{}x;
+  $ss =~ s{\s* \z}{}x;
+  # collapse multiple spaces into one
+  $ss =~ s{\s{2,}}{ }g;
+
+  # get new length
+  $s = $ss;
+  $slen = length $s;
+
+=pod
+
+  # track '{}', '()', '[]' first and last positions
+  my $cfirst   = -1; # curly braces
+  my $pfirst   = -1; # parentheses
+  my $sfirst   = -1; # square brackets
+
+  my $clast    = -1; # curly braces
+  my $plast    = -1; # parentheses
+  my $slast    = -1; # square brackets
+
+  my $semilast = -1; # semicolon
+
+  for (my $i = 0; $i < $slen; ++$i) {
+    my $c = substr $s, $i, 1;
+    if ($c eq '{') {
+      $cfirst = _update_index($cfirst, $i);
+    }
+    elsif ($c eq '}') {
+      $clast = _update_index($clast, $i);
+    }
+
+    elsif ($c eq '(') {
+      $pfirst = _update_index($pfirst, $i);
+    }
+    elsif ($c eq ')') {
+      $plast = _update_index($plast, $i);
+    }
+
+    elsif ($c eq '[') {
+      $sfirst = _update_index($sfirst, $i);
+    }
+    elsif ($c eq ']') {
+      $slast = _update_index($slast, $i);
+    }
+
+    elsif ($c eq ';') {
+      $semilast = _update_index($semilast, $i);
+    }
+  }
+
+  my $typ = 'unknown';
+  my $enum   = index $s, 'enum';
+  my $struct = index $s, 'struct';
+  my $union  = index $s, 'union';
+  my $typdef = index $s, 'typedef';
+
+  my @d = split(' ', $s);
+  my $ftok = shift @d;
+  if ($ftok eq 'extern') {
+    $typ = 'var decl';
+  }
+  elsif ($ftok eq 'struct') {
+    $typ = 'struct';
+  }
+  elsif ($ftok eq 'union') {
+    $typ = 'union';
+  }
+  elsif ($cfirst >= 0
+      && ($pfirst < 0 || $cfirst < $pfirst)
+      && ($sfirst < 0 || $cfirst < $sfirst)) {
+    if ($enum >=0 && $enum < $cfirst) {
+      $typ = 'enum';
+    }
+    elsif ($struct >=0 && $struct < $cfirst) {
+      $typ = 'struct';
+    }
+    elsif ($union >=0 && $union < $cfirst) {
+      $typ = 'union';
+    }
+  }
+  elsif ($pfirst >= 0
+      && ($cfirst < 0 || $pfirst < $cfirst)
+      && ($sfirst < 0 || $pfirst < $sfirst)) {
+    $typ = 'func decl';
+  }
+
+  my $typd = '';
+  $typd = 'typedef' if ($s =~/typedef/);
+  my $t = '';
+  if ($typd) {
+    $t = $typd;
+  }
+
+  if ($t && $typ ne 'unknown') {
+    $t .= " $typ";
+  }
+  elsif (!$t) {
+    $t = $typ;
+  }
+
+=cut
+
+  # object gets info
+  my $first_line = $first_index + 1;
+  my $last_line  = $last_index + 1;
+
+  $obj->c_line($s);
+  $obj->first_line($first_line);
+  $obj->last_line($first_line);
+
+=pod
+
+  my @xlines_1
+    = (
+       "\n",
+       "//=== starting extracted code at input line $first_line:\n",
+       #"//  object type '$t'\n",
+       #"// N original lines: $norig_lines\n",
+       #"// N actual lines:   $nactual_lines\n",
+      );
+
+  push @{$olines_cmt_aref}, @xlines_1;
+
+  # the one-liner
+  push @{$olines_cmt_aref}, "$s\n";;
+  push @{$olines_raw_aref}, "$s\n";;
+
+  my @xlines_2
+    = (
+       "//=== ending extracted code at input line $last_line\n",
+      );
+
+  push @{$olines_cmt_aref}, @xlines_2;
+
+=cut
+
+  return ($last_index);
+
+} # extract_object
+
+sub _update_index {
+  my $max = shift @_;
+  my $i   = shift @_;
+
+  return $i
+    if ($i > $max);
+
+  return $max;
+
+} # _update_index
+
+# mandatory true return for a Perl module
+1;

misc/d-bindings/D.pm

@@ -0,0 +1,806 @@
+package D;
+
+use v5.14;
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+use File::Copy;
+use File::Basename;
+use Running::Commentary;  # a better 'system' (Conway)
+
+use lib('.');
+
+use G;
+use CExtract;
+use BP;
+use DS;
+use ParsePPCHeader;
+use HObj;
+
+# ignored top-level original .h files
+my @ignore
+  = (
+     # don't use these at the moment
+     #'conf.h',
+     'dvec.h',
+     'redblack.h',
+    );
+my %ignore = ();
+@ignore{@ignore} = ();
+
+# temp ignored .h files called inside top-level files (may be
+# permanent, they are ostensably for CMake)
+my @tignore
+  = (
+     # don't use these at the moment
+     #'config_win.h',
+     #'brlcad_config.h',
+    );
+my %tignore = ();
+@tignore{@tignore} = ();
+
+# "mapped" files (header files not in the main BRL-CAD header dir)
+my %is_mapped
+  = (
+     'tcl.h'          => "$BP::IDIR2/tcl.h",
+     'tclDecls.h'     => "$BP::IDIR2/tclDecls.h",
+     'tclPlatDecls.h' => "$BP::IDIR2/tclPlatDecls.h",
+    );
+
+# sys headers and their equivalent Phobos module names form import
+# statements; empty is unknown or don't use
+my %sysmod
+  = (
+     # don't use these at the moment
+     #'<tchar.h>'     => '',,
+     #'<wchar.h>'     => '',,
+     #'<sys/types.h>' => '',,
+     #'<dlfcn.h>'     => '',,
+     #'<signal.h>'    => '',,
+     #'<setjmp.h>'    => '',,
+     #'<stdint.h>'    => '',,
+     #'<limits.h>'    => '',,
+     #'<string.h>'    => '',,
+     #'<stdlib.h>'    => '',,
+     #'<stdarg.h>'    => '',,
+     #'<stddef.h>'    => '',,
+     #'<stdio.h>'     => 'std.stdio',
+    );
+
+#### subroutines ####
+
+sub convert {
+  my $ifils_ref = shift @_; # @ifils
+  my $ofils_ref = shift @_; # @ofils
+  my $fref      = shift @_; # %f
+  my $sref      = shift @_; # %stats
+  my $meth      = shift @_; # meth: 1 or 2
+
+  die "ERROR:  Unknown conversion method $meth."
+    if (!defined $meth || $meth !~ m{\A [1-3]{1} \z}x);
+
+  # the input files array should contain C header files to be
+  # processed (typically with a .h suffix)
+
+  foreach my $ifil (@{$ifils_ref}) {
+
+    my $stem = basename $ifil;
+    $stem =~ s{$G::Hsuf \z}{}x;
+
+    my ($process, $stat) = (0, 0);
+    my ($curr_hash, $prev_hash, $fpo);
+
+    # check to see current status of input file
+    $curr_hash = DS::file_md5_hex($ifil);
+    $prev_hash = DS::retrieve_md5hash($ifil);
+
+    if (!$prev_hash || $prev_hash ne $curr_hash) {
+      $process = 1;
+      DS::store_md5hash($ifil, $curr_hash);
+    }
+    $process = 1
+      if ($G::force);
+
+    # final output file
+    my $ofil = "${BP::DIDIR}/${stem}${G::Dsuf}";
+    $prev_hash = DS::retrieve_md5hash($ofil);
+    if (!$prev_hash) {
+      $process = 1;
+    }
+
+    # don't overwrite
+    $process = 0
+      if (-e $ofil && !$G::force);
+
+    if (!$process) {
+      print "D::convert(): Skipping input file '$ifil'...\n"
+	if $G::verbose;
+      next;
+    }
+
+    print "D::convert(): Processing file '$ifil' => '$ofil'...\n"
+      if $G::verbose;
+
+    # container for tmp files
+    my @tmpfils = ();
+
+    # get rid of system headers (but record their use)
+    my %syshdr = ();
+
+    # intermediate file after gcc preprocessing
+    my $ppfil = "${BP::DIDIR}/${stem}.i";
+    push @tmpfils, $ppfil;
+    push @{$ofils_ref}, $ppfil
+      if $G::debug;
+
+    #==== method 1 ====
+    if ($meth == 1) {
+
+=pod
+
+      # insert unique included files into the single input file
+      flatten_c_header($ifil, $tfil0, $stem, \%syshdr);
+
+=cut
+
+      # use gcc; need a modified header as the C input file
+      my $cinfil = "./di/$stem.h.c";
+      push @tmpfils, $cinfil;
+      push @{$ofils_ref}, $cinfil
+	if $G::debug;
+
+      # note: handling of GCC constructs '__atribute__',
+      # -__restrict', '__extension__', et al.:
+      # Compatibility with non-GNU compilers
+      # ====================================
+      # Fortunately, the __attribute__ mechanism was cleverly designed in a
+      # way to make it easy to quietly eliminate them if used on platforms
+      # other than GNU C. Superficially, __attribute__ appears to have
+      # multiple parameters (which would typically rule out using a macro),
+      # but the two sets of parentheses effectively make it a single
+      # parameter, and in practice this works very nicely.
+      #
+      # /* If we're not using GNU C, elide __attribute__ */
+      # #ifndef __GNUC__
+      # #  define  __attribute__(x)  /*NOTHING*/
+      # #endif
+
+      open my $fp, '>', $cinfil
+        or die "$cinfil: $!";
+
+      # some prelims:
+      print $fp "/* HEADER ADDITION FOR D LANGUAGE INTERFACE:\n";
+      print $fp "\n";
+      print $fp "   Since we're not using GNU C output, elide unused\n";
+      print $fp "   funcstions (or macros) '__attribute__', '__extension__',\n";
+      print $fp "   and '__restrict' and rename '__const'.\n";
+      print $fp "\n";
+      print $fp "*/\n";
+      print $fp "#define  __attribute__(x)  /* NOTHING  */\n";
+      print $fp "#define  __extension__     /* NOTHING */\n";
+      print $fp "#define  __restrict        /* NOTHING */\n";
+      print $fp "#define  __const           const\n";
+
+      # if developing, have possibility to add a function to check its
+      # parsing (but MUCH later after all else is well)
+      if (0 && $G::addfunc) {
+	print $fp "void\n";
+	print $fp "foo(int i)\n";
+	print $fp "{\n";
+	print $fp "  printf(\"value of i is '%d'\\n\", i);\n";
+	print $fp "}\n";
+      }
+
+      # now add the lines from the original C header
+      open my $fpi, '<', $ifil
+	or die "$ifil: $!";
+      my @tflines = <$fpi>;
+      print $fp $_ for @tflines;
+      close $fp;
+
+      # use gcc -E to preprocess the file
+      print "DEBUG:  preprocessing '$cinfil' to '$ppfil' using gcc -E...\n"
+	if $G::debug;
+
+      convert_with_gcc_E($cinfil, $ppfil);
+
+      # convert it to "final" form
+      print "DEBUG:  converting '$ppfil' to D module '$ofil'...\n"
+	if $G::debug;
+
+      convert1final_and_run($ofil, $ppfil, \%syshdr, $stem, $ofils_ref, \@tmpfils);
+
+    }
+    #==== method 2 ====
+    elsif ($meth == 2) {
+
+=pod
+
+      # use dstep
+      convert_with_dstep($tfil0, $tfil1);
+
+      # dress up the file and convert it to "final" form (eventually)
+      convert1final($ofil, $tfil1, \%syshdr, $stem);
+
+=cut
+
+    }
+    #==== method 3 ====
+    elsif ($meth == 3) {
+
+=pod
+
+      # use gcc; need a C input file
+      my $cfil = "./di/$stem.h.c";
+      copy $ifil, $cfil;
+      push @tmpfils, $cfil;
+
+      # the output file of interest will be named:
+      my $tufil = "$cfil.001t.tu";
+      push @tmpfils, $tufil;
+      push @{$ofils_ref}, $tufil
+	if $G::debug;
+
+      convert_with_gcc_fdump_tu($cfil);
+
+      # extract data into another file
+      # the output file of interest will be named:
+      my $pfil = "$tufil.dat";
+      push @tmpfils, $pfil;
+      push @{$ofils_ref}, $pfil
+	if $G::debug;
+
+      process_tu_file($tufil, $pfil);
+
+      # dress up the file and convert it to "final" form (eventually)
+      #convert3final($ofil, $pfil, \%syshdr, $stem);
+
+=cut
+
+    }
+
+    # eliminate unneeded intermediate files;
+    unlink @tmpfils
+      if !$G::debug;
+
+    # update hash for the new, final output file
+    $curr_hash = DS::calc_md5hash($ofil);
+
+    if (!-f $ofil) {
+      print "D::convert(): Output file '$ofil' does not exist.\n"
+	if $G::verbose;
+    }
+    elsif (!$prev_hash || $prev_hash ne $curr_hash) {
+      if ($G::verbose) {
+	print "D::convert(): Output file '$ofil' hashes:\n";
+	print "  prev '$prev_hash'\n";
+	print "  curr '$curr_hash'\n";
+      }
+      DS::store_md5hash($ofil, $curr_hash);
+      push @{$ofils_ref}, $ofil;
+    }
+    else {
+      print "D::convert(): Output file '$ofil' has not changed.\n"
+	if $G::verbose;
+    }
+
+  } # iterate over input files
+
+} # convert
+
+sub collect_files {
+
+  # deletes generated files if $G::clean
+  my $href = shift @_; # @h
+  my $dref = shift @_; # @d
+
+  my @d = glob("${BP::DIDIR}/*${G::Dsuf}");
+  if ($G::clean) {
+    unlink @d;
+    DS::remove_md5hash_store();
+  }
+  else {
+    push @{$dref}, @d;
+  }
+
+  # main API headers
+  my @h  = glob("${BP::IDIR}/*${G::Hsuf}");
+  foreach my $f (@h) {
+    next if exists $ignore{ basename $f };
+    push @{$href}, $f;
+  }
+
+  # other headers
+  #my @oh  = glob("${BP::IDIR}/*${G::Hsuf}");
+
+} # collect_files
+
+sub is_syshdr {
+  my $f = shift @_;
+  return 1 if ($f =~ m{\A \s* \< [\S]+ \> \s* \z}x);
+  return 0;
+} # is_syshdr
+
+=pod
+
+sub process_tu_file {
+  die "GCC::TranslationUnit doesn't work; author queried";
+
+  # processes tu output for method 3
+  my $tufil = shift @_;
+  my $ofil  = shift @_;
+
+  use GCC::TranslationUnit;
+
+  die "ERROR:  tu file '$tufil' not found."
+    if ! -f $tufil;
+
+  # echo '#include <stdio.h>' > stdio.c
+  # gcc -fdump-translation-unit -c stdio.c
+  my $node = GCC::TranslationUnit::Parser->parsefile($tufil);
+  die "ERROR:  Undefined reference \$tu"
+    if (!defined $node or !$node);
+
+  open my $fp, '>', $ofil
+    or die "$ofil: $!";
+
+  # list every function/variable name
+  while ($node) {
+
+    #print Dumper($node);
+
+    if ($node->isa('GCC::Node::function_decl') ||
+       $node->isa('GCC::Node::var_decl')) {
+      printf $fp "%s declared in %s\n",
+        $node->name->identifier, $node->source;
+    }
+    else {
+      printf $fp "%s declared in %s\n",
+        $node->name->identifier, $node->source;
+    }
+
+    $node = $node->chain;
+  }
+
+} # convert_tu_file
+
+=cut
+
+sub convert1final_and_run {
+  my $ofil       = shift @_; # $ofil
+  my $ifil       = shift @_; # $ppfil
+  my $sref       = shift @_; # \%syshdr
+  my $stem       = shift @_; # stem of .h file name (e.g., stem of 'bu.h' is 'bu'
+
+  my $ofils_aref = shift @_; # \@ofils
+  my $tfils_aref = shift @_; # \@tmpfils
+
+  # before we open the final output file we need more intermediate
+  # processing: the $ppfil has to be parsed and some fancy extraction
+  # and class processing done
+
+  # process the input file ($ppfil)
+  open my $fpi, '<', $ifil
+    or die "$ifil: $!";
+
+  my @ilines = <$fpi>;
+  close $fpi;
+  my $nl = @ilines;
+
+  # save processed lines for later
+  my @olines = ();
+
+  # chunks go into an array
+  my @objs = ();
+
+  # reset the name hash for this file (module)
+  HObj::reset_names();
+
+  # use for limiting chunk (object) processing
+  my $nchunks = 0;
+
+ LINE:
+
+  for (my $i = 0; $i < $nl; ++$i) {
+    my $lnum = $i + 1;
+    my $line = $ilines[$i];
+
+    # ignore or collapse blank lines
+    if ($line !~ /\S+/) {
+      printf "DEBUG: skipping blank line at line %d (%s)...\n",
+	__LINE__, __FILE__
+	  if (0 && $G::debug);
+      next LINE;
+    }
+
+    my @d = split(' ', $line);
+
+    my $first_token = $d[0];
+
+    if ($first_token =~ m{\A \s* \#}x) {
+      # ignore cpp comment lines
+      next LINE;
+    }
+
+    # always getting chunks
+    my $obj = HObj::get_new_hobj();
+    $obj->num($nchunks);
+
+    $i = CExtract::extract_object({
+				   lines_aref      => \@ilines,
+				   curr_index      => $i,
+				   obj             => $obj,
+				 });
+
+    push @olines, $obj->c_line();
+    push @objs, $obj;
+
+    # update number of chunks being processed
+    ++$nchunks;
+
+    if ($G::maxchunks && $G::maxchunks == $nchunks) {
+      my $s = $nchunks > 1 ? 's' : '';
+      print "DEBUG:  last line after $nchunks chunk${s}.\n"
+	if $G::debug;
+      last LINE;
+    }
+
+  }
+
+  # report number of chunks found
+  if ($G::debug) {
+    my $s = $nchunks > 1 ? 's' : '';
+    say "DEBUG:  Processed $nchunks object${s}...";
+  }
+
+=pod
+
+  # don't go this route for now
+
+  # parse the tree
+  my $ptree = ParsePPCHeader::parse_cfile
+    ({
+      ityp => 'aref',
+      ival => \@olines,
+     });
+
+  if (defined $ptree) {
+    my $fp;
+    # dump it
+    my $efil = "${ifil}.dump.txt";
+    open $fp, '>', $efil
+      or die "$efil: $!";
+    push @{$tfils_aref}, $efil;
+    push @{$ofils_aref}, $efil
+      if $G::debug;
+    ParsePPCHeader::dump_parse_tree($fp, $ptree);
+    close $fp;
+
+    # inspect it (print it)
+    my $pfil = "${ifil}.myprint.txt";
+    open $fp, '>', $pfil
+      or die "$pfil: $!";
+    push @{$tfils_aref}, $pfil;
+    push @{$ofils_aref}, $pfil
+      if $G::debug;
+    ParsePPCHeader::print_parse_tree($fp, $ptree);
+  }
+
+=cut
+
+  # pretty print the objects if desired
+  if ($G::pretty_print) {
+    my ($f, $f2, $fp, $fp2);
+
+    print "DEVEL: pretty printing C and D objects...\n";
+    $f  = "${ifil}.c_pretty_print.txt";
+    $f2 = "${ifil}.d_pretty_print.txt";
+
+    open $fp, '>', $f
+      or die "$f: $!";
+    push @{$tfils_aref}, $f;
+    push @{$ofils_aref}, $f
+      if $G::debug;
+
+    open $fp2, '>', $f2
+      or die "$f2: $!";
+    push @{$tfils_aref}, $f2;
+    push @{$ofils_aref}, $f2
+      if $G::debug;
+
+    foreach my $o (@objs) {
+      $o->do_all_conversions();
+      $o->print_pretty($fp, 'c');
+      $o->print_pretty($fp2, 'd');
+      #$o->dump();
+    }
+
+  }
+
+  # process objects and write them out
+  #say "WARNING:  No final conversion yet!";
+
+  my $nobjs = @objs;
+
+  my $iternum = $G::iterate ? 1 : $nobjs;
+
+ ITERATE:
+
+  open my $fpo, '>', $ofil
+    or die "$ofil: $!";
+
+  say $fpo "module $stem;\n";
+
+  my @sysmods = (sort keys %sysmod);
+  if (@sysmods) {
+    foreach my $h (@sysmods) {
+      my $mod = $sysmod{$h};
+      next if !$mod;
+      say $fpo "import $mod;";
+    }
+    print $fpo "\n";
+  }
+
+  say $fpo "extern (C) {";
+
+  for (my $i = 0; $i < $iternum; ++$i) {
+    my $o = $objs[$i];
+    $o->do_all_conversions();
+    $o->print_final($fpo, $ifil);
+    if ($G::debug) {
+      my $num = $o->num();
+      say "DEBUG:  dumping object number $num:";
+      $o->dump();
+    }
+  }
+
+  # ender
+  print $fpo "\n";
+  print $fpo "} // extern (C) {\n";
+
+
+  # check for a good compile
+  check_final($ofil, $nobjs, $iternum);
+
+  if ($G::iterate && $iternum < $nobjs) {
+    ++$iternum;
+    goto ITERATE;
+  }
+
+} # convert1final
+
+sub convert_with_gcc_E {
+  my $ifil = shift @_; # tfil0
+  my $ofil = shift @_; # tfil1
+
+  my $incdirs  = "-I${BP::IDIR} -I${BP::IDIR2}";
+
+  my $opts = '';
+  #$opts .= ' -CC'; # keep C and C++ comments
+  #$opts .= ' -H'; # list includes
+  #$opts .= ' -v'; # report include paths
+  $opts .= ' -P'; # omit line markers
+  $opts .= ' -undef'; # Do not predefine any system-specific or GCC-specific macros. The standard predefined macros remain defined.
+  $opts .= ' -x c'; # input file is C source code
+
+  my $cmd = "gcc -E $opts $incdirs $ifil > $ofil";
+  print "DEBUG: cmd:  '$cmd'\n"
+    if (0 && $G::debug);
+
+  my $msg = qx($cmd);
+
+  if ($msg) {
+    chomp $msg;
+    print "WARNING: msg: '$msg'\n";
+  }
+
+} # convert_with_gcc_E
+
+sub convert_with_gcc_fdump_tu {
+  my $cfil = shift @_;
+
+  my $incdirs  = "-I${D::IDIR} -I${D::IDIR2}";
+
+  my $ofil = "$cfil.o";
+
+  my $cmd = "gcc -fdump-translation-unit -c $incdirs -o $ofil $cfil";
+  print "debug-cmd: '$cmd'\n"
+    if $G::debug;
+
+  my $msg = qx($cmd);
+
+  if ($msg) {
+    chomp $msg;
+    print "WARNING: msg: '$msg'\n";
+  }
+
+} # convert_with_fdump_tu
+
+sub convert_with_dstep {
+  my $ifil = shift @_; # tfil0
+  my $ofil = shift @_; # tfil1
+
+  # usage: dstep Foo.h -o Foo.d
+
+  my $msg = qx(dstep $ifil -o $ofil);
+
+  if ($msg) {
+    chomp $msg;
+    print "WARNING: msg: '$msg'\n";
+  }
+
+} # convert_with_dstep
+
+sub flatten_c_header {
+  # insert unique included files into the single input file
+  my $ifil      = shift @_; # $ifil
+  my $ofil      = shift @_; # $tfil0
+  my $stem      = shift @_; # stem of .h file name (e.g., stem of 'bu.h' is 'bu'
+  my $sysref    = shift @_; # \%syshdr
+
+  open my $fpo, '>', $ofil
+    or die "$ofil: $!";
+
+  my $incregex = qr/\A \s* \# \s* include \s+
+		    (
+		      (\<[a-zA-Z0-9\._\-\/]{3,}\>)
+		    |
+		      (\"[a-zA-Z0-9\._\-\/]{3,}\")
+		    ) \s*/x;
+
+  my (@fpi, @parfils) = ();
+
+  # the starting file
+  my $level = 0;
+  open $fpi[$level], '<', $ifil
+    or die "$ifil: $!";
+  push @parfils, $ifil;
+
+  if (0 && $G::debug) {
+    # use g++ -E
+    my $tfil = 'temp-bu-cpp-file.txt';
+    convert_with_gcc($ifil, $tfil);
+    die "debug exit: see tmp file '$tfil'";
+  }
+
+  # record its source
+  print $fpo "//===========================================================================\n";
+  print $fpo "// beginning input lines (level $level) from '$ifil'\n";
+  print $fpo "//===========================================================================\n";
+
+  # don't repeat included files
+  my %seen = ();
+  $seen{$ifil} = 1;
+
+ LINE:
+  while (defined(my $line = readline $fpi[$level])) {
+    if (0 && $G::debug) {
+      my $s = $line;
+      chomp $s;
+      print "debug: line = '$s'\n";
+    }
+    if ($line =~ m{$incregex}x) {
+      my $s = $1;
+      chomp $s;
+      $s =~ s{\A \s*}{}x;
+      $s =~ s{\s* \z}{}x;
+      $s =~ s{\A \"}{}x;
+      $s =~ s{\" \z}{}x;
+      print "debug: \$1 (\$s) = '$s'\n"
+	if (0 && $G::debug);
+
+      # get a new file
+      my $f = $s;
+
+      # ignore <> files
+      if (is_syshdr($f)) {
+	print "WARNING: ignoring sys include file '$f' for now...\n"
+	  if (0 && $G::debug);
+	$sysref->{$s} = 1;
+	# don't print
+	next LINE;
+      }
+
+      # some files are ignored for now
+      if (exists $tignore{$f}) {
+	print "WARNING: ignoring include file '$f' for now...\n"
+	  if (0 && $G::debug);
+	next LINE;
+      }
+
+      # may be a "mapped" file
+      if (exists $is_mapped{$f}) {
+	my $ff = $is_mapped{$f};
+	print "WARNING: using mapped file '$f' => '$ff' for now...\n"
+	  if (0 && $G::debug);
+	$f = $ff;
+      }
+
+      # one more shot for things in the subdir of $IDIR like './bu/bu.h'
+      if (!-f $f) {
+	# the following two formats are the same but confuse the 'seen' hash:
+	#   'bu/bu_vlist.h'
+	#   './bu/bu_vlist.h'
+	my $s = $f;
+	$s =~ s{\A \./}{}x;
+	my $ff = "${BP::IDIR}/${s}";
+	print "NOTE: using file '$f' => '$ff'...\n"
+	  if (0 && $G::debug);
+	$f = $ff;
+      }
+
+      # but don't include it if we've seen it before
+      next LINE if (exists $seen{$f});
+      # record it as seen
+      $seen{$f} = 1;
+
+      # we try to follow this include file
+      die "ERROR:  Include file '$f' (in '$parfils[$level]') not found."
+	if !-f $f;
+      print "DEBUG:  opening include file '$f' (in '$parfils[$level]')\n"
+	if $G::debug;
+      open $fpi[++$level], '<', $f
+	or die "$f: $!";
+      $parfils[$level] = $f;
+
+      # record its source
+      print $fpo "//===========================================================================\n";
+      print $fpo "// included input lines (level $level) from '$f'\n";
+      print $fpo "//===========================================================================\n";
+
+      next LINE;
+    }
+
+    print $fpo $line;
+  }
+
+  # work back up the file tree as we find EOF
+  if ($level > 0) {
+    --$level;
+    if (!defined $fpi[$level]) {
+      print "ERROR:  At level $level, file pointer is not defined!\n";
+    }
+    goto LINE;
+  }
+
+  #print Dumper(\@parfils); die "debug exit";
+
+  #print Dumper(\%syshdr); die "debug exit";
+} # flatten_c_header
+
+sub check_final {
+  # attempt to build the D source file
+  my $dfil    = shift @_;
+  my $nchunks = shift @_;
+  my $iternum = shift @_;
+
+  my $diff = $nchunks - $iternum;
+
+  my $cmd = "dmd -c $dfil";
+
+  my $pass = $iternum - 1;
+  my $errmsg = <<"HERE";
+FATAL:  Couldn't build '$dfil'.
+       Total C objects successfully processed: $pass out of $nchunks.
+HERE
+
+  # Act like system(), only louder and cleaner...
+  run_with -silent;
+
+  run "Checking the build for file '$dfil'" => $cmd
+    or die $errmsg;
+
+#'FATAL: Total C objects processed: $iternum out of $nchunks.';
+
+  if ($G::verbose || $G::debug) {
+    say "Successful build of file '$dfil'.";
+    say "  Total C objects processed: $iternum out of $nchunks."
+      if $nchunks;
+  }
+
+} # check_final
+
+# mandatory true return from a Perl module
+1;

misc/d-bindings/DS.pm

@@ -0,0 +1,76 @@
+package DS;
+
+# for the storage and manipulation of file data
+
+use strict;
+use warnings;
+
+use Readonly;
+use Storable;
+use Digest::MD5::File qw(file_md5_hex);
+
+# local vars ===========================
+my $storefile = '.path_md5hash_tablestore';
+
+# keep path md5 hash data in this table
+my %path_md5hash_table;
+# key: path
+# val: md5 hash of path
+
+my $debug = 0;
+
+#### subroutines ####
+sub calc_md5hash {
+  my $pth = shift @_;
+  return 0 if !-f $pth;
+  return file_md5_hex($pth);
+} # calc_md5hash
+
+sub store_md5hash {
+  # store an input hash (or calculates a new one) and stores it
+  my $pth     = shift @_;
+  my $md5hash = shift @_;
+
+  $md5hash = calc_md5hash($pth)
+    if !defined $md5hash;
+
+  my $tabref = retrieve($storefile)
+    if -e $storefile;
+  $tabref = \%path_md5hash_table
+    if !defined $tabref;
+  $tabref->{$pth} = $md5hash;
+  store $tabref, $storefile;
+
+  if (0 && $debug) {
+    print Dumper($tabref); die "debug exit";
+  }
+} # store_md5hash
+
+sub retrieve_md5hash {
+  # return stored path hash or 0 if not found in hash
+  my $pth = shift @_;
+
+  #die "ERROR:  input path '$pth' not defined" if !defined $pth;
+  #die "ERROR:  input path '$pth' is zero" if !$pth || $pth eq '0';
+
+  my $tabref = retrieve($storefile)
+    if -e $storefile;
+  $tabref = \%path_md5hash_table
+    if !defined $tabref;
+
+  my $md5hash = 0;
+  $md5hash = $tabref->{$pth}
+    if (exists $tabref->{$pth});
+
+  return $md5hash;
+
+} # retrieve_md5hash
+
+sub remove_md5hash_store {
+  unlink $storefile;
+  %path_md5hash_table = ();
+} # remove_md5hash_store
+
+# mandatory true return from a Perl module
+1;
+

misc/d-bindings/F.pm

@@ -0,0 +1,43 @@
+package F;
+
+# shared functions
+
+use v5.14;
+
+sub trim_string {
+  my $s = shift @_;
+  $s =~ s{\A \s*}{}xs;
+  $s =~ s{\s* \z}{}xs;
+  return $s;
+} # trim_string
+
+sub get_spaces {
+  my $level = shift @_;
+  my $ns = $level * 3;
+  my $s = sprintf "%-*.*s", $ns, $ns, ' ';
+  return $s;
+} # get_spaces
+
+sub debug_regex {
+  my $msg  = shift @_;
+  my @arr  = @_;
+
+  say "==============================================================";
+  say "DEBUG: $msg";
+
+  my $nl = @arr;
+  for (my $i = 0; $i < $nl; ++$i) {
+    my $c = $arr[$i];
+    my $n = $i + 1;
+    if (defined $c) {
+      say "  \$$n = '$c'";
+    }
+    else {
+      say "  \$$n = 'undef'";
+    }
+  }
+
+} # debug_regex
+
+# mandatory true return for a Perl module
+1;

misc/d-bindings/G.pm

@@ -0,0 +1,222 @@
+package G;
+
+use Readonly;
+
+# globals
+
+# no Windows for now
+Readonly our $WIN  => 0;
+# 64-bit only
+Readonly our $BITS => 64;
+
+# file type suffixes
+Readonly our $Hsuf => '.h';
+Readonly our $Dsuf => '.d';
+
+#==========================================================================
+# global option vars
+our $force        = 0;
+our $verbose      = 0;
+our $debug        = 0;
+our $clean        = 0;
+our $devel        = 0;
+our $quitundef    = 0; # >0 - stop at first undef chunk
+our $maxchunks    = 0; # >0 - stop after N successful chunks
+our $inspect_tree = 0; # >0 - try to interpret parse tree
+our $addfunc      = 0; # >0 - add a function to the top of the header for devel
+our $pretty_print = 0; # >0 - pretty print objects
+our $iterate      = 0; # >0 - iterate over objects
+
+Readonly our $NEW  => -1;
+Readonly our $SAME =>  0;
+Readonly our $DIFF =>  1;
+
+our %dmap, @dmap_keys;
+my %d64map, @d64map_keys;
+my %d32map, @d32map_keys;
+
+if ($BITS == 64) {
+  %dmap      = %d64map;
+  @dmap_keys = @d64map_keys;
+}
+else {
+  %dmap      = %d32map;
+  @dmap_keys = @d32map_keys;
+}
+
+# 64-bit mapping from C types to D types
+#   from: http://wiki.dlang.org/Converting_C_.h_Files_to_D_Modules#Types
+%d64map
+  = (
+     'long double'        => 'real',
+
+     'unsigned long long' => 'ulong',
+     'long long'          => 'long',
+     'unsigned long'	  => 'ulong', # Linux [int (Windows)]
+     'long'               => 'long', # Linux [int (Windows)]
+
+     # these explicit variants are missing:
+     'unsigned long long int' => 'ulong',
+     'long long int'          => 'long',
+     'unsigned long int'      => 'ulong', # Linux [int (Windows)]
+     'long int'               => 'long', # Linux [int (Windows)]
+     'long unsigned int'      => 'ulong', # Linux [int (Windows)]
+
+
+     'unsigned'           => 'uint',
+     'unsigned int'       => 'int',
+     'unsigned short'     => 'ushort',
+
+     'signed char'        => 'byte',
+     'unsigned char'      => 'ubyte',
+     'wchar_t'            => 'wchar', # or dchar
+     #'bool'               => 'bool', # byte, int
+     #'size_t'             => 'size_t',
+     #'ptrdiff_t'          => 'ptrdiff_t',
+    );
+
+# the preferred order for checking
+@d64map_keys
+  = (
+     'unsigned long long',
+     'long long',
+     'unsigned long',
+     'long',
+
+     # these explicit variants are missing:
+     'unsigned long long int',
+     'long long int',
+     'unsigned long int', # Linux [int (Windows)]
+     'long int',          # Linux [int (Windows)]
+     'long unsigned int', # Linux [int (Windows)]
+
+     'unsigned int',
+     'unsigned short',
+     'unsigned char',
+
+     'unsigned',
+
+     'long double',
+     'signed char',
+
+      'wchar_t',
+    );
+
+# 32-bit mapping from C types to D types
+#   from: http://wiki.dlang.org/Converting_C_.h_Files_to_D_Modules#Types
+%d32map
+  = (
+     'long double'        => 'real',
+
+     'unsigned long long' => 'ulong',
+     'long long'          => 'long',
+     'unsigned long'      => 'uint',
+     'long'               => 'int',
+
+     # these explicit variants are missing:
+     'unsigned long long int' => 'ulong',
+     'long long int'          => 'long',
+     'unsigned long int'      => 'uint',
+     'long int'               => 'int',
+
+     # this implicit variant is missing
+     'unsigned'           => 'uint',
+
+     'unsigned int'       => 'uint',
+     #'int'                => 'int',
+     'unsigned short'     => 'ushort',
+     'signed char'        => 'byte',
+     'unsigned char'      => 'ubyte',
+     'wchar_t'            => 'wchar', # or dchar
+     #'bool'               => 'bool',  # byte, int
+     #'size_t'             => 'size_t',
+     #'ptrdiff_t'          => 'ptrdiff_t',
+
+     # other
+     'NULL'               => 'null',
+    );
+
+# the preferred order for checking
+@d32map_keys
+  = (
+     'unsigned long long' => 'ulong',
+     'long long'          => 'long',
+     'unsigned long'      => 'uint',
+     'long'               => 'int',
+
+     # these explicit variants are missing:
+     'unsigned long long int' => 'ulong',
+     'long long int'          => 'long',
+     'unsigned long int'      => 'uint',
+     'long int'               => 'int',
+
+     # this implicit variant is missing
+     'unsigned'           => 'uint',
+
+     'unsigned int'       => 'uint',
+     'unsigned short'     => 'ushort',
+     'signed char'        => 'byte',
+     'unsigned char'      => 'ubyte',
+
+     'wchar_t'            => 'wchar', # or dchar
+
+     # other
+     'NULL',
+    );
+
+# input type for functions in ParsePPCHeader
+our @ityp
+  = (
+     'fnam',
+     'fp',
+     'str',
+     'aref',
+    );
+our %ityp;
+@ityp{@ityp} = ();
+
+# output type for functions in ParsePPCHeader
+our @otyp
+  = (
+     'fnam',
+     'fp',
+     'str',
+     'aref',
+    );
+our %otyp;
+@otyp{@otyp} = ();
+
+# all D types
+our @dtyp
+  = (
+     'void',
+     'bool',
+     'byte',
+     'ubyte',
+     'short',
+     'ushort',
+     'int',
+     'uint',
+     'long',
+     'ulong',
+     'cent',
+     'ucent',
+     'float',
+     'double',
+     'real',
+     'ifloat',
+     'idouble',
+     'ireal',
+     'cfloat',
+     'cdouble',
+     'creal',
+     'char',
+     'wchar',
+     'dchar',
+);
+our %dtyp;
+@dtyp{@dtyp} = ();
+
+# mandatory true return for a Perl module
+1;
+

misc/d-bindings/HACKING

@@ -0,0 +1,53 @@
+Using installed BRL-CAD rel version at rev 60688.
+
+To use dstep I installed the following:
+
+via git clone:
+-------------
+
+git clone https://github.com/jacob-carlborg/dstep.git
+git clone https://github.com/SiegeLord/Tango-D2.git
+
+via Debian packages:
+-------------------
+
+dub                      # see http://d-apt.sourceforge.net/
+libcurl-dev              # openssl version
+libparse-recdescent-perl
+
+via local install:
+-----------------
+
+libclang
+
+
+general data flow
+=================
+
+foreach header X.h
+  copy the file to X.h.c
+  preprocess it with gcc -e to yield a X.i file
+
+  foreach line in the X.i file
+    next if blank line
+    extract the object into an Hobj instance
+    push the Hobj->line onto the @olines array
+    push the Hobj instance onto the @objs array
+    last line if desired number of objects has neen extracted
+  end foreach line
+
+  use P::RD on the @lines array to yield the parse tree
+  
+  use Data::Dumper to dump the parse tree to a file X.i.dump.txt
+  interpret (print) the parse to a file X.i.myprint.txt
+
+  analyze the parse tree
+
+  # the objects array is available for debugging more if needed
+
+  convert the parse tree to the output X.d module
+
+end foreach header
+
+
+

misc/d-bindings/HObj.pm

@@ -0,0 +1,664 @@
+package HObj;
+
+use v5.14;
+
+use strict;
+# get compile-time warnings with Class::Struct when overriding an accessor
+#use warnings;
+
+#use Text::Balanced 'extract_bracketed'; # extract balanced text (Conway)
+use Data::Dumper; $Data::Dumper::Indent = 1;
+use Class::Struct;
+
+use F;
+use R;
+
+# vars for creating unique names for various data structures during
+# C-to-D conversion
+my $next_name_num = 1;
+my %names = ();
+
+our %tag
+  = (
+     'num'        => '$', # the input sequence number (indexed from 0)
+     'converted'  => '$', # set true if D conversion was required and completed
+     'c_line'     => '$', # originally extracted array flattened to one line (in C format)
+     'first_line' => '$', # line number of first line
+     'last_line'  => '$', # line number of last line
+     'd_line'     => '$', # 'c_line' with some D type conversions
+
+     # arrays need special accessors
+     'pretty_c'   => '@', # 'c_line' split by 'gen_pretty' (in C format)
+     'pretty_d'   => '@', # 'd_line' split by 'gen_pretty' (in D format)
+    );
+
+struct(HObj => \%tag);
+
+sub get_new_hobj {
+
+  # provide a default initialization
+  my $b
+    = HObj->new(
+		'num'        => '',
+		'converted'  => '',
+		'c_line'     => '',
+		'first_line' => '',
+		'last_line'  => '',
+		'd_line'     => '',
+
+		# arrays initially empty
+		'pretty_c'   => [],
+		'pretty_d'   => [],
+	       );
+
+  return $b;
+} # get_new_hobj
+
+# arrays need special accessors
+sub pretty_c {
+  my $self = shift @_;
+  my $aref = shift @_;
+  if (defined $aref) {
+    $self->{pretty_c} = [@{$aref}];
+  }
+  else {
+    return $self->{pretty_c}; # an array ref
+  }
+} # special accessor
+
+sub pretty_d {
+  my $self = shift @_;
+  my $aref = shift @_;
+  if (defined $aref) {
+    $self->{pretty_d} = [@{$aref}];
+  }
+  else {
+    return $self->{pretty_d}; # an array ref
+  }
+} # special accessor
+
+# open brackets
+my %ob
+  = (
+     #'(' => 0,
+     #'[' => 1,
+     '{' => 2,
+     '<' => 3,
+    );
+# close brackets
+my %cb
+  = (
+     #')' => 0,
+     #']' => 1,
+     '}' => 2,
+     '>' => 3,
+     #';' => 3,
+    );
+
+sub lastchar {
+  # returns last character of a string
+  my $s = shift @_;
+  my $len = length $s;
+  return '' if !$len;
+
+  my $c = substr $s, $len-1, 1;
+  return $c;
+
+} # lastchar
+
+
+sub c_line_to_d_line {
+  # convert C types to D types
+  my $self = shift @_;
+
+  my $line = $self->c_line(); # the flattened C line
+
+  # warning: don't do anything to typedefs here--we handle them later
+  # to ensure we don't try to redefine D types
+  if ($line =~ /typedef/) {
+    $self->d_line($line);
+    return;
+  }
+
+  $line = c_types_to_d_types($line);
+
+  # save the converted line
+  $self->d_line($line);
+
+  $self->converted(1)
+    if $line ne $self->c_line;
+
+} # c_line_to_d_line
+
+sub c_to_d {
+  my $self = shift @_;
+
+  # process input pretty_d lines as a group, insert back into pretty_d
+  # lines
+
+  my $daref = $self->pretty_d();
+  my $nd = @$daref;
+
+  # put new lines in a tmp array which will become the new pretty_d
+  my @arr = @$daref;
+
+  # conversion notes:
+
+die "FATAL: have to handle typedefs that try to refine D types such as 'wchar'";
+
+  # note D form 1 is the new and preferred form
+  # C: typedef int* bar;   # D form 1: alias bar = int*;   # 'bar' is the name, 'int*' is the type
+  #                        # D form 2: alias int* bar;
+  # C: typedef int bar[2]; # D form 1: alias bar = int[2]; # 'bar' (array of 2 ints) is the name, 'int' is the type
+  #                        # D form 2: alias int[2] bar;
+
+  # convert to D where necessary
+  # hold parts from first (or only) and last lines
+  my %fline = ();
+  my %oline = ();
+  my %lline = ();
+
+ LINE:
+  for (my $i = 0; $i < $nd; ++$i) {
+    my $line = $daref->[$i];
+
+    if ($i == 0) {
+      # first line
+
+      # check out types and subtypes for text before a first bracket
+      # (if it is '{')
+
+      # possibilities for the ENTIRE line:
+      if ($line =~ m{$R::r_first_line}) {
+	# save the captures first!
+	my ($t, $type, $name, $curly) = (defined $1 ? F::trim_string($1) : '',
+					 defined $2 ? F::trim_string($2) : '',
+					 defined $3 ? F::trim_string($3) : '',
+					 defined $4 ? F::trim_string($4) : '');
+
+	if ($G::debug) {
+	  F::debug_regex("first line match: '$line'",
+			 ($t, $type, $name, $curly));
+	}
+
+	$fline{typedef} = $t ? 1 : 0;
+	$fline{type}    = $type;
+	$fline{name}    = $name;
+	$fline{curly}   = $curly;
+
+	# we don't save the line
+	next LINE;
+      }
+      elsif ($line =~ m{$R::r_only_line}) {
+	# save the captures first!
+	my ($t, $toks, $semi) = (defined $1 ? F::trim_string($1) : '',
+				 defined $2 ? F::trim_string($2) : '',
+				 defined $3 ? F::trim_string($3) : '');
+	if ($G::debug) {
+	  F::debug_regex("only line match: '$line'",
+			 ($t, $toks, $semi));
+	}
+
+	$oline{typedef} = $t ? 1 : 0;
+        $oline{semi} = $semi;
+
+	if ($toks) {
+	  # the tokens
+	  my @d = split ' ', $toks;
+
+	  my $name = pop @d;
+	  # if name has an array indicator we need to add it to the D
+	  # type, e.g., 'val[3] long'
+	  my $arrind = '';
+	  if ($name =~ m{\A ([a-zA-Z_]+) (\[ [0-9] \]) \z}x) {
+	    $name   = $1;
+	    $arrind = $2;
+	  }
+	  $arrind = F::trim_string($arrind)
+	    if $arrind;
+
+	  if ($G::debug) {
+	    say "DEBUG:  only line : '$line', name = '$name'";
+	  }
+
+          my $type = join ' ', @d;
+	  $type = F::trim_string($type);
+	  $type .= $arrind
+	    if $arrind;
+
+	  $name = F::trim_string($name)
+	    if $name;
+	  $type = F::trim_string($type)
+	    if $type;
+
+	  $oline{name} = $name;
+	  $oline{type} = $type;
+	}
+
+	if ($G::debug) {
+	  say "DEBUG:  only line : '$line', semi = '$semi'";
+	}
+
+	# we don't save the line
+	next LINE;
+      }
+    }
+    # D lines only ========================
+    elsif ($i == $nd - 1) {
+      # last line
+      # possibilities for the ENTIRE line:
+      if ($line =~ m{$R::r_last_line}) {
+	# save the captures first!
+	my ($curly, $toks, $semi) = (defined $1 ? F::trim_string($1) : '',
+				     defined $2 ? F::trim_string($2) : '',
+				     defined $3 ? F::trim_string($3) : '');
+	if ($G::debug) {
+	  F::debug_regex("last line match: '$line'",
+			 ($curly, $toks, $semi));
+	}
+
+	$lline{curly} = $curly;
+	$lline{semi}  = $semi;
+
+	if ($toks) {
+	  # the tokens, e.g., *t, z;
+	  my @d = split ',', $2;
+	  my @names = ();
+	  foreach my $d (@d) {
+	    my @s = split ' ', $d;
+	    my $n = join '', @s;
+	    push @names, $n
+	  }
+	  $lline{names} = [@names];
+	}
+	else {
+	  $lline{names} = [];
+	}
+
+	# we don't save the line
+	next LINE;
+      }
+
+      # substitute correct types for unchecked body lines
+      $line = c_types_to_d_types($line)
+	if (exists $fline{typedef} && $fline{typedef});
+    }
+
+    push @arr, $line;
+  }
+
+  # have we any D conversions?
+  my $nF = scalar (keys %fline);
+  my $nO = scalar (keys %oline);
+  my $nL = scalar (keys %lline);
+  my $nA = $nO || $nF || $nL;
+
+  # requirements
+  my %is_required
+    = (
+       fline => { type => 1, curly => 1 },
+       oline => { typedef => 1, type => 1, name => 1, curly => 1 },
+       lline => { curly => 1, semi => 1 },
+    );
+
+  if ($nO) {
+    my $err = 0;
+    my $h = 'oline';
+    my $r = \%oline;
+    my $o = 'one line only';
+    my @k = qw(typedef type name);
+
+    $err += check_lines($h, $r, $o, \@k, \%is_required)
+      if $G::debug;
+    die "FATAL" if $err;
+
+    # this looks good so far
+    @arr = ("alias $oline{name} = $oline{type};");
+
+  }
+  elsif ($nF && $nL) {
+    my $err = 0;
+    my ($h, $r, $o, @k);
+
+    $h = 'fline';
+    $r = \%fline;
+    $o = 'first line';
+    @k = qw(typedef type name curly);
+    $err += check_lines($h, $r, $o, \@k, \%is_required)
+      if $G::debug;
+
+    $h = 'lline';
+    $r = \%lline;
+    $o = 'last line';
+    @k = qw(curly names semi);
+    $err += check_lines($h, $r, $o, \@k, \%is_required)
+      if $G::debug;
+    die "FATAL" if $err;
+
+  }
+  elsif ($nF || $nL) {
+    die "FATAL:  Unexpected first or last line without the other."
+  }
+
+  if (0 && $G::debug) {
+    say "DEBUUG:  dumping \@arr:";
+    print Dumper(\@arr);
+    die "DEBUG exit";
+  }
+
+  # save the work (but only if changed)
+  if ($nA) {
+    $self->pretty_d(\@arr);
+
+    # update object status
+    $self->converted(1);
+  }
+
+} # c_to_d
+
+sub print_final {
+  # print the C one-liner and data for reference; then pretty-print
+  # the D version
+  my $self  = shift @_;
+  my $fp    = shift @_;
+  my $ppfil = shift @_; # the .i file
+
+  my $slin = $self->first_line();
+  my $elin = $self->last_line();
+  my $num  = $self->num();
+
+  my $cline = $self->c_line();
+
+  print $fp "\n";
+
+  say $fp "//==========================================================";
+  say $fp "// the C version (object number $num):";
+  say $fp "//==========================================================";
+  say $fp "//   from C preprocessed file '$ppfil'"
+    if (defined $ppfil);
+  say $fp "//   line $slin to line $elin";
+  say $fp "// $cline";
+
+  if ($self->converted) {
+    say $fp "// the D version (pretty-printed):";
+  }
+  else {
+    say $fp "// no conversion necessary but a prettier C version:";
+  }
+
+  $self->print_pretty($fp, 'd');
+
+  say $fp "//==========================================================";
+  say $fp "// end C version (object number $num)";
+  say $fp "//==========================================================";
+
+} # print_final
+
+sub do_all_conversions {
+  my $self = shift @_;
+
+  # convert C line to D line
+  $self->c_line_to_d_line();
+
+  # make the pretty D array and convert to D constructs where necessary
+  # also convert the D array to final D lines
+  $self->gen_pretty('d');
+
+} # do_all_conversions
+
+sub gen_pretty {
+  # put extracted object into pretty format for printing
+  # also get certain details and convert D as necessary
+
+  my $self = shift @_;
+  my $ptyp = shift @_;
+
+  my $text;
+  if ($ptyp eq 'c') {
+    # this is C code
+    $text = $self->c_line(); # the flattened line
+  }
+  elsif ($ptyp eq 'd') {
+    # this is D code
+    $text = $self->d_line(); # the flattened line
+  }
+
+  # use a tmp array and a line
+  my @arr = ();
+  my $len = length $text;
+  my $line = '';
+  my $level = 0;
+
+  my $curr_bracket = '';
+  for (my $i = 0; $i < $len; ++$i) {
+    my $c = substr $text, $i, 1;
+    if (exists $ob{$c}) {
+      $curr_bracket = $c;
+
+      # an open bracket ends the line (and increases the level)
+      ++$level;
+      $line .= ' ' if ($line && lastchar($line) ne ' ');
+      $line .= $c;
+      push @arr, $line;
+
+      # next line should start with an indent
+      $line = F::get_spaces($level);
+    }
+    elsif (exists $cb{$c}) {
+      $curr_bracket = $c;
+
+      # a close bracket ends the current line and starts a new line
+      # (and decreases the level)
+      --$level;
+
+      push @arr, $line if $line;
+
+      $line = $level ? F::get_spaces($level) : '';
+      $line .= $c;
+    }
+    elsif ($c eq ';') {
+      # a semi the current line and starts a new line (no change in
+      # level)
+      $line .= $c;
+      push @arr, $line;
+      $line = $level ? F::get_spaces($level) : '';
+    }
+    elsif ($c eq ',' && $curr_bracket eq '{') {
+      # a comma ends the current line and starts a new line (no change in
+      # level)
+      $line .= $c;
+      push @arr, $line;
+      $line = $level ? F::get_spaces($level) : '';
+    }
+    else {
+      if ($c eq ' ') {
+	$line .= $c if ($line && lastchar($line) ne ' ');
+      }
+      else {
+	$line .= $c;
+      }
+    }
+
+  }
+
+  # remainder of any line
+  push @arr, $line
+    if $line;
+
+=pod
+
+  say "DEBUG: dumping \@arr array BEFORE cleanup:";
+  print Dumper(\@arr);
+
+=cut
+
+  # now tidy up a bit, and convert to D where necessary
+  my @arr2 = ();
+
+  my $nl = @arr;
+
+ LINE:
+  for (my $i = 0; $i < $nl; ++$i) {
+    my $line = $arr[$i];
+
+    # remove spaces around square brackets
+    $line =~ s{\s* \[}{\[}xg;
+    $line =~ s{\[ \s*}{\[}xg;
+    $line =~ s{\s* \]}{\]}xg;
+    $line =~ s{\] \s*}{\]}xg;
+
+    # remove spaces before semicolons
+    $line =~ s{\s* ;}{;}xg;
+
+    # remove spaces before open parens
+    $line =~ s{\s* \(}{\(}xg;
+    # remove spaces before close parens
+    $line =~ s{\s* \)}{\)}xg;
+    # remove spaces after open parens
+    $line =~ s{\( \s*}{\(}xg;
+
+    push @arr2, $line
+      if ($line =~ /\S/);
+  }
+
+  # and save the mess
+  if ($ptyp eq 'c') {
+    # this is C code
+    $self->pretty_c(\@arr2);
+  }
+  elsif ($ptyp eq 'd') {
+    # this is D code
+    $self->pretty_d(\@arr2);
+    # a little inefficient, but cleaner to do separately
+    $self->c_to_d();
+  }
+
+=pod
+
+  say "DEBUG: dumping \@arr array AFTER cleanup:";
+  print Dumper(\@arr);
+
+=cut
+
+} # gen_pretty
+
+sub print_pretty {
+  my $self = shift @_;
+  my $fp   = shift @_;
+  my $ptyp = shift @_;
+
+  my $aref;
+  if ($ptyp eq 'c') {
+    # this is C code
+    $aref = $self->pretty_c();
+  }
+  elsif ($ptyp eq 'd') {
+    # this is D code
+    $aref = $self->pretty_d();
+  }
+
+  foreach my $line (@$aref) {
+    say $fp $line;
+  }
+
+} # print_pretty
+
+sub dump {
+  my $self = shift @_;
+  say    "Dumping an Hobj object:";
+  printf "  num: %d\n",        $self->num();
+  printf "  converted: %s\n",  $self->converted() ? 'yes' : 'no';
+  printf "  c_line: \"%s\"\n", $self->c_line();
+  printf "  d_line: \"%s\"\n", $self->d_line();
+  printf "  first_line: %d\n", $self->first_line();
+  printf "  last_line: %d\n",  $self->last_line();
+
+  my ($sref);
+
+=pod
+
+  $sref = $self->pretty_c();
+  say "  pretty_c:";
+  if (defined $sref) {
+    say "    $_" for @$sref;
+  }
+
+=cut
+
+  $sref = $self->pretty_d();
+  say "  pretty_d:";
+  if (defined $sref) {
+    say "    $_" for @$sref;
+  }
+
+} # dump
+
+sub reset_names {
+  $next_name_num = 1;
+  %names = ();
+} # reset_names
+
+sub get_next_name {
+  my $n = sprintf "_Object_%04d", $next_name_num++;
+  $names{$n} = 1;
+  return $n;
+} # get_next_name
+
+sub check_lines {
+  # a debugging function
+  my ($h, $r, $o, $kref, $iref) = @_;
+
+  my $err = 0;
+  foreach my $k (@$kref) {
+    my ($m, $e) = ('NOTE', 0);
+    ($m, $e) = ('ERROR', 1)
+      if exists $iref->{$h}{$k};
+    if (!exists $r->{$k}) {
+      say "$m: Object '$o' has no key '$k'";
+      ++$err if $e;
+    }
+    elsif (!$r->{$k}) {
+      say "$m: Object '$o' has no value for key '$k'";
+      ++$err if $e;
+    }
+  }
+    die "FATAL" if $err;
+
+} # check_lines
+
+sub c_types_to_d_types {
+  my $line = shift @_;
+
+  foreach my $k (@G::dmap_keys) {
+    my $val = $G::dmap{$k};
+
+    # build the regex
+    my @d = split(' ', $k);
+    my $r = "\\b";
+    $r .= shift @d;
+    while (@d) {
+      $r .= "\\s+";
+      $r .= shift @d;
+    }
+
+    #say "DEBUG:  regex: '$r'";
+
+    # apply it
+    $line =~ s/$r/$val/g;
+  }
+
+=pod
+
+  # some other one liners:
+  $line =~ s/$R::r_null_2/typeof\(null\)/g;
+  $line =~ s/$R::r_null_1/typeof\(null\)/g;
+
+=cut
+
+  return $line;
+
+} # convert_c_types_to_d_types
+
+
+# mandatory true return for a module
+1;

misc/d-bindings/Parse-RecDescent-master-demo/README.demo_dot.txt

@@ -0,0 +1,143 @@
+From root@bib.adnintern.org  Thu Oct 21 05:31:59 1999
+Received: from gimli.cs.monash.edu.au (gimli.cs.monash.edu.au [130.194.64.60])
+	by indy05.cs.monash.edu.au (8.8.8/8.8.8) with ESMTP id FAA07658
+	for <damian@indy05.cs.monash.edu.au>; Thu, 21 Oct 1999 05:31:59 +1000 (EST)
+Received: from bib.adnintern.org ([194.242.172.1])
+	by gimli.cs.monash.edu.au (8.8.8/8.8.8) with ESMTP id FAA08901
+	for <damian@cs.monash.edu.au>; Thu, 21 Oct 1999 05:31:54 +1000
+Received: (from root@localhost)
+	by bib.adnintern.org (8.9.3/8.9.3) id VAA00889;
+	Wed, 20 Oct 1999 21:29:05 +0200
+Date: Wed, 20 Oct 1999 21:29:05 +0200
+Message-Id: <199910201929.VAA00889@bib.adnintern.org>
+From: "Stéphane Payrard -- stef@adnaccess.com (06 60 95 82 69)" <stef@adnaccess.com>
+To: damian@cs.monash.edu.au
+Subject: parsing dot file
+Reply-to: stef@adnaccess.com
+Status: RO
+
+
+you may be interested at this rough cut at the dot grammar to enrichen
+your collection.  dot is a language that describe graphs. I have
+problem with embedded \n in strings that I have not investigated yet
+
+http:/pub/web/www.research.att.com/sw/tools/graphviz
+
+__
+ stef
+
+
+
+
+#! /usr/bin/perl
+use Parse::RecDescent;
+my $DOTSRC="/var/src/gv1.5";
+
+my $graph = "$DOTSRC/graphs";
+
+# $::RD_HINT=1;
+# $::RD_AUTOSTUB=1;
+# $::RD_TRACE=1;
+
+#  'strict'(?) pas accepté
+$gram = <<'EOF';
+
+graph:        comment(?) strict(?)  ( 'digraph' | 'graph' ) id  '{' stmt_list '}'
+attr_stmt:    m/(graph|node|edge)\s+/ attrs(?)
+subgraph:     ( 'subgraph' id  )(?)  '{' stmt_list '}' | 'subgraph' id
+stmt_list:    ( stmt semi(?) )(s?)
+stmt:         id '=' id | attr_stmt |  edge_stmt | subgraph | node_stmt | comment
+node_stmt:    node_id  attrs(?)
+node_id:      id ( ':' id )(?)
+attrs:        '[' ( id '=' value comma(?) )(s) ']'
+value:        id | CONSTANT
+edge_stmt:    ( node_id | subgraph ) edgeRHS(s)  attrs(?)
+edgeRHS:      edgeop ( node_id | subgraph )
+edgeop:       m|-[>-]|
+keyword:      m/(subgraph|graph|node|edge)\s+/
+id:          ...!keyword /([\w\d][\w\d-]*)/ | STRING_LITERAL
+STRING_LITERAL:	{ extract_delimited($text,'"') }
+CONSTANT:	/[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?/
+strict:       'strict'
+semi:         ';'
+comma:        ','
+comment	: m{\s*			# optional whitespace
+	    //			# comment delimiter
+	    [^\n]*		# anything except a newline
+	    \n			# then a newline
+	   }x
+
+	| m{\s*			# optional whitespace
+	    /\*			# comment opener
+	    (?:[^*]+|\*(?!/))*	# anything except */
+	    \*/		        # comment closer
+            ([ \t]*)?           # trailing blanks or tabs
+	   }x
+
+
+
+EOF
+
+$parser = new Parse::RecDescent($gram);
+
+ $_='hashtable.dot';
+ for ( <$graph/directed/*.dot>, <$graph/undirected/*.dot> ) {
+  undef $/;
+  open F, $_;
+  $txt =   <F>;
+  $ok = $parser->graph($txt);
+  print $ok ? '': "not ", "OK $_\n";
+}
+
+__END__
+
+here is the score so far:
+
+
+OK /var/src/gv1.5/graphs/directed/KW91.dot
+OK /var/src/gv1.5/graphs/directed/NaN.dot
+OK /var/src/gv1.5/graphs/directed/abstract.dot
+OK /var/src/gv1.5/graphs/directed/alf.dot
+OK /var/src/gv1.5/graphs/directed/awilliams.dot
+OK /var/src/gv1.5/graphs/directed/clust.dot
+OK /var/src/gv1.5/graphs/directed/clust1.dot
+OK /var/src/gv1.5/graphs/directed/clust2.dot
+OK /var/src/gv1.5/graphs/directed/clust3.dot
+OK /var/src/gv1.5/graphs/directed/clust4.dot
+OK /var/src/gv1.5/graphs/directed/clust5.dot
+OK /var/src/gv1.5/graphs/directed/crazy.dot
+OK /var/src/gv1.5/graphs/directed/ctext.dot
+OK /var/src/gv1.5/graphs/directed/dfa.dot
+OK /var/src/gv1.5/graphs/directed/fig6.dot
+OK /var/src/gv1.5/graphs/directed/fsm.dot
+OK /var/src/gv1.5/graphs/directed/grammar.dot
+not OK /var/src/gv1.5/graphs/directed/hashtable.dot
+OK /var/src/gv1.5/graphs/directed/jcctree.dot
+OK /var/src/gv1.5/graphs/directed/jsort.dot
+OK /var/src/gv1.5/graphs/directed/ldbxtried.dot
+OK /var/src/gv1.5/graphs/directed/mike.dot
+OK /var/src/gv1.5/graphs/directed/newarrows.dot
+OK /var/src/gv1.5/graphs/directed/nhg.dot
+OK /var/src/gv1.5/graphs/directed/pgram.dot
+not OK /var/src/gv1.5/graphs/directed/pm2way.dot
+not OK /var/src/gv1.5/graphs/directed/pmpipe.dot
+not OK /var/src/gv1.5/graphs/directed/polypoly.dot
+not OK /var/src/gv1.5/graphs/directed/proc3d.dot
+OK /var/src/gv1.5/graphs/directed/records.dot
+OK /var/src/gv1.5/graphs/directed/rowe.dot
+OK /var/src/gv1.5/graphs/directed/shells.dot
+OK /var/src/gv1.5/graphs/directed/states.dot
+OK /var/src/gv1.5/graphs/directed/structs.dot
+OK /var/src/gv1.5/graphs/directed/train11.dot
+OK /var/src/gv1.5/graphs/directed/trapeziumlr.dot
+OK /var/src/gv1.5/graphs/directed/tree.dot
+not OK /var/src/gv1.5/graphs/directed/triedds.dot
+OK /var/src/gv1.5/graphs/directed/try.dot
+OK /var/src/gv1.5/graphs/directed/unix.dot
+OK /var/src/gv1.5/graphs/directed/unix2.dot
+OK /var/src/gv1.5/graphs/directed/viewfile.dot
+OK /var/src/gv1.5/graphs/directed/world.dot
+not OK /var/src/gv1.5/graphs/undirected/ER.dot
+OK /var/src/gv1.5/graphs/undirected/ngk10_4.dot
+OK /var/src/gv1.5/graphs/undirected/process.dot
+

misc/d-bindings/Parse-RecDescent-master-demo/README.demo_undumper.txt

@@ -0,0 +1,502 @@
+From merlyn@stonehenge.com  Fri Jul 13 09:47:35 2001
+Received: from nexus.csse.monash.edu.au (nexus.csse.monash.edu.au [130.194.226.4])
+	by indy05.csse.monash.edu.au (SGI-8.9.3/8.9.3) with ESMTP id JAA19597
+	for <damian@indy05.csse.monash.edu.au>; Fri, 13 Jul 2001 09:47:35 +1000 (EST)
+Received: from ALPHA9.CC.MONASH.EDU.AU (alpha9.cc.monash.edu.au [130.194.1.9])
+	by nexus.csse.monash.edu.au (8.9.3+Sun/8.9.3) with ESMTP id JAA28599
+	for <damian.conway@mail.csse.monash.edu.au>; Fri, 13 Jul 2001 09:47:32 +1000 (EST)
+Received: from c000.snv.cp.net ([209.228.32.59])
+ by vaxh.cc.monash.edu.au (PMDF V5.2-31 #29714)
+ with SMTP id <01K5VMB591048YCMRT@vaxh.cc.monash.edu.au> for
+ damian.conway@mail.csse.monash.edu.au; Fri, 13 Jul 2001 09:47:15 +1000
+Received: (cpmta 24211 invoked from network); Thu, 12 Jul 2001 16:46:12 -0700
+Received: (cpmta 24197 invoked from network); Thu, 12 Jul 2001 16:46:10 -0700
+Received: from halfdome.holdit.com (209.102.105.64)
+ by smtp.c000.snv.cp.net (209.228.32.59) with SMTP; Thu,
+ 12 Jul 2001 16:46:10 -0700
+Received: (from merlyn@localhost)	by halfdome.holdit.com (8.9.1/8.9.1)
+ id QAA21492; Thu, 12 Jul 2001 16:46:09 -0700
+X-Received: 12 Jul 2001 23:46:10 GMT
+Date: Thu, 12 Jul 2001 16:46:09 -0700
+From: merlyn@stonehenge.com (Randal L. Schwartz)
+Subject: new potential example for P::RD's eg directory?
+To: damian@conway.org
+Message-id: <m1n16990e6.fsf@halfdome.holdit.com>
+MIME-version: 1.0
+Content-type: MULTIPART/MIXED; BOUNDARY="Boundary_(ID_V8Qg38zNd7FfillEy8fgog)"
+Delivered-to: conway.org%damian@conway.org
+User-Agent: Gnus/5.0808 (Gnus v5.8.8) Emacs/20.3
+X-UID: Inbox;992469057;10334
+Lines: 15
+Status: RO
+
+
+--Boundary_(ID_V8Qg38zNd7FfillEy8fgog)
+Content-type: TEXT/PLAIN
+Content-transfer-encoding: 7BIT
+
+
+I just wrote a "Data::Dumper" undumper using P::RD.  I'm attaching the
+magazine column (which you can't re-use, unfortunately) but perhaps
+the code itself can be put in P::RD's distro (with a small README) as
+an example of an interesting grammar and usage.
+
+Or perhaps you can develop it into a full reference/dereference parser?
+
+--
+Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
+<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
+Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
+See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!
+
+--Boundary_(ID_V8Qg38zNd7FfillEy8fgog)
+Content-type: TEXT/PLAIN; NAME=col29.pod
+Content-description: col 29 linux magazine
+Content-disposition: attachment; filename=col29.pod
+Content-transfer-encoding: 7BIT
+
+=head1 Linux Magazine Column 29 (Oct 2001)
+
+[suggested title: Safe Undumping]
+
+Recently on the Perl Monestary at C<http://www.perlmonks.org/>, the
+user known as C<ton> asked about parsing a Perl-style double-quoted
+string, as part of a project to construct a safe C<Data::Dumper>
+parser that would take the output and interpret it rather than handing
+the result directly to C<eval> as is typically done.  A few postings
+later, the work in progress for their C<Undumper> was posted, and I commented
+that there was probably a simpler way to do some of the things,
+and that it didn't handle blessed references.
+
+Well, me and my big mouth.  Or was it my continuing curiousity to
+tinker with Damian Conway's excellent C<Parse::RecDescent> module? I'm
+not sure, but I found myself over the next dozen hours or so staring
+at C<Data::Dumper> source code, output, test cases, and
+C<Parse::RecDescent> traces and documentation.  I also pounded my head
+on the desk for better than a day trying to figure out how to break a
+left-recursion loop, and came up with a nice obvious (now!) solution.
+
+The point of this is to be able to take the output of C<Data::Dumper>
+and reconstruct the original data, but not open ourselves to the
+possibility of being fed dangerous constructs, like backticks or
+symbol-table-manipulating code.  Sure, you could also do this with the
+right use of the C<Safe> module, but I was already committed to
+finishing this version before I thought of that.  Maybe another column
+someday.
+
+But anyway, that brings us to the program in [listing one, below].
+Most of this program is input to C<Parse::RecDescent>, so I'll start
+by setting that aside and describing the Perl support structure first.
+
+Lines 1 through 3 start nearly every program I write, turning on
+warnings, compiler restrictions, and disabling the buffering on
+C<STDOUT>.
+
+Lines 5 and 6 control the behaviour of C<Parse::RecDescent>. When
+tracing is enabled (although commented out here), I can see how the
+parse is progressing. The number 80 trims the "to-be-parsed" string
+dumping to its first 80 characters, which is usually plenty for me to
+see what's going on. I left hints enabled, because the error messages
+that result from a hint were often helpful in debugging the grammar.
+
+Lines 8 and 9 pull in the C<Parse::RecDescent> (found in the CPAN) and
+C<Data::Dumper> (part of the core Perl distribution) modules.
+
+Lines 13 to 81 form the input grammar for C<Parse::RecDescent>,
+included as a single-quoted string using C<q{}> for delimiters. Damian
+Conway seems to prefer this quoting style for sending stuff to
+C<Parse::RecDescent>, so I've copied it at least here. In other
+places, I might have used a "here-document" instead. The result of
+feeding this grammar to C<Parse::RecDescent> is a parser object that
+we can then call on to parse the output of C<Data::Dumper> to "undump"
+it. If the grammar is bad, we die in line 81. At that point
+C<Parse::RecDescent> has already printed its own diagnostics, expanded
+by the enabled "hint" flag earlier.
+
+During development, I probably changed this grammar over 50 times,
+constantly tweaking it to recognize each new thing that I encountered
+in the input source. The hints were often useful, although the "left
+recursion" problem (that I'll describe later) had me stumped for the
+better part of two days.
+
+Once we have a parser object (in $parser), the action to "undump" a
+string containing Perl code is simple.  Skipping down quickly to the
+C<test> subroutine starting at line 177, we can see the use of this
+C<$parser> to take a given C<$input> and transform it to a hashref
+response (saved as C<$symbol> here). The keys of the hashref contain
+the top-level scalar variable names, which default to C<$VAR1>,
+C<$VAR2> and so on, unless overridden during the dumping. The values
+of this hashref are then the corresponding values of those variables
+from the original dump, as best can be reconstructed.
+
+The C<test> subroutine here uses C<Data::Dumper> to convert an
+existing collection of values (passed in as arguments) into a string,
+shows the string as the input to the undumper, then parses the string
+with the constructed parser object. The output of this undumping
+process is then dumped once again and shown. The comparison process
+has to be a manual one, because it is sensitive to the order in which
+the items are presented to C<Data::Dumper>.
+
+Above the definition of this testing routine is a series of tests that
+I used to develop and verify the undumper.  I started with the
+included tests found in the Perl 5.6.1 distribution to verify Perl on
+initial installation.  I actually didn't include the entire test, but
+took the data structure for each applicable test and copied that into
+this program.  I skipped over the tests that included symbol-table
+references (using globs) or coderefs, because I chose to ignore that
+for this program.  Each test provides an arrayref containing the
+references to be dumped, and most tests also provide a label list to
+keep the variables from simply being named C<$VAR1>, C<$VAR2> and so
+on.
+
+I enclosed each test in a conditional that I could switch between "if
+(0)" and "if (1)" to either run the test or skip it.  When I was
+focussing on a new feature, I enabled only one test until it worked,
+but once I got a good run, I reenabled all previous tests to ensure
+that I didn't break something else in the process.
+
+The "Extreme Programming" technique relies on this strategy of
+creating tests first and driving the development from those tests, and
+it worked nicely for the development of this program.  Other than a
+few snippets of code that I used for scaffolding to test some initial
+grammar ideas, all of the code that I used to develop and test this
+code is thereby archived along with the routines, for later
+maintenance to take place easily.
+
+Any one of the tests can be switched to invoke C<timetest> rather than
+C<test>, as I've done on the final test (starting in line 171).  This
+final test, by the way, exercises blessed references (objects), which
+none of the distribution tests even approach.  (Maybe a patch to the
+distribution's C<t/dumper.t> is in order?)  Using C<timetest>, we pop
+down to the routine beginning in line 184, which runs a quick
+benchmark comparing a straight C<eval> with our safe undumping parser.
+I'm using the C<timethese> routine from C<Benchmark> (a standard Perl
+module), giving it the default "0 times", which attempts to run each
+routine for slighly over 3 CPU seconds to compute an interations per
+second for each type.
+
+The bad news is that my code clocks in at 1/100th of the speed of
+C<eval>.  Ahh, the price to pay for safety.  The good news is that the
+speed difference is probably negligible for typical applications, and
+pennies to pay for the dollars saved in having a safe evaluation of
+what should be good C<Data::Dumper> output.
+
+Well, what little Perl code there is (outside of the grammar), that's
+it.  So let's pick apart the grammar now, starting back up at line 13.
+
+Line 15 declares a variable local to the parser for the "symbol table"
+we'll be creating.  The keys will be the full variable names as given
+in the dump. The values will be the constructed value for that
+key. Yes, this is the hash that is returned upon a successful parse.
+
+Line 17 defines the top-level rule for the parse.  A "file" is zero or
+more "assignments".  Howver, we also have to clear out the possibly
+leftover values from the previous run, and this is handled by the
+action block immediately preceding the assignment. We also have to
+verify that we've parsed the entire input string, which I'll do by
+matching C</\z/>, which matches only at the end of the string. If all
+went well, we'll return the hashref.
+
+Line 19 defines an assignment.  Currently, I'm handling only a scalar
+assignment, although C<Data::Dumper> can also generate array and hash
+assignments under some circumstances.  Gotta leave something for
+"release 2.0".
+
+Lines 21 and 22 define a scalar assignment, and the action to take for
+that.  A scalar assignment consists of an "lvalue" (like a variable)
+and an "rvalue" (like an expression).  Both lvalues and rvalues are
+references, so we dereference each of them in the action, and perform
+the requested assignment to keep our "virtual Perl symbol table" up to
+date.  The action returns a constant 1 to let the parent rule know
+that this rule succeeded.  Without that, an C<undef> value being
+assigned would have caused that rule to fail (one of my debugging
+attempts revealed such, with much head-banging-on-desk until I
+realized what I was doing).
+
+Lvalues are defined starting in line 24.  The most complex lvalue is a
+dereferenced scalar reference, handled in lines 26 to 47.  This is
+because C<Data::Dumper> can generate a reference path to a specific
+entry in the data structure to patch it up so that it points to a
+proper place for complex data interelationships.  For example, if an
+element of C<@a> points to C<@b>, but an element of C<@b> points to
+C<@a>, the "chicken-and-egg" tie is broken by first generating C<@a>
+without the C<@b> reference, then C<@b> with the C<@a> reference, then
+patching up C<@a> finally to point to C<@b>.
+
+The definition starting in line 26 uses a C<deref_head> to be a simple
+scalar, followed by an optional C<deref_chain> which is one or more
+array-element or hash element dereferences.  Let's look at the syntax
+before we study the actions taken.  Line 39 shows us that
+C<deref_head> is either a C<simple_scalar_lvalue> or
+C<simple_scalar_rvalue>.
+
+Further down in lines 49 and 53, we see that a C<simple_scalar_lvalue>
+can be either a scalar variable or a scalar reference dereference.
+And that would form the head of the chain.  If it's a scalar variable,
+we take a reference to a hash element in our "symbol table", and
+return that.  The key is the name of the variable, including the
+dollar sign.  This permits eventual expansion to include arrays and
+hashes in our "symbol table", again for version 2.0.  For the
+dereference of the scalar reference, we emulate the same steps in our
+virtual world, again returning a reference for all lvalues.
+
+Once we have the chain head, we then look for a dereference chain
+(line 40), starting with the mandatory arrow then a hash or array
+subscript expression.  This may be followed with additional
+arrow-optional hash or array subscript expressions (line 42).  Each
+subscript is returned as a two-element arrayref, with either the
+keyword "hash" or "array" followed by the scalar constant selecting
+the particular element (lines 45 and 47).  The action in line 41 rolls
+up the deref chain as a reference to an array of those two-element
+arrayrefs.
+
+Back in line 26, we thus have a reference to a starting point for the
+C<deref_head>, and possible one or more dereferences to apply to it.
+The action in lines 27 to 37 walk the dereference chain to get to the
+final target lvalue, and return it (as a reference to a scalar
+somewhere in our virtual Perl symbol space).
+
+On the other side of the equation, we've got rvalues of various
+shapes, defined in line 58 to be either a C<simple_scalar_rvalue> or a
+C<scalar_lvalue>.  The loop back to C<scalar_value> is necessary
+because any variable reference is also itself a source of values.
+
+Lines 60 to 66 define the only scalar constants that C<Data::Dumper>
+seems to emit: C<undef>, simple signed integers, and quoted strings.
+These values are returned as references to those values so that
+C<undef> can be a valid return value: again, something I figured out
+the hard way after my rule for C<undef> kept breaking.
+
+Lines 68 to 75 handle the reference values: scalar references, array
+references, and hash references.  Again, the syntax is very narrow:
+just the types of things I was able to see C<Data::Dumper> generate,
+both by trying some sample data, and by lightly examining the source
+code to C<Data::Dumper>.  I may have missed a form or two, in which
+case this grammar will make it easy to add additional forms.
+
+The grammar is nicely recursive: an array reference in turn contains
+one or more C<scalar_rvalue> items, which brings us right back to the
+same place in the hierarchy, but at a nested level.
+
+Lines 76 to 79 handle blessed references. Again, the syntax is very
+specific to what I was able to determine about C<Data::Dumper>'s
+behavior.
+
+And that's pretty much it.  The grammar looks for a series of
+assignments, each of which is an lvalue being given an rvalue.  Some
+of the lvalues ultimately lead to symbol table entries, which then
+populate our symbol table hash with keys and values when assigned.
+Rvalues can be constants, or pointers into existing data in the symbol
+table.  OK, it I<is> somewhat full of smoke and mirrors, and I was
+rather pleased when the whole thing worked.  And on some rainy Oregon
+afternoon, I hope to extend it to handle arrays and hashes as well, just
+to make it extremely flexible and universal. I even have some ideas
+about how to get it to handle globs. But that's for another day: until
+next time, enjoy!
+
+=head2 Listing
+
+        =1=     #!/usr/bin/perl -w
+        =2=     use strict;
+        =3=     $|++;
+        =4=
+        =5=     # $::RD_TRACE = 80;
+        =6=     $::RD_HINT = 1;
+        =7=
+        =8=     use Parse::RecDescent;
+        =9=     use Data::Dumper;
+        =10=
+        =11=    ## define grammar
+        =12=
+        =13=    my $parser = Parse::RecDescent->new(q{
+        =14=
+        =15=    { my %TABLE; }
+        =16=
+        =17=    file: { %TABLE = (); } assignment(s?) /\z/ { \%TABLE }
+        =18=
+        =19=    assignment: scalar_assignment | <error>
+        =20=
+        =21=    scalar_assignment: scalar_lvalue '=' scalar_rvalue ';'
+        =22=      { ${$item{scalar_lvalue}} = ${$item{scalar_rvalue}}; 1; }
+        =23=
+        =24=    ## lvalues, indicated as reference to value, so we can assign to them
+        =25=
+        =26=    scalar_lvalue: deref_head deref_chain(?) {
+        =27=      my $return = $item{deref_head};
+        =28=      if ($item{deref_chain}) {
+        =29=        for (@{$item{deref_chain}[0]}) {
+        =30=          if ($_->[0] eq "hash") {
+        =31=            $return = \$$return->{${$_->[1]}};
+        =32=          } elsif ($_->[0] eq "array") {
+        =33=            $return = \$$return->[${$_->[1]}];
+        =34=          } else { die "what is $_->[0]?" }
+        =35=        }
+        =36=      }
+        =37=      $return;
+        =38=    }
+        =39=    deref_head: simple_scalar_lvalue | simple_scalar_rvalue
+        =40=    deref_chain: "->" hash_or_array_subscript deref_chain_more(s?)
+        =41=      { [$item[2], @{$item[3]}] }
+        =42=    deref_chain_more: "->" hash_or_array_subscript | hash_or_array_subscript
+        =43=    hash_or_array_subscript: hash_subscript | array_subscript
+        =44=    hash_subscript: "{" scalar_constant "}"
+        =45=      { ["hash", $item{scalar_constant}] }
+        =46=    array_subscript: "[" scalar_constant "]"
+        =47=      { ["array", $item{scalar_constant}] }
+        =48=
+        =49=    simple_scalar_lvalue: '$' ident
+        =50=      { \ $TABLE{'$' . $item{ident}} }
+        =51=    ident: /[^\W\d]\w*/
+        =52=
+        =53=    simple_scalar_lvalue: '$' '{' scalar_rvalue '}'
+        =54=      { \ ${${$item{scalar_rvalue}}} }
+        =55=
+        =56=    ## rvalues, indicated as reference to value, because "undef" is legal
+        =57=
+        =58=    scalar_rvalue: simple_scalar_rvalue | scalar_lvalue
+        =59=
+        =60=    simple_scalar_rvalue: scalar_constant
+        =61=    scalar_constant: 'undef'
+        =62=      { \ undef }
+        =63=    scalar_constant: /-?[1-9]\d*|0/
+        =64=      { \ $item[1] }
+        =65=    scalar_constant: <perl_quotelike>
+        =66=      { \ $item[1][2] }
+        =67=
+        =68=    simple_scalar_rvalue: "\x5C" scalar_rvalue
+        =69=      { \ $item{scalar_rvalue} }
+        =70=    simple_scalar_rvalue: '[' scalar_rvalue(s? /,/) ']'
+        =71=      { \ [map $$_, @{$item[2]}] }
+        =72=    simple_scalar_rvalue: '{' hashpair(s? /,/) '}'
+        =73=      { \ {map @$_, @{$item[2]}} }
+        =74=    hashpair: scalar_constant '=>' scalar_rvalue
+        =75=      { [${$item{scalar_constant}}, ${$item{scalar_rvalue}}] }
+        =76=    simple_scalar_rvalue: 'bless' '(' scalar_rvalue ',' scalar_constant ')'
+        =77=      { \ bless( ${$item{scalar_rvalue}}, ${$item{scalar_constant}} ) }
+        =78=    simple_scalar_rvalue: 'do' '{' "\x5C" '(' 'my' '$o' '=' scalar_rvalue ')' '}'
+        =79=      { \ do { \ (my $o = ${$item{scalar_rvalue}})} }
+        =80=
+        =81=    }) or die "compile";
+        =82=
+        =83=    ## following tests from t/dumper.t in 5.6.1 distribution
+        =84=
+        =85=    if (0) {
+        =86=      my @c = ('c');
+        =87=      my $c = \@c;
+        =88=      my $b = {};
+        =89=      my $a = [1, $b, $c];
+        =90=      $b->{a} = $a;
+        =91=      $b->{b} = $a->[1];
+        =92=      $b->{c} = $a->[2];
+        =93=
+        =94=      test([$a, $b, $c], [qw(a b c)]);
+        =95=    }
+        =96=
+        =97=    if (0) {
+        =98=      my $foo = { "abc\000\'\efg" => "mno\000",
+        =99=                  "reftest" => \\1,
+        =100=               };
+        =101=
+        =102=     test([$foo], [qw($foo)]);
+        =103=   }
+        =104=
+        =105=   if (0) {
+        =106=     my $foo = 5;
+        =107=     my @foo = (-10,\$foo);
+        =108=     my %foo = (a=>1,b=>\$foo,c=>\@foo);
+        =109=     $foo{d} = \%foo;
+        =110=     $foo[2] = \%foo;
+        =111=
+        =112=     test([\%foo],[qw($foo)]);
+        =113=   }
+        =114=
+        =115=   if (0) {
+        =116=     my @dogs = ( 'Fido', 'Wags' );
+        =117=     my %kennel = (
+        =118=               First => \$dogs[0],
+        =119=               Second =>  \$dogs[1],
+        =120=              );
+        =121=     $dogs[2] = \%kennel;
+        =122=     my $mutts = \%kennel;
+        =123=     test([\@dogs, \%kennel, $mutts], [qw($dogs $kennel $mutts)]);
+        =124=   }
+        =125=
+        =126=   if (0) {
+        =127=     my $a = [];
+        =128=     $a->[1] = \$a->[0];
+        =129=     test([$a], [qw($a)]);
+        =130=   }
+        =131=
+        =132=   if (0) {
+        =133=     my $a = \\\\\'foo';
+        =134=     my $b = $$$a;
+        =135=     test([$a, $b], [qw($a $b)]);
+        =136=   }
+        =137=
+        =138=   if (1) {
+        =139=     my $b;
+        =140=     my $a = [{ a => \$b }, { b => undef }];
+        =141=     $b = [{ c => \$b }, { d => \$a }];
+        =142=     timetest([$a, $b], [qw($a $b)]);
+        =143=   }
+        =144=
+        =145=   if (0) {
+        =146=     my $a = [[[[\\\\\'foo']]]];
+        =147=     my $b = $a->[0][0];
+        =148=     my $c = $${$b->[0][0]};
+        =149=     test([$a, $b, $c], [qw($a $b $c)]);
+        =150=   }
+        =151=
+        =152=   if (0) {
+        =153=     my $f = "pearl";
+        =154=     my $e = [        $f ];
+        =155=     my $d = { 'e' => $e };
+        =156=     my $c = [        $d ];
+        =157=     my $b = { 'c' => $c };
+        =158=     my $a = { 'b' => $b };
+        =159=     test([$a, $b, $c, $d, $e, $f], [qw($a $b $c $d $e $f)]);
+        =160=   }
+        =161=
+        =162=   if (0) {
+        =163=     my $a;
+        =164=     $a = \$a;
+        =165=     my $b = [$a];
+        =166=     test([$b], [qw($b)]);
+        =167=   }
+        =168=
+        =169=   ## end of tests from t/dumper.t, now some of my own
+        =170=
+        =171=   if (0) {
+        =172=     my $x = bless {fred => 'flintstone'}, 'x';
+        =173=     my $y = bless \$x, 'y';
+        =174=     timetest([$x, $y], [qw($x $y)]);
+        =175=   }
+        =176=
+        =177=   sub test {
+        =178=     my $input = Data::Dumper->new(@_)->Purity(1)->Dumpxs;
+        =179=     print "=" x 60, "\ninput:\n$input\n==>\noutput:\n";
+        =180=     my $symbol = $parser->file($input) or die "execute";
+        =181=     print Data::Dumper->new([values %$symbol], [keys %$symbol])->Purity(1)->Dumpxs;
+        =182=   }
+        =183=
+        =184=   sub timetest {
+        =185=     require Benchmark;
+        =186=
+        =187=     my $input = Data::Dumper->new(@_)->Purity(1)->Dumpxs;
+        =188=     print "=" x 60, "\ninput:\n$input\n==>\noutput:\n";
+        =189=     Benchmark::timethese(0, {
+        =190=                              PRD => sub {
+        =191=                                package Dummy;
+        =192=                                no strict;
+        =193=                                my $symbol = $parser->file($input)
+        =194=                                  or die "execute";
+        =195=                              },
+        =196=                              EVAL => sub {
+        =197=                                package Dummy;
+        =198=                                no strict;
+        =199=                                eval $input;
+        =200=                              },
+        =201=                             });
+        =202=   }
+
+--Boundary_(ID_V8Qg38zNd7FfillEy8fgog)--

misc/d-bindings/Parse-RecDescent-master-demo/Run-demos.pl

@@ -0,0 +1,234 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+# global vars
+my %progs; # defined in BEGIN block below
+
+if (!@ARGV) {
+  print <<"HERE";
+Usage: $0 mode [...options...]
+
+Executes all "demo*pl" scripts and redirects output to stdout
+separated by comments identifying the script and the input file
+(if any).
+
+Modes:
+
+  -r            Run all programs.
+  -r=X[,Y,...]  Run a subset of all programs (the list must have no spaces).
+  -list         List all programs and their arguments (if any).
+
+Options:
+
+  -d            Debug.
+
+HERE
+
+  exit;
+}
+
+# modes
+my $run  = 0;
+my $list = 0;
+
+sub zero_modes {
+  $run  = 0;
+  $list = 0;
+}
+
+# options
+my $debug = 0;
+
+# other
+my %ifils = ();
+
+foreach my $arg (@ARGV) {
+  my $saved_arg = $arg;
+  my $val = undef;
+  my $idx = index $arg, '=';
+  if ($idx >= 0) {
+    $val = substr $arg, $idx+1;
+    $arg = substr $arg, 0, $idx;
+  }
+
+  if (0 || $debug) {
+    print "DEBUG:\n";
+    print "  original  arg: '$saved_arg'\n";
+    print "  processed arg: '$arg'\n";
+    if (defined $val) {
+      print "  processed val: '$val'\n";
+    }
+    else {
+      print "  val was not defined\n";
+    }
+  }
+  # modes
+  if ($arg =~ m{\A \-r}x) {
+    zero_modes();
+    if (defined $val) {
+      my @fils = split(',', $val);
+      foreach my $f (@fils) {
+	if (exists $progs{$f}) {
+	  $ifils{$f} = 1;
+	}
+	else {
+	  print "WARNING:  File '$f' is not in the progs list.\n";
+	}
+      }
+      $run = 2;
+    }
+    else {
+      $run = 1;
+    }
+  }
+  elsif ($arg =~ m{\A \-l}x) {
+    zero_modes();
+    $list = 1;
+  }
+  # opions
+  elsif ($arg =~ m{\A \-d}x) {
+    $debug = 1;
+  }
+  else {
+    die "FATAL:  Unknown arg '$saved_arg'.\n";
+  }
+}
+
+die "FATAL:  No valid files entered for the '-r=X' option.\n"
+  if ($run == 2  && !(keys %ifils));
+
+my @progs = (sort keys %progs);
+
+# option '-list' =============================
+if ($list) {
+  print "List of programs:\n";
+
+  my $maxlen = 0;
+  my @prog_list = ();
+  foreach my $prog (@progs) {
+    my $args = $progs{$prog};
+    my $nam  = $prog;
+    $nam .= " $args"
+      if $args;
+    my $len = length $nam;
+    $maxlen = $len
+      if $len > $maxlen;
+    push @prog_list, $nam;
+  }
+
+  my $np = @prog_list;
+  for (my $i = 0; $i < $np; $i += 2) {
+    my $first  = $progs[$i];
+    my $second = $progs[$i+1];
+    if (!defined $second || !-f $second) {
+      $second = 0;
+    }
+
+    printf "%-*.*s", $maxlen, $maxlen, $first;
+    if ($second) {
+      printf " | %-*.*s", $maxlen, $maxlen, $second;
+    }
+    print "\n";
+  }
+
+}
+# option '-r[=X]' =============================
+elsif ($run) {
+  foreach my $prog (@progs) {
+    next if ($run > 1 && !exists $ifils{$prog});
+
+    my $args = $progs{$prog};
+    print  STDOUT "=== begin program '$prog' ===\n";
+    printf STDOUT "    === args '%s' ===\n", ($args ? $args : '(none)');
+
+    my $msg = qx(perl $prog $args);
+    if ($msg) {
+      chomp $msg;
+      print STDOUT "=== msg: '$msg'\n";
+    }
+    print STDOUT "=== end program '$prog' ===\n";
+
+  }
+}
+
+#### subroutines ####
+
+BEGIN {
+
+  %progs
+    = (
+       # key: program name
+       # val: arguments inputs (if any)
+       'demo.pl'                     => '',
+       'demo_Cgrammar.pl'            => 'demo.c',
+       'demo_Cgrammar_v2.pl'         => 'demo.c',
+       'demo_LaTeXish.pl'            => '',
+       'demo_LaTeXish_autoact.pl'    => '',
+       'demo_NL2SQL.pl'              => '',
+       'demo_OOautoparsetree.pl'     => '',
+       'demo_OOparsetree.pl'         => 'demo2.txt',
+       'demo_PerlCSV.pl'             => '',
+       'demo_another_Cgrammar.pl'    => '',
+       'demo_arithmetic.pl'          => 'demo3.txt',
+       'demo_autorule.pl'            => '',
+       'demo_autoscoresep.pl'        => '',
+       'demo_autostub.pl'            => '',
+       'demo_bad.pl'                 => '',
+       'demo_buildcalc.pl'           => '',
+       'demo_calc.pl'                => '',
+       'demo_codeblock.pl'           => '',
+       'demo_cpp.pl'                 => 'demo.c',
+       'demo_decomment.pl'           => '',
+       'demo_decomment_nonlocal.pl'  => '',
+       'demo_delete.pl'              => '',
+       'demo_derived.pl'             => '',
+       'demo_dot.pl'                 => '',
+       'demo_embedding.pl'           => '',
+       'demo_errors.pl'              => '',
+       'demo_eval.pl'                => '',
+       'demo_implicit.pl'            => 'demo4.txt',
+       'demo_itemhash.pl'            => '',
+       'demo_language.pl'            => '',
+       'demo_leftassoc.pl'           => '',
+       # not yet working:
+       #'demo_leftop.pl'              => '',
+       'demo_lexer.pl'               => '',
+       'demo_lisplike.pl'            => '',
+       'demo_logic.pl'               => 'demo2.txt',
+       'demo_matchrule.pl'           => '',
+       'demo_matchrule2.pl'          => '',
+       'demo_mccoy.pl'               => 'demo5.txt',
+       'demo_methods.pl'             => 'demo6.txt',
+       'demo_operator.pl'            => 'demo2.txt',
+       'demo_opreps.pl'              => '',
+       'demo_parsetree.pl'           => '',
+       'demo_perlparsing.pl'         => '',
+       'demo_piecewise.pl'           => '',
+       'demo_precalc.pl'             => '',
+       'demo_quicklist.pl'           => '',
+       'demo_randomsentence.pl'      => '',
+       'demo_recipe.pl'              => '',
+       'demo_restructure_easy.pl'    => '',
+       'demo_restructure_painful.pl' => '',
+       'demo_scoredsep.pl'           => '',
+       'demo_selfmod.pl'             => 'demo7.txt',
+       'demo_separators.pl'          => '',
+       'demo_simple.pl'              => 'demo8.txt',
+       'demo_simpleXML.pl'           => '',
+       'demo_simplequery.pl'         => 'demo9.txt',
+       'demo_skipcomment.pl'         => '',
+       'demo_street.pl'              => 'demo10.txt',
+       'demo_template.pl'            => '',
+       'demo_textgen.pl'             => '',
+       'demo_tokens.pl'              => '',
+
+       # not yet working:
+       #'demo_undumper.pl'            => '',
+
+       # not yet working:
+       #'demo_whoson.pl'              => '',
+      ); # %progs
+
+} # BEGIN

misc/d-bindings/Parse-RecDescent-master-demo/demo.c

@@ -0,0 +1,10 @@
+int main()
+{
+  int i;
+  int k;
+      int more_indented;
+      int l;
+
+  char *str = "/* this is no comment */";
+  return 0;
+}

misc/d-bindings/Parse-RecDescent-master-demo/demo.pl

@@ -0,0 +1,25 @@
+#! /usr/bin/perl -w
+
+package Foo;
+use base Parse::RecDescent;
+
+sub print_cat {
+	print "Found ", @_[1..$#_], "\n";
+}
+
+package main;
+
+
+$parse = new Parse::RecDescent(<<'EOG');
+	input	 :	"cat"
+				{ $thisparser->print_cat($item[1]); }
+		 |	"dog"
+				{ $thisparser->print_cat($item[1]); }
+EOG
+
+$parse = bless $parse, "Foo";
+
+$parse->input("cat");
+$parse->input("doggone");
+
+

misc/d-bindings/Parse-RecDescent-master-demo/demo_Cgrammar.pl

@@ -0,0 +1,410 @@
+#!/usr/bin/env perl
+
+use Parse::RecDescent;
+
+local $/;
+my $grammar = <DATA>;
+my $parser = Parse::RecDescent->new($grammar);
+
+my $text = <>;
+
+my $parse_tree = $parser->translation_unit($text) or die "bad C code";
+
+__DATA__
+
+<autotree>
+
+primary_expression:
+          IDENTIFIER
+        | CONSTANT
+        | STRING_LITERAL
+        | '(' expression ')'
+
+postfix_expression:
+          primary_expression
+        | (primary_expression)(s) '[' expression ']'
+        | (primary_expression)(s) '(' ')'
+        | (primary_expression)(s) '(' argument_expression_list ')'
+        | (primary_expression)(s) '.' IDENTIFIER
+        | (primary_expression)(s) PTR_OP IDENTIFIER
+        | (primary_expression)(s) INC_OP
+        | (primary_expression)(s) DEC_OP
+
+argument_expression_list:
+          (assignment_expression ',')(s?) assignment_expression
+
+unary_expression:
+          postfix_expression
+        | INC_OP unary_expression
+        | DEC_OP unary_expression
+        | unary_operator cast_expression
+        | SIZEOF unary_expression
+        | SIZEOF '(' type_name ')'
+
+unary_operator:
+          '&'
+        | '*'
+        | '+'
+        | '-'
+        | '~'
+        | '!'
+
+cast_expression:
+          unary_expression
+        | '(' type_name ')' cast_expression
+
+multiplicative_expression:
+          (cast_expression mul_ex_op)(s?) cast_expression
+
+mul_ex_op : '*' | '/' | '%'
+
+additive_expression:
+          (multiplicative_expression add_op)(s?) multiplicative_expression
+
+add_op : '+' | '-'
+
+shift_expression:
+          (additive_expression shift_op )(s?) additive_expression
+
+shift_op : LEFT_OP | RIGHT_OP
+
+relational_expression:
+          (shift_expression rel_op)(s?) shift_expression
+
+rel_op: '<' | '>' | LE_OP | GE_OP
+
+equality_expression:
+          (relational_expression eq_ex_op)(s?) relational_expression
+
+eq_ex_op : EQ_OP | NE_OP
+
+and_expression:
+          (equality_expression '&')(s?) equality_expression
+
+exclusive_or_expression:
+          (and_expression '^')(s?) and_expression
+
+inclusive_or_expression:
+          (exclusive_or_expression '|')(s?) exclusive_or_expression
+
+logical_and_expression:
+          (inclusive_or_expression AND_OP)(s?) inclusive_or_expression
+
+logical_or_expression:
+          (logical_and_expression OR_OP)(s?) logical_and_expression
+
+conditional_expression:
+          logical_or_expression
+        | logical_or_expression '?' expression ':' conditional_expression
+
+assignment_expression:
+          conditional_expression
+        | unary_expression assignment_operator assignment_expression
+
+assignment_operator:
+          '='
+        | MUL_ASSIGN
+        | DIV_ASSIGN
+        | MOD_ASSIGN
+        | ADD_ASSIGN
+        | SUB_ASSIGN
+        | LEFT_ASSIGN
+        | RIGHT_ASSIGN
+        | AND_ASSIGN
+        | XOR_ASSIGN
+        | OR_ASSIGN
+
+expression:
+          (assignment_expression ',')(s?) assignment_expression
+
+constant_expression:
+          conditional_expression
+
+declaration:
+          declaration_specifiers ';'
+          { print "We have a match!\n"; }
+        | declaration_specifiers init_declarator_list ';'
+
+declaration_specifiers:
+          storage_class_specifier
+        | storage_class_specifier declaration_specifiers
+        | type_specifier
+        | type_specifier declaration_specifiers
+        | type_qualifier
+        | type_qualifier declaration_specifiers
+
+init_declarator_list:
+          (init_declarator ',')(s?) init_declarator
+
+init_declarator:
+          declarator
+        | declarator '=' initializer
+
+storage_class_specifier:
+          TYPEDEF
+        | EXTERN
+        | STATIC
+        | AUTO
+        | REGISTER
+
+type_specifier:
+          VOID
+        | CHAR
+        | SHORT
+        | INT
+        | LONG
+        | FLOAT
+        | DOUBLE
+        | SIGNED
+        | UNSIGNED
+        | struct_or_union_specifier
+        | enum_specifier
+        | TYPE_NAME
+
+struct_or_union_specifier:
+          struct_or_union IDENTIFIER '{' struct_declaration_list '}'
+        | struct_or_union '{' struct_declaration_list '}'
+        | struct_or_union IDENTIFIER
+
+struct_or_union:
+          STRUCT
+        | UNION
+
+struct_declaration_list:
+          struct_declaration(s)
+
+struct_declaration:
+          specifier_qualifier_list struct_declarator_list ';'
+
+specifier_qualifier_list:
+          type_specifier specifier_qualifier_list
+        | type_specifier
+        | type_qualifier specifier_qualifier_list
+        | type_qualifier
+
+struct_declarator_list:
+          (struct_declarator ',')(s?) struct_declarator
+
+struct_declarator:
+          declarator
+        | ':' constant_expression
+        | declarator ':' constant_expression
+
+enum_specifier:
+          ENUM '{' enumerator_list '}'
+        | ENUM IDENTIFIER '{' enumerator_list '}'
+        | ENUM IDENTIFIER
+
+enumerator_list:
+          (enumerator ',')(s?) enumerator
+
+enumerator:
+          IDENTIFIER
+        | IDENTIFIER '=' constant_expression
+
+type_qualifier:
+          CONST
+        | VOLATILE
+
+declarator:
+          pointer direct_declarator
+        | direct_declarator
+
+direct_declarator:
+          IDENTIFIER
+        | '(' declarator ')'
+        | (IDENTIFIER)(s?) ('(' declarator ')')(s?) '[' constant_expression ']'
+        | (IDENTIFIER)(s?) ('(' declarator ')')(s?) '[' ']'
+        | (IDENTIFIER)(s?) ('(' declarator ')')(s?) '(' parameter_type_list ')'
+        | (IDENTIFIER)(s?) ('(' declarator ')')(s?) '(' identifier_list ')'
+        | (IDENTIFIER)(s?) ('(' declarator ')')(s?) '(' ')'
+
+pointer:
+          '*'
+        | '*' type_qualifier_list
+        | '*' pointer
+        | '*' type_qualifier_list pointer
+
+type_qualifier_list:
+          type_qualifier(s)
+
+parameter_type_list:
+          parameter_list
+        | parameter_list ',' ELLIPSIS
+
+parameter_list:
+          (parameter_declaration ',')(s?) parameter_declaration
+
+parameter_declaration:
+          declaration_specifiers declarator
+        | declaration_specifiers abstract_declarator
+        | declaration_specifiers
+
+identifier_list:
+          (IDENTIFIER ',')(s?) IDENTIFIER
+
+type_name:
+          specifier_qualifier_list
+        | specifier_qualifier_list abstract_declarator
+
+abstract_declarator:
+          pointer
+        | direct_abstract_declarator
+        | pointer direct_abstract_declarator
+
+direct_abstract_declarator:
+          '(' abstract_declarator ')'
+        | '[' ']'
+        | '[' constant_expression ']'
+        | DAD '[' ']'
+        | DAD '[' constant_expression ']'
+        | '(' ')'
+        | '(' parameter_type_list ')'
+        | DAD '(' ')'
+        | DAD '(' parameter_type_list ')'
+
+DAD:    #macro for direct_abstract_declarator
+          ( '(' abstract_declarator ')' )(s?)
+          ( '[' ']' )(s?)
+          ( '[' constant_expression ']' )(s?)
+          ( '(' ')' )(s?)
+          ( '(' parameter_type_list ')' )(s?)
+
+initializer:
+          assignment_expression
+        | '{' initializer_list '}'
+        | '{' initializer_list ',' '}'
+
+initializer_list:
+          (initializer ',')(s?) initializer
+
+statement:
+          labeled_statement
+        | compound_statement
+        | expression_statement
+        | selection_statement
+        | iteration_statement
+        | jump_statement
+
+labeled_statement:
+          IDENTIFIER ':' statement
+        | CASE constant_expression ':' statement
+        | DEFAULT ':' statement
+
+compound_statement:
+          '{' '}'
+        | '{' statement_list '}'
+        | '{' declaration_list '}'
+        | '{' declaration_list statement_list '}'
+
+declaration_list:
+          declaration(s)
+
+statement_list:
+          statement(s)
+
+expression_statement:
+          ';'
+        | expression ';'
+
+selection_statement:
+          IF '(' expression ')' statement
+        | IF '(' expression ')' statement ELSE statement
+        | SWITCH '(' expression ')' statement
+
+iteration_statement:
+          WHILE '(' expression ')' statement
+        | DO statement WHILE '(' expression ')' ';'
+        | FOR '(' expression_statement expression_statement ')' statement
+        | FOR '(' expression_statement expression_statement expression ')' statement
+
+jump_statement:
+          GOTO IDENTIFIER ';'
+        | CONTINUE ';'
+        | BREAK ';'
+        | RETURN ';'
+        | RETURN expression ';'
+
+translation_unit:
+          external_declaration(s)
+
+external_declaration:
+          function_definition
+        | declaration
+
+function_definition:
+          declaration_specifiers declarator declaration_list compound_statement
+        | declaration_specifiers declarator compound_statement
+        | declarator declaration_list compound_statement
+        | declarator compound_statement
+
+# TERMINALS
+
+reserved_word:
+        AUTO     | BREAK   | CASE     | CHAR   | CONST    |
+        CONTINUE | DEFAULT | DO       | DOUBLE | ENUM     |
+        EXTERN   | FLOAT   | FOR      | GOTO   | IF       |
+        INT      | LONG    | REGISTER | RETURN | SHORT    |
+        SIGNED   | SIZEOF  | STATIC   | STRUCT | SWITCH   |
+        TYPEDEF  | UNION   | UNSIGNED | VOID   | VOLATILE |
+        WHILE
+
+
+ADD_ASSIGN:     '+='
+AND_ASSIGN:     '&='
+AND_OP:         '&&'
+AUTO:           'auto'
+BREAK:          'break'
+CASE:           'case'
+CHAR:           'char'
+CONST:          'const'
+CONSTANT:       /[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?/
+CONTINUE:       'continue'
+DEC_OP:         '--'
+DEFAULT:        'default'
+DIV_ASSIGN:     '/='
+DO:             'do'
+DOUBLE:         'double'
+ELLIPSIS:       '...'
+ELSE:           'else'
+ENUM:           'enum'
+EQ_OP:          '=='
+EXTERN:         'extern'
+FLOAT:          'float'
+FOR:            'for'
+GE_OP:          '>='
+GOTO:           'goto'
+IDENTIFIER:     ...!reserved_word /[a-z]\w*/i
+IF:             'if'
+INC_OP:         '++'
+INT:            'int'
+LEFT_ASSIGN:    '<<='
+LEFT_OP:        '<<'
+LE_OP:          '<='
+LONG:           'long'
+MOD_ASSIGN:     '%='
+MUL_ASSIGN:     '*='
+NE_OP:          '!='
+OR_ASSIGN:      '|='
+OR_OP:          '||'
+PTR_OP:         '->'
+REGISTER:       'register'
+RETURN:         'return'
+RIGHT_ASSIGN:   '>>='
+RIGHT_OP:       '>>'
+SHORT:          'short'
+SIGNED:         'signed'
+SIZEOF:         'sizeof'
+STATIC:         'static'
+STRING_LITERAL: { extract_delimited($text,'"') }
+STRUCT:         'struct'
+SUB_ASSIGN:     '-='
+SWITCH:         'switch'
+TYPEDEF:        'typedef'
+TYPE_NAME:      # NONE YET
+UNION:          'union'
+UNSIGNED:       'unsigned'
+VOID:           'void'
+VOLATILE:       'volatile'
+WHILE:          'while'
+XOR_ASSIGN:     '^='

misc/d-bindings/Parse-RecDescent-master-demo/demo_Cgrammar_v2.pl

@@ -0,0 +1,313 @@
+#!/usr/bin/env perl
+
+# This improved version of the C grammar was provided by Joe Buehler
+
+use Parse::RecDescent;
+
+local $/;
+my $grammar = <DATA>;
+my $parser = Parse::RecDescent->new($grammar);
+
+my $text = <>;
+
+my $parse_tree = $parser->translation_unit($text) or die "bad C code";
+
+use Data::Dumper 'Dumper';
+warn Dumper [ $parse_tree ];
+
+__DATA__
+<autotree>
+
+primary_expression:
+	IDENTIFIER
+	| CONSTANT
+	| STRING_LITERAL
+	| '(' expression ')'
+
+postfix_expression_post:
+	'[' expression ']'
+	| '(' argument_expression_list(?) ')'
+	| '.' IDENTIFIER
+	| '->' IDENTIFIER
+	| '++'
+	| '--'
+
+postfix_expression:
+	primary_expression postfix_expression_post(s?)
+
+argument_expression_list:
+	assignment_expression (',' assignment_expression)(s?)
+
+unary_expression:
+	postfix_expression
+	| '++' unary_expression
+	| '--' unary_expression
+	| unary_operator cast_expression
+	| SIZEOF unary_expression
+	| SIZEOF '(' type_name ')'
+
+unary_operator:
+	/[-&*+!~]/
+
+cast_expression:
+	'(' type_name ')' cast_expression
+	| unary_expression
+
+multiplicative_expression_op:
+	/[*\/%]/
+
+multiplicative_expression:
+	cast_expression (multiplicative_expression_op cast_expression)(s?)
+
+additive_expression_op:
+	/[-+]/
+
+additive_expression:
+	multiplicative_expression (additive_expression_op multiplicative_expression)(s?)
+
+shift_expression_pre_op:
+	/(<<|>>)(?!=)/
+
+shift_expression:
+	additive_expression (shift_expression_pre_op additive_expression)(s?)
+
+relational_expression_op:
+	/(<=|>=|<|>)/
+
+relational_expression:
+	shift_expression (relational_expression_op shift_expression)(s?)
+
+equality_expression_pre_op:
+	/==|!=/
+
+equality_expression:
+	relational_expression (equality_expression_pre_op relational_expression)(s?)
+
+and_expression:
+	equality_expression ('&' equality_expression)(s?)
+
+exclusive_or_expression:
+	and_expression ('^' and_expression)(s?)
+
+inclusive_or_expression:
+	exclusive_or_expression ('|' exclusive_or_expression)(s?)
+
+logical_and_expression:
+	inclusive_or_expression ('&&' inclusive_or_expression)(s?)
+
+logical_or_expression:
+	logical_and_expression ('||' logical_and_expression)(s?)
+
+conditional_expression:
+	logical_or_expression ('?' expression ':' conditional_expression)(?)
+
+assignment_expression:
+	conditional_expression
+	| unary_expression assignment_operator assignment_expression
+
+assignment_operator:
+	/=(?!=)|\+=|\&=|\/=|<<=|\%=|\*=|\|=|>>=|-=|\^=/
+
+expression:
+	assignment_expression (',' assignment_expression)(s?)
+
+constant_expression:
+	conditional_expression
+
+declaration:
+	declaration_specifiers init_declarator_list ';'
+	| declaration_specifiers ';'
+
+declaration_specifiers:
+	( storage_class_specifier | type_specifier | type_qualifier )(s)
+
+init_declarator_list:
+	init_declarator (',' init_declarator)(s?)
+
+init_declarator:
+	declarator '=' initializer
+	| declarator
+
+storage_class_specifier:
+	/(typedef|extern|static|auto|register)(?![a-zA-Z0-9_])/
+
+type_specifier:
+	/(void|char|short|int|long|float|double|signed|unsigned)(?![a-zA-Z0-9_])/
+	| struct_or_union_specifier
+	| enum_specifier
+	| TYPE_NAME
+
+struct_or_union_specifier:
+	struct_or_union IDENTIFIER '{' struct_declaration_list '}'
+	| struct_or_union '{' struct_declaration_list '}'
+	| struct_or_union IDENTIFIER
+
+struct_or_union:
+	/(struct|union)(?![a-zA-Z0-9_])/
+
+struct_declaration_list:
+	struct_declaration(s)
+
+struct_declaration:
+	specifier_qualifier_list struct_declarator_list ';'
+
+specifier_qualifier_list:
+	( type_specifier | type_qualifier )(s)
+
+struct_declarator_list:
+	struct_declarator (',' struct_declarator)(s?)
+
+struct_declarator:
+	declarator ':' constant_expression
+	| declarator
+	| ':' constant_expression
+
+enum_specifier:
+	ENUM '{' enumerator_list '}'
+	| ENUM IDENTIFIER '{' enumerator_list '}'
+	| ENUM IDENTIFIER
+
+enumerator_list:
+	enumerator (',' enumerator)(s?)
+
+enumerator:
+	IDENTIFIER '=' constant_expression
+	| IDENTIFIER
+
+type_qualifier:
+	/(const|volatile)(?![a-zA-Z0-9_])/
+
+declarator:
+	pointer(?) direct_declarator
+
+direct_declarator_pre:
+	IDENTIFIER
+	| '(' declarator ')'
+
+direct_declarator_post:
+	'[' constant_expression ']'
+	| '[' ']'
+	| '(' parameter_type_list ')'
+	| '(' identifier_list ')'
+	| '(' ')'
+
+direct_declarator:
+	direct_declarator_pre direct_declarator_post(s?)
+
+pointer:
+	'*' type_qualifier_list(?) pointer(?)
+
+type_qualifier_list:
+	type_qualifier(s)
+
+parameter_type_list:
+	parameter_list ',' '...'
+	| parameter_list
+
+parameter_list:
+	parameter_declaration (',' parameter_declaration)(s?)
+
+parameter_declaration:
+	declaration_specifiers declarator
+	| declaration_specifiers abstract_declarator(?)
+
+identifier_list:
+	IDENTIFIER (',' IDENTIFIER)(s?)
+
+type_name:
+	specifier_qualifier_list abstract_declarator(?)
+
+abstract_declarator:
+	pointer direct_abstract_declarator(?)
+	| direct_abstract_declarator
+
+direct_abstract_declarator_pre:
+	'(' abstract_declarator ')'
+	| direct_abstract_declarator_post
+
+direct_abstract_declarator_post:
+	'[' ']'
+	| '[' constant_expression ']'
+	| '(' ')'
+	| '(' parameter_type_list ')'
+
+direct_abstract_declarator:
+	direct_abstract_declarator_pre direct_abstract_declarator_post(s?)
+
+initializer:
+	assignment_expression
+	| '{' initializer_list '}'
+	| '{' initializer_list ',' '}'
+
+initializer_list:
+	initializer (',' initializer)(s?)
+
+statement:
+	labeled_statement
+	| compound_statement
+	| expression_statement
+	| selection_statement
+	| iteration_statement
+	| jump_statement
+
+labeled_statement:
+	IDENTIFIER ':' statement
+	| /case(?![a-zA-Z0-9_])/ constant_expression ':' statement
+	| /default(?![a-zA-Z0-9_])/ ':' statement
+
+compound_statement:
+	'{' declaration_list statement_list(?) '}'
+	| '{' statement_list(?) '}'
+
+declaration_list:
+	declaration(s)
+
+statement_list:
+	statement(s)
+
+expression_statement:
+	expression(?) ';'
+
+selection_statement:
+	IF '(' expression ')' statement ELSE statement
+	| IF '(' expression ')' statement
+	| SWITCH '(' expression ')' statement
+
+iteration_statement:
+	WHILE '(' expression ')' statement
+	| DO statement WHILE '(' expression ')' ';'
+	| FOR '(' expression_statement expression_statement expression(?) ')' statement
+
+jump_statement:
+	/goto(?![a-zA-Z0-9_])/ IDENTIFIER ';'
+	| /continue(?![a-zA-Z0-9_])/ ';'
+	| /break(?![a-zA-Z0-9_])/ ';'
+	| /return(?![a-zA-Z0-9_])/ expression(?) ';'
+
+translation_unit:
+	external_declaration(s)
+
+external_declaration:
+	function_definition { print "*** function\n"; }
+	| declaration { print "*** declaration\n"; }
+
+function_definition:
+	declaration_specifiers declarator(?) declaration_list(?) compound_statement
+
+reserved_word:
+	/(auto|break|case|char|const|continue|default|do|double|enum|extern|float|for|goto|if|int|long|register|return|short|signed|sizeof|static|struct|switch|typedef|union|unsigned|void|volatile|while)(?![a-zA-Z0-9_])/
+
+CONSTANT:       /[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?/
+DO:             /do(?![a-zA-Z0-9_])/
+ELSE:           /else(?![a-zA-Z0-9_])/
+ENUM:           /enum(?![a-zA-Z0-9_])/
+FOR:            /for(?![a-zA-Z0-9_])/
+IDENTIFIER:     ...!reserved_word /[a-zA-Z_][a-zA-Z_0-9]*/
+IF:             /if(?![a-zA-Z0-9_])/
+SIZEOF:         /sizeof(?![a-zA-Z0-9_])/
+STRING_LITERAL: { extract_delimited($text,'"') }
+SWITCH:         /switch(?![a-zA-Z0-9_])/
+TYPE_NAME:      ...!reserved_word /[a-zA-Z_][a-zA-Z_0-9]*/ ...IDENTIFIER
+				| ...!reserved_word /[a-zA-Z_][a-zA-Z_0-9]*/ .../[:*)]/
+WHILE:          /while(?![a-zA-Z0-9_])/
+

misc/d-bindings/Parse-RecDescent-master-demo/demo_LaTeXish.pl

@@ -0,0 +1,101 @@
+#!/usr/bin/env perl
+
+use v5.10;
+use warnings;
+
+
+use Parse::RecDescent;
+
+$RD_TRACE = 1;
+
+my $parser = Parse::RecDescent->new(<<'EOGRAMMAR');
+
+    <autotree>
+
+	file:		element(s)
+
+	element:	command | literal
+
+	command:	'\\' literal options(?) args(?)
+
+	options:	'[' option(s? /,/) ']'
+
+	args:		'{' element(s?) '}'
+
+	option:		/[^][\\$&%#_{}~^ \t\n,]+/
+
+	literal:	/[^][\\$&%#_{}~^ \t\n]+/
+
+
+EOGRAMMAR
+
+
+local $/;
+my $tree = $parser->file(<DATA>);
+
+$tree->explain(0);
+
+sub file::explain
+{
+	my ($self, $level) = @_;
+	for (@{$self->{'element(s)'}})
+	{
+		$_->explain($level);
+		print "\n";
+	}
+}
+
+sub element::explain
+{
+	my ($self, $level) = @_;
+	($self->{command}||$self->{literal})->explain($level)
+}
+
+sub command::explain
+{
+	my ($self, $level) = @_;
+	print "\t"x$level, "Command: $self->{literal}{__VALUE__}\n";
+	print "\t"x$level, "\tOptions:\n";
+	$self->{'options(?)'}[0]->explain($level+2) if @{$self->{'options(?)'}};
+	print "\t"x$level, "\tArgs:\n";
+	$self->{'args(?)'}[0]->explain($level+2) if @{$self->{'args(?)'}};
+}
+
+sub options::explain
+{
+	my ($self, $level) = @_;
+	$_->explain($level) foreach @{$self->{'option(s?)'}};
+}
+
+sub args::explain
+{
+	my ($self, $level) = @_;
+	$_->explain($level) foreach @{$self->{'element(s?)'}};
+}
+
+
+sub option::explain
+{
+	my ($self, $level) = @_;
+	print "\t"x$level, "Option: $self->{__VALUE__}\n";
+}
+
+sub literal::explain
+{
+	my ($self, $level) = @_;
+	print "\t"x$level, "Literal: $self->{__VALUE__}\n";
+}
+
+
+__DATA__
+
+\documentclass[a4paper,11pt]{article}
+\usepackage{latexsym}
+\author{D. Conway}
+\title{Parsing \LaTeX{}}
+\begin{document}
+\maketitle
+\tableofcontents
+\section{Description}
+...is easy \footnote{But not \emph{necessarily} simple}.
+\end{document}

misc/d-bindings/Parse-RecDescent-master-demo/demo_LaTeXish_autoact.pl

@@ -0,0 +1,99 @@
+#!/usr/bin/env perl
+
+use Parse::RecDescent;
+
+#$RD_TRACE = 1;
+#$RD_HINT = 1;
+
+my $parser = Parse::RecDescent->new(<<'EOGRAMMAR');
+
+    <autoaction: { bless \%item, $item{__RULE__} } >
+
+	file:		element(s)
+
+	element:	command | literal
+
+	command:	'\\' literal options(?) args(?)
+
+	options:	'[' option(s? /,/) ']'
+
+	args:		'{' element(s?) '}'
+
+	option:		/[^][\\$&%#_{}~^ \t\n,]+/
+
+	literal:	/[^][\\$&%#_{}~^ \t\n]+/
+
+EOGRAMMAR
+
+local $/;
+my $tree = $parser->file(<DATA>);
+
+use Data::Dumper 'Dumper';
+warn Dumper [ $tree ];
+
+$tree->explain(0);
+
+sub file::explain
+{
+	my ($self, $level) = @_;
+	for (@{$self->{'element(s)'}})
+	{
+		$_->explain($level);
+		print "\n";
+	}
+}
+
+sub element::explain
+{
+	my ($self, $level) = @_;
+	($self->{command}||$self->{literal})->explain($level)
+}
+
+sub command::explain
+{
+	my ($self, $level) = @_;
+	print "\t"x$level, "Command: $self->{literal}{__PATTERN1__}\n";
+	print "\t"x$level, "\tOptions:\n";
+	$self->{'options(?)'}[0]->explain($level+2) if @{$self->{'options(?)'}};
+	print "\t"x$level, "\tArgs:\n";
+	$self->{'args(?)'}[0]->explain($level+2) if @{$self->{'args(?)'}};
+}
+
+sub options::explain
+{
+	my ($self, $level) = @_;
+	$_->explain($level) foreach @{$self->{'option(s?)'}};
+}
+
+sub args::explain
+{
+	my ($self, $level) = @_;
+	$_->explain($level) foreach @{$self->{'element(s?)'}};
+}
+
+
+sub option::explain
+{
+	my ($self, $level) = @_;
+	print "\t"x$level, "Option: $self->{__PATTERN1__}\n";
+}
+
+sub literal::explain
+{
+	my ($self, $level) = @_;
+	print "\t"x$level, "Literal: $self->{__PATTERN1__}\n";
+}
+
+
+__DATA__
+
+\documentclass[a4paper,11pt]{article}
+\usepackage{latexsym}
+\author{D. Conway}
+\title{Parsing \LaTeX{}}
+\begin{document}
+\maketitle
+\tableofcontents
+\section{Description}
+...is easy \footnote{But not \emph{necessarily} simple}.
+\end{document}

misc/d-bindings/Parse-RecDescent-master-demo/demo_NL2SQL.pl

@@ -0,0 +1,93 @@
+#! /usr/local/bin/perl -ws
+
+use Parse::RecDescent;
+
+
+my $grammar = <<'EOGRAMMAR';
+
+translate:	select
+	 |	sum
+	 |	identify
+	 |			{ "Could you rephase that?\n" }
+
+select:		ask_select qualifier(?) field /of/ qualifier(?) table
+				{ "SELECT DISTINCT $item[3]\nFROM $item[6]\n" }
+	      |	ask_select qualifier(?) table /'?/ qualifier(?) field
+				{ "SELECT DISTINCT $item[6]\nFROM $item[3]\n" }
+	      |	ask_select qualifier(?) table
+				{ "SELECT *\nFROM $item[3]\n" }
+
+sum:		ask_count table prep qualifier field prep(?) value
+				{ "SELECT COUNT(*)\nFROM $item[2]\n" .
+				  "WHERE $item[5] = $item[7]\n" }
+   |		ask_count table
+				{ "SELECT COUNT(*)\nFROM $item[2]\n" }
+
+identify:	ask_select(?) /who supplies/ qualifier value
+				{ "SELECT supplier\nFROM merchandise\n" .
+				  "WHERE name = $item[4]\n" }
+
+	|	whats qualifier field /of/ qualifier /suppliers? of/ value
+				{ "SELECT suppliers.$item[3]\n" .
+				  "FROM suppliers, products\n" .
+				  "WHERE products.name = $item[-1]\n" .
+				  "AND suppliers.name = products.supplier \n" }
+
+
+
+
+field:		/(name)s?/			{ $1 }
+     |		/(product)s?/			{ $1 }
+     |		/(id)(entit(y|ies))?/		{ $1 }
+     |		/(quantit(y|ies))/		{ $1 }
+     |		/(received)s?/			{ $1 }
+     |		/(supplier)s?/			{ $1 }
+     |		/(cost)s?/			{ $1 }
+     |		/(address)(es)?/		{ $1 }
+
+table:		/suppliers?/			{ 'suppliers' }
+     |		'merchandise'
+     |		/orders?/			{ 'orders' }
+
+qualifier:	/the|every|all( the)?|any|our/
+
+ask_select:	reply to_me
+
+ask_count:	ask_select(?) /how (many|much)/
+
+reply:		/tell|show|list/
+
+value:		/\w+/				{ qq{'$item[1]'} }
+
+to_me:		/((to )?(me|us))?/
+
+whats:		/what's|what (is|are)/
+
+prep:		/for|of|with|by/
+
+EOGRAMMAR
+
+my $parser = Parse::RecDescent->new($grammar)
+	or die "Bad grammar";
+
+while (defined(my $line = <DATA>)) {
+  print "> ";
+  #sleep 1;
+  print "$line";
+  my $SQL = $parser->translate($line);
+  print $SQL, "\n";
+}
+
+__DATA__
+how many orders for the product spam are there?
+tell me how many suppliers by the name of Jones we have
+what are the names of our suppliers of trinitrotoluene?
+tell me our suppliers' names
+list our merchandise
+show us the suppliers of the mechanise
+list all supplier names
+how many orders are there?
+how much merchandise do we carry?
+who supplies our nitrocelluose?
+tell me who supplies our ethylacetate?
+what are the addresses of our suppliers of trinitrotoluene?

misc/d-bindings/Parse-RecDescent-master-demo/demo_OOautoparsetree.pl

@@ -0,0 +1,69 @@
+#! /usr/local/bin/perl -sw
+
+# PARSE AND EVALUATE LOGICAL EXPRESSIONS WITH A AUTOGENERATED OO PARSE TREE
+
+use Parse::RecDescent;
+use Data::Dumper;
+
+    sub trace_only {
+        my ($pattern) = @_;
+        $RD_TRACE=1;
+        my $_real_trace = \&Parse::RecDescent::_trace;
+        *Parse::RecDescent::_trace = sub ($;$$$) {
+            my ($msg, $context, $rulename, $level) = @_;
+            return if $msg !~ $pattern;
+            goto &{$_real_trace};
+        };
+    }
+
+my $parse = Parse::RecDescent->new(<<'EOG');
+
+<autotree: LOGICAL>
+	expr	:	set | clear | disj
+	set		:	'set' atom
+	clear	:	'clear' atom
+	disj	:	<leftop: conj 'or' conj>
+				{ bless $item[-1], 'LOGICAL::'.$item[0] }
+	conj	:	<leftop: unary 'and' unary>
+				{ bless $item[-1], 'LOGICAL::'.$item[0] }
+	unary	:	neg | bracket | atom
+	bracket :	'(' expr ')'
+	neg	:	'not' unary
+	atom	:	/[a-z]+/i
+EOG
+
+    trace_only( qr/Matched|consumed/ );
+
+while (<DATA>)
+{
+	my $tree = $parse->expr($_);
+	print Data::Dumper->Dump([$tree]);
+	print $tree->eval(), "\n" if $tree;
+}
+
+BEGIN {@var{qw(a c e)} = (1,1,1);}
+
+sub returning
+{
+ 	 # local $^W;
+	 # print +(caller(1))[3], " returning ($_[0])\n";
+	$_[0];
+}
+
+sub LOGICAL::expr::eval		{ my $type = $_[0]->{set}||$_[0]->{clear}
+													 ||$_[0]->{disj};
+							  returning $type->eval() }
+sub LOGICAL::disj::eval     { returning join '', map {$_->eval()} @{$_[0]} }
+sub LOGICAL::conj::eval     { returning ! join '', map {! $_->eval()} @{$_[0]} }
+sub LOGICAL::unary::eval    { my $type = $_[0]->{neg}||$_[0]->{bracket}
+												     ||$_[0]->{atom};
+							  returning $type->eval() }
+sub LOGICAL::bracket::eval  { returning $_[0]->{expr}->eval() }
+sub LOGICAL::neg::eval	   	{ returning ! $_[0]->{unary}->eval() }
+sub LOGICAL::set::eval      { returning $::var{$_[0]->{atom}->name()} = 1 }
+sub LOGICAL::clear::eval    { returning $::var{$_[0]->{atom}->name()} = 0 }
+sub LOGICAL::atom::eval     { returning $::var{$_[0]->{__VALUE__}} }
+sub LOGICAL::atom::name     { returning $_[0]->{__VALUE__} }
+
+__DATA__
+a or b and not c or d

misc/d-bindings/Parse-RecDescent-master-demo/demo_OOparsetree.pl

@@ -0,0 +1,50 @@
+#! /usr/local/bin/perl -sw
+
+# PARSE AND EVALUATE LOGICAL EXPRESSIONS WITH A OO PARSE TREE
+
+$::RD_AUTOACTION =
+	q{ bless [$item[-1]], $item[0] };
+
+use Parse::RecDescent;
+use Data::Dumper;
+
+my $parse = Parse::RecDescent->new(<<'EOG');
+
+	expr	:	set | clear | disj
+	set	:	'set' atom
+	clear	:	'clear' atom
+	disj	:	<leftop: conj 'or' conj>
+				{ bless $item[-1], $item[0] }
+	conj	:	<leftop: unary 'and' unary>
+				{ bless $item[-1], $item[0] }
+	unary	:	neg | bracket | atom
+	bracket :	'(' expr ')'  { $item[2] }
+	neg	:	'not' unary
+	atom	:	/[a-z]+/i
+EOG
+
+while (<>)
+{
+	my $tree = $parse->expr($_);
+	print Data::Dumper->Dump([$tree]);
+	print $tree->eval(), "\n" if $tree;
+}
+
+BEGIN {@var{qw(a c e)} = (1,1,1);}
+
+sub returning
+{
+ 	 # local $^W;
+	 # print +(caller(1))[3], " returning ($_[0])\n";
+	$_[0];
+}
+
+sub expr::eval     { returning $_[0][0]->eval() }
+sub disj::eval     { returning join '', map {$_->eval()} @{$_[0]} }
+sub conj::eval     { returning ! join '', map {! $_->eval()} @{$_[0]} }
+sub unary::eval    { returning $_[0][0]->eval() }
+sub neg::eval	   { returning ! $_[0][0]->eval() }
+sub set::eval      { returning $::var{$_[0][0]->name()} = 1 }
+sub clear::eval    { returning $::var{$_[0][0]->name()} = 0 }
+sub atom::eval     { returning $::var{$_[0][0]} }
+sub atom::name     { returning $_[0][0] }

misc/d-bindings/Parse-RecDescent-master-demo/demo_PerlCSV.pl

@@ -0,0 +1,22 @@
+#! /usr/local/bin/perl -w
+
+use Parse::RecDescent;
+
+my $PCSV_parser = Parse::RecDescent->new(<<'EOGRAMMAR');
+
+	file:	<skip: '[ \t]*'> line(s?)
+
+	line:	field(s? /,|=>/) "\n" 	{ $item[1] }
+
+	field:	<perl_quotelike>	{ join "", @{$item[1]} }
+	     |	/((?!,|=>).)*/
+
+EOGRAMMAR
+
+use Data::Dumper;
+
+print  Data::Dumper->Dump($PCSV_parser->file(join "", <DATA>));
+
+__DATA__
+comma,separated=>values
+with,q{a,perl,twist},/to them/

misc/d-bindings/Parse-RecDescent-master-demo/demo_another_Cgrammar.pl

@@ -0,0 +1,822 @@
+#!/usr/bin/perl -w
+#===============================================================================
+#
+#         FILE:  csourceparser.pl
+#
+#        USAGE:  ./csourceparser.pl [Option] ... File ...
+#
+#
+#  DESCRIPTION:	 Parse and extract specified elements from source-code
+#  				 written in the C language
+#
+#      OPTIONS:  ---
+# REQUIREMENTS:  Perl Version >= 5.8.0, Parse::RecDescent, Getopt::Long, Pod::Usage
+#         BUGS:  ---
+#        NOTES:  ---
+#       AUTHOR:  <hendrik.sirges(at)fh-swf.de>
+#      COMPANY:  FH-SWF
+#      VERSION:  0.1.0
+#      CREATED:  07/10/05 12:34:53 CEST
+#     REVISION:  ---
+#===============================================================================
+
+require 5.008000;
+use strict;
+
+use Parse::RecDescent;
+use Getopt::Long;
+use Pod::Usage;
+
+# use Data::Dumper 'Dumper';
+
+#$::RD_HINT 		= 1;					# Print hints on errors
+#$::RD_ERRORS		= 1;					# Print errors
+#$::RD_WARN 		= 1;
+#$::RD_TRACE 		= 1;					# Print tracecode to STDERR
+#$::RD_AUTOSTUB 	= 1;
+
+###############################################################
+# Grammar used to find and remove comments from C source code #
+###############################################################
+my $decomment_grammar = <<'END_OF_DECOMMENT';
+
+program	: <skip:''> { @{$thisparser}{qw(code)} = () }
+	  part(s)
+	  {@{$thisparser}{code};}
+
+part	: comment 		{ $thisparser->{code}		.= " "; }
+        | C_code  		{ $thisparser->{code}     	.= $item[1]; }
+        | string  		{ $thisparser->{code}     	.= qq("$item[1]"); }
+
+C_code  : m{(
+	      [^"/]+	# one or more non-delimiters
+	      (			# then (optionally)...
+	       /		# a potential comment delimiter
+	       [^*/]	# which is not an actual delimiter
+	      )?		#
+	    )+			# all repeated once or more
+	   }x
+
+string	: m{"		# a leading delimiter
+	    ((			# zero or more...
+	      \\.		# escaped anything
+	      |			# or
+	      [^"]		# anything but a delimiter
+	     )*
+	    )
+	    "}x
+		{ $return =  $1 }
+
+
+comment	: m{\s*				# optional whitespace
+	    //					# comment delimiter
+	    [^\n]*				# anything except a newline
+	    \n					# then a newline
+	    }x
+
+	| m{\s*					# optional whitespace
+	    /\*					# comment opener
+	    (?:[^*]+|\*(?!/))*	# anything except */
+	    \*/		      		# comment closer
+        ([ \t]*)?       	# trailing blanks or tabs
+	    }x
+END_OF_DECOMMENT
+
+######################################################################################
+# Grammar used to parse C source code (without comments and preprocessor directives) #
+# ####################################################################################
+my $Cgrammar = <<'END_OF_C_GRAMMAR';
+
+	translation_unit:
+		external_declaration(s)
+	|	<error>
+
+	external_declaration:
+		function_definition
+	|	declaration
+	|	<resync>
+		{
+			if ($::opt_SKIPPEDLINES || (defined $::opt_VERBOSE and $::opt_VERBOSE >= 1 ))
+			{
+				print "Skipping line $thisline\n"	# Try next line if possible...
+			}
+		 }
+
+	function_definition:
+		declaration_specifiers(?) declarator declaration_list(?) compound_statement
+		{
+			if($::opt_FUNCTIONS)
+			{
+				$::functions_output .= ::flatten_list($item[1]);
+				$::functions_output .= ::flatten_list($item[2]);
+				$::functions_output .= ::flatten_list($item[3]) . ";\n";
+			}
+		}
+
+	declaration:
+		declaration_specifiers init_declarator_list(?) ';'
+		{
+            if($::opt_DECLARATIONS)
+            {
+				$::declarations_output .= ::flatten_list($item[1]);
+				$::declarations_output .= ::flatten_list($item[2]);
+				$::declarations_output .= ::flatten_list($item[3]) . "\n";
+            }
+        }
+
+	declaration_list:
+		declaration(s)
+
+	declaration_specifiers:
+		type_qualifier 			declaration_specifiers(?)
+	|	storage_class_specifier declaration_specifiers(?)
+	|	type_specifier  		declaration_specifiers(?)
+
+	storage_class_specifier:
+		  'auto'
+		| 'register'
+		| 'static'
+		| 'extern'
+		| 'typedef'
+
+	type_specifier:
+		  'int'
+		| 'double'
+		| 'void'
+		| 'char'
+		| 'long'
+		| 'float'
+		| 'signed'
+		| 'unsigned'
+		| 'short'
+		| struct_or_union_specifier
+		| enum_specifier
+		| typedef_name ...typedef_name_lookahead { [$item[1] ] }
+
+	typedef_name_lookahead:
+		declarator
+#	|	pointer
+#	|	',' ...parameter_type_list
+#	|	')'
+
+	type_qualifier:
+		  'const'
+		| 'volatile'
+
+	struct_or_union_specifier:
+		  struct_or_union IDENTIFIER(?) '{' struct_declaration_list(?) '}'
+          {
+		  	if($::opt_STRUCTS){
+				$::structs_output .= ::flatten_list($item[1]) . " ";
+				$::structs_output .= ::flatten_list($item[2]);
+				$::structs_output .= ::flatten_list($item[3]) . "\n";
+				$::structs_output .= ::flatten_list_beautified($item[4]);
+				$::structs_output .= ::flatten_list($item[5]) . ";\n\n";
+			}
+          }
+		| struct_or_union IDENTIFIER
+
+	struct_or_union:
+		  'struct'
+		| 'union'
+
+
+	struct_declaration_list:
+		struct_declaration(s)
+
+	init_declarator_list:
+		init_declarator(s /(,)/)
+
+	init_declarator:
+		declarator '=' initializer
+	|	declarator
+
+	struct_declaration:
+		specifier_qualifier_list struct_declarator_list ';'
+
+	specifier_qualifier_list:
+		type_specifier specifier_qualifier_list(?)
+	|	type_qualifier specifier_qualifier_list(?)
+
+	struct_declarator_list:
+		struct_declarator(s /(,)/)
+
+	struct_declarator:
+		declarator(?) ':' constant_expression
+	|	declarator
+
+	enum_specifier:
+		'enum' IDENTIFIER(?) '{' enumerator_list '}'
+          {
+		  	if($::opt_STRUCTS){
+				$::structs_output .= ::flatten_list($item[1]) . " ";
+				$::structs_output .= ::flatten_list($item[2]);
+				$::structs_output .= ::flatten_list($item[3]) . "\n";
+				$::structs_output .= ::flatten_list_beautified($item[4]);
+				$::structs_output .= ::flatten_list($item[5]) . ";\n\n";
+			}
+          }
+	|	'enum' IDENTIFIER
+
+	enumerator_list:
+		enumerator(s /(,)/)
+
+	enumerator:
+		IDENTIFIER ('=' constant_expression)(?)
+
+	declarator:
+		pointer(?) direct_declarator
+
+	function_signature:
+		'[' constant_expression(?) ']'
+	|	'(' parameter_type_list ')'
+	|	'(' identifier_list(?) ')'
+
+	direct_declarator:
+		IDENTIFIER function_signature(s?)
+	|	'(' declarator ')' function_signature(s?)
+
+
+	pointer:
+	  '*' type_qualifier_list(?) pointer(?)
+
+	type_qualifier_list:
+		type_qualifier(s)
+
+	parameter_type_list:
+		parameter_list (',' '...')(?)
+
+	parameter_list:
+		parameter_declaration(s /(,)/)
+
+	parameter_declaration:
+		declaration_specifiers declarator
+	|	declaration_specifiers abstract_declarator(?)
+
+	identifier_list:
+		IDENTIFIER(s /(,)/)
+
+	initializer:
+		assignment_expression
+	|	'{' initializer_list (',')(?) '}'
+
+	initializer_list:
+		initializer(s /(,)/)
+
+	type_name:
+		specifier_qualifier_list abstract_declarator(?)
+
+	abstract_declarator:
+		pointer(?) direct_abstract_declarator
+	|	pointer
+
+	abstract_type:
+		'[' constant_expression(?) ']'
+	|	'(' parameter_type_list(?) ')'
+
+	direct_abstract_declarator:
+		'(' abstract_declarator ')' abstract_type(s?)
+	|	abstract_type(s)
+
+	typedef_name:
+		IDENTIFIER
+
+	statement:
+		selection_statement
+	|	expression_statement
+	|	iteration_statement
+	|	compound_statement
+	|	jump_statement
+	|	labeled_statement
+
+
+	labeled_statement:
+		'case' constant_expression ':' statement
+	|	IDENTIFIER ':' statement
+	|	'default' ':' statement
+
+	expression_statement:
+		expression(?) ';'
+
+	compound_statement:
+		'{' declaration_list(?) statement_list(?) '}'
+
+	statement_list:
+		statement(s)
+
+	selection_statement:
+		'if'      '(' expression  ')' statement ('else' statement)(?)
+	|	'switch'  '(' expression  ')' statement
+
+	iteration_statement:
+		'for'   '(' expression(?) ';' expression(?) ';' expression(?) ')' statement
+	|	'while' '(' expression ')' statement
+	|	'do' statement 'while' '(' expression ')'
+
+	jump_statement:
+		'return' expression(?) ';'
+	|	'break' ';'
+	|	'continue' ';'
+	|	'goto' IDENTIFIER ';'
+
+	expression:
+		assignment_expression(s /(,)/)
+
+	assignment_expression:
+		unary_expression ASSIGNMENT_OPERATOR assignment_expression
+	|	conditional_expression
+
+
+	conditional_expression:
+		 logical_OR_expression  ('?' expression ':' conditional_expression)(?)
+
+	constant_expression:
+		conditional_expression
+
+	logical_OR_expression:
+		logical_AND_expression(s /(\|\|)/)
+
+	logical_AND_expression:
+		inclusive_OR_expression(s /(&&)/)
+
+	inclusive_OR_expression:
+		exclusive_OR_expression(s /(\|)/)
+
+	exclusive_OR_expression:
+		AND_expression(s /(\^)/)
+
+	AND_expression:
+		equality_expression(s /(&)/)
+
+	equality_expression:
+		relational_expression(s /(==|!=)/)
+
+	relational_expression:
+		shift_expression(s /(<=|>=|<|>)/)
+
+	shift_expression:
+		additive_expression(s /(<<|>>)/)
+
+	additive_expression:
+		multiplicative_expression(s /(\+|-)/)
+
+	multiplicative_expression:
+		cast_expression(s /(\*|\/|%)/)
+
+	cast_expression:
+		unary_expression
+	|	'(' type_name ')' cast_expression
+
+	unary_expression:
+		postfix_expression
+	|	'++'  unary_expression
+	|	'--'  unary_expression
+	|	'sizeof' '(' type_name ')'
+	|   UNARY_OPERATOR cast_expression
+	|	'sizeof'  	unary_expression
+
+
+	postfix_expression:
+		primary_expression postfix_expression_token(s?)
+
+
+	postfix_expression_token:
+    	  '[' expression ']'
+		| '(' argument_expression_list(?)')'
+		| '.'  IDENTIFIER
+		| '->' IDENTIFIER
+		| '++'
+		| '--'
+
+
+	primary_expression:
+		IDENTIFIER
+	|	constant
+	|	STRING
+	|	'(' expression ')'
+
+	argument_expression_list:
+		assignment_expression(s /(,)/)
+
+	constant:
+		CHARACTER_CONSTANT
+	|	FLOATING_CONSTANT
+	|	INTEGER_CONSTANT
+	|	ENUMERATION_CONSTANT
+
+
+###	TERMINALS
+
+
+	INTEGER_CONSTANT:
+		/(?:0[xX][\da-fA-F]+) 					# Hexadecimal
+		 |(?:0[0-7]*)		  					# Octal or Zero
+		 |(?:[1-9]\d*)		  					# Decimal
+		 [uUlL]?			  					# Suffix
+		 /x
+
+	CHARACTER_CONSTANT:
+		/'([^\\'"]							# None of these
+		 |\\['\\ntvbrfa'"]  				# or a backslash followed by one of those
+		 |\\[0-7]{1,3}|\\x\d+)'			# or an octal or hex constant
+		/x
+
+	FLOATING_CONSTANT:
+		/(?:\d+|(?=\.\d+))					# No leading digits only if '.moreDigits' follows
+		 (?:\.|(?=[eE]))						# There may be no floating point only if an exponent is present
+		 \d*									# Zero or more floating digits
+		 ([eE][+-]?\d+)?						# expontent
+		 [lLfF]?								# Suffix
+		/x
+
+	ENUMERATION_CONSTANT:
+		INTEGER_CONSTANT
+
+	STRING:
+		/"(([^\\'"])							# None of these
+		|(\\[\\ntvbrfa'"])					# or a backslash followed by one of those
+		|(\\[0-7]{1,3})|(\\x\d+))*"/x		# or an octal or hex
+
+	IDENTIFIER:
+		/(?!(auto|break|case|char|const|continue|default|do|double|else|enum|extern|float|for|goto		# LOOKAHEAD FOR KEYWORDS
+			|if|int|long|register|return|signed|sizeof|short|static|struct|switch|typedef			# NONE OF THE KEYWORDS
+			|union|unsigned|void|volatile|while)[^a-zA-Z_])											# SHOULD FULLY MATCH!
+			(([a-zA-Z]\w*)|(_\w+))/x																# Check for valid identifier
+
+	ASSIGNMENT_OPERATOR:
+		'=' | '*=' | '/=' | '%=' | '+=' | '-=' | '<<=' | '>>=' | '&=' | '^=' | '|='
+
+	UNARY_OPERATOR:
+		'&' | '*' | '+' | '-' | '~' | '!'
+
+END_OF_C_GRAMMAR
+
+
+#===  FUNCTION  ================================================================
+#         NAME:  flatten_list
+#  DESCRIPTION:  Extracts values from a recursive list. Double whitespaces will
+#  				 be reduced
+# PARAMETER  1:  Array Reference
+#===============================================================================
+
+sub flatten_list {
+    ( my $tokens = join ' ', map { ref($_) ? flatten_list(@$_) : ($_) } @_ ) =~ s/\s+/ /g;
+    $tokens;
+}
+
+#===  FUNCTION  ================================================================
+#         NAME:  flatten_list_beautified
+#  DESCRIPTION:  Like flatten_list but inserts a newline after each semicolon
+# PARAMETER  1:  Array Reference
+#===============================================================================
+
+sub flatten_list_beautified {
+    ( my $tokens = join ' ', map { ref($_) ? flatten_list(@$_) : ($_) } @_ ) =~ s/\s+/ /g;
+    $tokens =~ s/;/;\n/g;
+	$tokens =~ s/^\s*/\t/mg;
+    $tokens;
+}
+
+#--------------------------------------------------------------------------#
+#  Parsing variables													   #
+#--------------------------------------------------------------------------#
+
+my $decommentParser;          # Parser using decomment grammar
+my $Cparser;                  # Parser using C grammar
+my $C_source;                 # C source code
+my $decommented_C_source;     # C source code without comments
+my $preprocessed_C_source;    # C source code without preprocessor directives
+    # preprocessor directives are just removed, not evalued
+
+#--------------------------------------------------------------------------#
+#  Command line options													   #
+#--------------------------------------------------------------------------#
+
+our $opt_HELP         = '';
+our $opt_SKIPPEDLINES = '';
+our $opt_ERRORS       = '';
+our $opt_TRACE        = '';
+our $opt_CODE         = '';
+our $opt_VERBOSE      = 0;
+our $opt_PRECOMPILE   = '';
+
+our $opt_FUNCTIONS    = '';
+our $opt_DECLARATIONS = '';
+our $opt_STRUCTS      = '';
+
+Getopt::Long::Configure("bundling");    # Enables option bundling
+
+GetOptions(                             # Parse command line options
+    'help|h'         => \$opt_HELP,            # --help -h
+    'skippedlines|s' => \$opt_SKIPPEDLINES,    # --skippedlines -s
+    'errors|e'       => \$opt_ERRORS,          # --errors -e
+    'trace|t'        => \$opt_TRACE,           # --trace -t
+    'code|c'         => \$opt_CODE,            # --code -c
+    'verbose|v+'     => \$opt_VERBOSE,         # --verbose -v
+    'functions|f'    => \$opt_FUNCTIONS,       # --functions -f
+    'declarations|d' => \$opt_DECLARATIONS,    # --declarations -d
+    'precompile|p'   => \$opt_PRECOMPILE,      # --precompile -p
+    'structs|u'	     =>	\$opt_STRUCTS	       # --structs -u
+);
+
+# variables for parser output
+our $functions_output    = '';
+our $declarations_output = '';
+our $structs_output 	 = '';
+
+$opt_HELP and pod2usage( -verbose => 2 );
+
+# Set error reporting
+if ($opt_ERRORS) {
+    $::RD_HINT   = 1;                          # Print hints on errors
+    $::RD_ERRORS = 1;                          # Print errors
+    open( Parse::RecDescent::ERROR, ">errfile" )
+      or die "Can't open errfile: $!";
+}
+# Die if no input files present
+@ARGV or pod2usage( -message => "Error: More arguments required.", -verbose => 0 );
+
+{
+    local $/;
+    $C_source = <>;
+}
+
+# Set trace level
+if ( $opt_TRACE || ( $opt_VERBOSE >= 3 ) ) {
+    $::RD_TRACE = 1;
+}
+
+# Generate precompiled parser modules
+if($opt_PRECOMPILE) {
+	print("\nCreating precompiled parsers...  \n");
+	Parse::RecDescent->Precompile( $decomment_grammar,"CSourceParser::DecommentGrammar" );
+	Parse::RecDescent->Precompile( $Cgrammar, "CSourceParser::Cgrammar" );
+	print("Done\n\n");
+}
+
+
+#--------------------------------------------------------------------------#
+#  Parse Level 1 (removes comments)										   #
+#--------------------------------------------------------------------------#
+
+if ( -e "DecommentGrammar.pm" ) {
+    require DecommentGrammar;
+    $decommentParser = new CSourceParser::DecommentGrammar
+      or die "Malformed Decomment grammar!\n";
+}
+else {
+    $decommentParser = new Parse::RecDescent($decomment_grammar)
+      or die "Malformed Decomment grammar!\n";
+}
+
+defined( $decommented_C_source = $decommentParser->program($C_source) )
+  or die "Malformed C code found at parse level 1!\n";
+
+#--------------------------------------------------------------------------#
+#  Parse Level 2 (Removes preprocessor directives)						   #
+#--------------------------------------------------------------------------#
+
+open( PREPROCESS, "<", \$decommented_C_source )    # open string as filehandle
+  or die "Can't open input string for parse level 2: $!";
+$preprocessed_C_source = "";
+my $skip_line = 0;
+
+foreach (<PREPROCESS>) {
+
+    # Match preprocessor directives ...
+    if (
+        m{\s*																				# Optional whitespace
+		\#																					# Preprocessor opener
+		\s*																					# Optional whitespace
+		(?:(define|include|undef|ifdef|ifndef|if|endif|else|elif|line|error|pragma)\s)	 	# Keyword followed by one or more whitespace
+		.*																					# anything (optinal)
+		}x || $skip_line
+      )
+    {
+        $skip_line = /.*\\[\n]/;    # Ignore this line AND NEXT LINE ALSO
+        $preprocessed_C_source .= " ";    # if this line ends with backslash
+    }
+    else {
+        $preprocessed_C_source .= $_;     # OK, parse this line
+    }
+}
+
+if ( $opt_CODE || ( $opt_VERBOSE >= 1 ) ) {  # print sourcecode with linenumbers
+    my $i = 1;
+    foreach ( split( /\n/, $preprocessed_C_source ) ) {
+        print "$i\t$_\n";
+        $i++;
+    }
+}
+
+if ( $opt_VERBOSE >= 2 ) {
+    $::RD_TRACE = 1;
+}
+
+#--------------------------------------------------------------------------#
+#  Parse Level 3 (parses C code)										   #
+#--------------------------------------------------------------------------#
+
+$::RD_AUTOACTION =
+  q {  [ @item[1..$#item] ] };    # set default auto-action for grammar rules
+
+if ( -e "CGrammar.pm" ) {
+    require CGrammar;
+    $Cparser = new CSourceParser::CGrammar or die "Malformed C grammar!\n";
+}
+else {
+    $Cparser = new Parse::RecDescent($Cgrammar) or die "Malformed C grammar!\n";
+}
+
+defined( $Cparser->translation_unit($preprocessed_C_source) )
+  or die "Malformed C code found at parse level 3!\n";
+
+print "\nDefined Functions:\n\n$functions_output\n\n"
+  if defined $functions_output
+  and $opt_FUNCTIONS;
+print "\nDeclarations:\n\n$declarations_output\n\n"
+  if defined $declarations_output
+  and $opt_DECLARATIONS;
+print "\nStructures:\n\n$structs_output\n\n"
+  if defined $structs_output
+  and $opt_STRUCTS;
+
+__END__
+
+
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+#  Application Documentation
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+=head1 NAME
+
+csourceparser.pl - extract components from sourcecode written in the C programming language
+
+
+=head1 VERSION
+
+This documentation refers to csourceparser.pl version 0.1.0
+
+
+=head1 SYNOPSIS
+
+B<./csourceparser.pl  [OPTION]  ...   FILE ...>
+
+B<Examples:>
+
+Print signatures of functions defined in a C-file:
+
+./csourceparser.pl -f myprog.c
+
+Print all declarations in a C-file:
+
+./csourceparser.pl -d myprog.c
+
+Print all structures in a C-file:
+
+./csourceparser.pl -u myheader.h
+
+=head1 REQUIRED ARGUMENTS
+
+One or more C-Sourcefiles to parse.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-c, --code>
+
+Show parsed source code with line numbers
+
+=item B<-d, --declarations>
+
+Prints (global) declarations in the sourcefile to stdout
+
+=item B<-e, --errors>
+
+Print error messages generated by Parse::RecDescent to the file
+'errfile'
+
+=item B<-f, --functions>
+
+Prints the signatures of functions defined in the source file to
+stdout (the function bodys are ommited)
+
+=item B<-h, --help>
+
+Print this help
+
+=item B<-p, --precompile>
+
+Generate precompiled parsers Cgrammar.pm and DecommentGrammar.pm in
+the current working directory. Precompiled parsers will speed up
+parsing.  If these files are available in the current working
+directory they will be used automatically. Every time the --precompile
+option is set the precompiled parsers are generateted newly so this
+option should only be used only once.  Also, don't forget to recreate
+the precompiled parseres if you modify the grammar.
+
+=item B<-s, --skippedlines>
+
+Show which lines had been skipped during parse due to parser errors or
+unrecognized tokens in the C source code
+
+=item B<-t, --trace>
+
+Print full tracecode generated by Parse::RecDescent. Note: this can be B<a lot>
+
+=item B<-u, --structs>
+
+Print all structs and unions defined in the C sourcefile
+
+=item B<-v, --verbose>
+
+Each use encreases verbosity level by one.
+
+=over 4
+
+=item Level 1:
+
+Print parsed sourcecode and skipped lines (same as I<-sc>)
+
+=item Level 2:
+
+Print tracecode of parse level 3 (C code without preprocessor
+directives and comments)
+
+=item Level 3:
+
+Print full tracecode.
+
+=back
+
+=back
+
+=head1 DIAGNOSTICS
+
+If you don't get the output you expect try to set the -sc options to
+see what happens.  When the parser can't handle the input it will
+silently get skipped (for empty lines this is a normal behaviour).
+
+If the parser doesn't behave as you expect take a look at the tracecode,
+e.g., './csourceparser -t file.c 2> trace' for full tracecode or
+'./csourceparser -vv file.c 2> trace' to see only parser level 3
+(C-parser) trace code. Depending on the size of the input file(s) this
+could take some time and may occupy some hd-space.
+
+Please refer to the Parse::RecDescent documentation if you get errors
+after modifying the grammar.
+
+=head1 DEPENDENCIES
+
+=over 4
+
+=item *
+
+Perl >= v5.00800
+
+=item *
+
+Parse::RecDescent
+
+=item *
+
+Getopt::Long
+
+=item *
+
+Pod::Usage
+
+=head1 BUGS AND LIMITATIONS
+
+Macros in C-Files could not be parsed at this time. Any declarations
+and definitions containing macros my cause errors.  Perhaps this
+feature could be implemented in the future by using a "real"
+preprocessor like m4.
+
+Please report problems to Hendrik Sirges (hendrik.sirges at fh-swf.de)
+Patches are welcome.
+
+=head1 AUTHOR
+
+ Hendrik Sirges  <hendrik.sirges[at]fh-swf.de>
+
+=head1 LICENCE AND COPYRIGHT
+
+This program is Copyright 2005 by Hendrik Sirges.  This program is
+free software; you can redistribute it and/or modify it under the
+terms of the Perl Artistic License or the GNU General Public License
+as published by the Free Software Foundation; either version 2 of the
+License, or (at your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+If you do not have a copy of the GNU General Public License write to
+the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
+USA.
+
+=cut

misc/d-bindings/Parse-RecDescent-master-demo/demo_arithmetic.pl

@@ -0,0 +1,47 @@
+#! /usr/local/bin/perl -sw
+
+# RPN ARITHMETIC EXPRESSIONS
+
+use Parse::RecDescent;
+
+sub Parse::RecDescent::rpn
+{
+	my @list = @_;
+	for (my $i=1; $i<@list; $i+=2)
+	{
+		@list[$i,$i+1] = @list[$i+1,$i];
+	}
+	join " ", @list;
+}
+
+# $RD_TRACE=1;
+
+$grammar =
+q{
+	expr	:	<leftop: conj /(\|\|)/ conj>
+				{ rpn(@{$item[1]}) }
+
+	conj	:	<leftop: addn /(&&)/ addn>
+				{ rpn(@{$item[1]}) }
+
+	addn	:	<leftop: mult /([+-])/ mult >
+				{ rpn(@{$item[1]}) }
+
+	mult	:	<leftop: expo /([*\/\%])/ expo >
+				{ rpn(@{$item[1]}) }
+
+	expo	:	<leftop: unary /(\^|\*\*)/ unary >
+				{ rpn(@{$item[1]}) }
+
+	unary	:	'(' expr ')'	{ $item[2] }
+		|	value
+
+	value	:	/\d+(\.\d+)?/
+};
+
+$parse = new Parse::RecDescent ($grammar) or die "bad grammar";
+
+while (<>)
+{
+	print $parse->expr($_), "\n" if $_;
+}

misc/d-bindings/Parse-RecDescent-master-demo/demo_autorule.pl

@@ -0,0 +1,21 @@
+#! /usr/local/bin/perl -ws
+
+# use strict;
+
+use Parse::RecDescent;
+
+print 1 if Parse::RecDescent->new(<<'EOGRAMMAR')->file(join "", <DATA>);
+
+	<autorule: /\w+/ { print "Found $item[-1]\n" } >
+
+	file: 	defn(s)
+
+	defn:	'def' ident ':' block
+
+	block:	'{' item(s) '}'
+
+EOGRAMMAR
+
+__DATA__
+
+def ident : { item item item }

misc/d-bindings/Parse-RecDescent-master-demo/demo_autoscoresep.pl

@@ -0,0 +1,32 @@
+#! /usr/local/bin/perl -ws
+
+use Parse::RecDescent;
+
+$RD_WARN = undef;
+$RD_TRACE=1;
+
+my $parse = Parse::RecDescent->new(<<'EOGRAMMAR');
+
+line: <autoscore: @{$item[1]}>
+line: seplist[sep=>',']
+    | seplist[sep=>':']
+    | seplist[sep=>" "]
+
+seplist: <skip:""> <leftop: /[^$arg{sep}]*/ "$arg{sep}" /[^$arg{sep}]*/>
+
+EOGRAMMAR
+
+while (<DATA>)
+{
+    chomp;
+    my $res = $parse->line($_);
+    print '[', join('][', @$res), "]\n";
+}
+
+__DATA__
+c,o,m,m,a,s,e,p,a,r,a,t,e,d
+c:o:l:o:n:s:e:p:a:r:a:t:e:d
+s p a c e s e p a r a t e d
+m u:l t i,s:ep ar:a,ted
+m u:l,t i,s:ep ar:a,ted
+m:u:l,t i,s:ep ar:a,ted

misc/d-bindings/Parse-RecDescent-master-demo/demo_autostub.pl

@@ -0,0 +1,22 @@
+#! /usr/local/bin/perl -ws
+
+# use strict;
+
+use Parse::RecDescent;
+
+
+print 1 if Parse::RecDescent->new(<<'EOGRAMMAR')->file(join "", <DATA>);
+
+<autostub>
+
+	file: 	defn(s)
+
+	defn:	'def' ident ':' block
+
+	block:	'{' item(s) '}'
+
+EOGRAMMAR
+
+__DATA__
+
+def ident : { item item item }

misc/d-bindings/Parse-RecDescent-master-demo/demo_bad.pl

@@ -0,0 +1,51 @@
+#!/usr/bin/env perl
+
+use v5.10;
+use warnings;
+
+
+# SHOWCASE VARIOUS ERROR MESSAGES WITH A VERY UNWELL GRAMMAR
+
+use Parse::RecDescent;
+
+open (Parse::RecDescent::ERROR, ">-") or die;
+
+$grammar =
+q{
+    <warn:3>
+
+	typedef : a ... ...! ... b
+	typedef : a ...!...!...!...! b
+		| /type/ ident /has/ field(s) /end type/
+			{ $result = $item[2]; }
+		| /type/ ident /is/ ident
+			{ $result = $item[2]; }
+		| quasit(s)
+		| quasit(-1..3)
+		| quasit(..0)
+		| field(?) field end
+		| <error> quasit "here" ...!/why/
+
+	Extend: extend
+
+	Replace: replace
+		$%^@#
+
+	field   : /field/ ident /is/ ident
+		| field quasit
+		| !quasit(s?)
+		!| #NOTHING
+
+
+	typedef : whatever
+
+	package somewhereelse
+
+	!ident   : /[A-Za-z]\w*???/
+			{ $result = $item[1]; }
+
+	quasit  : field
+		| typedef
+ };
+
+new Parse::RecDescent ($grammar) || die "Bad grammar! No biscuit!\n";

misc/d-bindings/Parse-RecDescent-master-demo/demo_buildcalc.pl

@@ -0,0 +1,57 @@
+#! /usr/local/bin/perl -ws
+
+use Parse::RecDescent;
+
+$RD_AUTOACTION = q{ $item[-1]; # JUST TO SHOW THEY WORK WITH PRECOMPILED PARSERS
+};
+
+Parse::RecDescent->Precompile(<<'EndGrammar', "Calc", $0 );
+
+	{ use Coy; }
+	{ my $lexical_var = 1; }
+
+	mult_op: '*'	{ sub { $_[0] *= $_[1] } }
+	       | '/'	{ sub { $_[0] /= $_[1] } }
+
+	main: expr /\s*\Z/ { $lexical_var++ } { $item[1]->() }
+	    | <error>
+
+	expr: /for(each)?/ lvar range expr
+			{ my ($vname,$expr) = @item[2,4];
+			  my ($from, $to) = @{$item[3]};
+			  sub { my $val;
+				no strict "refs";
+				for $$vname ($from->()..$to->())
+					{ $val = $expr->() }
+				return $val;
+			      }
+			}
+	    | lvar '=' addition
+			{ my ($vname, $expr) = @item[1,3];
+			  sub { no strict 'refs'; $$vname = $expr->() }
+			}
+	    | addition
+
+	range: "(" expr ".." expr ")"
+			{ [ @item[2,4] ] }
+
+	addition: <leftop:multiplication add_op multiplication>
+			{ my $add = $item[1]; sub { ::evalop($add) } }
+
+	add_op: '+'	{ sub { $_[0] += $_[1] } }
+	      | '-'	{ sub { $_[0] -= $_[1] } }
+
+	multiplication: <leftop:factor mult_op factor>
+			{ my $mult = $item[1]; sub { ::evalop($mult) } }
+
+	factor: number
+	      | rvar
+	      | '(' expr ')' { $item[2] }
+
+	number: /[-+]?\d+(\.\d+)?/	{ sub { $item[1] } }
+
+	lvar:	/\$([a-z]\w*)/		{ $1 }
+
+	rvar:	lvar			{ sub { no strict 'refs'; ${$item[1]} } }
+
+EndGrammar

misc/d-bindings/Parse-RecDescent-master-demo/demo_calc.pl

@@ -0,0 +1,85 @@
+#!/usr/bin/env perl
+
+use v5.10;
+use warnings;
+
+
+use Parse::RecDescent;
+
+sub evalop
+{
+    my (@list) = @{$_[0]};
+    my $val = shift(@list)->();
+    while (@list)
+    {
+        my ($op, $arg2) = splice @list, 0, 2;
+        $op->($val,$arg2->());
+    }
+    return $val;
+}
+
+my $parse = Parse::RecDescent->new(<<'EndGrammar');
+
+    <trace_parse>
+
+    main: expr /\s*\Z/ { $item[1]->() }
+        | <error>
+
+    expr: /for(each)?/ lvar range expr
+            { my ($vname,$expr) = @item[2,4];
+              my ($from, $to) = @{$item[3]};
+              sub { my $val;
+                no strict "refs";
+                for $$vname ($from->()..$to->())
+                    { $val = $expr->() }
+                return $val;
+                  }
+            }
+        | lvar '=' addition
+            { my ($vname, $expr) = @item[1,3];
+              sub { no strict 'refs'; $$vname = $expr->() }
+            }
+        | addition
+
+    range: "(" expr ".." expr ")"
+            { [ @item[2,4] ] }
+
+    addition: <leftop:multiplication add_op multiplication>
+            { my $add = $item[1]; sub { ::evalop $add } }
+
+    add_op: '+' { sub { $_[0] += $_[1] } }
+          | '-' { sub { $_[0] -= $_[1] } }
+
+    multiplication: <leftop:factor mult_op factor>
+            { my $mult = $item[1]; sub { ::evalop $mult } }
+
+    mult_op: '*'    { sub { $_[0] *= $_[1] } }
+           | '/'    { sub { $_[0] /= $_[1] } }
+
+    factor: number
+          | rvar
+          | '(' expr ')' { $item[2] }
+
+    number: /[-+]?\d+(\.\d+)?/  { sub { $item[1] } }
+
+    lvar:   /\$([a-z]\w*)/      { $1 }
+
+    rvar:   lvar            { sub { no strict 'refs'; ${$item[1]} } }
+
+EndGrammar
+
+print "> ";
+while (<DATA>) {    # FOR DEMO CHANGE TO: while (<DATA>)
+  print $parse->main($_), "\n\n> ";
+}
+
+__DATA__
+$x = 2
+$y = 3
++1-1+1-1+1-1+1-1+1
+7*7-6*8
+121/(121/11)/121*11
+1/(10-1/(1/(10-1)))
+$x * $y
+foreach $i (1..$y) $x = $x * 2 + $i
+$x

misc/d-bindings/Parse-RecDescent-master-demo/demo_codeblock.pl

@@ -0,0 +1,22 @@
+#! /usr/bin/perl -w
+
+use Parse::RecDescent;
+
+$RD_TRACE=1;
+my $parse = Parse::RecDescent->new(do{local$/;<DATA>});
+
+
+while (<DATA>) {
+	use Data::Dumper 'Dumper';
+	print Dumper [
+		$parse->line($_)
+	];
+}
+
+__DATA__
+
+line: block | call*
+
+block: <perl_codeblock>
+
+call: "foo" <perl_codeblock ()>

misc/d-bindings/Parse-RecDescent-master-demo/demo_cpp.pl

@@ -0,0 +1,69 @@
+#! /usr/local/bin/perl -sw
+
+# RECURSIVE #includes DURING A RECURSIVE DESCENT
+
+use Parse::RecDescent;
+
+sub loadfile($)
+{
+	open FILE, $_[0]  or die "Couldn't find included file: $_[0]\n";
+	my $contents = <FILE>;
+	close FILE;
+	return $contents;
+}
+
+%macro = ();
+
+sub demacro($)
+{
+	my $text = shift;
+	while (($macro,$defn) = each %macro )
+	{
+		$text =~ s/$macro/$defn/;
+	}
+	return $text;
+}
+
+$grammar =
+q{
+	file     : line(s)
+
+	line	 : include
+		 | macrodef
+		 | linedir
+			{ $thisline = $item[1]; }
+		 | codeline
+			{ print "found: [$item[1]] at $thisline\n" }
+
+	include	 : '#include' filename
+			{
+			  print "pre: [$text] at $thisline\n";
+			  $text = ::loadfile($item[-1]) . $text;
+			  Parse::RecDescent::LineCounter::resync $thisline;
+			  print "post: [$text] at $thisline\n";
+			}
+
+	filename : '"' m#[a-z0-9_./-]+#i '"'
+			{ $return = $item[-2] }
+		 | '<' m#[a-z0-9_./-]+#i '>'
+			{ $return = $item[-2] }
+
+	macrodef : '#define' /[a-z]\w*/i /.*/
+			{ $::macro{$item[-2]} = $item[-1] }
+
+	linedir:   '#line' /\d+/
+
+	codeline : /.*\n/
+			{ $return = ::demacro($item[-1]); }
+
+};
+
+$parse = new Parse::RecDescent ($grammar);
+
+undef $/;
+
+$reinput = $input = <>;
+
+$parse->file($input) or die "Bad file! No biscuit!\n";
+
+$parse->file($reinput) or die "Bad file! No biscuit!\n";

misc/d-bindings/Parse-RecDescent-master-demo/demo_decomment.pl

@@ -0,0 +1,120 @@
+#!/usr/local/bin/perl -ws
+
+# $::RD_TRACE = 1;
+
+# REMOVE COMMENTS FROM C++ CODE
+
+# ORIGINAL BY Helmut Jarausch
+# EXTENDED BY Damian Conway AND Helmut Jarausch AND Jeremy Braun
+
+use strict;
+use Parse::RecDescent;
+
+use vars qw/ $Grammar /;
+
+my $parser = new Parse::RecDescent $Grammar  or  die "invalid grammar";
+
+undef $/;
+my $text = @ARGV ? <> : <DATA>;
+
+my $parts = $parser->program($text) or die "malformed C program";
+
+print "Comments\n========\n$parts->{comments}\n";
+print "\nCode\n====\n$parts->{code}\n";
+print "\nStrings\n=======\n", map(qq{\t"$_"\n}, @{$parts->{strings}});
+
+BEGIN
+{ $Grammar=<<'EOF';
+
+program : <rulevar: local $WithinComment=0>
+program : <rulevar: local $Comments = ""> /this shouldn't be here :-/
+program : <reject>
+program : <reject> /with prejudice/
+program : <rulevar: local $Code = "">
+program : <rulevar: local @Strings>
+
+program	: <skip:''> part(s)
+		{ { code=>$Code, comments=>$Comments, strings=>[@Strings]} }
+
+part	: comment
+        | C_code
+        | string
+        | charlit
+
+C_code  : m{(
+	      [^"/]+		# one or more non-delimiters
+	      (			# then (optionally)...
+	       /		# a potential comment delimiter
+	       [^*/]		# which is not an actual delimiter
+	      )?		#
+	    )+			# all repeated once or more
+	   }x
+		{ $Code .= $item[1] }
+
+string	: m{"			# a leading delimiter
+	    ((			# zero or more...
+	      \\.		# escaped anything
+	      |			# or
+	      [^"]		# anything but a delimiter
+	     )*
+	    )
+	    "}x
+		{ $Code .= $item[1]; push @Strings, $1 }
+
+charlit	: m{'			# a leading delimiter
+	    ((			# zero or more...
+	      \\.		# escaped anything
+	      |			# or
+	      [^']		# anything but a delimiter
+	     )*
+	    )
+	    '}x
+		{ $Code .= $item[1]; push @Strings, $1 }
+
+
+comment	: m{\s*			# optional whitespace
+	    //			# comment delimiter
+	    [^\n]*		# anything except a newline
+	    \n			# then a newline
+	   }x
+		{ $Code .= "\n"; $Comments .= $item[1] }
+
+	| m{\s*			# optional whitespace
+	    /\*			# comment opener
+	    (?:[^*]+|\*(?!/))*	# anything except */
+	    \*/		        # comment closer
+            ([ \t]*)?           # trailing blanks or tabs
+	   }x
+		{ $Code .= " "; $Comments .= $item[1] }
+
+EOF
+}
+__DATA__
+program test; // for decomment
+
+// using Parse::RecDescent
+
+int main()
+{
+/* this should
+   be removed
+*/
+  char *cp1 = "";
+  char *cp2 = "cp2";
+  char c3   = 'c';
+  int i;  // a counter
+          // remove this line altogehter
+  int k;
+      int more_indented;  // keep indentation
+      int l;  /* a loop
+             variable */
+      // should be completely removed
+
+  char *str = "/* ceci n'est pas un commentaire */";
+  return 0;
+}
+
+
+
+
+

misc/d-bindings/Parse-RecDescent-master-demo/demo_decomment_nonlocal.pl

@@ -0,0 +1,110 @@
+#!/usr/local/bin/perl -ws
+
+# REMOVE COMMENTS FROM C++ CODE
+
+# ORIGINAL BY Helmut Jarausch
+# EXTENDED BY Damian Conway AND Helmut Jarausch AND Jeremy Braun
+
+use strict;
+use Parse::RecDescent;
+
+use vars qw/ $Grammar /;
+
+my $parser = new Parse::RecDescent $Grammar  or  die "invalid grammar";
+
+undef $/;
+my $text = @ARGV ? <> : <DATA>;
+
+$parser->program($text) or die "malformed C program";
+
+print "Comments\n========\n$parser->{comments}\n";
+print "\nCode\n====\n$parser->{code}\n";
+print "\nStrings\n=======\n", map(qq{\t"$_"\n}, @{$parser->{strings}});
+
+BEGIN
+{ $Grammar=<<'EOF';
+
+program	: <skip:''> { @{$thisparser}{qw(comments code strings)} = () }
+	  part(s)
+
+part	: comment { $thisparser->{comments} .= $item[1];
+        	    $thisparser->{code}     .= " "; }
+        | C_code  { $thisparser->{code}     .= $item[1]; }
+        | string  { $thisparser->{code}     .= qq("$item[1]");
+		    push @{$thisparser->{strings}}, $item[1]; }
+        | charlit  { $thisparser->{code}     .= qq('$item[1]');
+		    push @{$thisparser->{strings}}, $item[1]; }
+
+C_code  : m{(
+	      [^"/]+		# one or more non-delimiters
+	      (			# then (optionally)...
+	       /		# a potential comment delimiter
+	       [^*/]		# which is not an actual delimiter
+	      )?		#
+	    )+			# all repeated once or more
+	   }x
+
+string	: m{"			# a leading delimiter
+	    ((			# zero or more...
+	      \\.		# escaped anything
+	      |			# or
+	      [^"]		# anything but a delimiter
+	     )*
+	    )
+	    "}x
+		{ $return =  $1 }
+
+charlit	: m{'			# a leading delimiter
+	    ((			# zero or more...
+	      \\.		# escaped anything
+	      |			# or
+	      [^']		# anything but a delimiter
+	     )*
+	    )
+	    '}x
+		{ $return =  $1 }
+
+comment	: m{\s*			# optional whitespace
+	    //			# comment delimiter
+	    [^\n]*		# anything except a newline
+	    \n			# then a newline
+	   }x
+
+	| m{\s*			# optional whitespace
+	    /\*			# comment opener
+	    (?:[^*]+|\*(?!/))*	# anything except */
+	    \*/		        # comment closer
+            ([ \t]*)?           # trailing blanks or tabs
+	   }x
+
+EOF
+}
+__DATA__
+program test; // for decomment
+
+// using Parse::RecDescent
+
+int main()
+{
+/* this should
+   be removed
+*/
+  char *cp1 = "";
+  char *cp2 = "cp2";
+  char c3   = 'c';
+  int i;  // a counter
+          // remove this line altogehter
+  int k;
+      int more_indented;  // keep indentation
+      int l;  /* a loop
+             variable */
+      // should be completely removed
+
+  char *str = "/* ceci n'est pas un commentaire */";
+  return 0;
+}
+
+
+
+
+

misc/d-bindings/Parse-RecDescent-master-demo/demo_delete.pl

@@ -0,0 +1,55 @@
+#! /usr/local/bin/perl -sw
+
+# DELETABLE PRODUCTIONS
+
+use Parse::RecDescent;
+
+$grammar =
+q{
+	commands :	command(s)
+
+	command  :	directive
+		 |	evaluation
+
+	directive:	'only prefix'
+			    { $thisparser->{deleted} = {infix=>1,postfix=>1} }
+		 |	'not prefix'
+			    { $thisparser->{deleted}{prefix} = 1 }
+
+	evaluation:	<reject: $thisparser->{deleted}{prefix}> op var var
+				{ print "prefix $item[3] $item[2] $item[4]\n" }
+
+	          |	<reject: $thisparser->{deleted}{infix}> var op var
+				{ print "infix $item[2] $item[3] $item[4]\n" }
+
+	          |	<reject: $thisparser->{deleted}{postfix}> var var op
+				{ print "postfix $item[2] $item[4] $item[3]\n" }
+
+	op        :	'+' | '-'
+
+	var	  :	/(?!\d)\w+/
+};
+
+$parse = new Parse::RecDescent ($grammar);
+
+while (<DATA>)
+{
+	$parse->commands($_);
+}
+
+__DATA__
+a + b
++ a b
+a b +
+not prefix
+a + b
++ a b
+a b +
+only prefix
+a + b
++ a b
+a b +
+not prefix
+a + b
++ a b
+a b +

misc/d-bindings/Parse-RecDescent-master-demo/demo_derived.pl

@@ -0,0 +1,47 @@
+#! /usr/local/bin/perl -sw
+
+# THE OL' "EMPTY SUBCLASS IN THE DEMO" TRICK.
+
+use Parse::RecDescent;
+
+sub Parse::RecDescent::f
+{
+	print "Parse::RecDescent::f\n";
+}
+
+@DerParser::ISA = qw { Parse::RecDescent };
+
+$grammar =
+q{
+	typedef : /type/ ident /has/ <commit> field(s) 'end type'
+			{ $return = $item[2]; }
+		| /type/ ident ( /is/ | /are/ ) ident
+			{ $return = $item[2]; }
+		| <error>
+
+	field   : /field/ ident /is/ ident
+
+	ident   : /[A-Za-z]\w*/
+			{ f(); $return = $item[1]; }
+ };
+
+$parse = new DerParser ( $grammar ) || die "\n";
+
+$str = "
+type student has
+	field name is text
+	field age
+end type
+";
+
+print "> ", $parse->typedef($str) || "<failed (as expected)>", "\n";
+
+
+$str = " type student has end type ";
+
+print "> ", $parse->typedef($str) || "<failed (as expected)>", "\n";
+
+
+$str = " type studentRec is student ";
+
+print "> ", $parse->typedef($str) || "<failed (unexpectedly!)>", "\n";

misc/d-bindings/Parse-RecDescent-master-demo/demo_dot.pl

@@ -0,0 +1,112 @@
+#! /usr/bin/perl
+use Parse::RecDescent;
+my $DOTSRC="/var/src/gv1.5";
+
+my $graph = "$DOTSRC/graphs";
+
+# $::RD_HINT=1;
+# $::RD_AUTOSTUB=1;
+# $::RD_TRACE=1;
+
+#  'strict'(?) pas accepté
+$gram = <<'EOF';
+
+graph:        comment(?) strict(?)  ( 'digraph' | 'graph' ) id  '{' stmt_list '}'
+attr_stmt:    m/(graph|node|edge)\s+/ attrs(?)
+subgraph:     ( 'subgraph' id  )(?)  '{' stmt_list '}' | 'subgraph' id
+stmt_list:    ( stmt semi(?) )(s?)
+stmt:         id '=' id | attr_stmt |  edge_stmt | subgraph | node_stmt | comment
+node_stmt:    node_id  attrs(?)
+node_id:      id ( ':' id )(?)
+attrs:        '[' ( id '=' value comma(?) )(s) ']'
+value:        id | CONSTANT
+edge_stmt:    ( node_id | subgraph ) edgeRHS(s)  attrs(?)
+edgeRHS:      edgeop ( node_id | subgraph )
+edgeop:       m|-[>-]|
+keyword:      m/(subgraph|graph|node|edge)\s+/
+id:          ...!keyword /([\w\d][\w\d-]*)/ | STRING_LITERAL
+STRING_LITERAL:	{ extract_delimited($text,'"') }
+CONSTANT:	/[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?/
+strict:       'strict'
+semi:         ';'
+comma:        ','
+comment	: m{\s*			# optional whitespace
+	    //			# comment delimiter
+	    [^\n]*		# anything except a newline
+	    \n			# then a newline
+	   }x
+
+	| m{\s*			# optional whitespace
+	    /\*			# comment opener
+	    (?:[^*]+|\*(?!/))*	# anything except */
+	    \*/		        # comment closer
+            ([ \t]*)?           # trailing blanks or tabs
+	   }x
+
+
+
+EOF
+
+$parser = new Parse::RecDescent($gram);
+
+ $_='hashtable.dot';
+ for ( <$graph/directed/*.dot>, <$graph/undirected/*.dot> ) {
+  undef $/;
+  open F, $_;
+  $txt =   <F>;
+  $ok = $parser->graph($txt);
+  print $ok ? '': "not ", "OK $_\n";
+}
+
+__END__
+
+here is the score so far:
+
+
+OK /var/src/gv1.5/graphs/directed/KW91.dot
+OK /var/src/gv1.5/graphs/directed/NaN.dot
+OK /var/src/gv1.5/graphs/directed/abstract.dot
+OK /var/src/gv1.5/graphs/directed/alf.dot
+OK /var/src/gv1.5/graphs/directed/awilliams.dot
+OK /var/src/gv1.5/graphs/directed/clust.dot
+OK /var/src/gv1.5/graphs/directed/clust1.dot
+OK /var/src/gv1.5/graphs/directed/clust2.dot
+OK /var/src/gv1.5/graphs/directed/clust3.dot
+OK /var/src/gv1.5/graphs/directed/clust4.dot
+OK /var/src/gv1.5/graphs/directed/clust5.dot
+OK /var/src/gv1.5/graphs/directed/crazy.dot
+OK /var/src/gv1.5/graphs/directed/ctext.dot
+OK /var/src/gv1.5/graphs/directed/dfa.dot
+OK /var/src/gv1.5/graphs/directed/fig6.dot
+OK /var/src/gv1.5/graphs/directed/fsm.dot
+OK /var/src/gv1.5/graphs/directed/grammar.dot
+not OK /var/src/gv1.5/graphs/directed/hashtable.dot
+OK /var/src/gv1.5/graphs/directed/jcctree.dot
+OK /var/src/gv1.5/graphs/directed/jsort.dot
+OK /var/src/gv1.5/graphs/directed/ldbxtried.dot
+OK /var/src/gv1.5/graphs/directed/mike.dot
+OK /var/src/gv1.5/graphs/directed/newarrows.dot
+OK /var/src/gv1.5/graphs/directed/nhg.dot
+OK /var/src/gv1.5/graphs/directed/pgram.dot
+not OK /var/src/gv1.5/graphs/directed/pm2way.dot
+not OK /var/src/gv1.5/graphs/directed/pmpipe.dot
+not OK /var/src/gv1.5/graphs/directed/polypoly.dot
+not OK /var/src/gv1.5/graphs/directed/proc3d.dot
+OK /var/src/gv1.5/graphs/directed/records.dot
+OK /var/src/gv1.5/graphs/directed/rowe.dot
+OK /var/src/gv1.5/graphs/directed/shells.dot
+OK /var/src/gv1.5/graphs/directed/states.dot
+OK /var/src/gv1.5/graphs/directed/structs.dot
+OK /var/src/gv1.5/graphs/directed/train11.dot
+OK /var/src/gv1.5/graphs/directed/trapeziumlr.dot
+OK /var/src/gv1.5/graphs/directed/tree.dot
+not OK /var/src/gv1.5/graphs/directed/triedds.dot
+OK /var/src/gv1.5/graphs/directed/try.dot
+OK /var/src/gv1.5/graphs/directed/unix.dot
+OK /var/src/gv1.5/graphs/directed/unix2.dot
+OK /var/src/gv1.5/graphs/directed/viewfile.dot
+OK /var/src/gv1.5/graphs/directed/world.dot
+not OK /var/src/gv1.5/graphs/undirected/ER.dot
+OK /var/src/gv1.5/graphs/undirected/ngk10_4.dot
+OK /var/src/gv1.5/graphs/undirected/process.dot
+

misc/d-bindings/Parse-RecDescent-master-demo/demo_embedding.pl

@@ -0,0 +1,61 @@
+#! /usr/local/bin/perl -w
+
+use Parse::RecDescent;
+
+#$RD_TRACE=1;
+
+my $parser = Parse::RecDescent->new(<<'EOGRAMMAR');
+
+	file: 		<skip:''> item(s)
+
+	item: 		directive
+	    | 		text
+
+	directive: 	'<%' <skip:'\\s*'> command arg(s?) m|/?%>|
+				{ $return = bless \%item, 'directive' }
+
+	command: 	m|/?[a-z]\w*|i
+
+	arg:		argname '=' string
+				{ $return = \%item }
+	   |		string
+				{ $return = \%item }
+	   |		data
+				{ $return = \%item }
+
+	argname:	/[a-z]\w*/i
+
+	string:		'"' /[^\\"]*(\\.[^\\"]*)*/ '"'
+				{ $return = $item[2] }
+
+	data:		m|((?!/?%>)\S)+|
+
+
+	text: 		/((?!<%).)+/s
+				{ $return = bless \$item[1], 'text' }
+
+EOGRAMMAR
+
+my $data = join '', <DATA>;
+
+my $info = $parser->file($data);
+
+use Data::Dumper;
+
+print Data::Dumper->Dump($info);
+
+__DATA__
+
+<% If expr %>
+the if worked
+<% Else %>
+it didn't work
+<% /If %>
+   >
+<% Include file="foo.txt" /%>
+   >
+<% Run Function="myFunc" Attr="x" ...%>
+<% Arg Name="row" %>
+<TR><TD>Name</TD><TD>{name}</TD></TR>
+<% /Arg %>
+<% /Run %>

misc/d-bindings/Parse-RecDescent-master-demo/demo_errors.pl

@@ -0,0 +1,56 @@
+#!/usr/bin/env perl
+
+use v5.10;
+use warnings;
+
+
+# THE ONLY TRUE MISTAKES ARE THE ONES YOU NEVER MAKE
+
+#BEGIN {
+#        close STDERR and open STDERR, '>./STDERR' or die $!;
+#}
+use Parse::RecDescent;
+
+$grammar =
+q{
+        Para:     Sentence(s) /\Z/
+
+        # Can also intercept the error messages like so: ##
+
+           |    { use Data::Dumper 'Dumper';
+                  print "$_->[0]\n" for @{$thisparser->{errors}};
+                  exit;
+                }
+
+        Sentence: Noun Verb
+                | Verb Noun
+                | <error>
+
+        Noun:     Fish
+            |     Cat
+            |     'dog'
+
+        Verb:     'runs'
+
+        Fish:     'fish'
+            |     <error:Expected a fish!  But didn't get one>
+
+        Cat:      'cat'
+            |     <error:I wanna cat!>
+};
+
+$parse = new Parse::RecDescent ($grammar);
+
+while (<DATA>)
+{
+        chomp;
+        print "$_...\n";
+    $parse->Para($_);
+}
+
+__DATA__
+rat runs
+dog runs
+cat purrs
+cat runs
+mouse squeaks

misc/d-bindings/Parse-RecDescent-master-demo/demo_eval.pl

@@ -0,0 +1,54 @@
+#! /usr/local/bin/perl -w
+
+use Parse::RecDescent;
+
+$text = "1 + 2 * 3 ** 4";
+
+$grammar = q{
+        <autotree>
+
+        expr	:	<leftop: conj /\|\|/ conj>
+
+        conj	:	<leftop: addn /&&/ addn>
+
+        addn	:	<leftop: mult /[+-]/ mult >
+
+        mult	:	<leftop: expo /[*\/\%]/ expo >
+
+        expo	:	<leftop: value /\^|\*\*/ value >
+
+        value	:	/\d+(\.\d+)?/
+};
+
+my $extract_tree = Parse::RecDescent->new($grammar);
+
+my $tree = $extract_tree->expr($text);
+
+use Data::Dumper 'Dumper';
+print Dumper $tree;
+
+print $tree->eval();
+
+package expr;
+use List::Util  'reduce';
+sub eval { reduce {$_[0] || $_[1]} map $_->eval(), @{$_[0]{__DIRECTIVE1__}} }
+
+package conj ;
+use List::Util  'reduce';
+sub eval { reduce {$_[0] && $_[1]} map $_->eval(), @{$_[0]{__DIRECTIVE1__}} }
+
+package addn ;
+use List::Util  'reduce';
+sub eval { reduce {$_[0] + $_[1]} map $_->eval(), @{$_[0]{__DIRECTIVE1__}} }
+
+package mult ;
+use List::Util  'reduce';
+sub eval { reduce {$_[0] * $_[1]} map $_->eval(), @{$_[0]{__DIRECTIVE1__}} }
+
+package expo ;
+use List::Util  'reduce';
+sub eval { reduce {$_[0] ** $_[1]} map $_->eval(), @{$_[0]{__DIRECTIVE1__}} }
+
+package value ;
+sub eval { return $_[0]{__VALUE__} }
+

misc/d-bindings/Parse-RecDescent-master-demo/demo_implicit.pl

@@ -0,0 +1,31 @@
+#! /usr/local/bin/perl -sw
+
+# IMPLICIT SUB RULES, OKAY!
+
+use strict;
+use Parse::RecDescent;
+
+my $grammar =
+q{
+	{ my $state = "happy"; }
+
+	testimony	: declaration(s)
+				{ print "Ended up $state\n"; }
+
+	declaration	: 'I' ('like'|'loathe')(s) ('ice-cream'|'lawyers')
+				{ print "$item[3]\n";
+				  $state = 'happy/sad'; }
+			| 'I' ("can't"|"can") ('fly'|'swim')
+				{ print "$item[3]\n";
+				  $state = 'able/unable'; }
+			| <error>
+
+};
+
+my $parse = new Parse::RecDescent ($grammar);
+my $input;
+
+while (defined ($input = <>))
+{
+	$parse->testimony($input) or print "huh?\n";
+}

misc/d-bindings/Parse-RecDescent-master-demo/demo_itemhash.pl

@@ -0,0 +1,79 @@
+#! /usr/local/bin/perl -ws
+
+use Parse::RecDescent;
+
+sub evalop
+{
+	my (@list) = @{[@{$_[0]}]};
+	my $val = shift(@list)->();
+	while (@list)
+	{
+		my ($op, $arg2) = splice @list, 0, 2;
+		$op->($val,$arg2->());
+	}
+	return $val;
+}
+
+my $parse = Parse::RecDescent->new(<<'EndGrammar');
+
+	main: expr /\s*\Z/ { $item{expr}->() }
+	    | <error: expected expression in $item{__RULE__}>
+
+	expr: /for(each)?/ lvar range expr
+			{ my ($vname,$expr) = @item{"lvar","expr"};
+			  my ($from, $to) = @{$item{range}};
+			  sub { my $val;
+				no strict "refs";
+				for $$vname ($from->()..$to->())
+					{ $val = $expr->() }
+				return $val;
+			      }
+			}
+	    | lvar '=' addition
+			{ my ($vname, $expr) = @item{"lvar","addition"};
+			  sub { no strict 'refs'; $$vname = $expr->() }
+			}
+	    | addition
+
+	range: "(" expr ".." expr ")"
+			{ [ @item[2,4] ] }
+
+	addition: <leftop:multiplication add_op multiplication>
+			{ my $add = $item[1]; sub { ::evalop $add } }
+
+	add_op: '+'	{ sub { $_[0] += $_[1] } }
+	      | '-'	{ sub { $_[0] -= $_[1] } }
+
+	multiplication: <leftop:factor mult_op factor>
+			{ my $mult = $item[1]; sub { ::evalop $mult } }
+
+	mult_op: '*'	{ sub { $_[0] *= $_[1] } }
+	       | '/'	{ sub { $_[0] /= $_[1] } }
+
+	factor: number
+	      | rvar
+	      | '(' expr ')' { $item{expr} }
+
+	number: /[-+]?\d+(\.\d+)?/	{ sub { $item[1] } }
+
+	lvar:	/\$([a-z]\w*)/		{ $1 }
+
+	rvar:	lvar			{ sub { no strict 'refs'; ${$item{lvar}} } }
+
+EndGrammar
+
+print "> ";
+while (<DATA>) {	# FOR DEMO CHANGE TO: while (<DATA>)
+  print eval {$parse->main($_)}||"", "\n\n> ";
+}
+
+__DATA__
+$x = 2
+$y = 3
++1-1+1-1+1-1+1-1+1
+7*7-6*8
+121/(121/11)/121*11
+1/(10-1/(1/(10-1)))
+$x * $y
+foreach $i (1..$y) $x = $x * 2 + $i
+$x

misc/d-bindings/Parse-RecDescent-master-demo/demo_language.pl

@@ -0,0 +1,176 @@
+#! /usr/local/bin/perl -ws
+
+#SHARED SYMBOL_TABLE
+
+my %symbol_table = ();
+
+package Operation;
+
+sub new
+{
+	my ($class, %args) = @_;
+	bless \%args, $class;
+}
+
+
+package Assignment_Op; @ISA = qw( Operation );
+
+sub eval
+{
+	my ($self) = @_;
+	$symbol_table{$self->{var}->{name}}
+		= $self->{value}->eval();
+}
+
+
+package Addition_Op; @ISA = qw ( Operation );
+
+sub eval
+{
+	my ($self) = @_;
+	return $self->{left}->eval() + $self->{right}->eval();
+}
+
+
+package Multiplication_Op; @ISA = qw ( Operation );
+
+sub eval
+{
+	my ($self) = @_;
+	return $self->{left}->eval() * $self->{right}->eval();
+}
+
+
+package IfThenElse_Op; @ISA = qw ( Operation );
+
+sub eval
+{
+	my ($self) = @_;
+	if ($self->{condition}->eval() )
+	{
+		return $self->{true_expr}->eval();
+	}
+	else
+	{
+		return $self->{false_expr}->eval();
+	}
+}
+
+
+package LessThan_Op; @ISA = qw ( Operation );
+
+sub eval
+{
+	my ($self) = @_;
+	return $self->{left}->eval() < $self->{right}->eval();
+}
+
+
+package Value_Op; @ISA = qw( Operation );
+
+sub eval
+{
+	my ($self) = @_;
+	return $self->{value};
+}
+
+
+package Variable_Op; @ISA = qw( Operation );
+
+sub eval
+{
+	my ($self) = @_;
+	return $symbol_table{$self->{name}};
+}
+
+package Sequence_Op;
+
+sub new
+{
+	my ($class, $list_ref) = @_;
+	bless $list_ref, $class;
+}
+
+sub eval
+{
+	my ($self) = @_;
+	my $last_val;
+	foreach my $statement ( @$self )
+	{
+		$last_val = $statement->eval();
+	}
+	return $last_val;
+}
+
+
+package main;
+
+use Parse::RecDescent;
+
+my $grammar = q
+{
+	Script:		Statement(s) /^$/
+				{ Sequence_Op->new( $item[1] ) }
+
+	Statement:	Assignment
+		 |	IfThenElse
+		 |	Expression
+		 |	<error>
+
+	Assignment:	Variable '<-' Expression
+				{ Assignment_Op->new( var   => $item[1],
+						   value => $item[3]) }
+
+	Expression:	Product "+" Expression
+				{ Addition_Op->new( left  => $item[1],
+						    right => $item[3] ) }
+		  |	Product
+
+	Product:	Value "*" Product
+				{ Multiplication_Op->new( left  => $item[1],
+							  right => $item[3] ) }
+	       |	Value
+
+	Value:		/\d+/
+				{ Value_Op->new( value => $item[1] ) }
+	     |		Variable
+
+	Variable:	/(?!if)[a-z]/
+				{ Variable_Op->new( name => $item[1] ); }
+
+	IfThenElse:	'if' Condition 'then' Statement 'else' Statement
+				{ IfThenElse_Op->new( condition  => $item[2],
+						      true_expr  => $item[4],
+						      false_expr => $item[6]) }
+
+	Condition:	Expression '<' Expression
+				{ LessThan_Op->new( left  => $item[1],
+						    right => $item[3] ) }
+
+
+
+};
+
+my $parser = Parse::RecDescent->new($grammar)
+	or die "Bad grammar";
+
+local $/;
+my $script = <DATA>;
+
+my $tree = $parser->Script($script)
+	or die "Bad script";
+
+print $tree->eval();
+
+__DATA__
+
+a <- 1
+
+b <- 2
+
+if a<b then
+	c <- 3
+else
+	c <- 99
+
+b*c+a

misc/d-bindings/Parse-RecDescent-master-demo/demo_leftassoc.pl

@@ -0,0 +1,57 @@
+#! /usr/local/bin/perl -ws
+
+# THE COMMONEST REASON FOR WANTING LEFT RECURSION
+
+use strict;
+use Parse::RecDescent; $::RD_HINT = 1;
+
+
+my $parse = Parse::RecDescent->new(<<'EndGrammar');
+
+	main: expr /\Z/ { $item[1] }
+	    | <error>
+
+	expr: left_assoc[qw{term add_op term}]
+	    | term
+
+	add_op: '+'	{ sub { $_[0] + $_[1] } }
+	      | '-'	{ sub { $_[0] - $_[1] } }
+
+	term: left_assoc[qw{factor mult_op factor}]
+	    | factor
+
+	mult_op: '*'	{ sub { $_[0] * $_[1] } }
+	       | '/'	{ sub { $_[0] / $_[1] } }
+
+	factor: number
+	      | '(' expr ')' { $item[2] }
+
+	number: /[-+]?\d+(\.\d+)?/
+
+
+# THE BLACK MAGIC THAT MAKES IT WORK...
+
+	left_assoc: left_assoc_left[@arg[0,1]](s) <matchrule:$arg[2]>
+			{ my @terms = $item[1]
+				? ((map { @$_ } @{$item[1]}), $item[2])
+				: $item[1];
+			  splice @terms, 0, 3, $terms[1]->(@terms[0,2])
+				while @terms>1;
+			  $terms[0];
+			}
+
+	left_assoc_left: <matchrule:$arg[0]> <matchrule:$arg[1]>
+			{ [ @item[1..2] ] }
+
+
+EndGrammar
+
+while (<DATA>) {
+  print $parse->main($_), "\n";
+}
+
+__DATA__
++1-1+1-1+1-1+1-1+1
+7*7-6*8
+121/(121/11)/121*11
+1/(10-1/(1/(10-1)))

misc/d-bindings/Parse-RecDescent-master-demo/demo_leftop.pl

@@ -0,0 +1,52 @@
+#! /usr/local/bin/perl -ws
+
+# THE COMMONEST REASON FOR WANTING LEFT RECURSION
+
+use strict;
+use Parse::RecDescent; $::RD_HINT = 1;
+
+sub Parse::RecDescent::evalop {
+	$_[0][0] = $_[0][$_+1](@{$_[0]}[0,$_+2])
+		for map 2*($_-1), 1..@{$_[0]}/2;
+	return $_[0][0];
+}
+
+my $parse = Parse::RecDescent->new(<<'EndGrammar');
+
+	main: expr /\Z/ { $item[1] }
+	    | <error>
+
+	expr: <leftop:term add_op term>
+			{ evalop($item[1]) }
+
+	add_op: '+'	{ sub { $_[0] += $_[1] } }
+	      | '-'	{ sub { $_[0] -= $_[1] } }
+
+	term: <leftop:factor mult_op factor>
+			{ evalop($item[1]) }
+
+	mult_op: '*'	{ sub { $_[0] *= $_[1] } }
+	       | '/'	{ sub { $_[0] /= $_[1] } }
+
+	factor: number
+	      | '(' expr ')' { $item[2] }
+
+	number: /[-+]?\d+(\.\d+)?/
+
+EndGrammar
+
+while (<DATA>) {
+  print "$_ = ", $parse->main($_), "\n";
+}
+
+while (print "> " and defined($_=<>)) {
+  print "= ", $parse->main($_), "\n";
+}
+
+__DATA__
+2+3
+2*3
++1-1+1-1+1-1+1-1+1
+7*7-6*8
+121/(121/11)/121*11
+1/(10-1/(1/(10-1)))

misc/d-bindings/Parse-RecDescent-master-demo/demo_lexer.pl

@@ -0,0 +1,36 @@
+#! /usr/local/bin/perl -sw
+
+# IT'S A PARSER *AND* A LEXER...
+
+use Parse::RecDescent;
+use Data::Dumper;
+
+$lexer = new Parse::RecDescent q
+{
+	lex: token(s)
+
+	token: 'I\b'		<token:POSS>
+	     | 'see\b'		<token:VERB>
+	     | 'on\b'		<token:PREP>
+	     | 'by\b'		<token:PREP>
+	     | /the\b|a\b/i	<token:ARTICLE>
+	     | /\w+/		<token:WORD,PUNCT,OTHER>
+};
+
+$data = join '', <DATA>;
+
+print_tokens($lexer->lex(\$data));
+
+print "left: [$data]\n";
+
+sub print_tokens
+{
+	foreach $token ( @{$_[0]} )
+	{
+		print Dumper($token), "\n";
+	}
+}
+
+__DATA__
+
+I see a cat on the windowsill by the door!!!!!

misc/d-bindings/Parse-RecDescent-master-demo/demo_lisplike.pl

@@ -0,0 +1,81 @@
+#! /usr/local/bin/perl -w
+
+use Parse::RecDescent;
+use Data::Dumper;
+
+my $grammar = q{
+
+        s_expr: '(' s_expr(s) ')'               # NESTED S-EXPRS
+                        { $return = $item[2] }
+              | /" [^\\"]* (\\. [^\\"]*)* "/x   # STRINGS
+              | /[^()\s]+/                      # ANYTHING ELSE
+
+
+};
+
+my $parser = Parse::RecDescent->new($grammar) or die;
+
+undef $/;
+my $data = <DATA>;
+
+my $nested_array = $parser->s_expr($data);
+
+
+print Data::Dumper->Dump($nested_array);
+
+__DATA__
+
+     (net
+       (rename VDDTX "vddtx")
+       (joined
+	 (portRef VDDTX)
+	 (portRef &2
+	   (instanceRef I_45_1102680350)))
+       (figure WIRE
+	 (path
+	   (pointList
+	     (pt 6700 -2100)
+	     (pt 6900 -2100)))
+	 (path
+	   (pointList
+	     (pt 6900 -2100)
+	     (pt 6900 -2500)))))
+     (net
+       (rename N00023 "N00023")
+       (joined
+	 (portRef &2
+	   (instanceRef I_45_1215476478))
+	 (portRef &1
+	   (instanceRef I_45_1102680350))
+	 (portRef &2
+	   (instanceRef I_45_1215470655)))
+       (figure WIRE
+	 (path
+	   (pointList
+	     (pt 5800 -3400)
+	     (pt 6900 -3400)))
+	 (path
+	   (pointList
+	     (pt 5800 -3400)
+	     (pt 5800 -3700)))
+	 (path
+	   (pointList
+	     (pt 6900 -3100)
+	     (pt 6900 -3400)))
+	 (path
+	   (pointList
+	     (pt 8000 -3400)
+	     (pt 8000 -3700)))
+	 (path
+	   (pointList
+	     (pt 6900 -3400)
+	     (pt 8000 -3400))))
+       (instance
+	 (rename TIE1 "TIE1")
+	 (viewRef XTIE0A2Y2
+	   (cellRef XTIE0A2Y2
+	     (libraryRef RIPPER_LIBRARY)))
+	 (transform
+	   (origin
+	     (pt 6900 -3400)))))
+

misc/d-bindings/Parse-RecDescent-master-demo/demo_logic.pl

@@ -0,0 +1,39 @@
+#! /usr/local/bin/perl -sw
+
+# PARSE LOGICAL EXPRESSIONS
+
+use Parse::RecDescent;
+
+$RD_TRACE=1;
+
+$grammar =
+q{
+	expr	:	disj  no_garbage
+
+	no_garbage: /^\s*$/
+		  | <error: Trailing garbage>
+
+	disj	:	conj  ('or' conj)(s?)
+
+	conj	:	unary ('and' unary)(s?)
+
+	unary	:	'not' atom
+		|	'(' disj ( ')' | <error> )
+		|	atom
+
+	atom	:	/<.+?>/
+
+};
+
+$parse = new Parse::RecDescent ($grammar);
+
+$input = '';
+
+print "> ";
+while (<>)
+{
+
+	if (/^\.$/) { defined $parse->expr($input) or print "huh?\n"; $input = '' }
+	else	    { chomp; $input .= " $_" }
+	print "> ";
+}

misc/d-bindings/Parse-RecDescent-master-demo/demo_matchrule.pl

@@ -0,0 +1,49 @@
+#! /usr/local/bin/perl -sw
+
+use vars qw($animal);
+use Parse::RecDescent;
+
+$grammar = q {
+		    object:	 thing[article=>'a'](s)
+			  |	 thing[article=>'the'](s)
+
+		    thing:	 <matchrule:$arg{article}>
+			  	 <matchrule:${\scalar reverse $::animal}>
+
+		    a:		'a'
+		    the:	'the'
+
+		    cat:	'cat' { print "meow\n"; $::animal = 'god' }
+		    dog:	'dog' { print "woof\n" }
+	     };
+
+unless( $parser = new Parse::RecDescent( $grammar ))
+{
+    die "bad grammar; bailing\n";
+}
+
+$/ = "";
+while (defined ($input = <DATA>))
+{
+	$::animal = reverse 'cat';
+
+	print STDERR "parsing...\n";
+	unless( defined $parser->object( $input ))
+	{
+	    die "error in input; bailing\n";
+	}
+	print STDERR "...parsed\n";
+}
+
+__DATA__
+a cat
+a cat
+a cat
+a dog
+
+the cat
+the dog
+the dog
+the dog
+the dog
+a dog

misc/d-bindings/Parse-RecDescent-master-demo/demo_matchrule2.pl

@@ -0,0 +1,35 @@
+#! /usr/local/bin/perl -sw
+
+use vars qw($animal);
+use Parse::RecDescent;
+
+$RD_AUTOACTION = q{ $last = $item[1] };
+
+$grammar = q {
+
+	sequence: <rulevar: local $last>
+	sequence: base <matchrule: after_$last >(3..)
+			{ [ $item[1], @{$item[2]} ] }
+		| base sequence
+			{ $item[2] }
+
+
+	base: /[ACGT]/
+
+	after_A: /[C]/
+	after_C: /[AG]/
+	after_G: /[CT]/
+	after_T: /[G]/
+};
+
+$parser = new Parse::RecDescent( $grammar ) or
+    die "bad grammar; bailing";
+
+local $/;
+use AutoDump;
+
+show $parser->sequence(<DATA>);
+
+__DATA__
+
+AAACTTTAAAACGTGCGCACGTGTAAAAAA

misc/d-bindings/Parse-RecDescent-master-demo/demo_mccoy.pl

@@ -0,0 +1,30 @@
+#! /usr/local/bin/perl -sw
+
+# DAMMIT, JIM, I'M A DOCTOR, NOT A PERL PROGRAM!
+
+use Parse::RecDescent;
+
+$grammar =
+q{
+	McCoy	:	curse ',' name ", I'm a doctor, not a" profession '!'
+	     	|	possessive 'dead,' name '!'
+	     	|	<error>
+
+	curse	:	'Dammit' | 'Goddammit'
+
+	name	:	'Jim' | 'Spock' | 'Scotty'
+
+
+	profession:	'magician' | 'miracle worker' | 'Perl hacker'
+
+	possessive:	"He's" | "She's" | "It's" | "They're"
+};
+
+$parse = new Parse::RecDescent ($grammar);
+
+print "> ";
+while (<>)
+{
+	$parse->McCoy($_);
+	print "> ";
+}

misc/d-bindings/Parse-RecDescent-master-demo/demo_metaRD.pm

@@ -0,0 +1,85 @@
+# Changes! /usr/local/bin/perl -w
+
+use Parse::RecDescent;
+
+local $/;
+my $parse = Parse::RecDescent->new(<DATA>);
+
+my $grammar = <>;
+
+$tree = parse->grammar($grammar) or die "Bad grammar! No biscuit!";
+
+print Data::Dumper->Dump([$tree]);
+
+
+
+__DATA__
+
+<autotree>
+
+grammar    : prerule(s?) components(s?) /\Z/
+
+component  : rule
+	   | comment
+
+rule       : <skip:""> "\n" <skip: '[ \t]'> identifier ":"
+	     <skip: $item[1]> production(s? /|/)
+
+production : items(s)
+
+item       : lookahead(s?) simpleitem
+           | directive
+           | comment
+
+lookahead  : '...' | '...!'                   # +'ve or -'ve lookahead
+
+simpleitem : subrule args(?) rep(?)           # match another rule
+           | terminal                         # match the next input
+           | bracket args(?)                  # match alternative items
+           | action                           # do something
+
+subrule    : identifier                       # the name of the rule
+
+args       : {extract_codeblock($_[0],'[]')}  # just like a [...] array ref
+
+rep	   : '(' repspec ')'
+
+repspec	   : '?'                              # 0 or 1 times
+           | 's?'                             # 0 or more times
+           | 's'                              # 1 or more times
+           | /(\d+)[.][.](/\d+)/              # $1 to $2 times
+           | /[.][.](/\d*)/                   # at most $1 times
+           | /(\d*)[.][.])/                   # at least $1 times
+
+terminal   : /[/]([\][/]|[^/])*[/]/           # interpolated pattern
+           | /"([\]"|[^"])*"/                 # interpolated literal
+           | /'([\]'|[^'])*'/                 # uninterpolated literal
+
+action     : <perl_codeblock>		      # embedded Perl code
+
+bracket    : '(' production(s? /|/) ')'       # alternative subrules
+
+directive  : '<commit>'                       # commit to production
+           | '<uncommit>'                     # cancel commitment
+           | '<resync>'                       # skip to newline
+           | '<resync:' pattern '>'           # skip <pattern>
+           | '<reject>'                       # fail this production
+           | '<reject:' condition '>'         # fail if <condition>
+           | '<error>'                        # report an error
+           | '<error:' string '>'             # report error as "<string>"
+           | '<error?>'                       # error only if committed
+           | '<error?:' string '>'            #   "    "    "    "
+           | '<rulevar:' /[^>]+/ '>'          # define rule-local variable
+           | '<matchrule:' string '>'         # invoke rule named in string
+
+identifier : /[a-z]\w*/i                      # must start with alpha
+
+comment    : /#[^\n]*/                        # same as Perl
+
+pattern    : {extract_bracketed($text,'<')}   # allow embedded "<..>"
+
+condition  : {extract_codeblock($text,'{<')}  # full Perl expression
+
+string     : {extract_variable($text)}        # any Perl variable
+           | {extract_quotelike($text)}       #   or quotelike string
+           | {extract_bracketed($text,'<')}   #   or balanced brackets

misc/d-bindings/Parse-RecDescent-master-demo/demo_methods.pl

@@ -0,0 +1,55 @@
+#! /usr/local/bin/perl -sw
+
+# DEMONSTRATE USING DERIVED CLASS METHODS IN A PARSER
+
+package MyParser;
+
+	use Parse::RecDescent;
+
+	@ISA = qw { Parse::RecDescent };
+
+	# CALL THIS METHOD THROUGH AN OBJECT...
+
+	sub print_cat ($$)
+	{
+		print "CAT: $_[1]\n";
+	}
+
+	# CALL THESE METHODS DIRECTLY (MUST QUALIFY)...
+
+	sub print_dog ($)
+	{
+		print "DOG: $_[0]\n";
+	}
+
+	sub print_rat ($)
+	{
+		print "RAT: $_[0]\n";
+	}
+
+
+package main;
+
+	$grammar =
+	q{
+		inputs   :	input(s) | <reject>
+
+		input	 :	"cat"
+					{ $thisparser->print_cat($item[1]); }
+			 |	"dog"
+					{ MyParser::print_dog($item[1]); }
+			 |	"rat"
+					# ERROR (UNQUALIFIED METHOD CALL)
+					{ print_rat($item[1]); }
+
+	};
+
+	$parse = new MyParser ($grammar);
+
+	print "> ";
+	while (<>)
+	{
+		$parse->inputs($_) || print "huh?\n";
+		print "> ";
+	}
+

misc/d-bindings/Parse-RecDescent-master-demo/demo_operator.pl

@@ -0,0 +1,50 @@
+#! /usr/local/bin/perl -sw
+
+# PARSE LOGICAL EXPRESSIONS
+
+use Parse::RecDescent;
+
+$grammar =
+q{
+	expr	:	'[' <leftop: atom /,?/ atom>(?) ']' 	{ $item[2] }
+		|       '[[' atomlist ']]' 	{ $item[2] }
+		|	disj  no_garbage 	{ $item[1] }
+		|	<rightop: atom '=' num>
+		|	<leftop: atom '<<' num>
+
+	atomlist: <leftop: atom /,?/ atom>
+
+	no_garbage: /^\s*$/
+		  | <error: Trailing garbage: $text>
+
+	disj	:	<leftop: conj /(or)/ conj >
+
+	conj	:	<leftop: unary 'and' unary >
+
+	and	: 	'and'
+
+	unary	:	'not' atom
+		|	'(' expr ')'	{ $item[2] }
+		|	atom
+
+	atom	:	/(?!and|or)[a-z]/
+
+	num	: 	/\d+/
+
+};
+
+$parse = new Parse::RecDescent ($grammar) or die "bad grammar";
+
+$input = '';
+
+use Data::Dumper;
+
+print "> ";
+while (<>)
+{
+
+	if (/^\.$/) { print STDERR Data::Dumper->Dump([$parse->expr($input)]);
+		      $input = '' }
+	else	    { $input .= $_ }
+	print "> ";
+}

misc/d-bindings/Parse-RecDescent-master-demo/demo_opreps.pl

@@ -0,0 +1,48 @@
+#! /usr/local/bin/perl -w
+
+use Parse::RecDescent;
+
+#$RD_TRACE=1;
+#$RD_HINT=1;
+
+my $parser = Parse::RecDescent->new(<<'EOG') or die;
+
+	list1N:	<rightop: term ',' term>(s)
+
+	list12:	<rightop: term ',' term>(..2)
+
+	list2N:	<rightop: term ',' term>(2..)
+
+	list01:	<rightop: term ',' term>(?)
+
+	list:	<rightop: term ',' term>
+
+	list0N:	<rightop: term ',' term>(s?)
+
+	list23:	<rightop: term ',' term>(2..3)
+
+	list03:	<rightop: term ',' term>(0..3)
+
+	term: 't'
+EOG
+
+while (<DATA>)
+{
+	print;
+	print "\tlist:\t",   @{$parser->list($_)||['undef']}, "\n";
+	print "\tlist01:\t", @{$parser->list01($_)||['undef']}, "\n";
+	print "\tlist0N:\t", @{$parser->list0N($_)||['undef']}, "\n";
+	print "\tlist1N:\t", @{$parser->list1N($_)||['undef']}, "\n";
+	print "\tlist2N:\t", @{$parser->list2N($_)||['undef']}, "\n";
+	print "\tlist23:\t", @{$parser->list23($_)||['undef']}, "\n";
+	print "\tlist12:\t", @{$parser->list12($_)||['undef']}, "\n";
+	print "\tlist03:\t", @{$parser->list03($_)||['undef']}, "\n";
+	print "-----\n";
+}
+
+__DATA__
+
+t
+t,t
+t,t,t
+t,t,t,t

misc/d-bindings/Parse-RecDescent-master-demo/demo_parsetree.pl

@@ -0,0 +1,48 @@
+#! /usr/local/bin/perl -sw
+
+# PARSE LOGICAL EXPRESSIONS TO A "list of lists" PARSE TREE
+
+sub printtree
+{
+	print "    " x $_[0];
+	print "$_[1]:\n";
+	foreach ( @_[2..$#_] )
+	{
+		if (ref($_)) { printtree($_[0]+1,@$_); }
+		else	     { print "    " x $_[0], "$_\n" }
+	}
+	print "\n";
+
+}
+
+use Parse::RecDescent;
+
+$RD_AUTOACTION = q{ [@item] };
+
+$grammar =
+q{
+	expr	:	disj
+
+	disj	:	conj 'or' disj | conj
+
+	conj	:	unary 'and' conj | unary
+
+	unary	:	'not' atom
+		|	'(' expr ')'
+		|	atom
+
+	atom	:	/[a-z]+/i
+
+};
+
+$parse = new Parse::RecDescent ($grammar);
+
+while (<DATA>)
+{
+	my $tree = $parse->expr($_);
+	printtree(0,@$tree) if $tree;
+}
+
+__DATA__
+a and b and not c
+(c or d) and f

misc/d-bindings/Parse-RecDescent-master-demo/demo_perlparsing.pl

@@ -0,0 +1,61 @@
+#! /usr/local/bin/perl -w
+
+use Parse::RecDescent;
+
+my $parse = Parse::RecDescent->new(<<'EndGrammar');
+
+	perl: <perl_quotelike>
+		{ print 'quotelike: [', join("|", @{$item[1]}), "]\n" }
+	    | <skip: '-*'> <perl_variable>
+		{ print "variable: $item[-1]\n" }
+	    | <perl_codeblock>
+		{ print "codeblock: $item[1]\n" }
+	    | /.*/
+		{ print "unknown: $item[1]\n" }
+
+EndGrammar
+
+print "> ";
+while (<DATA>) {	# FOR DEMO CHANGE TO: while (<DATA>)
+  $parse->perl($_);
+}
+
+__DATA__
+{$a=1};
+$a;
+{ $a = $b; \n $a =~ /$b/; \n @a = map /\s/ @b };
+$_;
+$a[1];
+$_[1];
+$a{cat};
+$_{cat};
+$a->[1];
+$a->{"cat"}[1];
+@$listref;
+@{$listref};
+$obj->nextval;
+@{$obj->nextval};
+@{$obj->nextval($cat,$dog)->{new}};
+@{$obj->nextval($cat?$dog:$fish)->{new}};
+@{$obj->nextval(cat()?$dog:$fish)->{new}};
+$ a {'cat'};
+$a::b::c{d}->{$e->()};
+$#_;
+$#array;
+$#{array};
+$var[$#var];
+'a';
+"b";
+`c`;
+'a\'';
+'a\\';
+'\\a';
+"a\\";
+"\\a";
+"b\'\"\'";
+`c '\`abc\`'`;
+q{a};
+qq{a};
+qx{a};
+s{a}/b/;
+tr!a!b!;

misc/d-bindings/Parse-RecDescent-master-demo/demo_piecewise.pl

@@ -0,0 +1,181 @@
+#! /usr/local/bin/perl -ws
+
+use Parse::RecDescent;
+
+my $parser = new Parse::RecDescent q
+{
+	components: ganglia(s)
+
+	ganglia:    'ganglia' '{' cell(s) '}'
+
+	cell:	    'cell' '{' synapse(s) '}'
+
+	synapse:    'synapse' '{' WHATEVER '}'
+
+	WHATEVER:    /\d\.\d\.\d/   # OBVIOUSLY REPLACE THIS WITH WHATEVER :-)
+			<defer: print "$item[1]\n" >
+
+} or die "Bad grammar!\n";
+
+my $text = '';
+
+getnextchunk($text)				# GET FIRST CHUNK OF DATA
+	or die "No data!\n";
+
+$text =~ s/\s*define\s*NetworkDetails\s*{//	# EAT OUTERMOST OPENING BRACKET
+	or die "Bad data! (expected 'define...')";
+
+do
+{
+	$parser->components(\$text);		# TRY TO EAT GANGLIA
+}
+while (getnextchunk($text));			# APPEND THE NEXT CHUNK
+
+$text =~ m/\s*}/		# CHECK FOR THE OUTERMOST CLOSING BRACKET
+	or die "Unclosed 'define' (missing '}')!";
+
+
+sub getnextchunk	# APPEND SOME MORE TEXT TO THE FIRST ARG
+{
+	my $wasmore = 0;
+	for (1..10)		# OPTIMALLY, ONE LINE BIGGER THAN THE LARGEST
+				# SINGLE GANGLIA DEFINITION, BUT ANY NUMBER
+				# OF LINES WILL DO
+	{
+		my $nextline = <DATA>;
+		defined $nextline or last;
+		$_[0] .= $nextline;
+		$wasmore++
+	}
+	return $wasmore;
+}
+
+__DATA__
+
+define NetworkDetails
+{
+	ganglia {
+		cell {
+			synapse { 1.1.1 }
+			synapse { 1.1.2 }
+			synapse { 1.1.3 }
+			synapse { 1.1.4 }
+			synapse { 1.1.5 }
+		}
+		cell {
+			synapse { 1.2.1 }
+			synapse { 1.2.2 }
+			synapse { 1.2.3 }
+			synapse { 1.2.4 }
+			synapse { 1.2.5 }
+		}
+		cell {
+			synapse { 1.3.1 }
+			synapse { 1.3.2 }
+			synapse { 1.3.3 }
+			synapse { 1.3.4 }
+			synapse { 1.3.5 }
+		}
+		cell {
+			synapse { 1.4.1 }
+			synapse { 1.4.2 }
+			synapse { 1.4.3 }
+			synapse { 1.4.4 }
+			synapse { 1.4.5 }
+		}
+	}
+
+	ganglia {
+		cell {
+			synapse { 2.1.1 }
+			synapse { 2.1.2 }
+			synapse { 2.1.3 }
+			synapse { 2.1.4 }
+			synapse { 2.1.5 }
+		}
+		cell {
+			synapse { 2.2.1 }
+			synapse { 2.2.2 }
+			synapse { 2.2.3 }
+			synapse { 2.2.4 }
+			synapse { 2.2.5 }
+		}
+		cell {
+			synapse { 2.3.1 }
+			synapse { 2.3.2 }
+			synapse { 2.3.3 }
+			synapse { 2.3.4 }
+			synapse { 2.3.5 }
+		}
+		cell {
+			synapse { 2.4.1 }
+			synapse { 2.4.2 }
+			synapse { 2.4.3 }
+			synapse { 2.4.4 }
+			synapse { 2.4.5 }
+		}
+	}
+
+	ganglia {
+		cell {
+			synapse { 3.1.1 }
+			synapse { 3.1.2 }
+			synapse { 3.1.3 }
+			synapse { 3.1.4 }
+			synapse { 3.1.5 }
+		}
+		cell {
+			synapse { 3.2.1 }
+			synapse { 3.2.2 }
+			synapse { 3.2.3 }
+			synapse { 3.2.4 }
+			synapse { 3.2.5 }
+		}
+		cell {
+			synapse { 3.3.1 }
+			synapse { 3.3.2 }
+			synapse { 3.3.3 }
+			synapse { 3.3.4 }
+			synapse { 3.3.5 }
+		}
+		cell {
+			synapse { 3.4.1 }
+			synapse { 3.4.2 }
+			synapse { 3.4.3 }
+			synapse { 3.4.4 }
+			synapse { 3.4.5 }
+		}
+	}
+
+	ganglia {
+		cell {
+			synapse { 4.1.1 }
+			synapse { 4.1.2 }
+			synapse { 4.1.3 }
+			synapse { 4.1.4 }
+			synapse { 4.1.5 }
+		}
+		cell {
+			synapse { 4.2.1 }
+			synapse { 4.2.2 }
+			synapse { 4.2.3 }
+			synapse { 4.2.4 }
+			synapse { 4.2.5 }
+		}
+		cell {
+			synapse { 4.3.1 }
+			synapse { 4.3.2 }
+			synapse { 4.3.3 }
+			synapse { 4.3.4 }
+			synapse { 4.3.5 }
+		}
+		cell {
+			synapse { 4.4.1 }
+			synapse { 4.4.2 }
+			synapse { 4.4.3 }
+			synapse { 4.4.4 }
+			synapse { 4.4.5 }
+		}
+	}
+
+}

misc/d-bindings/Parse-RecDescent-master-demo/demo_precalc.pl

@@ -0,0 +1,46 @@
+#! /usr/local/bin/perl -ws
+
+BEGIN
+{
+	unless (-f "Calc.pm")
+	{
+		print "You first need to build Calc.pm.\n\n",
+		       "Try: perl -MParse::RecDescent - calc_grammar Calc\n",
+		       " or: demo_buildcalc.pl\n\n";
+		exit;
+	}
+}
+
+use Parse::RecDescent;
+use Calc;
+
+sub evalop
+{
+	# my (@list) = @{[@{$_[0]}]};
+	my (@list) = @{$_[0]};
+	my $val = shift(@list)->();
+	while (@list)
+	{
+		my ($op, $arg2) = splice @list, 0, 2;
+		$op->($val,$arg2->());
+	}
+	return $val;
+}
+
+my $parse = Calc->new() or die "bad grammar";
+
+print "> ";
+while (<DATA>) {	# FOR DEMO CHANGE TO: while (<DATA>)
+  print $parse->main($_), "\n\n> ";
+}
+
+__DATA__
+$x = 2
+$y = 3
++1-1+1-1+1-1+1-1+1
+7*7-6*8
+121/(121/11)/121*11
+1/(10-1/(1/(10-1)))
+$x * $y
+foreach $i (1..$y) $x = $x * 2 + $i
+$x

misc/d-bindings/Parse-RecDescent-master-demo/demo_quicklist.pl

@@ -0,0 +1,70 @@
+#! /usr/local/bin/perl -w
+
+use Parse::RecDescent;
+
+#$RD_TRACE=1;
+#$RD_HINT=1;
+
+my $parser = Parse::RecDescent->new(<<'EOG') or die;
+
+	list1N_c:	term(s /,/)
+	list1N_s:	term(s /\/+/)
+
+	list0N_c:	term(s? /,/)
+	list0N_s:	term(s? /\/+/)
+
+	list01_c:	term(? /,/)
+	list01_s:	term(? /\/+/)
+
+	list2_c:	term(2 /,/)
+	list2_s:	term(2 /\/+/)
+
+	list02_c:	term(0..2 /,/)
+	list02_s:	term(0..2 /\/+/)
+
+	list2N_c:	term(2.. /,/)
+	list2N_s:	term(2.. /\/+/)
+
+	list13_c:	term(..3 /,/)
+	list13_s:	term(..3 /\/+/)
+
+	term: 't'
+EOG
+
+while (<DATA>)
+{
+	print;
+	print "\tlist1N_c:\t", @{$parser->list1N_c($_)||['undef']}, "\n";
+	print "\tlist1N_s:\t", @{$parser->list1N_s($_)||['undef']}, "\n";
+
+	print "\tlist0N_c:\t", @{$parser->list0N_c($_)||['undef']}, "\n";
+	print "\tlist0N_s:\t", @{$parser->list0N_s($_)||['undef']}, "\n";
+
+	print "\tlist01_c:\t", @{$parser->list01_c($_)||['undef']}, "\n";
+	print "\tlist01_s:\t", @{$parser->list01_s($_)||['undef']}, "\n";
+
+	print "\tlist2_c:\t", @{$parser->list2_c($_)||['undef']}, "\n";
+	print "\tlist2_s:\t", @{$parser->list2_s($_)||['undef']}, "\n";
+
+	print "\tlist02_c:\t", @{$parser->list02_c($_)||['undef']}, "\n";
+	print "\tlist02_s:\t", @{$parser->list02_s($_)||['undef']}, "\n";
+
+	print "\tlist2N_c:\t", @{$parser->list2N_c($_)||['undef']}, "\n";
+	print "\tlist2N_s:\t", @{$parser->list2N_s($_)||['undef']}, "\n";
+
+	print "\tlist13_c:\t", @{$parser->list13_c($_)||['undef']}, "\n";
+	print "\tlist13_s:\t", @{$parser->list13_s($_)||['undef']}, "\n";
+
+	print "-----\n";
+}
+
+__DATA__
+
+t
+t,t
+t,t,t
+t,t,t,t
+t
+t/t
+t/t//t
+t/t///t/t

misc/d-bindings/Parse-RecDescent-master-demo/demo_randomsentence.pl

@@ -0,0 +1,101 @@
+#!/usr/bin/perl
+$|++;
+
+use Parse::RecDescent;
+
+my $parser = Parse::RecDescent->new(<<'END_OF_GRAMMAR');
+
+grammar: rule(s) /\Z/ { [ map { $_->[0], $_->[1] } @{$item[1]} ] }
+
+rule: identifier ":" defn ";" { [ $item[1], $item[3] ] }
+	| <error>
+
+defn: choice (barchoice)(s?) { [ $item[1], @{$item[2]} ] }
+
+barchoice: "|" choice
+
+choice: item(s)
+
+item: quoted_string | identifier | <error>
+
+quoted_string: /"(.*?)"/s { " ".substr($item[1],1,-1) }
+
+identifier: /[A-Za-z_]\w*/
+
+END_OF_GRAMMAR
+
+(my $parsed = $parser->grammar(join '', <DATA>)) or die "bad parse";
+
+my $top = $parsed->[0];
+my %defns = @$parsed;
+
+for (1..5) {
+  show($top);
+  print "\n----\n";
+}
+
+sub show {
+  my $defn = shift;
+  die "missing defn for $defn" unless exists $defns{$defn};
+
+  my @choices = @{$defns{$defn}};
+  for (@{$choices[rand @choices]}) {
+	## should be a list of ids or defns
+	die "huh $_ in $defn" if ref $defn;
+	if (/^ (.*)/s) {
+	  print $1;
+	} elsif (/^(\w+)$/) {
+	  show($1);
+	} else {
+	  die "Can't show $_ in $defn\n";
+	}
+  }
+}
+
+__END__
+stanza: stanza exclaim stanza2 | stanza2;
+stanza2: sentence comparison question | sentence comparison | comparison
+comparison exclaim | address question question sentence;
+
+sentence: sentence sentence2 | sentence2;
+sentence2: "The " adjectiveNotHep personNotHep verbRelating "the "
+adjectiveHep personHep ". " | "The " personHep verbRelating "the "
+adjectiveNotHep ", " adjectiveNotHep personNotHep ". ";
+
+question: question question2  | question2;
+question2: ques_start adjectiveHep personNotHep "? " | ques_start
+adjectiveNotHep personHep "? ";
+
+comparison: comparison comparison2 | comparison2;
+comparison2: "One says '" compNotHep "' while the other says '" compHep
+"'. "|
+"One thinks '" compNotHep "' while the other thinks '" compHep "'. "|
+"They shout '" compNotHep "!' And we shout'" compHep "'. "|
+"It's " compNotHep " versus " compHep "! ";
+
+personNotHep:  "capitalist" | "silk purse man" | "square" | "banker" |
+"Merchant King" | "pinstripe suit" ;
+
+personHep: "cat" | "beat soul" | "wordsmith" | "hep cat" | "free man" |
+"street poet" | "skin beater" | "reed man" ;
+
+adjectiveNotHep: "soul-sucking" | "commercial" | "cash-counting" |
+"bloody-handed" | "four-cornered" | "uncool" | "love-snuffing";
+
+adjectiveHep: "love-drunk" | "cool, cool" | "happening" | "tuned-in" |
+"street wise" | "wise and learned";
+
+verbRelating: "begrudges" | "fears" | "distresses" | "dodges" |
+"dislikes" | "evades" | "curses" | "belittles" | "avoids" | "battles";
+
+compNotHep: "recreation" | "isolation" | "tranportation" | "sacred nation"
+  | "complication" | "subordination";
+compHep: "fornication" | "instigation" | "interpretation" | "elevation"
+| "animation" | "inebriation" | "true relation";
+
+ques_start: "Could there ever be a "|"How could there be a "|
+  "Can you picture a ";
+address:  "Catch this: " | "Listen, cats, " | "Dig it: " |
+  "I lay this on you: ";
+exclaim: "Heavy, man. "|"Heavy. " | "Yow! " | "Snap 'em for me. " |
+  "Dig it. ";

misc/d-bindings/Parse-RecDescent-master-demo/demo_recipe.pl

@@ -0,0 +1,131 @@
+#! /usr/local/bin/perl -sw
+
+# "Potato, Egg, Red meat & Lard Cookbook",
+# T. Omnicient Rash & N. Hot Ignorant-Kant
+# O'Besity & Associates
+
+use Parse::RecDescent;
+
+$grammar =
+q{
+	Recipe: Step(s)
+
+	Step:
+		Verb Object Clause(s?)
+			{ print "$item[1]\n" }
+	      | <resync:[ ]{2}>
+
+	Verb:
+		'boil'
+	      | 'peel'
+	      | 'mix'
+	      | 'melt'
+	      | 'fry'
+	      | 'steam'
+	      | 'marinate'
+	      | 'sprinkle'
+	      | 'is'
+	      | 'are'
+	      | 'has'
+
+	Object:
+		IngredientQualifier(s) Ingredient
+	      | ReferenceQualifier(s) Ingredient
+	      | Reference
+
+	Clause:
+	        SubordinateClause
+              | CoordinateClause
+
+	SubordinateClause:
+		'until' State
+	      | 'while' State
+	      | 'for' Time
+
+	CoordinateClause:
+		/and( then)?/ Step
+	      | /or/ Step
+
+	State:
+		Object Verb Adjective
+	      | Adjective
+
+	Time:
+		Number TimeUnit
+
+	TimeUnit:
+		/hours?/
+		/minutes?/
+		/seconds?/
+
+	QuantityUnit:
+		/lbs?/
+
+
+	Object:
+		ReferenceQualifier Ingredient
+	      | Reference
+
+	Reference:
+		'they'
+	      | 'it'
+	      | 'them'
+
+	Ingredient:
+		'potatoes'
+	      | 'lard'
+	      | 'olive oil'
+	      | 'sugar'
+	      | 'bacon fat'
+	      | 'butter'
+	      | 'salt'
+	      | 'vinegar'
+
+	IngredientQualifier:
+		Amount
+	      | Number
+	      | 'a'
+	      | 'some'
+	      | 'large'
+	      | 'small'
+
+	Amount: Number QuantityUnit
+
+	ReferenceQualifier:
+	        'the'
+	      | 'those'
+	      | 'each'
+	      | 'half the'
+
+	Number:
+		/[1-9][0-9]*/
+	      | /one|two|three|four|five|six|seven|eight|nine/
+	      | 'a dozen'
+
+	Adjective:
+		'soft'
+	      | 'tender'
+	      | 'done'
+	      | 'charred'
+	      | 'grey'
+
+};
+
+$parse = new Parse::RecDescent ($grammar);
+
+$/ = "\n\n";
+while (<DATA>)
+{
+	if($ingredients = $parse->Recipe(lc $_))
+	{
+		print "$ingredients\n$_";
+	}
+}
+
+__DATA__
+Boil six large potatoes until they are grey and then marinate them
+for at least two hours in a mixture of lard, olive oil, raw
+sugar, and sea-salt.  In a deep-fryer melt 2 lbs of bacon fat and
+bring to the boil.  Fry the marinated potatoes for 7 minutes, or
+until they are nicely charred.  Serve with lashings of butter.
+Sprinkle with salt and vinegar to taste.

misc/d-bindings/Parse-RecDescent-master-demo/demo_restructure_easy.pl

@@ -0,0 +1,67 @@
+#!/usr/local/bin/perl -w
+
+# CONVERT FROM ONE EXTERNAL STRUCTURE TO A
+# SLIGHTLY DIFFERENT INTERNAL STRUCTURE
+#
+# LOCALIZED RULEVARS ARE ALWAYS EASIEST WHEN CHANGING STRUCTURES
+# SEE demo_restructure_painful.pl FOR ANOTHER APPROACH THAT SHOWS WHY
+
+use strict;
+use Parse::RecDescent;
+use Data::Dumper;
+
+my $grammar = q(
+
+	      file: <rulevar: local $file>
+              file:  section(s)
+                { $file }
+
+              section:  header '{' body '}'
+                { $file->{$item[1]} = $item[3] }
+
+              header: 'Domain=' /.+/
+
+	      body: <rulevar: local $body>
+              body: line(s)
+                { $body }
+
+              line: lineA | lineB
+
+              lineA: /[^\W_]+/ '=' /.+/
+                { $body->{$item[1]} = $item[3] }
+
+              lineB: /[^\W_]+/ '_' /[^\W_]+/ '=' /.+/
+                { $body->{$item[1]}{$item[3]} = $item[5] }
+               );
+
+my $parser = Parse::RecDescent->new($grammar);
+my $text;
+my @text = <DATA>;
+
+foreach (@text)
+{
+    next if /^\#/;  # Strip comments
+    $text .= $_;
+}
+
+my $f = $parser->file($text);
+print Dumper ($f);
+
+__DATA__
+#
+#
+Domain=domain1
+{
+P1_Name=n1
+P1_Address=host1:port1
+
+P2_Name=n2
+P2_Address=host2:port2
+}
+
+Domain=domain2
+{
+f1=v1
+f2=v2a v2b
+#comment
+}

misc/d-bindings/Parse-RecDescent-master-demo/demo_restructure_painful.pl

@@ -0,0 +1,90 @@
+#!/usr/local/bin/perl -w
+
+# CONVERT FROM ONE EXTERNAL STRUCTURE TO A
+# SLIGHTLY DIFFERENT INTERNAL STRUCTURE
+#
+# RETURNING NESTED LISTS AND THEN MUNGING THEM IS PAINFUL
+# SEE demo_restructure_easy.pl FOR A BETTER TECHNIQUE
+
+use strict;
+use Parse::RecDescent;
+use Data::Dumper;
+
+my $grammar = q(
+
+              {
+               sub consolidate {
+                   my $aref = shift;
+                   my @a = @{$aref};
+
+                   my %new = ();
+                   foreach my $a (@a) {
+                       my %h = %{$a};
+                       foreach my $k (keys %h) {
+                           if (ref($h{$k})) {
+                              foreach my $k2 (keys %{$h{$k}}) {
+                                  $new{$k}->{$k2} = $h{$k}->{$k2};
+                              }
+                          } else {
+                              $new{$k} = $h{$k};
+                          }
+                       }
+                   }
+                   return \%new;
+               }
+
+           }
+
+              file:  section(s)
+                { $return = consolidate($item[1]) }
+
+              section:  header '{' body '}'
+                { $return = { $item[1] => $item[3] } }
+
+              header: 'Domain=' /.+/
+                { $return = $item[2] }
+
+              body: line(s)
+                { $return = consolidate($item[1])  }
+
+              line: lineA | lineB
+                { $return = $item[1] }
+
+              lineA: /[^\W_]+/ '=' /.+/
+                { $return = { $item[1] => $item[3] } }
+
+              lineB: /[^\W_]+/ '_' /[^\W_]+/ '=' /.+/
+                { $return = { $item[1] => { $item[3] => $item[5] } } }
+               );
+
+my $parser = Parse::RecDescent->new($grammar);
+my $text;
+my @text = <DATA>;
+
+foreach (@text)
+{
+    next if /^\#/;  # Strip comments
+    $text .= $_;
+}
+
+my $f = $parser->file($text);
+print Dumper ($f);
+
+__DATA__
+#
+#
+Domain=domain1
+{
+P1_Name=n1
+P1_Address=host1:port1
+
+P2_Name=n2
+P2_Address=host2:port2
+}
+
+Domain=domain2
+{
+f1=v1
+f2=v2a v2b
+#comment
+}

misc/d-bindings/Parse-RecDescent-master-demo/demo_scoredsep.pl

@@ -0,0 +1,30 @@
+#! /usr/local/bin/perl -ws
+
+use Parse::RecDescent;
+
+$RD_WARN = undef;
+
+my $parse = Parse::RecDescent->new(<<'EOGRAMMAR');
+
+line: seplist[sep=>','] <score: @{$item[1]}>
+    | seplist[sep=>':'] <score: @{$item[1]}>
+    | seplist[sep=>" "] <score: @{$item[1]}>
+
+seplist: <skip:""> <leftop: /[^$arg{sep}]*/ "$arg{sep}" /[^$arg{sep}]*/>
+
+EOGRAMMAR
+
+while (<DATA>)
+{
+    chomp;
+    my $res = $parse->line($_);
+    print '[', join('][', @$res), "]\n";
+}
+
+__DATA__
+c,o,m,m,a,s,e,p,a,r,a,t,e,d
+c:o:l:o:n:s:e:p:a:r:a:t:e:d
+s p a c e s e p a r a t e d
+m u:l t i,s:ep ar:a,ted
+m u:l,t i,s:ep ar:a,ted
+m:u:l,t i,s:ep ar:a,ted

misc/d-bindings/Parse-RecDescent-master-demo/demo_selfmod.pl

@@ -0,0 +1,44 @@
+#! /usr/local/bin/perl -sw
+
+# A SELF-MODIFYING**2 PARSER
+
+use Parse::RecDescent;
+
+$grammar =
+q{
+	type_defn : 'only' <commit> "$::keyword" is type_name ';'
+		       { $thisparser->Replace("type_name: '$item[5]'");
+			  print "\"$item[5]\" is now the only valid type name\n";
+		       }
+
+		  | "$::keyword" <commit> identifier(s) is type_name /('?s)?/ ';'
+		       { my $newnames = join " | ", map { "'$_'" } @{$item[3]};
+			  $thisparser->Extend("type_name: $newnames");
+			  print "added $newnames as type name(s)\n";
+		       }
+
+		  | /change\s+$::keyword\s+to/ identifier
+		       { $::keyword = $item[2];
+			  print "changed $item[0] keyword to: $item[2]\n";
+		       }
+
+		  | <error>
+
+	is        : /is|are/
+
+	type_name : 'int' | 'float'
+
+	identifier: ...!is ...!"$::keyword" ...!type_name /[A-Za-z]\w*/
+
+};
+
+use vars qw { $keyword };
+
+$keyword = "type";
+
+$parse = new Parse::RecDescent ($grammar);
+
+while (<>)
+{
+	$parse->type_defn($_) or print "huh?\n";
+}

misc/d-bindings/Parse-RecDescent-master-demo/demo_separators.pl

@@ -0,0 +1,40 @@
+#! /usr/local/bin/perl -sw
+
+use Parse::RecDescent;
+
+undef $::RD_WARN;
+
+my $parse = Parse::RecDescent->new(<<'EOGRAMMAR');
+
+{use Tie::Hash; }
+
+line: <rulevar: local %max; tie %max, 'Tie::StdHash'; %max = (count => 0) >
+
+line: seplist[sep=>',']
+    | seplist[sep=>':']
+    | seplist[sep=>" "]
+    | { $max{item} }
+
+seplist: <skip:"">
+	 <leftop: /[^$arg{sep}]*/ "$arg{sep}" /[^$arg{sep}]*/>
+          { $max{count} = @{$max{item} = $item[2]}
+                if @{$item[2]} > $max{count};
+          }
+	 <reject>
+
+EOGRAMMAR
+
+while (<DATA>)
+{
+    chomp;
+    my $res = $parse->line($_);
+    print '[', join('][', @$res), "]\n";
+}
+
+__DATA__
+c,o,m,m,a,s,e,p,a,r,a,t,e,d
+c:o:l:o:n:s:e:p:a:r:a:t:e:d
+s p a c e s e p a r a t e d
+m u:l t i,s:ep ar:a,ted
+m u:l,t i,s:ep ar:a,ted
+m:u:l,t i,s:ep ar:a,ted

misc/d-bindings/Parse-RecDescent-master-demo/demo_simple.pl

@@ -0,0 +1,105 @@
+#!/usr/bin/env perl
+
+use v5.10;
+use warnings;
+
+
+# WHO IS NEXT TO WHOM?
+
+use Parse::RecDescent;
+
+$grammar =
+q{
+    <nocheck>
+
+	inputs   :	input(s)
+
+	input	 :	who_question "\n" {1}
+	     	 |	is_question  "\n" {1}
+	     	 |	statement    "\n" {1}
+	     	 |	/bye|quit|exit/ { exit }
+		 |	<reject:!$text> <error>     # ERROR IF NOT END OF TEXT
+		 |	{ print STDERR "resyncing\n" }
+
+			{ _error(@$_) foreach @{$thisparser->{errors}}; }
+			<resync>
+
+	statement:	namelist are <commit> 'next' 'to' namelist
+				{ ::nextto $item[1], $item[6], $thisline; 1 }
+		 |	<error?> <reject>
+
+	who_question:
+			'who' <commit> are 'next' 'to' name '?'
+				{ ::whonextto $item[6] ; 1 }
+		 |	<error?> <reject>
+
+	is_question:
+			'is' <commit> name 'next' 'to' name '?'
+				{ ::isnextto($item[3], $item[6]); 1 }
+		 |	<error?> <reject>
+
+	namelist :	name(s) 'and' <commit> namelist
+				{ [ @{$item[1]}, @{$item[3]} ] }
+		 |	name(s)
+
+	name	 :	...!'who' ...!'and' ...!are /[A-Za-z]+/
+
+	are	 :	'is' | 'are'
+};
+
+$parse = new Parse::RecDescent ($grammar);
+$parse->{tokensep} = '[ \t]*';
+
+$input = '';
+
+print "> ";
+while (<>)
+{
+
+	if (/^\.$/) { $parse->inputs($input) || print "huh?\n"; $input = '' }
+	else	    { $input .= $_ }
+	print "> ";
+}
+
+sub nextto($$$)
+{
+	foreach $A ( @{$_[0]} ) {
+	    foreach $B ( @{$_[1]} ) {
+		nexttoAB($A,$B,$_[2]);
+	    }
+	}
+	print "okay\n";
+}
+
+sub nexttoAB($$$)
+{
+	$nextto{$_[0]} or $nextto{$_[0]} = [];
+	$nextto{$_[1]} or $nextto{$_[1]} = [];
+	push @{$nextto{$_[0]}}, $_[1];
+	push @{$nextto{$_[1]}}, $_[0];
+	print "Learnt something from line $_[2]\n";
+}
+
+sub whonextto($)
+{
+	if (defined $nextto{$_[0]})
+		{ print join(" and ", @{$nextto{$_[0]}}) . ".\n"; }
+	else
+		{ print "sorry, I've never heard of $_[0].\n"; }
+}
+
+sub isnextto($$)
+{
+	if (!$nextto{$_[0]})
+		{ print "sorry, I've never heard of $_[0].\n"; }
+	elsif (!$nextto{$_[1]})
+		{ print "sorry, I've never heard of $_[1].\n"; }
+	else
+	{
+		foreach $name (@{$nextto{$_[0]}})
+		{
+			if ($name eq $_[1]) { print "yes\n"; return }
+		}
+		print "no\n";
+	}
+}

misc/d-bindings/Parse-RecDescent-master-demo/demo_simpleXML.pl

@@ -0,0 +1,93 @@
+#! /usr/local/bin/perl -w
+
+package XML2DS;
+use Parse::RecDescent;
+@ISA = qw( Parse::RecDescent );
+
+sub allow_nested
+{
+	my ($parser, $tag, @nestedtags) = @_;
+	my $nestedtags = join '|', map { '^'.$_.'$' } @nestedtags;
+	$parser->{allow}{$tag} = qr/$nestedtags/;
+}
+
+sub new
+{
+	bless Parse::RecDescent->new(<<'EOGRAMMAR'), XML2DS;
+
+	xml:  unitag(?)
+	   |  tag content[$item[1]](s) endtag[$item[1]]
+					{ bless $item[2], $item[1]}
+
+	unitag:
+		m{<([a-zA-Z]+)/>}	{ bless [], $1 }
+
+	tag:
+		m{<([a-zA-Z]+)>}	{ $return = $1 }
+
+	endtag:
+		m{</$arg[0]>}
+	      |	m{(\S+)} <error: was expecting </$arg[0]> but found $1 instead>
+
+	content: <rulevar: local $error>
+	content: rawtext <commit> check[$arg[0], $item[1]]
+	       | xml   <commit> check[$arg[0], $item[1]]
+	       | <error?: $error>  <error: error in <$arg[0]> block>
+
+	rawtext: m{[^<]+}		{ bless \$item[1], 'rawtext' }
+
+	check: { my ($outertag, $innertag) = ($arg[0], ref $arg[1]);
+		 $return = $arg[1] if !$thisparser->{allow}{$outertag}
+				   || $innertag =~ $thisparser->{allow}{$outertag};
+		 $error = ($innertag eq 'rawtext')
+			? "Raw text not valid in <$outertag> block"
+			: "<$innertag> tag not valid in <$outertag> block";
+		 undef;
+		}
+EOGRAMMAR
+}
+
+
+package main;
+use Data::Dumper;
+
+my $parser = XML2DS->new();
+
+$parser->allow_nested( Test    => qw(Example)	      );
+$parser->allow_nested( Example => qw(Data    rawtext) );
+$parser->allow_nested( Data    => qw(SubData rawtext) );
+$parser->allow_nested( SubData => qw(Example rawtext) );
+
+my $xml = join '', <DATA>;
+
+if (my $tree = $parser->xml($xml))
+{
+	print Data::Dumper->Dump([$tree]);
+}
+
+
+__DATA__
+
+<Test>
+	<Example/>
+	<Example>
+		<Data>
+			raw data
+			<SubData>
+				raw subdata
+			</SubData>
+			more raw data
+		</Data>
+		<Data>
+			still more raw data
+			<SubData>
+				<Example>
+					<Data>
+						nested example data
+					</Data>
+				</Example>
+			</SubData>
+		</Data>
+		last rawtext
+	</Example>
+</Test>

misc/d-bindings/Parse-RecDescent-master-demo/demo_simplequery.pl

@@ -0,0 +1,42 @@
+#! /usr/local/bin/perl -ws
+
+use Parse::RecDescent;
+use Data::Dumper;
+
+use Parse::RecDescent;
+
+my $grammar = <<'EOGRAMMAR';
+
+	{ my  %patterns; }
+
+	query:	  { %patterns=() }
+		  pattern(s) end_of_query
+		  { $return = { %patterns } }
+	     |    <error>
+
+	end_of_query: /\Z/
+
+	pattern: '+' string  { push @{$patterns{required}}, $item[2] }
+	       | '-' string  { push @{$patterns{excluded}}, $item[2] }
+	       | string      { push @{$patterns{optional}}, $item[1] }
+	       | <error>
+
+	string: quoted_string
+	      | bareword
+
+	quoted_string:
+		 { my $string = extract_delimited($text,q{'"});
+		   $return = substr($string,1,length($string)-2) if $string; }
+
+	bareword: /\w+/
+
+EOGRAMMAR
+
+my $parser = Parse::RecDescent->new($grammar) or die;
+
+while (<>)
+{
+	my $query = $parser->query($_);
+	print Data::Dumper->Dump([$query],['query']);
+}
+

misc/d-bindings/Parse-RecDescent-master-demo/demo_skipcomment.pl

@@ -0,0 +1,33 @@
+#!/usr/local/bin/perl -ws
+
+# REMOVE COMMENTS FROM C++ CODE
+
+use strict;
+use Parse::RecDescent;
+
+use vars qw/ $Grammar /;
+
+$RD_TRACE=1;
+my $parser = new Parse::RecDescent $Grammar  or  die "invalid grammar";
+
+undef $/;
+my $text = @ARGV ? <> : <DATA>;
+
+print join " ", @{$parser->program($text) or die "malformed C program"};
+
+BEGIN
+{ $Grammar=<<'EOF';
+
+program	: <skip:qr/(\s+|#.*\n)*/> part(s)
+
+part	: /\S+/
+EOF
+}
+__DATA__
+
+Now we find # to our inexpressible joy
+That the parser # a cunningly wrought thing
+Skips both whitespace # the usual behaviour
+# though it be configurable
+And comments
+#however many there be

misc/d-bindings/Parse-RecDescent-master-demo/demo_street.pl

@@ -0,0 +1,34 @@
+#! /usr/local/bin/perl -ws
+
+use Parse::RecDescent;
+
+my $street_type = join '|', qw
+{
+        Street		St\.?
+        Road		Rd
+        Avenue		Ave\.?
+	Lane
+	Way
+	Highway		Hwy
+};
+
+sub Parse::RecDescent::street_name
+{
+	print join('|', @_), "\n";
+        $_[1] =~ s/\A\s*(([A-Z]+\s+)+($street_type))//io;
+        return $1;
+}
+
+my $parser = Parse::RecDescent->new(<<'EOGRAMMAR');
+
+	addr: /\d+[A-Z]?/i street_name
+		{ print "Number $item[1] in $item{street_name}\n" }
+
+EOGRAMMAR
+
+while (<>)
+{
+	$parser->addr($_);
+}
+
+

misc/d-bindings/Parse-RecDescent-master-demo/demo_template.pl

@@ -0,0 +1,33 @@
+#! /usr/local/bin/perl -sw
+
+use Parse::RecDescent;
+
+$grammar = q {
+		list: 	  <leftop: <matchrule:$arg{rule}> /$arg{sep}/ <matchrule:$arg{rule}> >
+
+		function: 'func' ident '(' list[rule=>'param',sep=>';'] ')'
+				{{ name=>$item{ident}, param=>$item{list} }}
+
+		param:	  list[rule=>'ident',sep=>','] ':' typename
+				{{ vars=>$item{list}, type=>$item{typename} }}
+
+		ident:	  /\w+/
+
+		typename: /\w+/
+	     };
+
+unless( $parser = new Parse::RecDescent( $grammar ))
+{
+    die "bad grammar; bailing\n";
+}
+
+while (defined($input = <DATA>))
+{
+	use Data::Dumper;
+	print Data::Dumper->Dump([$parser->function( $input )]);
+}
+
+__DATA__
+func f (a,b,c:int; d:float; e,f:string)
+func g (x:int)
+func h (y;x)

misc/d-bindings/Parse-RecDescent-master-demo/demo_textgen.pl

@@ -0,0 +1,172 @@
+#! /usr/local/bin/perl -ws
+$|++;
+
+use Parse::RecDescent;
+# $::RD_TRACE = 1;
+
+my $start = "START";		# start symbol
+
+(my $parser = Parse::RecDescent->new(<<'END_OF_GRAMMAR')) or die "bad!";
+
+## return hashref
+## { ident => {
+##     is => [
+##       [weight => item, item, item, ...],
+##       [weight => item, item, item, ...], ...
+##     ],
+##     defined => { line-number => times }
+##     used => { line-number => times }
+##   }, ...
+## }
+## item is " literal" or ident
+## ident is C-symbol or number (internal for nested rules)
+
+{ my %grammar; my $internal = 0; }
+
+grammar: rule(s) /\Z/ { \%grammar; }
+
+## rule returns identifier (not used)
+rule: identifier ":" defn ';' {
+           push @{$grammar{$item[1]}{is}}, @{$item[3]};
+           $grammar{$item[1]}{defined}{$itempos[1]{line}{to}}++;
+           $item[1];
+           }
+    | <error>
+
+## defn returns listref of choices
+defn: <leftop: choice "|" choice>
+
+## choice returns a listref of [weight => @items]
+choice: unweightedchoice { [ 1 => @{$item[1]} ] }
+    | /\d+(\.\d+)?/ /\@/ unweightedchoice { [ $item[1] => @{$item[3]} ] }
+
+## unweightedchoice returns a listref of @items
+unweightedchoice: item(s)
+
+item: quoted_string
+    | identifier ...!/:/ {
+        $grammar{$item[1]}{used}{$itempos[1]{line}{to}}++;
+        $item[1]; # non-leading space flags an identifier
+    }
+    | "(" defn ")" { # parens for recursion, gensym an internal
+        ++$internal;
+        push @{$grammar{$internal}{is}}, @{$item[2]};
+        $internal;
+    }
+    | <error>
+
+quoted_string: /"/ <skip:""> quoted_char(s?) /"/ {
+        " " . join "", @{$item[3]} # leading space flags a string
+    }
+
+## this should be expanded, but it works for this grammar :)
+quoted_char:
+      /[^\\"]+/
+    | /\\n/ { "\n" }
+    | /\\"/ { "\"" }
+
+identifier: /[A-Za-z_]\w*/
+
+END_OF_GRAMMAR
+
+my @data = <DATA>;
+for (@data) {
+  s/^\s*#.*//;
+}
+
+(my $parsed = $parser->grammar(join '', @data)) or die "bad parse";
+
+for my $id (sort keys %$parsed) {
+  next if $id =~ /^\d+$/;	# skip internals
+  my $id_ref = $parsed->{$id};
+  unless (exists $id_ref->{defined}) {
+    print "$id used in @{[sort keys %{$id_ref->{used}}]} but not defined - FATAL\n";
+  }
+  unless (exists $id_ref->{used} or $id eq $start) {
+    print "$id defined in @{[sort keys %{$id_ref->{defined}}]} but not used - WARNING\n";
+  }
+}
+
+use Data::Dumper; print Dumper($parsed);
+show($start);
+
+sub show {
+  my $defn = shift;
+  die "missing defn for $defn" unless exists $parsed->{$defn};
+
+  my @choices = @{$parsed->{$defn}{is}};
+  my $weight = 0;
+  my @keeper = ();
+  while (@choices) {
+    my ($thisweight, @thisitem) = @{pop @choices};
+    $thisweight = 0 if $thisweight < 0; # no funny stuff
+    $weight += $thisweight;
+    @keeper = @thisitem if rand($weight) < $thisweight;
+  }
+  for (@keeper) {
+    ## should be a list of ids or defns
+    die "huh $_ in $defn" if ref $defn;
+    if (/^ (.*)/s) {
+      print $1;
+    } elsif (/^(\w+)$/) {
+      show($1);
+    } else {
+      die "Can't show $_ in $defn\n";
+    }
+  }
+}
+
+
+__END__
+START: stanza "\n---\n" stanza "\n---\n" stanza;
+
+stanza: stanza " " exclaim " " stanza2 | stanza2;
+stanza2: sentence " " comparison " " question |
+         sentence " " comparison |
+         comparison " " comparison " " exclaim |
+         address " " question " " question " " sentence;
+
+sentence: sentence "\n" sentence2 | sentence2;
+sentence2: "The " adjectiveNotHep " " personNotHep " " verbRelating " the "
+adjectiveHep " " personHep "." |
+"The " personHep " " verbRelating " the " adjectiveNotHep ", " adjectiveNotHep " " personNotHep ".";
+
+question: question " " question2  | question2;
+question2: ques_start " " adjectiveHep " " personNotHep "?" |
+ques_start " " adjectiveNotHep " " personHep "?";
+
+comparison: comparison " " comparison2 | comparison2;
+comparison2: "One says '" compNotHep "' while the other says '" compHep
+"'." |
+"One thinks '" compNotHep "' while the other thinks '" compHep "'." |
+"They shout '" compNotHep "!' And we shout '" compHep "'." |
+"It's " compNotHep " versus " compHep "!" ;
+
+personNotHep:  "capitalist" | "silk purse man" | "square" | "banker" |
+"Merchant King" | "pinstripe suit" ;
+
+personHep: "cat" | "beat soul" | "wordsmith" | "hep cat" | "free man" |
+"street poet" | "skin beater" | "reed man" ;
+
+adjectiveNotHep: "soul-sucking" | "commercial" | "cash-counting" |
+"bloody-handed" | "four-cornered" | "uncool" | "love-snuffing";
+
+adjectiveHep: "love-drunk" | "cool, cool" | "happening" | "tuned-in" |
+"street wise" | "wise and learned";
+
+verbRelating: "begrudges" | "fears" | "distresses" | "dodges" |
+"dislikes" | "evades" | "curses" | "belittles" | "avoids" | "battles";
+
+compNotHep: "recreation" | "isolation" | "tranportation" | "sacred nation"
+  | "complication" | "subordination";
+compHep: "fornication" | "instigation" | "interpretation" | "elevation"
+| "animation" | "inebriation" | "true relation";
+
+ques_start: 2 @ (5 @ "Could there ever" | 7 @ "How could there") " be a" |
+  "Can you picture a" ;
+address:  "Catch this:" | "Listen, cats," | "Dig it:" |
+  "I lay this on you:";
+exclaim: "Heavy, man."| "Heavy." | "Yow!" | "Snap 'em for me." |
+  "Dig it.";
+
+

misc/d-bindings/Parse-RecDescent-master-demo/demo_tokens.pl

@@ -0,0 +1,26 @@
+#! /usr/local/bin/perl -w
+
+use Parse::RecDescent;
+use Data::Dumper;
+
+my $lexer = new Parse::RecDescent q
+{
+	lex:	token(s)
+
+  	token:	/(I|you|he)\b/i	<token:PRON>
+ 	     |	/(is|are)\b/	<token:VERB>
+	     |	'dumbest'	<token:ADJ>
+	     |	'Bill-loving'	<token:ADJ>
+	     |	'clearly'	<token:ADJ>
+	     |	/the\b|a\b/	<token:ARTICLE>
+	     |	/\w+/		<token:WORD>
+	     |  /\S+/		<token:PUNCT,OTHER>
+};
+
+my $tokens = $lexer->lex(join "", <DATA>);
+
+print  Data::Dumper->Dump($tokens);
+
+__DATA__
+
+You are clearly the dumbest, Bill-loving script-kiddie I have ever seen!

misc/d-bindings/Parse-RecDescent-master-demo/demo_undumper.pl

@@ -0,0 +1,441 @@
+#!/usr/bin/perl -w
+use strict;
+$|++;
+
+# $::RD_TRACE = 80;
+$::RD_HINT = 1;
+
+use Parse::RecDescent;
+use Data::Dumper;
+
+## define grammar
+
+my $parser = Parse::RecDescent->new(q{
+
+{ my %TABLE; }
+
+file: { %TABLE = (); } assignment(s?) /\z/ { \%TABLE }
+
+assignment: scalar_assignment | <error>
+
+scalar_assignment: scalar_lvalue '=' scalar_rvalue ';'
+  { ${$item{scalar_lvalue}} = ${$item{scalar_rvalue}}; 1; }
+
+## lvalues, indicated as reference to value, so we can assign to them
+
+scalar_lvalue: deref_head deref_chain(?) {
+  my $return = $item{deref_head};
+  if ($item{deref_chain}) {
+    for (@{$item{deref_chain}[0]}) {
+      if ($_->[0] eq "hash") {
+        $return = \$$return->{${$_->[1]}};
+      } elsif ($_->[0] eq "array") {
+        $return = \$$return->[${$_->[1]}];
+      } else { die "what is $_->[0]?" }
+    }
+  }
+  $return;
+}
+deref_head: simple_scalar_lvalue | simple_scalar_rvalue
+deref_chain: "->" hash_or_array_subscript deref_chain_more(s?)
+  { [$item[2], @{$item[3]}] }
+deref_chain_more: "->" hash_or_array_subscript | hash_or_array_subscript
+hash_or_array_subscript: hash_subscript | array_subscript
+hash_subscript: "{" scalar_constant "}"
+  { ["hash", $item{scalar_constant}] }
+array_subscript: "[" scalar_constant "]"
+  { ["array", $item{scalar_constant}] }
+
+simple_scalar_lvalue: '$' ident
+  { \ $TABLE{'$' . $item{ident}} }
+ident: /[^\W\d]\w*/
+
+simple_scalar_lvalue: '$' '{' scalar_rvalue '}'
+  { \ ${${$item{scalar_rvalue}}} }
+
+## rvalues, indicated as reference to value, because "undef" is legal
+
+scalar_rvalue: simple_scalar_rvalue | scalar_lvalue
+
+simple_scalar_rvalue: scalar_constant
+scalar_constant: 'undef'
+  { \ undef }
+scalar_constant: /-?[1-9]\d*|0/
+  { \ $item[1] }
+scalar_constant: <perl_quotelike>
+  { \ $item[1][2] }
+
+simple_scalar_rvalue: "\x5C" scalar_rvalue
+  { \ $item{scalar_rvalue} }
+simple_scalar_rvalue: '[' scalar_rvalue(s? /,/) ']'
+  { \ [map $$_, @{$item[2]}] }
+simple_scalar_rvalue: '{' hashpair(s? /,/) '}'
+  { \ {map @$_, @{$item[2]}} }
+hashpair: scalar_constant '=>' scalar_rvalue
+  { [${$item{scalar_constant}}, ${$item{scalar_rvalue}}] }
+simple_scalar_rvalue: 'bless' '(' scalar_rvalue ',' scalar_constant ')'
+  { \ bless( ${$item{scalar_rvalue}}, ${$item{scalar_constant}} ) }
+simple_scalar_rvalue: 'do' '{' "\x5C" '(' 'my' '$o' '=' scalar_rvalue ')' '}'
+  { \ do { \ (my $o = ${$item{scalar_rvalue}})} }
+
+}) or die "compile";
+
+## following tests from t/dumper.t in 5.6.1 distribution
+
+if (0) {
+  my @c = ('c');
+  my $c = \@c;
+  my $b = {};
+  my $a = [1, $b, $c];
+  $b->{a} = $a;
+  $b->{b} = $a->[1];
+  $b->{c} = $a->[2];
+
+  test([$a, $b, $c], [qw(a b c)]);
+}
+
+if (0) {
+  my $foo = { "abc\000\'\efg" => "mno\000",
+              "reftest" => \\1,
+            };
+
+  test([$foo], [qw($foo)]);
+}
+
+if (0) {
+  my $foo = 5;
+  my @foo = (-10,\$foo);
+  my %foo = (a=>1,b=>\$foo,c=>\@foo);
+  $foo{d} = \%foo;
+  $foo[2] = \%foo;
+
+  test([\%foo],[qw($foo)]);
+}
+
+if (0) {
+  my @dogs = ( 'Fido', 'Wags' );
+  my %kennel = (
+            First => \$dogs[0],
+            Second =>  \$dogs[1],
+           );
+  $dogs[2] = \%kennel;
+  my $mutts = \%kennel;
+  test([\@dogs, \%kennel, $mutts], [qw($dogs $kennel $mutts)]);
+}
+
+if (0) {
+  my $a = [];
+  $a->[1] = \$a->[0];
+  test([$a], [qw($a)]);
+}
+
+if (0) {
+  my $a = \\\\\'foo';
+  my $b = $$$a;
+  test([$a, $b], [qw($a $b)]);
+}
+
+if (1) {
+  my $b;
+  my $a = [{ a => \$b }, { b => undef }];
+  $b = [{ c => \$b }, { d => \$a }];
+  timetest([$a, $b], [qw($a $b)]);
+}
+
+if (0) {
+  my $a = [[[[\\\\\'foo']]]];
+  my $b = $a->[0][0];
+  my $c = $${$b->[0][0]};
+  test([$a, $b, $c], [qw($a $b $c)]);
+}
+
+if (0) {
+  my $f = "pearl";
+  my $e = [        $f ];
+  my $d = { 'e' => $e };
+  my $c = [        $d ];
+  my $b = { 'c' => $c };
+  my $a = { 'b' => $b };
+  test([$a, $b, $c, $d, $e, $f], [qw($a $b $c $d $e $f)]);
+}
+
+if (0) {
+  my $a;
+  $a = \$a;
+  my $b = [$a];
+  test([$b], [qw($b)]);
+}
+
+## end of tests from t/dumper.t, now some of my own
+
+if (0) {
+  my $x = bless {fred => 'flintstone'}, 'x';
+  my $y = bless \$x, 'y';
+  timetest([$x, $y], [qw($x $y)]);
+}
+
+sub test {
+  my $input = Data::Dumper->new(@_)->Purity(1)->Dumpxs;
+  print "=" x 60, "\ninput:\n$input\n==>\noutput:\n";
+  my $symbol = $parser->file($input) or die "execute";
+  print Data::Dumper->new([values %$symbol], [keys %$symbol])->Purity(1)->Dumpxs;
+}
+
+sub timetest {
+  require Benchmark;
+
+  my $input = Data::Dumper->new(@_)->Purity(1)->Dumpxs;
+  print "=" x 60, "\ninput:\n$input\n==>\noutput:\n";
+  Benchmark::timethese(0, {
+                           PRD => sub {
+                             package Dummy;
+                             no strict;
+                             my $symbol = $parser->file($input)
+                               or die "execute";
+                           },
+                           EVAL => sub {
+                             package Dummy;
+                             no strict;
+                             eval $input;
+                           },
+                          });
+}
+
+=head1 Linux Magazine Column 29 (Oct 2001)
+
+[suggested title: Safe Undumping]
+
+Recently on the Perl Monestary at C<http://www.perlmonks.org/>, the
+user known as C<ton> asked about parsing a Perl-style double-quoted
+string, as part of a project to construct a safe C<Data::Dumper>
+parser that would take the output and interpret it rather than handing
+the result directly to C<eval> as is typically done.  A few postings
+later, the work in progress for their C<Undumper> was posted, and I commented
+that there was probably a simpler way to do some of the things,
+and that it didn't handle blessed references.
+
+Well, me and my big mouth.  Or was it my continuing curiousity to
+tinker with Damian Conway's excellent C<Parse::RecDescent> module? I'm
+not sure, but I found myself over the next dozen hours or so staring
+at C<Data::Dumper> source code, output, test cases, and
+C<Parse::RecDescent> traces and documentation.  I also pounded my head
+on the desk for better than a day trying to figure out how to break a
+left-recursion loop, and came up with a nice obvious (now!) solution.
+
+The point of this is to be able to take the output of C<Data::Dumper>
+and reconstruct the original data, but not open ourselves to the
+possibility of being fed dangerous constructs, like backticks or
+symbol-table-manipulating code.  Sure, you could also do this with the
+right use of the C<Safe> module, but I was already committed to
+finishing this version before I thought of that.  Maybe another column
+someday.
+
+But anyway, that brings us to the program in [listing one, below].
+Most of this program is input to C<Parse::RecDescent>, so I'll start
+by setting that aside and describing the Perl support structure first.
+
+Lines 1 through 3 start nearly every program I write, turning on
+warnings, compiler restrictions, and disabling the buffering on
+C<STDOUT>.
+
+Lines 5 and 6 control the behaviour of C<Parse::RecDescent>. When
+tracing is enabled (although commented out here), I can see how the
+parse is progressing. The number 80 trims the "to-be-parsed" string
+dumping to its first 80 characters, which is usually plenty for me to
+see what's going on. I left hints enabled, because the error messages
+that result from a hint were often helpful in debugging the grammar.
+
+Lines 8 and 9 pull in the C<Parse::RecDescent> (found in the CPAN) and
+C<Data::Dumper> (part of the core Perl distribution) modules.
+
+Lines 13 to 81 form the input grammar for C<Parse::RecDescent>,
+included as a single-quoted string using C<q{}> for delimiters. Damian
+Conway seems to prefer this quoting style for sending stuff to
+C<Parse::RecDescent>, so I've copied it at least here. In other
+places, I might have used a "here-document" instead. The result of
+feeding this grammar to C<Parse::RecDescent> is a parser object that
+we can then call on to parse the output of C<Data::Dumper> to "undump"
+it. If the grammar is bad, we die in line 81. At that point
+C<Parse::RecDescent> has already printed its own diagnostics, expanded
+by the enabled "hint" flag earlier.
+
+During development, I probably changed this grammar over 50 times,
+constantly tweaking it to recognize each new thing that I encountered
+in the input source. The hints were often useful, although the "left
+recursion" problem (that I'll describe later) had me stumped for the
+better part of two days.
+
+Once we have a parser object (in $parser), the action to "undump" a
+string containing Perl code is simple.  Skipping down quickly to the
+C<test> subroutine starting at line 177, we can see the use of this
+C<$parser> to take a given C<$input> and transform it to a hashref
+response (saved as C<$symbol> here). The keys of the hashref contain
+the top-level scalar variable names, which default to C<$VAR1>,
+C<$VAR2> and so on, unless overridden during the dumping. The values
+of this hashref are then the corresponding values of those variables
+from the original dump, as best can be reconstructed.
+
+The C<test> subroutine here uses C<Data::Dumper> to convert an
+existing collection of values (passed in as arguments) into a string,
+shows the string as the input to the undumper, then parses the string
+with the constructed parser object. The output of this undumping
+process is then dumped once again and shown. The comparison process
+has to be a manual one, because it is sensitive to the order in which
+the items are presented to C<Data::Dumper>.
+
+Above the definition of this testing routine is a series of tests that
+I used to develop and verify the undumper.  I started with the
+included tests found in the Perl 5.6.1 distribution to verify Perl on
+initial installation.  I actually didn't include the entire test, but
+took the data structure for each applicable test and copied that into
+this program.  I skipped over the tests that included symbol-table
+references (using globs) or coderefs, because I chose to ignore that
+for this program.  Each test provides an arrayref containing the
+references to be dumped, and most tests also provide a label list to
+keep the variables from simply being named C<$VAR1>, C<$VAR2> and so
+on.
+
+I enclosed each test in a conditional that I could switch between "if
+(0)" and "if (1)" to either run the test or skip it.  When I was
+focussing on a new feature, I enabled only one test until it worked,
+but once I got a good run, I reenabled all previous tests to ensure
+that I didn't break something else in the process.
+
+The "Extreme Programming" technique relies on this strategy of
+creating tests first and driving the development from those tests, and
+it worked nicely for the development of this program.  Other than a
+few snippets of code that I used for scaffolding to test some initial
+grammar ideas, all of the code that I used to develop and test this
+code is thereby archived along with the routines, for later
+maintenance to take place easily.
+
+Any one of the tests can be switched to invoke C<timetest> rather than
+C<test>, as I've done on the final test (starting in line 171).  This
+final test, by the way, exercises blessed references (objects), which
+none of the distribution tests even approach.  (Maybe a patch to the
+distribution's C<t/dumper.t> is in order?)  Using C<timetest>, we pop
+down to the routine beginning in line 184, which runs a quick
+benchmark comparing a straight C<eval> with our safe undumping parser.
+I'm using the C<timethese> routine from C<Benchmark> (a standard Perl
+module), giving it the default "0 times", which attempts to run each
+routine for slighly over 3 CPU seconds to compute an interations per
+second for each type.
+
+The bad news is that my code clocks in at 1/100th of the speed of
+C<eval>.  Ahh, the price to pay for safety.  The good news is that the
+speed difference is probably negligible for typical applications, and
+pennies to pay for the dollars saved in having a safe evaluation of
+what should be good C<Data::Dumper> output.
+
+Well, what little Perl code there is (outside of the grammar), that's
+it.  So let's pick apart the grammar now, starting back up at line 13.
+
+Line 15 declares a variable local to the parser for the "symbol table"
+we'll be creating.  The keys will be the full variable names as given
+in the dump. The values will be the constructed value for that
+key. Yes, this is the hash that is returned upon a successful parse.
+
+Line 17 defines the top-level rule for the parse.  A "file" is zero or
+more "assignments".  Howver, we also have to clear out the possibly
+leftover values from the previous run, and this is handled by the
+action block immediately preceding the assignment. We also have to
+verify that we've parsed the entire input string, which I'll do by
+matching C</\z/>, which matches only at the end of the string. If all
+went well, we'll return the hashref.
+
+Line 19 defines an assignment.  Currently, I'm handling only a scalar
+assignment, although C<Data::Dumper> can also generate array and hash
+assignments under some circumstances.  Gotta leave something for
+"release 2.0".
+
+Lines 21 and 22 define a scalar assignment, and the action to take for
+that.  A scalar assignment consists of an "lvalue" (like a variable)
+and an "rvalue" (like an expression).  Both lvalues and rvalues are
+references, so we dereference each of them in the action, and perform
+the requested assignment to keep our "virtual Perl symbol table" up to
+date.  The action returns a constant 1 to let the parent rule know
+that this rule succeeded.  Without that, an C<undef> value being
+assigned would have caused that rule to fail (one of my debugging
+attempts revealed such, with much head-banging-on-desk until I
+realized what I was doing).
+
+Lvalues are defined starting in line 24.  The most complex lvalue is a
+dereferenced scalar reference, handled in lines 26 to 47.  This is
+because C<Data::Dumper> can generate a reference path to a specific
+entry in the data structure to patch it up so that it points to a
+proper place for complex data interelationships.  For example, if an
+element of C<@a> points to C<@b>, but an element of C<@b> points to
+C<@a>, the "chicken-and-egg" tie is broken by first generating C<@a>
+without the C<@b> reference, then C<@b> with the C<@a> reference, then
+patching up C<@a> finally to point to C<@b>.
+
+The definition starting in line 26 uses a C<deref_head> to be a simple
+scalar, followed by an optional C<deref_chain> which is one or more
+array-element or hash element dereferences.  Let's look at the syntax
+before we study the actions taken.  Line 39 shows us that
+C<deref_head> is either a C<simple_scalar_lvalue> or
+C<simple_scalar_rvalue>.
+
+Further down in lines 49 and 53, we see that a C<simple_scalar_lvalue>
+can be either a scalar variable or a scalar reference dereference.
+And that would form the head of the chain.  If it's a scalar variable,
+we take a reference to a hash element in our "symbol table", and
+return that.  The key is the name of the variable, including the
+dollar sign.  This permits eventual expansion to include arrays and
+hashes in our "symbol table", again for version 2.0.  For the
+dereference of the scalar reference, we emulate the same steps in our
+virtual world, again returning a reference for all lvalues.
+
+Once we have the chain head, we then look for a dereference chain
+(line 40), starting with the mandatory arrow then a hash or array
+subscript expression.  This may be followed with additional
+arrow-optional hash or array subscript expressions (line 42).  Each
+subscript is returned as a two-element arrayref, with either the
+keyword "hash" or "array" followed by the scalar constant selecting
+the particular element (lines 45 and 47).  The action in line 41 rolls
+up the deref chain as a reference to an array of those two-element
+arrayrefs.
+
+Back in line 26, we thus have a reference to a starting point for the
+C<deref_head>, and possible one or more dereferences to apply to it.
+The action in lines 27 to 37 walk the dereference chain to get to the
+final target lvalue, and return it (as a reference to a scalar
+somewhere in our virtual Perl symbol space).
+
+On the other side of the equation, we've got rvalues of various
+shapes, defined in line 58 to be either a C<simple_scalar_rvalue> or a
+C<scalar_lvalue>.  The loop back to C<scalar_value> is necessary
+because any variable reference is also itself a source of values.
+
+Lines 60 to 66 define the only scalar constants that C<Data::Dumper>
+seems to emit: C<undef>, simple signed integers, and quoted strings.
+These values are returned as references to those values so that
+C<undef> can be a valid return value: again, something I figured out
+the hard way after my rule for C<undef> kept breaking.
+
+Lines 68 to 75 handle the reference values: scalar references, array
+references, and hash references.  Again, the syntax is very narrow:
+just the types of things I was able to see C<Data::Dumper> generate,
+both by trying some sample data, and by lightly examining the source
+code to C<Data::Dumper>.  I may have missed a form or two, in which
+case this grammar will make it easy to add additional forms.
+
+The grammar is nicely recursive: an array reference in turn contains
+one or more C<scalar_rvalue> items, which brings us right back to the
+same place in the hierarchy, but at a nested level.
+
+Lines 76 to 79 handle blessed references. Again, the syntax is very
+specific to what I was able to determine about C<Data::Dumper>'s
+behavior.
+
+And that's pretty much it.  The grammar looks for a series of
+assignments, each of which is an lvalue being given an rvalue.  Some
+of the lvalues ultimately lead to symbol table entries, which then
+populate our symbol table hash with keys and values when assigned.
+Rvalues can be constants, or pointers into existing data in the symbol
+table.  OK, it I<is> somewhat full of smoke and mirrors, and I was
+rather pleased when the whole thing worked.  And on some rainy Oregon
+afternoon, I hope to extend it to handle arrays and hashes as well, just
+to make it extremely flexible and universal. I even have some ideas
+about how to get it to handle globs. But that's for another day: until
+next time, enjoy!

misc/d-bindings/Parse-RecDescent-master-demo/demo_whoson.pl

@@ -0,0 +1,123 @@
+#! /usr/local/bin/perl -ws
+
+# WHO'S ON FIRST?
+
+use vars qw( @base @man @attempt );   # This is a comment
+
+use Parse::RecDescent;
+
+sub Parse::RecDescent::choose { $_[int rand @_]; }
+
+$abbott = new Parse::RecDescent <<'EOABBOTT';
+
+	Interpretation:
+		ConfirmationRequest
+	      | NameRequest
+	      | BaseRequest
+
+	ConfirmationRequest:
+	       	Preface(s?) Name /[i']s on/ Base
+			{ (lc $::man{$item[4]} eq lc $item[2])
+				? "Yes"
+				: "No, $::man{$item[4]}\'s on $item[4]"
+			}
+
+	      | Preface(s?) Name /[i']s the (name of the)?/ Man /('s name )?on/ Base
+			{ (lc $::man{$item[6]} eq lc $item[2])
+				? "Certainly"
+				: "No. \u$item[2] is on " . $::base{lc $item[2]}
+			}
+
+	BaseRequest:
+	        Preface(s?) Name /(is)?/
+			{ "He's on " . $::base{lc $item[2]} }
+
+	NameRequest:
+	        /(What's the name of )?the/i Base "baseman"
+			{ $::man{$item[2]} }
+
+	Preface: ...!Name /\S*/
+
+	Name:	/Who/i  | /What/i  | /I Don't Know/i
+
+	Base:	'first' | 'second' | 'third'
+
+	Man:	'man'   | 'guy'    | 'fellow'
+EOABBOTT
+
+$costello = new Parse::RecDescent <<'EOCOSTELLO';
+
+	Interpretation:
+		Meaning <reject:$item[1] eq $thisparser->{prev}>
+			{ $thisparser->{prev} = $item[1] }
+	      | { choose(@::attempt) }
+
+	Meaning:
+		Question
+	      | UnclearReferent
+	      | NonSequitur
+	      | { choose(@::attempt) }
+
+	Question:
+	        Preface Interrogative /[i']s on/ Base
+	      		{ choose ("Yes, what is the name of the guy on $item[4]?",
+				  "The $item[4] baseman?",
+				  "I'm asking you! $item[2]?",
+				  "I don't know!")			}
+
+	      | Interrogative
+	      		{ choose ("That's right, $item[1]?",
+				  "What?",
+				  "I don't know!")			}
+
+	UnclearReferent:
+	        "He's on" Base
+	      		{ choose ("Who's on $item[2]?",
+				  "Who is?",
+				  "So, what is the name of the guy on $item[2]?"
+				  )					}
+
+	NonSequitur:
+		( "Yes" | 'Certainly' | /that's correct/i )
+			{ choose("$item[1], who?",
+				 "What?",
+				 @::attempt)				}
+
+	Interrogative: /who/i | /what/i
+
+	Base:	'first' | 'second' | 'third'
+
+	Preface: ...!Interrogative /\S*/
+
+EOCOSTELLO
+
+%man = ( first => "Who", second => "What", third => "I Don't Know" );
+%base  = map { lc } reverse %man;
+
+@attempt =
+(
+	"So, who's on first?",
+	"I want to know who's on first?",
+	"What's the name of the first baseman?",
+	"Let's start again. What's the name of the guy on first?",
+	"Okay, then, who's on second?",
+	"Well then, who's on third?",
+	"What's the name of the fellow on third?",
+);
+
+$costello->{prev} = "Who's on first?";
+$line = "Who's on first?";
+
+$n = 15;
+$i = 0;
+while ($i < $n)
+{
+	print "<costello>  ", $line, "\n";
+	$line = $abbott->Interpretation($line);
+	sleep 1;
+	print "<abbott>    ", $line, "\n";
+	$line = $costello->Interpretation($line);
+	sleep 1;
+	++$i;
+}
+

misc/d-bindings/ParsePPCHeader.pm

@@ -0,0 +1,178 @@
+package ParsePPCHeader;
+
+# parse a pre-processed C header (with gcc -E)
+
+use strict;
+use warnings;
+
+use CGrammar;  # <== an auto-generated file
+use CGrammar2; # <== an auto-generated file
+
+# for globals
+use G;
+use F;
+
+# for debugging:
+my $COMP = 0;
+
+sub parse_cfile {
+  # input can be on of four types:
+  #   a file name of lines
+  #   a file ptr to a file of lines
+  #   an array ref of lines
+  #   a string
+  my $argref = shift @_;
+  my $r = ref $argref;
+  die "FATAL:  Input arg is NOT a HASH ref."
+    if $r ne 'HASH';
+
+  my $ityp = $argref->{ityp};
+  die "FATAL:  Input arg 'ityp' not found."
+    if (!defined $ityp || !exists $G::ityp{$ityp});
+
+  my $ival = $argref->{ival};
+  die "FATAL:  Input arg 'ival' not found."
+    if !defined $ival;
+
+  my $oref = $argref->{oref};
+  $oref = 0 if !defined $oref;
+
+  # The diagnostics provided by the tracing mechanism always go to
+  # STDERR. If you need them to go elsewhere, localize and reopen
+  # STDERR prior to the parse.
+  #
+  # For example:
+  #
+  #  {
+  #      local *STDERR = IO::File->new(">$filename") or die $!;
+  #
+  #      my $result = $parser->startrule($text);
+  #  }
+
+  if ($oref) {
+    my $errfil = 'PRD-errfile.txt';
+    local *STDERR = IO::File->new(">$errfil")
+      or die $!;
+    push @{$oref}, $errfil
+      if $oref;
+  }
+
+  my $text;
+
+  if ($argref->{ityp} eq 'fnam') {
+    local $/;
+    open my $fp, '<', $ival
+      or die "$ival: $!";
+    my @ilines = <$fp>;
+    $text = join(' ', @ilines)
+  }
+  elsif ($argref->{ityp} eq 'fp') {
+    local $/;
+    my $fp = $ival;
+    my @ilines = <$fp>;
+    $text = join(' ', @ilines);
+  }
+  elsif ($argref->{ityp} eq 'str') {
+    $text = $ival;
+  }
+  elsif ($argref->{ityp} eq 'aref') {
+    local $/;
+    $text = join(' ', @{$ival});
+  }
+
+  my $parser = CGrammar->new();
+
+  # the absolute top level
+  my $ptree = $parser->translation_unit($text);
+
+  if (!defined $ptree) {
+    warn "undef \$ptree";
+    my $line = $argref->{first_line};
+    $line = -1 if !defined $line;
+    if ($G::debug) {
+      print "DEBUG: test input (line: $line)\n";
+      print "  text '$text'\n";
+    }
+  }
+
+  return $ptree;
+
+} # parse_cfile
+
+sub dump_parse_tree {
+  my $fp    = shift @_;
+  my $ptree = shift @_;
+
+  use Data::Dumper;
+  use Data::Structure::Util qw(unbless);
+  $Data::Dumper::Terse    = 1;         # don't output names where feasible (doesn't work for my tree)
+  $Data::Dumper::Indent   = 1;         # mild pretty print
+  #$Data::Dumper::Indent   = 3;         # pretty print with array indices
+  $Data::Dumper::Purity   = 1;
+  $Data::Dumper::Deparse  = 1;
+  #$Data::Dumper::Sortkeys = 1;         # sort hash keys
+
+  print $fp Dumper(unbless($ptree));
+
+} # dump_parse_tree
+
+sub print_parse_tree {
+  my $fp    = shift @_;
+  my $ptree = shift @_;
+
+  print $fp "syntax tree:\n";
+
+  print_object($fp, $ptree, 1);
+
+} # print_parse_tree
+
+sub print_object {
+  my $fp    = shift @_;
+  my $obj   = shift @_;
+  my $level = shift @_; # use for number of leading spaces
+
+  $level = 0 if !defined $level;
+  my $s = $level ? F::get_spaces($level) : '';
+
+  # get type of object
+  my $r = ref $obj;
+
+  if (!$r) {
+    print $fp "${s}scalar value: '$obj'\n";
+  }
+  elsif ($r eq 'ARRAY') {
+    print $fp "${s}array ref: '$obj'\n";
+    foreach my $val (@{$obj}) {
+      if (!defined $val) {
+	print $fp "${s}value: 'undef'\n";
+	next;
+      }
+      print_object($fp, $val, $level + 1);
+    }
+  }
+  elsif ($r eq 'HASH') {
+    print $fp "${s}hash ref: '$obj'\n";
+    while (my ($key, $val) = each %{$obj}) {
+      print $fp "${s}hash key: '$key'\n";
+      if (!defined $val) {
+	print $fp "${s}value: 'undef'\n";
+	next;
+      }
+      print_object($fp, $val, $level + 1);
+    }
+  }
+  else {
+    warn_ref($r, $obj, $s, __FILE__, __LINE__);
+  }
+
+} # print_object
+
+sub warn_ref {
+  my ($r, $uref, $s, $fil, $linenum) = @_;
+  print "${s}WARNING:   unhandled ref type '$r'\n";
+  print "${s}scalar value: '$uref'\n";
+  print "${s}file '$fil', line $linenum\n";
+} # warn_ref
+
+# mandatory true return for a Perl module
+1;

misc/d-bindings/Phobos.pm

@@ -0,0 +1,65 @@
+package Phobos;
+
+# D standard library modules: std.X
+
+our %mod;
+our @mod
+  = qw(
+	algorithm
+	array
+	ascii
+	base64
+	bigint
+	bitmanip
+	compiler
+	complex
+	concurrency
+	container
+	conv
+	cstream
+	csv
+	datetime
+	demangle
+	encoding
+	exception
+	file
+	format
+	functional
+	getopt
+	json
+	math
+	mathspecial
+	metastrings
+	mmfile
+	numeric
+	outbuffer
+	parallelism
+	path
+	process
+	random
+	range
+	regex
+	signals
+	socket
+	socketstream
+	stdint
+	stdio
+	stdiobase
+	stream
+	string
+	syserror
+	system
+	traits
+	typecons
+	typelist
+	typetuple
+	uni
+	uri
+	utf
+	uuid
+	variant
+	xml
+	zip
+	zlib
+     );
+@mod{@mod} = ();

misc/d-bindings/R.pm

@@ -0,0 +1,80 @@
+package R;
+
+use v5.14;
+
+# holds varous regexes
+
+# regexes for HObj use:
+our $r_first_line
+  = qr{\A \s*
+       (typedef)?            # capture $1
+       \s*
+       (struct|enum|union)?  # capture $2
+
+       ([\s\S]*)             # capture $3
+
+       (\{)                  # capture $4
+
+       \s* \z
+    }ox;
+
+our $r_only_line
+  = qr{\A \s*
+       (typedef)            # capture $1
+
+       ([\s\S]*)            # capture $2
+
+       (;)                  # capture $3
+
+       \s* \z
+    }ox;
+
+our $r_last_line
+  = qr{\A \s*
+       (\})                     # capture $1
+
+       ([\S\s]*)                # capture $2
+
+       (\;)                     # capture $3
+
+       \s* \z
+    }ox;
+
+# for C line conversions
+#   transform, e.g., '((struct wdb_metaballpt *)0)'
+#   or               '(struct wdb_metaballpt *)0' to 'null'
+
+# Note the outside set of parens may not exist, but they'll need to be
+# paired and I'm not sure how to check that inside one regex, so I'll
+# define two separate ones.
+
+# two pairs of parens
+our $r_null_2
+  = qr{
+      \( \s*      # outside open paren
+      \(          # inside open paren
+
+      [^\(\)\*]+  # collect all but parens and asterisks
+
+      [\*\s]+     # don't forget the asterisk(s)!
+
+      \)          # inside close paren
+      \s* 0 \s*   # zero between the outer parens
+      \)          # outside close paren
+    }ox;
+
+# one pair of parens
+our $r_null_1
+  = qr{
+      \(          # inside open paren
+
+      [^\(\)\*]+  # collect all but parens and asterisks
+
+      [\*\s]+     # don't forget the asterisk(s)!
+
+      \)          # inside close paren
+      \s* 0       # zero after the close paren
+    }ox;
+
+# mandatory true return for a Perl module
+1;

misc/d-bindings/TODO

@@ -0,0 +1,117 @@
+Limitations
+===========
+
+Currently, neither nested, curly-braced expressions nor function
+bodies are explicitly handled, but they are not normally expected to
+appear in a C library API header.
+
+Some subtleties
+===============
+
+During object extraction and conversion, determine need for some D
+modules, e.g., the ptrdiff_t is known but a special module module must
+be explicitly imported.
+
+Likewise, file pointers and other C stdio kinds of things.
+
+Simple converter
+================
+
+
+Grammar converter
+=================
+
+Use successful program 'extract-grammar.pl' to convert P::RD grammar
+to R::G grammar.
+
+D grammar parser
+================
+
+Make a D grammar parser that creates a Perl class hierarchy to
+interpret and instantiate the C syntax tree (derived with R::G):
+
+C grammar parser
+================
+
+Make a C grammar parser that creates a Perl class hierarchy to
+interpret and instantiate the C syntax tree (derived with P::RD):
+
+  CC/
+   CC.pm # base class
+
+Try parsing individual chunks to fit individual classes by type.
+
+Also don't forget saving state of files (or freezing them) and hash
+checking to eliminate unnecessary rebuilds.
+
+status
+------
+
+Basically working--now convert to use better module Regex::Grammers
+(R::G).
+
+Decide how the D interface system fits into the build system
+============================================================
+
+1.  We need to know some system characteristics to properly create
+    modules.
+
+2.  Is completely-automatic generation of interface modules possible?
+
+3.  What is the status of D standard modules vs. the C library?
+
+Proposed layout in the build directory
+======================================
+  # all public api (for headers found in installed dir
+  # "$BRLCAD_ROOT/include/brlcad" and its sub-dirs)
+  ./di/X.d       # module: brlcad.X (includes all X/* headers)
+  ...
+
+  # other brlcad-specific, private installed headers
+
+  # "$BRLCAD_ROOT/include"
+  ./di/other/X.d  # module: brlcad.other.X
+  ...
+
+  # for subdirs
+  # "$BRLCAD_ROOT/include/X"
+  ./di/X/Y.d      # module: brlcad.X.Y
+  ...
+
+  # for external headers found, we attempt to generate F files for
+  # them and put them in a separate sub-dir
+  ./di/external/X.d      # module: brlcad.external.X
+  ./di/external/X/Y.d    # module: brlcad.external.X.Y
+  ...
+
+Note that for eventual installation the contents of directory "./di"
+will be recursively installed to:
+
+   $BRLCAD_ROOT/d
+
+Current librt dependencies
+==========================
+
+To be successful, the BRL-CAD core library librt must be available,
+and its current, external dependencies on my system are (from ldd):
+
+  linux-vdso.so.1
+  libz.so.1
+  libdl.so.2
+  libpthread.so.0
+  libm.so.6
+  libstdc++.so.6
+  libgcc_s.so.1
+  libc.so.6
+  /lib64/ld-linux-x86-64.so.2
+
+libbu and its external dependencies are only one less:
+
+  linux-vdso.so.1
+  libpthread.so.0
+  libdl.so.2
+  libm.so.6
+  libstdc++.so.6
+  libgcc_s.so.1
+  libc.so.6
+  /lib64/ld-linux-x86-64.so.2

misc/d-bindings/c-grammar.txt

@@ -0,0 +1,300 @@
+# C grammar from the Parse::RecDescent git repo in file:
+#   'demo_Cgrammar_v2.pl'
+# Quote:  This improved version of the C grammar was provided by Joe Buehler
+
+# Note:  This the pure version for default parsing with autotree.
+
+<autotree>
+
+primary_expression:
+	IDENTIFIER
+	| CONSTANT
+	| STRING_LITERAL
+	| '(' expression ')'
+
+postfix_expression_post:
+	'[' expression ']'
+	| '(' argument_expression_list(?) ')'
+	| '.' IDENTIFIER
+	| '->' IDENTIFIER
+	| '++'
+	| '--'
+
+postfix_expression:
+	primary_expression postfix_expression_post(s?)
+
+argument_expression_list:
+	assignment_expression (',' assignment_expression)(s?)
+
+unary_expression:
+	postfix_expression
+	| '++' unary_expression
+	| '--' unary_expression
+	| unary_operator cast_expression
+	| SIZEOF unary_expression
+	| SIZEOF '(' type_name ')'
+
+unary_operator:
+	/[-&*+!~]/
+
+cast_expression:
+	'(' type_name ')' cast_expression
+	| unary_expression
+
+multiplicative_expression_op:
+	/[*\/%]/
+
+multiplicative_expression:
+	cast_expression (multiplicative_expression_op cast_expression)(s?)
+
+additive_expression_op:
+	/[-+]/
+
+additive_expression:
+	multiplicative_expression (additive_expression_op multiplicative_expression)(s?)
+
+shift_expression_pre_op:
+	/(<<|>>)(?!=)/
+
+shift_expression:
+	additive_expression (shift_expression_pre_op additive_expression)(s?)
+
+relational_expression_op:
+	/(<=|>=|<|>)/
+
+relational_expression:
+	shift_expression (relational_expression_op shift_expression)(s?)
+
+equality_expression_pre_op:
+	/==|!=/
+
+equality_expression:
+	relational_expression (equality_expression_pre_op relational_expression)(s?)
+
+and_expression:
+	equality_expression ('&' equality_expression)(s?)
+
+exclusive_or_expression:
+	and_expression ('^' and_expression)(s?)
+
+inclusive_or_expression:
+	exclusive_or_expression ('|' exclusive_or_expression)(s?)
+
+logical_and_expression:
+	inclusive_or_expression ('&&' inclusive_or_expression)(s?)
+
+logical_or_expression:
+	logical_and_expression ('||' logical_and_expression)(s?)
+
+conditional_expression:
+	logical_or_expression ('?' expression ':' conditional_expression)(?)
+
+assignment_expression:
+	conditional_expression
+	| unary_expression assignment_operator assignment_expression
+
+assignment_operator:
+	/=(?!=)|\+=|\&=|\/=|<<=|\%=|\*=|\|=|>>=|-=|\^=/
+
+expression:
+	assignment_expression (',' assignment_expression)(s?)
+
+constant_expression:
+	conditional_expression
+
+declaration:
+	declaration_specifiers init_declarator_list ';'
+	| declaration_specifiers ';'
+
+declaration_specifiers:
+	( storage_class_specifier | type_specifier | type_qualifier )(s)
+
+init_declarator_list:
+	init_declarator (',' init_declarator)(s?)
+
+init_declarator:
+	declarator '=' initializer
+	| declarator
+
+storage_class_specifier:
+	/(typedef|extern|static|auto|register)(?![a-zA-Z0-9_])/
+
+type_specifier:
+	/(void|char|short|int|long|float|double|signed|unsigned)(?![a-zA-Z0-9_])/
+	| struct_or_union_specifier
+	| enum_specifier
+	| TYPE_NAME
+
+struct_or_union_specifier:
+	struct_or_union IDENTIFIER '{' struct_declaration_list '}'
+	| struct_or_union '{' struct_declaration_list '}'
+	| struct_or_union IDENTIFIER
+
+struct_or_union:
+	/(struct|union)(?![a-zA-Z0-9_])/
+
+struct_declaration_list:
+	struct_declaration(s)
+
+struct_declaration:
+	specifier_qualifier_list struct_declarator_list ';'
+
+specifier_qualifier_list:
+	( type_specifier | type_qualifier )(s)
+
+struct_declarator_list:
+	struct_declarator (',' struct_declarator)(s?)
+
+struct_declarator:
+	declarator ':' constant_expression
+	| declarator
+	| ':' constant_expression
+
+enum_specifier:
+	ENUM '{' enumerator_list '}'
+	| ENUM IDENTIFIER '{' enumerator_list '}'
+	| ENUM IDENTIFIER
+
+enumerator_list:
+	enumerator (',' enumerator)(s?)
+
+enumerator:
+	IDENTIFIER '=' constant_expression
+	| IDENTIFIER
+
+type_qualifier:
+	/(const|volatile)(?![a-zA-Z0-9_])/
+
+declarator:
+	pointer(?) direct_declarator
+
+direct_declarator_pre:
+	IDENTIFIER
+	| '(' declarator ')'
+
+direct_declarator_post:
+	'[' constant_expression ']'
+	| '[' ']'
+	| '(' parameter_type_list ')'
+	| '(' identifier_list ')'
+	| '(' ')'
+
+direct_declarator:
+	direct_declarator_pre direct_declarator_post(s?)
+
+pointer:
+	'*' type_qualifier_list(?) pointer(?)
+
+type_qualifier_list:
+	type_qualifier(s)
+
+parameter_type_list:
+	parameter_list ',' '...'
+	| parameter_list
+
+parameter_list:
+	parameter_declaration (',' parameter_declaration)(s?)
+
+parameter_declaration:
+	declaration_specifiers declarator
+	| declaration_specifiers abstract_declarator(?)
+
+identifier_list:
+	IDENTIFIER (',' IDENTIFIER)(s?)
+
+type_name:
+	specifier_qualifier_list abstract_declarator(?)
+
+abstract_declarator:
+	pointer direct_abstract_declarator(?)
+	| direct_abstract_declarator
+
+direct_abstract_declarator_pre:
+	'(' abstract_declarator ')'
+	| direct_abstract_declarator_post
+
+direct_abstract_declarator_post:
+	'[' ']'
+	| '[' constant_expression ']'
+	| '(' ')'
+	| '(' parameter_type_list ')'
+
+direct_abstract_declarator:
+	direct_abstract_declarator_pre direct_abstract_declarator_post(s?)
+
+initializer:
+	assignment_expression
+	| '{' initializer_list '}'
+	| '{' initializer_list ',' '}'
+
+initializer_list:
+	initializer (',' initializer)(s?)
+
+statement:
+	labeled_statement
+	| compound_statement
+	| expression_statement
+	| selection_statement
+	| iteration_statement
+	| jump_statement
+
+labeled_statement:
+	IDENTIFIER ':' statement
+	| /case(?![a-zA-Z0-9_])/ constant_expression ':' statement
+	| /default(?![a-zA-Z0-9_])/ ':' statement
+
+compound_statement:
+	'{' declaration_list statement_list(?) '}'
+	| '{' statement_list(?) '}'
+
+declaration_list:
+	declaration(s)
+
+statement_list:
+	statement(s)
+
+expression_statement:
+	expression(?) ';'
+
+selection_statement:
+	IF '(' expression ')' statement ELSE statement
+	| IF '(' expression ')' statement
+	| SWITCH '(' expression ')' statement
+
+iteration_statement:
+	WHILE '(' expression ')' statement
+	| DO statement WHILE '(' expression ')' ';'
+	| FOR '(' expression_statement expression_statement expression(?) ')' statement
+
+jump_statement:
+	/goto(?![a-zA-Z0-9_])/ IDENTIFIER ';'
+	| /continue(?![a-zA-Z0-9_])/ ';'
+	| /break(?![a-zA-Z0-9_])/ ';'
+	| /return(?![a-zA-Z0-9_])/ expression(?) ';'
+
+translation_unit:
+	external_declaration(s)
+
+external_declaration:
+	function_definition
+	| declaration
+
+function_definition:
+	declaration_specifiers declarator(?) declaration_list(?) compound_statement
+
+reserved_word:
+	/(auto|break|case|char|const|continue|default|do|double|enum|extern|float|for|goto|if|int|long|register|return|short|signed|sizeof|static|struct|switch|typedef|union|unsigned|void|volatile|while)(?![a-zA-Z0-9_])/
+
+CONSTANT:       /[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?/
+DO:             /do(?![a-zA-Z0-9_])/
+ELSE:           /else(?![a-zA-Z0-9_])/
+ENUM:           /enum(?![a-zA-Z0-9_])/
+FOR:            /for(?![a-zA-Z0-9_])/
+IDENTIFIER:     ...!reserved_word /[a-zA-Z_][a-zA-Z_0-9]*/
+IF:             /if(?![a-zA-Z0-9_])/
+SIZEOF:         /sizeof(?![a-zA-Z0-9_])/
+STRING_LITERAL: { extract_delimited($text,'"') }
+SWITCH:         /switch(?![a-zA-Z0-9_])/
+TYPE_NAME:      ...!reserved_word /[a-zA-Z_][a-zA-Z_0-9]*/ ...IDENTIFIER
+                | ...!reserved_word /[a-zA-Z_][a-zA-Z_0-9]*/ .../[:*)]/
+WHILE:          /while(?![a-zA-Z0-9_])/

misc/d-bindings/c-grammar2.txt

@@ -0,0 +1,316 @@
+# C grammar from the Parse::RecDescent git repo in file:
+#   'demo_Cgrammar_v2.pl'
+# Quote:  This improved version of the C grammar was provided by Joe Buehler
+
+# Note:  This version is for manual additions--not autotree.
+<autotree>
+{ my $i = 0; }
+
+primary_expression:
+	IDENTIFIER
+	| CONSTANT
+	| STRING_LITERAL
+	| '(' expression ')'
+
+postfix_expression_post:
+	'[' expression ']'
+	| '(' argument_expression_list(?) ')'
+	| '.' IDENTIFIER
+	| '->' IDENTIFIER
+	| '++'
+	| '--'
+
+postfix_expression:
+	primary_expression postfix_expression_post(s?)
+
+argument_expression_list:
+	assignment_expression (',' assignment_expression)(s?)
+
+unary_expression:
+	postfix_expression
+	| '++' unary_expression
+	| '--' unary_expression
+	| unary_operator cast_expression
+	| SIZEOF unary_expression
+	| SIZEOF '(' type_name ')'
+
+unary_operator:
+	/[-&*+!~]/
+
+cast_expression:
+	'(' type_name ')' cast_expression
+	| unary_expression
+
+multiplicative_expression_op:
+	/[*\/%]/
+
+multiplicative_expression:
+	cast_expression (multiplicative_expression_op cast_expression)(s?)
+
+additive_expression_op:
+	/[-+]/
+
+additive_expression:
+	multiplicative_expression (additive_expression_op multiplicative_expression)(s?)
+
+shift_expression_pre_op:
+	/(<<|>>)(?!=)/
+
+shift_expression:
+	additive_expression (shift_expression_pre_op additive_expression)(s?)
+
+relational_expression_op:
+	/(<=|>=|<|>)/
+
+relational_expression:
+	shift_expression (relational_expression_op shift_expression)(s?)
+
+equality_expression_pre_op:
+	/==|!=/
+
+equality_expression:
+	relational_expression (equality_expression_pre_op relational_expression)(s?)
+
+and_expression:
+	equality_expression ('&' equality_expression)(s?)
+
+exclusive_or_expression:
+	and_expression ('^' and_expression)(s?)
+
+inclusive_or_expression:
+	exclusive_or_expression ('|' exclusive_or_expression)(s?)
+
+logical_and_expression:
+	inclusive_or_expression ('&&' inclusive_or_expression)(s?)
+
+logical_or_expression:
+	logical_and_expression ('||' logical_and_expression)(s?)
+
+conditional_expression:
+	logical_or_expression ('?' expression ':' conditional_expression)(?)
+
+assignment_expression:
+	conditional_expression
+	| unary_expression assignment_operator assignment_expression
+
+assignment_operator:
+	/=(?!=)|\+=|\&=|\/=|<<=|\%=|\*=|\|=|>>=|-=|\^=/
+
+expression:
+	assignment_expression (',' assignment_expression)(s?)
+
+constant_expression:
+	conditional_expression
+
+declaration:
+	declaration_specifiers init_declarator_list ';'
+	| declaration_specifiers ';'
+
+declaration_specifiers:
+	( storage_class_specifier | type_specifier | type_qualifier )(s)
+
+init_declarator_list:
+	init_declarator (',' init_declarator)(s?)
+
+init_declarator:
+	declarator '=' initializer
+	| declarator
+
+storage_class_specifier:
+	/(typedef|extern|static|auto|register)(?![a-zA-Z0-9_])/
+
+type_specifier:
+        /(void|char|short|int|long|float|double|signed|unsigned)(?![a-zA-Z0-9_])/
+	| struct_or_union_specifier
+	| enum_specifier
+	| TYPE_NAME
+
+struct_or_union_specifier:
+	struct_or_union IDENTIFIER '{' struct_declaration_list '}'
+	| struct_or_union '{' struct_declaration_list '}'
+	| struct_or_union IDENTIFIER
+
+struct_or_union:
+	/(struct|union)(?![a-zA-Z0-9_])/
+
+struct_declaration_list:
+	struct_declaration(s)
+
+struct_declaration:
+	specifier_qualifier_list struct_declarator_list ';'
+
+specifier_qualifier_list:
+	( type_specifier | type_qualifier )(s)
+
+struct_declarator_list:
+	struct_declarator (',' struct_declarator)(s?)
+
+struct_declarator:
+	declarator ':' constant_expression
+	| declarator
+	| ':' constant_expression
+
+enum_specifier:
+	ENUM '{' enumerator_list '}'
+	| ENUM IDENTIFIER '{' enumerator_list '}'
+	| ENUM IDENTIFIER
+
+enumerator_list:
+	enumerator (',' enumerator)(s?)
+
+enumerator:
+	IDENTIFIER '=' constant_expression
+	| IDENTIFIER
+
+type_qualifier:
+	/(const|volatile)(?![a-zA-Z0-9_])/
+
+declarator:
+	pointer(?) direct_declarator
+
+direct_declarator_pre:
+	IDENTIFIER
+	| '(' declarator ')'
+
+direct_declarator_post:
+	'[' constant_expression ']'
+	| '[' ']'
+	| '(' parameter_type_list ')'
+	| '(' identifier_list ')'
+	| '(' ')'
+
+direct_declarator:
+	direct_declarator_pre direct_declarator_post(s?)
+
+pointer:
+	'*' type_qualifier_list(?) pointer(?)
+
+type_qualifier_list:
+	type_qualifier(s)
+
+parameter_type_list:
+	parameter_list ',' '...'
+	| parameter_list
+
+parameter_list:
+	parameter_declaration (',' parameter_declaration)(s?)
+
+parameter_declaration:
+	declaration_specifiers declarator
+	| declaration_specifiers abstract_declarator(?)
+
+identifier_list:
+	IDENTIFIER (',' IDENTIFIER)(s?)
+
+type_name:
+	specifier_qualifier_list abstract_declarator(?)
+
+abstract_declarator:
+	pointer direct_abstract_declarator(?)
+	| direct_abstract_declarator
+
+direct_abstract_declarator_pre:
+	'(' abstract_declarator ')'
+	| direct_abstract_declarator_post
+
+direct_abstract_declarator_post:
+	'[' ']'
+	| '[' constant_expression ']'
+	| '(' ')'
+	| '(' parameter_type_list ')'
+
+direct_abstract_declarator:
+	direct_abstract_declarator_pre direct_abstract_declarator_post(s?)
+
+initializer:
+	assignment_expression
+	| '{' initializer_list '}'
+	| '{' initializer_list ',' '}'
+
+initializer_list:
+	initializer (',' initializer)(s?)
+
+statement:
+	labeled_statement
+	| compound_statement
+	| expression_statement
+	| selection_statement
+	| iteration_statement
+	| jump_statement
+
+labeled_statement:
+	IDENTIFIER ':' statement
+	| /case(?![a-zA-Z0-9_])/ constant_expression ':' statement
+	| /default(?![a-zA-Z0-9_])/ ':' statement
+
+compound_statement:
+	'{' declaration_list statement_list(?) '}'
+	| '{' statement_list(?) '}'
+
+declaration_list:
+	declaration(s)
+
+statement_list:
+	statement(s)
+
+expression_statement:
+	expression(?) ';'
+
+selection_statement:
+	IF '(' expression ')' statement ELSE statement
+	| IF '(' expression ')' statement
+	| SWITCH '(' expression ')' statement
+
+iteration_statement:
+	WHILE '(' expression ')' statement
+	| DO statement WHILE '(' expression ')' ';'
+	| FOR '(' expression_statement expression_statement expression(?) ')' statement
+
+jump_statement:
+	/goto(?![a-zA-Z0-9_])/ IDENTIFIER ';'
+	| /continue(?![a-zA-Z0-9_])/ ';'
+	| /break(?![a-zA-Z0-9_])/ ';'
+	| /return(?![a-zA-Z0-9_])/ expression(?) ';'
+
+translation_unit:
+	external_declaration(s)
+
+external_declaration:
+	function_definition
+	{
+		if (defined $item[1] && $item[1]) {
+		   my $key = sprintf "%s-%04d", $item[0], ++$i;
+		   my $val = [ @item[1..$#item] ];
+		   $::item{$key} = $val
+		     if $val;
+		}
+	}
+	| declaration
+	{
+		if (defined $item[1] && $item[1]) {
+		   my $key = sprintf "%s-%04d", $item[0], ++$i;
+		   my $val = [ @item[1..$#item] ];
+		   $::item{$key} = $val
+		     if $val;
+		}
+	}
+
+function_definition:
+	declaration_specifiers declarator(?) declaration_list(?) compound_statement
+
+reserved_word:
+	/(auto|break|case|char|const|continue|default|do|double|enum|extern|float|for|goto|if|int|long|register|return|short|signed|sizeof|static|struct|switch|typedef|union|unsigned|void|volatile|while)(?![a-zA-Z0-9_])/
+
+CONSTANT:       /[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?/
+DO:             /do(?![a-zA-Z0-9_])/
+ELSE:           /else(?![a-zA-Z0-9_])/
+ENUM:           /enum(?![a-zA-Z0-9_])/
+FOR:            /for(?![a-zA-Z0-9_])/
+IDENTIFIER:     ...!reserved_word /[a-zA-Z_][a-zA-Z_0-9]*/
+IF:             /if(?![a-zA-Z0-9_])/
+SIZEOF:         /sizeof(?![a-zA-Z0-9_])/
+STRING_LITERAL: { extract_delimited($text,'"') }
+SWITCH:         /switch(?![a-zA-Z0-9_])/
+TYPE_NAME:      ...!reserved_word /[a-zA-Z_][a-zA-Z_0-9]*/ ...IDENTIFIER
+	        | ...!reserved_word /[a-zA-Z_][a-zA-Z_0-9]*/ .../[:*)]/
+WHILE:          /while(?![a-zA-Z0-9_])/

misc/d-bindings/convert-grammar.pl

@@ -0,0 +1,696 @@
+#!/usr/bin/env perl
+
+use v5.14; # say, switch
+
+# converts a C or D grammar to a Perl module for parsing
+
+use strict;
+use warnings;
+
+use Data::Dumper; $Data::Dumper::Indent = 1;
+
+use File::Basename;
+use lib('.');
+
+my $p = basename($0);
+my $usage  = "Usage: $p c | d [-d][-f][-h]";
+
+my $ifilc = 'c-grammar.txt'; # in P::RD format
+my $ifild = 'D.g4.txt';      # in approximate P::RD format
+
+my $pmc   = 'RGC';           # in R::G  format
+my $pmd   = 'RGD';           # in R::G  format
+
+my $ofilc = "${pmc}.pm";
+my $ofild = "${pmd}.pm";
+
+if (!@ARGV) {
+  say <<"HERE";
+$usage
+
+Use '-h' for extended help.
+HERE
+
+  exit;
+}
+
+my $debug = 0;
+my $force = 1;
+
+my $mode = 'c'; # or 'd'
+
+foreach my $arg (@ARGV) {
+
+  # options
+  if ($arg =~ m{\A -d}x) {
+    $debug = 1;
+  }
+  elsif ($arg =~ m{\A -f}x) {
+    $force = 1;
+  }
+  elsif ($arg =~ m{\A -h}x) {
+    longhelp();
+  }
+
+  # modes
+  elsif ($arg =~ m{\A [cC]}x) {
+    $mode = 'c';
+  }
+  elsif ($arg =~ m{\A [dD]}x) {
+    $mode = 'd';
+  }
+
+  # allow default mode
+  elsif ($arg =~ m{\A [\-]*[^dfh]*}x) {
+    ; # okay
+  }
+  else {
+    die "FATAL:  Unknown arg '$arg'.\n";
+  }
+}
+
+my ($ifil, $ofil, $pm);
+if ($mode eq 'd') {
+  $ifil = $ifild;
+  $ofil = $ofild;
+  $pm   = $pmd;
+}
+else {
+  $ifil = $ifilc;
+  $ofil = $ofilc;
+  $pm   = $pmc;
+}
+
+die "FATAL:  Unable to find grammar file '$ifil'.\n"
+  if ! -f $ifil;
+
+my %prod  = (); # hash of production names and their children
+my @prods = (); # retain order as read
+
+my $maxCAPSlen;
+
+if ($mode eq 'c') {
+  $maxCAPSlen =extract_c_grammar(\@prods, \%prod, $ifil, $mode);
+}
+else {
+  $maxCAPSlen = extract_d_grammar(\@prods, \%prod, $ifil, $mode);
+}
+
+say  "# DEBUG: max caps len = $maxCAPSlen"
+  if $debug;
+
+if ($debug) {
+  if ($mode eq 'c') {
+    dump_c_prods(\@prods, \%prod, $maxCAPSlen, $mode);
+  }
+  else {
+    dump_c_prods(\@prods, \%prod, $maxCAPSlen, $mode);
+  }
+}
+
+convert_to_RG(\@prods, \%prod, $ofil, $mode, $pm);
+
+say "Normal end.";
+if ($mode eq 'd' && -f $ofild) {
+  say "\nSee ouput file '$ofild'."
+}
+elsif ($mode eq 'c' && -f $ofilc) {
+  say "\nSee ouput file '$ofilc'."
+}
+else {
+  say "\nNo files were generated."
+}
+
+#### subroutines ####
+sub convert_to_RG {
+  my $p_aref = shift @_; # \@prods
+  my $p_href = shift @_; # \%prods
+  my $ofil   = shift @_; # $ofil
+  my $mode   = shift @_; # $mode
+  my $pm     = shift @_; # $pm
+
+  open my $fp, '>', $ofil
+    or die "$ofil: $!";
+
+  # prelims
+  {
+    say $fp <<"HERE";
+# This file is auto-generated by program '$p'.
+# Any edits will be LOST!
+
+package $pm;
+
+use Regexp::Grammars;
+
+my \$parser
+  = qr{
+HERE
+  }
+
+  # guts
+
+
+  # ender
+  {
+    say $fp <<"HERE";
+    }xms;
+
+# mandatory true return for a Perl module
+1;
+HERE
+  }
+
+} # convert_to_RG
+
+sub extract_c_grammar {
+  my $prods_aref = shift @_; # \@prods
+  my $prod_href  = shift @_; # \%prod
+  my $ifil       = shift @_; # $ifil
+  my $mode       = shift @_; # mode
+
+  die "FATAL:  wrong subroutine for mode C"
+    if $mode ne 'c';
+
+  open my $fp, '<', $ifil
+    or die "$ifil: $!";
+
+  # certain lines can't be processed
+  my @pipes_ok
+    = (
+       '/(typedef|extern|static|auto|register)(?![a-zA-Z0-9_])/',
+       '/(void|char|short|int|long|float|double|signed|unsigned)(?![a-zA-Z0-9_])/',
+       '/(struct|union)(?![a-zA-Z0-9_])/',
+       '/(const|volatile)(?![a-zA-Z0-9_])/',
+       '/(auto|break|case|char|const|continue|default|do|double|enum|extern|float|for|goto|if|int|long|register|return|short|signed|sizeof|static|struct|switch|typedef|union|unsigned|void|volatile|while)(?![a-zA-Z0-9_])/',
+       'CONSTANT:       /[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?/',
+       '( type_specifier | type_qualifier )(s)',
+       '( storage_class_specifier | type_specifier | type_qualifier )(s)',
+      );
+  my %pipes_ok;
+  @pipes_ok{@pipes_ok} = ();
+
+  # process each production as we encounter it
+  my $curr_prod     = ''; # name
+  my @curr_children = (); # all children
+
+  # track some prod name lengths
+  my $maxCAPSlen = 0;
+
+  my $linenum = 0;
+  while (defined(my $line = <$fp>)) {
+    ++$linenum;
+
+    $line = strip_comment($line);
+    if ($line !~ /\S+/) {
+      say "DEBUG:  skipping empty line '$line'."
+	if (0 && $debug);
+      next;
+    }
+    next if $line =~ /<autotree>/;
+    chomp $line;
+
+    if (0 && $debug) {
+      say "DEBUG: non-empty line '$line'";
+    }
+
+    # trim
+    $line =~ s{\A \s+}{}x;
+    $line =~ s{\s+ \z}{}x;
+
+    # add some spaces on the line for more reliable tokenizing
+    # careful, ignore chars between '/' and '/', etc.
+    # add space around some pipes
+    my $t1 = $line;
+    if (!exists $pipes_ok{$line}) {
+      $line =~ s{([a-zA-Z]) (\|)}{$1 $2}xg;
+      $line =~ s{(\|) (a-zA-Z])}{ $1 $2}xg;
+      # some lines  have been trimmed, remove leading pipes
+      $line =~ s{\A (\|)}{}x;
+
+      my $t2 = $line;
+      if (0 && $debug && $t1 ne $t2) {
+	say "DEBUG: original line with pipes:";
+	say "  '$t1'";
+	say "DEBUG: line with spaced pipes:";
+	say "  '$t2'";
+      }
+    }
+
+    # check for a production line
+    my $have_colon = ($line =~ m{\A [a-zA-Z_]+\s*\:}x) ? 1 : 0;
+
+    # check for malformed lines (or my misunderstanding)
+    if ($line =~ m{\A [a-zA-Z_]+\s*\:\S}x) {
+      die "bad colon line '$line'";
+    }
+
+    if ($have_colon) {
+      if (0 && $debug) {
+	my $s = $line;
+	say "DEBUG: original line with colon:";
+	say "  '$s'";
+      }
+      # affect only colons at end (or beginning?) of identifiers
+      $line =~ s{\A ([a-zA-Z_]+)\:}{$1 \:}x;
+      if (0 && $debug) {
+	my $s = $line;
+	say "       line with colon separated:";
+	say "  '$s'";
+      }
+    }
+
+    my @d = split(' ', $line);
+
+    # is this a production definition line"
+    my $key = shift @d;
+    my $newprod = ($key =~ s{\: \z}{}x) ? 1 : 0;
+    my $key2 = $newprod ? '' : shift @d;
+    if (defined $key2) {
+      if ($key2 eq ':') {
+	$newprod = 1;
+	$key2 = '';
+      }
+      else {
+	unshift @d, $key2;
+      }
+    }
+
+    if ($newprod) {
+      # beginning of a production rule with non-empty @d as subrules
+      if ($curr_prod) {
+	# we may need to save the current one
+	die "FATAL: dup production rule '$curr_prod'"
+	  if exists $prod{$curr_prod};
+	if (@curr_children) {
+	  # special case for lines beginning with '(' (a hack, could be improved for generality)
+	  my $c = substr $curr_children[0], 0, 1;
+	  if ($c eq '(') {
+	    $prod_href->{$curr_prod} = [join(' ', @curr_children)];
+	  }
+	  else {
+	    $prod_href->{$curr_prod} = [@curr_children];
+	  }
+	  @curr_children = ();
+	}
+	else {
+	  $prod_href->{$curr_prod} = [];
+	  say "WARNING:  production rule '$curr_prod' has no children.";
+	}
+	# save the prod order
+	push @{$prods_aref}, $curr_prod;
+      }
+      $curr_prod = $key;
+
+      # prod names in CAPS are special
+      if ($key =~ m{[A-Z]+}) {
+	my $len = length $key;
+	$maxCAPSlen = $len
+	  if $len > $maxCAPSlen;
+      }
+
+      # rejoin the line and reprocess it
+      my $pline = join(' ', @d);
+      # split on space-separated pipes
+      my @t = split(' \| ', $pline);
+      foreach my $t (@t) {
+	# trim
+	$t =~ s{\A \s*}{}x;
+	$t =~ s{\s* \z}{}x;
+	push @curr_children, $t
+	  if $t;
+      }
+    }
+    else {
+      if ($curr_prod) {
+	# rejoin the line and reprocess it
+	my $pline = join(' ', ($key, @d));
+	# split on space-separated pipes
+	if (!exists $pipes_ok{$pline}) {
+	  my @t = split(' \| ', $pline);
+	  foreach my $t (@t) {
+	    # trim
+	    $t =~ s{\A \s*}{}x;
+	    $t =~ s{\s* \z}{}x;
+	    push @curr_children, $t
+	      if $t;
+	  }
+	}
+	else {
+	  push @curr_children, $pline
+	      if $pline;
+	}
+      }
+      else {
+	say STDERR "ERROR: No \$curr_prod for line $linenum:";
+	say STDERR "  line: '$line'";
+	die "FATAL:  No \$curr_prod.";
+      }
+    }
+  }
+
+  # the last prod is remaining
+  # we may need to save the current one
+  die "FATAL: dup production rule '$curr_prod'"
+    if exists $prod{$curr_prod};
+  if (@curr_children) {
+    $prod_href->{$curr_prod} = [@curr_children];
+    @curr_children = ();
+  }
+  else {
+    $prod_href->{$curr_prod} = [];
+    say "WARNING:  production rule '$curr_prod' has no children.";
+  }
+  push @{$prods_aref}, $curr_prod;
+
+  return $maxCAPSlen;
+
+} # extract_c_grammar
+
+sub longhelp {
+  say <<"HERE";
+$usage
+
+  -d  Debug
+  -f  Force overwriting existing files
+  -h  Extended help
+
+Extracts P::RD grammar from file '$ifilc' (or '$ifild'),
+converts it to R::G format, and puts into an autogenerated
+Perl data module named '${ofilc}' (or '${ofild}').
+HERE
+
+  exit;
+} # help
+
+sub strip_comment {
+  my $line = shift @_;
+
+  if (1) {
+    $line =~ s{\A ([^\#]*) \# [\s\S]* \z}{$1}x;
+  }
+  else {
+    my $idx = index $line, '#';
+    if ($idx >= 0) {
+      $line = substr $line, 0, $idx;
+    }
+  }
+  return $line;
+} # strip_comment
+
+sub dump_c_prods {
+  my $p_aref     = shift @_; # \@prods
+  my $p_href     = shift @_; # \%prod
+  my $maxCAPSlen = shift @_;
+  my $mode       = shift @_; # mode
+
+  die "FATAL:  wrong subroutine for mode C"
+    if $mode ne 'c';
+
+  # chars allowed for CAPS prod name plus a colon plus one space
+  my $spaces = $maxCAPSlen + 2;
+
+
+  say "# C grammar:";
+  foreach my $p (@{$p_aref}) {
+    my $caps = ($p =~ m{\A [A-Z_]+ \z}x) ? 1 : 0;
+    my @c = @{$p_href->{$p}};
+    my $nc = @c;
+    if (!$caps) {
+      say "$p:";
+    }
+    else {
+      my $len = length $p;
+      my $sp  = $spaces;
+      $sp -= ($len + 1); # space for prod name plus colon
+      printf "$p:%-*.*s", $sp, $sp, ' ';
+    }
+    for (my $i = 0; $i < $nc; ++$i) {
+      my $c = $c[$i];
+      if ($caps && $i) {
+	my $sp = $spaces;
+	printf "%-*.*s", $sp, $sp, ' ';
+      }
+      if (!$caps) {
+	print "\t";
+      }
+      print "| " if $i;
+      print "$c";
+      print "\n";
+    }
+    print "\n" if !$caps;
+  }
+
+  #print Dumper($p_href);
+
+} # dump_c_prods
+
+sub extract_d_grammar {
+  my $prods_aref = shift @_; # \@prods
+  my $prod_href  = shift @_; # \%prod
+  my $ifil       = shift @_; # $ifil
+  my $mode       = shift @_; # mode
+
+  die "FATAL:  wrong subroutine for mode D"
+    if $mode ne 'd';
+
+  open my $fp, '<', $ifil
+    or die "$ifil: $!";
+
+  # certain lines can't be processed
+  my @pipes_ok
+    = (
+       '/(typedef|extern|static|auto|register)(?![a-zA-Z0-9_])/',
+       '/(void|char|short|int|long|float|double|signed|unsigned)(?![a-zA-Z0-9_])/',
+       '/(struct|union)(?![a-zA-Z0-9_])/',
+       '/(const|volatile)(?![a-zA-Z0-9_])/',
+       '/(auto|break|case|char|const|continue|default|do|double|enum|extern|float|for|goto|if|int|long|register|return|short|signed|sizeof|static|struct|switch|typedef|union|unsigned|void|volatile|while)(?![a-zA-Z0-9_])/',
+       'CONSTANT:       /[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?/',
+       '( type_specifier | type_qualifier )(s)',
+       '( storage_class_specifier | type_specifier | type_qualifier )(s)',
+      );
+  my %pipes_ok;
+  @pipes_ok{@pipes_ok} = ();
+
+  # process each production as we encounter it
+  my $curr_prod     = ''; # name
+  my @curr_children = (); # all children
+
+  # track some prod name lengths
+  my $maxCAPSlen = 0;
+
+  my $linenum = 0;
+  while (defined(my $line = <$fp>)) {
+    ++$linenum;
+
+    $line = strip_comment($line);
+    if ($line !~ /\S+/) {
+      say "DEBUG:  skipping empty line '$line'."
+	if (0 && $debug);
+      next;
+    }
+    next if $line =~ /<autotree>/;
+    chomp $line;
+
+    if (0 && $debug) {
+      say "DEBUG: non-empty line '$line'";
+    }
+
+    # trim
+    $line =~ s{\A \s+}{}x;
+    $line =~ s{\s+ \z}{}x;
+
+    # add some spaces on the line for more reliable tokenizing
+    # careful, ignore chars between '/' and '/', etc.
+    # add space around some pipes
+    my $t1 = $line;
+    if (!exists $pipes_ok{$line}) {
+      $line =~ s{([a-zA-Z]) (\|)}{$1 $2}xg;
+      $line =~ s{(\|) (a-zA-Z])}{ $1 $2}xg;
+      # some lines  have been trimmed, remove leading pipes
+      $line =~ s{\A (\|)}{}x;
+
+      my $t2 = $line;
+      if (0 && $debug && $t1 ne $t2) {
+	say "DEBUG: original line with pipes:";
+	say "  '$t1'";
+	say "DEBUG: line with spaced pipes:";
+	say "  '$t2'";
+      }
+    }
+
+    # check for a production line
+    my $have_colon = ($line =~ m{\A [a-zA-Z_]+\s*\:}x) ? 1 : 0;
+
+    # check for malformed lines (or my misunderstanding)
+    if ($line =~ m{\A [a-zA-Z_]+\s*\:\S}x) {
+      die "bad colon line '$line'";
+    }
+
+    if ($have_colon) {
+      if (0 && $debug) {
+	my $s = $line;
+	say "DEBUG: original line with colon:";
+	say "  '$s'";
+      }
+      # affect only colons at end (or beginning?) of identifiers
+      $line =~ s{\A ([a-zA-Z_]+)\:}{$1 \:}x;
+      if (0 && $debug) {
+	my $s = $line;
+	say "       line with colon separated:";
+	say "  '$s'";
+      }
+    }
+
+    my @d = split(' ', $line);
+
+    # is this a production definition line"
+    my $key = shift @d;
+    my $newprod = ($key =~ s{\: \z}{}x) ? 1 : 0;
+    my $key2 = $newprod ? '' : shift @d;
+    if (defined $key2) {
+      if ($key2 eq ':') {
+	$newprod = 1;
+	$key2 = '';
+      }
+      else {
+	unshift @d, $key2;
+      }
+    }
+
+    if ($newprod) {
+      # beginning of a production rule with non-empty @d as subrules
+      if ($curr_prod) {
+	# we may need to save the current one
+	die "FATAL: dup production rule '$curr_prod'"
+	  if exists $prod{$curr_prod};
+	if (@curr_children) {
+	  # special case for lines beginning with '(' (a hack, could be improved for generality)
+	  my $c = substr $curr_children[0], 0, 1;
+	  if ($c eq '(') {
+	    $prod_href->{$curr_prod} = [join(' ', @curr_children)];
+	  }
+	  else {
+	    $prod_href->{$curr_prod} = [@curr_children];
+	  }
+	  @curr_children = ();
+	}
+	else {
+	  $prod_href->{$curr_prod} = [];
+	  say "WARNING:  production rule '$curr_prod' has no children.";
+	}
+	# save the prod order
+	push @{$prods_aref}, $curr_prod;
+      }
+      $curr_prod = $key;
+
+      # prod names in CAPS are special
+      if ($key =~ m{[A-Z]+}) {
+	my $len = length $key;
+	$maxCAPSlen = $len
+	  if $len > $maxCAPSlen;
+      }
+
+      # rejoin the line and reprocess it
+      my $pline = join(' ', @d);
+      # split on space-separated pipes
+      my @t = split(' \| ', $pline);
+      foreach my $t (@t) {
+	# trim
+	$t =~ s{\A \s*}{}x;
+	$t =~ s{\s* \z}{}x;
+	push @curr_children, $t
+	  if $t;
+      }
+    }
+    else {
+      if ($curr_prod) {
+	# rejoin the line and reprocess it
+	my $pline = join(' ', ($key, @d));
+	# split on space-separated pipes
+	if (!exists $pipes_ok{$pline}) {
+	  my @t = split(' \| ', $pline);
+	  foreach my $t (@t) {
+	    # trim
+	    $t =~ s{\A \s*}{}x;
+	    $t =~ s{\s* \z}{}x;
+	    push @curr_children, $t
+	      if $t;
+	  }
+	}
+	else {
+	  push @curr_children, $pline
+	      if $pline;
+	}
+      }
+      else {
+	say STDERR "ERROR: No \$curr_prod for line $linenum:";
+	say STDERR "  line: '$line'";
+	die "FATAL:  No \$curr_prod.";
+      }
+    }
+  }
+
+  # the last prod is remaining
+  # we may need to save the current one
+  die "FATAL: dup production rule '$curr_prod'"
+    if exists $prod{$curr_prod};
+  if (@curr_children) {
+    $prod_href->{$curr_prod} = [@curr_children];
+    @curr_children = ();
+  }
+  else {
+    $prod_href->{$curr_prod} = [];
+    say "WARNING:  production rule '$curr_prod' has no children.";
+  }
+  push @{$prods_aref}, $curr_prod;
+
+  return $maxCAPSlen;
+
+} # extract_d_grammar
+
+sub dump_d_prods {
+  my $p_aref     = shift @_; # \@prods
+  my $p_href     = shift @_; # \%prod
+  my $maxCAPSlen = shift @_;
+  my $mode       = shift @_; # mode
+
+  die "FATAL:  wrong subroutine for mode D"
+    if $mode ne 'd';
+
+  # chars allowed for CAPS prod name plus a colon plus one space
+  my $spaces = $maxCAPSlen + 2;
+
+
+  say "# C grammar:";
+  foreach my $p (@{$p_aref}) {
+    my $caps = ($p =~ m{\A [A-Z_]+ \z}x) ? 1 : 0;
+    my @c = @{$p_href->{$p}};
+    my $nc = @c;
+    if (!$caps) {
+      say "$p:";
+    }
+    else {
+      my $len = length $p;
+      my $sp  = $spaces;
+      $sp -= ($len + 1); # space for prod name plus colon
+      printf "$p:%-*.*s", $sp, $sp, ' ';
+    }
+    for (my $i = 0; $i < $nc; ++$i) {
+      my $c = $c[$i];
+      if ($caps && $i) {
+	my $sp = $spaces;
+	printf "%-*.*s", $sp, $sp, ' ';
+      }
+      if (!$caps) {
+	print "\t";
+      }
+      print "| " if $i;
+      print "$c";
+      print "\n";
+    }
+    print "\n" if !$caps;
+  }
+
+  #print Dumper($p_href);
+
+} # dump_d_prods

misc/d-bindings/convert-h2d.pl

@@ -0,0 +1,370 @@
+#!/usr/bin/env perl
+
+# converts a C .h file to a rudimentary .d file for linking C to D
+
+use v5.14; # for 'say', etc.
+
+use strict;
+use warnings;
+
+use File::Basename;
+use lib('.');
+
+use G; # globals
+use D; # local convenience module
+use BP;
+
+# use the reference D compiler
+my $DMD = '/usr/bin/dmd';
+die "ERROR:  Reference compiler 'dmd' not found.\n"
+  if ! -f $DMD;
+
+# check for proper source dir:
+die "ERROR:  Unknown include dir for BRL-CAD public headers: '$BP::IDIR' (see D.pm)\n"
+  if ! -d $BP::IDIR;
+
+# check for proper D directory for interface files
+die "ERROR:  Unknown include dir for BRL-CAD public headers: '$BP::DIDIR' (see D.pm)\n"
+  if ! -d $BP::DIDIR;
+
+my $p = basename($0);
+my $usage  = "Usage: $p mode [options...]\n\n";
+$usage    .= "  modes:   -r | -cN | -h=X | -b | -e\n";
+$usage    .= "  options: -f -d -c -n=X -t -h";
+if (!@ARGV) {
+  say <<"HERE";
+$usage
+
+Use option '-h' for details.
+HERE
+
+  exit;
+}
+
+# modes
+my $report  = 0;
+my $convert = 0;
+my $Bgen    = 0;
+my $Egen    = 0;
+
+my $mode_selected = 0;
+sub zero_modes {
+  my $ms = shift @_;
+  $ms = 0 if !defined $ms;
+  $report  = 0;
+  $convert = 0;
+  $Bgen    = 0;
+  $Egen    = 0;
+
+  $mode_selected = 1 if $ms;
+} # zero_modes
+
+my @ifils = ();
+
+foreach my $arg (@ARGV) {
+  my $val = undef;
+  my $idx = index $arg, '=';
+  if ($idx >= 0) {
+    say "DEBUG: input arg is '$arg'"
+      if $G::debug;
+
+    $val = substr $arg, $idx+1;
+    if ((!defined $val) && !$G::debug) {
+      die "ERROR:  For option '$arg' \$val is empty.'\n";
+    }
+    $arg = substr $arg, 0, $idx;
+    if (0&& $G::debug) {
+      say "arg is now '$arg', val is '$val'";
+      die "debug exit";
+    }
+  }
+
+  if ($arg =~ m{\A -f}xms) {
+    $G::force = 1;
+  }
+  elsif ($arg =~ m{\A -d}xms) {
+    $G::debug = 1;
+  }
+  elsif ($arg =~ m{\A -v}xms) {
+    $G::verbose = 1;
+  }
+  elsif ($val && $arg =~ m{\A -h}xms ) {
+    my $f = $val;
+    die "ERROR:  Input file '$f' not found.\n"
+      if (! -e $f);
+    # one more check: must be a '.h' file
+    die "ERROR:  Input file '$f' must be a '$G::Hsuf' file.\n"
+      if ($f !~ m{$G::Hsuf \z}xms);
+    @ifils = ($f);
+  }
+  elsif ($arg =~ m{\A -h}xms) {
+    help();
+  }
+  elsif ($arg =~ m{\A -C \z}xms) {
+    $G::clean = 1;
+  }
+  elsif ($arg =~ m{\A -n}xms) {
+    $G::maxchunks = $val;
+    if ($val < 0) {
+      $G::maxchunks = 0;
+      $G::iterate   = 1;
+    }
+  }
+
+  # modes
+  elsif ($arg =~ m{\A -r}xms) {
+    zero_modes(1);
+    $report = 1;
+  }
+  elsif ($arg =~ m{\A -c([1]){1}}xms) {
+    # note c2 is not working yet
+    # note c3 is not working yet
+    zero_modes(1);
+    $convert = $1;
+  }
+  elsif ($arg =~ m{\A -b}xms) {
+    zero_modes(1);
+    $Bgen = 1;
+  }
+  elsif ($arg =~ m{\A -e}xms) {
+    zero_modes(1);
+    $Egen = 1;
+  }
+  elsif ($arg =~ m{\A -[Tt]{1}}xms) {
+    # a test mode
+    zero_modes(1);
+    $convert = 1;
+
+    $G::force        = 1;
+    $G::verbose      = 1;
+    $G::debug        = 1;
+    $G::clean        = 1;
+    $G::devel        = 1;
+    $G::quitundef    = 0;
+    $G::maxchunks    = 0;
+    $G::inspect_tree = 0;
+
+    $G::pretty_print = 0;
+
+  }
+
+  # error
+  else {
+    die "ERROR:  Unknown arg '$arg'.\n";
+  }
+}
+
+die "ERROR:  No mode selected.\n"
+  if !$mode_selected;
+
+if ($G::devel) {
+  @ifils = ("${BP::IDIR}/bu.h");
+  #@ifils = ("./test_hdr.h");
+}
+
+# collect all .h and .d files; note that some .h files are obsolete
+# and are so indicated inside the following function
+my (@h, @d) = ();
+D::collect_files(\@h, \@d); # deletes generated files if $G::clean
+my $nh   = @h;
+my $nd  = @d;
+my @fils = (@h, @d);
+my $nf   = @fils;
+my %f;
+@f{@fils} = ();
+my %stats = ();
+# collect their statuses
+get_status(\%stats, \%f);
+
+my @ofils = ();
+if ($report) {
+  say "Mode is '-r' (report)...";
+  my $n = $nh ? $nh : 'zero';
+  say "There are $n C header files in the '$D::IDIR' directory:";
+  say "  new:       $stats{h}{new}";
+  say "  unchanged: $stats{h}{sam}";
+  say "  changed:   $stats{h}{dif}";
+
+  if ($G::verbose) {
+    say "  Files:";
+    say "    $_" for (@h);
+  }
+
+  $n = $nd ? $nd : 'zero';
+  say "There are $n D interface files in the '$BP::DIDIR' directory:";
+  say "  new:       $stats{di}{new}";
+  say "  unchanged: $stats{di}{sam}";
+  say "  changed:   $stats{di}{dif}";
+
+  if ($G::verbose) {
+    say "  Files:";
+    say "    $_" for (@d);
+  }
+}
+elsif ($convert) {
+  @ifils = @h
+    if !@ifils;
+  say "Mode is '-c$convert' (convert method $convert)...\n";
+  die "debug exit"
+    if (0 && $G::debug);
+  die "FATAL:  No input files selected.\n"
+    if !@ifils;
+
+  D::convert(\@ifils, \@ofils, \%f, \%stats, $convert);
+}
+elsif ($Bgen) {
+  BP::get_brlcad_inc_data(\@ofils, $G::debug);
+}
+elsif ($Egen) {
+  # requires BH.pm
+  my $f = 'BH.pm';
+  die "ERROR:  Need auto-generated file '$f'.\n"
+    if ! -f $f;
+  BP::get_brlcad_ext_inc_data(\@ofils, $G::debug);
+}
+
+say "Normal end.";
+if (@ofils) {
+  my $s = (1 < @ofils) ? 's' : '';
+  say "See output file$s:";
+  say "  $_" for @ofils;
+}
+else {
+  say "No output files were generated (no input file was";
+  say "  changed from previous runs).";
+}
+
+#### subroutines ####
+sub get_status {
+  my $sref = shift @_; # \%stats
+  my $fref = shift @_; # \%f
+
+  $sref->{h}{new} = 0;
+  $sref->{h}{sam} = 0;
+  $sref->{h}{dif} = 0;
+
+  $sref->{di}{new} = 0;
+  $sref->{di}{sam} = 0;
+  $sref->{di}{dif} = 0;
+
+  foreach my $f (keys %{$fref}) {
+    my $s = file_status($f);
+    my $typ = $f =~ m{$G::Hsuf \z}xms ? 'h' : 'd';
+    die "ERROR:  Uknown file type for file '$f'!"
+      if ($typ eq 'd' && $f !~ m{$G::Dsuf \z}xms);
+
+    $fref->{$f}{status} = $s;
+    $fref->{$f}{typ}    = $typ;
+
+    if ($s == $G::NEW) {
+      ++$sref->{$typ}{new};
+    }
+    elsif ($s == $G::SAME) {
+      ++$sref->{$typ}{sam};
+    }
+    elsif ($s == $G::DIFF) {
+      ++$sref->{$typ}{dif};
+    }
+    else {
+      die "ERROR:  Unknown status for '$f'!" if ! defined $s;
+    }
+  }
+} # get_status
+
+sub file_status {
+  # uses an md5 hash to determine if a file has changed (or is new)
+  my $f = shift @_;
+
+  # current hash:
+  my $curr_hash = DS::calc_md5hash($f);
+  # previous, if any
+  my $prev_hash = DS::retrieve_md5hash($f);
+
+  my $status = undef;
+  if (!$prev_hash) {
+    $status = $G::NEW;
+    #say "Note that '$f' is new or unprocessed.";
+  }
+  elsif ($prev_hash eq $curr_hash) {
+    $status = $G::SAME;
+    #say "Note that '$f' has not changed.";
+  }
+  else {
+    DS::store_md5hash($f, $curr_hash);
+    $status = $G::DIFF;
+    #say "Note that '$f' has changed.";
+  }
+
+  die "ERROR:  Unknown status for '$f'!" if ! defined $status;
+
+  return $status;
+
+} # file_status
+
+sub help {
+  say <<"HERE";
+$usage
+
+modes:
+
+  -r    report status of .h and .d files in the directory
+
+  -c1   use method 1 to convert .h files to .d files
+          method 1 uses a C compiler to convert the header to an
+          intermediate file for further manipulation
+        this program uses GNU gcc:
+          \$ gcc -E -o outfile -I incdir .. -I incdirN infile
+
+  -c2   use method 2 to convert .h files to .d files
+          method 2 uses 'dstep' to convert the header to an
+          intermediate file for further manipulation
+        this program uses dstep:
+          \$ dstep infile -o outfile
+
+  -c3   NOT YET WORKING!!!
+        use method 3 to convert .h files to .d files
+          method 1 uses a C compiler to convert the header to an
+          intermediate file for further manipulation
+        this program uses GNU gcc:
+          \$ gcc -fdump-translation-unit -o outfile -I incdir .. -I incdirN infile
+
+  -h=X  restrict conversion attempt to just file X
+
+options:
+
+
+  -f    force overwriting files
+  -d    debug
+  -h    help
+  -C    cleans out all generated files and the stored file hashes
+
+  -n=X  parse after reading X chunks instead of the entire file
+
+        use '-n=-1' to run in an iterative node which expands the
+        run set by one object at a time until an added object
+        causes the set to fail a build
+
+   t    test mode for developers
+
+Notes:
+
+  1.  The convert options will normall convert all known .h files to
+      .d files only if they have no existing .d file.
+
+  2.  Excptions to note 1:
+
+      + Use of the '-h=X' option restricts the set of .h files to be
+        considered to the single file X.
+
+      + Use of the '-f' option will allow overwriting an existing .d
+        file.
+
+  3.  See conversion information at:
+
+      + <http://wiki.dlang.org/Converting_C_.h_Files_to_D_Modules>
+
+      + <http://stackoverflow.com/questions/994732/how-can-i-parse-a-c-header-file-with-perl>
+HERE
+
+  exit;
+} # help

misc/d-bindings/examples/demo_Cgrammar_v2.pl

@@ -0,0 +1,326 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+# This improved version of the C grammar was provided by Joe Buehler
+
+use Parse::RecDescent;
+
+if (!@ARGV) {
+  print "Usage: $0 <C file for parsing>\n";
+  exit;
+}
+
+my $ifil = shift @ARGV;
+open my $fp, '<', $ifil
+  or die "$ifil: $!";
+
+local $/;
+my $grammar = <DATA>;
+my $parser = Parse::RecDescent->new($grammar);
+
+my $text = <$fp>;
+#my $text = $s;
+
+my $parse_tree = $parser->translation_unit($text) or die "bad C code";
+
+use Data::Dumper 'Dumper';
+warn Dumper [ $parse_tree ];
+
+__DATA__
+<autotree>
+
+primary_expression:
+	IDENTIFIER
+	| CONSTANT
+	| STRING_LITERAL
+	| '(' expression ')'
+
+postfix_expression_post:
+	'[' expression ']'
+	| '(' argument_expression_list(?) ')'
+	| '.' IDENTIFIER
+	| '->' IDENTIFIER
+	| '++'
+	| '--'
+
+postfix_expression:
+	primary_expression postfix_expression_post(s?)
+
+argument_expression_list:
+	assignment_expression (',' assignment_expression)(s?)
+
+unary_expression:
+	postfix_expression
+	| '++' unary_expression
+	| '--' unary_expression
+	| unary_operator cast_expression
+	| SIZEOF unary_expression
+	| SIZEOF '(' type_name ')'
+
+unary_operator:
+	/[-&*+!~]/
+
+cast_expression:
+	'(' type_name ')' cast_expression
+	| unary_expression
+
+multiplicative_expression_op:
+	/[*\/%]/
+
+multiplicative_expression:
+	cast_expression (multiplicative_expression_op cast_expression)(s?)
+
+additive_expression_op:
+	/[-+]/
+
+additive_expression:
+	multiplicative_expression (additive_expression_op multiplicative_expression)(s?)
+
+shift_expression_pre_op:
+	/(<<|>>)(?!=)/
+
+shift_expression:
+	additive_expression (shift_expression_pre_op additive_expression)(s?)
+
+relational_expression_op:
+	/(<=|>=|<|>)/
+
+relational_expression:
+	shift_expression (relational_expression_op shift_expression)(s?)
+
+equality_expression_pre_op:
+	/==|!=/
+
+equality_expression:
+	relational_expression (equality_expression_pre_op relational_expression)(s?)
+
+and_expression:
+	equality_expression ('&' equality_expression)(s?)
+
+exclusive_or_expression:
+	and_expression ('^' and_expression)(s?)
+
+inclusive_or_expression:
+	exclusive_or_expression ('|' exclusive_or_expression)(s?)
+
+logical_and_expression:
+	inclusive_or_expression ('&&' inclusive_or_expression)(s?)
+
+logical_or_expression:
+	logical_and_expression ('||' logical_and_expression)(s?)
+
+conditional_expression:
+	logical_or_expression ('?' expression ':' conditional_expression)(?)
+
+assignment_expression:
+	conditional_expression
+	| unary_expression assignment_operator assignment_expression
+
+assignment_operator:
+	/=(?!=)|\+=|\&=|\/=|<<=|\%=|\*=|\|=|>>=|-=|\^=/
+
+expression:
+	assignment_expression (',' assignment_expression)(s?)
+
+constant_expression:
+	conditional_expression
+
+declaration:
+	declaration_specifiers init_declarator_list ';'
+	| declaration_specifiers ';'
+
+declaration_specifiers:
+	( storage_class_specifier | type_specifier | type_qualifier )(s)
+
+init_declarator_list:
+	init_declarator (',' init_declarator)(s?)
+
+init_declarator:
+	declarator '=' initializer
+	| declarator
+
+storage_class_specifier:
+	/(typedef|extern|static|auto|register)(?![a-zA-Z0-9_])/
+
+type_specifier:
+	/(void|char|short|int|long|float|double|signed|unsigned)(?![a-zA-Z0-9_])/
+	| struct_or_union_specifier
+	| enum_specifier
+	| TYPE_NAME
+
+struct_or_union_specifier:
+	struct_or_union IDENTIFIER '{' struct_declaration_list '}'
+	| struct_or_union '{' struct_declaration_list '}'
+	| struct_or_union IDENTIFIER
+
+struct_or_union:
+	/(struct|union)(?![a-zA-Z0-9_])/
+
+struct_declaration_list:
+	struct_declaration(s)
+
+struct_declaration:
+	specifier_qualifier_list struct_declarator_list ';'
+
+specifier_qualifier_list:
+	( type_specifier | type_qualifier )(s)
+
+struct_declarator_list:
+	struct_declarator (',' struct_declarator)(s?)
+
+struct_declarator:
+	declarator ':' constant_expression
+	| declarator
+	| ':' constant_expression
+
+enum_specifier:
+	ENUM '{' enumerator_list '}'
+	| ENUM IDENTIFIER '{' enumerator_list '}'
+	| ENUM IDENTIFIER
+
+enumerator_list:
+	enumerator (',' enumerator)(s?)
+
+enumerator:
+	IDENTIFIER '=' constant_expression
+	| IDENTIFIER
+
+type_qualifier:
+	/(const|volatile)(?![a-zA-Z0-9_])/
+
+declarator:
+	pointer(?) direct_declarator
+
+direct_declarator_pre:
+	IDENTIFIER
+	| '(' declarator ')'
+
+direct_declarator_post:
+	'[' constant_expression ']'
+	| '[' ']'
+	| '(' parameter_type_list ')'
+	| '(' identifier_list ')'
+	| '(' ')'
+
+direct_declarator:
+	direct_declarator_pre direct_declarator_post(s?)
+
+pointer:
+	'*' type_qualifier_list(?) pointer(?)
+
+type_qualifier_list:
+	type_qualifier(s)
+
+parameter_type_list:
+	parameter_list ',' '...'
+	| parameter_list
+
+parameter_list:
+	parameter_declaration (',' parameter_declaration)(s?)
+
+parameter_declaration:
+	declaration_specifiers declarator
+	| declaration_specifiers abstract_declarator(?)
+
+identifier_list:
+	IDENTIFIER (',' IDENTIFIER)(s?)
+
+type_name:
+	specifier_qualifier_list abstract_declarator(?)
+
+abstract_declarator:
+	pointer direct_abstract_declarator(?)
+	| direct_abstract_declarator
+
+direct_abstract_declarator_pre:
+	'(' abstract_declarator ')'
+	| direct_abstract_declarator_post
+
+direct_abstract_declarator_post:
+	'[' ']'
+	| '[' constant_expression ']'
+	| '(' ')'
+	| '(' parameter_type_list ')'
+
+direct_abstract_declarator:
+	direct_abstract_declarator_pre direct_abstract_declarator_post(s?)
+
+initializer:
+	assignment_expression
+	| '{' initializer_list '}'
+	| '{' initializer_list ',' '}'
+
+initializer_list:
+	initializer (',' initializer)(s?)
+
+statement:
+	labeled_statement
+	| compound_statement
+	| expression_statement
+	| selection_statement
+	| iteration_statement
+	| jump_statement
+
+labeled_statement:
+	IDENTIFIER ':' statement
+	| /case(?![a-zA-Z0-9_])/ constant_expression ':' statement
+	| /default(?![a-zA-Z0-9_])/ ':' statement
+
+compound_statement:
+	'{' declaration_list statement_list(?) '}'
+	| '{' statement_list(?) '}'
+
+declaration_list:
+	declaration(s)
+
+statement_list:
+	statement(s)
+
+expression_statement:
+	expression(?) ';'
+
+selection_statement:
+	IF '(' expression ')' statement ELSE statement
+	| IF '(' expression ')' statement
+	| SWITCH '(' expression ')' statement
+
+iteration_statement:
+	WHILE '(' expression ')' statement
+	| DO statement WHILE '(' expression ')' ';'
+	| FOR '(' expression_statement expression_statement expression(?) ')' statement
+
+jump_statement:
+	/goto(?![a-zA-Z0-9_])/ IDENTIFIER ';'
+	| /continue(?![a-zA-Z0-9_])/ ';'
+	| /break(?![a-zA-Z0-9_])/ ';'
+	| /return(?![a-zA-Z0-9_])/ expression(?) ';'
+
+translation_unit:
+	external_declaration(s)
+
+external_declaration:
+	function_definition { print "*** function\n"; }
+	| declaration { print "*** declaration\n"; }
+
+function_definition:
+	declaration_specifiers declarator(?) declaration_list(?) compound_statement
+
+reserved_word:
+	/(auto|break|case|char|const|continue|default|do|double|enum|extern|float|for|goto|if|int|long|register|return|short|signed|sizeof|static|struct|switch|typedef|union|unsigned|void|volatile|while)(?![a-zA-Z0-9_])/
+
+CONSTANT:       /[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?/
+DO:             /do(?![a-zA-Z0-9_])/
+ELSE:           /else(?![a-zA-Z0-9_])/
+ENUM:           /enum(?![a-zA-Z0-9_])/
+FOR:            /for(?![a-zA-Z0-9_])/
+IDENTIFIER:     ...!reserved_word /[a-zA-Z_][a-zA-Z_0-9]*/
+IF:             /if(?![a-zA-Z0-9_])/
+SIZEOF:         /sizeof(?![a-zA-Z0-9_])/
+STRING_LITERAL: { extract_delimited($text,'"') }
+SWITCH:         /switch(?![a-zA-Z0-9_])/
+TYPE_NAME:      ...!reserved_word /[a-zA-Z_][a-zA-Z_0-9]*/ ...IDENTIFIER
+				| ...!reserved_word /[a-zA-Z_][a-zA-Z_0-9]*/ .../[:*)]/
+WHILE:          /while(?![a-zA-Z0-9_])/
+

misc/d-bindings/examples/recdecent-example.pl

@@ -0,0 +1,60 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Parse::RecDescent;
+use Data::Dumper;
+
+use vars qw(%VARIABLE);
+
+# Enable warnings within the Parse::RecDescent module.
+
+$::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
+$::RD_WARN   = 1; # Enable warnings. This will warn on unused rules &c.
+$::RD_HINT   = 1; # Give out hints to help fix problems.
+
+my $grammar = <<'_EOGRAMMAR_';
+
+# Terminals (macros that can't expand further)
+#
+
+OP       : m([-+*/%])      # Mathematical operators
+INTEGER  : /[-+]?\d+/      # Signed integers
+VARIABLE : /\w[a-z0-9_]*/i # Variable
+
+expression : INTEGER OP expression
+           { return main::expression(@item) }
+           | VARIABLE OP expression
+           { return main::expression(@item) }
+           | INTEGER
+           | VARIABLE
+           { return $main::VARIABLE{$item{VARIABLE}} }
+
+print_instruction  : /print/i expression
+                   { print $item{expression}."\n" }
+assign_instruction : VARIABLE "=" expression
+                   { $main::VARIABLE{$item{VARIABLE}} = $item{expression} }
+
+instruction : print_instruction
+            | assign_instruction
+
+startrule: instruction(s /;/)
+
+_EOGRAMMAR_
+
+sub expression {
+  shift;
+  my ($lhs,$op,$rhs) = @_;
+  $lhs = $VARIABLE{$lhs} if $lhs=~/[^-+0-9]/;
+  return eval "$lhs $op $rhs";
+}
+
+my $parser = Parse::RecDescent->new($grammar);
+
+print "a=2\n";             $parser->startrule("a=2");
+print "a=1+3\n";           $parser->startrule("a=1+3");
+print "print 5*7\n";       $parser->startrule("print 5*7");
+print "print 2/4\n";       $parser->startrule("print 2/4");
+print "print 2+2/4\n";     $parser->startrule("print 2+2/4");
+print "print 2+-2/4\n";    $parser->startrule("print 2+-2/4");
+print "a = 5 ; print a\n"; $parser->startrule("a = 5 ; print a");

misc/d-bindings/gen-cgrammar-modules.sh

@@ -0,0 +1,22 @@
+#/bin/bash
+
+PM=CGrammar
+PM2=CGrammar2
+
+if [ -z "$1" ] ; then
+  echo "Usage: $0 go"
+  echo
+  echo "Generates the Perl modules for the C grammars:"
+  echo "  $PM.pm"
+  echo "  $PM2.pm"
+  exit
+fi
+
+cmd="perl -MParse::RecDescent - c-grammar.txt $PM"
+cmd2="perl -MParse::RecDescent - c-grammar2.txt $PM2"
+
+`$cmd`
+`$cmd2`
+
+echo "====================================================="
+echo "See generated files '$PM.pm' and '$PM2.pm'."

misc/d-bindings/makefile

@@ -0,0 +1,35 @@
+# Note:  This makefile is posted on the D Wiki in the Cookbook section at:
+#
+#   http://wiki.dlang.org/Using_C_libraries_for_a_D_program
+#
+# Corrections should be posted there.
+
+# use the dmd compiler
+DMD = /usr/bin/dmd
+
+BDIR    := /usr/brlcad/rel-7.25.0
+LIBDIR  := $(BDIR)/lib
+INCDIR  := $(BDIR)/include/brlcad
+INCDIR2 := $(BDIR)/include
+
+# D interface (DI) files dir
+DIDIR   := ./di
+
+BINDINGS = $(DIDIR)/bu.d
+
+SRC = test_bu.d $(BINDINGS)
+
+OBJ = $(SRC:.d=.o)
+
+PROG = test-bu
+
+all: $(PROG)
+
+$(PROG): $(OBJ)
+	$(DMD) $(OBJ) -L$(LIBDIR) -lbu
+
+%.o: %.d
+	$(DMD) -c $<
+
+clean:
+	-rm $(PROG) *.o

misc/d-bindings/test_bu.d

@@ -0,0 +1,7 @@
+import bu;
+
+void
+main()
+{
+  writeln("This is a test of interfacing BRL-CAD's libbu with a D program.");
+}

misc/d-bindings/test_hdr.h

@@ -0,0 +1,633 @@
+// C object: -1
+typedef (struct t*)0 blah0;
+typedef (struct t *)0 blah1;
+typedef ( struct t*) 0 blah2;
+typedef ( struct t * * ) 0 blah3;
+
+typedef ((struct t*)0) blah4;
+
+// C object: 0
+extern ptrdiff_t t;
+
+// C object: 1
+typedef long __tok;
+
+// C object: 2
+typedef long __val[2];
+
+// C object: 3
+typedef struct
+{
+  long __val[2];
+} __quad_t;
+
+// C object: 4
+typedef struct blah
+{
+  long t;
+} blah_t, foo_t;
+
+// C object: 5
+struct {
+  short t;
+} bar_t;
+
+// C object: 6
+typedef enum {
+  FAIL,
+  PASS = 2
+} raz;
+
+/*
+typedef struct
+{
+  __u_long __val[2];
+} __u_quad_t;
+*/
+
+/*
+typedef struct TclStubs {
+    int magic;
+    struct TclStubHooks *hooks;
+    int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, ClientData clientData);
+    const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, ClientData *clientDataPtr);
+    void (*tcl_Panic) (const char *format, ...);
+    char * (*tcl_Alloc) (unsigned int size);
+    void (*tcl_Free) (char *ptr);
+    char * (*tcl_Realloc) (char *ptr, unsigned int size);
+    char * (*tcl_DbCkalloc) (unsigned int size, const char *file, int line);
+    int (*tcl_DbCkfree) (char *ptr, const char *file, int line);
+    char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, const char *file, int line);
+    void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData);
+    void (*tcl_DeleteFileHandler) (int fd);
+    void (*tcl_SetTimer) (Tcl_Time *timePtr);
+    void (*tcl_Sleep) (int ms);
+    int (*tcl_WaitForEvent) (Tcl_Time *timePtr);
+    int (*tcl_AppendAllObjTypes) (Tcl_Interp *interp, Tcl_Obj *objPtr);
+    void (*tcl_AppendStringsToObj) (Tcl_Obj *objPtr, ...);
+    void (*tcl_AppendToObj) (Tcl_Obj *objPtr, const char *bytes, int length);
+    Tcl_Obj * (*tcl_ConcatObj) (int objc, Tcl_Obj *const objv[]);
+    int (*tcl_ConvertToType) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_ObjType *objTypePtr);
+    void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line);
+    void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line);
+    int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line);
+    Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line);
+    Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int length, const char *file, int line);
+    Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line);
+    Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line);
+    Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, const char *file, int line);
+    Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line);
+    Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, int length, const char *file, int line);
+    Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr);
+    void (*tclFreeObj) (Tcl_Obj *objPtr);
+    int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *boolPtr);
+    int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr);
+    unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr);
+    int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr);
+    int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr);
+    int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char **tablePtr, const char *msg, int flags, int *indexPtr);
+    int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr);
+    int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr);
+    int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr);
+    Tcl_ObjType * (*tcl_GetObjType) (const char *typeName);
+    char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr);
+    void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr);
+    int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr);
+    int (*tcl_ListObjAppendElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr);
+    int (*tcl_ListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr);
+    int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int tcl_scoped_index, Tcl_Obj **objPtrPtr);
+    int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr);
+    int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]);
+    Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue);
+    Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int length);
+    Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue);
+    Tcl_Obj * (*tcl_NewIntObj) (int intValue);
+    Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]);
+    Tcl_Obj * (*tcl_NewLongObj) (long longValue);
+    Tcl_Obj * (*tcl_NewObj) (void);
+    Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, int length);
+    void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue);
+    unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int length);
+    void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int length);
+    void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue);
+    void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue);
+    void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]);
+    void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue);
+    void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length);
+    void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, int length);
+    void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message);
+    void (*tcl_AddObjErrorInfo) (Tcl_Interp *interp, const char *message, int length);
+    void (*tcl_AllowExceptions) (Tcl_Interp *interp);
+    void (*tcl_AppendElement) (Tcl_Interp *interp, const char *element);
+    void (*tcl_AppendResult) (Tcl_Interp *interp, ...);
+    Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, ClientData clientData);
+    void (*tcl_AsyncDelete) (Tcl_AsyncHandler async);
+    int (*tcl_AsyncInvoke) (Tcl_Interp *interp, int code);
+    void (*tcl_AsyncMark) (Tcl_AsyncHandler async);
+    int (*tcl_AsyncReady) (void);
+    void (*tcl_BackgroundError) (Tcl_Interp *interp);
+    char (*tcl_Backslash) (const char *src, int *readPtr);
+    int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList);
+    void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData);
+    void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData);
+    int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan);
+    int (*tcl_CommandComplete) (const char *cmd);
+    char * (*tcl_Concat) (int argc, const char *const *argv);
+    int (*tcl_ConvertElement) (const char *src, char *dst, int flags);
+    int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags);
+    int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv);
+    int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]);
+    Tcl_Channel (*tcl_CreateChannel) (Tcl_ChannelType *channelTypePtr, const char *chanName, ClientData instanceData, int mask);
+    void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData);
+    void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData);
+    Tcl_Command (*tcl_CreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc);
+    void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData);
+    void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData);
+    Tcl_Interp * (*tcl_CreateInterp) (void);
+    void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData);
+    Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc);
+    Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe);
+    Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData);
+    Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData);
+    void (*tcl_DeleteAssocData) (Tcl_Interp *interp, const char *name);
+    void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData);
+    void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData);
+    int (*tcl_DeleteCommand) (Tcl_Interp *interp, const char *cmdName);
+    int (*tcl_DeleteCommandFromToken) (Tcl_Interp *interp, Tcl_Command command);
+    void (*tcl_DeleteEvents) (Tcl_EventDeleteProc *proc, ClientData clientData);
+    void (*tcl_DeleteEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData);
+    void (*tcl_DeleteExitHandler) (Tcl_ExitProc *proc, ClientData clientData);
+    void (*tcl_DeleteHashEntry) (Tcl_HashEntry *entryPtr);
+    void (*tcl_DeleteHashTable) (Tcl_HashTable *tablePtr);
+    void (*tcl_DeleteInterp) (Tcl_Interp *interp);
+    void (*tcl_DetachPids) (int numPids, Tcl_Pid *pidPtr);
+    void (*tcl_DeleteTimerHandler) (Tcl_TimerToken token);
+    void (*tcl_DeleteTrace) (Tcl_Interp *interp, Tcl_Trace tracer);
+    void (*tcl_DontCallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData);
+    int (*tcl_DoOneEvent) (int flags);
+    void (*tcl_DoWhenIdle) (Tcl_IdleProc *proc, ClientData clientData);
+    char * (*tcl_DStringAppend) (Tcl_DString *dsPtr, const char *bytes, int length);
+    char * (*tcl_DStringAppendElement) (Tcl_DString *dsPtr, const char *element);
+    void (*tcl_DStringEndSublist) (Tcl_DString *dsPtr);
+    void (*tcl_DStringFree) (Tcl_DString *dsPtr);
+    void (*tcl_DStringGetResult) (Tcl_Interp *interp, Tcl_DString *dsPtr);
+    void (*tcl_DStringInit) (Tcl_DString *dsPtr);
+    void (*tcl_DStringResult) (Tcl_Interp *interp, Tcl_DString *dsPtr);
+    void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length);
+    void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr);
+    int (*tcl_Eof) (Tcl_Channel chan);
+    const char * (*tcl_ErrnoId) (void);
+    const char * (*tcl_ErrnoMsg) (int err);
+    int (*tcl_Eval) (Tcl_Interp *interp, const char *script);
+    int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName);
+    int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr);
+    void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc);
+    void (*tcl_Exit) (int status);
+    int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName);
+    int (*tcl_ExprBoolean) (Tcl_Interp *interp, const char *expr, int *ptr);
+    int (*tcl_ExprBooleanObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr);
+    int (*tcl_ExprDouble) (Tcl_Interp *interp, const char *expr, double *ptr);
+    int (*tcl_ExprDoubleObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr);
+    int (*tcl_ExprLong) (Tcl_Interp *interp, const char *expr, long *ptr);
+    int (*tcl_ExprLongObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr);
+    int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr);
+    int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr);
+    void (*tcl_Finalize) (void);
+    void (*tcl_FindExecutable) (const char *argv0);
+    Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr);
+    int (*tcl_Flush) (Tcl_Channel chan);
+    void (*tcl_FreeResult) (Tcl_Interp *interp);
+    int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr);
+    int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv);
+    ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr);
+    Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr);
+    int (*tcl_GetChannelBufferSize) (Tcl_Channel chan);
+    int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, ClientData *handlePtr);
+    ClientData (*tcl_GetChannelInstanceData) (Tcl_Channel chan);
+    int (*tcl_GetChannelMode) (Tcl_Channel chan);
+    const char * (*tcl_GetChannelName) (Tcl_Channel chan);
+    int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr);
+    Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan);
+    int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr);
+    const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command);
+    int (*tcl_GetErrno) (void);
+    const char * (*tcl_GetHostName) (void);
+    int (*tcl_GetInterpPath) (Tcl_Interp *askInterp, Tcl_Interp *slaveInterp);
+    Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp);
+    const char * (*tcl_GetNameOfExecutable) (void);
+    Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp);
+    int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr);
+    Tcl_PathType (*tcl_GetPathType) (const char *path);
+    int (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr);
+    int (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr);
+    int (*tcl_GetServiceMode) (void);
+    Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName);
+    Tcl_Channel (*tcl_GetStdChannel) (int type);
+    const char * (*tcl_GetStringResult) (Tcl_Interp *interp);
+    const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags);
+    const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags);
+    int (*tcl_GlobalEval) (Tcl_Interp *interp, const char *command);
+    int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr);
+    int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken);
+    int (*tcl_Init) (Tcl_Interp *interp);
+    void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType);
+    int (*tcl_InputBlocked) (Tcl_Channel chan);
+    int (*tcl_InputBuffered) (Tcl_Channel chan);
+    int (*tcl_InterpDeleted) (Tcl_Interp *interp);
+    int (*tcl_IsSafe) (Tcl_Interp *interp);
+    char * (*tcl_JoinPath) (int argc, const char *const *argv, Tcl_DString *resultPtr);
+    int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, char *addr, int type);
+    void *reserved188;
+    Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode);
+    int (*tcl_MakeSafe) (Tcl_Interp *interp);
+    Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket);
+    char * (*tcl_Merge) (int argc, const char *const *argv);
+    Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr);
+    void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask);
+    Tcl_Obj * (*tcl_ObjGetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags);
+    Tcl_Obj * (*tcl_ObjSetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags);
+    Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, const char **argv, int flags);
+    Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions);
+    Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async);
+    Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData);
+    void (*tcl_Preserve) (ClientData data);
+    void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst);
+    int (*tcl_PutEnv) (const char *assignment);
+    const char * (*tcl_PosixError) (Tcl_Interp *interp);
+    void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position);
+    int (*tcl_Read) (Tcl_Channel chan, char *bufPtr, int toRead);
+    void (*tcl_ReapDetachedProcs) (void);
+    int (*tcl_RecordAndEval) (Tcl_Interp *interp, const char *cmd, int flags);
+    int (*tcl_RecordAndEvalObj) (Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags);
+    void (*tcl_RegisterChannel) (Tcl_Interp *interp, Tcl_Channel chan);
+    void (*tcl_RegisterObjType) (Tcl_ObjType *objTypePtr);
+    Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, const char *pattern);
+    int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start);
+    int (*tcl_RegExpMatch) (Tcl_Interp *interp, const char *text, const char *pattern);
+    void (*tcl_RegExpRange) (Tcl_RegExp regexp, int tcl_scoped_index, const char **startPtr, const char **endPtr);
+    void (*tcl_Release) (ClientData clientData);
+    void (*tcl_ResetResult) (Tcl_Interp *interp);
+    int (*tcl_ScanElement) (const char *str, int *flagPtr);
+    int (*tcl_ScanCountedElement) (const char *str, int length, int *flagPtr);
+    int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode);
+    int (*tcl_ServiceAll) (void);
+    int (*tcl_ServiceEvent) (int flags);
+    void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData);
+    void (*tcl_SetChannelBufferSize) (Tcl_Channel chan, int sz);
+    int (*tcl_SetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, const char *newValue);
+    int (*tcl_SetCommandInfo) (Tcl_Interp *interp, const char *cmdName, const Tcl_CmdInfo *infoPtr);
+    void (*tcl_SetErrno) (int err);
+    void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...);
+    void (*tcl_SetMaxBlockTime) (Tcl_Time *timePtr);
+    void (*tcl_SetPanicProc) (Tcl_PanicProc *panicProc);
+    int (*tcl_SetRecursionLimit) (Tcl_Interp *interp, int depth);
+    void (*tcl_SetResult) (Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc);
+    int (*tcl_SetServiceMode) (int mode);
+    void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr);
+    void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr);
+    void (*tcl_SetStdChannel) (Tcl_Channel channel, int type);
+    const char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags);
+    const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags);
+    const char * (*tcl_SignalId) (int sig);
+    const char * (*tcl_SignalMsg) (int sig);
+    void (*tcl_SourceRCFile) (Tcl_Interp *interp);
+    int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr);
+    void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr);
+    void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc);
+    int (*tcl_StringMatch) (const char *str, const char *pattern);
+    int (*tcl_TellOld) (Tcl_Channel chan);
+    int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData);
+    int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData);
+    char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr);
+    int (*tcl_Ungets) (Tcl_Channel chan, const char *str, int len, int atHead);
+    void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName);
+    int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan);
+    int (*tcl_UnsetVar) (Tcl_Interp *interp, const char *varName, int flags);
+    int (*tcl_UnsetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags);
+    void (*tcl_UntraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData);
+    void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData);
+    void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, const char *varName);
+    int (*tcl_UpVar) (Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags);
+    int (*tcl_UpVar2) (Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags);
+    int (*tcl_VarEval) (Tcl_Interp *interp, ...);
+    ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData);
+    ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData);
+    int (*tcl_Write) (Tcl_Channel chan, const char *s, int slen);
+    void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message);
+    int (*tcl_DumpActiveMemory) (const char *fileName);
+    void (*tcl_ValidateAllMemory) (const char *file, int line);
+    void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList);
+    void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList);
+    char * (*tcl_HashStats) (Tcl_HashTable *tablePtr);
+    const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr);
+    const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact);
+    const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, ClientData *clientDataPtr);
+    int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version);
+    const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact);
+    void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList);
+    int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList);
+    Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options);
+    void (*tcl_PanicVA) (const char *format, va_list argList);
+    void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type);
+    void (*tcl_InitMemory) (Tcl_Interp *interp);
+    Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, Tcl_ChannelType *channelTypePtr, ClientData instanceData, int mask, Tcl_Channel prevChan);
+    int (*tcl_UnstackChannel) (Tcl_Interp *interp, Tcl_Channel chan);
+    Tcl_Channel (*tcl_GetStackedChannel) (Tcl_Channel chan);
+    void (*tcl_SetMainLoop) (Tcl_MainLoopProc *proc);
+    void *reserved285;
+    void (*tcl_AppendObjToObj) (Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr);
+    Tcl_Encoding (*tcl_CreateEncoding) (const Tcl_EncodingType *encodingTypePtr);
+    void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData);
+    void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData);
+    void (*tcl_DiscardResult) (Tcl_SavedResult *statePtr);
+    int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, int numBytes, int flags);
+    int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags);
+    int (*tcl_EvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags);
+    void (*tcl_ExitThread) (int status);
+    int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr);
+    char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr);
+    void (*tcl_FinalizeThread) (void);
+    void (*tcl_FinalizeNotifier) (ClientData clientData);
+    void (*tcl_FreeEncoding) (Tcl_Encoding encoding);
+    Tcl_ThreadId (*tcl_GetCurrentThread) (void);
+    Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name);
+    const char * (*tcl_GetEncodingName) (Tcl_Encoding encoding);
+    void (*tcl_GetEncodingNames) (Tcl_Interp *interp);
+    int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr);
+    void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size);
+    Tcl_Obj * (*tcl_GetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, int flags);
+    ClientData (*tcl_InitNotifier) (void);
+    void (*tcl_MutexLock) (Tcl_Mutex *mutexPtr);
+    void (*tcl_MutexUnlock) (Tcl_Mutex *mutexPtr);
+    void (*tcl_ConditionNotify) (Tcl_Condition *condPtr);
+    void (*tcl_ConditionWait) (Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, Tcl_Time *timePtr);
+    int (*tcl_NumUtfChars) (const char *src, int length);
+    int (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag);
+    void (*tcl_RestoreResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr);
+    void (*tcl_SaveResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr);
+    int (*tcl_SetSystemEncoding) (Tcl_Interp *interp, const char *name);
+    Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags);
+    void (*tcl_ThreadAlert) (Tcl_ThreadId threadId);
+    void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position);
+    Tcl_UniChar (*tcl_UniCharAtIndex) (const char *src, int tcl_scoped_index);
+    Tcl_UniChar (*tcl_UniCharToLower) (int ch);
+    Tcl_UniChar (*tcl_UniCharToTitle) (int ch);
+    Tcl_UniChar (*tcl_UniCharToUpper) (int ch);
+    int (*tcl_UniCharToUtf) (int ch, char *buf);
+    const char * (*tcl_UtfAtIndex) (const char *src, int tcl_scoped_index);
+    int (*tcl_UtfCharComplete) (const char *src, int length);
+    int (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst);
+    const char * (*tcl_UtfFindFirst) (const char *src, int ch);
+    const char * (*tcl_UtfFindLast) (const char *src, int ch);
+    const char * (*tcl_UtfNext) (const char *src);
+    const char * (*tcl_UtfPrev) (const char *src, const char *start);
+    int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr);
+    char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr);
+    int (*tcl_UtfToLower) (char *src);
+    int (*tcl_UtfToTitle) (char *src);
+    int (*tcl_UtfToUniChar) (const char *src, Tcl_UniChar *chPtr);
+    int (*tcl_UtfToUpper) (char *src);
+    int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen);
+    int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr);
+    char * (*tcl_GetString) (Tcl_Obj *objPtr);
+    const char * (*tcl_GetDefaultEncodingDir) (void);
+    void (*tcl_SetDefaultEncodingDir) (const char *path);
+    void (*tcl_AlertNotifier) (ClientData clientData);
+    void (*tcl_ServiceModeHook) (int mode);
+    int (*tcl_UniCharIsAlnum) (int ch);
+    int (*tcl_UniCharIsAlpha) (int ch);
+    int (*tcl_UniCharIsDigit) (int ch);
+    int (*tcl_UniCharIsLower) (int ch);
+    int (*tcl_UniCharIsSpace) (int ch);
+    int (*tcl_UniCharIsUpper) (int ch);
+    int (*tcl_UniCharIsWordChar) (int ch);
+    int (*tcl_UniCharLen) (const Tcl_UniChar *uniStr);
+    int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars);
+    char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr);
+    Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr);
+    Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags);
+    Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count);
+    void (*tcl_FreeParse) (Tcl_Parse *parsePtr);
+    void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length);
+    int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr);
+    int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr);
+    int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr);
+    int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr);
+    int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append);
+    char * (*tcl_GetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr);
+    int (*tcl_Chdir) (const char *dirName);
+    int (*tcl_Access) (const char *path, int mode);
+    int (*tcl_Stat) (const char *path, struct stat *bufPtr);
+    int (*tcl_UtfNcmp) (const char *s1, const char *s2, unsigned long n);
+    int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, unsigned long n);
+    int (*tcl_StringCaseMatch) (const char *str, const char *pattern, int nocase);
+    int (*tcl_UniCharIsControl) (int ch);
+    int (*tcl_UniCharIsGraph) (int ch);
+    int (*tcl_UniCharIsPrint) (int ch);
+    int (*tcl_UniCharIsPunct) (int ch);
+    int (*tcl_RegExpExecObj) (Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, int offset, int nmatches, int flags);
+    void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr);
+    Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, int numChars);
+    void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars);
+    int (*tcl_GetCharLength) (Tcl_Obj *objPtr);
+    Tcl_UniChar (*tcl_GetUniChar) (Tcl_Obj *objPtr, int tcl_scoped_index);
+    Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr);
+    Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last);
+    void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length);
+    int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj);
+    void (*tcl_SetNotifier) (Tcl_NotifierProcs *notifierProcPtr);
+    Tcl_Mutex * (*tcl_GetAllocMutex) (void);
+    int (*tcl_GetChannelNames) (Tcl_Interp *interp);
+    int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, const char *pattern);
+    int (*tcl_ProcObjCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+    void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr);
+    void (*tcl_MutexFinalize) (Tcl_Mutex *mutex);
+    int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags);
+    int (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, int bytesToRead);
+    int (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, int srcLen);
+    Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan);
+    int (*tcl_ChannelBuffered) (Tcl_Channel chan);
+    const char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr);
+    Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr);
+    Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr);
+    Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (const Tcl_ChannelType *chanTypePtr);
+    Tcl_DriverClose2Proc * (*tcl_ChannelClose2Proc) (const Tcl_ChannelType *chanTypePtr);
+    Tcl_DriverInputProc * (*tcl_ChannelInputProc) (const Tcl_ChannelType *chanTypePtr);
+    Tcl_DriverOutputProc * (*tcl_ChannelOutputProc) (const Tcl_ChannelType *chanTypePtr);
+    Tcl_DriverSeekProc * (*tcl_ChannelSeekProc) (const Tcl_ChannelType *chanTypePtr);
+    Tcl_DriverSetOptionProc * (*tcl_ChannelSetOptionProc) (const Tcl_ChannelType *chanTypePtr);
+    Tcl_DriverGetOptionProc * (*tcl_ChannelGetOptionProc) (const Tcl_ChannelType *chanTypePtr);
+    Tcl_DriverWatchProc * (*tcl_ChannelWatchProc) (const Tcl_ChannelType *chanTypePtr);
+    Tcl_DriverGetHandleProc * (*tcl_ChannelGetHandleProc) (const Tcl_ChannelType *chanTypePtr);
+    Tcl_DriverFlushProc * (*tcl_ChannelFlushProc) (const Tcl_ChannelType *chanTypePtr);
+    Tcl_DriverHandlerProc * (*tcl_ChannelHandlerProc) (const Tcl_ChannelType *chanTypePtr);
+    int (*tcl_JoinThread) (Tcl_ThreadId threadId, int *result);
+    int (*tcl_IsChannelShared) (Tcl_Channel channel);
+    int (*tcl_IsChannelRegistered) (Tcl_Interp *interp, Tcl_Channel channel);
+    void (*tcl_CutChannel) (Tcl_Channel channel);
+    void (*tcl_SpliceChannel) (Tcl_Channel channel);
+    void (*tcl_ClearChannelHandlers) (Tcl_Channel channel);
+    int (*tcl_IsChannelExisting) (const char *channelName);
+    int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars);
+    int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase);
+    Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, const char *key);
+    Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const char *key, int *newPtr);
+    void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, Tcl_HashKeyType *hashKeyTypePtr);
+    void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr);
+    ClientData (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData);
+    int (*tcl_TraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData);
+    void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData);
+    char * (*tcl_AttemptAlloc) (unsigned int size);
+    char * (*tcl_AttemptDbCkalloc) (unsigned int size, const char *file, int line);
+    char * (*tcl_AttemptRealloc) (char *ptr, unsigned int size);
+    char * (*tcl_AttemptDbCkrealloc) (char *ptr, unsigned int size, const char *file, int line);
+    int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length);
+    Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel);
+    Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr);
+    int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr);
+    Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern);
+    Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags);
+    int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel);
+    int (*tcl_IsStandardChannel) (Tcl_Channel channel);
+    int (*tcl_FSCopyFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr);
+    int (*tcl_FSCopyDirectory) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr);
+    int (*tcl_FSCreateDirectory) (Tcl_Obj *pathPtr);
+    int (*tcl_FSDeleteFile) (Tcl_Obj *pathPtr);
+    int (*tcl_FSLoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1, const char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr);
+    int (*tcl_FSMatchInDirectory) (Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types);
+    Tcl_Obj * (*tcl_FSLink) (Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction);
+    int (*tcl_FSRemoveDirectory) (Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr);
+    int (*tcl_FSRenameFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr);
+    int (*tcl_FSLstat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
+    int (*tcl_FSUtime) (Tcl_Obj *pathPtr, struct utimbuf *tval);
+    int (*tcl_FSFileAttrsGet) (Tcl_Interp *interp, int tcl_scoped_index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
+    int (*tcl_FSFileAttrsSet) (Tcl_Interp *interp, int tcl_scoped_index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
+    const char ** (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
+    int (*tcl_FSStat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
+    int (*tcl_FSAccess) (Tcl_Obj *pathPtr, int mode);
+    Tcl_Channel (*tcl_FSOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *modeString, int permissions);
+    Tcl_Obj * (*tcl_FSGetCwd) (Tcl_Interp *interp);
+    int (*tcl_FSChdir) (Tcl_Obj *pathPtr);
+    int (*tcl_FSConvertToPathType) (Tcl_Interp *interp, Tcl_Obj *pathPtr);
+    Tcl_Obj * (*tcl_FSJoinPath) (Tcl_Obj *listObj, int elements);
+    Tcl_Obj * (*tcl_FSSplitPath) (Tcl_Obj *pathPtr, int *lenPtr);
+    int (*tcl_FSEqualPaths) (Tcl_Obj *firstPtr, Tcl_Obj *secondPtr);
+    Tcl_Obj * (*tcl_FSGetNormalizedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr);
+    Tcl_Obj * (*tcl_FSJoinToPath) (Tcl_Obj *pathPtr, int objc, Tcl_Obj *const objv[]);
+    ClientData (*tcl_FSGetInternalRep) (Tcl_Obj *pathPtr, Tcl_Filesystem *fsPtr);
+    Tcl_Obj * (*tcl_FSGetTranslatedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr);
+    int (*tcl_FSEvalFile) (Tcl_Interp *interp, Tcl_Obj *fileName);
+    Tcl_Obj * (*tcl_FSNewNativePath) (Tcl_Filesystem *fromFilesystem, ClientData clientData);
+    const char * (*tcl_FSGetNativePath) (Tcl_Obj *pathPtr);
+    Tcl_Obj * (*tcl_FSFileSystemInfo) (Tcl_Obj *pathPtr);
+    Tcl_Obj * (*tcl_FSPathSeparator) (Tcl_Obj *pathPtr);
+    Tcl_Obj * (*tcl_FSListVolumes) (void);
+    int (*tcl_FSRegister) (ClientData clientData, Tcl_Filesystem *fsPtr);
+    int (*tcl_FSUnregister) (Tcl_Filesystem *fsPtr);
+    ClientData (*tcl_FSData) (Tcl_Filesystem *fsPtr);
+    const char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr);
+    Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr);
+    Tcl_PathType (*tcl_FSGetPathType) (Tcl_Obj *pathPtr);
+    int (*tcl_OutputBuffered) (Tcl_Channel chan);
+    void (*tcl_FSMountsChanged) (Tcl_Filesystem *fsPtr);
+    int (*tcl_EvalTokensStandard) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count);
+    void (*tcl_GetTime) (Tcl_Time *timeBuf);
+    Tcl_Trace (*tcl_CreateObjTrace) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc);
+    int (*tcl_GetCommandInfoFromToken) (Tcl_Command token, Tcl_CmdInfo *infoPtr);
+    int (*tcl_SetCommandInfoFromToken) (Tcl_Command token, const Tcl_CmdInfo *infoPtr);
+    Tcl_Obj * (*tcl_DbNewWideIntObj) (Tcl_WideInt wideValue, const char *file, int line);
+    int (*tcl_GetWideIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr);
+    Tcl_Obj * (*tcl_NewWideIntObj) (Tcl_WideInt wideValue);
+    void (*tcl_SetWideIntObj) (Tcl_Obj *objPtr, Tcl_WideInt wideValue);
+    Tcl_StatBuf * (*tcl_AllocStatBuf) (void);
+    Tcl_WideInt (*tcl_Seek) (Tcl_Channel chan, Tcl_WideInt offset, int mode);
+    Tcl_WideInt (*tcl_Tell) (Tcl_Channel chan);
+    Tcl_DriverWideSeekProc * (*tcl_ChannelWideSeekProc) (const Tcl_ChannelType *chanTypePtr);
+    int (*tcl_DictObjPut) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr);
+    int (*tcl_DictObjGet) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr);
+    int (*tcl_DictObjRemove) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr);
+    int (*tcl_DictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr);
+    int (*tcl_DictObjFirst) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr);
+    void (*tcl_DictObjNext) (Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr);
+    void (*tcl_DictObjDone) (Tcl_DictSearch *searchPtr);
+    int (*tcl_DictObjPutKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv, Tcl_Obj *valuePtr);
+    int (*tcl_DictObjRemoveKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv);
+    Tcl_Obj * (*tcl_NewDictObj) (void);
+    Tcl_Obj * (*tcl_DbNewDictObj) (const char *file, int line);
+    void (*tcl_RegisterConfig) (Tcl_Interp *interp, const char *pkgName, Tcl_Config *configuration, const char *valEncoding);
+    Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc);
+    void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr);
+    int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
+    int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst);
+    int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite);
+    int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern);
+    Tcl_Namespace * (*tcl_GetCurrentNamespace) (Tcl_Interp *interp);
+    Tcl_Namespace * (*tcl_GetGlobalNamespace) (Tcl_Interp *interp);
+    Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags);
+    Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags);
+    Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr);
+    void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr);
+    int (*tcl_FSEvalFileEx) (Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName);
+    Tcl_ExitProc * (*tcl_SetExitProc) (Tcl_ExitProc *proc);
+    void (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc);
+    void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData);
+    int (*tcl_LimitReady) (Tcl_Interp *interp);
+    int (*tcl_LimitCheck) (Tcl_Interp *interp);
+    int (*tcl_LimitExceeded) (Tcl_Interp *interp);
+    void (*tcl_LimitSetCommands) (Tcl_Interp *interp, int commandLimit);
+    void (*tcl_LimitSetTime) (Tcl_Interp *interp, Tcl_Time *timeLimitPtr);
+    void (*tcl_LimitSetGranularity) (Tcl_Interp *interp, int type, int granularity);
+    int (*tcl_LimitTypeEnabled) (Tcl_Interp *interp, int type);
+    int (*tcl_LimitTypeExceeded) (Tcl_Interp *interp, int type);
+    void (*tcl_LimitTypeSet) (Tcl_Interp *interp, int type);
+    void (*tcl_LimitTypeReset) (Tcl_Interp *interp, int type);
+    int (*tcl_LimitGetCommands) (Tcl_Interp *interp);
+    void (*tcl_LimitGetTime) (Tcl_Interp *interp, Tcl_Time *timeLimitPtr);
+    int (*tcl_LimitGetGranularity) (Tcl_Interp *interp, int type);
+    Tcl_InterpState (*tcl_SaveInterpState) (Tcl_Interp *interp, int status);
+    int (*tcl_RestoreInterpState) (Tcl_Interp *interp, Tcl_InterpState state);
+    void (*tcl_DiscardInterpState) (Tcl_InterpState state);
+    int (*tcl_SetReturnOptions) (Tcl_Interp *interp, Tcl_Obj *options);
+    Tcl_Obj * (*tcl_GetReturnOptions) (Tcl_Interp *interp, int result);
+    int (*tcl_IsEnsemble) (Tcl_Command token);
+    Tcl_Command (*tcl_CreateEnsemble) (Tcl_Interp *interp, const char *name, Tcl_Namespace *namespacePtr, int flags);
+    Tcl_Command (*tcl_FindEnsemble) (Tcl_Interp *interp, Tcl_Obj *cmdNameObj, int flags);
+    int (*tcl_SetEnsembleSubcommandList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *subcmdList);
+    int (*tcl_SetEnsembleMappingDict) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *mapDict);
+    int (*tcl_SetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *unknownList);
+    int (*tcl_SetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int flags);
+    int (*tcl_GetEnsembleSubcommandList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **subcmdListPtr);
+    int (*tcl_GetEnsembleMappingDict) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **mapDictPtr);
+    int (*tcl_GetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **unknownListPtr);
+    int (*tcl_GetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int *flagsPtr);
+    int (*tcl_GetEnsembleNamespace) (Tcl_Interp *interp, Tcl_Command token, Tcl_Namespace **namespacePtrPtr);
+    void (*tcl_SetTimeProc) (Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, ClientData clientData);
+    void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, ClientData *clientData);
+    Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) (const Tcl_ChannelType *chanTypePtr);
+    Tcl_Obj * (*tcl_NewBignumObj) (mp_int *value);
+    Tcl_Obj * (*tcl_DbNewBignumObj) (mp_int *value, const char *file, int line);
+    void (*tcl_SetBignumObj) (Tcl_Obj *obj, mp_int *value);
+    int (*tcl_GetBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value);
+    int (*tcl_TakeBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value);
+    int (*tcl_TruncateChannel) (Tcl_Channel chan, Tcl_WideInt length);
+    Tcl_DriverTruncateProc * (*tcl_ChannelTruncateProc) (const Tcl_ChannelType *chanTypePtr);
+    void (*tcl_SetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj *msg);
+    void (*tcl_GetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj **msg);
+    void (*tcl_SetChannelError) (Tcl_Channel chan, Tcl_Obj *msg);
+    void (*tcl_GetChannelError) (Tcl_Channel chan, Tcl_Obj **msg);
+    int (*tcl_InitBignumFromDouble) (Tcl_Interp *interp, double initval, mp_int *toInit);
+    Tcl_Obj * (*tcl_GetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr);
+    int (*tcl_SetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr);
+    int (*tcl_GetEncodingFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr);
+    Tcl_Obj * (*tcl_GetEncodingSearchPath) (void);
+    int (*tcl_SetEncodingSearchPath) (Tcl_Obj *searchPath);
+    const char * (*tcl_GetEncodingNameFromEnvironment) (Tcl_DString *bufPtr);
+    int (*tcl_PkgRequireProc) (Tcl_Interp *interp, const char *name, int objc, Tcl_Obj *const objv[], ClientData *clientDataPtr);
+    void (*tcl_AppendObjToErrorInfo) (Tcl_Interp *interp, Tcl_Obj *objPtr);
+    void (*tcl_AppendLimitedToObj) (Tcl_Obj *objPtr, const char *bytes, int length, int limit, const char *ellipsis);
+    Tcl_Obj * (*tcl_Format) (Tcl_Interp *interp, const char *format, int objc, Tcl_Obj *const objv[]);
+    int (*tcl_AppendFormatToObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *format, int objc, Tcl_Obj *const objv[]);
+    Tcl_Obj * (*tcl_ObjPrintf) (const char *format, ...);
+    void (*tcl_AppendPrintfToObj) (Tcl_Obj *objPtr, const char *format, ...);
+} TclStubs;
+*/