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

Last change on this file was 38445, checked in by Kon Lovett, 4 months ago

update runner, appropriate optimization

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(define (check-subvector-indexes loc start end)
28  (unless
29    (<=
30      (check-natural-fixnum loc start 'start)
31      (check-natural-fixnum loc end 'end))
32    (##sys#signal-hook #:bounds-error loc "illegal subvector specification" start end) ) )
33
34;;
35
36(: string->hex (string #!optional fixnum (or boolean fixnum) --> string))
37;
38(define (string->hex str #!optional (start 0) (end #f))
39  (let* (
40    (len (number-of-bytes (check-string 'string->hex str)))
41    (end (or end len)) )
42    (check-subvector-indexes 'string->hex start end)
43    (*string->hex str start end) ) )
44
45(: hex->string (string #!optional fixnum --> string))
46;
47(define (hex->string str #!optional (start 0) (end #f))
48  (let* (
49    (len (number-of-bytes (check-string 'hex->string str)))
50    (end (or end len)) )
51    (unless (zero? (modulo end 2))
52      (error 'hex->string "too few characters" str) )
53    (check-subvector-indexes 'hex->string start end)
54    (*hex->string str start end) ) )
55
56;;
57
58(: *string->hex (string fixnum fixnum --> string))
59;
60(define (*string->hex str start end)
61  (let (
62    (len (- end start)) )
63    (if (zero? len)
64      ""
65      (str_to_hex (##sys#make-string (* len 2)) str start len) ) ) )
66
67(: *hex->string (string fixnum fixnum --> string))
68;
69(define (*hex->string str start end)
70  (let (
71    (len (- end start)) )
72    (if (zero? len)
73      ""
74      (hex_to_str (##sys#make-string (quotient len 2)) str start len) ) ) )
75
76#|
77(import
78  (only (srfi 1) drop drop-right)
79  (only (srfi 13) string-pad string-concatenate  reverse-list->string))
80
81(define ( ch)
82  (string-pad (number->string (char->integer ch) 16) 2 #\0) )
83
84(define (*string->hex str start end)
85  (let* (
86    (ls (string->list str))
87    (ls (drop ls start))
88    (strlen (string-length str))
89    (ls (drop-right ls (- strlen end))) )
90    (string-concatenate
91      (map
92        (lambda (c)
93          (string-pad (number->string (char->integer c) 16) 2 #\0))
94      ls)) ) )
95
96(define (*hex->string str)
97  (let (
98    (len (string-length str)) )
99    (let loop ((i 0) (ls '()))
100      (if (<= len i)
101        (reverse-list->string ls)
102        (let (
103          (ni (+ i 2)) )
104          (loop ni (cons (integer->char (string->number (substring str i ni) 16)) ls)) ) ) ) ) )
105|#
106
107) ;module string-hexadecimal
Note: See TracBrowser for help on using the repository browser.