diff options
| -rw-r--r-- | .gitignore | 6 | ||||
| -rw-r--r-- | Makefile.am | 7 | ||||
| -rw-r--r-- | README | 200 | ||||
| -rw-r--r-- | clexer.l | 4 | ||||
| -rw-r--r-- | gint.m4 | 8 | ||||
| -rw-r--r-- | gint.mk | 4 | ||||
| -rwxr-xr-x | snarf-doc-filter | 449 |
7 files changed, 635 insertions, 43 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..22f175f --- /dev/null +++ b/.gitignore @@ -0,0 +1,6 @@ +.emacs* +README.html +clexer +clexer.[co] +*~ + diff --git a/Makefile.am b/Makefile.am index 3b720db..2797db4 100644 --- a/Makefile.am +++ b/Makefile.am @@ -14,11 +14,16 @@ # You should have received a copy of the GNU General Public License # along with this program. If not, see <http://www.gnu.org/licenses/>. +EXTRA_DIST = gint.m4 gint.mk guile.m4 +if GINT_COND_SNARF_DOC_FILTER +noinst_SCRIPTS = snarf-doc-filter +else noinst_PROGRAMS = clexer clexer_SOURCES = clexer.l INCLUDES = @GINT_INCLUDES@ LDADD = @GINT_LDADD@ -EXTRA_DIST = gint.m4 gint.mk guile.m4 +endif + if GINT_COND_INC EXTRA_DIST += extract-exports endif @@ -1,3 +1,11 @@ +////////////////////////////////////////////////////////////// +This file is in AsciiDoc format. Use the following command +to convert it to HTML: + + asciidoc README + +See end of file for copyright statement. +////////////////////////////////////////////////////////////// GINT ==== Sergey Poznyakoff <gray@gnu.org> @@ -9,20 +17,21 @@ GINT -- Guile Integration Framework DESCRIPTION ----------- -Integrating *Guile* into a project requires performing a set of routine steps, -such, e.g., as creating additional Makefile rules, which, however trivial, -require additional efforts from authors and impose on them an extra -maintenance burden. Authors maintaining several projects, each of which uses -Guile as an extension language, soon find out that these steps differ only -insigificantly between the projects. It is therefore natural to move their -_common denominator_ into a separate module and share this module between -the projects. +Integrating *Guile* into a project consists of a set of routine steps, +which, however trivial, require additional efforts from authors and +impose on them an extra maintenance burden. These steps include, among +others, checking for the presence of Guile, determining its version number, +and creating additional Makefile rules. Authors maintaining several projects +that use Guile as an extension language, soon find out that these +steps differ only insigificantly between the projects. It is therefore +natural to move their _common denominator_ into a separate module and share +this module between the projects. *GINT* is an attempt to create such a module. It reduces the task of integrating Guile to importing a submodule and editing a couple of files. *GINT* is designed as a Git submodule easily embeddable into any project. -The only requirement to this host project is that it must use GNU Automake +The only requirement for this host project is that it must use GNU Automake and Autoconf. It is also recommended, but not required, that the host project use Git for its repository. @@ -45,16 +54,25 @@ drwxr-xr-x 5 gray users 1992 2010-04-05 19:20 src/ <4> <1> Top-level +Makefile+ source. <2> Configuration script source. <3> Directory with macro definitions for *aclocal*. -<4> Source directory. It contains actual +C+ and +scm+ sources, +<4> Source directory. It contains actual _C_ and +scm+ sources, which define new *Guile* interfaces. <5> Source +Makefile.am+. The purpose of *GINT* is to provide the autotools magic necessary to check, at configure time, whether Guile is installed, determine its version number and location of its components on the local file system, then to -compile and _snarf_ the +C+ sources, and finally, to produce the +compile and _snarf_ the _C_ sources, and finally, to produce the documentation files (+guile-procedures.texi+ and +guile-procedures.txt+). +Installation of *GINT* consists of the following four steps: + +1. Importing +gint+ submodule. +2. Editing the top-level +Makefile.am+ +3. Editing +configure.ac+ +4. Editing source +Makefile.am+. + +These steps are described in detail in the following subsections. + Import GINT as a submodule ~~~~~~~~~~~~~~~~~~~~~~~~~~~ This needs to be done only once: @@ -66,7 +84,7 @@ git submodule init [[gint-dir]] The *submodule add* command takes two arguments: the submodule repository, -which should be exactly as shown above, and the is the pathname of the +which should be exactly as shown above, and the pathname of the cloned submodule in your project. This latter is entirely at your option. Throughout this document we will suppose that the module pathname is +gint+. You will need to adjust the examples if you chose another @@ -109,7 +127,7 @@ In a simplest case, the following line will be enough: GINT_INIT --------- -For a detailed discussion, see <<GINT_INIT, macro description>>. +For a detailed discussion, see the <<GINT_INIT, macro description>>. Edit source `Makefile.am` ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -131,12 +149,12 @@ variables. Namely, the following variables must be defined before including the file: +INCLUDES+, +EXTRA_DIST+, +CLEANFILES+, +DISTCLEANFILES+, +SUFFIXES+. See the http://sources.redhat.com/automake/automake.html[`Automake` documentation], -for more info on these. If no special value is needed, yo may define each +for more info on these. If no special value is needed, define each of them to an empty string (see example below). Firthermore, the +MAKEINFO+ variable must contain the pathname (not necessarily an absolute one), of the +makeinfo+ binary. It is initialized -by +Automake+ if your project has a `Makefile.am` with the +info_TEXINFOS+ +by +Automake+ if your project contains a `Makefile.am` with the +info_TEXINFOS+ variable set. If not, you will have to initialize it manually. Finally, two +GINT+-specific variables must be defined: @@ -168,9 +186,9 @@ include ../gint/gint.mk The +GINT_INIT+ macro --------------------- ------------------------------------------------- +------------------------------------------------------------- GINT_INIT(DIR, OPTIONS, ACTION-IF-FOUND, ACTION-IF-NOT-FOUND) ------------------------------------------------- +------------------------------------------------------------- This macro configures +GINT+ submodule, located in subdirectory `DIR` according to the settings given in `OPTIONS`. It then @@ -196,12 +214,12 @@ Commands to execute if Guile is present. IF-NOT-FOUND:: Commands to execute if Guile is not found or its version is too old. If not given, the default action is to print a diagnostic message on -the standard error and abort the execution. +the standard error and abort execution. -The +OPTIONS+ parameter allows to execute finer control over the +The +OPTIONS+ parameter offers a way to control the functionality provided by +GINT_INIT+. Its value is a whitespace-separated list of words. Each word must be either the -name of an option, or the minimum (i.e. the older) allowed version +name of an option, or the minimum (i.e. the oldest) allowed version of Guile. For example, to check for Guile 1.8 or later one could write: @@ -209,22 +227,32 @@ write: GINT_INIT([gint], [1.8]) ------------------------ -Following is a list of valid options: +The following is a list of valid options: inc:: Enable generation of `.inc` files. Each such file contains a set of `export` statements, one for each `SCM_DEFINE` in the corresponding -`.c` source file. +`.c` source file. Normally this option is not needed, because it is +more appropriate to define public interfaces using `SCM_DEFINE_PUBLIC` +macro. std-site-dir:: -Set <<sitedir,sitedir>> to the standard Guile site directory, as +Set <<sitedir,site directory>> to the standard Guile site directory, as returned by the +%site-dir+ primitive. + -This is one of locations where Guile looks for its modules. -However, it breaks standard `distcheck` rules and automated builds, +This is one of the locations where Guile looks for its modules. +However, this setting breaks standard `distcheck` rules and automated builds, because this directory is normally outside of the installation prefix. Therefore by default, +GINT+ does not use it. <<guile-site-dir, See -below>>, for a description of the method used to determine it. +below>>, for a description of the method used to determine site directory. + +snarf-doc-filter:: +Use +snarf-doc-filter+ to extract docstrings from _C_ files. *GINT* offers +two programs for extraction of Scheme docstrings from _C_ sources. By default, +the _C_ implementation is used, mainly because it is much faster than its +Scheme counterpart. By supplying the +snarf-doc-filter+ option, you instruct +*GINT* to use Scheme implementation instead. See the section +<<doc-snarfing, Doc snarfing>> for a detailed discussion. Here is a more complex example: @@ -250,7 +278,7 @@ substitution variables: GUILE_VERSION:: The version of Guile, as a string, e.g. `1.9.9`. Additionally, -a +C+ preprocessor macro with the same name is defined. +a _C_ preprocessor macro with the same name is defined. GUILE_VERSION_NUMBER:: The version of Guile packed into a decimal number using the following formula: @@ -263,14 +291,14 @@ where `MAJOR`, `MINOR` and `PATCHLEVEL` are the three parts of a version number, separated by dots. For example, the version string `1.9.9` will produce the value `1909`, and the version `2.0` will yield `2000`. + -A +C+ preprocessor macro with the same name is also defined. +A _C_ preprocessor macro with the same name is also defined. GUILE_INCLUDES:: -The +C+ compiler flags needed to compile with Guile, as +_C_ compiler flags needed to compile with Guile, as returned by `guile-config compile`. GUILE_LIBS:: -The linker flags needed to link with +libguile+, as +Loader flags and additional libraries needed to link with +libguile+, as returned by `guile-config link`. GUILE_SNARF:: @@ -283,6 +311,77 @@ The full pathname of the `guile-tools` binary. GUILE_SITE:: The full pathname of the Guile site-wide module directory. +[[doc-snarfing]] +Doc Snarfing +~~~~~~~~~~~~ +Guile interfaces are defined in _C_ files using +SCM_DEFINE+ or ++SCM_DEFINE_PUBLIC+ macros. Among other parameters, these macros also +allow to specify a _docstring_ for the interface being defined. + +_Doc snarfing_ is a process of extraction these docstrings from _C_ +sources and combining them into two text files: +guile-procedures.texi+, +a _Texinfo_ document suitable for inclusion in the project's documentation, +and +guile-procedures.txt+, which is installed along with the rest of +files and is used by Guile's +help+ function. + +Apart from this primary goal, doc snarfing also serves to catch some minor +programming errors, such as using incorrect +SCM_ARG+_n_ macro in +SCM_ASSERT+, +etc. + +Doc snarfing consists of two phases. _C_ preprocessor is used +on the source file and its output is piped to a special program, called +_snarf filter_. The purpose of the snarf filter is to extract Guile-related +information from the preprocessed source. This information is stored in +a file with the +.doc+ suffix. The +.doc+ files created in this phase +are then used to produce final files: +guile-procedures.texi+ and ++guile-procedures.txt+. + +The +guile-procedures.texi+ file is created by concatenating all ++.doc+ files together and applying the +guile-tools +snarf-check-and-output-texi+ command to the resulting document. This +command is a part of Guile installation. + +The +guile-procedures.txt+ is created by invoking +makeinfo+ with the + +guile-procedures.texi+ file as input. + +Unfortunately, Guile installation does not include any snarf filter +program. *GINT* fixes this oversight and offers two filter implementations: + +clexer:: +This is a default implementation. It is written in _C_ and is +extremely efficient. During bootstrap it requires *flex* to +convert the +clexer.l+ file into a _C_ source which is then distributed +with the package. Of course, *flex* is needed only during the bootstrap, +it is not required to compile from a packaged source. + +snarf-doc-filter:: +A filter written entirely in Scheme. It does not require compilation, +but is significantly slower than +clexer+ and therefore is not used +by default. If you wish to use it, add the +snarf-doc-filter+ option to +the invocation of +GINT_INIT+. It may be feasible only if you require +Guile 1.9.8 or later. + +The +clexer.l+ source is written so as to not require any special attention +from your part. The only two points that are worth mentioning are: + +1. It includes +<config.h>+ if the preprocessor symbol +HAVE_CONFIG_H+ +is defined. +2. It uses +strerror+ function to convert _C_ error numbers to text. + +You may wish to supply additional command line options for compiling it, +if your +config.h+ is placed in an unusual location or includes another +file, not accessible within the normal include path and/or if you wish +to supply a replacement for +strerror+ on systems that lack it (which +is extremely rare nowadays). To do so, define variables +GINT_INCLUDES+ +and/or +GINT_LDADD+ in the `ACTION-IF-FOUND` argument to +GINT_INIT+: + +GINT_INCLUDES:: + Specifies additional command line options to be appended to the + +INCLUDES+ statement in +gint/Makefile.am+. +GINT_LDADD:: + Specifies additional command line options to be appended to the + +LDADD+ statement in +gint/Makefile.am+. + [[guile-site-dir]] THE `SITE DIRECTORY' PROBLEM ---------------------------- @@ -290,28 +389,53 @@ Projects installing some Scheme sources would normally want to install them under Guile's 'site directory' (+%site-dir+ Guile primitive). This way, Guile will be able to find them without any additional configuration. However, such usage breaks the standard GNU practice of not installing files outside -of the project's install prefix, unless the user explicitly requires so. +of project's install prefix, unless the user explicitly requires so. As a consequence, it also breaks the standard `make distcheck` rule. -To avoid this, the configuration code generated by +GINT+ macros determines -the site directory using the following algorithm: +To avoid this, configuration code generated by +GINT+ macros determines +the location of the site directory using the following algorithm: 1. Determine actual value of the default Guile site directory, by inspecting the value returned by the +%site-dir+ primitive. 2. If that value lies under the current installation prefix, it is accepted as the installation directory. -3. Otherwise, if the +--with-guile-site-dir+ option is used: +3. Otherwise, if the +--with-guile-site-dir+ option is supplied: a. If it is used without arguments, +%site-dir+ is enforced as the installation directory. - b. Otherwise, the value of this option is taken as the new installation - directory. Notices, that this value must be an absolute directory name. + b. Otherwise, the value of this option is taken as new site + directory. Notice, that this value must be an absolute directory name. 4. Otherwise, a warning is issued and `$(datadir)/guile/site` is used as -the installation directory. +the site directory. The use if this algorithm is suppressed and Guile site directory is -used instead, if the <<GINT_INIT,+GINT_INIT+>> macros was invoked +used instead, if the <<GINT_INIT,+GINT_INIT+>> macro was invoked with the +std-site-dir+ option. +FILES +----- +The package consists of the following files: +------------------------------------------------------ +Makefile.am <1> +README <2> +clexer.l <3> +extract-exports <4> +gint.m4 <5> +gint.mk <6> +guile.m4 <7> +snarf-doc-filter <8> +------------------------------------------------------ + +<1> Makefile for building +GINT+ components. +<2> The source file for this documentation. +<3> Source of the +clexer+, a program for extracting docstrings and + similar information from C files. +<4> Auxiliary program for converting +.doc+ files into a series of + Guile +export+ declarations. +<5> Source of the +GINT_INIT+ macro. +<6> Makefile to be included from the host project's +Makefile.am+. +<7> Auxiliary defines for +GINT_INIT+. +<8> Alternative implementation of +clexer+, written in Scheme. + COPYRIGHT --------- [verse] @@ -95,8 +95,8 @@ WS [ \t\v\f] {WS}+ ; \\ ; {ID} RETTXT (id, yytext); -0[xX]{X}+{IQ}? RETTXT (int_hex, yytext + 1); -0{O}+{IQ}? RETTXT (int_oct, yytext + 2); +0[xX]{X}+{IQ}? RETTXT (int_hex, yytext + 2); +0{O}+{IQ}? RETTXT (int_oct, yytext + 1); {N}+{IQ}? RETTXT (int_dec, yytext); L?\'[^\\']\' | L?\'\\[^0xX]\' | @@ -44,6 +44,9 @@ AC_DEFUN([_GINT_IF_OPTION_SET], AC_DEFUN([_GINT_SET_OPTIONS], [m4_foreach_w([_GINT_Option], [$1], [_GINT_SET_OPTION(_GINT_Option)])]) +AC_SUBST(GINT_INCLUDES) +AC_SUBST(GINT_LDADD) + dnl GINT_INIT([DIR], [OPTIONS], [IF-FOUND], [IF-NOT-FOUND]) dnl ------------------------------------------------------- dnl DIR Gint submodule directory (defaults to 'gint') @@ -53,11 +56,12 @@ dnl IF-FOUND What to do if Guile is present. dnl IF-NOT-FOUND What to do otherwise. dnl AC_DEFUN([GINT_INIT],[ - AM_PROG_LEX _GINT_SET_OPTIONS([$2]) + _GINT_IF_OPTION_SET([snarf-doc-filter],,[AM_PROG_LEX]) AC_SUBST([GINT_MODULE_DIR],[m4_if([$1],,[gint],[$1])]) AM_CONDITIONAL([GINT_COND_INC],[_GINT_IF_OPTION_SET([inc],[true],[false])]) - + AM_CONDITIONAL([GINT_COND_SNARF_DOC_FILTER],dnl + [_GINT_IF_OPTION_SET([snarf-doc-filter],[true],[false])]) GINT_CHECK_GUILE(m4_ifdef([_GINT_GUILE_VERSION],_GINT_GUILE_VERSION),[$3],[$4]) ]) @@ -31,7 +31,11 @@ DISTCLEANFILES +=\ ETAGS_ARGS = --regex='/SCM_\(GLOBAL_\)?\(G?PROC\|G?PROC1\|SYMBOL\|VCELL\|CONST_LONG\).*\"\([^\"]\)*\"/\3/' \ --regex='/[ \t]*SCM_[G]?DEFINE1?[ \t]*(\([^,]*\),[^,]*/\1/' +if GINT_COND_SNARF_DOC_FILTER +GUILE_DOC_SNARF=$(top_builddir)/$(GINT_MODULE_DIR)/snarf-doc-filter --snarfer +else GUILE_DOC_SNARF=$(top_builddir)/$(GINT_MODULE_DIR)/clexer --snarfer +endif SUFFIXES += .x .doc diff --git a/snarf-doc-filter b/snarf-doc-filter new file mode 100755 index 0000000..e22e268 --- /dev/null +++ b/snarf-doc-filter @@ -0,0 +1,449 @@ +#! /bin/sh +# aside from this initial boilerplate, this is actually -*- scheme -*- code +main='(module-ref (resolve-module '\''(gint snarf-doc-filter)) '\'main')' +exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))" "$@" +!# +;;;; This file is part of Gint +;;;; Copyright (C) 2010 Sergey Poznyakoff +;;;; +;;;; This program is free software; you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation; either version 3, 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. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +(define-module (gint snarf-doc-filter) + :use-module (ice-9 getopt-long) + :use-module (ice-9 regex) + :use-module (ice-9 rdelim)) + +(define debug-option #f) +(define print-option #f) +(define snarfer-option #f) + +(define state 'skip) +(define last-token '()) + +(define string-collection '()) + +(define (init-collection . rest) + (set! string-collection rest)) + +(define (collect-string . rest) + (for-each + (lambda (str) + (set! string-collection (cons str string-collection))) + rest)) + +(define (format-debug fmt . rest) + (if debug-option + (apply format (current-error-port) + (string-append "~A:~A:DEBUG:" fmt) + (cons (port-line (current-input-port)) + (cons (port-column (current-input-port)) + rest))))) + +(define (output sym) + (set! last-token sym) + (if print-option + (begin + (display sym) + (newline)))) + +(define (output-x sym) + (set! last-token sym) + (display sym) + (newline)) + +(define (output-cons name rest) + (set! last-token name) + (if print-option + (begin + (format #t "(~A . \"" name) + (for-each display (reverse rest)) + (display "\")\n")))) + +(define (output-string) + (set! last-token 'string) + (if print-option + (begin + (for-each display (reverse string-collection)) + (newline)))) + +(define char-set:c-delim + (char-set-delete + (char-set-union char-set:whitespace + char-set:punctuation + char-set:symbol) + #\_)) + +(define char-set:not-c-delim + (char-set-complement char-set:c-delim)) + +(define ident-rx + (make-regexp "^[a-zA-Z_][a-zA-Z_0-9]*")) + +(define onum-rx + (make-regexp "^0([0-7]+(l|L|ll|LL|lL|Ll|u|U)?)")) + +(define xnum-rx + (make-regexp "^0[xX]([0-9a-fA-F]*(l|L|ll|LL|lL|Ll|u|U)?)")) + +(define dnum-rx + (make-regexp "^(0|([1-9][0-9]*))(l|L|ll|LL|lL|Ll|u|U)?")) + +(define fnum-rx + (make-regexp + "^(([0-9]+[Ee][+-]?[0-9]+)|(([0-9]*\\.[0-9]+)|([0-9]+\\.[0-9]*))([Ee][+-]?[0-9]+)?)[fFlL]?")) + +(define snarf-cookie-rx + (make-regexp "^\\^[ \\t\\v\\n\\f]*\\^")) + +(define (string-prefix-one-of str pfxdef) + (call-with-current-continuation + (lambda (return) + (for-each + (lambda (pfx) + (if (string-prefix? (car pfx) str) + (return pfx))) + pfxdef) + (return #f)))) + +(define (lexer) + (let loop ((input (read-line))) + (letrec ((find-char-end + (lambda (str pfx) + (init-collection pfx) + (let find-char-end-loop ((str str) + (ind (string-length pfx))) + (cond + ((>= ind (string-length str)) + (format (current-error-port) + "~A:~A: invalid character constant~%" + (port-line (current-input-port)) + (port-column (current-input-port))) + (output "eol") + (loop (read-line))) ; Try to continue anyway + ((char=? (string-ref str ind) #\\) + (format-debug "SKIP SC \\~A~%" + (string-ref str (+ 1 ind))) + (collect-string "\\") + (find-char-end-loop str (+ ind 1))) + ((char=? (string-ref str ind) #\') + (collect-string "'") + (output-cons 'char string-collection) + (loop (substring str (+ 1 ind)))); Next iteration + (else + (let ((ch (string-ref str ind))) + (format-debug "SKIP SC ~A~%" ch) + (collect-string ch)) + (find-char-end-loop str (+ ind 1))))))) + + (find-string-end + (lambda (line pfx) + (let ((pos (cons (port-line (current-input-port)) + (port-column (current-input-port))))) + (init-collection pfx) + (let find-string-end-loop ((str line) + (start (string-length pfx))) +; (format-debug "FNE:~A~%" (substring str start)) + (if (eof-object? str) + (format (current-error-port) + "EOF in string started in ~A:~A~%" + (car pos) (cdr pos)) + + (let ((n (string-skip str (lambda (c) + (not (or (char=? c #\") + (char=? c #\\)))) + start))) + (cond + (n + (if (> n start) + (let ((prefix (substring str start n))) + (format-debug "SEGM ~A~%" prefix) + (collect-string prefix))) + (cond + ((char=? (string-ref str n) #\") + (collect-string "\"") + (output-string) + (loop (substring str (+ n 1)))) ; Next iteration + ((= (1+ n) (string-length str)) + (format-debug "ESCNL~%") + (collect-string "\\\n") + (find-string-end-loop (read-line) 0)) + ((char=? (string-ref str (1+ n)) #\") + (format-debug "ESCQUOTE~%") + (collect-string "\\\"") + (find-string-end-loop str (+ n 2))) + (else + (format-debug "ESCAPE~%") + (collect-string "\\") + (find-string-end-loop str (1+ n))))) + (else + (let ((segm (substring str start))) + (format-debug "SEGM ~A~%" segm) + (collect-string segm)) + (find-string-end-loop (read-line) 0)))))))))) + + (format-debug "IN:~A / ~A / ~A / ~A~%" input print-option state last-token) + (if (not (eof-object? input)) + (let ((line (string-trim input))) +; (format-debug "LI:~A~%" line) + (cond + ((string-null? line) + (output "eol") + (loop (read-line))) + ((string-prefix? "#" line) + (output "hash") + (loop (read-line))) + ((string-prefix? "/*" line) + (let ((pos (cons (port-line (current-input-port)) + (port-column (current-input-port))))) + (init-collection) + (let find-comment-end ((str line)) +; (format-debug "FCE:~A~%" str) + (cond + ((eof-object? str) + (format (current-error-port) + "EOF in comment started in ~A:~A~%" + (car pos) (cdr pos))) + ((string-contains str "*/") => + (lambda (n) + (collect-string (substring str 0 (+ n 2))) + (output-cons 'comment string-collection) + (loop (substring str (+ n 2))))) + (else + (collect-string str "\n") + (find-comment-end (read-line))))))) + + ((string-prefix? "\"" line) + (find-string-end line "\"")) + ((string-prefix? "L\"" line) + (find-string-end line "L\"")) + + ((string-prefix? "L'" line) + (find-char-end line "L'")) + + ((string-prefix? "{" line) + (let ((lt last-token)) + (output "brace_open") + (if (and (eq? lt 'snarf_cookie) + (eq? state 'cookie)) + (set! state 'multiline)) + (loop (substring line 1)))) + + ((string-prefix? "<%" line) + (let ((lt last-token)) + (output "brace_open") + (if (and (eq? lt 'snarf_cookie) + (eq? state 'cookie)) + (set! state 'multiline)) + (loop (substring line 2)))) + + ((string-prefix? "}" line) + (let ((lt last-token)) + (output "brace_close") + (if (and (eq? lt 'snarf_cookie) + (eq? state 'multiline-cookie)) + (begin + (set! state 'skip) + (set! print-option #f))) + (loop (substring line 1)))) + + ((string-prefix? "%>" line) + (let ((lt last-token)) + (output "brace_close") + (if (and (eq? lt 'snarf_cookie) + (eq? state 'multiline-cookie)) + (begin + (set! state 'skip) + (set! print-option #f))) + (loop (substring line 2)))) + + ((regexp-exec fnum-rx line) => + (lambda (m) + (format-debug "FNUM: ~S~%" m) + (let ((pfx (match:substring m))) + (output-cons 'flo_dec (list pfx)) + (loop (substring line (string-length pfx)))))) + + ((regexp-exec snarf-cookie-rx line) => + (lambda (m) + (if snarfer-option + (case state + ((skip) + (set! state 'cookie) + (set! print-option #t)) + ((multiline multiline-cookie) + (set! state 'multiline-cookie)) + ((cookie) + (set! state 'skip) + (set! print-option #f)))) + (output-x 'snarf_cookie) + (loop (substring line (- (match:end m) (match:start m)))))) + + ((string-prefix-one-of line + '((">>=" . shift_right_assign) + ("<<=" . shift_left_assign) + ("+=" . add_assign) + ("-=" . sub_assign) + ("*=" . mul-assign) + ("/=" . div_assign) + ("%=" . mod_assign) + ("&=" . logand_assign) + ("^=" . logxor_assign) + ("|=" . logior_assign) + (">>" . right_shift) + ("<<" . left_shift) + ("++" . inc) + ("--" . dec) + ("->" . ptr) + ("&&" . and) + ("||" . or) + ("<=" . le) + (">=" . ge) + ("==" . eq) + ("!=" . neq) + ("..." . ellipsis) + ("," . comma) + (":" . colon) + ("=" . assign) + ("(" . paren_open) + (")" . paren_close) + ("[" . bracket_open) + ("]" . bracket_close) + ("." . dot) + ("&" . amp) + ("!" . bang) + ("~" . tilde) + ("-" . minus) + ("+" . plus) + ("*" . star) + ("/" . slash) + ("%" . percent) + ("<" . lt) + (">" . gt) + ("^" . caret) + ("|" . pipe) + ("?" . question) + (";" . semicolon))) => + (lambda (pfx) + (output (symbol->string (cdr pfx))) + (loop (substring line (string-length (car pfx)))))) + + ;; more... + ((char-set-contains? char-set:c-delim (string-ref line 0)) +; (format-debug "special ~A~%" line) + (cond + ((string-prefix? "'" line) + (find-char-end line "'")) + (else + (format-debug "SKIP #\\~A~%" (substring line 0 1)) + (loop (substring line 1))))) + + ((regexp-exec ident-rx line) => + (lambda (m) + (format-debug "IDENT: ~S~%" m) + (let ((pfx (match:substring m))) + (output-cons 'id (list pfx)) + (loop (substring line (string-length pfx)))))) + + ((regexp-exec onum-rx line) => + (lambda (m) + (format-debug "ONUM: ~S~%" m) + (let ((pfx (match:substring m 1))) + (output-cons 'int_oct (list pfx)) + (loop (substring line + (- (match:end m) (match:start m))))))) + + ((regexp-exec xnum-rx line) => + (lambda (m) + (format-debug "XNUM: ~S~%" m) + (let ((pfx (match:substring m 1))) + (output-cons 'int_hex (list pfx)) + (loop (substring line (- (match:end m) (match:start m))))))) + + ((regexp-exec dnum-rx line) => + (lambda (m) + (format-debug "DNUM: ~S~%" m) + (let ((pfx (match:substring m))) + (output-cons 'int_dec (list pfx)) + (loop (substring line (string-length pfx)))))) + + (else + (let ((n (string-skip line char-set:not-c-delim))) + (format-debug "N=~A~%" n) + (cond + (n + (format-debug "SKIP '~A'~%" (substring line 0 n)) + (loop (substring line n))) + (else + (format-debug "SKIP '~A'~%" line) + (output "eol") + (loop (read-line)))))))))))) + +(define grammar + `((debug (single-char #\d)) + (snarfer (single-char #\s)) + (output (single-char #\o) + (value #t)) + (help (single-char #\h)))) + +(define (usage) + (display "usage: snarf-doc-filter [OPTIONS] [FILE]\n") + (display "\n") + (display "OPTIONS are:\n") + (display " -d, --debug debugging output\n") + (display " -s, --snarfer filter snarfed contents\n") + (display " -o, --output FILE set output file name\n") + (display " -h, --help display this help summary\n")) + +(define output-file-name #f) +(define input-file-name #f) + +(define (main . args) + (for-each + (lambda (x) + (case (car x) + ((debug) + (set! debug-option #t)) + ((snarfer) + (set! snarfer-option #t)) + ((output) + (set! output-file-name (cdr x))) + ((help) + (usage) + (exit 0)) + ('() + (if (not (null? (cdr x))) + (set! input-file-name (cadr x)))))) + (getopt-long args grammar)) + + (if (and + (not print-option) + (not snarfer-option)) + (set! print-option #t)) + + (letrec ((lex-out (lambda () + (if output-file-name + (with-output-to-file + output-file-name + lexer) + (lexer))))) + (if input-file-name + (with-input-from-file + input-file-name + lex-out) + (lex-out)))) + +;; End of snarf-doc-filter.scm + + + |