; McSAM is a micro implementation of SAM, the Script Applier Mechanism, ; and is copied from the paper "MICRO-SAM AND MICRO-ELI, EXERCISES IN ; POPULAR COGNITIVE MECHANICS", by Christopher K. Riesbeck and Eugene ; Charniak, of September 1978 (Research Report #139, Yale University, ; Department of Computer Science). ;====================================================================== ; Included here is an excerpt from the paper referenced above: ; ; "The meaning of a sentence is represented using Conceptual ; Dependency (Schank 1975). Conceptual Dependency (CD) is based on a ; small set of predicates, called acts, describing basic everyday ; activities such as moving things and transferring information. Each ; predicate is associated with a standard set of roles or arguments. In ; addition to the acts, there are also states which acts can bring about ; or change, and large knowledge structures, such as scripts, which are ; built from combinations of acts and states. ; ; "There are 11 primitive acts in Conceptual Dependency, but only ; the following are used by McSAM and McELI examples in this report: ; ; 1. PTRANS -- an actor moves an object to a location from a ; location. In LISP we write ; (PTRANS (ACTOR actor) (OBJECT object) ; (TO location1) (FROM location2)) ; ; 2. ATRANS -- an actor transfers possession of an object to ; someone from someone. In LISP we write ; (ATRANS (ACTOR actor) (OBJECT object) ; (TO person1) (FROM person2)) ; ; 3. MTRANS -- an actor tells someone a conceptualization. In ; LISP we write ; (MTRANS (ACTOR actor) (OBJECT object) (TO person)) ; ; 4. INGEST -- an actor eats (or drinks) something. In LISP we ; write ; (INGEST (ACTOR actor) (OBJECT object)) ; ;====================================================================== ; First, define some of the useful tools available in their LISP. @LOOP ;*********************************************************************** ; DATA STRUCTURES ;*********************************************************************** ; A story is a list of lines and a line is a list of statements. ; A statement is a predicate (PTRANS, PERSON, etc.) plus zero or more ; arguments (e.g., (ACTOR JOHN1)). An example of a 3-line story is: (SETQ STORY-CDS '( ( % Jack went to the store. (STORE (OBJECT STORE1)) (PERSON (OBJECT JACK1)) (PTRANS (ACTOR JACK1) (OBJECT JACK1) (TO STORE1)) ) ( % He got a kite (KITE (OBJECT KITE1)) (ATRANS (OBJECT KITE1) (TO JACK1)) ) ( % He went home. (HOUSE (OBJECT HOUSE1)) (PTRANS (ACTOR JACK1) (OBJECT JACK1) (TO HOUSE1] ; The form (predicate role-pair role-pair...) is used to represent ; CD structures -- (PTRANS (ACTOR JACK1) (OBJECT JACK1) (TO STORE1)) ; -- script binding forms -- (SHOPPING (SHOPPER JACK1) (STORE STORE1)) ; -- and the pattern matcher's binding lists ; PREDICATE:STM gets the predicate of a CD form ; ARGUMENTS:STM gets the list of roles of a CD form (DE PREDICATE:STM (X) (CAR X)) (DE ARGUMENTS:STM (X) (CDR X)) ; role-paris have the form (role filler) -- ROLE:PAIR returns the role ; and FILLER:PAIR returns the filler (DE ROLE:PAIR (X) (CAR X] (DE FILLER:PAIR (X) (CADR X] ; A script is a list of events. An event is a CD form, which may ; have references to the roles of the script, as in ; (PTRANS (ACTOR ?SHOPPER) ...). All such references to script ; roles (also called variables) start with a question mark ("?"). ; This is converted internally to (*VAR* role-name), so ?FOO ; becomes (*VAR* FOO). ; Below are functions for 1) making this conversion (at read time), ; 2) deciding if something is a variable, and 3) retrieving the ; name of a variable (e.g., FOO) from the form (*VAR* FOO). (DRM ? (LIST '*VAR* (READ] (LEX "?" 'CHRCLMONOP) % special to this implementation (DE IS-VAR (X) (AND (CONSP X) (EQ (CAR X) '*VAR*] (DE NAME:VAR (X) (AND (CONSP X) (CONSP (CDR X)) (CADR X] ; Script names are atoms with an EVENTS property of the atom pointing ; to a list of events (DE EVENTS:SCRIPT (X) (AND X (GET X 'EVENTS] ; For example, this is the shopping script: (DEFPROP SHOPPING ( (PTRANS (ACTOR ?SHOPPER) (OBJECT ?SHOPPER) (TO ?STORE)) (PTRANS (ACTOR ?SHOPPER) (OBJECT ?BOUGHT) (TO ?SHOPPER)) (ATRANS (ACTOR ?STORE) (OBJECT ?BOUGHT) (FROM ?STORE) (TO ?SHOPPER) ) (ATRANS (ACTOR ?SHOPPER) (OBJECT MONEY) (FROM ?SHOPPER) (TO ?STORE) ) (PTRANS (ACTOR ?SHOPPER) (OBJECT ?SHOPPER) (FROM ?STORE) (TO ?ELSEWHERE) ) ) EVENTS ) ; Some predicates have associated scripts. For example, the SHOPPING ; script is associated with STORE. The script is stored under ; the ASSOCIATED-SCRIPT property of the predicate. (DE ASSOCIATED-SCRIPT:PREDICATE (X) (GET X 'ASSOCIATED-SCRIPT] ; For example, (DEFPROP STORE (SHOPPING (STORE ?OBJECT)) ASSOCIATED-SCRIPT) ; says that SHOPPING is the associated script for STORE. When McSAM ; processes (STORE (OBJECT STORE1)), (SHOPPING (STORE ?OBJECT)) ; says that the STORE role of the SHOPPING script is to be filled by ; the OBJECT slot of the STORE form. ;**************************************************************** ; PROGRAM ;**************************************************************** ; (SPECIAL *CURRENT-SCRIPT* *POSSIBLE-NEXT-EVENTS* *DATA-BASE*) ; This is presently not supported on this implementation. ; *DATA-BASE* is the pointer to the data base. ; *CURRENT-SCRIPT* is the script currently active. It is a statement ; with the script name as the predicate and the script variables and ; their bindings as the arguments. ; *POSSIBLE-NEXT-EVENTS* is a list of the events in *CURRENT-SCRIPT* ; that have not been seen yet. ; CLEAR-SCRIPTS resets these global variables to NIL (DE CLEAR-SCRIPTS () (SETQ *DATA-BASE* NIL) (SETQ *CURRENT-SCRIPT* NIL) (SETQ *POSSIBLE-NEXT-EVENTS* NIL] ; PROCESS-LINE takes one line of the story at a time. Each line is ; a list of statements (STM). Either a statement is in the data base ; or it fits into the currently active script or it suggests a new script. (DE PROCESS-LINE (STORY-LINE) (LOOP [INITIAL STM NIL] [WHILE (SETQ STM (POP STORY-LINE] [DO (MSG T "Processing " STM) (OR (FETCH STM) (INTEGRATE-INTO-SCRIPT STM) (SUGGEST-NEW-SCRIPT STM] ] ; The data base is simply a list of the statements we wish remembered. ; New items are added to the end of the list. (DE FETCH (STM) (COND ((MEMBER STM *DATA-BASE*) STM] (DE ADD-STM (STM) [OR (FETCH STM) (SETQ *DATA-BASE* (APPEND1 *DATA-BASE* STM)) ] STM] ; To integrate an incoming statement into the currently active script, ; find the first event in *POSSIBLE-NEXT-EVENTS* that matches the ; statement. If one is found, update the data base. (DE INTEGRATE-INTO-SCRIPT (STORY-STM) (LOOP [INITIAL BINDING-FORM NIL EVENT NIL EVENTS *POSSIBLE-NEXT-EVENTS* ] [WHILE (SETQ EVENT (POP EVENTS] [DO (COND ((SETQ BINDING-FORM (MATCH EVENT STORY-STM *CURRENT-SCRIPT*)) (SETQ *CURRENT-SCRIPT* BINDING-FORM) (MSG T "Matches " EVENT) (ADD-SCRIPT-INFO EVENT) ] [UNTIL BINDING-FORM] [RESULT BINDING-FORM] ] ; ADD-SCRIPT-INFO is given an event in a script (the one that matched ; the input in INTEGRATE-INTO-SCRIPT). Each script event up through ; POSITION is instantiated and added to the data base. (DE ADD-SCRIPT-INFO (POSITION) (LOOP [INITIAL EVENT NIL EVENTS *POSSIBLE-NEXT-EVENTS* ] [WHILE (SETQ EVENT (POP EVENTS] [DO (ADD-STM (INSTANTIATE EVENT *CURRENT-SCRIPT*] [UNTIL (EQUAL EVENT POSITION] [RESULT (SETQ *POSSIBLE-NEXT-EVENTS* EVENTS] ] ; SUGGGEST-NEW-SCRIPT takes a CD form, adds it to the data base, and ; checks the predicate of the form to see if it is linked to a script ; -- e.g., STORE is linked to the SHOPPING script. If there was a ; previous script, add it to the data base before switching. ; Note that any events that were left in *POSSIBLE-NEXT-EVENTS* ; are not instantiated. (DE SUGGEST-NEW-SCRIPT (STORY-STM) (ADD-STM STORY-STM) (LET (POSSIBILITY (ASSOCIATED-SCRIPT:PREDICATE (PREDICATE:STM STORY-STM))) (COND (POSSIBILITY (AND *CURRENT-SCRIPT* (ADD-STM *CURRENT-SCRIPT*)) (MSG T "New script") (SETQ *CURRENT-SCRIPT* (INSTANTIATE POSSIBILITY STORY-STM)) (SETQ *POSSIBLE-NEXT-EVENTS* (EVENTS:SCRIPT (PREDICATE:STM *CURRENT-SCRIPT*)) ] ; INSTANTIATE replaces all the variables in a CD pattern with their ; values -- the function GET-BINDING gets the value of a variable ; from the free variable *BINDING-FORM* ; (SPECIAL *BINDING-FORM*) ; This is presently not supported on this implementation. (DE INSTANTIATE (PAT *BINDING-FORM*) (LET (STM (REMOVE-VARIABLES PAT 'GET-BINDING)) (MSG T "Instantiating " STM) STM ] (DE GET-BINDING (VAR) (BINDING VAR *BINDING-FORM*] ; REMOVE-VARIABLES takes a CD form like ; (act (ACTOR var1) (OBJECT var2) ...) ; where each vari has the form (*VAR* atom), plus a function that ; gets the binding of variables. It returns the CD with all the ; variables replaced by their bindings: ; -- If the variable is bound to NIL then the role is omitted ; -- If it is bound to a token, then the token replaces the ; (*VAR* atom) ; -- If it is bound to a CD, then the CD with its variables removed ; replaces the (*VAR* atom) (DE REMOVE-VARIABLES (CD-FORM GET-VAL-FN) (COND ((ATOM CD-FORM) CD-FORM) ( T (LOOP [INITIAL ROLE NIL FILLER NIL RESULT NIL ROLES (ARGUMENTS:STM CD-FORM) ] [WHILE (SETQ ROLE (POP ROLES] [DO (COND ((SETQ FILLER (GET-ROLE-VAL ROLE GET-VAL-FN)) (SETQ RESULT (APPEND1 RESULT (LIST (ROLE:PAIR ROLE) FILLER] [RESULT (CONS (PREDICATE:STM CD-FORM) RESULT] ] ; GET-ROLE-VAL gets the filler of a role and if it is a variable ; (i.e., (*VAR* atom)) it gets the value of the variable -- then ; REMOVE-VARIABLES is called to get rid of any variables in the ; this value (DE GET-ROLE-VAL (ROLE GET-VAL-FN) (REMOVE-VARIABLES (LET (FORM (FILLER:PAIR ROLE)) (COND ((IS-VAR FORM) (GET-VAL-FN (NAME:VAR FORM)) ) ( T FORM) ) ) GET-VAL-FN] ;********************************************************************** ; PATTERN MATCHER ;********************************************************************** ; MATCH takes three (predicate role-pair...) forms: ; 1) a pattern form which may contain variables ; 2) a constant form which has no variables ; 3) a binding form which is used to specify the bindings of the variables ; in the pattern (if NIL is given for the binding form, (T) is ; assumed) ; for example, if ; pattern = (PTRANS (ACTOR (*VAR* SHOPPER)) (TO (*VAR* STORE))) ; constant = (PTRANS (ACTOR JACK0) (TO STORE0)) ; binding = (SHOPPING (SHOPPER JACK0) (STORE STORE0)) ; then the variables in the pattern are SHOPPER and STORE and the ; binding form says that these variables are bound to JACK0 and STORE0 ; The pattern matches the constant if the predicates are equal and if ; all of the roles in the pattern are matched by roles in the constant ; -- a variable matches if its binding matches ; -- roles in the constant that are not in the pattern are ignored ; MATCH returns either NIL if the match failed or an updated binding ; form that includes any new variable bindings that may have been made ; a NIL constant always matches (DE MATCH (PAT CONST BIND-LIST) (LET (BINDING-FORM (OR BIND-LIST (LIST T))) (COND ((OR (NULL CONST) (EQUAL PAT CONST)) BINDING-FORM) ((IS-VAR PAT) (MATCH-VAR PAT CONST BINDING-FORM)) ((OR (ATOM CONST) (ATOM PAT)) NIL) ((EQ (PREDICATE:STM PAT) (PREDICATE:STM CONST)) (MATCH-ARGS (ARGUMENTS:STM PAT) CONST BINDING-FORM] ; MATCH-ARGS takes a list of role pairs (a role pair has the form ; (role filler), a constant CD form, and a binding form ; it goes through the list of pairs and matches each pair against the ; corresponding role pair in the constant form -- all of these must ; match (DE MATCH-ARGS (PAT-ARGS CONST BINDING-FORM) (LOOP [INITIAL PAT-ARG NIL CONST-VAL NIL ] [WHILE (SETQ PAT-ARG (POP PAT-ARGS] [DO (SETQ CONST-VAL (BINDING (ROLE:PAIR PAT-ARG) CONST] [UNTIL (NULL (SETQ BINDING-FORM (MATCH (FILLER:PAIR PAT-ARG) CONST-VAL BINDING-FORM) ] [RESULT BINDING-FORM] ] ; MATCH-VAR takes a variable, a constant, and a binding form ; -- if the variable has a binding then the binding must match th ; constant -- otherwise the binding form is updated to bind the ; variable to the constant (DE MATCH-VAR (PAT CONST BINDING-FORM) (LET (VAR-VALUE (BINDING (NAME:VAR PAT) BINDING-FORM)) (COND (VAR-VALUE (MATCH VAR-VALUE CONST BINDING-FORM)) ( T (APPEND1 BINDING-FORM (LIST (NAME:VAR PAT) CONST] ; a variable binding is found by looking for the variable name in ; a list of role pairs and returning the filler if a pair is found ; with that name as a role (DE BINDING (VAR-NAME BINDING-FORM) (LET [PAIR (ASSOC VAR-NAME (ARGUMENTS:STM BINDING-FORM] (COND (PAIR (FILLER:PAIR PAIR] ; clear the data base (CLEAR-SCRIPTS)