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