mim/development/mim/vax/mimlib/dups.mud

   1 <PACKAGE "DUPS">
   2
   3 <ENTRY DUPS OBLISTS PACKAGES REFS DUP-LIST PACK-LIST OB-LIST REF-LIST
   4        REFS>
   5
   6 <GDECL (DUP-LIST) <LIST [REST STRING LIST]>
   7        (PACK-LIST OB-LIST) LIST>
   8
   9 <DEFINE PACKAGES ("AUX" (ATBL ,ATOM-TABLE))
  10         #DECL ((ATBL) <VECTOR [REST LIST]>)
  11         <SETG PACK-LIST ()>
  12         <MAPF <>
  13               <FUNCTION (L)
  14                    #DECL ((L) LIST)
  15                    <MAPF <>
  16                          <FUNCTION (A "AUX" O)
  17                               #DECL ((A) ATOM (O) <OR OBLIST FALSE>)
  18                               <COND (<AND <SET O <OBLIST? .A>>
  19                                           <==? <CHTYPE .O ATOM> PACKAGE>
  20                                           <NOT <MEMQ .A ,PACK-LIST>>>
  21                                      <SETG PACK-LIST (.A !,PACK-LIST)>)>>
  22                          .L>>
  23               .ATBL>
  24         ,PACK-LIST>
  25
  26 <DEFINE OBLISTS ("AUX" (ATBL ,ATOM-TABLE))
  27         #DECL ((ATBL) <VECTOR [REST LIST]>)
  28         <SETG OB-LIST ()>
  29         <MAPF <>
  30               <FUNCTION (L)
  31                    #DECL ((L) LIST)
  32                    <MAPF <>
  33                          <FUNCTION (A "AUX" O)
  34                               #DECL ((A) ATOM (O) <OR OBLIST FALSE>)
  35                               <COND (<AND <SET O <OBLIST? .A>>
  36                                           <NOT <MEMQ .O ,OB-LIST>>>
  37                                      <SETG OB-LIST (.O !,OB-LIST)>)>>
  38                          .L>>
  39               .ATBL>
  40         ,OB-LIST>
  41
  42 <DEFINE DUPS ("AUX" (PACKS <PACKAGES>) (ATBL ,ATOM-TABLE) L)
  43         #DECL ((PACKS) <LIST [REST ATOM]> (ATBL) <VECTOR [REST LIST]>
  44                (L) LIST)
  45         <SETG DUP-LIST ()>
  46         <MAPF <>
  47               <FUNCTION (LL)
  48                    #DECL ((LL) LIST)
  49                    <MAPR <>
  50                          <FUNCTION (LL "AUX" (A <1 .LL>))
  51                               #DECL ((A) ATOM)
  52                               <COND (<AND <SAME-PNAME? .A <REST .LL>>
  53                                           <NOT
  54                                             <LENGTH? <SET L
  55                                                           <DLOOK .A .PACKS>>
  56                                                      1>>
  57                                           <NOT <MEMBER <SPNAME .A> ,DUP-LIST>>>
  58                                      <PRINC .A>
  59                                      <INDENT-TO 20>
  60                                      <PRINC .L>
  61                                      <CRLF>
  62                                      <SETG DUP-LIST
  63                                            (<SPNAME .A> .L !,DUP-LIST)>)>>
  64                          .LL>>
  65               .ATBL>
  66         T>
  67
  68 <DEFINE SAME-PNAME? (A L)
  69         #DECL ((A) ATOM (L) LIST)
  70         <MAPF <>
  71               <FUNCTION (B)
  72                    #DECL ((B) ATOM)
  73                    <COND (<=? <SPNAME .A> <SPNAME .B>> <MAPLEAVE T>)>>
  74               .L>>
  75
  76 <DEFINE DLOOK (A PACKS "AUX" (ENT? <>) L)
  77         #DECL ((A) ATOM (PACKS) <LIST [REST ATOM]> (L) LIST)
  78         <SET L
  79              <MAPF ,LIST
  80                    <FUNCTION (P "AUX" PL O)
  81                         #DECL ((P) ATOM (PL) <LIST [REST OBLIST]> (O) OBLIST)
  82                         <COND (<NOT <GASSIGNED? .P>> <MAPRET>)>
  83                         <SET PL ,.P>
  84                         <COND (<AND <N==? <ROOT> <SET O <2 .PL>>>
  85                                     <LOOKUP <SPNAME .A> .O>>
  86                                <SET ENT? T>
  87                                <MAPRET <CHTYPE .O ATOM>>)
  88                               (<AND <N==? <ROOT> <SET O <1 .PL>>>
  89                                     <LOOKUP <SPNAME .A> .O>>
  90                                <SET ENT? T>
  91                                <MAPRET <CHTYPE .O ATOM>>)
  92                               (ELSE <MAPRET>)>>
  93                    .PACKS>>
  94         <COND (.ENT? .L)>>
  95
  96 <DEFINE REFS (L "OPTIONAL" (REFL (T)) "AUX" OB A)
  97         #DECL ((L) STRUCTURED (REFL) LIST (OB) <OR FALSE OBLIST>)
  98         <MAPF <>
  99               <FUNCTION (O)
 100                    <COND (<TYPE? .O ATOM LVAL GVAL>
 101                           <COND (<SET OB <OBLIST? <SET A <CHTYPE .O ATOM>>>>
 102                                  <COND (<NOT <MEMQ .OB .REFL>>
 103                                         <PUTREST .REFL (.OB !<REST .REFL>)>)>)>)
 104                          (<TYPE? .O LIST FORM VECTOR SEGMENT>
 105                           <REFS .O .REFL>)>>
 106               .L>
 107         <REST .REFL>>
 108
 109 <ENDPACKAGE>