;; -*- mode:lisp -*-
(defun reduce-1 (f ls)
  (let ((memo nil))
    (labels ((reduce-2 (f ls)
               (if (null ls)
                   memo
                   (progn
                     (setf memo (funcall f memo (car ls)))
                     (reduce-2 f (cdr ls))))))
      (reduce-2 f (cdr ls))
      memo)))

(defun reduce (&rest args)
  (if (= (length args) 2)
      (apply #'reduce-1 args)
      (if (= (length args) 3)
          (funcall #'reduce-1 (car args) (append (list (elt args 2)) (elt args 1))))))

(defun remove (f ls)
  (reduce (lambda (memo item) (if (funcall f item) memo (cons item memo))) ls))

(defun acons (k v a) (cons (cons k v) a))

(defmacro defvar (variable value) `(defglobal ,variable ,value))

(defmacro defparameter (variable value) `(defglobal ,variable ,value))

(defun xassoc (key alist)
  (reduce (lambda (memo item)
            (if (equal key (car item))
                item
                memo))
          alist
          nil))

(defvar |x+y| '((((x . 1)). 1) (((y . 1)). 1)))

(defvar |2x^2+3y| '((((x . 2)) . 2) (((y . 1)). 3)))

(defun clone (ls)
  (if (not (consp ls)) ls
      (cons (clone (car ls))
            (clone (cdr ls)))))

(defun p (&rest args) (apply #'format (error-output) args))

(defun add (&rest ps)
  (let ((q nil))
    (labels ((add-1 (kv)
               (let* ((key (car kv))
                      (value (cdr kv))
                      (result (+ (or (and (xassoc key q) (cdr (xassoc key q))) 0) value)))
                 (if (not (xassoc key q))
                     (setf q (acons key result q))
                     (setf (cdr (xassoc key q)) result)))))
      (mapc (lambda (p1) (mapc #'add-1 p1)) ps))
    q))

(p "ANS:~A~%" (add |x+y| |2x^2+3y|))