[racket] Internal definition context

At Mon, 14 Jan 2013 01:21:46 +0100, Jens Axel Søgaard wrote:
> Hi All,
> 
> I'd like to change the program below s.t. the
> local-expand uses an internal definition context.
> Simply changing 'top-level to 'module does not work.
> 
> I have tried to use various combinations of
>   - (generate-expand-context #t)
>   - syntax-local-make-definition-context
>   - syntax-local-bind-syntaxes	
> without hitting the right incantation.
> 
> Any hints are welcome.

I think you need to stop local expansion at `define-values', recognize
definitions in the expansion, use `syntax-local-bind-syntaxes', and
finally use `internal-definition-context-apply' on the expressions.

;; ----------------------------------------

#lang racket
(require racket/stxparam
         racket/splicing
         (for-syntax syntax/parse
                     syntax/context
                     racket/syntax))

(begin-for-syntax
  (define *types* '()))

(define-syntax (program stx)
  (syntax-parse stx
    [(_ (def ...) (expr ...))
     (let ()
       (define def-ctx (syntax-local-make-definition-context))
       (define ctx (generate-expand-context))
       (define defs
         (map (lambda (def)
                (define new-def (local-expand def
                                              ctx
                                              (list #'define-values)
                                              def-ctx))
                (syntax-case new-def (define-values)
                  [(define-values (id ...) . _)
                   (syntax-local-bind-syntaxes 
                    (syntax->list #'(id ...))
                    #f
                    def-ctx)])
                new-def)
              (syntax->list #'(def ...))))
       (with-syntax ([(def ...) defs]
                     [(expr ...) 
                      (map (lambda (expr)
                             (internal-definition-context-apply 
                              def-ctx 
                              expr))
                           (syntax->list #'(expr ...)))])
         #'(begin def ... expr ...)))]))

(define-syntax (def stx)
  (syntax-parse stx
    [(_ name type expr)
     (begin
       (set! *types* (cons (cons #'name #'type) *types*))
       #'(define name expr))]))

(program
 ((def x int 42)
  (def y str "foo"))
 ((list x y)))