suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Contracts on dynamic-requires

Browse Source 
svn: r12940
This commit is contained in:
Jay McCarthy 2008-12-26 15:54:23 +00:00
parent 02153a2235
commit d00db36f66
1 changed files with 35 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
collects/web-server/servlet/setup.ss
View File

@ -112,22 +112,47 @@
(define s (load/use-compiled a-path)) (define s (load/use-compiled a-path))
(cond (cond
[(void? s) [(void? s)
(let* ([module-name `(file ,(path->string a-path))] (let* ([path-string (path->string a-path)]
[version (dynamic-require module-name 'interface-version)]) [path-sym (string->symbol path-string)]
[neg-blame 'web-server]
[pos-blame path-sym]
[module-name `(file ,path-string)]
[mk-loc
(lambda (name)
(list (make-srcloc a-path #f #f #f #f)
name))]
[version
(contract (symbols 'v1 'v2 'stateless)
(dynamic-require module-name 'interface-version)
pos-blame neg-blame
(mk-loc "interface-version"))])
(case version (case version
[(v1) [(v1)
(let ([timeout (dynamic-require module-name 'timeout)] (let ([timeout (contract number?
[start (dynamic-require module-name 'start)]) (dynamic-require module-name 'timeout)
pos-blame neg-blame
(mk-loc "timeout"))]
[start (contract (request? . -> . response?)
(dynamic-require module-name 'start)
pos-blame neg-blame
(mk-loc "start"))])
(make-v1.servlet (directory-part a-path) timeout start))] (make-v1.servlet (directory-part a-path) timeout start))]
[(v2) [(v2)
(let ([start (dynamic-require module-name 'start)] (let ([start (contract (request? . -> . response?)
[manager (dynamic-require module-name 'manager)]) (dynamic-require module-name 'start)
pos-blame neg-blame
(mk-loc "start"))]
[manager (contract manager?
(dynamic-require module-name 'manager)
pos-blame neg-blame
(mk-loc "manager"))])
(make-v2.servlet (directory-part a-path) manager start))] (make-v2.servlet (directory-part a-path) manager start))]
[(stateless) [(stateless)
(let ([start (dynamic-require module-name 'start)]) (let ([start (contract (request? . -> . response?)
(make-stateless.servlet (directory-part a-path) start))] (dynamic-require module-name 'start)
[else pos-blame neg-blame
(error 'path->servlet "unknown servlet version ~e, must be 'v1, 'v2, or 'stateless" version)]))] (mk-loc "start"))])
(make-stateless.servlet (directory-part a-path) start))]))]
[(response? s) [(response? s)
(make-v1.servlet (directory-part a-path) timeouts-default-servlet (make-v1.servlet (directory-part a-path) timeouts-default-servlet
(v0.response->v1.lambda s a-path))] (v0.response->v1.lambda s a-path))]