(defun simple-equal (x y)
  (if (or (atom x) (atom y)) ;atom = boolean
    (eql x y)
    (and (simple-equal (car x) (car y)) ;car primero en la lista.
         (simple-equal (cdr x) (cdr y))))) ; cdr el resto de la lista

(defun pat-match (pattern input)
  (if (variable-p pattern)
    t
    (if (or (atom pattern ) (atom input))
      (eql pattern input)
      (and (pat-match (car pattern) (car input)) ;car primero en la lista.
           (pat-match (cdr pattern) (cdr input)))))) ; cdr el resto de la lista

(defun variable-p (x)
  (and (symbolp x) (equal (char (symbol-name x) 0) #\?))) ;symbolp boolean para simbolos.

(defconstant fail nil)
(defconstant no-bindings '((t . t))) ;true true

(defun get-binding (var bindings)
  (assoc var bindings)) ;assoc takes a key and an alist and returns the first cons cell whose CAR matches the key or NIL if no match is found.

(defun binding-val (binding)
  (cdr binding))

(defun lookup (var bindings)
  (binding-val (get-binding var bindings)))

(defun extend-bindings (var val bindings)
  (cons (cons var val) bindings))

(defun pat-match (pattern input &optional (bindings no-bindings))
  (cond ((eq bindings fail) fail)
        ((variable-p pattern)
         (match-variable pattern input bindings))
        ((eql pattern input) bindings)
        ((and (consp pattern) (consp input))
         (pat-match (cdr pattern) (cdr input)
                    (pat-match (car pattern) (car input) bindings)))
        (t fail)))

(defun match-variable (var input bindings)
  (let ((binding (get-binding var bindings)))
    (cond ((not binding) (extend-bindings var input bindings))
          ((equal input (binding-val binding)) bindings)
          (t fail))))


(defun extend-bindings (var val bindings)
  (cons (cons var val)
        (if (eq bindings no-bindings)
          nil
          bindings)))

(defun pat-match (pattern input &optional (bindings no-bindings))
  (cond ((eq bindings fail) fail)
        ((variable-p pattern)
         (match-variable pattern input bindings))
        ((eql pattern input) bindings)
        ((segment-pattern-p pattern)
         (segment-match pattern input bindings))
        ((and (consp pattern) (consp input))
         (pat-match (cdr pattern) (cdr input)
                    (pat-match (car pattern) (car input) bindings)))
        (t fail)))

(defun segment-pattern-p (pattern)
  (and (consp pattern)
       (starts-with (car pattern) '?*)))

(defun starts-with (lst symb)
  (if (consp lst)
    (eql (car lst) symb)
    (eql lst symb)))

(defun segment-match (pattern input bindings &optional (start 0))
  (let ((var (cadr (car pattern)))
        (pat (cdr pattern)))
    (if (null pat)
      (match-variable var input bindings)
      (let ((pos (position (car pat) input :start start :test #'equal)))
        (if (null pos)
          fail
          (let ((b2 (pat-match pat (subseq input pos) bindings)))
            (if (eq b2 fail)
              (segment-match pattern input bindings (1+ pos))
              (match-variable var (subseq input 0 pos) b2))))))))

(defun segment-match (pattern input bindings &optional (start 0))
  (let ((var (cadr (car pattern)))
        (pat (cdr pattern)))
    (if (null pat)
      (match-variable var input bindings)
      (let ((pos (position (car pat) input :start start :test #'equal)))
        (if (null pos)
          fail
          (let ((b2 (pat-match
                      pat (subseq input pos)
                      (match-variable var (subseq input 0 pos)
                                      bindings))))
            (if (eq b2 fail)
              (segment-match pattern input bindings (1+ pos))
              b2)))))))

(defun rule-pattern (rule) (car rule))
(defun rule-responses (rule) (cdr rule))
(defparameter *s* (open "/Users/naiem/Documents/PROLOG/ELIZA/archivo.txt"))
(defparameter *eliza-rules*
(read *s*)
)

(defun eliza ()
  (loop
    (print 'eliza>)
    (write (flattern (use-eliza-rule (read))) :pretty t)))

(defun use-eliza-rule (input)
  (some #'(lambda (rule)
            (let ((result (pat-match (rule-pattern rule) input)))
              (if (not (eq result fail))
                (sublis (switch-viewpoint result)
                        (random-elt (rule-responses rule))))))
        *eliza-rules*))
(defun switch-viewpoint (words)
  (sublis '((yo . tu) (tu . yo) (yo . tu) (soy . eres))
          words))

(defun random-elt (lst)
  (elt lst (random (length lst))))

(defun mappend (fn lst)
  (apply #'append (mapcar fn lst)))

(defun flattern (lst)
  (mappend #'mklist lst))

(defun mklist (x)
  (if (listp x)
    x
    (list x)))

(eliza)