Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (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)
- )))))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement