<mdl.comp>/nprint.mud.21

   1 <PACKAGE "NPRINT">
   2
   3 <ENTRY NODE-COMPLAIN NODE-PRINT>
   4
   5 <USE "COMPDEC">
   6
   7 <DEFINE NODE-COMPLAIN (N "OPTIONAL" (MAX 80) "AUX" (P .N) TEM)
   8         #DECL ((N) NODE (MAX) FIX (P) <OR VECTOR NODE>)
   9         <REPEAT ((OPP .P))
  10                 <AND <EMPTY? .OPP> <RETURN>>
  11                 <OR <NODE-PRINT .OPP .N .MAX T> <RETURN>>
  12                 <OR <TYPE? <SET TEM <PARENT <SET P .OPP>>> NODE>
  13                     <RETURN>>
  14                 <OR <MEMQ .OPP <KIDS <SET OPP .TEM>>>
  15                     <RETURN>>>
  16         <NODE-PRINT .P .N .MAX>>
  17
  18 <DEFINE NODE-PRINT (N
  19                     "OPTIONAL" (LOSER <>) (MAX 80) (FLAT <>)
  20                     "AUX" (OUTC .OUTCHAN)
  21                           (OUTCHAN
  22                            <OPEN "PRINT" "INT:" <COND (.FLAT ,NF) (ELSE ,NP)>>)
  23                           (NCHS 0))
  24         #DECL ((MAX) <SPECIAL FIX> (NCHS) <SPECIAL ANY>
  25                (OUTCHAN OUTC) <SPECIAL CHANNEL>
  26                (LOSER) <SPECIAL <OR FALSE NODE>>)
  27         <PUT .OUTCHAN 13 <- <13 .OUTC> 2>>
  28         <COND (<PROG NACT ()
  29                      #DECL ((NACT) <SPECIAL ACTIVATION>)
  30                      <NPRINT .N>
  31                      <>>
  32                <OR .FLAT <PRINC " ..." .OUTC>>
  33                <SET NCHS <>>)>
  34         <OR .FLAT <TERPRI .OUTC>>
  35         <CLOSE .OUTCHAN>
  36         .NCHS>
  37
  38 <DEFINE NF (CH)
  39         <COND (<L? <SET MAX <- .MAX 1>> 0> <RETURN T .NACT>)>
  40         <SET NCHS <+ .NCHS 1>>>
  41
  42 <DEFINE NP (CH) #DECL ((CH) CHARACTER)
  43         <COND (<L? <SET MAX <- .MAX 1>> 0> <RETURN T .NACT>)>
  44         <PRINC .CH .OUTC>>
  45
  46 <DEFINE NPRINT (N "AUX" (COD <NODE-TYPE .N>) TC (FLG <==? .N .LOSER>))
  47         #DECL ((N) NODE (COD TC) FIX)
  48         <AND .FLG <PRINC " **** ">>
  49         <COND (<OR <==? .COD ,FUNCTION-CODE> <==? .COD ,MFCN-CODE>>
  50                <PRINC "<FUNCTION ">
  51                <PRNARGL <BINDING-STRUCTURE .N> <RESULT-TYPE .N> <>>
  52                <PRINC " ">
  53                <SEQ-PRINT <KIDS .N>>
  54                <PRINC ">">)
  55               (<==? .COD ,PROG-CODE>
  56                <PRINC "<">
  57                <PRIN1 <NODE-NAME .N>>
  58                <PRINC " ">
  59                <PRNARGL <BINDING-STRUCTURE .N> <RESULT-TYPE .N> T>
  60                <PRINC " ">
  61                <SEQ-PRINT <KIDS .N>>
  62                <PRINC ">">)
  63               (<==? .COD ,MFIRST-CODE>
  64                <PRINC <NTH ,MAP-SPEC-PRINT <NODE-SUBR .N>>>)
  65               (<==? .COD ,MPSBR-CODE>
  66                <PRINC ",">
  67                <OR <AND <EMPTY? <KIDS .N>> some-subr>
  68                    <PRIN1 <NODE-NAME <1 <KIDS .N>>>>>)
  69               (<==? .COD ,COPY-CODE>
  70                <PRINC <NTH ,ST-CHRS
  71                            <SET TC
  72                                 <LENGTH <MEMQ <NODE-NAME .N>
  73                                               '![UVECTOR VECTOR LIST!]>>>>>
  74                <SEQ-PRINT <KIDS .N>>
  75                <PRINC <NTH ,EN-CHRS .TC>>)
  76               (<OR <==? .COD ,SEG-CODE> <==? .COD ,SEGMENT-CODE>>)
  77               (<==? .COD ,BRANCH-CODE>
  78                <PRINC "(">
  79                <NPRINT <PREDIC .N>>
  80                <COND (<NOT <EMPTY? <CLAUSES .N>>>
  81                       <PRINC " ">
  82                       <SEQ-PRINT <CLAUSES .N>>)>
  83                <PRINC ")">)
  84               (<==? .COD ,QUOTE-CODE>
  85                <AND <TYPE? <NODE-NAME .N> VECTOR UVECTOR LIST FORM>
  86                     <PRINC !"'>>
  87                <PRIN1 <NODE-NAME .N>>)
  88               (<OR <==? .COD ,SET-CODE> <==? .COD ,FSET-CODE>>
  89                <PRINC "<">
  90                <PRIN1 SET>
  91                <PRINC " ">
  92                <SEQ-PRINT <KIDS .N>>
  93                <PRINC ">">)
  94               (<OR <MEMQ .COD ,LGV>
  95                    <AND <==? .COD ,SUBR-CODE>
  96                         <OR <AND <==? <NODE-SUBR .N> ,LVAL>
  97                                  <SET COD ,FLVAL-CODE>>
  98                             <AND <==? <NODE-SUBR .N> ,GVAL>
  99                                  <SET COD ,FGVAL-CODE>>>>>
 100                <COND (<OR <==? .COD ,LVAL-CODE> <==? .COD ,FLVAL-CODE>>
 101                       <PRINC !".>)
 102                      (ELSE <PRINC !",>)>
 103                <COND (<TYPE? <NODE-NAME .N> SYMTAB>
 104                       <PRIN1 <NAME-SYM <NODE-NAME .N>>>)
 105                      (ELSE <OR <AND <EMPTY? <KIDS .N>> some-atom>
 106                                <NPRINT <1 <KIDS .N>>>>)>)
 107               (<==? <NODE-NAME .N> INTH>
 108                <PRINC "<">
 109                <OR <EMPTY? <KIDS .N>> <NPRINT <2 <KIDS .N>>>>
 110                <PRINC " ">
 111                <OR <EMPTY? <KIDS .N>> <NPRINT <1 <KIDS .N>>>>
 112                <PRINC ">">)
 113               (ELSE
 114                <PRINC "<">
 115                <PRINC <NODE-NAME .N>>
 116                <PRINC " ">
 117                <SEQ-PRINT <KIDS .N>>
 118                <PRINC ">">)>
 119         <AND .FLG <PRINC " **** ">>>
 120
 121 <SETG MAP-SPEC-PRINT [",+" ",-" ",*" ",/" ",LIST"]>
 122
 123 <SETG LGV
 124       ![,LVAL-CODE ,FLVAL-CODE ,GVAL-CODE ,FGVAL-CODE!]>
 125
 126 <SETG ST-CHRS ["(" "[" "!["]>
 127
 128 <SETG EN-CHRS [")" "]" "!]"]>
 129
 130 <DEFINE SEQ-PRINT (L) #DECL ((L) <LIST [REST NODE]>)
 131         <COND (<NOT <EMPTY? .L>>
 132                <NPRINT <1 .L>>
 133                <COND (<NOT <EMPTY? <SET L <REST .L>>>>
 134                       <MAPF <>
 135                             <FUNCTION (N)
 136                                 #DECL ((N) NODE)
 137                                 <PRINC " ">
 138                                 <NPRINT .N>>
 139                             .L>)>)>>
 140
 141 <DEFINE PRNARGL (B R "OPTIONAL" (INAUX <>) "AUX" (INOPT <>) (DC ()) (FIRST T))
 142         #DECL ((B) <LIST [REST SYMTAB]> (DC) LIST)
 143         <PRINC "(">
 144         <MAPF <>
 145               <FUNCTION (SYM "AUX" (COD <CODE-SYM .SYM>))
 146                       #DECL ((SYM) SYMTAB (COD) FIX)
 147                       <OR .FIRST <PRINC " ">>
 148                       <SET FIRST <>>
 149                       <COND (<==? .COD 1>
 150                              <PRINC "\"NAME\" ">
 151                              <PRIN1 <NAME-SYM .SYM>>)
 152                             (<L=? .COD 3>
 153                              <COND (<NOT .INAUX>
 154                                     <SET INAUX T>
 155                                     <PRINC "\"AUX\" ">)>
 156                              <COND (<==? .COD 2>
 157                                     <PRINC "(">
 158                                     <PRIN1 <NAME-SYM .SYM>>
 159                                     <PRINC " ">
 160                                     <NPRINT <INIT-SYM .SYM>>
 161                                     <PRINC ")">)
 162                                    (ELSE <PRIN1 <NAME-SYM .SYM>>)>)
 163                             (<==? .COD 4>
 164                              <PRINC "\"TUPLE\" ">
 165                              <PRIN1 <NAME-SYM .SYM>>)
 166                             (<==? .COD 5>
 167                              <PRINC "\"ARGS\" ">
 168                              <PRIN1 <NAME-SYM .SYM>>)
 169                             (<L=? .COD 9>
 170                              <COND (<NOT .INOPT>
 171                                     <SET INOPT T>
 172                                     <PRINC "\"OPTIONAL\" ">)>
 173                              <COND (<L=? .COD 7>
 174                                     <PRINC "(">
 175                                     <AND <==? .COD 6> <PRINC "'">>
 176                                     <PRIN1 <NAME-SYM .SYM>>
 177                                     <PRINC " ">
 178                                     <NPRINT <INIT-SYM .SYM>>
 179                                     <PRINC ")">)
 180                                    (ELSE
 181                                     <AND <==? .COD 8> <PRINC "'">>
 182                                     <PRIN1 <NAME-SYM .SYM>>)>)
 183                             (<==? .COD 10>
 184                              <PRINC "\"CALL\" ">
 185                              <PRIN1 <NAME-SYM .SYM>>)
 186                             (<==? .COD 11>
 187                              <PRINC "\"BIND\" ">
 188                              <PRIN1 <NAME-SYM .SYM>>)
 189                             (ELSE
 190                              <AND <==? .COD 12> <PRINC "'">>
 191                              <PRIN1 <NAME-SYM .SYM>>)>
 192                       <COND (<N==? <1 <DECL-SYM .SYM>> ANY>
 193                              <SET DC
 194                                   ((<NAME-SYM .SYM>)
 195                                    <1 <DECL-SYM .SYM>>
 196                                    !.DC)>)>>
 197               .B>
 198         <COND (<AND .R <N==? .R ANY>> <SET DC ('(VALUE) .R !.DC)>)>
 199         <PRINC ")">
 200         <COND (<NOT <EMPTY? .DC>> <PRINC " "> <PRIN1 <CHTYPE .DC DECL>>)>>
 201
 202
 203
 204
 205
 206 <ENDPACKAGE>
 207 \ 3