Skip to content

Commit 0ab77b4

Browse files
mniepermnieper
committed
Handle the immediate table of marks in $guard and $reset-protect 
1 parent 0b2f4d3 commit 0ab77b4

File tree

3 files changed

+109
-79
lines changed

3 files changed

+109
-79
lines changed

‎mats/4.ms

Lines changed: 78 additions & 52 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,12 @@
11
;;; 4.ms
22
;;; Copyright 1984-2017 Cisco Systems, Inc.
3-
;;;
3+
;;;
44
;;; Licensed under the Apache License, Version 2.0 (the "License");
55
;;; you may not use this file except in compliance with the License.
66
;;; You may obtain a copy of the License at
7-
;;;
7+
;;;
88
;;; http://www.apache.org/licenses/LICENSE-2.0
9-
;;;
9+
;;;
1010
;;; Unless required by applicable law or agreed to in writing, software
1111
;;; distributed under the License is distributed on an "AS IS" BASIS,
1212
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
@@ -293,37 +293,37 @@
293293
(if (eq? x 'a) (set! x 'c))
294294
(eq? x 'b))
295295

296-
(equivalent-expansion?
296+
(equivalent-expansion?
297297
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
298298
(expand/optimize '(if (not (not (f x))) e1 e2)))
299299
'(if (f x) e1 e2))
300300

301-
(equivalent-expansion?
301+
(equivalent-expansion?
302302
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
303303
(expand/optimize '(if (begin (set! x y) (if (begin (set! z y) (zero? h)) #f #t)) e1 e2)))
304304
'(begin (set! x y) (if (begin (set! z y) (#2%zero? h)) e2 e1)))
305305

306-
(equivalent-expansion?
306+
(equivalent-expansion?
307307
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
308308
(expand/optimize '(if (begin (set! x y) (if (begin (set! z y) (zero? h)) #f #f)) e1 e2)))
309309
'(begin (set! x y) (set! z y) (#2%zero? h) e2))
310310

311-
(equivalent-expansion?
311+
(equivalent-expansion?
312312
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
313313
(expand/optimize '(if (begin (set! x y) (if (begin (set! z y) (zero? h)) #t #t)) e1 e2)))
314314
'(begin (set! x y) (set! z y) (#2%zero? h) e1))
315-
316-
(equivalent-expansion?
315+
316+
(equivalent-expansion?
317317
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
318318
(expand/optimize '(if (begin (set! x y) (if (begin (set! z y) (zero? h)) #t #f)) e1 e2)))
319319
'(if (begin (set! x y) (set! z y) (#2%zero? h)) e1 e2))
320320

321-
(equivalent-expansion?
321+
(equivalent-expansion?
322322
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
323323
(expand/optimize '(if (begin (set! x y) (if (begin (set! z y) (zero? h)) (begin (set! l z) #t) (begin (set! l y) #f))) e1 e2)))
324324
'(begin (set! x y) (if (begin (set! z y) (#2%zero? h)) (begin (set! l z) e1) (begin (set! l y) e2))))
325325

326-
(equivalent-expansion?
326+
(equivalent-expansion?
327327
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
328328
(expand/optimize '(if (begin (set! x y) (if (begin (set! z y) (zero? h)) (begin (set! l z) #t) (begin (set! l y) #t))) e1 e2)))
329329
'(begin (set! x y) (if (begin (set! z y) (#2%zero? h)) (set! l z) (set! l y)) e1))
@@ -333,7 +333,7 @@
333333
(expand/optimize '(if (begin (set! x y) (if (begin (set! z y) (zero? h)) (begin (set! l z) #f) (begin (set! l y) #f))) e1 e2)))
334334
'(begin (set! x y) (if (begin (set! z y) (#2%zero? h)) (set! l z) (set! l y)) e2))
335335

336-
(equivalent-expansion?
336+
(equivalent-expansion?
337337
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
338338
(expand/optimize '(if (begin (set! x y) (if (begin (set! z y) (zero? h)) (begin (set! l z) #f) (begin (set! l y) #t))) e1 e2)))
339339
'(begin (set! x y) (if (begin (set! z y) (#2%zero? h)) (begin (set! l z) e2) (begin (set! l y) e1))))
@@ -1205,7 +1205,7 @@
12051205
(set! next 0)))
12061206
(let ([m next])
12071207
(unless (= m n)
1208-
(set! next (fx+ next 1))
1208+
(set! next (fx+ next 1))
12091209
(let ([p (list-ref orig-ls m)])
12101210
(unless (eqv? (cdr p) m)
12111211
(errorf #f "unexpected cdr value (~s instead of ~s)" (cdr p) m))
@@ -1257,48 +1257,48 @@
12571257
;; avoid creating each list and doing the actual map
12581258
(equivalent-expansion?
12591259
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
1260-
(expand/optimize
1261-
'(map (lambda (x y z) (apply + x y z))
1260+
(expand/optimize
1261+
'(map (lambda (x y z) (apply + x y z))
12621262
(list 1 2 3)
12631263
(list 4 5 6)
12641264
(list '(7) '(8) '(9)))))
12651265
'(#2%list 12 15 18))
12661266
(equivalent-expansion?
12671267
(parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
1268-
(expand/optimize
1269-
'(map (lambda (x y z) (apply + x y z))
1268+
(expand/optimize
1269+
'(map (lambda (x y z) (apply + x y z))
12701270
(list 1 2 3)
12711271
(list 4 5 6)
12721272
(list '(7) '(8) '(9)))))
12731273
'(#3%list 12 15 18))
12741274
(equivalent-expansion?
12751275
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
1276-
(expand/optimize
1277-
'(map (lambda (x y z) (apply + x y z))
1276+
(expand/optimize
1277+
'(map (lambda (x y z) (apply + x y z))
12781278
'(1 2 3)
12791279
(list 4 5 6)
12801280
(list '(7) '(8) '(9)))))
12811281
'(#2%list 12 15 18))
12821282
(equivalent-expansion?
12831283
(parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
1284-
(expand/optimize
1285-
'(map (lambda (x y z) (apply + x y z))
1284+
(expand/optimize
1285+
'(map (lambda (x y z) (apply + x y z))
12861286
'(1 2 3)
12871287
(list 4 5 6)
12881288
(list '(7) '(8) '(9)))))
12891289
'(#3%list 12 15 18))
12901290
(equivalent-expansion?
12911291
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
1292-
(expand/optimize
1293-
'(map (lambda (x y z) (apply + x y z))
1292+
(expand/optimize
1293+
'(map (lambda (x y z) (apply + x y z))
12941294
'(1 2 3)
12951295
'(4 5 6)
12961296
'((7) (8) (9)))))
12971297
'(#2%list 12 15 18))
12981298
(equivalent-expansion?
12991299
(parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
1300-
(expand/optimize
1301-
'(map (lambda (x y z) (apply + x y z))
1300+
(expand/optimize
1301+
'(map (lambda (x y z) (apply + x y z))
13021302
'(1 2 3)
13031303
'(4 5 6)
13041304
'((7) (8) (9)))))
@@ -1430,7 +1430,7 @@
14301430
(equal?
14311431
(fold-left cons '(q) '(a b c))
14321432
'((((q) . a) . b) . c))
1433-
(eqv?
1433+
(eqv?
14341434
(fold-left + 0 '(1 2 3) '(4 5 6))
14351435
21)
14361436
(procedure? (lambda (x) (fold-left x)))
@@ -2125,48 +2125,48 @@
21252125
;; avoid creating each list and doing the actual for-each
21262126
(equivalent-expansion?
21272127
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
2128-
(expand/optimize
2129-
'(for-each (lambda (x y z) (display (apply + x y z)))
2128+
(expand/optimize
2129+
'(for-each (lambda (x y z) (display (apply + x y z)))
21302130
(list 1 2 3)
21312131
(list 4 5 6)
21322132
(list '(7) '(8) '(9)))))
21332133
'(begin (#2%display 12) (#2%display 15) (#2%display 18)))
21342134
(equivalent-expansion?
21352135
(parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
2136-
(expand/optimize
2137-
'(for-each (lambda (x y z) (display (apply + x y z)))
2136+
(expand/optimize
2137+
'(for-each (lambda (x y z) (display (apply + x y z)))
21382138
(list 1 2 3)
21392139
(list 4 5 6)
21402140
(list '(7) '(8) '(9)))))
21412141
'(begin (#3%display 12) (#3%display 15) (#3%display 18)))
21422142
(equivalent-expansion?
21432143
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
2144-
(expand/optimize
2145-
'(for-each (lambda (x y z) (display (apply + x y z)))
2144+
(expand/optimize
2145+
'(for-each (lambda (x y z) (display (apply + x y z)))
21462146
'(1 2 3)
21472147
(list 4 5 6)
21482148
(list '(7) '(8) '(9)))))
21492149
'(begin (#2%display 12) (#2%display 15) (#2%display 18)))
21502150
(equivalent-expansion?
21512151
(parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
2152-
(expand/optimize
2153-
'(for-each (lambda (x y z) (display (apply + x y z)))
2152+
(expand/optimize
2153+
'(for-each (lambda (x y z) (display (apply + x y z)))
21542154
'(1 2 3)
21552155
(list 4 5 6)
21562156
(list '(7) '(8) '(9)))))
21572157
'(begin (#3%display 12) (#3%display 15) (#3%display 18)))
21582158
(equivalent-expansion?
21592159
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
2160-
(expand/optimize
2161-
'(for-each (lambda (x y z) (display (apply + x y z)))
2160+
(expand/optimize
2161+
'(for-each (lambda (x y z) (display (apply + x y z)))
21622162
'(1 2 3)
21632163
'(4 5 6)
21642164
'((7) (8) (9)))))
21652165
'(begin (#2%display 12) (#2%display 15) (#2%display 18)))
21662166
(equivalent-expansion?
21672167
(parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
2168-
(expand/optimize
2169-
'(for-each (lambda (x y z) (display (apply + x y z)))
2168+
(expand/optimize
2169+
'(for-each (lambda (x y z) (display (apply + x y z)))
21702170
'(1 2 3)
21712171
'(4 5 6)
21722172
'((7) (8) (9)))))
@@ -2684,19 +2684,19 @@
26842684
(l #f))
26852685
'hi)
26862686
(((call/cc call/cc) (lambda (x) x)) #t)
2687-
(let ()
2687+
(let ()
26882688
(define f
26892689
(lambda (n)
26902690
(let f ((n n))
2691-
(or (fx= n 0)
2691+
(or (fx= n 0)
26922692
(and (call/cc (lambda (k) k))
26932693
(f (fx- n 1)))))))
26942694
(f 100000))
2695-
(let ()
2695+
(let ()
26962696
(define f
26972697
(lambda (n)
26982698
(let f ((n n))
2699-
(or (fx= n 0)
2699+
(or (fx= n 0)
27002700
(and (call/cc (lambda (k) (k k)))
27012701
(f (fx- n 1)))))))
27022702
(f 100000))
@@ -2790,7 +2790,7 @@
27902790
(and (eq? (leaf-eq? '(a (b (c))) '((a) b c)) #t)
27912791
(eq? (leaf-eq? '(a (b (c))) '((a) b c d)) #f)))
27922792
)
2793-
2793+
27942794
(mat dynamic-wind
27952795
(let ([x 3])
27962796
(and (eqv? x 3)
@@ -3075,11 +3075,11 @@
30753075
(case-lambda
30763076
[() me]
30773077
[(x) #t]))))
3078-
(let ()
3078+
(let ()
30793079
(define f
30803080
(lambda (n)
30813081
(let f ((n n))
3082-
(or (fx= n 0)
3082+
(or (fx= n 0)
30833083
(and (call/cc (lambda (k) (k k)))
30843084
(f (fx- n 1)))))))
30853085
(f 100000))
@@ -3453,7 +3453,7 @@
34533453
(error? (call-with-yep (lambda () (call-with-yeah* (lambda () ((returns-not-a-procedure)))))))
34543454
(error? (call-with-yep (lambda () (list (call-with-yeah* (lambda () ((returns-not-a-procedure))))))))
34553455
(error? (call-with-yep (lambda () (act-like-list (call-with-yeah* (lambda () ((returns-not-a-procedure))))))))
3456-
3456+
34573457
(equal? '() (if (call-with-yep list)
34583458
(#%$current-attachments)
34593459
#f))
@@ -3736,7 +3736,7 @@
37363736
[(marks keys) ($mark-iter->lists (continuation-marks->iterator marks (list->vector keys)))]
37373737
[(marks keys no) ($mark-iter->lists (continuation-marks->iterator marks (list->vector keys) no))]))
37383738
#t)
3739-
3739+
37403740
(equal? '((xv1 yv)) (with-continuation-mark
37413741
'x 'xv0
37423742
(with-continuation-mark
@@ -3828,6 +3828,32 @@
38283828
(with-continuation-mark
38293829
'other 'no
38303830
(loop (sub1 depth)))))))))
3831+
3832+
(with-continuation-mark
3833+
'key #t
3834+
(guard
3835+
(c [#t (call-with-immediate-continuation-mark 'key values)])
3836+
(raise #f)))
3837+
3838+
(with-continuation-mark
3839+
'key #t
3840+
(guard
3841+
(c [#t (call-with-immediate-continuation-mark 'key values)]
3842+
[else #f])
3843+
(raise #f)))
3844+
3845+
(equal? 'inner
3846+
(call/cc
3847+
(lambda (k)
3848+
(with-continuation-mark 'key 'outer
3849+
(with-exception-handler
3850+
(lambda (c)
3851+
(k (continuation-marks-first (current-continuation-marks) 'key)))
3852+
(lambda ()
3853+
(guard (c [#f #f])
3854+
(with-continuation-mark 'key 'inner
3855+
(raise #f)))))))))
3856+
38313857
)
38323858
38333859
(mat call-in-continuation
@@ -3959,7 +3985,7 @@
39593985
(lambda (k)
39603986
(#%$call-in-continuation
39613987
k
3962-
(lambda ()
3988+
(lambda ()
39633989
(#%$call-consuming-continuation-attachment
39643990
'also-unknown
39653991
(lambda (v)
@@ -4866,7 +4892,7 @@
48664892
(begin
48674893
(define ephemeron-key car)
48684894
(define ephemeron-value cdr)
4869-
4895+
48704896
(define gdn (make-guardian))
48714897
#t)
48724898

@@ -4891,7 +4917,7 @@
48914917
es))
48924918
(weak-cons k1 (weak-cons k2 wps))
48934919
(cons k1 saved)))])))
4894-
4920+
48954921
(collect (collect-maximum-generation))
48964922

48974923
;; All now waiting to be reported by the guardian
@@ -4934,7 +4960,7 @@
49344960
;; behavior
49354961
(let ()
49364962
(define (wrapper v) (list 1 2 3 4 5 v))
4937-
4963+
49384964
;; Create a chain of ephemerons where we have all
49394965
;; the the ephemerons immediately in a list,
49404966
;; but we discover the keys one at a time
@@ -5008,7 +5034,7 @@
50085034
50095035
;; ----------------------------------------
50105036
;; Check interaction of mutation and generations
5011-
5037+
50125038
;; This check disables interrupts so that a garbage collection
50135039
;; happens only for the explicit `collect` request.
50145040
(with-interrupts-disabled

‎s/7.ss

Lines changed: 16 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -621,21 +621,22 @@
621621
(lambda (body out)
622622
(call/cc
623623
(lambda (k)
624-
(parameterize ([reset-handler
625-
(lambda ()
626-
(call-in-continuation k
627-
(lambda ()
628-
(out)
629-
((reset-handler)))))])
630-
(with-exception-handler
631-
(lambda (c)
632-
; would prefer not to burn bridges even for serious condition
633-
; if the exception is continuable, but we have no way to know
634-
; short of grubbing through the continuation
635-
(if (serious-condition? c)
636-
(call-in-continuation k (lambda () (out) (raise c)))
637-
(raise-continuable c)))
638-
body))))))
624+
(let ([marks (current-continuation-marks)])
625+
(parameterize ([reset-handler
626+
(lambda ()
627+
(call-in-continuation k
628+
(lambda ()
629+
(out)
630+
((reset-handler)))))])
631+
(with-exception-handler
632+
(lambda (c)
633+
; would prefer not to burn bridges even for serious condition
634+
; if the exception is continuable, but we have no way to know
635+
; short of grubbing through the continuation
636+
(if (serious-condition? c)
637+
(call-in-continuation k marks (lambda () (out) (raise c)))
638+
(raise-continuable c)))
639+
body)))))))
639640

640641
(define exit-handler)
641642
(define reset-handler)

0 commit comments

Comments
 (0)