418c3252006a481ce9c6209a22691b24b6490a2c
[software/python-on-guile.git] / modules / language / python / module / python.scm
1 (define-module (language python module python)
2 #:use-module (oop goops)
3 #:use-module (ice-9 match)
4 #:use-module (ice-9 readline)
5 #:use-module ((oop pf-objects) #:select
6 (<p> <property> class-method static-method refq
7 py-super-mac))
8 #:use-module (language python exceptions )
9 #:use-module (language python def )
10 #:use-module (language python for )
11 #:use-module (language python try )
12 #:use-module (language python yield )
13 #:use-module (language python list )
14 #:use-module (language python dict )
15 #:use-module (language python set )
16 #:use-module (language python compile )
17 #:use-module (language python string )
18 #:use-module (language python set )
19 #:use-module (language python number )
20 #:use-module (language python dir )
21 #:use-module (language python hash )
22 #:use-module (language python property )
23 #:use-module (language python range )
24 #:use-module (language python tuple )
25
26 #:replace (list abs min max hash round)
27 #:re-export (Exception StopIteration send sendException next
28 GeneratorExit sendClose RuntimeError
29 len dir next dict None property range
30 tuple
31 )
32 #:export (print repr complex float int
33 set all any bin callable reversed
34 chr classmethod staticmethod
35 divmod enumerate filter format
36 getattr hasattr hex isinstance
37 iter map sum id input oct ord pow super
38 sorted zip))
39
40 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
41
42 (define print
43 (case-lambda
44 (() (format #t "~%"))
45 ((x) (format #t "~s~%" x))
46 (l (format #t "~s~%" l))))
47
48 (define (repr x) (format #f "~a" x))
49 (define abs py-abs)
50 (define string pystring)
51 (define complex py-complex)
52 (define float py-float)
53 (define int py-int)
54 (define round py-round)
55 (define set py-set)
56 (define all py-all)
57 (define any py-any)
58 (define bin py-bin)
59 (define divmod py-divmod)
60 (define format py-format)
61 (define hash py-hash)
62 (define hex py-hex)
63
64 (define-method (callable x ) #f)
65 (define-method (callable (x <procedure> )) #t)
66 (define-method (callable (x <procedure-class> )) #t)
67 (define-method (callable (x <applicable> )) #t)
68 (define-method (callable (x <primitive-generic>)) #t)
69 (define-method (callable (x <p>))
70 (refq x '__call__))
71
72 (define chr integer->char)
73
74 (define classmethod class-method)
75 (define staticmethod static-method)
76
77 (define (enumerate l)
78 (make-generator enumerate
79 (lambda (yield)
80 (for ((x : l)) ((i 0))
81 (yield i x)
82 (+ i 1)))))
83
84 (define (filter f l)
85 (make-generator enumerate
86 (lambda (yield)
87 (for ((x : l)) ()
88 (if (f x)
89 (yield x))))))
90
91 (define miss ((@ (guile) list) 'miss))
92
93 (define* (getattr a b #:optional (k miss))
94 (let ((r (refq a (symbol->string b) k)))
95 (if (eq? r miss)
96 (raise AttributeError "object/class ~a is missing attribute ~a" a b)
97 r)))
98
99 (define (hasattr a b)
100 (let ((r (refq a (symbol->string b) miss)))
101 (not (eq? r miss))))
102
103 (define (isinstance o cl)
104 (if (pair? cl)
105 (or
106 (isinstance o (car cl))
107 (isinstance o (cdr cl)))
108 (is-a? o cl)))
109
110 (define iter
111 (case-lambda
112 ((o) (aif it (wrap-in o)
113 it
114 (aif get (refq o '__getitem__)
115 (make-generator iter
116 (lambda (yield)
117 (for () ((i 0))
118 (yield (get i))
119 (+ i 1))))
120 (raise TypeError "not iterable" o))))
121 ((f sent)
122 (make-generator iter
123 (lambda (yield)
124 (for () ()
125 (let ((r (f)))
126 (if (equal? r sent)
127 (break)
128 (yield r)))))))))
129
130
131
132 (define-syntax map
133 (lambda (x)
134 (syntax-case x ()
135 ((map f a ...)
136 (with-syntax (((x ...) (generate-temporaries #'(a ...))))
137 #'(make-generator map
138 (lambda (yield)
139 (for ((x : a) ...) () (yield (f x ...))))))))))
140
141 (define* (sum i #:optional (start 0))
142 (for ((x : i)) ((s start))
143 (+ s x)
144 #:final
145 s))
146
147
148 (define (id x) (object-address x))
149
150 (define (input str)
151 (format #t str)
152 (readline))
153
154 (define (idx x) x)
155
156 (def (py-min (* l) (= key idx) (= default miss))
157 (let lp ((l l))
158 (match l
159 ((it)
160 (for ((x : it)) ((s default) (b default))
161 (if (eq? s miss)
162 (values (key x) x)
163 (let ((k (key x)))
164 (if (< k s)
165 (values k x)
166 (values s b))))
167 #:final
168 (if (eq? b miss)
169 (raise ValueError "min does not work for zero length list")
170 b)))
171 (_ (lp ((@ (guile) list) l))))))
172
173 (def (py-max (* l) (= key idx) (= default miss))
174 (let lp ((l l))
175 (match l
176 ((it)
177 (for ((x : it)) ((s default) (b default))
178 (if (eq? default miss)
179 (values (key x) x)
180 (let ((k (key x)))
181 (if (> k s)
182 (values k x)
183 (values s b))))
184 #:final
185 (if (eq? b miss)
186 (raise ValueError "min does not work for zero length list")
187 b)))
188 (_ (lp ((@ (guile) list) l))))))
189
190 (define (oct x) (+ "0o" (number->string (py-index x) 8)))
191 (define (ord x) (char->integer (string-ref (pylist-ref x 0) 0)))
192
193 (define pow
194 (case-lambda
195 ((x y)
196 (expt x y))
197 ((x y z)
198 (py-mod (expt x y) z))))
199
200 (define-syntax-rule (super . l) (py-super-mac . l))
201
202 (define min py-min)
203 (define max py-max)
204 (define list pylist)
205 (define reversed py-reversed)
206 (define (key-id x) x)
207 (define* (sorted it #:key (key key-id) (reverse #f))
208 (define l (to-pylist '()))
209 (for ((x : it)) () (pylist-append! l x))
210 (pylist-sort! l #:key key #:reverse reverse)
211 l)
212
213 (define (zip . l)
214 (let ((l ((@ (guile) map) wrap-in l)))
215 ((make-generator ()
216 (lambda (yield)
217 (let lp ()
218 (let lp2 ((l l) (r '()))
219 (if (pair? l)
220 (call-with-values (lambda () (next (car l)))
221 (lambda z
222 (lp2 (cdr l) (append (reverse z) r))))
223 (begin
224 (apply yield (reverse r))
225 (lp))))))))))
226
227
228