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

Simplify code for define-option-interface.

Browse source
This commit is contained in:
Neil Jerram 2002-11-04 19:40:49 +00:00
parent 8e733f1095
commit 0983f67f09
2 changed files with 17 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

3
ice-9/ChangeLog
View file

@ -1,5 +1,8 @@
2002-11-04 Neil Jerram <neil@ossau.uklinux.net>
* boot-9.scm (define-option-interface): Simplify code-generation
code.
* debugger/command-loop.scm (read-and-dispatch-command): Import
set-readline-prompt dynamically if we need to. (Previous
arrangement didn't work if this module was loaded before (ice-9

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

@ -2018,32 +2018,22 @@
(set! options (delq! flag options)))
flags)
(,interface options)
(,interface)))))
(make-set! (lambda (interface)
`((name exp)
(,'quasiquote
(begin (,interface (append (,interface)
(list '(,'unquote name)
(,'unquote exp))))
(,interface)))))))
(,interface))))))
(procedure->memoizing-macro
(lambda (exp env)
(cons 'begin
(let* ((option-group (cadr exp))
(interface (car option-group)))
(append (map (lambda (name constructor)
`(define ,name
,(constructor interface)))
(cadr option-group)
(list make-options
make-enable
make-disable))
(map (lambda (name constructor)
`(defmacro ,name
,@(constructor interface)))
(caddr option-group)
(list make-set!)))))))))
(interface (car option-group))
(options/enable/disable (cadr option-group)))
`(begin
(define ,(car options/enable/disable)
,(make-options interface))
(define ,(cadr options/enable/disable)
,(make-enable interface))
(define ,(caddr options/enable/disable)
,(make-disable interface))
(defmacro ,(caaddr option-group) (opt val)
`(,,(car options/enable/disable)
(list ',opt ,val)))))))))
(define-option-interface
(eval-options-interface