mim/development/mim/mimc/chkdcl.checker

   1 <COND (<LOOKUP "COMPDEC" <MOBLIST PACKAGE!- >>
   2        <USE "COMPDEC" "CHKDCL">)>
   3
   4 ; "CHKDCL Diagnostic program."
   5
   6 <SETG NUMBER 0>
   7
   8 <DEFINE CHECKIT ('A 'B 'C 'TST OP "AUX" RES)
   9         <PRINT <SETG NUMBER <+ ,NUMBER 1>>>
  10         <COND (<NOT <APPLY .OP <SET RES <APPLY <EVAL .TST> .A .B>> .C>>
  11                <PRINC "Loser:  ">
  12                <PRIN1 .TST>
  13                <PRINC " applied to ">
  14                <PRIN1 .A>
  15                <PRINC " ">
  16                <PRIN1 .B>
  17                <PRINC " resulted in ">
  18                <PRIN1 .RES>
  19                <PRINC " instead of ">
  20                <PRIN1 .C>
  21                <CRLF>
  22                <ERROR>)>>
  23
  24 <CHECKIT FIX FIX FIX ,TYPE-AND ,==?>
  25
  26 <CHECKIT FIX FIX FIX ,TYPE-MERGE ,==?>
  27
  28 <CHECKIT <PRIMTYPE FIX> FIX FIX ,TYPE-AND ,==?>
  29
  30 <CHECKIT <PRIMTYPE FIX> FIX <PRIMTYPE FIX> ,TYPE-MERGE ,=?>
  31
  32 <CHECKIT FIX FLOAT #FALSE () ,TYPE-AND ,==?>
  33
  34 <CHECKIT FIX FLOAT (<OR FIX FLOAT> <OR FLOAT FIX>) ,TYPE-MERGE ,MEMBER>
  35
  36 <CHECKIT <PRIMTYPE VECTOR> <OR FIX <VECTOR FIX>> <VECTOR FIX> ,TYPE-AND ,=?>
  37
  38 <CHECKIT <PRIMTYPE VECTOR> <OR FIX <VECTOR FIX>> (<OR FIX <PRIMTYPE VECTOR>>
  39                                                   <OR <PRIMTYPE VECTOR> FIX>)
  40          ,TYPE-MERGE ,MEMBER>
  41
  42 <CHECKIT <LIST ANY> <LIST [REST <LIST [REST ATOM]> ATOM]>
  43                     <LIST <LIST [REST ATOM]> [REST ATOM <LIST [REST ATOM]>]>
  44                     ,TYPE-AND ,=?>
  45
  46 <CHECKIT <LIST [REST FIX FLOAT]> <LIST [REST FIX ATOM]> #FALSE () ,TYPE-AND ,==?>
  47
  48 <CHECKIT <LIST [REST FIX FLOAT]> <LIST [REST FIX ATOM]>
  49          (<LIST [REST FIX <OR ATOM FLOAT>]> <LIST [REST FIX <OR FLOAT ATOM>]>)
  50          ,TYPE-MERGE ,MEMBER>
  51 <CHECKIT <NOT <LIST FIX FIX>> <LIST  [2 FIX]> #FALSE () ,TYPE-AND ,==?>
  52
  53 <CHECKIT <NOT <LIST [2 FIX]>> <LIST  FIX FIX> #FALSE () ,TYPE-AND ,==?>
  54
  55 <CHECKIT <UVECTOR FIX [REST FIX]> <UVECTOR FIX FIX [REST FIX]> <UVECTOR FIX [REST FIX]>
  56          ,TYPE-MERGE ,=?>
  57
  58 <CHECKIT <NOT LIST> <LIST <LIST ANY ANY ANY FIX>> #FALSE () ,TYPE-AND ,==?>
  59
  60 '<CHECKIT STRUCTURED APPLICABLE <OR RSUBR RSUBR-ENTRY FUNCTION> ,TYPE-AND ,=?>
  61
  62 <CHECKIT STRUCTURED APPLICABLE <OR  APPLICABLE STRUCTURED> ,TYPE-MERGE ,=?>
  63
  64 <CHECKIT <<OR FALSE LIST> [REST FIX]> <NOT <<OR LIST FALSE> [REST FIX]>> #FALSE ()
  65         ,TYPE-AND ,==?>
  66
  67 <CHECKIT <LIST <OR STRING ATOM VECTOR>> <NOT <LIST <OR STRING VECTOR ATOM>>> #FALSE ()
  68         ,TYPE-AND ,==?>
  69
  70 <CHECKIT <LIST FIX> <LIST [REST FIX]> (LIST <LIST [OPTIONAL FIX]> <LIST [OPT FIX]>) ,TYPE-MERGE ,MEMBER>
  71
  72 <CHECKIT <LIST FIX> <LIST [REST FIX]> <LIST FIX [REST FIX]> ,TYPE-AND ,=?>
  73
  74 <CHECKIT <OR <LIST [REST <NOT ANY>]>
  75              <LIST FIX FLOAT [REST <NOT ANY>]>>
  76          <STRUCTURED ANY ANY> <LIST FIX FLOAT [REST <NOT ANY>]> ,TYPE-AND ,=?>
  77
  78 <CHECKIT <OR <LIST [REST <NOT ANY>]>
  79              <LIST FIX FLOAT [REST <NOT ANY>]>>
  80          <STRUCTURED ANY> <LIST FIX FLOAT [REST <NOT ANY>]> ,TYPE-AND ,=?>
  81
  82 <CHECKIT <OR <LIST [REST <NOT ANY>]>
  83              <LIST FIX FLOAT [REST <NOT ANY>]>>
  84          <STRUCTURED ANY [REST <NOT ANY>]>
  85          #FALSE () ,TYPE-AND ,==?>
  86 <CHECKIT <OR FIX FALSE LIST> <LIST FIX> <OR FALSE FIX LIST> ,TYPE-MERGE ,=?>
  87
  88 <PUT-DECL STRING '<STRING [REST CHARACTER]>>
  89
  90 <CHECKIT <OR FIX STRING <LIST [REST STRING]>> STRING
  91          <OR FIX STRING <LIST [REST STRING]>> ,TYPE-MERGE ,=?>
  92
  93
  94
  95 <CHECKIT ANY <PRIMTYPE FIX> ANY ,TYPE-MERGE ,=?>
  96
  97 <CHECKIT <PRIMTYPE LIST> <OR <PRIMTYPE ATOM> <PRIMTYPE LIST>>
  98         <OR <PRIMTYPE ATOM> <PRIMTYPE LIST>>
  99         ,TYPE-MERGE ,=?>
 100
 101
 102 <NEWTYPE SPACE VECTOR '<VECTOR  <LIST [REST PBLOCK]> WORD WORD WORD LIST>>
 103
 104 <NEWTYPE AREAX VECTOR>
 105
 106 <NEWTYPE PBLOCK VECTOR>
 107
 108 <CHECKIT <OR <AREAX [2 ANY] WORD> <SPACE <LIST [REST PBLOCK]> [3 WORD] LIST>>
 109          <OR SPACE AREAX> <OR AREAX SPACE> ,TYPE-MERGE ,=?>
 110
 111 <CHECKIT <OR <VECTOR [REST <OR ATOM FALSE LOSE>]>
 112              <VECTOR <OR ATOM FALSE>
 113                      FIX
 114                     <OR ATOM FALSE LOSE>
 115                     FIX
 116                     [REST <OR ATOM FALSE LOSE>]>>
 117          <VECTOR [REST <OR ATOM FALSE LOSE>]>
 118          <OR <VECTOR [REST <OR ATOM FALSE LOSE>]>
 119              <VECTOR <OR ATOM FALSE>
 120                      FIX
 121                     <OR ATOM FALSE LOSE>
 122                     FIX
 123                     [REST <OR ATOM FALSE LOSE>]>>
 124          ,TYPE-MERGE ,=?>
 125
 126 <CHECKIT <PRIMTYPE  LIST> <<PRIMTYPE LIST> ANY> <PRIMTYPE LIST> ,TYPE-MERGE ,=?>
 127
 128 <CHECKIT <VECTOR FIX FIX> <VECTOR FIX FLOAT> <VECTOR FIX <OR FIX FLOAT>>
 129          ,TYPE-MERGE ,=?>
 130
 131 <CHECKIT <VECTOR FIX FIX> <VECTOR FLOAT FLOAT>
 132          <OR <VECTOR FIX FIX> <VECTOR FLOAT FLOAT>> ,TYPE-MERGE ,=?>
 133
 134 <CHECKIT <OR LIST <VECTOR FIX FIX>> <OR <LIST [2 ANY]> <VECTOR [2 FIX]>>
 135          <OR LIST <VECTOR [2 FIX]>> ,TYPE-MERGE ,=?>
 136
 137 <CHECKIT <OR <LIST [2 ANY]> <VECTOR [2 FIX]>> <OR LIST <VECTOR FIX FIX>>
 138          <OR LIST <VECTOR [2 FIX]>> ,TYPE-MERGE ,=?>
 139
 140 <PUT-DECL NUMBER '<OR FIX FLOAT>>
 141
 142 <CHECKIT NUMBER FIX <OR FIX FLOAT> ,TYPE-MERGE ,=?>
 143
 144 <CHECKIT FIX NUMBER <OR FIX FLOAT> ,TYPE-MERGE ,=?>
 145
 146 <CHECKIT <LIST FIX FLOAT> <LIST [REST FIX FLOAT]>
 147          (LIST <LIST [OPTIONAL FIX FLOAT]>)  ,TYPE-MERGE ,MEMBER>
 148
 149 <CHECKIT !<LIST FIX FIX> !<LIST FIX FIX FIX> #FALSE () ,TYPE-AND ,==?>
 150
 151 <CHECKIT !<LIST FIX FIX> <LIST [REST FIX]> !<LIST [2 FIX]> ,TYPE-AND ,=?>
 152
 153 <CHECKIT <LIST [OPT FIX FLOAT]> <LIST [REST FIX FLOAT]> <LIST [OPTIONAL
 154          FIX FLOAT]> ,TYPE-MERGE ,=?>
 155
 156 <CHECKIT <LIST FIX FLOAT [REST ATOM STRING]> 1 FIX ,GET-ELE-TYPE ,==?>
 157
 158 <CHECKIT <LIST FIX FLOAT [REST ATOM STRING]> 2 FLOAT ,GET-ELE-TYPE ,==?>
 159
 160 <CHECKIT <LIST FIX FLOAT [REST ATOM STRING]> 3 ATOM ,GET-ELE-TYPE ,==?>
 161
 162 <CHECKIT <LIST FIX FLOAT [REST ATOM STRING]> 4 STRING ,GET-ELE-TYPE ,==?>
 163
 164 <CHECKIT <LIST FIX FLOAT [REST ATOM STRING]> ALL
 165          <OR ATOM FIX FLOAT STRING> ,GET-ELE-TYPE ,=?>
 166
 167 <DEFINE GETY (A B) <GET-ELE-TYPE .A .B T>>
 168
 169 %<SETG FOO '<LIST FIX FLOAT [REST ATOM STRING]>>
 170
 171 <CHECKIT %,FOO 1 <LIST FLOAT [REST ATOM STRING]> ,GETY ,=?>
 172
 173 <CHECKIT %,FOO 2 <LIST [REST ATOM STRING]> ,GETY ,=?>
 174
 175 <CHECKIT %,FOO 3 <LIST [REST <OR ATOM STRING>]> ,GETY ,=?>
 176
 177 <CHECKIT %,FOO ALL <LIST [REST <OR ATOM FIX FLOAT STRING>]> ,GETY ,=?>
 178 \f
 179 <PUT-DECL VV VECTOR>
 180
 181 <CHECKIT <OR VV FALSE> ANY <OR FALSE VECTOR> ,TYPE-AND ,=?>
 182
 183
 184 <PUT-DECL QQ '<VECTOR FIX FIX>>
 185
 186 <CHECKIT <OR QQ FALSE> VECTOR <VECTOR FIX FIX> ,TYPE-AND ,=?>
 187