[plt-scheme] Parameters and servlets

Jens Axel Søgaard wrote:
> Jay McCarthy wrote:

>> I think this approach is most what you want, as cells do something 
>> different, and your `persistent parameters' seem very kludgy
> 
> Yeah, I am not too happy happy about them either.
> 
> The usage of parameterize in start does do what I want - it's just
> that it seems cleaner to define the default values where they "belong".
> 
> That is, what I want, I think, is a
> 
>    (define-default property value)
> 
> form, which can be used anywhere. To use the defaults it would be ok
> to write
> 
>    (define (start initial-request)
>       (with-defaults
>          (html-a-page)))
> 
> Furthermore if module A requires B, which requires C, then defaults
> in C can be overruled by defaults in B.
> 
> Hmm. It sounds as if this a compile-time issue and could be
> solved by using macros.

Here is another attempt, which from superficial testing seems
to work as I want (I might change mind later :-) ).


(module default mzscheme
   (provide with-defaults
            define-default
            override-default)

   (define-for-syntax defaults '())

   (require-for-syntax (prefix srfi: (lib "1.ss" "srfi")))

   (begin-for-syntax
     (define (default-registered? name)
       (not (not (srfi:assoc name defaults module-identifier=?))))

     (define (register-default name val)
       (set! defaults
             (cons (cons name val) defaults))))

   (define-syntax (define-default stx)
     (syntax-case stx ()
       [(define-default name val)
        (begin
          (when (default-registered? #'name)
            (raise-syntax-error #f
               "duplicate definition of default" stx #'name))
          #'(begin
              (begin-for-syntax
                (register-default #'name #'val))
              (define name (make-parameter val))))]))

   (define-syntax (override-default stx)
     (syntax-case stx ()
       [(override-default name val)
        (begin
          (unless (default-registered? #'name)
            (raise-syntax-error #f
               "can't override undefined default" stx #'name))
          #'(begin
              (begin-for-syntax
                (register-default #'name #'val))
              (name val)))]))

   (define-syntax (with-defaults stx)
     (syntax-case stx ()
       [(with-defaults body ...)
           #`(parameterize
                 (#,@(map (lambda (default)
                            #`(#,(car default) #,(cdr default)))
                          (reverse defaults)))
               body ...)])))

Example:

(module c mzscheme
   (require "default.scm")
   (provide e pi)

   (define-default e  2.71828)
   (define-default pi 3.15))


(module b mzscheme
   (require "default.scm" "c.scm")
   (provide pi)

   (override-default pi 3.14))


(module a mzscheme
   (require "default.scm" "b.scm" "c.scm")

   ;(override-default pi 7)

   (with-defaults
       (display (list (pi) (e))))
   (newline)

   (with-defaults
       (parameterize ([pi 2])
         (display (list (pi) (e)))))
   (newline)
)

; Running a gives:

   (3.14 2.71828)
   (2 2.71828)

Removing the outcommenting line in a gives

   (7 2.71828)
   (2 2.71828)

-- 
Jens Axel Søgaard