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
Sync with trunk thru r68370
2016-07-20 00:55:06 +00:00 · 2016-07-19 20:18:36 +00:00 · 2016-07-19 15:09:45 +00:00 · 2016-07-19 02:39:44 +00:00 · 2016-07-19 02:26:08 +00:00 · 2016-07-19 02:12:06 +00:00
2038 changed files with 36709 additions and 660613 deletions
@@ -1134,6 +1134,13 @@ endif(BRLCAD_ENABLE_OPENCL)
 option(BRLCAD_ENABLE_SPR "Enable features requiring Screened Poisson Surface Reconstruction" OFF)
 mark_as_advanced(BRLCAD_ENABLE_SPR)

+# Enable experimental support for binary attributes
+option(BRLCAD_ENABLE_BINARY_ATTRIBUTES "Enable support for binary attributes" OFF)
+mark_as_advanced(BRLCAD_ENABLE_BINARY_ATTRIBUTES)
+if(BRLCAD_ENABLE_BINARY_ATTRIBUTES)
+  CONFIG_H_APPEND(BRLCAD "#define USE_BINARY_ATTRIBUTES 1\n")
+endif(BRLCAD_ENABLE_BINARY_ATTRIBUTES)
+
 #----------------------------------------------------------------------
 # The following are fine-grained options for enabling/disabling compiler
 # and source code definition settings.  Typically these are set to
@@ -722,15 +722,6 @@ version if BRLCAD_BUNDLED_LIBS is also AUTO.
 Aliases:  ENABLE_SPR


--- BRLCAD_BSON ---
-
-Option for enabling and disabling compilation of the Libbson library
-provided with BRL-CAD's source code.  Default is BUNDLED, using
-the included other/src version.
-
-Aliases:  ENABLE_BSON
-
-
 --- BRLCAD_SC ---

 Option for enabling and disabling compilation of the NIST Step Class
@@ -13,6 +13,8 @@ changes made.  See document footer for additional details.
 --- 2016-07-XX  Release 7.26.2                                     ---
 ----------------------------------------------------------------------

+* upgraded freetype to version 2.6.5 - Cliff Yapp
+* upgraded zlib to version 1.2.8 - Cliff Yapp


 ----------------------------------------------------------------------
@@ -1494,6 +1494,9 @@ ARCHER
 ATTRIBUTES
 ----------

+* See src/libbu/TODO.binary_attributes for more info about
+  bson based binary attribute work.
+
 * attr command option to output to a file

 * attr command change to only output non-standard attributes
@@ -190,10 +190,6 @@ do
                                  shift;;
     --disable-spr)                options="$options -DBRLCAD_SPR=SYSTEM";
                                  shift;;
-     --enable-bson)                options="$options -DBRLCAD_BSON=BUNDLED";
-                                  shift;;
-     --disable-bson)                options="$options -DBRLCAD_BSON=SYSTEM";
-                                  shift;;
     --enable-scl)                options="$options -DBRLCAD_SC=BUNDLED";
                                  shift;;
     --disable-scl)                options="$options -DBRLCAD_SC=SYSTEM";
@@ -3,6 +3,8 @@ set(specifications_EN
  )
 ADD_DOCBOOK("HTML;PHP;PDF" specifications_EN specifications/en "")

+CMAKEFILES(BRL_CAD_g_format_V6.xml)
+
 # Local Variables:
 # tab-width: 8
 # mode: cmake
@@ -44,8 +44,8 @@
 /** @file bg.h */
 /** @} */

-#ifndef GM_H
-#define GM_H
+#ifndef BG_H
+#define BG_H

 #include "common.h"

@@ -56,7 +56,7 @@
 #include "bg/tri_ray.h"
 #include "bg/tri_tri.h"

-#endif /* GM_H */
+#endif /* BG_H */

 /*
 * Local Variables:
@@ -18,8 +18,8 @@
 * information.
 */

-#ifndef DVEC_H
-#define DVEC_H
+#ifndef BN_DVEC_H
+#define BN_DVEC_H

 #include "common.h"

@@ -207,7 +207,7 @@ extern "C++" {

 /** @} */

-#endif /* DVEC_H */
+#endif /* BN_DVEC_H */

 /*
 * Local Variables:
@@ -30,8 +30,8 @@
 /** @{ */
 /** @file plot3.h */

-#ifndef PLOT3_H
-#define PLOT3_H
+#ifndef BN_PLOT3_H
+#define BN_PLOT3_H

 #include "common.h"

@@ -484,7 +484,7 @@ BN_EXPORT extern void BU_FORTRAN(f3vect, F3VECT)(FILE **fp,

 __END_DECLS

-#endif /* PLOT3_H */
+#endif /* BN_PLOT3_H */

 /** @} */
 /*
@@ -26,8 +26,8 @@
 /** @{ */
 /** @file spm.h */

-#ifndef SPM_H
-#define SPM_H
+#ifndef BN_SPM_H
+#define BN_SPM_H

 #include "common.h"
 #include "bn/defines.h"
@@ -135,7 +135,7 @@ BN_EXPORT extern void bn_spm_dump(bn_spm_map_t *mp, int verbose);

 __END_DECLS

-#endif /* SPM_H */
+#endif /* BN_SPM_H */

 /** @} */
 /*
@@ -25,14 +25,14 @@

 #include <stddef.h> /* for size_t */

+#if defined(USE_BINARY_ATTRIBUTES)
+#  include "bson.h"
+#endif
+
 #include "bu/defines.h"
 #include "bu/magic.h"
 #include "bu/vls.h"

-#if defined(USE_BINARY_ATTRIBUTES)
-#include "bson.h"
-#endif
-
 __BEGIN_DECLS

 /*----------------------------------------------------------------------*/
@@ -29,8 +29,8 @@
 * example).
 *
 */
-#ifndef BVIEW_H
-#define BVIEW_H
+#ifndef DM_BVIEW_H
+#define DM_BVIEW_H

 #include "common.h"
 #include "bu/list.h"
@@ -312,7 +312,7 @@ struct view_obj {
 };
 #define VIEW_OBJ_NULL ((struct view_obj *)0)

-#endif /* BVIEW_H */
+#endif /* DM_BVIEW_H */

 /** @} */
 /*
@@ -25,6 +25,9 @@
 *
 */

+#ifndef DM_DM_DESIGN_H
+#define DM_DM_DESIGN_H
+
 /* Display Manager Types */
 #define DM_TYPE_BAD     -1
 #define DM_TYPE_NULL	0
@@ -201,7 +204,7 @@ DM_EXPORT extern int   dm_set_type(dm_s *dmp, int dm_t);
 DM_EXPORT extern int   dm_get_image(dm_s *dmp, icv_image_t *image);
 DM_EXPORT extern int   dm_get_obj_image(dm_s *dmp, const char *handle, icv_image_t *image);

-#endif /* DM_H */
+#endif /* DM_DM_DESIGN_H */

 /** @} */
 /*
@@ -22,8 +22,8 @@
 /** @file dm_xvars.h
 *
 */
-#ifndef DM_XVARS_H
-#define DM_XVARS_H
+#ifndef DM_DM_XVARS_H
+#define DM_DM_XVARS_H

 #include "common.h"

@@ -83,7 +83,7 @@ struct dm_xvars {
    int devbuttonrelease;
 };

-#endif /* DM_XVARS_H */
+#endif /* DM_DM_XVARS_H */
 /** @} */
 /*
 * Local Variables:
@@ -26,8 +26,8 @@
 *
 */

-#ifndef LIGHT_H
-#define LIGHT_H
+#ifndef OPTICAL_LIGHT_H
+#define OPTICAL_LIGHT_H

 #include "common.h"

@@ -90,7 +90,7 @@ OPTICAL_EXPORT extern void light_obs(struct application *ap, struct shadework *s

 __END_DECLS

-#endif /* LIGHT_H */
+#endif /* OPTICAL_LIGHT_H */

 /** @} */
 /*
@@ -22,8 +22,8 @@
 /** @file plastic.h
 *
 */
-#ifndef PLASTIC_H
-#define PLASTIC_H
+#ifndef OPTICAL_PLASTIC_H
+#define OPTICAL_PLASTIC_H

 #define PL_NULL ((struct phong_specific *)0)
 #define PL_O(m) offsetof(struct phong_specific, m)
@@ -43,7 +43,7 @@ struct phong_specific {
 };

 extern struct bu_structparse phong_parse[];
-#endif
+#endif /* OPTICAL_PLASTIC_H */
 /** @} */
 /*
 * Local Variables:
@@ -23,8 +23,8 @@
 *
 */

-#ifndef SHADEFUNCS_H
-#define SHADEFUNCS_H
+#ifndef OPTICAL_SHADEFUNCS_H
+#define OPTICAL_SHADEFUNCS_H

 #include "common.h"

@@ -96,7 +96,7 @@ OPTICAL_EXPORT extern struct mfuncs *load_dynamic_shader(const char *material);

 __END_DECLS

-#endif /* SHADEFUNCS_H */
+#endif /* OPTICAL_SHADEFUNCS_H */


 /** @} */
@@ -23,8 +23,8 @@
 *
 */

-#ifndef SHADEWORK_H
-#define SHADEWORK_H
+#ifndef OPTICAL_SHADEWORK_H
+#define OPTICAL_SHADEWORK_H

 #include "common.h"
 #include "bn/tabdata.h"
@@ -76,7 +76,7 @@ extern void pr_shadework(const char *str, const struct shadework *swp);

 __END_DECLS

-#endif /* SHADEWORK_H */
+#endif /* OPTICAL_SHADEWORK_H */

 /** @} */
 /*
@@ -26,8 +26,8 @@
 *
 */

-#ifndef ARB_EDIT_H
-#define ARB_EDIT_H
+#ifndef RT_ARB_EDIT_H
+#define RT_ARB_EDIT_H

 #include "common.h"
 #include "bn.h"
@@ -441,7 +441,7 @@ arb_edit(struct rt_arb_internal *arb, fastf_t peqn[7][4], int edge, int newedge,

 __END_DECLS

-#endif  /* ARB_EDIT_H */
+#endif  /* RT_ARB_EDIT_H */

 /** @} */
 /*
@@ -61,8 +61,8 @@
 *
 */

-#ifndef DB_H
-#define DB_H
+#ifndef RT_DB4_H
+#define RT_DB4_H

 #include "common.h"

@@ -489,7 +489,7 @@ DEPRECATED void rt_dbmat_mat(dbfloat_t *dbp, const fastf_t *ff);

 __END_DECLS

-#endif	/* DB_H */
+#endif	/* RT_DB4_H */

 /** @} */
 /*
@@ -26,8 +26,8 @@
 *
 */

-#ifndef DB5_H
-#define DB5_H
+#ifndef RT_DB5_H
+#define RT_DB5_H

 #include "common.h"

@@ -231,7 +231,7 @@ RT_EXPORT extern const unsigned char *db5_get_raw_internal_ptr(struct db5_raw_in

 __END_DECLS

-#endif	/* DB5_H */
+#endif	/* RT_DB5_H */

 /** @} */
 /*
@@ -27,8 +27,8 @@
 * this message goes away.
 *
 */
-#ifndef RTFUNC_H
-#define RTFUNC_H
+#ifndef RT_FUNC_H
+#define RT_FUNC_H

 #include "common.h"

@@ -179,7 +179,7 @@ RT_EXPORT extern int rt_obj_mirror(struct rt_db_internal *ip, const plane_t *pla

 __END_DECLS

-#endif  /* RTFUNC_H */
+#endif  /* RT_FUNC_H */

 /** @} */

@@ -28,8 +28,8 @@
 *
 */

-#ifndef NURB_H
-#define NURB_H
+#ifndef RT_NURB_H
+#define RT_NURB_H

 #include "common.h"

@@ -284,7 +284,7 @@ RT_EXPORT extern void rt_nurb_map_oslo(struct oslo_mat *oslo,

 __END_DECLS

-#endif /* NURB_H */
+#endif /* RT_NURB_H */

 /** @} */
 /*
@@ -22,8 +22,8 @@
 *
 */

-#ifndef TIE_H
-#define TIE_H
+#ifndef RT_TIE_H
+#define RT_TIE_H

 #include "common.h"

@@ -154,7 +154,7 @@ RT_EXPORT extern void TIE_VAL(tie_push)(struct tie_s *tie, TIE_3 **tlist, unsign

 __END_DECLS

-#endif /* TIE_H */
+#endif /* RT_TIE_H */

 /*
 * Local Variables:
@@ -0,0 +1,94 @@
+# From https://github.com/mongodb/mongo-c-driver/blob/master/build/cmake/FindBSON.cmake
+# License: Apache License Version 2.0, January 2004
+
+# Read-Only variables:
+#  BSON_FOUND - system has the BSON library
+#  BSON_INCLUDE_DIR - the BSON include directory
+#  BSON_LIBRARIES - The libraries needed to use BSON
+#  BSON_VERSION - This is set to $major.$minor.$revision$path (eg. 0.4.1)
+
+if (UNIX)
+  find_package(PkgConfig QUIET)
+  pkg_check_modules(_BSON QUIET libbson-1.0)
+endif ()
+
+find_path(BSON_INCLUDE_DIR
+  NAMES
+    libbson-1.0/bson.h
+  HINTS
+    ${BSON_ROOT_DIR}
+    ${_BSON_INCLUDEDIR}
+  PATH_SUFFIXES
+    include
+)
+
+set(BSON_INCLUDE_DIR "${BSON_INCLUDE_DIR}/libbson-1.0")
+
+if(WIN32 AND NOT CYGWIN)
+  if(MSVC)
+    find_library(BSON
+      NAMES
+        "bson-1.0"
+      HINTS
+        ${BSON_ROOT_DIR}
+      PATH_SUFFIXES
+        bin
+        lib
+    )
+
+    mark_as_advanced(BSON)
+    set(BSON_LIBRARIES ${BSON} ws2_32)
+  else()
+      # bother supporting this?
+  endif()
+else()
+
+  find_library(BSON_LIBRARY
+    NAMES
+      bson-1.0
+    HINTS
+      ${_BSON_LIBDIR}
+    PATH_SUFFIXES
+      lib
+  )
+
+  mark_as_advanced(BSON_LIBRARY)
+
+  find_package (Threads REQUIRED)
+
+  set(BSON_LIBRARIES ${BSON_LIBRARY} ${CMAKE_THREAD_LIBS_INIT})
+
+endif()
+
+if (BSON_INCLUDE_DIR)
+  if (_BSON_VERSION)
+     set(BSON_VERSION "${_BSON_VERSION}")
+  elseif(BSON_INCLUDE_DIR AND EXISTS "${BSON_INCLUDE_DIR}/bson-version.h")
+     file(STRINGS "${BSON_INCLUDE_DIR}/bson-version.h" bson_version_str
+        REGEX "^#define[\t ]+BSON_VERSION[\t ]+\([0-9.]+\)[\t ]+$")
+
+     string(REGEX REPLACE "^.*BSON_VERSION[\t ]+\([0-9.]+\)[\t ]+$"
+        "\\1" BSON_VERSION "${bson_version_str}")
+  endif ()
+endif ()
+
+include(FindPackageHandleStandardArgs)
+
+if (BSON_VERSION)
+   find_package_handle_standard_args(BSON
+    REQUIRED_VARS
+      BSON_LIBRARIES
+      BSON_INCLUDE_DIR
+    VERSION_VAR
+      BSON_VERSION
+    FAIL_MESSAGE
+      "Could NOT find BSON version"
+  )
+else ()
+   find_package_handle_standard_args(BSON "Could NOT find BSON"
+      BSON_LIBRARIES
+      BSON_INCLUDE_DIR
+  )
+endif ()
+
+mark_as_advanced(BSON_INCLUDE_DIR BSON_LIBRARIES)
@@ -0,0 +1,100 @@
+#                   F I N D G E C O D E . C M A K E
+# BRL-CAD
+#
+# Copyright (c) 2011-2014 United States Government as represented by
+# the U.S. Army Research Laboratory.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+#
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+#
+# 2. Redistributions in binary form must reproduce the above
+# copyright notice, this list of conditions and the following
+# disclaimer in the documentation and/or other materials provided
+# with the distribution.
+#
+# 3. The name of the author may not be used to endorse or promote
+# products derived from this software without specific prior written
+# permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS
+# OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+# GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+#
+###
+# - Find Gecode constraint programming libraries
+#
+# The following variables are set:
+#
+# GECODE_INCLUDE_DIR
+# GECODE_LIBRARIES
+
+find_path(GECODE_INCLUDE_DIR gecode/search.hh)
+
+find_library(GECODE_SUPPORT_LIB NAMES gecodesupport)
+find_library(GECODE_KERNEL_LIB NAMES gecodekernel)
+find_library(GECODE_SEARCH_LIB NAMES gecodesearch)
+find_library(GECODE_INT_LIB NAMES gecodeint)
+find_library(GECODE_SET_LIB NAMES gecodeset)
+find_library(GECODE_FLOAT_LIB NAMES gecodefloat)
+find_library(GECODE_MINIMODEL_LIB NAMES gecodeminimodel)
+find_library(GECODE_DRIVER_LIB NAMES gecodedriver)
+find_library(GECODE_FLATZINC_LIB NAMES gecodeflatzinc)
+
+set(GECODE_LIBRARIES
+  ${GECODE_SUPPORT_LIB}
+  ${GECODE_KERNEL_LIB}
+  ${GECODE_SEARCH_LIB}
+  ${GECODE_INT_LIB}
+  ${GECODE_SET_LIB}
+  ${GECODE_FLOAT_LIB}
+  ${GECODE_MINIMODEL_LIB}
+  ${GECODE_DRIVER_LIB}
+  ${GECODE_FLATZINC_LIB}
+)
+
+set(GECODE_LIBRARIES "${GECODE_LIBRARIES}" CACHE STRING "Gecode libraries")
+
+
+include(FindPackageHandleStandardArgs)
+FIND_PACKAGE_HANDLE_STANDARD_ARGS(GECODE DEFAULT_MSG
+  GECODE_SUPPORT_LIB
+  GECODE_KERNEL_LIB
+  GECODE_SEARCH_LIB
+  GECODE_INT_LIB
+  GECODE_SET_LIB
+  GECODE_FLOAT_LIB
+  GECODE_MINIMODEL_LIB
+  GECODE_DRIVER_LIB
+  GECODE_FLATZINC_LIB
+  )
+
+mark_as_advanced(
+  GECODE_SUPPORT_LIB
+  GECODE_KERNEL_LIB
+  GECODE_SEARCH_LIB
+  GECODE_INT_LIB
+  GECODE_SET_LIB
+  GECODE_FLOAT_LIB
+  GECODE_MINIMODEL_LIB
+  GECODE_DRIVER_LIB
+  GECODE_FLATZINC_LIB
+  )
+
+# Local Variables:
+# tab-width: 8
+# mode: cmake
+# indent-tabs-mode: t
+# End:
+# ex: shiftwidth=2 tabstop=8
@@ -49,6 +49,7 @@ include(CMakeParseArguments)
 #             [RESET_VARS var1 var2 ...]
 #             [ALIASES alias1 alias2 ...]
 #             [FLAGS flag1 flag2 ...]
+#             [UNDOCUMENTED]
 #            )

 #-----------------------------------------------------------------------------
@@ -72,7 +73,7 @@ macro(THIRD_PARTY dir varname_root build_target description)

  if(${ARGC} GREATER 3)
    # Parse extra arguments
-    CMAKE_PARSE_ARGUMENTS(${varname_root} "" "FIND_NAME;FIND_VERSION" "FIND_COMPONENTS;REQUIRED_VARS;RESET_VARS;ALIASES;FLAGS" ${ARGN})
+    CMAKE_PARSE_ARGUMENTS(${varname_root} "UNDOCUMENTED" "FIND_NAME;FIND_VERSION" "FIND_COMPONENTS;REQUIRED_VARS;RESET_VARS;ALIASES;FLAGS" ${ARGN})
  endif(${ARGC} GREATER 3)
  if(NOT ${varname_root}_FIND_NAME)
    set(${varname_root}_FIND_NAME ${varname_root})
@@ -262,8 +263,10 @@ macro(THIRD_PARTY dir varname_root build_target description)
    CMAKEFILES(${dir})
  endif(${CMAKE_PROJECT_NAME}_${varname_root}_BUILD)

-  OPTION_ALIASES("${CMAKE_PROJECT_NAME}_${varname_root}" "${varname_root}_ALIASES" "ABS")
-  OPTION_DESCRIPTION("${CMAKE_PROJECT_NAME}_${varname_root}" "${varname_root}_ALIASES" "${description}")
+  if(NOT ${varname_root}_UNDOCUMENTED)
+    OPTION_ALIASES("${CMAKE_PROJECT_NAME}_${varname_root}" "${varname_root}_ALIASES" "ABS")
+    OPTION_DESCRIPTION("${CMAKE_PROJECT_NAME}_${varname_root}" "${varname_root}_ALIASES" "${description}")
+  endif(NOT ${varname_root}_UNDOCUMENTED)

  # For drop-down menus in CMake gui - set STRINGS property
  set_property(CACHE ${CMAKE_PROJECT_NAME}_${varname_root} PROPERTY STRINGS AUTO BUNDLED SYSTEM)
@@ -29,24 +29,32 @@
 # OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 # ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+cmake_policy(SET CMP0064 OLD)
+
 # The purpose of this logic is to scan a set of C/C++ source files to identify
 # all of the variables the CMake configure process may need to set.

 # The global property C_DEFINE_VARS will hold the list of defined variables
 # found.

+# TODO - Use https://sourceforge.net/p/predef/wiki/Home/ to create more
+# comprehensive and less ad-hoc lists of flags for OS, arch, etc.
+
 # A user can suppress consideration of definitions that match one or a set of
-# patterns by appending those patterns to the C_DEFINE_SKIPVARS global
-# property.  There are some "standard" patterns that are automatically skipped
+# patterns.  There are some "standard" patterns that are automatically skipped
 # - tests matching the "header guard" pattern are skipped, as are defines
 # matching the "EXPORT" and "IMPORT" substrings, operating system and compiler
 # identifiers, and various other flags that do not typically need user-defined
 # configure stage testing.
-set_property(GLOBAL APPEND PROPERTY C_DEFINE_SKIPVARS ".*EXPORT.*")
-set_property(GLOBAL APPEND PROPERTY C_DEFINE_SKIPVARS ".*IMPORT.*")
+set_property(GLOBAL APPEND PROPERTY C_DEFINE_SKIPPATTERNS ".*EXPORT.*")
+set_property(GLOBAL APPEND PROPERTY C_DEFINE_SKIPPATTERNS ".*IMPORT.*")

 function(autoheader_ignore_define def)
-  set_property(GLOBAL APPEND PROPERTY C_DEFINE_SKIPVARS ".*[ (\t]+${def}[ )\t$]*.*")
+  if("${def}" MATCHES ".*[*].*")
+    set_property(GLOBAL APPEND PROPERTY C_DEFINE_SKIPPATTERNS "${def}")
+  else("${def}" MATCHES ".*[*].*")
+    set_property(GLOBAL APPEND PROPERTY C_DEFINE_SKIPVARS "${def}")
+  endif("${def}" MATCHES ".*[*].*")
 endfunction(autoheader_ignore_define)

 function(autoheader_ignore_defines deflist)
@@ -55,15 +63,22 @@ function(autoheader_ignore_defines deflist)
  endforeach(def ${${deflist}})
 endfunction(autoheader_ignore_defines)

+function(autoheader_skip_files def)
+  set_property(GLOBAL APPEND PROPERTY FILE_SKIPPATTERNS "${def}")
+endfunction(autoheader_skip_files)
+
 # OS flags.  For performance, put most common
 # comparisons first (that'll typicall be
 # Windows related tests)
 set(OS_FLAGS
  WIN32
+  WIN32_LEAN_AND_MEAN
  _WIN32
  _WIN64
-  WIN32_LEAN_AND_MEAN
+  _WINDOWS
  __WIN32__
+  __WIN64
+  __WINDOWS__
  __APPLE__
  BSD
  CRAY1
@@ -72,32 +87,82 @@ set(OS_FLAGS
  MSDOS
  SUNOS
  SYSV
+  _AIX
+  _BEOS
+  _BEOS_
+  _IBMR2
+  _SCO_SV
+  _SGI
+  _ULTRIX
  _WINSOCKAPI_
+  _XENIX
+  __AIX
+  __AIX__
+  __ANDROID__
+  __BEOS__
+  __BeOS
+  __CRAYXC
+  __CRAYXE
  __CYGWIN__
+  __DARWIN__
  __DOS__
  __FreeBSD__
+  __GNU__
+  __HAIKU__
+  __LINUX__
  __MSDOS__
  __NT__
+  __NetBSD
+  __NetBSD__
+  __OPENBSD
  __OS2__
+  __OS400__
  __OpenBSD__
+  __QNX__
+  __SCO_VERSION__
+  __TRU64__
+  __aix
+  __aix__
  __alpha
  __alpha__
  __apollo
+  __bsdos__
  __convex__NATIVE
+  __hppa
+  __hpua
  __hpux
+  __i386
  __i386__
  __ia64__
+  __linux
  __linux__
+  __minux
+  __osf
+  __osf__
+  __ppc64__
+  __ppc__
+  __riscos
+  __riscos__
  __sgi
+  __sinix
+  __sinix__
  __sp3__ # what is this? context indicates it is a platform...
  __sparc64__
+  __sun
+  __tru64
+  __ultrix
+  __ultrix__
  __x86_64__
+  _sgi
  _sun
+  _tru64
  convex_NATIVE
  eta10
+  hpux
  ibm
  linux
  mips
+  sco_sv
  sgi
  sun
  vax
@@ -158,95 +223,111 @@ macro(header_guard rdir fname ovar)
  string(REPLACE "${rdir}/" "" stage1 ${fname})
  string(REPLACE "/" "_" stage2 ${stage1})
  string(REPLACE "." "_" stage3 ${stage2})
-  string(TOUPPER "${stage3}" stage4)
-  set(${ovar} ${stage4})
+  string(REPLACE "-" "_" stage4 ${stage3})
+  string(TOUPPER "${stage4}" stage5)
+  set(${ovar} ${stage5})
 endmacro(header_guard)

-# Given an atom from a line (i.e. one conditional if the original line had
-# and/or branches, or the original line if there were no and/or branches),
-# extract the compile flag
-macro(compile_def_flag atom ovar)
-  string(REGEX REPLACE "^[ \t]*#*.*[!]*(ifdef|defined|elseif defined)[ \t]*[(]*" "" stage1 "${atom}")
-  string(REGEX REPLACE "[/][*].*[*][/]" "" stage2 "${stage1}")
-  string(REGEX REPLACE "[)][ \t]*" "" stage3 "${stage2}")
-  string(REGEX REPLACE "[ \t]+$" "" stage4 "${stage3}")
-  string(REGEX REPLACE "^[ \t]+" "" stage5 "${stage4}")
-  set(${ovar} ${stage5})
-endmacro(compile_def_flag)
-
-function(autoheader_scan seed_dir)
+function(autoheader_scan_internal seed_dir recurse)
  set(scan_files)
  set(extensions c h cxx cpp hxx hpp)
  get_property(C_DEFINE_SKIPVARS GLOBAL PROPERTY C_DEFINE_SKIPVARS)
+  get_property(C_DEFINE_SKIPPATTERNS GLOBAL PROPERTY C_DEFINE_SKIPPATTERNS)
+  get_property(FILE_SKIPPATTERNS GLOBAL PROPERTY FILE_SKIPPATTERNS)

  foreach(exten ${extensions})
    set(sfiles)
-    file(GLOB_RECURSE sfiles "${seed_dir}/*.${exten}")
+    if(recurse)
+      file(GLOB_RECURSE sfiles "${seed_dir}/*.${exten}")
+    else(recurse)
+      file(GLOB sfiles "${seed_dir}/*.${exten}")
+    endif(recurse)
    set(scan_files ${scan_files} ${sfiles})
  endforeach(exten ${extensions})

  #message("found files: ${scan_files}")

+  foreach(ptn ${FILE_SKIPPATTERNS})
+    list(FILTER scan_files EXCLUDE REGEX "${ptn}")
+  endforeach(ptn ${FILE_SKIPPATTERNS})
+
+  #message("processing files: ${scan_files}")
+
  set(unique_keys)
  foreach(sf ${scan_files})
    header_guard("${seed_dir}" "${sf}" hg)
-    set(SKIP_LIST ".*[ \t]+${hg}[ \t]*" ${C_DEFINE_SKIPVARS})
-    file(STRINGS ${sf} SRC_LINES REGEX "^[ \t]*#.*(ifdef|defined[(]).+")
-    set(def_list)
-    foreach(line ${SRC_LINES})
-      #message("line: ${line}")
-      set(lset ${line})
-      string(REPLACE "&&" ";" lset "${lset}")
-      string(REPLACE "||" ";" lset "${lset}")
-      foreach(l ${lset})
-	#message("   atom: ${l}")
-	set(skip_line 0)
-	foreach(sk ${SKIP_LIST})
-	  if(NOT skip_line)
-	    #message("testing ${l} vs ${sk}")
-	    if("${l}" MATCHES "${sk}")
-	      #message("matched ${l} vs ${sk} - skipping")
-	      set(skip_line 1)
-	    endif("${l}" MATCHES "${sk}")
-	  endif(NOT skip_line)
-	endforeach(sk ${SKIP_LIST})
-	if(NOT skip_line)
-	  set(def_list ${def_list} ${l})
-	endif(NOT skip_line)
-      endforeach(l ${lset})
-    endforeach(line ${SRC_LINES})
+    set(SKIP_LIST "${hg}" ${C_DEFINE_SKIPVARS})
+
+    # Use unifdef to get the list of conditional symbols
+    # See http://dotat.at/prog/unifdef/ and https://github.com/fanf2/unifdef
+    execute_process(COMMAND unifdef -s ${sf} OUTPUT_VARIABLE def_list)
+    string(REPLACE "\n" ";" def_list "${def_list}")
+
    if(def_list)
-      #message("file ${sf} def lines:")
-      foreach(l ${def_list})
-	set(dflag)
-	compile_def_flag(${l} dflag)
-	#message("   line: ${l}")
-	#message("   extracted: ${dflag}")
-	set(unique_keys ${unique_keys} ${dflag})
-      endforeach(l ${def_list})
+      foreach(dflag ${def_list})
+	set(skip_flag 0)
+	foreach(sk ${SKIP_LIST})
+	  if(NOT skip_flag)
+	    if("${dflag}" STREQUAL "${sk}")
+	      set(skip_flag 1)
+	    endif("${dflag}" STREQUAL "${sk}")
+	  endif(NOT skip_flag)
+	endforeach(sk ${SKIP_LIST})
+	foreach(sp ${C_DEFINE_SKIPPATTERNS})
+	  if(NOT skip_flag)
+	    if("${dflag}" MATCHES ${sp})
+	      set(skip_flag 1)
+	    endif("${dflag}" MATCHES ${sp})
+	  endif(NOT skip_flag)
+	endforeach(sp ${C_DEFINE_SKIPPATTERNS})
+	if(NOT skip_flag)
+	  #message("   ${dflag}")
+	  set(unique_keys ${unique_keys} ${dflag})
+	endif(NOT skip_flag)
+      endforeach(dflag ${def_list})
    endif(def_list)
  endforeach(sf ${scan_files})
-  list(REMOVE_DUPLICATES unique_keys)
-  foreach(k ${unique_keys})
-    set_property(GLOBAL APPEND PROPERTY C_DEFINE_VARS "${k}")
-  endforeach(k ${unique_keys})
+  list(LENGTH unique_keys UKLEN)
+  if(UKLEN)
+    list(REMOVE_DUPLICATES unique_keys)
+    foreach(k ${unique_keys})
+      set_property(GLOBAL APPEND PROPERTY C_DEFINE_VARS "${k}")
+    endforeach(k ${unique_keys})
+  endif(UKLEN)
+
+  # If we've run autoheader_scan mulitple times, we need to
+  # ensure uniqueness globally...
  get_property(C_DEFINE_VARS GLOBAL PROPERTY C_DEFINE_VARS)
-  list(REMOVE_DUPLICATES C_DEFINE_VARS)
-  list(SORT C_DEFINE_VARS)
+  list(LENGTH C_DEFINE_VARS DLEN)
+  if(DLEN)
+    list(REMOVE_DUPLICATES C_DEFINE_VARS)
+    list(SORT C_DEFINE_VARS)
+  endif(DLEN)
  set_property(GLOBAL PROPERTY C_DEFINE_VARS "${C_DEFINE_VARS}")
+endfunction(autoheader_scan_internal)
+
+function(autoheader_scan seed_dir)
+  autoheader_scan_internal("${seed_dir}" 0)
 endfunction(autoheader_scan)

+function(autoheader_recursive_scan seed_dir)
+  autoheader_scan_internal("${seed_dir}" 1)
+endfunction(autoheader_recursive_scan)
+
+
 # For testing convenience, the following will exercise the
 # logic in cmake -P script mode.  Should be removed if/when
 # this goes "live" in the real build.

-set(LOCAL_SKIP DIRENT_ BRLCADBUILD BRLCAD_ DM_ FB_ NO_BOMBING_MACROS USE_BINARY_ATTRIBUTES
+set(LOCAL_SKIP DIRENT_ BRLCADBUILD ^BRLCAD_* ^DM_* ^FB_* NO_BOMBING_MACROS USE_BINARY_ATTRIBUTES
  IF_WGL IF_X IF_QT IF_OGL NO_DEBUG_CHECKING USE_OPENCL)
 autoheader_ignore_defines(LOCAL_SKIP)

-set_property(GLOBAL APPEND PROPERTY C_DEFINE_SKIPVARS ".*IMPORT.*")
-autoheader_scan(${CMAKE_CURRENT_SOURCE_DIR}/include)
-autoheader_scan(${CMAKE_CURRENT_SOURCE_DIR}/src/libbu)
+autoheader_skip_files(".*src/other/.*")
+
+autoheader_recursive_scan(${CMAKE_CURRENT_SOURCE_DIR}/include)
+autoheader_recursive_scan(${CMAKE_CURRENT_SOURCE_DIR}/src)
+autoheader_scan(${CMAKE_CURRENT_SOURCE_DIR}/misc/tools/perplex)

 get_property(C_DEFINE_VARS GLOBAL PROPERTY C_DEFINE_VARS)
 message("keys:")
@@ -80,6 +80,7 @@ set(misc_ignore_files
  mime.types
  mime_cad.types
  nsis
+  osl_shaders
  wix
  svn2git
  uncpowerplant2g.sh
@@ -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;
@@ -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;
@@ -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;
@@ -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;
+
@@ -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;
@@ -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;
+
@@ -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
+
+
+
@@ -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;
@@ -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
+
@@ -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)--
@@ -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
@@ -0,0 +1,10 @@
+int main()
+{
+  int i;
+  int k;
+      int more_indented;
+      int l;
+
+  char *str = "/* this is no comment */";
+  return 0;
+}
@@ -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");
+
+
@@ -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:     '^='
@@ -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_])/
+
@@ -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}
@@ -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}
@@ -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?
@@ -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
@@ -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] }
@@ -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/
@@ -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
@@ -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 $_;
+}
@@ -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 }
@@ -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
@@ -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 }
@@ -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";
@@ -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
@@ -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
@@ -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 ()>
@@ -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";
@@ -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;
+}
+
+
+
+
+
@@ -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;
+}
+
+
+
+
+
@@ -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 +
@@ -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";
@@ -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
+
@@ -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 %>
@@ -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
@@ -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__} }
+
@@ -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";
+}
@@ -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
@@ -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
@@ -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)))
@@ -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)))
@@ -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!!!!!
@@ -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)))))
+
@@ -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 "> ";
+}
@@ -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
@@ -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
@@ -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 "> ";
+}
@@ -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
@@ -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 "> ";
+	}
+
@@ -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 "> ";
+}
@@ -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
@@ -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
@@ -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!;
@@ -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 }
+		}
+	}
+
+}
@@ -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
@@ -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
@@ -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. ";
@@ -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.
@@ -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
+}
@@ -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
+}
@@ -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
@@ -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";
+}
@@ -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
@@ -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";
+	}
+}
@@ -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>
@@ -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']);
+}
+
@@ -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
--- a/Show More
+++ b/Show More