96 lines
2.3 KiB
Scheme
96 lines
2.3 KiB
Scheme
|
;; Structures and interfaces for servlets.
|
||
|
|
|
||
|
|
(define-interface rt-module-language-interface
|
||
|
|
(export ((lambda-interface
|
||
|
|
with-names-from-rt-structure)
|
||
|
|
:syntax)
|
||
|
|
reify-structure
|
||
|
|
load-structure
|
||
|
|
load-config-file
|
||
|
|
rt-structure-binding))
|
||
|
|
|
||
|
|
(define-interface rt-modules-interface
|
||
|
|
(export interface-value-names
|
||
|
|
reify-structure
|
||
|
|
load-config-file
|
||
|
|
rt-structure-binding
|
||
|
|
load-structure))
|
||
|
|
|
||
|
|
(define-structure rt-module-language rt-module-language-interface
|
||
|
|
(open scheme
|
||
|
|
rt-modules)
|
||
|
|
(for-syntax (open scheme
|
||
|
|
rt-modules))
|
||
|
|
(begin
|
||
|
|
(define-syntax lambda-interface
|
||
|
|
(lambda (expr rename compare)
|
||
|
|
(let ((%lambda (rename 'lambda))
|
||
|
|
(interface-name (cadr expr))
|
||
|
|
(body (cddr expr)))
|
||
|
|
`(,%lambda ,(interface-value-names interface-name) ,@body))))
|
||
|
|
|
||
|
|
;(with-names-from-rt-structure plugin plugin-interface (main))
|
||
|
|
(define-syntax with-names-from-rt-structure
|
||
|
|
(lambda (expr rename compare)
|
||
|
|
(let ((%lambda (rename 'lambda))
|
||
|
|
(%let (rename 'let))
|
||
|
|
(%rt-structure-value (rename 'rt-structure-value))
|
||
|
|
(%rt-structure-binding (rename 'rt-structure-binding))
|
||
|
|
(rt-structure (cadr expr))
|
||
|
|
(interface-name (caddr expr))
|
||
|
|
(body (cdddr expr)))
|
||
|
|
(let ((ivn (interface-value-names interface-name)))
|
||
|
|
`(,%let ((,%rt-structure-value ,rt-structure))
|
||
|
|
((,%lambda ,ivn ,@body)
|
||
|
|
,@(map (lambda (name)
|
||
|
|
`(,%rt-structure-binding ,%rt-structure-value ',name))
|
||
|
|
ivn)))))))))
|
||
|
|
|
||
|
|
(define-structure rt-modules rt-modules-interface
|
||
|
|
(open scheme
|
||
|
|
meta-types ; syntax-type
|
||
|
|
interfaces ; for-each-declaration
|
||
|
|
define-record-types
|
||
|
|
records
|
||
|
|
signals
|
||
|
|
bindings
|
||
|
|
packages
|
||
|
|
packages-internal
|
||
|
|
locations
|
||
|
|
environments
|
||
|
|
ensures-loaded
|
||
|
|
package-commands-internal)
|
||
|
|
(files rt-module))
|
||
|
|
|
||
|
|
(define-interface servlet-handler-interface
|
||
|
|
(export servlet-handler))
|
||
|
|
|
||
|
|
|
||
|
|
(define-structures
|
||
|
|
((servlet-handler servlet-handler-interface)
|
||
|
|
(plugin-utilities plugin-utilities-interface))
|
||
|
|
(open httpd-responses
|
||
|
|
httpd-request
|
||
|
|
uri
|
||
|
|
tables ;hash-tables
|
||
|
|
define-record-types
|
||
|
|
rt-module-language ;get structures dynamically
|
||
|
|
srfi-13
|
||
|
|
srfi-14 ;CHAR-SET:DIGIT
|
||
|
|
handle-fatal-error
|
||
|
|
random ;not quite random
|
||
|
|
locks
|
||
|
|
thread-cells
|
||
|
|
scsh
|
||
|
|
scheme
|
||
|
|
)
|
||
|
|
(files servlet-handler))
|
||
|
|
|
||
|
|
(define-interface plugin-utilities-interface
|
||
|
|
(export send/suspend
|
||
|
|
send/finish
|
||
|
|
))
|
||
|
|
|
||
|
|
(define-interface plugin-interface
|
||
|
|
(export main))
|