Changeset 40450 in project


Ignore:
Timestamp:
09/08/21 08:08:55 (2 weeks ago)
Author:
Kon Lovett
Message:

ports allow digest where primitive accepted (digest re-use possible)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/5/message-digest-utils/trunk/message-digest-port.scm

    r40449 r40450  
    2626  (chicken base)
    2727  (chicken type)
     28  (only (chicken blob) blob?)
    2829  (only (chicken string) ->string)
    2930  (only (chicken port) make-output-port with-output-to-port)
     
    3334  message-digest-primitive
    3435  message-digest-type
     36  message-digest-item
    3537  message-digest-byte-vector)
    3638
     
    4244
    4345(: make-digest-port-name (message-digest-primitive --> string))
    44 (: open-output-digest (message-digest-primitive -> digest-output-port))
     46(: open-output-digest (message-digest-kind -> digest-output-port))
    4547(: digest-output-port? (* -> boolean : digest-output-port))
    4648(: digest-output-port-name (digest-output-port --> string))
    4749(: *close-output-digest (symbol digest-output-port message-digest-result-form -> message-digest-result-type))
    4850(: get-output-digest (digest-output-port #!rest -> message-digest-result-type))
    49 (: call-with-output-digest (message-digest-primitive procedure #!rest -> message-digest-result-type))
    50 (: with-output-to-digest (message-digest-primitive procedure #!rest -> message-digest-result-type))
     51(: call-with-output-digest (message-digest-kind procedure #!rest -> message-digest-result-type))
     52(: with-output-to-digest (message-digest-kind procedure #!rest -> message-digest-result-type))
    5153
    5254;;
     
    115117;;; Message Digest Output Port API
    116118
    117 (define (open-output-digest mdp)
     119(define (open-output-digest mdk)
    118120  (let* (
    119     (md
    120       (setup-message-digest (check-message-digest-primitive 'open-output-digest mdp)))
    121     (writer
    122       (lambda (obj)
    123         ;for now only a string
    124         (if (string? obj)
    125           (message-digest-update-string md obj)
    126           (message-digest-update-blob md obj))))
    127       ;use default close behavior
    128     (port
    129       (make-output-port writer void)) )
     121    (md     (initialized-message-digest mdk))
     122    (mdp    (message-digest-algorithm md))
     123    (writer (lambda (obj)
     124              (cond
     125                ((string? obj)
     126                  (message-digest-update-string md obj))
     127                ((blob? obj)
     128                  (message-digest-update-blob md obj))
     129                ;FIXME ...
     130                (else
     131                  (message-digest-object md obj)))))
     132    ;use default close behavior
     133    (port   (make-output-port writer void)) )
    130134    (%set-port-data! port md)
    131135    (%port-type-set! port PORT-TAG)
     
    144148  (%port-name (check-digest-output-port 'digest-output-port-name port)) )
    145149
    146 (define (*close-output-digest loc port restyp)
    147   (check-open-digest-output-port loc port 'digest-port)
    148   ;must be restyp
    149   (let (
    150     (res (finalize-message-digest (%port-data port) restyp)) )
    151     (close-output-port port)
    152     res ) )
    153 
    154150(define (get-output-digest port . opts)
    155   (let (
    156     (restyp (optional opts (message-digest-result-form))) )
    157     (*close-output-digest 'get-output-digest port restyp) ) )
     151  (check-open-digest-output-port 'get-output-digest port)
     152  (let ((restyp (optional opts (message-digest-result-form))))
     153    ;FIXME must be restyp
     154    (let ((res (finalize-message-digest (%port-data port) restyp)))
     155      (close-output-port port)
     156      res ) ) )
    158157
    159158;;
    160159
    161 (define (call-with-output-digest mdp proc . opts)
     160(define (call-with-output-digest mdk proc . opts)
    162161  (check-procedure 'call-with-output-digest proc)
    163   (check-message-digest-primitive 'call-with-output-digest mdp)
    164   (let (
    165     (restyp (optional opts (message-digest-result-form))) )
    166     (let (
    167       (port (open-output-digest mdp)) )
     162  (let ((restyp (optional opts (message-digest-result-form))))
     163    ;FIXME must be restyp
     164    (let ((port (open-output-digest mdk)))
    168165      (dynamic-wind
    169166        void
     
    171168        (lambda () (close-output-port port))) ) ) )
    172169
    173 (define (with-output-to-digest mdp thunk . opts)
    174   (let (
    175     (restyp (optional opts (message-digest-result-form))) )
    176     (call-with-output-digest
    177       mdp #;(check-message-digest-primitive 'with-output-to-digest mdp)
    178       (cut with-output-to-port <> thunk)
    179       restyp) ) )
     170(define (with-output-to-digest mdk thunk . opts)
     171  (let ((restyp (optional opts (message-digest-result-form))))
     172    ;FIXME must be restyp
     173    (call-with-output-digest mdk (cut with-output-to-port <> thunk) restyp) ) )
    180174
    181175) ;module message-digest
Note: See TracChangeset for help on using the changeset viewer.