Hash :
c9b10f5d
Author :
Thomas de Grivel
Date :
2018-07-29T16:21:13
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97
(in-package :positional)
(defgeneric base-parse (base input))
(defgeneric base-positional (base number))
(declaim (type simple-string *integer-base*))
(defvar *integer-base*
"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")
(defparameter *integer-base-cache*
(cons *integer-base*
(make-array `(,(length *integer-base*))
:initial-element nil)))
(defun update-integer-base-cache (ib)
(declare (type string ib))
(let ((ibc *integer-base-cache*)
(ib-n (length ib)))
(setf (first ibc) ib)
(if (= ib-n (length (the simple-vector (rest ibc))))
(let ((i 0))
(loop (unless (< i ib-n) (return))
(setf (svref (rest ibc) i) nil)
(incf i)))
(setf (rest ibc)
(make-array `(,ib-n) :initial-element nil)))))
(defun integer-base (base)
(declare (type fixnum base))
(let* ((ib *integer-base*)
(ibc *integer-base-cache*))
(unless (<= 2 base (length ib))
(error "Undefined integer base ~D" base))
(or (cond ((= base (length ib)) ib)
((eq ib (first ibc))
(svref (rest ibc) (1- base)))
(t (update-integer-base-cache ib) nil))
(setf (svref (rest ibc) (1- base))
(let ((b (subseq ib 0 base)))
(format t "~&IB ~S b ~S~%" ib b)
b)))))
#+nil (integer-base 10)
#+nil (integer-base 16)
(defmethod base-parse ((base integer) input)
(base-parse (integer-base base) input))
(defmethod base-parse ((base string) (input string))
(let ((base-len (length base))
(input-len (length input))
(result 0)
(i 0))
(loop
(unless (< i input-len)
(return))
(let* ((char (char input i))
(pos (position char base :test #'char=)))
(unless pos
(error "Invalid char ~S for base ~S." char base))
(setf result (+ (* result base-len) pos)))
(incf i))
result))
(defun parse (input &optional (base 10))
(base-parse base input))
#+nil (parse "123")
#+nil (parse "DEADBEEF" 16)
(defmethod base-positional ((base string) (number integer))
(let* ((base-n (length base))
(out-n (ceiling (log number base-n)))
(out (make-string out-n :initial-element (char base 0)))
(i (1- out-n)))
(loop
(when (= number 0)
(return out))
(when (< i 0)
(error "bad math"))
(multiple-value-bind (q r) (floor number base-n)
(setf number q
(char out i) (char base r)))
(decf i))))
#+nil (base-positional (integer-base 16) 100)
(defmethod base-positional ((base integer) number)
(base-positional (integer-base base) number))
(defun positional (number &optional (base 10))
(base-positional base number))
#+nil (positional 123)
#+nil (positional 3735928559 16)