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