From 52f23f62bf816f6396fc1eb653ccdfbd5efbc5a2 Mon Sep 17 00:00:00 2001 From: Stefan Israelsson Tampe Date: Thu, 5 Apr 2018 23:32:39 +0200 Subject: subprocess.py compiles --- modules/language/python/compile.scm | 62 +++++++++++----------------- modules/language/python/def.scm | 13 +++--- modules/language/python/exceptions.scm | 3 +- modules/language/python/guilemod.scm | 6 ++- modules/language/python/module/itertools.scm | 7 ++-- modules/language/python/module/os/path.scm | 3 -- 6 files changed, 44 insertions(+), 50 deletions(-) diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index ad341a5..a039ee1 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -401,20 +401,20 @@ (define (fastfkn x) (hash-ref fasthash x)) (define (get-kwarg vs arg) - (let lp ((arg arg) (l '()) (kw '())) + (let lp ((arg arg)) (match arg + (((#:comp . (and x (_ (#:cfor . _) . _))) . arg2) + (cons `(* ,(exp vs `(#:tuple ,@x))) (lp arg2))) + (((#:* a) . arg) + (cons `(* ,(exp vs a)) (lp arg))) + (((#:** a) . arg) + (cons `(** ,(exp vs a)) (lp arg))) (((#:= a b) . arg) - (lp arg - l - (cons* - (exp vs b) - (symbol->keyword - (exp vs a)) - kw))) + (cons `(= ,(exp vs a) ,(exp vs b)) (lp arg))) ((x . arg) - (lp arg (cons (exp vs x) l) kw)) + (cons (exp vs x) (lp arg))) (() - (values (reverse l) (reverse kw)))))) + '())))) (define (get-args_ vs arg) (let lp ((arg arg)) @@ -512,18 +512,8 @@ `(#:fast-id ,it ',tag) `(#:identifier ',tag)))))) - ((#:arglist args apply kw) - (call-with-values (lambda () (get-kwarg vs args)) - (lambda (args kwarg) - (if (or kw apply) - `(#:apply ,@args ,@kwarg - ,`(,(L 'to-list) - (,(G 'append) - (if apply (exp vs apply) ''()) - (if kw - '(,(C 'kw->li) (exp vs kw)) - ''())))) - `(#:call ,@args ,@kwarg))))) + ((#:arglist args) + `(#:apply ,@(get-kwarg vs args))) ((#:subscripts (n #f #f)) `(#:vecref ,(exp vs n))) @@ -723,20 +713,13 @@ (#:bytes ((_ l) - (let* ((n (let lp ((l l) (s 0)) - (if (pair? l) - (lp (cdr l) (+ s (length (car l)))) - s))) - (b (make-bytevector n))) + (let* ((b (make-bytevector (length l)))) (let lp ((l l) (i 0)) (if (pair? l) - (let lp2 ((u (car l)) (i i)) - (if (pair? u) - (begin - (bytevector-u8-set! b i (car u)) - (lp2 (cdr u) (+ i 1))) - (lp (cdr l) i))))) - `(,(B 'bytes) ,b)))) + (begin + (bytevector-u8-set! b i (car l)) + (lp (cdr l) (+ i 1))) + `(,(B 'bytes) ,b)))))) (#:+ @@ -1273,7 +1256,12 @@ (#:assign (l))) (let ((s (string->symbol v))) `(,s/d ,s ,(exp vs l))))) - + + (#:assert + ((_ x f n m) + `(if (,(G 'not) (,(G 'and) ,@(map (lambda (x) `(,(C 'boolit) ,(exp vs x))) + x))) + (,(C 'raise) ,(C 'AssertionError) ',f ,n ,m)))) (#:return ((_ x) @@ -1832,9 +1820,9 @@ ((_ v (#:call x ...) . l) (ref-x (v x ...) . l)) ((_ v (#:apply x ...) . l) - (ref-x (apply v x ...) . l)) + (ref-x (py-apply v x ...) . l)) ((_ v (#:apply x ...) . l) - (ref-x (apply v x ...) . l)) + (ref-x (py-apply v x ...) . l)) ((_ v (#:vecref x) . l) (ref-x (pylist-ref v x) . l)) ((_ v (#:vecsub . x) . l) diff --git a/modules/language/python/def.scm b/modules/language/python/def.scm index bd2139e..06e83e6 100644 --- a/modules/language/python/def.scm +++ b/modules/language/python/def.scm @@ -108,9 +108,10 @@ (define (no x) (and-map (lambda (x) - (syntax-case x (* **) - ((* _) #f) - ((** _) #f) + (syntax-case x (* ** =) + ((* _) #f) + ((** _) #f) + ((= a b) #f) (_ #t))) x)) @@ -123,7 +124,9 @@ x)))) (define-syntax m* - (syntax-rules (* **) + (syntax-rules (* ** =) + ((_ (= a b)) + (list (symbol->keyword 'a) b)) ((_ (* a)) a) ((_ (** kw)) (for ((k v : kw)) ((l '())) @@ -137,7 +140,7 @@ (syntax-case x () ((_ f a ...) (if (no #'(a ...)) - #'(apply f a ...) + #'(f a ...) #'(apply f (let lp ((l (list (m* a) ...))) (if (pair? l) (append (car l) (lp (cdr l))) diff --git a/modules/language/python/exceptions.scm b/modules/language/python/exceptions.scm index b12f89b..60b850e 100644 --- a/modules/language/python/exceptions.scm +++ b/modules/language/python/exceptions.scm @@ -7,7 +7,7 @@ SyntaxError SystemException OSError ProcessLookupError PermissionError None NotImplemented NotImplementedError - RunTimeError)) + RunTimeError AssertionError)) (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) @@ -27,6 +27,7 @@ (define PermissionError 'PermissionError) (define NotImplementedError 'NotImplementedError) (define RunTimeError 'RunTimeError) +(define AssertionError 'AssertionError) (define-python-class Exception () (define __init__ diff --git a/modules/language/python/guilemod.scm b/modules/language/python/guilemod.scm index 3f7ec7f..da1f5c7 100644 --- a/modules/language/python/guilemod.scm +++ b/modules/language/python/guilemod.scm @@ -27,6 +27,7 @@ (define-exp-C *do-extension-dispatch* #t) (define-exp-C *extension-dispatches* '((("py" "python") . python) (("pl" "prolog") . prolog))) +(define-exp-C %current-file% (make-fluid '(guile))) (define-C default-language (lambda (file) @@ -57,9 +58,12 @@ (env ((C default-environment) from)) (opts '()) (canonicalization 'relative)) + (with-fluids (((C %in-compile ) #t ) ((M %dont-warn-list ) '() ) - ((C %file-port-name-canonicalization) canonicalization)) + ((C %file-port-name-canonicalization) canonicalization ) + ((C %current-file% ) file)) + (let* ((comp (or output-file ((C compiled-file-name) file) (error "failed to create path for auto-compiled file" file))) diff --git a/modules/language/python/module/itertools.scm b/modules/language/python/module/itertools.scm index c4958d1..b5b3dbf 100644 --- a/modules/language/python/module/itertools.scm +++ b/modules/language/python/module/itertools.scm @@ -149,17 +149,18 @@ (lambda (yield) (let lp ((head #f)) (if (and head (= i head)) - (let* ((x (next it)) + (let* ((x (call-with-values (lambda () (next it)) + (lambda x x))) (i0 (+ i 1))) (set! r (cons x r)) (set! i i0) - (yield x) + (apply yield x) (lp i0)) (if (pair? l) (let ((x (car l))) (set! l (cdr l)) - (yield x) + (apply yield x) (lp #f)) (if (null? r) (lp i) diff --git a/modules/language/python/module/os/path.scm b/modules/language/python/module/os/path.scm index 8d76762..0c1abde 100644 --- a/modules/language/python/module/os/path.scm +++ b/modules/language/python/module/os/path.scm @@ -175,9 +175,6 @@ (define (isdir p) (ca (S_ISDIR (stat:mode ((@ (guile) stat) (path-it p)))))) -(define (islink p) - (ca (S_ISLNK (stat:mode ((@ (guile) stat) (path-it p)))))) - (define (ismount p) (ca (let* ((p (path-it p)) -- cgit v1.2.3