perm filename CYCOMG[1,LMM] blob sn#031707 filedate 1973-03-27 generic text, type T, neo UTF8
(DE LLUNCLASS (LLOBJ)
      (MAPCAR @LUNCLASS LLOBJ))))
)))))))

(DE PERMRADS (CENT CLRADS FLAG)
        (PROG2
          (SETQ CLRADS (CLCREATE CLRADS))
          (IF (ATOM CENT)
             THEN (LIST (RADICAL
                    CENTER
                    =
                    CENT
                    ATTACHEDRADS
                    =
                    CLRADS))
           ELSEIF (STRUCFORM? CENT)
             THEN (LIST (RADICAL
                    CENTER
                    =
                    (MAKECENTER RADSTRUC = CENT)
                    ATTACHEDRADS
                    =
                    CLRADS))
           ELSE (FOR NEW L
                  IN (LABELFV
                      CENT
                      ((LAMBDA (X)
                            (IF FLAG THEN (CONS 1 X) ELSE X))
                        (CDRLIST CLRADS)))
                    XLIST  (RADICAL
                        CENTER
                        =
                        (MAKECENTER
                          AFFLINK
                          =
                          (IF FLAG THEN (CAAR (LABELED L))
                           ELSE NIL)
                          RADSTRUC
                          =
                          (LSTRUC L)
                          CUFFLINKS
                          =
                          (IF FLAG THEN (CDR (LABELED L))
                           ELSE (LABELED L)))
                        ATTACHEDRADS
                        =
                        CLRADS))))))
  ))

(DE LABEEDGES (STRUC LABELS)
        (FOR NEW L
          IN (LABELM
              (UNCLASSED
                OBJECTS
                =
                (FOR NEW CT IN (CTABLE STRUC)
                  FOR NEW N IN (NBRS CT)
                    WHEN
                      (LEQ (NODENUM CT) N)
                XLIST (CONS (NODENUM CT) N)))
              LABELS
              STRUC)
            XLIST  (LABELING FROM L LABELED = (LUNCLASS **)))))
  ))

(DE LABELFV (STRUC LABELS)
        (FOR NEW L
          IN (LABELM
              (UNCLASSED OBJECTS = (COLLECTFV STRUC))
              LABELS
              STRUC)
            XLIST  (LABELING FROM L LABELED = (LUNCLASS **)))))
  ))

(DE STRUCTURESWITHATOMS (CLL STRUC)
        (FOR NEW L IN (LLABELNODES STRUC (LCDRLIST CLL))
          XLIST  (INSERTMARKERS
              (COPYSTRUC (LSTRUC L))
              CLL
              (LABELED L)))))
  ))

(DE ATTACHFVS (FVP STRUC)
        (FOR NEW L IN (LLABELNODES STRUC FVP)
          XLIST  (PUTFVS (COPYSTRUC (LSTRUC L)) (LABELED L)))))
  ))

(DE ATTACHBIVALENTS (PART STRUC)
        (FOR NEW L IN (LABELEDGES STRUC (CDRLIST PART))
          XLIST  (PUTBIVS
              (COPYSTRUC (LSTRUC L))
              (CARLIST PART)
              (LABELED L)))))
  ))
 
(DE LLABELNODES (STRUC LLABELS)
        (FOR NEW L
          IN (LLABEL
              (MAPCAR @MAKEUNCLASSED(LISTBYVALENCE STRUC) )
              LLABELS
              STRUC)
            XLIST  (LABELING FROM L LABELED = (LLUNCLASS **)))))
  ))

(DE MAKEUNCLASSED (X)
        (IF (NOT X) THEN NIL ELSE (UNCLASSED OBJECTS = X))))
  ))