perm filename CYCDRF.LSP[3,LMM] blob
sn#037475 filedate 1973-04-21 generic text, type T, neo UTF8
(DEFPROP CYCDRFFNS
(CYCDRFFNS NODEPICK1 INTERSECTION)
VALUE)
(DEFPROP NODEPICK1
(LAMBDA(FCM NF)
(PROG (X Y Z Y2)
(SETQ X (MAPCAR (FUNCTION FNODLST) FCM))
(RETURN
(FOR Y
IN
NF
LIST
(SETQ Y2 (CDR Y))
(SETQ Z NIL)
(COND ((NULL Y2) (GO A)))
(SETQ Z (CDR (ASSOC (CAR Y2) X)))
B
(SETQ Y2 (CDR Y2))
(COND ((NULL Y2) (GO A)))
(SETQ Z (INTERSECTION Z (CDR (ASSOC (CAR Y2) X))))
(GO B)
A
(CONS (CAR Y) Z)))))
EXPR)
(DEFPROP INTERSECTION
(LAMBDA (A B) (FOR NEW X IN A WHEN (MEMBER X B) LIST X))
EXPR)