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