From 91da112ec1d4295a8143ddf44bdc234226fe2bea Mon Sep 17 00:00:00 2001
From: mainzelm <mainzelm>
Date: Tue, 3 May 2005 12:39:31 +0000
Subject: [PATCH] Use Sunterlib's rt-modules implementation instead of our own.

---
 INSTALL                              |  5 ++
 scheme/httpd/surflets/packages.scm   | 68 +---------------------------
 scheme/httpd/surflets/rt-module.scm  | 58 ------------------------
 web-server/start-extended-web-server |  2 +-
 web-server/start-surflet-server      |  2 +-
 web-server/start-web-server          |  2 +-
 6 files changed, 9 insertions(+), 128 deletions(-)
 delete mode 100644 scheme/httpd/surflets/rt-module.scm

diff --git a/INSTALL b/INSTALL
index 59b47c5..272f9c5 100644
--- a/INSTALL
+++ b/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,
 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
 ============
diff --git a/scheme/httpd/surflets/packages.scm b/scheme/httpd/surflets/packages.scm
index a5dcc6c..7bda766 100644
--- a/scheme/httpd/surflets/packages.scm
+++ b/scheme/httpd/surflets/packages.scm
@@ -255,25 +255,6 @@
 	  thread-safe-counter-next!
 	  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
   (export with-lock*
 	  (with-lock :syntax)))
@@ -440,7 +421,7 @@
 	let-opt				;:OPTIONAL
 	locks				;MAKE-LOCK et al.
 	profiling			;PROFILE-SPACE
-	rt-module-language		;get structures dynamically
+	rt-modules      		;get structures dynamically
 	scheme-with-scsh		;regexp et al.
         search-trees
 	shift-reset			;SHIFT and RESET
@@ -678,53 +659,6 @@
 	surflets/surflet-sxml)
   (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
   (open scheme
 	locks)
diff --git a/scheme/httpd/surflets/rt-module.scm b/scheme/httpd/surflets/rt-module.scm
deleted file mode 100644
index 52d7b91..0000000
--- a/scheme/httpd/surflets/rt-module.scm
+++ /dev/null
@@ -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)))
diff --git a/web-server/start-extended-web-server b/web-server/start-extended-web-server
index 70d60d9..24e00a9 100755
--- a/web-server/start-extended-web-server
+++ b/web-server/start-extended-web-server
@@ -1,6 +1,6 @@
 #!/bin/sh
 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
diff --git a/web-server/start-surflet-server b/web-server/start-surflet-server
index a4772a4..7b25f5e 100755
--- a/web-server/start-surflet-server
+++ b/web-server/start-surflet-server
@@ -1,7 +1,7 @@
 #!/bin/sh
 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
diff --git a/web-server/start-web-server b/web-server/start-web-server
index 9d8ff02..818099a 100755
--- a/web-server/start-web-server
+++ b/web-server/start-web-server
@@ -1,6 +1,6 @@
 #!/bin/sh
 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