;;; -*- Mode:LISP; Package:SPELL; Base:10; Readtable:ZL -*-

(defun spell-s-ending (word word-length)
  
;
; check for flags: X, J, Z, S, P, M
;
; X     -ions or -ications or -ens
; J     -ings
; Z     -ers or -iers
; S     -ies or -es or -s
; P     -iness or -ness
; M     -'S
;
  
  (block nil
    (store-array-leader (- word-length 1) word 0)
    
    (cond ((or (not (string-search (aref word (- word-length 2)) "SXZHY"))
               (and (char-equal (aref word (- word-length 2)) #/Y)
                    (vowelp (aref word (- word-length 3)))))
           (let ((word-number (word-in-dictionary-p word)))
             (when word-number
               (return (and (not (zerop (de-s-flag word-number)))
                            (de-word word-number)))))))
    
    (let ((l (aref word (- word-length 2))))
      (cond ((char-equal l #/N)                ;for X flag
             (cond ((and (char-equal (aref word (- word-length 4)) #/I)
                         (char-equal (aref word (- word-length 3)) #/O))
                    ;;word ended in xxxIONS ... replace with xxxE
                    (aset #/E word (- word-length 4))
                    (store-array-leader (- word-length 3) word 0)
                    (let ((word-number (word-in-dictionary-p word)))
                      (when word-number
                        (return (and (not (zerop (de-x-flag word-number)))
                                     (de-word word-number)))))))
             
             (cond ((and (greaterp word-length 8)
                         (char-equal (aref word (- word-length 8)) #/I)
                         (char-equal (aref word (- word-length 7)) #/C)
                         (char-equal (aref word (- word-length 6)) #/A)
                         (char-equal (aref word (- word-length 5)) #/T)
                         (char-equal (aref word (- word-length 4)) #/E))
                    (aset #/Y word (- word-length 8))
                    (store-array-leader (- word-length 7) word 0)
                    
                    (let ((word-number (word-in-dictionary-p word)))
                      (if (and word-number (not (zerop (de-x-flag word-number))))
                          (return (de-word word-number))
                        (return nil)))))
             
             (cond ((and (char-equal (aref word (- word-length 3)) #/E)
                         (not (char-equal (aref word (- word-length 4)) #/E))
                         (not (char-equal (aref word (- word-length 4)) #/Y)))
                    (store-array-leader (- word-length 3) word 0)
                    (let ((word-number (word-in-dictionary-p word)))
                      (if (and word-number (not (zerop (de-x-flag word-number))))
                          (return (de-word word-number))
                        (return nil)))))
             
             (return nil))
            
            ((char-equal l #/G)                ;J flag
             (if (not (char-equal (aref word (- word-length 4)) #/I)) (return nil))
             (if (not (char-equal (aref word (- word-length 3)) #/N)) (return nil))
             ;;word ended in INGS ... remove INGS, put on E
             (aset #/E word (- word-length 4))
             (store-array-leader (- word-length 3) word 0)
             (let ((word-number (word-in-dictionary-p word)))
               (when word-number
                 (return (and (not (zerop (de-j-flag word-number)))
                              (de-word word-number)))))
             
             ;;now remove the E
             (store-array-leader (- word-length 4) word 0)
             (if (and
                   (greaterp (string-length word) 5)
                   (char-equal (aref word (- word-length 5)) #/E))
                 (return nil))
             
             (let ((word-number (word-in-dictionary-p word)))
               (when word-number
                 (return (and (not (zerop (de-j-flag word-number)))
                              (de-word word-number)))))
             
             (return nil))
            
            ((char-equal l #/R)                ;Z flag
             ;;must end in ERS
             (if (not (char-equal (aref word (- word-length 3)) #/E)) (return nil))
             
             ;;remove RS
             (store-array-leader (- word-length 2) word 0)
             
             (let ((word-number (word-in-dictionary-p word)))
               (when word-number
                 (return (and (not (zerop (de-z-flag word-number)))
                              (de-word word-number)))))
             
             (cond ((char-equal (aref word (- word-length 4)) #/I)
                    ;;word ended in IERS ... remove and add Y
                    (aset #/Y word (- word-length 4))
                    (store-array-leader (- word-length 3) word 0)
                    (let ((word-number (word-in-dictionary-p word)))
                      (when word-number
                        (return (and (not (zerop (de-z-flag word-number)))
                                     (de-word word-number)))))
                    (return nil)))
             
             ;;now chop at E from ...ERS
             (store-array-leader (- word-length 3) word 0)
             
             (let ((word-number (word-in-dictionary-p word)))
               (when word-number
                 (return (and (not (zerop (de-z-flag word-number)))
                              (de-word word-number)))))
             
             (return nil))
            
            ((char-equal l #/E)                ;S flag (except simple adding of S (?)
             
             ;;word ends in ES ... prevent "ACEES", "HATEES"!
             (if (char-equal (aref word (- word-length 3)) #/E)
                 (return nil))
             
             ;;word ends xES where x is consonant or vowel not E...
             ;;still need to prevent "ACTES" !
             ;;not to mention "TESTES", which is right for the wrong reason.
             
             (store-array-leader (- word-length 2) word 0)
             (let ((word-number (word-in-dictionary-p word)))
               (when word-number
                 (return (and (not (zerop (de-s-flag word-number)))
                              (de-word word-number)))))
             
             (cond ((char-equal (aref word (- word-length 3)) #/I)
                    ;;ok, we had IES ... remove, add Y
                    (aset #/Y word (- word-length 3))
                    (let ((word-number (word-in-dictionary-p word)))
                      (when word-number
                        (return (and (not (zerop (de-s-flag word-number)))
                                     (de-word word-number)))))))
             
             (return nil))
            
            ((char-equal l #/S)                ;P flag
             (if (not (char-equal (aref word (- word-length 4)) #/N))
                 (return nil))
             (if (not (char-equal (aref word (- word-length 3)) #/E))
                 (return nil))
             
             ;;ok, we had NESS ... kill it
             (store-array-leader (- word-length 4) word 0)
             
             ;;don't check ONESS, etc. 
             
             (if (lessp (string-length word) 2) (return nil))
             
             (cond ((or (not (char-equal (aref word (- word-length 5)) #/Y))
                        (vowelp (aref word (- word-length 6))))
                    (let ((word-number (word-in-dictionary-p word)))
                      (when word-number
                        (return (and (not (zerop (de-p-flag word-number)))
                                     (de-word word-number)))))))

             (cond ((char-equal (aref word (- word-length 5)) #/I)
                    (aset #/Y word (- word-length 5))
                    (let ((word-number (word-in-dictionary-p word)))
                      (when word-number
                        (return (and (not (zerop (de-p-flag word-number)))
                                     (de-word word-number)))))))

             (return nil))

            ((char-equal l #/')                ;M flag, ...'S *** !
             (store-array-leader (- word-length 2) word 0)
             (return word))

            (t
             (return nil))))))