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