mim/development/mim/mimc/advmess.mud

   1
   2 <PACKAGE "ADVMESS">
   3
   4 <ENTRY VMESS ANA-MESS ADDVMESS COMPILE-ERROR COMPILE-LOSSAGE COMPILE-WARNING
   5        COMPILE-NOTE COMPILE-ACTIVATION>
   6
   7 <USE "NPRINT" "COMPDEC">
   8
   9 <DEFINE VMESS ("TUPLE" MSG)
  10         #DECL ((MSG) TUPLE)
  11         <PRINC "===== ">
  12         <MAPF <>
  13               <FUNCTION (O)
  14                       <COND (<TYPE? .O STRING> <PRINC .O>) (ELSE <PRIN1 .O>)>>
  15               .MSG>
  16         <CRLF>>
  17
  18 <DEFINE ANA-MESS (L)
  19         #DECL ((L) <LIST ANY [REST NODE LIST]>)
  20         <REPEAT ((LL <REST .L>))
  21                 #DECL ((LL) <LIST [REST NODE LIST]>)
  22                 <COND (<EMPTY? .LL> <RETURN>)>
  23                 <PRINC "===== ">
  24                 <MAPF <>
  25                       <FUNCTION (O)
  26                               <COND (<TYPE? .O NODE> <NODE-COMPLAIN .O>)
  27                                     (<TYPE? .O STRING> <PRINC .O>)
  28                                     (ELSE <PRIN1 .O>)>>
  29                       <2 .LL>>
  30                 <CRLF>
  31                 <NODE-COMPLAIN <1 .LL>>
  32                 <SET LL <REST .LL 2>>>>
  33
  34 <DEFINE ADDVMESS (N L "AUX" LL (V .VERBOSE))
  35         #DECL ((N) NODE (L) LIST (V VERBOSE) <LIST [REST NODE LIST]>
  36                (LL) <PRIMTYPE LIST>)
  37         <COND (<SET LL <MEMQ .N .V>>
  38                <PUTREST <REST <SET LL <2 .LL>> <- <LENGTH .LL> -1>> .L>)
  39               (ELSE
  40                <SET VERBOSE <REST <PUTREST .V (.N .L)> 2>>)>>
  41
  42
  43 <DEFINE COMPILE-ERROR ("TUPLE" X)
  44         <PRINC "*** ERROR ">
  45         <MAPF <>
  46               <FUNCTION (IT)
  47                 <COND (<TYPE? .IT STRING> <PRINC .IT>)
  48                       (<TYPE? .IT NODE> <NODE-COMPLAIN .IT>)
  49                       (ELSE <PRIN1 .IT>)>
  50                 <PRINC " ">> .X>
  51         <COND (<AND <GASSIGNED? DEBUGSW> ,DEBUGSW> <ERROR>)>
  52         <RETURN <> .COMPILE-ACTIVATION>>
  53
  54 <DEFINE COMPILE-LOSSAGE ("TUPLE" X)
  55         <PRINC "*** LOSSAGE ">
  56         <MAPF <>
  57               <FUNCTION (IT)
  58                 <COND (<TYPE? .IT STRING> <PRINC .IT>)
  59                       (<TYPE? .IT NODE> <NODE-COMPLAIN .IT>)
  60                       (ELSE <PRIN1 .IT>)>
  61                 <PRINC " ">> .X>
  62         <ERROR LOSSAGE!-ERRORS>>
  63
  64 <DEFINE COMPILE-WARNING ("TUPLE" X)
  65         <PRINC "*** WARNING ">
  66         <MAPF <>
  67               <FUNCTION (IT)
  68                 <COND (<TYPE? .IT STRING> <PRINC .IT>)
  69                       (<TYPE? .IT NODE> <NODE-COMPLAIN .IT>)
  70                       (ELSE <PRIN1 .IT>)>
  71                 <PRINC " ">> .X>
  72         <CRLF>>
  73
  74
  75 <DEFINE COMPILE-NOTE ("TUPLE" X)
  76         <PRINC "*** NOTE ">
  77         <MAPF <>
  78               <FUNCTION (IT)
  79                 <COND (<TYPE? .IT STRING> <PRINC .IT>)
  80                       (<TYPE? .IT NODE> <NODE-COMPLAIN .IT>)
  81                       (ELSE <PRIN1 .IT>)>
  82                 <PRINC " ">> .X>
  83         <CRLF>>
  84
  85 <ENDPACKAGE>