(FILECREATED "16-Dec-84 17:27:39" {ERIS}<LISPCORE>LIBRARY>PLURAL.;7 2588   

      changes to:  (VARS PLURALCOMS)

      previous date: "13-Dec-84 04:25:17" {ERIS}<LISPCORE>LIBRARY>PLURAL.;6)


(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT PLURALCOMS)

(RPAQQ PLURALCOMS ((FNS Conjoin ORDINALSUFFIXSTRING Ordinal Plural)))
(DEFINEQ

(Conjoin
  [LAMBDA (a b)                                              (* mk: "26-MAY-84 10:38")
    (CONCAT a (if (U-CASEP (SUBSTRING a -1 -1))
		  then (U-CASE b)
		else b])

(ORDINALSUFFIXSTRING
  (LAMBDA (N CAP)                                            (* JonL " 5-Dec-84 22:52")
    (SETQ N (IABS N))
    (if (OR (AND (IGEQ N 4)
		 (ILEQ N 20))
	    (EQ 0 (SETQ N (IREMAINDER N 10)))
	    (IGEQ N 4))
	then (if CAP
		 then "TH"
	       else "th")
      else (SELECTQ N
		    (1 (if CAP
			   then "ST"
			 else "st"))
		    (2 (if CAP
			   then "ND"
			 else "nd"))
		    (3 (if CAP
			   then "RD"
			 else "rd"))
		    (SHOULDNT)))))

(Ordinal
  (LAMBDA (N CAP)                                            (* JonL " 5-Dec-84 22:51")
    (CONCAT N (ORDINALSUFFIXSTRING N CAP))))

(Plural
  [LAMBDA (word n)                                           (* mk: "28-Sep-84 10:04")
    (COND
      [(NOT (AND (FIXP n)
		 (EQ n 1)))
	(PROG (penult pl lCase)
	      [if (SETQ pl (GETP (MKATOM (SETQ lCase (L-CASE word)))
				 (QUOTE PLURAL)))
		  then (RETURN (MKSTRING (if (EQP word lCase)
					     then pl
					   elseif (U-CASEP word)
					     then (U-CASE pl)
					   else (L-CASE pl T]
	      (SETQ penult (SELECTQ (MKATOM (SUBSTRING lCase -2 -2))
				    ((a e i o u)
				      (QUOTE v))
				    ((s c)
				      (QUOTE s))
				    NIL))
	      (RETURN (SELECTQ (MKATOM (SUBSTRING lCase -1 -1))
			       (y (if (EQ penult (QUOTE v))
				      then (Conjoin word "s")
				    else (Conjoin (SUBSTRING word 1 -2)
						  "ies")))
			       (h (if (EQ penult (QUOTE s))
				      then (Conjoin word "es")
				    else (Conjoin word "s")))
			       ((j s x z)
				 (Conjoin word "es"))
			       (Conjoin word "s"]
      (T (MKSTRING word])
)
(PUTPROPS PLURAL COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (370 2511 (Conjoin 380 . 590) (ORDINALSUFFIXSTRING 592 . 1170) (Ordinal 1172 . 1329) (
Plural 1331 . 2509)))))
STOP