[racket-dev] submodules

From: Eli Barzilay (eli at barzilay.org)
Date: Fri Mar 9 18:18:39 EST 2012

A few minutes ago, Eli Barzilay wrote:
> [...] Here's what I have in mind:

(Other things were broken there...)

Here's the code that works now:

  (sub tests (require tests/eli-tester)) ; make it known before main
  (sub main (printf "Welcome to MY library!\n"))
  
  (define (plus x y) (+ x y))
  
  (sub tests (test (plus 1 2) => 3))
  
  (sub main (require (submod "." ".." tests))
            (printf "Goodbye.\n"))

There is the obvious output order here where there main printouts come
after the test message because `tests' is instantiated before the
printout forms in `main'.  If the test is changed to a failure, it
throws an error and you won't see that printout.  Complete code below,
with the same example done with rackunit.


-------------------------------------------------------------------------------
#lang racket/base

(require (for-syntax racket/base))
(define-for-syntax subs '())
(define-syntax (sub stx)
  (syntax-case stx ()
    [(_ name E ...)
     (identifier? #'name)
     (let ([sub (assq (syntax-e #'name) subs)])
       (if sub
         (begin ((cdr sub) #'(begin E ...))
                #'(begin))
         (with-syntax ([(submod) (generate-temporaries #'(name))])
           (let ([bodies (list (syntax-local-introduce #'(begin E ...)))])
             (set! subs
                   (cons (cons (syntax-e #'name)
                               (case-lambda
                                 [(E) (set! bodies (cons E bodies))]
                                 [()  (reverse bodies)]))
                         subs)))
           (syntax-local-lift-module-end-declaration #'(submod))
           #'(define-syntax (submod stx)
               (with-syntax ([(E* (... ...)) ((cdr (assq 'name subs)))])
                 (syntax-local-introduce
                  #'(module* name #f E* (... ...))))))))]))


(sub tests (require rackunit)) ; make it known before main
(sub main (printf "Welcome to MY library!\n"))

(define (plus x y) (+ x y))

(sub tests (check-equal? (plus 1 2) 3)
           (check-equal? (plus 1 2) 33))

(sub main (require (submod "." ".." tests))
          (printf "Goodbye.\n"))
-------------------------------------------------------------------------------


-- 
          ((lambda (x) (x x)) (lambda (x) (x x)))          Eli Barzilay:
                    http://barzilay.org/                   Maze is Life!

Posted on the dev mailing list.