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