perm filename EXPLAI[DEN,LMM] blob sn#070827 filedate 1973-11-09 generic text, type T, neo UTF8

(FILECREATED " 9-NOV-73 0:59:44" S-EXPLAIN changes to: EXPLAINRINGSKEL previous date: " 5-NOV-73 0:52:59") (LISPXPRINT (QUOTE EXPLAINVARS) T) (RPAQQ EXPLAINVARS ((* Everything needed to do an "EXPLAIN" command) (FNS EXPLAIN PRINCL BONDING PRINU PRINMB PRINNUMLIS PRINNUMLISTS EXPLAINVALENTNODE PRIN1L EXPLAINUPDATEFLG WHERE STRUCFORMLEVEL) (FNS EXPLAINATIONMOLECULES EXPLAINGENMOL EXPLAINRINGS EXPLAINSTRUCWAT EXPLAINRINGSKEL EXPLAINATTACFVS EXPLAINNOFV EXPLAINNOLOOP EXPLAINCAT EXPLAINATTBIV EXPLAINVL EXPLAINBVL EXPLAINSINGLERINGS) (VARS (EXPLAININDENT 0) (EXPLAINLEVEL 0)) (PROP EXPLAINATION MOLECULES GENMOL RINGS STRUCTURESWITHATOMS RINGSKELETONS ATTACHFVS NOFVRINGS NOLOOPEDRINGS CATALOG ATTACHBIVALENTS ATTACHBIVS&LOOPS SINGLERINGS) (USERMACROS EXPLAINALL EXPLAIN ⊗ @ SLEVEL SWHICH))) (* Everything needed to do an "EXPLAIN" command) (DEFINEQ (EXPLAIN [LAMBDA (FORM PREFIX NOMOREINDENT) (* This function is the driver for the EXPLAIN package. It prints the explaination for any given FORM. Requires the setting of "EXPLAINLEVEL" and "EXPLAININDENT"; EXPLAINLEVEL is the depth to which explainations should go (and a negative value means never to DRAW structures or expand out sublists)) (* The explaination for STRUCFORM's is driven off the property lists of functions; give the function a property "EXPLAINATION" of a function, with the same arguments; however that the "EXPLAINATION" function prints an explaination of what the real function generates with those given arguments. Rules are that the function should not carriage return afterwards; and may use a variety of the functions already available (i.e. PRINCL is a good way of explaining a composition list of atoms / structures)) (* PREFIX is a thing to be printed on the same line with the beginning of the explaination; NOMOREINDENT means not to bump the EXPLAININDENT) (PROG [(EXPLAININDENT (COND [EXPLAININDENT (TAB EXPLAININDENT) (COND (NOMOREINDENT EXPLAININDENT) (T (IPLUS 5 EXPLAININDENT] (T 5))) (EXPLAINLEVEL (COND ((NULL EXPLAINLEVEL -30)) ((EQ EXPLAINLEVEL 0) 0) ((MINUSP EXPLAINLEVEL) (ADD1 EXPLAINLEVEL)) (T (SUB1 EXPLAINLEVEL] (COND (PREFIX (MAPRINT PREFIX T NIL " " ""))) (PRIN1 (COND ((STRUCLIST? FORM) (COND ((ILESSP EXPLAINLEVEL 1) (PROG (FORMS LISTS OTHER STRUCS RADS FLG) [FOR X IN (fetch LISTITEMS of FORM) AS I FROM 1 DO (COND ((STRUCLIST? X) (SETQ LISTS (CONS I LISTS))) ((STRUCFORM? X) (SETQ FORMS (CONS I FORMS))) ((STRUCTURE? X) (SETQ STRUCS (CONS I STRUCS))) ((RADICAL? X) (SETQ RADS (CONS I RADS))) (T (SETQ OTHER (CONS I OTHER] (PRINNUMLISTS FORMS "forms:" LISTS "sublists:" STRUCS "structures:" RADS "radicals:" OTHER "garbage:")) "") (T (PRIN1 "List with:" T) (FOR X IN (fetch LISTITEMS of FORM) AS I FROM 1 DO (EXPLAIN X (LIST "#" I))) " "))) ((STRUCFORM? FORM) (COND ((ZEROP EXPLAINLEVEL) (PRIN1 (CADR FORM) T) " expression") ((NOT (GETP (CADR FORM) (QUOTE EXPLAINATION))) (RESETFORM (PRINTLEVEL 2) (PRIN1 (CDR FORM) T)) "") (T (APPLY (GETP (CADR FORM) (QUOTE EXPLAINATION)) (CDDR FORM)) ""))) ((OR (STRUCTURE? FORM) (RADICAL? FORM)) (COND ((EQ (fetch LASTNODE# of FORM) 2) [PRINMB (ATOMTYPE (CAR (fetch CTABLE of FORM))) (FOR X IN (fetch NBRS of (CAR (fetch CTABLE of FORM))) WHEN (NOT (EQ X (QUOTE FV))) SUM 1) (ATOMTYPE (CADR (fetch CTABLE of FORM] "") ((ILESSP EXPLAINLEVEL 1) (COND ((STRUCTURE? FORM) "structure") (T "radical"))) (T (PRIN1 "The structure: " T) (DRAW FORM) " "))) (T "garbage")) T]) (PRINCL [LAMBDA (CL) (SETQ CL (SORT (APPEND CL) T)) (PROG (FLG TEM BFLG) (FOR X IN CL DO [SETQ TEM (COND ((ATOM (CAR X)) (CAR X)) ((AND (ATOM (CAAR X)) (GETP (CAAR X) (QUOTE VALENCE))) (CAAR X)) (T (AND FLG (NEQ FLG (QUOTE FOO)) (PRIN1 " and" T)) (SETQQ FLG FOO) (EXPLAIN (CAR X) (LIST (CDR X))) (GO BYPASS] (EXPLAINUPDATEFLG) (PRIN1L (CDR X) " " TEM) BYPASS (AND (IGREATERP (CDR X) 1) (PRIN1 (QUOTE "'s ") T]) (BONDING [LAMBDA (U) (SELECTQ U (1 "-") (2 "=") (3 ":::") (CONCAT "-" U "-"]) (PRINU [LAMBDA (U) (PRIN1L U (SELECTQ U (1 " unsaturation, ") " unsaturations, "]) (PRINMB [LAMBDA (AT BND AT2) (PRIN1L (OR AT "@") (BONDING BND) (OR AT2 "@") " "]) (PRINNUMLIS [LAMBDA (X) (SETQ X (REVERSE X)) (PROG (LST) (PRIN1 (SETQ LST (CAR X)) T) (FOR OLD X ON (CDR X) AS FLG IS NIL DO (FOR OLD X ON X WHILE (EQ (CAR X) (SETQ LST (ADD1 LST))) DO (SETQ FLG (CAR X))) (COND (FLG (PRIN1L "-" FLG))) (COND (X (PRIN1L "," (SETQ LST (CAR X]) (PRINNUMLISTS [LAMBDA N (PROG (FLG) (FOR I FROM 1 TO N BY 2 DO (COND ((ARG N I) (EXPLAINUPDATEFLG) (PRIN1 (ARG N (ADD1 I)) T) (PRINNUMLIS (ARG N I]) (EXPLAINVALENTNODE [LAMBDA (NUMBERNODES VALENCE) (PRIN1L (COND ((EQ NUMBERNODES 1) "one") (T NUMBERNODES)) " " (SELECTQ VALENCE (1 "uni") (2 "bi") (3 "tri") (4 "quadri") VALENCE) (SELECTQ NUMBERNODES (1 "valent") "valents"]) (PRIN1L [LAMBDA N (FOR I FROM 1 TO N DO (PRIN1 (ARG N I) T]) (EXPLAINUPDATEFLG [LAMBDA NIL (PRIN1 (COND (FLG ", ") (T " ")) T) (SETQ FLG T]) (WHERE [LAMBDA NIL (PROG ((EXPRESSION (##)) (LEVEL (STRUCFORMLEVEL L)) TAIL) (PRIN1L "Level " LEVEL) [NLSETQ (PROG ((L L)) LP (SETQ WHICH (LENGTH (## UP))) [SETQ L (EDITL0 L (QUOTE (!0] (OR (STRUCLIST? (CAR L)) (GO LP)) (SETQ WHICH (CONS (IPLUS -1 (LENGTH (CAR L)) (IMINUS WHICH)) (STRUCFORMLEVEL L))) (PRIN1L (COND ((EQ (SUB1 LEVEL) (CDR WHICH)) ", #") (T " within #")) (CAR WHICH) " at level " (CDR WHICH] (PRIN1 ", " T) (PROG ((EXPLAININDENT)) (EXPLAIN EXPRESSION) (TERPRI T]) (STRUCFORMLEVEL [LAMBDA (L) (FOR X IN (CDR L) WHEN (STRUCFORM? X) SUM 1]) ) (DEFINEQ (EXPLAINATIONMOLECULES [LAMBDA (CL U) (PRIN1 (QUOTE "Molecules with ") T) (PRINU U) (PRINCL CL]) (EXPLAINGENMOL [LAMBDA (CL) (PRIN1 (QUOTE "all trees made out of") T) (PRINCL CL]) (EXPLAINRINGS [LAMBDA (U CL) (COND ((EQ (CLCOUNT CL) 2) (SETQ CL (CLEXPAND CL)) (PRINMB (CAR CL) (ADD1 U) (CADR CL))) (T (PRIN1 "rings with " T) (PRINU U) (PRINCL CL]) (EXPLAINSTRUCWAT [LAMBDA (CLL STRUC) (PRINCL (APPLY (QUOTE APPEND) CLL)) (PRIN1 (QUOTE " placed on ") T) (EXPLAIN STRUC]) (EXPLAINRINGSKEL [LAMBDA (FV VL) (PRIN1 "Ring skeletons with " T) (PRIN1 FV T) (PRIN1 " free valences," T) (EXPLAINVL VL]) (EXPLAINATTACFVS [LAMBDA (FVL STRUC) (EXPLAIN STRUC NIL T) (PRIN1 ", with " T) (PROG (FLG) (FOR FVR IN FVL AS VALNODE FROM 2 FOR FVI IN FVR AS NUMFV FROM 1 WHEN (NOT (ZEROP FVI)) DO (EXPLAINUPDATEFLG) (EXPLAINVALENTNODE FVI VALNODE) (PRIN1L " getting " NUMFV " free valences"]) (EXPLAINNOFV [LAMBDA (FV) (PRIN1 "rings with " T) (EXPLAINVL FV]) (EXPLAINNOLOOP [LAMBDA (VL) (PRIN1 "non-looped " T) (EXPLAINNOFV VL]) (EXPLAINCAT [LAMBDA (TVL) (PRIN1 "catalog entries with " T) (EXPLAINVL (CONS (QUOTE 0) TVL]) (EXPLAINATTBIV [LAMBDA (BVP STRUC) (EXPLAIN STRUC NIL T) (PRIN1 ", with" T) (PROG (FLG) (FOR PR IN BVP WHEN (NOT (ZEROP (CAR PR))) DO (EXPLAINUPDATEFLG) (PRIN1L (CAR PR) " bivalents placed on " (CDR PR) (COND ((EQ (CDR PR) 1) " edge") (T " edges"]) (EXPLAINVL [LAMBDA (VL) (PROG (FLG) (FOR X IN VL AS I FROM 2 WHEN (NOT (ZEROP X)) DO (EXPLAINUPDATEFLG) (EXPLAINVALENTNODE X I]) (EXPLAINBVL [LAMBDA (BVP LPP STRUC) (EXPLAINATTBIV BVP STRUC) (PROG (FLG) (FOR VLPP IN LPP AS NV FROM 2 FOR PR IN VLPP DO (EXPLAINUPDATEFLG) (EXPLAINVALENTNODE (CDR PR) NV) (PRIN1 " getting " T) (COND ((NULL (CDR (CAR PR))) (PRIN1 (SELECTQ (CDAAR PR) (1 " a loop with ") (PROGN (PRIN1 (CDAAR PR) T) " loops with ")) T) (EXPLAINVALENTNODE (CAAAR PR) 2)) (T (PRIN1L (CLCOUNT (CAR PR)) " loops (") (PROG (FLG) (FOR PR1 IN (CAR PR) DO (EXPLAINUPDATEFLG) (PRIN1L (CAR PR1) " bivalents on " (CDR PR1) " of them "))) (PRIN1 ")" T]) (EXPLAINSINGLERINGS [LAMBDA (NUMBIVS) (PRIN1 "ring of " T) (EXPLAINVALENTNODE NUMBIVS 2]) ) (RPAQ EXPLAININDENT 0) (RPAQ EXPLAINLEVEL 0) (DEFLIST(QUOTE( (MOLECULES EXPLAINATIONMOLECULES) (GENMOL EXPLAINGENMOL) (RINGS EXPLAINRINGS) (STRUCTURESWITHATOMS EXPLAINSTRUCWAT) (RINGSKELETONS EXPLAINRINGSKEL) (ATTACHFVS EXPLAINATTACFVS) (NOFVRINGS EXPLAINNOFV) (NOLOOPEDRINGS EXPLAINNOLOOP) (CATALOG EXPLAINCAT) (ATTACHBIVALENTS EXPLAINATTBIV) (ATTACHBIVS&LOOPS EXPLAINBVL) (SINGLERINGS EXPLAINSINGLERINGS) ))(QUOTE EXPLAINATION)) (ADDTOVAR USERMACROS (@ NIL (@ 1)) [@ (EXPLEVEL) (ORR (UP 1 SWHICH SLEVEL (E (PROG ((EXPLAINLEVEL EXPLEVEL)) (WHERE)) T)) ((E (QUOTE ?] (EXPLAIN NIL (EXPLAIN -100)) [EXPLAIN (EXPLEVEL) (ORR ((E (PROG ((EXPLAINLEVEL EXPLEVEL)) (EXPLAIN (##)) (TERPRI T)) T)) ((E (QUOTE ?] (EXPLAINALL NIL (EXPLAIN 100)) (SLEVEL NIL MARK (E (SETQ LEVEL 0) T) (LPQ UPFORM (E (SETQ LEVEL (ADD1 LEVEL)) T)) ←←) (SWHICH NIL MARK (ORR ((E (SETQ WHICH) T) [LC UP (E (SETQ WHICH (LENGTH (##))) T) 0 (IF (STRUCLIST? (##)) (NIL) ((E (ERROR!) T] (E (SETQ WHICH (IPLUS -1 (LENGTH (##)) (IMINUS WHICH))) T) (E (PROG (LEVEL) (## SLEVEL) (SETQ WHICH (CONS WHICH LEVEL))) T)) (NIL)) ←←)) (ADDTOVAR EDITCOMSA SWHICH SLEVEL EXPLAINALL EXPLAIN @) (ADDTOVAR EDITCOMSL EXPLAIN @) STOP