3 <ENTRY SUBRS TEMPLATES>
5 <USE "COMPDEC" "CHKDCL">
8 ; "Functions to decide arg dependent types."
10 <DEFINE FIRST-ARG ("TUPLE" T) <1 .T>>
12 <DEFINE SECOND-ARG ("TUPLE" T) <2 .T>>
14 <DEFINE LOC-FCN (STR "OPTIONAL" N
15 "AUX" (TEM <MEMQ <ISTYPE? .STR>
16 ![UVECTOR VECTOR ASOC TUPLE STRING LIST!]>))
17 <COND (.TEM <NTH '![LOCL LOCS LOCA LOCAS LOCV LOCU!] <LENGTH .TEM>>)
20 <DEFINE MAPF-VALUE ("TUPLE" T) ANY>
22 <DEFINE MEM-VALUE (ITEM STR "AUX" TEM)
23 <COND (<SET TEM <ISTYPE? .STR>> <FORM OR FALSE <TYPEPRIM .TEM>>)
26 <DEFINE SPFIRST-ARG ("TUPLE" T "AUX" TEM)
27 <COND (<SET TEM <STRUCTYP <1 .T>>>
28 <COND (<==? .TEM TUPLE> VECTOR)(ELSE .TEM)>)>>
31 <DEFINE PFIRST-ARG ("TUPLE" T "AUX" TEM)
32 <COND (<SET TEM <STRUCTYP <1 .T>>>)
35 ; "Data structure specifying return types and # of args to common subrs."
38 ![(,*!- ANY '<OR FIX FLOAT> () STACK <> |CTIMES)
39 (,+!- ANY '<OR FIX FLOAT> () STACK <> |CPLUS)
40 (,/!- ANY '<OR FIX FLOAT> () STACK <> |CDIVID)
41 (,-!- ANY '<OR FIX FLOAT> () STACK <> |CMINUS)
42 (,0?!- 1 '<OR ATOM FALSE>)
43 (,1?!- 1 '<OR ATOM FALSE>)
45 (,==?!- 2 '<OR ATOM FALSE>)
46 (,=?!- 2 '<OR ATOM FALSE> () ((,AC-A ,AC-B) (,AC-C ,AC-D)) T |CIEQUA)
47 (,ABS!- 1 '<OR FIX FLOAT>)
49 (,ALLTYPES!- 0 '<VECTOR [REST ATOM]>)
52 (,APPLYTYPE!- '(1 2) '<OR FALSE ATOM APPLICABLE>)
53 (,ARGS!- 1 TUPLE () ((,AC-A ,AC-B)) <> |CARGS)
54 (,ASCII!- 1 '<OR CHARACTER FIX>)
55 (,ASSIGNED?!- '(1 2) '<OR ATOM FALSE> () ((ATOM ,AC-B)) T |CASSQ)
56 (,ASSOCIATIONS!- 0 ASOC)
57 (,AT!- '(1 2) ,LOC-FCN (1) ((,AC-A ,AC-B) (FIX ,AC-C)) <> |CIAT)
58 (,ATAN!- 1 FLOAT () ((,AC-A ,AC-B)) <> |CATAN)
59 (,ATOM!- 1 ATOM () ((,AC-A ,AC-B)) <> |CATOM)
61 (,BACK!- '(1 2) ,PFIRST-ARG (1) ((,AC-A ,AC-B) (FIX ,AC-C)) <> |CIBACK)
63 (,BLOAT!- '(0 15) FIX)
64 (,BLOCK!- 1 '<LIST [REST OBLIST]>)
65 (,BOUND?!- '(1 2) '<OR ATOM FALSE>)
66 (,BREAK-SEQ!- 2 PROCESS)
67 (,CHANLIST!- 0 '<LIST [REST CHANNEL]>)
68 (,CHANNEL!- '(0 6) CHANNEL)
70 (,CHUTYPE!- 2 UVECTOR () ((UVECTOR ,AC-A) (ATOM ,AC-B)) <> |CCHUTY)
72 (,CONS!- 2 LIST () ((,AC-C ,AC-D) (LIST ,AC-E)) <> |CICONS)
73 (,COS!- 1 FLOAT () ((,AC-A ,AC-B)) <> |CCOS)
74 (,CRLF 1 ATOM () ((,AC-A ,AC-B)) <> |CICRLF)
75 (,DISABLE!- 1 IHEADER)
77 (,ECHOPAIR!- 2 CHANNEL)
78 (,EMPTY?!- 1 '<OR FALSE ATOM> () ((,AC-A ,AC-B)) T |CEMPTY)
80 (,ENDBLOCK!- 0 '<LIST [REST OBLIST]>)
82 ;(,ERASE!- '(1 2) ANY)
86 (,EVALTYPE!- '(1 2) '<OR FALSE ATOM APPLICABLE>)
87 (,EVENT!- '(1 3) IHEADER)
88 (,EXP!- 1 FLOAT () ((,AC-A ,AC-B)) <> |CEXP)
89 (,FIX!- 1 FIX () ((,AC-A ,AC-B)) <> |CFIX)
90 (,FLATSIZE!- 3 '<OR FALSE FIX> () ((,AC-A ,AC-B) (FIX ,AC-D) (FIX ,AC-C))
92 (,FLOAD!- '(0 5) STRING) ;"\"DONE\""
93 (,FLOAT!- 1 FLOAT () ((,AC-A ,AC-B)) <> |CFLOAT)
94 (,FORM!- ANY FORM () STACK <> |IIFORM)
95 (,FRAME!- '(0 1) FRAME (#LOSE 0) ((,AC-A ,AC-B)) <> |CFRAME)
97 (,FREE-RUN!- 1 <OR FALSE PROCESS>)
98 (,FUNCT!- 1 ATOM () ((,AC-A ,AC-B)) <> |CFUNCT)
99 (,G=?!- 2 '<OR ATOM FALSE> () ((,AC-A ,AC-B)(,AC-C ,AC-D)) T |CGEQ)
100 (,G?!- 2 '<OR ATOM FALSE> () ((,AC-A ,AC-B)(,AC-C ,AC-D)) T |CGQ)
101 (,GASSIGNED?!- 1 '<OR FALSE ATOM> () ((ATOM ,AC-B)) T |CGASSQ)
103 (,GET!- '(2 3) ANY () ((,AC-A ,AC-B) (,AC-C ,AC-D)) T |CIGET)
105 (,GETL!- '(2 3) LOCAS () ((,AC-A ,AC-B)(,AC-C ,AC-D)) T |CIGETL)
106 (,GETPROP!- '(2 3) ANY)
107 (,GLOC!- '(1 2) LOCD () ((ATOM ,AC-B)) <> |CGLOC)
109 (,MULTI-SECTION!- '(0 1) ANY)
110 (,GUNASSIGN!- 1 ATOM)
112 (,HANDLER!- '(2 3) HANDLER)
113 (,IFORM!- '(1 2) FORM)
114 (,ILIST!- '(1 2) LIST)
115 (,IMAGE!- '(1 2) FIX)
116 (,IN!- 1 ANY () ((,AC-A ,AC-B)) <> |CIN)
118 (,INSERT!- 2 ATOM () ((,AC-A ,AC-B) (OBLIST ,AC-C)) <> |CINSER)
119 (,INT-LEVEL!- '(0 1) FIX)
120 (,INTERRUPT!- ANY '<OR FALSE ATOM>)
121 (,INTERRUPTS!- 0 OBLIST)
122 (,ISTRING!- '(1 2) STRING)
124 (,ITUPLE!- '(1 2) TUPLE)
125 (,IUVECTOR!- '(1 2) UVECTOR)
126 (,IVECTOR!- '(1 2) VECTOR)
127 (,L=?!- 2 '<OR FALSE ATOM> () ((,AC-A ,AC-B)(,AC-C ,AC-D)) T |CLEQ)
128 (,L?!- 2 '<OR FALSE ATOM> () ((,AC-A ,AC-B)(,AC-C ,AC-D)) T |CLQ)
129 (,LEGAL?!- 1 '<OR FALSE ATOM> () ((,AC-A ,AC-B)) T |CILEGQ)
130 (,LENGTH!- 1 FIX () ((,AC-A ,AC-B)) <> |CILNT)
131 (,LENGTH? 2 '<OR FALSE FIX> () ((,AC-A ,AC-B) (FIX ,AC-C)) T |CILNQ)
132 (,LINK!- '(2 3) ,FIRST-ARG)
133 (,LIST!- ANY LIST () STACK <> |IILIST)
135 (,LLOC!- '(1 2) LOCD () ((ATOM ,AC-B)) <> |CLLOC)
136 (,LOAD!- '(1 2) STRING)
137 (,LOG!- 1 FLOAT () ((,AC-A ,AC-B)) <> |CLOG)
139 (,LOOKUP!- 2 '<OR ATOM FALSE> () ((,AC-A ,AC-B) (OBLIST ,AC-C))
143 (,MAPF!- ANY ,MAPF-VALUE)
144 (,MAPR!- ANY ,MAPF-VALUE)
145 (,MAX!- ANY '<OR FIX FLOAT> () STACK <> |CMAX)
147 (,MEMBER!- 2 ,MEM-VALUE () ((,AC-A ,AC-B)(,AC-C ,AC-D)) T |CIMEMB)
148 (,MEMQ!- 2 ,MEM-VALUE () ((,AC-A ,AC-B)(,AC-C ,AC-D)) T |CIMEMQ)
149 (,MIN!- ANY '<OR FIX FLOAT> () STACK <> |CMIN)
150 (,MOBLIST!- '(0 2) OBLIST)
151 (,MOD!- 2 '<OR FIX FLOAT>)
152 (,MONAD?!- 1 '<OR ATOM FALSE> () ((,AC-A ,AC-B)) T |CIMON)
153 (,N==?!- 2 '<OR FALSE ATOM>)
154 (,N=?!- 2 '<OR FALSE ATOM> () ((,AC-A ,AC-B)(,AC-C ,AC-D)) T |CINEQU)
155 (,NETACC!- 1 CHANNEL)
157 (,NETSTATE!- 1 '<UVECTOR [3 FIX]>)
158 (,NEWTYPE!- '(2 3) ATOM)
159 (,NEXT!- 1 '<OR ASOC FALSE>)
160 (,NEXTCHR!- 1 ANY () ((,AC-A ,AC-B)) <> |CNXTC1)
161 (,NOT!- 1 '<OR ATOM FALSE>)
162 (,NTH!- '(1 2) ANY (1) ((,AC-A ,AC-B) (FIX ,AC-C)) <> |CINTH)
163 (,OBLIST?!- 1 '<OR FALSE OBLIST>)
164 (,OFF!- '(1 2) '<OR HANDLER IHEADER FALSE>)
165 (,ON!- '(3 5) HANDLER)
166 (,OPEN!- '(0 6) '<OR CHANNEL FALSE>)
168 (,PARSE!- '(0 5) ANY)
169 (,PNAME!- 1 STRING () ((ATOM ,AC-A)) <> |CIPNAM)
170 (,PRIMTYPE!- 1 ATOM () ((,AC-A DONT-CARE)) <> |CPTYPE)
171 (,PRINC!- '(1 2) ,FIRST-ARG)
172 (,PRIN1!- '(1 2) ,FIRST-ARG)
173 (,PRINT!- '(1 2) ,FIRST-ARG)
174 (,PRINTB!- 2 UVECTOR)
175 (,PRINTTYPE!- '(1 2) '<OR FALSE ATOM APPLICABLE>)
176 (,PROCESS!- 1 PROCESS)
178 (,PUTBITS!- '(2 3) ,FIRST-ARG)
179 (,PUTPROP!- '(2 3) ANY)
180 (,PUTREST!- 2 ,FIRST-ARG)
183 (,RANDOM!- '(0 2) FIX () () <> |CRAND)
185 (,READB!- '(2 3) FIX)
186 (,READCHR!- 1 ANY () ((,AC-A ,AC-B)) <> |CREDC1)
187 (,REMOVE!- '(1 2) '<OR ATOM FALSE> (0) ((,AC-A ,AC-B)(OBLIST ,AC-C))
189 (,RENAME!- '(1 9) '<OR ATOM FALSE CHANNEL>)
190 (,RESET!- 1 '<OR FALSE CHANNEL>)
191 (,REST!- '(1 2) ,PFIRST-ARG (1) ((,AC-A ,AC-B) (FIX ,AC-C)) <> |CIREST)
192 (,RESTORE!- '(1 4) ANY)
193 (,RESUME!- '(1 2) ANY)
194 (,RESUMER!- '(0 1) '<OR FALSE PROCESS>)
195 (,RETRY!- '(0 1) ANY)
196 (,RETURN!- '(1 2) ANY)
199 (,SAVE!- '(0 4) STRING)
200 (,SET!- '(2 3) ,SECOND-ARG)
201 (,SETG!- 2 ,SECOND-ARG)
202 (,SETLOC!- 2 ,SECOND-ARG)
203 (,SIN!- 1 FLOAT () ((,AC-A ,AC-B)) <> |CSIN)
204 (,SNAME!- '(0 1) STRING)
205 (,SORT!- ANY ,SECOND-ARG)
206 (,SPNAME 1 STRING () ((ATOM ,AC-B)) <> |CSPNAM)
207 (,SQRT!- 1 FLOAT () ((,AC-A ,AC-B)) <> |CSQRT)
209 ;(,STORE!- 1 STORAGE)
210 (,STRCOMP!- 2 FIX () ((,AC-A ,AC-B)(,AC-C ,AC-D)) <> |ISTRCM)
211 (,STRING!- ANY STRING () STACK <> |CISTNG)
212 (,STRUCTURED?!- 1 '<OR FALSE ATOM> () ((,AC-A DONT-CARE)) T |CISTRU)
213 (,SUBSTRUC!- ANY ,SPFIRST-ARG () STACK <> |CSBSTR)
214 (,SUICIDE!- '(1 2) ANY)
216 (,TERPRI!- 1 FALSE () ((,AC-A ,AC-B)) <> |CITERP)
218 (,TOP!- 1 ,PFIRST-ARG () ((,AC-A ,AC-B)) <> |CITOP)
219 (,TTYECHO!- 2 CHANNEL)
221 (,TYI!- '(0 1) CHARACTER)
222 (,TYPE!- 1 ATOM () ((,AC-A DONT-CARE)) <> |CITYPE)
223 (,TYPE-C '(1 2) TYPE-C (ANY) ((ATOM ,AC-B)(ATOM ,AC-C)) <> |CTYPEC)
224 (,TYPE-W '(1 3) TYPE-W (ANY 0) ((ATOM ,AC-B)(ATOM ,AC-C)(FIX ,AC-D)) <>
226 (,TYPE?!- ANY '<OR ATOM FALSE> () STACK T |CTYPEQ)
227 (,TYPEPRIM!- 1 ATOM () ((ATOM ,AC-B)) <> |CTYPEP)
228 (,UNASSIGN!- '(1 2) ATOM)
229 (,UNPARSE!- 2 STRING () ((,AC-A ,AC-B) (FIX ,AC-C)) <> |CIUPRS)
230 (,UTYPE!- 1 ATOM () ((UVECTOR ,AC-B)) <> |CUTYPE)
231 (,UVECTOR!- ANY UVECTOR () STACK <> |CIUVEC)
232 (,VALID-TYPE? 1 '<OR FALSE TYPE-C> () ((ATOM ,AC-B)) T |CVTYPE)
235 (,VECTOR!- ANY VECTOR () STACK <> |CIVEC)
236 (,XORB!- ANY WORD)!]>
238 <SETG SUBRS <MAPF ,UVECTOR 1 ,SUBR-DATA>>
240 <SETG TEMPLATES <MAPF ,UVECTOR ,REST ,SUBR-DATA>>
244 <IUVECTOR <SET I <LENGTH ,TEMPLATES>>
245 '<PROG ((T <NTH ,TEMPLATES .I>))
246 <SET I <- .I 1>> .T>>>>