decimal

[software/python-on-guile.git] / modules / language / python / module / python.scm

(define-module (language python module python)
  #:use-module (oop goops)
  #:use-module (ice-9 match)
  #:use-module (ice-9 readline)
  #:use-module ((oop pf-objects) #:select
                (<p> <property> class-method static-method ref
                     py-super-mac type object pylist-ref define-python-class
                     object-method))
  #:use-module (language python exceptions       )
  #:use-module ((language python module string   ) #:select ())
  #:use-module (language python def              )
  #:use-module (language python for              )
  #:use-module (language python try              )
  #:use-module (language python yield            )
  #:use-module (language python list             )
  #:use-module (language python dict             )
  #:use-module (language python set              )
  #:use-module (language python compile          )
  #:use-module (language python string           )
  #:use-module (language python bytes            )
  #:use-module (language python set              )
  #:use-module (language python number           )
  #:use-module (language python dir              )
  #:use-module (language python hash             )
  #:use-module (language python property         )
  #:use-module (language python range            )
  #:use-module (language python tuple            )
  #:use-module (language python eval             )
  #:use-module (language python bool             )

  #:replace (list abs min max hash round format)
  
  #:re-export (StopIteration GeneratorExit RuntimeError
                             Exception ValueError TypeError
                             IndexError KeyError AttributeError
                             send sendException next
                             GeneratorExit sendClose RuntimeError
                             SyntaxError bool
                             len dir next dict None property range
                             tuple bytes bytearray eval locals globals
                             compile exec type object
                             )
  
  #:export (print repr complex float int str
                  set all any bin callable reversed
                  chr classmethod staticmethod objectmethod
                  divmod enumerate filter open
                  getattr hasattr setattr hex isinstance issubclass
                  iter map sum id input oct ord pow super
                  sorted zip
                  ClassMethod StaticMethod Funcobj))

(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))

(define (path-it path)
  (aif it (ref path '__fspath__)
       (it)
       path))

(define print
  (case-lambda
    (()  ((@ (guile) format) #t "~%"))
    ((x) ((@ (guile) format) #t "~s~%" x))
    (l   ((@ (guile) format) #t "~s~%" l))))

(define (repr x) ((@ (guile) format) #f "~a" x))
(define abs     py-abs)
(define str     pystring)
(define complex py-complex)
(define float   py-float)
(define int     py-int)
(define round   py-round)
(define set     py-set)
(define all     py-all)
(define any     py-any)
(define bin     py-bin)
(define divmod  py-divmod)
(define format  py-format)
(define hash    py-hash)
(define hex     py-hex)

(define-method (callable  x                     ) #f)
(define-method (callable (x <procedure>        )) #t)
(define-method (callable (x <procedure-class>  )) #t)
(define-method (callable (x <applicable>       )) #t)
(define-method (callable (x <primitive-generic>)) #t)
(define-method (callable (x <p>))
  (ref x '__call__))

(define chr integer->char)

(define objectmethod object-method)
(define classmethod  class-method)
(define staticmethod static-method)

(define (enumerate l)
  ((make-generator ()
    (lambda (yield)
       (for ((x : l)) ((i 0))
            (yield i x)
           (+ i 1))))))

(define (filter f l)
  ((make-generator ()
     (lambda (yield)
       (for ((x : l)) ()
            (if (f x)
                (yield x)))))))

(define miss ((@ (guile) list) 'miss))

(define* (getattr a b #:optional (k miss))
  (let ((r (ref a (if (string? b) (string->symbol b) b) k)))
    (if (eq? r miss)
        (raise AttributeError "object/class ~a is missing attribute ~a" a b)
        r)))

(define (setattr a k v)
  (set a (if (string? k) (string->symbol k) k) v))

(define (hasattr a b)
  (let ((r (ref a (symbol->string b) miss)))
    (not (eq? r miss))))

(define-method (issubclass x y) #f)
(define-method (issubclass (sub <p>) (cls <p>))
  (aif it (ref cls '__subclasscheck__)
       (it cls sub)
       (if (eq? sub cls)
           #t
           (is-a? (ref sub '__goops__) (ref cls '__goops__)))))

(define-method (isinstance x y)
  (if (null? y)
      #f
      (if (pair? y)
          (or (isinstance x (car y))
              (isinstance x (cdr y)))
          (is-a? x y))))

(define-method (isinstance (i <integer>) y)
  (if (issubclass y int)
      #t
      (if (pair? y)
          (or (isinstance i (car y))
              (isinstance i (cdr y)))
          (is-a? i y))))

(define-method (isinstance (i <real>) y)
  (if (issubclass y float)
      #t
      (if (pair? y)
          (or (isinstance i (car y))
              (isinstance i (cdr y)))
          (is-a? i y))))

(define-method (isinstance (i <pair>) y)
  (if (issubclass y tuple)
      #t
      (if (pair? y)
          (or (isinstance i (car y))
              (isinstance i (cdr y)))
          (is-a? i y))))

(define-method (isinstance (i <string>) y)
  (if (issubclass y str)
      #t
      (if (pair? y)
          (or (isinstance i (car y))
              (isinstance i (cdr y)))
          (is-a? i y))))

(define-method (isinstance (i <bytevector>) y)
  (if (issubclass y bytes)
      #t
      (if (pair? y)
          (or (isinstance i (car y))
              (isinstance i (cdr y)))
          (is-a? i y))))


(define-method (isinstance o (cl <p>))
  (cond
   ((eq? cl py-list)
    (is-a? o <py-list>))
   (else #f)))
  
(define-method (isinstance (o <p>) (cl <p>))
  (cond
   ((ref cl '__instancecheck__) =>
    (lambda (it)
      (it o)))
   ((pair? cl)
    (or
     (isinstance o (car cl))
     (isinstance o (cdr cl))))
   (else
    (is-a? o (ref cl '__goops__)))))
               
               

(define iter
  (case-lambda
    ((o) (aif it (wrap-in o)
              it
              (aif get (ref o '__getitem__)
                   (make-generator iter
                                   (lambda (yield)
                                     (for () ((i 0))
                                          (yield (get i))
                                          (+ i 1))))
                   (raise TypeError "not iterable" o))))
    ((f sent)
     (make-generator iter
                     (lambda (yield)
                       (for () ()
                            (let ((r (f)))
                              (if (equal? r sent)
                                  (break)
                                  (yield r)))))))))
                               
                                      

(define-syntax map
  (lambda (x)
    (syntax-case x ()
      ((map f a ...)
       (with-syntax (((x ...) (generate-temporaries #'(a ...))))
         #'(for ((x : a) ...) ((l '()))
            (cons (f x ...) l)
            #:final (py-list (reverse l))))))))
                    
(define* (sum i #:optional (start 0))
  (for ((x : i)) ((s start))
       (+ s x)
       #:final
       s))


(define (id x) (object-address x))

(define (input str)
  ((@ (guile) format) #t str)
  (readline))

(define (idx x) x)

(def (py-min (* l) (= key idx) (= default miss))
     (let lp ((l l))
       (match l
         ((it)
          (for ((x : it)) ((s miss) (b miss))
               (if (eq? s miss)
                   (values (key x) x)
                   (let ((k (key x)))
                     (if (< k s)
                         (values k x)
                         (values s b))))
               #:final
               (if (eq? b miss)
                   (if (eq? default miss)
                       (raise ValueError
                              "min does not work for zero length list")
                       default)
                   b)))
         (_ (lp ((@ (guile) list) l))))))

(def (py-max (* l) (= key idx) (= default miss))
     (let lp ((l l))
       (match l
         ((it)
          (for ((x : it)) ((s miss) (b miss))
               (if (eq? s miss)
                   (values (key x) x)
                   (let ((k (key x)))
                     (if (> k s)
                         (values k x)
                         (values s b))))
               #:final
               (if (eq? b miss)
                   (if (eq? default miss)
                       (raise ValueError
                              "min does not work for zero length list")
                       default)
                   b)))
         (_ (lp ((@ (guile) list) l))))))

(define (oct x) (+ "0o" (number->string (py-index x) 8)))
(define (ord x) (char->integer (string-ref (pylist-ref x 0) 0)))

(define pow
  (case-lambda
    ((x y)
     (expt x y))
    ((x y z)
     (py-mod (expt x y) z))))

(define-syntax-rule (super . l) (py-super-mac . l))       

(define min  py-min)
(define max  py-max)
(define list pylist)
(define reversed py-reversed)
(define (key-id x) x)
(define* (sorted it #:key (key key-id) (reverse #f))
  (define l (to-pylist '()))
  (for ((x : it)) () (pylist-append! l x))
  (pylist-sort! l #:key key #:reverse reverse)
  l)

(define (zip . l)
  (let ((l ((@ (guile) map) wrap-in l)))
    ((make-generator ()
      (lambda (yield)
        (let lp ()
          (let lp2 ((l l) (r '()))
            (if (pair? l)
                (call-with-values (lambda () (next (car l)))
                  (lambda z
                    (lp2 (cdr l) (append (reverse z) r))))
                (begin
                  (yield (reverse r))
                  (lp))))))))))

(define DEFAULT_BUFFER_SIZE 4096)
(def (open path
           (= mode      "r")
           (= buffering -1 )
           (= encoding   None)
           (= errors     None)
           (= newline    None)
           (= closefd    #t)
           (= opener     None))
     
     (define modelist (string->list mode))
     (define path     (path-it path))
     (define (clean ch l)
       (filter (lambda (c) (not (eq? ch c))) l))
     (let ((port (if (number? path)
                     (begin
                       (if (member #\a modelist)
                           (seek path 0 SEEK_END))
                       (if (member #\x modelist)
                           (error "cannot use mode 'x' for fd input"))
                       (cond
                        ((member #\r modelist)
                         (fdes->inport path))
                        ((member #\w modelist)
                         (fdes->outport path))))
                     (begin
                       (if (member #\x modelist)
                           (if (file-exists? path)
                               (raise OSError "mode='x' and file exists")
                               (set mode (list->string
                                          (clean #\x modelist)))))                                                            
                       ((@ (guile) open-file) (path-it path) mode)))))

       (case buffering
         ((-1)
          (setvbuf port 'block DEFAULT_BUFFER_SIZE))
         ((0)
          (setvbuf port 'none))
         ((1)
          (setvbuf port 'line))
         (else
          (setvbuf port 'block buffering)))

       port))


(define-python-class ClassMethod  ())
(define-python-class StaticMethod ())
(define-python-class Funcobj      ())