;;;; string-hexadecimal.scm  -*- Hen -*-
;;;; Kon Lovett, Aug '10

(module string-hexadecimal

  (;export
    string->hex)

  (import
    scheme
    chicken
    lookup-table
    miscmacros
    (only type-checks
      check-natural-fixnum check-string))

  (require-library type-checks)

  (declare
    (bound-to-procedure
      ##sys#signal-hook
      ##sys#size
      ##sys#byte
      ##sys#make-string))

;;

(define-inline (%setchar s i c) (##core#inline "C_setsubchar" s i c))

(define string->hex
  (let ((digits '#(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\a #\b #\c #\d #\e #\f)))
    (lambda (str #!optional (start 0) (end #f))
      (check-string 'string->hex str)
      (check-natural-fixnum 'string->hex start 'start)
      (when end (check-natural-fixnum 'string->hex end 'end))
      (let ((end (or end (##sys#size str))))
        (unless (fx<= start end)
          (##sys#signal-hook #:bounds-error 'string->hex
                             "illegal substring specification" start end))
        (let ((res (##sys#make-string (fx* (fx- end start) 2))))
          (do ((i start (fx+ i 1))
               (j 0 (fx+ j 2)) )
              ((fx>= i end) res)
            (let ((byte (##sys#byte str i)))
              (%setchar res j (vector-ref digits (fxand (fxshr byte 4) #x0f)))
              (%setchar res (fx+ j 1) (vector-ref digits (fxand byte #x0f))) ) ) ) ) ) ) )

) ;module string-hexadecimal