mim/development/mim/mimc/subrty.mud

   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
  17                                          LIST]>))
  18         <COND (.TEM
  19                <NTH '[LOCL LOCS LOCA LOCAS LOCV LOCU] <LENGTH .TEM>>)
  20               (ELSE ANY)>>
  21
  22 <DEFINE MAPF-VALUE ("TUPLE" T) ANY>
  23
  24 <DEFINE MEM-VALUE (ITEM STR "AUX" TEM)
  25         <COND (<SET TEM <ISTYPE? .STR>> <FORM OR FALSE <TYPEPRIM .TEM>>)
  26               (ELSE STRUCTURED)>>
  27
  28 <DEFINE SPFIRST-ARG ("TUPLE" T "AUX" TEM)
  29         <COND (<SET TEM <STRUCTYP <1 .T>>>
  30                <COND (<==? .TEM TUPLE> VECTOR)(ELSE .TEM)>)>>
  31
  32
  33 <DEFINE PFIRST-ARG ("TUPLE" T "AUX" TEM)
  34         <COND (<SET TEM <STRUCTYP <1 .T>>>)
  35               (ELSE ANY)>>
  36
  37 ; "Data structure specifying return types and # of args to common subrs."
  38
  39 <SETG SUBR-DATA
  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]>)
  50           (,ANDB!- ANY FIX)
  51           (,APPLY!- ANY ANY)
  52           (,APPLYTYPE!- '(1 2) '<OR FALSE ATOM APPLICABLE>)
  53           (,ARGS!- 1 TUPLE)
  54           (,ASCII!- 1 '<OR CHARACTER FIX>)
  55           (,ASSIGNED?!- '(1 2) '<OR ATOM !<FALSE!>>)
  56           (,ATAN!- 1 FLOAT)
  57           (,ATOM!- 1 ATOM)
  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]>)
  62           (,CHTYPE!- 2 ANY)
  63           (,CLOSE!- 1 CHANNEL)
  64           (,COS!- 1 FLOAT)
  65           (,CRLF '(0 2) ATOM)
  66           (,EMPTY?!- 1 '<OR !<FALSE!> ATOM>)
  67           (,ENDBLOCK!- 0 '<LIST [REST OBLIST]>)
  68           (,EQVB!- ANY FIX)
  69           (,ERRET!- '(0 2) ANY)
  70           (,ERRORS!- 0 OBLIST)
  71           (,EVAL!- '(1 2) ANY)
  72           (,EVALTYPE!- '(1 2) '<OR FALSE ATOM APPLICABLE>)
  73           (,EXP!- 1 FLOAT)
  74           (,FIX!- 1 FIX)
  75           (,FLATSIZE!- '(2 3) '<OR !<FALSE!> FIX>)
  76           (,FLOAD!- '(0 5) STRING)              ;"\"DONE\""
  77           (,FLOAT!- 1 FLOAT)
  78           (,FORM!- ANY FORM)
  79           (,FRAME!- '(0 1) '<OR FRAME !<FALSE!>>)
  80           (,FUNCT!- 1 ATOM)
  81           (,G=?!- 2 '<OR ATOM !<FALSE!>>)
  82           (,G?!- 2 '<OR ATOM !<FALSE!>>)
  83           (,GASSIGNED?!- 1 '<OR !<FALSE!> ATOM>)
  84           (,GUNASSIGN!- 1 ATOM)
  85           (,GVAL!- 1 ANY)
  86           (,ILIST!- '(1 2) LIST)
  87           (,INSERT!- 2 ATOM)
  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>)
  95           (,LENGTH!- 1 FIX)
  96           (,LENGTH? 2  '<OR !<FALSE!> FIX>)
  97           (,LINK!- '(2 3) ,FIRST-ARG)
  98           (,LIST!- ANY LIST)
  99           (,LISTEN!- ANY ANY)
 100           (,LOG!- 1 FLOAT)
 101           (,LOOKUP!- 2 '<OR ATOM !<FALSE!>>)
 102           (,LVAL!- '(1 2) ANY)
 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!>>)
 111           (,NTH!- '(1 2) ANY)
 112           (,OBLIST?!- 1 '<OR !<FALSE!> OBLIST>)
 113           (,OPEN!- '(0 6) '<OR CHANNEL FALSE>)
 114           (,ORB!- ANY FIX)
 115           (,PARSE!- '(0 5) ANY)
 116           (,PNAME!- 1 STRING)
 117           (,PRIMTYPE!- 1 ATOM)
 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>)
 122           (,PUT!- '(2 3) ANY)
 123           (,PUTREST!- 2 ,FIRST-ARG)
 124           (,RANDOM!- '(0 2) FIX)
 125           (,READ!- '(0 4) ANY)
 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)
 132           (,ROOT!- 0 OBLIST)
 133           (,SAVE!- '(0 4) STRING)
 134           (,SET!- '(2 3) ,SECOND-ARG)
 135           (,SETG!- 2 ,SECOND-ARG)
 136           (,SIN!- 1 FLOAT)
 137           (,SPNAME!- 1 STRING)
 138           (,SQRT!- 1 FLOAT)
 139           (,STRCOMP!- 2 FIX)
 140           (,STRING!- ANY STRING)
 141           (,STRUCTURED?!- 1 '<OR !<FALSE!> ATOM>)
 142           (,TIME!- ANY FLOAT)
 143           (,TOP!- 1 ,PFIRST-ARG)
 144           (,TYPE!- 1 ATOM)
 145           (,TYPE-C '(1 2) TYPE-C)
 146           (,TYPE-W '(1 3) TYPE-W)
 147           (,TYPE?!- ANY '<OR ATOM !<FALSE!>>)
 148           (,TYPEPRIM!- 1 ATOM)
 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)
 154           (,XORB!- ANY FIX)]>
 155
 156 <SETG SUBRS <MAPF ,VECTOR 1 ,SUBR-DATA>>
 157
 158 <SETG TEMPLATES <MAPF ,VECTOR ,REST ,SUBR-DATA>>
 159
 160 <PROG (I)
 161         <SETG TEMPLATES
 162                 <IVECTOR <SET I <LENGTH ,TEMPLATES>>
 163                          '<PROG ((T <NTH ,TEMPLATES .I>))
 164                                <SET I <- .I 1>> .T>>>>
 165
 166 <SETG SUBR-DATA ()>
 167
 168 <REMOVE SUBR-DATA>
 169 \f
 170 <ENDPACKAGE>