source: project/release/5/string-utils/trunk/string-hexadecimal.scm @ 38937

Last change on this file since 38937 was 38937, checked in by Kon Lovett, 10 months ago

add -strict-types, type is interface

File size: 2.7 KB
Line 
1;;;; string-hexadecimal.scm  -*- Scheme -*-
2;;;; Kon Lovett, Jul '18
3;;;; Kon Lovett, Aug '17
4;;;; Kon Lovett, Aug '10
5
6(declare
7  (bound-to-procedure
8    ##sys#signal-hook
9    ##sys#make-string))
10
11(module string-hexadecimal
12
13(;export
14  string->hex *string->hex
15  hex->string *hex->string)
16
17(import scheme)
18(import (chicken base))
19(import (chicken type))
20(import (chicken foreign))
21(import (chicken memory representation))
22(import to-hex)
23(import (only type-checks check-natural-fixnum check-string))
24
25;;
26
27(: string->hex (string #!optional fixnum (or boolean fixnum) --> string))
28(: hex->string (string #!optional fixnum --> string))
29(: *string->hex (string fixnum fixnum --> string))
30(: *hex->string (string fixnum fixnum --> string))
31
32;;
33
34(define (check-subvector-indexes loc start end)
35  (unless
36    (<=
37      (check-natural-fixnum loc start 'start)
38      (check-natural-fixnum loc end 'end))
39    (##sys#signal-hook #:bounds-error loc "illegal subvector specification" start end) ) )
40
41;;
42
43(define (string->hex str #!optional (start 0) (end #f))
44  (let* (
45    (len (number-of-bytes (check-string 'string->hex str)))
46    (end (or end len)) )
47    (check-subvector-indexes 'string->hex start end)
48    (*string->hex str start end) ) )
49
50(define (hex->string str #!optional (start 0) (end #f))
51  (let* (
52    (len (number-of-bytes (check-string 'hex->string str)))
53    (end (or end len)) )
54    (unless (zero? (modulo end 2))
55      (error 'hex->string "too few characters" str) )
56    (check-subvector-indexes 'hex->string start end)
57    (*hex->string str start end) ) )
58
59;;
60
61(define (*string->hex str start end)
62  (let (
63    (len (- end start)) )
64    (if (zero? len)
65      ""
66      (str_to_hex (##sys#make-string (* len 2)) str start len) ) ) )
67
68(define (*hex->string str start end)
69  (let (
70    (len (- end start)) )
71    (if (zero? len)
72      ""
73      (hex_to_str (##sys#make-string (quotient len 2)) str start len) ) ) )
74
75#|
76(import
77  (only (srfi 1) drop drop-right)
78  (only (srfi 13) string-pad string-concatenate  reverse-list->string))
79
80(define ( ch)
81  (string-pad (number->string (char->integer ch) 16) 2 #\0) )
82
83(define (*string->hex str start end)
84  (let* (
85    (ls (string->list str))
86    (ls (drop ls start))
87    (strlen (string-length str))
88    (ls (drop-right ls (- strlen end))) )
89    (string-concatenate
90      (map
91        (lambda (c)
92          (string-pad (number->string (char->integer c) 16) 2 #\0))
93      ls)) ) )
94
95(define (*hex->string str)
96  (let (
97    (len (string-length str)) )
98    (let loop ((i 0) (ls '()))
99      (if (<= len i)
100        (reverse-list->string ls)
101        (let (
102          (ni (+ i 2)) )
103          (loop ni (cons (integer->char (string->number (substring str i ni) 16)) ls)) ) ) ) ) )
104|#
105
106) ;module string-hexadecimal
Note: See TracBrowser for help on using the repository browser.