80 lines
4.3 KiB
Plaintext
80 lines
4.3 KiB
Plaintext
<FLAGS-AND-DEFAULTS (("ONE-BYTE-PARTS-OF-SPEECH" %<>)("WORD-FLAGS-IN-TABLE" T)(
|
|
"IN-ZILCH" T)) (("PSEUDO-OBJECTS" "DEFS2" #WORD *37202215421*))>
|
|
|
|
<ZZSECTION "FIND">
|
|
<INCLUDE "BASEDEFS" "PDEFS" "PBITDEFS">
|
|
<USE "NEWSTRUC" "PARSER" "PMEM">
|
|
<BLOCK (<ROOT>)>
|
|
THINGS
|
|
<ENDBLOCK>
|
|
<FILE-FLAGS MDL-ZIL? CLEAN-STACK?>
|
|
<DEFAULTS-DEFINED EXCLUDE-HERE-OBJECT? INVALID-OBJECT? MOBY-FIND?
|
|
LAST-PSEUDO-LOC PSEUDO-OBJECTS SEARCH-IN-LG?>
|
|
<BEGIN-SEGMENT 0>
|
|
<PUT-DECL BOOLEAN '<OR ATOM FALSE>>
|
|
<DEFMAC FD-FLAG (WHICH 'VAL "OPT" 'NEW) <COND (<ASSIGNED? NEW> <COND (<OR <
|
|
TYPE? .NEW ATOM FALSE> <AND <TYPE? .NEW FORM> <EMPTY? .NEW>>> <COND (<TYPE? .
|
|
NEW ATOM> <FORM ORB ,.WHICH .VAL>) (T <FORM ANDB .VAL <XORB ,.WHICH -1>>)>) (<
|
|
TYPE? .VAL FIX LVAL GVAL> <FORM COND (.NEW <FORM ORB .VAL ,.WHICH>) (T <FORM
|
|
ANDB .VAL <XORB ,.WHICH -1>>)>) (T <FORM BIND ((FLAG .VAL)) <FORM COND (.NEW <
|
|
FORM ORB ,.WHICH '.FLAG>) (T <FORM ANDB '.FLAG <XORB ,.WHICH -1>>)>>)>) (T <
|
|
FORM NOT <FORM 0? <FORM ANDB .VAL ,.WHICH>>>)>>
|
|
<CONSTANT FIND-FLAGS-GWIM 1>
|
|
<DEFMAC FIND-GWIM? ('F) <FORM NOT <FORM 0? <FORM ANDB <FORM FIND-FLAGS .F> ,
|
|
FIND-FLAGS-GWIM>>>>
|
|
<CONSTANT FINDER <MAKE-FINDER>>
|
|
<GLOBAL P-NOT-HERE:NUMBER 0>
|
|
<DEFINE-ROUTINE FIND-DESCENDANTS>
|
|
<DEFINE-ROUTINE EXCLUDED?>
|
|
<DEFAULT-DEFINITION INVALID-OBJECT? <ROUTINE INVALID-OBJECT?>>
|
|
<DEFINE-ROUTINE MATCH-OBJECT>
|
|
<CONSTANT SYN-FIND-PROP 256>
|
|
<DEFINE-ROUTINE TEST-OBJECT>
|
|
<DEFINE-ROUTINE ADD-OBJECT>
|
|
<DEFINE-ROUTINE NOT-IN-FIND-RES?>
|
|
<DEFINE-ROUTINE EVERYWHERE-VERB?>
|
|
<DEFINE-ROUTINE MULTIPLE-EXCEPTION?>
|
|
<ADD-WORD OPEN ADJ>
|
|
<ADD-WORD CLOSED ADJ>
|
|
<ADD-WORD SHUT ADJ>
|
|
<DEFINE-ROUTINE CHECK-ADJS-THERE?>
|
|
<DEFINE-ROUTINE CHECK-ADJS>
|
|
<OBJECT GENERIC-OBJECTS (ADJACENT 0)>
|
|
<DEFAULT-DEFINITION MOBY-FIND? <DEFMAC MOBY-FIND? ('SEARCH) <FORM OR <FORM AND
|
|
<FORM BAND .SEARCH ',SEARCH-MOBY> <FORM 0? <FORM BAND .SEARCH ',
|
|
SEARCH-MUST-HAVE>>> <FORM BAND ',PAST-TENSE <FORM WORD-FLAGS <FORM PARSE-VERB '
|
|
,PARSE-RESULT>>>>>>
|
|
<DEFAULT-DEFINITION SEARCH-IN-LG? <ROUTINE SEARCH-IN-LG?>>
|
|
<DEFAULT-DEFINITION EXCLUDE-HERE-OBJECT? <ROUTINE EXCLUDE-HERE-OBJECT?>>
|
|
<DEFINE-ROUTINE FIND-OBJECTS>
|
|
<DEFAULT-DEFINITION PSEUDO-OBJECTS <PUTPROP THINGS PROPSPEC HACK-PSEUDOS> <
|
|
DEFINE20 HACK-PSEUDOS (LIST "AUX" (N 0) (CT 0)) <SET LIST <REST .LIST>> <SET
|
|
LIST <MAPR ,LIST <FUNCTION (X "AUX" L (ACT 0) (NCT 0)) <COND (<0? .N> <SET CT <
|
|
+ .CT 1>> <SET N 1> <COND (<TYPE? <1 .X> ATOM> <SET ACT 1>) (<TYPE? <1 .X> LIST
|
|
> <SET ACT <LENGTH <1 .X>>>) (T <SET ACT 0>)> <COND (<LENGTH? .X 1>) (<TYPE? <2
|
|
.X> ATOM> <SET NCT 1>) (<TYPE? <2 .X> LIST> <SET NCT <LENGTH <2 .X>>>) (T <SET
|
|
NCT 0>)> <TABLE (PURE) <BYTE .ACT> <BYTE .NCT> <COND (<0? .ACT> 0) (<==? .ACT 1
|
|
> <VOC <SPNAME <1 .X>> ADJ>) (T <EVAL <CHTYPE (TABLE (PURE) !<MAPF ,LIST <
|
|
FUNCTION (Y) <VOC <SPNAME .Y> ADJ>> <1 .X>!>) FORM>>)> <COND (<0? .NCT> 0) (<
|
|
==? .NCT 1> <VOC <SPNAME <2 .X>> NOUN>) (T <EVAL <CHTYPE (TABLE (PURE) !<MAPF ,
|
|
LIST <FUNCTION (Y) <VOC <SPNAME .Y> NOUN>> <2 .X>!>) FORM>>)>>) (<1? .N> <SET N
|
|
2> <MAPRET>) (T <SET N 0> <1 .X>)>> .LIST>> (<> <EVAL <CHTYPE (TABLE (PURE) .CT
|
|
!.LIST) FORM>>)> <DEFINE TEST-THINGS (RM F "AUX" CT (RMG <GETP .RM ,P?THINGS>)
|
|
(RMGL <GET .RMG 0>)) <SET RMG <REST .RMG 2>> <COND (<T? <SET CT <FIND-ADJS .F>>
|
|
> <SET CT <ADJS-COUNT .CT>>)> <REPEAT (TTBL (NOUN <FIND-NOUN .F>) XCT (V <
|
|
REST-TO-SLOT <FIND-ADJS .F> ADJS-COUNT 1>)) <SET TTBL <GET .RMG 0>> <COND (<AND
|
|
<OR <EQUAL? .NOUN ,W?ONE> <AND <1? <SET XCT <GETB .TTBL 1>>> <EQUAL? .NOUN <
|
|
ZGET .TTBL 2>>> <INTBL? .NOUN <ZGET .TTBL 2> .XCT>> <OR <0? .CT> <AND <1? <SET
|
|
XCT <GETB .TTBL 0>>> <EQUAL? <ZGET .V 0> <ZGET .TTBL 1>>> <INTBL? <ZGET .V 0> <
|
|
ZGET .TTBL 1> .XCT>> <OR <NOT <FIND-OF .F>> <AND <EQUAL? 1 <FIND-RES-COUNT ,
|
|
OWNER-SR-HERE>> <EQUAL? ,PSEUDO-OBJECT <FIND-RES-OBJ1 ,OWNER-SR-HERE>> <EQUAL?
|
|
,LAST-PSEUDO-LOC .RM> <EQUAL? <GETP ,PSEUDO-OBJECT ,P?ACTION> <GET .RMG 1>>>>>
|
|
<SETG LAST-PSEUDO-LOC .RM> <PUTP ,PSEUDO-OBJECT ,P?ACTION <GET .RMG 1>> <SET V
|
|
<ZBACK <GETPT ,PSEUDO-OBJECT ,P?ACTION> 7>> <COPYT .NOUN .V 6> <COND (<BTST <
|
|
WORD-FLAGS .NOUN> ,PLURAL-FLAG> <FSET ,PSEUDO-OBJECT ,PLURAL>) (T <FCLEAR ,
|
|
PSEUDO-OBJECT ,PLURAL>)> <ADD-OBJECT ,PSEUDO-OBJECT .F> <RFALSE>)> <SET RMG <
|
|
ZREST .RMG 4>> <COND (<L? <SET RMGL <- .RMGL 1>> 1> <RTRUE>)>>> <GLOBAL
|
|
LAST-PSEUDO-LOC:OBJECT <>> <OBJECT PSEUDO-OBJECT (LOC LOCAL-GLOBALS) (DESC
|
|
"pseudoxxx") (ACTION 0)>>
|
|
<END-SEGMENT>
|
|
<END-DEFINITIONS> |