#lang scheme/base
(require scheme/unit
mzlib/defmacro
(for-syntax scheme/base
(only-in (lib "1.ss" "srfi") lset-difference))
)
(provide with-library
define-base-lib
define-lib
define-lib-aux )
(define-signature starters^ (req))
(define-signature empty-sig^ ())
(begin-for-syntax
(define LIB-NAMES '(req server-start))
)
(define-macro (define-lib-sig)
`(define-signature lib^ ,(cons '(define-syntaxes (define-page)
(values (syntax-rules ()
((_ (page-name arg ...) body ...)
(define-controller (page-name req arg ...)
body ...)))))
LIB-NAMES)))
(define-lib-sig)
(define-syntax with-library
(syntax-rules ()
((_ ((req req-val) prefixed-server-start-iden base-lib@ extended-lib@) body ...)
(let* ((starters@ (unit
(import)
(export starters^)
(define req req-val)))
(main@ (unit
(import (prefix web: lib^))
(export empty-sig^)
body ...
(prefixed-server-start-iden)))
(import-free@ (compound-unit (import)
(export RESULT)
(link [((STARTERS : starters^)) starters@]
[((BASE : lib^)) base-lib@ STARTERS]
[((EXT : lib^)) extended-lib@ BASE]
[((RESULT : empty-sig^)) main@ EXT]))))
(invoke-unit import-free@)))))
(define-syntax define-base-lib
(syntax-rules (define)
((_ name (req-iden prefixed-req-iden)
(define (fn arg ...) body ...)
...)
(define-unit name
(import (prefix web: starters^))
(export lib^)
(define req-iden prefixed-req-iden)
(define (fn arg ...) body ...)
...))))
(define-macro (define-lib lib-name . def-exprs)
(let ((def-idens (map caadr def-exprs)))
`(define-lib-aux ,lib-name ,(map (lambda (iden)
(list iden
(string->symbol
(string-append
"web:"
(symbol->string iden)))))
(lset-difference eq? LIB-NAMES def-idens))
,def-exprs)))
(define-syntax define-lib-aux
(syntax-rules (define)
((_ lib-name ((not-overridden prefixed-not-overridden) ...)
((define (fn arg ...) body ...) ...))
(define-unit lib-name
(import (prefix web: lib^))
(export lib^)
(define not-overridden prefixed-not-overridden) ...
(define (fn arg ...) body ...) ...))))