subprocess.py compiles
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Thu, 5 Apr 2018 21:32:39 +0000 (23:32 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Thu, 5 Apr 2018 21:32:39 +0000 (23:32 +0200)
modules/language/python/compile.scm
modules/language/python/def.scm
modules/language/python/exceptions.scm
modules/language/python/guilemod.scm
modules/language/python/module/itertools.scm
modules/language/python/module/os/path.scm

index ad341a546595bc45b689c1622b1b78cd9d454979..a039ee15e7e0ebceee52a5fe050f8b1abd17d0c1 100644 (file)
 (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))
                           `(#: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)))
 
  (#: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))))))
            
      
  (#:+
     (#: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)
     ((_ 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)
index bd2139e7aade47fd76bd1a6f1ec57e419cc33b91..06e83e62f4eb1c1fdfc7bc6df75566ad9a8f9542 100644 (file)
 (define (no x)
   (and-map
    (lambda (x)
-     (syntax-case x (* **)
-       ((*  _) #f)
-       ((** _) #f)
+     (syntax-case x (* ** =)
+       ((*  _)  #f)
+       ((** _)  #f)
+       ((= a b) #f)
        (_ #t)))
    x))
 
           x))))
 
 (define-syntax m*
-  (syntax-rules (* **)
+  (syntax-rules (* ** =)
+    ((_ (=  a b))
+     (list (symbol->keyword 'a) b))
     ((_ (*  a)) a)
     ((_ (** kw))
      (for ((k v : kw)) ((l '()))
     (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)))
index b12f89b74f53627e2c4f270acf81423a660b9067..60b850e3da6a0787f9d469d3e2c8d944a6e70267 100644 (file)
@@ -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__
index 3f7ec7fca0b98a4578a6acbbd90d61f571725563..da1f5c7d8479a603fed12026683ac92defb7fc39 100644 (file)
@@ -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)
                  (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)))
index c4958d174a356c3de5dd304ed9fc7af4acf73c22..b5b3dbf1291315fbb05dd1c54619968a12166fbf 100644 (file)
              (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)
index 8d767620aa35258d319a1652546ed3015f876654..0c1abde49456ba3a985d29d291b1cc246dc233b7 100644 (file)
 (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))