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> 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 * debugger/command-loop.scm (read-and-dispatch-command): Import
set-readline-prompt dynamically if we need to. (Previous set-readline-prompt dynamically if we need to. (Previous
arrangement didn't work if this module was loaded before (ice-9 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))) (set! options (delq! flag options)))
flags) flags)
(,interface options) (,interface options)
(,interface))))) (,interface))))))
(make-set! (lambda (interface)
`((name exp)
(,'quasiquote
(begin (,interface (append (,interface)
(list '(,'unquote name)
(,'unquote exp))))
(,interface)))))))
(procedure->memoizing-macro (procedure->memoizing-macro
(lambda (exp env) (lambda (exp env)
(cons 'begin
(let* ((option-group (cadr exp)) (let* ((option-group (cadr exp))
(interface (car option-group))) (interface (car option-group))
(append (map (lambda (name constructor) (options/enable/disable (cadr option-group)))
`(define ,name `(begin
,(constructor interface))) (define ,(car options/enable/disable)
(cadr option-group) ,(make-options interface))
(list make-options (define ,(cadr options/enable/disable)
make-enable ,(make-enable interface))
make-disable)) (define ,(caddr options/enable/disable)
(map (lambda (name constructor) ,(make-disable interface))
`(defmacro ,name (defmacro ,(caaddr option-group) (opt val)
,@(constructor interface))) `(,,(car options/enable/disable)
(caddr option-group) (list ',opt ,val)))))))))
(list make-set!)))))))))
(define-option-interface (define-option-interface
(eval-options-interface (eval-options-interface