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