-
Notifications
You must be signed in to change notification settings - Fork 16
/
prare.zabstr
84 lines (83 loc) · 4.37 KB
/
prare.zabstr
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
<FLAGS-AND-DEFAULTS (("P-ZORK0" %<>)("ONE-BYTE-PARTS-OF-SPEECH" %<>)(
"WORD-FLAGS-IN-TABLE" T)("IN-ZILCH" T)("P-APOSTROPHE-BREAKS-WORDS" T)(
"P-BE-VERB" T)) (("SETUP-ORPHAN-NP" "DEFS" #WORD *32734731554*) (
"WINNER-SAYS-WHICH?" "DEFS" #WORD *11064457026*) ("REFRESH" "DEFS" #WORD
*26533721703*))>
<ZZPACKAGE "PARSER">
<RENTRY PRINT-LEXV TELL-CTHE TELL-THE>
<INCLUDE "BASEDEFS" "PBITDEFS" "PDEFS">
<USE "PMEM" "PSTACK" "REDS">
<FILE-FLAGS MDL-ZIL? CLEAN-STACK?>
<BEGIN-SEGMENT 0>
<DEFAULTS-DEFINED CANT-FIND-OBJECT CANT-USE-MULTIPLE DONT-UNDERSTAND
PRINT-INTQUOTE PRINT-LEXV REFRESH SETUP-ORPHAN SETUP-ORPHAN-NP TOO-MANY-NOUNS
WHICH-LIST? WHICH-PRINT WINNER-SAYS-WHICH? YES?>
<DEFINE-ROUTINE TOO-MANY-NEW>
<DEFINE-ROUTINE NAKED-OOPS>
<DEFINE-ROUTINE CANT-OOPS>
<DEFINE-ROUTINE CANT-AGAIN>
<DEFAULT-DEFINITION CANT-USE-MULTIPLE <ROUTINE CANT-USE-MULTIPLE>>
<DEFINE-ROUTINE MAKE-ROOM-FOR-TOKENS>
<DEFINE-ROUTINE REPLACE-ONE-TOKEN>
<DEFAULT-DEFINITION REFRESH <DEFINE V-$REFRESH () <LOWCORE FLAGS <BAND <LOWCORE
FLAGS> <BCOM ,F-REFRESH>>> <CLEAR -1> <INIT-STATUS-LINE> <RTRUE>>>
<DEFAULT-DEFINITION PRINT-INTQUOTE <ROUTINE PRINT-INTQUOTE>>
<DEFAULT-DEFINITION PRINT-LEXV <ROUTINE PRINT-LEXV>>
<DEFINE-ROUTINE COPY-INPUT>
<COND (<NOT <OR <CHECK-VERSION? XZIP> <CHECK-VERSION? YZIP>>> <DEFINE
COPY-INBUF (SRC DEST "AUX" CNT:FIX) <SET CNT <- <GETB .SRC 0> 1>> <REPEAT () <
PUTB .DEST .CNT <GETB .SRC .CNT>> <COND (<L? <SET CNT <- .CNT 1>> 0> <RETURN>)>
>> <DEFINE COPY-LEXV (SRC DEST "OPT" (MAX:FIX ,LEXV-LENGTH) "AUX" (CTR:FIX 1))
<PUTB .DEST 0 <GETB .SRC 0>> <PUTB .DEST 1 <GETB .SRC 1>> <SET DEST <ZREST .
DEST <* ,P-LEXSTART:FIX 2>>> <SET SRC <ZREST .SRC <* ,P-LEXSTART:FIX 2>>> <
REPEAT () <ZPUT .DEST 0 <ZGET .SRC 0>> <PUTB .DEST 2 <GETB .SRC 2>> <PUTB .DEST
3 <GETB .SRC 3>> <COND (<G? <SET CTR <+ .CTR 1>> .MAX> <RETURN>)> <SET DEST <
ZREST .DEST <* 2 ,P-LEXELEN:FIX>>> <SET SRC <ZREST .SRC <* 2 ,P-LEXELEN:FIX>>>>
>)>
<END-SEGMENT>
<BEGIN-SEGMENT 0>
<ADD-WORD NO.WORD ADJ>
<DEFINE-ROUTINE BUFFER-PRINT>
<DEFINE-ROUTINE CAPITALIZE>
<DEFINE-ROUTINE PRINT-PARSER-FAILURE>
<DEFINE-ROUTINE NAKED-ADJECTIVE?>
<DEFINE-ROUTINE CHANGE-AND-TO-THEN?>
<DEFAULT-DEFINITION DONT-UNDERSTAND <ROUTINE DONT-UNDERSTAND>>
<DEFINE-ROUTINE MISSING>
<DEFAULT-DEFINITION CANT-FIND-OBJECT <ROUTINE CANT-FIND-NPP> <ROUTINE
CANT-FIND-OBJECT> <ROUTINE NP-CANT-SEE>>
<DEFAULT-DEFINITION WINNER-SAYS-WHICH? <DEFINE WINNER-SAYS-WHICH? (NP) <>>>
<DEFAULT-DEFINITION WHICH-LIST? <ROUTINE WHICH-LIST?>>
<DEFAULT-DEFINITION WHICH-PRINT <ROUTINE WHICH-PRINT>>
<DEFINE-ROUTINE NP-PRINT>
<DEFINE-ROUTINE ADJS-PRINT>
<DEFAULT-DEFINITION TOO-MANY-NOUNS <ROUTINE TOO-MANY-NOUNS>>
<DEFINE-ROUTINE INBUF-ADD>
<DEFINE-ROUTINE INBUF-PRINT>
<DEFAULT-DEFINITION YES? <CONSTANT YES-INBUF <ITABLE 19 (BYTE LENGTH) 0>> <
CONSTANT YES-LEXV <ITABLE 3 (LEXV) 0 0>> <DEFINE YES? ("OPT" (NO-Q <>) "AUX"
WORD VAL) <COND (<NOT .NO-Q> <TELL !\?>)> <REPEAT () <TELL "|>"> <COND (T <PUTB
,YES-INBUF 1 0>)> <COND (,DEMO-VERSION? <READ-DEMO ,YES-INBUF ,YES-LEXV>) (T <
ZREAD ,YES-INBUF ,YES-LEXV>)> <COND (<AND <NOT <0? <GETB ,YES-LEXV ,P-LEXWORDS>
>> <SET WORD <ZGET ,YES-LEXV ,P-LEXSTART>>> <COND (<COMPARE-WORD-TYPES <
WORD-CLASSIFICATION-NUMBER .WORD> <GET-CLASSIFICATION VERB>> <SET VAL <
WORD-VERB-STUFF .WORD>>) (T <SET VAL <>>)> <COND (<EQUAL? .VAL ,ACT?YES> <SET
VAL T> <RETURN>) (<OR <EQUAL? .VAL ,ACT?NO> <EQUAL? .WORD ,W?N>> <SET VAL <>> <
RETURN>) (<EQUAL? .VAL ,ACT?RESTART> <V-RESTART>) (<EQUAL? .VAL ,ACT?RESTORE> <
V-RESTORE>) (<EQUAL? .VAL ,ACT?QUIT> <V-QUIT>)>)> <TELL
"[Please type YES or NO.]">> .VAL>>
<DEFAULT-DEFINITION SETUP-ORPHAN <ROUTINE SETUP-ORPHAN>>
<DEFAULT-DEFINITION SETUP-ORPHAN-NP <DEFINE SETUP-ORPHAN-NP (STR OBJ1 OBJ2
"OPT" (OBJ3 <>) "AUX" NUM VEC) <DIROUT ,D-TABLE-ON ,O-INBUF> <TELL .STR> <
DIROUT ,D-TABLE-OFF> <PUTB ,O-INBUF 0 ,INBUF-LENGTH> <LEX ,O-INBUF ,O-LEXV> <
COND (<ZERO? <SET NUM <GETB ,O-LEXV ,P-LEXWORDS>>> <>) (<INTBL? 0 <ZREST ,
O-LEXV <* 2 ,P-LEXSTART>> .NUM 132> <>) (T <SETG P-OFLAG <- 1 <* ,P-LEXELEN <
GETB ,O-LEXV ,P-LEXWORDS>>>> <ZPUT ,OOPS-TABLE ,O-END <+ 2 <GETB ,O-INBUF 1>>>
<ZPUT ,OOPS-TABLE ,O-AGAIN <ZREST ,P-LEXV <* 2 ,P-LEXSTART>>> <SET VEC <
REST-TO-SLOT ,ORPHAN-SR FIND-RES-OBJ1>> <ZPUT .VEC 0 .OBJ1> <ZPUT .VEC 1 .OBJ2>
<SET NUM 2> <COND (<T? .OBJ3> <INC NUM> <ZPUT .VEC 2 .OBJ3>)> <FIND-RES-COUNT ,
ORPHAN-SR .NUM> T)>>>
<DEFINE-ROUTINE INSERT-ADJS>
<DEFINE-ROUTINE INSERT-ADJS-WD>
<END-SEGMENT>
<ENDPACKAGE>