From 1a179b03b02d7967c9eba7ef6f196fcbfbafa15b Mon Sep 17 00:00:00 2001 From: Mikael Djurfeldt Date: Sun, 21 Oct 2001 09:49:19 +0000 Subject: [PATCH] * lib.scm: Move module the system directives `export', `export-syntax', `re-export' and `re-export-syntax' into the `define-module' form. This is the recommended way of exporting bindings. * srfi-2.scm, srfi-4.scm, srfi-8.scm, srfi-9.scm, srfi-10.scm, srfi-11.scm, srfi-14.scm, srfi-16.scm: Move module the system directives `export', `export-syntax', `re-export' and `re-export-syntax' into the `define-module' form. This is the recommended way of exporting bindings. * goops.scm, goops/active-slot.scm, goops/compile.scm, goops/composite-slot.scm, goops/describe.scm, goops/dispatch.scm, goops/old-define-method.scm, goops/save.scm, goops/util.scm: Move module the system directives `export', `export-syntax', `re-export' and `re-export-syntax' into the `define-module' form. This is the recommended way of exporting bindings. * slib.scm (array-indexes): New procedure. (*features*): Extend. (Probably some of these options should be set elsewhere.) (Thanks to Aubrey Jaffer.) * and-let-star-compat.scm, and-let-star.scm, calling.scm, channel.scm, common-list.scm, debug.scm, debugger.scm, expect.scm, hcons.scm, lineio.scm, ls.scm, mapping.scm, null.scm, optargs.scm, poe.scm, popen.scm, pretty-print.scm, q.scm, r5rs.scm, rdelim.scm, regex.scm, runq.scm, safe-r5rs.scm, safe.scm, session.scm, slib.scm, streams.scm, string-fun.scm, syncase.scm, threads.scm: Move module the system directives `export', `export-syntax', `re-export' and `re-export-syntax' into the `define-module' form. This is the recommended way of exporting bindings. --- ice-9/ChangeLog | 17 +++ ice-9/and-let-star.scm | 5 +- ice-9/calling.scm | 31 ++--- ice-9/channel.scm | 14 ++- ice-9/common-list.scm | 54 +++++---- ice-9/debug.scm | 13 ++- ice-9/debugger.scm | 3 +- ice-9/expect.scm | 28 +++-- ice-9/hcons.scm | 25 ++-- ice-9/lineio.scm | 12 +- ice-9/ls.scm | 16 +-- ice-9/mapping.scm | 67 ++++++----- ice-9/null.scm | 21 ++-- ice-9/optargs.scm | 28 +++-- ice-9/poe.scm | 9 +- ice-9/popen.scm | 16 +-- ice-9/pretty-print.scm | 5 +- ice-9/q.scm | 30 ++--- ice-9/r5rs.scm | 27 ++--- ice-9/rdelim.scm | 8 +- ice-9/regex.scm | 36 +++--- ice-9/runq.scm | 19 +-- ice-9/safe-r5rs.scm | 197 ++++++++++++++++--------------- ice-9/safe.scm | 9 +- ice-9/session.scm | 25 ++-- ice-9/slib.scm | 198 ++++++++++++++++++++------------ ice-9/streams.scm | 17 ++- ice-9/string-fun.scm | 50 ++++---- ice-9/syncase.scm | 68 ++++++----- ice-9/threads.scm | 16 +-- oop/ChangeLog | 9 ++ oop/goops.scm | 92 ++++++++------- oop/goops/active-slot.scm | 5 +- oop/goops/compile.scm | 5 +- oop/goops/composite-slot.scm | 5 +- oop/goops/describe.scm | 5 +- oop/goops/dispatch.scm | 5 +- oop/goops/old-define-method.scm | 3 +- oop/goops/save.scm | 13 +-- oop/goops/util.scm | 7 +- srfi/ChangeLog | 8 ++ srfi/srfi-10.scm | 5 +- srfi/srfi-11.scm | 6 +- srfi/srfi-14.scm | 7 +- srfi/srfi-16.scm | 5 +- srfi/srfi-2.scm | 5 +- srfi/srfi-4.scm | 7 +- srfi/srfi-8.scm | 5 +- srfi/srfi-9.scm | 5 +- test-suite/ChangeLog | 7 ++ test-suite/lib.scm | 7 +- 51 files changed, 705 insertions(+), 575 deletions(-) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index 6218c22f8..c18e49fa2 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,20 @@ +2001-10-21 Mikael Djurfeldt + + * slib.scm (array-indexes): New procedure. + (*features*): Extend. (Probably some of these options should be + set elsewhere.) (Thanks to Aubrey Jaffer.) + + * and-let-star-compat.scm, and-let-star.scm, calling.scm, + channel.scm, common-list.scm, debug.scm, debugger.scm, + expect.scm, hcons.scm, lineio.scm, ls.scm, mapping.scm, + null.scm, optargs.scm, poe.scm, popen.scm, pretty-print.scm, + q.scm, r5rs.scm, rdelim.scm, regex.scm, runq.scm, safe-r5rs.scm, + safe.scm, session.scm, slib.scm, streams.scm, string-fun.scm, + syncase.scm, threads.scm: Move module the system directives + `export', `export-syntax', `re-export' and `re-export-syntax' + into the `define-module' form. This is the recommended way of + exporting bindings. + 2001-10-17 Mikael Djurfeldt * boot-9.scm (process-define-module): New options: :export-syntax, diff --git a/ice-9/and-let-star.scm b/ice-9/and-let-star.scm index 61765f910..472d8b626 100644 --- a/ice-9/and-let-star.scm +++ b/ice-9/and-let-star.scm @@ -42,7 +42,8 @@ ;;;; whether to permit this exception to apply to your modifications. ;;;; If you do not wish that, delete this exception notice. -(define-module (ice-9 and-let-star)) +(define-module (ice-9 and-let-star) + :export-syntax (and-let*)) (defmacro and-let* (vars . body) @@ -68,5 +69,3 @@ (error "not a proper list" vars)))) (expand vars body)) - -(export-syntax and-let*) diff --git a/ice-9/calling.scm b/ice-9/calling.scm index 3f2f57b65..7785391bd 100644 --- a/ice-9/calling.scm +++ b/ice-9/calling.scm @@ -1,6 +1,6 @@ ;;;; calling.scm --- Calling Conventions ;;;; -;;;; Copyright (C) 1995, 1996, 1997, 2000 Free Software Foundation, Inc. +;;;; Copyright (C) 1995, 1996, 1997, 2000, 2001 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 @@ -42,7 +42,15 @@ ;;;; If you do not wish that, delete this exception notice. ;;;; -(define-module (ice-9 calling)) +(define-module (ice-9 calling) + :export-syntax (with-excursion-function + with-getter-and-setter + with-getter + with-delegating-getter-and-setter + with-excursion-getter-and-setter + with-configuration-getter-and-setter + with-delegating-configuration-getter-and-setter + let-with-configuration-getter-and-setter)) ;;;; ;;; @@ -62,7 +70,7 @@ ;;; entering and leaving the call to proc non-locally, such as using ;;; call-with-current-continuation, error, or throw. ;;; -(defmacro-public with-excursion-function (vars proc) +(defmacro with-excursion-function (vars proc) `(,proc ,(excursion-function-syntax vars))) @@ -107,7 +115,7 @@ ;;; ;; takes its arguments in a different order. ;;; ;;; -(defmacro-public with-getter-and-setter (vars proc) +(defmacro with-getter-and-setter (vars proc) `(,proc ,@ (getter-and-setter-syntax vars))) ;;; with-getter vars proc @@ -115,7 +123,7 @@ ;;; The procedure is called: ;;; (proc getter) ;;; -(defmacro-public with-getter (vars proc) +(defmacro with-getter (vars proc) `(,proc ,(car (getter-and-setter-syntax vars)))) @@ -132,7 +140,7 @@ ;;; proc is a procedure that is called ;;; (proc getter setter) ;;; -(defmacro-public with-delegating-getter-and-setter (vars get-delegate set-delegate proc) +(defmacro with-delegating-getter-and-setter (vars get-delegate set-delegate proc) `(,proc ,@ (delegating-getter-and-setter-syntax vars get-delegate set-delegate))) @@ -146,7 +154,7 @@ ;;; with-getter-and-setter ;;; with-excursion-function ;;; -(defmacro-public with-excursion-getter-and-setter (vars proc) +(defmacro with-excursion-getter-and-setter (vars proc) `(,proc ,(excursion-function-syntax vars) ,@ (getter-and-setter-syntax vars))) @@ -272,7 +280,7 @@ ;;; for the corresponding variable. If omitted, the binding of ;;; is simply set using set!. ;;; -(defmacro-public with-configuration-getter-and-setter (vars-etc proc) +(defmacro with-configuration-getter-and-setter (vars-etc proc) `((lambda (simpler-get simpler-set body-proc) (with-delegating-getter-and-setter () simpler-get simpler-set body-proc)) @@ -295,7 +303,7 @@ ,proc)) -(defmacro-public with-delegating-configuration-getter-and-setter (vars-etc delegate-get delegate-set proc) +(defmacro with-delegating-configuration-getter-and-setter (vars-etc delegate-get delegate-set proc) `((lambda (simpler-get simpler-set body-proc) (with-delegating-getter-and-setter () simpler-get simpler-set body-proc)) @@ -337,10 +345,7 @@ ;;; ...) ;;; (with-configuration-getter-and-setter (( v1-get v1-set) ...) proc)) ;;; -(defmacro-public let-with-configuration-getter-and-setter (vars-etc proc) +(defmacro let-with-configuration-getter-and-setter (vars-etc proc) `(let ,(map (lambda (v) `(,(car v) ,(cadr v))) vars-etc) (with-configuration-getter-and-setter ,(map (lambda (v) `(,(car v) ,(caddr v) ,(cadddr v))) vars-etc) ,proc))) - - - diff --git a/ice-9/channel.scm b/ice-9/channel.scm index e3527d441..0ca2fcf3a 100644 --- a/ice-9/channel.scm +++ b/ice-9/channel.scm @@ -95,7 +95,11 @@ ;;; Code: -(define-module (ice-9 channel)) +(define-module (ice-9 channel) + :export (make-object-channel + channel-open + channel-print-value + channel-print-token)) ;;; ;;; Channel type @@ -106,7 +110,7 @@ (define make-channel (record-constructor channel-type)) -(define-public (make-object-channel printer) +(define (make-object-channel printer) (make-channel (current-input-port) (current-output-port) printer @@ -121,7 +125,7 @@ ;;; Channel ;;; -(define-public (channel-open ch) +(define (channel-open ch) (let ((stdin (channel-stdin ch)) (stdout (channel-stdout ch)) (printer (channel-printer ch)) @@ -155,10 +159,10 @@ (list key (apply format #f (cadr args) (caddr args)))) (loop)))))))) -(define-public (channel-print-value ch val) +(define (channel-print-value ch val) (format (channel-stdout ch) "value = ~S\n" val)) -(define-public (channel-print-token ch val) +(define (channel-print-token ch val) (let* ((token (symbol-append (gensym "%%") '%%)) (pair (cons token (object->string val)))) (format (channel-stdout ch) "token = ~S\n" pair) diff --git a/ice-9/common-list.scm b/ice-9/common-list.scm index a8b775cef..29fa0e536 100644 --- a/ice-9/common-list.scm +++ b/ice-9/common-list.scm @@ -75,7 +75,11 @@ ;;; Code: -(define-module (ice-9 common-list)) +(define-module (ice-9 common-list) + :export (adjoin union intersection set-difference reduce-init reduce + some every notany notevery count-if find-if member-if remove-if + remove-if-not delete-if! delete-if-not! butlast and? or? + has-duplicates? pick pick-mappings uniq)) ;;"comlist.scm" Implementation of COMMON LISP list functions for Scheme ; Copyright (C) 1991, 1993, 1995 Aubrey Jaffer. @@ -96,11 +100,11 @@ ;promotional, or sales literature without prior written consent in ;each case. -(define-public (adjoin e l) +(define (adjoin e l) "Return list L, possibly with element E added if it is not already in L." (if (memq e l) l (cons e l))) -(define-public (union l1 l2) +(define (union l1 l2) "Return a new list that is the union of L1 and L2. Elements that occur in both lists occur only once in the result list." @@ -108,7 +112,7 @@ the result list." ((null? l2) l1) (else (union (cdr l1) (adjoin (car l1) l2))))) -(define-public (intersection l1 l2) +(define (intersection l1 l2) "Return a new list that is the intersection of L1 and L2. Only elements that occur in both lists occur in the result list." (if (null? l2) l2 @@ -117,20 +121,20 @@ Only elements that occur in both lists occur in the result list." ((memv (car l1) l2) (loop (cdr l1) (cons (car l1) result))) (else (loop (cdr l1) result)))))) -(define-public (set-difference l1 l2) +(define (set-difference l1 l2) "Return elements from list L1 that are not in list L2." (let loop ((l1 l1) (result '())) (cond ((null? l1) (reverse! result)) ((memv (car l1) l2) (loop (cdr l1) result)) (else (loop (cdr l1) (cons (car l1) result)))))) -(define-public (reduce-init p init l) +(define (reduce-init p init l) "Same as `reduce' except it implicitly inserts INIT at the start of L." (if (null? l) init (reduce-init p (p init (car l)) (cdr l)))) -(define-public (reduce p l) +(define (reduce p l) "Combine all the elements of sequence L using a binary operation P. The combination is left-associative. For example, using +, one can add up all the elements. `reduce' allows you to apply a function which @@ -140,7 +144,7 @@ programmers usually refer to this as foldl." ((null? (cdr l)) (car l)) (else (reduce-init p (car l) (cdr l))))) -(define-public (some pred l . rest) +(define (some pred l . rest) "PRED is a boolean function of as many arguments as there are list arguments to `some', i.e., L plus any optional arguments. PRED is applied to successive elements of the list arguments in order. As soon @@ -156,7 +160,7 @@ All the lists should have the same length." (or (apply pred (car l) (map car rest)) (mapf (cdr l) (map cdr rest)))))))) -(define-public (every pred l . rest) +(define (every pred l . rest) "Return #t iff every application of PRED to L, etc., returns #t. Analogous to `some' except it returns #t if every application of PRED is #t and #f otherwise." @@ -169,39 +173,39 @@ PRED is #t and #f otherwise." (and (apply pred (car l) (map car rest)) (mapf (cdr l) (map cdr rest)))))))) -(define-public (notany pred . ls) +(define (notany pred . ls) "Return #t iff every application of PRED to L, etc., returns #f. Analogous to some but returns #t if no application of PRED returns a true value or #f as soon as any one does." (not (apply some pred ls))) -(define-public (notevery pred . ls) +(define (notevery pred . ls) "Return #t iff there is an application of PRED to L, etc., that returns #f. Analogous to some but returns #t as soon as an application of PRED returns #f, or #f otherwise." (not (apply every pred ls))) -(define-public (count-if pred l) +(define (count-if pred l) "Return the number of elements in L for which (PRED element) returns true." (let loop ((n 0) (l l)) (cond ((null? l) n) ((pred (car l)) (loop (+ n 1) (cdr l))) (else (loop n (cdr l)))))) -(define-public (find-if pred l) +(define (find-if pred l) "Search for the first element in L for which (PRED element) returns true. If found, return that element, otherwise return #f." (cond ((null? l) #f) ((pred (car l)) (car l)) (else (find-if pred (cdr l))))) -(define-public (member-if pred l) +(define (member-if pred l) "Return the first sublist of L for whose car PRED is true." (cond ((null? l) #f) ((pred (car l)) l) (else (member-if pred (cdr l))))) -(define-public (remove-if pred l) +(define (remove-if pred l) "Remove all elements from L where (PRED element) is true. Return everything that's left." (let loop ((l l) (result '())) @@ -209,7 +213,7 @@ Return everything that's left." ((pred (car l)) (loop (cdr l) result)) (else (loop (cdr l) (cons (car l) result)))))) -(define-public (remove-if-not pred l) +(define (remove-if-not pred l) "Remove all elements from L where (PRED element) is #f. Return everything that's left." (let loop ((l l) (result '())) @@ -217,7 +221,7 @@ Return everything that's left." ((not (pred (car l))) (loop (cdr l) result)) (else (loop (cdr l) (cons (car l) result)))))) -(define-public (delete-if! pred l) +(define (delete-if! pred l) "Destructive version of `remove-if'." (let delete-if ((l l)) (cond ((null? l) '()) @@ -226,7 +230,7 @@ Return everything that's left." (set-cdr! l (delete-if (cdr l))) l)))) -(define-public (delete-if-not! pred l) +(define (delete-if-not! pred l) "Destructive version of `remove-if-not'." (let delete-if-not ((l l)) (cond ((null? l) '()) @@ -235,7 +239,7 @@ Return everything that's left." (set-cdr! l (delete-if-not (cdr l))) l)))) -(define-public (butlast lst n) +(define (butlast lst n) "Return all but the last N elements of LST." (letrec ((l (- (length lst) n)) (bl (lambda (lst n) @@ -247,25 +251,25 @@ Return everything that's left." (error "negative argument to butlast" n) l)))) -(define-public (and? . args) +(define (and? . args) "Return #t iff all of ARGS are true." (cond ((null? args) #t) ((car args) (apply and? (cdr args))) (else #f))) -(define-public (or? . args) +(define (or? . args) "Return #t iff any of ARGS is true." (cond ((null? args) #f) ((car args) #t) (else (apply or? (cdr args))))) -(define-public (has-duplicates? lst) +(define (has-duplicates? lst) "Return #t iff 2 members of LST are equal?, else #f." (cond ((null? lst) #f) ((member (car lst) (cdr lst)) #t) (else (has-duplicates? (cdr lst))))) -(define-public (pick p l) +(define (pick p l) "Apply P to each element of L, returning a list of elts for which P returns a non-#f value." (let loop ((s '()) @@ -275,7 +279,7 @@ for which P returns a non-#f value." ((p (car l)) (loop (cons (car l) s) (cdr l))) (else (loop s (cdr l)))))) -(define-public (pick-mappings p l) +(define (pick-mappings p l) "Apply P to each element of L, returning a list of the non-#f return values of P." (let loop ((s '()) @@ -285,7 +289,7 @@ non-#f return values of P." ((p (car l)) => (lambda (mapping) (loop (cons mapping s) (cdr l)))) (else (loop s (cdr l)))))) -(define-public (uniq l) +(define (uniq l) "Return a list containing elements of L, with duplicates removed." (let loop ((acc '()) (l l)) diff --git a/ice-9/debug.scm b/ice-9/debug.scm index bec2068b8..56729952d 100644 --- a/ice-9/debug.scm +++ b/ice-9/debug.scm @@ -44,12 +44,13 @@ ;;;; -(define-module (ice-9 debug)) +(define-module (ice-9 debug) + :export (frame-number->index trace untrace trace-stack untrace-stack)) ;;; {Misc} ;;; -(define-public (frame-number->index n . stack) +(define (frame-number->index n . stack) (let ((stack (if (null? stack) (fluid-ref the-last-stack) (car stack)))) @@ -66,7 +67,7 @@ ;;; (define traced-procedures '()) -(define-public (trace . args) +(define (trace . args) (if (null? args) (nameify traced-procedures) (begin @@ -87,7 +88,7 @@ (debug-enable 'trace) (nameify args)))) -(define-public (untrace . args) +(define (untrace . args) (if (and (null? args) (not (null? traced-procedures))) (apply untrace traced-procedures) @@ -112,7 +113,7 @@ (define traced-stack-ids (list 'repl-stack)) (define trace-all-stacks? #f) -(define-public (trace-stack id) +(define (trace-stack id) "Add ID to the set of stack ids for which tracing is active. If `#t' is in this set, tracing is active regardless of stack context. To remove ID again, use `untrace-stack'. If you add the same ID twice @@ -120,7 +121,7 @@ using `trace-stack', you will need to remove it twice." (set! traced-stack-ids (cons id traced-stack-ids)) (set! trace-all-stacks? (memq #t traced-stack-ids))) -(define-public (untrace-stack id) +(define (untrace-stack id) "Remove ID from the set of stack ids for which tracing is active." (set! traced-stack-ids (delq1! id traced-stack-ids)) (set! trace-all-stacks? (memq #t traced-stack-ids))) diff --git a/ice-9/debugger.scm b/ice-9/debugger.scm index f98509c2c..e65da390b 100644 --- a/ice-9/debugger.scm +++ b/ice-9/debugger.scm @@ -44,6 +44,7 @@ (define-module (ice-9 debugger) :use-module (ice-9 debug) :use-module (ice-9 format) + :export (debug) :no-backtrace ) @@ -54,7 +55,7 @@ (define debugger-prompt "debug> ") -(define-public (debug) +(define (debug) (let ((stack (fluid-ref the-last-stack))) (if stack (let ((state (make-state stack 0))) diff --git a/ice-9/expect.scm b/ice-9/expect.scm index 0fb55b7b7..ba12b2ab0 100644 --- a/ice-9/expect.scm +++ b/ice-9/expect.scm @@ -53,22 +53,26 @@ ;;; Code: (define-module (ice-9 expect) - :use-module (ice-9 regex)) + :use-module (ice-9 regex) + :export-syntax (expect expect-strings) + :export (expect-port expect-timeout expect-timeout-proc + expect-eof-proc expect-char-proc expect-strings-compile-flags + expect-strings-exec-flags expect-select expect-regexec)) ;;; Expect: a macro for selecting actions based on what it reads from a port. ;;; The idea is from Don Libes' expect based on Tcl. ;;; This version by Gary Houston incorporating ideas from Aubrey Jaffer. -(define-public expect-port #f) -(define-public expect-timeout #f) -(define-public expect-timeout-proc #f) -(define-public expect-eof-proc #f) -(define-public expect-char-proc #f) +(define expect-port #f) +(define expect-timeout #f) +(define expect-timeout-proc #f) +(define expect-eof-proc #f) +(define expect-char-proc #f) ;;; expect: each test is a procedure which is applied to the accumulating ;;; string. -(defmacro-public expect clauses +(defmacro expect clauses (let ((s (gensym)) (c (gensym)) (port (gensym)) @@ -134,12 +138,12 @@ (next-char))))))))))) -(define-public expect-strings-compile-flags regexp/newline) -(define-public expect-strings-exec-flags regexp/noteol) +(define expect-strings-compile-flags regexp/newline) +(define expect-strings-exec-flags regexp/noteol) ;;; the regexec front-end to expect: ;;; each test must evaluate to a regular expression. -(defmacro-public expect-strings clauses +(defmacro expect-strings clauses `(let ,@(let next-test ((tests (map car clauses)) (exprs (map cdr clauses)) (defs '()) @@ -162,7 +166,7 @@ ;;; simplified select: returns #t if input is waiting or #f if timed out or ;;; select was interrupted by a signal. ;;; timeout is an absolute time in floating point seconds. -(define-public (expect-select port timeout) +(define (expect-select port timeout) (let* ((secs-usecs (gettimeofday)) (relative (- timeout (car secs-usecs) @@ -175,7 +179,7 @@ ;;; match a string against a regexp, returning a list of strings (required ;;; by the => syntax) or #f. called once each time a character is added ;;; to s (eof? will be #f), and once when eof is reached (with eof? #t). -(define-public (expect-regexec rx s eof?) +(define (expect-regexec rx s eof?) ;; if expect-strings-exec-flags contains regexp/noteol, ;; remove it for the eof test. (let* ((flags (if (and eof? diff --git a/ice-9/hcons.scm b/ice-9/hcons.scm index 1b20a5362..811f9fd48 100644 --- a/ice-9/hcons.scm +++ b/ice-9/hcons.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 1995, 1996, 1998 Free Software Foundation, Inc. +;;;; Copyright (C) 1995, 1996, 1998, 2001 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 @@ -43,7 +43,10 @@ ;;;; -(define-module (ice-9 hcons)) +(define-module (ice-9 hcons) + :export (hashq-cons-hash hashq-cons-assoc hashq-cons-get-handle + hashq-cons-create-handle! hashq-cons-ref hashq-cons-set! hashq-cons + hashq-conser make-gc-buffer)) ;;; {Eq? hash-consing} @@ -54,12 +57,12 @@ ;;; A hash conser does not contribute life to the pairs it returns. ;;; -(define-public (hashq-cons-hash pair n) +(define (hashq-cons-hash pair n) (modulo (logxor (hashq (car pair) 4194303) (hashq (cdr pair) 4194303)) n)) -(define-public (hashq-cons-assoc key l) +(define (hashq-cons-assoc key l) (and (not (null? l)) (or (and (pair? l) ; If not a pair, use its cdr? (pair? (car l)) @@ -69,22 +72,22 @@ (car l)) (hashq-cons-assoc key (cdr l))))) -(define-public (hashq-cons-get-handle table key) +(define (hashq-cons-get-handle table key) (hashx-get-handle hashq-cons-hash hashq-cons-assoc table key #f)) -(define-public (hashq-cons-create-handle! table key init) +(define (hashq-cons-create-handle! table key init) (hashx-create-handle! hashq-cons-hash hashq-cons-assoc table key init)) -(define-public (hashq-cons-ref table key) +(define (hashq-cons-ref table key) (hashx-ref hashq-cons-hash hashq-cons-assoc table key #f)) -(define-public (hashq-cons-set! table key val) +(define (hashq-cons-set! table key val) (hashx-set! hashq-cons-hash hashq-cons-assoc table key val)) -(define-public (hashq-cons table a d) +(define (hashq-cons table a d) (car (hashq-cons-create-handle! table (cons a d) #f))) -(define-public (hashq-conser hash-tab-or-size) +(define (hashq-conser hash-tab-or-size) (let ((table (if (vector? hash-tab-or-size) hash-tab-or-size (make-doubly-weak-hash-table hash-tab-or-size)))) @@ -93,7 +96,7 @@ -(define-public (make-gc-buffer n) +(define (make-gc-buffer n) (let ((ring (make-list n #f))) (append! ring ring) (lambda (next) diff --git a/ice-9/lineio.scm b/ice-9/lineio.scm index b45cf0d52..c18e87f7e 100644 --- a/ice-9/lineio.scm +++ b/ice-9/lineio.scm @@ -45,7 +45,9 @@ (define-module (ice-9 lineio) - :use-module (ice-9 readline)) + :use-module (ice-9 readline) + :export (unread-string read-string lineio-port? + make-line-buffering-input-port)) ;;; {Line Buffering Input Ports} @@ -77,15 +79,15 @@ ;; 'unread-string and 'read-string properties, bound to hooks ;; implementing these functions. ;; -(define-public (unread-string str line-buffering-input-port) +(define (unread-string str line-buffering-input-port) ((object-property line-buffering-input-port 'unread-string) str)) ;; -(define-public (read-string line-buffering-input-port) +(define (read-string line-buffering-input-port) ((object-property line-buffering-input-port 'read-string))) -(define-public (lineio-port? port) +(define (lineio-port? port) (not (not (object-property port 'read-string)))) ;; make-line-buffering-input-port port @@ -96,7 +98,7 @@ ;; to read-char, read-string, and unread-string. ;; -(define-public (make-line-buffering-input-port underlying-port) +(define (make-line-buffering-input-port underlying-port) (let* (;; buffers - a list of strings put back by unread-string or cached ;; using read-line. ;; diff --git a/ice-9/ls.scm b/ice-9/ls.scm index 60c765eb9..37cdaf019 100644 --- a/ice-9/ls.scm +++ b/ice-9/ls.scm @@ -1,6 +1,6 @@ ;;;; ls.scm --- functions for browsing modules ;;;; -;;;; Copyright (C) 1995, 1996, 1997, 1999 Free Software Foundation, Inc. +;;;; Copyright (C) 1995, 1996, 1997, 1999, 2001 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 @@ -43,7 +43,9 @@ ;;;; (define-module (ice-9 ls) - :use-module (ice-9 common-list)) + :use-module (ice-9 common-list) + :export (local-definitions-in definitions-in ls lls + recursive-local-define)) ;;;; ;;; local-definitions-in root name @@ -76,7 +78,7 @@ ;;; ;;; Analogous to `ls', but with local definitions only. -(define-public (local-definitions-in root names) +(define (local-definitions-in root names) (let ((m (nested-ref root names)) (answer '())) (if (not (module? m)) @@ -84,7 +86,7 @@ (module-for-each (lambda (k v) (set! answer (cons k answer))) m)) answer)) -(define-public (definitions-in root names) +(define (definitions-in root names) (let ((m (nested-ref root names))) (if (not (module? m)) m @@ -93,7 +95,7 @@ (map (lambda (m2) (definitions-in m2 '())) (module-uses m))))))) -(define-public (ls . various-refs) +(define (ls . various-refs) (if (pair? various-refs) (if (cdr various-refs) (map (lambda (ref) @@ -102,7 +104,7 @@ (definitions-in (current-module) (car various-refs))) (definitions-in (current-module) '()))) -(define-public (lls . various-refs) +(define (lls . various-refs) (if (pair? various-refs) (if (cdr various-refs) (map (lambda (ref) @@ -111,7 +113,7 @@ (local-definitions-in (current-module) (car various-refs))) (local-definitions-in (current-module) '()))) -(define-public (recursive-local-define name value) +(define (recursive-local-define name value) (let ((parent (reverse! (cdr (reverse name))))) (and parent (make-modules-in (current-module) parent)) (local-define name value))) diff --git a/ice-9/mapping.scm b/ice-9/mapping.scm index 3630147ab..34820ee4f 100644 --- a/ice-9/mapping.scm +++ b/ice-9/mapping.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 1996 Free Software Foundation, Inc. +;;;; Copyright (C) 1996, 2001 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 @@ -45,46 +45,53 @@ (define-module (ice-9 mapping) - :use-module (ice-9 poe)) - -(define-public mapping-hooks-type (make-record-type 'mapping-hooks '(get-handle - create-handle - remove))) - - -(define-public make-mapping-hooks (perfect-funcq 17 (record-constructor mapping-hooks-type))) -(define-public mapping-hooks? (record-predicate mapping-hooks-type)) -(define-public mapping-hooks-get-handle (record-accessor mapping-hooks-type 'get-handle)) -(define-public mapping-hooks-create-handle (record-accessor mapping-hooks-type 'create-handle)) -(define-public mapping-hooks-remove (record-accessor mapping-hooks-type 'remove)) - -(define-public mapping-type (make-record-type 'mapping '(hooks data))) -(define-public make-mapping (record-constructor mapping-type)) -(define-public mapping? (record-predicate mapping-type)) -(define-public mapping-hooks (record-accessor mapping-type 'hooks)) -(define-public mapping-data (record-accessor mapping-type 'data)) -(define-public set-mapping-hooks! (record-modifier mapping-type 'hooks)) -(define-public set-mapping-data! (record-modifier mapping-type 'data)) - -(define-public (mapping-get-handle map key) + :use-module (ice-9 poe) + :export (mapping-hooks-type make-mapping-hooks mapping-hooks? + mapping-hooks-get-handle mapping-hooks-create-handle + mapping-hooks-remove mapping-type make-mapping mapping? + mapping-hooks mapping-data set-mapping-hooks! set-mapping-data! + mapping-get-handle mapping-create-handle! mapping-remove! + mapping-ref mapping-set! hash-table-mapping-hooks + make-hash-table-mapping hash-table-mapping)) + +(define mapping-hooks-type (make-record-type 'mapping-hooks '(get-handle + create-handle + remove))) + + +(define make-mapping-hooks (perfect-funcq 17 (record-constructor mapping-hooks-type))) +(define mapping-hooks? (record-predicate mapping-hooks-type)) +(define mapping-hooks-get-handle (record-accessor mapping-hooks-type 'get-handle)) +(define mapping-hooks-create-handle (record-accessor mapping-hooks-type 'create-handle)) +(define mapping-hooks-remove (record-accessor mapping-hooks-type 'remove)) + +(define mapping-type (make-record-type 'mapping '(hooks data))) +(define make-mapping (record-constructor mapping-type)) +(define mapping? (record-predicate mapping-type)) +(define mapping-hooks (record-accessor mapping-type 'hooks)) +(define mapping-data (record-accessor mapping-type 'data)) +(define set-mapping-hooks! (record-modifier mapping-type 'hooks)) +(define set-mapping-data! (record-modifier mapping-type 'data)) + +(define (mapping-get-handle map key) ((mapping-hooks-get-handle (mapping-hooks map)) map key)) -(define-public (mapping-create-handle! map key . opts) +(define (mapping-create-handle! map key . opts) (apply (mapping-hooks-create-handle (mapping-hooks map)) map key opts)) -(define-public (mapping-remove! map key) +(define (mapping-remove! map key) ((mapping-hooks-remove (mapping-hooks map)) map key)) -(define-public (mapping-ref map key . dflt) +(define (mapping-ref map key . dflt) (cond ((mapping-get-handle map key) => cdr) (dflt => car) (else #f))) -(define-public (mapping-set! map key val) +(define (mapping-set! map key val) (set-cdr! (mapping-create-handle! map key #f) val)) -(define-public hash-table-mapping-hooks +(define hash-table-mapping-hooks (let ((wrap (lambda (proc) (lambda (1st . rest) (apply proc (mapping-data 1st) rest))))) (perfect-funcq 17 @@ -114,10 +121,10 @@ (lambda (table key) (hashx-get-handle hash-proc assoc-proc delete-proc table key))))))))))) -(define-public (make-hash-table-mapping table hash-proc assoc-proc delete-proc) +(define (make-hash-table-mapping table hash-proc assoc-proc delete-proc) (make-mapping (hash-table-mapping-hooks hash-proc assoc-proc delete-proc) table)) -(define-public (hash-table-mapping . options) +(define (hash-table-mapping . options) (let* ((size (or (and options (number? (car options)) (car options)) 71)) (hash-proc (or (kw-arg-ref options :hash-proc) hash)) diff --git a/ice-9/null.scm b/ice-9/null.scm index 30f785a4f..2ca35529c 100644 --- a/ice-9/null.scm +++ b/ice-9/null.scm @@ -43,19 +43,18 @@ ;;;; The null environment - only syntactic bindings (define-module (ice-9 null) - :use-module (ice-9 syncase)) - -(re-export define quote lambda if set! + :use-module (ice-9 syncase) + :re-export-syntax (define quote lambda if set! - cond case and or - - let let* letrec + cond case and or + + let let* letrec - begin do + begin do - delay + delay - quasiquote + quasiquote - define-syntax - let-syntax letrec-syntax) + define-syntax + let-syntax letrec-syntax)) diff --git a/ice-9/optargs.scm b/ice-9/optargs.scm index 47e1a5045..bbeab8cf4 100644 --- a/ice-9/optargs.scm +++ b/ice-9/optargs.scm @@ -82,7 +82,15 @@ ;;; Code: -(define-module (ice-9 optargs)) +(define-module (ice-9 optargs) + :export-syntax (let-optional + let-optional* + let-keywords + let-keywords* + define* lambda* + define*-public + defmacro* + defmacro*-public)) ;; let-optional rest-arg (binding ...) . body ;; let-optional* rest-arg (binding ...) . body @@ -100,10 +108,10 @@ ;; bound to whatever may have been left of rest-arg. ;; -(defmacro-public let-optional (REST-ARG BINDINGS . BODY) +(defmacro let-optional (REST-ARG BINDINGS . BODY) (let-optional-template REST-ARG BINDINGS BODY 'let)) -(defmacro-public let-optional* (REST-ARG BINDINGS . BODY) +(defmacro let-optional* (REST-ARG BINDINGS . BODY) (let-optional-template REST-ARG BINDINGS BODY 'let*)) @@ -123,10 +131,10 @@ ;; -(defmacro-public let-keywords (REST-ARG ALLOW-OTHER-KEYS? BINDINGS . BODY) +(defmacro let-keywords (REST-ARG ALLOW-OTHER-KEYS? BINDINGS . BODY) (let-keywords-template REST-ARG ALLOW-OTHER-KEYS? BINDINGS BODY 'let)) -(defmacro-public let-keywords* (REST-ARG ALLOW-OTHER-KEYS? BINDINGS . BODY) +(defmacro let-keywords* (REST-ARG ALLOW-OTHER-KEYS? BINDINGS . BODY) (let-keywords-template REST-ARG ALLOW-OTHER-KEYS? BINDINGS BODY 'let*)) @@ -248,7 +256,7 @@ ;; Lisp dialects. -(defmacro-public lambda* (ARGLIST . BODY) +(defmacro lambda* (ARGLIST . BODY) (parse-arglist ARGLIST (lambda (non-optional-args optionals keys aok? rest-arg) @@ -387,10 +395,10 @@ ;; Of course, define*[-public] also supports #:rest and #:allow-other-keys ;; in the same way as lambda*. -(defmacro-public define* (ARGLIST . BODY) +(defmacro define* (ARGLIST . BODY) (define*-guts 'define ARGLIST BODY)) -(defmacro-public define*-public (ARGLIST . BODY) +(defmacro define*-public (ARGLIST . BODY) (define*-guts 'define-public ARGLIST BODY)) ;; The guts of define* and define*-public. @@ -421,10 +429,10 @@ ;; semantics. Here is an example of a macro with an optional argument: ;; (defmacro* transmorgify (a #:optional b) -(defmacro-public defmacro* (NAME ARGLIST . BODY) +(defmacro defmacro* (NAME ARGLIST . BODY) (defmacro*-guts 'define NAME ARGLIST BODY)) -(defmacro-public defmacro*-public (NAME ARGLIST . BODY) +(defmacro defmacro*-public (NAME ARGLIST . BODY) (defmacro*-guts 'define-public NAME ARGLIST BODY)) ;; The guts of defmacro* and defmacro*-public diff --git a/ice-9/poe.scm b/ice-9/poe.scm index 91acd1195..96133c764 100644 --- a/ice-9/poe.scm +++ b/ice-9/poe.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 1996 Free Software Foundation, Inc. +;;;; Copyright (C) 1996, 2001 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 @@ -44,7 +44,8 @@ (define-module (ice-9 poe) - :use-module (ice-9 hcons)) + :use-module (ice-9 hcons) + :export (pure-funcq perfect-funcq)) @@ -95,7 +96,7 @@ -(define-public (pure-funcq base-func) +(define (pure-funcq base-func) (lambda args (let ((cached (hashx-get-handle funcq-hash funcq-assoc funcq-memo (cons base-func args)))) (if cached @@ -117,7 +118,7 @@ ;;; funcq never does. ;;; -(define-public (perfect-funcq size base-func) +(define (perfect-funcq size base-func) (define funcq-memo (make-hash-table size)) (lambda args diff --git a/ice-9/popen.scm b/ice-9/popen.scm index 62846ff6c..2a3bdd605 100644 --- a/ice-9/popen.scm +++ b/ice-9/popen.scm @@ -1,6 +1,6 @@ ;; popen emulation, for non-stdio based ports. -;;;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +;;;; Copyright (C) 1998, 1999, 2000, 2001 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 @@ -42,7 +42,9 @@ ;;;; If you do not wish that, delete this exception notice. ;;;; -(define-module (ice-9 popen)) +(define-module (ice-9 popen) + :export (port/pid-table open-pipe close-pipe open-input-pipe + open-output-pipe)) ;; (define-module (guile popen) ;; :use-module (guile posix)) @@ -52,7 +54,7 @@ (define pipe-guardian (make-guardian)) ;; a weak hash-table to store the process ids. -(define-public port/pid-table (make-weak-key-hash-table 31)) +(define port/pid-table (make-weak-key-hash-table 31)) (define (ensure-fdes port mode) (or (false-if-exception (fileno port)) @@ -134,7 +136,7 @@ (cdr p)) pid)))))) -(define-public (open-pipe command mode) +(define (open-pipe command mode) "Executes the shell command @var{command} (a string) in a subprocess. A pipe to the process is created and returned. @var{modes} specifies whether an input or output pipe to the process is created: it should @@ -173,7 +175,7 @@ be the value of @code{OPEN_READ} or @code{OPEN_WRITE}." (car port/pid) (cdr port/pid)))))) (lambda args #f))) -(define-public (close-pipe p) +(define (close-pipe p) "Closes the pipe created by @code{open-pipe}, then waits for the process to terminate and returns its status value, @xref{Processes, waitpid}, for information on how to interpret this value." @@ -194,10 +196,10 @@ information on how to interpret this value." (add-hook! after-gc-hook reap-pipes) -(define-public (open-input-pipe command) +(define (open-input-pipe command) "Equivalent to @code{open-pipe} with mode @code{OPEN_READ}" (open-pipe command OPEN_READ)) -(define-public (open-output-pipe command) +(define (open-output-pipe command) "Equivalent to @code{open-pipe} with mode @code{OPEN_WRITE}" (open-pipe command OPEN_WRITE)) diff --git a/ice-9/pretty-print.scm b/ice-9/pretty-print.scm index 2eac93e94..cc32c8917 100644 --- a/ice-9/pretty-print.scm +++ b/ice-9/pretty-print.scm @@ -41,9 +41,8 @@ ;;;; whether to permit this exception to apply to your modifications. ;;;; If you do not wish that, delete this exception notice. ;;;; -(define-module (ice-9 pretty-print)) - -(export pretty-print) +(define-module (ice-9 pretty-print) + :export (pretty-print)) ;; From SLIB. diff --git a/ice-9/q.scm b/ice-9/q.scm index 335ec4ecd..b09f69537 100644 --- a/ice-9/q.scm +++ b/ice-9/q.scm @@ -81,7 +81,9 @@ ;;; Code: -(define-module (ice-9 q)) +(define-module (ice-9 q) + :export (sync-q! make-q q? q-empty? q-empty-check q-front q-rear + q-remove! q-push! enq! q-pop! deq! q-length)) ;;; sync-q! ;;; The procedure @@ -90,7 +92,7 @@ ;;; ;;; recomputes and resets the component of a queue. ;;; -(define-public (sync-q! q) +(define (sync-q! q) (set-cdr! q (if (pair? (car q)) (last-pair (car q)) #f)) q) @@ -98,7 +100,7 @@ ;;; make-q ;;; return a new q. ;;; -(define-public (make-q) (cons '() #f)) +(define (make-q) (cons '() #f)) ;;; q? obj ;;; Return true if obj is a Q. @@ -106,7 +108,7 @@ ;;; or it is a pair P with (list? (car P)) ;;; and (eq? (cdr P) (last-pair (car P))). ;;; -(define-public (q? obj) +(define (q? obj) (and (pair? obj) (if (pair? (car obj)) (eq? (cdr obj) (last-pair (car obj))) @@ -115,29 +117,29 @@ ;;; q-empty? obj ;;; -(define-public (q-empty? obj) (null? (car obj))) +(define (q-empty? obj) (null? (car obj))) ;;; q-empty-check q ;;; Throw a q-empty exception if Q is empty. -(define-public (q-empty-check q) (if (q-empty? q) (throw 'q-empty q))) +(define (q-empty-check q) (if (q-empty? q) (throw 'q-empty q))) ;;; q-front q ;;; Return the first element of Q. -(define-public (q-front q) (q-empty-check q) (caar q)) +(define (q-front q) (q-empty-check q) (caar q)) ;;; q-rear q ;;; Return the last element of Q. -(define-public (q-rear q) (q-empty-check q) (cadr q)) +(define (q-rear q) (q-empty-check q) (cadr q)) ;;; q-remove! q obj ;;; Remove all occurences of obj from Q. -(define-public (q-remove! q obj) +(define (q-remove! q obj) (set-car! q (delq! obj (car q))) (sync-q! q)) ;;; q-push! q obj ;;; Add obj to the front of Q -(define-public (q-push! q obj) +(define (q-push! q obj) (let ((h (cons obj (car q)))) (set-car! q h) (or (cdr q) (set-cdr! q h))) @@ -145,7 +147,7 @@ ;;; enq! q obj ;;; Add obj to the rear of Q -(define-public (enq! q obj) +(define (enq! q obj) (let ((h (cons obj '()))) (if (null? (car q)) (set-car! q h) @@ -155,7 +157,7 @@ ;;; q-pop! q ;;; Take the front of Q and return it. -(define-public (q-pop! q) +(define (q-pop! q) (q-empty-check q) (let ((it (caar q)) (next (cdar q))) @@ -166,11 +168,11 @@ ;;; deq! q ;;; Take the front of Q and return it. -(define-public deq! q-pop!) +(define deq! q-pop!) ;;; q-length q ;;; Return the number of enqueued elements. ;;; -(define-public (q-length q) (length (car q))) +(define (q-length q) (length (car q))) ;;; q.scm ends here diff --git a/ice-9/r5rs.scm b/ice-9/r5rs.scm index 73b9d0fe0..0704ce5a2 100644 --- a/ice-9/r5rs.scm +++ b/ice-9/r5rs.scm @@ -42,24 +42,21 @@ ;;;; R5RS bindings -(define-module (ice-9 r5rs)) - -(module-use! %module-public-interface (resolve-interface '(ice-9 safe-r5rs))) - -(export scheme-report-environment - ;;transcript-on - ;;transcript-off - ) +(define-module (ice-9 r5rs) + :export (scheme-report-environment + ;;transcript-on + ;;transcript-off + ) + :re-export (interaction-environment -(re-export interaction-environment + call-with-input-file call-with-output-file + with-input-from-file with-output-to-file + open-input-file open-output-file + close-input-port close-output-port - call-with-input-file call-with-output-file - with-input-from-file with-output-to-file - open-input-file open-output-file - close-input-port close-output-port + load)) - load - ) +(module-use! %module-public-interface (resolve-interface '(ice-9 safe-r5rs))) (define scheme-report-interface %module-public-interface) diff --git a/ice-9/rdelim.scm b/ice-9/rdelim.scm index edc8cf8ec..97c27039f 100644 --- a/ice-9/rdelim.scm +++ b/ice-9/rdelim.scm @@ -46,13 +46,13 @@ ;;; This is the Scheme part of the module for delimited I/O. It's ;;; similar to (scsh rdelim) but somewhat incompatible. -(define-module (ice-9 rdelim)) +(define-module (ice-9 rdelim) + :export (read-line read-line! read-delimited read-delimited! + %read-delimited! %read-line write-line) ; C + ) (%init-rdelim-builtins) -(export read-line read-line! read-delimited read-delimited!) -(export %read-delimited! %read-line write-line) ; C - (define (read-line! string . maybe-port) ;; corresponds to SCM_LINE_INCREMENTORS in libguile. (define scm-line-incrementors "\n") diff --git a/ice-9/regex.scm b/ice-9/regex.scm index 023c0b7bc..fb4a93e58 100644 --- a/ice-9/regex.scm +++ b/ice-9/regex.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 1997, 1999 Free Software Foundation, Inc. +;;;; Copyright (C) 1997, 1999, 2001 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 @@ -42,7 +42,11 @@ ;;;; POSIX regex support functions. -(define-module (ice-9 regex)) +(define-module (ice-9 regex) + :export (match:count match:string match:prefix match:suffix + regexp-match? regexp-quote match:start match:end match:substring + string-match regexp-substitute fold-matches list-matches + regexp-substitute/global)) ;;; FIXME: ;;; It is not clear what should happen if a `match' function @@ -53,22 +57,22 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; These procedures are not defined in SCSH, but I found them useful. -(define-public (match:count match) +(define (match:count match) (- (vector-length match) 1)) -(define-public (match:string match) +(define (match:string match) (vector-ref match 0)) -(define-public (match:prefix match) +(define (match:prefix match) (substring (match:string match) 0 (match:start match 0))) -(define-public (match:suffix match) +(define (match:suffix match) (substring (match:string match) (match:end match 0))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; SCSH compatibility routines. -(define-public (regexp-match? match) +(define (regexp-match? match) (and (vector? match) (string? (vector-ref match 0)) (let loop ((i 1)) @@ -79,7 +83,7 @@ (loop (+ 1 i))) (else #f))))) -(define-public (regexp-quote regexp) +(define (regexp-quote regexp) (call-with-output-string (lambda (p) (let loop ((i 0)) @@ -91,21 +95,21 @@ (write-char (string-ref regexp i) p) (loop (1+ i)))))))) -(define-public (match:start match . args) +(define (match:start match . args) (let* ((matchnum (if (pair? args) (+ 1 (car args)) 1)) (start (car (vector-ref match matchnum)))) (if (= start -1) #f start))) -(define-public (match:end match . args) +(define (match:end match . args) (let* ((matchnum (if (pair? args) (+ 1 (car args)) 1)) (end (cdr (vector-ref match matchnum)))) (if (= end -1) #f end))) -(define-public (match:substring match . args) +(define (match:substring match . args) (let* ((matchnum (if (pair? args) (car args) 0)) @@ -113,12 +117,12 @@ (end (match:end match matchnum))) (and start end (substring (match:string match) start end)))) -(define-public (string-match pattern str . args) +(define (string-match pattern str . args) (let ((rx (make-regexp pattern)) (start (if (pair? args) (car args) 0))) (regexp-exec rx str start))) -(define-public (regexp-substitute port match . items) +(define (regexp-substitute port match . items) ;; If `port' is #f, send output to a string. (if (not port) (call-with-output-string @@ -153,7 +157,7 @@ ;;; `b'. Around or within `xxx', only the match covering all three ;;; x's counts, because the rest are not maximal. -(define-public (fold-matches regexp string init proc . flags) +(define (fold-matches regexp string init proc . flags) (let ((regexp (if (regexp? regexp) regexp (make-regexp regexp))) (flags (if (null? flags) 0 flags))) (let loop ((start 0) @@ -171,10 +175,10 @@ (else (loop (match:end m) (proc m value) #t))))))) -(define-public (list-matches regexp string . flags) +(define (list-matches regexp string . flags) (reverse! (apply fold-matches regexp string '() cons flags))) -(define-public (regexp-substitute/global port regexp string . items) +(define (regexp-substitute/global port regexp string . items) ;; If `port' is #f, send output to a string. (if (not port) diff --git a/ice-9/runq.scm b/ice-9/runq.scm index 4929756d3..4f8f8026c 100644 --- a/ice-9/runq.scm +++ b/ice-9/runq.scm @@ -72,7 +72,10 @@ ;;; Code: (define-module (ice-9 runq) - :use-module (ice-9 q)) + :use-module (ice-9 q) + :export (runq-control make-void-runq make-fair-runq + make-exclusive-runq make-subordinate-runq-to strip-sequence + fair-strip-subtask)) ;;;; ;;; (runq-control q msg . args) @@ -91,7 +94,7 @@ ;;; 'kill! ;; empty the queue ;;; else ;; throw 'not-understood ;;; -(define-public (runq-control q msg . args) +(define (runq-control q msg . args) (case msg ((add!) (for-each (lambda (t) (enq! q t)) args) '*unspecified*) ((enqueue!) (for-each (lambda (t) (enq! q t)) args) '*unspecified*) @@ -109,7 +112,7 @@ ;;; Make a runq that discards all messages except "length", for which ;;; it returns 0. ;;; -(define-public (make-void-runq) +(define (make-void-runq) (lambda opts (and opts (apply-to-args opts @@ -129,7 +132,7 @@ ;;; to the end of the queue, meaning it will be the last to execute ;;; of all the remaining procedures. ;;; -(define-public (make-fair-runq) +(define (make-fair-runq) (letrec ((q (make-q)) (self (lambda ctl @@ -165,7 +168,7 @@ ;;; of that (if the CDR is not nil). This way, the rest of the thunks ;;; in the list that contained W have priority over the return value of W. ;;; -(define-public (make-exclusive-runq) +(define (make-exclusive-runq) (letrec ((q (make-q)) (self (lambda ctl @@ -197,7 +200,7 @@ ;;; N is the length of the basic-inferior queue when the proxy ;;; strip is entered. [Countless scheduling variations are possible.] ;;; -(define-public (make-subordinate-runq-to superior-runq basic-runq) +(define (make-subordinate-runq-to superior-runq basic-runq) (let ((runq-task (cons #f #f))) (set-car! runq-task (lambda () @@ -238,7 +241,7 @@ ;;; ;;; Returns a new strip which is the concatenation of the argument strips. ;;; -(define-public ((strip-sequence . strips)) +(define ((strip-sequence . strips)) (let loop ((st (let ((a strips)) (set! strips #f) a))) (and (not (null? st)) (let ((then ((car st)))) @@ -255,7 +258,7 @@ ;;; ;;; ;;; -(define-public (fair-strip-subtask . initial-strips) +(define (fair-strip-subtask . initial-strips) (let ((st (make-fair-runq))) (apply st 'add! initial-strips) st)) diff --git a/ice-9/safe-r5rs.scm b/ice-9/safe-r5rs.scm index b17dd57b0..c60fb820f 100644 --- a/ice-9/safe-r5rs.scm +++ b/ice-9/safe-r5rs.scm @@ -42,120 +42,119 @@ ;;;; Safe subset of R5RS bindings -(define-module (ice-9 safe-r5rs)) - -(define null-interface (resolve-interface '(ice-9 null))) - -(module-use! %module-public-interface null-interface) - -(re-export eqv? eq? equal? - number? complex? real? rational? integer? - exact? inexact? - = < > <= >= - zero? positive? negative? odd? even? - max min - + * - / - abs - quotient remainder modulo - gcd lcm - ;;numerator denominator XXX - ;;rationalize XXX - floor ceiling truncate round - exp log sin cos tan asin acos atan - sqrt - expt - make-rectangular make-polar real-part imag-part magnitude angle - exact->inexact inexact->exact +(define-module (ice-9 safe-r5rs) + :re-export (eqv? eq? equal? + number? complex? real? rational? integer? + exact? inexact? + = < > <= >= + zero? positive? negative? odd? even? + max min + + * - / + abs + quotient remainder modulo + gcd lcm + ;;numerator denominator XXX + ;;rationalize XXX + floor ceiling truncate round + exp log sin cos tan asin acos atan + sqrt + expt + make-rectangular make-polar real-part imag-part magnitude angle + exact->inexact inexact->exact + + number->string string->number - number->string string->number + boolean? + not - boolean? - not + pair? + cons car cdr + set-car! set-cdr! + caar cadr cdar cddr + caaar caadr cadar caddr cdaar cdadr cddar cdddr + caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr + cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr + null? + list? + list + length + append + reverse + list-tail list-ref + memq memv member + assq assv assoc - pair? - cons car cdr - set-car! set-cdr! - caar cadr cdar cddr - caaar caadr cadar caddr cdaar cdadr cddar cdddr - caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr - cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr - null? - list? - list - length - append - reverse - list-tail list-ref - memq memv member - assq assv assoc + symbol? + symbol->string string->symbol - symbol? - symbol->string string->symbol + char? + char=? char? char<=? char>=? + char-ci=? char-ci? char-ci<=? char-ci>=? + char-alphabetic? char-numeric? char-whitespace? + char-upper-case? char-lower-case? + char->integer integer->char + char-upcase + char-downcase - char? - char=? char? char<=? char>=? - char-ci=? char-ci? char-ci<=? char-ci>=? - char-alphabetic? char-numeric? char-whitespace? - char-upper-case? char-lower-case? - char->integer integer->char - char-upcase - char-downcase + string? + make-string + string + string-length + string-ref string-set! + string=? string-ci=? + string? string<=? string>=? + string-ci? string-ci<=? string-ci>=? + substring + string-length + string-append + string->list list->string + string-copy string-fill! - string? - make-string - string - string-length - string-ref string-set! - string=? string-ci=? - string? string<=? string>=? - string-ci? string-ci<=? string-ci>=? - substring - string-length - string-append - string->list list->string - string-copy string-fill! + vector? + make-vector + vector + vector-length + vector-ref vector-set! + vector->list list->vector + vector-fill! - vector? - make-vector - vector - vector-length - vector-ref vector-set! - vector->list list->vector - vector-fill! + procedure? + apply + map + for-each + force - procedure? - apply - map - for-each - force + call-with-current-continuation - call-with-current-continuation + values + call-with-values + dynamic-wind - values - call-with-values - dynamic-wind - - eval + eval - input-port? output-port? - current-input-port current-output-port + input-port? output-port? + current-input-port current-output-port - read - read-char - peek-char - eof-object? - char-ready? + read + read-char + peek-char + eof-object? + char-ready? - write - display - newline - write-char + write + display + newline + write-char + + ;;transcript-on + ;;transcript-off + ) - ;;transcript-on - ;;transcript-off - ) + :export (null-environment)) -(export null-environment) +(define null-interface (resolve-interface '(ice-9 null))) + +(module-use! %module-public-interface null-interface) (define (null-environment n) (if (not (= n 5)) diff --git a/ice-9/safe.scm b/ice-9/safe.scm index b8bd7ac6f..aca656d1d 100644 --- a/ice-9/safe.scm +++ b/ice-9/safe.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 2000 Free Software Foundation, Inc. +;;;; Copyright (C) 2000, 2001 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 @@ -42,11 +42,12 @@ ;;;; Safe subset of R5RS bindings -(define-module (ice-9 safe)) +(define-module (ice-9 safe) + :export (safe-environment make-safe-module)) (define safe-r5rs-interface (resolve-interface '(ice-9 safe-r5rs))) -(define-public (safe-environment n) +(define (safe-environment n) (if (not (= n 5)) (scm-error 'misc-error 'safe-environment "~A is not a valid version" @@ -54,5 +55,5 @@ '())) safe-r5rs-interface) -(define-public (make-safe-module) +(define (make-safe-module) (make-module 1021 (list safe-r5rs-interface))) diff --git a/ice-9/session.scm b/ice-9/session.scm index 23ae667f6..00a023084 100644 --- a/ice-9/session.scm +++ b/ice-9/session.scm @@ -44,13 +44,16 @@ (define-module (ice-9 session) :use-module (ice-9 documentation) :use-module (ice-9 regex) - :use-module (ice-9 rdelim)) + :use-module (ice-9 rdelim) + :export (help apropos apropos-internal apropos-fold + apropos-fold-accessible apropos-fold-exported apropos-fold-all + source arity system-module)) ;;; Documentation ;;; -(define-public help +(define help (procedure->syntax (lambda (exp env) "(help [NAME]) @@ -255,7 +258,7 @@ where OPTIONSET is one of debug, read, eval, print ;;; Author: Roland Orre ;;; -(define-public (apropos rgx . options) +(define (apropos rgx . options) "Search for bindings: apropos regexp {options= 'full 'shadow 'value}" (if (zero? (string-length rgx)) "Empty string not allowed" @@ -300,7 +303,7 @@ where OPTIONSET is one of debug, read, eval, print obarray))) modules)))) -(define-public (apropos-internal rgx) +(define (apropos-internal rgx) "Return a list of accessible variable names." (apropos-fold (lambda (module name var data) (cons name data)) @@ -308,7 +311,7 @@ where OPTIONSET is one of debug, read, eval, print rgx (apropos-fold-accessible (current-module)))) -(define-public (apropos-fold proc init rgx folder) +(define (apropos-fold proc init rgx folder) "Folds PROCEDURE over bindings matching third arg REGEXP. Result is @@ -369,7 +372,7 @@ It is an image under the mapping EXTRACT." data))) ((null? modules) data)))))) -(define-public (apropos-fold-accessible module) +(define (apropos-fold-accessible module) (make-fold-modules (lambda () (list module)) module-uses identity)) @@ -388,18 +391,18 @@ It is an image under the mapping EXTRACT." '() (module-obarray m))) -(define-public apropos-fold-exported +(define apropos-fold-exported (make-fold-modules root-modules submodules module-public-interface)) -(define-public apropos-fold-all +(define apropos-fold-all (make-fold-modules root-modules submodules identity)) -(define-public (source obj) +(define (source obj) (cond ((procedure? obj) (procedure-source obj)) ((macro? obj) (procedure-source (macro-transformer obj))) (else #f))) -(define-public (arity obj) +(define (arity obj) (define (display-arg-list arg-list) (display #\`) (display (car arg-list)) @@ -480,7 +483,7 @@ It is an image under the mapping EXTRACT." (display #\')))))))) (display ".\n")) -(define-public system-module +(define system-module (procedure->syntax (lambda (exp env) (let* ((m (nested-ref the-root-module diff --git a/ice-9/slib.scm b/ice-9/slib.scm index c7d3af57f..e91edaedc 100644 --- a/ice-9/slib.scm +++ b/ice-9/slib.scm @@ -1,6 +1,6 @@ ;;;; slib.scm --- definitions needed to get SLIB to work with Guile ;;;; -;;;; Copyright (C) 1997, 1998, 2000 Free Software Foundation, Inc. +;;;; Copyright (C) 1997, 1998, 2000, 2001 Free Software Foundation, Inc. ;;;; ;;;; This file is part of GUILE. ;;;; @@ -44,8 +44,18 @@ ;;;; If you do not wish that, delete this exception notice. ;;;; (define-module (ice-9 slib) + :export (slib:load slib:load-source defmacro:load + implementation-vicinity library-vicinity home-vicinity + scheme-implementation-type scheme-implementation-version + output-port-width output-port-height identity array-indexes + make-random-state require slib:error slib:exit slib:warn slib:eval + defmacro:eval logical:logand logical:logior logical:logxor + logical:lognot logical:ash logical:logcount logical:integer-length + logical:bit-extract logical:integer-expt logical:ipow-by-squaring + slib:eval-load slib:tab slib:form-feed difftime offset-time + software-type) :no-backtrace) - + (define (eval-load evl) @@ -86,71 +96,98 @@ (define (defined? symbol) (module-defined? slib-module symbol)) -(define slib:features - (append '(source - eval - abort - alist - defmacro - delay - dynamic-wind - full-continuation - hash - hash-table - line-i/o - logical - multiarg/and- - multiarg-apply - promise - rev2-procedures - rev4-optional-procedures - string-port - with-file) - - (if (defined? 'getenv) - '(getenv) - '()) - - (if (defined? 'current-time) - '(current-time) - '()) - - (if (defined? 'system) - '(system) - '()) - - (if (defined? 'array?) - '(array) - '()) - - (if (defined? 'char-ready?) - '(char-ready?) - '()) - - (if (defined? 'array-for-each) - '(array-for-each) - '()) - - (if (and (string->number "0.0") (inexact? (string->number "0.0"))) - '(inexact) - '()) - - (if (rational? (string->number "1/19")) - '(rational) - '()) - - (if (real? (string->number "0.0")) - '(real) - ()) - - (if (complex? (string->number "1+i")) - '(complex) - '()) - - (let ((n (string->number "9999999999999999999999999999999"))) - (if (and n (exact? n)) - '(bignum) - '())))) +;;; *FEATURES* should be set to a list of symbols describing features +;;; of this implementation. Suggestions for features are: +(define *features* + (append + '( + source ;can load scheme source files + ;(slib:load-source "filename") +; compiled ;can load compiled files + ;(slib:load-compiled "filename") + + ;; Scheme report features + +; rev5-report ;conforms to + eval ;R5RS two-argument eval +; values ;R5RS multiple values + dynamic-wind ;R5RS dynamic-wind +; macro ;R5RS high level macros + delay ;has DELAY and FORCE + multiarg-apply ;APPLY can take more than 2 args. +; rationalize + rev4-optional-procedures ;LIST-TAIL, STRING->LIST, + ;LIST->STRING, STRING-COPY, + ;STRING-FILL!, LIST->VECTOR, + ;VECTOR->LIST, and VECTOR-FILL! + +; rev4-report ;conforms to + +; ieee-p1178 ;conforms to + +; rev3-report ;conforms to + + rev2-procedures ;SUBSTRING-MOVE-LEFT!, + ;SUBSTRING-MOVE-RIGHT!, + ;SUBSTRING-FILL!, + ;STRING-NULL?, APPEND!, 1+, + ;-1+, ?, >=? +; object-hash ;has OBJECT-HASH + + multiarg/and- ;/ and - can take more than 2 args. + with-file ;has WITH-INPUT-FROM-FILE and + ;WITH-OUTPUT-FROM-FILE +; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF +; ieee-floating-point ;conforms to IEEE Standard 754-1985 + ;IEEE Standard for Binary + ;Floating-Point Arithmetic. + full-continuation ;can return multiple times + + ;; Other common features + +; srfi ;srfi-0, COND-EXPAND finds all srfi-* +; sicp ;runs code from Structure and + ;Interpretation of Computer + ;Programs by Abelson and Sussman. + defmacro ;has Common Lisp DEFMACRO +; record ;has user defined data structures + string-port ;has CALL-WITH-INPUT-STRING and + ;CALL-WITH-OUTPUT-STRING +; sort +; pretty-print +; object->string +; format ;Common-lisp output formatting +; trace ;has macros: TRACE and UNTRACE +; compiler ;has (COMPILER) +; ed ;(ED) is editor + random + ) + + (if (defined? 'getenv) + '(getenv) + '()) + + (if (defined? 'current-time) + '(current-time) + '()) + + (if (defined? 'system) + '(system) + '()) + + (if (defined? 'array?) + '(array) + '()) + + (if (defined? 'char-ready?) + '(char-ready?) + '()) + + (if (defined? 'array-for-each) + '(array-for-each) + '()) + + *features*)) ;;; FIXME: Because uers want require to search the path, this uses @@ -162,7 +199,7 @@ ;;; changing catalog:get in slib/require.scm, and I don't expect ;;; Aubrey will integrate such a change. So I'm just going to punt ;;; for the time being. -(define-public (slib:load name) +(define (slib:load name) (save-module-excursion (lambda () (set-current-module slib-module) @@ -189,23 +226,34 @@ (substring path 0 (- (string-length path) 17)) (error "Could not find slib/require.scm in " %load-path)))) -(define-public (implementation-vicinity) +(define (implementation-vicinity) (string-append slib-parent-dir "/")) -(define-public (library-vicinity) +(define (library-vicinity) (string-append (implementation-vicinity) "slib/")) -(define-public home-vicinity +(define home-vicinity (let ((home-path (getenv "HOME"))) (lambda () home-path))) -(define-public (scheme-implementation-type) 'guile) -(define-public (scheme-implementation-version) "") +(define (scheme-implementation-type) 'guile) +(define scheme-implementation-version version) +;;; (scheme-implementation-home-page) should return a (string) URI +;;; (Uniform Resource Identifier) for this scheme implementation's home +;;; page; or false if there isn't one. +(define (scheme-implementation-home-page) + "http://www.gnu.org/software/guile/guile.html") (define (output-port-width . arg) 80) (define (output-port-height . arg) 24) (define (identity x) x) +;;; {array-for-each} +(define (array-indexes ra) + (let ((ra0 (apply make-array '() (array-shape ra)))) + (array-index-map! ra0 list) + ra0)) + ;;; {Random numbers} ;;; -(define-public (make-random-state . args) +(define (make-random-state . args) (let ((seed (if (null? args) *random-state* (car args)))) (cond ((string? seed)) ((number? seed) (set! seed (number->string seed))) @@ -251,7 +299,7 @@ no other easy or unambiguous way of detecting such features." (slib:load (in-vicinity (library-vicinity) "require.scm")) -(define-public require require:require) +(define require require:require) ;; {Extensions to the require system so that the user can add new ;; require modules easily.} diff --git a/ice-9/streams.scm b/ice-9/streams.scm index 9091b896c..518adbf22 100644 --- a/ice-9/streams.scm +++ b/ice-9/streams.scm @@ -46,15 +46,14 @@ ;; (i.e. ripped off) Scheme48's `stream' package, ;; modulo stream-empty? -> stream-null? renaming. -(define-module (ice-9 streams)) - -(export make-stream - stream-car stream-cdr stream-null? - list->stream vector->stream port->stream - stream->list stream->reversed-list - stream->list&length stream->reversed-list&length - stream->vector - stream-fold stream-for-each stream-map) +(define-module (ice-9 streams) + :export (make-stream + stream-car stream-cdr stream-null? + list->stream vector->stream port->stream + stream->list stream->reversed-list + stream->list&length stream->reversed-list&length + stream->vector + stream-fold stream-for-each stream-map)) ;; Use: ;; diff --git a/ice-9/string-fun.scm b/ice-9/string-fun.scm index f6ffaa1d9..8470e39d6 100644 --- a/ice-9/string-fun.scm +++ b/ice-9/string-fun.scm @@ -1,6 +1,6 @@ ;;;; string-fun.scm --- string manipulation functions ;;;; -;;;; Copyright (C) 1995, 1996, 1997, 1999 Free Software Foundation, Inc. +;;;; Copyright (C) 1995, 1996, 1997, 1999, 2001 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 @@ -42,7 +42,15 @@ ;;;; If you do not wish that, delete this exception notice. ;;;; -(define-module (ice-9 string-fun)) +(define-module (ice-9 string-fun) + :export (split-after-char split-before-char split-discarding-char + split-after-char-last split-before-char-last + split-discarding-char-last split-before-predicate + split-after-predicate split-discarding-predicate + separate-fields-discarding-char separate-fields-after-char + separate-fields-before-char string-prefix-predicate string-prefix=? + sans-surrounding-whitespace sans-trailing-whitespace + sans-leading-whitespace sans-final-newline has-trailing-newline?)) ;;;; ;;; @@ -112,53 +120,53 @@ ;;; complicated with these functions, consider using regular expressions. ;;; -(define-public (split-after-char char str ret) +(define (split-after-char char str ret) (let ((end (cond ((string-index str char) => 1+) (else (string-length str))))) (ret (substring str 0 end) (substring str end)))) -(define-public (split-before-char char str ret) +(define (split-before-char char str ret) (let ((end (or (string-index str char) (string-length str)))) (ret (substring str 0 end) (substring str end)))) -(define-public (split-discarding-char char str ret) +(define (split-discarding-char char str ret) (let ((end (string-index str char))) (if (not end) (ret str "") (ret (substring str 0 end) (substring str (1+ end)))))) -(define-public (split-after-char-last char str ret) +(define (split-after-char-last char str ret) (let ((end (cond ((string-rindex str char) => 1+) (else 0)))) (ret (substring str 0 end) (substring str end)))) -(define-public (split-before-char-last char str ret) +(define (split-before-char-last char str ret) (let ((end (or (string-rindex str char) 0))) (ret (substring str 0 end) (substring str end)))) -(define-public (split-discarding-char-last char str ret) +(define (split-discarding-char-last char str ret) (let ((end (string-rindex str char))) (if (not end) (ret str "") (ret (substring str 0 end) (substring str (1+ end)))))) -(define-public (split-before-predicate pred str ret) +(define (split-before-predicate pred str ret) (let loop ((n 0)) (cond ((= n (string-length str)) (ret str "")) ((not (pred (string-ref str n))) (loop (1+ n))) (else (ret (substring str 0 n) (substring str n)))))) -(define-public (split-after-predicate pred str ret) +(define (split-after-predicate pred str ret) (let loop ((n 0)) (cond ((= n (string-length str)) (ret str "")) @@ -166,7 +174,7 @@ (else (ret (substring str 0 (1+ n)) (substring str (1+ n))))))) -(define-public (split-discarding-predicate pred str ret) +(define (split-discarding-predicate pred str ret) (let loop ((n 0)) (cond ((= n (string-length str)) (ret str "")) @@ -174,7 +182,7 @@ (else (ret (substring str 0 n) (substring str (1+ n))))))) -(define-public (separate-fields-discarding-char ch str ret) +(define (separate-fields-discarding-char ch str ret) (let loop ((fields '()) (str str)) (cond @@ -183,7 +191,7 @@ (substring str 0 w)))) (else (apply ret str fields))))) -(define-public (separate-fields-after-char ch str ret) +(define (separate-fields-after-char ch str ret) (reverse (let loop ((fields '()) (str str)) @@ -193,7 +201,7 @@ (substring str (+ 1 w))))) (else (apply ret str fields)))))) -(define-public (separate-fields-before-char ch str ret) +(define (separate-fields-before-char ch str ret) (let loop ((fields '()) (str str)) (cond @@ -214,11 +222,11 @@ ;;; (define-public string-prefix=? (string-prefix-predicate string=?)) ;;; -(define-public ((string-prefix-predicate pred?) prefix str) +(define ((string-prefix-predicate pred?) prefix str) (and (<= (string-length prefix) (string-length str)) (pred? prefix (substring str 0 (string-length prefix))))) -(define-public string-prefix=? (string-prefix-predicate string=?)) +(define string-prefix=? (string-prefix-predicate string=?)) ;;; {String Fun: Strippers} @@ -231,7 +239,7 @@ ;;; | final-newline ;;; -(define-public (sans-surrounding-whitespace s) +(define (sans-surrounding-whitespace s) (let ((st 0) (end (string-length s))) (while (and (< st (string-length s)) @@ -244,7 +252,7 @@ "" (substring s st end)))) -(define-public (sans-trailing-whitespace s) +(define (sans-trailing-whitespace s) (let ((st 0) (end (string-length s))) (while (and (< 0 end) @@ -254,7 +262,7 @@ "" (substring s st end)))) -(define-public (sans-leading-whitespace s) +(define (sans-leading-whitespace s) (let ((st 0) (end (string-length s))) (while (and (< st (string-length s)) @@ -264,7 +272,7 @@ "" (substring s st end)))) -(define-public (sans-final-newline str) +(define (sans-final-newline str) (cond ((= 0 (string-length str)) str) @@ -277,7 +285,7 @@ ;;; {String Fun: has-trailing-newline?} ;;; -(define-public (has-trailing-newline? str) +(define (has-trailing-newline? str) (and (< 0 (string-length str)) (char=? #\nl (string-ref str (1- (string-length str)))))) diff --git a/ice-9/syncase.scm b/ice-9/syncase.scm index 948e11b86..36ea4f962 100644 --- a/ice-9/syncase.scm +++ b/ice-9/syncase.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 1997, 2000 Free Software Foundation, Inc. +;;;; Copyright (C) 1997, 2000, 2001 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 @@ -42,40 +42,50 @@ (define-module (ice-9 syncase) - :use-module (ice-9 debug)) + :use-module (ice-9 debug) + :export-syntax (sc-macro define-syntax eval-when fluid-let-syntax + identifier-syntax let-syntax + letrec-syntax syntax syntax-case syntax-rules + with-syntax + include) + :export (sc-expand sc-expand3 install-global-transformer + syntax-dispatch syntax-error bound-identifier=? + datum->syntax-object free-identifier=? + generate-temporaries identifier? syntax-object->datum + void eval syncase)) -(define-public sc-macro +(define sc-macro (procedure->memoizing-macro (lambda (exp env) (sc-expand exp)))) ;;; Exported variables -(define-public sc-expand #f) -(define-public sc-expand3 #f) -(define-public install-global-transformer #f) -(define-public syntax-dispatch #f) -(define-public syntax-error #f) - -(define-public bound-identifier=? #f) -(define-public datum->syntax-object #f) -(define-public define-syntax sc-macro) -(define-public eval-when sc-macro) -(define-public fluid-let-syntax sc-macro) -(define-public free-identifier=? #f) -(define-public generate-temporaries #f) -(define-public identifier? #f) -(define-public identifier-syntax sc-macro) -(define-public let-syntax sc-macro) -(define-public letrec-syntax sc-macro) -(define-public syntax sc-macro) -(define-public syntax-case sc-macro) -(define-public syntax-object->datum #f) -(define-public syntax-rules sc-macro) -(define-public with-syntax sc-macro) -(define-public include sc-macro) +(define sc-expand #f) +(define sc-expand3 #f) +(define install-global-transformer #f) +(define syntax-dispatch #f) +(define syntax-error #f) + +(define bound-identifier=? #f) +(define datum->syntax-object #f) +(define define-syntax sc-macro) +(define eval-when sc-macro) +(define fluid-let-syntax sc-macro) +(define free-identifier=? #f) +(define generate-temporaries #f) +(define identifier? #f) +(define identifier-syntax sc-macro) +(define let-syntax sc-macro) +(define letrec-syntax sc-macro) +(define syntax sc-macro) +(define syntax-case sc-macro) +(define syntax-object->datum #f) +(define syntax-rules sc-macro) +(define with-syntax sc-macro) +(define include sc-macro) (define primitive-syntax '(quote lambda letrec if set! begin define or and let let* cond do quasiquote unquote @@ -87,7 +97,7 @@ ;;; Hooks needed by the syntax-case macro package -(define-public (void) *unspecified*) +(define (void) *unspecified*) (define andmap (lambda (f first . rest) @@ -161,7 +171,7 @@ (define internal-eval (nested-ref the-scm-module '(app modules guile eval))) -(define-public (eval x environment) +(define (eval x environment) (internal-eval (if (and (pair? x) (equal? (car x) "noexpand")) (cadr x) @@ -175,4 +185,4 @@ '*sc-expander* '(define)))) -(define-public syncase sc-expand) +(define syncase sc-expand) diff --git a/ice-9/threads.scm b/ice-9/threads.scm index 6fc4511d0..586bae368 100644 --- a/ice-9/threads.scm +++ b/ice-9/threads.scm @@ -56,7 +56,12 @@ ;;; Code: -(define-module (ice-9 threads)) +(define-module (ice-9 threads) + :export-syntax (make-thread + begin-thread + with-mutex + monitor) + :export (%thread-handler)) @@ -109,13 +114,4 @@ (begin ,first ,@rest))) -;; export - -(export %thread-handler) - -(export-syntax make-thread - begin-thread - with-mutex - monitor) - ;;; threads.scm ends here diff --git a/oop/ChangeLog b/oop/ChangeLog index 87a52a216..5fc09eed1 100644 --- a/oop/ChangeLog +++ b/oop/ChangeLog @@ -1,3 +1,12 @@ +2001-10-21 Mikael Djurfeldt + + * goops.scm, goops/active-slot.scm, goops/compile.scm, + goops/composite-slot.scm, goops/describe.scm, goops/dispatch.scm, + goops/old-define-method.scm, goops/save.scm, goops/util.scm: Move + module the system directives `export', `export-syntax', + `re-export' and `re-export-syntax' into the `define-module' form. + This is the recommended way of exporting bindings. + 2001-08-25 Marius Vollmer * Makefile.am, goops/Makefile.am: (AUTOMAKE_OPTIONS): Change diff --git a/oop/goops.scm b/oop/goops.scm index 4f997da3f..b8f63ff27 100644 --- a/oop/goops.scm +++ b/oop/goops.scm @@ -51,6 +51,51 @@ ;;;; (define-module (oop goops) + :export-syntax (define-class class + define-generic define-accessor define-method + method) + :export (goops-version is-a? + ensure-metaclass ensure-metaclass-with-supers + make-class + make-generic ensure-generic + make-accessor ensure-accessor + make-method add-method! + object-eqv? object-equal? + class-slot-ref class-slot-set! slot-unbound slot-missing + slot-definition-name slot-definition-options + slot-definition-allocation + slot-definition-getter slot-definition-setter + slot-definition-accessor + slot-definition-init-value slot-definition-init-form + slot-definition-init-thunk slot-definition-init-keyword + slot-init-function class-slot-definition + method-source + compute-cpl compute-std-cpl compute-get-n-set compute-slots + compute-getter-method compute-setter-method + allocate-instance initialize make-instance make + no-next-method no-applicable-method no-method + change-class update-instance-for-different-class + shallow-clone deep-clone + class-redefinition + apply-generic apply-method apply-methods + compute-applicable-methods %compute-applicable-methods + method-more-specific? sort-applicable-methods + class-subclasses class-methods + goops-error + min-fixnum max-fixnum + ;;; *fixme* Should go into goops.c + instance? slot-ref-using-class + slot-set-using-class! slot-bound-using-class? + slot-exists-using-class? slot-ref slot-set! slot-bound? + class-name class-direct-supers class-direct-subclasses + class-direct-methods class-direct-slots class-precedence-list + class-slots class-environment + generic-function-name + generic-function-methods method-generic-function method-specializers + primitive-generic-generic enable-primitive-generic! + method-procedure accessor-method-slot-definition + slot-exists? make find-method get-keyword) + :re-export (class-of) ;; from (guile) :no-backtrace) ;; First initialize the builtin part of GOOPS @@ -61,53 +106,6 @@ (oop goops dispatch) (oop goops compile)) -(export ; Define the exported symbols of this file - goops-version is-a? - ensure-metaclass ensure-metaclass-with-supers - define-class class make-class - define-generic make-generic ensure-generic - define-accessor make-accessor ensure-accessor - define-method make-method method add-method! - object-eqv? object-equal? - class-slot-ref class-slot-set! slot-unbound slot-missing - slot-definition-name slot-definition-options slot-definition-allocation - slot-definition-getter slot-definition-setter slot-definition-accessor - slot-definition-init-value slot-definition-init-form - slot-definition-init-thunk slot-definition-init-keyword - slot-init-function class-slot-definition - method-source - compute-cpl compute-std-cpl compute-get-n-set compute-slots - compute-getter-method compute-setter-method - allocate-instance initialize make-instance make - no-next-method no-applicable-method no-method - change-class update-instance-for-different-class - shallow-clone deep-clone - class-redefinition - apply-generic apply-method apply-methods - compute-applicable-methods %compute-applicable-methods - method-more-specific? sort-applicable-methods - class-subclasses class-methods - goops-error - min-fixnum max-fixnum -) - -;;; *fixme* Should go into goops.c - -(export - instance? slot-ref-using-class - slot-set-using-class! slot-bound-using-class? - slot-exists-using-class? slot-ref slot-set! slot-bound? - class-name class-direct-supers class-direct-subclasses - class-direct-methods class-direct-slots class-precedence-list - class-slots class-environment - generic-function-name - generic-function-methods method-generic-function method-specializers - primitive-generic-generic enable-primitive-generic! - method-procedure accessor-method-slot-definition - slot-exists? make find-method get-keyword) - -(re-export class-of) ;; from (guile) - (define min-fixnum (- (expt 2 29))) diff --git a/oop/goops/active-slot.scm b/oop/goops/active-slot.scm index cdedd30aa..7060b83be 100644 --- a/oop/goops/active-slot.scm +++ b/oop/goops/active-slot.scm @@ -51,9 +51,8 @@ ;;;; (define-module (oop goops active-slot) - :use-module (oop goops internal)) - -(export ) + :use-module (oop goops internal) + :export ()) (define-class ()) diff --git a/oop/goops/compile.scm b/oop/goops/compile.scm index a538215ae..e84d3d0d9 100644 --- a/oop/goops/compile.scm +++ b/oop/goops/compile.scm @@ -44,12 +44,11 @@ (define-module (oop goops compile) :use-module (oop goops) :use-module (oop goops util) + :export (compute-cmethod compute-entry-with-cmethod + compile-method cmethod-code cmethod-environment) :no-backtrace ) -(export compute-cmethod compute-entry-with-cmethod - compile-method cmethod-code cmethod-environment) - (define source-formals cadr) (define source-body cddr) diff --git a/oop/goops/composite-slot.scm b/oop/goops/composite-slot.scm index 88147a571..84ce7937f 100644 --- a/oop/goops/composite-slot.scm +++ b/oop/goops/composite-slot.scm @@ -51,9 +51,8 @@ ;;;; (define-module (oop goops composite-slot) - :use-module (oop goops)) - -(export ) + :use-module (oop goops) + :export ()) ;;; ;;; (define-class CLASS SUPERS diff --git a/oop/goops/describe.scm b/oop/goops/describe.scm index 4dd218127..dc0e63424 100644 --- a/oop/goops/describe.scm +++ b/oop/goops/describe.scm @@ -53,9 +53,8 @@ (define-module (oop goops describe) :use-module (oop goops) :use-module (ice-9 session) - :use-module (ice-9 format)) - -(export describe) ; Export the describe generic function + :use-module (ice-9 format) + :export (describe)) ; Export the describe generic function ;;; ;;; describe for simple objects diff --git a/oop/goops/dispatch.scm b/oop/goops/dispatch.scm index cd1c7e698..749cf9273 100644 --- a/oop/goops/dispatch.scm +++ b/oop/goops/dispatch.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2000, 2001 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 @@ -45,11 +45,10 @@ :use-module (oop goops) :use-module (oop goops util) :use-module (oop goops compile) + :export (memoize-method!) :no-backtrace ) -(export memoize-method!) - ;;; ;;; This file implements method memoization. It will finally be ;;; implemented on C level in order to obtain fast generic function diff --git a/oop/goops/old-define-method.scm b/oop/goops/old-define-method.scm index 79165ae44..13f05c284 100644 --- a/oop/goops/old-define-method.scm +++ b/oop/goops/old-define-method.scm @@ -45,11 +45,10 @@ (define-module (oop goops old-define-method) :use-module (oop goops) + :export (define-method) :no-backtrace ) -(export define-method) - (define define-method (procedure->memoizing-macro (lambda (exp env) diff --git a/oop/goops/save.scm b/oop/goops/save.scm index 1597c8e90..7db319e22 100644 --- a/oop/goops/save.scm +++ b/oop/goops/save.scm @@ -46,14 +46,11 @@ (define-module (oop goops save) :use-module (oop goops internal) :use-module (oop goops util) - ) - -(re-export make-unbound) - -(export save-objects load-objects restore - enumerate! enumerate-component! - write-readably write-component write-component-procedure - literal? readable make-readable) + :re-export (make-unbound) + :export (save-objects load-objects restore + enumerate! enumerate-component! + write-readably write-component write-component-procedure + literal? readable make-readable)) ;;; ;;; save-objects ALIST PORT [EXCLUDED] [USES] diff --git a/oop/goops/util.scm b/oop/goops/util.scm index d3d904c60..9e6a3c927 100644 --- a/oop/goops/util.scm +++ b/oop/goops/util.scm @@ -42,13 +42,12 @@ (define-module (oop goops util) + :export (any every filter + mapappend find-duplicate top-level-env top-level-env? + map* for-each* length* improper->proper) :no-backtrace ) -(export any every filter - mapappend find-duplicate top-level-env top-level-env? - map* for-each* length* improper->proper - ) ;;; ;;; {Utilities} diff --git a/srfi/ChangeLog b/srfi/ChangeLog index f3f76740e..a6a49435e 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,11 @@ +2001-10-21 Mikael Djurfeldt + + * srfi-2.scm, srfi-4.scm, srfi-8.scm, srfi-9.scm, srfi-10.scm, + srfi-11.scm, srfi-14.scm, srfi-16.scm: Move module the system + directives `export', `export-syntax', `re-export' and + `re-export-syntax' into the `define-module' form. This is the + recommended way of exporting bindings. + 2001-09-22 Mikael Djurfeldt * srfi-19.scm (priv:split-real): Inserted missing call to diff --git a/srfi/srfi-10.scm b/srfi/srfi-10.scm index f24ec0d94..e3327548c 100644 --- a/srfi/srfi-10.scm +++ b/srfi/srfi-10.scm @@ -69,9 +69,8 @@ ;;; Code: (define-module (srfi srfi-10) - #:use-module (ice-9 rdelim)) - -(export define-reader-ctor) + :use-module (ice-9 rdelim) + :export (define-reader-ctor)) (cond-expand-provide (current-module) '(srfi-10)) diff --git a/srfi/srfi-11.scm b/srfi/srfi-11.scm index de0753636..e60ef43f9 100644 --- a/srfi/srfi-11.scm +++ b/srfi/srfi-11.scm @@ -42,7 +42,8 @@ ;;; If you do not wish that, delete this exception notice. (define-module (srfi srfi-11) - :use-module (ice-9 syncase)) + :use-module (ice-9 syncase) + :export-syntax (let-values let*-values)) (cond-expand-provide (current-module) '(srfi-11)) @@ -256,6 +257,3 @@ ; (if (null? vars) ; `(begin ,@body) ; (let-values-helper vars body))) - -(export-syntax let-values - let*-values) diff --git a/srfi/srfi-14.scm b/srfi/srfi-14.scm index 08aa7b71e..c47ddd514 100644 --- a/srfi/srfi-14.scm +++ b/srfi/srfi-14.scm @@ -41,9 +41,8 @@ ;;;; whether to permit this exception to apply to your modifications. ;;;; If you do not wish that, delete this exception notice. -(define-module (srfi srfi-14)) - -(export +(define-module (srfi srfi-14) + :export ( ;;; General procedures char-set? char-set= @@ -112,7 +111,7 @@ char-set:ascii char-set:empty char-set:full - ) + )) (cond-expand-provide (current-module) '(srfi-14)) diff --git a/srfi/srfi-16.scm b/srfi/srfi-16.scm index 73fd22dc7..fe179e849 100644 --- a/srfi/srfi-16.scm +++ b/srfi/srfi-16.scm @@ -69,9 +69,8 @@ ;;; Author: Martin Grabmueller ;;; Code: -(define-module (srfi srfi-16)) - -(export-syntax case-lambda) +(define-module (srfi srfi-16) + :export-syntax (case-lambda)) (cond-expand-provide (current-module) '(srfi-16)) diff --git a/srfi/srfi-2.scm b/srfi/srfi-2.scm index fa6d0c960..9febda017 100644 --- a/srfi/srfi-2.scm +++ b/srfi/srfi-2.scm @@ -42,8 +42,7 @@ ;;;; If you do not wish that, delete this exception notice. (define-module (srfi srfi-2) - :use-module (ice-9 and-let-star)) - -(re-export-syntax and-let*) + :use-module (ice-9 and-let-star) + :re-export-syntax (and-let*)) (cond-expand-provide (current-module) '(srfi-2)) diff --git a/srfi/srfi-4.scm b/srfi/srfi-4.scm index ea7137cd1..134ac5875 100644 --- a/srfi/srfi-4.scm +++ b/srfi/srfi-4.scm @@ -49,9 +49,8 @@ ;;; Author: Martin Grabmueller -(define-module (srfi srfi-4)) - -(export +(define-module (srfi srfi-4) + :export ( ;;; Unsigned 8-bit vectors. u8vector? make-u8vector u8vector u8vector-length u8vector-ref u8vector-set! u8vector->list list->u8vector @@ -91,7 +90,7 @@ ;;; 64-bit floating point vectors. f64vector? make-f64vector f64vector f64vector-length f64vector-ref f64vector-set! f64vector->list list->f64vector - ) + )) ;; Make 'srfi-4 available as a feature identifiere to `cond-expand'. diff --git a/srfi/srfi-8.scm b/srfi/srfi-8.scm index 52961ed3a..85b31830e 100644 --- a/srfi/srfi-8.scm +++ b/srfi/srfi-8.scm @@ -42,8 +42,7 @@ ;;; If you do not wish that, delete this exception notice. (define-module (srfi srfi-8) - :use-module (ice-9 receive)) - -(re-export-syntax receive) + :use-module (ice-9 receive) + :re-export-syntax (receive)) (cond-expand-provide (current-module) '(srfi-8)) diff --git a/srfi/srfi-9.scm b/srfi/srfi-9.scm index 7bf032721..b36b11f4e 100644 --- a/srfi/srfi-9.scm +++ b/srfi/srfi-9.scm @@ -83,9 +83,8 @@ ;;; Code: -(define-module (srfi srfi-9)) - -(export-syntax define-record-type) +(define-module (srfi srfi-9) + :export-syntax (define-record-type)) (cond-expand-provide (current-module) '(srfi-9)) diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 1be4e7c60..7ee1d514f 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,10 @@ +2001-10-21 Mikael Djurfeldt + + * lib.scm: Move module the system directives `export', + `export-syntax', `re-export' and `re-export-syntax' into the + `define-module' form. This is the recommended way of exporting + bindings. + 2001-10-18 Dirk Herrmann * tests/syntax.test: Added test cases for 'cond =>' syntax with diff --git a/test-suite/lib.scm b/test-suite/lib.scm index a5a44fa8a..de242bd11 100644 --- a/test-suite/lib.scm +++ b/test-suite/lib.scm @@ -18,9 +18,8 @@ (define-module (test-suite lib) :use-module (ice-9 stack-catch) - :use-module (ice-9 regex)) - -(export + :use-module (ice-9 regex) + :export ( ;; Exceptions which are commonly being tested for. exception:out-of-range exception:unbound-var @@ -40,7 +39,7 @@ make-log-reporter full-reporter user-reporter - format-test-name) + format-test-name)) ;;;; If you're using Emacs's Scheme mode: -- 2.20.1