mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-13 23:20:32 +02:00
Code Activity

define* usage in boot-9

Browse source 
* module/ice-9/boot-9.scm (make-module, make-mutable-parameter): Use
  define*.
This commit is contained in:
Andy Wingo 2010-08-29 11:59:10 -07:00
parent a2220d7ea4
commit e9729cbb2c
1 changed files with 31 additions and 48 deletions
Download patch file Download diff file Expand all files Collapse all files

79
module/ice-9/boot-9.scm
View file

@ -1461,48 +1461,34 @@ If there is no handler at all, Guile prints an error and then exits."
;; Create a new module, perhaps with a particular size of obarray, ;; Create a new module, perhaps with a particular size of obarray,
;; initial uses list, or binding procedure. ;; initial uses list, or binding procedure.
;; ;;
(define make-module (define* (make-module #:optional (size 31) (uses '()) (binder #f))
(lambda args (define %default-import-size
;; Typical number of imported bindings actually used by a module.
600)
(define (parse-arg index default) (if (not (integer? size))
(if (> (length args) index) (error "Illegal size to make-module." size))
(list-ref args index) (if (not (and (list? uses)
default)) (and-map module? uses)))
(error "Incorrect use list." uses))
(if (and binder (not (procedure? binder)))
(error
"Lazy-binder expected to be a procedure or #f." binder))
(define %default-import-size (let ((module (module-constructor (make-hash-table size)
;; Typical number of imported bindings actually used by a module. uses binder #f macroexpand
600) #f #f #f
(make-hash-table %default-import-size)
'()
(make-weak-key-hash-table 31) #f
(make-hash-table 7) #f #f #f)))
(if (> (length args) 3) ;; We can't pass this as an argument to module-constructor,
(error "Too many args to make-module." args)) ;; because we need it to close over a pointer to the module
;; itself.
(set-module-eval-closure! module (standard-eval-closure module))
(let ((size (parse-arg 0 31)) module))
(uses (parse-arg 1 '()))
(binder (parse-arg 2 #f)))
(if (not (integer? size))
(error "Illegal size to make-module." size))
(if (not (and (list? uses)
(and-map module? uses)))
(error "Incorrect use list." uses))
(if (and binder (not (procedure? binder)))
(error
"Lazy-binder expected to be a procedure or #f." binder))
(let ((module (module-constructor (make-hash-table size)
uses binder #f macroexpand
#f #f #f
(make-hash-table %default-import-size)
'()
(make-weak-key-hash-table 31) #f
(make-hash-table 7) #f #f #f)))
;; We can't pass this as an argument to module-constructor,
;; because we need it to close over a pointer to the module
;; itself.
(set-module-eval-closure! module (standard-eval-closure module))
module))))
@ -3080,16 +3066,13 @@ module '(ice-9 q) '(make-q q-length))}."
;;; {Parameters} ;;; {Parameters}
;;; ;;;
(define make-mutable-parameter (define* (make-mutable-parameter init #:optional (converter identity))
(let ((make (lambda (fluid converter) (let ((fluid (make-fluid)))
(lambda args (fluid-set! fluid (converter init))
(if (null? args) (case-lambda
(fluid-ref fluid) (() (fluid-ref fluid))
(fluid-set! fluid (converter (car args)))))))) ((val) (fluid-set! fluid (converter val))))))
(lambda* (init #:optional (converter identity))
(let ((fluid (make-fluid)))
(fluid-set! fluid (converter init))
(make fluid converter)))))