No longer used.

diff --git a/v7/src/ssp/matcher.scm b/v7/src/ssp/matcher.scm
deleted file mode 100644 (file)
index a1dafb8..0000000
--- a/v7/src/ssp/matcher.scm
+++ /dev/null
@@ -1,184 +0,0 @@
-#| -*-Scheme-*-
-
-$Id: matcher.scm,v 1.1 2003/12/29 05:24:39 uid67408 Exp $
-
-Copyright 2003 Massachusetts Institute of Technology
-
-This file is part of MIT/GNU Scheme.
-
-MIT/GNU Scheme is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or (at
-your option) any later version.
-
-MIT/GNU Scheme is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with MIT/GNU Scheme; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
-USA.
-
-|#
-
-;;;; List matching
-
-(declare (usual-integrations))
-\f
-(define ((ml:matcher pattern) items)
-  (ml:apply pattern items))
-
-(define (ml:apply pattern items)
-  (guarantee-list items 'ML:APPLY)
-  (pattern (lambda (kf p r) kf p (r->v r))
-          (lambda () #f)
-          items))
-
-(define ((ml:match predicate) ks kf p)
-  (if (pair? p)
-      (let ((item (car p)))
-       (if (predicate item)
-           (ks kf (cdr p) (r1 item))
-           (kf)))
-      (kf)))
-
-(define ((ml:noise predicate) ks kf p)
-  (if (and (pair? p) (predicate (car p)))
-      (ks kf (cdr p) (r0))
-      (kf)))
-
-(define (ml:end ks kf p)
-  (if (null? p)
-      (ks kf p (r0))
-      (kf)))
-
-(define ((ml:* matcher) ks kf p)
-  (let ks* ((kf kf) (p p) (r (r0)))
-    (matcher (lambda (kf p r*) (ks* kf p (r+ r r*)))
-            (lambda () (ks kf p r))
-            p)))
-
-(define (ml:seq . matchers)
-  (let loop ((matchers matchers))
-    (if (pair? matchers)
-       (let ((m1 (car matchers))
-             (matchers (cdr matchers)))
-         (if (pair? matchers)
-             (let ((m2 (loop matchers)))
-               (lambda (ks kf p)
-                 (m1 (lambda (kf p r1)
-                       (m2 (lambda (kf p r2) (ks kf p (r+ r1 r2)))
-                           kf
-                           p))
-                     kf
-                     p)))
-             m1))
-       (lambda (ks kf p) (ks kf p (r0))))))
-
-(define (ml:alt . matchers)
-  (if (pair? matchers)
-      (let loop ((matchers matchers))
-       (let ((m1 (car matchers))
-             (matchers (cdr matchers)))
-         (if (pair? matchers)
-             (let ((m2 (loop matchers)))
-               (lambda (ks kf p)
-                 (m1 ks
-                     (lambda () (m2 ks kf p))
-                     p)))
-             m1)))
-      (lambda (ks kf p) ks p (kf))))
-
-(define (ml:transform procedure matcher)
-  (transformer (lambda (v) (v->r (procedure v))) matcher))
-
-(define (ml:encapsulate procedure matcher)
-  (transformer (lambda (v) (r1 (procedure v))) matcher))
-
-(define (ml:map procedure matcher)
-  (transformer (lambda (v) (v->r (vector-map procedure v))) matcher))
-
-(define ((transformer transform matcher) ks kf p)
-  (matcher (lambda (kf p r) (ks kf p (transform (r->v r))))
-          kf
-          p))
-\f
-(define (ml:+ matcher)
-  (ml:seq matcher (ml:* matcher)))
-
-(define (ml:? matcher)
-  (ml:alt matcher (ml:seq)))
-
-(define ((ml:values . items) ks kf p)
-  (ks kf p (l->r items)))
-
-(define (ml:*-list matcher)
-  (ml:encapsulate vector->list (ml:* matcher)))
-
-(define-integrable (r0) '#())
-(define-integrable (r1 item) (vector item))
-(define-integrable (r->v r) r)
-(define-integrable (v->r v) v)
-(define-integrable (l->r l) (list->vector l))
-
-(define (r+ r1 r2)
-  (let ((n1 (vector-length r1))
-       (n2 (vector-length r2)))
-    (cond ((fix:= n1 0) r2)
-         ((fix:= n2 0) r1)
-         (else
-          (let ((r (make-vector (fix:+ n1 n2))))
-            (do ((i 0 (fix:+ i 1)))
-                ((fix:= i n1))
-              (vector-set! r i (vector-ref r1 i)))
-            (do ((i 0 (fix:+ i 1))
-                 (j n1 (fix:+ j 1)))
-                ((fix:= i n2))
-              (vector-set! r j (vector-ref r2 i)))
-            r)))))
-
-#|
-
-;;; If the set of items doesn't include #F or pairs, this should be
-;;; faster than the above.
-
-(define-integrable (r0) #f)
-(define-integrable (r1 item) item)
-
-(define (r+ r1 r2)
-  (cond ((not r1) r2)
-       ((not r2) r1)
-       (else (cons r1 r2))))
-
-(define (r->v r)
-  (if r
-      (let ((n
-            (let loop ((r r))
-              (if (pair? r)
-                  (fix:+ (loop (car r))
-                         (loop (cdr r)))
-                  1))))
-       (let ((v (make-vector n)))
-         (let loop ((r r) (i 0) (q '()))
-           (if (pair? r)
-               (loop (car r)
-                     i
-                     (cons (cdr r) q))
-               (begin
-                 (vector-set! v i r)
-                 (if (pair? q)
-                     (loop (car q)
-                           (fix:+ i 1)
-                           (cdr q))))))
-         v))
-      '#()))
-
-(define (v->r v)
-  ???)
-
-(define (l->r l)
-  ???)
-
-|#
\ No newline at end of file

diff --git a/v7/src/ssp/xhtml.scm b/v7/src/ssp/xhtml.scm
deleted file mode 100644 (file)
index 614087a..0000000
--- a/v7/src/ssp/xhtml.scm
+++ /dev/null
@@ -1,246 +0,0 @@
-#| -*-Scheme-*-
-
-$Id: xhtml.scm,v 1.1 2003/12/29 05:24:55 uid67408 Exp $
-
-Copyright 2002,2003 Massachusetts Institute of Technology
-
-This file is part of MIT/GNU Scheme.
-
-MIT/GNU Scheme is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or (at
-your option) any later version.
-
-MIT/GNU Scheme is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with MIT/GNU Scheme; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
-USA.
-
-|#
-
-;;;; XHTML support
-
-(declare (usual-integrations))
-\f
-(define xhtml-external-dtd
-  (make-xml-external-id "-//W3C//DTD XHTML 1.0 Strict//EN"
-                       "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"))
-
-(define xhtml-dtd
-  (make-xml-dtd 'html xhtml-external-dtd '()))
-
-(define xhtml-iri
-  (make-xml-namespace-iri "http://www.w3.org/1999/xhtml"))
-
-(define-syntax define-standard-element
-  (sc-macro-transformer
-   (lambda (form environment)
-     environment
-     (if (syntax-match? '(IDENTIFIER) (cdr form))
-        (let ((name (cadr form)))
-          `(DEFINE ,name
-             (STANDARD-ELEMENT-CONSTRUCTOR ',name XHTML-IRI)))
-        (ill-formed-syntax form)))))
-
-(define (standard-element-constructor simple iri)
-  (let ((name (make-xml-name simple iri)))
-    (lambda (attrs . items)
-      (make-xml-element name
-                       (if (not attrs)
-                           '()
-                           attrs)
-                       (flatten-xml-element-contents items)))))
-
-(define (flatten-xml-element-contents item)
-  (letrec
-      ((scan-item
-       (lambda (item tail)
-         (cond ((xml-content-item? item) (cons item tail))
-               ((pair? item) (scan-list item tail))
-               ((or (not item) (null? item)) tail)
-               (else (cons (convert-xhtml-string-value item) tail)))))
-       (scan-list
-       (lambda (items tail)
-         (if (pair? items)
-             (scan-item (car items)
-                        (scan-list (cdr items) tail))
-             (begin
-               (if (not (null? items))
-                   (error:wrong-type-datum items "list"))
-               tail)))))
-    (scan-item item '())))
-
-(define (convert-xhtml-string-value value)
-  (cond ((symbol? value) (symbol-name value))
-       ((number? value) (number->string value))
-       ((xml-namespace-iri? value) (xml-namespace-iri-string value))
-       (else (error:wrong-type-datum value "string value"))))
-\f
-(define-standard-element a)
-(define-standard-element abbr)
-(define-standard-element acronym)
-(define-standard-element address)
-(define-standard-element b)
-(define-standard-element big)
-(define-standard-element blockquote)
-(define-standard-element body)
-(define-standard-element button)
-(define-standard-element caption)
-(define-standard-element cite)
-(define-standard-element code)
-(define-standard-element col)
-(define-standard-element colgroup)
-(define-standard-element dd)
-(define-standard-element defn)
-(define-standard-element del)
-(define-standard-element dir)
-(define-standard-element div)
-(define-standard-element dl)
-(define-standard-element dt)
-(define-standard-element em)
-(define-standard-element form)
-(define-standard-element h1)
-(define-standard-element h2)
-(define-standard-element h3)
-(define-standard-element h4)
-(define-standard-element h5)
-(define-standard-element head)
-(define-standard-element html)
-(define-standard-element i)
-(define-standard-element ins)
-(define-standard-element kbd)
-(define-standard-element li)
-(define-standard-element listing)
-(define-standard-element menu)
-(define-standard-element ol)
-(define-standard-element optgroup)
-(define-standard-element option)
-(define-standard-element p)
-(define-standard-element pre)
-(define-standard-element q)
-(define-standard-element s)
-(define-standard-element samp)
-(define-standard-element script)
-(define-standard-element select)
-(define-standard-element small)
-(define-standard-element span)
-(define-standard-element strike)
-(define-standard-element strong)
-(define-standard-element sub)
-(define-standard-element sup)
-(define-standard-element table)
-(define-standard-element tbody)
-(define-standard-element td)
-(define-standard-element textarea)
-(define-standard-element tfoot)
-(define-standard-element th)
-(define-standard-element thead)
-(define-standard-element title)
-(define-standard-element tr)
-(define-standard-element tt)
-(define-standard-element u)
-(define-standard-element ul)
-(define-standard-element var)
-\f
-(define-syntax define-empty-element
-  (sc-macro-transformer
-   (lambda (form environment)
-     environment
-     (if (syntax-match? '(IDENTIFIER) (cdr form))
-        (let ((name (cadr form)))
-          `(DEFINE ,name
-             (EMPTY-ELEMENT-CONSTRUCTOR ',name XHTML-IRI)))
-        (ill-formed-syntax form)))))
-
-(define (empty-element-constructor simple iri)
-  (let ((name (make-xml-name simple iri)))
-    (lambda keyword-list
-      (make-xml-element name
-                       (if (and (pair? keyword-list)
-                                (list-of-type? (car keyword-list)
-                                  xml-attribute?)
-                                (null? (cdr keyword-list)))
-                           (car keyword-list)
-                           (apply attributes keyword-list))
-                       '()))))
-
-(define-empty-element br)
-(define-empty-element hr)
-(define-empty-element img)
-(define-empty-element input)
-(define-empty-element link)
-(define-empty-element meta)
-
-(define (attributes . keyword-list)
-  (let loop ((bindings keyword-list))
-    (if (and (pair? bindings)
-            (xml-name? (car bindings))
-            (pair? (cdr bindings)))
-       (let ((value (cadr bindings))
-             (tail (loop (cddr bindings))))
-         (if value
-             (cons (make-xml-attribute
-                    (car bindings)
-                    (cond ((eq? value #t) (symbol-name (car bindings)))
-                          ((xml-char-data? value) value)
-                          (else (convert-xhtml-string-value value))))
-                   tail)
-             tail))
-       (begin
-         (if (not (null? bindings))
-             (error:wrong-type-argument keyword-list
-                                        "keyword list"
-                                        'ATTRIBUTES))
-         '()))))
-\f
-(define (href iri . contents)
-  (apply a
-        (attributes 'href iri)
-        contents))
-
-(define (id-def tag . contents)
-  (apply a
-        (attributes 'id tag
-                    'name tag)
-        contents))
-
-(define (id-ref tag . contents)
-  (apply href (string-append "#" tag) contents))
-
-(define (rel-link rel iri)
-  (link 'rel rel
-       'href iri))
-
-(define (style-link iri)
-  (link 'rel "stylesheet"
-       'href iri
-       'type "text/css"))
-
-(define (http-equiv name value)
-  (meta 'http-equiv name
-       'content value))
-
-(define (style . keyword-list)
-  (let loop ((bindings keyword-list))
-    (if (and (pair? bindings)
-            (symbol? (car bindings))
-            (pair? (cdr bindings))
-            (string? (cadr bindings)))
-       (string-append (symbol-name (car bindings))
-                      ": "
-                      (cadr bindings)
-                      (if (pair? (cddr bindings))
-                          (string-append "; " (loop (cddr bindings)))
-                          ";"))
-       (begin
-         (if (not (null? bindings))
-             (error:wrong-type-argument keyword-list "keyword list" 'STYLE))
-         ""))))
-
-(define (comment . strings)
-  (make-xml-comment (string-append " " (apply string-append strings) " ")))
\ No newline at end of file