summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>2018-11-06 23:31:41 +0100
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>2018-11-06 23:31:41 +0100
commit13c923ed2fb507dc0a9e21726edb095d6855df8b (patch)
tree13d273e5ad03f6daa9017ab7010f4093ca943a21
parent520e15905eb2d220a7acc0ca96ea08a1e1cc8555 (diff)
cleanup
-rw-r--r--modules/language/*.scm0
-rw-r--r--modules/language/python/#eval.scm#171
-rw-r--r--modules/language/python/#persist.scm#114
-rw-r--r--modules/language/python/#python.scm#246
-rw-r--r--modules/language/python/#spec.scm#68
-rw-r--r--modules/language/python/#test.py#13
-rw-r--r--modules/language/python/#util.scm#3
-rw-r--r--modules/language/python/#yield.scm#138
-rw-r--r--modules/language/python/bool.gobin76101 -> 0 bytes
-rw-r--r--modules/language/python/def.gobin99637 -> 0 bytes
-rw-r--r--modules/language/python/exceptions.gobin171189 -> 0 bytes
-rw-r--r--modules/language/python/for.gobin175053 -> 0 bytes
-rw-r--r--modules/language/python/guilemod.gobin100253 -> 0 bytes
-rw-r--r--modules/language/python/hash.gobin82157 -> 0 bytes
-rw-r--r--modules/language/python/list.gobin399333 -> 0 bytes
-rw-r--r--modules/language/python/module/#_md5.scm#11
-rw-r--r--modules/language/python/module/#_sha1.scm#10
-rw-r--r--modules/language/python/module/#_sha256.scm#10
-rw-r--r--modules/language/python/module/#bz2.py#362
-rw-r--r--modules/language/python/module/#difflib.py#212
-rw-r--r--modules/language/python/module/#json.py#369
-rw-r--r--modules/language/python/module/#string.scm#411
-rw-r--r--modules/language/python/module/#textwrap.py#479
-rw-r--r--modules/language/python/module/xml.py~20
-rw-r--r--modules/language/python/persist.gobin84973 -> 0 bytes
-rw-r--r--modules/language/python/try.gobin93685 -> 0 bytes
-rw-r--r--modules/language/python/tuple.gobin82373 -> 0 bytes
-rw-r--r--modules/language/python/with.gobin77901 -> 0 bytes
-rw-r--r--modules/language/python/yield.gobin91485 -> 0 bytes
-rw-r--r--modules/oop/#a#2
-rw-r--r--modules/oop/pf-objects.gobin594109 -> 0 bytes
-rw-r--r--modules/oop/pf-objects.scm.bak1072
-rw-r--r--modules/oop/pf-objects.scm~502
33 files changed, 0 insertions, 4213 deletions
diff --git a/modules/language/*.scm b/modules/language/*.scm
deleted file mode 100644
index e69de29..0000000
--- a/modules/language/*.scm
+++ /dev/null
diff --git a/modules/language/python/#eval.scm# b/modules/language/python/#eval.scm#
deleted file mode 100644
index 5328fe5..0000000
--- a/modules/language/python/#eval.scm#
+++ /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
index 4ee46fc..0000000
--- a/modules/language/python/#persist.scm#
+++ /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
index cb36775..0000000
--- a/modules/language/python/#python.scm#
+++ /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
index 8291a14..0000000
--- a/modules/language/python/#spec.scm#
+++ /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
index 976e04f..0000000
--- a/modules/language/python/#test.py#
+++ /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
index 95c54a2..0000000
--- a/modules/language/python/#util.scm#
+++ /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
index 7488f42..0000000
--- a/modules/language/python/#yield.scm#
+++ /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
index c69d97a..0000000
--- a/modules/language/python/bool.go
+++ /dev/null
Binary files differ
diff --git a/modules/language/python/def.go b/modules/language/python/def.go
deleted file mode 100644
index b0fdc60..0000000
--- a/modules/language/python/def.go
+++ /dev/null
Binary files differ
diff --git a/modules/language/python/exceptions.go b/modules/language/python/exceptions.go
deleted file mode 100644
index c978f75..0000000
--- a/modules/language/python/exceptions.go
+++ /dev/null
Binary files differ
diff --git a/modules/language/python/for.go b/modules/language/python/for.go
deleted file mode 100644
index 6fc5dea..0000000
--- a/modules/language/python/for.go
+++ /dev/null
Binary files differ
diff --git a/modules/language/python/guilemod.go b/modules/language/python/guilemod.go
deleted file mode 100644
index 37043ec..0000000
--- a/modules/language/python/guilemod.go
+++ /dev/null
Binary files differ
diff --git a/modules/language/python/hash.go b/modules/language/python/hash.go
deleted file mode 100644
index c39e3fb..0000000
--- a/modules/language/python/hash.go
+++ /dev/null
Binary files differ
diff --git a/modules/language/python/list.go b/modules/language/python/list.go
deleted file mode 100644
index 99090c0..0000000
--- a/modules/language/python/list.go
+++ /dev/null
Binary files differ
diff --git a/modules/language/python/module/#_md5.scm# b/modules/language/python/module/#_md5.scm#
deleted file mode 100644
index cc07ebd..0000000
--- a/modules/language/python/module/#_md5.scm#
+++ /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
index 87a0adb..0000000
--- a/modules/language/python/module/#_sha1.scm#
+++ /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
index c87ea1a..0000000
--- a/modules/language/python/module/#_sha256.scm#
+++ /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
index 3740792..0000000
--- a/modules/language/python/module/#bz2.py#
+++ /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
index a808007..0000000
--- a/modules/language/python/module/#difflib.py#
+++ /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
index 93a7b1c..0000000
--- a/modules/language/python/module/#json.py#
+++ /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
index 3255d99..0000000
--- a/modules/language/python/module/#string.scm#
+++ /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
index 150e3f9..0000000
--- a/modules/language/python/module/#textwrap.py#
+++ /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
index bf6d8dd..0000000
--- a/modules/language/python/module/xml.py~
+++ /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
index 736e41b..0000000
--- a/modules/language/python/persist.go
+++ /dev/null
Binary files differ
diff --git a/modules/language/python/try.go b/modules/language/python/try.go
deleted file mode 100644
index 24f385f..0000000
--- a/modules/language/python/try.go
+++ /dev/null
Binary files differ
diff --git a/modules/language/python/tuple.go b/modules/language/python/tuple.go
deleted file mode 100644
index deb3ce7..0000000
--- a/modules/language/python/tuple.go
+++ /dev/null
Binary files differ
diff --git a/modules/language/python/with.go b/modules/language/python/with.go
deleted file mode 100644
index 3525896..0000000
--- a/modules/language/python/with.go
+++ /dev/null
Binary files differ
diff --git a/modules/language/python/yield.go b/modules/language/python/yield.go
deleted file mode 100644
index 16fe75f..0000000
--- a/modules/language/python/yield.go
+++ /dev/null
Binary files differ
diff --git a/modules/oop/#a# b/modules/oop/#a#
deleted file mode 100644
index aec1575..0000000
--- a/modules/oop/#a#
+++ /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
index ad26a63..0000000
--- a/modules/oop/pf-objects.go
+++ /dev/null
Binary files differ
diff --git a/modules/oop/pf-objects.scm.bak b/modules/oop/pf-objects.scm.bak
deleted file mode 100644
index 8946c59..0000000
--- a/modules/oop/pf-objects.scm.bak
+++ /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
index a8f120e..0000000
--- a/modules/oop/pf-objects.scm~
+++ /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)))
-