Ignore:
Timestamp:
10/26/18 18:28:33 (2 years ago)
Author:
Kon Lovett
Message:

add raw -> cooked

File:
1 edited

Legend:

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

    r35915 r36722  
    3434  (chicken gc)
    3535  (chicken type)
     36  (chicken foreign)
    3637  (only (chicken memory) allocate free)
    3738  (only type-checks define-check+error-type check-positive-fixnum check-procedure)
     
    5960(define-type message-digest-primitive-context-info (or fixnum procedure))
    6061
     62;(foreign-lambda void ***Update     c-pointer   scheme-pointer  unsigned-int)
     63;(foreign-lambda void ***RawUpdate  c-pointer   c-pointer       unsigned-int)
     64
    6165(define-type message-digest-primitive-raw-update (or boolean procedure))
    6266
    6367(define-type message-digest-primitive (struct message-digest-primitive))
    64 ;assignment of value of type `(procedure message-digest-primitive#*make-message-digest-primitive (* * * * * * * *) (struct message-digest-primitive#message-digest-primitive))' to toplevel variable `message-digest-primitive#*make-message-digest-primitive' does not match declared type `(procedure message-digest-primitive#*make-message-digest-primitive ((or fixnum procedure) fixnum procedure procedure procedure fixnum (or symbol string) (or boolean procedure)) (struct message-digest-primitive))'
    65 (: *make-message-digest-primitive (message-digest-primitive-context-info fixnum procedure procedure procedure fixnum message-digest-primitive-name message-digest-primitive-raw-update --> message-digest-primitive))
     68
     69;assignment of value of type `(procedure
     70;message-digest-primitive#*make-message-digest-primitive (* * * * * * * *)
     71;(struct message-digest-primitive#message-digest-primitive))' to toplevel
     72;variable `message-digest-primitive#*make-message-digest-primitive' does not
     73;match declared type `(procedure
     74;message-digest-primitive#*make-message-digest-primitive ((or fixnum procedure)
     75;fixnum procedure procedure procedure fixnum (or symbol string) (or boolean
     76;procedure)) (struct message-digest-primitive))'
     77(: *make-message-digest-primitive (message-digest-primitive-context-info fixnum procedure procedure procedure fixnum message-digest-primitive-name message-digest-primitive-raw-update -> message-digest-primitive))
    6678(: message-digest-primitive? (* -> boolean : message-digest-primitive))
    6779(: message-digest-primitive-context-info (message-digest-primitive --> message-digest-primitive-context-info))
     
    95107  (check-positive-fixnum loc digest-len 'digest-length)
    96108  (check-procedure loc init 'digest-initializer)
    97   (check-procedure loc update 'digest-updater)
     109  (when update
     110    (check-procedure loc update 'digest-updater) )
    98111  (check-procedure loc final 'digest-finalizer)
    99112  (check-positive-fixnum loc block-len 'block-length)
     
    105118;;
    106119
     120;(: scheme-object-data-pointer ())
     121(define scheme-object-data-pointer
     122  (foreign-lambda* c-pointer ((scheme-pointer psrc)) "C_return( psrc );"))
     123
     124;;
     125
     126(define ((make-scheme-object-updater raw-update) ctx-info obj len)
     127  (raw-update ctx-info (scheme-object-data-pointer obj) len) )
     128
     129;;
     130
    107131;assignment of value of type `(procedure message-digest-primitive#make-message-digest-primitive (* * * * * #!rest) (struct message-digest-primitive#message-digest-primitive))' to toplevel variable `message-digest-primitive#make-message-digest-primitive' does not match declared type `(procedure message-digest-primitive#make-message-digest-primitive ((or fixnum procedure) fixnum procedure procedure procedure #!rest *) (struct message-digest-primitive))'
    108 (: make-message-digest-primitive (message-digest-primitive-context-info fixnum procedure procedure procedure #!rest -> message-digest-primitive))
     132(: make-message-digest-primitive (message-digest-primitive-context-info fixnum procedure (or boolean procedure) procedure #!rest -> message-digest-primitive))
    109133;
    110134(define (make-message-digest-primitive ctx-info digest-len init update final
    111135            #!key (block-length 4) (name (gensym 'mdp)) (raw-update #f))
    112136  (check-message-digest-arguments 'make-message-digest-primitive
    113     ctx-info digest-len init update final
    114     block-length name raw-update)
    115   (*make-message-digest-primitive
    116     ctx-info digest-len init update final
    117     block-length name raw-update) )
     137    ctx-info digest-len init update final block-length name raw-update)
     138  (let (
     139    (update (or update (and raw-update (make-scheme-object-updater raw-update)))) )
     140    ;we know about raw -> cooked
     141    (unless update
     142      (error 'make-message-digest-primitive "missing update & raw-update") )
     143    (*make-message-digest-primitive
     144      ctx-info digest-len init update final block-length name raw-update) ) )
    118145
    119146;;
Note: See TracChangeset for help on using the changeset viewer.