[plt-scheme] define-syntax help

On 3/23/07, support at taxupdate.com <support at taxupdate.com> wrote:

> I started to look at the docs on this, and it seems I'd have to convert any
> syntax which uses this to functions, right?  Unless the parameterization would
> be available during syntax expansion?

There are two things you can do --- either use regular parameters,
which are available only at runtime, or syntax parameters, which are
available at syntax expansion time. Here's an implementation of the
constructs from your original question that uses regular parameters:

(module implicit-object-dynamic mzscheme

  (provide lookup register)

  (define *field-hash* (make-hash-table))
  (define lookup-context (make-parameter #f))

  ;; syntaxes->field-symbol : syntax[id] syntax[id] -> symbol
  ;; given symbols 'a and 'b, produces 'a.b
  (define (symbols->field-symbol o f)
    (string->symbol (format "~a.~a" o f)))

  (define-syntax (lookup stx)
    (syntax-case stx ()
      [(_ field)
       (syntax/loc stx (lookup/internal (lookup-context) 'field))]
      [(_ obj field)
       (syntax/loc stx (lookup/internal 'obj 'field))]))

  (define (lookup/internal obj field)
    (unless obj
      (error 'lookup "cannot use lookup shorthand outside the dynamic
context of a register statement"))
    (hash-table-get *field-hash* (symbols->field-symbol obj field)))

  (define-syntax (register stx)
    (syntax-case stx ()
      [(_ field expr obj)
       (syntax/loc stx
         (hash-table-put! *field-hash*
          (symbols->field-symbol 'obj 'field)
          (parameterize ([lookup-context 'obj]) expr)))])))

Using this module, if you run

(begin
      (register test 2 main)
      (register value 7 other)
      (let* ([v1 (lookup main test)]
             [v2 (lookup other value)]
             [v3 (begin
                   (register amount (* 2 (lookup value)) other)
                   (lookup other amount))])
        (list v1 v2 v3))))

you get (2 7 14) as desired. The way it works is that register expands
to an expression that dynamically binds (in the sense of Lisp dynamic
binding) the parameter lookup-context to the name of the object being
updated during evaluation of the expression that will result in a new
value.  The implicit lookup syntax just expands to a plain function
that just checks that dynamic variable and uses its result.

There are other consequences of using dynamic variables, though, that
you might find undesirable. If you define a function

(define (myfun) (lookup somefield))

calls to myfun will succeed if they're made in the context of a
register statement and fail otherwise:

(register somefield 8 bar)
(register foo (myfun) bar) ;; succeeds
(myfun) ;; fails

Also, (lookup x) is never a syntax error:

(if (some-condition)
    (lookup obj current-value)
    (* (lookup current-value) 2))  ;; oops, we forgot obj, but it's
not caught until runtime

Maybe this is what you want. If, on the other hand, the intention is
to make (lookup x) syntactically illegal except in the lexical context
of a register expression, then we can do that too. The trick is to
move the parameter so that instead of being active at runtime, it's
active at macro-expansion time, using what are called
syntax-parameters available from (lib "stxparam.ss"):

(module implicit-object-static mzscheme

  (require (lib "stxparam.ss"))
  (require-for-syntax (lib "stxparam.ss"))
  (provide lookup register)

  (define *field-hash* (make-hash-table))
  (define-syntax-parameter lookup-context #f)

  ;; syntaxes->field-symbol : syntax[id] syntax[id] -> symbol
  ;; given identifiers a and b, produces 'a.b
  (define-for-syntax (syntaxes->field-symbol o f)
    (string->symbol (format "~a.~a" (syntax-object->datum o)
(syntax-object->datum f))))

  (define-syntax (lookup stx)
    (syntax-case stx ()
      [(_ field)
       (unless (syntax-parameter-value #'lookup-context)
         (raise-syntax-error #f "cannot use lookup shorthand outside
the lexical context of a register statement" stx))
       (with-syntax ([implicit-object-name (syntax-parameter-value
#'lookup-context)])
         (syntax/loc stx (lookup implicit-object-name field)))]
      [(_ obj field)
       (with-syntax ([object-symbol (syntaxes->field-symbol #'obj #'field)])
         (syntax/loc stx (hash-table-get *field-hash* 'object-symbol)))]))

  (define-syntax (register stx)
    (syntax-case stx ()
      [(_ field expr obj)
       (with-syntax ([object-symbol (syntaxes->field-symbol #'obj #'field)])
          (syntax/loc stx
            (syntax-parameterize ((lookup-context #'obj))
              (hash-table-put! *field-hash* 'object-symbol expr))))])))

In this version, lookup-context is a parameter that only exists at
compile-time, not at runtime. At compile time, register does the same
parameterization, binding lookup-context to the name of the object
currently being registered, but now, rather than being bound during
the _evaluation_ of register's expression it's being bound during the
_expansion_ of that expression. The consequence of this is that
lookups that don't specify an object must be syntactically nested
inside   registers, or they will be syntax errors. So myfun, defined
above, is no longer syntactically legal, and the if statement will be
a statically-detected syntax error, but the working example will still
produce (2 7 14) as we wanted originally.

-jacob