MUDDLE/ptrace.7

   1 <DEFINE TRACE
   2  <FUNCTION ("REST" 'SPECS)
   3    <MAPCAR ,TRACE1 .SPECS>   >>
   4
   5
   6 <DEFINE UNTRACE
   7  <FUNCTION ("REST" PROCNS "AUX" OTYP)
   8    <MAPCAR
   9        #FUNCTION ((PROCN)
  10                   <SET OTYP <TYPE ,.PROCN>>
  11                   <SETG .PROCN <2 <1 <LAST <1 ,.PROCN>>>>>
  12                   <COND (<==? .OTYP ACTOR-FUNCTION>
  13                          <SETG .PROCN <CHTYPE ,.PROCN ACTOR-FUNCTION>>)   >
  14                   .PROCN)
  15        .PROCNS>  >>\f<DEFINE TRACE1
  16  <FUNCTION TR1 (SPEC "AUX" PROCN ARGL PROC SPEC1)
  17    <COND (<ATOM? .SPEC>
  18           <SET SPEC (.SPEC EN '<DISPLAY .*ARGS> EX '<DISPLAY .*VAL>)>)   >
  19    <SET PROCN <1 .SPEC>>
  20    <OR <MEMQ <TYPE <SET PROC ,.PROCN>> '(SUBR FSUBR FUNCTION ACTOR-FUNCTION)>
  21        <.TR1 <ERROR MEANINGLESS-TRACE-REQUEST .PROCN>>>
  22    <SETG .PROCN
  23     <CHTYPE ((!<SET ARGL <ARGDECLS .PROC>>
  24               "AUX" !<COND (<MEMQ <TYPE .PROC> '(FUNCTION ACTOR-FUNCTION)>
  25                             ((*ARGS <ARGVALS .ARGL>)))>
  26                     *VAL
  27                     (*OFUNC <COND (<==? <TYPE .PROC> ACTOR-FUNCTION>
  28                                    <CHTYPE .PROC FUNCTION>)
  29                                   (.PROC)  >))
  30              !<COND (<SET SPEC1 <MEMQ EN .SPEC>>
  31                      (<FORM PRINT (ENTERING .PROCN)>
  32                       !<UPTONEXTATOM <REST .SPEC1>>))>
  33              !<COND (<SET SPEC1 <MEMQ FO .SPEC>>
  34                      (<FORM FAILPOINT ()
  35                             <>
  36                             '(*MES *ACT)
  37                             <FORM PRINT (FAILING OUT OF .PROCN)>
  38                             !<UPTONEXTATOM <REST .SPEC1>>
  39                             '<FAIL .*MES .*ACT>   >))   >
  40              '<SET *VAL <APPLY .*OFUNC (!.*ARGS)>>
  41              !<COND (<SET SPEC1 <MEMQ FI .SPEC>>
  42                      (<FORM FAILPOINT ()
  43                             <>
  44                             '(*MES *ACT)
  45                             <FORM PRINT (FAILING INTO .PROCN)>
  46                             !<UPTONEXTATOM <REST .SPEC1>>
  47                             '<FAIL .*MES .*ACT>   >))   >
  48              !<COND (<SET SPEC1 <MEMQ EX .SPEC>>
  49                      (<FORM PRINT (EXITING .PROCN)>
  50                       !<UPTONEXTATOM <REST .SPEC1>>))   >
  51              <FORM LVAL *VAL>   )
  52             <COND (<==? <TYPE .PROC> ACTOR-FUNCTION> ACTOR-FUNCTION)
  53                   (FUNCTION)   >>>
  54    .PROCN   >>\f<DEFINE ARGDECLS
  55  <FUNCTION (PROC "AUX" (TP <TYPE .PROC>) DECLS R)
  56    <COND (<==? .TP SUBR>
  57           '("REST" *ARGS))
  58          (<==? .TP FSUBR>
  59           '("REST" '*ARGS))
  60          (T <AND <ATOM? <1 .PROC>> <SET PROC <REST .PROC>>>
  61             <SET DECLS <1 .PROC>>
  62             <COND (<OR <SET R <MEMBER "AUX" .DECLS>>
  63                        <SET R <MEMBER "ACT" .DECLS>>>
  64                    <UPTO .DECLS .R>)
  65                   (.DECLS)   >)   >   >>
  66
  67
  68 <DEFINE ARGVALS
  69  <FUNCTION (ARGL)
  70    <MAPCAN
  71       #FUNCTION ((DECL "AUX" (TP <TYPE  .DECL>))
  72                  <COND (<==? .TP STRING> ())
  73                        ((<FORM LVAL
  74                                <COND (<ATOM? .DECL> .DECL)
  75                                      (<==? .TP FORM>
  76                                       <LEGALFORMDECL .DECL>)
  77                                      (<==? .TP LIST>
  78                                       <OR <==? <LENGTH .DECL> 2>
  79                                           <TRCOMPLAIN .PROCN>>
  80                                       <SET DECL <1 .DECL>>
  81                                       <COND (<ATOM? .DECL> .DECL)
  82                                             (<==? .TP FORM>
  83                                              <LEGALFORMDECL .DECL>)
  84                                             (T <TRCOMPLAIN .PROCN>)>)   >>))   >)
  85       .ARGL>   >>
  86
  87
  88 <DEFINE LEGALFORMDECL
  89  <FUNCTION (DECL)
  90    <COND (<AND <==? <LENGTH .DECL> 2>
  91                <==? <1 .DECL> QUOTE>
  92                <ATOM? <2 .DECL>>>
  93           <2 .DECL>)
  94          (<TRCOMPLAIN .PROCN>)   >   >>
  95
  96
  97 <DEFINE TRCOMPLAIN
  98  <FUNCTION (PROCN)
  99    <PRINT (MEANINGLESS PARAMETER DECLARATION IN .PROCN)>
 100    <.TR1 (.PROCN *NOT TRACED*)>   >>\f<DEFINE UPTONEXTATOM
 101  <FUNCTION (L)
 102    <COND (<OR <EMPTY? .L> <ATOM? <1 .L>>> ())
 103          ((<1 .L> !<UPTONEXTATOM <REST .L>>))   >>>
 104
 105
 106 <DEFINE DISPLAY
 107  <FUNCTION ("REST" 'ITEMS)
 108    <MAPC
 109       #FUNCTION ((ITEM)
 110                  <PRINT .ITEM>
 111                  <PRINC "= " >
 112                  <PRIN1 <EVAL .ITEM>>)
 113       .ITEMS>
 114    <TERPRI>   >>\f\ 3\f