*** empty log message ***

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.
+
+

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)
+  (let* ((the-loop 
-      string
+	  (lambda (start incr)
-      (let* ((length (string-length string))
+	    (let lp ((i start))
-	     (start
+	      (if (char=? #\space (string-ref string i))
-	      (if (not (char=? #\space (string-ref string 0)))
+		  (lp (+ i incr))
-		  0
+		  i))))
-		  (do ((index 0 (+ 1 index)))
+	 (start (the-loop 0 1))
-		      ((or (= index length)
+	 (end (+ 1 (the-loop (- (string-length string) 1) -1))))
-			   (not (char=? #\space (string-ref string index))))
+    (substring string start end)))
-		       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)))))