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