mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-15 02:00:22 +02:00
Code Activity

turn define-option-interface into a defmacro

Browse source 
* ice-9/boot-9.scm (define-option-interface): Turn into a defmacro
  instead of an mmacro.
This commit is contained in:
Andy Wingo 2008-09-01 23:51:30 -07:00
parent 373d251b4d
commit 27af6bc2b3
1 changed files with 27 additions and 31 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -2210,23 +2210,11 @@ module '(ice-9 q) '(make-q q-length))}."
;;; {Run-time options} ;;; {Run-time options}
;;; ;;;
(define define-option-interface (defmacro define-option-interface (option-group)
(let* ((option-name car) (let* ((option-name car)
(option-value cadr) (option-value cadr)
(option-documentation caddr) (option-documentation caddr)
(print-option (lambda (option)
(display (option-name option))
(if (< (string-length
(symbol->string (option-name option)))
8)
(display #\tab))
(display #\tab)
(display (option-value option))
(display #\tab)
(display (option-documentation option))
(newline)))
;; Below follow the macros defining the run-time option interfaces. ;; Below follow the macros defining the run-time option interfaces.
(make-options (lambda (interface) (make-options (lambda (interface)
@ -2234,8 +2222,19 @@ module '(ice-9 q) '(make-q q-length))}."
(cond ((null? args) (,interface)) (cond ((null? args) (,interface))
((list? (car args)) ((list? (car args))
(,interface (car args)) (,interface)) (,interface (car args)) (,interface))
(else (for-each ,print-option (else (for-each
(,interface #t))))))) (lambda (option)
(display (option-name option))
(if (< (string-length
(symbol->string (option-name option)))
8)
(display #\tab))
(display #\tab)
(display (option-value option))
(display #\tab)
(display (option-documentation option))
(newline))
(,interface #t)))))))
(make-enable (lambda (interface) (make-enable (lambda (interface)
`(lambda flags `(lambda flags
@ -2250,22 +2249,19 @@ module '(ice-9 q) '(make-q q-length))}."
flags) flags)
(,interface options) (,interface options)
(,interface)))))) (,interface))))))
(procedure->memoizing-macro (let* ((interface (car option-group))
(lambda (exp env) (options/enable/disable (cadr option-group)))
(let* ((option-group (cadr exp)) `(begin
(interface (car option-group)) (define ,(car options/enable/disable)
(options/enable/disable (cadr option-group))) ,(make-options interface))
`(begin (define ,(cadr options/enable/disable)
(define ,(car options/enable/disable) ,(make-enable interface))
,(make-options interface)) (define ,(caddr options/enable/disable)
(define ,(cadr options/enable/disable) ,(make-disable interface))
,(make-enable interface)) (defmacro ,(caaddr option-group) (opt val)
(define ,(caddr options/enable/disable) `(,',(car options/enable/disable)
,(make-disable interface)) (append (,',(car options/enable/disable))
(defmacro ,(caaddr option-group) (opt val) (list ',opt ,val))))))))
`(,',(car options/enable/disable)
(append (,',(car options/enable/disable))
(list ',opt ,val))))))))))
(define-option-interface (define-option-interface
(eval-options-interface (eval-options-interface