suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

switch to #lang, reformat

Browse Source 
svn: r12655
This commit is contained in:
Eli Barzilay 2008-12-01 03:21:46 +00:00
parent 8905cc86e5
commit 7ea8ab6592
1 changed files with 113 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
collects/mzlib/sandbox.ss
View File

@ -1,6 +1,8 @@
(module sandbox scheme/base
#lang scheme/base
(require scheme/sandbox
(prefix-in mz: (only-in mzscheme make-namespace)))
(provide sandbox-init-hook
sandbox-reader
sandbox-input
@ -51,41 +53,34 @@
(list (extract-requires lang reqs)
(if beg-req? null reqs))
(case lang
[(r5rs beginner beginner-abbr intermediate intermediate-lambda advanced)
[(r5rs beginner beginner-abbr intermediate intermediate-lambda
advanced)
(list 'special lang)]
[else lang])
(append
(if beg-req? (cdr reqs) null)
progs)))))]
[(mod)
(with-ns-params
(lambda ()
(make-module-evaluator mod)))]))
(append (if beg-req? (cdr reqs) null) progs)))))]
[(mod) (with-ns-params (lambda () (make-module-evaluator mod)))]))
(define (make-mz-namespace)
(let ([ns (mz:make-namespace)])
;; Because scheme/sandbox needs scheme/base:
(namespace-attach-module (namespace-anchor->namespace anchor)
'scheme/base
ns)
'scheme/base ns)
ns))
(define (with-ns-params thunk)
(let ([v (sandbox-namespace-specs)])
(cond
[(and (not gui?)
(eq? (car v) make-base-namespace))
(cond [(and (not gui?) (eq? (car v) make-base-namespace))
(parameterize ([sandbox-namespace-specs
(cons make-mz-namespace
(cdr v))])
(cons make-mz-namespace (cdr v))])
(thunk))]
[(and gui?
(eq? (car v) (dynamic-require 'mred 'make-gui-namespace)))
(parameterize ([sandbox-namespace-specs
[(and gui? (eq? (car v) (dynamic-require 'mred 'make-gui-namespace)))
(parameterize
([sandbox-namespace-specs
;; Simulate the old make-namespace-with-mred:
(cons (lambda ()
(let ([ns (make-mz-namespace)]
[ns2 ((dynamic-require 'mred 'make-gui-namespace))])
[ns2 ((dynamic-require
'mred 'make-gui-namespace))])
(namespace-attach-module ns2 'mred ns)
(namespace-attach-module ns2 'scheme/class ns)
(parameterize ([current-namespace ns])
@ -97,8 +92,7 @@
[else (thunk)])))
(define (literal-identifier=? x y)
(or (free-identifier=? x y)
(eq? (syntax-e x) (syntax-e y))))
(or (free-identifier=? x y) (eq? (syntax-e x) (syntax-e y))))
(define (extract-requires language requires)
(define (find-requires forms)
@ -121,4 +115,4 @@
(append (find-requires (cdr language)) requires)]
[else (error 'extract-requires
"bad language spec: ~e" language)])])
requires)))
requires))