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