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

Using immutable hash vs alist

Browse Source 
svn: r11423
This commit is contained in:
Jay McCarthy 2008-08-25 18:07:41 +00:00
parent 8956e83c72
commit d50c1e401d
2 changed files with 43 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/web-server/lang/abort-resume.ss
View File

@ -35,14 +35,12 @@
(define web-prompt (make-continuation-prompt-tag 'web))
(define (current-saved-continuation-marks-and key val)
(list* (cons key val)
(filter (lambda (k*v) (not (equal? key (car k*v))))
(let-values ([(current)
(continuation-mark-set->list (current-continuation-marks web-prompt)
the-save-cm-key)])
(if (empty? current)
empty
(first current))))))
(define c
(continuation-mark-set->list (current-continuation-marks web-prompt)
the-save-cm-key))
(if (empty? c)
(make-immutable-hash (list (cons key val)))
(hash-set (first c) key val)))
;; current-continuation-as-list: -> (listof value)
;; check the safety marks and return the list of marks representing the continuation
@ -73,6 +71,11 @@
(with-continuation-mark cm-key cm-val
(with-continuation-marks cms thnk))]))
(define (with-continuation-marks/hash cms thnk)
(with-continuation-marks
(hash-map cms cons)
thnk))
;; resume: (listof (value -> value)) value -> value
;; resume a computation given a value and list of frame procedures
(define (resume frames val)
@ -89,7 +92,7 @@
f)]
[(vector #f cms)
(with-continuation-mark the-save-cm-key cms
(with-continuation-marks cms (lambda () (resume fs val))))]
(with-continuation-marks/hash cms (lambda () (resume fs val))))]
[(vector f cms)
(resume (list* (vector f #f) (vector #f cms) fs) val)])]))
@ -104,7 +107,7 @@
[(vector f #f)
(rebuild-cms fs thunk)]
[(vector f cms)
(with-continuation-marks cms (lambda () (rebuild-cms fs thunk)))])]))
(with-continuation-marks/hash cms (lambda () (rebuild-cms fs thunk)))])]))
(define (abort/cc thunk)
(call-with-continuation-prompt

51
collects/web-server/tests/lang/abort-resume-test.ss
View File

@ -19,36 +19,42 @@
"Easy"
(check-equal? (abort/cc
(lambda () (current-saved-continuation-marks-and 'k1 'v1)))
(list (cons 'k1 'v1))))
(make-immutable-hash (list (cons 'k1 'v1)))))
(test-case
"Preserve"
(check-equal? (abort/cc
(lambda ()
(with-continuation-mark the-save-cm-key (list (cons 'k2 'v2))
(with-continuation-mark the-save-cm-key (make-immutable-hash (list (cons 'k2 'v2)))
(current-saved-continuation-marks-and 'k1 'v1))))
(list (cons 'k1 'v1)
(cons 'k2 'v2))))
(make-immutable-hash
(list (cons 'k1 'v1)
(cons 'k2 'v2)))))
(test-case
"Update"
(check-equal? (abort/cc
(lambda ()
(with-continuation-mark the-save-cm-key (list (cons 'k2 'v2) (cons 'k1 'v3))
(with-continuation-mark the-save-cm-key
(make-immutable-hash (list (cons 'k2 'v2) (cons 'k1 'v3)))
(current-saved-continuation-marks-and 'k1 'v1))))
(list (cons 'k1 'v1)
(cons 'k2 'v2))))
(make-immutable-hash
(list (cons 'k1 'v1)
(cons 'k2 'v2)))))
(test-case
"Double"
(check-equal? (abort/cc
(lambda ()
(with-continuation-mark the-save-cm-key (list (cons 'k3 'v1) (cons 'k4 'v0))
(with-continuation-mark the-save-cm-key
(make-immutable-hash (list (cons 'k3 'v1) (cons 'k4 'v0)))
((lambda (x) x)
(with-continuation-mark the-save-cm-key (list (cons 'k2 'v2) (cons 'k1 'v3))
(with-continuation-mark the-save-cm-key
(make-immutable-hash (list (cons 'k2 'v2) (cons 'k1 'v3)))
(current-saved-continuation-marks-and 'k1 'v1))))))
(list (cons 'k1 'v1)
(cons 'k2 'v2)))))
(make-immutable-hash
(list (cons 'k1 'v1)
(cons 'k2 'v2))))))
(test-suite
"activation-record-list"
@ -156,9 +162,9 @@
(check-equal? (abort/cc
(lambda ()
(let/ec esc
(resume (list (vector f (list (cons 3 4) (cons 1 2)))
(vector g (list (cons 5 6)))
(vector esc (list (cons 7 8)))
(resume (list (vector f (make-immutable-hash (list (cons 3 4) (cons 1 2))))
(vector g (make-immutable-hash (list (cons 5 6))))
(vector esc (make-immutable-hash (list (cons 7 8))))
(vector (lambda _
(continuation-mark-set->list*
(current-continuation-marks)
@ -179,14 +185,14 @@
(lambda ()
(let/ec esc
(set-box! esc-b esc)
(resume (list (vector f (list (cons 3 4) (cons 1 2)))
(vector g (list (cons 5 6)))
(vector esc (list (cons 7 8)))
(resume (list (vector f (make-immutable-hash (list (cons 3 4) (cons 1 2))))
(vector g (make-immutable-hash (list (cons 5 6))))
(vector esc (make-immutable-hash (list (cons 7 8))))
(vector capture #f))
(list 42)))))
(list (vector f (list (cons 3 4) (cons 1 2)))
(vector g (list (cons 5 6)))
(vector (unbox esc-b) (list (cons 7 8))))))))
(list (vector f (make-immutable-hash (list (cons 3 4) (cons 1 2))))
(vector g (make-immutable-hash (list (cons 5 6))))
(vector (unbox esc-b) (make-immutable-hash (list (cons 7 8)))))))))
; XXX test kont
@ -198,4 +204,7 @@
; XXX test dispatch
))
))
(require (planet "graphical-ui.ss" ("schematics" "schemeunit.plt" 2)))
(test/graphical-ui abort-resume-tests)