diff options
author | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2018-03-31 18:16:02 +0200 |
---|---|---|
committer | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2018-03-31 18:16:02 +0200 |
commit | f428d49e6430a73d96fbcd55961977e420ae8dc7 (patch) | |
tree | 25d9c85a73636b5fa0c846f05369659127aa62cc /modules/language/python | |
parent | 045653a5d82987865ecd304fb2777fda0edb88a0 (diff) |
os.path compiles
Diffstat (limited to 'modules/language/python')
-rw-r--r-- | modules/language/python/module/collections/abc.scm | 6 | ||||
-rw-r--r-- | modules/language/python/module/itertools.scm | 2 | ||||
-rw-r--r-- | modules/language/python/module/os.scm | 7 | ||||
-rw-r--r-- | modules/language/python/module/os/path.scm | 45 | ||||
-rw-r--r-- | modules/language/python/module/pwd.scm | 4 |
5 files changed, 37 insertions, 27 deletions
diff --git a/modules/language/python/module/collections/abc.scm b/modules/language/python/module/collections/abc.scm index d526e73..4bd242d 100644 --- a/modules/language/python/module/collections/abc.scm +++ b/modules/language/python/module/collections/abc.scm @@ -544,9 +544,3 @@ ((ref (ref self '_mapping) 'values))))) -(name-object Container Hashable Iterable Iterator Reversable Generator - Sized Callable Collection Sequence MutableSequence - ByteString Set MutableSet Mapping MutableMapping - MappingView ItemsView KeysView ValuesView) - - diff --git a/modules/language/python/module/itertools.scm b/modules/language/python/module/itertools.scm index 7679459..c4958d1 100644 --- a/modules/language/python/module/itertools.scm +++ b/modules/language/python/module/itertools.scm @@ -128,7 +128,7 @@ (define starmap (make-generator (f seq) (lambda (yield f seq) - (for ((x : seq)) () (yield (f x)))))) + (for ((x : seq)) () (yield (apply f x)))))) (define takewhile (make-generator (pred seq) diff --git a/modules/language/python/module/os.scm b/modules/language/python/module/os.scm index a735f13..8791626 100644 --- a/modules/language/python/module/os.scm +++ b/modules/language/python/module/os.scm @@ -24,12 +24,13 @@ #:use-module ((language python module python) #:select ((open . builtin:open))) #:use-module (language python list) - #:export (error name ctermid environ environb chdir fchdir getcwd - fsencode fdencode fspath PathLike getenv getenvb + #:replace (getcwd getuid getenv) + #:export (error name ctermid environ environb chdir fchdir + fsencode fdencode fspath PathLike getenvb get_exec_path getgid getegid geteuid fdopen getgroups getgrouplist getlogin getpgid getpgrp getpid getppid PRIO_PROCESS PRIO_PRGRP PRIO_USER getpriority - getresgid getuid initgroups putenv setegid seteuid + getresgid initgroups putenv setegid seteuid setgid setgroups setpgrp setpgid setpriority setregid setresgid setreuid setresuid getsid setsid setuid strerr umask uname unsetenv diff --git a/modules/language/python/module/os/path.scm b/modules/language/python/module/os/path.scm index 8846bd5..4cf96cf 100644 --- a/modules/language/python/module/os/path.scm +++ b/modules/language/python/module/os/path.scm @@ -2,9 +2,14 @@ #:use-module (language python module os) #:use-module (language python module pwd) #:use-module (language python module errno) + #:use-module (language python module stat) #:use-module (language python for) + #:use-module (language python try) + #:use-module (system foreign) + #:use-module (parser stis-parser) #:use-module (language python exceptions) - #:use-module (oop pg-objects) + #:use-module (oop pf-objects) + #:use-module (ice-9 match) #:export (abspath basename commonpath commonprefix dirname exists lexists expanduser expandvars getatime getmtime getctime getsize isabs isfile isdir islink ismount @@ -34,11 +39,11 @@ (define (basename path) (ca ((@ (guile) basename) (path-it path)))) (define (commonprefix paths) - (letrec ((l (for ((p paths)) ((l '())) + (letrec ((l (for ((p : paths)) ((l '())) (cons (string->list (normpath p)) l) #:final l)) (f (lambda (l) - (let lp ((l l)) ((r #f) (d '())) + (let lp ((l l) (r #f) (d '())) (match l ((() . _) '()) (((x . u) . l) @@ -53,7 +58,7 @@ (define (commonpath paths) (define kind - (for ((p paths)) ((e #f)) + (for ((p : paths)) ((e #f)) (let ((x (if (isabs (path-it p)) 'abs 'rel))) (if e (if (eq? e x) @@ -64,11 +69,11 @@ (if (not kind) (raise ValueError "No paths")) - (letrec ((l (for ((p paths)) ((l '())) + (letrec ((l (for ((p : paths)) ((l '())) (cons (string-split (normpath p) #\/) l) #:final l)) (f (lambda (l) - (let lp ((l l)) ((r #f) (d '())) + (let lp ((l l) (r #f) (d '())) (match l ((() . _) '()) (((x . u) . l) @@ -127,12 +132,18 @@ (string-join (append (string-split (lookup-self) "/") (cdr (string-split path #\/))))))))) -(define f-var (f-mk (f-or! - (f-seq (f-tag! "$") (f+ (f-reg! "[a-zA-Z0-9]"))) - (f-seq (f-tag! "$") (f-tag "{") (f+ (f-not! (f-tag "}"))) - (f-tag "}"))))) +(define f-var (mk-token + (f-or! + (f-seq (f-tag! "$") (f+ (f-reg! "[a-zA-Z0-9]"))) + (f-seq (f-tag! "$") (f-tag "{") (f+ (f-not! (f-tag "}"))) + (f-tag "}"))))) + +(define f-other (mk-token (f* (f-not! f-var)))) + +(define f-f (f-cons f-other (ff* (f-seq f-var f-other)))) + (define (expandvars p) - (let lp ((l (f-split (path-it p) f-var)) (r '())) + (let lp ((l (parse (path-it p) f-f)) (r '())) (match l ((a b . l) (lp l (cons* (getenv b) a r))) @@ -175,8 +186,6 @@ (stat:dev ((@ (guile) stat) q))))))) - (normpath (string-join (map path-it l) "/"))) - (define (normcase x) x) (define join (@@ (language python module os) path:join)) @@ -198,9 +207,13 @@ (free s) ret)))))) -(define* (relpath p #:optional (start curpath)) - (define l1 (string-aplit (realpath (path-it p)) #\/)) - (define l2 (string-split (realpath start)) #\/) +(define* (relpath p #:optional (start curdir)) + (define (reduce f s l) + (if (pair? l) + (reduce f (f (car l) s) (cdr l)) + s)) + (define l1 (string-split (realpath (path-it p)) #\/)) + (define l2 (string-split (realpath start) #\/)) (define red (lambda (x s) (cons ".." s))) (let lp ((l1 l1) (l2 l2)) (match (cons l1 l2) diff --git a/modules/language/python/module/pwd.scm b/modules/language/python/module/pwd.scm index 0996db3..3922ac9 100644 --- a/modules/language/python/module/pwd.scm +++ b/modules/language/python/module/pwd.scm @@ -3,7 +3,9 @@ #:use-module (language python module collections abc) #:use-module (language python exceptions) #:use-module (language python yield) - #:export (getpwuid getpwname getpwall)) + #:use-module (language python try) + #:replace (getpwuid) + #:export (getpwname getpwall)) (define-python-class PWD (Sequence) (define __init__ |