modules improvements

3 files changed, 183 insertions, 63 deletions

diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index d0e1ca5..3d9fc95 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -812,28 +812,46 @@
                      l)
                     (l l)))))))))))
 
+ (#:verb
+  ((_ x) x))
+ 
  (#:scm
   ((_ (#:string _ s)) (with-input-from-string s read)))
  
  (#:import
-  ((_ (#:from (() nm) . #f))
-   `(use-modules (language python module ,(exp vs nm))))
+  ((_ (#:from (() . nm) . #f))
+   `(use-modules (language python module ,@(map (lambda (nm) (exp vs nm))
+						nm))))
   
-  ((_ (#:name ((ids ...) . as) ...))
+  ((_ (#:name ((ids ...) . as)) ...)
+   (pk x)
    `(begin
-      ,@(map (lambda (ids as)
-               (let* ((syms (map (g vs exp) ids))
-                      (id   (if as (exp vs as) (car (reverse syms)))))
-                 (add-prefix id)
-                 `(use-modules ((language python module ,@syms)
-                                #:prefix
-                                ,(string->symbol
-                                  (string-append (symbol->string id) "."))))))
-             ids as))))
-                             
-                                   
-  
- 
+      ,@(map
+	 (lambda (ids as)	     
+	   (let ((path (map (g vs exp) ids)))
+	     (if as
+		 (exp
+		  vs
+		  `(#:expr-stmt
+		    ((#:test (#:power #f ,as ())))
+		    (#:assign 
+		     ((#:verb
+		       ((@ (language python module) Module)
+			',(reverse (append '(language python module) path))
+			',(reverse path)))))))
+		       
+		 (exp
+		  vs
+		  `(#:expr-stmt
+		    ((#:test (#:power #f ,(car ids) ())))
+		    (#:assign
+		     ((#:verb
+		       (((@ (language python module) import)
+			 ((@ (language python module) Module)
+			  ',(append '(language python module) path))
+			 ,(exp vs (car ids))))))))))))
+	 ids as))))
+	       
  (#:for
   ((_ e in code . #f)
    (=> next)
@@ -1131,7 +1149,6 @@
        (cons 'values (map (g vs exp) l))
        (exp vs (car l)))))
   
-
  (#:expr-stmt
   ((_ (l ...) (#:assign))
    (let ((l (map (g vs exp) l)))
diff --git a/modules/language/python/module.scm b/modules/language/python/module.scm
index 615d163..55120e0 100644
--- a/modules/language/python/module.scm
+++ b/modules/language/python/module.scm
@@ -1,11 +1,20 @@
 (define-module (language python module)
   #:use-module (oop pf-objects)
+  #:use-module (oop goops)
   #:use-module (ice-9 match)
+  #:use-module (system syntax)
   #:use-module (language python exceptions)
   #:use-module (language python yield)
   #:use-module (language python try)
   #:use-module (language python dir)
-  #:export (Module))
+  #:export (Module private public import))
+
+(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
+
+(define (private mod)
+  ((ref mod '__setprivate__) #t))
+(define (public mod)
+  ((ref mod '__setprivate__) #f))
 
 (define e (list 'e))
 
@@ -22,21 +31,48 @@
 	(rawref self '_export))))
 
 (define-python-class Module ()
+  (define _modules (make-hash-table))
   (define __setprivate__
     (lambda (self p)
-      (set self '_isprivate p)))
+      (rawset self '_isprivate p)))
+
+  (define _cont
+    (lambda (self id pre l nm)
+      (if id
+	  (aif it (rawref self id)
+	       ((ref it '__init__) pre l nm)
+	       (begin
+		 (rawset self id (Module pre l nm))
+		 (_make self pre nm)))
+	  (_make self pre nm))))
 
+  (define _contupdate
+    (lambda (self id pre l nm)
+      (if id
+	  (aif it (rawref self id)
+	       ((ref it '__update__) pre l nm)
+	       (rawset self id (Module pre l nm)))
+	  #f)))
+  
   (define __init__
     (case-lambda
      ((self pre l nm)
+      (pk 2 l)
       (match l
-	((name)
-	 (_make self (cons name pre) (cons name nm)))
-	((name . (and l (name2 . _)))
-	 (set self name2 (Module (cons name pre) l (cons name nm)))
-	 (_make self (cons name pre) (cons name nm)))))
-     
-     ((self l)     
+       ((name)
+	(set self '_path (reverse (cons name pre)))	      
+	(_cont self #f   (cons name pre) #f (cons name nm)))
+       
+       ((name . (and l (name2 . _)))
+	(set self '_path (reverse (cons name pre)))
+	(_cont self name2 (cons name pre) l  (cons name nm)))))
+       
+
+     ((self l nm)
+      (_cont self #f l #f nm))
+
+     ((self l)
+      (pk 1)
       (if (pair? l)
 	  (if (and (> (length l) 3)
 		   (equal? (list (list-ref l 0)
@@ -44,26 +80,59 @@
 				 (list-ref l 2))
 			   '(language python module)))
 	      (__init__ self (reverse '(language python module)) (cdddr l) '())
-	      (_make self l l))
+	      #f)
 	  (__init__ self
 		    (map string->symbol
 			 (string-split l #\.)))))))
+  (define __update__
+    (case-lambda
+     ((self pre l nm)
+      (match l
+       ((name)
+	(_contupdate self #f   (cons name pre) #f (cons name nm)))
+       
+       ((name . (and l (name2 . _)))
+	(_contupdate self name2 (cons name pre) l  (cons name nm)))))
+       
+
+     ((self l nm)
+      (_contupdate self #f l #f nm))
+
+     ((self l)
+      (if (pair? l)
+	  (if (and (> (length l) 3)
+		   (equal? (list (list-ref l 0)
+				 (list-ref l 1)
+				 (list-ref l 2))
+			   '(language python module)))
+	      (__uppdate__ self (reverse '(language python module))
+			   (cdddr l) '()))	      
+	  (__update__ self
+		      (map string->symbol
+			   (string-split l #\.)))))))
+  
   (define _make
     (lambda (self l nm)
-      (begin
-	(set self '_private #f)
-	(set self '__dict__ self)
-	(set self '__name__ (string-join (map symbol->string (reverse nm)) "."))
-	(let ((_module (resolve-module (reverse l))))
-	  (set self '_export (module-public-interface _module))
-	  (set self '_module _module)))))
-    
+      (pk 'make)
+      (rawset self '_private #f)
+      (if (not (rawref self '_module))
+	  (begin
+	    (pk 'a)
+	    (set self '__dict__ self)
+	    (set self '__name__ (string-join
+				 (map symbol->string (reverse nm)) "."))
+	    (pk 'b)
+	    (let ((_module (resolve-module (reverse l))))
+	      (set self '_export (module-public-interface _module))
+	      (set self '_module _module)
+	      (pk 'c)
+	      (hash-set! _modules l self))))))
+      
   (define __getattribute__
-    (lambda (self k . l)
+    (lambda (self k)
       (define (fail)
-	(if (pair? l)
-	    (car l)
-	    (raise KeyError "getattr in Module")))
+	(raise KeyError "getattr in Module"))
+	       
       (if (rawref self '_module)
 	  (let ((k (_k k))
 		(m (_m self)))
@@ -79,29 +148,27 @@
 	    (fail  (lambda () (raise KeyError "getattr in Module"))))
 	(if (rawref self k)
 	    (fail)
-	    (if (rawref self '_module)
-		(let ((m (_m self)))
-		  (catch #t
-			 (lambda ()
-			   (if (module-defined? m k)
-			       (module-set! m k v)
-			       (module-define! m k v)))			
-			 (lambda x (pk 'fail x))))
-		(fail))))))
+	    (aif m (rawref self '_module)
+		 (catch #t
+			(lambda ()
+			  (if (module-defined? m k)
+			      (module-set! m k v)
+			      (module-define! m k v)))			
+			(lambda x (pk 'fail x)))
+		 (fail))))))
 
   (define __delattr__
     (lambda (self k)
       (define (fail) (raise KeyError "getattr in Module"))
-      (if (rawref self '_module)
-	  (let ((m (_m self))
-		(k (_k k)))
+      (aif m (rawref self '_module)
+	  (let ((k (_k k)))
 	    (if (module-defined? m k)
 		(module-remove!  m k)
 		(raise KeyError "delattr of missing key in Module")))
 	  (fail))))
 
   (define __repr__
-    (lambda (self) (ref self '__name__)))
+    (lambda (self) (format #f "Module(~a)" (ref self '__name__))))
 
   (define __getitem__
     (lambda (self k)
@@ -110,14 +177,42 @@
   
   (define __iter__
     (lambda (self)
-      (define m (_m self))
+      (define m (_m obj))
       ((make-generator ()
-	 (lambda (yield)
-	   (define l '())
-	   (define (f k v) (set! l (cons (list (symbol->string k) v) l)))
-	   (module-for-each f m)
-	   (let lp ((l l))
-	     (if (pair? l)
-		 (begin
-		   (apply yield (car l))
-		   (lp (cdr l)))))))))))
+       (lambda (yield)
+	 (define l '())
+	 (define (f k v) (set! l (cons (list (symbol->string k) v) l)))
+	 (module-for-each f m)
+	 (let lp ((l l))
+	   (if (pair? l)
+	       (begin
+		 (apply yield (car l))
+		 (lp (cdr l)))))	   
+	 (hash-for-each yield (slot-ref self 'h))))))))
+
+
+
+(define-syntax import
+  (lambda (x)
+    (pk (syntax->datum  x))
+    (syntax-case x ()
+      ((_ (a ...) var)
+       #`(import-f #,(case (pk (syntax-local-binding #'var))
+		       ((lexical)
+			#'var)
+		       ((global)
+			#'(if (pk (module-defined? (current-module)
+						   (syntax->datum #'var)))
+			      var
+			      #f))
+		       (else
+			#f)) a ...)))))
+
+(define (m? x) ((@ (language python module python) isinstance) x Module))
+(define (import-f x f . l)
+  (pk 'import-f f x)
+  (pk (if x
+	  (if (m? x)
+	      (apply (rawref x '__update__) l)
+	      (apply f l))
+	  (apply (pk f) l))))
diff --git a/modules/oop/pf-objects.scm b/modules/oop/pf-objects.scm
index 5b78063..0f58326 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -2,6 +2,7 @@
   #:use-module (oop goops)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 pretty-print)
   #:use-module (logic guile-log persistance)
   #:replace (equal?)  
   #:export (set ref make-p <p> <py> <pf> <pyf> <property>
@@ -13,7 +14,7 @@
                 py-super-mac py-super py-equal? 
                 *class* *self* pyobject? pytype?
                 type object pylist-set! pylist-ref tr
-		resolve-method rawref
+		resolve-method rawref rawset
                 ))
 
 #|
@@ -426,6 +427,9 @@ explicitly tell it to not update etc.
 (define-method (set (x <pyf>) key val) (mklam (mset-py  x key) val))
 (define-method (set (x <py>)  key val) (mklam (mset-py  x key) val))
 
+(define-method (rawset (x <pf>)  key val) (mklam (mset     x key) val))
+(define-method (rawset (x <p>)   key val) (mklam (mset     x key) val))
+
 ;; mref will reference the value of the key in the object x, an extra default
 ;; parameter will tell what the fail object is else #f if fail
 ;; if there is no found binding in the object search the class and
@@ -924,6 +928,10 @@ explicitly tell it to not update etc.
     ((_ class self)
      (py-super class self))))
 
+(define (pp x)
+  (pretty-print (syntax->datum x))
+  x)
+
 (define-syntax letruc
   (lambda (x)
     (syntax-case x ()