2 <BLOCK (<MOBLIST M!- 13> <ROOT>)>
12 <BLOCK (<MOBLIST IM!-M!- 23> <GET M!- OBLIST> <ROOT>)>
14 <SETG O <FUNCTION (IT)
22 <NEWTYPE CURSOR!- VECTOR>
26 <SETG GETC <FUNCTION () <CHTYPE [.CO .CI .CL+1 .LST .LOC] CURSOR>>>
28 <SETG PUSHO <FUNCTION (IT) <PUSH!- OPDL <GETC>> <O .IT>>>
30 <SETG POPO <FUNCTION () <NC <POP!- OPDL>>>>
32 <SETG NC <FUNCTION (IT)
39 \f<SETG L <FUNCTION (N "AUX" (T <- .CI .N>))
40 <==? .T <SET CI <MAX 1 .T>>>>>
42 <SETG R <FUNCTION (N "AUX" (T <+ .CI .N>))
43 <==? .T <SET CI <MIN .CL+1 .T>>>>>
47 <COND (<==? .CI .CL+1> #FALSE("NO-RIGHT"))
48 (ELSE <PRID .CI T>)>>>
52 <COND (<1? .CI> #FALSE("NO-LEFT"))
53 (ELSE <PRID <- .CI 1> #FALSE()>)>>>
55 <SETG PRID <FUNCTION (N T)
56 <COND (<MONAD? <.N .CO>> #FALSE("MONAD"))
58 <SET LST (.CO .N .CL+1 !.LST)>
60 <SET CL+1 <+ 1 <LENGTH .CO>>>
61 <SET CI <COND (.T 1) (ELSE .CL+1)>>)>>>
64 <COND (<EMPTY? .LST> #FALSE("TOP"))
65 (ELSE <SET CI <2 .LST>> <PRIU>)>>>
68 <COND (<EMPTY? .LST> #FALSE("TOP"))
69 (ELSE <SET CI <+ 1 <2 .LST>>> <PRIU>)>>>
71 <SETG PRIU <FUNCTION ()
74 <SET LST <REST .LST 3>>
76 \f<SETG WR <FUNCTION () <OR <DR> <R 1> <UR>>>>
77 <SETG WL <FUNCTION () <OR <DL> <L 1> <UL>>>>
79 <SETG SR <FUNCTION (IT) <PRIMS .IT ,DR ,R ,UR>>>
80 <SETG SL <FUNCTION (IT) <PRIMS .IT ,DL ,L ,UL>>>
82 <SETG PRIMS <FUNCTION (IT DOWN ACROSS UP)
84 <COND (<AND <L? .CI .CL+1> <=? .IT <.CI .CO>>>
86 (<.DOWN>) (<.ACROSS 1>) (<.UP>)
87 (ELSE <RETURN #FALSE ("NOT-FOUND")>)>>>>
89 <SETG CWR <FUNCTION (C) <PRIMCW .C ,DR ,R ,UR>>>
90 <SETG CWL <FUNCTION (C) <PRIMCW .C ,DL ,L ,UL>>>
92 <SETG PRIMCW <FUNCTION (C DOWN ACROSS UP)
94 <COND (<EVAL .C> <RETURN T>)
95 (<.DOWN>) (<.ACROSS 1>) (<.UP>)
96 (ELSE <RETURN #FALSE ("END")>)>>>>
97 \f<SETG I <FUNCTION (IT "AUX" (RCI <- .CI 1>) (LIT <LENGTH .IT>) (OCI .CI))
99 <SET CL+1 <+ .CL+1 .LIT>>
100 <COND (<==? <PRIMTYPE .CO> LIST>
101 <COND (<EMPTY? .IT> T)
102 (ELSE <SET IT (!.IT)>
103 <PUTREST <REST .IT <- .LIT 1>> <REST .CO .RCI>>
106 <SET CO <CHTYPE <NEWSTRUC ,<PRIMTYPE .CO>
107 (.CO .IT <REST .CO .RCI>)
108 (.RCI .LIT <- .CL+1 .CI>)>
113 <SETG K <FUNCTION (N "AUX" (RCO <REST .CO <MIN <- .CL+1 1> <+ .CI .N -1>>>)
114 (LCO <LENGTH .RCO>) (OCI .CI))
115 <SET CL+1 <+ .CI .LCO>>
116 <COND (<==? <PRIMTYPE .CO> LIST> <LIPSTIC .RCO>)
118 <SET CO <CHTYPE <NEWSTRUC ,<PRIMTYPE .CO>
124 <SETG LIPSTIC <FUNCTION (L)
125 <COND (<1? .OCI> <SET CO <CHTYPE .L <TYPE .CO>>> <UPDATE>)
126 (ELSE <PUTREST <REST .CO <- .OCI 2>> .L> T)>>>
130 <SETG UPDATE <FUNCTION ("AUX" (LLST <LENGTH .LST>))
133 <COND (<AND <NOT <MONAD? .CO>> <1? <LENGTH .CO>>> <1 .CO>)
135 (ELSE <COND (<==? 3 .LLST> <SETLOC .LOC .CO>)>
136 <SETLOC <AT <1 .LST> <2 .LST>> .CO>)>
139 <SETG G <FUNCTION (N "AUX" (M <MIN .N <- .CL+1 .CI>>) (N <- .CI 1>))
140 <ILIST .M '<<SET N <+ .N 1>> .CO>>>>
142 <SETG C <FUNCTION (N)
143 <COND (<==? .CI .CL+1> #FALSE ("RIGHT-EDGE"))
144 (ELSE <SETLOC <AT .CO .CI> .N>)>>>
147 <FUNCTION (FN OL NL "AUX" T (O <1 .OL>) (N <1 .NL>) (IX 0))
148 ;"Actual structure hacker. STACKFORMs FN, gobbling <1 .NL> members from <1 .OL> 'till gone."
153 <COND (<EMPTY? <SET OL <REST .OL>>>
161 <SET T <1 <SET O <1 .OL>>>>
162 <RETURN <SET O <REST .O>>>)>>)
163 (ELSE <SET T <1 .O>> <SET IX <+ .IX 1>> <SET O <REST .O>>)>>>>
165 \f\f\ 3\fð`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\að`Á
\83\a