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 ref
   7                      py-super-mac type object pylist-ref define-python-class
   8                      object-method))
   9   #:use-module (language python exceptions       )
  10   #:use-module ((language python module string   ) #:select ())
  11   #:use-module ((language python module io       ) #:select (open))
  12   #:use-module (language python def              )
  13   #:use-module (language python for              )
  14   #:use-module (language python try              )
  15   #:use-module (language python yield            )
  16   #:use-module (language python list             )
  17   #:use-module (language python dict             )
  18   #:use-module (language python set              )
  19   #:use-module (language python compile          )
  20   #:use-module (language python string           )
  21   #:use-module (language python bytes            )
  22   #:use-module (language python set              )
  23   #:use-module (language python number           )
  24   #:use-module (language python dir              )
  25   #:use-module (language python hash             )
  26   #:use-module (language python property         )
  27   #:use-module (language python range            )
  28   #:use-module (language python tuple            )
  29   #:use-module (language python eval             )
  30   #:use-module (language python bool             )
  31
  32   #:replace (list abs min max hash round format)
  33
  34   #:re-export (StopIteration GeneratorExit RuntimeError
  35                              Exception ValueError TypeError
  36                              IndexError KeyError AttributeError
  37                              send sendException next
  38                              GeneratorExit sendClose RuntimeError
  39                              SyntaxError bool
  40                              len dir next dict None property range
  41                              tuple bytes bytearray eval locals globals
  42                              compile exec type object open
  43                              )
  44
  45   #:export (print repr complex float int str
  46                   set all any bin callable reversed
  47                   chr classmethod staticmethod objectmethod
  48                   divmod enumerate filter
  49                   getattr hasattr setattr hex isinstance issubclass
  50                   iter map sum id input oct ord pow super
  51                   sorted zip
  52                   ClassMethod StaticMethod Funcobj))
  53
  54 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
  55
  56 (define print
  57   (case-lambda
  58     (()  ((@ (guile) format) #t "~%"))
  59     ((x) ((@ (guile) format) #t "~s~%" x))
  60     (l   ((@ (guile) format) #t "~s~%" l))))
  61
  62 (define (repr x) ((@ (guile) format) #f "~a" x))
  63 (define abs     py-abs)
  64 (define str     pystring)
  65 (define complex py-complex)
  66 (define float   py-float)
  67 (define int     py-int)
  68 (define round   py-round)
  69 (define set     py-set)
  70 (define all     py-all)
  71 (define any     py-any)
  72 (define bin     py-bin)
  73 (define divmod  py-divmod)
  74 (define format  py-format)
  75 (define hash    py-hash)
  76 (define hex     py-hex)
  77
  78 (define-method (callable  x                     ) #f)
  79 (define-method (callable (x <procedure>        )) #t)
  80 (define-method (callable (x <procedure-class>  )) #t)
  81 (define-method (callable (x <applicable>       )) #t)
  82 (define-method (callable (x <primitive-generic>)) #t)
  83 (define-method (callable (x <p>))
  84   (ref x '__call__))
  85
  86 (define chr integer->char)
  87
  88 (define objectmethod object-method)
  89 (define classmethod  class-method)
  90 (define staticmethod static-method)
  91
  92 (define (enumerate l)
  93   ((make-generator ()
  94     (lambda (yield)
  95        (for ((x : l)) ((i 0))
  96             (yield i x)
  97            (+ i 1))))))
  98
  99 (define (filter f l)
 100   ((make-generator ()
 101      (lambda (yield)
 102        (for ((x : l)) ()
 103             (if (f x)
 104                 (yield x)))))))
 105
 106 (define miss ((@ (guile) list) 'miss))
 107
 108 (define* (getattr a b #:optional (k miss))
 109   (let ((r (ref a (if (string? b) (string->symbol b) b) k)))
 110     (if (eq? r miss)
 111         (raise AttributeError "object/class ~a is missing attribute ~a" a b)
 112         r)))
 113
 114 (define (setattr a k v)
 115   (set a (if (string? k) (string->symbol k) k) v))
 116
 117 (define (hasattr a b)
 118   (let ((r (ref a (symbol->string b) miss)))
 119     (not (eq? r miss))))
 120
 121 (define-method (issubclass x y) #f)
 122 (define-method (issubclass (sub <p>) (cls <p>))
 123   (aif it (ref cls '__subclasscheck__)
 124        (it cls sub)
 125        (if (eq? sub cls)
 126            #t
 127            (is-a? (ref sub '__goops__) (ref cls '__goops__)))))
 128
 129 (define-method (isinstance x y)
 130   (if (null? y)
 131       #f
 132       (if (pair? y)
 133           (or (isinstance x (car y))
 134               (isinstance x (cdr y)))
 135           (is-a? x y))))
 136
 137 (define-method (isinstance (i <integer>) y)
 138   (if (issubclass y int)
 139       #t
 140       (if (pair? y)
 141           (or (isinstance i (car y))
 142               (isinstance i (cdr y)))
 143           (is-a? i y))))
 144
 145 (define-method (isinstance (i <real>) y)
 146   (if (issubclass y float)
 147       #t
 148       (if (pair? y)
 149           (or (isinstance i (car y))
 150               (isinstance i (cdr y)))
 151           (is-a? i y))))
 152
 153 (define-method (isinstance (i <pair>) y)
 154   (if (issubclass y tuple)
 155       #t
 156       (if (pair? y)
 157           (or (isinstance i (car y))
 158               (isinstance i (cdr y)))
 159           (is-a? i y))))
 160
 161 (define-method (isinstance (i <string>) y)
 162   (if (issubclass y str)
 163       #t
 164       (if (pair? y)
 165           (or (isinstance i (car y))
 166               (isinstance i (cdr y)))
 167           (is-a? i y))))
 168
 169 (define-method (isinstance (i <bytevector>) y)
 170   (if (issubclass y bytes)
 171       #t
 172       (if (pair? y)
 173           (or (isinstance i (car y))
 174               (isinstance i (cdr y)))
 175           (is-a? i y))))
 176
 177
 178 (define-method (isinstance o (cl <p>))
 179   (cond
 180    ((eq? cl py-list)
 181     (is-a? o <py-list>))
 182    (else #f)))
 183
 184 (define-method (isinstance (o <p>) (cl <p>))
 185   (cond
 186    ((ref cl '__instancecheck__) =>
 187     (lambda (it)
 188       (it o)))
 189    ((pair? cl)
 190     (or
 191      (isinstance o (car cl))
 192      (isinstance o (cdr cl))))
 193    (else
 194     (is-a? o (ref cl '__goops__)))))
 195
 196
 197
 198 (define iter
 199   (case-lambda
 200     ((o) (aif it (wrap-in o)
 201               it
 202               (aif get (ref o '__getitem__)
 203                    (make-generator iter
 204                                    (lambda (yield)
 205                                      (for () ((i 0))
 206                                           (yield (get i))
 207                                           (+ i 1))))
 208                    (raise TypeError "not iterable" o))))
 209     ((f sent)
 210      (make-generator iter
 211                      (lambda (yield)
 212                        (for () ()
 213                             (let ((r (f)))
 214                               (if (equal? r sent)
 215                                   (break)
 216                                   (yield r)))))))))
 217
 218
 219
 220 (define-syntax map
 221   (lambda (x)
 222     (syntax-case x ()
 223       ((map f a ...)
 224        (with-syntax (((x ...) (generate-temporaries #'(a ...))))
 225          #'(for ((x : a) ...) ((l '()))
 226             (cons (f x ...) l)
 227             #:final (py-list (reverse l))))))))
 228
 229 (define* (sum i #:optional (start 0))
 230   (for ((x : i)) ((s start))
 231        (+ s x)
 232        #:final
 233        s))
 234
 235
 236 (define (id x) (object-address x))
 237
 238 (define (input str)
 239   ((@ (guile) format) #t str)
 240   (readline))
 241
 242 (define (idx x) x)
 243
 244 (def (py-min (* l) (= key idx) (= default miss))
 245      (let lp ((l l))
 246        (match l
 247          ((it)
 248           (for ((x : it)) ((s miss) (b miss))
 249                (if (eq? s miss)
 250                    (values (key x) x)
 251                    (let ((k (key x)))
 252                      (if (< k s)
 253                          (values k x)
 254                          (values s b))))
 255                #:final
 256                (if (eq? b miss)
 257                    (if (eq? default miss)
 258                        (raise ValueError
 259                               "min does not work for zero length list")
 260                        default)
 261                    b)))
 262          (_ (lp ((@ (guile) list) l))))))
 263
 264 (def (py-max (* l) (= key idx) (= default miss))
 265      (let lp ((l l))
 266        (match l
 267          ((it)
 268           (for ((x : it)) ((s miss) (b miss))
 269                (if (eq? s miss)
 270                    (values (key x) x)
 271                    (let ((k (key x)))
 272                      (if (> k s)
 273                          (values k x)
 274                          (values s b))))
 275                #:final
 276                (if (eq? b miss)
 277                    (if (eq? default miss)
 278                        (raise ValueError
 279                               "min does not work for zero length list")
 280                        default)
 281                    b)))
 282          (_ (lp ((@ (guile) list) l))))))
 283
 284 (define (oct x) (+ "0o" (number->string (py-index x) 8)))
 285 (define (ord x) (char->integer (string-ref (pylist-ref x 0) 0)))
 286
 287 (define pow
 288   (case-lambda
 289     ((x y)
 290      (expt x y))
 291     ((x y z)
 292      (py-mod (expt x y) z))))
 293
 294 (define-syntax-rule (super . l) (py-super-mac . l))
 295
 296 (define min  py-min)
 297 (define max  py-max)
 298 (define list pylist)
 299 (define reversed py-reversed)
 300 (define (key-id x) x)
 301 (define* (sorted it #:key (key key-id) (reverse #f))
 302   (define l (to-pylist '()))
 303   (for ((x : it)) () (pylist-append! l x))
 304   (pylist-sort! l #:key key #:reverse reverse)
 305   l)
 306
 307 (define (zip . l)
 308   (let ((l ((@ (guile) map) wrap-in l)))
 309     ((make-generator ()
 310       (lambda (yield)
 311         (let lp ()
 312           (let lp2 ((l l) (r '()))
 313             (if (pair? l)
 314                 (call-with-values (lambda () (next (car l)))
 315                   (lambda z
 316                     (lp2 (cdr l) (append (reverse z) r))))
 317                 (begin
 318                   (yield (reverse r))
 319                   (lp))))))))))
 320
 321 (define-python-class ClassMethod  ())
 322 (define-python-class StaticMethod ())
 323 (define-python-class Funcobj      ())
 324
 325
 326
 327
 328