Skip to content

Commit

Permalink
Corrected dynamic sandboxing algorithm
Browse files Browse the repository at this point in the history
CACH wasn't actually adding to the sandbox, and the sandbox expansion
algorithm wasn't correctly handling mutually recursive functions.
  • Loading branch information
dolio committed Oct 25, 2023
1 parent 05bd1f9 commit 0ea62b8
Show file tree
Hide file tree
Showing 2 changed files with 32 additions and 15 deletions.
16 changes: 8 additions & 8 deletions scheme-libs/racket/unison/primops-generated.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -518,29 +518,29 @@
runtime-namespace)))

(define (code-dependencies co)
(group-term-dependencies (unison-code-rep co)))
(chunked-list->list
(group-term-dependencies
(unison-code-rep co))))

(define (unison-POp-CACH dfns0)
(define (flat-map f l)
(foldl
(lambda (x acc)
(append (chunked-list->list (f (usnd x))) acc))
'()
l))
(define (map-links dss)
(map (lambda (ds) (map reference->termlink ds)) dss))

(let ([udefs (chunked-list->list dfns0)])
(cond
[(not (null? udefs))
(let* ([links (map ufst udefs)]
[refs (map termlink->reference links)]
[deps (flat-map code-dependencies udefs)]
[depss (map (compose code-dependencies usnd) udefs)]
[deps (flatten depss)]
[fdeps (filter need-dependency? deps)]
[rdeps (remove* refs fdeps)])
(cond
[(null? fdeps) (sum 0 '())]
[(null? rdeps)
(let ([sdefs (flatten (map gen-code udefs))]
[mname (generate-module-name links)])
(expand-sandbox links (map-links depss))
(register-code udefs)
(add-module-associations links mname)
(add-runtime-module mname links sdefs)
Expand Down
31 changes: 24 additions & 7 deletions scheme-libs/racket/unison/sandbox.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@

(provide expand-sandbox check-sandbox set-sandbox)

(require racket)
(require racket racket/hash)
(require (except-in unison/data true false unit))

; sandboxing information
Expand All @@ -13,15 +13,32 @@
(define (check-sandbox ln)
(hash-ref sandbox-links ln '()))

(define (expand build have ds)
(define (check d)
(hash-ref build d (lambda () (check-sandbox d))))

(for/fold ([acc '()]) ([d ds])
(append (remove* have (check d)) acc)))

; Add a link to the sandboxing information.
; deps0 should be the immediate dependencies of the code for ln.
; They will be used to generate the overall sandboxing
(define (expand-sandbox ln deps0)
(let rec ([tot '()] [deps deps0])
(match deps
['() (hash-set! sandbox-links ln (remove-duplicates tot))]
[(cons d ds)
(rec (append (check-sandbox d) tot) ds)])))
(define (expand-sandbox ls dss)
(let rec ([build (make-immutable-hash)])
(for/fold
([new (make-immutable-hash)]

#:result
(if (hash-empty? new)
; set the newly found links
(hash-union! sandbox-links build #:combine append)
(rec (hash-union build new #:combine append))))

([l ls] [ds dss])
(let ([xp (expand build (hash-ref build l '()) ds)])
(if (not (null? xp))
(hash-set new l xp)
new)))))

(define (set-sandbox link links)
(hash-set! sandbox-links link links))
Expand Down

0 comments on commit 0ea62b8

Please sign in to comment.