guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-14-117-g6


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-14-117-g6ce3666
Date: Thu, 27 Jan 2011 12:06:29 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=6ce3666ff2a8f73a6abab17535dc27051f8ab8b6

The branch, master has been updated
       via  6ce3666ff2a8f73a6abab17535dc27051f8ab8b6 (commit)
       via  f9654187b1ff0e20dfcb66da963eae62f4d03be1 (commit)
       via  9805ffdaf770f7129db31213f1d9319eaa98a84e (commit)
       via  38a73781e6dd248268c237980351c61bd36004ea (commit)
       via  a27b0f36828baa7a1282fb3595792c21cb4ff9a9 (commit)
       via  dce0252bf2b6b25ce825038472b2c3fa811a0164 (commit)
      from  4914fe1963ce5bee2ecd86f3a386dd0e23d3678b (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.

- Log -----------------------------------------------------------------
commit 6ce3666ff2a8f73a6abab17535dc27051f8ab8b6
Author: Andy Wingo <address@hidden>
Date:   Thu Jan 27 13:11:02 2011 +0100

    for mmap objcodes, store the fd in the third word, as a scheme int
    
    This leaves space for native code.
    
    * libguile/objcodes.h (SCM_OBJCODE_NATIVE_CODE)
      (SCM_SET_OBJCODE_NATIVE_CODE): Reserve the fourth word of objcode for
      "native code", whatever that means.
    
    * libguile/objcodes.c: Update a comment.
      (make_objcode_by_mmap): Put the fd in the third word.

commit f9654187b1ff0e20dfcb66da963eae62f4d03be1
Author: Andy Wingo <address@hidden>
Date:   Thu Jan 27 12:44:53 2011 +0100

    objcode type is an enumeration, not flags
    
    * libguile/objcodes.h (SCM_OBJCODE_TYPE_MMAP)
      (SCM_OBJCODE_TYPE_BYTEVECTOR, SCM_OBJCODE_TYPE_SLICE)
      (SCM_OBJCODE_TYPE_STATIC): Enumerate objcode types instead of
      expressing them as flags.
      (SCM_OBJCODE_TYPE): Type is held in bits 8-15.
      (SCM_OBJCODE_FLAGS): Flags are now shifted by 16 bits, not 8.
      (SCM_MAKE_OBJCODE_TAG): New helper.
    
    * libguile/continuations.c (STATIC_OBJCODE_TAG):
    * libguile/control.c (STATIC_OBJCODE_TAG):
    * libguile/foreign.c (STATIC_OBJCODE_TAG):
    * libguile/gsubr.c (STATIC_OBJCODE_TAG):
    * libguile/smob.c (STATIC_OBJCODE_TAG):
    * libguile/objcodes.c (make_objcode_by_mmap, scm_c_make_objcode_slice)
      (scm_bytecode_to_objcode): : Use SCM_MAKE_OBJCODE_TAG.

commit 9805ffdaf770f7129db31213f1d9319eaa98a84e
Author: Andy Wingo <address@hidden>
Date:   Thu Jan 27 11:24:22 2011 +0100

    guile-tools gracefully errors for missing scripts
    
    * meta/guile-tools.in (find-script): Use the #:ensure arg of
      resolve-module.
      (main): Display a comprehensible error message if we don't find a
      script.

commit 38a73781e6dd248268c237980351c61bd36004ea
Author: Andy Wingo <address@hidden>
Date:   Thu Jan 27 11:15:01 2011 +0100

    guile-tools uses getopt-long
    
    * meta/guile-tools.in: Use getopt-long.

commit a27b0f36828baa7a1282fb3595792c21cb4ff9a9
Author: Andy Wingo <address@hidden>
Date:   Thu Jan 27 10:57:18 2011 +0100

    guile-tools uses srfi-1
    
    * meta/guile-tools.in (guile-tools): Use srfi-1 here, now that we can.

commit dce0252bf2b6b25ce825038472b2c3fa811a0164
Author: Andy Wingo <address@hidden>
Date:   Thu Jan 27 10:49:51 2011 +0100

    fix error handling in variable-ref family of instructions
    
    * libguile/vm-i-system.c (variable-ref, variable-set, variable-bound?):
      Check that the argument is actually a variable.  Thanks to Kevin
      Holmes for the report.
    
    * libguile/vm-engine.c (vm_engine): Error handling down here.
    
    * THANKS: Update.

-----------------------------------------------------------------------

Summary of changes:
 THANKS                   |    1 +
 libguile/continuations.c |    4 +-
 libguile/control.c       |    4 +-
 libguile/foreign.c       |    4 +-
 libguile/gsubr.c         |    4 +-
 libguile/objcodes.c      |   17 +++++-----
 libguile/objcodes.h      |   24 +++++++++-----
 libguile/smob.c          |    4 +-
 libguile/vm-engine.c     |    6 ++++
 libguile/vm-i-system.c   |   32 ++++++++++++++++---
 meta/guile-tools.in      |   76 +++++++++++++++++++++++++---------------------
 11 files changed, 108 insertions(+), 68 deletions(-)

diff --git a/THANKS b/THANKS
index cbc3337..a9a14da 100644
--- a/THANKS
+++ b/THANKS
@@ -63,6 +63,7 @@ For fixes or providing information which led to a fix:
           Judy Hawkins
            Jon Herron
             Sam Hocevar
+          Kevin Holmnes
        Patrick Horgan
            Ales Hvezda
          Stefan Israelsson Tampe
diff --git a/libguile/continuations.c b/libguile/continuations.c
index b478963..dc6850e 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,2000,2001,2004, 2006, 2008, 2009, 2010 Free 
Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001,2004, 2006, 2008, 2009, 2010, 2011 
Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -89,7 +89,7 @@ static const type sym##__unaligned[]
 #endif
 
 #define STATIC_OBJCODE_TAG                                      \
-  SCM_PACK (scm_tc7_objcode | (SCM_F_OBJCODE_IS_STATIC << 8))
+  SCM_PACK (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_STATIC, 0))
 
 #define SCM_STATIC_OBJCODE(sym)                                         \
   SCM_DECLARE_STATIC_ALIGNED_ARRAY (scm_t_uint8, sym##__bytecode);      \
diff --git a/libguile/control.c b/libguile/control.c
index 2ab4ce9..b6a5587 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2010  Free Software Foundation, Inc.
+/* Copyright (C) 2010, 2011  Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -99,7 +99,7 @@ static const type sym##__unaligned[]
 #endif
 
 #define STATIC_OBJCODE_TAG                                      \
-  SCM_PACK (scm_tc7_objcode | (SCM_F_OBJCODE_IS_STATIC << 8))
+  SCM_PACK (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_STATIC, 0))
 
 #define SCM_STATIC_OBJCODE(sym)                                         \
   SCM_DECLARE_STATIC_ALIGNED_ARRAY (scm_t_uint8, sym##__bytecode);      \
diff --git a/libguile/foreign.c b/libguile/foreign.c
index 082ec7f..47579af 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2010  Free Software Foundation, Inc.
+/* Copyright (C) 2010, 2011  Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -734,7 +734,7 @@ static const struct
        (setq i (1+ i)))))
 */
 #define STATIC_OBJCODE_TAG                                      \
-  SCM_PACK (scm_tc7_objcode | (SCM_F_OBJCODE_IS_STATIC << 8))
+  SCM_PACK (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_STATIC, 0))
 
 static const struct
 {
diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index ef3ad23..b6f261f 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008, 2009, 2010 
Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008, 2009, 2010, 
2011 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -313,7 +313,7 @@ static const struct
 */
 
 #define STATIC_OBJCODE_TAG                                      \
-  SCM_PACK (scm_tc7_objcode | (SCM_F_OBJCODE_IS_STATIC << 8))
+  SCM_PACK (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_STATIC, 0))
 
 static const struct
 {
diff --git a/libguile/objcodes.c b/libguile/objcodes.c
index 68035f5..b7aa578 100644
--- a/libguile/objcodes.c
+++ b/libguile/objcodes.c
@@ -45,11 +45,11 @@ verify (((sizeof (SCM_OBJCODE_COOKIE) - 1) & 7) == 0);
  */
 
 /* The words in an objcode SCM object are as follows:
-     - scm_tc7_objcode | the flags for this objcode
+     - scm_tc7_objcode | type | flags
      - the struct scm_objcode C object
-     - the parent of this objcode, if this is a slice, or #f if none
-     - the file descriptor this objcode came from if this was mmaped,
-       or 0 if none
+     - the parent of this objcode: either another objcode, a bytevector,
+       or, in the case of mmap types, file descriptors (as an inum)
+     - "native code" -- not currently used.
  */
 
 static SCM
@@ -98,10 +98,9 @@ make_objcode_by_mmap (int fd)
                                                   + data->metalen)));
     }
 
-  sret = scm_double_cell (scm_tc7_objcode | (SCM_F_OBJCODE_IS_MMAP<<8),
+  sret = scm_double_cell (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_MMAP, 0),
                           (scm_t_bits)(addr + strlen (SCM_OBJCODE_COOKIE)),
-                          SCM_UNPACK (SCM_BOOL_F),
-                          (scm_t_bits)fd);
+                          SCM_UNPACK (scm_from_int (fd)), 0);
 
   /* FIXME: we leak ourselves and the file descriptor. but then again so does
      dlopen(). */
@@ -139,7 +138,7 @@ scm_c_make_objcode_slice (SCM parent, const scm_t_uint8 
*ptr)
   assert (SCM_C_OBJCODE_BASE (data) + data->len + data->metalen
          <= parent_base + parent_data->len + parent_data->metalen);
 
-  return scm_double_cell (scm_tc7_objcode | (SCM_F_OBJCODE_IS_SLICE<<8),
+  return scm_double_cell (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_SLICE, 0),
                           (scm_t_bits)data, SCM_UNPACK (parent), 0);
 }
 #undef FUNC_NAME
@@ -198,7 +197,7 @@ SCM_DEFINE (scm_bytecode_to_objcode, "bytecode->objcode", 
1, 0, 0,
 
   /* foolishly, we assume that as long as bytecode is around, that c_bytecode
      will be of the same length; perhaps a bad assumption? */
-  return scm_double_cell (scm_tc7_objcode | (SCM_F_OBJCODE_IS_BYTEVECTOR<<8),
+  return scm_double_cell (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_BYTEVECTOR, 
0),
                           (scm_t_bits)data, SCM_UNPACK (bytecode), 0);
 }
 #undef FUNC_NAME
diff --git a/libguile/objcodes.h b/libguile/objcodes.h
index 2bff9aa..2fc43d5 100644
--- a/libguile/objcodes.h
+++ b/libguile/objcodes.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -35,10 +35,10 @@ struct scm_objcode
 #define SCM_C_OBJCODE_BASE(obj)                                \
   ((scm_t_uint8 *)(obj) + sizeof (struct scm_objcode))
 
-#define SCM_F_OBJCODE_IS_MMAP       (1<<0)
-#define SCM_F_OBJCODE_IS_BYTEVECTOR (1<<1)
-#define SCM_F_OBJCODE_IS_SLICE      (1<<2)
-#define SCM_F_OBJCODE_IS_STATIC     (1<<3)
+#define SCM_OBJCODE_TYPE_MMAP       (0)
+#define SCM_OBJCODE_TYPE_BYTEVECTOR (1)
+#define SCM_OBJCODE_TYPE_SLICE      (2)
+#define SCM_OBJCODE_TYPE_STATIC     (3)
 
 #define SCM_OBJCODE_P(x)       (SCM_NIMP (x) && SCM_TYP7 (x) == 
scm_tc7_objcode)
 #define SCM_OBJCODE_DATA(x)    ((struct scm_objcode *) SCM_CELL_WORD_1 (x))
@@ -49,10 +49,16 @@ struct scm_objcode
 #define SCM_OBJCODE_TOTAL_LEN(x) (SCM_OBJCODE_LEN (x) + SCM_OBJCODE_META_LEN 
(x))
 #define SCM_OBJCODE_BASE(x)    (SCM_C_OBJCODE_BASE (SCM_OBJCODE_DATA (x)))
 
-#define SCM_OBJCODE_FLAGS(x)   (SCM_CELL_WORD_0 (x) >> 8)
-#define SCM_OBJCODE_IS_MMAP(x) (SCM_OBJCODE_FLAGS (x) & SCM_F_OBJCODE_IS_MMAP)
-#define SCM_OBJCODE_IS_BYTEVECTOR(x) (SCM_OBJCODE_FLAGS (x) & 
SCM_F_OBJCODE_IS_BYTEVECTOR)
-#define SCM_OBJCODE_IS_SLICE(x) (SCM_OBJCODE_FLAGS (x) & 
SCM_F_OBJCODE_IS_SLICE)
+#define SCM_MAKE_OBJCODE_TAG(type, flags) (scm_tc7_objcode | (type << 8) | 
(flags << 16))
+#define SCM_OBJCODE_TYPE(x)    ((SCM_CELL_WORD_0 (x) >> 8) & 0xff)
+#define SCM_OBJCODE_FLAGS(x)   (SCM_CELL_WORD_0 (x) >> 16)
+#define SCM_OBJCODE_IS_MMAP(x) (SCM_OBJCODE_TYPE (x) == SCM_OBJCODE_TYPE_MMAP)
+#define SCM_OBJCODE_IS_BYTEVECTOR(x) (SCM_OBJCODE_TYPE (x) == 
SCM_OBJCODE_TYPE_BYTEVECTOR)
+#define SCM_OBJCODE_IS_SLICE(x) (SCM_OBJCODE_TYPE (x) == 
SCM_OBJCODE_TYPE_SLICE)
+#define SCM_OBJCODE_IS_STATIC(x) (SCM_OBJCODE_TYPE (x) == 
SCM_OBJCODE_TYPE_STATIC)
+
+#define SCM_OBJCODE_NATIVE_CODE(x) (SCM_CELL_WORD_3 (x))
+#define SCM_SET_OBJCODE_NATIVE_CODE(x, code) (SCM_SET_CELL_WORD_3 (x, code))
 
 SCM scm_c_make_objcode_slice (SCM parent, const scm_t_uint8 *ptr);
 SCM_API SCM scm_load_objcode (SCM file);
diff --git a/libguile/smob.c b/libguile/smob.c
index 171db8d..adb34ba 100644
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2009, 2010 
Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2009, 2010, 
2011 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -255,7 +255,7 @@ static const struct
 #undef META
 
 #define STATIC_OBJCODE_TAG                                      \
-  SCM_PACK (scm_tc7_objcode | (SCM_F_OBJCODE_IS_STATIC << 8))
+  SCM_PACK (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_STATIC, 0))
 
 static const struct
 {
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 341dbc8..20d9ed2 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -153,6 +153,12 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
                    scm_list_1 (finish_args), SCM_BOOL_F);
     goto vm_error;
 
+  vm_error_not_a_variable:
+    SYNC_ALL ();
+    scm_error (scm_arg_type_key, func_name, "Not a variable: ~S",
+               scm_list_1 (finish_args), scm_list_1 (finish_args));
+    goto vm_error;
+
   vm_error_apply_to_non_list:
     SYNC_ALL ();
     scm_error (scm_arg_type_key, "apply", "Apply to non-list: ~S",
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 5b40c1b..57712ca 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001,2008,2009,2010 Free Software Foundation, Inc.
+/* Copyright (C) 2001,2008,2009,2010,2011 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -300,7 +300,17 @@ VM_DEFINE_INSTRUCTION (25, variable_ref, "variable-ref", 
0, 1, 1)
 {
   SCM x = *sp;
 
-  if (SCM_UNLIKELY (!VARIABLE_BOUNDP (x)))
+  /* We don't use ASSERT_VARIABLE or ASSERT_BOUND_VARIABLE here because,
+     unlike in top-variable-ref, it really isn't an internal assertion
+     that can be optimized out -- the variable could be coming directly
+     from the user.  */
+  if (SCM_UNLIKELY (!SCM_VARIABLEP (x)))
+    {
+      func_name = "variable-ref";
+      finish_args = x;
+      goto vm_error_not_a_variable;
+    }
+  else if (SCM_UNLIKELY (!VARIABLE_BOUNDP (x)))
     {
       SCM var_name;
 
@@ -320,10 +330,16 @@ VM_DEFINE_INSTRUCTION (25, variable_ref, "variable-ref", 
0, 1, 1)
 
 VM_DEFINE_INSTRUCTION (26, variable_bound, "variable-bound?", 0, 1, 1)
 {
-  if (VARIABLE_BOUNDP (*sp))
-    *sp = SCM_BOOL_T;
+  SCM x = *sp;
+  
+  if (SCM_UNLIKELY (!SCM_VARIABLEP (x)))
+    {
+      func_name = "variable-bound?";
+      finish_args = x;
+      goto vm_error_not_a_variable;
+    }
   else
-    *sp = SCM_BOOL_F;
+    *sp = scm_from_bool (VARIABLE_BOUNDP (x));
   NEXT;
 }
 
@@ -398,6 +414,12 @@ VM_DEFINE_INSTRUCTION (30, long_local_set, 
"long-local-set", 2, 1, 0)
 
 VM_DEFINE_INSTRUCTION (31, variable_set, "variable-set", 0, 2, 0)
 {
+  if (SCM_UNLIKELY (!SCM_VARIABLEP (sp[0])))
+    {
+      func_name = "variable-set!";
+      finish_args = sp[0];
+      goto vm_error_not_a_variable;
+    }
   VARIABLE_SET (sp[0], sp[-1]);
   DROPN (2);
   NEXT;
diff --git a/meta/guile-tools.in b/meta/guile-tools.in
index 28ef1ba..cdcb610 100755
--- a/meta/guile-tools.in
+++ b/meta/guile-tools.in
@@ -6,7 +6,7 @@ exec guile $GUILE_FLAGS -e '(@@ (guile-tools) main)' -s "$0" 
"$@"
 ;;;; guile-tools --- running scripts bundled with Guile
 ;;;; Andy Wingo <address@hidden> --- April 2009
 ;;;; 
-;;;;   Copyright (C) 2009, 2010 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -23,7 +23,10 @@ exec guile $GUILE_FLAGS -e '(@@ (guile-tools) main)' -s "$0" 
"$@"
 ;;;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 ;;;; Boston, MA 02110-1301 USA
 
-(define-module (guile-tools))
+(define-module (guile-tools)
+  #:use-module ((srfi srfi-1) #:select (fold append-map))
+  #:autoload (ice-9 format) (format)
+  #:use-module (ice-9 getopt-long))
 
 ;; Hack to provide scripts with the bug-report address.
 (module-define! the-scm-module
@@ -31,13 +34,9 @@ exec guile $GUILE_FLAGS -e '(@@ (guile-tools) main)' -s "$0" 
"$@"
                 "@PACKAGE_BUGREPORT@")
 
 
-;; We can't import srfi-1, unfortunately, as we are used early in the
-;; boot process, before the srfi-1 shlib is built.
-
-(define (fold kons seed seq)
-  (if (null? seq)
-      seed
-      (fold kons (kons (car seq) seed) (cdr seq))))
+(define *option-grammar*
+  '((help (single-char #\h))
+    (version (single-char #\v))))
 
 (define (display-help)
   (display "\
@@ -87,10 +86,6 @@ There is NO WARRANTY, to the extent permitted by law.
         ((equal? (car l) (cadr l)) (unique (cdr l)))
         (else (cons (car l) (unique (cdr l))))))
 
-;; for want of srfi-1
-(define (append-map f l)
-  (apply append (map f l)))
-
 (define (find-submodules head)
   (let ((shead (map symbol->string head)))
     (unique
@@ -112,28 +107,39 @@ There is NO WARRANTY, to the extent permitted by law.
             (find-submodules '(scripts))))
 
 (define (find-script s)
-  (let ((m (resolve-module (append '(scripts) (list (string->symbol s))))))
-    (and (module-public-interface m)
-         m)))
+  (resolve-module (list 'scripts (string->symbol s)) #:ensure #f))
+
+(define (getopt args grammar)
+  (catch 'misc-error
+    (lambda ()
+      (getopt-long args grammar))
+    (lambda (k proc fmt args . extra)
+      (format (current-error-port)
+              "guile-tools: ~?~%" fmt args)
+      (format (current-error-port)
+              "Try `guile-tools --help' for more information.~%")
+      (exit 1))))
 
 (define (main args)
   (setlocale LC_ALL "")
-  (cond
-   ((or (equal? (cdr args) '())
-        (equal? (cdr args) '("list")))
-    (list-scripts))
-   ((string-prefix? "-" (cadr args))
-    (let ((option (cadr args)))
-      (cond
-       ((equal? option "--help")
-        (display-help)
-        (exit 0))
-       ((equal? option "--version")
-        (display-version)
-        (exit 0))
-       (else
-        (format (current-error-port) "Unrecognized option: ~an" option)
-        (exit 1)))))
-   (else
-    (let ((mod (find-script (cadr args))))
-      (exit (apply (module-ref mod 'main) (cddr args)))))))
+  (let* ((options (getopt args *option-grammar*))
+         (args (option-ref options '() '())))
+    (cond
+     ((option-ref options 'help #f)
+      (display-help)
+      (exit 0))
+     ((option-ref options 'version #f)
+      (display-version)
+      (exit 0))
+     ((or (equal? args '())
+          (equal? args '("list")))
+      (list-scripts))
+     ((find-script (car args))
+      => (lambda (mod)
+           (exit (apply (module-ref mod 'main) (cdr args)))))
+     (else
+      (format (current-error-port)
+              "guile-tools: unknown script ~s~%" (car args))
+      (format (current-error-port)
+              "Try `guile-tools --help' for more information.~%")
+      (exit 1)))))


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]