summaryrefslogtreecommitdiff
path: root/modules
diff options
context:
space:
mode:
Diffstat (limited to 'modules')
-rw-r--r--modules/language/python/compile.scm51
-rw-r--r--modules/language/python/module.scm185
-rw-r--r--modules/oop/pf-objects.scm10
3 files changed, 183 insertions, 63 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index 95878a4..80f523c 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 125a3f7..d0ba6e4 100644
--- a/modules/oop/pf-objects.scm
+++ b/modules/oop/pf-objects.scm
@@ -4,6 +4,7 @@
#:use-module (ice-9 match)
#:use-module (system base message)
#:use-module (language python guilemod)
+ #:use-module (ice-9 pretty-print)
#:use-module (logic guile-log persistance)
#:replace (equal?)
#:export (set ref make-p <p> <py> <pf> <pyf> <property>
@@ -15,7 +16,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
))
#|
@@ -428,6 +429,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
@@ -930,6 +934,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 ()
generated by cgit v1.2.3 (git 2.46.0) at 2024-11-10 16:05:41 +0000