33 lines
934 B
Common Lisp
33 lines
934 B
Common Lisp
(defpackage :all-your-base
|
|
(:use :cl)
|
|
(:export :rebase))
|
|
|
|
(in-package :all-your-base)
|
|
|
|
(defun conv (l base)
|
|
(if (null l)
|
|
0
|
|
(+ (* (first l) (expt base (- (length l) 1))) (conv (rest l) base))))
|
|
|
|
(defun calc-start-exponent (num base x)
|
|
(if (< num (expt base (1+ x)))
|
|
x
|
|
(calc-start-exponent num base (1+ x))))
|
|
|
|
(defun unconv (num base exponent)
|
|
(let ((x
|
|
(if (eq exponent -1)
|
|
(calc-start-exponent num base 0)
|
|
exponent)))
|
|
(if (eq x 0)
|
|
(list num)
|
|
(multiple-value-bind (q r)
|
|
(truncate num (expt base x))
|
|
(append (list q) (unconv r base (- x 1)))))))
|
|
|
|
(defun rebase (l source destination)
|
|
(cond ((< source 2) nil)
|
|
((< destination 2) nil)
|
|
((some #'(lambda (x) (< x 0)) l) nil)
|
|
((some #'(lambda (x) (>= x source)) l) nil)
|
|
(t (unconv (conv l source) destination -1))))
|