(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