[Author Prev][Author Next][Thread Prev][Thread Next][Author Index][Thread Index]
gEDA-cvs: gaf.git: branch: master updated (1.7.0-20110116-87-g5785b75)
The branch, master has been updated
via 5785b75e225b1876453a67799a0184830584e77a (commit)
via 0348b21c1e4772774c239da706736764df8805ca (commit)
from 7bd75fad7cbd3b0e3520cf40ac64cf0986b16c84 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
=========
Summary
=========
gnetlist/include/prototype.h | 2 +-
gnetlist/scheme/Makefile.am | 5 +-
gnetlist/scheme/gnetlist.scm | 9 ++
gnetlist/scheme/gnetlist/backend-getopt.scm | 172 +++++++++++++++++++++++++++
gnetlist/src/g_netlist.c | 48 +++-----
gnetlist/src/g_register.c | 2 +-
6 files changed, 203 insertions(+), 35 deletions(-)
create mode 100644 gnetlist/scheme/gnetlist/backend-getopt.scm
=================
Commit Messages
=================
commit 5785b75e225b1876453a67799a0184830584e77a
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
gnetlist: Add convenience library to help backends parse `-O' options.
Based on a suggestion by Patrick Bernaud that it would be useful for
gnetlist backends to be able to accept more complex options on the
gnetlist command line, this patch adds the (gnetlist backend-getopt)
Scheme module to gnetlist.
This provides convenience functions that allow a backend to easily
handle several different types of `-O' backend option: flag options,
options with arguments, and options with optional arguments.
:100644 100644 ec804bf... 11fdc4e... M gnetlist/scheme/Makefile.am
:000000 100644 0000000... d8ff2da... A gnetlist/scheme/gnetlist/backend-getopt.scm
commit 0348b21c1e4772774c239da706736764df8805ca
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
gnetlist: Refactor `gnetlist:get-calling-flags'.
Reimplement `gnetlist:get-calling-flags' in Scheme, based on a new
`gnetlist:backend-arguments' function.
:100644 100644 0b2a7a6... 99e0094... M gnetlist/include/prototype.h
:100644 100644 eaa83ef... 9c4b4d8... M gnetlist/scheme/gnetlist.scm
:100644 100644 d079448... 15de633... M gnetlist/src/g_netlist.c
:100644 100644 da5497a... 71a2049... M gnetlist/src/g_register.c
=========
Changes
=========
commit 5785b75e225b1876453a67799a0184830584e77a
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
gnetlist: Add convenience library to help backends parse `-O' options.
Based on a suggestion by Patrick Bernaud that it would be useful for
gnetlist backends to be able to accept more complex options on the
gnetlist command line, this patch adds the (gnetlist backend-getopt)
Scheme module to gnetlist.
This provides convenience functions that allow a backend to easily
handle several different types of `-O' backend option: flag options,
options with arguments, and options with optional arguments.
diff --git a/gnetlist/scheme/Makefile.am b/gnetlist/scheme/Makefile.am
index ec804bf..11fdc4e 100644
--- a/gnetlist/scheme/Makefile.am
+++ b/gnetlist/scheme/Makefile.am
@@ -6,7 +6,7 @@ PCBM4DIR= @PCBM4DIR@
PCBCONFDIR= @PCBCONFDIR@
scmdatadir = @GEDADATADIR@/scheme
-scmdata_DATA = $(DIST_SCM) $(BUILT_SCM)
+nobase_scmdata_DATA = $(DIST_SCM) $(BUILT_SCM)
DIST_SCM = gnet-PCB.scm gnet-allegro.scm gnet-bom.scm gnet-geda.scm \
gnet-spice.scm gnet-tango.scm gnet-verilog.scm \
@@ -20,7 +20,8 @@ DIST_SCM = gnet-PCB.scm gnet-allegro.scm gnet-bom.scm gnet-geda.scm \
gnet-futurenet2.scm gnet-cascade.scm \
gnet-redac.scm gnet-systemc.scm gnet-eagle.scm \
gnet-pcbpins.scm gnet-calay.scm gnet-osmond.scm \
- gnet-mathematica.scm gnet-liquidpcb.scm
+ gnet-mathematica.scm gnet-liquidpcb.scm \
+ gnetlist/backend-getopt.scm
EXTRA_DIST = $(DIST_SCM) $(SCM_SRCS)
diff --git a/gnetlist/scheme/gnetlist/backend-getopt.scm b/gnetlist/scheme/gnetlist/backend-getopt.scm
new file mode 100644
index 0000000..d8ff2da
--- /dev/null
+++ b/gnetlist/scheme/gnetlist/backend-getopt.scm
@@ -0,0 +1,172 @@
+;; gEDA - GPL Electronic Design Automation
+;; gnetlist - gEDA Schematic Capture - Scheme API
+;; Copyright (C) 2011 Peter Brett <peter@xxxxxxxxxxxxx>
+;;
+;; 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 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.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111 USA
+;;
+
+;; This module provides an API to assist backends which wish to
+;; provide command-line gnetlist options via the `-O' argument. The
+;; API consists of two functions:
+;;
+;; `backend-getopt', which accepts a grammar and the set of `-O'
+;; arguments, and extracts the options.
+;;
+;; `backend-option-ref', which is used to look-up an option in the
+;; structure returned by `backend-getopt'.
+
+(define-module (gnetlist backend-getopt)
+ #:use-module (srfi srfi-1)
+ #:use-module (ice-9 optargs)
+ #:use-module (ice-9 receive)
+ #:export (backend-getopt backend-option-ref))
+
+
+(define (backend-getopt args grammar)
+ "backend-getopt ARGS GRAMMAR
+
+Parse the command-line `-O' arguments in ARGS against the given
+backend option GRAMMAR, returning an option structure that can be
+passed to backend-option-ref.
+
+The GRAMMAR argument is expected to be a list of this form:
+
+ `((OPTION (PROPERTY VALUE) ...) ...)'
+
+where each OPTION is a symbol denoting the option name.
+
+For each option, there may be a list of arbitrarily many
+property/value pairs. The order of the pairs is not important, but
+every property may only appear once in the property list. The
+following table lists the possible properties:
+
+ `(required? BOOL)'
+ If BOOL is true, the option is required. `backend-getopt' will
+ raise an error if it is not found in ARGS.
+
+ `(value BOOL)'
+ If BOOL is `#t', the option requires a value; if it is `#f',
+ it does not; and if it is the symbol `optional', the option
+ may appear in ARGS with or without a value.
+
+ `(predicate FUNC)'
+ If the option accepts a value (i.e. you specified `(value #t)'
+ or `(value optional)' for this option), then `backend-getopt'
+ will apply FUNC to the value, and raise an error if it returns
+ `#f'. FUNC should be a procedure which accepts a string and
+ returns a boolean value.
+
+Normally, you will want to pass the result of calling
+`gnetlist:get-backend-arguments' as the ARGS parameter.
+
+If `backend-getopt' finds a problem with ARGS, it raises an error with
+the key `option-error'."
+ (let ((options '()))
+ ;; First pass: process options
+ (for-each
+ (lambda (arg)
+ (receive (name value)
+ (split-arg arg)
+ (set! options
+ (assoc-set! options name (process-arg name value grammar)))))
+ args)
+
+ ;; Second pass: ensure required options have been provided
+ (for-each
+ (lambda (grammar-entry)
+ (let ((name (car grammar-entry))
+ (spec (cdr grammar-entry)))
+ (and (opt-property spec 'required? #f)
+ (or (backend-option-ref options name)
+ (option-error
+ "Backend option '~A' must be specified." name)))))
+ grammar)
+
+ ;; Return options
+ options))
+
+
+(define* (backend-option-ref options key #:optional default)
+ "backend-option-ref OPTIONS KEY [DEFAULT]
+
+Search OPTIONS for a backend option named KEY and return its value,
+if found. If the option has no value, but was given, return `#t'. If
+the option was not given, return DEFAULT, or if DEFAULT was not
+specified, `#f'. OPTIONS must be the ruslt of a call to
+`backend-getopt'."
+ (or (assoc-ref options key) default))
+
+
+(define (option-error message . args)
+ "Raise an error due to a bad option."
+ (scm-error 'option-error "backend-getopt" message args #f))
+
+
+(define (split-arg arg)
+ "Split an `-O' argument into name and value. The name is assumed to
+be all characters in ARG up to the first `=' or ` '. The name is
+returned as a symbol, and the value (if present) as a string. If
+argument has no value component, the value is returned as #f."
+ (let ((idx (string-index arg (char-set #\space #\=))))
+ (case idx
+ ((0) (option-error "Invalid backend option syntax '~A'." arg))
+ ((#f) (values (string->symbol arg) #f))
+ (else (values (string->symbol (substring arg 0 idx))
+ (substring arg (1+ idx)))))))
+
+
+(define (opt-spec name grammar)
+ "Search GRAMMAR for an option specification for NAME."
+ (let ((s (find (lambda (x) (eqv? name (car x))) grammar)))
+ (and s (cdr s)))) ; Throw away the name of the option.
+
+
+(define (opt-property spec property default)
+ "Search SPEC (obtained using find-opt-spec) for the given option
+PROPERTY. Returns the value of that property, or default if the
+property wasn't present in SPEC."
+ (let ((p (find (lambda (x) (eqv? property (car x))) spec)))
+ (if p (cadr p) default))) ; Throw away the name of the property.
+ ; If property not found, use default.
+
+
+(define (process-arg name value grammar)
+ "Validates the given `-O' argument NAME & VALUE against GRAMMAR,
+returning the value to be returned to the user code."
+ (let ((spec (opt-spec name grammar)))
+ ; Is this a valid argument?
+ (or spec
+ (option-error "Unrecognized backend option '~A'." name))
+
+ ; Check that a value was provided, if one was required, or vice
+ ; versa.
+ (case (opt-property spec 'value #f)
+ ((optional) #t)
+ ((#f) (and value (option-error
+ "Backend option '~A' doesn't allow an argument." name)))
+ (else (or value (option-error
+ "Backend option '~A' requires an argument." name))))
+
+ ; If a value-verification predicate was provided, use it to verify
+ ; the value.
+ (let ((pred? (opt-property spec 'predicate #f)))
+ (and pred? value
+ (or (pred? value)
+ (option-error
+ "Invalid argument '~A' to backend option '~A'."
+ value name))))
+
+ ; If a value was provided, return it, otherwise #t.
+ (or value #t)))
commit 0348b21c1e4772774c239da706736764df8805ca
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
gnetlist: Refactor `gnetlist:get-calling-flags'.
Reimplement `gnetlist:get-calling-flags' in Scheme, based on a new
`gnetlist:backend-arguments' function.
diff --git a/gnetlist/include/prototype.h b/gnetlist/include/prototype.h
index 0b2a7a6..99e0094 100644
--- a/gnetlist/include/prototype.h
+++ b/gnetlist/include/prototype.h
@@ -1,7 +1,7 @@
/* g_netlist.c */
void g_set_project_current(TOPLEVEL *pr_current);
SCM g_scm_c_get_uref(TOPLEVEL *toplevel, OBJECT *object);
-SCM g_get_calling_flags(); /* SDB -- 9.1.2003 */
+SCM g_get_backend_arguments ();
SCM g_get_packages(SCM level);
SCM g_get_non_unique_packages(SCM level);
SCM g_get_pins(SCM uref);
diff --git a/gnetlist/scheme/gnetlist.scm b/gnetlist/scheme/gnetlist.scm
index eaa83ef..9c4b4d8 100644
--- a/gnetlist/scheme/gnetlist.scm
+++ b/gnetlist/scheme/gnetlist.scm
@@ -37,6 +37,15 @@
)))
+(define (gnetlist:get-calling-flags) ; DEPRECATED
+ "Returns a list of `-O' arguments in the form:
+
+ ((ARGUMENT #t) ...)
+
+This function is deprecated, and should not be used in new code. New
+code should use `gnetlist:get-backend-arguments' directly."
+ (map (lambda (x) (list x #t)) (gnetlist:get-backend-arguments)))
+
;;---------------------------------------------------------------
;; calling-flag?
;; Returns #t or #f depending upon the corresponding flag
diff --git a/gnetlist/src/g_netlist.c b/gnetlist/src/g_netlist.c
index d079448..15de633 100644
--- a/gnetlist/src/g_netlist.c
+++ b/gnetlist/src/g_netlist.c
@@ -728,38 +728,24 @@ SCM g_get_toplevel_attribute(SCM scm_wanted_attrib)
return (scm_return_value);
}
-/*
- This function returns certain calling flags to the calling guile prog.
- The calling flags are returned to Guile as a list of option/value pairs [e.g.
- ((verbose_mode #t) (interactive_mode #f) . . . ) ]
- It is used primarily to enable refdes sorting during netlisting via
- the -s flag. Note that this prog is not very flexible -- the allowed
- calling flags are hard coded into the function. At some point this
- should be fixed . . .
- 9.1.2003 -- SDB
-
- 8.2.2005 -- Carlos Nieves Onega
- Different modes are now included in the backend_params list, as well as
- the backend parameters given from the command line. Since the function
- calling-flag? in scheme/gnetlist.scm returns false if the calling flag was
- not found, it's only necessary to include the flags being true.
-*/
-SCM g_get_calling_flags()
+
+/*! \brief Obtain a list of `-O' backend arguments.
+ * \par Function Description
+ * Returns a list of arguments passed to the gnetlist backend via the
+ * `-O' gnetlist command-line option.
+ */
+SCM
+g_get_backend_arguments()
{
- SCM arglist = SCM_EOL;
-
- GSList *aux;
-
- aux = backend_params;
- while (aux != NULL) {
- arglist = scm_cons (scm_list_n (scm_from_locale_string (aux->data),
- SCM_BOOL (TRUE),
- SCM_UNDEFINED),
- arglist);
- aux = aux->next;
- }
-
- return (arglist);
+ SCM result = SCM_EOL;
+ GSList *iter;
+
+ for (iter = backend_params; iter != NULL; iter = g_slist_next (iter)) {
+ result = scm_cons (scm_from_locale_string ((char *) iter->data),
+ result);
+ }
+
+ return scm_reverse_x (result, SCM_UNDEFINED);
}
diff --git a/gnetlist/src/g_register.c b/gnetlist/src/g_register.c
index da5497a..71a2049 100644
--- a/gnetlist/src/g_register.c
+++ b/gnetlist/src/g_register.c
@@ -93,7 +93,7 @@ static struct gsubr_t gnetlist_funcs[] = {
3, 0, 0, g_graphical_objs_in_net_with_attrib_get_attrib },
/* SDB -- 9.1.2003 */
- { "gnetlist:get-calling-flags", 0, 0, 0, g_get_calling_flags },
+ { "gnetlist:get-backend-arguments", 0, 0, 0, g_get_backend_arguments },
{ NULL, 0, 0, 0, NULL } };
_______________________________________________
geda-cvs mailing list
geda-cvs@xxxxxxxxxxxxxx
http://www.seul.org/cgi-bin/mailman/listinfo/geda-cvs