1335 lines
45 KiB
Plaintext
1335 lines
45 KiB
Plaintext
"REDS file: imitates old parser.
|
||
Copyright (C) 1988 Infocom, Inc. All rights reserved."
|
||
|
||
<ZZPACKAGE "REDS">
|
||
|
||
<ENTRY RED-SP RED-ADV RED-PART
|
||
RED-SV RED-SVN RED-SVNP RED-SVPNPN RED-SVPNN RED-SVNPN RED-SD RED-SVD
|
||
RED-PERS RED-VP RED-NP RED-OF RED-QT RED-QN RED-NPP RED-PP
|
||
RED-POSS RED-ADJ RED-QUOTE>
|
||
|
||
<ENTRY RED-O-ADJ RED-O-PP RED-O-NP NUMERIC-ADJ?>
|
||
|
||
<INCLUDE "BASEDEFS" "FIND" "PBITDEFS" "PDEFS">
|
||
|
||
<USE "NEWSTRUC" "PARSER" "PMEM" "PSTACK">
|
||
|
||
<FILE-FLAGS MDL-ZIL? ;ZAP-TO-SOURCE-DIRECTORY?>
|
||
|
||
<BEGIN-SEGMENT 0>
|
||
|
||
<DEFMAC ABS ('NUM)
|
||
<FORM COND (<FORM L? .NUM 0> <FORM - 0 .NUM>)
|
||
(T .NUM)>>
|
||
|
||
"Generic reduction, which just returns a list of frobs"
|
||
<DEFINE RED-FCN ("OPT" N:FIX TYP:FIX)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "ANY">) (T <RFALSE>)>)>
|
||
<COND (<==? .N 0> T)
|
||
(<==? .N 1>
|
||
<POP-PSTACK ,DATA-STACK>)>>
|
||
|
||
<DEFINE RED-PART RP ("OPT" N:FIX TYP:FIX "AUX" WD)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "?PART">) (T <RFALSE>)>)>
|
||
<COND (<==? .N 0>
|
||
<RETURN T .RP>)>
|
||
<SET WD <POP-PSTACK ,DATA-STACK>>
|
||
<COND (<AND <NOT <EQUAL? .WD T ,W?OF>>
|
||
<NOT <WORD-TYPE? .WD ,P-PARTICLE-CODE>>>
|
||
<RETURN <> .RP>)
|
||
(<==? .N 1>
|
||
<RETURN .WD .RP>)
|
||
(T
|
||
<POP-PSTACK ,DATA-STACK>)>>
|
||
|
||
<DEFINE GET-SYNTAX GS (VA:TABLE NUM "OPT" (PREP 0) (GWIM <>) "AUX" LEN)
|
||
<COND (<==? .PREP 1>
|
||
<SET PREP 0>)>
|
||
<COND (<1? .NUM>
|
||
<SET LEN ,VERB-ONE-SYNTAX-LEN ;6>)
|
||
(T
|
||
<SET LEN ,VERB-TWO-SYNTAX-LEN ;10>)>
|
||
<REPEAT ((CT:FIX <ZGET .VA 0>) S2 (P2 <PARSE-PARTICLE2 ,PARSE-RESULT>)
|
||
(GWIM-NOW <>)
|
||
(SYN <IF-MUDDLE <CHTYPE <ZREST .VA 2> VERB-SYNTAX>
|
||
<ZREST .VA 2>>))
|
||
<COND (<AND <==? .PREP <SYNTAX-PREP ;1 .SYN 1>>
|
||
<OR <1? .NUM>
|
||
<EQUAL? .P2
|
||
<SET S2 <SYNTAX-GET .SYN ,SYN-PREP 2>>>
|
||
<AND <0? .S2>
|
||
<1? .P2>>
|
||
<AND <T? .GWIM-NOW>
|
||
<T? <SET S2 <COND (<1? .NUM> .PREP) (T .S2)>>>
|
||
<ZPUT ,GWIM-MSG 0 .S2>>>>
|
||
<PARSE-SYNTAX ;3 ,PARSE-RESULT .SYN>
|
||
<PARSE-ACTION ;4 ,PARSE-RESULT <SYNTAX-ID .SYN>>
|
||
<PARSE-PARTICLE1 ,PARSE-RESULT .PREP>
|
||
<RETURN .SYN .GS>)
|
||
(<L? <SET CT <- .CT 1>> 1>
|
||
<COND (<AND <T? .GWIM>
|
||
<F? .GWIM-NOW>>
|
||
<SET CT <ZGET .VA 0>>
|
||
<SET GWIM-NOW T>
|
||
<SET SYN <IF-MUDDLE <CHTYPE <ZREST .VA 2> VERB-SYNTAX>
|
||
<ZREST .VA 2>>>
|
||
<AGAIN>)
|
||
(T
|
||
<RETURN <> .GS>)>)
|
||
(T
|
||
<SET SYN <IF-MUDDLE <CHTYPE <ZREST .SYN .LEN> VERB-SYNTAX>
|
||
<ZREST .SYN .LEN>>>)>>>
|
||
|
||
"Reduction for case of verb with no objects. If OK, win. Otherwise,
|
||
try defaulting (and go to case of verb with one object)/orphaning..."
|
||
|
||
<DEFINE RED-SV ("OPT" N:FIX TYP:FIX "AUX" SYN VERB PART DATA:VERB-DATA OBJ)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "VP-?P">) (T <RFALSE>)>)>
|
||
<SET PART <POP-PSTACK ,DATA-STACK>>
|
||
<POP-PSTACK ,DATA-STACK>
|
||
<COND (<SET VERB <ROOT-VERB <PARSE-VERB ,PARSE-RESULT>>>
|
||
<SET DATA <WORD-VERB-STUFF .VERB>>
|
||
<COND (<AND <1? .PART>
|
||
<L=? 0 <VERB-ZERO .DATA>:FIX>>
|
||
;"Verb can take no args, so this flies"
|
||
<PARSE-ACTION ,PARSE-RESULT <VERB-ZERO .DATA>>
|
||
T ;,PARSE-RESULT)
|
||
(<AND <SET SYN <VERB-ONE .DATA>>
|
||
<SET SYN <GET-SYNTAX .SYN 1 .PART T>>
|
||
<SET OBJ <DETERMINE-OBJ <> 1>>>
|
||
<PARSE-OBJ1 ,PARSE-RESULT .OBJ>
|
||
T ;,PARSE-RESULT)
|
||
(<AND <SET SYN <VERB-TWO .DATA>>
|
||
<SET SYN <GET-SYNTAX .SYN 2 .PART T>>
|
||
<SET OBJ <DETERMINE-OBJ <> 1>>>
|
||
<PARSE-OBJ1 ,PARSE-RESULT .OBJ>
|
||
<ZPUT ,ORPHAN-S ,O-OBJECT <NOUN-PHRASE-OBJ1 .OBJ>>
|
||
<COND (<SET OBJ <DETERMINE-OBJ <> 2>>
|
||
<PARSE-OBJ2 ,PARSE-RESULT .OBJ>
|
||
T ;,PARSE-RESULT)>)>)>>
|
||
|
||
<DEFINE ROOT-VERB (VERB "AUX" DATA)
|
||
<COND (<AND <T? <WORD-FLAGS .VERB>>
|
||
<SET DATA <WORD-SEMANTIC-STUFF .VERB>>>
|
||
<SET VERB .DATA>)>
|
||
.VERB>
|
||
|
||
<DEFINE RED-SVN ("OPT" N:FIX TYP:FIX
|
||
"AUX" SYN1 SYN2 VERB PART DATA OBJ OBJ1 OBJ2)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "VP-?P-NP">) (T <RFALSE>)>)>
|
||
<SET OBJ <POP-PSTACK ,DATA-STACK>>
|
||
<SET PART <POP-PSTACK ,DATA-STACK>>
|
||
;<PARSE-PARTICLE1 ,PARSE-RESULT .PART>
|
||
<POP-PSTACK ,DATA-STACK> ;"RED-SVNP depends on these POPs"
|
||
<COND (<SET VERB <ROOT-VERB <PARSE-VERB ,PARSE-RESULT>>>
|
||
<SET DATA <WORD-VERB-STUFF .VERB>>
|
||
<COND (<AND <ZERO? <PARSE-PARTICLE2 ,PARSE-RESULT>>
|
||
<SET SYN1 <VERB-ONE .DATA>>
|
||
<SET SYN1 <GET-SYNTAX .SYN1 1 .PART>>>
|
||
;<PARSE-PARTICLE1 ,PARSE-RESULT .PART> ;"SWG 28-Jul-88"
|
||
<COND (<NOT <SET OBJ1 <DETERMINE-OBJ .OBJ 1>>>
|
||
<PARSER-ERROR 0 ,PARSER-ERROR-NOOBJ .OBJ
|
||
.PART ;<SYNTAX-SEARCH ;B5 .SYN1 1>>)
|
||
(<AND <EQUAL? ,INTDIR <NOUN-PHRASE-OBJ1 .OBJ1>>
|
||
<ZAPPLY ,DIR-VERB-WORD?
|
||
<PARSE-VERB ,PARSE-RESULT>>
|
||
<PUSH-PSTACK ,DATA-STACK <NP-NAME .OBJ>>>
|
||
<RED-SD 1 .TYP>)
|
||
(T
|
||
<PARSE-OBJ1 ,PARSE-RESULT .OBJ1>
|
||
,PARSE-RESULT)>)
|
||
(<AND <SET SYN2 <VERB-TWO .DATA>>
|
||
<SET SYN2 <GET-SYNTAX .SYN2 2 .PART T>>>
|
||
;<PARSE-PARTICLE1 ,PARSE-RESULT .PART> ;"SWG 28-Jul-88"
|
||
<COND (<NOT <SET OBJ1 <DETERMINE-OBJ .OBJ 1>>>
|
||
<PARSER-ERROR 0 ,PARSER-ERROR-NOOBJ .OBJ
|
||
.PART ;<SYNTAX-SEARCH ;B5 .SYN2 1>>)
|
||
(T
|
||
<PARSE-OBJ1 ,PARSE-RESULT .OBJ1>
|
||
<ZPUT ,ORPHAN-S ,O-OBJECT <NOUN-PHRASE-OBJ1 .OBJ1>>
|
||
<COND (<SET OBJ2 <DETERMINE-OBJ <> 2>>
|
||
<PARSE-OBJ2 ,PARSE-RESULT .OBJ2>
|
||
,PARSE-RESULT)>)>)
|
||
;(T
|
||
<PARSER-ERROR 0 ,PARSER-ERROR-NOOBJ .OBJ
|
||
.PART ;<SYNTAX-SEARCH ;B5 .SYN1 1>>)>)>>
|
||
|
||
<DEFINE RED-SVNP ("OPT" N:FIX TYP:FIX "AUX" PART OBJ)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "VP-NP-P">) (T <RFALSE>)>)>
|
||
<SET PART <POP-PSTACK ,DATA-STACK>>
|
||
<SET OBJ <POP-PSTACK ,DATA-STACK>>
|
||
;"PICK OBJECT UP = PICK UP OBJECT"
|
||
<PUSH-PSTACK ,DATA-STACK .PART>
|
||
<PUSH-PSTACK ,DATA-STACK .OBJ>
|
||
<COND (<NOT <RED-SVN .N .TYP>>
|
||
<PUSH-PSTACK ,DATA-STACK <PARSE-VERB ,PARSE-RESULT>>
|
||
<PUSH-PSTACK ,DATA-STACK T>
|
||
<PARSE-PARTICLE2 ,PARSE-RESULT .PART>
|
||
<PUSH-PSTACK ,DATA-STACK .OBJ>
|
||
<RED-SVN .N .TYP>)
|
||
(T T)>>
|
||
|
||
<DEFINE RED-SVNPN ("OPT" N:FIX TYP:FIX "AUX" OBJ2 ;PART OBJ1)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "VP-NP-P-NP">)
|
||
(T <RFALSE>)>)>
|
||
<SET OBJ2 <POP-PSTACK ,DATA-STACK>>
|
||
<PARSE-PARTICLE2 ,PARSE-RESULT <POP-PSTACK ,DATA-STACK>>
|
||
<SET OBJ1 <POP-PSTACK ,DATA-STACK>>
|
||
;<COND (<AND <EQUAL? <PARSE-VERB ,PARSE-RESULT> ,W?SAY>
|
||
<EQUAL? <PARSE-PARTICLE2 ,PARSE-RESULT> ,W?TO>
|
||
<PMEM? .OBJ1>
|
||
<PMEM-TYPE? .OBJ1 NOUN-PHRASE>
|
||
<EQUAL? <NOUN-PHRASE-OBJ1 .OBJ1> ,INTQUOTE>>
|
||
;"etc."
|
||
)>
|
||
;<PUSH-PSTACK ,DATA-STACK .PART>
|
||
<PUSH-PSTACK ,DATA-STACK .OBJ1>
|
||
<PUSH-PSTACK ,DATA-STACK .OBJ2>
|
||
<DEC N>
|
||
<RED-SVPNN .N .TYP>>
|
||
|
||
<DEFINE RED-SVPNN ("OPT" N:FIX TYP:FIX "AUX" N1 N2 (PART <>) OBJ1 OBJ2 SYN)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "VP-?P-NP-NP">)
|
||
(T <RFALSE>)>)>
|
||
<SET N2 <POP-PSTACK ,DATA-STACK>>
|
||
<COND (<0? <PARSE-PARTICLE2 ;8 ,PARSE-RESULT>>
|
||
<PARSE-PARTICLE2 ;8 ,PARSE-RESULT <OR <ZGET ,GWIM-MSG 0> 1>>)>
|
||
<SET N1 <POP-PSTACK ,DATA-STACK>>
|
||
<COND (<==? .N 4>
|
||
<SET PART <POP-PSTACK ,DATA-STACK>>)>
|
||
<COND (<NOT <SET SYN <ROOT-VERB <PARSE-VERB ,PARSE-RESULT>>>>
|
||
<PARSER-ERROR 0 ;"No syntax" ,PARSER-ERROR-NOUND>)
|
||
(<NOT <SET SYN <VERB-TWO <WORD-VERB-STUFF .SYN>>>>
|
||
<PARSER-ERROR 0 ,PARSER-ERROR-TMNOUN>)
|
||
(<NOT <SET SYN <GET-SYNTAX .SYN 2 .PART>>>
|
||
<PARSER-ERROR 0 ;"No syntax" ,PARSER-ERROR-NOUND>)
|
||
(<NOT <SET OBJ1 <DETERMINE-OBJ .N1 1>>>
|
||
<PARSER-ERROR 0 ,PARSER-ERROR-NOOBJ .N1
|
||
.PART ;<SYNTAX-SEARCH ;B5 .SYN 1>>)
|
||
(<NOT <SET OBJ2 <DETERMINE-OBJ .N2 2>>>
|
||
<PARSER-ERROR 0 ,PARSER-ERROR-NOOBJ .N2
|
||
.PART ;<SYNTAX-SEARCH ;B9 .SYN 2>>)
|
||
(<ZAPPLY ,DIR-VERB-PRSI? .OBJ2>
|
||
<PARSER-ERROR 0 ;"Not a direction" ,PARSER-ERROR-NOUND>)
|
||
(T
|
||
<POP-PSTACK ,DATA-STACK>
|
||
<PARSE-OBJ1 ,PARSE-RESULT .OBJ1>
|
||
<PARSE-OBJ2 ,PARSE-RESULT .OBJ2>
|
||
T)>>
|
||
|
||
<DEFINE RED-SVPNPN ("OPT" N:FIX TYP:FIX "AUX" N2)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "VP-P-NP-P-NP">)
|
||
(T <RFALSE>)>)>
|
||
<SET N2 <POP-PSTACK ,DATA-STACK>>
|
||
<PARSE-PARTICLE2 ,PARSE-RESULT <POP-PSTACK ,DATA-STACK>>
|
||
<PUSH-PSTACK ,DATA-STACK .N2>
|
||
<RED-SVPNN <- .N 1> .TYP>>
|
||
|
||
<DEFINE RED-SD ("OPT" N:FIX TYP:FIX "AUX" V)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "DIR=S">) (T <RFALSE>)>)>
|
||
<PARSE-VERB ,PARSE-RESULT <SET V ,W?WALK>>
|
||
<GET-SYNTAX <VERB-ONE <WORD-VERB-STUFF .V>> 1 <>>
|
||
<SETG P-WALK-DIR <WORD-DIR-ID <POP-PSTACK ,DATA-STACK>>>
|
||
;<SETG PRSO ,P-WALK-DIR>
|
||
<PARSE-OBJ1 ,PARSE-RESULT <PMEM-ALLOC NOUN-PHRASE
|
||
COUNT 1
|
||
LENGTH ,NOUN-PHRASE-MIN-LENGTH
|
||
OBJ1 ,P-WALK-DIR>>
|
||
T ;,PARSE-RESULT>
|
||
|
||
<DEFINE RED-SVD ("OPT" N:FIX TYP:FIX "AUX" DIR)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "VP-DIR">) (T <RFALSE>)>)>
|
||
<SET DIR <POP-PSTACK ,DATA-STACK>>
|
||
<COND (<ZAPPLY ,DIR-VERB-WORD? <PARSE-VERB ,PARSE-RESULT>>
|
||
<POP-PSTACK ,DATA-STACK>
|
||
<PUSH-PSTACK ,DATA-STACK .DIR>
|
||
<RED-SD <- .N 1> .TYP>)>>
|
||
|
||
<DEFINE RED-SP ("OPT" N:FIX TYP:FIX "AUX" A)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "SP">) (T <RFALSE>)>)>
|
||
<SET A <POP-PSTACK ,DATA-STACK>>
|
||
<DEC N>
|
||
<COND (<AND <EQUAL? .N 2 ;3>
|
||
<N==? T .A>>
|
||
<PARSE-ADV ,PARSE-RESULT <OR <WORD-SEMANTIC-STUFF .A> .A>>)>
|
||
<FLUSH-PSTACK ,DATA-STACK .N>
|
||
,PARSE-RESULT>
|
||
|
||
<GLOBAL SEARCH-FLAGS:NUMBER 0>
|
||
|
||
<DEFINE IREDUCE-EXCEPTION (ENP:PMEM NP:PMEM)
|
||
;"Both ENP and NP are NPs"
|
||
<COND (<==? <NP-NAME .ENP> ,W?ONE>
|
||
;"All books except the red one..."
|
||
<NP-NAME .ENP <NP-NAME .NP>>)>
|
||
<COND (<NOT <NP-QUANT .ENP>>
|
||
<NP-QUANT .ENP ,NP-QUANT-ALL>)>
|
||
<SETG SEARCH-FLAGS <BOR ,SEARCH-ALL ;15 ,SEARCH-MANY ;16>>
|
||
<DETERMINE-NP 0 0 .ENP>>
|
||
|
||
<DEFINE REDUCE-EXCEPT-IT (PHR NP)
|
||
<COND (<AND <==? 1 <NOUN-PHRASE-COUNT .PHR>>
|
||
<==? ,IT <NOUN-PHRASE-OBJ1 .PHR>>>
|
||
<COND (<ZERO? ,P-IT-OBJECT>
|
||
<PARSER-ERROR 0 ,PARSER-ERROR-NOOBJ .NP>)
|
||
;(<NOT <VISIBLE? ,P-IT-OBJECT>>
|
||
<NOT-HERE ,P-IT-OBJECT>)
|
||
(T
|
||
<NOUN-PHRASE-OBJ1 .PHR ,P-IT-OBJECT>)>)>>
|
||
|
||
<DEFINE REDUCE-EXCEPTION RE (PP:PMEM NP:PMEM "AUX"
|
||
(ENP:PMEM <PP-NOUN .PP>) NOUN-PHRASE)
|
||
<COND
|
||
(<PMEM-TYPE? .ENP NP>
|
||
;"Just one thing"
|
||
<COND (<SET NOUN-PHRASE <IREDUCE-EXCEPTION .ENP .NP>>
|
||
;"Returns a noun-phrase, which we can then stuff into
|
||
an NPP to be stuffed into the EXCEPT slot"
|
||
<REDUCE-EXCEPT-IT .NOUN-PHRASE .ENP>
|
||
<NP-EXCEPT .NP <PMEM-ALLOC NPP
|
||
NOUN .ENP
|
||
NOUN-PHRASE .NOUN-PHRASE>>
|
||
.NP)>)
|
||
(T
|
||
;"NPP"
|
||
<REPEAT (RES (NNP:<OR PMEM FALSE> .ENP) (GOOD <>) BAD)
|
||
<COND (<SET RES <IREDUCE-EXCEPTION <SET BAD <NPP-NOUN .NNP>> .NP>>
|
||
<SET GOOD T>
|
||
<REDUCE-EXCEPT-IT .RES .BAD>
|
||
<NPP-NOUN-PHRASE .NNP .RES>)>
|
||
<COND (<NOT <SET NNP <NPP-NEXT .NNP>>>
|
||
<COND (<T? .GOOD>
|
||
<NP-EXCEPT .NP .ENP>
|
||
<RETURN .NP .RE>)
|
||
(T
|
||
<RETURN <PARSER-ERROR 0 ,PARSER-ERROR-NOOBJ .BAD> .RE>)>)>>)>>
|
||
|
||
<CONSTANT P-NO-INSIDE "No inside">
|
||
<CONSTANT P-NO-SURFACE "No surface">
|
||
<CONSTANT P-NOTHING "Nothing">
|
||
|
||
<CONSTANT PREP-BIT <ITABLE 3 0>>
|
||
|
||
<DEFINE REDUCE-LOCATION RL
|
||
(PP:PMEM
|
||
"OPT" (SYN:<OR FALSE VERB-SYNTAX> <>)
|
||
(WHICH:<OR FIX FALSE> <>)
|
||
"AUX" (SEARCH <COND (.SYN
|
||
<COND (<==? .WHICH 1>
|
||
<SYNTAX-SEARCH .SYN 1>)
|
||
(T
|
||
<SYNTAX-SEARCH .SYN 2>)>)>)
|
||
(TEST <COND (.SYN
|
||
<COND (<==? .WHICH 1>
|
||
<SYNTAX-FIND .SYN 1>)
|
||
(T
|
||
<SYNTAX-FIND .SYN 2>)>)>)
|
||
(PREP:VWORD <PP-PREP .PP>)
|
||
(NP:PMEM <PP-NOUN .PP>) (RLOC <>)
|
||
(BIT 0) (MSG <>) "VALUE" <OR PMEM FALSE>)
|
||
<COND (<NOT .SEARCH> <SET SEARCH <BOR ,SEARCH-HELD ,SEARCH-ON-GROUND> ;5>)>
|
||
;<COND (<NOT .TEST> <SET TEST ,TEST-PREP>)>
|
||
<COPYT ,PREP-BIT 0 6>
|
||
<COND
|
||
(<EQUAL? .PREP ,W?BUT ,W?EXCEPT>
|
||
<RETURN <> .RL>)
|
||
;(<EQUAL? .PREP ,W?UNDER>
|
||
<SET BIT ,F?HAS-UNDER>
|
||
<SET MSG ,P-NO-UNDERSIDE>)
|
||
;(<EQUAL? .PREP ,W?ABOUT ,W?FOR ,W?TO>)
|
||
(<EQUAL? .PREP ,W?IN ,W?INSIDE>
|
||
<SET BIT ,CONTBIT>
|
||
<SET MSG ,P-NO-INSIDE>)
|
||
(<EQUAL? .PREP ,W?ON ,W?OFF>
|
||
<SET BIT ,SURFACEBIT>
|
||
<SET MSG ,P-NO-SURFACE>)
|
||
;(<EQUAL? .PREP ,W?BEHIND>
|
||
<SET BIT ,F?HAS-BEHIND>
|
||
<SET MSG ,P-NO-BACKSIDE>)
|
||
(<EQUAL? .PREP ,W?FROM ;,W?OF>
|
||
<SET BIT ,SURFACEBIT>
|
||
<ZPUT ,PREP-BIT 1 ,PERSONBIT>
|
||
<ZPUT ,PREP-BIT 2 ,CONTBIT>
|
||
<SET MSG ,P-NOTHING>)
|
||
(T
|
||
<RETURN <> .RL>)>
|
||
<ZPUT ,PREP-BIT 0 .BIT>
|
||
<COND (<PMEM-TYPE? .NP NP>
|
||
<COND (<SET RLOC <NP-LOC .NP>:PMEM>
|
||
<SET RLOC <NOUN-PHRASE-OBJ1 <LOCATION-OBJECT .RLOC>:PMEM>>)>
|
||
<MAKE-FINDER 'FINDER ,FINDER
|
||
'FIND-APPLIC .TEST
|
||
'FIND-RES ,SEARCH-RES
|
||
'FIND-ADJS <NP-ADJS .NP>
|
||
'FIND-NOUN <NP-NAME .NP>
|
||
'FIND-NUM <NUMERIC-ADJ? .NP>>
|
||
<SET SEARCH <FIND-OBJECTS <COND (<NOT .RLOC> .SEARCH) (T 0)>
|
||
.RLOC>>
|
||
;<FIND-NUM ,FINDER 0>
|
||
<COND (.SEARCH
|
||
<SET RLOC <PMEM-ALLOC NOUN-PHRASE
|
||
COUNT 1
|
||
LENGTH ,NOUN-PHRASE-MIN-LENGTH
|
||
OBJ1 <FIND-RES-OBJ1 ,SEARCH-RES>
|
||
NP1 .NP>>
|
||
<PMEM-ALLOC LOCATION PREP .PREP OBJECT .RLOC>)
|
||
(<0? <FIND-RES-COUNT ,SEARCH-RES>:FIX>
|
||
<PARSER-ERROR 0 ,PARSER-ERROR-NOOBJ .NP .PREP ;.SEARCH>)
|
||
(<READY-TO-DISAMBIGUATE? .NP>
|
||
<PARSER-ERROR 0 ,PARSER-ERROR-ORPH-NP
|
||
.NP <PARSE-VERB ,PARSE-RESULT>>)
|
||
;(T
|
||
<PARSER-ERROR ,P-TOO-MANY-OBJECTS-FOR-LOCATION 0 .NP>)>)>>
|
||
|
||
;<DEFINE DO-TEST-PREP DTP (OBJ:OBJECT VERB:VWORD "AUX" (BIT:TABLE ,PREP-BIT))
|
||
<COND (<0? <ZGET .BIT 0>:FIX> T)
|
||
(T
|
||
<REPEAT ((CT 0))
|
||
<COND (<FSET? .OBJ <ZGET .BIT .CT>:FIX> <RETURN T .DTP>)>
|
||
<COND (<OR <G? <SET CT <+ .CT 1>> 2>
|
||
<0? <ZGET .BIT .CT>:FIX>>
|
||
<RETURN <> .DTP>)>>)>>
|
||
|
||
<COND (<GASSIGNED? DO-TEST-PREP> <SETG TEST-PREP <TABLE ,DO-TEST-PREP>>)>
|
||
|
||
"Decide what object(s) OBJ refers to. If OBJ is false, we're looking to
|
||
GWIM something. Otherwise, it's one of NP, NPP, or NOUN-PHRASE. In the
|
||
last case, just return it, because it's already been reduced."
|
||
|
||
<DEFINE DETERMINE-OBJ DO (OBJ:<OR FALSE PMEM> NUM:FIX "OPT" (PICK <>)
|
||
"AUX" (VAL <>) RES (COUNT:FIX 0)
|
||
(SYN:VERB-SYNTAX <PARSE-SYNTAX ;3 ,PARSE-RESULT>)
|
||
(S-FLAGS:FIX
|
||
<COND (<==? .NUM 1> <SYNTAX-SEARCH ;B5 .SYN 1>)
|
||
(T <SYNTAX-SEARCH ;B9 .SYN 2>)>)
|
||
(SEARCH-ACT:FIX
|
||
<COND (<==? .NUM 1> <SYNTAX-FIND ;B4 .SYN 1>)
|
||
(T <SYNTAX-FIND ;B8 .SYN 2>)>))
|
||
<COND (<NOT .OBJ> ;"Get What I Mean!"
|
||
<MAKE-FINDER 'FINDER ,FINDER
|
||
'FIND-APPLIC .SEARCH-ACT
|
||
'FIND-FLAGS ,FIND-FLAGS-GWIM
|
||
'FIND-SYNTAX .SYN
|
||
'FIND-WHICH .NUM
|
||
'FIND-RES ,SEARCH-RES>
|
||
<COND (<T? .PICK>
|
||
<FIND-QUANT ,FINDER ,NP-QUANT-ALL>
|
||
;<SET S-FLAGS <BOR .S-FLAGS ,SEARCH-ALL>>)>
|
||
<COND (<OR <AND <EQUAL? .SEARCH-ACT ,ROOMSBIT>
|
||
<FIND-RES-OBJ1 ,SEARCH-RES ,ROOMS>>
|
||
<AND <T? .S-FLAGS>
|
||
<OR <FIND-OBJECTS .S-FLAGS>
|
||
<AND .PICK <FIND-RES-COUNT ,SEARCH-RES>>>
|
||
<ZPUT ,GWIM-MSG 0 <COND (<1? .NUM>
|
||
<SYNTAX-PREP .SYN 1>)
|
||
(T
|
||
<SYNTAX-PREP .SYN 2>)>>
|
||
<ZPUT ,GWIM-MSG 1 <FIND-RES-OBJ1 ,SEARCH-RES>>>>
|
||
;"Found one thing, so be happy"
|
||
;<FIND-NUM ,FINDER 0>
|
||
<SET RES <PMEM-ALLOC NOUN-PHRASE
|
||
LENGTH ,NOUN-PHRASE-MIN-LENGTH
|
||
COUNT 1
|
||
;FLAGS ;,NP-FLAG-MULTI
|
||
OBJ1 <FIND-RES-OBJ1 ,SEARCH-RES>
|
||
NP1 <>>>)
|
||
(T
|
||
;"This will return an appropriate lossage so the
|
||
parser will know to continue."
|
||
<ZPUT ,ORPHAN-S ,O-VERB <PARSE-VERB ,PARSE-RESULT>>
|
||
<ZPUT ,ORPHAN-S ,O-LEXPTR
|
||
<COND (<0? ,P-LEN>
|
||
<ZREST ,TLEXV ;,P-RUNNING <* 2 ,P-LEXELEN>>)
|
||
(T ,TLEXV ;,P-RUNNING)>>
|
||
<ZPUT ,ORPHAN-S ,O-SYNTAX <PARSE-SYNTAX ,PARSE-RESULT>>
|
||
<ZPUT ,ORPHAN-S ,O-WHICH .NUM>
|
||
<ZPUT ,ORPHAN-S ,O-PART <PARSE-PARTICLE1 ,PARSE-RESULT>>
|
||
<ZPUT ,ORPHAN-S ,O-OBJECT
|
||
<NOUN-PHRASE-OBJ1 <PARSE-OBJ1 ,PARSE-RESULT>>>
|
||
<COND (<SET VAL <PARSE-CHOMPER ,PARSE-RESULT>>
|
||
<SET VAL <NOUN-PHRASE-OBJ1 .VAL>>)>
|
||
<ZPUT ,ORPHAN-S ,O-SUBJECT .VAL>
|
||
<RETURN <PARSER-ERROR 0 ,PARSER-ERROR-ORPH-S
|
||
<PARSE-OBJ1 ,PARSE-RESULT>>
|
||
.DO>)>)
|
||
(<PMEM-TYPE? .OBJ NOUN-PHRASE>
|
||
;"Already a winner, so just return it"
|
||
<RETURN .OBJ .DO>)
|
||
(<PMEM-TYPE? .OBJ NP>
|
||
<SETG SEARCH-FLAGS .S-FLAGS>
|
||
<DETERMINE-NP 0 ;.SEARCH-ACT .NUM .OBJ>)
|
||
(<0? <ANDB .S-FLAGS ,SEARCH-MANY ;16>>
|
||
<PARSER-ERROR 0 ,PARSER-ERROR-NOMULT
|
||
.NUM <PARSE-VERB ,PARSE-RESULT>>)
|
||
(T
|
||
;"Do each noun phrase in turn, since we can take multiple objects"
|
||
<SETG SEARCH-FLAGS .S-FLAGS>
|
||
<REPEAT ((NO .OBJ) (CT <>) PTR)
|
||
<COND (<SET PTR <DETERMINE-NP 0 ;.SEARCH-ACT .NUM .NO T>>
|
||
;"Remember how many objects we have"
|
||
<SET COUNT <+ .COUNT
|
||
<NOUN-PHRASE-COUNT
|
||
<NPP-NOUN-PHRASE .NO:PMEM>:PMEM>>>
|
||
;"And how many real objects we have"
|
||
<COND (<ZERO? .CT>
|
||
<SET PTR <REST-TO-SLOT .PTR NOUN-PHRASE-OBJ1>>
|
||
<REPEAT ((CNT .COUNT))
|
||
<COND (<DLESS? CNT 0>
|
||
<RETURN>)
|
||
(<NOT <EQUAL? ,NOT-HERE-OBJECT
|
||
<ZGET .PTR 0>>>
|
||
<SET CT T>
|
||
<RETURN>)
|
||
(T <SET PTR <ZREST .PTR 4>>)>>)>
|
||
<COND (<NOT <SET NO <NPP-NEXT .NO:PMEM>>>
|
||
<COND (<ZERO? .CT>
|
||
<RETURN <> .DO>)>
|
||
<RETURN>)>)
|
||
(T
|
||
<RETURN <> .DO>)>>
|
||
;"Build a single noun phrase"
|
||
<SET RES <PMEM-ALLOC NOUN-PHRASE
|
||
;FLAGS ;,NP-FLAG-MULTI
|
||
LENGTH <+ ,NOUN-PHRASE-MIN-LENGTH
|
||
<* .COUNT 2> -2>
|
||
COUNT .COUNT>>
|
||
;"Copy everything into the single noun phrase"
|
||
<REPEAT ((NO .OBJ) (RR <REST-TO-SLOT .RES NOUN-PHRASE-OBJ1>)
|
||
PHRASE TMP)
|
||
<SET PHRASE <NPP-NOUN-PHRASE .NO:PMEM>>
|
||
<SET TMP <* 4 <NOUN-PHRASE-COUNT .PHRASE>:FIX>>
|
||
<COPYT <REST-TO-SLOT .PHRASE NOUN-PHRASE-OBJ1> .RR .TMP>
|
||
<SET RR <ZREST .RR .TMP>>
|
||
<COND (<NOT <SET NO <NPP-NEXT .NO:PMEM>>>
|
||
<RETURN>)>>
|
||
.RES)>>
|
||
|
||
<DEFINE CHECK-DIR-ADJS (ADJS:PMEM)
|
||
<REPEAT ((AV <REST-TO-SLOT .ADJS ADJS-COUNT 1>)
|
||
(CT <ADJS-COUNT .ADJS>) ADJ PT)
|
||
<COND (<L? <SET CT <- .CT 1>> 0>
|
||
<RETURN>)
|
||
(<AND <WORD-TYPE? <SET ADJ <ZGET .AV .CT>> ,P-DIR-CODE>
|
||
<SET PT <GETPT ,HERE <WORD-DIR-ID .ADJ>>>
|
||
<EQUAL? <PTSIZE .PT> ,DEXIT>>
|
||
<ZPUT .AV .CT ,W?NO.WORD>
|
||
<COND (<NOT <MATCH-OBJECT <GET .PT ,DEXITOBJ> ,FINDER T>>
|
||
<ZPUT .AV .CT .ADJ>
|
||
<RETURN>)>
|
||
<ZPUT .AV .CT .ADJ>)>>>
|
||
|
||
<DEFINE NUMERIC-ADJ? (NP:PMEM "AUX" ADJS (VAL 0))
|
||
<COND (<SET ADJS <NP-ADJS .NP>>
|
||
<REPEAT ((AV <REST-TO-SLOT .ADJS ADJS-COUNT 1>) (CT <ADJS-COUNT .ADJS>)
|
||
ADJ)
|
||
<COND (<L? <SET CT <- .CT 1>> 0>
|
||
<RETURN>)
|
||
(<EQUAL? <SET ADJ <ZGET .AV .CT>> ,W?INT.NUM>
|
||
<REPEAT ((VV <NP-LEXEND .NP> ;,TLEXV))
|
||
<COND (<EQUAL? .ADJ <ZGET .VV 0>>
|
||
<SET VAL <ZGET .VV 1>>
|
||
<RETURN>)
|
||
(<G? ,P-LEXV <SET VV <ZBACK .VV ,P-LEXELEN>>>
|
||
<RETURN>)>>)>>
|
||
.VAL)>>
|
||
|
||
;<CONSTANT FIND-OWNER:TABLE <TABLE (LENGTH) 0 0>>
|
||
<VOC "HIMSELF" NOUN>
|
||
;<VOC "ITSELF" NOUN>
|
||
<IFN-P-PS-ADV <VOC "HERSELF" NOUN>>
|
||
|
||
<DEFINE DETERMINE-NP DN (SEARCH-ACT:<OR FIX TABLE> WHICH:FIX OBJ:PMEM
|
||
"OPT" (MULTI <>)
|
||
"AUX" (SYN:<OR VERB-SYNTAX FALSE>
|
||
<COND (<0? .WHICH> <>)
|
||
(T <PARSE-SYNTAX ,PARSE-RESULT>)>)
|
||
(ROBJ:PMEM .OBJ) (RLOC:<OR FALSE PMEM> <>) ;RNP
|
||
QUANT:<OR FIX FALSE> OWNER
|
||
(RES <>) COUNT:FIX)
|
||
<COND (<PMEM-TYPE? .OBJ NPP>
|
||
<SET ROBJ <NPP-NOUN .OBJ>>)>
|
||
<COND (<SET RLOC <NP-LOC .ROBJ>>
|
||
<SET RLOC <LOCATION-OBJECT .RLOC>:PMEM>
|
||
;<SET RNP <NOUN-PHRASE-NP1 .RLOC>>
|
||
<SET RLOC <NOUN-PHRASE-OBJ1 .RLOC>>)>
|
||
<SET QUANT <NP-QUANT .ROBJ>>
|
||
<COND (<AND .QUANT
|
||
<G? .QUANT ,NP-QUANT-A>
|
||
<0? <ANDB ,SEARCH-FLAGS ,SEARCH-MANY ;16>>>
|
||
<RETURN <PARSER-ERROR 0 ,PARSER-ERROR-NOMULT
|
||
.WHICH <PARSE-VERB ,PARSE-RESULT>>
|
||
.DN>)>
|
||
<COND (<AND <OR <SET OWNER <NP-OF .ROBJ>>
|
||
<AND <SET OWNER <NP-ADJS .ROBJ>>
|
||
<SET OWNER <ADJS-POSS .OWNER>>>
|
||
;<SET OWNER .RNP>
|
||
;<AND <SET OWNER <NP-LOC .ROBJ>>
|
||
<SET OWNER <LOCATION-OBJECT .OWNER>>
|
||
<SET OWNER <NOUN-PHRASE-NP1 .OWNER>>>>
|
||
<PMEM? .OWNER>>
|
||
;<COND (<PMEM-TYPE? .OWNER NOUN-PHRASE>
|
||
<SET OWNER <NOUN-PHRASE-NP1 .OWNER>>)>
|
||
;<FIND-RES-COUNT ,OWNER-SR-HERE 0>
|
||
;<FIND-RES-COUNT ,OWNER-SR-THERE 0>
|
||
<MAKE-FINDER 'FINDER ,FINDER
|
||
'FIND-APPLIC .SEARCH-ACT
|
||
;'FIND-QUANT ;<NP-QUANT .OWNER>
|
||
'FIND-SYNTAX .SYN
|
||
'FIND-WHICH .WHICH
|
||
'FIND-RES ,SEARCH-RES
|
||
'FIND-ADJS <NP-ADJS .OWNER>
|
||
'FIND-NUM <NUMERIC-ADJ? .OWNER>
|
||
'FIND-NOUN <NP-NAME .OWNER>
|
||
'FIND-OF <NP-OF .OWNER> ;<OR <NP-OF .ROBJ> .RNP>
|
||
;'FIND-EXCEPTIONS ;<NP-EXCEPT .OWNER>>
|
||
<FIND-RES-COUNT ,SEARCH-RES 0>
|
||
<FIND-RES-NEXT ,SEARCH-RES <>>
|
||
<FIND-OBJECTS ,SEARCH-ALL> ;"Find owner in HERE"
|
||
<COPYT ,SEARCH-RES ,OWNER-SR-HERE <* 2 ,FIND-RES-LENGTH>>
|
||
<FIND-RES-COUNT ,SEARCH-RES 0>
|
||
<FIND-RES-NEXT ,SEARCH-RES <>>
|
||
<FIND-OWNERS ,OWNERS> ;"Search for other owners."
|
||
<COPYT ,SEARCH-RES ,OWNER-SR-THERE <* 2 ,FIND-RES-LENGTH>>)>
|
||
<COND (<EQUAL? <NP-NAME .ROBJ> ,W?HIMSELF> ;"ASK TROLL ABOUT HIMSELF"
|
||
<COND (<AND <EQUAL? 2 .WHICH>
|
||
<SET COUNT <PARSE-OBJ1 ,PARSE-RESULT>>
|
||
<SET COUNT <NOUN-PHRASE-OBJ1 .COUNT>>
|
||
<FSET? .COUNT ,PERSONBIT>>
|
||
<SET RES .COUNT>
|
||
<IFN-P-PS-ADV
|
||
<COND (<FSET? .COUNT ,FEMALE ;,FEMALEBIT>
|
||
<SET RES ,P-HIM-OBJECT>)>>)
|
||
(T
|
||
<SET RES ,P-HIM-OBJECT>)>)>
|
||
<IFN-P-PS-ADV
|
||
<COND (<EQUAL? <NP-NAME .ROBJ> ,W?HERSELF ;%<VOC "HERSELF" NOUN>>
|
||
<COND (<AND <EQUAL? 2 .WHICH>
|
||
<SET COUNT <PARSE-OBJ1 ,PARSE-RESULT>>
|
||
<SET COUNT <NOUN-PHRASE-OBJ1 .COUNT>>
|
||
<FSET? .COUNT ,PERSONBIT>
|
||
<FSET? .COUNT ,FEMALE ;,FEMALEBIT>>
|
||
<SET RES .COUNT>)
|
||
(T
|
||
<SET RES ,P-HER-OBJECT>)>)>>
|
||
|
||
<COND (<T? .RES>
|
||
<RETURN <PMEM-ALLOC NOUN-PHRASE
|
||
LENGTH ,NOUN-PHRASE-MIN-LENGTH
|
||
COUNT 1
|
||
OBJ1 .RES
|
||
NP1 .ROBJ>
|
||
.DN>)>
|
||
<MAKE-FINDER 'FINDER ,FINDER
|
||
'FIND-APPLIC .SEARCH-ACT
|
||
'FIND-QUANT .QUANT
|
||
'FIND-SYNTAX .SYN
|
||
'FIND-WHICH .WHICH
|
||
'FIND-RES ,SEARCH-RES
|
||
'FIND-ADJS <NP-ADJS .ROBJ>
|
||
'FIND-NUM <NUMERIC-ADJ? .ROBJ>
|
||
'FIND-NOUN <NP-NAME .ROBJ>
|
||
'FIND-OF <OR <NP-OF .ROBJ> ;.RNP>
|
||
'FIND-EXCEPTIONS <NP-EXCEPT .ROBJ>>
|
||
<FIND-OBJECTS ,SEARCH-FLAGS .RLOC>
|
||
<COND (<AND <ZERO? <FIND-RES-COUNT ,SEARCH-RES>>
|
||
<T? <NP-ADJS .ROBJ>>>
|
||
<CHECK-DIR-ADJS <NP-ADJS .ROBJ>>)>
|
||
<COND (<AND <ZERO? <SET COUNT <FIND-RES-COUNT ,SEARCH-RES>>>
|
||
<SET RLOC <NP-NAME .ROBJ>>
|
||
<T? <ANDB ,PLURAL-FLAG <WORD-FLAGS .RLOC>>>>
|
||
<NP-QUANT .ROBJ ,NP-QUANT-ALL ;,NP-QUANT-PLURAL>
|
||
<NP-NAME .ROBJ <WORD-SEMANTIC-STUFF .RLOC>>
|
||
<AGAIN>)
|
||
(<ZERO? .COUNT>
|
||
<COND (<OR <T? .MULTI>
|
||
<ZAPPLY ,NOT-HERE-VERB?
|
||
<PARSE-ACTION ,PARSE-RESULT>>>
|
||
<SET RES <PMEM-ALLOC NOUN-PHRASE
|
||
LENGTH ,NOUN-PHRASE-MIN-LENGTH
|
||
COUNT 1
|
||
OBJ1 ,NOT-HERE-OBJECT
|
||
NP1 .ROBJ>>)>)
|
||
(<OR <1? .COUNT>
|
||
<T? .QUANT>
|
||
<SET RES <ZAPPLY <GETP <FIND-RES-OBJ1 ,SEARCH-RES>
|
||
,P?GENERIC>
|
||
,SEARCH-RES ,FINDER>>
|
||
;"Protocol: returns .OBJ if that's the one to use,
|
||
,NOT-HERE-OBJECT if 'are none',
|
||
[,ROOMS if case was handled and msg TELLed,]
|
||
<> if WHICH-PRINT should be called"
|
||
;<AND <SET RES ,P-IT-OBJECT>
|
||
<NOT <NOT-IN-FIND-RES? .RES ,SEARCH-RES T>>>>
|
||
<COND (<EQUAL? .RES ,NOT-HERE-OBJECT ;,ROOMS>
|
||
;<THROW ,PARSER-RESULT-DEAD ,PARSE-SENTENCE-ACTIVATION>
|
||
<RETURN <PARSER-ERROR 0 ,PARSER-ERROR-NOOBJ .OBJ> .DN>)
|
||
(<T? .RES>
|
||
<SET COUNT 1>
|
||
<FIND-RES-COUNT ,SEARCH-RES 1>
|
||
<FIND-RES-NEXT ,SEARCH-RES <>>
|
||
<FIND-RES-OBJ1 ,SEARCH-RES
|
||
<COND (<EQUAL? .RES ,HERE> ,GLOBAL-HERE)
|
||
(T .RES)>>)>
|
||
<SET RES <PMEM-ALLOC NOUN-PHRASE
|
||
;FLAGS ;<COND (.QUANT ,NP-FLAG-MULTI)
|
||
(T 0)>
|
||
LENGTH <+ <* .COUNT 2>
|
||
,NOUN-PHRASE-MIN-LENGTH
|
||
-2>
|
||
COUNT .COUNT>>
|
||
<COND (<OR <SET SYN <NP-OF .ROBJ>> ;"Store owner found."
|
||
<AND <SET SYN <NP-ADJS .ROBJ>>
|
||
<SET SYN <ADJS-POSS .SYN>>>
|
||
;<SET SYN .RNP>>
|
||
<COND (<NOT <OBJECT? .SYN>>
|
||
<SET SYN <FIND-RES-OWNER ,SEARCH-RES>>
|
||
<COND (<NP-OF .ROBJ>
|
||
<NP-OF .ROBJ .SYN>)
|
||
(T ;<NP-ADJS .ROBJ>
|
||
<ADJS-POSS <NP-ADJS .ROBJ> .SYN>)
|
||
;(T
|
||
<NOUN-PHRASE-NP1 <LOCATION-OBJECT <NP-LOC .ROBJ>>
|
||
.SYN>)>)>)>
|
||
<COND (<SET SYN <DETERMINE-NP-XFER .COUNT .ROBJ ,SEARCH-RES
|
||
<REST-TO-SLOT .RES NOUN-PHRASE-OBJ1>>>
|
||
<NOUN-PHRASE-COUNT .RES <- .COUNT .SYN>>)>)
|
||
(<READY-TO-DISAMBIGUATE? .ROBJ>
|
||
<RETURN <PARSER-ERROR 0 ,PARSER-ERROR-ORPH-NP
|
||
.ROBJ <PARSE-VERB ,PARSE-RESULT>>
|
||
.DN>)>
|
||
<COND (<AND .RES <PMEM-TYPE? .OBJ NPP>>
|
||
<NPP-NOUN-PHRASE .OBJ .RES>)>
|
||
;<FIND-NUM ,FINDER 0>
|
||
.RES>
|
||
|
||
<DEFINE FIND-OWNERS (TBL)
|
||
<REPEAT (OOBJ (LEN <ZGET .TBL 0>))
|
||
<COND (<L? .LEN 1>
|
||
<RETURN>)
|
||
(<OBJECT? <SET OOBJ <ZGET .TBL .LEN>>>
|
||
<COND (<NOT <MATCH-OBJECT .OOBJ ,FINDER T>>
|
||
<RETURN>)>)
|
||
(T ;"It's another table!"
|
||
<FIND-OWNERS .OOBJ>)>
|
||
<SET LEN <- .LEN 1>>>>
|
||
|
||
<DEFINE READY-TO-DISAMBIGUATE? RTD (NP "AUX" PTR NOUN)
|
||
<COND (<AND <SET PTR <NP-LEXEND .NP>>
|
||
<SET NOUN <NP-NAME .NP>>>
|
||
<REPEAT ()
|
||
<COND (<==? .NOUN <ZGET .PTR 0>>
|
||
<RETURN .PTR .RTD>)
|
||
(<G? ,P-LEXV <SET PTR <- .PTR ,LEXV-ELEMENT-SIZE-BYTES>>>
|
||
<RETURN <> .RTD>)>>)>>
|
||
|
||
<DEFINE DETERMINE-NP-XFER ACT (COUNT ROBJ SRES DV "AUX" CT V)
|
||
<SET CT <FIND-RES-SIZE .SRES>>
|
||
<SET V <REST-TO-SLOT .SRES FIND-RES-OBJ1>>
|
||
<REPEAT ()
|
||
<COND (<G? .CT .COUNT>
|
||
<SET CT .COUNT>)>
|
||
<SET COUNT <- .COUNT .CT>>
|
||
<REPEAT (TMP (NUM 0))
|
||
<COND (<SET TMP <ZGET .V 0>>
|
||
<ZPUT .DV 0 .TMP>
|
||
<ZPUT .DV 1 .ROBJ>)
|
||
(T
|
||
<INC NUM>)>
|
||
<SET DV <ZREST .DV 4>>
|
||
<SET V <ZREST .V 2>>
|
||
<COND (<L? <SET CT <- .CT 1>> 1>
|
||
<COND (<ZERO? <SET SRES <FIND-RES-NEXT .SRES>>>
|
||
<RETURN .NUM .ACT>)>
|
||
<SET CT ,FIND-RES-MAXOBJ ;<OBJLIST-SIZE .SRES>>
|
||
<SET V <REST-TO-SLOT .SRES OBJLIST-OBJ1>>
|
||
<COND (<G? .CT .COUNT>
|
||
<SET CT .COUNT>)>
|
||
<SET COUNT <- .COUNT .CT>>)>>>>
|
||
|
||
<DEFINE RED-O-ADJ ("OPT" N:FIX TYP:FIX)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "O-ADJ">)
|
||
(T <RFALSE>)>)>
|
||
<COND (<T? ,P-OFLAG>
|
||
<COPYT ,O-LEXV ,G-LEXV ,LEXV-LENGTH-BYTES>
|
||
<COPYT ,O-INBUF ,G-INBUF <+ 1 ,INBUF-LENGTH>>
|
||
<ZPUT ,OOPS-TABLE ,O-START <ZGET ,OOPS-TABLE ,O-AGAIN>>
|
||
;<COND (<ZERO? <ZGET ,G-LEXV ,P-OFLAG>> ;"PARSER-ERROR-ORPH-S"
|
||
<ZPUT ,G-LEXV ,P-OFLAG ,W?NO.WORD>)>
|
||
<INSERT-ADJS <POP-PSTACK ,DATA-STACK>>
|
||
;<SETG P-OFLAG <>>
|
||
<COPY-INPUT T>
|
||
<THROW ,PARSER-RESULT-AGAIN ,PARSE-SENTENCE-ACTIVATION>)>>
|
||
|
||
<DEFINE RED-O-PP ("OPT" N:FIX TYP:FIX "AUX" PP A PREP)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "O-PP">) (T <RFALSE>)>)>
|
||
<COND (<AND <T? <SET PP <ABS ,P-OFLAG>>>
|
||
<EQUAL? ,W?NO.WORD ;0 <ZGET ,O-LEXV .PP>>
|
||
<SET A <ZGET ,O-LEXV <- .PP ,P-LEXELEN>>>
|
||
<SET PP <POP-PSTACK ,DATA-STACK>>
|
||
<OR <AND <==? .N 1> ;<PMEM-TYPE? .PP PP>
|
||
;<EQUAL? .A <PP-PREP .PP>>>
|
||
<AND ;<PMEM-TYPE? .PP NP>
|
||
<SET PREP <POP-PSTACK ,DATA-STACK>> ;<EQUAL? .A >>>>
|
||
;<ZPUT ,O-LEXV .PP ,W?NO.WORD>
|
||
<COPYT ,O-LEXV ,G-LEXV ,LEXV-LENGTH-BYTES>
|
||
<COPYT ,O-INBUF ,G-INBUF <+ 1 ,INBUF-LENGTH>>
|
||
<ZPUT ,OOPS-TABLE ,O-START <ZGET ,OOPS-TABLE ,O-AGAIN>>
|
||
<INSERT-NP ;.PP <COND (<EQUAL? .A .PREP> 1) (T 0)>>
|
||
;<SETG P-OFLAG <>>
|
||
<COPY-INPUT T>
|
||
<THROW ,PARSER-RESULT-AGAIN ,PARSE-SENTENCE-ACTIVATION>)>>
|
||
|
||
<DEFINE INSERT-NP ("OPT" (NUM 0) (NP <>) "AUX" (GPTR <ABS ,P-OFLAG>) PPTR TMP)
|
||
<COND (<SET TMP <PARSE-VERB-LEXV ,PARSE-RESULT>>
|
||
<SET PPTR <ZREST .TMP <* .NUM <* 2 ,P-LEXELEN>>>>
|
||
<SET TMP <+ 1 </ <- ,TLEXV .TMP> ,LEXV-ELEMENT-SIZE-BYTES>>>)
|
||
(T
|
||
<COND ;(.NP
|
||
<SET PPTR <NP-LEXBEG .NP>> ;"unreliable"
|
||
<SET TMP <+ 1 </ <- <NP-LEXEND .NP> .PPTR>
|
||
,LEXV-ELEMENT-SIZE-BYTES>>>)
|
||
(T
|
||
<SET PPTR <ZGET ,OOPS-TABLE ,O-START>
|
||
;<REST-TO-SLOT ,P-LEXV LEXV-START>>
|
||
<SET TMP <ZGET ,OOPS-TABLE ,O-LENGTH> ;,P-OLEN>)>
|
||
<SET PPTR <ZREST .PPTR <* .NUM <* 2 ,P-LEXELEN>>>>)
|
||
;(T
|
||
<SET PPTR <ZREST ,P-LEXV
|
||
<* 2 <+ ,P-LEXSTART <* .NUM ,P-LEXELEN>>>>>
|
||
<SET TMP <GETB ,P-LEXV ,P-LEXWORDS>>)>
|
||
<SET NUM <- .TMP .NUM>>
|
||
<MAKE-ROOM-FOR-TOKENS <+ -1 .NUM> ,G-LEXV .GPTR>
|
||
;<PUTB ,G-LEXV ,P-LEXWORDS <+ -1 .NUM <GETB ,G-LEXV ,P-LEXWORDS>>>
|
||
<REPEAT ()
|
||
<COND (<DLESS? NUM 0> <RETURN>)>
|
||
<INBUF-ADD <LEXV-WORD-LENGTH .PPTR>
|
||
<LEXV-WORD-OFFSET .PPTR>
|
||
<SET TMP <+ 3 <* .GPTR 2>>>>
|
||
<SET TMP <ZGET .PPTR 0>>
|
||
<ZPUT ,G-LEXV .GPTR .TMP>
|
||
<COND (<EQUAL? .TMP ,W?INT.NUM ,W?INT.TIM>
|
||
<ZPUT ,G-LEXV <+ 1 .GPTR> <ZGET .PPTR 1>>)>
|
||
<SET GPTR <+ .GPTR ,LEXV-ELEMENT-SIZE>>
|
||
<SET PPTR <+ .PPTR ,LEXV-ELEMENT-SIZE-BYTES>>>>
|
||
|
||
<DEFINE TEST-SR ACT (NP "AUX" A (CT 0) (LEN <FIND-RES-COUNT ,ORPHAN-SR>))
|
||
<COND (<ZERO? .LEN>
|
||
<RETURN <> .ACT>)
|
||
(<WORD-TYPE? <SET A <NP-NAME .NP>> ,P-QUANT-CODE>
|
||
<RETURN .A .ACT>)
|
||
(<ZERO? <SET A <NP-ADJS .NP>>>
|
||
<SET A <PMEM-ALLOC ADJS LEXPTR <NP-LEXBEG .NP>>>)
|
||
(<NOT <G? ,ADJS-MAX-COUNT <SET CT <ADJS-COUNT .A>>>>
|
||
<RETURN <> .ACT>)>
|
||
<ZPUT <REST-TO-SLOT .A ADJS-COUNT 1> .CT <NP-NAME .NP>>
|
||
<ADJS-COUNT .A <+ 1 .CT>>
|
||
<FIND-ADJS ,FINDER .A>
|
||
<FIND-NUM ,FINDER <NUMERIC-ADJ? .NP>>
|
||
<FIND-NOUN ,FINDER <NP-NAME ,ORPHAN-NP>>
|
||
<FIND-RES-COUNT ,SEARCH-RES 0>
|
||
<FIND-RES-NEXT ,SEARCH-RES <>>
|
||
<REPEAT ((VEC <REST-TO-SLOT ,ORPHAN-SR FIND-RES-OBJ1>)
|
||
(SZ <FIND-RES-SIZE ,ORPHAN-SR>)
|
||
(REM .LEN))
|
||
<COND (<NOT <MATCH-OBJECT <ZGET .VEC 0> ,FINDER T>>
|
||
<RETURN .A .ACT>)
|
||
;(T <SET LEN <- .LEN 1>>)>
|
||
<COND (<L? <SET REM <- .REM 1>> 1>
|
||
<RETURN>)
|
||
(<L? <SET SZ <- .SZ 1>> 1>
|
||
<COND (T ;<ZERO? <SET SR <FIND-RES-NEXT ,ORPHAN-SR>>>
|
||
<RETURN>)>
|
||
;<SET SZ ,FIND-RES-MAXOBJ ;<OBJLIST-SIZE ,ORPHAN-SR>>
|
||
;<SET VEC <REST-TO-SLOT ,ORPHAN-SR OBJLIST-NEXT>>)
|
||
(T <SET VEC <ZREST .VEC 2>>)>>
|
||
<COND (<NOT <0? .CT>>
|
||
<ADJS-COUNT .A .CT>)>
|
||
<COND (<NOT <0? <FIND-RES-COUNT ,SEARCH-RES>>>
|
||
.A)>>
|
||
|
||
<DEFINE RED-O-NP ("OPT" N:FIX TYP:FIX "AUX" A NP (PP <>))
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "O-NP">) (T <RFALSE>)>)>
|
||
<COND (<EQUAL? .N 2>
|
||
<SET PP <POP-PSTACK ,DATA-STACK>>)>
|
||
<SET NP <POP-PSTACK ,DATA-STACK>>
|
||
<COND (<AND <PMEM-TYPE? .NP NOUN-PHRASE>
|
||
<EQUAL? <NOUN-PHRASE-OBJ1 .NP> ,INTQUOTE>>
|
||
<SET NP <NOUN-PHRASE-NP1 .NP>>
|
||
<COND (<ZERO? ,P-OFLAG>
|
||
<SET PP </ <- <NP-LEXBEG .NP> ,P-LEXV> 2>>
|
||
<MAKE-ROOM-FOR-TOKENS 1 ,G-LEXV .PP>
|
||
<ZPUT ,G-LEXV .PP ,W?SAY>
|
||
<COPY-INPUT>
|
||
<THROW ,PARSER-RESULT-AGAIN ,PARSE-SENTENCE-ACTIVATION>)>)>
|
||
<COND (<T? ,P-OFLAG>
|
||
<COND (<AND <ZERO? .PP>
|
||
<WORD-TYPE? <NP-NAME .NP> ,P-ADJ-CODE>
|
||
;<ZERO? <NP-LOC .NP>>
|
||
<ZERO? <NP-QUANT .NP>>
|
||
<SET A <TEST-SR .NP>>> ;"Try as adjective instead."
|
||
<PUSH-PSTACK ,DATA-STACK .A>
|
||
<RED-O-ADJ 1 .TYP> ;"Never returns?"
|
||
<RFALSE>)>
|
||
<COPYT ,O-LEXV ,G-LEXV ,LEXV-LENGTH-BYTES>
|
||
<COPYT ,O-INBUF ,G-INBUF <+ 1 ,INBUF-LENGTH>>
|
||
<SET N <ABS ,P-OFLAG>>
|
||
<COND (<EQUAL? ,W?NO.WORD ;0 <ZGET ,G-LEXV .N>>
|
||
;"PARSER-ERROR-ORPH-S: delete NO.WORD?"
|
||
;<PUTB ,G-LEXV ,P-LEXWORDS <- <GETB ,G-LEXV ,P-LEXWORDS> 1>>
|
||
<INSERT-NP 0 .NP>)
|
||
(T
|
||
<PROG ((A1 <>))
|
||
<COND (<SET A <NP-NAME .NP>>
|
||
<ZPUT ,G-LEXV .N .A>
|
||
<SET A <NP-LEXEND .NP>>
|
||
<INBUF-ADD <LEXV-WORD-LENGTH .A>
|
||
<LEXV-WORD-OFFSET .A>
|
||
<+ 3 <* .N 2>>>)>
|
||
<COND (<SET A <NP-ADJS .NP>>
|
||
<INSERT-ADJS .A>)>
|
||
<COND (<T? .PP>
|
||
;<SET PP <NP-LOC .NP>>
|
||
<MAKE-ROOM-FOR-TOKENS 2 ,G-LEXV <+ .N ,P-LEXELEN>>
|
||
<ZPUT ,G-LEXV <+ .N ,P-LEXELEN> <LOCATION-PREP .PP>>
|
||
<SET A <LOCATION-OBJECT .PP>>
|
||
<COND (<PMEM-TYPE? .A NOUN-PHRASE>
|
||
<SET A <NOUN-PHRASE-NP1 .A>>)
|
||
(<PMEM-TYPE? .A NPP>
|
||
<SET A <NPP-NOUN .A>>)>
|
||
<ZPUT ,G-LEXV <+ .N <* 2 ,P-LEXELEN>> <NP-NAME .A>>)>
|
||
<COND (<AND <SET A <NP-QUANT .NP>>
|
||
;<T? <NP-NAME .NP>>>
|
||
<PROG ((PTR .N))
|
||
<REPEAT (WD)
|
||
<COND (<G? 0 <SET PTR <- .PTR ,P-LEXELEN>>>
|
||
<SET PTR <OR .A1 .N>>
|
||
<MAKE-ROOM-FOR-TOKENS 1 ,G-LEXV .PTR>
|
||
<RETURN>)
|
||
(<OR <EQUAL? <SET WD <ZGET ,G-LEXV .PTR>>
|
||
,W?THE>
|
||
<WORD-TYPE? .WD ,P-QUANT-CODE>>
|
||
<RETURN>)
|
||
(<WORD-TYPE? .WD ,P-ADJ-CODE>
|
||
<SET A1 .PTR>)
|
||
(T
|
||
<SET PTR <OR .A1 .N>>
|
||
<MAKE-ROOM-FOR-TOKENS 1 ,G-LEXV .PTR>
|
||
<RETURN>)>>
|
||
<ZPUT ,G-LEXV .PTR <GET-QUANTITY-WORD .A>>>)>>)>
|
||
<ZPUT ,OOPS-TABLE ,O-START <ZGET ,OOPS-TABLE ,O-AGAIN>>
|
||
;<SETG P-OFLAG <>>
|
||
<COPY-INPUT ;T>
|
||
<THROW ,PARSER-RESULT-AGAIN ,PARSE-SENTENCE-ACTIVATION>)>>
|
||
|
||
<DEFINE RED-PERS ACT ("OPT" N:FIX TYP:FIX "AUX" X:PMEM)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "PERS">) (T <RFALSE>)>)>
|
||
<COND (<NOT <EQUAL? .N 2 3>>
|
||
T)
|
||
(<OR <AND <==? <SET X <POP-PSTACK ,DATA-STACK>> ,W?COMMA>
|
||
<EQUAL? .N 2>>
|
||
<AND <==? .X ,W?TO>
|
||
;<EQUAL? .N 3>>>
|
||
<SET X <POP-PSTACK ,DATA-STACK>>
|
||
<COND (<EQUAL? .N 3>
|
||
<COND ;(<NOT <ZAPPLY ,ASKING-VERB-WORD?
|
||
<POP-PSTACK ,DATA-STACK>>>
|
||
<RETURN <> .ACT>)
|
||
(<NOT <WORD-TYPE? <ZGET ,P-RUNNING 0> ,P-VERB-CODE>>
|
||
<RETURN <> .ACT>)>)>
|
||
<HACK-TELL .X>)>>
|
||
|
||
<DEFINE HACK-TELL ACT (X "AUX" NP)
|
||
<PARSE-VERB ,PARSE-RESULT ,W?TELL>
|
||
<GET-SYNTAX <VERB-ONE <WORD-VERB-STUFF ,W?TELL>> 1 <>>
|
||
<COND (<NOT <SET NP <DETERMINE-OBJ .X 1>>>
|
||
<RETURN <PARSER-ERROR 0 ,PARSER-ERROR-NOOBJ .X> .ACT>)>
|
||
<PARSE-VERB-LEXV ,PARSE-RESULT ,TLEXV>
|
||
<PARSE-CHOMPER ,PARSE-RESULT .NP>
|
||
<SET X <NOUN-PHRASE-OBJ1 .NP>>
|
||
<COND (<EQUAL? .X ,WINNER ,PLAYER ,ME>
|
||
T)
|
||
<IFN-P-PS-ADV
|
||
(<EQUAL? .X ,YOU>
|
||
T)>
|
||
(T
|
||
<IGNORE-FIRST-WORD ,W?YOU>
|
||
<COND (<L? ,P-LEN 1>
|
||
<SETG P-CONT <>>)
|
||
(T
|
||
<SETG P-CONT ,TLEXV>)>
|
||
<COND (<OR <EQUAL? ,M-FATAL <HACK-TELL-1 .NP>>
|
||
<ZERO? ,P-CONT>>
|
||
<SETG P-CONT -1>
|
||
<THROW ,PARSER-RESULT-DEAD
|
||
,PARSE-SENTENCE-ACTIVATION>)>
|
||
;<SETG WINNER <PARSE-CHOMPER ,PARSE-RESULT>>)>
|
||
T>
|
||
|
||
<DEFINE HACK-TELL-1 ACT (NP "AUX" X NUM CT)
|
||
<SETG PRSO-NP <NOUN-PHRASE-NP1 .NP>>
|
||
<SET X <NOUN-PHRASE-OBJ1 .NP>>
|
||
<COND (<L? 1 <SET CT <NOUN-PHRASE-COUNT .NP>>>
|
||
<COND (<L=? .CT <SET NUM <NOUN-PHRASE-FLAGS .NP>>>
|
||
<RETURN <> .ACT>)>
|
||
<NOUN-PHRASE-FLAGS .NP <+ 1 .NUM>>
|
||
<SETG PRSO-NP <ZGET <REST-TO-SLOT .NP NOUN-PHRASE-NP1>
|
||
<* 2 .NUM>>>
|
||
<SET X <ZGET <REST-TO-SLOT .NP NOUN-PHRASE-OBJ1>
|
||
<* 2 .NUM>>>
|
||
<TELL D .X ":|">)>
|
||
<IF-P-BE-VERB
|
||
<SETG PRSQ <>>
|
||
<SETG PRSS <>>>
|
||
<SET X <PERFORM ,V?TELL .X>>
|
||
<PARSE-ACTION ,PARSE-RESULT 0 ;"for DONT-UNDERSTAND">
|
||
.X>
|
||
|
||
<DEFINE RED-VP ("OPT" N:FIX TYP:FIX "AUX" VERB (A1 T) (A2 T))
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "VP">) (T <RFALSE>)>)>
|
||
<COND (<G? .N 2>
|
||
<SET A1 <POP-PSTACK ,DATA-STACK>>)>
|
||
<SET VERB <POP-PSTACK ,DATA-STACK>>
|
||
<COND (<G? .N 2>
|
||
<SET A2 <POP-PSTACK ,DATA-STACK>>
|
||
<COND (<EQUAL? .N 4>
|
||
<POP-PSTACK ,DATA-STACK>)>)>
|
||
<PARSE-VERB ,PARSE-RESULT .VERB>
|
||
<PARSE-VERB-LEXV ,PARSE-RESULT ,TLEXV>
|
||
<COND (<N==? .A1 T>
|
||
<PARSE-ADV ,PARSE-RESULT <OR <WORD-SEMANTIC-STUFF .A1> .A1>>)
|
||
(<N==? .A2 T>
|
||
<PARSE-ADV ,PARSE-RESULT <OR <WORD-SEMANTIC-STUFF .A2> .A2>>)>
|
||
T>
|
||
|
||
"Basic NP reduction. Doesn't do any checking at this level, just copies
|
||
everything into a structure for later use."
|
||
|
||
<DEFINE RED-NP ("OPT" N:FIX TYP:FIX
|
||
"AUX" NAME (QUANT ,NP-QUANT-NONE) LEXB (LEXE ,TLEXV) ADJ)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "ADJ*-NOUN">) (T <RFALSE>)>)>
|
||
<SET NAME <POP-PSTACK ,DATA-STACK>>
|
||
<COND (<EQUAL? .NAME 1>
|
||
<SET NAME <>>)>
|
||
<COND (<WORD-TYPE? <ZGET .LEXE 0> ,P-COMMA-CODE ,P-EOI-CODE>
|
||
;<EQUAL? ,W?COMMA <ZGET .LEXE 0>>
|
||
<SET LEXE <ZBACK .LEXE ,LEXV-ELEMENT-SIZE-BYTES>>)>
|
||
<COND (<==? <SET ADJ <POP-PSTACK ,DATA-STACK>> 1>
|
||
<SET LEXB .LEXE>
|
||
<SET ADJ <>>)
|
||
(T
|
||
<SET LEXB <ADJS-LEXPTR .ADJ>>
|
||
<COND (<T? <ADJS-QUANT .ADJ>>
|
||
<SET QUANT <ADJS-QUANT .ADJ>>)>)>
|
||
<PMEM-ALLOC NP NAME .NAME ADJS .ADJ
|
||
LEXBEG .LEXB LEXEND .LEXE QUANT .QUANT>>
|
||
|
||
"Reduction for FOO OF BARS"
|
||
<DEFINE RED-OF ("OPT" N:FIX TYP:FIX "AUX" ONP:PMEM NP:PMEM TMP A)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "NP-OF-NP">) (T <RFALSE>)>)>
|
||
<SET ONP <POP-PSTACK ,DATA-STACK>>
|
||
<COND (<==? <POP-PSTACK ,DATA-STACK> ,W?OF>
|
||
<COND (<AND <NP-QUANT <SET NP <POP-PSTACK ,DATA-STACK>>>
|
||
<NOT <NP-NAME .NP>>
|
||
<NOT <NP-ADJS .NP>>>
|
||
;"ALL OF THE BOOKS = ALL BOOKS"
|
||
<NP-QUANT .ONP <NP-QUANT .NP>>
|
||
.ONP)
|
||
(T
|
||
<NP-OF .NP .ONP>
|
||
.NP)>)>>
|
||
|
||
"Reduction for case of a quantity by itself"
|
||
<DEFINE RED-QT ("OPT" N:FIX TYP:FIX "AUX" Q)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "QUANT">) (T <RFALSE>)>)>
|
||
<SET Q <POP-PSTACK ,DATA-STACK>>
|
||
<COND (<NOT <EQUAL? .Q ,W?A ,W?AN>>
|
||
<PMEM-ALLOC NP QUANT <GET-QUANTITY .Q>
|
||
LEXBEG ,TLEXV LEXEND ,TLEXV>)>>
|
||
|
||
<DEFINE GET-QUANTITY-WORD (Q "AUX" TBL)
|
||
<COND (<SET TBL <INTBL? .Q ,NP-QUANT-TBL ,NP-QUANT-TBL-LEN *204*>>
|
||
<ZGET .TBL 1>)>>
|
||
|
||
<DEFINE GET-QUANTITY (Q:VWORD "AUX" TBL)
|
||
<COND (<SET TBL <INTBL? .Q <ZREST ,NP-QUANT-TBL 2> ,NP-QUANT-TBL-LEN *204*>>
|
||
<ZGET <ZBACK .TBL 2> 0>)>>
|
||
|
||
"Quantity followed by a noun phrase: ALL RED BOOKS"
|
||
<DEFINE RED-QN ("OPT" N:FIX TYP:FIX "AUX" NP:PMEM Q)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "QUANT-NP">) (T <RFALSE>)>)>
|
||
<SET NP <POP-PSTACK ,DATA-STACK>>
|
||
<COND ;(<NOT <EQUAL? <NP-QUANT .NP> ,NP-QUANT-NONE ,NP-QUANT-PLURAL>>
|
||
<PARSER-ERROR ,P-DONT-UNDERSTAND-TWO-QUANTITIES>)
|
||
(T
|
||
;"We don't distinguish ALL THE BOOKS from ALL THE BOOK."
|
||
<NP-LEXBEG .NP <- <NP-LEXBEG .NP> ,LEXV-ELEMENT-SIZE-BYTES>>
|
||
<NP-QUANT .NP <GET-QUANTITY <POP-PSTACK ,DATA-STACK>>>
|
||
.NP)>>
|
||
|
||
"Basic top-level noun phrase reduction"
|
||
<DEFINE RED-NPP RED ("OPT" N:FIX TYP:FIX
|
||
"AUX" NPP:PMEM ONPP:PMEM PP:PMEM NP (RLOC <>)
|
||
(X1 <>) (X2 <>) (KLUDGE-FLAG <>))
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "NPP">) (T <RFALSE>)>)>
|
||
<COND (<==? .N 1>
|
||
;"Just an NP, so nothing interesting to do"
|
||
<POP-PSTACK ,DATA-STACK>)
|
||
(<==? .N 2>
|
||
;"NP/NPP followed by PP"
|
||
<SET PP <POP-PSTACK ,DATA-STACK>>
|
||
<SET ONPP <POP-PSTACK ,DATA-STACK>>
|
||
<COND (<EQUAL? <PP-PREP .PP> ,W?BUT ,W?EXCEPT>
|
||
;"An exception, which isn't the same as a location"
|
||
<COND
|
||
(<NOT <PMEM-TYPE? .ONPP NP>>;"Can't have exceptions to an NPP"
|
||
<RETURN <PARSER-ERROR 0 ,PARSER-ERROR-NOUND> .RED>)
|
||
(<NOT <NP-QUANT .ONPP>>
|
||
<COND ;"PUT ALL IN FOO BUT BAR?"
|
||
(<NOT <PSTACK-EMPTY? ,DATA-STACK>>
|
||
<SET X1 <POP-PSTACK ,DATA-STACK>>
|
||
<COND (<NOT <PSTACK-EMPTY? ,DATA-STACK>>
|
||
<SET X2 <POP-PSTACK ,DATA-STACK>>
|
||
<COND (<AND <PMEM? .X2>
|
||
<PMEM-TYPE? .X2 NP>
|
||
<NP-QUANT .X2>
|
||
<REDUCE-EXCEPTION .PP .X2>>
|
||
<SET KLUDGE-FLAG T>)>
|
||
<PUSH-PSTACK ,DATA-STACK .X2>)>
|
||
<PUSH-PSTACK ,DATA-STACK .X1>)>
|
||
<COND (<NOT .KLUDGE-FLAG>;"Doesn't make much sense otherwise"
|
||
<RETURN <PARSER-ERROR 0 ,PARSER-ERROR-NOUND> .RED>)>)
|
||
(<NOT <REDUCE-EXCEPTION .PP .ONPP>> ;"Try to make sense of it"
|
||
<RETURN <> .RED>)>)
|
||
(<NOT <SET RLOC <REDUCE-LOCATION .PP>>>
|
||
;"Died, set up orphaning and severity"
|
||
<RETURN <> .RED>)>
|
||
<COND (<NOT .RLOC> .ONPP)
|
||
(<PMEM-TYPE? .ONPP NP>
|
||
;"We have NP (disguised as NPP) followed by PP,
|
||
so glue them together"
|
||
<COND (<NP-LOC .ONPP>
|
||
<PARSER-ERROR 0 ,PARSER-ERROR-TMNOUN
|
||
<LOCATION-PREP .RLOC>>)
|
||
(T
|
||
<NP-LOC .ONPP .RLOC>
|
||
.ONPP)>)
|
||
(T
|
||
;"We have NPP followed by PP. NPP is produced only
|
||
by NP CONJ NP"
|
||
<REPEAT ((OONPP:<OR PMEM FALSE> .ONPP) NP:PMEM)
|
||
<COND (<NOT <NP-LOC <SET NP <NPP-NOUN .OONPP>>>>
|
||
<NP-LOC .NP .RLOC>)>
|
||
<COND (<NOT <SET OONPP <NPP-NEXT .OONPP>>>
|
||
<RETURN .ONPP .RED>)
|
||
(<PMEM-TYPE? .OONPP NP>
|
||
<NP-LOC .OONPP .RLOC>
|
||
<RETURN .ONPP .RED>)>>)>)
|
||
(T
|
||
;"Case of NPP AND NP"
|
||
<SET NP <POP-PSTACK ,DATA-STACK>>
|
||
<COND (<EQUAL? <POP-PSTACK ,DATA-STACK>
|
||
,W?AND ;,W?OR ,W?COMMA>
|
||
<COND (<AND <PMEM-TYPE? <SET NPP <POP-PSTACK ,DATA-STACK>> NP>
|
||
<NP-EXCEPT .NPP>>
|
||
;"Prefer all (but foo and bar) over
|
||
(all but foo) and bar..."
|
||
<RETURN <> .RED>)>
|
||
<SET NP <PMEM-ALLOC NPP NOUN .NP>>
|
||
<COND (<PMEM-TYPE? .NPP NP>
|
||
<PMEM-ALLOC NPP NEXT .NP
|
||
NOUN .NPP>)
|
||
(T
|
||
<REPEAT ((NN:PMEM .NPP) TEMP:<OR FALSE PMEM>)
|
||
<COND (<NOT <SET TEMP <NPP-NEXT .NN>>>
|
||
<NPP-NEXT .NN .NP>
|
||
<RETURN>)>
|
||
<SET NN .TEMP>>
|
||
.NPP)>)>)>>
|
||
|
||
<DEFINE RED-PP PP ("OPT" N:FIX TYP:FIX
|
||
"AUX" TMP NOUN:PMEM (PREP:<OR VWORD FALSE> <>))
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "PP">) (T <RFALSE>)>)>
|
||
<SET NOUN <POP-PSTACK ,DATA-STACK>>
|
||
<COND (<==? .N 2>
|
||
<SET PREP <POP-PSTACK ,DATA-STACK>>)
|
||
(<==? <SET TMP <POP-PSTACK ,DATA-STACK>> ,W?OF>
|
||
<COND (<==? <SET PREP <POP-PSTACK ,DATA-STACK>> ,W?OUT>
|
||
<SET PREP ,W?FROM>)
|
||
(T
|
||
<RETURN <> .PP>)>)
|
||
(<==? .TMP ,W?NOT>
|
||
<COND (<EQUAL? <SET PREP <POP-PSTACK ,DATA-STACK>> ,W?BUT ,W?EXCEPT>
|
||
T)
|
||
(T
|
||
<RETURN <> .PP>)>)>
|
||
<COND (.PREP <PMEM-ALLOC PP PREP .PREP NOUN .NOUN>)>>
|
||
|
||
<ADD-WORD MY ADJ>
|
||
<ADD-WORD ME NOUN>
|
||
<ADD-WORD YOUR ADJ>
|
||
<ADD-WORD YOU NOUN>
|
||
<ADD-WORD ITS ADJ>
|
||
<ADD-WORD IT NOUN>
|
||
<ADD-WORD HIS ADJ>
|
||
<ADD-WORD HIM NOUN>
|
||
<IFN-P-PS-ADV
|
||
<ADD-WORD HER ADJ>
|
||
<ADD-WORD HER NOUN>>
|
||
;<ADD-WORD OUR ADJ>
|
||
;<ADD-WORD US NOUN>
|
||
;<ADD-WORD THEIR ADJ>
|
||
;<ADD-WORD THEM NOUN>
|
||
|
||
<DEFINE RED-POSS RP ("OPT" N:FIX TYP:FIX "AUX" (OBJ 0) WD A)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "POSSESSIVE">) (T <RFALSE>)>)>
|
||
<COND (<==? .N 3>
|
||
<COND (<N==? <POP-PSTACK ,DATA-STACK> ,W?S>
|
||
<PARSER-ERROR 0 ,PARSER-ERROR-NOUND>)
|
||
(<N==? <POP-PSTACK ,DATA-STACK> ,W?APOSTROPHE>
|
||
<PARSER-ERROR 0 ,PARSER-ERROR-NOUND>)
|
||
(T
|
||
<POP-PSTACK ,DATA-STACK>)>)>>
|
||
|
||
<CONSTANT LAST-OBJECT 0>
|
||
|
||
<DEFINE RED-ADJ RA ("OPT" N:FIX TYP:FIX "AUX" A1 A2 CT AD)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "ADJ*">) (T <RFALSE>)>)>
|
||
;"We die after four adjectives for now, since we don't have arbitrary
|
||
storage allocation. Other possibilities exist for the future..."
|
||
<COND (<0? .N> 1)
|
||
(T
|
||
<COND (<==? <SET A1 <POP-PSTACK ,DATA-STACK>> 1>
|
||
<SET A1 <PMEM-ALLOC ADJS LEXPTR ,TLEXV>>)>
|
||
<SET A2 <POP-PSTACK ,DATA-STACK>>
|
||
<COND (<PMEM? .A2> ;"NP"
|
||
<ADJS-POSS .A1 .A2>
|
||
<RETURN .A1 .RA>)
|
||
(<EQUAL? .A2 ,W?MY>
|
||
<ADJS-POSS .A1 ,PLAYER>
|
||
<RETURN .A1 .RA>)
|
||
(<EQUAL? .A2 ,W?YOUR>
|
||
<COND (T ;<NOT <==? ,WINNER ,PLAYER>>
|
||
<ADJS-POSS .A1 ,WINNER>)>
|
||
<RETURN .A1 .RA>)
|
||
(<EQUAL? .A2 ,W?HIS> ;"ASK TROLL ABOUT HIS AX"
|
||
<COND (<AND <SET AD <PARSE-OBJ1 ,PARSE-RESULT>>
|
||
<SET AD <NOUN-PHRASE-OBJ1 .AD>>
|
||
<FSET? .AD ,PERSONBIT>>
|
||
<ADJS-POSS .A1 .AD>
|
||
<IFN-P-PS-ADV
|
||
<COND (<FSET? .AD ,FEMALE ;,FEMALEBIT>
|
||
<ADJS-POSS .A1 ,P-HIM-OBJECT>)>>)
|
||
(T
|
||
<ADJS-POSS .A1 ,P-HIM-OBJECT>)>
|
||
<RETURN .A1 .RA>)>
|
||
<IFN-P-PS-ADV
|
||
<COND (<EQUAL? .A2 ,W?HER>
|
||
<COND (<AND <SET AD <PARSE-OBJ1 ,PARSE-RESULT>>
|
||
<SET AD <NOUN-PHRASE-OBJ1 .AD>>
|
||
<FSET? .AD ,PERSONBIT>
|
||
<FSET? .AD ,FEMALE ;,FEMALEBIT>>
|
||
<ADJS-POSS .A1 .AD>)
|
||
(T
|
||
<ADJS-POSS .A1 ,P-HER-OBJECT>)>
|
||
<RETURN .A1 .RA>)>>
|
||
<COND (<EQUAL? .A2 ,W?ITS>
|
||
<COND (<AND <SET AD <PARSE-OBJ1 ,PARSE-RESULT>>
|
||
<SET AD <NOUN-PHRASE-OBJ1 .AD>>
|
||
<NOT <FSET? .AD ,PERSONBIT>>>
|
||
<ADJS-POSS .A1 .AD>)
|
||
(T
|
||
<ADJS-POSS .A1 ,P-IT-OBJECT>)>)
|
||
(<BAND ,POSSESSIVE <WORD-FLAGS .A2>>
|
||
<ADJS-POSS .A1 <WORD-SEMANTIC-STUFF .A2>>)
|
||
(<EQUAL? .A2 ,W?A ,W?AN ;,W?ANY>
|
||
<ADJS-QUANT .A1 ,NP-QUANT-A>)
|
||
(<EQUAL? .A2 ,W?THE>
|
||
T)
|
||
(<WORD-TYPE? .A2 ,P-ADJ-CODE>
|
||
<SET AD <COND (T ;<CHECK-EXTENDED?> .A2)
|
||
;(T <WORD-ADJ-ID .A2>)>>
|
||
<COND (<L? <SET CT <ADJS-COUNT .A1:PMEM>>:FIX ,ADJS-MAX-COUNT>
|
||
;"Make sure the adjective isn't already here..."
|
||
<REPEAT ((VV:<PRIMTYPE TABLE>
|
||
<REST-TO-SLOT .A1:PMEM ADJS-COUNT 1>)
|
||
(TCT:FIX <ADJS-COUNT .A1:PMEM>))
|
||
<COND (<0? .TCT>
|
||
<ZPUT .VV 0 .A2>
|
||
<ADJS-COUNT .A1 <+ .CT 1>>
|
||
<RETURN>)>
|
||
<COND (<==? .AD <COND (T ;<CHECK-EXTENDED?>
|
||
<ZGET .VV 0>)
|
||
;(T <WORD-ADJ-ID
|
||
<ZGET .VV 0>>)>>
|
||
<RETURN>)>
|
||
<SET VV <ZREST .VV 2>>
|
||
<SET TCT <- .TCT 1>>>)>)
|
||
(T <RETURN <> .RA>)>
|
||
.A1)>>
|
||
|
||
<OBJECT INTQUOTE
|
||
(LOC GLOBAL-OBJECTS)
|
||
(DESC "quotation")>
|
||
|
||
<DEFINE RED-QUOTE ACT ("OPT" N:FIX TYP:FIX "AUX" NP)
|
||
;<COND (<NOT <ASSIGNED? N>>
|
||
<IFFLAG (P-DEBUGGING-PARSER <PRINTR "QUOTE">) (T <RFALSE>)>)>
|
||
<COND (<EQUAL? ,W?QUOTE <POP-PSTACK ,DATA-STACK>>
|
||
;<COND (<EQUAL? .N 3>
|
||
<SET NP <POP-PSTACK ,DATA-STACK>>
|
||
<COND (<EQUAL? ,W?QUOTE <POP-PSTACK ,DATA-STACK>>
|
||
<RETURN .NP .ACT>)
|
||
(T <RETURN <> .ACT>)>)
|
||
(<NOT <SPEAKING-VERB? <PARSE-ACTION ,PARSE-RESULT>>>
|
||
<RETURN <> .ACT>)>
|
||
<SET NP <PMEM-ALLOC NP NAME ,W?QUOTE
|
||
LEXBEG <ZBACK ,P-RUNNING <* 2 ,P-LEXELEN> ;<* 2>>
|
||
;"Back up over NO.WORD">>
|
||
<REPEAT ()
|
||
<SET N <ZGET ,P-RUNNING 0>>
|
||
<COND (<OR <L? <SETG P-LEN <- ,P-LEN 1>> 0>
|
||
<EQUAL? .N ,W?QUOTE ,W?END.OF.INPUT>>
|
||
<COND (<EQUAL? .N ,W?QUOTE>
|
||
<NP-LEXEND .NP ,P-RUNNING>
|
||
<SETG P-RUNNING <ZREST ,P-RUNNING <* 2 ,P-LEXELEN>>>)
|
||
(T
|
||
<NP-LEXEND .NP <ZBACK ,P-RUNNING <* 2 ,P-LEXELEN>>>)>
|
||
;<SETG P-RUNNING <ZREST ,P-RUNNING <* 2 ,P-LEXELEN>>>
|
||
<COND (T ;<NOT <EQUAL? .N ,W?QUOTE>> ;"LOOK UP 'WORM'"
|
||
<SETG P-WORDS-AGAIN </ <- ,P-RUNNING
|
||
<ZGET ,OOPS-TABLE ,O-START>>
|
||
<* 2 ,P-LEXELEN>>>
|
||
;<SETG P-WORDS-AGAIN <- ,P-WORDS-AGAIN 1>>)>
|
||
<RETURN>)>
|
||
<SETG P-RUNNING <ZREST ,P-RUNNING <* 2 ,P-LEXELEN>>>>
|
||
<PMEM-ALLOC NOUN-PHRASE
|
||
COUNT 1 LENGTH ,NOUN-PHRASE-MIN-LENGTH
|
||
OBJ1 ,INTQUOTE NP1 .NP>)>>
|
||
|
||
<END-SEGMENT>
|
||
<ENDPACKAGE>
|