2 <FUNCTION ("STACK" FUNNAME DEF)
9 <COND (<0? .N> <FRAME>)
10 (T <FRAME <FRAMEN <- .N 1>>>)>>>
\e
15 <FUNCTION CF ("STACK" )
22 <FAILPOINT FP ("STACK" )
24 <RESTORE .FP (FAILURE CAUGHT WITH M = .M AND A = .A)>> >>
29 <FUNCTION ("STACK" VAR\ VAL "AUX" (OV <RLVAL .VAR\ >))
31 <SET .VAR\ <RLVAL VAL>>
33 <SET .VAR\ <RLVAL OV>>
38 <FUNCTION ("STACK" ELT L)
39 <COND (<EMPTY? .L> .L)
41 <CHTYPE <REST .L> <TYPE .L>>)
42 (T <THDELQ1 .ELT .L>) >>>
46 <FUNCTION ("STACK" ELT L)
47 <COND (<EMPTY? <REST .L>> .L)
48 (<==? <2 .L> .ELT> <THPUTREST .L <REST .L 2>>)
49 (T <THDELQ1 .ELT <REST .L>>) > >>
53 <FUNCTION ("STACK" LIST1 LIST2)
54 <FAILPOINT ("STACK" (OREST <REST .LIST1>))
55 <PUTREST .LIST1 .LIST2>
57 <PUTREST .LIST1 .OREST>
62 <FUNCTION ("STACK" THING IND "OPTIONAL" PROP)
63 <FAILPOINT ("STACK" (OPROP <GET .THING .IND>))
64 <COND (<ASSIGNED? PROP>
65 <PUT .THING .IND .PROP>)
66 (T <PUT .THING .IND>) >
68 <COND (.OPROP <PUT .THING .IND .OPROP>)
74 <FUNCTION ("STACK" LOC VAL "AUX" (OVAL <IN .LOC>))
76 <SETLOC .LOC <RLVAL VAL>>
78 <SETLOC .LOC <RLVAL OVAL>>
79 <FAIL .M .A> >>>
\f<DEFINE FALSE
80 <FUNCTION ("STACK" "ARGS" A) <CHTYPE <EVAL .A> FALSE> >>
84 <FUNCTION ("STACK" "ARGS" A) <CHTYPE <EVAL .A> FORM> >>
87 <FUNCTION ("STACK" "ARGS" A) <CHTYPE <EVAL .A> UNASSIGNED> >>
90 <FUNCTION ("STACK" "REST" 'A) <CHTYPE <EVAL .A> SEGMENT> >>
93 <FUNCTION ("STACK" TYPE)
94 <GET .TYPE 'CONSTRUCTOR> >>
97 <PUT LIST CONSTRUCTOR ,CONSL>
98 <PUT FORM CONSTRUCTOR ,FORM>
99 <PUT FALSE CONSTRUCTOR ,FALSE>
100 <PUT VECTOR CONSTRUCTOR ,CONSV>
101 <PUT SEGMENT CONSTRUCTOR ,SEGMENT>
102 <PUT UVECTOR CONSTRUCTOR ,CONSU>
107 <FUNCTION ("STACK" ATOM)
108 <COND (<GASSIGNED? .ATOM> <GVAL .ATOM>)
111 <FUNCTION ("STACK" VAR)
112 <FAILPOINT CLIPPER ("STACK" (VAL ..VAR))
115 <COND (<EMPTY? .VAL> <FAIL>)
118 <SET .VAR <SET VAL <REST .VAL>>>>>) >> >>
122 <FUNCTION ("STACK" FOO) <NOT <EMPTY? <RLVAL FOO>>>>>
126 <FUNCTION ACT ("STACK" CURRENTENV NEWENV)
127 <PROG1 <SPLICE .CURRENTENV .NEWENV>
132 <FUNCTION ("STACK" "BIND" FOO) .FOO>>
\f<DEFINE RESET
133 <FUNCTION ("STACK" VAR)
134 <FAILPOINT ("STACK" (VAL <RLVAL .VAR>)) <> ("STACK")
135 <SET .VAR <RLVAL VAL>>
139 <FUNCTION ("STACK" "REST" A) <1 .A> >>
143 <FUNCTION ("STACK" "REST" A) <2 .A> >>
\f<DEFINE MULTILEVEL
144 <FUNCTION ("STACK" OBJECT)
145 <AND <NOT <MONAD? .OBJECT>>
146 <MEMQ <TYPE .OBJECT> '(LIST FORM VECTOR SEGMENT VECTOR)>> >>
149 <FUNCTION REV ("STACK" L "OPTIONAL" (CFUNC <CONSTRUCTOR <TYPE .L>>)
151 <COND (<EMPTY? .L> <.CFUNC !.RESULT>)
152 (T <SET RESULT (<1 .L> !.RESULT)>
158 <FUNCTION ("STACK" "REST" LSTUPL)
159 <COND (<EMPTY? .LSTUPL> ())
160 (T <CHTYPE <NCONC1 .LSTUPL> <TYPE <1 .LSTUPL>>>) >>>
164 <FUNCTION ("STACK" LSTUPL)
165 <COND (<EMPTY? <REST .LSTUPL>> <1 .LSTUPL>)
166 (T <NCONC2 <1 .LSTUPL> <REST .LSTUPL>>) >>>
170 <FUNCTION ("STACK" L1 LREST)
171 <COND (<EMPTY? .L1> <NCONC1 .LREST>)
172 (T <PUTREST .L1 <NCONC2 <REST .L1> .LREST>>) >>>
\f<DEFINE ANOTHER
173 <FUNCTION ("STACK" OBJ BOUND)
174 <FAILPOINT FP ("STACK")
176 <AND <==? .OBJ .BOUND> <FAIL>>
177 <RESTORE .FP <SET OBJ <REST .OBJ>>>> >>
181 <FUNCTION MAPPER ("STACK" FUN "REST" EXPS "AUX" (RESULT ()) RES1 LAS)
182 <SET RES1 <APPLY .FUN <LISTFIRSTS .EXPS>>>
183 <COND (<EMPTY? .RESULT>
184 <SET LAS <SET RESULT (.RES1)>>)
185 (T <PUTREST .LAS <SET LAS (.RES1)>>) >
190 <FUNCTION MAPPER ("STACK" FUN "REST" EXPS "AUX" (RESULT ()))
191 <REPEAT ("STACK") <APPLY .FUN <LISTFIRSTS .EXPS>>> >>
195 <FUNCTION MAPPER ("STACK" FUN "REST" EXPS
196 "AUX" (RESULT ()) RES1 LAS1)
197 <SET RES1 <APPLY .FUN <LISTFIRSTS .EXPS>>>
198 <COND (<EMPTY? .RESULT>
200 (T <PUTREST .LAS1 .RES1>) >
201 <SET LAS1 <LAST .RES1>>
206 <FUNCTION ("STACK" EXPTUPL)
207 <COND (<EMPTY? .EXPTUPL> ())
208 (<EMPTY? <SET RES1 <1 .EXPTUPL>>> <.MAPPER .RESULT>)
210 <PUT .EXPTUPL 1 <REST .RES1>>>
211 !<LISTFIRSTS <REST .EXPTUPL>>)) > >>
215 <FUNCTION L ("STACK" EXP)
216 <COND (<EMPTY? .EXP> ())
217 (<EMPTY? <REST .EXP>> .EXP)
218 (T <SET EXP <REST .EXP>>
219 <AGAIN .L>) >>>
\f<DEFINE BOTTOM
220 <FUNCTION ("STACK" THING)
221 <COND (<MONAD? .THING> .THING)
222 (<==? <TYPE .THING> LIST> ())
223 (T <REST .THING <LENGTH .THING>>)> >>
229 <FUNCTION ("STACK" VEC "REST" VARS)
230 <MAPC ,SET .VARS .VEC> >>
\f\ 3\f