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