Fig bugs in the flag library.

Now bool flags are handled properly. We have a compiler!!

1 files changed, 22 insertions, 10 deletions

diff --git a/csc/flag.csc b/csc/flag.csc
index c328dcf..c0a28a8 100644
--- a/csc/flag.csc
+++ b/csc/flag.csc
@@ -38,14 +38,26 @@
 
 
     (define *parsers* (make-map compare-strings))
+    ; I'm working around a Guile bug, which wrongly concludes
+    ; that *parsers* is immutable.
+    (set! *parsers* *parsers*)
+
+
+    (define-record-type <flag>
+      (make-flag bool? setter)
+      flag?
+      (bool? flag-bool?)
+      (setter flag-setter))
 
 
     (define-syntax define-flag
       (syntax-rules ()
         ((define-flag name flag type default)
-          (define name (begin
-                         (set! *parsers* (insert *parsers* flag (lambda (x) (set! name (type x)))))
-                         default)))))
+          (begin
+            (define name default)
+            (set! *parsers* (insert *parsers* flag
+                              (make-flag (eq? type bool-flag)
+                                         (lambda (x) (set! name (type x))))))))))
 
 
     (define *args* '())
@@ -85,13 +97,13 @@
                               (set! name a)
                               b)
                             (_ #f)))
-            (define parser (guard (e ((key-not-found-error? e)
-                                       (raise (make-parse-error "flag provided but not defined" s))))
-                             (lookup *parsers* name)))
-            (if (eq? parser bool-flag)  ; Special case: doesn't need an arg.
+            (define flag (guard (e ((key-not-found-error? e)
+                                     (raise (make-parse-error "flag provided but not defined" s))))
+                           (lookup *parsers* name)))
+            (if (flag-bool? flag)  ; Special case: doesn't need an arg.
               (if value
-                (parser value)
-                (parser "true"))
+                ((flag-setter flag) value)
+                ((flag-setter flag) "true"))
               (begin
                 ; It must have a value, which might be the next argument.
                 (when (and (not value)
@@ -101,7 +113,7 @@
                   (set! args (cdr args)))
                 (unless value
                   (raise (make-parse-error "flag needs an argument" s)))
-                (parser value)))
+                ((flag-setter flag) value)))
             #t)))
       (loop while (parse-one))
       (set! *args* args))))