diff options
author | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2018-11-06 23:31:41 +0100 |
---|---|---|
committer | Stefan Israelsson Tampe <stefan.itampe@gmail.com> | 2018-11-06 23:31:41 +0100 |
commit | 13c923ed2fb507dc0a9e21726edb095d6855df8b (patch) | |
tree | 13d273e5ad03f6daa9017ab7010f4093ca943a21 | |
parent | 520e15905eb2d220a7acc0ca96ea08a1e1cc8555 (diff) |
cleanup
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 Binary files differdeleted file mode 100644 index c69d97a..0000000 --- a/modules/language/python/bool.go +++ /dev/null diff --git a/modules/language/python/def.go b/modules/language/python/def.go Binary files differdeleted file mode 100644 index b0fdc60..0000000 --- a/modules/language/python/def.go +++ /dev/null diff --git a/modules/language/python/exceptions.go b/modules/language/python/exceptions.go Binary files differdeleted file mode 100644 index c978f75..0000000 --- a/modules/language/python/exceptions.go +++ /dev/null diff --git a/modules/language/python/for.go b/modules/language/python/for.go Binary files differdeleted file mode 100644 index 6fc5dea..0000000 --- a/modules/language/python/for.go +++ /dev/null diff --git a/modules/language/python/guilemod.go b/modules/language/python/guilemod.go Binary files differdeleted file mode 100644 index 37043ec..0000000 --- a/modules/language/python/guilemod.go +++ /dev/null diff --git a/modules/language/python/hash.go b/modules/language/python/hash.go Binary files differdeleted file mode 100644 index c39e3fb..0000000 --- a/modules/language/python/hash.go +++ /dev/null diff --git a/modules/language/python/list.go b/modules/language/python/list.go Binary files differdeleted file mode 100644 index 99090c0..0000000 --- a/modules/language/python/list.go +++ /dev/null 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 Binary files differdeleted file mode 100644 index 736e41b..0000000 --- a/modules/language/python/persist.go +++ /dev/null diff --git a/modules/language/python/try.go b/modules/language/python/try.go Binary files differdeleted file mode 100644 index 24f385f..0000000 --- a/modules/language/python/try.go +++ /dev/null diff --git a/modules/language/python/tuple.go b/modules/language/python/tuple.go Binary files differdeleted file mode 100644 index deb3ce7..0000000 --- a/modules/language/python/tuple.go +++ /dev/null diff --git a/modules/language/python/with.go b/modules/language/python/with.go Binary files differdeleted file mode 100644 index 3525896..0000000 --- a/modules/language/python/with.go +++ /dev/null diff --git a/modules/language/python/yield.go b/modules/language/python/yield.go Binary files differdeleted file mode 100644 index 16fe75f..0000000 --- a/modules/language/python/yield.go +++ /dev/null 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 Binary files differdeleted file mode 100644 index ad26a63..0000000 --- a/modules/oop/pf-objects.go +++ /dev/null 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))) - |