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

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

@ -2210,12 +2210,20 @@ 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) ;; Below follow the macros defining the run-time option interfaces.
(make-options (lambda (interface)
`(lambda args
(cond ((null? args) (,interface))
((list? (car args))
(,interface (car args)) (,interface))
(else (for-each
(lambda (option)
(display (option-name option)) (display (option-name option))
(if (< (string-length (if (< (string-length
(symbol->string (option-name option))) (symbol->string (option-name option)))
@ -2225,16 +2233,7 @@ module '(ice-9 q) '(make-q q-length))}."
(display (option-value option)) (display (option-value option))
(display #\tab) (display #\tab)
(display (option-documentation option)) (display (option-documentation option))
(newline))) (newline))
;; Below follow the macros defining the run-time option interfaces.
(make-options (lambda (interface)
`(lambda args
(cond ((null? args) (,interface))
((list? (car args))
(,interface (car args)) (,interface))
(else (for-each ,print-option
(,interface #t))))))) (,interface #t)))))))
(make-enable (lambda (interface) (make-enable (lambda (interface)
@ -2250,10 +2249,7 @@ 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)
(let* ((option-group (cadr exp))
(interface (car option-group))
(options/enable/disable (cadr option-group))) (options/enable/disable (cadr option-group)))
`(begin `(begin
(define ,(car options/enable/disable) (define ,(car options/enable/disable)
@ -2265,7 +2261,7 @@ module '(ice-9 q) '(make-q q-length))}."
(defmacro ,(caaddr option-group) (opt val) (defmacro ,(caaddr option-group) (opt val)
`(,',(car options/enable/disable) `(,',(car options/enable/disable)
(append (,',(car options/enable/disable)) (append (,',(car options/enable/disable))
(list ',opt ,val)))))))))) (list ',opt ,val))))))))
(define-option-interface (define-option-interface
(eval-options-interface (eval-options-interface