contents of CONDITIONALS.SCM are not used any more

contents of TOOTHLESS.SCM can be found in modules.scm

conditionals.scm

@@ -1,98 +0,0 @@
-;;; handy syntax
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define-syntax when
-  (syntax-rules ()
-    ((when bool body1 body2 ...)
-     (if bool (begin body1 body2 ...)))))
-
-
-(define-syntax unless
-  (syntax-rules ()
-    ((unless bool body1 body2 ...)
-     (if (not bool) (begin body1 body2 ...)))))
-
-(define-syntax ?	; ? is synonym for COND.
-  (syntax-rules ()
-    ((? clause ...) (cond clause ...))))
-
-
-;;; Like CASE, but you specify the key-comparison procedure.
-;;; SWITCH evaluates its keys each time through the conditional.
-;;; SWITCHQ keys are not evaluated -- are simply constants.
-;;; (switchq string=? (vector-ref vec i)
-;;;   (("plus" "minus") ...)
-;;;   (("times" "div")  ...)
-;;;   (else ...))
-
-(define-syntax switchq
-  (syntax-rules ()
-    ((switchq compare key clause ...)
-     (let ((k key)			; Eval KEY and COMPARE
-	   (c compare))			; just once, then call %switch.
-       (%switchq c k clause ...)))))	; C, K are vars, hence replicable.
-
-(define-syntax %switchq
-  (syntax-rules (else)
-    ((%switchq compare key ((key1 ...) body1 body2 ...) rest ...)
-     (if (or (compare key 'key1) ...)
-	 (begin body1 body2 ...)
-	 (%switchq compare key rest ...)))
-
-    ((%switchq compare key ((key1 ...)) rest ...)	; Null body.
-     (if (not (or (compare key 'key1) ...))
-	 (%switchq compare key rest ...)))
-    
-    ((%switchq compare key (else body ...))
-     (begin body ...))
-
-    ((%switchq compare key) '#f)))
-
-
-(define-syntax switch
-  (syntax-rules ()
-    ((switch compare key clause ...)
-     (let ((k key)			; Eval KEY and COMPARE
-	   (c compare))			; just once, then call %switch.
-       (%switch c k clause ...)))))	; C, K are vars, hence replicable.
-
-(define-syntax %switch
-  (syntax-rules (else)
-    ((%switch compare key ((key1 ...) body1 body2 ...) rest ...)
-     (if (or (compare key key1) ...)
-	 (begin body1 body2 ...)
-	 (%switch compare key rest ...)))
-
-    ((%switch compare key ((key1 ...)) rest ...)	; Null body.
-     (if (not (or (compare key key1) ...))
-	 (%switch compare key rest ...)))
-    
-    ((%switch compare key (else body ...))
-     (begin body ...))
-
-    ((%switch compare key) '#f)))
-
-;;; I can't get this to work -- S48 complains "too many ...'s".
-;(define-syntax switchq
-;  (syntax-rules (else)
-;    ((switchq compare key clause ...)
-;     (letrec-syntax ((%switchq (syntax-rules (else)
-;			         ((%switchq compare key
-;					   ((key1 ...) body1 body2 ...) rest ...)
-;				  (if (or (compare key 'key1) ...)
-;				      (begin body1 body2 ...)
-;				      (%switchq compare key rest ...)))
-;
-;				 ; Null body.
-;				 ((%switchq compare key ((key1 ...)) rest ...)
-;				  (if (not (or (compare key 'key1) ...))
-;				      (%switchq compare key rest ...)))
-;    
-;			         ((%switchq compare key (else body ...))
-;				  (begin body ...))
-;
-;				 ((%switchq compare key) '#f))))
-;
-;        (let ((k key)			 ; Eval KEY and COMPARE
-;	      (c compare))		 ; just once, then call %switch.
-;	   (%switchq c k clause ...)))))); C, K are vars, hence replicable.

toothless.scm

@@ -1,58 +0,0 @@
-;;; -*- Scheme -*-
-;;; This file 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.
-;;;
-;;; Copyright (c) 1995 by Olin Shivers.
-
-(define-structure loser-package (export loser)
-  (open scheme error-package)
-  (begin (define (loser name)
-	   (lambda x (error "Illegal call" name)))))
-
-;;; The toothless structure is R4RS without the dangerous procedures.
-
-(define-structure toothless (interface-of scheme)
-  (open scheme loser-package)
-  (begin
-    (define call-with-input-file	(loser "call-with-input-file"))
-    (define call-with-output-file	(loser "call-with-output-file"))
-    (define load			(loser "load"))
-    (define open-input-file		(loser "open-input-file"))
-    (define open-output-file		(loser "open-output-file"))
-    (define transcript-on		(loser "transcript-on"))
-    (define with-input-from-file	(loser "with-input-from-file"))
-    (define with-input-to-file		(loser "with-input-to-file"))
-    (define eval			(loser "eval"))
-    (define interaction-environment	(loser "interaction-environment"))
-    (define scheme-report-environment	(loser "scheme-report-environment"))))
-
-;;; (EVAL-SAFELEY exp)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Create a brand new package, import the TOOTHLESS structure, and
-;;; evaluate EXP in it. When the evaluation is done, you throw away
-;;; the environment, 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.
-
-(define-structure toothless-eval (export eval-safely)
-  (open evaluation			; eval
-	package-commands-internal	; config-package, get-reflective-tower
-	packages			; structure-package, make-simple-package
-	environments			; environment-ref
-	handle				; ignore-errors
-	scheme)
-  (access toothless)	; Force it to be loaded.
-  (begin
-
-    (define toothless-struct (environment-ref (config-package) 'toothless))
-    (define toothless-package (structure-package toothless-struct))
-
-    (define (new-safe-package)
-      (make-simple-package (list toothless-struct) #t
-			   (get-reflective-tower toothless-package) ; ???
-			   'safe-env))
-
-    (define (eval-safely exp)
-      (ignore-errors (lambda () (eval exp (new-safe-package)))))))