Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
(FILECREATED "30-OCT-76 17:01:41" <MOORE>TELL.;19 6679
changes to: TELLCOMS
previous date: "30-OCT-76 16:58:06" <MOORE>TELL.;18)
(PRETTYCOMPRINT TELLCOMS)
(RPAQQ TELLCOMS
[(FNS * TELLFNS)
(VARS REASONABLEOMISSIONLST)
(BLOCKS (TELLBLOCK ADDTOSET ADVERBLST BASISTELLABOUT
ENNUMERATEQUESTIONS EVERYONE GETQUESTIONS
OBJECTQUESTION OBJECTQUESTIONS
SUBJECTQUESTION SUBJECTQUESTIONS TELLABOUT
TELLABOUTEVERYONE
(ENTRIES TELLABOUT ENNUMERATEQUESTIONS
EVERYONE TELLABOUTEVERYONE
BASISTELLABOUT])
(RPAQQ TELLFNS
(ADDTOSET ADVERBLST BASISTELLABOUT ENNUMERATEQUESTIONS EVERYONE
GETQUESTIONS OBJECTQUESTION OBJECTQUESTIONS
SUBJECTQUESTION SUBJECTQUESTIONS TELLABOUT
TELLABOUTEVERYONE))
(DEFINEQ
(ADDTOSET
[LAMBDA (X LST)
(COND
((MEMBER X LST)
LST)
(T (CONS X LST])
(ADVERBLST
[LAMBDA (ADV)
(CDR (ASSOC ADV (QUOTE ((LOCALLY locally)
(FREELY freely)
(GLOBALLY globally)
(ARGUMENTS as an argument)
(RECORDS as a record)
(FIELDS as a field)
(PROPERTIES as a property)
(I.S.OPRS as a Clisp I.S.operator)
(FIELDS as a field])
(BASISTELLABOUT
[LAMBDA (DUMPFILE)
(TELLABOUTEVERYONE REASONABLEOMISSIONLST DUMPFILE])
(ENNUMERATEQUESTIONS
[LAMBDA NIL
(for I from 1 as Q in (GETQUESTIONS)
do (COND
((ILESSP I 10)
(SPACES 1 T)))
(PRIN1 I T)
(PRIN1 (QUOTE %.)
T)
(SPACES 1 T)
(for W in (CAR Q) do (SPACES 1 T)
(PRIN1 W T))
(PRIN1 (QUOTE ?)
T)
(TERPRI T])
(EVERYONE
[LAMBDA NIL
(APPEND (MASTERSCOPE (QUOTE (WHO IS KNOWN)))
(MASTERSCOPE (QUOTE (WHO IS USED)))
(MASTERSCOPE (QUOTE (WHO IS USED AS A PROPERTY)))
(MASTERSCOPE (QUOTE (WHO IS USED AS A FIELD)))
(MASTERSCOPE (QUOTE (WHO IS USED AS A RECORD])
(GETQUESTIONS
[LAMBDA NIL
(APPEND (SUBJECTQUESTIONS)
(OBJECTQUESTIONS])
(OBJECTQUESTION
[LAMBDA (VERB ADVERB ARRAYNAMES)
(CONS [CONS (QUOTE Who)
(CONS (MKATOM (CONCAT (L-CASE VERB)
(QUOTE s)))
(CONS (QUOTE *)
(COND
(ADVERB (ADVERBLST ADVERB]
(for N in ARRAYNAMES collect (CDDR (ASSOC N MSDATABASELST])
(OBJECTQUESTIONS
[LAMBDA NIL
(for VERB in VERB.TO.TABLE join (for ADVERB in (CDR VERB)
collect (OBJECTQUESTION
(CAR VERB)
(CAR ADVERB)
(CDR ADVERB))
unless (EQ (CAR VERB)
(QUOTE IS])
(SUBJECTQUESTION
[LAMBDA (VERB ADVERB ARRAYNAMES)
(CONS [CONS (QUOTE Whom)
(CONS (QUOTE does)
(CONS (QUOTE *)
(CONS (L-CASE VERB)
(COND
(ADVERB (ADVERBLST ADVERB]
(for N in ARRAYNAMES collect (CADR (ASSOC N MSDATABASELST])
(SUBJECTQUESTIONS
[LAMBDA NIL
(for VERB in VERB.TO.TABLE join (for ADVERB in (CDR VERB)
collect (SUBJECTQUESTION
(CAR VERB)
(CAR ADVERB)
(CDR ADVERB))
unless (EQ (CAR VERB)
(QUOTE IS])
(TELLABOUT
[LAMBDA (SUBJECTS UNIVERSE OMITQUESTIONS DUMPFILE)
(PROG (UNIVHARRAY)
(SETQ DUMPFILE (OUTPUT (OUTFILE DUMPFILE)))
[SETQ UNIVHARRAY (HARRAY (TIMES 2 (LENGTH UNIVERSE]
(for U in UNIVERSE do (PUTHASH U T UNIVHARRAY))
(SETQ QUESTIONS (for I from 1 as Q in (GETQUESTIONS)
collect Q unless (MEMBER I OMITQUESTIONS)))
(SETQ SUBJECTS (SORT (COPY SUBJECTS)))
(for STAIL on SUBJECTS as S in SUBJECTS
do
(PRIN1 S DUMPFILE)
(PRIN1 (QUOTE :)
DUMPFILE)
(TERPRI DUMPFILE)
[for Q in QUESTIONS
do
[SETQ ANSWER
(SORT (for H in (CDR Q) bind ANS X
do (SETQ X (GETHASH S H))
[COND
((LISTP X)
(for X1 in X
do (SETQ ANS (ADDTOSET X1 ANS))
when (GETHASH X1 UNIVHARRAY)))
((AND X (GETHASH X UNIVHARRAY))
(SETQ ANS (ADDTOSET X ANS]
finally (RETURN ANS]
(COND
(ANSWER
(SPACES 2 DUMPFILE)
(SETQ Q (CAR Q))
(PRIN1 (CAR Q)
DUMPFILE)
[for I in (CDR Q)
do (SPACES 1 DUMPFILE)
(COND
((EQ I (QUOTE *))
(PRIN1 S DUMPFILE))
(T (PRIN1 I DUMPFILE]
(PRIN1 (QUOTE ?)
DUMPFILE)
(TERPRI DUMPFILE)
(SPACES 5 DUMPFILE)
[for ANSTAIL on ANSWER
do (COND
((GREATERP (IPLUS (POSITION DUMPFILE)
(NCHARS (CAR ANSTAIL))
10)
(LINELENGTH))
(TERPRI DUMPFILE)
(SPACES 5 DUMPFILE)))
(PRIN1 (CAR ANSTAIL)
DUMPFILE)
[COND
((CDR ANSTAIL)
(COND
((EQLENGTH ANSWER 2)
(SPACES 1 DUMPFILE))
(T (PRIN1 ", " DUMPFILE]
(COND
((AND (CDR ANSTAIL)
(NULL (CDDR ANSTAIL)))
(PRIN1 "and " DUMPFILE]
(PRIN1 (QUOTE %.)
DUMPFILE)
(TERPRI DUMPFILE)
(TERPRI DUMPFILE]
when (NEQ S (CADR STAIL)))
(PRIN1
"
The following questions were asked about each of the atoms * above
that is followed by a colon:
" DUMPFILE)
(for Q in QUESTIONS do (TERPRI DUMPFILE)
(for W in (CAR Q)
do (SPACES 1 DUMPFILE)
(PRIN1 W DUMPFILE))
(PRIN1 (QUOTE ?)
DUMPFILE))
(PRIN1
"
Any question that is not posed under an atom above has the answer
%"no one%"." DUMPFILE)
(TERPRI DUMPFILE)
(TERPRI DUMPFILE)
(PRIN1
"
The answers to the questions were limited to the following set:
{" DUMPFILE)
[for U in (SORT (COPY UNIVERSE)) as UTAIL on UNIVERSE
do (COND
((GREATERP (IPLUS (POSITION DUMPFILE)
(NCHARS U)
2)
(LINELENGTH))
(TERPRI DUMPFILE)))
(PRIN1 U DUMPFILE)
(COND
((CDR UTAIL)
(PRIN1 ", " DUMPFILE]
(PRIN1 "}" DUMPFILE)
(TERPRI DUMPFILE)
(TERPRI DUMPFILE)
(CLOSEF DUMPFILE])
(TELLABOUTEVERYONE
[LAMBDA (OMITQUESTIONS DUMPFILE)
(PROG (TEMP)
(TELLABOUT (SETQ TEMP (EVERYONE))
TEMP OMITQUESTIONS DUMPFILE])
)
(RPAQQ REASONABLEOMISSIONLST
(2 5 6 7 8 12 13 17 21 25 30 33 34 35 36 40 41 45 49 53))
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: TELLBLOCK ADDTOSET ADVERBLST BASISTELLABOUT ENNUMERATEQUESTIONS
EVERYONE GETQUESTIONS OBJECTQUESTION OBJECTQUESTIONS
SUBJECTQUESTION SUBJECTQUESTIONS TELLABOUT TELLABOUTEVERYONE
(ENTRIES TELLABOUT ENNUMERATEQUESTIONS EVERYONE
TELLABOUTEVERYONE BASISTELLABOUT))
]
(DECLARE: DONTCOPY
(FILEMAP (NIL (801 6221 (ADDTOSET 813 . 906) (ADVERBLST 910 . 1236)
(BASISTELLABOUT 1240 . 1334) (ENNUMERATEQUESTIONS 1338 . 1644) (EVERYONE
1648 . 1926) (GETQUESTIONS 1930 . 2015) (OBJECTQUESTION 2019 . 2301)
(OBJECTQUESTIONS 2305 . 2552) (SUBJECTQUESTION 2556 . 2826) (
SUBJECTQUESTIONS 2830 . 3079) (TELLABOUT 3083 . 6059) (TELLABOUTEVERYONE
6063 . 6218)))))
STOP