From 3e6277cfbf4bc2b5540dd59a9d743244a5e7f99b Mon Sep 17 00:00:00 2001
From: interp <interp>
Date: Tue, 5 Jun 2001 12:46:05 +0000
Subject: [PATCH] *** empty log message ***

---
 doc/toothless.scm.doc | 64 +++++++++++++++++++++++++++++++++++++++++++
 stringhax.scm         | 42 ++++++++++++++--------------
 2 files changed, 85 insertions(+), 21 deletions(-)
 create mode 100644 doc/toothless.scm.doc

diff --git a/doc/toothless.scm.doc b/doc/toothless.scm.doc
new file mode 100644
index 0000000..c6839cb
--- /dev/null
+++ b/doc/toothless.scm.doc
@@ -0,0 +1,64 @@
+This file documents names defined in toothless.scm
+
+
+
+
+NOTES
+
+toothless.scm defines a Scheme 48 module that is R4RS without features
+that could examine or effect the file system. You can also use it as a
+model of how to execute code in other protected environments in S48.
+
+
+
+
+DEFINITIONS AND DESCRIPTIONS
+
+
+structure
+loser-package
+
+Exports:
+
+procedure 
+loser name --> error
+
+Raises an error like "Illegal call NAME".
+
+
+structure
+toothless
+
+Exports everything of R4RS. Following procedures are redefined, so
+they raise an error if the are called:
+
+call-with-input-file
+call-with-output-file
+load			
+open-input-file		
+open-output-file	
+transcript-on		
+with-input-from-file	
+with-input-to-file	
+eval			
+interaction-environment	
+scheme-report-environment
+
+toothless shall create an environment as described in NOTES.
+
+
+structure 
+toothless-eval
+
+Exports:
+
+procedure
+eval-safely expression
+
+Creates a brand new package, imports the TOOTHLESS structure, and
+evaluates EXP in it. When the evaluation is done, the environment is
+thrown away, so EXP's side-effects don't persist from one EVAL-SAFELY
+call to the next. If EXP raises an error exception, we abort and
+return #f.
+
+
diff --git a/stringhax.scm b/stringhax.scm
index 30b5d59..d4de51f 100644
--- a/stringhax.scm
+++ b/stringhax.scm
@@ -2,6 +2,7 @@
 ;;; Copyright (c) 1995 by Olin Shivers.
 ;;; Copyright (c) 1997 by Mike Sperber
 
+; do a 'map' on each character of the string
 (define (string-map f s)
   (let* ((slen (string-length s))
 	 (ns (make-string slen)))
@@ -9,6 +10,7 @@
 	((< i 0) ns)
       (string-set! ns i (f (string-ref s i))))))
 
+; convert string to down-/uppercase
 (define (downcase-string s)
   (string-map char-downcase s))
 
@@ -16,6 +18,7 @@
   (string-map char-upcase s))
 
 
+;return index of first character contained in char-set
 (define (char-set-index str cset . maybe-start)
   (let-optionals maybe-start ((start 0))
     (let ((len (string-length str)))
@@ -24,6 +27,8 @@
 	       (char-set-contains? cset (string-ref str i)))
 	   (and (< i len) i))))))
 
+;return index of last character contained in char-set
+;NOTE: character defined by maybe-start is not looked up
 (define (char-set-rindex str cset . maybe-start)
   (let ((len (string-length str)))
     (let-optionals maybe-start ((start len))
@@ -32,12 +37,15 @@
 	       (char-set-contains? cset (string-ref str i)))
 	   (and (>= i 0) i))))))
 
+;do a "fold-right" on string
+;(string-reduce nil cons s) ==> (cons ... (cons s[1] (cons s[0] nil)) ...)
 (define (string-reduce nil cons s)
   (let ((slen (string-length s)))
     (do ((ans nil (cons (string-ref s i) ans))
 	 (i 0 (+ i 1)))
 	((= i slen) ans))))
 
+;is PREFIX a prefix of STRING?
 (define (string-prefix? prefix string)
   (let ((plen (string-length prefix))
 	(slen (string-length string)))
@@ -48,6 +56,7 @@
 			    (string-ref string i))
 		    (lp (+ i 1))))))))
 
+;is SUFFIX a suffix of STRING?
 (define (string-suffix? suffix string)
   (let ((slen (string-length suffix))
 	(len (string-length string)))
@@ -59,31 +68,22 @@
 			    (string-ref string j))
 		    (lp (- i 1) (- j 1))))))))
 
+;return index of first non-whitespace character in S, #f otherwise
 (define skip-whitespace
   (let ((non-whitespace (char-set-complement char-set:whitespace)))
     (lambda (s) (char-set-index s non-whitespace))))
 
 ; Why is this so complicated?
+; Hope, it isn't anymore *g*  Andreas
 
 (define (trim-spaces string)
-  (if (string=? "" string)
-      string
-      (let* ((length (string-length string))
-	     (start
-	      (if (not (char=? #\space (string-ref string 0)))
-		  0
-		  (do ((index 0 (+ 1 index)))
-		      ((or (= index length)
-			   (not (char=? #\space (string-ref string index))))
-		       index))))
-	     (end
-	      (if (not (char=? #\space (string-ref string (- length 1))))
-		  length
-		  (do ((index (- length 1) (- index 1)))
-		      ((or (= index 0)
-			   (not (char=? #\space (string-ref string index))))
-		       (+ 1 index))))))
-	(if (and (= 0 start)
-		 (= length end))
-	    string
-	    (substring string start end)))))
+  (let* ((the-loop 
+	  (lambda (start incr)
+	    (let lp ((i start))
+	      (if (char=? #\space (string-ref string i))
+		  (lp (+ i incr))
+		  i))))
+	 (start (the-loop 0 1))
+	 (end (+ 1 (the-loop (- (string-length string) 1) -1))))
+    (substring string start end)))
+