diff options
author | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2017-10-17 00:59:20 +0200 |
---|---|---|
committer | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2017-10-17 00:59:20 +0200 |
commit | b40e3b8b85eb3562cc49b2cbea041ee50949c46d (patch) | |
tree | 6b5a1087b7db3f161e8869ad3982ce1b5ac1f4c9 /modules/language/python | |
parent | a7346773d6b517fc09e5b776fb685daffc228528 (diff) |
completer
Diffstat (limited to 'modules/language/python')
-rw-r--r-- | modules/language/python/bytes.scm | 1218 | ||||
-rw-r--r-- | modules/language/python/compile.scm | 6 | ||||
-rw-r--r-- | modules/language/python/completer.scm | 48 | ||||
-rw-r--r-- | modules/language/python/dir.scm | 2 | ||||
-rw-r--r-- | modules/language/python/list.scm | 19 | ||||
-rw-r--r-- | modules/language/python/module/f2.scm | 30 | ||||
-rw-r--r-- | modules/language/python/module/python.scm | 3 | ||||
-rw-r--r-- | modules/language/python/spec.scm | 6 | ||||
-rw-r--r-- | modules/language/python/str.scm | 846 | ||||
-rw-r--r-- | modules/language/python/tuple.scm | 5 |
10 files changed, 1321 insertions, 862 deletions
diff --git a/modules/language/python/bytes.scm b/modules/language/python/bytes.scm new file mode 100644 index 0000000..880e3e7 --- /dev/null +++ b/modules/language/python/bytes.scm @@ -0,0 +1,1218 @@ +(define-module (language python bytes) + #:use-module (oop goops) + #:use-module (oop pf-objects) + #:use-module (ice-9 match) + #:use-module (rnrs bytevectors) + #:use-module (system foreign) + #:use-module (language python string) + #:use-module (language python for) + #:use-module (language python try) + #:use-module (language python exceptions) + #:use-module (language python list) + #:use-module (language python hash) + #:export (<py-bytes> pybytes-listing bytes bytevector bytes->bytevector)) + +(define (bytes->bytevector x) (slot-ref x 'bytes)) +(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) + +(define b-ref bytevector-u8-ref) +(define b-set! bytevector-u8-set!) +(define b-make make-bytevector) +(define b-len bytevector-length) + +(define-class <py-bytes> () bytes) +(define-class <py-bytearray> () n vec) + +(define-method (b-get (o <bytevector>)) + o) +(define-method (b-get (o <py-bytes>)) + (slot-ref o 'bytes)) +(define-method (b-get (o <py-bytearray>)) + (slot-ref o 'vec)) + +(define (b-char x) + (cond + ((char? x) + (ch-find x)) + ((string? x) + (ch-find (string-ref x 0))) + (else + x))) + +(define-python-class bytes (<py-bytes>) + (define __init__ + (case-lambda + ((self s) + (cond + ((is-a? s <string>) + (let* ((n (string-length s)) + (bytes (b-make n))) + (let lp ((i 0)) + (if (< i n) + (begin + (b-set! bytes i (ch-find (string-ref s i))) + (lp (+ i 1))))) + (slot-set! self 'bytes bytes))) + ((is-a? s <py-string>) + (__init__ self (slot-ref s 'bytes))) + ((is-a? s <py-bytes>) + (slot-set! self 'bytes (slot-ref s 'bytes))) + ((is-a? s <bytevector>) + (slot-set! self 'bytes s)) + ((is-a? s <py-bytearray>) + (let* ((n (slot-ref s 'n)) + (b (b-make n))) + (bytevector-copy! (slot-ref s 'vec) 0 b 0 n) + (slot-set! self 'bytes b))) + (else + (for ((x : s)) ((r '())) + (cons (b-char x) r) + + #:final + (let* ((n (length r)) + (bytes (b-make n))) + (let lp ((i (- n 1)) (r r)) + (if (>= i 0) + (begin + (b-set! bytes i (car r)) + (lp (- i 1) (cdr r))) + (slot-set! self 'bytes bytes))))))))))) + +(define-python-class bytearray (<py-bytearray>) + (define __init__ + (case-lambda + ((self s) + (cond + ((is-a? s <string>) + (let* ((n (string-length s)) + (bytes (b-make n))) + (let lp ((i 0)) + (if (< i n) + (begin + (b-set! bytes i (ch-find (string-ref s i))) + (lp (+ i 1))))) + (slot-set! self 'vec bytes) + (slot-set! self 'n n))) + ((is-a? s <py-string>) + (__init__ self (slot-ref s 'str))) + ((is-a? s <py-bytes>) + (let ((b (slot-ref s 'bytes))) + (slot-set! self 'vec (bytevector-copy b)) + (slot-set! self 'n (b-len b)))) + ((is-a? s <bytevector>) + (slot-set! self 'vec (bytevector-copy s)) + (slot-set! self 'n (b-len s))) + ((is-a? s <py-bytearray>) + (slot-set! self 'vec (bytevector-copy (slot-ref s 'vec))) + (slot-set! self 'n (slot-ref s 'n))) + (else + (for ((x : s)) ((r '())) + (cons (b-char x) r) + #:final + (let* ((n (length r)) + (bytes (b-make n))) + (let lp ((i (- n 1)) (r r)) + (if (>= i 0) + (begin + (b-set! bytes i (car r)) + (lp (- i 1) (cdr r))) + (begin + (slot-set! self 'vec bytes) + (slot-set! self 'n (b-len bytes))))))))))))) + +(define-syntax-rule (define-py (f o . u) code ...) + (begin + (define-method (f (o <bytevector>) . u) code ...) + (define-method (f (o <py-bytes>) . l) (apply f (slot-ref o 'bytes) l)))) + +(define-syntax-rule (define-py! (f o . u) code ...) + (begin + (define-method (f (o <py-bytearray>) . u) code ...))) + +(define (idd x) x) +(define-syntax-rule (define-py* (f m o n . u) code ...) + (begin + (define (g m o n . u) code ...) + (define-method (f (o <bytevector>) . l) + (apply g idd o (b-len o) l)) + (define-method (f (o <py-bytes>) . l) + (let ((b (slot-ref o 'bytes))) + (apply g bytes b (b-len b) l))) + (define-method (f (o <py-bytearray>) . l) + (let ((b (slot-ref o 'vec)) + (n (slot-ref o 'n))) + (apply g bytearray b n l))))) + +(define-method (write (b <py-bytes>) . l) + (define port (if (pair? l) (car l) #t)) + (format port "b~s" (b->string (slot-ref b 'bytes)))) + +(define-method (write (b <py-bytearray>) . l) + (define port (if (pair? l) (car l) #t)) + (format port "ba~s" (b->string (pylist-slice (slot-ref b 'vec) 0 (len b) 1)))) + + +(define dynlink (dynamic-link)) + +(define stringn + (pointer->procedure + '* + (dynamic-func "scm_from_locale_stringn" dynlink) + (list '* size_t))) + +(define ch->i (make-hash-table)) + +(define (re-eval ch) + (let lp ((i 0)) + (if (< i 256) + (if (eq? ch (chf i)) + (begin + (hash-set! ch->i ch i) + (lp (+ i 1))) + (lp (+ i 1))) + (hash-ref ch->i ch)))) + +(define (ch-find ch) + (aif it (hash-ref ch->i ch #f) + (if (eq? ch (chf it)) + it + (re-eval ch)) + (re-eval ch))) + +(define (chf ch) + (let ((bytes (pointer->scm + (stringn + (bytevector->pointer + (b-make 1 ch)) + 1)))) + (if (= (string-length bytes) 1) + (string-ref bytes 0) + (chf 0)))) + +(define (b->string b) + (pointer->scm + (stringn (bytevector->pointer b) (b-len b)))) + +(define-py (py-hash b) (hash b pyhash-N)) + +(define-py (pylist-ref o nin) + (define N (b-len o)) + (define n (if (< nin 0) (+ N nin) nin)) + (if (and (>= n 0) (< n N)) + (bytes (b-make (b-ref o n))) + (raise IndexError))) + +(define-py! (pylist-ref o nin) + (define N (slot-ref o 'n)) + (define v (slot-ref o 'vec)) + (define n (if (< nin 0) (+ N nin) nin)) + (if (and (>= n 0) (< n N)) + (bytes (b-make (b-ref v n))) + (raise IndexError))) + +(define-py (len b) (b-len b)) +(define-py! (len b) (slot-ref b 'n)) + +(define-py* (to-list mk b n) + (let lp ((i 0) (r '())) + (if (< i n) + (lp (+ i 1) (cons (b-ref b i) r)) + (reverse r)))) + +(define-py* (to-pylist mk b n) + (let* ((m n) + (o (make <py-list>)) + (v (make-vector m))) + (slot-set! o 'vec v) + (slot-set! o 'n n) + (let lp ((i 0)) + (if (< i n) + (begin + (vector-set! v i (bytes (b-make 1 (b-ref b i)))) + (lp (+ i 1))) + o)))) + + +(define-py! (pylist-set! o nin val) + (define N (slot-ref o 'n)) + (define n (if (< nin 0) (+ N nin) nin)) + (if (and (>= n 0) (< n (slot-ref o 'n))) + (b-set! (slot-ref o 'vec) n val) + (raise IndexError))) + +(define-py (pylist-slice o n1 n2 n3) + (define N (b-len o)) + (define (f n) (if (< n 0) (+ N n) n)) + + (let* ((n1 (f (if (eq? n1 None) 0 n1))) + (n2 (f (if (eq? n2 None) (slot-ref o 'n) n2))) + (n3 (f (if (eq? n3 None) 1 n3))) + (n (let lp ((i n1) (j 0)) + (if (< i n2) + (lp (+ i n3) (+ j 1)) + j))) + (b (b-make n))) + (let lp ((i n1) (j 0)) + (if (< j n) + (begin + (b-set! b j (b-ref o i)) + (lp (+ i n3) (+ j 1))) + (bytes b))))) + +(define-py! (pylist-slice o n1 n2 n3) + (define N (slot-ref o 'n)) + (define (f n) (if (< n 0) (+ N n) n)) + + (let* ((n1 (f (if (eq? n1 None) 0 n1))) + (n2 (f (if (eq? n2 None) (slot-ref o 'n) n2))) + (n3 (f (if (eq? n3 None) 1 n3))) + (v (slot-ref o 'vec)) + (n (let lp ((i n1) (j 0)) + (if (< i n2) + (lp (+ i n3) (+ j 1)) + j))) + (b (b-make n)) + (r (make <py-bytes>))) + (slot-set! r 'vec b) + (slot-set! r 'n n) + (let lp ((i n1) (j 0)) + (if (< j n) + (begin + (b-set! b j (b-ref v i)) + (lp (+ i n3) (+ j 1))) + r)))) + +(define-py! (pylist-subset! o n1 n2 n3 val) + (define N (slot-ref o 'n)) + (define (f n) (if (< n 0) (+ N n) n)) + + (let* ((n1 (f (if (eq? n1 None) 0 n1))) + (n2 (f (if (eq? n2 None) (slot-ref o 'n) n2))) + (n3 (f (if (eq? n3 None) 1 n3))) + (vec (slot-ref o 'vec)) + (l2 (to-list val)) + (N2 (length l2))) + (if (<= n2 N) + (let lp ((i 0) (l2 l2) (j n1)) + (if (< j n2) + (if (< i N2) + (let ((r (car l2))) + (if (and (number? r) (integer? r) (>= r 0) (< r 256)) + (begin + (vector-set! vec j r) + (lp (+ i 1) (cdr l2) (+ j n3))) + (raise TypeError "not a byte"))) + (let lp ((j2 j)) + (if (< j2 n2) + (lp (+ j2 n3)) + (let lp ((k1 j) (k2 j2)) + (if (< k2 N) + (begin + (vector-set! vec k1 (vector-ref vec k2)) + (lp (+ k1 1) (+ k2 1))) + (begin + (let lp ((i k2)) + (if (< i N) + (begin + (vector-set! vec i #f) + (lp (+ i 1))) + (slot-set! o 'n k1))))))))))) + (raise IndexError)) + (values))) + +(define (byte x) + (or (and (integer? x) (>= x 0) (< x 256) x) + (and (is-a? x '<bytevector>) (b-ref x 0)) + (and (is-a? x '<py-bytes>) (b-ref (slot-ref x 'bytes) 0)) + (and (is-a? x '<py-bytearray>) (b-ref (slot-ref x 'vec) 0)))) + +(define-py! (pylist-append! o val) + (let* ((n (slot-ref o 'n)) + (vec (slot-ref o 'vec)) + (N (vector-length vec))) + (aif val (byte val) + (begin + (if (< n N) + (begin + (vector-set! vec n val) + (slot-set! o 'n (+ n 1))) + (let* ((N (* 2 N)) + (vec2 (b-make N))) + (let lp ((i 0)) + (if (< i n) + (begin + (b-set! vec2 i (b-ref vec i)) + (lp (+ i 1))))) + (b-set! vec2 n val) + (slot-set! o 'vec vec2))) + (slot-set! o 'n (+ n 1)) + (values)) + (raise TypeError "not a byte")))) + + +(define (b-concat b1 n1 b2 n2) + (let* ((n (+ n1 n2)) + (b (b-make n))) + (let lp ((i 0)) + (if (< i n1) + (begin + (b-set! b i (b-ref b1 i)) + (lp (+ i 1))) + (let lp ((i i) (j 0)) + (begin + (b-set! b i (b-ref b2 j)) + (lp (+ i 1) (+ j 1))) + b))))) + +(define-method (+ (o1 <py-bytes>) (b2 <bytevector>)) + (let* ((b1 (slot-ref o1 'bytes)) + (n1 (b-len b1)) + (n2 (b-len b2)) + (o (make <py-bytes>)) + (b (b-concat b1 n1 b2 n2))) + (slot-set! o 'bytes b) + o)) + +(define-method (+ (b2 <bytevector>) (o1 <py-bytes>)) + (let* ((b1 (slot-ref o1 'bytes)) + (n1 (b-len b1)) + (n2 (b-len b2)) + (o (make <py-bytes>)) + (b (b-concat b2 n2 b1 n1))) + (slot-set! o 'bytes b) + o)) + +(define-method (+ (b1 <bytevector>) (b2 <bytevector>)) + (let* ((n1 (b-len b1)) + (n2 (b-len b2))) + (b-concat b1 n1 b2 n2))) + +(define-method (+ (o1 <py-bytes>) (o2 <py-bytes>)) + (let* ((b1 (slot-ref o1 'bytes)) + (b2 (slot-ref o2 'bytes)) + (n1 (b-len b1)) + (n2 (b-len b2)) + (o (make <py-bytes>)) + (b (b-concat b1 n1 b2 n2))) + (slot-set! o 'bytes b) + o)) + +(define-method (+ (o1 <py-bytearray>) (o2 <py-bytes>)) + (let* ((b1 (slot-ref o1 'vec)) + (b2 (slot-ref o2 'bytes)) + (n1 (slot-ref o1 'n)) + (n2 (b-len b2)) + (o (make <py-bytearray>)) + (b (b-concat b1 n1 b2 n2))) + (slot-set! o 'vec b) + (slot-set! o 'n (+ n1 n2)) + o)) + +(define-method (+ (o1 <py-bytearray>) (b2 <bytevector>)) + (let* ((b1 (slot-ref o1 'vec)) + (n1 (slot-ref o1 'n)) + (n2 (b-len b2)) + (o (make <py-bytearray>)) + (b (b-concat b1 n1 b2 n2))) + (slot-set! o 'vec b) + (slot-set! o 'n (+ n1 n2)) + o)) + +(define-method (+ (o2 <py-bytes>) (o1 <py-bytearray>)) + (let* ((b1 (slot-ref o1 'vec)) + (b2 (slot-ref o2 'bytes)) + (n1 (slot-ref o1 'n)) + (n2 (b-len b2)) + (o (make <py-bytearray>)) + (b (b-concat b2 n2 b1 n1))) + (slot-set! o 'vec b) + (slot-set! o 'n (+ n1 n2)) + o)) + +(define-method (+ (b2 <bytevector>) (o1 <py-bytearray>) ) + (let* ((b1 (slot-ref o1 'vec)) + (n1 (slot-ref o1 'n)) + (n2 (b-len b2)) + (o (make <py-bytearray>)) + (b (b-concat b2 n2 b1 n1))) + (slot-set! o 'vec b) + (slot-set! o 'n (+ n1 n2)) + o)) + +(define-method (+ (o1 <py-bytearray>) (o2 <py-bytearray>)) + (let* ((b1 (slot-ref o1 'vec)) + (b2 (slot-ref o2 'vec)) + (n1 (slot-ref o1 'n)) + (n2 (slot-ref o2 'n)) + (o (make <py-bytearray>)) + (b (b-concat b1 n1 b2 n2))) + (slot-set! o 'vec b) + (slot-set! o 'n (+ n1 n2)) + o)) + +(define (b-rep b n m) + (let* ((N (* n m)) + (r (b-make N))) + (let lp ((i 0) (j 0)) + (if (< i m) + (let lp2 ((j j) (k 0)) + (if (< k n) + (begin + (b-set! r j (b-ref b k)) + (lp2 (+ j 1) (+ k 1))) + (lp (+ i 1) j))) + r)))) + +(define-method (* (o1 <py-bytearray>) m) + (let* ((b1 (slot-ref o1 'vec)) + (n1 (slot-ref o1 'n)) + (o (make <py-bytearray>)) + (b (b-rep b1 n1 m))) + (slot-set! o 'vec b) + (slot-set! o 'n (* n1 m)) + o)) + +(define-method (* (b1 <bytevector>) m) + (let* ((n1 (b-len b1))) + (b-rep b1 n1 m))) + +(define-method (* (o1 <py-bytes>) m) + (let* ((b1 (slot-ref o1 'bytes)) + (n1 (b-len b1)) + (o (make <py-bytes>)) + (b (b-rep b1 n1 m))) + (slot-set! o 'bytes b) + o)) + +(define-py* (py-capitalize bytes s n) + (let* ((w (b-make n))) + (let lp ((i 0) (first? #t)) + (if (< i n) + (let* ((x (b-ref s i)) + (ch (chf x))) + (define (f first?) + (b-set! w i x) + (lp (+ i 1) first?)) + + (if (and first? (char-alphabetic? ch)) + (aif it (ch-find (char-upcase ch)) + (begin + (b-set! w i it) + (lp (+ i 1) #f)) + (f #t)) + (f #f))) + (bytes w))))) + +(define-py* (py-center bytes o n w . l) + (let* ((ws (if (pair? l) + (ch-find (b-ref (car l) 0)) + (ch-find #\space))) + (w (if (< w n) n w)) + (d (- w n)) + (e (floor-quotient (- w n) 2)) + (s (b-make w (ch-find #\space)))) + (let lp ((i 0) (j e)) + (if (< i n) + (begin + (b-set! s j (b-ref o i)) + (lp (+ i 1) (+ j 1))))) + (bytes s))) + +;;;py-decode +;;;py-encode + +(define-py* (py-endswith bytes o n suff . l) + (let* ((suff (slot-ref (bytes suff) 'bytes)) + (ns (b-len suff)) + (f (lambda (x) (< x 0) (+ n x) x))) + (call-with-values (lambda () + (match l + (() (values 0 n )) + ((x) (values (f x) n )) + ((x y) (values (f x) (f y))))) + (lambda (start end) + (let lp ((i (- n ns)) (j 0)) + (if (< i start) + (lp (+ i 1) (+ j 1)) + (if (>= i end) + #t + (and + (eq? (b-ref o i) (b-ref suff j)) + (lp (+ i 1) (+ j 1)))))))))) + +(define-py* (py-startswith bytes o n pre . l) + (let* ((pre (slot-ref (bytes pre) 'bytes)) + (pre (b-get pre)) + (ns (len pre)) + (f (lambda (x) (< x 0) (+ n x) x))) + (call-with-values (lambda () + (match l + (() (values 0 n )) + ((x) (values (f x) n )) + ((x y) (values (f x) (f y))))) + (lambda (start end) + (let lp ((i 0)) + (cond + ((or (>= i end) + (>= i ns)) + #t) + ((< i start) + (lp (+ i 1))) + (else + (and + (eq? (b-ref o i) (b-ref pre i)) + (lp (+ i 1)))))))))) + + +(define-py* (py-expandtabs bytes s n . l) + (let* ((tabsize (match l (() 8) ((x) x))) + (ct (ch-find #\tab)) + (cs (ch-find #\space)) + (n (b-len s))) + (let lp ((i 0) (r '())) + (if (< i n) + (let ((x (b-ref s i))) + (if (eq? x ct) + (let lp2 ((j 0) (r r)) + (if (< j tabsize) + (lp2 (+ j 1) (cons cs r)) + (lp (+ i 1) r))) + (lp (+ i 1) (cons x r)))) + (bytes (reverse r)))))) + +(define (b-contains s sub nsub start end) + (define (match i) + (let lp ((i i) (j 0)) + (if (and (< j nsub) (< i end)) + (if (eq? (b-ref s i) (b-ref sub j)) + (lp (+ i 1) (+ j 1)) + #f) + #t))) + + (let lp ((i (max start 0))) + (if (< i end) + (if (match i) + i + (lp (+ i 1))) + #f))) + +(define-py* (py-find bytes s n sub . l) + (let* ((f (lambda (x) (< x 0) (+ n x) x))) + (call-with-values (lambda () + (match l + (() (values 0 n )) + ((x) (values (f x) n )) + ((x y) (values (f x) (f y))))) + (lambda (start end) + (let ((sub (b-get sub))) + (aif it (b-contains s sub (len sub) start end) + it + -1)))))) + +(define (b-reverse s n) + (if (is-a? s (<py-bytes>)) + (b-reverse (slot-ref s 'bytes) n) + (let* ((r (b-make n))) + (let lp ((i 0) (j (- n 1))) + (if (< i n) + (begin + (b-set! r j (b-ref s i)) + (lp (+ i 1) (- j 1))) + r))))) + + +(define-py* (py-rfind bytes s n sub . l) + (let* ((sub (slot-ref (bytes sub) 'bytes)) + (s (b-reverse s n)) + (nsub (len sub)) + (sub (b-reverse (b-get sub) nsub)) + (f (lambda (x) (< x 0) (+ n x) x))) + (call-with-values (lambda () + (match l + (() (values 0 n )) + ((x) (values (f x) n )) + ((x y) (values (f x) (f y))))) + (lambda (start end) + (aif it (b-contains s sub nsub start end) + (- n it nsub) + -1))))) + +#| +(define i (f-list #:i (mk-token (f+ (f-reg! "[0-9]"))))) +(define s (f-list #:s (mk-token (f+ (f-not! (f-tag "}")))))) +(define e (f-list #:e (f-and (f-tag "}") f-true))) +(define tagbody (f-or! e i s)) + +(define tag (f-seq "{" tagbody "}")) +(define nontag (f-list #:bytes (mk-token (f+ (f-or! (f-tag "{{") + (f-not! tag)))))) +(define e (ff* (f-or! tag nontag))) + +(define (compile x args kwargs) + (let lp ((l x) (r '()) (u '()) (i 0)) + (match l + (((#:bytes x) . l) + (lp l (cons x r) u i)) + (((#:i x) . l) + (lp l (cons "~a" r) (cons (list-ref args (string->number x)) u) i)) + (((#:s x) . l) + (lp l (cons "~a" r) (cons (hash-ref kwargs x None) u) i)) + (((#:e) . l) + (lp l (cons "~a" r) (cons (list-ref args i) u) (+ i 1))) + (() + (apply format #f (string-join (reverse r) "") (reverse u)))))) + +(define-py (py-format format s . l) + (call-with-values + (lambda () + (let lp ((l l) (args '()) (kwargs (make-hash-table))) + (match l + (((? keyword? key) x . l) + (hash-set! kwargs (symbol->string (keyword->symbol key)) x) + (lp l args kwargs)) + ((x . l) + (lp l (cons x args) kwargs)) + (() + (values (reverse args) kwargs))))) + (lambda (args kwargs) + (compile (parse s e) args kwargs)))) +|# + +(define-syntax-rule (mk-is py-isalnum x ...) + (define-py* (py-isalnum bytes s n) + (let lp ((i 0)) + (if (< i n) + (let ((ch (chf (b-ref s i)))) + (if (or (x ch) ...) + (lp (+ i 1)) + #f)) + #t)))) + +(mk-is py-isalnum char-alphabetic? char-numeric?) +(mk-is py-isalpha char-alphabetic?) +(mk-is py-isdigit char-numeric?) +(mk-is py-islower char-lower-case?) +(mk-is py-isspace char-whitespace?) +(mk-is py-isupper char-upper-case?) + + +(define-py* (py-istitle bytes s n) + (if ((> n 0)) + (let lp ((i 0) (space? #t)) + (if (< i n) + (let ((ch (chf (b-ref s i)))) + (if space? + (cond + ((char-whitespace? ch) + (lp (+ i 1) #t)) + ((char-upper-case? ch) + (lp (+ i 1) #f)) + (else + #f)) + (cond + ((char-whitespace? ch) + (lp (+ i 1) #t)) + ((char-upper-case? ch) + #f) + ((char-lower-case? ch) + (lp (+ i 1) #f)) + (else + #f)))) + #t)) + #f)) + +(define (b-join bytes l s ns) + (let* ((n (let lp ((l l) (n 0)) + (if (pair? l) + (let ((x (car l)) + (l (cdr l))) + (lp l (+ n (len x) (if (pair? l) ns 0)))) + n))) + (r (b-make n))) + (let lp ((l l) (i 0)) + (if (pair? l) + (let* ((x (car l)) + (n (len x)) + (x (b-get x)) + (l (cdr l))) + (let lp2 ((j 0) (i i)) + (if (< j n) + (begin + (b-set! r i (b-ref x j)) + (lp2 (+ j 1) (+ i 1))) + (if (pair? l) + (let lp3 ((j 0) (i i)) + (if (< j ns) + (begin + (b-set! r i (b-ref s j)) + (lp3 (+ j 1) (+ i 1))) + (lp l i))) + (lp l i))))) + (bytes r))))) + +(define-py* (py-join bytes s n iterator) + (b-join bytes (to-list iterator) s n)) + +(define-py* (py-ljust bytes s n width . l) + (let* ((ch (match l + ((x) + (b-char x)) + (() + (b-char #\space))))) + (if (< width n) + (pylist-slice s 0 width 1) + (let ((ret (b-make width ch))) + (let lp ((i 0)) + (if (< i n) + (begin + (b-set! ret i (b-ref s i)) + (lp (+ i 1))) + (bytes ret))))))) + +(define-py* (py-rjust bytes s n width . l) + (let* ((ch (match l + ((x) + (b-char x)) + (() + (b-char #\space))))) + (if (< width n) + (pylist-slice s (- width) (len s) 1) + (let ((ret (b-make width ch))) + (let lp ((i 0) (j (- width n))) + (if (< i n) + (begin + (b-set! ret j (b-ref s i)) + (lp (+ i 1) (+ j 1))) + (bytes ret))))))) + + +(define-py* (py-lower bytes s n) + (let* ((r (b-make n))) + (let lp ((i 0)) + (if (< i n) + (let* ((x (b-ref s i)) + (ch (chf x))) + (b-set! r i (if (char-upper-case? ch) + (ch-find (char-downcase ch)) + x)) + (lp (+ i 1))) + (bytes r))))) + +(define-py* (py-upper bytes s n) + (let* ((r (b-make n))) + (let lp ((i 0)) + (if (< i n) + (let* ((x (b-ref s i)) + (ch (chf x))) + (b-set! r i (if (char-lower-case? ch) + (ch-find (char-upcase ch)) + x)) + (lp (+ i 1))) + (bytes r))))) + +(define-py* (py-swapcase bytes s n) + (let* ((r (b-make n))) + (let lp ((i 0)) + (if (< i n) + (let* ((x (b-ref s i)) + (ch (chf x))) + (b-set! r i (cond + ((char-lower-case? ch) + (ch-find (char-upcase ch))) + ((char-upper-case? ch) + (ch-find (char-downcase ch))) + (else + x))) + (lp (+ i 1))) + (bytes r))))) + +(define b-trim + (case-lambda + ((bytes s n) + (b-trim bytes s n (lambda (ch x) (char-whitespace? ch)))) + ((bytes s n p) + (let lp ((i 0) (r '()) (first? #t)) + (if (< i n) + (let ((x (b-ref s i))) + (if first? + (if (p (chf x) x) + (lp (+ i 1) r #t) + (lp (+ i 1) (cons x r) #f)) + (lp (+ i 1) (cons x r) #f))) + (bytes (reverse r))))))) + +(define b-rtrim + (case-lambda + ((bytes s n) + (b-rtrim bytes s n (lambda (ch x) (char-whitespace? ch)))) + ((bytes s n p) + (let lp ((i (- n 1)) (r '()) (first? #t)) + (if (>= i 0) + (let ((x (b-ref s i))) + (if first? + (if (p (chf x) x) + (lp (- i 1) r #t) + (lp (- i 1) (cons x r) #f)) + (lp (- i 1) (cons x r) #f))) + (bytes r)))))) + +(define-py* (py-lstrip bytes s n . l) + (match l + (() + (b-trim bytes s n)) + ((x) + (let ((l (map b-char (to-list x)))) + (b-trim bytes s n (lambda (ch x) (member x l))))))) + +(define-py* (py-rstrip bytes s n . l) + (match l + (() + (b-rtrim bytes s n)) + ((x) + (let ((l (map b-char (to-list x)))) + (b-rtrim bytes s n (lambda (ch x) (member x l))))))) + + +(define-py* (py-partition bytes s n sep) + (let* ((sep (b-get sep)) + (m (b-len sep))) + (define (test i) + (let lp ((i i) (j 0)) + (if (< i n) + (if (< j m) + (if (eq? (b-ref s i) (b-ref sep j)) + (lp (+ i 1) (+ j 1)) + #f) + #t) + #f))) + (let lp ((i 0)) + (if (< i n) + (if (test i) + (list (pylist-slice s 0 i) sep (pylist-slice s (+ i m) n)) + (lp (+ i 1))) + (list s "" ""))))) + +(define-py* (py-rpartition bytes ss n ssep) + (let* ((s (b-reverse ss n)) + (m (len ssep)) + (sep (b-reverse (b-get ssep) m))) + (define (test i) + (let lp ((i i) (j 0)) + (if (< i n) + (if (< j m) + (if (eq? (b-ref s i) (b-ref sep j)) + (lp (+ i 1) (+ j 1)) + #f) + #t) + #f))) + (let lp ((i 0)) + (if (< i n) + (if (test i) + (list (bytes + (b-reverse + (pylist-slice s (+ i m) n) + (- n (+ i m)))) + (bytes sep) + (bytes + (b-reverse + (pylist-slice s 0 i) + i))) + (lp (+ i 1))) + (list (bytes "") (bytes "") s))))) + +(define-py* (py-replace bytes s n old new . l) + (let ((n (match l (() #f) ((n . _) n)))) + (b-join + bytes + (reverse + (let lp ((s s) (r '())) + (let ((l (py-partition s old))) + (if (equal? (cadr l) "") + (cons s r) + (lp (list-ref l 2) (cons (car l) r)))))) + n + new))) + +(define-py (py-stripip s . l) + (apply py-rstrip (apply py-lstrip s l) l)) + +(define-py! (py-stripip s . l) + (apply py-rstrip (apply py-lstrip s l) l)) + +(define-py* (pylist-index bytes o n val . l) + (let* ((vec o) + (f (lambda (m) (if (< m 0) (+ m n) m)))) + (call-with-values + (lambda () + (match l + (() + (values 0 n)) + ((x) + (values (f x) n)) + ((x y) + (values (f x) (f y))))) + (lambda (n1 n2) + (if (and (>= n1 0) (>= n2 0) (< n1 n) (<= n2 n)) + (let lp ((i n1)) + (if (< i n2) + (let ((r (b-ref vec i))) + (if (equal? r val) + i + (lp (+ i 1)))) + (raise ValueError "could not find value in index fkn"))) + (raise IndexError "index out of scop in index fkn")))))) + +(define-py* (py-rindex býtes s n . l) + (let ((n (b-len s))) + (- n (apply pylist-index (b-reverse s n) l) 1))) + +#; +(define-py (py-title title s) + (string-titlecase s)) + +#; +(define-py (py-split s . l) + (define ws (f+ (f-reg "[ \t\n]"))) + (define r + (f-or! (f-seq f-eof (f-out '())) + (f-cons (f-seq (mk-token (f* (f-reg! "."))) f-eof) (f-out '())))) + (define (u ws) (mk-token (f+ (f-not! ws)))) + (define (tok ws i) + (if (= i 0) + (f-list (mk-token (f* (f-reg! ".")))) + (let ((e (mk-token (f* (f-not! ws))))) + (f-seq (f? ws) + (f-cons e + (let lp ((i i)) + (if (> (- i 1) 0) + (f-or! (f-seq (f? ws) f-eof (f-out '())) + (f-cons (f-seq ws e) (Ds (lp (- i 1))))) + r))))))) + + (define N 1000000000000) + (let ((e (call-with-values + (lambda () + (match l + (() (values ws N)) + ((sep) (values (f-tag sep) N)) + ((sep n) (values (f-tag sep) n)))) + tok))) + (parse s e))) + +#; +(define-py (py-rsplit s . l) + (reverse + (map string-reverse + (apply py-split + (string-reverse s) + (match l + (() '()) + ((sep . l) (cons (string-reverse sep) l))))))) + + +(define-py* (py-splitlines bytes s n . l) + (let ((keep? (match l + ((#:keepends v) + v) + ((v) + v) + (_ #f)))) + (let lp ((i 0) (r '()) (old 0)) + (if (< i n) + (let* ((x (b-ref s i)) + (ch (chf x))) + (if (eq? ch #\newline) + (if keep? + (lp (+ i 1) + (cons + (pylist-slice s old (+ i 1) 1) + r) + (+ i 1)) + (lp (+ i 1) + (cons + (pylist-slice s old i 1) + r) + (+ i 1))) + (lp (+ i 1) r old))) + (reverse r))))) + +(define-py* (py-translate bytes s n table . l) + (let* ((table (b-get table)) + (w (b-make n)) + (t (if (eq? table None) #f table)) + (d (match l (() #f) ((x) (map b-char (to-list x)))))) + (define (tr ch) + (define (e) + (if t + (if (< ch (b-len t)) + (b-ref t ch) + ch) + ch)) + + (if d + (if (member ch d) + #f + (e)) + (e))) + + (let lp ((i 0) (k 0)) + (if (< i n) + (let ((ch (tr (b-ref s i)))) + (if ch + (begin + (b-set! w k ch) + (lp (+ i 1) (+ k 1))) + (lp (+ i 1) k))) + (bytes + (if (= k n) + w + (pylist-slice w 0 k 1))))))) + +(define-syntax-rule (a b x y) (b (symbol->string x) (symbol->string y))) + +(define-syntax-rule (mkop op) + (begin + (define-method (op (s1 <bytevector>) (s2 <py-bytes>)) + (op s1 (slot-ref s2 'bytes))) + (define-method (op (s2 <py-bytes>) (s1 <bytevector>)) + (op s1 (slot-ref s2 'bytes))))) + +(mkop <) +(mkop <=) +(mkop >) +(mkop >=) +(mkop py-equal?) +(mkop +) +(mkop *) + +(define-syntax-rule (mkop2 op) + (define-method (< (s1 <bytevector>) (s2 <bytevector>)) + (let* ((n1 (b-len s1)) + (n2 (b-len s2)) + (n (min n1 n2))) + (let lp ((i 0)) + (if (< i n) + (let ((x1 (b-ref s1 i)) + (x2 (b-ref s2 i))) + (if (= x1 x2) + (lp (+ i 1)) + (op x1 x2))) + (op n1 n2)))))) + +(mkop2 <) +(mkop2 <=) +(mkop2 >=) +(mkop2 >) +(mkop2 py-equal?) + +(define-py* (py-zfill bytes s n width) + (let* ((w (pylist-slice s 0 n 1))) + (let lp ((i 0)) + (if (< i n) + (let* ((x (b-ref s i)) + (ch (chf x))) + (if (char-numeric? ch) + (let lp ((j (max 0 (- i width)))) + (if (< j i) + (begin + (b-set! w j (ch-find #\0)) + (lp (+ j 1))) + (bytes w))) + (lp (+ i 1)))) + s)))) + + (define-method (py-hash (o <py-bytes>)) (hash (slot-ref o 'bytes) pyhash-N)) + +(define-class <bytes-iter> (<py-bytes>) i d) +(define-class <bytearray-iter> (<py-bytearray>) i d) + +(define-method (wrap-in (o <bytes-iter> )) + (let ((out (make <bytes-iter>))) + (slot-set! out 'bytes (slot-ref o 'bytes)) + (slot-set! out 'i (slot-ref o 'i)) + (slot-set! out 'd (slot-ref o 'd)) + out)) + +(define-method (wrap-in (o <bytearray-iter> )) + (let ((out (make <bytearray-iter>))) + (slot-set! out 'vec (slot-ref o 'vec)) + (slot-set! out 'n (slot-ref o 'n)) + (slot-set! out 'i (slot-ref o 'i)) + (slot-set! out 'd (slot-ref o 'd)) + out)) + +(define-method (wrap-in (s <bytevector>)) + (let ((out (make <bytes-iter>))) + (slot-set! out 'bytes s) + (slot-set! out 'i 0) + (slot-set! out 'd 1) + out)) + +(define-method (py-reversed (s <py-bytes>)) + (let ((out (make <bytes-iter>))) + (slot-set! out 'bytes (slot-ref s 'bytes)) + (slot-set! out 'i (- (b-len s) 1)) + (slot-set! out 'd -1) + out)) + +(define-method (py-reversed (s <py-bytearray>)) + (let ((out (make <bytearray-iter>))) + (slot-set! out 'n (slot-ref s 'n)) + (slot-set! out 'vec (slot-ref s 'vec)) + (slot-set! out 'i (- (slot-ref s 'n) 1)) + (slot-set! out 'd -1) + out)) + +(define-method (next (o <bytes-iter>)) + (let ((i (slot-ref o 'i )) + (d (slot-ref o 'd)) + (bytes (slot-ref o 'bytes))) + (if (> d 0) + (if (< i (b-len bytes)) + (let ((ret (b-ref bytes i))) + (slot-set! o 'i (+ i d)) + ret) + (throw StopIteration)) + (if (>= i 0) + (let ((ret (b-ref bytes i))) + (slot-set! o 'i (+ i d)) + ret) + (throw StopIteration))))) + +(define-method (next (o <bytearray-iter>)) + (let ((i (slot-ref o 'i )) + (d (slot-ref o 'd )) + (bytes (slot-ref o 'vec)) + (n (slot-ref o 'n ))) + (if (> d 0) + (if (< i n) + (let ((ret (b-ref bytes i))) + (slot-set! o 'i (+ i d)) + ret) + (throw StopIteration)) + (if (>= i 0) + (let ((ret (b-ref bytes i))) + (slot-set! o 'i (+ i d)) + ret) + (throw StopIteration))))) + +(define (pybytes-listing) + (let ((l (to-pylist + (map symbol->string + '(__add__ __class__ __contains__ __delattr__ __doc__ + __eq__ __format__ __ge__ __getattribute__ + __getitem__ __getnewargs__ __getslice__ __gt__ + __hash__ __init__ __le__ __len__ __lt__ __mod__ + __mul__ __ne__ __new__ __reduce__ __reduce_ex__ + __repr__ __rmod__ __rmul__ __setattr__ __sizeof__ + __bytes__ __subclasshook__ + _formatter_field_name_split _formatter_parser + capitalize center count decode encode endswith + expandtabs find format index isalnum isalpha + isdigit islower isspace istitle isupper join + ljust lower lbytesip partition replace rfind rindex + rjust rpartition rsplit rbytesip split splitlines + startswith strip swapcase + title translate upper zfill))))) + (pylist-sort! l) + l)) diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index 50698c8..0126bbd 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -11,7 +11,7 @@ #:use-module (language python try) #:use-module (language python list) #:use-module (language python string) - #:use-module (language python str) + #:use-module (language python bytes) #:use-module (language python number) #:use-module (language python def) #:use-module (ice-9 pretty-print) @@ -28,7 +28,7 @@ (define-inlinable (L x) `(@@ (language python list) ,x)) (define-inlinable (A x) `(@@ (language python array) ,x)) (define-inlinable (S x) `(@@ (language python string) ,x)) -(define-inlinable (STR x) `(@@ (language python str) ,x)) +(define-inlinable (B x) `(@@ (language python bytes) ,x)) (define-inlinable (Se x) `(@@ (language python set) ,x)) (define-inlinable (D x) `(@@ (language python def) ,x)) (define-inlinable (Di x) `(@@ (language python dict) ,x)) @@ -618,7 +618,7 @@ (bytevector-u8-set! b i (car u)) (lp2 (cdr u) (+ i 1))) (lp (cdr l) i))))) - `(,(STR 'str) ,b)))) + `(,(B 'bytes) ,b)))) (#:+ diff --git a/modules/language/python/completer.scm b/modules/language/python/completer.scm new file mode 100644 index 0000000..73f96bd --- /dev/null +++ b/modules/language/python/completer.scm @@ -0,0 +1,48 @@ +(define-module (language python completer) + #:use-module (language python list) + #:use-module (language python dir) + #:use-module (system base language) + #:use-module (ice-9 regex) + #:export (complete-fkn)) + +(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) + +(define (old) (@@ (ice-9 readline) *readline-completion-function*)) + +(define reg "(\\w+(\\.\\w+)*)\\.(\\w*)$") + +(define (complete-fkn eval) + (let ((old (old)) + (strs '() ) + (pp "" ) + (regexp #f )) + (letrec + ((compl + (lambda (text continue?) + (if continue? + (if (null? strs) + #f + (let ((str (car strs))) + (set! strs (cdr strs)) + (if (string-match regexp str) + (string-append pp "." str) + (compl text #t)))) + (if (and (equal? (language-name (current-language)) 'python) + (in "." text)) + (aif it (string-match reg text) + (let* ((n (match:count it)) + (p (match:substring it 1)) + (t (match:substring it (- n 1))) + (d (to-list (dir (eval p))))) + (begin + (set! strs d) + (set! pp p) + (set! regexp (string-append + "^" (if (equal? t "") + "[^_]" + (regexp-quote t)))) + (compl text #t))) + #f) + (old text continue?)))))) + compl))) + diff --git a/modules/language/python/dir.scm b/modules/language/python/dir.scm index 1189673..8e3c35d 100644 --- a/modules/language/python/dir.scm +++ b/modules/language/python/dir.scm @@ -84,7 +84,7 @@ (to-pylist (map symbol->string (sort l <)))))) (define-method (dir (o <py-list>)) - (let ((l1 (pylist-listing))) + (let ((l1 (pk (pylist-listing)))) (if (is-a? o <p>) (let* ((l2 (next-method)) (l (+ l1 l2))) diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm index a35ceae..ded6b15 100644 --- a/modules/language/python/list.scm +++ b/modules/language/python/list.scm @@ -174,10 +174,16 @@ (to-pylist l))) (define-method (pylist-slice (o <string>) n1 n2 n3) - (list->string - (map (lambda (x) (string-ref x 0)) - (to-list - (pylist-slice (to-pylist o) n1 n2 n3))))) + (define N (slot-ref o 'n)) + (define (f n) (if (< n 0) (+ N n) n)) + + (let* ((n1 (f (if (eq? n1 None) 0 n1))) + (n2 (f (if (eq? n2 None) (slot-ref o 'n) n2))) + (n3 (f (if (eq? n3 None) 1 n3)))) + (list->string + (map (lambda (x) (string-ref x 0)) + (to-list + (pylist-slice (to-pylist o) n1 n2 n3)))))) (defpair (pylist-slice o n1 n2 n3) @@ -621,7 +627,7 @@ (next-method))) ;; SORT! -(define (id x) id) +(define (id x) x) (define-method (pylist-sort! (o <py-list>) . l) (apply (lambda* (#:key (key id) (reverse #f)) @@ -889,6 +895,3 @@ (break #t)) #:final #f)) - - - diff --git a/modules/language/python/module/f2.scm b/modules/language/python/module/f2.scm new file mode 100644 index 0000000..3a00158 --- /dev/null +++ b/modules/language/python/module/f2.scm @@ -0,0 +1,30 @@ +(define-module (language python module f2) + #:use-module (language python exceptions) + #:use-module (language python for) + #:use-module (language python yield) + #:use-module (language python try) + #:re-export (next send sendException Exception) + #:export (gen)) + +(define gen + (make-generator + (lambda (yield n) + (try + (lambda () + (let lp ((i 0) (s 0)) + (if (< i n) + (let ((x (+ s i))) + (call-with-values (lambda () (yield x)) + (lambda x (pk 'send x))) + (lp (+ i 1) x))))) + + (#:except Exception => + (lambda (tag l) + (apply pk tag l))) + + #:finally + (lambda () + (pk 'yeeeeeees)))))) + +(for ((i : (gen 10))) () + (pk i)) diff --git a/modules/language/python/module/python.scm b/modules/language/python/module/python.scm index 492e013..87bbf32 100644 --- a/modules/language/python/module/python.scm +++ b/modules/language/python/module/python.scm @@ -15,6 +15,7 @@ #: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 ) @@ -27,7 +28,7 @@ #:re-export (Exception StopIteration send sendException next GeneratorExit sendClose RuntimeError len dir next dict None property range - tuple + tuple bytes ) #:export (print repr complex float int set all any bin callable reversed diff --git a/modules/language/python/spec.scm b/modules/language/python/spec.scm index 155de87..429974b 100644 --- a/modules/language/python/spec.scm +++ b/modules/language/python/spec.scm @@ -1,8 +1,10 @@ (define-module (language python spec) #:use-module (parser stis-parser lang python3-parser) #:use-module (language python compile) + #:use-module (language python completer) #:use-module (rnrs io ports) #:use-module (ice-9 pretty-print) + #:use-module (ice-9 readline) #:use-module (system base compile) #:use-module (system base language) #:use-module (language scheme compile-tree-il) @@ -26,6 +28,10 @@ (define (cc port x) (if (equal? x "") (read port) (c x))) +(define (e x) (eval (c x) (current-module))) + +(set! (@@ (ice-9 readline) *readline-completion-function*) (complete-fkn e)) + (define-language python #:title "python" #:reader (lambda (port env) diff --git a/modules/language/python/str.scm b/modules/language/python/str.scm deleted file mode 100644 index ef09def..0000000 --- a/modules/language/python/str.scm +++ /dev/null @@ -1,846 +0,0 @@ -(define-module (language python str) - #:use-module (oop goops) - #:use-module (oop pf-objects) - #:use-module (ice-9 match) - #:use-module (rnrs bytevectors) - #:use-module (system foreign) - #:use-module (language python string) - #:use-module (language python for) - #:use-module (language python try) - #:use-module (language python exceptions) - #:use-module (language python list) - #:use-module (language python hash) - #:export (<py-str> pystr-listing str str->bytevector)) - -(define (str->bytevector x) (slot-ref x 'str)) -(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) - -(define b-ref bytevector-u8-ref) -(define b-set! bytevector-u8-set!) -(define b-make make-bytevector) -(define b-len bytevector-length) - -(define-class <py-str> () str) - -(define (b-char x) - (cond - ((char? x) - (ch-find x)) - ((string? x) - (ch-find (string-ref x 0))) - (else - x))) - -(define-python-class str (<py-str>) - (define __init__ - (case-lambda - ((self s) - (cond - ((is-a? s <string>) - (let* ((n (string-length s)) - (str (b-make n))) - (let lp ((i 0)) - (if (< i n) - (begin - (b-set! str i (ch-find (string-ref s i))) - (lp (+ i 1))))) - (slot-set! self 'str str))) - ((is-a? s <py-string>) - (__init__ self (slot-ref s 'str))) - ((is-a? s <py-str>) - (slot-set! self 'str (slot-ref s 'str))) - ((is-a? s <bytevector>) - (slot-set! self 'str s)) - (else - (for ((x : s)) ((r '())) - (cons (b-char x) r) - - #:final - (let* ((n (length r)) - (str (b-make n))) - (let lp ((i (- n 1)) (r r)) - (if (>= i 0) - (begin - (b-set! str i (car r)) - (lp (- i 1) (cdr r))) - (slot-set! self 'str str))))))))))) - -(define-syntax-rule (define-py (f o . u) code ...) - (begin - (define-method (f (o <bytevector>) . u) code ...) - (define-method (f (o <py-str>) . l) (apply f (slot-ref o 'str) l)))) - -(define-method (write (b <py-str>) . l) - (define port (if (pair? l) (car l) #t)) - (format port "b~s" (b->string (slot-ref b 'str)))) - -(define dynlink (dynamic-link)) - -(define stringn - (pointer->procedure - '* - (dynamic-func "scm_from_locale_stringn" dynlink) - (list '* size_t))) - -(define ch->i (make-hash-table)) - -(define (re-eval ch) - (let lp ((i 0)) - (if (< i 256) - (if (eq? ch (chf i)) - (begin - (hash-set! ch->i ch i) - (lp (+ i 1))) - (lp (+ i 1))) - (hash-ref ch->i ch)))) - -(define (ch-find ch) - (aif it (hash-ref ch->i ch #f) - (if (eq? ch (chf it)) - it - (re-eval ch)) - (re-eval ch))) - -(define (chf ch) - (let ((str (pointer->scm - (stringn - (bytevector->pointer - (b-make 1 ch)) - 1)))) - (if (= (string-length str) 1) - (string-ref str 0) - (chf 0)))) - -(define (b->string b) - (pointer->scm - (stringn (bytevector->pointer b) (b-len b)))) - -(define-py (py-capitalize s) - (let* ((n (b-len s)) - (w (b-make n))) - (let lp ((i 0) (first? #t)) - (if (< i n) - (let* ((x (b-ref s i)) - (ch (chf x))) - (define (f first?) - (b-set! w i x) - (lp (+ i 1) first?)) - - (if (and first? (char-alphabetic? ch)) - (aif it (ch-find (char-upcase ch)) - (begin - (b-set! w i it) - (lp (+ i 1) #f)) - (f #t)) - (f #f))) - (str w))))) - -(define-py (py-center o w . l) - (let* ((ws (if (pair? l) - (ch-find (b-ref (car l) 0)) - (ch-find #\space))) - (n (b-len o)) - (w (if (< w n) n w)) - (d (- w n)) - (e (floor-quotient (- w n) 2)) - (s (b-make w (ch-find #\space)))) - (let lp ((i 0) (j e)) - (if (< i n) - (begin - (b-set! s j (b-ref o i)) - (lp (+ i 1) (+ j 1))))) - (str s))) - -;;;py-decode -;;;py-encode - -(define-py (py-endswith o suff . l) - (let* ((suff (slot-ref (str suff) 'str)) - (n (b-len o)) - (ns (b-len suff)) - (f (lambda (x) (< x 0) (+ n x) x))) - (call-with-values (lambda () - (match l - (() (values 0 n )) - ((x) (values (f x) n )) - ((x y) (values (f x) (f y))))) - (lambda (start end) - (let lp ((i (- n ns)) (j 0)) - (if (< i start) - (lp (+ i 1) (+ j 1)) - (if (>= i end) - #t - (and - (eq? (b-ref o i) (b-ref suff j)) - (lp (+ i 1) (+ j 1)))))))))) - -(define-py (py-startswith o pre . l) - (let* ((pre (slot-ref (str pre) 'str)) - (n (b-len o)) - (ns (b-len pre)) - (f (lambda (x) (< x 0) (+ n x) x))) - (call-with-values (lambda () - (match l - (() (values 0 n )) - ((x) (values (f x) n )) - ((x y) (values (f x) (f y))))) - (lambda (start end) - (let lp ((i 0)) - (cond - ((or (>= i end) - (>= i ns)) - #t) - ((< i start) - (lp (+ i 1))) - (else - (and - (eq? (b-ref o i) (b-ref pre i)) - (lp (+ i 1)))))))))) - - -(define-py (py-expandtabs s . l) - (let* ((tabsize (match l (() 8) ((x) x))) - (ct (ch-find #\tab)) - (cs (ch-find #\space)) - (n (b-len s))) - (let lp ((i 0) (r '())) - (if (< i n) - (let ((x (b-ref s i))) - (if (eq? x ct) - (let lp2 ((j 0) (r r)) - (if (< j tabsize) - (lp2 (+ j 1) (cons cs r)) - (lp (+ i 1) r))) - (lp (+ i 1) (cons x r)))) - (str (reverse r)))))) - -(define (b-contains s sub start end) - (define nsub (b-len sub)) - (define (match i) - (let lp ((i i) (j 0)) - (if (and (< j nsub) (< i end)) - (if (eq? (b-ref s i) (b-ref sub j)) - (lp (+ i 1) (+ j 1)) - #f) - #t))) - - (let lp ((i (max start 0))) - (if (< i end) - (if (match i) - i - (lp (+ i 1))) - #f))) - -(define-py (py-find s sub . l) - (let* ((n (b-len s)) - (f (lambda (x) (< x 0) (+ n x) x))) - (call-with-values (lambda () - (match l - (() (values 0 n )) - ((x) (values (f x) n )) - ((x y) (values (f x) (f y))))) - (lambda (start end) - (let ((sub (slot-ref (str sub) 'str))) - (aif it (b-contains s sub start end) - it - -1)))))) - -(define (b-reverse s) - (if (is-a? s (<py-str>)) - (b-reverse (slot-ref s 'str)) - (let* ((n (b-len s)) - (r (b-make n))) - (let lp ((i 0) (j (- n 1))) - (if (< i n) - (begin - (b-set! r j (b-ref s i)) - (lp (+ i 1) (- j 1))) - r))))) - - -(define-py (py-rfind s sub . l) - (let* ((sub (slot-ref (str sub) 'str)) - (n (b-len s)) - (s (b-reverse s)) - (sub (b-reverse sub)) - (f (lambda (x) (< x 0) (+ n x) x))) - (call-with-values (lambda () - (match l - (() (values 0 n )) - ((x) (values (f x) n )) - ((x y) (values (f x) (f y))))) - (lambda (start end) - (aif it (b-contains s sub start end) - (- n it (b-len sub)) - -1))))) - -#| -(define i (f-list #:i (mk-token (f+ (f-reg! "[0-9]"))))) -(define s (f-list #:s (mk-token (f+ (f-not! (f-tag "}")))))) -(define e (f-list #:e (f-and (f-tag "}") f-true))) -(define tagbody (f-or! e i s)) - -(define tag (f-seq "{" tagbody "}")) -(define nontag (f-list #:str (mk-token (f+ (f-or! (f-tag "{{") - (f-not! tag)))))) -(define e (ff* (f-or! tag nontag))) - -(define (compile x args kwargs) - (let lp ((l x) (r '()) (u '()) (i 0)) - (match l - (((#:str x) . l) - (lp l (cons x r) u i)) - (((#:i x) . l) - (lp l (cons "~a" r) (cons (list-ref args (string->number x)) u) i)) - (((#:s x) . l) - (lp l (cons "~a" r) (cons (hash-ref kwargs x None) u) i)) - (((#:e) . l) - (lp l (cons "~a" r) (cons (list-ref args i) u) (+ i 1))) - (() - (apply format #f (string-join (reverse r) "") (reverse u)))))) - -(define-py (py-format format s . l) - (call-with-values - (lambda () - (let lp ((l l) (args '()) (kwargs (make-hash-table))) - (match l - (((? keyword? key) x . l) - (hash-set! kwargs (symbol->string (keyword->symbol key)) x) - (lp l args kwargs)) - ((x . l) - (lp l (cons x args) kwargs)) - (() - (values (reverse args) kwargs))))) - (lambda (args kwargs) - (compile (parse s e) args kwargs)))) -|# - -(define-syntax-rule (mk-is py-isalnum x ...) - (define-py (py-isalnum s) - (let ((n (b-len s))) - (let lp ((i 0)) - (if (< i n) - (let ((ch (chf (b-ref s i)))) - (if (or (x ch) ...) - (lp (+ i 1)) - #f)) - #t))))) - -(mk-is py-isalnum char-alphabetic? char-numeric?) -(mk-is py-isalpha char-alphabetic?) -(mk-is py-isdigit char-numeric?) -(mk-is py-islower char-lower-case?) -(mk-is py-isspace char-whitespace?) -(mk-is py-isupper char-upper-case?) - - -(define-py (py-istitle s) - (let ((n (b-len s))) - (if ((> n 0)) - (let lp ((i 0) (space? #t)) - (if (< i n) - (let ((ch (chf (b-ref s i)))) - (if space? - (cond - ((char-whitespace? ch) - (lp (+ i 1) #t)) - ((char-upper-case? ch) - (lp (+ i 1) #f)) - (else - #f)) - (cond - ((char-whitespace? ch) - (lp (+ i 1) #t)) - ((char-upper-case? ch) - #f) - ((char-lower-case? ch) - (lp (+ i 1) #f)) - (else - #f)))) - #t)) - #f))) - -(define (b-join l s) - (let* ((ns (b-len s)) - (l (pk (map (lambda (x) (slot-ref (str x) 'str)) l))) - (n (let lp ((l l) (n 0)) - (if (pair? l) - (let ((x (car l)) - (l (cdr l))) - (lp l (+ n (b-len x) (if (pair? l) ns 0)))) - n))) - (r (b-make n))) - (let lp ((l l) (i 0)) - (if (pair? l) - (let* ((x (car l)) - (n (b-len x)) - (l (cdr l))) - (let lp2 ((j 0) (i i)) - (if (< j n) - (begin - (b-set! r i (b-ref x j)) - (lp2 (+ j 1) (+ i 1))) - (if (pair? l) - (let lp3 ((j 0) (i i)) - (if (< j ns) - (begin - (b-set! r i (b-ref s j)) - (lp3 (+ j 1) (+ i 1))) - (lp l i))) - (lp l i))))) - (str r))))) - -(define-py (py-join s iterator) - (b-join (to-list iterator) s)) - -(define-py (pylist-slice s n1 n2 n3) - (define N (b-len s)) - (define (f n) (if (< n 0) (+ N n) n)) - - (let* ((n1 (f (if (eq? n1 None) 0 n1))) - (n2 (f (if (eq? n2 None) N n2))) - (n3 (f (if (eq? n3 None) 1 n3))) - (r (b-make (floor-quotient (+ 1 (abs (- n2 n1))) n3)))) - (let lp ((i n1) (j 0)) - (if (< i n3) - (begin - (b-set! r j (b-ref s i)) - (lp (+ i n3) (+ j 1))) - (str r))))) - - -(define-py (py-ljust s width . l) - (let* ((n (b-len s)) - (ch (match l - ((x) - (b-char x)) - (() - (b-char #\space))))) - (if (< width n) - (pylist-slice s 0 width 1) - (let ((ret (b-make width ch))) - (let lp ((i 0)) - (if (< i n) - (begin - (b-set! ret i (b-ref s i)) - (lp (+ i 1))) - (str ret))))))) - -(define-py (py-rjust s width . l) - (let* ((n (b-len s)) - (ch (match l - ((x) - (b-char x)) - (() - (b-char #\space))))) - (if (< width n) - (pylist-slice s (- width) (len s) 1) - (let ((ret (b-make width ch))) - (let lp ((i 0) (j (- width n))) - (if (< i n) - (begin - (b-set! ret j (b-ref s i)) - (lp (+ i 1) (+ j 1))) - (str ret))))))) - - -(define-py (py-lower s) - (let* ((n (b-len s)) - (r (b-make n))) - (let lp ((i 0)) - (if (< i n) - (let* ((x (b-ref s i)) - (ch (chf x))) - (b-set! r i (if (char-upper-case? ch) - (ch-find (char-downcase ch)) - x)) - (lp (+ i 1))) - (str r))))) - -(define-py (py-upper s) - (let* ((n (b-len s)) - (r (b-make n))) - (let lp ((i 0)) - (if (< i n) - (let* ((x (b-ref s i)) - (ch (chf x))) - (b-set! r i (if (char-lower-case? ch) - (ch-find (char-upcase ch)) - x)) - (lp (+ i 1))) - (str r))))) - -(define-py (py-swapcase s) - (let* ((n (b-len s)) - (r (b-make n))) - (let lp ((i 0)) - (if (< i n) - (let* ((x (b-ref s i)) - (ch (chf x))) - (b-set! r i (cond - ((char-lower-case? ch) - (ch-find (char-upcase ch))) - ((char-upper-case? ch) - (ch-find (char-downcase ch))) - (else - x))) - (lp (+ i 1))) - (str r))))) - -(define b-trim - (case-lambda - ((s) - (b-trim s (lambda (ch x) (char-whitespace? ch)))) - ((s p) - (let ((n (b-len s))) - (let lp ((i 0) (r '()) (first? #t)) - (if (< i n) - (let ((x (b-ref s i))) - (if first? - (if (p (chf x) x) - (lp (+ i 1) r #t) - (lp (+ i 1) (cons x r) #f)) - (lp (+ i 1) (cons x r) #f))) - (str (reverse r)))))))) - -(define b-rtrim - (case-lambda - ((s) - (b-rtrim s (lambda (ch x) (char-whitespace? ch)))) - ((s p) - (let ((n (b-len s))) - (let lp ((i (- n 1)) (r '()) (first? #t)) - (if (>= i 0) - (let ((x (b-ref s i))) - (if first? - (if (p (chf x) x) - (lp (- i 1) r #t) - (lp (- i 1) (cons x r) #f)) - (lp (- i 1) (cons x r) #f))) - (str r))))))) - -(define-py (py-lstrip s . l) - (match l - (() - (b-trim s)) - ((x) - (let ((l (map b-char (to-list x)))) - (b-trim s (lambda (ch x) (member x l))))))) - -(define-py (py-rstrip s . l) - (match l - (() - (b-rtrim s)) - ((x) - (let ((l (map b-char (to-list x)))) - (b-rtrim s (lambda (ch x) (member x l))))))) - - -(define-py (py-partition s sep) - (let* ((sep (slot-ref (str sep) 'str)) - (n (b-len s)) - (m (b-len sep))) - (define (test i) - (let lp ((i i) (j 0)) - (if (< i n) - (if (< j m) - (if (eq? (b-ref s i) (b-ref sep j)) - (lp (+ i 1) (+ j 1)) - #f) - #t) - #f))) - (let lp ((i 0)) - (if (< i n) - (if (test i) - (list (pylist-slice s 0 i) sep (pylist-slice s (+ i m) n)) - (lp (+ i 1))) - (list s "" ""))))) - -(define-py (py-rpartition ss ssep) - (let* ((ssep (slot-ref (str ssep) 'str)) - (s (b-reverse ss)) - (sep (b-reverse ssep)) - (n (b-len s)) - (m (b-len sep))) - (define (test i) - (let lp ((i i) (j 0)) - (if (< i n) - (if (< j m) - (if (eq? (b-ref s i) (b-ref sep j)) - (lp (+ i 1) (+ j 1)) - #f) - #t) - #f))) - (let lp ((i 0)) - (if (< i n) - (if (test i) - (list (str - (b-reverse - (pylist-slice s (+ i m) n))) - ssep - (str - (b-reverse - (pylist-slice s 0 i)))) - (lp (+ i 1))) - (list "" "" s))))) - -(define-py (py-replace s old new . l) - (let ((n (match l (() #f) ((n . _) n)))) - (b-join - (reverse - (let lp ((s s) (r '())) - (let ((l (py-partition s old))) - (if (equal? (cadr l) "") - (cons s r) - (lp (list-ref l 2) (cons (car l) r)))))) - new))) - -(define-py (py-strip s . l) - (apply py-rstrip (apply py-lstrip s l) l)) - -(define-py (pylist-index o val . l) - (let* ((n (b-len o)) - (vec o) - (f (lambda (m) (if (< m 0) (+ m n) m)))) - (call-with-values - (lambda () - (match l - (() - (values 0 n)) - ((x) - (values (f x) n)) - ((x y) - (values (f x) (f y))))) - (lambda (n1 n2) - (if (and (>= n1 0) (>= n2 0) (< n1 n) (<= n2 n)) - (let lp ((i n1)) - (if (< i n2) - (let ((r (b-ref vec i))) - (if (equal? r val) - i - (lp (+ i 1)))) - (raise ValueError "could not find value in index fkn"))) - (raise IndexError "index out of scop in index fkn")))))) - -(define-py (py-rindex s . l) - (let ((n (b-len s))) - (- n (apply pylist-index (b-reverse s) l) 1))) - -#; -(define-py (py-title title s) - (string-titlecase s)) - -#; -(define-py (py-split s . l) - (define ws (f+ (f-reg "[ \t\n]"))) - (define r - (f-or! (f-seq f-eof (f-out '())) - (f-cons (f-seq (mk-token (f* (f-reg! "."))) f-eof) (f-out '())))) - (define (u ws) (mk-token (f+ (f-not! ws)))) - (define (tok ws i) - (if (= i 0) - (f-list (mk-token (f* (f-reg! ".")))) - (let ((e (mk-token (f* (f-not! ws))))) - (f-seq (f? ws) - (f-cons e - (let lp ((i i)) - (if (> (- i 1) 0) - (f-or! (f-seq (f? ws) f-eof (f-out '())) - (f-cons (f-seq ws e) (Ds (lp (- i 1))))) - r))))))) - - (define N 1000000000000) - (let ((e (call-with-values - (lambda () - (match l - (() (values ws N)) - ((sep) (values (f-tag sep) N)) - ((sep n) (values (f-tag sep) n)))) - tok))) - (parse s e))) - -#; -(define-py (py-rsplit s . l) - (reverse - (map string-reverse - (apply py-split - (string-reverse s) - (match l - (() '()) - ((sep . l) (cons (string-reverse sep) l))))))) - - -(define-py (py-splitlines s . l) - (let ((n (len s)) - (keep? (match l - ((#:keepends v) - v) - ((v) - v) - (_ #f)))) - (let lp ((i 0) (r '()) (old 0)) - (if (< i n) - (let* ((x (b-ref s i)) - (ch (chf x))) - (if (eq? ch #\newline) - (if keep? - (lp (+ i 1) - (cons - (pylist-slice s old (+ i 1) 1) - r) - (+ i 1)) - (lp (+ i 1) - (cons - (pylist-slice s old i 1) - r) - (+ i 1))) - (lp (+ i 1) r old))) - (reverse r))))) - -(define-py (py-translate s table . l) - (let* ((table (slot-ref (str table) 'str)) - (n (b-len s)) - (w (b-make n)) - (t (if (eq? table None) #f table)) - (d (match l (() #f) ((x) (map b-char (to-list x)))))) - (define (tr ch) - (define (e) - (if t - (if (< ch (b-len t)) - (b-ref t ch) - ch) - ch)) - - (if d - (if (member ch d) - #f - (e)) - (e))) - - (let lp ((i 0) (k 0)) - (if (< i n) - (let ((ch (tr (b-ref s i)))) - (if ch - (begin - (b-set! w k ch) - (lp (+ i 1) (+ k 1))) - (lp (+ i 1) k))) - (if (= k n) - w - (pylist-slice w 0 k 1)))))) - -(define-syntax-rule (a b x y) (b (symbol->string x) (symbol->string y))) - -(define-syntax-rule (mkop op) - (begin - (define-method (op (s1 <bytevector>) (s2 <py-str>)) - (op s1 (slot-ref s2 'str))) - (define-method (op (s2 <py-str>) (s1 <bytevector>)) - (op s1 (slot-ref s2 'str))))) - -(mkop <) -(mkop <=) -(mkop >) -(mkop >=) -(mkop py-equal?) -(mkop +) -(mkop *) - -(define-syntax-rule (mkop2 op) - (define-method (< (s1 <bytevector>) (s2 <bytevector>)) - (let* ((n1 (b-len s1)) - (n2 (b-len s2)) - (n (min n1 n2))) - (let lp ((i 0)) - (if (< i n) - (let ((x1 (b-ref s1 i)) - (x2 (b-ref s2 i))) - (if (= x1 x2) - (lp (+ i 1)) - (op x1 x2))) - (op n1 n2)))))) - -(mkop2 <) -(mkop2 <=) -(mkop2 >=) -(mkop2 >) -(mkop2 py-equal?) - -(define-py (py-zfill s width) - (let* ((n (b-len s)) - (w (pylist-slice s 0 n 1))) - (let lp ((i 0)) - (if (< i n) - (let* ((x (b-ref s i)) - (ch (chf x))) - (if (char-numeric? ch) - (let lp ((j (max 0 (- i width)))) - (if (< j i) - (begin - (b-set! w j (ch-find #\0)) - (lp (+ j 1))) - w)) - (lp (+ i 1)))) - s)))) - -(define-method (pyhash (o <py-str>)) (hash (slot-ref o 'str) pyhash-N)) - -(define-class <str-iter> (<py-str>) str i d) - -(define-method (wrap-in (o <str-iter> )) - (let ((out (make <str-iter>))) - (slot-set! out 'str (slot-ref o 'str)) - (slot-set! out 'i (slot-ref o 'i)) - (slot-set! out 'd (slot-ref o 'd)) - out)) - -(define-method (wrap-in (s <bytevector>)) - (let ((out (make <str-iter>))) - (slot-set! out 'str s) - (slot-set! out 'i 0) - (slot-set! out 'd 1) - out)) - -(define-method (py-reversed (s <bytevector>)) - (let ((out (make <str-iter>))) - (slot-set! out 'str s) - (slot-set! out 'i (- (b-len s) 1)) - (slot-set! out 'd -1) - out)) - -(define-method (next (o <str-iter>)) - (let ((i (slot-ref o 'i )) - (d (slot-ref o 'd)) - (str (slot-ref o 'str))) - (if (> d 0) - (if (< i (b-len str)) - (let ((ret (b-ref str i))) - (slot-set! o 'i (+ i d)) - ret) - (throw StopIteration)) - (if (>= i 0) - (let ((ret (b-ref str i))) - (slot-set! o 'i (+ i d)) - ret) - (throw StopIteration))))) - -(define (pystr-listing) - (let ((l (to-pylist - (map symbol->string - '(__add__ __class__ __contains__ __delattr__ __doc__ - __eq__ __format__ __ge__ __getattribute__ - __getitem__ __getnewargs__ __getslice__ __gt__ - __hash__ __init__ __le__ __len__ __lt__ __mod__ - __mul__ __ne__ __new__ __reduce__ __reduce_ex__ - __repr__ __rmod__ __rmul__ __setattr__ __sizeof__ - __str__ __subclasshook__ - _formatter_field_name_split _formatter_parser - capitalize center count decode encode endswith - expandtabs find format index isalnum isalpha - isdigit islower isspace istitle isupper join - ljust lower lstrip partition replace rfind rindex - rjust rpartition rsplit rstrip split splitlines - startswith strip swapcase - title translate upper zfill))))) - (pylist-sort! l) - l)) diff --git a/modules/language/python/tuple.scm b/modules/language/python/tuple.scm index 5362cc9..5a36b4b 100644 --- a/modules/language/python/tuple.scm +++ b/modules/language/python/tuple.scm @@ -32,7 +32,6 @@ (begin (define-method (f (o <pair>) . u) code ...) - (define-method (f (o <py-tuple>) . u) + (define-method (f (o <py-tuple>) . l) (let ((o (slot-ref o 'l))) - code ...)))) - + (apply f o l))))) |