Add tag util module.

src/util-tag.scm

@@ -0,0 +1,64 @@
+;;
+;; util-tag.scm
+;;
+;; Implementation of data structure tags.
+;;
+;; ISC License
+;;
+;; Copyright 2023 Brmlab, z.s.
+;; Dominik Pantůček <dominik.pantucek@trustica.cz>
+;;
+;; Permission to use, copy, modify, and/or distribute this software
+;; for any purpose with or without fee is hereby granted, provided
+;; that the above copyright notice and this permission notice appear
+;; in all copies.
+;; 
+;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
+;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
+;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
+;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
+;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+;;
+
+(declare (unit util-tag))
+
+(module
+ util-tag
+ (
+  make-tag
+  util-tag-make
+  )
+
+ (import scheme
+	 (chicken string)
+	 (chicken random))
+
+ ;; Syntactic wrapper to allow easy tag creation
+ (define-syntax make-tag
+   (syntax-rules ()
+     ((_ tag)
+      (util-tag-make 'tag))))
+
+ ;; Creates a tag symbol based on symbol
+ (define (util-tag-make sym)
+   (string->symbol
+    (string-intersperse
+     (cons
+      (symbol->string sym)
+      (cons
+       "-"
+       (map (lambda (n)
+	      (substring
+	       (number->string
+		(+ 256 (char->integer n))
+		16)
+	       1))
+	    (string->list
+	     (random-bytes
+	      (make-string 8))))))
+     "")))
+
+ )