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