From 669e5ab4a8bb37030e70c870caabc145ba2c473f Mon Sep 17 00:00:00 2001 From: interp Date: Mon, 20 Aug 2001 11:33:04 +0000 Subject: [PATCH] contents of CONDITIONALS.SCM are not used any more contents of TOOTHLESS.SCM can be found in modules.scm --- conditionals.scm | 98 ------------------------------------------------ toothless.scm | 58 ---------------------------- 2 files changed, 156 deletions(-) delete mode 100644 conditionals.scm delete mode 100644 toothless.scm diff --git a/conditionals.scm b/conditionals.scm deleted file mode 100644 index 4260cfb..0000000 --- a/conditionals.scm +++ /dev/null @@ -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. diff --git a/toothless.scm b/toothless.scm deleted file mode 100644 index 95ff6c9..0000000 --- a/toothless.scm +++ /dev/null @@ -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)))))))