; NOTE:
;	McSAM must be read in before McELI, so that the readmacro for "?"
;	will be defined.


; The sentences and their parses for McELI

(SETQ STORY-TEXT
   '(
      (JACK WENT TO THE STORE)
      (HE GOT A KITE)
      (HE WENT HOME]
      
; "He" is ignored since McSAM has no provision for 
; matching "male person" against Jack.  This means that 
; "He got a kite" is parsed into just the ATRANS of a kite.
; The missing ACTOR, TO and FROM slots are filled in by McSAM

;**********************************************************************
; 		THE TOP-LEVEL STORY UNDERSTANDER
; 		McSAM and McELI -- together at last
;**********************************************************************

; DO-STORY takes a list of sentences in list form, such as STORY-TEXT.
; For each sentence, it calls McELI to get a conceptual analysis,
; then it calls McSAM to process the analysis.  It pauses before each 
; phase.  Type GO when asked.  At the end, the instantiated
; script form is printed.

(DE DO-STORY (STORY)
   (CLEAR-SCRIPTS)
   (LOOP
      [INITIAL SENTENCE NIL CONCEPT NIL]
      [WHILE (SETQ SENTENCE (POP STORY]
      [DO
         (MSG T T "Type GO to start McELI ")
         (READ)
         (MSG T "Parsing " SENTENCE)
         (SETQ CONCEPT (PARSE SENTENCE))
         (MSG T T "Final concept")
         (SPRINT CONCEPT 1)
         (MSG T T "Type GO to start McSAM ")
         (READ)
         (PROCESS-LINE CONCEPT)
      ]
   )
   (ADD-STM *CURRENT-SCRIPT*)
   (MSG T T "Story done -- the data base is")
   (SPRINT *DATA-BASE* 4]

;**********************************************************************
; 		McELI: THE ENGLISH LANGUAGE INTERPRETER
;**********************************************************************

; The heart of McELI is the variable *STACK*.  *STACK* is a list of
; packets of things that McELI is prepared to do.  For example,
; after McELI has analyzed the verb "go" into PTRANS, it prepares for 
; filling in the TO slot by putting a packet on *STACK* that says 
; "look for 'to <location>' OR look for 'home'".  Notice that a packet
; is a list of alternative situateions that may arise.  An alternative 
; is called a REQUEST and has this format:

; ((TEST predicate)
;  (ASSIGN variable1 expression1
;          variable2 expression2 ...)
;  (NEXT-PACKET request1 request2...))

; -- all three fields are optional

; -- the dictionary near the end of this file shows how words are
; defined with packets of requests

; The flow of control during analysis is:
;   1) read a word and put its packet on the front of *STACK*
;   2) take the first packet in *STACK*
;      take the first request in it whose test evaluates to true
;      if there are none, go to step 3
;      otherwise, remove the packet from *STACK*
;                 execute the assignments in the request
;                 save the request in the list TRIGGERED
;                 go to step 2
;   3) take each request saved in TRIGGERED and if it has a 
;      NEXT-PACKET clause then add the requests specified to *STACK*
;      go to step 1

; Note that only the first packet in *STACK* is checked.  If no
; request in it is triggered, then no more packets are checked and the 
; next word is read.  Also note that new packets are added in front of
; the pending ones.  *STACK* is a true "stack" or LIFO (last in, first
; out) data-control structure.  The first element in the list *STACK* 
; is called the "top" of the stack.

; The following variables are used by McELI:

; *SENTENCE* -- the sentence being analyzed
; *WORD* -- the current word being analyzed
; *CONCEPT* -- the CD form for the whole sentence
; *PREDICATES* -- the list of predicates describing the tokens built
; *STACK* -- the list of pending packets

; The following variables are English-oriented -- they are used only
; by the dictionary entries, not by the central McELI functions -- the
; pseudo-word *START* (see the dictionary) clears them at the start of 
; a sentence:

; *PART-OF-SPEECH* -- the current part of speech
; *CD-FORM* -- the current conceptual dependency form
; *SUBJECT* -- the CD form for the subject of the sentence

; (SPECIAL *SENTENCE* *WORD* *PART-OF-SPEECH* *CD-FORM*
;          *CONCEPT* *SUBJECT* *PREDICATES* *STACK*)

;**********************************************************************
; 	DATA STRUCTURES
;**********************************************************************

; McELI uses a stack for control -- the top of the stack is the first
; element in the list

(DE TOP-OF (STACK) (CAR STACK]

; ADD-STACK puts a packet at the front of the list of pending packets

(DE ADD-STACK (PACKET)
   (AND PACKET (SETQ *STACK* (CONS PACKET *STACK*)))
   PACKET]

; Word definitions are stored under the property DEFINITION.
; LOAD-DEF adds a word's request packet to the stack.

(DE LOAD-DEF ()
   (LET (PACKET (GET *WORD* 'DEFINITION))
      (COND
         (PACKET (ADD-STACK PACKET))
         ( T (MSG " -- not in the dictionary"]

; REQ-CLAUSE gets clauses from the format
;  ((TEST ...) (ASSIGN ...) (NEXT-PACKET ...))
; -- NOTE: this definition depends on CDR NIL = NIL

(DE REQ-CLAUSE (KEY L) (CDR (ASSOC KEY L]

;**********************************************************************
; 			PROGRAM
;**********************************************************************

; PARSE takes a sentence in list form -- e.g., (JACK WENT TO THE STORE)
; -- and returns the conceptual analysis for it.  It sets *SENTENCE*
; to the input sentence (e.g., (JACK WENT TO THE STORE)) with 
; the atom *START* stuck in front.  *START* is a pseudo-word in the 
; dictionary with information useful for starting the analysis.

; PARSE takes *SENTENCE* one word at a time, loads the packet
; for that word (if any), and then checks the top packet on the stack
; to see if any request in it has a true test.

; During the analysis, the variable *CONCEPT* will be set to the 
; main concept of the sentence (usually it will be set by the main
; verb's requests).  Since McELI builds CD forms with variables in them,
; McELI has to remove these variables when the sentence is finished, so
; that McSAM can use the CD form produced.  It uses the function
; REMOVE-ELI-VARIABLES to do this.

; When noun group tokens are built, predications like
; (PERSON (OBJECT JACK1)) are saved in *PREDICATES*.  Hence the
; analysis is really the union of *PREDICATES* and *CONCEPT*.

(DE PARSE (SENTENCE)
   (SETQ *CONCEPT* NIL)
   (SETQ *PREDICATES* NIL)
   (SETQ *STACK* NIL)
   (LOOP
      [INITIAL
         *WORD* NIL
         *SENTENCE* (CONS '*START* SENTENCE)
      ]
      [WHILE (SETQ *WORD* (POP *SENTENCE*]
      [DO
         (MSG T T "Processing " *WORD*)
         (LOAD-DEF)
         (RUN-STACK)
      ]
      [RESULT (APPEND1 *PREDICATES* (REMOVE-ELI-VARIABLES *CONCEPT*]
]

; RUN-STACK:
;    As long as some request in the expectation packet on top of 
; the stack can be triggered, the whole packet is removed from the
; stack, and that request is executed and saved.
;    When the top packet does not contain any triggerable requests,
; the packets in the requests that were executed and saved (if
; any) are added to the stack

(DE RUN-STACK ()
   (LOOP
      [INITIAL REQUEST NIL TRIGGERED NIL]
      [WHILE (SETQ REQUEST (CHECK-TOP *STACK*]
      [DO
         (POP *STACK*)
         (DO-ASSIGNS REQUEST)
         (SETQ TRIGGERED (CONS REQUEST TRIGGERED))
      ]
      [RESULT (ADD-PACKETS TRIGGERED]
]

; CHECK-TOP gets the first request in the packet on top of the stack 
; with a true test (if any)

(DE CHECK-TOP (STACK)
   (COND
      (STACK
         (LOOP
            [INITIAL REQUEST NIL PACKET (TOP-OF STACK]
            [WHILE (SETQ REQUEST (POP PACKET]
            [UNTIL (IS-TRIGGERED REQUEST]
            [RESULT REQUEST]
]

; IS-TRIGGERED returns true if a request has no test at all or if the
; test evaluates to true

(DE IS-TRIGGERED (REQUEST)
   (LET (TEST (REQ-CLAUSE 'TEST REQUEST))
      (OR (NULL TEST) (EVAL (CAR TEST]

; DO-ASSIGNS sets the variables given in the ASSIGN clause
; -- the first POP gets a variable and the second POP gets the value
; following it.

(DE DO-ASSIGNS (REQUEST)
   (LOOP
      [INITIAL ASSIGNMENTS (REQ-CLAUSE 'ASSIGN REQUEST]
      [WHILE ASSIGNMENTS]
      [DO (REASSIGN (POP ASSIGNMENTS) (POP ASSIGNMENTS)]
]

; REASSIGN set VAR to the value of VAL and prints a message saying 
; it did it

(DE REASSIGN (VAR VAL)
   (COND
      ((SET VAR (EVAL VAL))
         (MSG T "    " VAR " = ")
         (SPRINT (EVAL VAR) (POSN]

; ADD-PACKETS takes a list of requests and adds the packets
; attached to them to the stack

(DE ADD-PACKETS (REQUESTS)
   (LOOP
      [INITIAL REQUEST NIL]
      [WHILE (SETQ REQUEST (POP REQUESTS]
      [DO (ADD-STACK (REQ-CLAUSE 'NEXT-PACKET REQUEST]
]

; REMOVE-ELI-VARIABLES removes all the parser variables from a CD pattern
; -- the function EVAL gets the bindings of McELI's variables

(DE REMOVE-ELI-VARIABLES (CD-FORM) (REMOVE-VARIABLES CD-FORM 'EVAL]

;**********************************************************************
; 		TOKEN BUILDING FUNCTIONS
;**********************************************************************

; MAKE-TOKEN returns a new token from NAME, adding the given
; predications to *PREDICATES*
; -- for example "a man" would call (MAKE-TOKEN '(PERSON) 'MAN)
; which would return MAN1, saving the fact that MAN1 is a PERSON

(DE MAKE-TOKEN (PREDICATES NAME)
   (SAVE-PREDICATES (NEW-NAME NAME) PREDICATES]

; GET-TOKEN is like MAKE-TOKEN, but it reuses the last new token
; generated for NAME -- for example,"the man" would call 
; (GET-TOKEN '(PERSON) 'MAN), returning MAN1 as generated above
; -- if McELI didn't do this, then every time it parsed "the man"
; it would get a new token

(DE GET-TOKEN (PREDICATES NAME)
   (SAVE-PREDICATES (OLD-NAME NAME) PREDICATES]

; SAVE-PREDICATES saves the predications of a token on the list 
; *PREDICATES* -- for example, (SAVE-PREDICATES 'KITE1 (KITE RED))
; would save (KITE (OBJECT KITE1)) and (RED (OBJECT KITE1)) on the 
; list *PREDICATES* -- TOKEN is returned

(DE SAVE-PREDICATES (TOKEN PREDICATES)
   (LOOP
      [INITIAL PREDICATE NIL]
      [WHILE (SETQ PREDICATE (POP PREDICATES]
      [DO (SETQ *PREDICATES*
             (CONS (LIST PREDICATE (LIST 'OBJECT TOKEN))
                   *PREDICATES*]
      [RESULT TOKEN]
]

;**********************************************************************
; 		NAME GENERATING FUNCTIONS
;**********************************************************************

; NEW-NAME increments the counter for generating a name

(DE NEW-NAME (NAME)
   (MAKE-NAME NAME (ADD1 (OR (GET NAME 'NAME-COUNT) 0]

; OLD-NAME uses the current counter for generating a name

(DE OLD-NAME (NAME)
   (MAKE-NAME NAME (OR (GET NAME 'NAME-COUNT) 1]

; MAKE-NAME concatenates an atom and a number, and saves the 
; number under the atom -- in Rutgers LISP, *NOPOINT must be set to  
; T to avoid decimal points in the number

(DE MAKE-NAME (NAME COUNT)
   (INTERN (STRCONS NAME COUNT]

; The original definition in Rutgers LISP is as follows:

;(DE MAKE-NAME (NAME COUNT)
;   (LET (*NOPOINT T)
;      (READLIST (APPEND (EXPLODE NAME)
;                        (EXPLODE (PUTPROP NAME COUNT 'NAME-COUNT]

(DE SPRINT (S COL)	% Pretty-Print a symbolic expression
,  (PPAUX S COL 0 (LESSP COL (POSN)))
,,,)

;**********************************************************************
;			THE DICTIONARY
;**********************************************************************

; (DEF-WORD name request1 request2...) stores a definition
; under a word consisting of the list (request1 request2...)

(DF DEF-WORD (L)
   (PUTPROP (CAR L) (CDR L) 'DEFINITION)
   (CAR L]

; HE is a noun phrase that produces an empty CD form

(DEF-WORD HE
  ((ASSIGN *PART-OF-SPEECH* 'NOUN-PHRASE
	   *CD-FORM* NIL]

; JACK is a noun phrase that means a person named Jack

(DEF-WORD JACK
   ((ASSIGN *CD-FORM* (GET-TOKEN '(PERSON) *WORD*)
            *PART-OF-SPEECH* 'NOUN-PHRASE]

; GOT is a verb that means someone ATRANSed something to the subject.
; GOT looks for a noun phrase to fill the object slot.

(DEF-WORD GOT
   ((ASSIGN
      *PART-OF-SPEECH* 'VERB
      *CD-FORM* '(ATRANS (ACTOR ?GET-VAR3) (OBJECT ?GET-VAR2)
      			(TO ?GET-VAR1) (FROM ?GET-VAR3))
      GET-VAR1 *SUBJECT*
      GET-VAR2 NIL
      GET-VAR3 NIL)
    (NEXT-PACKET
      ((TEST (EQUAL *PART-OF-SPEECH* 'NOUN-PHRASE))
       (ASSIGN GET-VAR2 *CD-FORM*]

; WENT is a verb that means someone (the subject) PTRANSed himself to 
; somewhere from elsewhere.  WENT looks for "to <noun phrase>" or
; "home" to fill the TO slot.

(DEF-WORD WENT
   ((ASSIGN
      *PART-OF-SPEECH* 'VERB
      *CD-FORM* '(PTRANS (ACTOR ?GO-VAR1) (OBJECT ?GO-VAR1)
      			(TO ?GO-VAR2) (FROM ?GO-VAR3))
      GO-VAR1 *SUBJECT*
      GO-VAR2 NIL
      GO-VAR3 NIL)
    (NEXT-PACKET
      ((TEST (EQUAL *WORD* 'TO))
       (NEXT-PACKET
          ((TEST (EQUAL *PART-OF-SPEECH* 'NOUN-PHRASE))
           (ASSIGN GO-VAR2 *CD-FORM*))))
      ((TEST (EQUAL *WORD* 'HOME))
       (ASSIGN GO-VAR2 (GET-TOKEN '(HOUSE) *WORD*]

; A looks for a noun to build a noun phrase with a new token name

(DEF-WORD A
   ((TEST (EQUAL *PART-OF-SPEECH* 'NOUN))
      (ASSIGN
         *PART-OF-SPEECH* 'NOUN-PHRASE
         *CD-FORM* (MAKE-TOKEN *CD-FORM* *WORD*]

; THE looks for a noun to build a noun phrase with a new token name
   
(DEF-WORD THE
   ((TEST (EQUAL *PART-OF-SPEECH* 'NOUN))
      (ASSIGN
         *PART-OF-SPEECH* 'NOUN-PHRASE
         *CD-FORM* (GET-TOKEN *CD-FORM* *WORD*]

; KITE is a noun that builds the concept KITE

(DEF-WORD KITE
   ((ASSIGN *PART-OF-SPEECH* 'NOUN
   *CD-FORM* '(KITE]

; STORE is a noun that builds the concept STORE

(DEF-WORD STORE
   ((ASSIGN *PART-OF-SPEECH* 'NOUN
            *CD-FORM* '(STORE]

; *START* is loaded at the start of each sentence.  It looks for
; a noun phrase (the subject) followed by a verb (the main concept)

(DEF-WORD *START*
   ((ASSIGN
      *PART-OF-SPEECH* NIL
      *CD-FORM* NIL)
    (NEXT-PACKET
       ((TEST (EQUAL *PART-OF-SPEECH* 'NOUN-PHRASE))
        (ASSIGN *SUBJECT* *CD-FORM*)
        (NEXT-PACKET
           ((TEST (EQUAL *PART-OF-SPEECH* 'VERB))
            (ASSIGN *CONCEPT* *CD-FORM*]