<mdl.comp>/subrty.mud.61

   1 <PACKAGE "SUBRTY">
   2
   3 <ENTRY SUBRS TEMPLATES>
   4
   5 <USE "COMPDEC" "CHKDCL">
   6
   7
   8 ; "Functions to decide arg dependent types."
   9
  10 <DEFINE FIRST-ARG ("TUPLE" T) <1 .T>>
  11
  12 <DEFINE SECOND-ARG ("TUPLE" T) <2 .T>>
  13
  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>>)
  18               (ELSE ANY)>>
  19
  20 <DEFINE MAPF-VALUE ("TUPLE" T) ANY>
  21
  22 <DEFINE MEM-VALUE (ITEM STR "AUX" TEM)
  23         <COND (<SET TEM <ISTYPE? .STR>> <FORM OR FALSE <TYPEPRIM .TEM>>)
  24               (ELSE STRUCTURED)>>
  25
  26 <DEFINE SPFIRST-ARG ("TUPLE" T "AUX" TEM)
  27         <COND (<SET TEM <STRUCTYP <1 .T>>>
  28                <COND (<==? .TEM TUPLE> VECTOR)(ELSE .TEM)>)>>
  29
  30
  31 <DEFINE PFIRST-ARG ("TUPLE" T "AUX" TEM)
  32         <COND (<SET TEM <STRUCTYP <1 .T>>>)
  33               (ELSE ANY)>>
  34
  35 ; "Data structure specifying return types and # of args to common subrs."
  36
  37 <SETG SUBR-DATA
  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>)
  44           (,1STEP!- 1 PROCESS)
  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>)
  48           (,ACCESS!- 2 CHANNEL)
  49           (,ALLTYPES!- 0 '<VECTOR [REST ATOM]>)
  50           (,ANDB!- ANY WORD)
  51           (,APPLY!- ANY ANY)
  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)
  60           (,AVALUE!- 1 ANY)
  61           (,BACK!- '(1 2) ,PFIRST-ARG (1) ((,AC-A ,AC-B) (FIX ,AC-C)) <> |CIBACK)
  62           (,BITS!- '(1 2) BITS)
  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)
  69           (,CHTYPE!- 2 ANY)
  70           (,CHUTYPE!- 2 UVECTOR () ((UVECTOR ,AC-A) (ATOM ,AC-B)) <> |CCHUTY)
  71           (,CLOSE!- 1 CHANNEL)
  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)
  76           ;(,DISPLAY!- 2 ANY)
  77           (,ECHOPAIR!- 2 CHANNEL)
  78           (,EMPTY?!- 1 '<OR FALSE ATOM> () ((,AC-A ,AC-B)) T |CEMPTY)
  79           (,ENABLE!- 1 IHEADER)
  80           (,ENDBLOCK!- 0 '<LIST [REST OBLIST]>)
  81           (,EQVB!- ANY WORD)
  82           ;(,ERASE!- '(1 2) ANY)
  83           (,ERRET!- '(0 2) ANY)
  84           (,ERRORS!- 0 OBLIST)
  85           (,EVAL!- '(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))
  91            T |CIFLTZ)
  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)
  96           ;(,FREE!- 1 STORAGE)
  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)
 102           (,GC!- '(0 3) FIX)
 103           (,GET!- '(2 3) ANY () ((,AC-A ,AC-B) (,AC-C ,AC-D)) T |CIGET)
 104           (,GETBITS!- 2 WORD)
 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)
 108           (,GO!- 1 ANY)
 109           (,MULTI-SECTION!- '(0 1) ANY)
 110           (,GUNASSIGN!- 1 ATOM)
 111           (,GVAL!- 1 ANY)
 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)
 117           (,INDICATOR!- 1 ANY)
 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)
 123           (,ITEM!- 1 ANY)
 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)
 134           (,LISTEN!- ANY ANY)
 135           (,LLOC!- '(1 2) LOCD () ((ATOM ,AC-B)) <> |CLLOC)
 136           (,LOAD!- '(1 2) STRING)
 137           (,LOG!- 1 FLOAT () ((,AC-A ,AC-B)) <> |CLOG)
 138           (,LOGOUT!- 0 FALSE)
 139           (,LOOKUP!- 2 '<OR ATOM FALSE> () ((,AC-A ,AC-B) (OBLIST ,AC-C))
 140                 T |CLOOKU)
 141           (,LVAL!- '(1 2) ANY)
 142           (,MAIN!- 0 PROCESS)
 143           (,MAPF!- ANY ,MAPF-VALUE)
 144           (,MAPR!- ANY ,MAPF-VALUE)
 145           (,MAX!- ANY '<OR FIX FLOAT> () STACK <> |CMAX)
 146           (,ME!- 0 PROCESS)
 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)
 156           (,NETS!- 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>)
 167           (,ORB!- ANY WORD)
 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)
 177           (,PUT!- '(2 3) ANY)
 178           (,PUTBITS!- '(2 3) ,FIRST-ARG)
 179           (,PUTPROP!- '(2 3) ANY)
 180           (,PUTREST!- 2 ,FIRST-ARG)
 181           (,QUIT!- 0 FALSE)
 182           (,QUITTER!- 2 ANY)
 183           (,RANDOM!- '(0 2) FIX () () <> |CRAND)
 184           (,READ!- '(0 4) ANY)
 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))
 188                      <> |CIRMV)
 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)
 197           (,ROOT!- 0 OBLIST)
 198           (,RSUBR!- 1 RSUBR)
 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)
 208           (,STATE!- 1 ATOM)
 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)
 215           (,TAG!- 1 TAG)
 216           (,TERPRI!- 1 FALSE () ((,AC-A ,AC-B)) <> |CITERP)
 217           (,TIME!- ANY FLOAT)
 218           (,TOP!- 1 ,PFIRST-ARG () ((,AC-A ,AC-B)) <> |CITOP)
 219           (,TTYECHO!- 2 CHANNEL)
 220           (,TUPLE!- ANY TUPLE)
 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)) <>
 225                 |CTYPEW)
 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)
 233           (,VALRET!- 1 FALSE)
 234           (,VALUE!- 1 ANY)
 235           (,VECTOR!- ANY VECTOR () STACK <> |CIVEC)
 236           (,XORB!- ANY WORD)!]>
 237
 238 <SETG SUBRS <MAPF ,UVECTOR 1 ,SUBR-DATA>>
 239
 240 <SETG TEMPLATES <MAPF ,UVECTOR ,REST ,SUBR-DATA>>
 241
 242 <PROG (I)
 243         <SETG TEMPLATES
 244                 <IUVECTOR <SET I <LENGTH ,TEMPLATES>>
 245                           '<PROG ((T <NTH ,TEMPLATES .I>))
 246                                 <SET I <- .I 1>> .T>>>>
 247
 248 <SETG SUBR-DATA ()>
 249
 250 <REMOVE SUBR-DATA>
 251 \f
 252 <ENDPACKAGE>