From df7a44b43bb9bb1633e4bcd3154079a278e08da1 Mon Sep 17 00:00:00 2001
From: Nikolay Puzanov <np@embddr.com>
Date: Tue, 1 Nov 2022 18:56:51 +0300
Subject: [PATCH] Initial commit

---
 README.md         |   5 ++
 embddr/common.scm | 163 ++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 168 insertions(+)
 create mode 100644 README.md
 create mode 100644 embddr/common.scm

diff --git a/README.md b/README.md
new file mode 100644
index 0000000..91dfcb3
--- /dev/null
+++ b/README.md
@@ -0,0 +1,5 @@
+# My Scheme function collection
+
+Only for [Guile](https://www.gnu.org/software/guile/) just now,
+
+## Documentation (TODO)
diff --git a/embddr/common.scm b/embddr/common.scm
new file mode 100644
index 0000000..dc09abd
--- /dev/null
+++ b/embddr/common.scm
@@ -0,0 +1,163 @@
+(cond-expand
+ (guile
+  (define-module (embddr common))
+
+  (import (srfi srfi-1)
+          (srfi srfi-60))
+
+  (export log2
+          clog2 one?
+          curry curry-r
+          transpose
+          number->string-binary
+          number->string-binary-slice
+          number->string-hex
+          number->bits
+          string-c-radix->number
+          has-duplicates? find-duplicates
+
+          make-mux-selectors))
+ (else
+  (error "Guile is required")))
+
+;;; Log2
+(define (log2 x)
+  (/ (log x) (log 2)))
+
+;;; Ceiling of log2 ($clog2 function in SV)
+(define (clog2 x)
+  (inexact->exact (ceiling (log2 x))))
+
+;;; Check a number is a power of two
+(define (power-of-two? x)
+  (let ((l (round (log2 x))))
+    (= (expt 2 l) x)))
+
+;;; Check for (x == 1)
+(define (one? x) (= x 1))
+
+;;; Currying
+;;; Example: ((curry-r f 1) 2 3) -> (f 1 2 3)
+(define (curry f . args)
+  (lambda x (apply f (append args x))))
+
+;;; Currying right
+;;; Example: ((curry-r f 1) 2 3) -> (f 2 3 1)
+(define (curry-r f . args)
+  (lambda x (apply f (append x args))))
+
+;;; Transpose of matrix (list of lists)
+(define (transpose m)
+  (apply map (cons list m)))
+
+;;; Convert number to binary string of length 'len'
+(define (number->string-binary n len)
+  (list->string
+   (reverse
+    (map (lambda (x) (if x #\1 #\0))
+         (list-tabulate len (lambda (i) (bit-set? i n)))))))
+
+;;; Convert number to binary and slice from msb to lsb
+(define (number->string-binary-slice n msb lsb)
+  (list->string
+   (reverse
+    (drop
+     (map (lambda (x) (if x #\1 #\0))
+          (list-tabulate (+ msb 1) (lambda (i) (bit-set? i n))))
+     lsb))))
+
+;;; Convert number to hex with length l (padded left with 0)
+(define (number->string-hex n l)
+  (let* ((s (number->string n 16))
+         (sl (string-length s)))
+    (if (<= l sl)
+        s
+        (string-append (make-string (- l sl) #\0) s))))
+
+;;; Convert number to bit list
+(define (number->bits x len)
+  (map (lambda (n) (if (bit-set? n x) 1 0)) (iota len)))
+
+;;; Convert arbitrary radix string in C-format (0x, 0b 0..) to number
+(define (string-c-radix->number str)
+  (if (and str (string? str))
+      (let ((str (string-trim-both str)))
+        (cond
+         ((string-every #\0 str) 0)
+         ((string-prefix? "0x" str)
+          (string->number (substring str 2) 16))
+         ((string-prefix? "0b" str)
+          (string->number (substring str 2) 2))
+         ((string-prefix? "0" str)
+          (string->number (substring str 1) 8))
+         (else
+          (string->number str 10))))
+      #f))
+
+;;; Check list for duplicates
+(define (has-duplicates? items less)
+  (if (< (length items) 2)
+      #f
+      (let ((sorted (sort items less)))
+        (any (lambda (a b) (and (not (less a b))
+                           (not (less b a))))
+             sorted
+             (append (cdr sorted)
+                     `(,(car sorted)))))))
+
+;;; Return first duplicated item or #f if no duplicates
+(define (find-duplicates items less)
+  (if (null? items)
+      #f
+      (let ((sorted (sort items less)))
+        (let loop ((item (car sorted))
+                   (rest (cdr sorted)))
+          (cond
+           ((null? rest) #f)
+           ((and (not (less item (car rest)))
+                 (not (less (car rest) item))) item)
+           (else (loop (car rest) (cdr rest))))))))
+
+;;; In the list b0 leaves only the last most significant (other than b1) bit
+(define (bits-first-diff-msb b0 b1)
+  (let loop ((b0 (reverse b0))
+             (b1 (reverse b1))
+             (keep '()))
+    (if (null? b0)
+        keep
+        (let ((b0b (car b0))
+              (b0s (cdr b0)))
+          (if (= b0b (car b1))
+              (loop b0s (cdr b1) (cons #f keep))
+              (append (make-list (length b0s) #f) (cons b0b keep)))))))
+
+;;; Return bit lists of address selectors
+;;; If list item is #f then bit is not care
+;;; First element of each list is a address
+;;; Example:
+;;; (make-mux-selectors '(#x10 #x20 #x30)) ->
+;;;   ((#x30 #f #f #f #f  1 1)
+;;;    (#x20 #f #f #f #f  0 1)
+;;;    (#x10 #f #f #f #f #f 0))
+(define (make-mux-selectors addrs)
+  (let ((bit-width (apply max (map integer-length addrs)))
+        (addrs (sort addrs >)))
+    (map
+     (lambda (addr)
+       (let ((others (remove (curry = addr) addrs))
+             (abits (number->bits addr bit-width)))
+         (cons
+          addr
+          (apply map
+                 (lambda bits
+                   (let ((abit (car bits))
+                         (obits (cdr bits)))
+                     (if (every not obits) #f abit)))
+                 (cons
+                  abits
+                  (map
+                   (lambda (other)
+                     (let ((obits (number->bits other bit-width)))
+                       (bits-first-diff-msb abits obits)))
+                   others))))))
+     addrs)))