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