guile-cvs
[Top][All Lists]
Advanced

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

guile/guile-core/ice-9 session.scm optargs.scm ...


From: Marius Vollmer
Subject: guile/guile-core/ice-9 session.scm optargs.scm ...
Date: Wed, 09 May 2001 17:45:24 -0700

CVSROOT:        /cvs
Module name:    guile
Branch:         mvo-vcell-cleanup-1-branch
Changes by:     Marius Vollmer <address@hidden> 01/05/09 17:45:24

Modified files:
        guile-core/ice-9: session.scm optargs.scm format.scm debug.scm 
                          boot-9.scm 

Log message:
        * session.scm (apropos): Do not use `builtin-bindings', always use
        the module obarray.
        (apropos-fold): Likewise.
        
        * optargs.scm (bound?): Removed.  We should not play games with
        the magical undefined value.
        (let-o-k-template): Use `#f' instead of the undefined value as
        the default default for bindings.
        
        * boot-9.scm (module-make-local-var!): Do not pass name hint to
        make-undefined-variable.
        (root-module-closure): Removed.
        (make-root-module): Set the obarray of the module to the
        `pre-modules-obarray'.  Do not use a lazy binder.
        (scm-module-closure): Removed.
        (make-root-module): Set the obarray of the module to the
        `pre-modules-obarray'.  Do not use a lazy binder.  Set the
        eval-closure to a `standard-interface-eval-closure'.
        (module-define!): Do not pass name hint to make-variable.
        (make-modules-in, beautify-user-module, resolve-module): Moved
        towards the beginning of boot-9.scm, across the call to
        set-current-module that boots the module system.  These
        definitions need to be visible at the time of the first
        `set-current-module' call.
        (try-module-autoload): Define a `#f' before the call to
        set-current-module.  It is redefined later.
        
        * debug.scm: Use `module-set!' instead of `variable-set!' to set
        insert `debug-options' into the-root-module.
        * format.scm: Likewise, for `format'.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/ice-9/session.scm.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.25&tr2=1.25.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/ice-9/optargs.scm.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.10&tr2=1.10.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/ice-9/format.scm.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.7&tr2=1.7.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/ice-9/debug.scm.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.19&tr2=1.19.4.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/ice-9/boot-9.scm.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.240&tr2=1.240.2.1&r1=text&r2=text

Patches:
Index: guile/guile-core/ice-9/boot-9.scm
diff -u guile/guile-core/ice-9/boot-9.scm:1.239 
guile/guile-core/ice-9/boot-9.scm:1.240
--- guile/guile-core/ice-9/boot-9.scm:1.239     Tue May  1 17:59:43 2001
+++ guile/guile-core/ice-9/boot-9.scm   Sat May  5 06:41:59 2001
@@ -2582,7 +2582,7 @@
           `((set-module-transformer! (current-module) ,spec)))
      (fluid-set! scm:eval-transformer (module-transformer (current-module))))
     (else
-     (error "use-modules can only be used at the top level"))))
+     (error "use-syntax can only be used at the top level"))))
 
 (define define-private define)
 
Index: guile/guile-core/ice-9/debug.scm
diff -u guile/guile-core/ice-9/debug.scm:1.18 
guile/guile-core/ice-9/debug.scm:1.19
--- guile/guile-core/ice-9/debug.scm:1.18       Sat Sep 11 11:28:12 1999
+++ guile/guile-core/ice-9/debug.scm    Sun Sep 12 04:06:25 1999
@@ -1,4 +1,4 @@
-;;;;   Copyright (C) 1996, 1997, 1998 Free Software Foundation
+;;;;   Copyright (C) 1996, 1997, 1998, 1999 Free Software Foundation
 ;;;; 
 ;;;; 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
Index: guile/guile-core/ice-9/format.scm
diff -u guile/guile-core/ice-9/format.scm:1.6 
guile/guile-core/ice-9/format.scm:1.7
--- guile/guile-core/ice-9/format.scm:1.6       Tue Apr  4 04:40:39 2000
+++ guile/guile-core/ice-9/format.scm   Mon Aug 14 08:40:03 2000
@@ -822,13 +822,17 @@
          (string-append "("
                         (let loop ((obj-list obj)
                                    (visited visited)
-                                   (offset 0))
+                                   (offset 0)
+                                   (prefix ""))
                           (cond ((null? (cdr obj-list))
-                                 (obj->str (car obj-list)
-                                           #t
-                                           (cons (car obj-list) visited)))
+                                 (string-append
+                                  prefix
+                                  (obj->str (car obj-list)
+                                            #t
+                                            (cons (car obj-list) visited))))
                                 ((memq (cdr obj-list) visited)
                                  (string-append
+                                  prefix
                                   (obj->str (car obj-list)
                                             #t
                                             (cons (car obj-list) visited))
@@ -838,16 +842,18 @@
                                       (list-index visited (cdr obj-list))))
                                   "#"))
                                 ((pair? (cdr obj-list))
-                                 (string-append
-                                  (obj->str (car obj-list)
-                                            #t
-                                            (cons (car obj-list) visited))
-                                  " "
-                                  (loop (cdr obj-list)
-                                        (cons (cdr obj-list) visited)
-                                        (+ 1 offset))))
+                                 (loop (cdr obj-list)
+                                       (cons (cdr obj-list) visited)
+                                       (+ 1 offset)
+                                       (string-append
+                                        prefix
+                                        (obj->str (car obj-list)
+                                                  #t
+                                                  (cons (car obj-list) 
visited))
+                                        " ")))
                                 (else
                                  (string-append
+                                  prefix
                                   (obj->str (car obj-list)
                                             #t
                                             (cons (car obj-list) visited))
Index: guile/guile-core/ice-9/optargs.scm
diff -u guile/guile-core/ice-9/optargs.scm:1.9 
guile/guile-core/ice-9/optargs.scm:1.10
--- guile/guile-core/ice-9/optargs.scm:1.9      Mon Mar  5 15:52:09 2001
+++ guile/guile-core/ice-9/optargs.scm  Sat Apr 28 11:58:09 2001
@@ -1,29 +1,27 @@
 ;;;; optargs.scm -- support for optional arguments
 ;;;;
 ;;;;   Copyright (C) 1997, 1998, 1999 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
-;;;; 
+;;;;
 ;;;; Contributed by Maciej Stachowiak <address@hidden>
 
 
 
-(define-module (ice-9 optargs))
-
-
+;;; Commentary:
 
 ;;; {Optional Arguments}
 ;;;
@@ -40,7 +38,7 @@
 ;;;   let-keywords*
 ;;;   lambda*
 ;;;   define*
-;;;   define*-public   
+;;;   define*-public
 ;;;   defmacro*
 ;;;   defmacro*-public
 ;;;
@@ -49,17 +47,19 @@
 ;;; are used to indicate grouping only):
 ;;;
 ;;; ext-param-list ::= [identifier]* [#:optional [ext-var-decl]+]?
-;;;   [#:key [ext-var-decl]+ [#:allow-other-keys]?]? 
+;;;   [#:key [ext-var-decl]+ [#:allow-other-keys]?]?
 ;;;   [[#:rest identifier]|[. identifier]]?
 ;;;
-;;; ext-var-decl ::= identifier | ( identifier expression )  
+;;; ext-var-decl ::= identifier | ( identifier expression )
 ;;;
 ;;; The characters `*', `+' and `?' are not to be taken literally; they
 ;;; mean respectively, zero or more occurences, one or more occurences,
 ;;; and one or zero occurences.
 ;;;
 
+;;; Code:
 
+(define-module (ice-9 optargs))
 
 ;; bound? var
 ;;   Checks if a variable is bound in the current environment.
@@ -71,9 +71,9 @@
 
 (defmacro-public bound? (var)
   `(catch 'misc-error
-         (lambda () 
-           ,var 
-           (not (eq? ,var ,(variable-ref 
+         (lambda ()
+           ,var
+           (not (eq? ,var ,(variable-ref
                            (make-undefined-variable)))))
          (lambda args #f)))
 
@@ -111,7 +111,7 @@
 ;; duplicates keyword args in the rest arg. More explanation of what
 ;; keyword arguments in a lambda list look like can be found below in
 ;; the documentation for lambda*.  Bindings can have the same form as
-;; for let-optional. If allow-other-keys? is false, an error will be 
+;; for let-optional. If allow-other-keys? is false, an error will be
 ;; thrown if anything that looks like a keyword argument but does not
 ;; match a known keyword parameter will result in an error.
 ;;
@@ -127,7 +127,7 @@
 ;; some utility procedures for implementing the various let-forms.
 
 (define (let-o-k-template REST-ARG BINDINGS BODY let-type proc)
-  (let ((bindings (map (lambda (x) 
+  (let ((bindings (map (lambda (x)
                         (if (list? x)
                             x
                             (list x (variable-ref
@@ -139,8 +139,8 @@
     (if (null? BINDINGS)
        `(begin ,@BODY)
        (let-o-k-template REST-ARG BINDINGS BODY let-type
-                         (lambda (optional) 
-                           `(,(car optional) 
+                         (lambda (optional)
+                           `(,(car optional)
                              (cond
                               ((not (null? ,REST-ARG))
                                (let ((result (car ,REST-ARG)))
@@ -157,11 +157,11 @@
               (bindfilter (lambda (key)
                             `(,(car key)
                               (cond
-                               ((assq ',(car key) ,kb-list-gensym) 
+                               ((assq ',(car key) ,kb-list-gensym)
                                 => cdr)
-                               (else 
+                               (else
                                 ,(cadr key)))))))
-         `(let* ((ra->kbl ,rest-arg->keyword-binding-list) 
+         `(let* ((ra->kbl ,rest-arg->keyword-binding-list)
                  (,kb-list-gensym (ra->kbl ,REST-ARG ',(map
                                                         (lambda (x) 
(symbol->keyword (if (pair? x) (car x) x)))
                                                         BINDINGS)
@@ -186,7 +186,7 @@
                    (error "Keyword argument has no value.")
                    (next (cons (cons (keyword->symbol first)
                                      (car rest)) accum))))
-              ((not allow-other-keys?) 
+              ((not allow-other-keys?)
                (error "Unknown keyword in arguments."))
               (else (if (null? rest)
                         accum
@@ -199,7 +199,7 @@
 ;; "#&optional" instead of "#:optional"
 
 (read-hash-extend #\& (lambda (c port)
-                       (display 
+                       (display
                         "WARNING: `#&' is deprecated, use `#:' instead\n"
                         (current-error-port))
                        (case (read port)
@@ -212,7 +212,7 @@
 
 ;; lambda* args . body
 ;;   lambda extended for optional and keyword arguments
-;;   
+;;
 ;; lambda* creates a procedure that takes optional arguments. These
 ;; are specified by putting them inside brackets at the end of the
 ;; paramater list, but before any dotted rest argument. For example,
@@ -232,11 +232,11 @@
 ;; Optional and keyword arguments can also be given default values
 ;; which they take on when they are not present in a call, by giving a
 ;; two-item list in place of an optional argument, for example in:
-;;   (lambda* (foo #:optional (bar 42) #:key (baz 73)) (list foo bar baz)) 
+;;   (lambda* (foo #:optional (bar 42) #:key (baz 73)) (list foo bar baz))
 ;; foo is a fixed argument, bar is an optional argument with default
 ;; value 42, and baz is a keyword argument with default value 73.
 ;; Default value expressions are not evaluated unless they are needed
-;; and until the procedure is called.  
+;; and until the procedure is called.
 ;;
 ;; lambda* now supports two more special parameter list keywords.
 ;;
@@ -259,7 +259,7 @@
 
 
 (defmacro-public lambda* (ARGLIST . BODY)
-  (parse-arglist 
+  (parse-arglist
    ARGLIST
    (lambda (non-optional-args optionals keys aok? rest-arg)
      ; Check for syntax errors.
@@ -281,7 +281,7 @@
                         (string? (car BODY)))
                    (list (car BODY))
                    '())
-             (let-optional* 
+             (let-optional*
               ,rest-gensym
               ,optionals
               (let-keywords* ,rest-gensym
@@ -292,7 +292,7 @@
                                          (error "Too many arguments.")))
                                    '())
                              ,@BODY)))
-          `(lambda (,@non-optional-args . ,(if rest-arg rest-arg '())) 
+          `(lambda (,@non-optional-args . ,(if rest-arg rest-arg '()))
              ,@BODY))))))
 
 
@@ -302,7 +302,7 @@
           (every? pred (cdr lst)))))
 
 (define (ext-decl? obj)
-  (or (symbol? obj) 
+  (or (symbol? obj)
       (and (list? obj) (= 2 (length obj)) (symbol? (car obj)))))
 
 (define (parse-arglist arglist cont)
@@ -311,9 +311,9 @@
      ((memq val lst)
       => (lambda (pos)
           (if (memq val (cdr pos))
-              (error (with-output-to-string 
+              (error (with-output-to-string
                        (lambda ()
-                         (map display `(,val 
+                         (map display `(,val
                                         " specified more than once in argument 
list.")))))
               (cont (reverse (cdr (memq val (reverse lst)))) (cdr pos) #t))))
      (else (cont lst '() #f))))
@@ -325,25 +325,25 @@
           (error "#:optional specified but no optional arguments declared.")
           (cont before after keys aok? rest)))))
   (define (parse-keys arglist rest cont)
-    (split-list-at 
+    (split-list-at
      #:allow-other-keys arglist
      (lambda (aok-before aok-after aok-split?)
        (if (and aok-split? (not (null? aok-after)))
           (error "#:allow-other-keys not at end of keyword argument 
declarations.")
-          (split-list-at 
+          (split-list-at
            #:key aok-before
            (lambda (key-before key-after key-split?)
-             (cond 
+             (cond
               ((and aok-split? (not key-split?))
                (error "#:allow-other-keys specified but no keyword arguments 
declared."))
-              (key-split? 
+              (key-split?
                (cond
                 ((null? key-after) (error "#:key specified but no keyword 
arguments declared."))
                 ((memq #:optional key-after) (error "#:optional arguments 
declared after #:key arguments."))
                 (else (parse-opt-and-fixed key-before key-after aok-split? 
rest cont))))
               (else (parse-opt-and-fixed arglist '() #f rest cont)))))))))
   (define (parse-rest arglist cont)
-    (cond 
+    (cond
      ((null? arglist) (cont '() '() '() #f #f))
      ((not (pair? arglist)) (cont '() '() '() #f arglist))
      ((not (list? arglist))
@@ -354,8 +354,8 @@
            (if (memq #:rest copy)
                (error "Cannot specify both #:rest and dotted rest argument.")
                (parse-keys copy ra cont))))
-     (else (split-list-at 
-           #:rest arglist 
+     (else (split-list-at
+           #:rest arglist
            (lambda (before after split?)
              (if split?
                  (case (length after)
@@ -382,7 +382,7 @@
 ;;   (define-public* ((foo #:optional bar) #:optional baz) '())
 ;; This illustrates currying. A procedure foo is defined, which,
 ;; when called with an optional argument bar, returns a procedure that
-;; takes an optional argument baz. 
+;; takes an optional argument baz.
 ;;
 ;; Of course, define*[-public] also supports #:rest and #:allow-other-keys
 ;; in the same way as lambda*.
@@ -414,7 +414,7 @@
 ;; defmacro* name args . body
 ;; defmacro*-public args . body
 ;;   defmacro and defmacro-public extended for optional and keyword arguments
-;; 
+;;
 ;; These are just like defmacro and defmacro-public except that they
 ;; take lambda*-style extended paramter lists, where #:optional,
 ;; #:key, #:allow-other-keys and #:rest are allowed with the usual
@@ -432,3 +432,5 @@
   `(,DT ,NAME
        (,(lambda (transformer) (defmacro:transformer transformer))
         (lambda* ,ARGLIST ,@BODY))))
+
+;;; optargs.scm ends here
Index: guile/guile-core/ice-9/session.scm
diff -u guile/guile-core/ice-9/session.scm:1.24 
guile/guile-core/ice-9/session.scm:1.25
--- guile/guile-core/ice-9/session.scm:1.24     Fri Apr 27 17:32:23 2001
+++ guile/guile-core/ice-9/session.scm  Fri Apr 27 17:35:02 2001
@@ -167,6 +167,7 @@
   (display "Usage: (help NAME) gives documentation about objects named NAME (a 
symbol)
        (help REGEXP) ditto for objects with names matching REGEXP (a string)
        (help ,EXPR) gives documentation for object returned by EXPR
+       (help (my module)) gives module commentary for `(my module)'
        (help) gives this text
 
 `help' searches among bindings exported from loaded modules, while



reply via email to

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