From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Thien-Thi Nguyen Newsgroups: gmane.lisp.guile.user,gmane.lisp.guile.sources Subject: fspec2c 1.1 Date: Sun, 09 Nov 2003 13:58:54 +0100 Sender: guile-user-bounces+guile-user=m.gmane.org@gnu.org Message-ID: Reply-To: ttn@glug.org NNTP-Posting-Host: deer.gmane.org X-Trace: sea.gmane.org 1068382506 3704 80.91.224.253 (9 Nov 2003 12:55:06 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Sun, 9 Nov 2003 12:55:06 +0000 (UTC) Cc: guile-user@gnu.org Original-X-From: guile-user-bounces+guile-user=m.gmane.org@gnu.org Sun Nov 09 13:55:03 2003 Return-path: Original-Received: from monty-python.gnu.org ([199.232.76.173]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1AIp5r-0003Oe-00 for ; Sun, 09 Nov 2003 13:55:03 +0100 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.24) id 1AIq2S-0001mX-Oh for guile-user@m.gmane.org; Sun, 09 Nov 2003 08:55:36 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.24) id 1AIq1u-0001mN-EA for guile-user@gnu.org; Sun, 09 Nov 2003 08:55:02 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.24) id 1AIq1O-0001gr-Om for guile-user@gnu.org; Sun, 09 Nov 2003 08:55:01 -0500 Original-Received: from [151.37.59.162] (helo=surf.glug.org) by monty-python.gnu.org with esmtp (Exim 4.24) id 1AIq0q-0001L7-NE; Sun, 09 Nov 2003 08:53:57 -0500 Original-Received: from ttn by surf.glug.org with local (Exim 3.35 #1 (Debian)) id 1AIp9a-0002O4-00; Sun, 09 Nov 2003 13:58:54 +0100 Original-To: guile-sources@gnu.org X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.2 Precedence: list List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-user-bounces+guile-user=m.gmane.org@gnu.org Xref: main.gmane.org gmane.lisp.guile.user:2375 gmane.lisp.guile.sources:73 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.user:2375 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 ;;; 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 _______________________________________________ Guile-user mailing list Guile-user@gnu.org http://mail.gnu.org/mailman/listinfo/guile-user