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
19 <NTH '[LOCL LOCS LOCA LOCAS LOCV LOCU] <LENGTH .TEM>>)
22 <DEFINE MAPF-VALUE ("TUPLE" T) ANY>
24 <DEFINE MEM-VALUE (ITEM STR "AUX" TEM)
25 <COND (<SET TEM <ISTYPE? .STR>> <FORM OR FALSE <TYPEPRIM .TEM>>)
28 <DEFINE SPFIRST-ARG ("TUPLE" T "AUX" TEM)
29 <COND (<SET TEM <STRUCTYP <1 .T>>>
30 <COND (<==? .TEM TUPLE> VECTOR)(ELSE .TEM)>)>>
33 <DEFINE PFIRST-ARG ("TUPLE" T "AUX" TEM)
34 <COND (<SET TEM <STRUCTYP <1 .T>>>)
37 ; "Data structure specifying return types and # of args to common subrs."
40 [(,*!- ANY '<OR FIX FLOAT>)
41 (,+!- ANY '<OR FIX FLOAT>)
42 (,/!- ANY '<OR FIX FLOAT>)
43 (,-!- ANY '<OR FIX FLOAT>)
44 (,0?!- 1 '<OR ATOM !<FALSE!>>)
45 (,1?!- 1 '<OR ATOM !<FALSE!>>)
46 (,==?!- 2 '<OR ATOM !<FALSE!>>)
47 (,=?!- 2 '<OR ATOM !<FALSE!>>)
48 (,ABS!- 1 '<OR FIX FLOAT>)
49 (,ALLTYPES!- 0 '<VECTOR [REST ATOM]>)
52 (,APPLYTYPE!- '(1 2) '<OR FALSE ATOM APPLICABLE>)
54 (,ASCII!- 1 '<OR CHARACTER FIX>)
55 (,ASSIGNED?!- '(1 2) '<OR ATOM !<FALSE!>>)
58 (,BACK!- '(1 2) ,PFIRST-ARG)
59 (,BLOCK!- 1 '<LIST [REST OBLIST]>)
60 (,BOUND?!- '(1 2) '<OR ATOM !<FALSE!>>)
61 (,CHANLIST!- 0 '<LIST [REST CHANNEL]>)
66 (,EMPTY?!- 1 '<OR !<FALSE!> ATOM>)
67 (,ENDBLOCK!- 0 '<LIST [REST OBLIST]>)
72 (,EVALTYPE!- '(1 2) '<OR FALSE ATOM APPLICABLE>)
75 (,FLATSIZE!- '(2 3) '<OR !<FALSE!> FIX>)
76 (,FLOAD!- '(0 5) STRING) ;"\"DONE\""
79 (,FRAME!- '(0 1) '<OR FRAME !<FALSE!>>)
81 (,G=?!- 2 '<OR ATOM !<FALSE!>>)
82 (,G?!- 2 '<OR ATOM !<FALSE!>>)
83 (,GASSIGNED?!- 1 '<OR !<FALSE!> ATOM>)
86 (,ILIST!- '(1 2) LIST)
88 (,INTERRUPTS!- 0 OBLIST)
89 (,ISTRING!- '(1 2) STRING)
90 (,IUVECTOR!- '(1 2) UVECTOR)
91 (,IVECTOR!- '(1 2) VECTOR)
92 (,L=?!- 2 '<OR !<FALSE!> ATOM>)
93 (,L?!- 2 '<OR !<FALSE!> ATOM>)
94 (,LEGAL?!- 1 '<OR !<FALSE!> ATOM>)
96 (,LENGTH? 2 '<OR !<FALSE!> FIX>)
97 (,LINK!- '(2 3) ,FIRST-ARG)
101 (,LOOKUP!- 2 '<OR ATOM !<FALSE!>>)
103 (,MEMBER!- 2 ,MEM-VALUE)
104 (,MEMQ!- 2 ,MEM-VALUE)
105 (,MOD!- 2 '<OR FIX FLOAT>)
106 (,MONAD?!- 1 '<OR ATOM !<FALSE!>>)
107 (,N==?!- 2 '<OR !<FALSE!> ATOM>)
108 (,N=?!- 2 '<OR !<FALSE!> ATOM>)
109 (,NEWTYPE!- '(2 3) ATOM)
110 (,NOT!- 1 '<OR ATOM !<FALSE!>>)
112 (,OBLIST?!- 1 '<OR !<FALSE!> OBLIST>)
113 (,OPEN!- '(0 6) '<OR CHANNEL FALSE>)
115 (,PARSE!- '(0 5) ANY)
118 (,PRINC!- '(1 3) ,FIRST-ARG)
119 (,PRIN1!- '(1 3) ,FIRST-ARG)
120 (,PRINT!- '(1 3) ,FIRST-ARG)
121 (,PRINTTYPE!- '(1 2) '<OR FALSE ATOM APPLICABLE>)
123 (,PUTREST!- 2 ,FIRST-ARG)
124 (,RANDOM!- '(0 2) FIX)
126 (,READCHR!- '(0 2) ANY)
127 (,REMOVE!- '(1 2) '<OR ATOM !<FALSE!>>)
128 (,REST!- '(1 2) ,PFIRST-ARG)
129 (,RESTORE!- '(1 4) ANY)
130 (,RETRY!- '(0 1) ANY)
131 (,RETURN!- '(1 2) ANY)
133 (,SAVE!- '(0 4) STRING)
134 (,SET!- '(2 3) ,SECOND-ARG)
135 (,SETG!- 2 ,SECOND-ARG)
140 (,STRING!- ANY STRING)
141 (,STRUCTURED?!- 1 '<OR !<FALSE!> ATOM>)
143 (,TOP!- 1 ,PFIRST-ARG)
145 (,TYPE-C '(1 2) TYPE-C)
146 (,TYPE-W '(1 3) TYPE-W)
147 (,TYPE?!- ANY '<OR ATOM !<FALSE!>>)
149 (,UNASSIGN!- '(1 2) ATOM)
150 (,UNPARSE!- '(1 2) STRING)
151 (,UVECTOR!- ANY UVECTOR)
152 (,VALID-TYPE? 1 '<OR !<FALSE!> TYPE-C>)
153 (,VECTOR!- ANY VECTOR)
156 <SETG SUBRS <MAPF ,VECTOR 1 ,SUBR-DATA>>
158 <SETG TEMPLATES <MAPF ,VECTOR ,REST ,SUBR-DATA>>
162 <IVECTOR <SET I <LENGTH ,TEMPLATES>>
163 '<PROG ((T <NTH ,TEMPLATES .I>))
164 <SET I <- .I 1>> .T>>>>