fspec2c 1.1

[Thien-Thi Nguyen]

see this script in action!  guile-sdl cvs instructions:

 http://www.glug.org/people/ttn/software/guile-sdl/ANONCVS

checkout using tag "ok-1" (to be safe).  the makefiles therein respect
env var "fspec2c", so you can save this to /tmp (and chmod +x) and do
something like:

 sh -x autogen.sh    # NB: read comments for auto* tool version reqs
 ./configure
 make fspec2c='/tmp/fspec2c'

you will, of course, need to install a version of gperf that supports
option "--output-file" (or alternatively hack fspec2c to work around
those versions of gperf that don't -- patches welcome), not to mention
SDL libs and headers...

in related news, guile-sdl "ok-1" passes "make && make check" so only
"make dist" issues gate a release.  (still alpha, though, so don't get
your hopes up...)

thi


______________________________________________________________________
#!/bin/sh
exec ${GUILE-guile} -e '(scripts fspec2c)' -s $0 "$@" # -*-scheme -*-
!#
;;; fspec2c --- translate flag spec to C code

;;      Copyright (C) 2003 Free Software Foundation, Inc.
;;
;; 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 2, 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 software; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;; Boston, MA 02111-1307 USA
;;
;; As a special exception, the Free Software Foundation gives permission
;; for additional uses of the text contained in its release of GUILE.
;;
;; The exception is that, if you link the GUILE library with other files
;; to produce an executable, this does not by itself cause the
;; resulting executable to be covered by the GNU General Public License.
;; Your use of that executable is in no way restricted on account of
;; linking the GUILE library code into it.
;;
;; This exception does not however invalidate any other reasons why
;; the executable file might be covered by the GNU General Public License.
;;
;; This exception applies only to the code released by the
;; Free Software Foundation under the name GUILE.  If you copy
;; code from other Free Software Foundation releases into a copy of
;; GUILE, as the General Public License permits, the exception does
;; not apply to the code that you add in this way.  To avoid misleading
;; anyone as to the status of such modified files, you must delete
;; this exception notice from them.
;;
;; If you write modifications of your own for GUILE, it is your choice
;; whether to permit this exception to apply to your modifications.
;; If you do not wish that, delete this exception notice.

;;; Author: Thien-Thi Nguyen <address@hidden>

;;; Commentary:

;; Usage: fspec2c [OPTIONS] FSPEC
;;
;; Write C fragment to stdout derived from running gperf (GNU perfect
;; hash function generator) on the flags mined from the header as
;; specified in FSPEC.  OPTIONS are zero or more of:
;;
;;  -o, --output FILE    -- write to FILE instead of stdout
;;  -I, --include DIR    -- look in DIR instead of /usr/include
;;  -n, --no-cgen        -- write generated gperf input instead
;;                          of actually sending it to gperf
;;
;; The FSPEC file contents is a Scheme list with alternating keyword and
;; data elements.  Currently, these keywords are recognized:
;;
;;  #:infile RELPATH     -- which header to scan (string)
;;  #:region (BEG . END) -- only scan lines inside BEG-END regexps (strings)
;;  #:regexp REGEXP      -- regexp w/ at least one subexpression (string)
;;  #:key-match-num NUM  -- which subexpression is the key
;;  #:struct SPEC        -- struct-member specifiers (list, see below)
;;  #:struct-name NAME   -- for "struct NAME { ... }" (string)
;;  #:gperf-options OPT  -- additional options for gperf (string)
;;  #:pre-boilerplate S  -- gperf "%{ ... %}" declarations (symbol, see below)
;;  #:post-boilerplate S -- direct C inclusion (symbol, see below)
;;
;; SPEC is a list of struct-member specifiers, each a list of the form:
;;
;;   (MATCH C-TYPE-COMPONENT-1 [C-TYPE-COMPONENT-2 ...] C-VAR-NAME)
;;
;; MATCH can be a number to specify a subexpression of REGEXP to use for
;; static-data initialization, a string to be used for same (note that
;; to indicate a C string, you need to escape its double-quotes), or #f
;; to indicate no initialization.  Per info node "(gperf)User-supplied
;; Struct", the first element of SPEC must be:
;;
;;   (1 char * name)
;;
;; This restriction may be lifted in the future, as fspec2c is enhanced
;; to interoperate better with those features of gperf that allow
;; customization of this struct element.
;;
;; The #:pre-boilerplate and #:post-boilerplate data elements are
;; symbols rather than strings, in order to minimize quoting headaches.
;; Such symbols have the syntax: #{ TEXT }# where TEXT can include
;; anything (including spaces, newlines, and quote characters) except
;; the closing curly-brace-hash token.  Boilerplate text is passed
;; straight-through by both fspec2c and gperf; errors in the code will
;; only be flagged during compilation.

;;; Code:

(define-module (scripts fspec2c)
  #:use-module (scripts PROGRAM)
  #:use-module (ice-9 rdelim)
  #:use-module (ice-9 regex)
  #:autoload (ice-9 popen) (open-output-pipe))

(define (fspec2c/qop qop)
  (let* ((info (read (open-input-file
                      (let ((args (qop '())))
                        (or (and (pair? args) (car args))
                            (error "no input specified"))))))
         (spec (lambda (kw) (and=> (memq kw info) cadr)))
         (gperf-input '()))
    (let* ((p (open-input-file (in-vicinity
                                (or (qop 'include) "/usr/include")
                                (spec #:infile))))
           (rx (make-regexp (spec #:regexp)))
           (beg-rx (and=> (and=> (spec #:region) car) make-regexp))
           (end-rx (and=> (and=> (spec #:region) cdr) make-regexp))
           (in? #f))
      (let loop ((line (read-line p)))
        (or (eof-object? line)
            (number? in?)
            (begin
              (cond ((and end-rx in? (regexp-exec end-rx line))
                     (set! in? 0))
                    ((and beg-rx (not in?) (regexp-exec beg-rx line))
                     (set! in? #t))
                    ((and (or (and beg-rx in?)
                              (not beg-rx))
                          (regexp-exec rx line))
                     => (lambda (m)
                          (set! gperf-input (cons m gperf-input)))))
              (loop (read-line p)))))
      (close-port p))
    ;; feed gperf (unless --no-cgen)
    (let* ((kw-num (spec #:key-match-num))
           (struct (or (spec #:struct) '()))
           (op (if (qop 'no-cgen)
                   (or (qop 'output open-output-file)
                       (current-output-port))
                   (open-output-pipe
                    (format #f "gperf~A~A --output-file=~A"
                            (if (null? struct) "" " -t")
                            (cond ((spec #:gperf-options)
                                   => (lambda (o) (format #f " ~A" o)))
                                  (else ""))
                            (or (qop 'output) "-"))))))
      (cond ((spec #:pre-boilerplate)
             => (lambda (x)
                  (display "%{\n" op)
                  (display (symbol->string x) op)
                  (display "\n%}\n" op))))
      (cond ((null? struct))
            (else
             (format op "struct ~A {" (or (spec #:struct-name)
                                          "randomstructname"))
             (for-each (lambda (x)
                         (for-each (lambda (xx)
                                     (format op " ~A" xx))
                                   (cdr x))
                         (format op ";"))
                       struct)
             (format op " };\n%%\n")))
      (for-each (lambda (m)
                  (display (match:substring m kw-num) op)
                  (or (null? struct)
                      (for-each
                       (lambda (x)
                         (and=> (car x)
                                (lambda (init)
                                  (format
                                   op ", ~A"
                                   (cond ((number? init)
                                          (match:substring m init))
                                         ((string? init)
                                          init)
                                         (else
                                          (error "bad init:" init)))))))
                       ;; 1st fixed; see "(gperf)User-supplied Struct"
                       (cdr struct)))
                  (newline op))
                gperf-input)
      (cond ((spec #:post-boilerplate)
             => (lambda (x)
                  (display "%%\n" op)
                  (display (symbol->string x) op)
                  (newline op))))
      (if (qop 'no-cgen)
          (or (eq? op (current-output-port))
              (close-port op))
          (close-pipe op)))
    #t))

(define (main args)
  (HVQC-MAIN args fspec2c/qop
             '(usage . commentary)
             '(package . "Guile")
             '(version . "1.1")
             ;; 1.0 -- first release
             ;; 1.1 -- close-pipe bugfix; support string init; support #:region
             '(option-spec (output  (single-char #\o) (value #t))
                           (include (single-char #\I) (value #t))
                           (no-cgen (single-char #\n)))))

;;; fspec2c ends here