cleanup
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Tue, 6 Nov 2018 22:31:41 +0000 (23:31 +0100)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Tue, 6 Nov 2018 22:31:41 +0000 (23:31 +0100)
33 files changed:
modules/language/*.scm [deleted file]
modules/language/python/#eval.scm# [deleted file]
modules/language/python/#persist.scm# [deleted file]
modules/language/python/#python.scm# [deleted file]
modules/language/python/#spec.scm# [deleted file]
modules/language/python/#test.py# [deleted file]
modules/language/python/#util.scm# [deleted file]
modules/language/python/#yield.scm# [deleted file]
modules/language/python/bool.go [deleted file]
modules/language/python/def.go [deleted file]
modules/language/python/exceptions.go [deleted file]
modules/language/python/for.go [deleted file]
modules/language/python/guilemod.go [deleted file]
modules/language/python/hash.go [deleted file]
modules/language/python/list.go [deleted file]
modules/language/python/module/#_md5.scm# [deleted file]
modules/language/python/module/#_sha1.scm# [deleted file]
modules/language/python/module/#_sha256.scm# [deleted file]
modules/language/python/module/#bz2.py# [deleted file]
modules/language/python/module/#difflib.py# [deleted file]
modules/language/python/module/#json.py# [deleted file]
modules/language/python/module/#string.scm# [deleted file]
modules/language/python/module/#textwrap.py# [deleted file]
modules/language/python/module/xml.py~ [deleted file]
modules/language/python/persist.go [deleted file]
modules/language/python/try.go [deleted file]
modules/language/python/tuple.go [deleted file]
modules/language/python/with.go [deleted file]
modules/language/python/yield.go [deleted file]
modules/oop/#a# [deleted file]
modules/oop/pf-objects.go [deleted file]
modules/oop/pf-objects.scm.bak [deleted file]
modules/oop/pf-objects.scm~ [deleted file]

diff --git a/modules/language/*.scm b/modules/language/*.scm
deleted file mode 100644 (file)
index e69de29..0000000
diff --git a/modules/language/python/#eval.scm# b/modules/language/python/#eval.scm#
deleted file mode 100644 (file)
index 5328fe5..0000000
+++ /dev/null
@@ -1,171 +0,0 @@
-(define-module (language python eval)
-  #:use-module (language python guilemod)
-  #:use-module (parser stis-parser lang python3-parser)
-  #:use-module (language python exceptions)
-  #:use-module (language python module)
-  #:use-module (language python try)
-  #:use-module (language python list)
-  #:use-module (language python for)
-  #:use-module (language python dict)
-  #:use-module (oop pf-objects)
-  #:use-module ((ice-9 local-eval) #:select ((the-environment . locals)))
-  #:re-export (locals)
-  #:replace (eval)
-  #:export (local-eval local-compile globals compile exec))
-
-(define seval (@ (guile) eval))
-
-(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
-
-(define-syntax-rule (L x) (@@ (ice-9 local-eval) x))
-
-(define-syntax globals
-  (lambda (x)
-    (syntax-case x ()
-      ((g)
-       #'(M ((L env-module) (locals g)))))))
-
-(define-syntax-rule (call- self item a ...)
-  (let ((class (ref self '_module)))
-    ((rawref class item) class a ...)))
-
-(define-syntax-rule (apply- self item a ...)
-  (let ((class (ref self '_module)))
-    (apply (rawref class item) class a ...)))
-
-(define-syntax-rule (ref- self item)
-  (let ((class (ref self '_module)))
-    (rawref class item)))
-
-   
-(define-python-class GlobalModuleWrap (dict)
-  (define __init__
-    (lambda (self module)
-      (set self '_module module)))
-  
-  (define __getitem__
-    (lambda (self key)
-      (if (string? key) (set! key (string->symbol key)))
-      (call- self '__global_getitem__ key)))
-
-  (define get
-    (lambda (self key . es)
-      (if (string? key) (set! key (string->symbol key)))
-      (apply- self '__global_get__ key es)))
-
-  (define __setitem__
-    (lambda (self key val)
-      (if (string? key) (set! key (string->symbol key)))
-      (call- self '__global_setitem__ key val)))
-
-  (define __iter__
-    (lambda (self)
-      (call- self '__global_iter__)))
-
-  (define values
-    (lambda (self)
-      (for ((k v : (__iter__ self))) ((l '()))
-           (cons v l)
-           #:final l)))
-
-  (define keys
-    (lambda (self)
-      (for ((k v : (__iter__ self))) ((l '()))
-           (cons k l)
-           #:final l)))
-
-  (define __contains__
-    (lambda (self key)
-      (if (string? key) (set! key (string->symbol key)))
-      (for ((k v : (__iter__ self))) ()
-           (if (eq? k key)
-               (break #t))
-           #:final
-           #f)))
-  
-  (define items __iter__)
-
-  (define __repr__
-    (lambda (self)
-      (format #f "globals(~a)" (ref- self '__name__)))))
-
-  
-      
-(define MM (list 'error))
-(define (M mod)
-  (set! mod (module-name mod))
-  (if (and (> (length mod) 3)
-           (eq? (car   mod) 'language)
-           (eq? (cadr  mod) 'python)
-           (eq? (caddr mod) 'module))
-      (set! mod (Module (reverse mod)
-                        (reverse (cdddr mod))))
-      (set! mod (Module (reverse mod) (reverse mod))))
-
-  (GlobalModuleWrap mod))
-                      
-
-(define* (local-eval x locals globals)
-  "Evaluate the expression @var{x} within the local environment @var{local} and
-global environment @var{global}."
-  (if locals
-      (if globals
-          (apply (seval ((L local-wrap) x locals) globals)
-                 ((L env-boxes) locals))
-          (apply (seval ((L local-wrap) x locals) ((L env-module) locals))
-                 ((L env-boxes) locals)))
-      (seval x (current-module))))
-
-(define* (local-compile x locals globals #:key (opts '()))
-  "Compile the expression @var{x} within the local environment @var{local} and
-global environment @var{global}."
-  (if locals
-      (if globals
-          (apply ((@ (system base compile) compile)
-                  ((L local-wrap) x locals) #:env globals
-                          #:from 'scheme #:opts opts)
-                 ((L env-boxes) locals))
-          (apply ((@ (system base compile) compile) ((L local-wrap) x locals)
-                          #:env ((L env-module) locals)
-                          #:from 'scheme #:opts opts)
-                 ((L env-boxes) locals)))
-      ((@ (system base compile) compile) x #:env (current-module)
-               #:from 'scheme #:opts opts)))
-
-(define-syntax eval 
-  (lambda (x)
-    (syntax-case x ()
-      ((eval x)
-       #'(eval0 x (locals eval)))
-      ((eval x . l)
-       #'(eval0 x . l)))))
-
-(define* (eval0 x #:optional (locals #f) (globals #f))
-  (cond
-   ((string? x)
-    (aif xp (p x)
-         (aif cp (comp xp)
-              (local-eval cp locals globals)
-              (raise SyntaxError))
-         (raise SyntaxError)))
-   ((pair? x)
-    (local-eval x locals globals))))
-
-(define* (compile x filename mode
-                  #:optional (flags 0) (dont_inherit #f) (optiomize -1))
-  (aif xp (p x)
-       (aif cp (comp xp)
-            cp
-            (raise SyntaxError))
-       (raise SyntaxError)))
-
-(define-syntax exec
-  (lambda (x)
-    (syntax-case x ()
-      ((exec x)
-       #'(eval0 x (locals exec)))
-      ((exec x . l)
-       #'(exec0 x . l)))))
-
-(define* (exec0 x #:optional (locals #f) (globals #f))
-  (local-eval x locals globals))
diff --git a/modules/language/python/#persist.scm# b/modules/language/python/#persist.scm#
deleted file mode 100644 (file)
index 4ee46fc..0000000
+++ /dev/null
@@ -1,114 +0,0 @@
-(define-module (language python persist)
-  #:use-module (ice-9 match)
-  #:use-module (ice-9 vlist)
-  #:use-module (ice-9 pretty-print)
-  #:use-module (oop goops)
-  #:use-module (oop pf-objects)
-  #:use-module (logic guile-log persistance)
-  #:re-export(pcopyable? deep-pcopyable? pcopy deep-pcopy name-object
-                        name-object-deep)
-  #:export (reduce cp red cpit))
-
-(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
-
-(define (vhash->assoc v)
-  (let ((t (make-hash-table)))
-    (vhash-fold
-     (lambda (k v s)
-       (if (hash-ref t k)
-          s
-          (begin
-            (hash-set! t k #t)
-            (cons (cons k v) s))))
-     '() v)))
-
-(define-method (pcopyable?      (o <p>)) #t)
-(define-method (deep-pcopyable? (o <p>)) #t)
-
-(define (cp o)
-  (match (red o)
-        ((#:reduce mk f)
-         (let ((oo (mk)))
-           (for-each (lambda (x) (apply (car x) oo (cdr x))) f)
-           oo))))
-
-(define (red o)
-  (fluid-set! first #t)
-  (list #:reduce
-       (let ((cl (class-of o)))
-         (lambda () (make cl)))                
-       (reduce o)))
-  
-
-(define-method (pcopy (o <p>))
-  (list #:obj
-       (aif it (ref o '__copy__)
-            (it)
-            (cp o))))
-
-(define-method (deep-pcopy (o <p>) p?)
-  (aif it (and p? (ref o '__deepcopy__))
-       (list #:obj  (it))
-       (red o)))
-
-(define first (make-fluid #f))
-(define-method (reduce o) '())
-(define-method (reduce (o <p>))
-  (if (fluid-ref first)
-      (begin
-       (fluid-set! first #f)
-       (cons
-        (aif it (ref o '__reduce__)
-             (it)
-             (cons
-              (lambda (o args)
-                (let ((h (make-hash-table)))
-                  (slot-set! o 'h h)
-                  (for-each
-                   (lambda (x) (hash-set! h (car x) (cdr x)))
-                   args)))
-              (list
-               (hash-fold
-                (lambda (k v s) (cons (cons k v) s))
-                '()
-                (slot-ref o 'h)))))
-        (next-method)))
-      (next-method)))
-
-(define (fold f s l)
-  (if (pair? l)
-      (fold f (f (car l) s) (cdr l))
-      s))
-
-(define-method (reduce (o <pf>))
-  (if (fluid-ref first)
-      (begin
-       (fluid-set! first #f)
-       (cons*
-        (cons
-         (lambda (o n args)
-           (slot-set! o 'size n)
-           (slot-set! o 'n    n)
-           (let ((h
-                  (fold              
-                   (lambda (k v s) (vhash-assoc k v s))
-                   vlist-null
-                   args)))
-             (slot-set! o 'h h)))
-         (list (slot-ref o 'n) (vhash->assoc (slot-ref o 'h))))
-        (next-method)))
-      (next-method)))
-     
-(define-syntax cpit
-  (lambda (x)
-    (syntax-case x ()
-      ((_ <c> (o lam a))
-       #'(begin    
-          (define-method (pcopyable?      (o <c>)   ) #t)
-          (define-method (deep-pcopyable? (o <c>)   ) #t)
-          (define-method (pcopy           (o <c>)   ) (cp o))
-          (define-method (deep-pcopy      (o <c>) p?) (red o))
-          (define-method (reduce          (o <c>)   )
-            (cons*
-             (cons lam a)
-             (next-method))))))))
diff --git a/modules/language/python/#python.scm# b/modules/language/python/#python.scm#
deleted file mode 100644 (file)
index cb36775..0000000
+++ /dev/null
@@ -1,246 +0,0 @@
-(define-module (language python python)
-  #:use-module (language python parser)
-  #:use-module (language python expr)
-  #:use-module (ice-9    match)
-  #:export (compile-python-string compile-python-file))
-
-;;; VARIABLES ----------------------------------------------------------------
-(define (find-global-variables vars tree)
-  (define (for-each* f l)
-    (match l
-      ((x . l)
-       (f x)
-       (for-each* f l))
-      (x
-       (f x))))
-
-  (define (local tree)
-    (match tree
-      ((#:global l)
-       (for-each* 
-        (lambda (x) (hash-set! vars x #t)) l))
-      ((x . l) 
-       (for-each* local tree))
-      (_       
-       #t)))
-
-  (define (collect tree)
-    (match tree
-      ((#:lambdef . _)
-       #t)
-      ((#:identifier . l)
-       (hash-set! vars tree #t))
-      ((_ . _)
-       (for-each* collect tree))
-      (_
-       #t)))
-
-  (let lp ((tree tree))
-    (match tree
-      ((#:def . l)
-       (for-each* local l))
-      ((#:lambdef . l)
-       (for-each* local l))
-      ((#:class  . l)
-       (for-each* local l))
-      ((#:expr-stmt
-        a (#:assign x ... e))
-       (collect a)
-       (collect x))
-      ((x . l)
-       (for-each* lp tree))
-      (_
-       #t))))
-;; COMPILATION
-
-(define (expr stx out tree)
-  (define (expr-lhs tree)
-    (match tree
-      ((#:test (#:power (#:identifier v . _)))
-       (datum->syntax stx (string->symbol v)))))
-
-
-  (define (expr-rhs tree)
-    (define (comp-tr op)
-      (match op
-        ("notin" #'py-notin)
-        ("isnot" #'py-isnot)
-        ("=="    #'py_==)
-        (">="    #'py_>=)
-        ("<="    #'py_<=)
-        ("<>"    #'py_<>)
-        ("!="    #'py_!=)
-        ("in"    #'py_in)
-        ("is"    #'py_is)
-        ("<"     #'py_< )
-        (">"     #'py_> )))
-
-    (let lp ((tree tree))
-      (match tree
-        ((#:test x #f)
-         (lp x))
-        ((#:test x (a b))
-         #`(if #,(py-true? (lp a)) #,(lp x) #,(lp b)))
-        ((#:or x . y)
-         #`(py-or #,(lp x) #,@(map lp y)))
-        ((#:and x y)
-         #`(py-and #,(lp x) #,@(map lp y)))
-        ((#:not x)
-         #`(py-not #,(lp x)))
-        ((#:comp x)
-         (lp x))
-        ((#:comp x (op . y) . l)
-         #'(#,(comp-tr op) #,(lp x) #,(lp (cons* #:comp y l))))
-        ((#:bor x y)
-         #`(py-bor #,(lp x) #,@(map lp y)))
-        ((#:bxor x y)
-         #`(py-bxor #,(lp x) #,@(map lp y)))
-        ((#:xand x y)
-         #`(py-band #,(lp x) #,@(map lp y)))
-        ((#:<< x y)
-         #`(py-<< #,(lp x) #,@(map lp y)))
-        ((#:>> x y)
-         #`(py->> #,(lp x) #,@(map lp y)))
-        ((#:+ x y)
-         #`(py-+ #,(lp x) #,@(map lp y)))
-        ((#:- x y)
-         #`(py-- #,(lp x) #,@(map lp y)))
-        ((#:* x y)
-         #`(py-* #,(lp x) #,@(map lp y)))
-        ((#:/ x y)
-         #`(py-/ #,(lp x) #,@(map lp y)))
-        ((#:// x y)
-         #`(py-// #,(lp x) #,@(map lp y)))
-        ((#:% x y)
-         #`(py-% #,(lp x) #,@(map lp y)))
-        ((#:u+ x)
-         #`(py-u+ #,(lp x)))
-        ((#:u- x)
-         #`(py-u- #,(lp x)))
-        ((#:u~ x)
-         #`(py-u~ #,(lp x)))
-        ((#:power x trailer . #f)
-         (compile-trailer trailer (lp x)))
-        ((#:power x trailer . l)
-         #'(py-power ,#(compile-trailer trailer (lp x)) #,(lp l)))
-        ((#:identifier x . _)
-         (datum->syntax stx (string->symbol x)))
-        ((not (_ . _))
-         tree))))
-        
-        
-
-  (lambda (tree)
-    (match tree
-      ((test1 (#:assign))
-       (expr-rhs test1))
-      ((test1 (#:assign tests ... last))
-       (with-syntax (((rhs ...)       (map expr-rhs last))
-                     ((lhs1 ...)      (map expr-lhs test1))
-                     (((lhs ...) ...) (reverse (map (lambda (l) 
-                                                      (map expr-lhs l))
-                                                    tests))))
-         (with-syntax (((v ...) (generate-temporaries #'(lhs1 ...))))
-            (out #'(call-with-values (lambda () (values rhs ...))
-                      (lambda (v ...)
-                        (begin
-                          (set! lhs v) ...)
-                        ...
-                        (set! lhs1 v) ...)))))))))
-             
-
-(define (compile-outer state out tree)
-  (define (compile-stmt state tree)    
-    (match tree
-      ((#:expr-stmt l)
-       (compile-expr l))
-
-      ((#:del       l)
-       (compile-del l))
-      
-      (#:pass 
-       (out #'(if #f #f)))
-      
-      (#:break
-       (break out))      
-      
-      (#:continue
-       (continue out))
-      
-      ((#:return . l)
-       (compile-return state l))
-      
-      ((#:raise . l)
-       (compile-raise state l))
-      
-      ((#:import l)
-       (compile-import state l))
-
-      ((#:global . _)
-       #t)
-      
-      ((#:nonlocal . _)
-       #t)
-         
-      ((#:assert . l)
-       (compile-assert state l))))
-    
-  (match tree
-    ((#:stmt x)
-     (for-each* compile-stmt tree))
-    ((#:if . l)
-     (compile-if state l))
-    ((#:while . l)
-     (compile-while state l))
-    ((#:for  . l)
-     (compile-for state l))
-    ((#:try  . l)
-     (compile-try state l))
-    ((#:with . l)
-     (compile-with state l))
-    ((#:def  . l)
-     (compile-def state l))
-    ((#:decorated . l)
-     (compile-decorated state l))))
-
-
-(define (compile-python0 stx tree output)
-  (define global-variables (make-hash-table))
-  
-  (find-global-variables global-variables tree)
-  (set! all-variables 
-        (hash-fold
-         (lambda (k v e)
-           (match k
-             ((_ v . _)
-              (cons (datum->syntax stx (string->symbol v)) e))))
-         '() global-variables))
-  (set! all-globals
-        (hash-fold
-         (lambda (k v e)
-           (match k
-            ((_ v)
-              (cons (datum->syntax stx (string->symbol v)) e))))
-         '() global-variables))
-
-  (output (with-syntax (((v ...) all-variables))
-          #'(begin (define v (if #f #f)) ...)))
-  
-  (output (with-syntax (((v ...) all-globals))
-            #'(export v ...)))
-
-  (output #`(begin #,@(compile-outer))))
-  
-
-(define (compile-python1 stx tree)
-  (let ((out '()))
-    (define (out x) (set! out (cons x out)))
-    (compile-python0 stx tree out)
-    (cons* #'begin (reverse out))))
-
-(define-syntax compile-python-string
-  (lambda (x)
-    (syntax-case x ()
-      ((_ y)
-       (if (string? (syntax->datum #'y))
-          (compile-python1 x (python-parser
diff --git a/modules/language/python/#spec.scm# b/modules/language/python/#spec.scm#
deleted file mode 100644 (file)
index 8291a14..0000000
+++ /dev/null
@@ -1,68 +0,0 @@
-(define-module (language python spec)
-  #:use-module (language python guilemod)
-  #:use-module (parser stis-parser lang python3-parser)
-  #:use-module ((language python module python) #:select ())
-  #:use-module (language python compile)
-  #:use-module (language python completer)
-  #:use-module (rnrs io ports)
-  #:use-module (ice-9 pretty-print)
-  #:use-module (ice-9 readline)
-  #:use-module (system base compile)
-  #:use-module (system base language)
-  #:use-module (language scheme compile-tree-il)
-  #:use-module (language scheme decompile-tree-il)
-  #:use-module (ice-9 rdelim)
-  #:export (python))
-
-;;;
-;;; Language definition
-;;;
-
-(define (pr . x)
-  (define port (open-file "/home/stis/src/python-on-guile/log.txt" "a"))
-  (with-output-to-port port
-    (lambda ()
-      (pretty-print x) (car (reverse  x))))
-  (close port)
-  (car (reverse x)))
-
-(define (c x) (pr (comp (pr (p (pr x))))))
-(define (cc port x)
-  (if (equal? x "") (read port) (c x)))
-
-(define (e x) (eval (c x) (current-module)))
-
-(catch #t
-  (lambda ()
-    (set! (@@ (ice-9 readline) *readline-completion-function*)
-      (complete-fkn e)))
-  (lambda x #f))
-
-(define-language python
-  #:title      "python"
-  #:reader      (lambda (port env)
-                  (if (not (fluid-ref (@@ (system base compile) %in-compile)))
-                      (cc port (read-line port))
-                      (cc port (read-string port))))
-
-  #:compilers   `((tree-il . ,compile-tree-il))
-  #:decompilers `((tree-il . ,decompile-tree-il))
-  #:evaluator  (lambda (x module) (primitive-eval x))
-  #:printer    write
-  #:make-default-environment
-  (lambda ()
-    ;; Ideally we'd duplicate the whole module hierarchy so that `set!',
-    ;; `fluid-set!', etc. don't have any effect in the current environment.
-    (let ((m (make-fresh-user-module)))                    
-      ;; Provide a separate `current-reader' fluid so that
-      ;; compile-time changes to `current-reader' are
-      ;; limited to the current compilation unit.
-      (module-define! m 'current-reader (make-fluid))
-      
-      ;; Default to `simple-format', as is the case until
-      ;; (ice-9 format) is loaded.  This allows
-      ;; compile-time warnings to be emitted when using
-      ;; unsupported options.
-      (module-set! m 'format simple-format)
-      
-      m)))
diff --git a/modules/language/python/#test.py# b/modules/language/python/#test.py#
deleted file mode 100644 (file)
index 976e04f..0000000
+++ /dev/null
@@ -1,13 +0,0 @@
-def f(x):
-    def h(q):
-        return q + y + z
-    global y
-    y=x
-    z=1
-    return y + x
-
-def g():
-    return y,y
-
-x : x.a = 1
-x : x.f(10)
diff --git a/modules/language/python/#util.scm# b/modules/language/python/#util.scm#
deleted file mode 100644 (file)
index 95c54a2..0000000
+++ /dev/null
@@ -1,3 +0,0 @@
-(define-module (language python util)
-  #:export ())
-
diff --git a/modules/language/python/#yield.scm# b/modules/language/python/#yield.scm#
deleted file mode 100644 (file)
index 7488f42..0000000
+++ /dev/null
@@ -1,138 +0,0 @@
-(define-module (language python yield)
-  #:use-module (oop pf-objects)
-  #:use-module (language python exceptions)
-  #:use-module (oop goops)
-  #:use-module (ice-9 control)
-  #:use-module (ice-9 match)
-  #:use-module (language python persist)
-  #:replace (send)
-  #:export (<yield> 
-            in-yield define-generator
-            make-generator
-            sendException sendClose))
-
-(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
-
-(define in-yield (make-fluid #f))
-
-(define-syntax-parameter YIELD (lambda x #f))
-
-(define-syntax yield
-  (lambda (x)
-    (syntax-case x ()
-      ((_ x ...)
-       #'(begin
-           (fluid-set! in-yield #t)
-           ((abort-to-prompt YIELD x ...))))
-      (x
-       #'(lambda x
-           (fluid-set! in-yield #t)
-           ((apply abort-to-prompt YIELD x)))))))
-
-(define-syntax make-generator
-  (syntax-rules ()
-    ((_ closure)
-     (make-generator () closure))
-    ((_ args closure)
-     (lambda a
-       (let ()
-         (define obj   (make <yield>))
-         (define ab (make-prompt-tag))
-         (syntax-parameterize ((YIELD (lambda x #'ab)))
-           (slot-set! obj 'k #f)
-           (slot-set! obj 'closed #f)
-           (slot-set! obj 's
-                      (lambda ()
-                        (call-with-prompt
-                         ab
-                         (lambda ()
-                           (apply closure yield a)
-                           (slot-set! obj 'closed #t)
-                           (throw StopIteration))
-                         (letrec ((lam
-                                   (lambda (k . l)
-                                     (fluid-set! in-yield #f)
-                                     (slot-set! obj 'k
-                                                (lambda (a)
-                                                  (call-with-prompt
-                                                   ab
-                                                   (lambda ()
-                                                     (k a))
-                                                   lam)))
-                                     (apply values l))))
-                           lam))))
-           obj))))))
-
-(define-syntax define-generator
-  (lambda (x)
-    (syntax-case x ()
-      ((_ (f y . args) code ...)
-       #'(define f (make-generator args  (lambda (y . args) code ...)))))))
-
-(define-class <yield>      () s k closed)
-(name-object <yield>)
-(cpit <yield> (o (lambda (o s k closed)
-                  (slot-set! o 's      s     )
-                  (slot-set! o 'k      k     )
-                  (slot-set! o 'closed closed))
-                (list
-                 (slot-ref o 's)
-                 (slot-ref o 'k)
-                 (slot-ref o 'closed))))
-                 
-(define-method (send (l <yield>) . u)
-  (let ((k (slot-ref l 'k))
-        (s (slot-ref l 's))
-        (c (slot-ref l 'closed)))
-    (if (not c)
-        (if k
-            (k (lambda ()
-                 (if (null? u)
-                     'Null
-                     (apply values u))))
-            (throw 'python (Exception))))))
-
-
-(define-method (sendException (l <yield>) e . ls)
-  (let ((k (slot-ref l 'k))
-        (s (slot-ref l 's))
-        (c (slot-ref l 'closed)))
-    (if (not c)
-        (if k           
-            (k (lambda ()
-                 (if (pyclass? e) 
-                     (throw 'python (apply e ls))
-                     (apply throw 'python e ls))))
-            (throw 'python (Exception))))))
-
-(define-method (sendClose (l <yield>))
-  (let ((k (slot-ref l 'k))
-        (s (slot-ref l 's))
-        (c (slot-ref l 'closed)))
-    (if c
-        (values)
-        (if k
-            (catch #t
-              (lambda ()
-                (k (lambda () (throw 'python GeneratorExit)))
-                (slot-set! l 'closed #t)
-                (throw 'python RuntimeError))
-              (lambda (k tag . v)
-                (slot-set! l 'closed #t)
-                (if (eq? tag 'python)
-                    (match v
-                      ((tag . l)
-                       (if (eq? tag GeneratorExit)
-                           (values)
-                           (apply throw tag l))))
-                    (apply throw tag v))))
-            (slot-set! l 'closed #t)))))
-
-(define-method (send (l <p>) . u)
-  (apply (ref l '__send__) u))
-
-(define-method (sendException (l <p>) . u)
-  (apply (ref l '__exception__) u))
-
-(define-method (sendClose (l <p>))
-  ((ref l '__close__)))
diff --git a/modules/language/python/bool.go b/modules/language/python/bool.go
deleted file mode 100644 (file)
index c69d97a..0000000
Binary files a/modules/language/python/bool.go and /dev/null differ
diff --git a/modules/language/python/def.go b/modules/language/python/def.go
deleted file mode 100644 (file)
index b0fdc60..0000000
Binary files a/modules/language/python/def.go and /dev/null differ
diff --git a/modules/language/python/exceptions.go b/modules/language/python/exceptions.go
deleted file mode 100644 (file)
index c978f75..0000000
Binary files a/modules/language/python/exceptions.go and /dev/null differ
diff --git a/modules/language/python/for.go b/modules/language/python/for.go
deleted file mode 100644 (file)
index 6fc5dea..0000000
Binary files a/modules/language/python/for.go and /dev/null differ
diff --git a/modules/language/python/guilemod.go b/modules/language/python/guilemod.go
deleted file mode 100644 (file)
index 37043ec..0000000
Binary files a/modules/language/python/guilemod.go and /dev/null differ
diff --git a/modules/language/python/hash.go b/modules/language/python/hash.go
deleted file mode 100644 (file)
index c39e3fb..0000000
Binary files a/modules/language/python/hash.go and /dev/null differ
diff --git a/modules/language/python/list.go b/modules/language/python/list.go
deleted file mode 100644 (file)
index 99090c0..0000000
Binary files a/modules/language/python/list.go and /dev/null differ
diff --git a/modules/language/python/module/#_md5.scm# b/modules/language/python/module/#_md5.scm#
deleted file mode 100644 (file)
index cc07ebd..0000000
+++ /dev/null
@@ -1,11 +0,0 @@
-(define-module (language python module _md5)
-  #:use-module (language python checksum)
-  #:use-module (oop pf-objects)
-  #:export (md5))
-
-(define-python-class md5 (Summer)
-  (define name     "md5")
-  (define digest_size 16)
-  
-  (define _command "/usr/bin/md5sum"))
-  
diff --git a/modules/language/python/module/#_sha1.scm# b/modules/language/python/module/#_sha1.scm#
deleted file mode 100644 (file)
index 87a0adb..0000000
+++ /dev/null
@@ -1,10 +0,0 @@
-(define-module (language python module _sha1)
-  #:use-module (language python checksum)
-  #:use-module (oop pf-objects)
-  #:export (sha1))
-
-(define-python-class sha1 (Summer)
-  (define name     "sha1")
-  (define digest_size 20)
-  
-  (define _command "/usr/bin/sha1sum"))
diff --git a/modules/language/python/module/#_sha256.scm# b/modules/language/python/module/#_sha256.scm#
deleted file mode 100644 (file)
index c87ea1a..0000000
+++ /dev/null
@@ -1,10 +0,0 @@
-(define-module (language python module _sha256)
-  #:use-module (language python checksum)
-  #:use-module (oop pf-objects)
-  #:export (sha256))
-
-(define-python-class sha256 (Summer)
-  (define name     "sha256")
-  (define digest_size 32)
-  
-  (define _command "/usr/bin/sha256sum"))
diff --git a/modules/language/python/module/#bz2.py# b/modules/language/python/module/#bz2.py#
deleted file mode 100644 (file)
index 3740792..0000000
+++ /dev/null
@@ -1,362 +0,0 @@
-module(bz2)
-"""Interface to the libbzip2 compression library.
-
-This module provides a file interface, classes for incremental
-(de)compression, and functions for one-shot (de)compression.
-"""
-
-__all__ = ["BZ2File", "BZ2Compressor", "BZ2Decompressor",
-           "open", "compress", "decompress"]
-
-__author__ = "Nadeem Vawda <nadeem.vawda@gmail.com>"
-
-from builtins import open as _builtin_open
-import io
-import os
-import warnings
-import _compression
-
-try:
-    from threading import RLock
-except ImportError:
-    from dummy_threading import RLock
-
-from _bz2 import BZ2Compressor, BZ2Decompressor
-
-
-_MODE_CLOSED   = 0
-_MODE_READ     = 1
-# Value 2 no longer used
-_MODE_WRITE    = 3
-
-
-class BZ2File(_compression.BaseStream):
-
-    """A file object providing transparent bzip2 (de)compression.
-
-    A BZ2File can act as a wrapper for an existing file object, or refer
-    directly to a named file on disk.
-
-    Note that BZ2File provides a *binary* file interface - data read is
-    returned as bytes, and data to be written should be given as bytes.
-    """
-
-    def __init__(self, filename, mode="r", buffering=None, compresslevel=9):
-        """Open a bzip2-compressed file.
-
-        If filename is a str, bytes, or PathLike object, it gives the
-        name of the file to be opened. Otherwise, it should be a file
-        object, which will be used to read or write the compressed data.
-
-        mode can be 'r' for reading (default), 'w' for (over)writing,
-        'x' for creating exclusively, or 'a' for appending. These can
-        equivalently be given as 'rb', 'wb', 'xb', and 'ab'.
-
-        buffering is ignored. Its use is deprecated.
-
-        If mode is 'w', 'x' or 'a', compresslevel can be a number between 1
-        and 9 specifying the level of compression: 1 produces the least
-        compression, and 9 (default) produces the most compression.
-
-        If mode is 'r', the input file may be the concatenation of
-        multiple compressed streams.
-        """
-        # This lock must be recursive, so that BufferedIOBase's
-        # writelines() does not deadlock.
-        self._lock = RLock()
-        self._fp = None
-        self._closefp = False
-        self._mode = _MODE_CLOSED
-
-        if buffering is not None:
-            warnings.warn("Use of 'buffering' argument is deprecated",
-                          DeprecationWarning)
-
-        if not (1 <= compresslevel <= 9):
-            raise ValueError("compresslevel must be between 1 and 9")
-
-        if mode in ("", "r", "rb"):
-            mode = "rb"
-            mode_code = _MODE_READ
-        elif mode in ("w", "wb"):
-            mode = "wb"
-            mode_code = _MODE_WRITE
-            self._compressor = BZ2Compressor(compresslevel)
-        elif mode in ("x", "xb"):
-            mode = "xb"
-            mode_code = _MODE_WRITE
-            self._compressor = BZ2Compressor(compresslevel)
-        elif mode in ("a", "ab"):
-            mode = "ab"
-            mode_code = _MODE_WRITE
-            self._compressor = BZ2Compressor(compresslevel)
-        else:
-            raise ValueError("Invalid mode: %r" % (mode,))
-
-        if isinstance(filename, (str, bytes, os.PathLike)):
-            self._fp = _builtin_open(filename, mode)
-            self._closefp = True
-            self._mode = mode_code
-        elif hasattr(filename, "read") or hasattr(filename, "write"):
-            self._fp = filename
-            self._mode = mode_code
-        else:
-            raise TypeError("filename must be a str, bytes, file or PathLike object")
-
-        if self._mode == _MODE_READ:
-            raw = _compression.DecompressReader(self._fp,
-                BZ2Decompressor, trailing_error=OSError)
-            self._buffer = io.BufferedReader(raw)
-        else:
-            self._pos = 0
-
-    def close(self):
-        """Flush and close the file.
-
-        May be called more than once without error. Once the file is
-        closed, any other operation on it will raise a ValueError.
-        """
-        with self._lock:
-            if self._mode == _MODE_CLOSED:
-                return
-            try:
-                if self._mode == _MODE_READ:
-                    self._buffer.close()
-                elif self._mode == _MODE_WRITE:
-                    self._fp.write(self._compressor.flush())
-                    self._compressor = None
-            finally:
-                try:
-                    if self._closefp:
-                        self._fp.close()
-                finally:
-                    self._fp = None
-                    self._closefp = False
-                    self._mode = _MODE_CLOSED
-                    self._buffer = None
-
-    @property
-    def closed(self):
-        """True if this file is closed."""
-        return self._mode == _MODE_CLOSED
-
-    def fileno(self):
-        """Return the file descriptor for the underlying file."""
-        self._check_not_closed()
-        return self._fp.fileno()
-
-    def seekable(self):
-        """Return whether the file supports seeking."""
-        return self.readable() and self._buffer.seekable()
-
-    def readable(self):
-        """Return whether the file was opened for reading."""
-        self._check_not_closed()
-        return self._mode == _MODE_READ
-
-    def writable(self):
-        """Return whether the file was opened for writing."""
-        self._check_not_closed()
-        return self._mode == _MODE_WRITE
-
-    def peek(self, n=0):
-        """Return buffered data without advancing the file position.
-
-        Always returns at least one byte of data, unless at EOF.
-        The exact number of bytes returned is unspecified.
-        """
-        with self._lock:
-            self._check_can_read()
-            # Relies on the undocumented fact that BufferedReader.peek()
-            # always returns at least one byte (except at EOF), independent
-            # of the value of n
-            return self._buffer.peek(n)
-
-    def read(self, size=-1):
-        """Read up to size uncompressed bytes from the file.
-
-        If size is negative or omitted, read until EOF is reached.
-        Returns b'' if the file is already at EOF.
-        """
-        with self._lock:
-            self._check_can_read()
-            return self._buffer.read(size)
-
-    def read1(self, size=-1):
-        """Read up to size uncompressed bytes, while trying to avoid
-        making multiple reads from the underlying stream. Reads up to a
-        buffer's worth of data if size is negative.
-
-        Returns b'' if the file is at EOF.
-        """
-        with self._lock:
-            self._check_can_read()
-            if size < 0:
-                size = io.DEFAULT_BUFFER_SIZE
-            return self._buffer.read1(size)
-
-    def readinto(self, b):
-        """Read bytes into b.
-
-        Returns the number of bytes read (0 for EOF).
-        """
-        with self._lock:
-            self._check_can_read()
-            return self._buffer.readinto(b)
-
-    def readline(self, size=-1):
-        """Read a line of uncompressed bytes from the file.
-
-        The terminating newline (if present) is retained. If size is
-        non-negative, no more than size bytes will be read (in which
-        case the line may be incomplete). Returns b'' if already at EOF.
-        """
-        if not isinstance(size, int):
-            if not hasattr(size, "__index__"):
-                raise TypeError("Integer argument expected")
-            size = size.__index__()
-        with self._lock:
-            self._check_can_read()
-            return self._buffer.readline(size)
-
-    def readlines(self, size=-1):
-        """Read a list of lines of uncompressed bytes from the file.
-
-        size can be specified to control the number of lines read: no
-        further lines will be read once the total size of the lines read
-        so far equals or exceeds size.
-        """
-        if not isinstance(size, int):
-            if not hasattr(size, "__index__"):
-                raise TypeError("Integer argument expected")
-            size = size.__index__()
-        with self._lock:
-            self._check_can_read()
-            return self._buffer.readlines(size)
-
-    def write(self, data):
-        """Write a byte string to the file.
-
-        Returns the number of uncompressed bytes written, which is
-        always len(data). Note that due to buffering, the file on disk
-        may not reflect the data written until close() is called.
-        """
-        with self._lock:
-            self._check_can_write()
-            compressed = self._compressor.compress(data)
-            self._fp.write(compressed)
-            self._pos += len(data)
-            return len(data)
-
-    def writelines(self, seq):
-        """Write a sequence of byte strings to the file.
-
-        Returns the number of uncompressed bytes written.
-        seq can be any iterable yielding byte strings.
-
-        Line separators are not added between the written byte strings.
-        """
-        with self._lock:
-            return _compression.BaseStream.writelines(self, seq)
-
-    def seek(self, offset, whence=io.SEEK_SET):
-        """Change the file position.
-
-        The new position is specified by offset, relative to the
-        position indicated by whence. Values for whence are:
-
-            0: start of stream (default); offset must not be negative
-            1: current stream position
-            2: end of stream; offset must not be positive
-
-        Returns the new file position.
-
-        Note that seeking is emulated, so depending on the parameters,
-        this operation may be extremely slow.
-        """
-        with self._lock:
-            self._check_can_seek()
-            return self._buffer.seek(offset, whence)
-
-    def tell(self):
-        """Return the current file position."""
-        with self._lock:
-            self._check_not_closed()
-            if self._mode == _MODE_READ:
-                return self._buffer.tell()
-            return self._pos
-
-
-def open(filename, mode="rb", compresslevel=9,
-         encoding=None, errors=None, newline=None):
-    """Open a bzip2-compressed file in binary or text mode.
-
-    The filename argument can be an actual filename (a str, bytes, or
-    PathLike object), or an existing file object to read from or write
-    to.
-
-    The mode argument can be "r", "rb", "w", "wb", "x", "xb", "a" or
-    "ab" for binary mode, or "rt", "wt", "xt" or "at" for text mode.
-    The default mode is "rb", and the default compresslevel is 9.
-
-    For binary mode, this function is equivalent to the BZ2File
-    constructor: BZ2File(filename, mode, compresslevel). In this case,
-    the encoding, errors and newline arguments must not be provided.
-
-    For text mode, a BZ2File object is created, and wrapped in an
-    io.TextIOWrapper instance with the specified encoding, error
-    handling behavior, and line ending(s).
-
-    """
-    if "t" in mode:
-        if "b" in mode:
-            raise ValueError("Invalid mode: %r" % (mode,))
-    else:
-        if encoding is not None:
-            raise ValueError("Argument 'encoding' not supported in binary mode")
-        if errors is not None:
-            raise ValueError("Argument 'errors' not supported in binary mode")
-        if newline is not None:
-            raise ValueError("Argument 'newline' not supported in binary mode")
-
-    bz_mode = mode.replace("t", "")
-    binary_file = BZ2File(filename, bz_mode, compresslevel=compresslevel)
-
-    if "t" in mode:
-        return io.TextIOWrapper(binary_file, encoding, errors, newline)
-    else:
-        return binary_file
-
-
-def compress(data, compresslevel=9):
-    """Compress a block of data.
-
-    compresslevel, if given, must be a number between 1 and 9.
-
-    For incremental compression, use a BZ2Compressor object instead.
-    """
-    comp = BZ2Compressor(compresslevel)
-    return comp.compress(data) + comp.flush()
-
-
-def decompress(data):
-    """Decompress a block of data.
-
-    For incremental decompression, use a BZ2Decompressor object instead.
-    """
-    results = []
-    while data:
-        decomp = BZ2Decompressor()
-        try:
-            res = decomp.decompress(data)
-        except OSError:
-            if results:
-                break  # Leftover data is not a valid bzip2 stream; ignore it.
-            else:
-                raise  # Error on the first iteration; bail out.
-        results.append(res)
-        if not decomp.eof:
-            raise ValueError("Compressed data ended before the "
-                             "end-of-stream marker was reached")
-        data = decomp.unused_data
-    return b"".join(results)
diff --git a/modules/language/python/module/#difflib.py# b/modules/language/python/module/#difflib.py#
deleted file mode 100644 (file)
index a808007..0000000
+++ /dev/null
@@ -1,212 +0,0 @@
-module(difflib)
-
-"""
-Module difflib -- helpers for computing deltas between objects.
-
-Function get_close_matches(word, possibilities, n=3, cutoff=0.6):
-    Use SequenceMatcher to return list of the best "good enough" matches.
-
-Function context_diff(a, b):
-    For two lists of strings, return a delta in context diff format.
-
-Function ndiff(a, b):
-    Return a delta: the difference between `a` and `b` (lists of strings).
-
-Function restore(delta, which):
-    Return one of the two sequences that generated an ndiff delta.
-
-Function unified_diff(a, b):
-    For two lists of strings, return a delta in unified diff format.
-
-Class SequenceMatcher:
-    A flexible class for comparing pairs of sequences of any type.
-
-Class Differ:
-    For producing human-readable deltas from sequences of lines of text.
-
-Class HtmlDiff:
-    For producing HTML side by side comparison with change highlights.
-"""
-
-__all__ = ['get_close_matches', 'ndiff', 'restore', 'SequenceMatcher',
-           'Differ','IS_CHARACTER_JUNK', 'IS_LINE_JUNK', 'context_diff',
-           'unified_diff', 'diff_bytes', 'HtmlDiff', 'Match']
-
-from heapq import nlargest as _nlargest
-from collections import namedtuple as _namedtuple
-
-Match = _namedtuple('Match', 'a b size')
-
-def _calculate_ratio(matches, length):
-    if length:
-        return 2.0 * matches / length
-    return 1.0
-
-class SequenceMatcher:
-
-    """
-    SequenceMatcher is a flexible class for comparing pairs of sequences of
-    any type, so long as the sequence elements are hashable.  The basic
-    algorithm predates, and is a little fancier than, an algorithm
-    published in the late 1980's by Ratcliff and Obershelp under the
-    hyperbolic name "gestalt pattern matching".  The basic idea is to find
-    the longest contiguous matching subsequence that contains no "junk"
-    elements (R-O doesn't address junk).  The same idea is then applied
-    recursively to the pieces of the sequences to the left and to the right
-    of the matching subsequence.  This does not yield minimal edit
-    sequences, but does tend to yield matches that "look right" to people.
-
-    SequenceMatcher tries to compute a "human-friendly diff" between two
-    sequences.  Unlike e.g. UNIX(tm) diff, the fundamental notion is the
-    longest *contiguous* & junk-free matching subsequence.  That's what
-    catches peoples' eyes.  The Windows(tm) windiff has another interesting
-    notion, pairing up elements that appear uniquely in each sequence.
-    That, and the method here, appear to yield more intuitive difference
-    reports than does diff.  This method appears to be the least vulnerable
-    to synching up on blocks of "junk lines", though (like blank lines in
-    ordinary text files, or maybe "<P>" lines in HTML files).  That may be
-    because this is the only method of the 3 that has a *concept* of
-    "junk" <wink>.
-
-    Example, comparing two strings, and considering blanks to be "junk":
-
-    >>> s = SequenceMatcher(lambda x: x == " ",
-    ...                     "private Thread currentThread;",
-    ...                     "private volatile Thread currentThread;")
-    >>>
-
-    .ratio() returns a float in [0, 1], measuring the "similarity" of the
-    sequences.  As a rule of thumb, a .ratio() value over 0.6 means the
-    sequences are close matches:
-
-    >>> print(round(s.ratio(), 3))
-    0.866
-    >>>
-
-    If you're only interested in where the sequences match,
-    .get_matching_blocks() is handy:
-
-    >>> for block in s.get_matching_blocks():
-    ...     print("a[%d] and b[%d] match for %d elements" % block)
-    a[0] and b[0] match for 8 elements
-    a[8] and b[17] match for 21 elements
-    a[29] and b[38] match for 0 elements
-
-    Note that the last tuple returned by .get_matching_blocks() is always a
-    dummy, (len(a), len(b), 0), and this is the only case in which the last
-    tuple element (number of elements matched) is 0.
-
-    If you want to know how to change the first sequence into the second,
-    use .get_opcodes():
-
-    >>> for opcode in s.get_opcodes():
-    ...     print("%6s a[%d:%d] b[%d:%d]" % opcode)
-     equal a[0:8] b[0:8]
-    insert a[8:8] b[8:17]
-     equal a[8:29] b[17:38]
-
-    See the Differ class for a fancy human-friendly file differencer, which
-    uses SequenceMatcher both to compare sequences of lines, and to compare
-    sequences of characters within similar (near-matching) lines.
-
-    See also function get_close_matches() in this module, which shows how
-    simple code building on SequenceMatcher can be used to do useful work.
-
-    Timing:  Basic R-O is cubic time worst case and quadratic time expected
-    case.  SequenceMatcher is quadratic time for the worst case and has
-    expected-case behavior dependent in a complicated way on how many
-    elements the sequences have in common; best case time is linear.
-
-    Methods:
-
-    __init__(isjunk=None, a='', b='')
-        Construct a SequenceMatcher.
-
-    set_seqs(a, b)
-        Set the two sequences to be compared.
-
-    set_seq1(a)
-        Set the first sequence to be compared.
-
-    set_seq2(b)
-        Set the second sequence to be compared.
-
-    find_longest_match(alo, ahi, blo, bhi)
-        Find longest matching block in a[alo:ahi] and b[blo:bhi].
-
-    get_matching_blocks()
-        Return list of triples describing matching subsequences.
-
-    get_opcodes()
-        Return list of 5-tuples describing how to turn a into b.
-
-    ratio()
-        Return a measure of the sequences' similarity (float in [0,1]).
-
-    quick_ratio()
-        Return an upper bound on .ratio() relatively quickly.
-
-    real_quick_ratio()
-        Return an upper bound on ratio() very quickly.
-    """
-
-    def __init__(self, isjunk=None, a='', b='', autojunk=True):
-        """Construct a SequenceMatcher.
-
-        Optional arg isjunk is None (the default), or a one-argument
-        function that takes a sequence element and returns true iff the
-        element is junk.  None is equivalent to passing "lambda x: 0", i.e.
-        no elements are considered to be junk.  For example, pass
-            lambda x: x in " \\t"
-        if you're comparing lines as sequences of characters, and don't
-        want to synch up on blanks or hard tabs.
-
-        Optional arg a is the first of two sequences to be compared.  By
-        default, an empty string.  The elements of a must be hashable.  See
-        also .set_seqs() and .set_seq1().
-
-        Optional arg b is the second of two sequences to be compared.  By
-        default, an empty string.  The elements of b must be hashable. See
-        also .set_seqs() and .set_seq2().
-
-        Optional arg autojunk should be set to False to disable the
-        "automatic junk heuristic" that treats popular elements as junk
-        (see module documentation for more information).
-        """
-
-        # Members:
-        # a
-        #      first sequence
-        # b
-        #      second sequence; differences are computed as "what do
-        #      we need to do to 'a' to change it into 'b'?"
-        # b2j
-        #      for x in b, b2j[x] is a list of the indices (into b)
-        #      at which x appears; junk and popular elements do not appear
-        # fullbcount
-        #      for x in b, fullbcount[x] == the number of times x
-        #      appears in b; only materialized if really needed (used
-        #      only for computing quick_ratio())
-        # matching_blocks
-        #      a list of (i, j, k) triples, where a[i:i+k] == b[j:j+k];
-        #      ascending & non-overlapping in i and in j; terminated by
-        #      a dummy (len(a), len(b), 0) sentinel
-        # opcodes
-        #      a list of (tag, i1, i2, j1, j2) tuples, where tag is
-        #      one of
-        #          'replace'   a[i1:i2] should be replaced by b[j1:j2]
-        #          'delete'    a[i1:i2] should be deleted
-        #          'insert'    b[j1:j2] should be inserted
-        #          'equal'     a[i1:i2] == b[j1:j2]
-        # isjunk
-        #      a user-supplied function taking a sequence element and
-        #      returning true iff the element is "junk" -- this has
-        #      subtle but helpful effects on the algorithm, which I'll
-        #      get around to writing up someday <0.9 wink>.
-        #      DON'T USE!  Only __chain_b uses this.  Use "in self.bjunk".
-        # bjunk
-        #      the items in b for which isjunk is True.
-        # bpopular
-        #      nonjunk items in b treated as junk by the heuristic (if used).
-
-
diff --git a/modules/language/python/module/#json.py# b/modules/language/python/module/#json.py#
deleted file mode 100644 (file)
index 93a7b1c..0000000
+++ /dev/null
@@ -1,369 +0,0 @@
-module(json)
-
-r"""JSON (JavaScript Object Notation) <http://json.org> is a subset of
-JavaScript syntax (ECMA-262 3rd edition) used as a lightweight data
-interchange format.
-
-:mod:`json` exposes an API familiar to users of the standard library
-:mod:`marshal` and :mod:`pickle` modules.  It is derived from a
-version of the externally maintained simplejson library.
-
-Encoding basic Python object hierarchies::
-
-    >>> import json
-    >>> json.dumps(['foo', {'bar': ('baz', None, 1.0, 2)}])
-    '["foo", {"bar": ["baz", null, 1.0, 2]}]'
-    >>> print(json.dumps("\"foo\bar"))
-    "\"foo\bar"
-    >>> print(json.dumps('\u1234'))
-    "\u1234"
-    >>> print(json.dumps('\\'))
-    "\\"
-    >>> print(json.dumps({"c": 0, "b": 0, "a": 0}, sort_keys=True))
-    {"a": 0, "b": 0, "c": 0}
-    >>> from io import StringIO
-    >>> io = StringIO()
-    >>> json.dump(['streaming API'], io)
-    >>> io.getvalue()
-    '["streaming API"]'
-
-Compact encoding::
-
-    >>> import json
-    >>> from collections import OrderedDict
-    >>> mydict = OrderedDict([('4', 5), ('6', 7)])
-    >>> json.dumps([1,2,3,mydict], separators=(',', ':'))
-    '[1,2,3,{"4":5,"6":7}]'
-
-Pretty printing::
-
-    >>> import json
-    >>> print(json.dumps({'4': 5, '6': 7}, sort_keys=True, indent=4))
-    {
-        "4": 5,
-        "6": 7
-    }
-
-Decoding JSON::
-
-    >>> import json
-    >>> obj = ['foo', {'bar': ['baz', None, 1.0, 2]}]
-    >>> json.loads('["foo", {"bar":["baz", null, 1.0, 2]}]') == obj
-    True
-    >>> json.loads('"\\"foo\\bar"') == '"foo\x08ar'
-    True
-    >>> from io import StringIO
-    >>> io = StringIO('["streaming API"]')
-    >>> json.load(io)[0] == 'streaming API'
-    True
-
-Specializing JSON object decoding::
-
-    >>> import json
-    >>> def as_complex(dct):
-    ...     if '__complex__' in dct:
-    ...         return complex(dct['real'], dct['imag'])
-    ...     return dct
-    ...
-    >>> json.loads('{"__complex__": true, "real": 1, "imag": 2}',
-    ...     object_hook=as_complex)
-    (1+2j)
-    >>> from decimal import Decimal
-    >>> json.loads('1.1', parse_float=Decimal) == Decimal('1.1')
-    True
-
-Specializing JSON object encoding::
-
-    >>> import json
-    >>> def encode_complex(obj):
-    ...     if isinstance(obj, complex):
-    ...         return [obj.real, obj.imag]
-    ...     raise TypeError(repr(obj) + " is not JSON serializable")
-    ...
-    >>> json.dumps(2 + 1j, default=encode_complex)
-    '[2.0, 1.0]'
-    >>> json.JSONEncoder(default=encode_complex).encode(2 + 1j)
-    '[2.0, 1.0]'
-    >>> ''.join(json.JSONEncoder(default=encode_complex).iterencode(2 + 1j))
-    '[2.0, 1.0]'
-
-
-Using json.tool from the shell to validate and pretty-print::
-
-    $ echo '{"json":"obj"}' | python -m json.tool
-    {
-        "json": "obj"
-    }
-    $ echo '{ 1.2:3.4}' | python -m json.tool
-    Expecting property name enclosed in double quotes: line 1 column 3 (char 2)
-"""
-__version__ = '2.0.9'
-__all__ = [
-    'dump', 'dumps', 'load', 'loads',
-    'JSONDecoder', 'JSONDecodeError', 'JSONEncoder',
-]
-
-__author__ = 'Bob Ippolito <bob@redivi.com>'
-
-from json.decoder import JSONDecoder, JSONDecodeError
-from json.encoder import JSONEncoder
-import codecs
-
-_default_encoder = JSONEncoder(
-    skipkeys=False,
-    ensure_ascii=True,
-    check_circular=True,
-    allow_nan=True,
-    indent=None,
-    separators=None,
-    default=None,
-)
-
-def dump(obj, fp, *, skipkeys=False, ensure_ascii=True, check_circular=True,
-        allow_nan=True, cls=None, indent=None, separators=None,
-        default=None, sort_keys=False, **kw):
-    """Serialize ``obj`` as a JSON formatted stream to ``fp`` (a
-    ``.write()``-supporting file-like object).
-
-    If ``skipkeys`` is true then ``dict`` keys that are not basic types
-    (``str``, ``int``, ``float``, ``bool``, ``None``) will be skipped
-    instead of raising a ``TypeError``.
-
-    If ``ensure_ascii`` is false, then the strings written to ``fp`` can
-    contain non-ASCII characters if they appear in strings contained in
-    ``obj``. Otherwise, all such characters are escaped in JSON strings.
-
-    If ``check_circular`` is false, then the circular reference check
-    for container types will be skipped and a circular reference will
-    result in an ``OverflowError`` (or worse).
-
-    If ``allow_nan`` is false, then it will be a ``ValueError`` to
-    serialize out of range ``float`` values (``nan``, ``inf``, ``-inf``)
-    in strict compliance of the JSON specification, instead of using the
-    JavaScript equivalents (``NaN``, ``Infinity``, ``-Infinity``).
-
-    If ``indent`` is a non-negative integer, then JSON array elements and
-    object members will be pretty-printed with that indent level. An indent
-    level of 0 will only insert newlines. ``None`` is the most compact
-    representation.
-
-    If specified, ``separators`` should be an ``(item_separator, key_separator)``
-    tuple.  The default is ``(', ', ': ')`` if *indent* is ``None`` and
-    ``(',', ': ')`` otherwise.  To get the most compact JSON representation,
-    you should specify ``(',', ':')`` to eliminate whitespace.
-
-    ``default(obj)`` is a function that should return a serializable version
-    of obj or raise TypeError. The default simply raises TypeError.
-
-    If *sort_keys* is true (default: ``False``), then the output of
-    dictionaries will be sorted by key.
-
-    To use a custom ``JSONEncoder`` subclass (e.g. one that overrides the
-    ``.default()`` method to serialize additional types), specify it with
-    the ``cls`` kwarg; otherwise ``JSONEncoder`` is used.
-
-    """
-    # cached encoder
-    if (not skipkeys and ensure_ascii and
-        check_circular and allow_nan and
-        cls is None and indent is None and separators is None and
-        default is None and not sort_keys and not kw):
-        iterable = _default_encoder.iterencode(obj)
-    else:
-        if cls is None:
-            cls = JSONEncoder
-        iterable = cls(skipkeys=skipkeys, ensure_ascii=ensure_ascii,
-            check_circular=check_circular, allow_nan=allow_nan, indent=indent,
-            separators=separators,
-            default=default, sort_keys=sort_keys, **kw).iterencode(obj)
-    # could accelerate with writelines in some versions of Python, at
-    # a debuggability cost
-    for chunk in iterable:
-        fp.write(chunk)
-
-
-def dumps(obj, *, skipkeys=False, ensure_ascii=True, check_circular=True,
-        allow_nan=True, cls=None, indent=None, separators=None,
-        default=None, sort_keys=False, **kw):
-    """Serialize ``obj`` to a JSON formatted ``str``.
-
-    If ``skipkeys`` is true then ``dict`` keys that are not basic types
-    (``str``, ``int``, ``float``, ``bool``, ``None``) will be skipped
-    instead of raising a ``TypeError``.
-
-    If ``ensure_ascii`` is false, then the return value can contain non-ASCII
-    characters if they appear in strings contained in ``obj``. Otherwise, all
-    such characters are escaped in JSON strings.
-
-    If ``check_circular`` is false, then the circular reference check
-    for container types will be skipped and a circular reference will
-    result in an ``OverflowError`` (or worse).
-
-    If ``allow_nan`` is false, then it will be a ``ValueError`` to
-    serialize out of range ``float`` values (``nan``, ``inf``, ``-inf``) in
-    strict compliance of the JSON specification, instead of using the
-    JavaScript equivalents (``NaN``, ``Infinity``, ``-Infinity``).
-
-    If ``indent`` is a non-negative integer, then JSON array elements and
-    object members will be pretty-printed with that indent level. An indent
-    level of 0 will only insert newlines. ``None`` is the most compact
-    representation.
-
-    If specified, ``separators`` should be an ``(item_separator, key_separator)``
-    tuple.  The default is ``(', ', ': ')`` if *indent* is ``None`` and
-    ``(',', ': ')`` otherwise.  To get the most compact JSON representation,
-    you should specify ``(',', ':')`` to eliminate whitespace.
-
-    ``default(obj)`` is a function that should return a serializable version
-    of obj or raise TypeError. The default simply raises TypeError.
-
-    If *sort_keys* is true (default: ``False``), then the output of
-    dictionaries will be sorted by key.
-
-    To use a custom ``JSONEncoder`` subclass (e.g. one that overrides the
-    ``.default()`` method to serialize additional types), specify it with
-    the ``cls`` kwarg; otherwise ``JSONEncoder`` is used.
-
-    """
-    # cached encoder
-    if (not skipkeys and ensure_ascii and
-        check_circular and allow_nan and
-        cls is None and indent is None and separators is None and
-        default is None and not sort_keys and not kw):
-        return _default_encoder.encode(obj)
-    if cls is None:
-        cls = JSONEncoder
-    return cls(
-        skipkeys=skipkeys, ensure_ascii=ensure_ascii,
-        check_circular=check_circular, allow_nan=allow_nan, indent=indent,
-        separators=separators, default=default, sort_keys=sort_keys,
-        **kw).encode(obj)
-
-
-_default_decoder = JSONDecoder(object_hook=None, object_pairs_hook=None)
-
-
-def detect_encoding(b):
-    bstartswith = b.startswith
-    if bstartswith((codecs.BOM_UTF32_BE, codecs.BOM_UTF32_LE)):
-        return 'utf-32'
-    if bstartswith((codecs.BOM_UTF16_BE, codecs.BOM_UTF16_LE)):
-        return 'utf-16'
-    if bstartswith(codecs.BOM_UTF8):
-        return 'utf-8-sig'
-
-    if len(b) >= 4:
-        if not b[0]:
-            # 00 00 -- -- - utf-32-be
-            # 00 XX -- -- - utf-16-be
-            return 'utf-16-be' if b[1] else 'utf-32-be'
-        if not b[1]:
-            # XX 00 00 00 - utf-32-le
-            # XX 00 00 XX - utf-16-le
-            # XX 00 XX -- - utf-16-le
-            return 'utf-16-le' if b[2] or b[3] else 'utf-32-le'
-    elif len(b) == 2:
-        if not b[0]:
-            # 00 XX - utf-16-be
-            return 'utf-16-be'
-        if not b[1]:
-            # XX 00 - utf-16-le
-            return 'utf-16-le'
-    # default
-    return 'utf-8'
-
-
-def load(fp, *, cls=None, object_hook=None, parse_float=None,
-        parse_int=None, parse_constant=None, object_pairs_hook=None, **kw):
-    """Deserialize ``fp`` (a ``.read()``-supporting file-like object containing
-    a JSON document) to a Python object.
-
-    ``object_hook`` is an optional function that will be called with the
-    result of any object literal decode (a ``dict``). The return value of
-    ``object_hook`` will be used instead of the ``dict``. This feature
-    can be used to implement custom decoders (e.g. JSON-RPC class hinting).
-
-    ``object_pairs_hook`` is an optional function that will be called with the
-    result of any object literal decoded with an ordered list of pairs.  The
-    return value of ``object_pairs_hook`` will be used instead of the ``dict``.
-    This feature can be used to implement custom decoders that rely on the
-    order that the key and value pairs are decoded (for example,
-    collections.OrderedDict will remember the order of insertion). If
-    ``object_hook`` is also defined, the ``object_pairs_hook`` takes priority.
-
-    To use a custom ``JSONDecoder`` subclass, specify it with the ``cls``
-    kwarg; otherwise ``JSONDecoder`` is used.
-
-    """
-    return loads(fp.read(),
-        cls=cls, object_hook=object_hook,
-        parse_float=parse_float, parse_int=parse_int,
-        parse_constant=parse_constant, object_pairs_hook=object_pairs_hook, **kw)
-
-
-def loads(s, *, encoding=None, cls=None, object_hook=None, parse_float=None,
-        parse_int=None, parse_constant=None, object_pairs_hook=None, **kw):
-    """Deserialize ``s`` (a ``str``, ``bytes`` or ``bytearray`` instance
-    containing a JSON document) to a Python object.
-
-    ``object_hook`` is an optional function that will be called with the
-    result of any object literal decode (a ``dict``). The return value of
-    ``object_hook`` will be used instead of the ``dict``. This feature
-    can be used to implement custom decoders (e.g. JSON-RPC class hinting).
-
-    ``object_pairs_hook`` is an optional function that will be called with the
-    result of any object literal decoded with an ordered list of pairs.  The
-    return value of ``object_pairs_hook`` will be used instead of the ``dict``.
-    This feature can be used to implement custom decoders that rely on the
-    order that the key and value pairs are decoded (for example,
-    collections.OrderedDict will remember the order of insertion). If
-    ``object_hook`` is also defined, the ``object_pairs_hook`` takes priority.
-
-    ``parse_float``, if specified, will be called with the string
-    of every JSON float to be decoded. By default this is equivalent to
-    float(num_str). This can be used to use another datatype or parser
-    for JSON floats (e.g. decimal.Decimal).
-
-    ``parse_int``, if specified, will be called with the string
-    of every JSON int to be decoded. By default this is equivalent to
-    int(num_str). This can be used to use another datatype or parser
-    for JSON integers (e.g. float).
-
-    ``parse_constant``, if specified, will be called with one of the
-    following strings: -Infinity, Infinity, NaN.
-    This can be used to raise an exception if invalid JSON numbers
-    are encountered.
-
-    To use a custom ``JSONDecoder`` subclass, specify it with the ``cls``
-    kwarg; otherwise ``JSONDecoder`` is used.
-
-    The ``encoding`` argument is ignored and deprecated.
-
-    """
-    if isinstance(s, str):
-        if s.startswith('\ufeff'):
-            raise JSONDecodeError("Unexpected UTF-8 BOM (decode using utf-8-sig)",
-                                  s, 0)
-    else:
-        if not isinstance(s, (bytes, bytearray)):
-            raise TypeError('the JSON object must be str, bytes or bytearray, '
-                            'not {!r}'.format(s.__class__.__name__))
-        s = s.decode(detect_encoding(s), 'surrogatepass')
-
-    if (cls is None and object_hook is None and
-            parse_int is None and parse_float is None and
-            parse_constant is None and object_pairs_hook is None and not kw):
-        return _default_decoder.decode(s)
-    if cls is None:
-        cls = JSONDecoder
-    if object_hook is not None:
-        kw['object_hook'] = object_hook
-    if object_pairs_hook is not None:
-        kw['object_pairs_hook'] = object_pairs_hook
-    if parse_float is not None:
-        kw['parse_float'] = parse_float
-    if parse_int is not None:
-        kw['parse_int'] = parse_int
-    if parse_constant is not None:
-        kw['parse_constant'] = parse_constant
-    return cls(**kw).decode(s)
diff --git a/modules/language/python/module/#string.scm# b/modules/language/python/module/#string.scm#
deleted file mode 100644 (file)
index 3255d99..0000000
+++ /dev/null
@@ -1,411 +0,0 @@
-(define-module (language python module string)
-  #:use-module (oop pf-objects)
-  #:use-module (oop goops)
-  #:use-module (ice-9 match)
-  #:use-module (language python number)
-  #:use-module (language python exceptions)
-  #:use-module (language python yield)
-  #:use-module (language python list)
-  #:use-module (language python for)
-  #:use-module (language python def)
-  #:use-module (language python string)
-  #:use-module (language python bytes)
-  #:use-module ((parser stis-parser) #:select (*whitespace* f-n f-m))
-  #:use-module (parser stis-parser lang python3 tool)
-  #:export (Formatter ascii_letters digits hexdigits))
-
-(define digits        "0123456789")
-(define ascii_letters "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ")
-(define hexdigits     "0123456789abcdefABCDEF")
-
-(define (repr x) ((@ (guile) format) #f "~a" x))
-(define int (mk-token (f+ (f-reg! "[0-9]")) string->number))
-(define id  (mk-token (f-seq (f-reg! "[_a-zA-Z]")
-                             (f* (f-reg! "[_0-9a-zA-Z]")))))
-(define str (mk-token (f+ (f-not! (f-char #\[)))))
-
-(define conversion (mk-token (f-reg "[rsa]")))
-
-(define fill      (mk-token (f-reg! ".")))
-(define align     (mk-token (f-reg! "[<>=^]")))
-(define sign      (mk-token (f-reg! "[-+ ]")))
-(define width     int)
-(define precision int)
-(define type      (mk-token (f-reg! "[bcdeEfFgGnosxX%]")))
-(define formatSpec
-  (f-list
-   (gg? (f-list #:align (gg? fill) align))
-   (gg? sign)
-   (gg? (mk-token (f-tag! "#")))
-   (gg? (mk-token (f-tag! "0")))
-   (gg? width)
-   (gg? (mk-token (f-tag ",")))
-   (gg? (f-seq "." precision))
-   (gg? type)))
-
-(define (get-align s align width sign)
-  (define widthq (- width (len sign)))
-  (define (f s a l)
-    (match a
-      ("<" (apply py-ljust  (+ sign s) width l))
-      (">" (apply py-rjust  (+ sign s) width l))
-      ("^" (apply py-center (+ sign s) width l))
-      ("=" (+ sign (apply py-rjust s widthq l)))))
-     
-  (match align
-    (#f
-     (f s "<" '()))
-    ((_ #f a)
-     (f s a '()))
-    ((_ fill a)
-     (f s a (list fill)))))
-
-(define (convert-string format-str s)
-  (match (with-fluids ((*whitespace* f-true))
-           (stis-parse format-str (f-seq formatSpec f-eof)))
-    ((align sign sharp zero width comma rec type)
-     (if width
-         (get-align s align width "")
-         s))
-    (_ (raise (ValueError (+ "wrong format " format-str))))))
-
-(set! (@@ (language python string) format)
-      (lambda (f s)
-       (py-format s f)))
-
-(define (gen-sign s sign)
-  (let lp ((sign sign))
-    (match sign
-      (#f  (lp "-"))
-      ("+" (if (< s 0)
-               (values (- s) "-")
-               (values s     "+")))
-      ("-" (if (< s 0)
-               (values (- s) "-")
-               (values s     "")))
-      (" " (if (< s 0)
-               (values (- s) "-")
-               (values s     " "))))))
-
-(define (convert-float s format-str)
-  (match (with-fluids ((*whitespace* f-true))
-           (stis-parse format-str (f-seq formatSpec f-eof)))
-    ((align sign sharp zero width comma prec type)
-     (call-with-values (lambda () (gen-sign s sign))                         
-       (lambda (s s-sign)
-         (let* ((prec (if prec prec 6))
-                (s    (let lp ((type type))
-                        (match type
-                          (#f (lp "g"))
-                          
-                          ("f"
-                           (format #f (+ "~," (number->string prec) "f") s))
-                          
-                          ("F"
-                           (let ((s (format #f (+ "~," (number->string prec)
-                                                  "f")
-                                            s)))
-                             (py-replace
-                              (py-replace s "nan" "NAN")
-                              "inf" "INF")))
-
-                          ("e"
-                           (py-replace
-                            (format #f (+ "~," (number->string prec) "e") s)
-                            "E" "e"))
-
-                          ("E"
-                           (format #f (+ "~," (number->string prec) "e") s))
-                          
-                          ("g"
-                           (let ((exp (log10 (abs s))))
-                             (if (and (<= -4  exp)
-                                      (<= exp (max 1 prec)))
-                                 (lp "f")
-                                 (lp "e"))))
-                          ("G"
-                           (let ((exp (log10 (abs s))))
-                             (if (and (<= -4  exp)
-                                      (<= exp (max 1 prec)))
-                                 (lp "F")
-                                 (lp "E"))))
-                          ("n"
-                           (let ((exp (log10 (abs s))))
-                             (if (and (<= -4  exp)
-                                      (<= exp (max 1 prec)))
-                                 (lp "f")
-                                 (format #f (+ "~," (number->string prec) "h")
-                                         s))))
-
-                          ("%"
-                           (set s (* s 100))
-                           (+ (lp "f") "%"))))))
-                
-           (if width
-               (if zero
-                   (get-align s '(#:align "0" "=") width
-                              s-sign)
-                   (get-align s align width
-                              s-sign))
-                          
-               (+ s-sign s))))))))
-
-(define (convert-complex s format-str)
-  (match (with-fluids ((*whitespace* f-true))
-           (stis-parse format-str (f-seq formatSpec f-eof)))
-    ((align sign sharp zero width comma prec type)
-     (let* ((prec (if prec prec 6))
-            (s    (let lp ((type type))
-                    (match type
-                      (#f (lp "f"))
-                      ("f"
-                       (format #f (+ "~," (number->string prec) "i") s))))))
-       (if width
-           (get-align s align width "")
-           s)))))
-                
-                        
-(define-method (py-format (s <real>) f)
-  (convert-float s f))
-(define-method (py-format (s <py-float>) f)
-  (convert-float s f))
-
-(define-method (py-format (s <complex>) f)
-  (convert-complex s f))
-(define-method (py-format (s <py-complex>) f)
-  (convert-complex s f))
-
-                        
-                         
-                        
-         
-(define (convert-integer s format-str)
-  (match (with-fluids ((*whitespace* f-true))
-           (stis-parse format-str (f-seq formatSpec f-eof)))
-    ((align sign sharp zero width comma prec type)
-     (call-with-values (lambda () (gen-sign s sign))                         
-       (lambda (s s-sign)
-         (let ((prefix (if sharp
-                           (match type
-                             ("b" "0b")
-                             ("x" "0x")
-                             ("X" "0X")
-                             ("o" "0o")
-                             ("d"  "")
-                             (#f  ""))
-                           ""))
-               (s (let lp ((type type))
-                    (match type
-                      ("b"
-                       (if comma
-                           (format #f "~:b"       s)
-                           (format #f "~b"        s)))
-                      ("x"
-                       (if comma
-                           (format #f "~:x"      s)
-                           (format #f "~x"       s)))
-                      ("X"
-                       (if comma
-                           (format #f "~:@(~:x~)" s)
-                           (format #f "~:@(~x~)"  s)))
-                      ("o"
-                       (if comma
-                           (format #f "~:o"      s)
-                           (format #f "~o"       s)))
-                      ("d"
-                       (if comma
-                           (format #f "~:d" s)
-                           (format #f "~d" s)))
-                      (#f
-                       (lp "d"))))))
-           (if width
-               (if zero
-                   (get-align s '(#:align "0" "=") width
-                              (+ s-sign prefix))
-                   (get-align (+ prefix s) align width
-                              s-sign))
-               
-               (+ s-sign prefix s))))))))
-
-(define-method (py-format (s <integer>) f)
-  (convert-integer s f))
-
-(define-method (py-format (o <py-int>) f)
-  (convert-integer (slot-ref o 'x) f))
-
-(define argName (f-or! id int))
-(define attributeName id)
-(define elementIndex  (f-or! int str))
-
-(define fieldName
-  (f-cons argName (ff* (f-or! (f-list #:attr "." attributeName)
-                              (f-list #:elem "[" elementIndex "]")))))
-
-(define (replField fieldName1)
-  (f-list
-   #:field
-   (ff?                      fieldName1             None)
-   (ff? (f-seq "!" (mk-token (f-scope conversion))) None)
-   (ff? (f-seq ":" (mk-token (f-scope formatSpec))) None)))
-(define (tag fieldName1)
-  (f-seq (f-tag "{") (replField fieldName1) (f-tag "}")))
-
-(define nontag  (f-list #:str
-                        (mk-token (f+
-                                   (f-or!
-                                    (f-tag! "{{")
-                                    (f-not! (tag (mk-token
-                                                  (f-scope
-                                                   fieldName)))))))))
-
-(define e       (f-seq (ff* (f-or! (tag (mk-token (f-scope fieldName)))
-                                   nontag))
-                       f-eof))
-
-(set! (@@ (parser stis-parser lang python3-parser) f-formatter) tag)
-
-(define mk-gen
-  (make-generator (l)
-    (lambda (yield l)
-      (let lp ((u l) (i 0))
-        (match u
-          (()
-           (yield "" None None None))
-          (((#:str str))
-           (yield str None None None))
-          (((#:field a b c))
-           (if (eq? a None)
-               (yield "" (number->string i) c b)
-               (yield "" a b c)))
-          (((#:field a b c) . u)
-           (if (eq? a None)
-               (begin
-                 (yield "" (number->string i) c b)
-                 (lp u (+ i 1)))
-               (begin
-                 (yield "" a b c)
-                 (lp u i))))
-          (((#:str s) (#:field a b c) . u)
-           (if (eq? a None)
-               (begin
-                 (yield s (number->string i) c b)
-                 (lp u (+ i 1)))
-               (begin
-                 (yield s a c b)
-                 (lp u i)))))))))
-     
-(define (f-parse str)
-  (let ((l (with-fluids ((*whitespace* f-true))
-             (parse str e))))
-    (mk-gen l)))        
-
-(define stis-parse parse)
-
-(define-python-class Formatter ()
-  (define format
-    (lam (self format_string (* args) (** kwargs))
-         ((ref self 'vformat) format_string args kwargs)))
-
-  (define vformat2
-    (lambda (self fn2 co fo)
-      (if (and (eq? fo None) (eq? co None))
-          ((ref self 'convert_field)  fn2 "r")
-          (let ((fn3 (if (eq? co None)
-                         fn2
-                         ((ref self 'convert_field)
-                          fn2 co))))
-            (if (eq? fo None)
-                fn3
-                ((ref self 'format_field ) fn3 fo))))))
-  
-  (define vformat1
-    (lambda (self s fn fo co ss args kwargs)
-      (if (eq? fn None)
-          (cons s ss)
-          (let* ((fn2 ((ref self 'get_field    ) fn args kwargs))
-                 (fn3 (if (and (eq? fo None) (eq? co None))
-                          ((ref self 'convert_field)  fn2 "r")
-                          (let ((fn3 (if (eq? co None)
-                                         fn2
-                                         ((ref self 'convert_field)
-                                          fn2 co))))
-                            (if (eq? fo None)
-                                fn3
-                                ((ref self 'format_field )
-                                 fn3 fo))))))
-            (cons* fn3 s ss)))))
-      
-  (define vformat
-    (lambda (self format_string args kwargs)
-      (set self '_args '())
-      (for ((s fn fo co : ((ref self 'parse) format_string))) ((ss '("")))
-           (vformat1 self s fn fo co ss args kwargs)
-           #:final
-           (begin
-             ((ref self 'check_unused_args) (ref self '_args) args kwargs)
-             (apply string-append (reverse ss))))))
-
-  (define parse
-    (lambda (self format_string)
-      (f-parse format_string)))
-  
-  (define get_field
-    (lambda (self field_name args kwargs)
-      (match (with-fluids ((*whitespace* f-true))
-               (stis-parse field_name fieldName))
-        ((key a ...)
-         (set self '_args (cons key (ref self '_args)))
-         (let ((f ((ref self 'get_value) key args kwargs)))
-           (let lp ((a a) (f f))
-             (match a
-               (((#:ref r) . l)
-                (lp l (ref f (string->symbol r))))
-               (((#:elem k) . l)
-                (lp l (pylist-ref f k)))
-               (()
-                f)))))
-        (_
-         (throw (TypeError (+ "wrong field name format" field_name)))))))
-
-  (define get_value
-    (lambda (self key args kwargs)
-      (set self '__args (cons key args))
-      (if (integer? key)
-          (pylist-ref args   key)
-          (pylist-ref kwargs key))))
-  
-  (define check_unused_args
-    (lambda (self used_args args kwargs)
-      (let ((n (len args)))
-        (let lp ((i 0))
-          (if (< i n)
-              (if (member i used_args)
-                  (lp (+ i 1))
-                  (warn "unused arg" i)))))
-      (for ((k v : kwargs)) ()
-           (if (not (member k used_args))
-               (warn "unused arg" k)))))
-            
-
-  (define format_field
-    (lambda (self value format_spec)
-      (py-format value format_spec)))
-  
-  (define convert_field
-    (lambda (self value conversion)
-      (cond
-       ((equal? conversion "s")
-        (str value))
-       ((equal? conversion "r")
-        (repr value))
-       ((equal? conversion "a")
-        (ascii value))
-       (else
-        (throw (TypeError (+ "conversion " conversion))))))))
-
-(define (ascii x) (bytes x))
-
-(define formatter (Formatter))
-(set! (@@ (language python string)  formatter) formatter)
-(set! (@@ (language python compile) formatter) (ref formatter 'vformat2))
diff --git a/modules/language/python/module/#textwrap.py# b/modules/language/python/module/#textwrap.py#
deleted file mode 100644 (file)
index 150e3f9..0000000
+++ /dev/null
@@ -1,479 +0,0 @@
-module(textwrap)
-
-"""Text wrapping and filling.
-"""
-
-# Copyright (C) 1999-2001 Gregory P. Ward.
-# Copyright (C) 2002, 2003 Python Software Foundation.
-# Written by Greg Ward <gward@python.net>
-
-import re
-
-__all__ = ['wrap', 'TextWrapper', 'fill', 'dedent', 'indent', 'shorten']
-
-# Hardcode the recognized whitespace characters to the US-ASCII
-# whitespace characters.  The main reason for doing this is that
-# some Unicode spaces (like \u00a0) are non-breaking whitespaces.
-_whitespace = '\t\n\x0b\x0c\r '
-
-
-class TextWrapper:
-    """
-    Object for wrapping/filling text.  The public interface consists of
-    the wrap() and fill() methods; the other methods are just there for
-    subclasses to override in order to tweak the default behaviour.
-    If you want to completely replace the main wrapping algorithm,
-    you'll probably have to override _wrap_chunks().
-
-    Several instance attributes control various aspects of wrapping:
-      width (default: 70)
-        the maximum width of wrapped lines (unless break_long_words
-        is false)
-      initial_indent (default: "")
-        string that will be prepended to the first line of wrapped
-        output.  Counts towards the line's width.
-      subsequent_indent (default: "")
-        string that will be prepended to all lines save the first
-        of wrapped output; also counts towards each line's width.
-      expand_tabs (default: true)
-        Expand tabs in input text to spaces before further processing.
-        Each tab will become 0 .. 'tabsize' spaces, depending on its position
-        in its line.  If false, each tab is treated as a single character.
-      tabsize (default: 8)
-        Expand tabs in input text to 0 .. 'tabsize' spaces, unless
-        'expand_tabs' is false.
-      replace_whitespace (default: true)
-        Replace all whitespace characters in the input text by spaces
-        after tab expansion.  Note that if expand_tabs is false and
-        replace_whitespace is true, every tab will be converted to a
-        single space!
-      fix_sentence_endings (default: false)
-        Ensure that sentence-ending punctuation is always followed
-        by two spaces.  Off by default because the algorithm is
-        (unavoidably) imperfect.
-      break_long_words (default: true)
-        Break words longer than 'width'.  If false, those words will not
-        be broken, and some lines might be longer than 'width'.
-      break_on_hyphens (default: true)
-        Allow breaking hyphenated words. If true, wrapping will occur
-        preferably on whitespaces and right after hyphens part of
-        compound words.
-      drop_whitespace (default: true)
-        Drop leading and trailing whitespace from lines.
-      max_lines (default: None)
-        Truncate wrapped lines.
-      placeholder (default: ' [...]')
-        Append to the last line of truncated text.
-    """
-
-    unicode_whitespace_trans = {}
-    uspace = ord(' ')
-    for x in _whitespace:
-        unicode_whitespace_trans[ord(x)] = uspace
-
-    # This funky little regex is just the trick for splitting
-    # text up into word-wrappable chunks.  E.g.
-    #   "Hello there -- you goof-ball, use the -b option!"
-    # splits into
-    #   Hello/ /there/ /--/ /you/ /goof-/ball,/ /use/ /the/ /-b/ /option!
-    # (after stripping out empty strings).
-    word_punct = r'[\w!"\'&.,?]'
-    letter = r'[^\d\W]'
-    whitespace = r'[%s]' % re.escape(_whitespace)
-    nowhitespace = '[^' + whitespace[1:]
-    wordsep_re = re.compile(r'''
-        ( # any whitespace
-          %(ws)s+
-        | # em-dash between words
-          (?<=%(wp)s) -{2,} (?=\w)
-        | # word, possibly hyphenated
-          %(nws)s+? (?:
-            # hyphenated word
-              -(?: (?<=%(lt)s{2}-) | (?<=%(lt)s-%(lt)s-))
-              (?= %(lt)s -? %(lt)s)
-            | # end of word
-              (?=%(ws)s|\Z)
-            | # em-dash
-              (?<=%(wp)s) (?=-{2,}\w)
-            )
-        )''' % {'wp': word_punct, 'lt': letter,
-                'ws': whitespace, 'nws': nowhitespace},
-        re.VERBOSE)
-    del word_punct, letter, nowhitespace
-
-    # This less funky little regex just split on recognized spaces. E.g.
-    #   "Hello there -- you goof-ball, use the -b option!"
-    # splits into
-    #   Hello/ /there/ /--/ /you/ /goof-ball,/ /use/ /the/ /-b/ /option!/
-    wordsep_simple_re = re.compile(r'(%s+)' % whitespace)
-    del whitespace
-
-    # XXX this is not locale- or charset-aware -- string.lowercase
-    # is US-ASCII only (and therefore English-only)
-    sentence_end_re = re.compile(r'[a-z]'             # lowercase letter
-                                 r'[\.\!\?]'          # sentence-ending punct.
-                                 r'[\"\']?'           # optional end-of-quote
-                                 r'\Z')               # end of chunk
-
-    def __init__(self,
-                 width=70,
-                 initial_indent="",
-                 subsequent_indent="",
-                 expand_tabs=True,
-                 replace_whitespace=True,
-                 fix_sentence_endings=False,
-                 break_long_words=True,
-                 drop_whitespace=True,
-                 break_on_hyphens=True,
-                 tabsize=8,
-                 *,
-                 max_lines=None,
-                 placeholder=' [...]'):
-        self.width = width
-        self.initial_indent = initial_indent
-        self.subsequent_indent = subsequent_indent
-        self.expand_tabs = expand_tabs
-        self.replace_whitespace = replace_whitespace
-        self.fix_sentence_endings = fix_sentence_endings
-        self.break_long_words = break_long_words
-        self.drop_whitespace = drop_whitespace
-        self.break_on_hyphens = break_on_hyphens
-        self.tabsize = tabsize
-        self.max_lines = max_lines
-        self.placeholder = placeholder
-
-
-    # -- Private methods -----------------------------------------------
-    # (possibly useful for subclasses to override)
-
-    def _munge_whitespace(self, text):
-        """_munge_whitespace(text : string) -> string
-
-        Munge whitespace in text: expand tabs and convert all other
-        whitespace characters to spaces.  Eg. " foo\\tbar\\n\\nbaz"
-        becomes " foo    bar  baz".
-        """
-        if self.expand_tabs:
-            text = text.expandtabs(self.tabsize)
-        if self.replace_whitespace:
-            text = text.translate(self.unicode_whitespace_trans)
-        return text
-
-
-    def _split(self, text):
-        """_split(text : string) -> [string]
-
-        Split the text to wrap into indivisible chunks.  Chunks are
-        not quite the same as words; see _wrap_chunks() for full
-        details.  As an example, the text
-          Look, goof-ball -- use the -b option!
-        breaks into the following chunks:
-          'Look,', ' ', 'goof-', 'ball', ' ', '--', ' ',
-          'use', ' ', 'the', ' ', '-b', ' ', 'option!'
-        if break_on_hyphens is True, or in:
-          'Look,', ' ', 'goof-ball', ' ', '--', ' ',
-          'use', ' ', 'the', ' ', '-b', ' ', option!'
-        otherwise.
-        """
-        if self.break_on_hyphens is True:
-            chunks = self.wordsep_re.split(text)
-        else:
-            chunks = self.wordsep_simple_re.split(text)
-        chunks = [c for c in chunks if c]
-        return chunks
-
-    def _fix_sentence_endings(self, chunks):
-        """_fix_sentence_endings(chunks : [string])
-
-        Correct for sentence endings buried in 'chunks'.  Eg. when the
-        original text contains "... foo.\\nBar ...", munge_whitespace()
-        and split() will convert that to [..., "foo.", " ", "Bar", ...]
-        which has one too few spaces; this method simply changes the one
-        space to two.
-        """
-        i = 0
-        patsearch = self.sentence_end_re.search
-        while i < len(chunks)-1:
-            if chunks[i+1] == " " and patsearch(chunks[i]):
-                chunks[i+1] = "  "
-                i += 2
-            else:
-                i += 1
-
-    def _handle_long_word(self, reversed_chunks, cur_line, cur_len, width):
-        """_handle_long_word(chunks : [string],
-                             cur_line : [string],
-                             cur_len : int, width : int)
-
-        Handle a chunk of text (most likely a word, not whitespace) that
-        is too long to fit in any line.
-        """
-        # Figure out when indent is larger than the specified width, and make
-        # sure at least one character is stripped off on every pass
-        if width < 1:
-            space_left = 1
-        else:
-            space_left = width - cur_len
-
-        # If we're allowed to break long words, then do so: put as much
-        # of the next chunk onto the current line as will fit.
-        if self.break_long_words:
-            cur_line.append(reversed_chunks[-1][:space_left])
-            reversed_chunks[-1] = reversed_chunks[-1][space_left:]
-
-        # Otherwise, we have to preserve the long word intact.  Only add
-        # it to the current line if there's nothing already there --
-        # that minimizes how much we violate the width constraint.
-        elif not cur_line:
-            cur_line.append(reversed_chunks.pop())
-
-        # If we're not allowed to break long words, and there's already
-        # text on the current line, do nothing.  Next time through the
-        # main loop of _wrap_chunks(), we'll wind up here again, but
-        # cur_len will be zero, so the next line will be entirely
-        # devoted to the long word that we can't handle right now.
-
-    def _wrap_chunks(self, chunks):
-        """_wrap_chunks(chunks : [string]) -> [string]
-
-        Wrap a sequence of text chunks and return a list of lines of
-        length 'self.width' or less.  (If 'break_long_words' is false,
-        some lines may be longer than this.)  Chunks correspond roughly
-        to words and the whitespace between them: each chunk is
-        indivisible (modulo 'break_long_words'), but a line break can
-        come between any two chunks.  Chunks should not have internal
-        whitespace; ie. a chunk is either all whitespace or a "word".
-        Whitespace chunks will be removed from the beginning and end of
-        lines, but apart from that whitespace is preserved.
-        """
-        lines = []
-        if self.width <= 0:
-            raise ValueError("invalid width %r (must be > 0)" % self.width)
-        if self.max_lines is not None:
-            if self.max_lines > 1:
-                indent = self.subsequent_indent
-            else:
-                indent = self.initial_indent
-            if len(indent) + len(self.placeholder.lstrip()) > self.width:
-                raise ValueError("placeholder too large for max width")
-
-        # Arrange in reverse order so items can be efficiently popped
-        # from a stack of chucks.
-        chunks.reverse()
-
-        while chunks:
-            # Start the list of chunks that will make up the current line.
-            # cur_len is just the length of all the chunks in cur_line.
-            cur_line = []
-            cur_len = 0
-
-            # Figure out which static string will prefix this line.
-            if lines:
-                indent = self.subsequent_indent
-            else:
-                indent = self.initial_indent
-
-            # Maximum width for this line.
-            width = self.width - len(indent)
-
-            # First chunk on line is whitespace -- drop it, unless this
-            # is the very beginning of the text (ie. no lines started yet).
-            if self.drop_whitespace and chunks[-1].strip() == '' and lines:
-                del chunks[-1]
-
-            while chunks:
-                l = len(chunks[-1])
-
-                # Can at least squeeze this chunk onto the current line.
-                if cur_len + l <= width:
-                    cur_line.append(chunks.pop())
-                    cur_len += l
-
-                # Nope, this line is full.
-                else:
-                    break
-
-            # The current line is full, and the next chunk is too big to
-            # fit on *any* line (not just this one).
-            if chunks and len(chunks[-1]) > width:
-                self._handle_long_word(chunks, cur_line, cur_len, width)
-                cur_len = sum(map(len, cur_line))
-
-            # If the last chunk on this line is all whitespace, drop it.
-            if self.drop_whitespace and cur_line and cur_line[-1].strip() == '':
-                cur_len -= len(cur_line[-1])
-                del cur_line[-1]
-
-            if cur_line:
-                if (self.max_lines is None or
-                    len(lines) + 1 < self.max_lines or
-                    (not chunks or
-                     self.drop_whitespace and
-                     len(chunks) == 1 and
-                     not chunks[0].strip()) and cur_len <= width):
-                    # Convert current line back to a string and store it in
-                    # list of all lines (return value).
-                    lines.append(indent + ''.join(cur_line))
-                else:
-                    while cur_line:
-                        if (cur_line[-1].strip() and
-                            cur_len + len(self.placeholder) <= width):
-                            cur_line.append(self.placeholder)
-                            lines.append(indent + ''.join(cur_line))
-                            break
-                        cur_len -= len(cur_line[-1])
-                        del cur_line[-1]
-                    else:
-                        if lines:
-                            prev_line = lines[-1].rstrip()
-                            if (len(prev_line) + len(self.placeholder) <=
-                                    self.width):
-                                lines[-1] = prev_line + self.placeholder
-                                break
-                        lines.append(indent + self.placeholder.lstrip())
-                    break
-        return lines
-
-    def _split_chunks(self, text):
-        text = self._munge_whitespace(text)
-        return self._split(text)
-
-    # -- Public interface ----------------------------------------------
-
-    def wrap(self, text):
-        """wrap(text : string) -> [string]
-
-        Reformat the single paragraph in 'text' so it fits in lines of
-        no more than 'self.width' columns, and return a list of wrapped
-        lines.  Tabs in 'text' are expanded with string.expandtabs(),
-        and all other whitespace characters (including newline) are
-        converted to space.
-        """
-        chunks = self._split_chunks(text)
-
-        if self.fix_sentence_endings:
-            self._fix_sentence_endings(chunks)
-
-        return self._wrap_chunks(chunks)
-
-    def fill(self, text):
-        """fill(text : string) -> string
-
-        Reformat the single paragraph in 'text' to fit in lines of no
-        more than 'self.width' columns, and return a new string
-        containing the entire wrapped paragraph.
-        """
-        return "\n".join(self.wrap(text))
-
-# -- Convenience interface ---------------------------------------------
-
-def wrap(text, width=70, **kwargs):
-    """Wrap a single paragraph of text, returning a list of wrapped lines.
-
-    Reformat the single paragraph in 'text' so it fits in lines of no
-    more than 'width' columns, and return a list of wrapped lines.  By
-    default, tabs in 'text' are expanded with string.expandtabs(), and
-    all other whitespace characters (including newline) are converted to
-    space.  See TextWrapper class for available keyword args to customize
-    wrapping behaviour.
-    """
-    w = TextWrapper(width=width, **kwargs)
-    return w.wrap(text)
-
-def fill(text, width=70, **kwargs):
-    """Fill a single paragraph of text, returning a new string.
-
-    Reformat the single paragraph in 'text' to fit in lines of no more
-    than 'width' columns, and return a new string containing the entire
-    wrapped paragraph.  As with wrap(), tabs are expanded and other
-    whitespace characters converted to space.  See TextWrapper class for
-    available keyword args to customize wrapping behaviour.
-    """
-    w = TextWrapper(width=width, **kwargs)
-    return w.fill(text)
-
-def shorten(text, width, **kwargs):
-    """Collapse and truncate the given text to fit in the given width.
-
-    The text first has its whitespace collapsed.  If it then fits in
-    the *width*, it is returned as is.  Otherwise, as many words
-    as possible are joined and then the placeholder is appended::
-
-        >>> textwrap.shorten("Hello  world!", width=12)
-        'Hello world!'
-        >>> textwrap.shorten("Hello  world!", width=11)
-        'Hello [...]'
-    """
-    w = TextWrapper(width=width, max_lines=1, **kwargs)
-    return w.fill(' '.join(text.strip().split()))
-
-# -- Loosely related functionality -------------------------------------
-
-_whitespace_only_re = re.compile('^[ \t]+$', re.MULTILINE)
-_leading_whitespace_re = re.compile('(^[ \t]*)(?:[^ \t\n])', re.MULTILINE)
-
-def dedent(text):
-    """Remove any common leading whitespace from every line in `text`.
-
-    This can be used to make triple-quoted strings line up with the left
-    edge of the display, while still presenting them in the source code
-    in indented form.
-
-    Note that tabs and spaces are both treated as whitespace, but they
-    are not equal: the lines "  hello" and "\\thello" are
-    considered to have no common leading whitespace.  (This behaviour is
-    new in Python 2.5; older versions of this module incorrectly
-    expanded tabs before searching for common leading whitespace.)
-    """
-    # Look for the longest leading string of spaces and tabs common to
-    # all lines.
-    margin = None
-    text = _whitespace_only_re.sub('', text)
-    indents = _leading_whitespace_re.findall(text)
-
-    for indent in indents:
-        if margin is None:
-            margin = indent
-        
-        # Current line more deeply indented than previous winner:
-        # no change (previous winner is still on top).
-        elif indent.startswith(margin):
-            pass
-        
-        # Current line consistent with and no deeper than previous winner:
-        # it's the new winner.
-        elif margin.startswith(indent):
-            margin = indent
-        
-        
-        # Find the largest common whitespace between current line and previous
-        # winner.
-        else:
-            for i, (x, y) in enumerate(zip(margin, indent)):
-                if x != y:
-                    margin = margin[:i]
-                    break
-            else:
-                margin = margin[:len(indent)]
-    
-    if margin:
-        text = re.sub(r'(?m)^' + margin, '', text)
-    return text
-
-
-def indent(text, prefix, predicate=None):
-    """Adds 'prefix' to the beginning of selected lines in 'text'.
-
-    If 'predicate' is provided, 'prefix' will only be added to the lines
-    where 'predicate(line)' is True. If 'predicate' is not provided,
-    it will default to adding 'prefix' to all non-empty lines that do not
-    consist solely of whitespace characters.
-    """
-    if predicate is None:
-        def predicate(line):
-            return line.strip()
-
-    def prefixed_lines():
-        for line in text.splitlines(True):
-            yield (prefix + line if predicate(line) else line)
-    return ''.join(prefixed_lines())
diff --git a/modules/language/python/module/xml.py~ b/modules/language/python/module/xml.py~
deleted file mode 100644 (file)
index bf6d8dd..0000000
+++ /dev/null
@@ -1,20 +0,0 @@
-"""Core XML support for Python.
-
-This package contains four sub-packages:
-
-dom -- The W3C Document Object Model.  This supports DOM Level 1 +
-       Namespaces.
-
-parsers -- Python wrappers for XML parsers (currently only supports Expat).
-
-sax -- The Simple API for XML, developed by XML-Dev, led by David
-       Megginson and ported to Python by Lars Marius Garshol.  This
-       supports the SAX 2 API.
-
-etree -- The ElementTree XML library.  This is a subset of the full
-       ElementTree XML release.
-
-"""
-
-
-__all__ = ["dom", "parsers", "sax", "etree"]
diff --git a/modules/language/python/persist.go b/modules/language/python/persist.go
deleted file mode 100644 (file)
index 736e41b..0000000
Binary files a/modules/language/python/persist.go and /dev/null differ
diff --git a/modules/language/python/try.go b/modules/language/python/try.go
deleted file mode 100644 (file)
index 24f385f..0000000
Binary files a/modules/language/python/try.go and /dev/null differ
diff --git a/modules/language/python/tuple.go b/modules/language/python/tuple.go
deleted file mode 100644 (file)
index deb3ce7..0000000
Binary files a/modules/language/python/tuple.go and /dev/null differ
diff --git a/modules/language/python/with.go b/modules/language/python/with.go
deleted file mode 100644 (file)
index 3525896..0000000
Binary files a/modules/language/python/with.go and /dev/null differ
diff --git a/modules/language/python/yield.go b/modules/language/python/yield.go
deleted file mode 100644 (file)
index 16fe75f..0000000
Binary files a/modules/language/python/yield.go and /dev/null differ
diff --git a/modules/oop/#a# b/modules/oop/#a#
deleted file mode 100644 (file)
index aec1575..0000000
+++ /dev/null
@@ -1,2 +0,0 @@
-#<<applicable-struct-class> type 560f4ada9630>
-#<<applicable-struct-class> type 560f4ada9630>
\ No newline at end of file
diff --git a/modules/oop/pf-objects.go b/modules/oop/pf-objects.go
deleted file mode 100644 (file)
index ad26a63..0000000
Binary files a/modules/oop/pf-objects.go and /dev/null differ
diff --git a/modules/oop/pf-objects.scm.bak b/modules/oop/pf-objects.scm.bak
deleted file mode 100644 (file)
index 8946c59..0000000
+++ /dev/null
@@ -1,1072 +0,0 @@
-(define-module (oop pf-objects)
-  #:use-module (oop goops)
-  #:use-module (ice-9 vlist)
-  #:use-module (ice-9 match)
-<<<<<<< HEAD
-  #:use-module (system base message)
-  #:use-module (language python guilemod)
-=======
-  #:use-module (ice-9 pretty-print)
->>>>>>> d71244f5cb87a4a61a6b341e4838a38e50142815
-  #:use-module (logic guile-log persistance)
-  #:replace (equal?)  
-  #:export (set ref make-p <p> <py> <pf> <pyf> <property>
-                call with copy fset fcall put put!
-                pcall pcall! get fset-x pyclass?                
-                def-p-class   mk-p-class   make-p-class
-                define-python-class get-type py-class
-                object-method class-method static-method
-                py-super-mac py-super py-equal? 
-                *class* *self* pyobject? pytype?
-                type object pylist-set! pylist-ref tr
-               resolve-method rawref rawset
-                ))
-
-#|
-Python object system is basically syntactic suger otop of a hashmap and one
-this project is inspired by the python object system and what it measn when
-one in stead of hasmaps use functional hashmaps. We use vhashes, but those have a drawback in that those are not thread safe. But it is a small effort to work
-with assocs or tree like functional hashmaps in stead.
-
-The hashmap works like an assoc e.g. we will define new values by 'consing' a
-new binding on the list and when the assoc take up too much space it will be
-reshaped and all extra bindings will be removed.
-
-The datastructure is functional but the objects mutate. So one need to 
-explicitly tell it to not update etc.
-|#
-
-(define fail (cons 'fail '()))
-
-(define-syntax-rule (kif it p x y)
-  (let ((it p))
-    (if (eq? it fail)
-       y
-       x)))
-
-(define-method (pylist-set! (o <hashtable>) key val)
-  (hash-set! o key val))
-
-(define-method (pylist-ref (o <hashtable>) key)
-  (kif it (hash-ref o key fail)
-       it
-       (error "IndexError")))
-
-(define (is-acl? a b) (member a (cons b (class-subclasses b))))
-
-(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
-(define-class <p>  (<applicable-struct> <object>) h)
-(define-class <pf> (<p>) size n)         ; the pf object consist of a functional
-                                         ; hashmap it's size and number of live
-                                         ; object
-(define-class <py>  (<p>))
-(define-class <pyf> (<pf>))
-
-(define-class <property> () get set del)
-
-(name-object <p>)
-(name-object <pf>)
-(name-object <py>)
-(name-object <pyf>)
-(name-object <property>)
-
-(define (resolve-method-g g pattern)
-  (define (mmatch p pp)
-    (if (eq? pp '_)
-       '()
-       (match (cons p pp)
-         (((p . ps) . (pp . pps))
-          (if (eq? pp '_)
-              (mmatch ps pps)
-              (if (is-a? p pp)
-                  (cons p (mmatch ps pps))
-                  #f)))
-         ((() . ())
-          '())
-         (_
-          #f))))
-
-  (define (q< x y)
-    (let lp ((x x) (y y))
-      (match (cons x y)
-       (((x . xs) . (y . ys))
-        (and (is-a? x y)
-             (lp xs ys)))
-       (_ #t))))
-  
-  (let ((l
-        (let lp ((ms (generic-function-methods g)))
-          (if (pair? ms)
-              (let* ((m (car ms))
-                     (p (method-specializers m))
-                     (f (method-generic-function m)))
-                (aif it (mmatch p pattern)
-                    (cons (cons it f) (lp (cdr ms)))
-                    (lp (cdr ms))))
-              '()))))
-    
-    
-    (cdr (car (sort l q<)))))
-
-(define (resolve-method-o o pattern)
-  (resolve-method-g (class-of o) pattern))
-  
-(define (get-dict self name parents)
-  (aif it (ref self '__prepare__)
-       (it self name parents)
-       (make-hash-table)))
-
-(define (hashforeach a b) (values))
-
-(define (new-class meta name parents dict kw)
-  (aif it (ref meta '__new__)
-       (apply it name parents dict kw)
-       (let* ((goops (pylist-ref dict '__goops__))
-              (p     (kwclass->class kw meta))
-              (class (make-p p)))
-        (slot-set! class 'procedure
-                    (lambda x
-                      (create-object class meta goops x)))
-         (if (hash-table? dict)
-             (hash-for-each
-              (lambda (k v) k (set class k v))
-              dict)
-             (hashforeach
-              (lambda (k v) k (set class k v))
-              dict))
-         (let((mro (ref class '__mro__)))
-           (if (pair? mro)
-               (let ((p (car mro)))
-                 (aif it (ref p '__init_subclass__)
-                      (apply it class #f kw)
-                      #f))))
-         (set class '__mro__ (cons class (ref class '__mro__)))
-         class)))
-
-(define (type- meta name parents dict keys)
-  (let ((class (new-class meta name parents dict keys)))
-    (aif it (ref meta '__init__)
-         (it name parents dict keys)
-         #f)
-    class))
-
-(define (create-class meta name parents gen-methods . keys)
-  (let ((dict (gen-methods (get-dict meta name keys))))
-    (aif it (ref meta '__class__)
-         (aif it (find-in-class (ref meta '__class__) '__call__ #f)
-              (apply (it meta 'class) name parents dict keys)
-              (type- meta name parents dict keys))
-         (type- meta name parents dict keys))))
-
-(define (create-object class meta goops x)
-  (with-fluids ((*make-class* #t))
-    (aif it #f ;(ref meta '__call__)
-       (apply it x)       
-       (let ((obj (aif it (find-in-class class '__new__ #f)
-                       ((it class 'object))
-                       (make-object class meta goops))))        
-         (aif it (ref obj '__init__)
-              (apply it x)
-              #f)
-         (slot-set! obj 'procedure
-                    (lambda x
-                      (aif it (ref obj '__call__)
-                           (apply it x)
-                           (error "not a callable object"))))
-         obj))))
-
-(define (make-object class meta goops)
-  (let ((obj (make-p goops)))
-    (set obj '__class__ class)
-    obj))
-
-;; Make an empty pf object
-(define (make-p <x>)
-  (let ((r (make <x>)))
-    (cond
-     ((is-a? r <pf>)
-      (slot-set! r 'h vlist-null)
-      (slot-set! r 'size 0)
-      (slot-set! r 'n 0))
-     ((is-a? r <p>)
-      (slot-set! r 'h (make-hash-table)))
-     (else
-      (error "make-p in pf-objects need a <p> or <pf> derived class got ~a"
-             r)))
-    r))
-
-
-(define-syntax-rule (hif it (k h) x y)
-  (let ((a (vhash-assq k h)))
-    (if (pair? a)
-        (let ((it (cdr a)))
-          x)
-        y)))
-
-(define-syntax-rule (cif (it h) (k cl) x y)
-  (let* ((h (slot-ref cl 'h))
-         (a (vhash-assq k h)))
-    (if (pair? a)
-        (let ((it (cdr a)))
-          x)
-        y)))
-
-(define-syntax-rule (mrefx x key l)
-  (let ()
-    (define (end)
-      (if (null? l)
-          #f
-          (car l)))
-
-    (define (parents li)
-      (let lp ((li li))
-        (if (pair? li)
-            (let ((p (car li)))
-              (cif (it h) (key p)
-                   it
-                  (lp (cdr li))))
-            fail)))
-  
-    (cif (it h) (key x)
-         it
-         (hif cl ('__class__ h)
-              (cif (it h) (key cl)
-                   it
-                   (hif p ('__mro__ h)
-                        (let ((r (parents p)))
-                          (if (eq? r fail)
-                              (end)
-                              r))
-                        (end)))
-              (end)))))
-
-(define *refkind* (make-fluid 'object))
-
-(define-method (find-in-class (klass <p>) key fail)
-  (hash-ref (slot-ref klass 'h) key fail))
-
-(define-method (find-in-class (klass <pf>) key fail)
-  (let ((r (vhash-assoc key (slot-ref klass 'h))))
-    (if r
-       (cdr r)
-       fail)))
-
-(define-syntax-rule (find-in-class-and-parents klass key fail)
-  (kif r (find-in-class klass key fail)
-       r
-       (aif parents (find-in-class klass '__mro__ #f)
-           (let lp ((parents parents))
-             (if (pair? parents)
-                 (kif r (find-in-class (car parents) key fail)
-                      r
-                      (lp (cdr parents)))
-                 fail))
-           fail)))
-
-(define-syntax-rule (mrefx klass key l)
-  (let ()
-    (define (end) (if (pair? l) (car l) #f))
-    (fluid-set! *refkind* 'object)
-    (kif it (find-in-class klass key fail)
-        it
-        (begin
-          (fluid-set! *refkind* 'class)
-          (aif klass (find-in-class klass '__class__ #f)
-               (kif it (find-in-class-and-parents klass key fail)
-                    it
-                    (end))
-               (end))))))
-
-(define not-implemented (cons 'not 'implemeneted))
-
-(define-syntax-rule (prop-ref xx x)
-  (let ((y xx)
-        (r x))
-      (if (and (is-a? r <property>) (not (pyclass? y)))
-          ((slot-ref r 'get) y)
-          r)))
-
-(define-syntax-rule (mrefx-py x key l)
-  (let ((xx x))
-    (prop-ref
-     xx
-     (let* ((g (mrefx xx '__fget__ '(#t)))
-           (f (if g
-                  (if (eq? g #t)
-                      (aif it (mrefx xx '__getattribute__ '())
-                           (begin
-                             (mset xx '__fget__ it it)
-                             it)
-                           (begin
-                             (if (mc?)
-                                 (mset xx '__fget__ it it))
-                             #f))
-                      g)
-                  #f)))
-       (if (or (not f) (eq? f not-implemented))
-          (mrefx xx key l)
-          (catch #t
-                 (lambda () ((f xx (fluid-ref *refkind*)) key))
-                 (lambda x
-                   (mrefx xx key l))))))))
-
-
-(define-syntax-rule (mref x key l)
-  (let ((xx x))
-    (let ((res (mrefx xx key l)))
-      (if (and (not (struct? res)) (procedure? res))
-         (res xx (fluid-ref *refkind*))
-         res))))
-
-(define-syntax-rule (mref-py x key l)
-  (let ((xx x))
-    (let ((res (mrefx-py xx key l)))
-      (if (and (not (struct? res)) (procedure? res))
-         (res xx (fluid-ref *refkind*))
-         res))))
-
-(define-method (ref x key . l) (if (pair? l) (car l) #f))
-(define-method (ref (x <pf> )  key . l) (mref     x key l))
-(define-method (ref (x <p>  )  key . l) (mref     x key l))
-(define-method (ref (x <pyf>)  key . l) (mref-py  x key l))
-(define-method (ref (x <py> )  key . l) (mref-py  x key l))
-
-(define-method (rawref (x <pf> )  key . l) (mref     x key l))
-(define-method (rawref (x <p>  )  key . l) (mref     x key l))
-
-
-(define-method (set (f <procedure>) key val)
-  (set-procedure-property! f key val))
-
-(define-method (ref (f <procedure>) key . l)
-  (aif it (assoc key (procedure-properties f))
-       (cdr it)
-       (if (pair? l) (car l) #f)))
-
-
-;; the reshape function that will create a fresh new pf object with less size
-;; this is an expensive operation and will only be done when we now there is
-;; a lot to gain essentially tho complexity is as in the number of set
-(define (reshape x)
-  (let ((h (slot-ref x 'h))
-        (m (make-hash-table))
-        (n 0))
-    (define h2 (vhash-fold (lambda (k v s)
-                             (if (hash-ref m k #f)
-                                 s
-                                 (begin
-                                   (hash-set! m k #t)
-                                   (set! n (+ n 1))
-                                   (vhash-consq k v s))))
-                           vlist-null
-                           h))
-    (slot-set! x 'h h2)
-    (slot-set! x 'size n)
-    (slot-set! x 'n    n)
-    (values)))
-
-;; on object x add a binding that key -> val
-(define-method (mset (x <pf>) key rval val)
-  (let ((h (slot-ref x 'h))
-        (s (slot-ref x 'size))
-        (n (slot-ref x 'n)))
-    (slot-set! x 'size (+ 1 s))
-    (let ((r (vhash-assoc key h)))
-      (when (not r)
-        (slot-set! x 'n (+ n 1)))
-      (slot-set! x 'h (vhash-cons key val h))
-      (when (> s (* 2 n))
-        (reshape x))
-      (values))))
-
-(define (pkh h) (hash-for-each (lambda x (pk x)) h) h)
-
-(define-method (mset (x <p>) key rval val)
-  (begin
-    (hash-set! (slot-ref x 'h) key val)
-    (values)))
-
-(define *make-class* (make-fluid #f))
-(define (mc?) (not (fluid-ref *make-class*)))
-
-(define-syntax-rule (mset-py x key rval val)
-  (let* ((xx x)
-        (v  (mref xx key (list fail))))
-    (if (or (eq? v fail)
-           (not (and (is-a? v <property>)
-                     (not (pyclass? xx)))))
-       (let* ((g (mrefx xx '__fset__ '(#t)))
-              (f (if g
-                     (if (eq? g #t)
-                         (aif it (mrefx xx '__setattr__ '())
-                              (begin
-                                (mset xx '__fset__ it it)
-                                it)
-                              (begin
-                                (if (mc?)
-                                    (mset xx '__fset__ it it))
-                                #f))
-                         g)
-                     #f)))
-         (if (or (eq? f not-implemented) (not f))
-             (mset xx key val val)              
-             (catch #t
-               (lambda () ((f xx (fluid-ref *refkind*)) key rval))
-               (lambda x (mset xx key val val)))))
-       ((slot-ref v 'set) xx val))))
-
-(define-syntax-rule (mklam (mset a ...) val)
-  (if (and (procedure? val)
-           (not (pyclass? val))
-           (not (pytype?  val))
-           (if (is-a? val <p>)
-               (ref val '__call__)
-               #t))
-      (if (procedure-property val 'py-special)
-          (mset a ... val val)
-          (mset a ... val (object-method val)))
-      (mset a ... val val)))
-
-(define-method (set (x <pf>)  key val) (mklam (mset     x key) val))
-(define-method (set (x <p>)   key val) (mklam (mset     x key) val))
-(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
-;; the super classes for a binding
-
-;; call a function as a value of key in x with the object otself as a first
-;; parameter, this is pythonic object semantics
-(define-syntax-rule (mk-call mcall mref)
-  (define-syntax-rule (mcall x key l)
-    (apply (mref x key '()) l)))
-
-(mk-call mcall     mref)
-(mk-call mcall-py  mref-py)
-  
-(define-method (call (x <pf>)  key . l) (mcall     x key l))
-(define-method (call (x <p>)   key . l) (mcall     x key l))
-(define-method (call (x <pyf>) key . l) (mcall-py  x key l))
-(define-method (call (x <py>)  key . l) (mcall-py  x key l))
-
-
-;; make a copy of a pf object
-(define-syntax-rule (mcopy x)
-  (let ((r (make-p (ref x '__goops__))))
-    (slot-set! r 'h (slot-ref x 'h))
-    (slot-set! r 'size (slot-ref x 'size))
-    (slot-set! r 'n (slot-ref x 'n))
-    r))
-
-(define-syntax-rule (mcopy- x)
-  (let* ((r (make-p (ref x '__goops__)))
-         (h (slot-ref r 'h)))
-    (hash-for-each (lambda (k v) (hash-set! h k v)) (slot-ref x 'h))
-    r))
-
-(define-method (copy (x <pf>)) (mcopy  x))
-(define-method (copy (x <p> )) (mcopy- x))
-
-;; make a copy of a pf object
-(define-syntax-rule (mtr r x)
-  (begin
-    (slot-set! r 'h    (slot-ref x 'h   ))
-    (slot-set! r 'size (slot-ref x 'size))
-    (slot-set! r 'n    (slot-ref x 'n   ))
-    (values)))
-
-(define-syntax-rule (mtr- r x)
-  (begin
-    (slot-set! r 'h (slot-ref x 'h))
-    (values)))
-  
-
-(define-method (tr (r <pf>) (x <pf>)) (mtr  r x))
-(define-method (tr (r <p> ) (x <p> )) (mtr- r x))
-  
-
-;; with will execute thunk and restor x to it's initial state after it has
-;; finished note that this is a cheap operatoin because we use a functional
-;; datastructure
-(define-syntax-rule (mwith x thunk)
-  (let ((old (mcopy x)))
-    (let ((r (thunk)))
-      (slot-set! x 'h    (slot-ref old 'h))
-      (slot-set! x 'size (slot-ref old 'size))    
-      (slot-set! x 'n    (slot-ref old 'n))
-      r)))
-
-(define-syntax-rule (mwith- x thunk)
-  (let ((old (mcopy- x)))
-    (let ((r (thunk)))
-      (slot-set! x 'h    (slot-ref old 'h))
-      r)))
-
-
-
-;; a functional set will return a new object with the added binding and keep
-;; x untouched
-(define-method (fset (x <pf>) key val)
-  (let ((x (mcopy x)))
-    (mset x key val val)
-    x))
-
-(define-method (fset (x <p>) key val)
-  (let ((x (mcopy- x)))
-    (mset x key val val)
-    x))
-
-(define (fset-x obj l val)
-  (let lp ((obj obj) (l l) (r '()))
-    (match l
-      (()
-       (let lp ((v val) (r r))
-         (if (pair? r)
-             (lp (fset (caar r) (cdar r) v) (cdr r))
-             v)))
-      ((k . l)
-       (lp (ref obj k #f) l (cons (cons obj k) r))))))
-
-
-
-           
-
-;; a functional call will keep x untouched and return (values fknval newx)
-;; e.g. we get both the value of the call and the new version of x with
-;; perhaps new bindings added
-(define-method (fcall (x <pf>) key . l)
-  (let* ((y (mcopy x))
-         (r (mcall y key l)))
-    (if (eq? (slot-ref x 'h) (slot-ref y 'h))
-        (values r x)
-        (values r y))))
-
-(define-method (fcall (x <p>) key . l)
-  (let ((x (mcopy x)))
-    (values (mcall x key l)
-            x)))
-
-;; this shows how we can override addition in a pythonic way
-
-;; lets define get put pcall etc so that we can refer to an object like
-;; e.g. (put x.y.z 1) (pcall x.y 1)
-
-(define-syntax-rule (cross x k f set)
-  (call-with-values (lambda () f)
-    (lambda (r y)
-      (if (eq? x y)
-          (values r x)
-          (values r (set x k y))))))
-
-(define-syntax-rule (cross! x k f _) f)
-
-(define-syntax mku
-  (syntax-rules ()
-    ((_ cross set setx f (key) (val ...))
-     (setx f key val ...))
-    ((_ cross set setx f (k . l) val)
-     (cross f k (mku cross set setx (ref f k) l val) set))))
-
-(define-syntax-rule (mkk pset setx set cross)
-  (define-syntax pset
-    (lambda (x)   
-      (syntax-case x ()
-        ((_ f val (... ...))
-         (let* ((to (lambda (x)
-                      (datum->syntax #'f  (string->symbol x))))
-                (l (string-split (symbol->string (syntax->datum #'f)) #\.)))
-           (with-syntax (((a (... ...)) (map (lambda (x) #`'#,(to x))
-                                             (cdr l)))
-                         (h       (to (car l))))
-             #'(mku cross setx set h (a (... ...)) (val (... ...))))))))))
-
-(mkk put    fset  fset cross)
-(mkk put!   set   set  cross!)
-(mkk pcall! call  fset cross!)
-(mkk pcall  fcall fset cross)
-(mkk get    ref   fset cross!)
-
-;; it's good to have a null object so we don't need to construct it all the
-;; time because it is functional we can get away with this.
-(define null (make-p <pf>))
-
-(define (filter-parents l)
-  (let lp ((l l))
-    (if (pair? l)
-        (if (is-a? (car l) <p>)
-            (cons (car l) (lp (cdr l)))
-            (lp (cdr l)))
-        '())))
-
-(define (kw->class kw meta)
-  (if (memq #:functional kw)
-      (if (memq #:fast kw)
-          <pf>
-          (if (or (not meta) (is-a? meta <pyf>) (is-a? meta <py>))
-              <pyf>
-              <pf>))              
-      (if (memq #:fast kw)
-          (if (or (is-a? meta <pyf>) (is-a? meta <pf>))
-              <pf>
-              <p>)
-          (cond
-           ((is-a? meta <pyf>)
-            <pyf>)
-           ((is-a? meta <py>)
-            <py>)
-           ((is-a? meta <pf>)
-            <pf>)
-           ((is-a? meta <p>)
-            <p>)
-           (else
-            <py>)))))
-           
-
-(define (defaulter d)
-  (if d
-      (cond
-       ((is-a? d <pyf>)
-        <pyf>)
-       ((is-a? d <py>)
-        <py>)
-       ((is-a? d <pf>)
-        <pf>)
-       ((is-a? d <p>)
-        <p>)
-       (else
-        d))
-      <py>))
-
-(define (kwclass->class kw default)
-  (if (memq #:functionalClass kw)
-      (if (memq #:fastClass kw)
-          <pf>
-          (if (memq #:pyClass kw)
-              <pyf>
-              (if (or (is-a? default <py>) (is-a? default <pyf>))
-                  <pyf>
-                  <pf>)))
-      (if (memq #:mutatingClass kw)
-          (if (memq #:fastClass kw)
-              <p>
-              (if (memq #:pyClass kw)
-                  <py>
-                  (if (or (is-a? default <py>) (is-a? default <pyf>))
-                      <py>
-                      <p>)))
-          (if (memq #:fastClass kw)
-              (if (or (is-a? default <pf>) (is-a? default <pyf>))
-                  <pf>
-                  <p>)
-              (if (memq #:pyClass kw)
-                  (if (or (is-a? default <pf>) (is-a? default <pyf>))
-                      <pyf>
-                      <py>)
-                  (defaulter default))))))
-
-(define object #f)
-(define (make-p-class name supers.kw methods)
-  (define kw      (cdr supers.kw))
-  (define supers  (car supers.kw))
-  (define goopses (map (lambda (sups)
-                         (aif it (ref sups '__goops__ #f)
-                              it
-                              sups))
-                       supers))
-  (define parents (let ((p (filter-parents supers)))
-                    (if (null? p)
-                        (if object
-                            (list object)
-                            '())
-                        p)))
-  
-  (define meta (aif it (memq #:metaclass kw)
-                    (car it)
-                    (if (null? parents)
-                        type
-                        (let* ((p   (car parents))
-                               (m   (ref p '__class__))
-                               (mro (reverse (ref m '__mro__))))
-                          (let lp ((l   (cdr parents))
-                                   (max mro)
-                                   (min mro))
-                            (if (pair? l)
-                                (let* ((p    (car l))
-                                       (meta (ref p '__class__))
-                                       (mro  (ref meta '__mro__)))
-                                  (let lp2 ((max max) (mr (reverse mro)))
-                                    (if (and (pair? max) (pair? mr))
-                                        (if (eq? (car max) (car mr))
-                                            (lp2 (cdr max) (cdr mr))
-                                            (error
-                                             "need a common lead for meta"))
-                                        (if (pair? max)
-                                            (if (< (length mro) (length min))
-                                                (lp (cdr l) max mro)
-                                                (lp (cdr l) max min))
-                                            (lp (cdr l) mro min)))))
-                                (car (reverse min))))))))
-  
-  (define goops (make-class (append goopses (list (kw->class kw meta)))
-                            '() #:name name))
-    
-  (define (gen-methods dict)
-    (methods dict)
-    (pylist-set! dict '__goops__   goops)
-    (pylist-set! dict '__class__   meta)
-    (pylist-set! dict '__fget__    #t)
-    (pylist-set! dict '__fset__    #t)
-    (pylist-set! dict '__name__    name)
-    (pylist-set! dict '__parents__ parents)
-    (pylist-set! dict '__class__   meta)
-    (pylist-set! dict '__mro__     (get-mro parents))
-    dict)
-
-  (with-fluids ((*make-class* #t))
-    (create-class meta name parents gen-methods kw)))
-
-
-;; Let's make an object essentially just move a reference
-
-;; the make class and defclass syntactic sugar
-(define-syntax mk-p-class
-  (lambda (x)
-    (syntax-case x ()
-      ((_ name parents (ddef dname dval) ...)
-       (with-syntax (((ddname ...)
-                     (map (lambda (dn)
-                            (datum->syntax
-                             #'name
-                             (string->symbol
-                              (string-append
-                               (symbol->string
-                                (syntax->datum #'name))
-                               "-"
-                               (symbol->string
-                                (syntax->datum dn))))))
-                          #'(dname ...)))
-                    (nname (datum->syntax
-                            #'name
-                            (string->symbol
-                             (string-append
-                              (symbol->string
-                               (syntax->datum #'name))
-                              "-goops-class")))))
-         (%add-to-warn-list (syntax->datum #'nname))
-         (map (lambda (x) (%add-to-warn-list (syntax->datum x)))
-              #'(ddname ...))
-       #'(let ()
-           (define name 
-             (letruc ((dname dval) ...)
-                     (make-p-class 'name
-                                   parents
-                                   (lambda (dict)
-                                     (pylist-set! dict 'dname dname)
-                                     ...
-                                     (values)))))
-
-           (begin
-             (module-define! (current-module) 'ddname (ref name 'dname))
-             (name-object ddname))
-           ...
-
-           (module-define! (current-module) 'nname (ref name '__goops__))
-           (name-object nname)
-           (name-object name)
-           name))))))
-
-(define-syntax-rule (def-p-class name . l)
-  (define name (mk-p-class name . l)))
-
-(define (get-class o)
-  (cond
-   ((is-a? o <p>)
-    o)
-   (else
-    (error "not a pyclass"))))
-
-(define (get-type o)
-  (cond
-   ((is-a? o <pyf>)
-    'pyf)
-   ((is-a? o <py>)
-    'py)
-   ((is-a? o <pf>)
-    'pf)
-   ((is-a? o <p>)
-    'p)
-   (else
-    'none)))
-
-(define (print o l)
-  (define p (if (pyclass? o) "C" (if (pyobject? o) "O" "T")))
-  (define port (if (pair? l) (car l) #t))
-  (format port "~a"
-          (aif it (if (pyclass? o)
-                      #f
-                      (if (pyobject? o)
-                          (ref o '__repr__)
-                          #f))
-               (format
-                #f "~a(~a)<~a>"
-                p (get-type o) (it))
-               (format
-                #f "~a(~a)<~a>"
-                p (get-type o) (ref o '__name__ 'Annonymous)))))
-
-(define-method (write   (o <p>) . l) (print o l))
-(define-method (display (o <p>) . l) (print o l))
-
-(define (arglist->pkw l)
-  (let lp ((l l) (r '()))
-    (if (pair? l)
-        (let ((x (car l)))
-          (if (keyword? x)
-              (cons (reverse r) l)
-              (lp (cdr l) (cons x r))))
-        (cons (reverse r) '()))))
-
-(define-syntax-rule (define-python-class name (parents ...) code ...)
-  (define name (mk-p-class name (arglist->pkw (list parents ...)) code ...)))
-
-
-(define-syntax make-python-class
-  (lambda (x)
-    (syntax-case x ()
-      ((_ name (parents ...) code ...)
-       #'(let* ((cl  (mk-p-class name
-                                (arglist->pkw (list parents ...))
-                                code ...)))
-          cl)))))
-    
-
-(define (kind x)
-  (and (is-a? x <p>)
-       (aif it (find-in-class x '__goops__ #f)
-            (if (is-a? (make it) (ref type '__goops__))
-                'type
-                'class)
-            'object)))
-
-(define (pyobject? x) (eq? (kind x) 'object))
-(define (pyclass?  x) (eq? (kind x) 'class))
-(define (pytype?   x) (eq? (kind x) 'type))
-
-(define (mark-fkn tag f)
-  (set-procedure-property! f 'py-special tag)
-  f)
-
-(define (object-method f)
-  (letrec ((self
-            (mark-fkn 'object
-                      (lambda (x kind)
-                       (if (eq? kind 'object)
-                           f
-                           (lambda z (apply f x z)))))))
-    self))
-
-(define (class-method f)
-  (letrec ((self
-            (mark-fkn 'class
-              (lambda (x kind)
-               (if (eq? kind 'object)
-                   (let ((klass (ref x '__class__)))
-                     (lambda z (apply f klass z)))
-                   (lambda z (apply f x z)))))))
-    self))
-
-(define (static-method f)
-  (letrec ((self
-            (mark-fkn 'static
-                      (lambda (x kind) f))))
-    self))
-
-        
-(define-syntax-parameter
-  *class* (lambda (x) (error "*class* not parameterized")))
-(define-syntax-parameter
-  *self* (lambda (x) (error "*class* not parameterized")))
-
-(define *super* (list 'super))
-
-(define (not-a-super) 'not-a-super)
-(define (py-super class obj)
-  (define (make cl parents)
-    (let ((c (make-p <p>))
-          (o (make-p <p>)))
-      (set c '__super__        #t)
-      (set c '__mro__       parents)
-      (set c '__getattribute__  (lambda (self key . l)
-                                  (aif it (ref c key)
-                                       (if (procedure? it)
-                                           (if (eq? (procedure-property
-                                                     it
-                                                     'py-special)
-                                                    'class)
-                                               (it cl)
-                                               (it obj))
-                                           it)
-                                       (error "no attribute"))))
-      (set o '__class__ c)
-      o))
-  
-  (call-with-values
-      (lambda ()
-        (let lp ((l (ref (ref obj '__class__) '__mro__ '())))
-          (if (pair? l)
-              (if (eq? class (car l))
-                  (let ((r (cdr l)))
-                    (if (pair? r)
-                        (values (car r) r)
-                        (values #f      #f)))
-                  (lp (cdr l)))
-              (values #f #f))))
-    make))
-        
-        
-   
-(define-syntax py-super-mac
-  (syntax-rules ()
-    ((_)
-     (py-super *class* *self*))
-    ((_ class self)
-     (py-super class self))))
-
-(define (pp x)
-  (pretty-print (syntax->datum x))
-  x)
-
-(define-syntax letruc
-  (lambda (x)
-    (syntax-case x ()
-      ((_ ((x v) ...) code ...)
-       (let lp ((a #'(x ...)) (b #'(v ...)) (u '()))
-         (if (pair? a)
-             (let* ((x (car a))
-                    (s (syntax->datum x)))
-               (let lp2 ((a2 (cdr a)) (b2 (cdr b)) (a3 '()) (b3 '())
-                         (r (list (car b))))
-                 (if (pair? a2)
-                     (if (eq? (syntax->datum a2) s)
-                         (lp2 (cdr a2) (cdr b2) a3 b3 (cons (car b2) r))
-                         (lp2 (cdr a2) (cdr b2)
-                              (cons (car a2) a3)
-                              (cons (car b2) b3)
-                              r))
-                     (lp (reverse a3) (reverse b3)
-                         (cons
-                          (list x #`(let* #,(map (lambda (v) (list x v))
-                                                 (reverse r)) #,x))
-                          u)))))
-             #`(letrec #,(reverse u) code ...)))))))
-                        
-
-             
-       
-(define-method (py-init (o <p>) . l)
-  (apply (ref o '__init__) l))
-
-(define mk-tree
-  (case-lambda
-   ((root)
-    (vector root '()))
-   ((root hist) (vector root hist))))
-
-(define (geth t) (vector-ref t 1))
-(define (getr t) (vector-ref t 0))
-(define (tree-ref t) (car (getr t)))
-
-(define (nxt tree)  
-  (define (dive r h)
-    (let ((x (car r)))
-      (if (pair? x)
-         (dive (car r) (cons (cdr r) h))
-         (mk-tree r h))))
-  
-  (define (up r h)
-    (if (null? r)
-       (if (pair? h)
-           (up (car h) (cdr h))
-           #f)
-       (let ((x (car r)))
-         (if (pair? x)
-             (dive r h)
-             (mk-tree r h)))))
-        
-  (let ((r (getr tree)) (h (geth tree)))
-    (cond
-     ((pair? r)
-      (let ((r (cdr r)))
-       (if (pair? r)
-           (let ((x (car r)))
-             (if (pair? x)
-                 (dive x (cons (cdr r) h))
-                 (mk-tree r h)))
-           (if (pair? h)
-               (up (car h) (cdr h))
-               #f))))
-     (else
-      (if (pair? h)
-         (up (car h) (cdr h))
-         #f)))))
-
-(define (class-to-tree cl) (cons cl (map class-to-tree (ref cl '__parents__))))
-
-(define (find-tree o tree)
-  (if tree
-      (let ((x (tree-ref tree)))
-       (if (eq? o x)
-           #t
-           (find-tree o (nxt tree))))
-      #f))
-
-(define (get-mro parents)
-  (if (null? parents)
-      parents
-      (get-mro0 parents)))
-
-(define (get-mro0 parents)  
-  (define tree (mk-tree parents))
-  (let lp ((tree tree) (r '()))
-    (if tree
-        (let ((x (tree-ref tree))
-              (n (nxt tree)))
-          (if (find-tree x n)
-              (lp n r)
-              (lp n (cons x r))))
-        (reverse r))))
-
-(define-method (py-equal? (x <p>)  y)
-  (aif it (ref x '__eq__)
-       (it y)
-       (next-method)))
-
-(define-method (py-equal? y (x <p>))
-  (aif it (ref x '__eq__)
-       (it y)
-       (next-method)))
-
-(define-method (py-equal? x y) ((@ (guile) equal?) x y))
-
-(define (equal? x y) (or (eq? x y) (py-equal? x y)))
-
-(define type #f)
-(set! type
-      (make-python-class type ()
-        (define __call__
-          (case-lambda
-            ((meta obj)
-             (ref obj '__class__ 'None))
-            ((meta name bases dict . keys)
-             (type- meta name bases dict keys))))))
-(set type '__class__ type)
-
-(set! object (make-python-class object ()))
-
-(name-object type)
-(name-object object)
diff --git a/modules/oop/pf-objects.scm~ b/modules/oop/pf-objects.scm~
deleted file mode 100644 (file)
index a8f120e..0000000
+++ /dev/null
@@ -1,502 +0,0 @@
-(define-module (oop pf-objects)
-  #:use-module (oop goops)
-  #:use-module (ice-9 vlist)
-  #:export (set ref make-pf <pf> call with copy fset fcall make-p put put!
-                pcall pcall! get
-                mk
-                def-pf-class  mk-pf-class  make-pf-class
-                def-p-class   mk-p-class   make-p-class
-                def-pyf-class mk-pyf-class make-pyf-class
-                def-py-class  mk-py-class  make-py-class
-
-#|
-Python object system is basically syntactic suger otop of a hashmap and one
-this project is inspired by the python object system and what it measn when
-one in stead of hasmaps use functional hashmaps. We use vhashes, but those have a drawback in that those are not thread safe. But it is a small effort to work
-with assocs or tree like functional hashmaps in stead.
-
-The hashmap works like an assoc e.g. we will define new values by 'consing' a
-new binding on the list and when the assoc take up too much space it will be
-reshaped and all extra bindings will be removed.
-
-The datastructure is functional but the objects mutate. So one need to 
-explicitly tell it to not update etc.
-|#
-
-(define-class <p> () h)
-(define-class <pf> (<p>) size n)         ; the pf object consist of a functional
-                                         ; hashmap it's size and number of live
-                                         ; object
-(define-class <py>  (<p>))
-(define-class <pyf> (<pf>))
-
-;; Make an empty pf object
-(define (make-pf)
-  (define r (make <pf>))
-  (slot-set! r 'h vlist-null)
-  (slot-set! r 'size 0)
-  (slot-set! r 'n 0)
-  r)
-
-(define (make-p)
-  (define r (make <p>))
-  (slot-set! r 'h make-hash-table)
-  r)
-
-(define fail (cons 'fail '()))
-(define-syntax-rule (mrefx x key l)
-  (let ((h (slot-ref x 'h)))
-    (define pair (vhash-assq key h))
-    (define (end)
-      (if (null? l)
-          #f
-          (car l)))
-    (define (parents)
-      (let ((pair (vhash-assq '__parents__ h)))
-        (if (pair? pair)
-            (let lp ((li (cdr pair)))
-              (if (pair? li)
-                  (let ((r (ref (car li) key fail)))
-                    (if (eq? r fail)
-                        (lp (cdr li))
-                        r))
-                  (end)))
-            (end))))
-
-    (if pair
-        (cdr pair)
-        (let ((cl (ref x '__class__)))
-          (if cl
-              (let ((r (ref cl key) fail))
-                (if (eq? r fail)
-                    (parents)
-                    r))
-              (parents))))))
-
-(define-syntax-rule (mrefx- x key l)
-  (let* ((h (slot-ref x 'h))
-         (r (hash-ref x key fail)))
-    (if (eq? r fail)
-        (if (pair? l)
-            (car l)
-            #f)
-        r))))
-
-(define not-implemented (cons 'not 'implemeneted))
-
-(define-syntax-rule (mrefx-py- x key l)
-  (let ((f (mref- x '__ref__)))
-    (if (or (not f) (eq? f not-implemented))
-        (mref- x key l)
-        (apply f x key l))))
-
-(define-syntax-rule (mrefx-py x key l)
-  (let ((f (mref x '__ref__)))
-    (if (or (not f) (eq? f not-implemented))
-        (mref    x key l)
-        (apply f x key l))))
-
-(define-syntax-rule (unx mrefx- mref-)
-  (define-syntax-rule (mref- x key l)
-    (let ((xx x))
-      (let ((res (mrefx- xx key l)))
-        (if (procedure? res)
-            (lambda z
-              (apply res xx z))
-            res)))))
-
-(unx mrefx-    mref-)
-(unx mrefx     mref)
-(unx mrefx-py  mref-py)
-(unx mrefx-py- mref-py-)
-
-(define-method (ref (x <pf> )  key . l) (mref     x key l))
-(define-method (ref (x <p>  )  key . l) (mref-    x key l))
-(define-method (ref (x <pyf>)  key . l) (mref-py  x key l))
-(define-method (ref (x <py> )  key . l) (mref-py- x key l))
-
-
-
-;; the reshape function that will create a fresh new pf object with less size
-;; this is an expensive operation and will only be done when we now there is
-;; a lot to gain essentially tho complexity is as in the number of set
-(define (reshape x)
-  (let ((h (slot-ref x 'h))
-        (m (make-hash-table))
-        (n 0))
-    (define h2 (vhash-fold (lambda (k v s)
-                             (if (hash-ref m k #f)
-                                 s
-                                 (begin
-                                   (hash-set! m k #t)
-                                   (set! n (+ n 1))
-                                   (vhash-consq k v s))))
-                           vlist-null
-                           h))
-    (slot-set! x 'h h2)
-    (slot-set! x 'size n)
-    (slot-set! x 'n    n)
-    (values)))
-
-;; on object x add a binding that key -> val
-(define-syntax-rule (mset x key val)
-  (let ((h (slot-ref x 'h))
-        (s (slot-ref x 'size))
-        (n (slot-ref x 'n)))
-    (slot-set! x 'size (+ 1 s))
-    (let ((r (vhash-assq key h)))
-      (when (not r)
-        (slot-set! x 'n (+ n 1)))
-      (slot-set! x 'h (vhash-consq key val h))
-      (when (> s (* 2 n))
-        (reshape x))
-      (values))))
-
-(define-syntax-rule (mset-py x key val)
-  (let ((f (mref-py x '__set__)))
-    (if (or (eq? f not-implemented) (not f))
-        (mset x key val)
-        (f key val))))
-        
-
-(define-syntax-rule (mset- x key val)
-  (let ((h (slot-ref x 'h)))
-    (hash-set! h key val)))
-
-(define-syntax-rule (mset-py- x key val)
-  (let ((f (mref-py- x '__set__)))
-    (if (or (eq? f not-implemented) (not f))
-        (mset- x key val)
-        (f key val))))
-
-(define-method (set (x <pf>)  key val) (mset     x key val))
-(define-method (set (x <p>)   key val) (mset-    x key val))
-(define-method (set (x <pyf>) key val) (mset-py  x key val))
-(define-method (set (x <py>)  key val) (mset-py- 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
-;; the super classes for a binding
-
-
-;; call a function as a value of key in x with the object otself as a first
-;; parameter, this is pythonic object semantics
-(define-syntax-rule (mk-call mcall mref)
-  (define-syntax-rule (mcall x key l)
-    (apply (mref y key '()) l)))
-
-(mk-call mcall     mref)
-(mk-call mcall-    mref-)
-(mk-call mcall-py  mref-py)
-(mk-call mcall-py- mref-py-)
-  
-(define-method (call (x <pf>)  key . l) (mcall     x key l))
-(define-method (call (x <p>)   key . l) (mcall-    x key l))
-(define-method (call (x <pyf>) key . l) (mcall-py  x key l))
-(define-method (call (x <py>)  key . l) (mcall-py- x key l))
-
-
-;; make a copy of a pf object
-(define-syntax-rule (mcopy x)
-  (let ((r (make <pf>)))
-    (slot-set! r 'h (slot-ref x 'h))
-    (slot-set! r 'size (slot-ref x 'size))
-    (slot-set! r 'n (slot-ref x 'n))
-    r))
-
-(define-syntax-rule (mcopy- x)
-  (let ((r (make-p))
-        (h (slot-ref r 'h)))
-    (hash-for-each (lambda (k v) (hash-set! h k v)) (slot-ref x 'h))
-    r))
-
-(define-method (copy (x <pf>)) (mcopy  x))
-(define-method (copy (x <p> )) (mcopy- x))
-  
-
-;; with will execute thunk and restor x to it's initial state after it has
-;; finished note that this is a cheap operatoin because we use a functional
-;; datastructure
-(define-syntax-rule (mwith x thunk)
-  (let ((old (mcopy x)))
-    (let ((r (thunk)))
-      (slot-set! x 'h    (slot-ref old 'h))
-      (slot-set! x 'size (slot-ref old 'size))    
-      (slot-set! x 'n    (slot-ref old 'n))
-      r)))
-
-(define-syntax-rule (mwith- x thunk)
-  (let ((old (mcopy- x)))
-    (let ((r (thunk)))
-      (slot-set! x 'h    (slot-ref old 'h))
-      r)))
-
-
-
-;; a functional set will return a new object with the added binding and keep
-;; x untouched
-(define-method (fset (x <pf>) key val)
-  (let ((x (mcopy x)))
-    (mset x key val)
-    x))
-
-(define-method (fset (x <p>) key val)
-  (let ((x (mcopy- x)))
-    (mset x key val)
-    x))
-
-;; a functional call will keep x untouched and return (values fknval newx)
-;; e.g. we get both the value of the call and the new version of x with
-;; perhaps new bindings added
-(define-method (fcall (x <pf>) key . l)
-  (let* ((y (mcopy x))
-         (r (mcall y key l)))
-    (if (eq? (slot-ref x 'h) (slot-ref y 'h))
-        (values r x)
-        (values r y))))
-
-(define-method (fcall (x <p>) key . l)
-  (let ((x (mcopy x)))
-    (values (mcall- x key l)
-            x)))
-
-;; this shows how we can override addition in a pythonic way
-(define-syntax-rule (mk-arith + +x __add__ __radd__)
-  (begin
-    (define-method (+ (x <p>) y)
-      (call x '__add__ y))
-
-    (define-method (+ x (y <p>))
-      (call y '__radd__ x))
-
-    (define-method (+ (x <py>) y)
-      (let ((f (mref-py- x '__add__)))
-        (if f
-            (f y)
-            (+x y x))))
-
-    (define-method (+ (x <pyf>) y)
-      (let ((f (mref-py x '__add__)))
-        (if f
-            (let ((res (f y)))
-              (if (eq? res not-implemented)                  
-                  (+x y x)
-                  res))
-            (+x y x))))
-
-    (define-method (+ (x <py>) y)
-      (let ((f (mref-py- x '__add__)))
-        (if f
-            (let ((res (f y)))
-              (if (eq? res not-implemented)                  
-                  (+x y x)
-                  res))
-            (+x y x))))
-    
-    (define-method (+ x (y <py>))
-      (call y '__radd__ x))
-
-    (define-method (+ x (y <pyf>))
-      (call y '__radd__ x))
-    
-    (define-method (+x (x <p>) y)
-      (call x '__radd__ y))))
-
-;; A few arithmetic operations at service
-(mk-arith + +x __add__ __radd__)
-(mk-arith - -x __sub__ __rsub__)
-(mk-arith * *x __mul__ __rmul__)
-
-;; lets define get put pcall etc so that we can refer to an object like
-;; e.g. (put x.y.z 1) (pcall x.y 1)
-
-(define-syntax-rule (cross x k f set)
-  (call-with-values (lambda () f)
-    (lambda (r y)
-      (if (eq? x y)
-          (values r x)
-          (values r (set x k y))))))
-
-(define-syntax-rule (cross! x k f _) f)
-
-(define-syntax mku
-  (syntax-rules ()
-    ((_ cross set setx f (key) (val ...))
-     (setx f key val ...))
-    ((_ cross setx f (k . l) val)
-     (cross f k (mku cross set setx (ref f k) l val) set))))
-
-(define-syntax-rule (mkk pset setx set cross)
-  (define-syntax pset
-    (lambda (x)   
-      (syntax-case x ()
-        ((_ f val (... ...))
-         (let* ((to (lambda (x)
-                      (datum->syntax #'f  (string->symbol x))))
-                (l (string-split (symbol->string (syntax->datum #'f)) #\.)))
-           (with-syntax (((a (... ...)) (map (lambda (x) #`'#,(to x))
-                                             (cdr l)))
-                         (h       (to (car l))))
-             #'(mku cross set h (a (... ...)) (val (... ...))))))))))
-
-(mkk put    fset  fset cross)
-(mkk put!   set   set  cross!)
-(mkk pcall! call  fset cross!)
-(mkk pcall  fcall fset cross)
-(mkk get    ref   fset cross!)
-
-;; it's good to have a null object so we don't need to construct it all the
-;; time because it is functional we can get away with this.
-(define null (make-pf))
-
-;; append the bindings in x in front of y + some optimizations
-(define (union x y)
-  (define hx (slot-ref x 'h))
-  (define hy (slot-ref y 'h))
-  (define n  (slot-ref x 'n))
-  (define s  (slot-ref x 'size))
-  (define m (make-hash-table))
-
-  (define h
-    (vhash-fold
-     (lambda (k v st)
-       (if (vhash-assq k hy)
-           (begin
-             (set! s (+ s 1))
-             (vhash-consq k v st))
-           (if (hash-ref m k)
-               s
-               (begin
-                 (set! n (+ n 1))
-                 (set! s (+ s 1))
-                 (hash-set! m k #t)
-                 (vhash-consq k v st)))))
-     hy
-     hx))
-  
-  (define out (make <pf>))
-  (slot-set! out 'h h)
-  (slot-set! out 'n n)
-  (slot-set! out 'size s)
-  out)
-
-(define (union- x y)
-  (define hx (slot-ref x 'h))
-  (define hy (slot-ref y 'h))  
-  (define out (make <p>))
-  (hash-for-each (lambda (k v) (hash-set! hy k v)) hx)
-  (slot-set! out 'h hy)
-  out)
-
-
-;; make a class. A class add some meta information to allow for multiple
-;; inherritance and add effectively static data to the object the functional
-;; datastructure show it's effeciency now const is data that will not change
-;; and bindings that are added to all objects. Dynamic is the mutating class
-;; information. supers is a list of priorities
-(define-syntax-rule (mk-pf make-pf-class <pf>)
-  (define (make-pf-class name const dynamic supers)
-    (define class dynamic)
-    (define-class <pf> (<pf>))
-    (put! class.__const__
-          (union const
-                 (let lp ((sup supers))
-                   (if (pair? sup)
-                       (union (ref (car sup) '__const__  null)
-                              (lp (cdr supers)))
-                       null))))
-  
-    (reshape (get class.__const__ null))
-
-    (put! class.__goops__    <pf>)
-    (put! class.__name__     name)
-    (put! class.__parents__  supers)
-
-    (put! class.__const__.__name__    (cons name 'obj))
-    (put! class.__const__.__class__   class)
-    (put! class.__const__.__parents__ supers)
-    class))
-
-(mk-pf make-pf-class <pf>)
-(mk-pf make-pf-class <pyf>)
-
-(define-syntax-rule (mk-p make-p-class <p>)
-  (define (make-p-class name const dynamic supers)
-    (define class dynamic)
-    (define-class <p> (<p>))
-    (put! class.__const__
-          (union- const
-                  (let lp ((sup supers))
-                    (if (pair? sup)
-                        (union- (ref (car sup) '__const__  null)
-                                (lp (cdr supers)))
-                        (make-p)))))
-    
-
-    (put! class.__goops__    <p>)
-    (put! class.__name__     name)
-    (put! class.__parents__  supers)
-
-    (put! class.__const__.__name__    (cons name 'obj))
-    (put! class.__const__.__class__   class)
-    (put! class.__const__.__parents__ supers)
-  
-    (union- class (get class.__const__))))
-
-(mk-p  make-p-class  <p>)
-(mk-py make-py-class <py>)
-
-;; Let's make an object essentially just move a reference
-(define-method (mk (x <pf>) . l)
-  (let ((r (get x.__const__))
-        (k (make (get class.__goops__))))
-    (slot-set! k 'h (slot-ref r 'h))
-    (slot-set! k 'size (slot-ref r 'size))
-    (slot-set! k 'n (slot-ref r 'n))
-    (apply (ref k '__init__ (lambda x (values))) k l)
-    k))
-
-(define-method (mk (x <p>) . l)
-  (let ((k (make (get x.__goops__))))
-    (put! r.__class__ x)
-    (apply (ref r '__init__ (lambda x (values))) r l)
-    r))
-
-;; the make class and defclass syntactic sugar
-(define-syntax-rule (mk-p/f mk-pf-class make-pf-class)
-  (define-syntax-rule (mk-pf-class name (parents (... ...))
-                                   #:const
-                                   ((sdef mname sval) (... ...))
-                                   #:dynamic
-                                   ((ddef dname dval) (... ...)))
-    (let ()
-      (define name
-        (make-pf-class 'name
-                       (let ((s (make-pf)))
-                         (set s 'mname sval) (... ...)
-                         s)
-                       (let ((d (make-pf)))
-                         (set d 'dname dval) (... ...)
-                         d)                 
-                       (list parents (... ...))))
-      name)))
-
-(mk-p/f mk-pf-class  make-pf-class)
-(mk-p/f mk-p-class   make-p-class)
-(mk-p/f mk-pyf-class make-pyf-class)
-(mk-p/f mk-py-class  make-py-class)
-  
-(define-syntax-rule (def-pf-class name . l)
-  (define name (mk-pf-class name . l)))
-
-(define-syntax-rule (def-p-class  name . l)
-  (define name (mk-p-class name . l)))
-
-(define-syntax-rule (def-pyf-class name . l)
-  (define name (mk-pyf-class name . l)))
-
-(define-syntax-rule (def-py-class  name . l)
-  (define name (mk-py-class name . l)))
-