Simplify code for define-option-interface.

diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog
index 0e8f70d..22ab2fe 100644 (file)
--- a/ice-9/ChangeLog
+++ b/ice-9/ChangeLog
@@ -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

diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm
index c3ef7f6..b6f010c 100644 (file)
--- a/ice-9/boot-9.scm
+++ b/ice-9/boot-9.scm
@@ -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!)))))))))
+       (let* ((option-group (cadr exp))
+             (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