(defun match (pattern data bindings-list)
    (let ((end-of-pattern (endp pattern))
        (end-of-data (endp data)))
        (if (or end-of-pattern end-of-data)
            (when (and end-of-pattern end-of-data) bindings-list)
            (let ((result (match-elements (first pattern) (first data) bindings-list)))
                (when result (match (rest pattern) (rest data) result))))))

(defun match-elements (pattern-elem data-elem bindings-list)
    (cond ((and (atom pattern-elem) (atom data-elem))
        ; oba elementy sa atomami
        (match-atoms pattern-elem data-elem bindings-list))
        ((and (listp pattern-elem)
            (eq '? (first pattern-elem)))
            ; element wzorca jest wyrażeniem reprezentujacym zmienna
            (match-variable pattern-elem data-elem bindings-list) )
        (t nil) ; tylko dla przejrzystosci zapisu
    ))

(defun match-atoms (pattern-elem data-elem bindings-list)
    (when (eql pattern-elem data-elem) bindings-list))

(defun match-variable (pattern-elem data-elem bindings-list)
    (let ((binding (find-binding pattern-elem bindings-list))) ; sprawdz czy jest przypisanie dla zmiennej
        (if binding (match-elements (extract-value binding) data-elem bindings-list)
            ; jesli jest przypisanie to dopasuj wartosć zmiennej
            (add-binding pattern-elem data-elem bindings-list )
            ; w przeciwnym razie dołacz przypisanie do listy
        )))

(defun find-binding (pattern-variable-expr bindings-list)
    (assoc (extract-variable pattern-variable-expr)
        ; nazwa zmiennej
        bindings-list
        ; szukaj przypisania w liscie przypisań wg klucza
        ; którym jest nazwa zmiennej
    ))

(defun extract-variable (pattern-variable-expr)
    (second pattern-variable-expr))

(defun extract-value (binding)
    (second binding))

(defun add-binding (pattern-variable-expr symbol bindings-list)
    (cons (list (extract-variable pattern-variable-expr) symbol) bindings-list))

(defun match-pattern-to-facts (pattern subst)
    (filter-list
        ; usuń pozycje nil z listy podstawień zwróconej przez mapcar
        (mapcar
            #'(lambda (fact) (match pattern fact subst))
            *facts*
            ; dopasuj wzorzec kolejno do każdego faktu
        )))

(defun process-one-antecedent (antecedent subst-list)
    (conc-lists
        ; sklej listę list podstawień zwróconš przez mapcar w jedna listę
        (mapcar
            #'(lambda (subst)
            (match-pattern-to-facts antecedent subst))
            subst-list
        ; wykonaj przeglad faktów kolejno dla każdego podstawienia
        ; z listy subst-list. Przeglad faktów dla wybranego podstawienia
        ; zwraca listę podstawień. mapcar zwraca listę list podstawień.
        )))

(defun filter-list (list)
    (remove-if
        ; procedura remove-if stosuje test okreslony funkcja do listy
        #'(lambda (element) (eq nil element))
        ; ta funkcja anonimowa sprawdza, czy element jest symbolem nil
        list))

(defun conc-lists (lists)
    (if (endp lists)
        nil
        (append
            (first lists)
            (conc-lists (rest lists)))))

(defun process-antecedents (antecedents initial-subst-list)
    (if (endp antecedents)
        initial-subst-list
        ; jesli koniec listy poprzedników, to zwróć zbudowana listę podstawień
        (process-antecedents
        ; przetwarzaj resztę listy poprzedników
            (rest antecedents)
            (process-one-antecedent
                ; podajac listę podstawień otrzymana po
                ; przetworzeniu pierwszego poprzednika z listy
                (first antecedents)
                initial-subst-list))))

(defun use-rule (rule)
    (let ((subst-list
        (process-antecedents
            (get-antecedents rule)
            (list nil))))
        (do ((remaining-subst-list subst-list
            (rest remaining-subst-list))
            (success-flag nil))
            ((endp remaining-subst-list) success-flag)
            (let ((result
                (instantiate-variables
                    (get-consequent rule)
                        (first remaining-subst-list))))
                (when (assert-fact result)
                    (format t
                        " ~%Nowy fakt: ~a
                        ~%Na podstawie reguły ~a "
                        result
                        (get-name rule))
                    (setf success-flag t))))))

(defun get-antecedents (rule)
    (butlast (rest rule)))

(defun get-consequent (rule)
    (first (last rule)))

(defun get-name (rule)
    (first rule))

(defun instantiate-variables (pattern bindings-list)
    (if (endp pattern)
        nil
        (cons (process-pattern-element (first pattern) bindings-list)
            (instantiate-variables (rest pattern) bindings-list))))

(defun assert-fact (fact)
    (unless (member fact *facts* :test #'equal)
        (setf *facts* (cons fact *facts*))))

(defun process-pattern-element (element bindings-list)
    (cond ((atom element) element)
        ((and (listp element)
            (eq '? (first element)))
            (extract-value (find-binding element bindings-list)))))

(defun forward-chain ()
    (do ((remaining-rules *rules*
        (rest remaining-rules))
        (repeat-flag nil))
        ((endp remaining-rules)
            (if repeat-flag
                (progn
                    (format t " ~% Następny przebieg. ")
                    (forward-chain))
                (progn
                    (format t
                        " ~% Brak nowych faktów. ")
                    ' koniec-wnioskowania)))
        (when (use-rule (first remaining-rules))
            (setf repeat-flag t))))