4103c4dea2978c0ef08a18524f4a0c2147419b34
[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
24 #:replace (list abs min max)
25 #:re-export (Exception StopIteration send sendException next
26 GeneratorExit sendClose RuntimeError
27 len dir next dict None property)
28 #:export (print repr complex float int round
29 set all any bin callable
30 chr classmethod staticmethod
31 divmod enumerate filter format
32 getattr hasattr hash hex isinstance
33 iter map sum id input oct ord pow super))
34
35 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
36
37 (define print
38 (case-lambda
39 (() (format #t "~%"))
40 ((x) (format #t "~s~%" x))
41 (l (format #t "~s~%" l))))
42
43 (define (repr x) (format #f "~a" x))
44 (define abs py-abs)
45 (define string pystring)
46 (define complex py-complex)
47 (define float py-float)
48 (define int py-int)
49 (define round py-round)
50 (define set py-set)
51 (define all py-all)
52 (define any py-any)
53 (define bin py-bin)
54 (define divmod py-divmod)
55 (define format py-format)
56 (define hash py-hash)
57 (define hex py-hex)
58
59 (define-method (callable x ) #f)
60 (define-method (callable (x <procedure> )) #t)
61 (define-method (callable (x <procedure-class> )) #t)
62 (define-method (callable (x <applicable> )) #t)
63 (define-method (callable (x <primitive-generic>)) #t)
64 (define-method (callable (x <p>))
65 (refq x '__call__))
66
67 (define chr integer->char)
68
69 (define classmethod class-method)
70 (define staticmethod static-method)
71
72 (define (enumerate l)
73 (make-generator enumerate
74 (lambda (yield)
75 (for ((x : l)) ((i 0))
76 (yield i x)
77 (+ i 1)))))
78
79 (define (filter f l)
80 (make-generator enumerate
81 (lambda (yield)
82 (for ((x : l)) ()
83 (if (f x)
84 (yield x))))))
85
86 (define miss ((@ (guile) list) 'miss))
87
88 (define* (getattr a b #:optional (k miss))
89 (let ((r (refq a (symbol->string b) k)))
90 (if (eq? r miss)
91 (raise AttributeError "object/class ~a is missing attribute ~a" a b)
92 r)))
93
94 (define (hasattr a b)
95 (let ((r (refq a (symbol->string b) miss)))
96 (not (eq? r miss))))
97
98 (define (isinstance o cl)
99 (if (pair? cl)
100 (or
101 (isinstance o (car cl))
102 (isinstance o (cdr cl)))
103 (is-a? o cl)))
104
105 (define iter
106 (case-lambda
107 ((o) (aif it (wrap-in o)
108 it
109 (aif get (refq o '__getitem__)
110 (make-generator iter
111 (lambda (yield)
112 (for () ((i 0))
113 (yield (get i))
114 (+ i 1))))
115 (raise TypeError "not iterable" o))))
116 ((f sent)
117 (make-generator iter
118 (lambda (yield)
119 (for () ()
120 (let ((r (f)))
121 (if (equal? r sent)
122 (break)
123 (yield r)))))))))
124
125
126
127 (define-syntax map
128 (lambda (x)
129 (syntax-case x ()
130 ((map f a ...)
131 (with-syntax (((x ...) (generate-temporaries #'(a ...))))
132 #'(make-generator map
133 (lambda (yield)
134 (for ((x : a) ...) () (yield (f x ...))))))))))
135
136 (define* (sum i #:optional (start 0))
137 (for ((x : i)) ((s start))
138 (+ s x)
139 #:final
140 s))
141
142
143 (define (id x) (object-address x))
144
145 (define (input str)
146 (format #t str)
147 (readline))
148
149 (define (idx x) x)
150
151 (def (py-min (* l) (= key idx) (= default miss))
152 (let lp ((l l))
153 (match l
154 ((it)
155 (for ((x : it)) ((s default) (b default))
156 (if (eq? s miss)
157 (values (key x) x)
158 (let ((k (key x)))
159 (if (< k s)
160 (values k x)
161 (values s b))))
162 #:final
163 (if (eq? b miss)
164 (raise ValueError "min does not work for zero length list")
165 b)))
166 (_ (lp ((@ (guile) list) l))))))
167
168 (def (py-max (* l) (= key idx) (= default miss))
169 (let lp ((l l))
170 (match l
171 ((it)
172 (for ((x : it)) ((s default) (b default))
173 (if (eq? default miss)
174 (values (key x) x)
175 (let ((k (key x)))
176 (if (> k s)
177 (values k x)
178 (values s b))))
179 #:final
180 (if (eq? b miss)
181 (raise ValueError "min does not work for zero length list")
182 b)))
183 (_ (lp ((@ (guile) list) l))))))
184
185 (define (oct x) (+ "0o" (number->string (py-index x) 8)))
186 (define (ord x) (char->integer (string-ref (pylist-ref x 0) 0)))
187
188 (define pow
189 (case-lambda
190 ((x y)
191 (expt x y))
192 ((x y z)
193 (py-mod (expt x y) z))))
194
195 (define-syntax-rule (super . l) (py-super-mac . l))
196
197 (define min py-min)
198 (define max py-max)
199 (define list pylist)