raco setup: fix command-line argument handling

racket/collects/setup/option.rkt

@@ -2,7 +2,8 @@
 (require racket/future)
 
 ;; other params are provided by declaration
-(provide set-flag-params
+(provide call-with-flag-params
+         set-flag-params
 	 setup-program-name
 	 specific-collections
 	 specific-planet-dirs
@@ -20,14 +21,28 @@
       (let ([param (make-parameter default)])
 	(defined-flag-params (cons (cons 'name param) (defined-flag-params)))
 	param))))
+
+;; this macro is used to actually do the setting, `more ...' is for additional
+;; parameters to set
+(define (call-with-flag-params flags k)
+  (let loop ([flag-params (defined-flag-params)])
+    (cond
+     [(null? flag-params) (k)]
+     [else 
+      (define name+param (car flag-params))
+      (define x (assq (car name+param) flags))
+      (if x
+          (parameterize ([(cdr name+param) (cadr x)])
+            (loop (cdr flag-params)))
+          (loop (cdr flag-params)))])))
+
+;; Imperative version of `with-flag-params':
+(define-syntax-rule (set-flag-params flags more ...)
+  (set-flag-params* flags (list* (cons 'more more) ... (defined-flag-params))))
 (define (set-flag-params* flags flag-params)
   (for ([name+param flag-params])
     (cond [(assq (car name+param) flags)
            => (lambda (x) ((cdr name+param) (cadr x)))])))
-;; this macro is used to actually do the setting, `more ...' is for additional
-;; parameters to set
-(define-syntax-rule (set-flag-params flags more ...)
-  (set-flag-params* flags (list* (cons 'more more) ... (defined-flag-params))))
 
 (define setup-program-name (make-parameter "raco setup"))
 

racket/collects/setup/setup-go.rkt

@@ -7,14 +7,18 @@
   (define-values (short-name x-flags x-specific-collections x-specific-planet-packages x-archives)
     (parse-cmdline (current-command-line-arguments)))
 
+  (define (has-x-flag? s)
+    (define a (assq s x-flags))
+    (and a (cadr a)))
+
   (parameterize
    ;; Converting parse-cmdline results into parameter settings:
    ([current-target-plt-directory-getter
-     (if (assq 'all-users x-flags)
+     (if (has-x-flag? 'all-users)
          (lambda (preferred main-collects-parent-dir choices) 
            main-collects-parent-dir)
          (current-target-plt-directory-getter))]
-    [trust-existing-zos (or (assq 'trust-existing-zos x-flags)
+    [trust-existing-zos (or (has-x-flag? 'trust-existing-zos)
                             (trust-existing-zos))]
     [specific-collections x-specific-collections]
     [archives x-archives]
@@ -22,4 +26,6 @@
     
     [setup-program-name short-name])
    
-   (setup-core)))
+   (call-with-flag-params
+    x-flags
+    setup-core)))