blob: 9778f3ba6b40ddbe4b07560d27c8f5d41c5edf4c (
about) (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
(define-module (language python try)
#:use-module (language python exceptions)
#:use-module (language python yield)
#:use-module (oop pf-objects)
#:use-module (oop goops)
#:use-module (ice-9 control)
#:use-module (ice-9 match)
#:replace (raise)
#:export (try))
(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
(define-inlinable (standard-check class obj l)
(if (struct? obj)
(if (is-a? obj <p>)
(if (is-a? class <p>)
(is-a? obj (ref class '__goops__))
(is-a? obj class))
(if (is-a? obj <object>)
(is-a? obj class)
(eq? obj class)))
(if (and (procedure? class) (not (pyclass? class)))
(apply class obj l)
(eq? class obj))))
(define (check class obj l)
(standard-check class obj l))
(define-syntax compile-error
(lambda (x)
(syntax-case x ()
((_ x)
(error (syntax->datum #'x))))))
(define-syntax check-exception
(syntax-rules (and or not)
((_ (or E ...) tag l)
(or (check-exception E tag l) ...))
((_ (and E ...) tag l)
(and (check-exception E tag l) ...))
((_ (not E) tag l)
(not (check-exception E tag l)))
((_ E tag l)
(check E tag l))))
(define-syntax handler
(syntax-rules (=>)
((handler ecx)
(lambda (k tag . l)
(handler ecx tag l)))
((handler ((#:except E => lam) . ecx) tag l)
(if (check-exception E tag l)
(lam tag l)
(handler ecx tag l)))
((handler ((#:except E code ...) . ecx) tag l)
(if (check-exception E tag l)
(nbegin code ...)
(handler ecx tag l)))
((handler ((#:else code ...)) tag l)
(begin code ...))
((handler () tag l)
(apply throw 'python tag l))
((a ...)
(compile-error "not a proper python macro try block"))))
(define-syntax try
(syntax-rules ()
((try code exc ... #:finally fin)
(dynamic-wind
(lambda () #f)
(lambda ()
(catch #t
code
(handler (exc ...))))
(lambda ()
(if (not (fluid-ref in-yield))
(fin)))))
((try code exc ...)
(catch #t
code
(handler (exc ...))))))
(define raise
(case-lambda
((x . l)
(if (pyclass? x)
(throw 'python (apply x l))
(apply throw 'python x l)))
(() (raise Exception))))
|
