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