fix exception handler inside links-reading code

This commit is contained in:
Matthew Flatt 2013-07-05 07:46:32 -06:00
parent 6a78219d5d
commit f98c56f722
3 changed files with 828 additions and 818 deletions

File diff suppressed because it is too large Load Diff

View File

@ -422,6 +422,7 @@
"(list lf)))))))"
"(define-values(links-caches)(make-vector(vector-length links-paths)(make-hasheq)))"
"(define-values(links-stamps)(make-vector(vector-length links-paths) #f))"
"(define-values(stamp-prompt-tag)(make-continuation-prompt-tag 'stamp))"
"(define-values(file->stamp)"
"(lambda(path)"
"(call-with-continuation-prompt"
@ -429,11 +430,11 @@
"(with-continuation-mark"
" exception-handler-key"
"(lambda(exn)"
"(if(exn:fail:filesystem? exn)"
"(abort-current-continuation "
"(default-continuation-prompt-tag)"
"(lambda() #f))"
"(lambda()(raise exn))))"
" stamp-prompt-tag"
"(if(exn:fail:filesystem? exn)"
"(lambda() #f)"
"(lambda()(raise exn)))))"
"(let((p(open-input-file path)))"
"(dynamic-wind"
" void"
@ -451,7 +452,8 @@
" null"
"(cons bstr(loop)))))))"
" bstr)))"
"(lambda()(close-input-port p)))))))))"
"(lambda()(close-input-port p))))))"
" stamp-prompt-tag)))"
"(define-values(get-linked-collections)"
"(lambda(user? shared? ii)"
"(call/ec(lambda(esc)"

View File

@ -502,6 +502,8 @@
(define-values (links-caches) (make-vector (vector-length links-paths) (make-hasheq)))
(define-values (links-stamps) (make-vector (vector-length links-paths) #f))
(define-values (stamp-prompt-tag) (make-continuation-prompt-tag 'stamp))
(define-values (file->stamp)
(lambda (path)
;; We'd prefer to do something lighter than read the file every time!
@ -514,11 +516,11 @@
(with-continuation-mark
exception-handler-key
(lambda (exn)
(if (exn:fail:filesystem? exn)
(abort-current-continuation
(default-continuation-prompt-tag)
(lambda () #f))
(lambda () (raise exn))))
(abort-current-continuation
stamp-prompt-tag
(if (exn:fail:filesystem? exn)
(lambda () #f)
(lambda () (raise exn)))))
(let ([p (open-input-file path)])
(dynamic-wind
void
@ -536,7 +538,8 @@
null
(cons bstr (loop)))))))
bstr)))
(lambda () (close-input-port p)))))))))
(lambda () (close-input-port p))))))
stamp-prompt-tag)))
(define-values (get-linked-collections)
(lambda (user? shared? ii)