(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