Interactive Fiction Parser

(defparameter word-ignore '("a" "the" "to" "an" "at" "for" "i" "from" "is" "it" "of"
                            "over" "please" "around" "that" "these" "them" "through"))

(defparameter modifiers '("in" "on"
                          "with"
                          "under" "behind"))

(defparameter error-table '(:wrong-or-unknown-verb "I don't understand that verb.")
)

(defun error-alert (error-code)
    ;(if (null (member error-code error-table))
            ;(writeline "~&[Non-lethal] Error: Corresponding error code not found."))
            ;(writeline "~&~a" (getf error-table error-code)))
)

(defun member-of-word-ignore (atom)
    (if (not (null (member atom word-ignore :test #'equalp)))
        'T))

(defun announce (list)
    (writeline "~&~s" list))

(defun and-parser (list)
    (setf list (list-split-multiple-delimiters list "and"))
    ;(writeline "~&AND-PARSER:: List after being split by 'and's: ~s" list)
    (loop for n from 0 to (1- (length list)) do
        (setf (nth n list) (concatenate-strings-with-spaces (nth n list))))
    ;(writeline "~&AND-PARSER:: List after having the words inside lists concatenated: ~s" list)
(append list))

(defun pre-parser (string)
    (let ((splat-string (split-string string #\Space)))
        ;(writeline "~&Splat-string (By spaces): ~s" splat-string)
        (loop for n from 0 to (length splat-string) do
            (if (equal '(#\.) (last (coerce (nth n splat-string) 'list)))
                (setf splat-string (append (list-subseq splat-string 0 (1- n))
                                           (list (coerce
                                                    (reverse (cdr (reverse (coerce (nth n splat-string) 'list))))
                                                'string) "then")
                                           (list-subseq splat-string (1+ n))))))
        ;(writeline "~&After coercion of 'word.' into 'word then': ~s" splat-string)
        (loop for n from 0 to (length splat-string) do
            (if (equal '(#\,) (last (coerce (nth n splat-string) 'list)))
                (setf splat-string (append (list-subseq splat-string 0 (1- n))
                                           (list (coerce
                                                    (reverse (cdr (reverse (coerce (nth n splat-string) 'list))))
                                                'string) "and")
                                           (list-subseq splat-string (1+ n))))))
        ;(writeline "~&After coercion of 'word,' into 'word and': ~s" splat-string)
        (setf splat-string (remove-if #'member-of-word-ignore splat-string))
        ;(writeline "~&String after removal of ignored words: ~s" splat-string)
        (setf splat-string (list-split-multiple-delimiters splat-string "then"))
        ;(writeline "~&String after separation into multiple statements by 'then': ~s" splat-string)
        (loop for n from 0 to (1- (length splat-string)) do (classify (nth n splat-string)))))

(defun classify (string)
    (let* ((modifier '())
           (and-exists? nil))
        ;(writeline "~&Command to parse: ~s" string)
        (if (null (member (first string) modifiers)) ;check whether the verb is fucked up
                (error-alert :wrong-or-unknown-verb))
        (if (not (null (member "and" string :test #'equalp)))
            (setf and-exists? t))
        ;(writeline "~&Is there an 'and'?: ~s" and-exists?)
        (loop for n from 0 to (length modifiers) do
            (if (not (null (member (nth n modifiers) string :test #'equalp)))
                ;check whether the string has a modifier, if so, append its string and position
                (progn (setf modifier (append (list (nth n modifiers)) (list (car (collect-item-positions string (nth n modifiers) :single? t)))))
                       (return))))
        (if (null modifier)
                    (progn ;(writeline "~&Type: UNMODIFIED.")   ;doesn't have modifiers
                           (parser string 'unmodified and-exists?)
                    )
                    (progn ;(writeline "~&Type: MODIFIED.")     ;has modifiers
                           (if (eql 1 (cadr modifier))
                               (progn ;(writeline "~&The modifier is first-word.")
                                      (parser string 'modified-first-word and-exists?)
                               )
                               (progn ;(writeline "~&The modifier is last-word.")
                                      (parser string 'modified-last-word and-exists? :modifier-position (cadr modifier))
))))))

(defun parser (list modified? and-exists? &optional &key modifier-position)
    ;(writeline "~&Parsing string: ~s" list)
    ;(writeline "~&Of type: ~s" modified?)
    ;(writeline "~&And exists?: ~s" and-exists?)
    (cond (and-exists?
            (cond ((equal modified? 'unmodified)
                        (setf list (append (list (car list))
                                            (list (and-parser (list-subseq list 1)))))
                        (announce list)
                  )
                  ((equal modified? 'modified-first-word)
                        (setf list (append (list (concatenate 'string (first list) "-" (second list)))
                                            (list (and-parser (list-subseq list 2)))))
                        (announce list)
                  )
                  ((equal modified? 'modified-last-word)
                        (setf list (append (list (concatenate 'string (first list) "-" (nth modifier-position list)))
                                            (list (and-parser (list-subseq list 1 (1- modifier-position))))
                                            (list (and-parser (list-subseq list (1+ modifier-position))))))
                        (announce list)
                  )))
          ((not and-exists?)
            (cond ((equal modified? 'unmodified)
                        (setf list (append (list (car list))
                                            (list (list (concatenate-strings-with-spaces (cdr list))))))
                        (announce list)
                  )
                  ((equal modified? 'modified-first-word)
                        (setf list (append (list (concatenate 'string (first list) "-" (second list)))
                                            (list (list (concatenate-strings-with-spaces (cddr list))))))
                        (announce list)
                  )
                  ((equal modified? 'modified-last-word)
                        (setf list (append (list (concatenate 'string (first list) "-" (nth modifier-position list)))
                                            (list (list (concatenate-strings-with-spaces (list-subseq list 1 (1- modifier-position)))))
                                            (list (list (concatenate-strings-with-spaces (list-subseq list (1+ modifier-position)))))))
                        (announce list)
)))))