further refinements of properties
[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 #:use-module (language python property )
22
23 #:replace (list abs min max)
24 #:re-export (Exception StopIteration send sendException next
25 GeneratorExit sendClose RuntimeError
26 len dir next dict None property)
27 #:export (print repr complex float int round
28 set all any bin callable
29 chr classmethod staticmethod
30 divmod enumerate filter format
31 getattr hasattr hash hex isinstance
32 iter map sum id input oct ord pow))
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
195
196 (define min py-min)
197 (define max py-max)
198 (define list pylist)
199