(declare (genprefix cgram)) ################################################################ CGRAM > the regular grammar after going through the precompiler ################################################################ (DEFUN CLAUSE NIL (PROG (FE H ME NB C SM CUT NN T1 T2 T3 :RESULT POSITION-OF-PRTMVB LOCATIONMARKER SUBJ-VB-BACKUP-TYPE1 POSITION-OF-PTW) (SETQ NN T) (SETQ CUT END) (SETQ C (BUILDNODE (SETQ FE (REVERSE REST)) (SETQ NB (OR (NB RE) N)) N (SETQ H RE) NIL)) (SETR 'PARENT PARENT C) ENTERING-CLAUSE (AND LABELTRACE (PASSING 'ENTERING-CLAUSE)) (SETR 'TIME (BUILD TSSNODE= (MAKESYM 'TSS)) C) (SETQ :RESULT (CQ SIMP)) (COND (:RESULT (GO SUBJ))) (SETQ :RESULT (CQ MAJOR)) (COND (:RESULT (GO INIT)) (T (GO SEC))) INIT (AND LABELTRACE (PASSING 'INIT)) (SETQ LOCATIONMARKER N) (SETQ :RESULT (AND (NQ BINDER) (PARSE CLAUSE BOUND INIT))) (COND ((NULL :RESULT) (COND ((NULL NN) (GO FIXIT)) (T (GO MAJOR))))) (FQ BIND) (SETQ :RESULT (CALLSM (SMBIND))) (COND (:RESULT (GO INIT))) FIXIT(AND LABELTRACE (PASSING 'FIXIT)) (SETQ PTW CUT) (SETQ :RESULT (CUT (MOVE-PTW))) (COND (:RESULT (GO INIT)) (T (GO MAJOR))) MAJOR(AND LABELTRACE (PASSING 'MAJOR)) (CUT END) (COND ((EQ PUNCT '?) (GO QUEST)) ((OR (CQ IMPER) (EQ PUNCT '!)) (GO IMPER))) (GO THEREINIT) FDEC (AND LABELTRACE (PASSING 'FDEC)) (FQ DECLAR) THEREINIT (AND LABELTRACE (PASSING 'THEREINIT)) (SETQ :RESULT (AND (NEXTWORD? 'THERE) (PARSE NIL THERE) (FQ DECLAR))) (COND (:RESULT (COND ((NULL NN) (M INIT) (GO FAIL)) (T (GO THERE))))) THER2(AND LABELTRACE (PASSING 'THER2)) (AND (NQ PREP) (PARSE PREPG INIT) (OR (CALLSM (SMRELATE H)) (POP))) (AND (NQ ADV) (PARSE ADV TIMW) (OR (CALLSM (SMADVERB)) (POP))) (AND (NQ ADV) (PARSE ADJG ADV VBAD) (OR (CALLSM (SMRELATE H)) (POP))) (PARSE NG TIME) (SETQ :RESULT (EQ LOCATIONMARKER N)) (COND (:RESULT (COND ((NULL NN) (GO INPOP)) (T (GO CLAUSETYPE)))) (T (GO INIT))) INPOP(AND LABELTRACE (PASSING 'INPOP)) (SETQ :RESULT (MOVE-PT C DLC)) (COND ((NULL :RESULT) (M INPOP) (GO FAIL))) BICUT(AND LABELTRACE (PASSING 'BICUT)) (CUT-BACK-ONE) (GO INIT) CLAUSETYPE (AND LABELTRACE (PASSING 'CLAUSETYPE)) (SETQ :RESULT (CQ DECLAR)) (COND (:RESULT (GO SUBJ))) (SETQ :RESULT (AND (NQ VB) (NQ INF) (PARSE VG IMPER) (FQ IMPER))) (COND (:RESULT (GO VG1))) (FQ DECLAR) (SETQ :RESULT (CQ IMPER)) (COND (:RESULT (M IMPER) (GO FAIL))) SUBJ (AND LABELTRACE (PASSING 'SUBJ)) (CUT END) SUBJ3(AND LABELTRACE (PASSING 'SUBJ3)) (SETQ :RESULT (OR (AND (NEXTWORD? 'TO) (PARSE CLAUSE RSNG TO SUBJ)) (AND (PARSE CLAUSE RSNG ING SUBJ)))) (COND (:RESULT (COND ((NULL NN) (GO SUBJ1)) (T (GO SUBREG))))) SUBJ4(AND LABELTRACE (PASSING 'SUBJ4)) (SETQ :RESULT (PARSE NG SUBJ)) (COND (:RESULT (COND ((NULL NN) (GO SUBJ1)) (T (GO SUBREG))))) (COND ((CQ REL-NOT-FOUND) (RQ REL-NOT-FOUND) (SETR 'SUBJECT (GETR 'RELHEAD C) C) (GO VB)) (SUBJ-VB-BACKUP-TYPE1 (SETQ SUBJ-VB-BACKUP-TYPE1 NIL) (GO SUBJ11)) ((AND H (ISQ H TIME) (ISQ H NG)) (SETR 'SUBJECT H C) (GO VB)) ((MOVE-PT C U (REL-NOT-FOUND)) (SETR 'SUBJECT (GETR 'RELHEAD PT) C) (SETR 'RELHEAD (GETR 'RELHEAD PT) C) (REMOVE-F-PT 'REL-NOT-FOUND PT) (GO VB)) ((AND (CQ COMPONENT) NN) (FQ SUBJFORK) (GO VB)) (H (POP) (GO SUBJ)) ((GO FAIL))) HEAD (AND LABELTRACE (PASSING 'HEAD)) (SETQ :RESULT (OR (MOVE-PTW N PW (NOUN)) (MOVE-PTW N PW (PRON)))) (COND ((NULL :RESULT) (M HEAD) (GO FAIL))) SUB2 (AND LABELTRACE (PASSING 'SUB2)) (SETQ :RESULT (POP)) (COND ((NULL :RESULT) (GO FAIL))) (SETQ :RESULT (CUT PTW)) (COND (:RESULT (GO INIT)) (T (GO SUB2))) SUBJ1(AND LABELTRACE (PASSING 'SUBJ1)) (COND ((ISQ H QUOTED) (AND (ISQ H LIST) (FQ LIST)) (FQ QUOTED) (SETQ H (H H)) (GO RETSM))) (AND (CQ REL-NOT-FOUND) (MOVE-PT H PV (QAUX)) (COND ((ISQ PT BE) (FQ INT AUXBE) (RQ REL-NOT-FOUND) (SETR 'COMP (GETR 'RELHEAD C) C) (SETR 'SUBJECT H C) (SETMVB PT) (GO ONT)) ((ISQ PT HAVE) (FQ SUBQ) (RQ REL-NOT-FOUND) (SETR 'SUBJECT (GETR 'RELHEAD C) C) (GO VBL)))) SUBJ11 (AND LABELTRACE (PASSING 'SUBJ11)) (SETQ :RESULT (CUT-BACK-ONE)) (COND (:RESULT (GO SUBJ3)) (T (M SUBJ11) (GO FAIL))) SUBREG (AND LABELTRACE (PASSING 'SUBREG)) (SETR 'SUBJECT H C) (GO VB) VB (AND LABELTRACE (PASSING 'VB)) (SETQ :RESULT (PARSE ADJG ADV VBAD)) (COND (:RESULT (COND ((NULL NN) (M VB-ADJG) (GO FAIL)) (T (GO VB))))) (RQ VBLOK) VBL (AND LABELTRACE (PASSING 'VBL)) (SETQ :RESULT (PARSE VG)) (COND (:RESULT (GO VBREG))) NOVERB (AND LABELTRACE (PASSING 'NOVERB)) (COND ((CQ SUBJFORK) (FQ VBFORK) (GO FINDOBJ1)) ((ISQ H QUOTED) (FQ REL-NOT-FOUND) (GO SUBJ4)) ((NOT (ISQ H SUBJ)) (GO FAIL)) ((ISQ H CLAUSE) (SETQ SUBJ-VB-BACKUP-TYPE1 T) (POP) (GO SUBJ4)) ((ISQ H SUBJ) (POP) (FQ SUBJFORK) (GO VBL))) VB2 (AND LABELTRACE (PASSING 'VB2)) (CUT-BACK-ONE) (GO SUBJ3) VBREG(AND LABELTRACE (PASSING 'VBREG)) (SETR 'VG H C) VG1 (AND LABELTRACE (PASSING 'VG1)) (CUT END) (SETQ :RESULT (ISQ MVB BE)) (COND (:RESULT (COND ((NULL NN) (M BE) (GO FAIL)) (T (GO BE))))) (SETQ :RESULT (ISQ MVB VPRT)) (COND ((NULL :RESULT) (COND ((NULL NN) (GO CHECKPASV)) (T (GO CHECKPASV))))) (SETQ :RESULT (AND (NQ PRT) (PARSE PRT))) (COND ((NULL :RESULT) (GO DPRT))) (FQ PRT) (SETQ :RESULT (SETMVB (COMBINATION? (ROOT (NB MVB)) (WORD (NB H))))) (COND (:RESULT (GO CHECKPASV)) (T (GO POPRT))) DPRT (AND LABELTRACE (PASSING 'DPRT)) (SETQ :RESULT (ISQ H PASV)) (COND (:RESULT (GO CHECKPASV))) (SETQ :RESULT (SETQ POSITION-OF-PRT (MOVE-PTW N NW (PRT)))) (COND ((NULL :RESULT) (GO FINDOBJ1))) (SETQ :RESULT (SETMVB (COMBINATION? (ROOT (NB MVB)) (WORD POSITION-OF-PRT)))) (COND ((NULL :RESULT) (GO POPRT))) (SETQ :RESULT (ISQ MVB TRANS)) (COND ((NULL :RESULT) (GO FINDOBJ1))) (CUT POSITION-OF-PRT) (SETQ :RESULT (PARSE NG OBJ OBJ1)) (COND (:RESULT (GO POPRT)) (T (GO FINDOBJ1))) (CUT END) (SETR 'OBJ1 H C) (PARSE PRT) (FQ PRT DPRT) (GO FINDOBJ2) POPRT(AND LABELTRACE (PASSING 'POPRT)) (POPTO VG) (GO FINDOBJ1) CHECKPASV (AND LABELTRACE (PASSING 'CHECKPASV)) (SETQ :RESULT (AND (ISQ H PASV) (FQ PASV) (SETR 'OBJ1 (GETR 'SUBJECT C) C))) (COND (:RESULT (COND ((NULL NN) (GO FINDFAKE2)) (T (GO FINDOBJ2))))) (FQ ACTV) (GO FINDOBJ1) BE (AND LABELTRACE (PASSING 'BE)) (FQ BE) (AND (PARSE NIL NOT) (FQ NEG)) (PARSE ADV VBAD) FINDOBJ1 (AND LABELTRACE (PASSING 'FINDOBJ1)) (SETQ :RESULT (OR (CANPARSE 1 '(ADJG COMP) 'INT) (CANPARSE 1 '(NG COMP) 'INT))) (COND (:RESULT (COND ((NULL NN) (GO ONT)) (T (GO CHECKIT))))) (SETQ :RESULT (OR (CANPARSE 1 '(PREPG COMP) 'INT) (CANPARSE 1 '(CLAUSE RSNG ING) 'TRANS) (CANPARSE 1 '(CLAUSE RSNG REPORT) 'TRANS) (CANPARSE 1 '(CLAUSE RSNG TO) 'TRANS) (CANPARSE 1 '(PREPG LOC) 'ITRNSL) (CANPARSE 1 '(ADV PLACE) 'ITRNSL))) (COND (:RESULT (GO ONT))) (SETQ :RESULT (CANPARSE 1 '(NG) 'TRANS)) (COND (:RESULT (COND ((NULL NN) (GO FINDFAKE2)) (T (GO FINDOBJ2))))) FINDFAKE1 (AND LABELTRACE (PASSING 'FINDFAKE1)) (SETQ :RESULT (MOVE-PT C U (REL-NOT-FOUND))) (COND (:RESULT (GO OBJ1REL))) (SETQ :RESULT (AND (CANTAKE 1 '(PREPG LOC) 'ITRNSL) (MOVE-PT C U (QADJ)) (ISQ (GETR 'QADJ PT) PLACE) (FQ ITRANSL))) (COND (:RESULT (GO PUTLOBJ))) (SETQ :RESULT (CANPARSE 1 NIL 'ITRNS)) (COND (:RESULT (GO ONT))) GOOF1(AND LABELTRACE (PASSING 'GOOF1)) (OR GLOBAL-MESSAGE (ERTERR NEW TRANSITIVITY - FIRST OBJ)) (GO FAIL) OBJ1REL (AND LABELTRACE (PASSING 'OBJ1REL)) (SETR 'OBJ1 (GETR 'RELHEAD PT) C) (REMOVE-F-PT 'REL-NOT-FOUND PT) (FQ OBJ1REL) FINDOBJ2 (AND LABELTRACE (PASSING 'FINDOBJ2)) (SETQ :RESULT (CANPARSE 2 '(CLAUSE RSNG TO) 'TRANS2)) (COND (:RESULT (GO FIXSUBJECT))) (SETQ :RESULT (OR (CANPARSE 2 '(ADV PLACE) 'TRANSL) (CANPARSE 2 '(PREPG LOC) 'TRANSL))) (COND (:RESULT (GO ONT))) (SETQ :RESULT (OR (CANPARSE 2 '(ADJG COMP) 'TRANSINT) (CANPARSE 2 '(NG COMP) 'TRANSINT))) (COND (:RESULT (GO ONT))) (SETQ :RESULT (CANPARSE 2 '(NG) 'TRANS2)) (COND (:RESULT (GO ONT))) FINDFAKE2 (AND LABELTRACE (PASSING 'FINDFAKE2)) (SETQ :RESULT (AND (ISQ MVB TRANS2) (MOVE-PT C U (REL-NOT-FOUND)))) (COND (:RESULT (GO OBJ2REL))) (SETQ :RESULT (AND (CANTAKE 2 '(PREPG LOC) 'TRANSL) (MOVE-PT C U (QADJ)) (ISQ (GETR 'QADJ PT) PLACE) (FQ TRANSL))) (COND (:RESULT (GO PUTLOBJ))) OBJ2TO (AND LABELTRACE (PASSING 'OBJ2TO)) (PARSE ADV VBAD) (SETQ :RESULT (COND ((AND (NEXTWORD? 'TO) (ISQ MVB TO2) (PARSE PREPG TO)) (SETR 'OBJ2 (GETR 'OBJ1 H) C) (FQ TRANS2TO TRANS2)) ((AND (CQ PREPQ) (MOVE-PT H PV (QUEST)) (EQ (WORD (MOVE-PTW FW)) 'TO) (RQ PREPQ) (FQ TRANS2TOQ TRANS2) (SETR 'OBJ2 (GETR 'OBJ1 PT) C))))) (COND (:RESULT (GO ONT))) (SETQ :RESULT (CANPARSE 2 NIL 'TRANS)) (COND (:RESULT (GO ONT)) (T (GO FAIL))) PUTLOBJ (AND LABELTRACE (PASSING 'PUTLOBJ)) (SETR 'LOBJ PT C) (SETR 'RELHEAD (GETR 'QADJ PT) PT) (SETR 'QADJ NIL PT) (REMOVE-F-PT 'QADJ PT) (GO ONT) OBJ2REL (AND LABELTRACE (PASSING 'OBJ2REL)) (SETR 'OBJ2 (GETR 'RELHEAD PT) C) (REMOVE-F-PT 'REL-NOT-FOUND PT) (FQ OBJ2REL) (GO ONT) FIXSUBJECT (AND LABELTRACE (PASSING 'FIXSUBJECT)) (SETR 'SUBJECT (GETR 'OBJ1 C) H) (GO ONT) CHECKIT (AND LABELTRACE (PASSING 'CHECKIT)) (SETQ :RESULT (EQ (WORD (NB (GETR 'SUBJECT C))) 'IT)) (COND ((NULL :RESULT) (GO ONT))) (SETQ :RESULT (OR (AND (NEXTWORD? 'TO) (PARSE CLAUSE RSNG TO SUBJ)) (AND (NQ ING) (PARSE CLAUSE RSNG ING SUBJ)) (PARSE CLAUSE REPORT))) (COND ((NULL :RESULT) (GO ONT))) (FQ IT) (SETR 'LOGICAL-SUBJECT H C) (GO ONT) GOOF2(AND LABELTRACE (PASSING 'GOOF2)) (OR GLOBAL-MESSAGE (ERTERR NEW TRANSITIVITY - SECOND OBJECT)) (GO FAIL) ONT (AND LABELTRACE (PASSING 'ONT)) (SETQ :RESULT (CQ PASV)) (COND (:RESULT (GO PONT))) ONT1 (AND LABELTRACE (PASSING 'ONT1)) (SETQ :RESULT (CALLSM (SMCL1))) (COND ((NULL :RESULT) (M SMCL1) (GO FAIL))) (SETQ :RESULT (NOT (CQ REL-NOT-FOUND))) (COND (:RESULT (COND ((NULL NN) (GO RETSM)) (T (GO TONT))))) (SETQ :RESULT (ISQ (GETR 'HEAD (GETR 'RELHEAD C)) TIM1)) (COND ((NULL :RESULT) (GO PREPSHORT))) TIMEQ(AND LABELTRACE (PASSING 'TIMEQ)) (RQ REL-NOT-FOUND) (FQ TIMEQ) (GO TONT) PREPSHORT (AND LABELTRACE (PASSING 'PREPSHORT)) (SETQ :RESULT (AND (NQ PREP) (PARSE PREPG))) (COND ((NULL :RESULT) (M ONT-SHORT-PREP) (GO FAIL))) (SETQ :RESULT (CALLSM (SMRELATE H))) (COND ((NULL :RESULT) (M ONT:) (GO FAIL))) (SETQ :RESULT (CQ REL-NOT-FOUND)) (COND (:RESULT (COND ((NULL NN) (M ONT-NOT-FOUND) (GO FAIL)) (T (GO PREPSHORT)))) (T (GO TONT))) PONT (AND LABELTRACE (PASSING 'PONT)) (AND (NEXTWORD? 'BY) (PARSE PREPG AGENT) (FQ AGENT)) (SETR 'LOGICAL-SUBJECT (GETR 'OBJ1 H) C) (GO ONT1) TONT (AND LABELTRACE (PASSING 'TONT)) (SETQ :RESULT (SETQ POSITION-OF-PTW N)) (COND ((NULL :RESULT) (COND ((NULL NN) (GO RETSM)) (T (GO RETSM))))) NPASV(AND LABELTRACE (PASSING 'NPASV)) (SETQ :RESULT (AND (NQ PREP) (PARSE PREPG) (CALLSM (SMRELATE H)))) (COND ((AND (NULL NN) :RESULT) (GO RETSM))) (SETQ :RESULT (AND (NQ TIMW) (PARSE ADV TIMW) (OR (CALLSM (SMTIME)) (GO FAIL)))) (COND ((AND (NULL NN) :RESULT) (GO RETSM))) (SETQ :RESULT (AND (NOT (CQ BE)) (PARSE ADJG ADV) (OR (CALLSM (SMRELATE H)) (GO FAIL)))) (COND ((AND (NULL NN) :RESULT) (GO RETSM))) (SETQ :RESULT (AND (PARSE NG TIME) (OR (CALLSM (SMTIME)) (GO FAIL)))) (COND ((AND (NULL NN) :RESULT) (GO RETSM))) (SETQ :RESULT (AND (NQ PLACE) (PARSE ADV PLACE) (OR (CALLSM (SMPLACE)) (GO FAIL)))) (COND ((AND (NULL NN) :RESULT) (GO RETSM))) (SETQ :RESULT (AND (NQ BINDER) (PARSE CLAUSE BOUND) (OR (CALLSM (SMBIND)) (GO FAIL)))) (COND ((AND (NULL NN) :RESULT) (GO RETSM))) (SETQ :RESULT (AND (NEXTWORD? 'TO) (PARSE CLAUSE TO ADJUNCT) (OR (CALLSM (SMTOADJ)) (GO FAIL)))) (COND ((AND (NULL NN) :RESULT) (GO RETSM))) (SETQ :RESULT (EQ N POSITION-OF-PTW)) (COND ((NULL :RESULT) (COND ((NULL NN) (GO RETSM)) (T (GO TONT))))) (SETQ :RESULT (OR (NOT (CQ TOPLEVEL)) (NQ SPECIAL))) (COND (:RESULT (GO RETSM))) (ERT CLAUSE: SOMETHING LEFT OVER AT TOP LEVEL) (GO FAIL) THERE(AND LABELTRACE (PASSING 'THERE)) (FQ THERE) (CUT END) (SETQ :RESULT (PARSE ADV TIMW)) (COND ((AND (NULL NN) :RESULT) (M THERE) (GO FAIL))) (SETQ :RESULT (AND (PARSE VG) (ISQ MVB BE))) (COND (:RESULT (COND ((NULL NN) (M THERE) (GO FAIL)) (T (GO THEF)))) (T (GO NOTHE))) THERQ(AND LABELTRACE (PASSING 'THERQ)) (SETQ :RESULT (ISQ (MOVE-PT H PV (QAUX)) BE)) (COND (:RESULT (GO THERQ2))) (SETQ :RESULT (AND (NQ TIMW) (PARSE ADV TIMW))) (COND ((AND (NULL NN) :RESULT) (M THEREQ) (GO FAIL))) (SETQ :RESULT (AND (PARSE VG) (ISQ MVB BE))) (COND (:RESULT (GO THERQ2))) (RQ POLR2) (GO NOTHE) THERQ2 (AND LABELTRACE (PASSING 'THERQ2)) (FQ SUBJTQ) (FQ THERE) (SETQ :RESULT (CQ POLAR)) (COND (:RESULT (GO THEF)) (T (GO ONT))) THEF (AND LABELTRACE (PASSING 'THEF)) (SETQ :RESULT (AND (NQ ADV) (PARSE ADV TIMW))) (COND ((AND (NULL NN) :RESULT) (M THEF) (GO FAIL))) (SETQ :RESULT (PARSE NG SUBJ SUBJT)) (COND ((NULL :RESULT) (GO THERREL))) (FQ THERE) (SETR 'SUBJECT H C) (GO ONT) THERREL (AND LABELTRACE (PASSING 'THERREL)) (SETQ :RESULT (MOVE-PT C U (REL-NOT-FOUND))) (COND ((NULL :RESULT) (GO NOTHE))) (SETR 'SUBJECT (GETR 'RELHEAD PT) C) (REMOVE-F-PT 'REL-NOT-FOUND PT) (GO ONT) NOTHE(AND LABELTRACE (PASSING 'NOTHE)) (RQ THERE) (POP THERE) (AND (NQ ADV) (PARSE ADV PLACE)) (GO THER2) IMPER(AND LABELTRACE (PASSING 'IMPER)) (SETQ :RESULT (PARSE NG TIME)) (COND ((AND (NULL NN) :RESULT) (GO IMPOP))) (SETQ :RESULT (AND (NQ ADV) (PARSE ADJG ADV VBAD))) (COND ((AND (NULL NN) :RESULT) (GO IMPOP))) (SETQ :RESULT (AND (NQ ADV) (PARSE ADV TIMW))) (COND ((AND (NULL NN) :RESULT) (GO IMPOP))) IMPE (AND LABELTRACE (PASSING 'IMPE)) (SETQ :RESULT (PARSE VG IMPER)) (COND ((NULL :RESULT) (GO IMPOP))) (FQ IMPER) (GO VG1) IMPOP(AND LABELTRACE (PASSING 'IMPOP)) (SETQ :RESULT (POP NIL)) (COND (:RESULT (GO IMPE)) (T (M IMPOP) (GO FAIL))) QUEST(AND LABELTRACE (PASSING 'QUEST)) (FQ QUEST) (SETQ :RESULT (NQ PREP)) (COND ((NULL :RESULT) (GO NGQUES))) (SETQ :RESULT (PARSE PREPG)) (COND ((NULL :RESULT) (COND ((NULL NN) (M PREPQ-INCOMPLETE) (GO FAIL)) (T (GO NGQUES))))) (SETQ :RESULT (ISQ H QUEST)) (COND ((NULL :RESULT) (GO QUEST))) (SETR 'QADJ H C) (GO POLAR) NGQUES (AND LABELTRACE (PASSING 'NGQUES)) (SETQ :RESULT (PARSE NG QUEST)) (COND (:RESULT (GO NGQST))) (SETQ :RESULT (OR (AND (NEXTWORD? 'HOW) (PARSE ADJG QUEST) (SETR 'RELHEAD H C)) (AND (NQ QADJ) (PARSE QADJ) (FQ QADJ) (SETR 'QADJ H C)))) (COND (:RESULT (GO POLAR)) (T (GO POLAR))) (FQ SHORTQUES) (CALLSM (SMADJQSHORT)) ADJQS(AND LABELTRACE (PASSING 'ADJQS)) (GO RETURN) NGQST(AND LABELTRACE (PASSING 'NGQST)) (SETR 'RELHEAD H C) NGQST2 (AND LABELTRACE (PASSING 'NGQST2)) (CUT END) (SETR 'SUBJECT H C) (AND (NQ ADV) (PARSE ADJG ADV VBAD)) (COND ((PARSE VG NAUX) (FQ SUBJQ) (GO VG1)) ((NQ VB) (FQ REL-NOT-FOUND) (GO POLAR)) (T (MOVE-PTW N PW) (POP NG QUEST) (CUT PTW) (GO NGQUES))) QUEST2 (AND LABELTRACE (PASSING 'QUEST2)) (SETQ :RESULT (AND (NEXTWORD? 'THERE) (PARSE NIL THERE))) (COND (:RESULT (GO THERQ)) (T (GO SUBF))) SUBF (AND LABELTRACE (PASSING 'SUBF)) (SETQ :RESULT (PARSE NG SUBJ)) (COND (:RESULT (COND ((NULL NN) (GO SUBJ1)) (T (GO SUBREG))))) (RQ REL-NOT-FOUND) (GO BE) POLAR(AND LABELTRACE (PASSING 'POLAR)) (SETQ :RESULT (AND (NQ VB) (PARSE VB AUX (QAUX)) (SETR 'QAUX H C) (CALLSM (SMVAUX)) (SETMVB H))) (COND ((NULL :RESULT) (GO QCHOP))) (OR (CQ QADJ) (GETR 'RELHEAD C) (FQ POLAR)) (FQ POLR2) (GO QUEST2) QCHOP(AND LABELTRACE (PASSING 'QCHOP)) (ERT CLAUSE: QCHOP) (SETQ :RESULT (POPTO CLAUSE BOUND)) (COND (:RESULT (GO BICUT)) (T (M QCHOP) (GO FAIL))) SEC (AND LABELTRACE (PASSING 'SEC)) (COND ((CQ BOUND) (GO BOUND)) ((CQ TO) (GO TO)) ((CQ RSQ) (GO RSQ)) ((CQ REPORT) (GO REPORT)) ((CQ ING) (GO ING)) (T (MQ RSNG-TYPE) (GO FAIL))) BOUND(AND LABELTRACE (PASSING 'BOUND)) (SETQ :RESULT (PARSE BINDER)) (COND ((NULL :RESULT) (COND ((NULL NN) (M BINDER) (GO FAIL)) (T (M BOUND) (GO FAIL))))) (SETQ LOCATIONMARKER N) (GO FDEC) RSQ (AND LABELTRACE (PASSING 'RSQ)) (SETR 'RELHEAD (MOVE-PT C U (NG)) C) (SETQ :RESULT (CQ PREPREL)) (COND ((NULL :RESULT) (GO RSQ2))) (PARSE PREPG PRONREL) (SETR 'QADJ H C) (GO REPORT) RSQ2 (AND LABELTRACE (PASSING 'RSQ2)) (COND ((PARSE VG EN PASV) (OR (ISQ MVB TRANS) (GO FAIL)) (SETR 'SUBJECT (GETR 'RELHEAD C) C) (GO VG1)) ((PARSE VG ING) (SETR 'SUBJECT (GETR 'RELHEAD C) C) (GO VG1)) ((NQ PRONREL) (PARSE NG RELWD) (GO REL)) ((CQ COMPONENT) (SETR 'RELHEAD (GETR 'RELHEAD (MOVE-PT C PC)) C) (GO REL)) ((PARSE NG SUBJ) (FQ REL-NOT-FOUND) (GO SUBREG)) (T (GO FAIL))) REL (AND LABELTRACE (PASSING 'REL)) (SETR 'SUBJECT (GETR 'RELHEAD C) C) (SETQ :RESULT (PARSE VG)) (COND (:RESULT (GO VG1))) (FQ REL-NOT-FOUND) (GO SUBJ) TO (AND LABELTRACE (PASSING 'TO)) (SETQ :RESULT (AND (CQ COMPONENT) (PARSE VG TO TODEL))) (COND (:RESULT (GO VG1))) (SETQ :RESULT (NEXTWORD? 'FOR)) (COND ((NULL :RESULT) (GO TO1))) (PARSE NIL FOR) (FQ FOR) (PARSE NG SUBJ TOSUBJ) (SETR 'SUBJECT H C) TO1 (AND LABELTRACE (PASSING 'TO1)) (SETQ :RESULT (PARSE VG TO)) (COND (:RESULT (GO VG1)) (T (M TO) (GO FAIL))) ING (AND LABELTRACE (PASSING 'ING)) (SETQ :RESULT (MOVE-PTW N NW (ING))) (COND ((NULL :RESULT) (GO FAIL))) (SETQ :RESULT (OR (NQ ING) (CQ OBJ2) (AND (PARSE NG SUBJ INGSUBJ) (SETR 'SUBJECT H C) (FQ SUBING) (RQ ING)))) (COND ((AND (NULL NN) :RESULT) (M ING) (GO FAIL))) (SETQ :RESULT (PARSE VG ING)) (COND (:RESULT (GO VG1)) (T (M ING) (GO FAIL))) REPORT (AND LABELTRACE (PASSING 'REPORT)) (AND (NEXTWORD? 'THAT) (PARSE NIL THAT) (FQ THAT)) (SETQ LOCATIONMARKER N) (GO FDEC) RETSM(AND LABELTRACE (PASSING 'RETSM)) (OR (CALLSM (SMCL2)) (GO FAIL)) (GO RETURN) FAIL (SETQ MES ME) (SETQ N (OR (N RE) NB)) (RETURN NIL) RETURN (SETQ MES ME) (RETURN (REBUILD (REVERSE FE) NB N H SM C)))) (DEFUN NG NIL (PROG (FE H ME NB C SM CUT NN T1 T2 T3 :RESULT) (SETQ NN T) (SETQ CUT END) (SETQ C (BUILDNODE (SETQ FE (REVERSE REST)) (SETQ NB (OR (NB RE) N)) N (SETQ H RE) NIL)) (SETR 'PARENT PARENT C) ENTERING-NG (AND LABELTRACE (PASSING 'ENTERING-NG)) NGSTART (AND LABELTRACE (PASSING 'NGSTART)) (COND ((CQ RELWD) (GO RELWD)) ((CQ QUEST) (GO QUEST)) ((OR (NQ QDET) (NQ QPRON)) (FQ QUEST) (GO QUEST)) ((CQ TIME) (GO TIME)) ((NQ PROPN) (GO PROPN)) ((NQ TPRON) (GO TPRON)) ((NQ EVERPRON) (GO EVERPRON)) ((NQ PRON) (GO PRON))) LOOK (AND LABELTRACE (PASSING 'LOOK)) (COND ((NQ DET) (GO DET)) ((NQ NUM) (GO NUM)) ((OR (NQ ING) (NQ EN) (NQ ADJ)) (GO ADJ)) ((NQ CLASF) (GO CLASF)) ((NQ NUMD) (GO NUMD)) ((NEXTWORD? 'AT) (GO AT)) ((NEXTWORD? 'AS) (GO AS)) ((NQ NOUN) (GO NOUN)) ((NQ TIMORD) (GO TIMORD)) ((AND (CQ COMPONENT) (ISQ (MOVE-PT PC) QUEST)) (GO QUEST)) ((MQ START) (GO FAIL))) START(AND LABELTRACE (PASSING 'START)) PROPN(AND LABELTRACE (PASSING 'PROPN)) (PARSE PROPN) (FQ DEF PROPNG) (SETQ :RESULT (ISQ H POSS)) (COND (:RESULT (GO PROPS))) (SETQ :RESULT (AND NN (NQ PROPN))) (COND (:RESULT (GO PROPN))) PROPS(AND LABELTRACE (PASSING 'PROPS)) (OR (CALLSM (SMPROP)) (GO FAIL)) (SETQ :RESULT (ISQ H POSS)) (COND (:RESULT (GO POSS)) (T (GO PRAG))) PRON (AND LABELTRACE (PASSING 'PRON)) (SETQ :RESULT (PARSE PRON POSS)) (COND (:RESULT (COND ((NULL NN) (GO RED2)) (T (GO POSS))))) PRON2(AND LABELTRACE (PASSING 'PRON2)) (SETQ :RESULT (CQ NPRON)) (COND (:RESULT (M NPRON) (GO FAIL))) (SETQ :RESULT (OR (AND (CQ SUBJ) (PARSE PRON SUBJ)) (AND (OR (CQ OBJ) (CQ TOSUBJ) (CQ INGSUBJ)) (PARSE PRON OBJ)) (CQ INGSUBJ))) (COND ((NULL :RESULT) (M PRON) (GO FAIL))) (FQ PRONG DEF) PRON3(AND LABELTRACE (PASSING 'PRON3)) (SETQ :RESULT (CALLSM (SMPRON H))) (COND ((NULL :RESULT) (GO FAIL))) PRAG (AND LABELTRACE (PASSING 'PRAG)) (SETR 'HEAD H C) (MOVE-PT H) (TRNSF NS NPL NFS NEG) (GO RETURN) TPRON(AND LABELTRACE (PASSING 'TPRON)) (PARSE TPRON) (FQ TPRON) (MOVE-PT H) (TRNSF NS NPL ANY NEG) (SETR 'HEAD C H) (AND NN (NQ ADJ) (PARSE ADJ)) (GO SMNG) EVERPRON (AND LABELTRACE (PASSING 'EVERPRON)) (SETQ :RESULT (AND (PARSE PRON EVERPRON) (CALLSM (SMPRON H)))) (COND ((NULL :RESULT) (GO FAIL))) (SETQ :RESULT (AND (PARSE CLAUSE RSQ NOREL) (CALLSM (SMRELATE H)))) (COND (:RESULT (GO RETSM)) (T (GO FAIL))) AS (AND LABELTRACE (PASSING 'AS)) (SETQ :RESULT (AND (PARSE NIL AS) (PARSE NUMD NUMDAS) NN (PARSE NIL AS))) (COND (:RESULT (COND ((NULL NN) (M AS) (GO FAIL)) (T (GO NUMD2)))) (T (M AS) (GO FAIL))) AT (AND LABELTRACE (PASSING 'AT)) (SETQ :RESULT (AND (PARSE NIL AT) (PARSE NUMD NUMDAT))) (COND ((NULL :RESULT) (COND ((NULL NN) (M AT) (GO FAIL)) (T (M AT) (GO FAIL))))) NUMD2(AND LABELTRACE (PASSING 'NUMD2)) (SETQ :RESULT (AND (PARSE NUM) (FQ NUM NUMD))) (COND (:RESULT (COND ((NULL NN) (GO INCOM)) (T (GO DET1)))) (T (M NUMD2) (GO FAIL))) NUMD (AND LABELTRACE (PASSING 'NUMD)) (SETQ :RESULT (PARSE NUMD NUMDAN)) (COND ((NULL :RESULT) (COND ((NULL NN) (GO INCOM)) (T (GO ND3))))) (SETQ :RESULT (PARSE NIL THAN)) (COND (:RESULT (COND ((NULL NN) (GO POPCOM)) (T (GO NUMD2)))) (T (GO INCOM))) ND3 (AND LABELTRACE (PASSING 'ND3)) (SETQ :RESULT (PARSE NUMD NUMDALONE)) (COND (:RESULT (COND ((NULL NN) (M NUMD) (GO FAIL)) (T (GO NUMD2)))) (T (M NUMD) (GO FAIL))) TIME (AND LABELTRACE (PASSING 'TIME)) (SETQ :RESULT (AND (NQ TIME) (PARSE NOUN TIME))) (COND (:RESULT (GO RETSM))) (SETQ :RESULT (MOVE-PTW N NW (TIM1))) (COND (:RESULT (GO LOOK)) (T (M TIME) (GO FAIL))) TIMORD (AND LABELTRACE (PASSING 'TIMORD)) (SETQ :RESULT (PARSE ORD TIMORD)) (COND ((NULL :RESULT) (GO FAIL))) (SETQ :RESULT (AND (PARSE NOUN TIM1) (FQ DET DEF) (CALLSM (SMNGTIME)))) (COND (:RESULT (GO RETURN)) (T (GO FAIL))) DET (AND LABELTRACE (PASSING 'DET)) (PARSE DET) (FQ DET) (MOVE-PT H) (SETQ :RESULT (TRNSF NPL NS PART DEF INDEF ANY NEG QNTFR)) (COND (:RESULT (COND ((NULL NN) (GO INCOM)) (T (GO IND)))) (T (M BUG) (GO FAIL))) IND (AND LABELTRACE (PASSING 'IND)) (SETQ :RESULT (AND (EQ (WORD (NB H)) 'ALL) (EQ (WORD N) 'THE) (PARSE DET) (FQ DEF))) (COND (:RESULT (COND ((NULL NN) (M THE) (GO FAIL)) (T (GO NUM))))) (SETQ :RESULT (AND (ISQ H QNTFR) (FQ QNTFR))) (COND (:RESULT (GO QNUM))) ORD (AND LABELTRACE (PASSING 'ORD)) (SETQ :RESULT (AND (PARSE ORD) (FQ ORD))) (COND ((NULL :RESULT) (COND ((NULL NN) (GO INCOM)) (T (GO NUM))))) (SETQ :RESULT (AND (NEXTWORD? 'OF) (ISQ (MOVE-PTW N NW) MONTH) (PARSE NIL OF) (PARSE NOUN MONTH) (FQ DATE))) (COND (:RESULT (GO RETSM))) (SETQ :RESULT (CQ DEF)) (COND ((NULL :RESULT) (GO ADJ))) NUM (AND LABELTRACE (PASSING 'NUM)) (SETQ :RESULT (PARSE NUM)) (COND ((NULL :RESULT) (GO ADJ))) (FQ NUM) (SETQ :RESULT (CQ DET)) (COND ((NULL :RESULT) (GO DET1))) (SETQ :RESULT (COND ((AND (ISQ H NS) (CQ NS)) (RQ NPL PART)) ((CQ NPL) (RQ NS PART)))) (COND (:RESULT (COND ((NULL NN) (GO INCOM)) (T (GO ADJ)))) (T (M NUM) (GO FAIL))) DET1 (AND LABELTRACE (PASSING 'DET1)) (COND ((ISQ H NS) (FQ NS)) (T (FQ NPL))) (OR NN (AND (FQ NUMBER) (GO INCOM))) NUMBER (AND LABELTRACE (PASSING 'NUMBER)) (FQ DET) (SETQ :RESULT (NQ OF)) (COND (:RESULT (GO OF)) (T (GO ADJ))) QNUM (AND LABELTRACE (PASSING 'QNUM)) (SETQ :RESULT (ISQ H NONUM)) (COND (:RESULT (GO OF))) (SETQ :RESULT (AND (PARSE NUM) (FQ NUM))) (COND ((NULL :RESULT) (GO OF))) (SETQ :RESULT (COND ((EQ (SM H) 1) (AND (CQ NS) (RQ NPL))) ((CQ NPL) (RQ NS)))) (COND ((NULL :RESULT) (COND ((NULL NN) (GO INCOM)) (T (M NUMD) (GO FAIL))))) (SETQ :RESULT (EQ (WORD (NB H)) 'NO)) (COND (:RESULT (GO ADJ))) OF (AND LABELTRACE (PASSING 'OF)) (SETQ :RESULT (AND (NQ OF) (PARSE PREPG OF))) (COND (:RESULT (GO SMOF)) (T (GO NONE))) SMOF (AND LABELTRACE (PASSING 'SMOF)) (FQ OF) (SETQ :RESULT (OR (CALLSM (SMNGOF)) (NOT (POP)))) (COND (:RESULT (GO RETSM)) (T (GO INCOM))) NONE (AND LABELTRACE (PASSING 'NONE)) (SETQ :RESULT (EQ (WORD (NB H)) 'NONE)) (COND (:RESULT (GO INCOM)) (T (GO ADJ))) ADJ (AND LABELTRACE (PASSING 'ADJ)) (SETQ :RESULT (PARSE ADJ)) (COND ((NULL :RESULT) (COND ((NULL NN) (GO INCOM)) (T (GO EPR))))) (AND (ISQ H COMPAR) (FQ COMPARATIVE-MODIFIER) (SETR 'COMPARATIVE-MODIFIER H C)) (GO ADJ) EPR (AND LABELTRACE (PASSING 'EPR)) (SETQ :RESULT (OR (ISQ H SUP) (ISQ H COMPAR))) (COND ((NULL :RESULT) (COND ((NULL NN) (GO INCOM)) (T (GO CLASF))))) (FQ ADJ) (AND (NEXTWORD? 'OF) (PARSE PREPG OF) (OR (CALLSM (SMNGOF)) (GO FAIL)) (FQ OF) (GO RETSM)) CLASF(AND LABELTRACE (PASSING 'CLASF)) (SETQ :RESULT (OR (PARSE VB ING (CLASF)) (PARSE VB EN (CLASF)) (PARSE CLASF))) (COND (:RESULT (COND ((NULL NN) (GO REDUC)) (T (GO CLASF))))) NOUN (AND LABELTRACE (PASSING 'NOUN)) (SETQ :RESULT (PARSE NOUN)) (COND ((NULL :RESULT) (GO RED2))) (SETQ :RESULT (AND (CQ TIME) (NOT (ISQ H TIM1)))) (COND (:RESULT (GO RED1))) (SETQ T1 FE) (COND ((AND (ISQ H MASS) (OR (CQ PART) (NOT (CQ DET)))) (FQ MASS))) (COND ((NOT (ISQ H NPL)) (RQ NPL PART))) (COND ((NOT (ISQ H NS)) (RQ NS))) (COND ((AND (NOT (CQ DET)) (NOT (CQ NUMD))) (MOVE-PT H) (TRNSF NPL MASS))) (SETQ :RESULT (MEET FE '(NS NPL PART MASS))) (COND ((NULL :RESULT) (GO RED0))) (SETQ :RESULT (NEXTWORD? 'THAN)) (COND ((NULL :RESULT) (GO SMNG))) (FQ THAN) SMNG (AND LABELTRACE (PASSING 'SMNG)) (SETR 'HEAD H C) (SETQ :RESULT (AND (CQ OBOFJ) (NOT (CQ DEF)))) (COND (:RESULT (GO FAIL))) (OR (CALLSM (SMNG1)) (GO FAIL)) (SETQ :RESULT (NOT (ISQ H POSS))) (COND ((NULL :RESULT) (COND ((NULL NN) (GO RETSM)) (T (GO POSS))))) (SETQ :RESULT (AND (CQ THAN) (PARSE ADJG))) (COND ((NULL :RESULT) (GO RSQ-TO))) (SETQ :RESULT (CALLSM (SMRELATE H))) (COND (:RESULT (GO RETSM)) (T (GO FAIL))) RSQ-TO (AND LABELTRACE (PASSING 'RSQ-TO)) (SETQ :RESULT (AND (NEXTWORD? 'TO) (MEET FE '(COMP SUBJ)) (PARSE CLAUSE RSQ TO) (OR (CALLSM (SMRELATE H)) (GO POPRET)))) (COND (:RESULT (GO RETSM))) (SETQ :RESULT (AND (OR (NEXTWORD? 'AS) (NQ COMPAR)) (PARSE ADJG THANNEED))) (COND ((NULL :RESULT) (GO PREPNG))) (AND (NULL N) (CQ SUBJ) (ISQ (MOVE-PT C PV) AUX) (ISQ PT BE) (GO POPRET)) (SETQ :RESULT (CALLSM (SMRELATE H))) (COND (:RESULT (COND ((NULL NN) (GO RETSM)) (T (GO RSQ-TO)))) (T (GO POPRET))) PREPNG (AND LABELTRACE (PASSING 'PREPNG)) (SETQ :RESULT (AND (NQ PREP) (NOT (OR (AND (NQ PLACE) (CQ NOLOC)) (AND (CQ OBJ1) (ISQ MVB TRANSL) (NOT (ISQ (MOVE-PT C U) QUEST))))) (PARSE PREPG Q))) (COND ((NULL :RESULT) (GO DISGRSQ))) (AND (NULL N) (CQ SUBJ) (ISQ (MOVE-PT C PV) AUX) (ISQ PT BE) (NOT (ISQ (MOVE-PT U) NGQ)) (GO POPRET)) (SETQ :RESULT (CALLSM (SMRELATE H))) (COND (:RESULT (COND ((NULL NN) (GO RETSM)) (T (GO RSQ-TO)))) (T (GO POPRET))) DISGRSQ (AND LABELTRACE (PASSING 'DISGRSQ)) (SETQ :RESULT (EQ (CAR MES) 'PREP-WHICH)) (COND ((NULL :RESULT) (GO RSQ))) (SETQ MES (CDR MES)) (SETQ :RESULT (PARSE CLAUSE RSQ PREPREL)) (COND (:RESULT (COND ((NULL NN) (GO RETSM)) (T (GO PREPNG)))) (T (M RSQ-PREPREL) (GO FAIL))) RSQ (AND LABELTRACE (PASSING 'RSQ)) (SETQ :RESULT (AND (ISQ (MOVE-PT C U) POLR2) (CQ SUBJ) (NQ VB) (NOT (CQ SUBJT)) (NOT (ISQ PT QADJ)))) (COND (:RESULT (GO RETSM))) (SETQ :RESULT (PARSE CLAUSE RSQ)) (COND ((NULL :RESULT) (GO RETSM))) (SETQ :RESULT (CALLSM (SMRELATE H))) (COND (:RESULT (GO RETSM)) (T (GO POPRET))) RED0 (AND LABELTRACE (PASSING 'RED0)) (SETQ FE T1) RED1 (AND LABELTRACE (PASSING 'RED1)) (POP) RED2 (AND LABELTRACE (PASSING 'RED2)) (COND ((NULL H) (MQ NO) (GO FAIL)) ((ISQ H NUMBER) (GO INCOM)) ((AND (ISQ H POSS) (OR (ISQ H PRON) (AND (MOVE-PT H DLC) (ISQ PT PRON)))) (POP) (GO PRON2)) ((AND (NULL (CDR H)) (CQ DEFPOSS)) (GO POSSDEF)) ((AND (CQ QUEST) (NULL (CDR H))) (GO QDETCHECK)) ((ISQ H ADJ) (GO EPR)) ((NOT (ISQ H CLASF)) (GO INCOM))) REDUC(AND LABELTRACE (PASSING 'REDUC)) (POP) (SETQ :RESULT (AND (NULL H) (NQ PROPN))) (COND (:RESULT (GO PROPN)) (T (GO NOUN))) POPCOM (AND LABELTRACE (PASSING 'POPCOM)) (POP) INCOM(AND LABELTRACE (PASSING 'INCOM)) (FQ INCOM) (SETQ :RESULT (AND (ISQ H DET) (ISQ H INCOM) (CALLSM (SMINCOM)))) (COND (:RESULT (GO RETURN))) (SETQ :RESULT (AND (NULL CUT) (CQ NUM))) (COND (:RESULT (GO SMNG))) QDETCHECK (AND LABELTRACE (PASSING 'QDETCHECK)) (COND ((AND (ISQ H QDET) (ISQ (NB H) QPRON)) (POP) (GO QPRON)) ((AND (ISQ H QDET) (ISQ (NB H) EVERPRON)) (POP) (GO EVERPRON))) (GO FAIL) POSS (AND LABELTRACE (PASSING 'POSS)) (OR (CALLSM (SMNG2)) (GO FAIL)) POSS2(AND LABELTRACE (PASSING 'POSS2)) (SETQ :RESULT (CQ INGSUBJ)) (COND (:RESULT (GO RETSM))) (SETQ H (BUILDNODE (REVERSE (CONS 'POSS (SETDIF FE '(COMPONENT)))) NB N H SM)) (SETQ BACKREF (APPEND H (CDR BACKREF))) (SETQ :RESULT (SETR 'FEATURES (SETQ FE (APPEND '(POSES DET DEF NS NPL) (REVERSE REST))) C)) (COND ((NULL :RESULT) (M BUG) (GO FAIL))) (SETQ :RESULT (OR (NOT NN) (ISQ H DEFPOSS))) (COND ((NULL :RESULT) (GO ORD))) POSSDEF (AND LABELTRACE (PASSING 'POSSDEF)) (RQ POSES DET DEF) (FQ POSSDEF NS NPL) QUEST(AND LABELTRACE (PASSING 'QUEST)) (SETQ :RESULT (PARSE NIL HOW)) (COND ((NULL :RESULT) (COND ((NULL NN) (GO FAIL)) (T (GO QDET))))) (SETQ :RESULT (PARSE NIL MANY)) (COND ((NULL :RESULT) (COND ((NULL NN) (GO INCOM)) (T (GO FAIL))))) (FQ DET NPL INDEF HOWMANY) (GO OF) QDET (AND LABELTRACE (PASSING 'QDET)) (SETQ :RESULT (AND (PARSE DET QDET) (FQ DET NPL QDET NS))) (COND (:RESULT (COND ((NULL NN) (GO INCOM)) (T (GO QNUM))))) QPRON(AND LABELTRACE (PASSING 'QPRON)) (SETQ :RESULT (PARSE PRON QPRON)) (COND (:RESULT (GO PRON3)) (T (GO FAIL))) RELWD(AND LABELTRACE (PASSING 'RELWD)) (SETQ :RESULT (AND (PARSE PRONREL) (CALLSM (SMSET (SM (MOVE-PT C U U (NG))))))) (COND (:RESULT (GO RETURN))) POPRET (AND LABELTRACE (PASSING 'POPRET)) (POP) RETSM(AND LABELTRACE (PASSING 'RETSM)) (OR (CALLSM (SMNG2)) (GO TRYA)) (GO RETURN) TRYA (AND LABELTRACE (PASSING 'TRYA)) (SETQ :RESULT (ISQ H NOUN)) (COND ((NULL :RESULT) (M TRYA) (GO FAIL))) (POP) (CUT N) UP (AND LABELTRACE (PASSING 'UP)) (SETQ :RESULT (POP)) (COND (:RESULT (GO UP))) (SETQ FE (REVERSE REST)) (SMSET NIL) (GO NGSTART) FAIL (SETQ MES ME) (SETQ N (OR (N RE) NB)) (RETURN NIL) RETURN (SETQ MES ME) (RETURN (REBUILD (REVERSE FE) NB N H SM C)))) (DEFUN VG NIL (PROG (FE H ME NB C SM CUT NN T1 T2 T3 :RESULT TENSE) (SETQ NN T) (SETQ CUT END) (SETQ C (BUILDNODE (SETQ FE (REVERSE REST)) (SETQ NB (OR (NB RE) N)) N (SETQ H RE) NIL)) (SETR 'PARENT PARENT C) ENTERING-VG (AND LABELTRACE (PASSING 'ENTERING-VG)) (COND ((CQ TO) (GO TO)) ((CQ EN) (GO EN)) ((CQ ING) (GO ING)) ((CQ IMPER) (GO IMPER)) ((ISQ (MOVE-PT C U) POLR2) (GO POLR2))) NEW (AND LABELTRACE (PASSING 'NEW)) (COND ((NOT (NQ VB)) (MQ VB) (GO FAIL)) ((AND (NQ DO) (PARSE VB AUX DO)) (GO DO)) ((AND (NQ MODAL) (PARSE VB AUX MODAL)) (GO MODAL)) ((AND (NQ WILL) (PARSE VB AUX WILL)) (GO WILL)) ((AND (NQ BE) (PARSE VB AUX BE)) (GO BE)) ((AND (NQ HAVE) (PARSE VB AUX HAVE)) (GO HAVE)) ((NOT (PARSE VB (MVB))) (MQ VB) (GO FAIL))) SIMPLE (AND LABELTRACE (PASSING 'SIMPLE)) (MOVE-PT C DLC) (TRNSF VPL INF V3PS) (SETQ TENSE (COND ((AND (ISQ PT PRESENT) (ISQ PT PAST)) '(PAST-PRESENT)) ((ISQ PT PAST) '(PAST)) (T '(PRESENT)))) (GO REV) TO (AND LABELTRACE (PASSING 'TO)) (FQ NAGR) (SETQ :RESULT (AND (PARSE NIL NOT) (FQ NEG))) (COND ((AND (NULL NN) :RESULT) (M NOT) (GO FAIL))) (SETQ :RESULT (OR (PARSE NIL TO) (CQ TODEL))) (COND ((NULL :RESULT) (COND ((NULL NN) (M TO) (GO FAIL)) (T (M TO) (GO FAIL))))) (SETQ TENSE '(INFINITIVE)) (GO MODAL2) EN (AND LABELTRACE (PASSING 'EN)) (FQ NAGR) (SETQ :RESULT (AND (PARSE NIL NOT) (FQ NEG))) (COND ((AND (NULL NN) :RESULT) (M NOT) (GO FAIL))) (SETQ TENSE '(PAST)) (SETQ :RESULT (AND (PARSE VB EN (MVB)) (SETMVB H) (FQ PASV))) (COND (:RESULT (GO RETSM)) (T (GO FAIL))) ING (AND LABELTRACE (PASSING 'ING)) (FQ NAGR) (SETQ :RESULT (AND (PARSE NIL NOT) (FQ NEG))) (COND ((AND (NULL NN) :RESULT) (M NOT) (GO FAIL))) INGADV (AND LABELTRACE (PASSING 'INGADV)) (SETQ :RESULT (OR (PARSE ADV TIMW) (PARSE ADV VBAD))) (COND (:RESULT (GO INGADV))) (SETQ TENSE '(PRESENT)) (GO BE2) IMPER(AND LABELTRACE (PASSING 'IMPER)) (SETQ :RESULT (AND (PARSE VB DO NEG INF) (FQ NEG))) (COND ((AND (NULL NN) :RESULT) (M DONT) (GO FAIL))) (SETQ :RESULT (AND (PARSE VB (MVB) INF) (SETMVB H) (CALLSM (SMVG)))) (COND (:RESULT (GO RETURN)) (T (M IMPER) (GO FAIL))) POLR2(AND LABELTRACE (PASSING 'POLR2)) (OR (SETQ PT (GETR 'QAUX (MOVE-PT C U))) (AND (BUG VG:POLR2) (GO FAIL))) (SETQ H (LIST (CAR PT))) (TRNSF NEG) (COND ((ISQ H DO) (GO DO)) ((ISQ H MODAL) (GO MODAL)) ((ISQ H WILL) (GO WILL)) ((ISQ H BE) (GO BE)) ((ISQ H HAVE) (GO HAVE))) (ERT BUG VG:POLR2VB) (GO FAIL) DO (AND LABELTRACE (PASSING 'DO)) (FQ DO) (MOVE-PT C DLC) (TRNSF VPL NEG INF V3PS) (SETQ TENSE (COND ((ISQ PT PAST) '(PAST)) (T '(PRESENT)))) (COND (NN (GO DO2)) (T (GO MVB))) DO2 (AND LABELTRACE (PASSING 'DO2)) (SETQ :RESULT (AND (PARSE NIL NOT) (FQ NEG))) (COND ((AND (NULL NN) :RESULT) (M NOT) (GO FAIL))) ADV2 (AND LABELTRACE (PASSING 'ADV2)) (SETQ :RESULT (OR (PARSE ADV TIMW) (PARSE ADV VBAD))) (COND (:RESULT (COND ((NULL NN) (M ADV) (GO FAIL)) (T (GO ADV2))))) (SETQ :RESULT (PARSE VB (MVB) INF)) (COND ((NULL :RESULT) (GO MVB))) (GO REV) MODAL(AND LABELTRACE (PASSING 'MODAL)) (FQ NAGR MODAL) (SETQ TENSE '(MODAL)) (COND (NN (GO MODAL2)) (T (GO INCOMP))) MODAL2 (AND LABELTRACE (PASSING 'MODAL2)) (SETQ :RESULT (AND (PARSE NIL NOT) (FQ NEG))) (COND ((AND (NULL NN) :RESULT) (M NOT) (GO FAIL))) ADV3 (AND LABELTRACE (PASSING 'ADV3)) (SETQ :RESULT (OR (PARSE ADV TIMW) (PARSE ADV VBAD))) (COND (:RESULT (COND ((NULL NN) (M ADV) (GO FAIL)) (T (GO ADV3))))) (COND ((PARSE VB BE INF) (GOCOND BE2 MVB)) ((PARSE VB HAVE INF) (GOCOND HAV2 MVB)) ((PARSE VB INF (MVB)) (GO REV)) (T (GO INCOMP))) WILL (AND LABELTRACE (PASSING 'WILL)) (FQ NAGR) (SETQ TENSE '(FUTURE)) (COND (NN (GO MODAL2)) (T (GO INCOMP))) BE (AND LABELTRACE (PASSING 'BE)) (MOVE-PT C DLC) (TRNSF VPL INF V3PS VFS) (SETQ TENSE (COND ((ISQ PT PAST) '(PAST)) (T '(PRESENT)))) (COND (NN (GO BE2)) (T (GO MVB))) BE2 (AND LABELTRACE (PASSING 'BE2)) (SETQ :RESULT (AND (PARSE NIL NOT) (FQ NEG))) (COND ((AND (NULL NN) :RESULT) (M NOT) (GO FAIL))) ADV4 (AND LABELTRACE (PASSING 'ADV4)) (SETQ :RESULT (OR (PARSE ADV TIMW) (PARSE ADV VBAD))) (COND (:RESULT (COND ((NULL NN) (M ADV) (GO FAIL)) (T (GO ADV4))))) (COND ((AND (NEXTWORD? 'GOING) (PARSE VB)) (GO GOING)) ((AND (NQ BE) (PARSE VB ING)) (SETQ TENSE (CONS 'PRESENT TENSE)) (GO EN2)) ((AND (NQ ING) (PARSE VB ING (MVB))) (SETQ TENSE (CONS 'PRESENT TENSE)) (GO REV)) ((CQ ING) (MQ ING) (GO FAIL))) EN2 (AND LABELTRACE (PASSING 'EN2)) (SETQ :RESULT (PARSE VB EN (MVB))) (COND ((NULL :RESULT) (GO MVBE))) (FQ PASV) (GO REV) GOING(AND LABELTRACE (PASSING 'GOING)) (SETQ :RESULT (PARSE NIL TO)) (COND ((NULL :RESULT) (GO GOI))) (SETQ :RESULT (NQ INF)) (COND (:RESULT (GO GOING2))) (POP) GOI (AND LABELTRACE (PASSING 'GOI)) (SETQ TENSE (CONS 'PRESENT TENSE)) (GO MVB) GOING2 (AND LABELTRACE (PASSING 'GOING2)) (SETQ TENSE (CONS 'FUTURE TENSE)) (GO MODAL2) MVBE (AND LABELTRACE (PASSING 'MVBE)) (SETQ :RESULT (ISQ (MOVE-PT H PV (VB)) AUX)) (COND ((NULL :RESULT) (GO MVB))) (SETQ :RESULT (ISQ PT BE)) (COND ((NULL :RESULT) (M MVBE) (GO FAIL))) (SETMVB PT) (GO REV) HAVE (AND LABELTRACE (PASSING 'HAVE)) (MOVE-PT C DLC) (TRNSF VPL INF V3PS VFS) (SETQ TENSE (COND ((ISQ PT PAST) (FQ NAGR) '(PAST)) (T '(PRESENT)))) (COND (NN (GO HAV2)) (T (GO MVB))) HAV2 (AND LABELTRACE (PASSING 'HAV2)) (SETQ :RESULT (AND (PARSE NIL NOT) (FQ NEG))) (COND ((AND (NULL NN) :RESULT) (M NOT) (GO FAIL))) ADV5 (AND LABELTRACE (PASSING 'ADV5)) (SETQ :RESULT (PARSE ADV)) (COND (:RESULT (COND ((NULL NN) (M ADV) (GO FAIL)) (T (GO ADV5))))) (SETQ :RESULT (PARSE VB BE EN)) (COND ((NULL :RESULT) (GO HAV3))) (SETQ TENSE (CONS 'PAST TENSE)) (COND (NN (GO BE2)) (T (GO MVB))) HAV3 (AND LABELTRACE (PASSING 'HAV3)) (SETQ :RESULT (PARSE VB (MVB) EN)) (COND ((NULL :RESULT) (GO MVB))) (SETQ TENSE (CONS 'PAST TENSE)) (GO REV) INCOMP (AND LABELTRACE (PASSING 'INCOMP)) (FQ INCOMP) (GO FAIL) MVB (AND LABELTRACE (PASSING 'MVB)) (SETQ :RESULT (EQ (FE MVB) (FE H))) (COND (:RESULT (GO MVB2))) (POP VB) (SETQ :RESULT (PARSE VB (MVB))) (COND ((NULL :RESULT) (M MVB) (GO FAIL))) MVB2 (AND LABELTRACE (PASSING 'MVB2)) (GO REV) REV (AND LABELTRACE (PASSING 'REV)) (SETR 'TENSE TENSE C) (AND NN (PARSE NIL NOT) (FQ NEG)) (COND ((OR (EQUAL TENSE '(PAST)) (CQ NAGR) (ISQ (MOVE-PT C U) IMPER) (ISQ PT THERE) (ISQ PT RSNG)) (GO NAUX)) ((SETQ PT (GETR 'SUBJECT (MOVE-PT C U)))) (T (ERTERR VG -- NO SUBJECT TO CHECK FOR AGREEMENT))) (SETQ T3 NIL) (COND ((ISQ PT NFS) (OR (SETQ T3 (MEET FE '(VFS INF))) (GO NAGR))) ((ISQ PT CLAUSE) (OR (SETQ T3 (CQ V3PS)) (GO NAGR))) ((OR (ISQ PT NS) (ISQ PT MASS)) (OR (AND (CQ V3PS) (SETQ T3 T)) (FESET PT (SETDIF (FE PT) '(NS MASS)))))) (COND ((OR (ISQ PT PART) (ISQ PT NPL)) (OR (AND (MEET FE '(INF VPL)) (SETQ T3 T)) (FESET PT (SETDIF (FE PT) '(PART NPL)))))) NAGR (AND LABELTRACE (PASSING 'NAGR)) (SETQ :RESULT (OR T3 (AND (EQUAL '(PAST-PRESENT) TENSE) (SETQ TENSE '(PAST))))) (COND ((NULL :RESULT) (M NAGR) (GO FAIL))) NAUX (AND LABELTRACE (PASSING 'NAUX)) (SETMVB (OR (MOVE-PT H PV (MVB)) MVB)) (SETQ :RESULT (AND (CQ NAUX) (ISQ (MOVE-PT H PV (VB)) AUX) (NOT (MOVE-PT PV PV (VB))))) (COND (:RESULT (M NAUX) (GO FAIL)) (T (GO RETSM))) POPV (AND LABELTRACE (PASSING 'POPV)) (ERT POPV) (GO FAIL) RETSM(AND LABELTRACE (PASSING 'RETSM)) (SETQ :RESULT (CALLSM (SMVG))) (COND (:RESULT (GO RETURN)) (T (GO FAIL))) FAIL (SETQ MES ME) (SETQ N (OR (N RE) NB)) (RETURN NIL) RETURN (SETQ MES ME) (RETURN (REBUILD (REVERSE FE) NB N H SM C)))) (DEFUN PREPG NIL (PROG (FE H ME NB C SM CUT NN T1 T2 T3 :RESULT) (SETQ NN T) (SETQ CUT END) (SETQ C (BUILDNODE (SETQ FE (REVERSE REST)) (SETQ NB (OR (NB RE) N)) N (SETQ H RE) NIL)) (SETR 'PARENT PARENT C) ENTERING-PREPG (AND LABELTRACE (PASSING 'ENTERING-PREPG)) ADV (AND LABELTRACE (PASSING 'ADV)) (SETQ :RESULT (AND (NQ PREPADV) (PARSE ADV PREPADV))) (COND (:RESULT (COND ((NULL NN) (M PREPADV) (GO FAIL)) (T (GO ADV))))) (SETQ :RESULT (COND ((CQ AGENT) (NEXTWORD? 'BY)) ((CQ LOC) (NQ PLACE)) ((CQ Q) (NOT (NQ MOTOR))) (T))) (COND ((NULL :RESULT) (M PREP) (GO FAIL))) (SETQ :RESULT (PARSE PREP)) (COND ((NULL :RESULT) (M PREP) (GO FAIL))) (MOVE-PT H) (TRNSF PLACE TIME) (SETQ T1 H) (AND (NQ PREP2) (COND ((SETQ T1 (COMBINATION? (WORD (NB H)) (WORD N))) (PARSE PREP2)) ((SETQ T1 (COMBINATION? (WORD (NB H)) (WORD N) (WORD (CDR N)))) (PARSE PREP2) (PARSE PREP2))) (SETQ T1 (BUILDNODE (FE T1) NB N 'WORD (SM T1))) (SETR 'PARENT C T1)) (SETQ :RESULT (ISQ H NEED2)) (COND (:RESULT (M NEED2) (GO FAIL))) (SETR 'HEAD T1 C) (OR NN (GO SHORT)) (COND ((EQ (WORD H) 'BY) (FQ AGENT))) QUEST(AND LABELTRACE (PASSING 'QUEST)) (SETQ :RESULT (CQ QUEST)) (COND ((NULL :RESULT) (GO NG))) (SETQ :RESULT (PARSE NG QUEST OBJ)) (COND (:RESULT (GO OBJR)) (T (M PREPQUEST) (GO FAIL))) (SETQ :RESULT (AND (CQ OF) (PARSE NG OFOBJ))) (COND (:RESULT (GO OBJR))) NG (AND LABELTRACE (PASSING 'NG)) (SETQ :RESULT (PARSE NG OBJ)) (COND (:RESULT (GO OBJR))) REL (AND LABELTRACE (PASSING 'REL)) (SETQ :RESULT (NEXTWORD? 'WHICH)) (COND ((NULL :RESULT) (GO REST))) (SETQ :RESULT (ISQ (MOVE-PT U) CLAUSE)) (COND ((NULL :RESULT) (M PREP-WHICH) (GO FAIL))) (SETQ :RESULT (ISQ PT PRONREL)) (COND ((NULL :RESULT) (GO PRONREL))) (SETQ MES (CDR MES)) (GO P-RELWRD) PRONREL (AND LABELTRACE (PASSING 'PRONREL)) (REMOVE-F-PT 'REL-NOT-FOUND PT) (ADD-F-PT 'PRONREL PT) P-RELWRD (AND LABELTRACE (PASSING 'P-RELWRD)) (PARSE NG RELWD OBJ) (SETR 'OBJ1 (GETR 'HEAD PT) C) (GO RETT) REST (AND LABELTRACE (PASSING 'REST)) (SETQ :RESULT (PARSE CLAUSE RSNG ING)) (COND (:RESULT (GO OBJR)) (T (GO SHORT))) OBJR (AND LABELTRACE (PASSING 'OBJR)) (SETR 'OBJ1 H C) (GO RETT) SHORT(AND LABELTRACE (PASSING 'SHORT)) (SETQ :RESULT (MEET FE '(NOSHORT Q))) (COND (:RESULT (M SHORT) (GO FAIL))) (OR (ISQ (MOVE-PT C U) REL-NOT-FOUND) (ISQ (GETR 'QUESTION-ELEMENT PT) QADJ) (GO FAIL)) (REMOVE-F-PT 'REL-NOT-FOUND PT) (ADD-F-PT 'PREPREL PT) (SETR 'OBJ1 (GETR 'RELHEAD (MOVE-PT C U)) C) RETT (AND LABELTRACE (PASSING 'RETT)) (AND (OR (ISQ H QUEST) (AND (ISQ H COMPOUND) (MOVE-PT H H PV (QUEST)))) (FQ QUEST)) (SETQ :RESULT (CALLSM (SMADJG-PREPG))) (COND (:RESULT (GO RETURN)) (T (GO FAIL))) FAIL (SETQ MES ME) (SETQ N (OR (N RE) NB)) (RETURN NIL) RETURN (SETQ MES ME) (RETURN (REBUILD (REVERSE FE) NB N H SM C)))) (DEFUN ADJG NIL (PROG (FE H ME NB C SM CUT NN T1 T2 T3 :RESULT) (SETQ NN T) (SETQ CUT END) (SETQ C (BUILDNODE (SETQ FE (REVERSE REST)) (SETQ NB (OR (NB RE) N)) N (SETQ H RE) NIL)) (SETR 'PARENT PARENT C) ENTERING-ADJG (AND LABELTRACE (PASSING 'ENTERING-ADJG)) COMPCHECK (AND LABELTRACE (PASSING 'COMPCHECK)) (SETQ :RESULT (AND (MOVE-PT C U (BE)) (NOT (CQ COMP)))) (COND (:RESULT (GO FAIL))) (SETQ :RESULT (ISQ (MOVE-PT C U) THAN)) (COND ((NULL :RESULT) (GO DISP))) (SETR 'HEAD (GETR 'COMPARATIVE-MODIFIER PT) C) (GO THAN) DISP (AND LABELTRACE (PASSING 'DISP)) (SETQ :RESULT (AND (NQ AS) (PARSE NIL AS))) (COND (:RESULT (COND ((NULL NN) (M AS) (GO FAIL)) (T (GO AS))))) (SETQ :RESULT (AND (NQ AS) (PARSE NIL AS))) (COND (:RESULT (COND ((NULL NN) (M AS) (GO FAIL)) (T (GO AS))))) (SETQ :RESULT (NEXTWORD? 'HOW)) (COND (:RESULT (GO HOW)) (T (GO ADV))) HOW (AND LABELTRACE (PASSING 'HOW)) (SETQ :RESULT (AND (PARSE NIL HOW) (FQ QUEST))) (COND ((NULL :RESULT) (COND ((NULL NN) (GO FAIL)) (T (GO FAIL))))) (SETQ :RESULT (AND (PARSE ADJ) (FQ ADJ) (SETR 'HEAD H C))) (COND (:RESULT (GO RETSM))) (SETQ :RESULT (AND (PARSE ADV VBAD) (FQ VBAD) (SETR 'HEAD H C))) (COND (:RESULT (GO RETSM)) (T (GO FAIL))) ADV (AND LABELTRACE (PASSING 'ADV)) (SETQ :RESULT (PARSE ADV ADVADV)) (COND (:RESULT (COND ((NULL NN) (GO POPAD)) (T (GO ADV))))) (SETQ :RESULT (PARSE NIL MORE)) (COND ((NULL :RESULT) (GO ADJ))) (FQ COMPAR) ADJ (AND LABELTRACE (PASSING 'ADJ)) (SETQ :RESULT (COND ((CQ ADV) (PARSE ADV VBAD)) (T (PARSE ADJ)))) (COND ((NULL :RESULT) (M ADJ) (GO FAIL))) (SETQ :RESULT (SETR 'HEAD H C)) (COND ((AND (NULL NN) :RESULT) (GO RETSM))) (SETQ :RESULT (OR (CQ COMPAR) (ISQ H COMPAR))) (COND ((NULL :RESULT) (GO RETSM))) (FQ COMPAR) (SETQ :RESULT NN) (COND ((NULL :RESULT) (GO RETSM))) THAN (AND LABELTRACE (PASSING 'THAN)) (COND ((NOT NN) (GO RETSM))) (SETQ :RESULT (PARSE NIL THAN)) (COND ((NULL :RESULT) (COND ((NULL NN) (M THAN) (GO FAIL)) (T (GO RETSM))))) (RQ THANNEED) (FQ THAN) (GO SUBJ) AS (AND LABELTRACE (PASSING 'AS)) (FQ AS) (RQ THANNEED) (SETQ :RESULT (AND (PARSE ADJ) (SETR 'HEAD H C))) (COND ((NULL :RESULT) (COND ((NULL NN) (GO RETSM)) (T (M ADJ) (GO FAIL))))) (SETQ :RESULT (PARSE NIL AS)) (COND (:RESULT (COND ((NULL NN) (M AS) (GO FAIL)) (T (GO SUBJ)))) (T (GO RETSM))) SUBJ (AND LABELTRACE (PASSING 'SUBJ)) (SETQ :RESULT (PARSE NG SUBJ COMPAR)) (COND ((NULL :RESULT) (M THAN) (GO FAIL))) (SETQ :RESULT (SETR 'OBJ1 H C)) (COND ((AND (NULL NN) :RESULT) (GO RETSM))) (SETQ :RESULT (AND (ONE-WORD-LEFT) (PARSE VB AUX))) (COND ((NULL :RESULT) (GO RETSM))) (SETQ :RESULT (CHECK-AGREEMENT H (CDR H))) (COND (:RESULT (GO RETSM))) (POP) (GO RETSM) POPAD(AND LABELTRACE (PASSING 'POPAD)) (POP) (GO ADJ) RETSM(AND LABELTRACE (PASSING 'RETSM)) (SETQ :RESULT (CQ THANNEED)) (COND (:RESULT (M THANNEED) (GO FAIL))) (SETQ :RESULT (CALLSM (SMADJG-PREPG))) (COND (:RESULT (GO RETURN)) (T (M SMADJ) (GO FAIL))) FAIL (SETQ MES ME) (SETQ N (OR (N RE) NB)) (RETURN NIL) RETURN (SETQ MES ME) (RETURN (REBUILD (REVERSE FE) NB N H SM C)))) (DEFUN CONJ NIL (PROG (END GOODIE) (SETQ END CUT) (COND ((SETQ GOODIE (APPLY-GRAMMAR 'CONJOIN)) (RETURN (SETQ RE GOODIE))) (T (RETURN NIL))))) (DEFUN COMMA NIL (COND ((SECONDWORD? '") (FLUSHME) T) ((CONJ)) ((ISQ RE INIT) (FLUSHME) T))) (DEFUN CONJOIN NIL (PROG (FE H ME NB C SM CUT NN T1 T2 T3 :RESULT PREV) (SETQ NN T) (SETQ CUT END) (SETQ C (BUILDNODE (SETQ FE (REVERSE REST)) (SETQ NB (OR (NB RE) N)) N (SETQ H RE) NIL)) (SETR 'PARENT PARENT C) ENTERING-CONJOIN (AND LABELTRACE (PASSING 'ENTERING-CONJOIN)) UP (AND LABELTRACE (PASSING 'UP)) (SETQ PREV (NEXTWORD)) (FLUSHME) (COND ((AND (EQ PREV '/,) (OR (CDR H) (GREATERP (DIFFERENCE (LENGTH (NB H)) (LENGTH (N H))) 4)) (MEMQ (NEXTWORD) '(OR AND NOR BUT)) (F (NEXTWORD))) (SETQ PREV (LIST PREV (NEXTWORD))) (FLUSHME))) (AND (ATOM PREV) (MOVE-PTW N NW (EQ (WORD PTW) PREV)) (CUT PTW)) (AND (OR (EQ PREV 'BUT) (EQ (CADR PREV) 'BUT)) (NEXTWORD? 'NOT) (OR (FLUSHME) (GO LOSE2)) (FQ NEGBUT)) (SETQ :RESULT (COND ((MEMQ (CAR REST) '(ADJ NUM NOUN PREP VB ADV)) (PARSE3 (APPEND REST '(COMPONENT)) NIL)) ((MEMQ (CAR REST) '(NG PREPG ADJG)) (AND (NOT (CQ OFOBJ)) (PARSE2 (APPEND REST '(COMPONENT)) NIL))) ((EQ (CAR REST) 'CLAUSE) ((LAMBDA (LASTSENT AUXFE) (AND (PARSE2 (APPEND REST AUXFE '(COMPONENT)) NIL) (OR (NOT AUXFE) (F (CAR AUXFE))) (SETR 'TIME (GETR 'TIME H) C))) (COND ((ISQ H MAJOR) H) (LASTSENT)) (MEET (FE H) '(DECLAR IMPER)))))) (COND ((NULL :RESULT) (GO LOSE2))) (CUT END) (COND ((NOT (ATOM PREV)) (GO RETSM)) ((EQ PREV '/,) (COND ((NEXTWORD? COMMA) (FQ LIST) (GO UP)) (T (GO LIST)))) ((MEMQ PREV '(AND OR NOR BUT)) (COND ((EQ BOTH (NB H)) (FQ BOTH))) (COND ((OR (NEXTWORD? 'BUT) (AND (NEXTWORD? PREV) (NOT (AND (EQ BOTH (NB H)) (EQ PREV 'AND))))) (FQ LISTA) (F PREV) (GO UP)) (T (GO LISTA))))) LOSE2(AND LABELTRACE (PASSING 'LOSE2)) (SETQ :RESULT (CQ LISTA)) (COND (:RESULT (GO LISTA))) LIST (AND LABELTRACE (PASSING 'LIST)) (SETQ :RESULT (AND (EQ PREV '/,) (EQUAL (LENGTH H) 2) (ISQ H NG) (NOT (OR (ISQ H PRONG) (ISQ (CDR H) PRONG))) (OR (NEXTWORD? COMMA) (NULL N)))) (COND ((NULL :RESULT) (M CONJOIN:) (GO FAIL))) (FLUSHME) (FQ APPOSITIVE) (GO RETSM) LISTA(AND LABELTRACE (PASSING 'LISTA)) (F PREV) RETSM(AND LABELTRACE (PASSING 'RETSM)) (FQ COMPOUND) (AND (GREATERP (LENGTH H) 2) (FQ LIST)) (COND ((OR (CQ NG) (CQ NOUN)) (COND ((CQ AND) (FQ NPL)) (T (MOVE-PT H) (TRNSF NPL NS MASS NFS)))) ((CQ VB) (PROG (COMMON) (SETQ COMMON (GET 'VB 'ELIM)) (MAP '(LAMBDA (X) (SETQ COMMON (MEET COMMON (FE X)))) H)) (FESET (UNION COMMON (FE C)) C))) (SETQ :RESULT (CALLSM (SMCONJ))) (COND (:RESULT (GO RETURN)) (T (M CONJOIN:) (GO FAIL))) FAIL (SETQ MES ME) (SETQ N (OR (N RE) NB)) (RETURN NIL) RETURN (SETQ MES ME) (RETURN (REBUILD (REVERSE FE) NB N H SM C)))) (DEFUN BOTH FEXPR (A) (PROG (END) (SETQ END CUT) (RETURN (PROG (CUT NBB BOTH) (SETQ NBB N) (AND (FLUSHME) (MOVE-PTW N NW (EQ (WORD PTW) (CAR A)) NW) (CUT END) (SETQ BOTH PTW) (SETQ RE (COND ((MEMQ (CAR REST) '(PREP ADV)) (PARSE3 REST T)) ((MEMQ (CAR REST) '(NG PREPG ADJG CLAUSE)) (PARSE2 REST T)))) (LESSP (LENGTH N) (LENGTH BOTH)) (RETURN (SETQ SPECIAL 'SKIP))) (SETQ RE NIL) (SETQ N NBB) (RETURN NIL))))) (DEFUN DOUBLEQUOTER NIL (APPLY-GRAMMAR 'PARSEQUOTED)) (DEFUN CANTAKE (NUM TYPE FEATURE) (PROG (VBFEAT) (SETQ VBFEAT (FE MVB)) (RETURN (COND ((MEMQ 'RSNG TYPE) (MEMQ (READLIST (APPEND (COND ((MEMQ 'TO TYPE) '(T O)) ((MEMQ 'ING TYPE) '(I N G)) ((MEMQ 'REPORT TYPE) '(R E P))) '(O B) (LIST (COND ((EQ NUM 1) '/1) (T '/2))))) VBFEAT)) ((MEMQ 'COMP TYPE) (MEMQ 'INT VBFEAT)) ((MEMQ 'NG TYPE) (COND ((EQUAL NUM 1) (NOT (NULL (MEET '(TRANS TRANS2 TRANSL TRANSINT) VBFEAT)))) (T (MEMQ 'TRANS2 VBFEAT)))) (T (MEMQ FEATURE VBFEAT)))))) (DEFUN CANPARSE (NUM TYPE FEATURE) (PROG (REG) (AND (CANTAKE NUM TYPE FEATURE) (OR (NULL TYPE) (AND (APPLY 'PARSE (APPEND TYPE (COND ((MEMQ 'COMP TYPE) (SETQ REG 'COMP) NIL) (T (LIST 'OBJ (SETQ REG (COND ((OR (MEMQ 'LOC TYPE) (MEMQ 'PLACE TYPE)) 'LOBJ) ((EQUAL NUM 1) 'OBJ1) (T 'OBJ2)))))))) (SETR REG H C))) (OR (NULL FEATURE) (F FEATURE)) (RETURN T)))) REMEMBER/ TO/ UFILE