Use Sunterlib's rt-modules implementation instead of our own.
This commit is contained in:
parent
6c80f06dd6
commit
91da112ec1
5
INSTALL
5
INSTALL
|
@ -16,6 +16,11 @@ recommended that you read it before installing your first scsh
|
||||||
package. What follows is a very brief summary of this documentation,
|
package. What follows is a very brief summary of this documentation,
|
||||||
intended to get you started quickly.
|
intended to get you started quickly.
|
||||||
|
|
||||||
|
In addition, you need to have the Sunterlib library installed. See
|
||||||
|
|
||||||
|
http://www.scsh.net/resources/sunterlib.html
|
||||||
|
|
||||||
|
for more information about obtaining and installing Sunterlib.
|
||||||
|
|
||||||
Installation
|
Installation
|
||||||
============
|
============
|
||||||
|
|
|
@ -255,25 +255,6 @@
|
||||||
thread-safe-counter-next!
|
thread-safe-counter-next!
|
||||||
thread-safe-counter?))
|
thread-safe-counter?))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;; These two are from Martin Gasbichler:
|
|
||||||
(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-interface with-locks-interface
|
(define-interface with-locks-interface
|
||||||
(export with-lock*
|
(export with-lock*
|
||||||
(with-lock :syntax)))
|
(with-lock :syntax)))
|
||||||
|
@ -440,7 +421,7 @@
|
||||||
let-opt ;:OPTIONAL
|
let-opt ;:OPTIONAL
|
||||||
locks ;MAKE-LOCK et al.
|
locks ;MAKE-LOCK et al.
|
||||||
profiling ;PROFILE-SPACE
|
profiling ;PROFILE-SPACE
|
||||||
rt-module-language ;get structures dynamically
|
rt-modules ;get structures dynamically
|
||||||
scheme-with-scsh ;regexp et al.
|
scheme-with-scsh ;regexp et al.
|
||||||
search-trees
|
search-trees
|
||||||
shift-reset ;SHIFT and RESET
|
shift-reset ;SHIFT and RESET
|
||||||
|
@ -678,53 +659,6 @@
|
||||||
surflets/surflet-sxml)
|
surflets/surflet-sxml)
|
||||||
(files send-html))
|
(files send-html))
|
||||||
|
|
||||||
;; These two are from Martin Gasbichler:
|
|
||||||
(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 surflet surflet-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-structure with-locks with-locks-interface
|
(define-structure with-locks with-locks-interface
|
||||||
(open scheme
|
(open scheme
|
||||||
locks)
|
locks)
|
||||||
|
|
|
@ -1,58 +0,0 @@
|
||||||
;; rt-module.scm
|
|
||||||
;; Copyright Martin Gasbichler, 2002
|
|
||||||
|
|
||||||
;; Receipt:
|
|
||||||
;;(load-config-file "test.scm") --> nothing
|
|
||||||
;; load config file containing structure definition
|
|
||||||
;;
|
|
||||||
;; (reify-structure 'surflet) --> #{Rt-stucture surflet}
|
|
||||||
;; gets structure info about a structure
|
|
||||||
;;
|
|
||||||
;; (define surflet ##)
|
|
||||||
;; (load-structure surflet)
|
|
||||||
;; loads rt-structure
|
|
||||||
;;
|
|
||||||
;; (rt-structure-binding surflet 'main) --> value
|
|
||||||
;; get a binding of a structure
|
|
||||||
|
|
||||||
|
|
||||||
(define (interface-value-names interface-name)
|
|
||||||
(let ((interface (environment-ref (config-package) interface-name))
|
|
||||||
(value-names '()))
|
|
||||||
(for-each-declaration
|
|
||||||
(lambda (name base-neme type)
|
|
||||||
(if (not (equal? type syntax-type))
|
|
||||||
(set! value-names (cons name value-names))))
|
|
||||||
interface)
|
|
||||||
value-names))
|
|
||||||
|
|
||||||
(define-record-type rt-structure :rt-structure
|
|
||||||
(make-rt-structure meta-structure)
|
|
||||||
rt-structure?
|
|
||||||
(meta-structure rt-structure-meta-structure))
|
|
||||||
|
|
||||||
(define (rt-structure-loaded? rt-structure)
|
|
||||||
(package-loaded?
|
|
||||||
(structure-package (rt-structure-meta-structure rt-structure))))
|
|
||||||
|
|
||||||
(define-record-discloser :rt-structure
|
|
||||||
(lambda (s)
|
|
||||||
(list 'rt-stucture (structure-name (rt-structure-meta-structure s)))))
|
|
||||||
|
|
||||||
(define (reify-structure name)
|
|
||||||
(let ((struct (get-structure name)))
|
|
||||||
(make-rt-structure struct)))
|
|
||||||
|
|
||||||
(define (load-structure rts)
|
|
||||||
(ensure-loaded (rt-structure-meta-structure rts)))
|
|
||||||
|
|
||||||
(define (rt-structure-binding structure name)
|
|
||||||
(if (not (rt-structure-loaded? structure))
|
|
||||||
(error "Structure not loaded" structure))
|
|
||||||
(contents
|
|
||||||
(binding-place
|
|
||||||
(generic-lookup (rt-structure-meta-structure structure)
|
|
||||||
name))))
|
|
||||||
|
|
||||||
(define (load-config-file file)
|
|
||||||
(load file (config-package)))
|
|
|
@ -1,6 +1,6 @@
|
||||||
#!/bin/sh
|
#!/bin/sh
|
||||||
echo "Loading..."
|
echo "Loading..."
|
||||||
exec scsh -lel SSAX-4.9/load.scm -lel sunet-2.1/load.scm -dm -o http-test -e main -s "$0" "$@"
|
exec scsh -lel SSAX-4.9/load.scm -lel module-system/load.scm -lel sunet-2.1/load.scm -dm -o http-test -e main -s "$0" "$@"
|
||||||
!#
|
!#
|
||||||
|
|
||||||
(define-structure http-test
|
(define-structure http-test
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
#!/bin/sh
|
#!/bin/sh
|
||||||
echo "Loading..."
|
echo "Loading..."
|
||||||
|
|
||||||
exec scsh -lel SSAX-4.9/load.scm -lel sunet-2.1/load.scm -dm -o surflet-server -e main -s "$0" "$@"
|
exec scsh -lel SSAX-4.9/load.scm -lel module-system/load.scm -lel sunet-2.1/load.scm -dm -o surflet-server -e main -s "$0" "$@"
|
||||||
!#
|
!#
|
||||||
|
|
||||||
(define-structure surflet-server
|
(define-structure surflet-server
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
#!/bin/sh
|
#!/bin/sh
|
||||||
echo "Loading..."
|
echo "Loading..."
|
||||||
exec scsh -lel SSAX-4.9/load.scm -lel sunet-2.1/load.scm -dm -o http-test -e main -s "$0" "$@"
|
exec scsh -lel SSAX-4.9/load.scm -lel module-system/load.scm -lel sunet-2.1/load.scm -dm -o http-test -e main -s "$0" "$@"
|
||||||
!#
|
!#
|
||||||
|
|
||||||
(define-structure http-test
|
(define-structure http-test
|
||||||
|
|
Loading…
Reference in New Issue