definition of functions that follow the python argument parsing style

2 files changed, 224 insertions, 0 deletions

diff --git a/modules/language/python/def.scm b/modules/language/python/def.scm
new file mode 100644
index 0000000..d149348
--- /dev/null
+++ b/modules/language/python/def.scm
@@ -0,0 +1,80 @@
+(define-module (language python def)
+  #:export (def))
+
+(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
+(define (fold lam s l)
+  (if (pair? l)
+      (lam (car l) (fold lam s (cdr l)))
+      s))
+
+
+(define-syntax def
+  (lambda (x)
+    (define (get-akw l)
+      (let lp ((l l) (args '()) (kw (make-hash-table)))
+        (match l
+          (((? keyword? k) v . l)
+           (hash-set! kw k v)
+           (lp l args kw))
+          ((x . l)
+           (lp l (cons x args) k))
+          (()
+           (values (reverse args) kw)))))
+
+    (define-syntax-rule (mk get-as (k v s) x y z w)
+      (define get-as
+        (lambda (a s)
+          (syntax-case a (= * **)
+            ((= k v) #'x)
+            ((**  k) #'y)
+            ((*   k) #'z)          
+            (k       #'w)))))
+
+    (mk get-as (k v s)  s                    s           s           (cons k s))
+    (mk get-kw (k v s)  s                    (cons k s)  s           s         )
+    (mk get-ww (k v s)  s                    s           (cons k s)  s         )
+    (mk get-kv (k v s)  (cons (cons k v) s)  s           s           s         )
+
+    (define (->kw x) (symbol->keyword (syntax->datum x)))
+
+    (define-syntax-rule (take-1 ww* kw s v)
+      (if (null? ww*)
+          (values ww*
+                  (aif it (hash-ref kw s #f)
+                       (begin
+                         (remove-hash! kw s)
+                         it)
+                       v))
+          (begin
+            (remove-hash! kw s)
+            (values (cdr ww) (car ww)))))
+    
+    (syntax-case x ()
+      ((_ f (arg ...) code ...)
+       (let* ((as  (fold get-as '() #'(arg ...)))
+              (kw  (fold get-kw '() #'(arg ...)))
+              (ww  (fold get-ww '() #'(arg ...)))
+              (kv  (fold get-kv '() #'(arg ...))))
+         (if (and-map null? (list kw ww kv))
+             #`(define f (lambda #,as code ....))
+             (with-syntax ((l       (datum->syntax #'f  (gensym "l")))
+                           (kw      (if (null? kw)
+                                        (datum->syntax #'f (gensym "kw"))
+                                        (car kw)))
+                           (ww      (if (null? ww)
+                                        (datum->syntax #'f (gensym "ww"))
+                                        (car ww)))                           
+                           ((k ...) (map car kv))
+                           ((s ...) (map ->kw (map car kv)))
+                           ((v ...) (map cdr kv)))
+               #`(define f                   
+                   (lambda* (#,@as . l)                     
+                     (call-with-values (get-akv l)
+                       (lambda (ww* kw)
+                         (let-values* (((ww* k) (take-1 ww* kw s v))
+                                       ...)
+                           (let ((ww ww*))
+                             code ...)))))))))))))
+                                              
+                                 
+                                 
diff --git a/modules/language/python/string.scm b/modules/language/python/string.scm
new file mode 100644
index 0000000..c68b9ae
--- /dev/null
+++ b/modules/language/python/string.scm
@@ -0,0 +1,144 @@
+(define-module (language python string)
+  #:use-module (oop goops)
+  #:use-module (oop pf-objects)
+  #:use-module (ice-9 match)
+  #:use-module (parser stis-parser)
+  #:export (py-format))
+
+(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
+
+(define-syntax-rule (define-py (f n o . u) code ...)
+  (begin
+    (define-method (f (o <string>) . u) code ...)
+    (define-method (f (o <p>) . l) (apply (ref o 'n) l))))
+
+#|
+(define-py (py-capitalize capitalize o)
+  (string-capitalize o))
+
+(define-py (py-center center o w . l)
+  (let* ((ws (if (pair? l)
+                 (car (string->list (car l)))
+                 #\space))
+         (n  (string-length o))
+         (w  (if (< w n) n w))
+         (d  (- w n))
+         (e  (floor-quotient (- w n) / 2))
+         (s  (make-string w #\space)))
+    (let lp ((i 0) (j e))
+      (if (< i n)
+          (begin
+            (string-set! s j (string-ref o i))
+            (lp (+ i 1) (+ j 1)))))
+    s))
+    
+    
+
+;py-decode
+;py-encode
+(define-py (py-endswith endswith o (suff <string>) . l)
+  (let ((n   (string-length o))
+        (ns  (string-length 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)
+        (string-suffix? o suff start end)))))
+
+(define-py (py-expandtabs expandtabs s . l)
+  (let* ((tabsize (match l (() 8) ((x) x)))
+         (u       (string->list (make-string tabsize #\space)))
+         (n       (string-length s)))
+    (let lp ((l (string->list s)) (r '()))
+      (if (pair? l)
+          (let ((x (car l)))
+            (if (eq? x #\tab)
+                (lp (cdr l) (append u r))
+                (lp (cdr l) (cons x r))))
+          (list->string (reverse r))))))
+      
+(define-py (py-find find s 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)
+        (aif it (string-contains s sub start end)
+             it
+             -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))))
+
+#|      
+py-isalnum
+py-isalpha
+py-isdigit
+py-islower
+py-isspace
+py-istitle
+py-isupper
+py-join
+py-ljust
+py-lower
+py-lstrip
+py-partition
+py-replace
+py-rfind
+py-rindex
+py-rjust
+py-rpartition
+py-rsplit
+py-rstrip
+py-split
+py-splitlines
+py-startswith
+py-strip
+py-swapcase
+py-title
+py-translate
+py-upper
+py-zfill
+|#