mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

* srfi-1.scm (filter, filter!): Removed. (Now implemented in the core.)

Browse source 
* goops/util.scm (filter): Removed.  (Now supplied by core.)

* list.c, list.h (scm_filter, scm_filter_x): New functions.

* debugger/command-loop.scm: Prefix all commands imported from
(ice-9 debugger command-loop) with debugger:.

* boot-9.scm (resolve-interface): Process #:hide; Name custom interfaces
appropriately.
(module-use!, module-use-interfaces!): Remove existing interfaces
on the use-list based on module name rather than interface
identity so that custom interfaces truly replaces their previous
version.
This commit is contained in:
Mikael Djurfeldt 2003-03-11 19:58:14 +00:00
parent b0dff01890
commit c614a00b8c
10 changed files with 143 additions and 62 deletions
Download patch file Download diff file Expand all files Collapse all files

9
ice-9/ChangeLog
View file

@ -1,7 +1,16 @@
2003-03-11 Mikael Djurfeldt <djurfeldt@nada.kth.se>
* debugger/command-loop.scm: Prefix all commands imported from
(ice-9 debugger command-loop) with debugger:.
* boot-9.scm (process-duplicates): Use module-import-interface.
(module-symbol-interface): Removed.
(resolve-interface): Process #:hide; Name custom interfaces
appropriately.
(module-use!, module-use-interfaces!): Remove existing interfaces
on the use-list based on module name rather than interface
identity so that custom interfaces truly replaces their previous
version.
* boot-9.scm (module-override!, make-mutable-parameter,
lookup-duplicates-handlers, default-module-duplicates-handler):

64
ice-9/boot-9.scm
View file

@ -1444,7 +1444,11 @@
;;
(define (module-use! module interface)
(set-module-uses! module
(cons interface (delq! interface (module-uses module))))
(cons interface
(filter (lambda (m)
(not (equal? (module-name m)
(module-name interface))))
(module-uses module))))
(module-modified module))
;; MODULE-USE-INTERFACES! module interfaces
@ -1459,7 +1463,11 @@
(set! uses (delq! (cdr duplicates-info) uses))
;; remove interfaces to be added
(for-each (lambda (interface)
(set! uses (delq! interface uses)))
(set! uses
(filter (lambda (m)
(not (equal? (module-name m)
(module-name interface))))
uses)))
interfaces)
;; add interfaces to use list
(set-module-uses! module uses)
@ -1663,7 +1671,7 @@
;; Return a module that is an interface to the module designated by
;; NAME.
;;
;; `resolve-interface' takes two keyword arguments:
;; `resolve-interface' takes four keyword arguments:
;;
;; #:select SELECTION
;;
@ -1676,17 +1684,20 @@
;; are made available in the interface. Bindings that are added later
;; are not picked up.
;;
;; #:renamer RENAMER
;; #:hide BINDINGS
;;
;; RENAMER is a procedure that takes a symbol and returns its new
;; name. The default is to append a specified prefix (see below) or
;; not perform any renaming.
;; BINDINGS is a list of bindings which should not be imported.
;;
;; #:prefix PREFIX
;;
;; PREFIX is a symbol that will be appended to each exported name.
;; The default is to not perform any renaming.
;;
;; #:renamer RENAMER
;;
;; RENAMER is a procedure that takes a symbol and returns its new
;; name. The default is not perform any renaming.
;;
;; Signal "no code for module" error if module name is not resolvable
;; or its public interface is not available. Signal "no binding"
;; error if selected binding does not exist in the used module.
@ -1703,6 +1714,7 @@
def)))
(let* ((select (get-keyword-arg args #:select #f))
(hide (get-keyword-arg args #:hide '()))
(renamer (or (get-keyword-arg args #:renamer #f)
(let ((prefix (get-keyword-arg args #:prefix #f)))
(and prefix (symbol-prefix-proc prefix)))
@ -1711,27 +1723,40 @@
(public-i (and module (module-public-interface module))))
(and (or (not module) (not public-i))
(error "no code for module" name))
(if (and (not select) (eq? renamer identity))
(if (and (not select) (null? hide) (eq? renamer identity))
public-i
(let ((selection (or select (module-map (lambda (sym var) sym)
public-i)))
(custom-i (make-module 31)))
(set-module-kind! custom-i 'interface)
(set-module-kind! custom-i 'custom-interface)
(set-module-name! custom-i name)
;; XXX - should use a lazy binder so that changes to the
;; used module are picked up automatically.
(for-each (lambda (bspec)
(let* ((direct? (symbol? bspec))
(orig (if direct? bspec (car bspec)))
(seen (if direct? bspec (cdr bspec))))
(module-add! custom-i (renamer seen)
(or (module-local-variable public-i orig)
(module-local-variable module orig)
(error
;; fixme: format manually for now
(simple-format
#f "no binding `~A' in module ~A"
orig name))))))
(seen (if direct? bspec (cdr bspec)))
(var (or (module-local-variable public-i orig)
(module-local-variable module orig)
(error
;; fixme: format manually for now
(simple-format
#f "no binding `~A' in module ~A"
orig name)))))
(if (memq orig hide)
(set! hide (delq! orig hide))
(module-add! custom-i
(renamer seen)
var))))
selection)
;; Check that we are not hiding bindings which don't exist
(for-each (lambda (binding)
(if (not (module-local-variable public-i binding))
(error
(simple-format
#f "no binding `~A' to hide in module ~A"
binding name))))
hide)
custom-i))))
(define (symbol-prefix-proc prefix)
@ -2551,6 +2576,7 @@
(define keys
;; sym key quote?
'((:select #:select #t)
(:hide #:hide #t)
(:prefix #:prefix #t)
(:renamer #:renamer #f)))
(if (not (pair? (car spec)))
@ -2853,7 +2879,7 @@
(define (make-duplicates-interface)
(let ((m (make-module)))
(set-module-kind! m 'interface)
(set-module-kind! m 'custom-interface)
(set-module-name! m 'duplicates)
m))

30
ice-9/debugger/command-loop.scm
View file

@ -1,6 +1,6 @@
;;;; Guile Debugger command loop
;;; Copyright (C) 1999, 2001, 2002 Free Software Foundation, Inc.
;;; Copyright (C) 1999, 2001, 2002, 2003 Free Software Foundation, Inc.
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
@ -42,7 +42,7 @@
;;; If you do not wish that, delete this exception notice.
(define-module (ice-9 debugger command-loop)
#:use-module (ice-9 debugger commands)
#:use-module ((ice-9 debugger commands) :prefix debugger:)
#:export (debugger-command-loop
debugger-command-loop-error
debugger-command-loop-quit)
@ -538,21 +538,21 @@
(error "Unknown value from lookup-command:" value)))))
state))
(define-command "frame" '('optional exact-nonnegative-integer) frame)
(define-command "frame" '('optional exact-nonnegative-integer) debugger:frame)
(define-command "position" '() position)
(define-command "position" '() debugger:position)
(define-command "up" '('optional exact-integer) up)
(define-command "up" '('optional exact-integer) debugger:up)
(define-command "down" '('optional exact-integer) down)
(define-command "down" '('optional exact-integer) debugger:down)
(define-command "backtrace" '('optional exact-integer) backtrace)
(define-command "backtrace" '('optional exact-integer) debugger:backtrace)
(define-command "evaluate" '(object) evaluate)
(define-command "evaluate" '(object) debugger:evaluate)
(define-command '("info" "args") '() info-args)
(define-command '("info" "args") '() debugger:info-args)
(define-command '("info" "frame") '() info-frame)
(define-command '("info" "frame") '() debugger:info-frame)
(define-command "quit" '()
(lambda (state)
@ -567,12 +567,12 @@
(define-command-alias '("info" "stack") "backtrace")
(define-command "continue" '() continue)
(define-command "continue" '() debugger:continue)
(define-command "finish" '() finish)
(define-command "finish" '() debugger:finish)
(define-command "trace-finish" '() trace-finish)
(define-command "trace-finish" '() debugger:trace-finish)
(define-command "step" '('optional exact-integer) step)
(define-command "step" '('optional exact-integer) debugger:step)
(define-command "next" '('optional exact-integer) next)
(define-command "next" '('optional exact-integer) debugger:next)