weird issue

(load "random-snippets.lisp") ;; o compoising operator rcurry partial
(ql:quickload :cl-ppcre)

(defparameter batch1 '(wonder tranquil mystic serenity luminary twilight soothing bedtime restful celestial moonlit drowsy calming whisper nebula zephyr radiant peaceful shimmer repose ethereal comets aurora placid somber galactic musing starlit gentle dreamy hushed glowing nimbus serene wistful cosmic starlight moondust stardom phantom silken lucid moonrise stardew quietude stargaze restive silencer starshine moonscape cometary moondrift silentium sparklet starblow starblick starflick starglim starglint starglow glowstreak nimbuster serenitude moonglide silentful sparklen glowshine starfield cosmical silentiary nebulary starthrone mooncraft stardrift glowspark tranquilness starlighten restfulness moonscapist quietness starbloom dreamscape silenthush glowficker nebulist starwhisper moonshadow resthaven cosmicray velvetine stardancer slumberpath mystichaze quietrealm glowbeacon moonhaze restdream cosmicveil velvettouch stardweller slumberhaze mysticwand quietshade glowfairy starlumen moonflicker restglade cosmicdrift velvetmist starflame slumberwind mysticglobe quietblaze glowphantom starvowel moonchaser restcloud cosmicflame velvetshade stardolphin slumbertide mysticflair quietforge glowsprite starclimb moonvapor restmeadow cosmicgleam velvetdream starfountain slumbercave mysticvapor quietstone glowbeast sleep dream night stars moon cloud mist haze))
(defun rem-dup-batch (x)
  (remove-duplicates x))
(defun word-no-dups (x)
  (remove-duplicates x :test #'string=))
(defun dup* (x)
   (not (string= (word-no-dups x) x)))
(defun <x (word x)
 (< (length word) x))
(defun =x (word x)
 (= (length word) x))
(defun constainsweird (word)
 (not (string= (remove-if (complement #'alpha-char-p) word) word)))
(defun invalidstring (word x)
 (or (dup* word)
  (not (=x word x))
  (cl-ppcre:all-matches "[A-Z]" word)
  (constainsweird word)))
(defun remove-invalid-string (batch)
 (remove-if  (rcurry #'invalidstring 4) batch))
(defun <6 (word)
  (< (length word) 6) )
(defun invalid (x)
  (setf x (write-to-string x))
  (or(dup* x) (<6 x)))
(defun zzz ()
 (remove-if #'invalid batch1))
(print (zzz))
(ql:quickload :rutils)
;(in-package :rtl-user)
;(named-readtables:in-readtable rutils-readtable)


;; /usr/share/dict/words has a word on each line
;; (awk "usr/share/dict/words" " " thunk)

(defstruct (tn-node (:conc-name nil))
 v
 (c (list)))
(defparameter *trie* (make-tn-node))
(defparameter *xxx* 2)
(defun tr-lookup (key root)
 (rtl:dovec (ch key (v root))
  (rtl:if-it (rtl:assoc1 ch (c root))
   (setf root rtl:it)
   (return))))
(defun tr-add (key val root)
 (let ((i 0))
  (rtl:dovec (ch key)
   (rtl:if-it (rtl:assoc1 ch (c root))
    (progn(setf root rtl:it)
     (incf i))
    (return)))
  (if (= i (length key))
   (cerror "Assign a new value"
    "There was already a value at key ~A" (v root))
   (rtl:dovec (ch (rtl:slice key i))
    (let ((child (make-tn-node)))
     (push (cons ch child) (c root))
     (setf root child))))
  (setf (v root) val)))
(tr-add "moon" :moon *trie*)
(tr-add "dust" :dust *trie*)
(tr-add "star" :star *trie*)
(defun tr-composite-p (word trie)
 "Returns T if WORD is a composite word in TRIE, NIL otherwise.
   A composite word is formed by concatenating two or more words stored in the trie."
 (labels
  ((check-from (i root)
    ;; Helper: Checks if substring from index i is composite.
    ;; Returns T if composite, NIL otherwise.
    (let ((current root))
     ;; Try to find prefixes from index i
     (loop for j from i below (length word)
      ;; increases until length word
      for ch = (char word j)
      for child = (rtl:assoc1 ch (c current))
      do
      (unless child
       (return nil)) ; No path for this character
      (setf current child)
      when (and (< j (1- (length word))) ; Not at end
            (v current)) ; Prefix is a word
      do
      (let ((suffix-composite? (or (tr-lookup (rtl:slice word (1+ j)) trie)
                                (check-from (1+ j) trie))))
       (when suffix-composite?
        (return t))) ; Found a valid split
      finally
      ;; If we reach here and the whole suffix is a word
      (return (and (= j (length word))
               (v current)))))))
  (and (> (length word) 1) ; Single-char words can't be composite
   (check-from 0 trie))))
(defun add-word (word)
 (tr-add word (intern (string-upcase word) "KEYWORD") *trie*))
(defparameter *small-words* nil)
(defparameter *small-words2* nil)
(defparameter *bigger-words* nil)
(defparameter *prefixes* (cl-ppcre:split " "
  (concatenate 'string "dis mega un mini in micro non macro anti co pre"
   "post counter re pro ex trans sub super inter")) )
(defparameter *suffixes* (cl-ppcre:split " "
  (concatenate 'string "er or ist ian ment ation ing ure ful less able ling"
  "ville ish ton bury ship hood dom ry let kin")))
(defparameter *saved-trie* *trie*)
;; bigger words seem to have some words like disarm and so on
(with-open-file (file "/usr/share/dict/words" :direction :input)
 (loop for i from 1
  for line = (read-line file nil nil)
  while line
  when (not (invalidstring line 4))
  do (push line *bigger-words*)
  ))
(time (progn (setf *trie* (make-tn-node))
       (mapcar #'add-word *small-words*)))
(defparameter test
 (funcall (o (partial #'remove-if #'null)
           (partial #'remove-if (rcurry
                                 #'tr-lookup *trie*))) *prefixes*))
(defun cartesian-product (s1 s2)
 "Compute the cartesian product of two sets represented as lists"
 (loop for x in s1
  nconc (loop for y in s2 collect (list x y))))
(defun each-element-cond (s1 s2 func)
 (let ((prod (cartesian-product s1 s2)))
  (mapcar (lambda (a b)
     (list a b))
   (mapcar (o #'eval (partial #'cons `,func )) prod)
   prod)))
(defparameter *small-words-save* *small-words*)
(setf *small-words*
 (remove-if
  #'null
  (remove-duplicates
   (funcall (o  (partial #'remove-if #'null)
             (partial #'remove-if (rcurry
                                   #'tr-lookup *trie*)))
    (remove-if #'null (remove-duplicates *small-words*))))))

(defun add-words (batch)
 (let ((doctored-words
        (remove-if
         #'null
         (remove-duplicates
          (funcall (o  (partial #'remove-if #'null)
                    (partial #'remove-if (rcurry
                                          #'tr-lookup *trie*)))
           (remove-if #'null (remove-duplicates batch)))))))
  (mapcar #'add-word doctored-words)))
(time (mapcar #'add-word
       (funcall (o (partial #'remove-if #'null)
                 (partial #'remove-if (rcurry
                                       #'tr-lookup *trie*))) *prefixes*)))
;; this form has been verified to be correct
;; prefixes doesn't have duplicates
;; adding prefixes leads to "There was already a value at key nil"
;; *prefixes* is bigger than test

(mapcar #'add-word test)
;; idea - start over with the trie and at first add the prefixes and suffexes
;; after adding suffixes and prefixes small words cannot be added
;; anti and mega are in both prefixes and small words
;; and can be seen with tr-lookup
;; when we delete the extra words in small words it still says
;; the same error