Google
 

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