1 files changed, 82 insertions, 0 deletions
diff --git a/plus-inc.lisp b/plus-inc.lisp
new file mode 100644
index 0000000..6e3dc72
--- /dev/null
+++ b/plus-inc.lisp
@@ -0,0 +1,82 @@
+;;;; plus function
+
+(defvar *number-units-at-beginning* nil)
+
+(defun may-reverse (number)
+  "If units is placed on the end, reverse; else keep it."
+  (if *number-units-at-beginning*
+	number
+	(reverse number)))
+
+(defun explode-to-symbol (number)
+  "Given a number (which can have letters), it returns a list of the symbols of this number"
+  (loop for letter across (prin1-to-string number) collect (intern (string letter))))
+
+(defun implode-from-symbol (number)
+  "Given a list of the symbols of a number (which can have letters), it returns the symbol of this number"
+  (intern (apply #'concatenate 'string (mapcar #'symbol-name number))))
+
+(defun symbol-to-number (symbol)
+  "Given a symbol, returns it's number."
+  (nth-value 0 (parse-integer (symbol-name symbol))))
+
+(defun next-digit (numerals digit)
+  "Given a list of a numeral system and a digit, it returns the next digit."
+  (cond
+    ((eq (car (last numerals)) digit) (car numerals))
+    ((not (eq (car numerals) digit)) (next-digit (cdr numerals) digit))
+    (t (cadr numerals))))
+
+(defun next-list-number (numerals number-list)
+  "Given a list of a numeral system and a list of a number, it returns a list of the next number."
+  (cond
+    ((null number-list)
+     (cons (if (eq (car numerals) '|0|)
+	       (cadr numerals)
+	       (car numerals)) nil))
+    ((eq (car number-list) (car (last numerals)))
+     (cons (car numerals) (next-list-number numerals (cdr number-list))))
+    (t (cons (next-digit numerals (car number-list)) (cdr number-list)))))
+
+(defun previous-digit (numerals digit)
+  "Given a list of a numeral system and a digit, it returns the previous digit."
+  (next-digit (reverse numerals) digit))
+
+(defun previous-list-number (numerals number-list)
+  "Given a list of a numeral system and a list of a number, it returns a list of the previous number."
+  (cond
+    ((and
+      (null (cdr number-list))
+      (eq (car number-list)
+	   (if (eq (car numerals) '|0|)
+	       (cadr numerals)
+	       (car numerals))))
+     nil)
+    ((and
+      (eq (car number-list) (car numerals))
+      (not (null (cdr number-list))))
+     (cons (previous-digit numerals (car number-list)) (previous-list-number numerals (cdr number-list))))
+    (t (cons (previous-digit numerals (car number-list)) (cdr number-list)))))
+
+(defun plus-args-list (numerals a b)
+  "Given a list of a numeral system and 2 lists of numbers, it returns the list of it's sum."
+  (cond
+    ((and
+      (null (cdr b))
+      (eq (car b) (if (eq (car numerals) '|0|)
+				(cadr numerals)
+				(car numerals))))
+     (next-list-number numerals a))
+    (t (plus-args-list numerals (next-list-number numerals a) (previous-list-number numerals b)))))
+
+(defun plus (numerals a b)
+  "Given a list of a numeral system and 2 numbers, it returns the list of it's sum."
+  (may-reverse (plus-args-list numerals (may-reverse (explode-to-symbol a)) (may-reverse (explode-to-symbol b)))))
+
+(defun plus-decimal (&rest args)
+  "Given decimal numbers, it returns the symbol it's sum."
+  (nth-value 0 (implode-from-symbol (may-reverse (reduce (lambda (a b) (plus-args-list '(|0| |1| |2| |3| |4| |5| |6| |7| |8| |9|) a b)) (mapcar #'may-reverse (mapcar #'explode-to-symbol args)))))))
+
+(defun plus-earth (&rest args)
+  "Give earthal numbers, it returns it's sum."
+  (symbol-to-number (nth-value 0 (implode-from-symbol (may-reverse (reduce (lambda (a b) (plus-args-list '(|1| |2| |3| |4| |5|) a b)) (mapcar #'may-reverse (mapcar #'explode-to-symbol args))))))))