;;; -*- Mode:LISP; Package:WORDS; Readtable:CL; Base:10 -*-

(defvar *slist* nil "List of sentence structures")

(defvar *wlist* nil "A-List of word symbol/structure pairs")

(defstruct sentence
  (text "")
  (words nil)
  (wordlist nil)
  (big-a (add-word 'word-a))
  (big-b (add-word 'word-b))
  (big-c (add-word 'word-c))
  (big-d (add-word 'word-d))
  (big-e (add-word 'word-e))
  (big-f (add-word 'word-f))
  (big-g (add-word 'word-g))
  (big-h (add-word 'word-h))
  (big-i (add-word 'word-i))
  (big-j (add-word 'word-j))
  (big-k (add-word 'word-k))
  (big-l (add-word 'word-l))
  (big-m (add-word 'word-m))
  (big-n (add-word 'word-n))
  (big-o (add-word 'word-o))
  (big-p (add-word 'word-p))
  (big-q (add-word 'word-q))
  (big-r (add-word 'word-r))
  (big-s (add-word 'word-s))
  (big-t (add-word 'word-t))
  (big-u (add-word 'word-u))
  (big-v (add-word 'word-v))
  (big-w (add-word 'word-w))
  (big-x (add-word 'word-x))
  (big-y (add-word 'word-y))
  (big-z (add-word 'word-z)))

(defstruct note
  (text "")
  (symbol nil))

(defstruct word
  (text "")
  (symbol nil)
  (big-a (add-note 'word-a))
  (big-b (add-note 'note-b))
  (big-c (add-note 'note-c))
  (big-d (add-note 'note-d))
  (big-e (add-note 'note-e))
  (big-f (add-note 'note-f))
  (big-g (add-note 'note-g))
  (big-h (add-note 'note-h))
  (big-i (add-note 'note-i))
  (big-j (add-note 'note-j))
  (big-k (add-note 'note-k))
  (big-l (add-note 'note-l))
  (big-m (add-note 'note-m))
  (big-n (add-note 'note-n))
  (big-o (add-note 'note-o))
  (big-p (add-note 'note-p))
  (big-q (add-note 'note-q))
  (big-r (add-note 'note-r))
  (big-s (add-note 'note-s))
  (big-t (add-note 'note-t))
  (big-u (add-note 'note-u))
  (big-v (add-note 'note-v))
  (big-w (add-note 'note-w))
  (big-x (add-note 'note-x))
  (big-y (add-note 'note-y))
  (big-z (add-note 'note-z)))

(defmacro word-p(word)
  `(assoc ,word *wlist*))

(defmacro wordify(word)
  `(intern (string ,word) 'words))

(defun add-word(word)
  (setq word (wordify word))
  (or (word-p word)
      (car(push (cons word (make-word :text (string word) :symbol word))
		*wlist*))))

(defun words-in-list(words)
  (if (listp words) (format nil "~{~s ~}" words)))

(defun words-in-string(words)
  (when (stringp words)
    (setq words (string-trim " " words))
    (when (greaterp (length words) 0)
      (multiple-value-bind (val index)
	  (read-from-string words nil :eof)
	(and (neq val :eof)
	     (cons val
		   (words-in-string
		     (substring words index))))))))

(defun add-note(note)
  (make-note :text (string note) :symbol (wordify note)))

(defun add-words(words)
  (loop for word in words
	when (not(word-p word))
	collect (progn (setq word (wordify word))
		       (add-word word))))

(defun add-sentence(sentence &aux text words newone)
  (etypecase sentence
    (string
     (setq text sentence)
     (setq words (words-in-string sentence)))
    (list
     (setq text (words-in-list sentence))
     (setq words sentence))
    (sentence
     (setq text (sentence-text sentence))
     (setq words (sentence-words sentence))))
  (setq newone
	(make-sentence :text text
		       :words words
		       :wordlist (add-words words)))
  (push newone *slist*)
  newone)

(defun init()
  (setq *slist* nil)
  (setq *wlist* nil))

(init)

(defun test()
  (format t "~&~a" (sentence-text (add-sentence "my dog has fleas")))
  (format t "~&~a" (sentence-text (add-sentence "this is a test sentence")))
  (format t "~&~a" (sentence-text (add-sentence "when will this ever end")))
  (format t "~&~a" (sentence-text (add-sentence "i hope this breaks and causes ILLOPs")))
  (format t "~&~a" (sentence-text (add-sentence "where have all the flowers gone long time passing"))))

(defun exercise()
  (do-forever (test)))