start supporting hash sums from guile python
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sun, 26 Aug 2018 16:14:35 +0000 (18:14 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sun, 26 Aug 2018 16:14:35 +0000 (18:14 +0200)
modules/language/python/checksum.scm [new file with mode: 0644]
modules/language/python/compile.scm
modules/language/python/exceptions.scm
modules/language/python/module/_md5.scm [new file with mode: 0644]
modules/language/python/module/_sha1.scm [new file with mode: 0644]
modules/language/python/module/_sha224.scm [new file with mode: 0644]
modules/language/python/module/_sha256.scm [new file with mode: 0644]
modules/language/python/module/_sha384.scm [new file with mode: 0644]
modules/language/python/module/_sha512.scm [new file with mode: 0644]
modules/language/python/module/hashlib.py [new file with mode: 0644]

diff --git a/modules/language/python/checksum.scm b/modules/language/python/checksum.scm
new file mode 100644 (file)
index 0000000..dc0ce80
--- /dev/null
@@ -0,0 +1,124 @@
+(define-module (language python checksum)
+  #:use-module (oop pf-objects)
+  #:use-module (language python bytes)
+  #:use-module (language python for)
+  #:use-module (language python list)
+  #:use-module (language python exceptions)
+  #:use-module (ice-9 binary-ports)
+  #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 popen)
+  #:export (Summer run))
+
+(define mapper (make-hash-table))
+
+(let lp ((i 0))
+  (if (< i 256)
+      (let ((a (logand #xf i))
+            (b (ash (logand #xf0 i) -16)))
+        
+        (define (m i)
+          (car (string->list (number->string i 16))))
+        
+        (hash-set! mapper i (cons (m a) (m b)))
+        (lp (+ i 1)))))
+
+(define (run data command)
+  (define n1 (char->integer #\0))
+  (define n2 (char->integer #\9))
+  (define p1 (char->integer #\a))
+  (define p2 (char->integer #\f))
+  
+  (let ((i.o (pipe)))
+    (with-output-to-port (cdr i.o)
+      (lambda ()
+        (let ((port (open-pipe command OPEN_WRITE)))
+          (for ((b : data)) ()
+               (put-u8 port b))
+          (close-pipe port))))
+    (close-port (cdr i.o))
+    (let* ((ret (get-bytevector-all  (car i.o)))
+           (n   (len ret)))
+      (let lp ((i 0))
+        (define (hex? i)
+          (and (< i n)
+               (let ((i (bytevector-u8-ref ret i)))
+                 (or
+                  (and (>= i n1) (<= i n2))
+                  (and (>= i p1) (<= i p2))))))
+
+          (define (hex i)
+            (let ((i (bytevector-u8-ref ret i)))
+              (if (and (>= i n1) (<= i n2))
+                  (+ (- i n1)  0)
+                  (+ (- i p1) 10))))
+
+          (define (final l)
+            (let ((ret (make-bytevector (len l))))
+              (let lp ((l l) (i (- (len l) 1)))
+                (if (>= i 0)
+                    (begin
+                      (bytevector-u8-set! ret i (car l))
+                      (lp (cdr l) (- i 1)))
+                    (bytes ret)))))
+
+          (if (hex? i)
+              (let lp ((i i) (l '()))                            
+              (if (hex? i)
+                  (if (hex? (+ i 1))
+                      (lp (+ i 2) (cons (+ (hex i) (ash (hex (+ i 1)) 4))
+                                        l))
+                      (final (cons (hex i) l)))
+                  (final l)))
+            (error "no hex output checksum code"))))))
+           
+
+
+(define-python-class Summer ()
+  (define __init__
+    (lambda (self)
+      (set self '_data None)))
+    
+  (define update
+    (lambda (self data)
+      (let ((old (ref self '_data)))
+        (if (eq? old None)
+            (set self '_data data)
+            (set self '_data (+ old data))))
+      (set self '_digest None)
+      (values)))
+
+  (define digest
+    (lambda (self)
+      (let ((data (ref self '_data)))
+        (if (eq? data None)
+            (raise (ValueError "no data to digest"))
+            (let ((old (ref self '_digest)))
+              (if (eq? old None)
+                  (set! old (run data (ref self '_command))))
+              (set self '_digest old)
+              old)))))
+
+  
+  (define hexdigest
+    (lambda (self)
+      (let* ((x (digest self))
+             (o (make-string (* 2 (len x)))))        
+        (for ((b : (bv-scm x))) ((i 0))
+             (let ((a.b (hash-ref mapper b)))
+               (string-set! o i       (car a.b))
+               (string-set! o (+ i 1) (cdr a.b))
+               (+ i 2))
+             #:final
+             o))))
+
+  (define copy
+    (lambda (self)
+      (let ((o ((ref self '__class__))))
+        (set o '_data   (ref self '_data))
+        (set o '_digest (ref self '_digest))
+        o))))
+               
+                  
+      
+
+  
index d912587..50eacb6 100644 (file)
@@ -21,7 +21,7 @@
   #:use-module ((language python format2) #:select (fnm))
   #:use-module ((language python with) #:select ())
   #:use-module (ice-9 pretty-print)
-  #:export (comp exit-fluid exit-prompt))
+  #:export (comp exit-fluid exit-prompt pks))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
                        : ,(exp vs in-e))) ()
             ,(gen-sel vs cont item))))))
     ((#:cif cif cont)
-     `(if ,(exp vs cif)          
+     `(,(G 'if) ,(exp vs cif)          
           ,(gen-sel vs cont item)))))
 
 (define (union as vs)
           (if  (keyword? x)
                (list (G 'cons) `(,(G 'list) ,@(reverse r)) `(,(G 'list) ,@l))
                (lp (cdr l) (cons x r))))
-        (list (G 'cons)  `(,(G 'list) ,@(reverse r)) ''()))))
+        (list (G 'cons)  `(,(G 'list) ,@(reverse r)) `(,(G 'quote) ())))))
 
 (define (get-addings vs x fast?)
   (match x
                   (is-fkn? (aif it (and fast? is-fkn? fast)
                                 `(#:call-obj (lambda (e)
                                                (lambda ,xs
-                                                 (apply ,it e ,xs))))
+                                                 (,(G 'apply) ,it e ,xs))))
                                 #f)))
              (if is-fkn?
                  is-fkn?
                  (if (and fast? fast)
-                     `(#:fastfkn-ref ,fast ',tag)
+                     `(#:fastfkn-ref ,fast (,(G 'quote) ,tag))
                      (aif it (and fast? (fast-ref tag))
-                          `(#:fast-id ,it ',tag)
-                          `(#:identifier ',tag))))))
+                          `(#:fast-id ,it (,(G 'quote) ,tag))
+                          `(#:identifier (,(G 'quote) ,tag)))))))
           
           ((#:arglist args)
            `(#:apply ,@(get-kwarg vs args)))
       ("-="  '-)
       ("*="  '*)
       ("/="  '/)
-      ("%="  'modulo)
-      ("&="  'logand)
-      ("|="  'logior)
-      ("^="  'logxor)
-      ("**=" 'expt)
+      ("%="  (G 'modulo))
+      ("&="  (G 'logand))
+      ("|="  (G 'logior))
+      ("^="  (G 'logxor))
+      ("**=" (G 'expt))
       ("<<=" (C '<<))
       (">>=" (C '>>))
-      ("//="  'floor-quotient)))
+      ("//=" (G 'floor-quotient))))
   
   (match x
     ((#:verb x) x)
                   
 (define is-class? (make-fluid #f))
 (define (gen-yargs vs x)
-  (match (pr 'yarg x)    ((#:list args)
+  (match x    ((#:list args)
      (map (g vs exp) args))))
 
 (define inhibit-finally #f)
  (#:+
   (x
    (lr+ vs x)))
  (#:-
   (x
    (lr+ vs x)))
     
  (#:not
   ((_ x)
-   (list 'not (list (C 'boolit) (exp vs x)))))
+   (list (G 'not) (list (C 'boolit) (exp vs x)))))
  
  (#:or
   ((_ . x)
-   (cons 'or (map (lambda (x) (list (C 'boolit) (exp vs x))) x))))
+   (cons (G 'or) (map (lambda (x) (list (C 'boolit) (exp vs x))) x))))
     
  (#:and
   ((_ . x)
-   (cons 'and (map (lambda (x) (list (C 'boolit) (exp vs x))) x))))
+   (cons (G 'and) (map (lambda (x) (list (C 'boolit) (exp vs x))) x))))
     
  (#:test
   ((_ e1 #f)
    (exp vs e1))
 
   ((_ e1 (e2 #f))
-   (list 'if (list (C 'boolit) (exp vs e2)) (exp vs e1) (C 'None)))
+   (list (G 'if) (list (C 'boolit) (exp vs e2)) (exp vs e1) (C 'None)))
 
   ((_ e1 (e2 e3))
-   (list 'if (list (C 'boolit) (exp vs e2)) (exp vs e1) (exp vs e3))))
+   (list (G 'if) (list (C 'boolit) (exp vs e2)) (exp vs e1) (exp vs e3))))
 
  (#:del
   ;;We don't delete variables
   ((_  . l)
-   `(begin 
+   `(,(G 'begin)
       ,@(let lp ((l l))
           (match l
             (((#:power #f base () . #f) . l)
      ,@(if else `((else ,(exp vs else))) '()))))
     
  (#:suite
-  ((_ . l) (cons 'begin (map (g vs exp) l))))
+  ((_ . l) (cons (G 'begin) (map (g vs exp) l))))
     
  (#:classdef
    ((_ class parents code)
                 ,class                
                 ,(if parents
                      (arglist->pkw (clean parents))
-                     `(,(G 'cons) '() '()))
+                     `(,(G 'cons) (,(G 'quote) ()) (,(G 'quote) ())))
                 ,(map (lambda (x) `(define ,x ,(gw-persson x vo))) ls)
                 ,(wth (exp vs code)))))))))))
  (#:verb
    (let* ((xl  (map (lambda (nm) (exp vs nm)) nm))
           (ll `(language python module ,@xl)))
      
-     `(,(C 'use) #t '()
+     `(,(C 'use) #t (,(G 'quote) ())
        (,ll
         #:select
         ,(map (lambda (x)
                                              
   
   ((_ (#:name ((ids ...) . as) ...) ...)
-   `(begin
+   `(,(G 'begin)
       ,@(map
          (lambda (ids as)
-           `(begin
+           `(,(G 'begin)
               ,@(map (lambda (ids as)
                        (let ((path (map (g vs exp) ids)))
                          (if as
                                  ((#:verb
                                    ((@ (language python module) import)
                                     ((@ (language python module) Module)
-                                     ',(reverse (append
+                                     (,(G 'quote)
+                                      ,(reverse (append
                                                  '(language python module)
-                                                 path))
-                                     ',(reverse path))
+                                                 path)))
+                                     (,(G 'quote) ,(reverse path)))
                                     ,(exp vs as)))))))
                              (exp
                               vs
                                  ((#:verb
                                    ((@ (language python module) import)
                                     ((@ (language python module) Module)
-                                     ',(append '(language python module)
-                                               path))
+                                     (,(G 'quote)
+                                      ,(append '(language python module)
+                                               path)))
                                     ,(exp vs (car ids)))))))))))
                      ids as)))
          ids as))))
                            (x   (string->symbol x))
                            (lp  (gensym "lp")))
                        `(,(C 'let/ec) break-ret
-                         (let ((,v ,(exp vs arg)))
-                           (let ,lp ((,x 0))
-                                (if (< ,x ,v)
-                                    (begin
+                         (,(G 'let) ((,v ,(exp vs arg)))
+                           (,(G 'let) ,lp ((,x 0))
+                                (,(G 'if) (< ,x ,v)
+                                    (,(G 'begin)
                                       (,(C 'let/ec) continue-ret
                                        (,(C 'with-sp) ((continue (,cvalues))
                                                        (break    (break-ret)))
                            (x   (string->symbol x))
                            (lp  (gensym "lp")))
                        `(,(C 'let/ec) break-ret
-                         (let ((,v ,(exp vs arg)))
-                           (let ,lp ((,x 0))
-                                (if (< ,x ,v)
-                                    (begin
+                         (,(G 'let) ((,v ,(exp vs arg)))
+                           (,(G 'let) ,lp ((,x 0))
+                                (,(G 'if) (< ,x ,v)
+                                    (,(G 'begin)
                                       (,(C 'with-sp) ((break    (break-ret)))
                                        ,code2)
                                       (,lp (+ ,x 1))))))))))
                        (lp  (gensym "lp")))
                    (if p
                        `(,(C 'let/ec) break-ret
-                         (let ((,v1 ,(exp vs arg1))
-                               (,v2 ,(exp vs arg2)))
-                           (let ,lp ((,x ,v1))
-                                (if (< ,x ,v2)
-                                    (begin
+                         (,(G 'let) ((,v1 ,(exp vs arg1))
+                                     (,v2 ,(exp vs arg2)))
+                           (,(G 'let) ,lp ((,x ,v1))
+                                (,(G 'if) (< ,x ,v2)
+                                    (,(G 'begin)
                                       (,(C 'let/ec) continue-ret
                                        (,(C 'with-sp) ((continue (,cvalues))
                                                        (break    (break-ret)))
                                         ,code2))
                                       (,lp (+ ,x 1)))))))
                        `(,(C 'let/ec) break-ret
-                         (let ((,v1 ,(exp vs arg1))
-                               (,v2 ,(exp vs arg2)))
-                           (let ,lp ((,x ,v1))
-                                (if (< ,x ,v2)
-                                    (begin
+                         (,(G 'let) ((,v1 ,(exp vs arg1))
+                                     (,v2 ,(exp vs arg2)))
+                           (,(G 'let) ,lp ((,x ,v1))
+                                (,(G 'if) (< ,x ,v2)
+                                    (,(G 'begin)
                                       (,(C 'with-sp) ((break    (break-ret)))
                                        ,code2)
                                       (,lp (+ ,x 1))))))))))
                        (lp  (gensym "lp")))
                    (if p
                        `(,(C 'let/ec) break-ret
-                         (let ((,v1 ,(exp vs arg1))
-                               (,st ,(exp vs arg3))                          
-                               (,v2 ,(exp vs arg2)))
-                           (if (> ,st 0)
-                               (let ,lp ((,x ,v1))
-                                    (if (< ,x ,v2)
-                                        (begin
+                         (,(G 'let) ((,v1 ,(exp vs arg1))
+                                     (,st ,(exp vs arg3))  
+                                     (,v2 ,(exp vs arg2)))
+                           (,(G 'if) (> ,st 0)
+                               (,(G 'let) ,lp ((,x ,v1))
+                                    (,(G 'if) (< ,x ,v2)
+                                        (,(G 'begin)
                                           (,(C 'let/ec) continue-ret
                                            (,(C 'with-sp)
                                             ((continue (,cvalues))
                                              (break    (break-ret)))
                                             ,code2))
                                           (,lp (+ ,x ,st)))))
-                               (if (< ,st 0)
-                                   (let ,lp ((,x ,v1))
-                                        (if (> ,x ,v2)
-                                            (begin
+                               (,(G 'if) (< ,st 0)
+                                   (,(G 'let) ,lp ((,x ,v1))
+                                        (,(G 'if) (> ,x ,v2)
+                                            (,(G 'begin)
                                               (,(C 'let/ec) continue-ret
                                                (,(C 'with-sp)
                                                 ((continue (,cvalues))
                                                  (break    (break-ret)))
                                                 ,code2))
                                               (,lp (+ ,x ,st)))))
-                                   (error "range with step 0 not allowed")))))
+                                   (,(G 'error)
+                                    "range with step 0 not allowed")))))
                        `(,(C 'let/ec) break-ret
-                         (let ((,v1 ,(exp vs arg1))
-                               (,st ,(exp vs arg3))                          
-                               (,v2 ,(exp vs arg2)))
-                           (if (> ,st 0)
-                               (let ,lp ((,x ,v1))
-                                    (if (< ,x ,v2)
-                                        (begin
+                         (,(G 'let) ((,v1 ,(exp vs arg1))
+                                     (,st ,(exp vs arg3))
+                                     (,v2 ,(exp vs arg2)))
+                           (,(G 'if) (> ,st 0)
+                               (,(G 'let) ,lp ((,x ,v1))
+                                    (,(G 'if) (< ,x ,v2)
+                                        (,(G 'begin)
                                           (,(C 'with-sp)
                                            ((break    (break-ret)))
                                            ,code2)
                                           (,lp (+ ,x ,st)))))
-                               (if (< ,st 0)
-                                   (let ,lp ((,x ,v1))
-                                        (if (> ,x ,v2)
-                                            (begin
-                                              (,(C 'with-sp)
-                                               ((break    (break-ret)))
-                                               ,code2)
-                                              (,lp (+ ,x ,st)))))
-                                   (error
+                               (,(G 'if) (< ,st 0)
+                                         (,(G 'let) ,lp ((,x ,v1))
+                                             (,(G 'if) (> ,x ,v2)
+                                              (,(G 'begin)
+                                               (,(C 'with-sp)
+                                                ((break    (break-ret)))
+                                                ,code2)
+                                               (,lp (+ ,x ,st)))))
+                                   (,(G 'error)
                                     "range with step 0 not allowed"))))))))
                 (_ (next)))))
              (_ (next))))
           (p     (is-ec #t code2 #t (list (C 'continue)))))
      (if p
          `(,(C 'let/ec) break-ret
-           (let ,lp ()
-            (if (,(C 'boolit) ,(exp vs test))
-                (begin
+           (,(G 'let) ,lp ()
+            (,(G 'if) (,(C 'boolit) ,(exp vs test))
+                (,(G 'begin)
                   (,(C 'let/ec) continue-ret
                    (,(C 'with-sp) ((continue (,cvalues))
                                    (break    (break-ret)))                    
                   (,lp)))))
 
          `(,(C 'let/ec) break-ret
-           (let ,lp ()
-            (if (,(C 'boolit) ,(exp vs test))
-                (begin
+           (,(G 'let) ,lp ()
+            (,(G 'if) (,(C 'boolit) ,(exp vs test))
+                (,(G 'begin)
                   (,(C 'with-sp) ((break    (break-ret)))
                    ,code2)
                   (,lp))))))))
           (p     (is-ec #t code2 #t (list (C 'continue)))))
      (if p
          `(,(C 'let/ec) break-ret
-           (let ,lp ()
-            (if (,(C 'boolit) ,(exp vs test))
-                (begin
+           (,(G 'let) ,lp ()
+            (,(G 'if) (,(C 'boolit) ,(exp vs test))
+                (,(G 'begin)
                   (,(C 'let/ec) ,(C 'continue-ret)
                    (,(C 'with-sp) ((continue (,cvalues))
                                    (break    (break-ret)))
                   (,lp))
                 ,(exp vs else))))
          `(,(C 'let/ec) break-ret
-           (let ,lp ()
-             (if (,(C 'boolit) ,(exp vs test))
-                 (begin
+           (,(G 'let) ,lp ()
+             (,(G 'if) (,(C 'boolit) ,(exp vs test))
+                 (,(G 'begin)
                    (,(C 'with-sp) ((break    (break-ret)))
                     ,code2)
                    (,lp))
    (let ((o (gensym "o"))
          (c (gensym "c")))              
      `(,(T 'raise)
-       (let ((,c ,(exp vs code)))
-         (let ((,o (if (,(O 'pyclass?) ,c)
+       (,(G 'let) ((,c ,(exp vs code)))
+         (,(G 'let) ((,o (,(G 'if) (,(O 'pyclass?) ,c)
                        (,c)
                        ,c)))
            (,(O 'set) ,o '__cause__ ,(exp vs from))
   ((_ (#:from x))
    (let ((y (gensym "y"))
          (f (gensym "f")))
-     `(begin
+     `(,(G 'begin)
         (fluid-set! ,(Y 'in-yield) #t)
         (,(F 'for) ((,y : ,(exp vs x))) ()
-         (let ((,f (scm.yield ,y)))
+         (,(G 'let) ((,f (scm.yield ,y)))
            (,f))))))
    
   ((_ args)
    (let ((f (gensym "f")))
-     `(begin
-        (fluid-set! ,(Y 'in-yield) #t)
-        (let ((,f (scm.yield ,@(gen-yargs vs args))))
+     `(,(G 'begin)
+        (,(G 'fluid-set!) ,(Y 'in-yield) #t)
+        (,(G 'let) ((,f (scm.yield ,@(gen-yargs vs args))))
           (,f)))))
 
     
   ((_ f args)
    (let ((f (gen-yield (exp vs f)))
          (g (gensym "f")))
-     `(begin
+     `(,(G 'begin)
         (set! ,(C 'inhibit-finally) #t)
-        (let ((,g (,f ,@(gen-yargs vs args))))
+        (,(G 'let) ((,g (,f ,@(gen-yargs vs args))))
           (,g))))))
  
  (#:def
                    (,(C 'def-wrap) ,y? ,f ,ab
                     (,(D 'lam) ,aa
                      (,(C 'with-return) ,r
-                      ,(mk `(let ,(map (lambda (x) (list x #f)) ls)
+                      ,(mk `(,(G 'let) ,(map (lambda (x) (list x #f)) ls)
                               (,(C 'with-self) ,c? ,aa
                                ,(with-fluids ((return r))
                                    (wth (exp ns code)))))))))))
                   (,(C 'def-decor) ,decor
                    (,(D 'lam) ,aa
                     (,(C 'with-return) ,r
-                     ,(mk `(let ,(map (lambda (x) (list x #f)) ls)
+                     ,(mk `(,(G 'let) ,(map (lambda (x) (list x #f)) ls)
                              (,(C 'with-self) ,c? ,aa
                               ,(with-fluids ((return r))
                                  (wth (exp ns code)))))))))))
                    (,(C 'def-wrap) ,y? ,f ,ab
                     (,(D 'lam) ,aa
                      (,(C 'with-return) ,r 
-                      (let ,(map (lambda (x) (list x #f)) ls)
+                      (,(G 'let) ,(map (lambda (x) (list x #f)) ls)
                         (,(C 'with-self) ,c? ,aa
                          ,(with-fluids ((return r))
                             (mk
                   (,(C 'def-decor) ,decor
                    (,(D 'lam) ,aa
                     (,(C 'with-return) ,r 
-                     (let ,(map (lambda (x) (list x #f)) ls)
+                     (,(G 'let) ,(map (lambda (x) (list x #f)) ls)
                        (,(C 'with-self) ,c? ,aa
                         ,(with-fluids ((return r))
                            (wth (exp ns code)))))))))))))))
  (#:list
   ((_ x (and e (#:cfor . _)))
    (let ((l (gensym "l")))
-     `(let ((,l (,(L 'to-pylist) '())))
+     `(,(G 'let) ((,l (,(L 'to-pylist) (,(G 'quote) ()))))
         ,(gen-sel vs e `(,(L 'pylist-append!) ,l ,(exp vs x)))
         ,l)))
   
   ((_ . l)
    (list (L 'to-pylist) (let lp ((l l))
                           (match l                             
-                            ((or () #f) ''())                            
+                            ((or () #f) `(,(G 'quote) ()))
                             (((#:starexpr  #:power #f (#:list . l) . _) . _)
                              (lp l))
                             (((#:starexpr  #:power #f (#:tuple . l) . _) . _)
                             (((#:starexpr . l) . _)
                              `(,(L 'to-list) ,(exp vs l)))
                             ((x . l)
-                             `(cons ,(exp vs x) ,(lp l))))))))
+                             `(,(G 'cons) ,(exp vs x) ,(lp l))))))))
  (#:tuple
   ((_ x (and e (#:cfor . _)))
    (let ((l  (gensym "l")))
-     `(let ((,l '()))
-        ,(gen-sel vs e `(set! ,l (cons ,(exp vs x) ,l)))
-        (reverse ,l))))
+     `(,(G 'let) ((,l (,(G 'quote) ())))
+       ,(gen-sel vs e `(set! ,l (,(G 'cons) ,(exp vs x) ,l)))
+       (,(G 'reverse) ,l))))
 
   ((_ . l)
    (let lp ((l l))
      (match l
-       (() ''())
+       (() `(,(G 'quote) ()))
        (((#:starexpr  #:power #f (#:list . l) . _) . _)
         (lp l))
        (((#:starexpr  #:power #f (#:tuple . l) . _) . _)
        (((#:starexpr . l) . _)
         `(,(L 'to-list) ,(exp vs l)))
        ((x . l)
-        `(cons ,(exp vs x) ,(lp l)))))))
+        `(,(G 'cons) ,(exp vs x) ,(lp l)))))))
  
  (#:lambdef
   ((_ (#:var-args-list . v) e)
 
   ((_ a (#:assign b c . u))
    (let ((z (gensym "x")))
-     `(let ((,z ,(exp vs `(#:expr-stmt1 ,b (#:assign ,c . ,u)))))
+     `(,(G 'let) ((,z ,(exp vs `(#:expr-stmt1 ,b (#:assign ,c . ,u)))))
         ,(exp vs `(#:expr-stmt ,a (#:assign ((#:verb ,z))))))))
   
   ((_ l type)
        (cond
         ((= (length l) (length u))
          (if (= (length l) 1)
-             `(begin
+             `(,(G 'begin)
                 ,(make-set vs op (car l) (exp vs (car u)))
                 (,cvalues))
-             `(begin
+             `(,(G 'begin)
                 ,@(map (lambda (l u) (make-set vs op l u))
                        l
                        (map (g vs exp) u))
          (let ((vars (map (lambda (x) (gensym "v")) l))
                (q    (gensym "q"))
                (f    (gensym "f")))
-           `(begin
+           `(,(G 'begin)
               (call-with-values (lambda () ,(exp vs (car u)))
-                (letrec ((,f
-                          (case-lambda
-                            ((,q)
-                             (if (pair? ,q)
-                                 (apply ,f ,q)
-                                 (apply ,f (,(L 'to-list) ,q))))
-                            (,vars
-                             ,@(map (lambda (l v) (make-set vs op l v))
-                                    l vars)))))
-                  ,f))
+                (,(G 'letrec) ((,f
+                                (case-lambda
+                                  ((,q)
+                                   (,(G 'if) (pair? ,q)
+                                       (,(G 'apply) ,f ,q)
+                                       (,(G 'apply) ,f (,(L 'to-list) ,q))))
+                                  (,vars
+                                   ,@(map (lambda (l v) (make-set vs op l v))
+                                          l vars)))))
+                 ,f))
               (,cvalues))))
         
         ((and (= (length l) 1) (not op))
-         `(begin
+         `(,(G 'begin)
             ,(make-set vs op (car l) `(,(G 'list) ,@(map (g vs exp) u)))
             (,cvalues)))))))
   
 
  (#:assert
   ((_ x f n m)
-   `(if (,(G 'not) (,(G 'and) ,@(map (lambda (x) `(,(C 'boolit) ,(exp vs x)))
+   `(,(G 'if)
+     (,(G 'not) (,(G 'and) ,@(map (lambda (x) `(,(C 'boolit) ,(exp vs x)))
                                      x)))
-        (,(C 'raise) ,(C 'AssertionError) ',f ,n ,m))))
+     (,(C 'raise) ,(C 'AssertionError) ',f ,n ,m))))
 
 
   
  (#:expr-stmt1
   ((_ a (#:assign b c . u))
    (let ((z (gensym "x")))
-     `(let ((,z ,(exp vs `(#:expr-stmt1 ,b
+     `(,(G 'let) ((,z ,(exp vs `(#:expr-stmt1 ,b
                                         (#:assign ,c . ,u)))))
         ,(exp vs `(#:expr-stmt1 ,a (#:assign ((#:verb ,z))))))))
   
        (cond
         ((= (length l) (length u))
          (if (= (length l) 1)
-             `(begin
+             `(,(G 'begin)
                 ,(make-set vs op (car l) (exp vs (car u)))
                 ,(exp vs (car l)))
-             `(begin
+             `(,(G 'begin)
                 ,@(map (lambda (l u) (make-set vs op l u))
                        l
                        (map (g vs exp) u))
          (let ((vars (map (lambda (x) (gensym "v")) l))
                (q    (gensym "q"))
                (f    (gensym "f")))
-           `(begin
+           `(,(G 'begin)
               (call-with-values (lambda () ,(exp vs (car u)))
-                (letrec ((,f
+                (,(G 'letrec) ((,f
                           (case-lambda
                             ((,q)
-                             (if (pair? ,q)
-                                 (apply ,f ,q)
-                                 (apply ,f (,(L 'to-list) ,q))))
+                             (,(G 'if) (pair? ,q)
+                                 (,(G 'apply) ,f ,q)
+                                 (,(G 'apply) ,f (,(L 'to-list) ,q))))
                             (,vars
                              ,@(map (lambda (l v) (make-set vs op l v))
                                     l vars)))))
               (,cvalues ,@(map (g exp vs) l)))))
         
         ((and (= (length l) 1) (not op))
-         `(begin
+         `(,(G 'begin)
             ,(make-set vs op (car l) `(,(G 'list) ,@(map (g vs exp) u)))
             (,cvalues ,(exp vs (car l))))))))))
   
 
   ((_  (#:e k . v) (and e (#:cfor . _)))
    (let ((dict (gensym "dict")))
-     `(let ((,dict (,(Di 'make-py-hashtable))))
+     `(,(G 'let) ((,dict (,(Di 'make-py-hashtable))))
         ,(gen-sel vs e `(,(L 'pylist-set!) ,dict ,(exp vs k) ,(exp vs v)))
         ,dict)))
   
   ((_  (#:e k . v) ...)
    (let ((dict (gensym "dict")))
-     `(let ((,dict (,(Di 'make-py-hashtable))))
+     `(,(G 'let) ((,dict (,(Di 'make-py-hashtable))))
         ,@(map (lambda (k v)
                  `(,(L 'pylist-set!) ,dict ,(exp vs k) ,(exp vs v)))
                k v)
 
   ((_  k (and e (#:cfor . _)))
    (let ((dict (gensym "dict")))
-     `(let ((,dict (,(Se 'set))))
+     `(,(G 'let) ((,dict (,(Se 'set))))
         ,(gen-sel vs e `((,(O 'ref) ,dict 'add) ,(exp vs k)))
         ,dict)))
   
   ((_  k ...)
    (let ((set (gensym "dict")))
-     `(let ((,set (,(Se 'set))))
+     `(,(G 'let) ((,set (,(Se 'set))))
         ,@(map (lambda (k)
                  `((,(O 'ref) ,set 'add) ,(exp vs k)))
                k)
 
   ((_ x (op . y) . l)
    (let ((m (gensym "op")))
-     `(let ((,m ,(exp vs y)))
-        (and ,(tr-comp op (exp vs x) m)
-             ,(exp vs `(#:comp (#:verb ,m) . ,l))))))))
+     `(,(G 'let) ((,m ,(exp vs y)))
+       (,(G 'and) ,(tr-comp op (exp vs x) m)
+        ,(exp vs `(#:comp (#:verb ,m) . ,l))))))))
 
 
 (define (exp vs x)
-  (match (pr x)
+  (match x
     ((e)
      (exp vs e))
     ((tag . l)
 
     (#:True  #t)
     (#:None  (E 'None))
-    (#:null  ''())
+    (#:null  `(,(G 'quote) ()))
     (#:False #f)
     (#:pass  `(,cvalues))
     (#:break
                 arglist))
 
          `((,(G 'define-module) (language python module ,@args)
+            #:pure
+            #:use-module ((guile) #:select
+                          (@ @@ pk let* lambda call-with-values case-lambda
+                                   set! = * + - < <= > >= / pair?
+                                   syntax-rules let-syntax))
             #:use-module (language python module python)
+            #:use-module ((language python compile) #:select (pks))
             #:use-module (language python exceptions))
-           (define __doc__    #f)
-           (define __module__ '(language python module ,@args)))))
+           (,(G 'define) __doc__    #f)
+           (,(G 'define) __module__ (,(G 'quote)
+                                     (language python module ,@args))))))
       (x '())))
 
   (fluid-set! ignore '())
 
        (let* ((globs (get-globals x))
               (e     (map (g globs exp) x)))
-         `(begin
+         `(,(G 'begin)
             ,@start
-            (define ,fnm (make-hash-table))
+            (,(G 'define) ,fnm (,(G 'make-hash-table)))
             ,@(map (lambda (s)
                      (if (member s (fluid-ref ignore))
                          `(,cvalues)
         (let* ((globs (get-globals x))
                (res   (gensym "res"))
                (e     (map (g globs exp) x)))
-          `(begin
+          `(,(G 'begin)
              ,@start
              ,@(map (lambda (s)
                       (if (member s (fluid-ref ignore))
 
       
 (define (is-ec ret x tail tags)
-  (match (pr 'is-ec x)
-    (('cond (p a ... b) ...)
+  (match x
+    (((@ (guile) 'cond) (p a ... b) ...)
      (or
       (or-map (lambda (x) (or-map (lambda (x) (is-ec ret x #f tags)) x))
               a)
       (or-map (lambda (x) (is-ec ret x tail tags))
               b)))
         
-    (('with-self u v a ... b)
+    (((_ _ 'with-self) u v a ... b)
      (or
       (or-map (lambda (x) (is-ec ret x #f tags)) a)
       (is-ec ret b tail tags)))
       (or-map (lambda (x) (is-ec ret x #f tags)) a)
       (is-ec ret b tail tags)))
         
-    (('begin a ... b)
+    (((@ (guile) 'begin) a ... b)
      (or
       (or-map (lambda (x) (is-ec ret x #f tags)) a)
       (is-ec ret b tail tags)))
         
-    (('let lp ((y x) ...) a ... b) (=> next)
+    (((@ (guile) 'let) lp ((y x) ...) a ... b) (=> next)
      (if (symbol? lp)
          (or
           (or-map (lambda (x) (is-ec ret x #f tags)) x)
           (is-ec ret b tail tags))
          (next)))
         
-    (('let ((y x) ...) a ... b)
+    (((@ (guile) 'let) ((y x) ...) a ... b)
      (or
       (or-map (lambda (x) (is-ec ret x #f tags)) x)
       (or-map (lambda (x) (is-ec ret x #f tags)) a)
       (or-map (lambda (x) (is-ec ret x #f tags)) a)
       (is-ec ret b tail tags)))
 
-    (('define . _)
+    (((@ (guile) 'define) . _)
      #f)
 
-    (('if p a b)
+    (((@ (guile) 'if) p a b)
      (or
       (is-ec ret p #f   tags)
       (is-ec ret a tail tags)
       (is-ec ret b tail tags)))
         
-    (('if p a)
+    (((@ (guile) 'if) p a)
      (or
       (is-ec ret #'p #f   tags)
       (is-ec ret #'a tail tags)))
 (define-syntax with-return
   (lambda (x)
     (define (analyze ret x)
-      (syntax-case x (begin let if let-syntax)
-        ((cond (p a ... b) ...)
-         (equal? (syntax->datum #'cond)
+      (syntax-case x (let-syntax @)
+        ((cond- (p a ... b) ...)
+         (equal? (syntax->datum #'cond-)
                  '(@ (guile) cond))
          (with-syntax (((bb ...) (map (lambda (x) (analyze ret x)) #'(b ...))))
            #'(cond (p a ... bb) ...)))
-        ((with-self u v a ... b)
-         (equal? (syntax->datum #'with-self)
+        
+        (((_ _ with-self-) u v a ... b)         
+         (equal? (syntax->datum #'with-self-)
                  '(@@ (language python compile) with-self))
          #`(with-self u v a ... #,(analyze ret #'b)))
+        
         ((let-syntax v a ... b)
          #`(let-syntax v a ... #,(analyze ret #'b)))
-        ((begin a ... b)
+        
+        (((@ (guile) begin-) a ... b)
+         (equal? (syntax->datum #'begin-)
+                 'begin)
          #`(begin a ... #,(analyze ret #'b)))
-        ((let lp v a ... b)
-         (symbol? (syntax->datum #'lp))
+        
+        (((@ (guile) let-) lp v a ... b)
+         (and
+          (equal? (syntax->datum #'let-)
+                  'let)
+          (symbol? (syntax->datum #'lp)))
          #`(let lp v a ... #,(analyze ret #'b)))
-        ((let v a ... b)
+        
+        (((@ (guile) let-) v a ... b)
+         (equal? (syntax->datum #'let-)
+                 'let)
          #`(let v a ... #,(analyze ret #'b)))
-        ((if p a b)
+        
+        (((@ (guile) if-) p a b)
+         (equal? (syntax->datum #'if-)
+                 'if)
          #`(if p #,(analyze ret #'a) #,(analyze ret #'b)))
-        ((if p a)
+        
+        (((@ (guile) if-) p a)
+         (equal? (syntax->datum #'if-)
+                 'if)
          #`(if p #,(analyze ret #'a)))
+        
         ((return a b ...)
          (equal? (syntax->datum #'return) (syntax->datum ret))
          (if (eq? #'(b ...) '())
              #'a
              #`(values a b ...)))
+        
         ((return)
          (equal? (syntax->datum #'return) (syntax->datum ret))
-         #`(values))        
+         #`(values))
+        
         (x #'x)))
   
     (define (is-ec ret x tail)
-      (syntax-case x (let-syntax begin let let* if define @@)
-        ((cond (p a ... b) ...)
+      (syntax-case x (let-syntax with-self let* @@ @)
+        (((@ (guile) cond) (p a ... b) ...)
          (equal? (syntax->datum #'cond)
                  '(@ (guile) cond))
          (or
           (or-map (lambda (x) (is-ec ret x tail))
                   #'(b ...))))
         
-        ((with-self u v a ... b)
+        (((_ _ with-self) u v a ... b)
          (equal? (syntax->datum #'with-self)
                  '(@@ (language python compile) with-self))         
          (or
           (or-map (lambda (x) (is-ec ret x #f)) #'(a ...))
           (is-ec ret #'b tail)))
         
-        ((begin a ... b)
-         #t
+        (((@ (guile) begin) a ... b)
+         (equal? (syntax->datum #'begin)
+                 'begin)
          (or
           (or-map (lambda (x) (is-ec ret x #f)) #'(a ...))
           (is-ec ret #'b tail)))
         
-        ((let lp ((y x) ...) a ... b)
-         (symbol? (syntax->datum #'lp))
+        (((@ (guile) let) lp ((y x) ...) a ... b)
+         (and
+          (equal? (syntax->datum #'let)
+                  'let)
+          (symbol? (syntax->datum #'lp)))
          (or
           (or-map (lambda (x) (is-ec ret x #f)) #'(x ...))
           (or-map (lambda (x) (is-ec ret x #f)) #'(a ...))
           (is-ec ret #'b tail)))
         
-        ((let ((y x) ...) a ... b)
-         #t
+        (((@ (guile) let) ((y x) ...) a ... b)
+         (equal? (syntax->datum #'let)
+                 'let)
+
          (or
           (or-map (lambda (x) (is-ec ret x #f)) #'(x ...))
           (or-map (lambda (x) (is-ec ret x #f)) #'(a ...))
           (or-map (lambda (x) (is-ec ret x #f)) #'(a ...))
           (is-ec ret #'b tail)))
 
-        ((define . _)
-         #t
+        (((@ (guile) define) . _)         
+         (equal? (syntax->datum #'define)
+                 'define)
          #f)
 
-        ((if p a b)
-         #t
+        (((@ (guile) if) p a b)
+         (equal? (syntax->datum #'if)
+                 'if)
          (or
           (is-ec ret #'p #f)
           (is-ec ret #'a tail)
           (is-ec ret #'b tail)))
         
-        ((if p a)
-         #t
+        (((@ (guile) if) p a)
+         (equal? (syntax->datum #'if)
+                 'if)         
          (or
           (is-ec ret #'p #f)
           (is-ec ret #'a tail)))
   (lambda (x)
     (syntax-case x ()
       ((_ #f f ab x)
-       (pr 'def-wrap #'f 'false)
        #'x)
       
       ((_ #t f ab code)
-       (pr 'def-wrap #'f 'true)
        #'(lambda x
            (define obj (make <yield>))
            (define ab  (make-prompt-tag))
     ((_ '() v) (values))
     ((_  x  v)
      (define! 'x v))))
+
+(define-syntax pks
+  (lambda (x)
+    (pk (syntax->datum x))
+    #f))
index bb2c739..915c9ef 100644 (file)
@@ -14,7 +14,8 @@
                          OverflowError RecursionError
                          Warning DeprecationWarning BytesWarning
                           UnicodeDecodeError LookupError IndentationError
-                          KeyboardInterrupt MemoryError NameError))
+                          KeyboardInterrupt MemoryError NameError
+                          EOFError UnicodeError))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
@@ -67,6 +68,8 @@
 (define StopIteration           'StopIteration)
 (define GeneratorExit           'GeneratorExit)
 
+(define-er UnicodeError         'UnicodeError)
+(define-er EOFError             'EOFError)
 (define-er MemoryError          'MemoryError)
 (define-er NameError            'NameError)
 (define-er UnicodeDecodeError   'UnicodeDecodeError)
diff --git a/modules/language/python/module/_md5.scm b/modules/language/python/module/_md5.scm
new file mode 100644 (file)
index 0000000..cc07ebd
--- /dev/null
@@ -0,0 +1,11 @@
+(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
new file mode 100644 (file)
index 0000000..87a0adb
--- /dev/null
@@ -0,0 +1,10 @@
+(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/_sha224.scm b/modules/language/python/module/_sha224.scm
new file mode 100644 (file)
index 0000000..16f1618
--- /dev/null
@@ -0,0 +1,10 @@
+(define-module (language python module _sha224)
+  #:use-module (language python checksum)
+  #:use-module (oop pf-objects)
+  #:export (sha224)
+
+(define-python-class sha224 (Summer)
+  (define name     "sha224")
+  (define digest_size 28)
+  
+  (define _command "/usr/bin/sha224sum"))
diff --git a/modules/language/python/module/_sha256.scm b/modules/language/python/module/_sha256.scm
new file mode 100644 (file)
index 0000000..c87ea1a
--- /dev/null
@@ -0,0 +1,10 @@
+(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/_sha384.scm b/modules/language/python/module/_sha384.scm
new file mode 100644 (file)
index 0000000..6add4da
--- /dev/null
@@ -0,0 +1,10 @@
+(define-module (language python module _sha384)
+  #:use-module (language python checksum)
+  #:use-module (oop pf-objects)
+  #:export (sha384))
+
+(define-python-class sha384 (Summer)
+  (define name     "sha384")
+  (define digest_size 48)
+  
+  (define _command "/usr/bin/sha384sum"))
diff --git a/modules/language/python/module/_sha512.scm b/modules/language/python/module/_sha512.scm
new file mode 100644 (file)
index 0000000..11ca053
--- /dev/null
@@ -0,0 +1,10 @@
+(define-module (language python module _sha512)
+  #:use-module (language python checksum)
+  #:use-module (oop pf-objects)
+  #:export (sha512))
+
+(define-python-class sha512 (Summer)
+  (define name     "sha512")
+  (define digest_size 64)
+  
+  (define _command "/usr/bin/sha512sum"))
diff --git a/modules/language/python/module/hashlib.py b/modules/language/python/module/hashlib.py
new file mode 100644 (file)
index 0000000..343f116
--- /dev/null
@@ -0,0 +1,253 @@
+module(hashlib)
+
+#.  Copyright (C) 2005-2010   Gregory P. Smith (greg@krypto.org)
+#  Licensed to PSF under a Contributor Agreement.
+#
+
+__doc__ = """hashlib module - A common interface to many hash functions.
+
+new(name, data=b'', **kwargs) - returns a new hash object implementing the
+                                given hash function; initializing the hash
+                                using the given binary data.
+
+Named constructor functions are also available, these are faster
+than using new(name):
+
+md5(), sha1(), sha224(), sha256(), sha384(), sha512(), blake2b(), blake2s(),
+sha3_224, sha3_256, sha3_384, sha3_512, shake_128, and shake_256.
+
+More algorithms may be available on your platform but the above are guaranteed
+to exist.  See the algorithms_guaranteed and algorithms_available attributes
+to find out what algorithm names can be passed to new().
+
+NOTE: If you want the adler32 or crc32 hash functions they are available in
+the zlib module.
+
+Choose your hash function wisely.  Some have known collision weaknesses.
+sha384 and sha512 will be slow on 32 bit platforms.
+
+Hash objects have these methods:
+ - update(arg): Update the hash object with the bytes in arg. Repeated calls
+                are equivalent to a single call with the concatenation of all
+                the arguments.
+ - digest():    Return the digest of the bytes passed to the update() method
+                so far.
+ - hexdigest(): Like digest() except the digest is returned as a unicode
+                object of double length, containing only hexadecimal digits.
+ - copy():      Return a copy (clone) of the hash object. This can be used to
+                efficiently compute the digests of strings that share a common
+                initial substring.
+
+For example, to obtain the digest of the string 'Nobody inspects the
+spammish repetition':
+
+    >>> import hashlib
+    >>> m = hashlib.md5()
+    >>> m.update(b"Nobody inspects")
+    >>> m.update(b" the spammish repetition")
+    >>> m.digest()
+    b'\\xbbd\\x9c\\x83\\xdd\\x1e\\xa5\\xc9\\xd9\\xde\\xc9\\xa1\\x8d\\xf0\\xff\\xe9'
+
+More condensed:
+
+    >>> hashlib.sha224(b"Nobody inspects the spammish repetition").hexdigest()
+    'a4337bc45a8fc544c03f52dc550cd6e1e87021bc896588bd79e901e2'
+
+"""
+
+# This tuple and __get_builtin_constructor() must be modified if a new
+# always available algorithm is added.
+__always_supported = ('md5', 'sha1', 'sha224', 'sha256', 'sha384', 'sha512',
+                      'blake2b', 'blake2s',
+                      'sha3_224', 'sha3_256', 'sha3_384', 'sha3_512',
+                      'shake_128', 'shake_256')
+
+
+algorithms_guaranteed = set(__always_supported)
+algorithms_available = set(__always_supported)
+
+__all__ = __always_supported + ('new', 'algorithms_guaranteed',
+                                'algorithms_available', 'pbkdf2_hmac')
+
+
+__builtin_constructor_cache = {}
+
+def __get_builtin_constructor(name):
+    cache = __builtin_constructor_cache
+    constructor = cache.get(name)
+    if constructor is not None:
+        return constructor
+    try:
+        if name in ('SHA1', 'sha1'):
+            import _sha1
+            cache['SHA1'] = cache['sha1'] = _sha1.sha1
+        elif name in ('MD5', 'md5'):
+            import _md5
+            cache['MD5'] = cache['md5'] = _md5.md5
+        elif name in ('SHA256', 'sha256', 'SHA224', 'sha224'):
+            import _sha256
+            cache['SHA224'] = cache['sha224'] = _sha256.sha224
+            cache['SHA256'] = cache['sha256'] = _sha256.sha256
+        elif name in ('SHA512', 'sha512', 'SHA384', 'sha384'):
+            import _sha512
+            cache['SHA384'] = cache['sha384'] = _sha512.sha384
+            cache['SHA512'] = cache['sha512'] = _sha512.sha512
+        elif name in ('blake2b', 'blake2s'):
+            import _blake2
+            cache['blake2b'] = _blake2.blake2b
+            cache['blake2s'] = _blake2.blake2s
+        elif name in {'sha3_224', 'sha3_256', 'sha3_384', 'sha3_512',
+                      'shake_128', 'shake_256'}:
+            import _sha3
+            cache['sha3_224'] = _sha3.sha3_224
+            cache['sha3_256'] = _sha3.sha3_256
+            cache['sha3_384'] = _sha3.sha3_384
+            cache['sha3_512'] = _sha3.sha3_512
+            cache['shake_128'] = _sha3.shake_128
+            cache['shake_256'] = _sha3.shake_256
+    except ImportError:
+        pass  # no extension module, this hash is unsupported.
+
+    constructor = cache.get(name)
+    if constructor is not None:
+        return constructor
+
+    raise ValueError('unsupported hash type ' + name)
+
+
+def __get_openssl_constructor(name):
+    if name in {'blake2b', 'blake2s'}:
+        # Prefer our blake2 implementation.
+        return __get_builtin_constructor(name)
+    try:
+        f = getattr(_hashlib, 'openssl_' + name)
+        # Allow the C module to raise ValueError.  The function will be
+        # defined but the hash not actually available thanks to OpenSSL.
+        f()
+        # Use the C function directly (very fast)
+        return f
+    except (AttributeError, ValueError):
+        return __get_builtin_constructor(name)
+
+
+def __py_new(name, data=b'', **kwargs):
+    """new(name, data=b'', **kwargs) - Return a new hashing object using the
+    named algorithm; optionally initialized with data (which must be bytes).
+    """
+    return __get_builtin_constructor(name)(data, **kwargs)
+
+
+def __hash_new(name, data=b'', **kwargs):
+    """new(name, data=b'') - Return a new hashing object using the named algorithm;
+    optionally initialized with data (which must be bytes).
+    """
+    if name in {'blake2b', 'blake2s'}:
+        # Prefer our blake2 implementation.
+        # OpenSSL 1.1.0 comes with a limited implementation of blake2b/s.
+        # It does neither support keyed blake2 nor advanced features like
+        # salt, personal, tree hashing or SSE.
+        return __get_builtin_constructor(name)(data, **kwargs)
+    try:
+        return _hashlib.new(name, data)
+    except ValueError:
+        # If the _hashlib module (OpenSSL) doesn't support the named
+        # hash, try using our builtin implementations.
+        # This allows for SHA224/256 and SHA384/512 support even though
+        # the OpenSSL library prior to 0.9.8 doesn't provide them.
+        return __get_builtin_constructor(name)(data)
+
+
+try:
+    import _hashlib
+    new = __hash_new
+    __get_hash = __get_openssl_constructor
+    algorithms_available = algorithms_available.union(
+            _hashlib.openssl_md_meth_names)
+except ImportError:
+    new = __py_new
+    __get_hash = __get_builtin_constructor
+
+try:
+    # OpenSSL's PKCS5_PBKDF2_HMAC requires OpenSSL 1.0+ with HMAC and SHA
+    from _hashlib import pbkdf2_hmac
+except ImportError:
+    _trans_5C = bytes((x ^ 0x5C) for x in range(256))
+    _trans_36 = bytes((x ^ 0x36) for x in range(256))
+
+    def pbkdf2_hmac(hash_name, password, salt, iterations, dklen=None):
+        """Password based key derivation function 2 (PKCS #5 v2.0)
+
+        This Python implementations based on the hmac module about as fast
+        as OpenSSL's PKCS5_PBKDF2_HMAC for short passwords and much faster
+        for long passwords.
+        """
+        if not isinstance(hash_name, str):
+            raise TypeError(hash_name)
+
+        if not isinstance(password, (bytes, bytearray)):
+            password = bytes(memoryview(password))
+        if not isinstance(salt, (bytes, bytearray)):
+            salt = bytes(memoryview(salt))
+
+        # Fast inline HMAC implementation
+        inner = new(hash_name)
+        outer = new(hash_name)
+        blocksize = getattr(inner, 'block_size', 64)
+        if len(password) > blocksize:
+            password = new(hash_name, password).digest()
+        password = password + b'\x00' * (blocksize - len(password))
+        inner.update(password.translate(_trans_36))
+        outer.update(password.translate(_trans_5C))
+
+        def prf(msg, inner=inner, outer=outer):
+            # PBKDF2_HMAC uses the password as key. We can re-use the same
+            # digest objects and just update copies to skip initialization.
+            icpy = inner.copy()
+            ocpy = outer.copy()
+            icpy.update(msg)
+            ocpy.update(icpy.digest())
+            return ocpy.digest()
+
+        if iterations < 1:
+            raise ValueError(iterations)
+        if dklen is None:
+            dklen = outer.digest_size
+        if dklen < 1:
+            raise ValueError(dklen)
+
+        dkey = b''
+        loop = 1
+        from_bytes = int.from_bytes
+        while len(dkey) < dklen:
+            prev = prf(salt + loop.to_bytes(4, 'big'))
+            # endianess doesn't matter here as long to / from use the same
+            rkey = int.from_bytes(prev, 'big')
+            for i in range(iterations - 1):
+                prev = prf(prev)
+                # rkey = rkey ^ prev
+                rkey ^= from_bytes(prev, 'big')
+            loop += 1
+            dkey += rkey.to_bytes(inner.digest_size, 'big')
+
+        return dkey[:dklen]
+
+try:
+    # OpenSSL's scrypt requires OpenSSL 1.1+
+    from _hashlib import scrypt
+except ImportError:
+    pass
+
+
+for __func_name in __always_supported:
+    # try them all, some may not work due to the OpenSSL
+    # version not supporting that algorithm.
+    try:
+        globals()[__func_name] = __get_hash(__func_name)
+    except ValueError:
+        import logging
+        logging.exception('code for hash %s was not found.', __func_name)
+
+
+# Cleanup locals()
+del __always_supported, __func_name, __get_hash
+del __py_new, __hash_new, __get_openssl_constructor