sunet/scheme/httpd/surflets/packages.scm

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))