(FILECREATED " 7-NOV-73  5:23:28" S-EXPAND)


  (LISPXPRINT (QUOTE EXPANDVARS)
              T)
  (RPAQQ EXPANDVARS
         ((* These functions deal with the interactive editor package)
          (FNS START RESTART RP GENAPPLY FIXFN UNFIXFN ISFORM 
               GENEXPANSION MAKELIST GETVAL MAKEMAKEFORM TURNON 
               TURNOFF NOFORMIN STRUCINCL STRUCINLIST STATE 
               STRUCLIST? GETFILENAM EXPANDER EXPAND WRITERESULTS)
          (RECORDS STRUCLIST FORM)
          (VARS (FIXEDFNLIST))
          (USERMACROS UPFORM EXPAND !EXPAND ISFORM NEXTFORM NEXFORM 
                      GROUP !!EXPAND FORMNOFORM Q # ARGS D FN W DO WW 
                      COMMANDS U FF #1 #2 #3 #4 #5 #6 #7 #8 #9)
          (PROP VALTYPE MOLECULES RINGS NOFVRINGS CATALOG ATTACHFVS 
                ATTACHBIVALENTS ATTACHBIVS&LOOPS STRUCTURESWITHATOMS 
                PERMRADS GENMOL)))

(* These functions deal with the interactive editor package)

(DEFINEQ

(START
  [LAMBDA (FUNCTIONNAME)
    (OR FUNCTIONNAME (SETQQ FUNCTIONNAME MOLECULES))
    (TURNOFF FUNCTIONNAME)
    (EDITL (LIST (SETQ SAVEDRESULTS (FOR X IN (ARGLIST FUNCTIONNAME)
                                       COLLECT
                                       FIRST (LIST (QUOTE STRUCFORM)
                                                   FUNCTIONNAME)
                                             (RP X)))
                 (SETQ SAVEDRESULTS (LIST SAVEDRESULTS)))
           NIL
           (QUOTE SAVEDRESULTS)
           (PACK (LIST FUNCTIONNAME ":")))
    (QUOTE SAVEDRESULTS])

(RESTART
  [LAMBDA NIL
    (EDITL (LIST SAVEDRESULTS)
           (QUOTE (≠START 1 (ORR (\)
                                  NIL)
                           @))
           (QUOTE SAVEDRESULTS)
           (QUOTE restart:))
    (QUOTE SAVEDRESULTS])

(RP
  [LAMBDA (STR)
    (PRIN1 STR T)
    (PRIN1 " ? " T)
    (READ T])

(GENAPPLY
  [LAMBDA (FORM GOLIST MUSTCHANGEFLG)
    (PROG (EVALFORM (NEWFORM (fetch FORM of FORM)))

          (* Kludgey way of rebinding all of the EXPANDFLAGs 
          to NIL by embedding in a PROG and then EVALing 
          that PROG -
          EXPANDER uses NEWFORM as a free variable and just 
          does (APPLY (CAR NEWFORM) 
          (CDR NEWFORM)))


          [SETQ EVALFORM (LIST (QUOTE PROG)
                               (for V in (CONS (CAR NEWFORM)
                                               GOLIST)
                                  join (AND (SETQ V
                                              (GETP V (QUOTE 
                                                       EXPANDFLAG)))
                                            (LIST V)))
                               (QUOTE (EXPANDER]
          (SETQ NEWFORM (SELECTQ (GETVAL (CAR NEWFORM))
                                 (STRUC (EVAL EVALFORM))
                                 (LSTRUC (MAKELIST (EVAL EVALFORM)))
                                 (HELP)))
          (AND MUSTCHANGEFLG (EQUAL NEWFORM FORM)
               (PRIN1 "nothing done.
" T)
               (ERROR!))
          (RETURN NEWFORM])

(FIXFN
  [LAMBDA (FN VALTYPE STRUCCHECK CONDITIONS)
    (COND
      ((NOT (AND (LITATOM FN)
                 (FGETD FN)))
        (ERROR FN "NOT A FUNCTION")))
    (PROG ((VALTYPE (GETVAL FN VALTYPE))
           [FNFLAG (OR (GETP FN (QUOTE EXPANDFLAG))
                       (/PUT FN (QUOTE EXPANDFLAG)
                             (PACK (LIST FN (GENSYM]
           (FIXED (GETP FN (QUOTE FIXED)))
           CHECKVAR CONDITION (WT (ITIMES 2 DWIMWAIT)))
          (COND
            (FIXED (PRIN1 FN T)
                   (PRIN1 " already fixed.
edit instead:" T)
                   (PRINT FIXED T)
                   (EDITE FIXED)
                   (RETURN FN)))
          (SET FNFLAG T)
          (SETQ FIXED (LIST FNFLAG))
          [COND
            ([NUMBERP
                (SETQ CHECKVAR
                  (OR
                    STRUCCHECK
                    (PROGN (PRIN1 FN T)
                           (PRIN1 " check for STRUCFORM in " T)
                           (PRIN1 (ARGLIST FN)
                                  T)
                           (APPLY* (QUOTE Y/N)
                                   [CONS (QUOTE (N . o))
                                         (for Z in (ARGLIST FN)
                                            as I
                                            from 1
                                            collect
                                             (CONS I (CONCAT " " Z]
                                   "?"]
              (SETQ FIXED (CONS (LIST (QUOTE STRUCFORM?)
                                      (CAR (NTH (ARGLIST FN)
                                                CHECKVAR)))
                                FIXED]
          [COND
            [CONDITIONS (SETQ FIXED (REMOVE NIL (APPEND CONDITIONS 
                                                        FIXED]
            (T (PROG NIL
                     (PRIN1 "add extra condition?" T)
                 WTLP(COND
                       ((MINUSP (SETQ WT (SUB1 WT)))
                         (PRIN1 "...NIL
")
                         (RETURN NIL))
                       ((READP T))
                       (T (DISMISS 500)
                          (GO WTLP)))
                 LP  (COND
                       ((SETQ CONDITION (READ T))
                         (SETQ FIXED (CONS CONDITION FIXED))
                         (PRIN1 "condition? " T)
                         (GO LP]
      NOEXTRA
          [/PUT
            FN
            (QUOTE FIXED)
            (SETQ FIXED
              (LIST (QUOTE COND)
                    (LIST (COND
                            ((CDR FIXED)
                              (CONS (QUOTE OR)
                                    FIXED))
                            (T (CAR FIXED)))
                          (LIST (QUOTE RETURN)
                                (SELECTQ VALTYPE
                                         (LSTRUC (LIST (QUOTE LIST)
                                                       (MAKEMAKEFORM
                                                         FN)))
                                         (MAKEMAKEFORM FN]
          (ADVISE FN (QUOTE BEFORE)
                  FIXED)
          (SETQ FIXEDFNLIST (CONS FN FIXEDFNLIST)))
    FN])

(UNFIXFN
  [LAMBDA (FN)
    (/RPLACD (GETP FN (QUOTE FIXED)))
    (/REMPROP FN (QUOTE VALTYPE))
    (/REMPROP FN (QUOTE EXPANDFLAG])

(ISFORM
  [LAMBDA (AT)
    (STRUCFORM? AT])

(GENEXPANSION
  [LAMBDA NIL
    (OR (STRUCLIST? (##))
        (HELP "BAD ARG TO GENEXPANSION"))

          (* This function assumes it is called from the 
          editor and uses the edit pushdown list freely.
          However, it assumes that the editor is looking at 
          a strucform -
          the idea is to expand the thing into the next 
          higher STRUCFORM)


    (PROG [(FORM (##))
           (0FORM (## !0))
           (UPFORML (EDITL0 L (QUOTE (UPFORM]
          [/RPLNODE2
            (CAR UPFORML)
            (COND
              [(NUMBERP (CDR 0FORM))

          (* This corresponds to a composition list which 
          contains a STRUCLIST -
          to expand it, need to substitute the GROUPRADS of 
          the expansion: (((STRUCLIST A B C) . 3) ...) goes 
          to ((A . 3) ...) ((A . 2) 
          (B . 2) ...) ((A . 1) (B . 1) 
          (C . 1) ...) etc.)


                (MAKELIST (for L
                             in [GROUPRADS
                                  (LIST (CONS (fetch LISTITEMS of 
                                                     FORM)
                                              (CDR 0FORM]
                             collect (LSUBST (CLCREATE L)
                                             0FORM
                                             (CAR UPFORML]
              ((STRUCLIST? (CAR UPFORML))
                (LSUBST (fetch LISTITEMS of FORM)
                        FORM
                        (CAR UPFORML)))
              (T (MAKELIST (for L in (fetch LISTITEMS of FORM)
                              collect (SUBST L FORM (CAR UPFORML]
          (SETQ L UPFORML])

(MAKELIST
  [LAMBDA (MAKELISTVAR)
    ([LAMBDA (L)
        (COND
          ((CDR L)
            (CREATE STRUCLIST LISTITEMS← L))
          (T (CAR L]
      (MAPCONC MAKELISTVAR (FUNCTION (LAMBDA (Y)
                   (COND
                     ((STRUCLIST? Y)
                       (APPEND (FETCH LISTITEMS OF Y)))
                     (T (LIST Y])

(GETVAL
  [LAMBDA (FN VALTYPE)
    (OR (AND (NOT VALTYPE)
             (GETP FN (QUOTE VALTYPE)))
        (/PUT FN (QUOTE VALTYPE)
              (SELECTQ (OR VALTYPE (PROGN (PRIN1 FN T)
                                          (Y/N ((L . ist)
                                                (S . ingle))
                                               
                                     " value type (list/single)?")))
                       (L (QUOTE LSTRUC))
                       (QUOTE STRUC])

(MAKEMAKEFORM
  [LAMBDA (FN)
    (CONS (QUOTE LIST)
          (CONS (QUOTE (QUOTE STRUCFORM))
                (CONS (KWOTE FN)
                      (ARGLIST FN])

(TURNON
  [LAMBDA (FN)
    (COND
      ((NOT FN)
        (SETQ FN FIXEDFNLIST)))
    (COND
      ((ATOM FN)
        (COND
          ((NOT (GETP FN (QUOTE FIXED)))
            (FIXFN FN)))
        (/SET (GETP FN (QUOTE EXPANDFLAG)))
        FN)
      (T (MAPCAR FN (FUNCTION TURNON])

(TURNOFF
  [LAMBDA (FN)
    (COND
      ((NOT FN)
        (SETQ FN FIXEDFNLIST)))
    (COND
      ((ATOM FN)
        (COND
          ((NOT (GETP FN (QUOTE FIXED)))
            (FIXFN FN)))
        (/SET (GETP FN (QUOTE EXPANDFLAG))
              T)
        FN)
      (T (MAPCAR FN (FUNCTION TURNOFF])

(NOFORMIN
  [LAMBDA (X)
    (OR (NLISTP X)
        (AND (NOT (STRUCFORM? X))
             (EVERY X (FUNCTION NOFORMIN])

(STRUCINCL
  [LAMBDA (CL)
    (SOME CL (FUNCTION (LAMBDA (X)
              (STRUCFORM? (CAR X])

(STRUCINLIST
  [LAMBDA (LIST)
    (SOME LIST (FUNCTION (LAMBDA (ITEM)
              (STRUCFORM? ITEM])

(STATE
  [LAMBDA (FN)
    (COND
      ((NULL FN)
        (SETQ FN FIXEDFNLIST)))
    (COND
      [(LISTP FN)
        (MAPC FN (FUNCTION (LAMBDA (X)
                  (MAPRINT (STATE X)
                           T NIL ".
" NIL NIL T]
      (T (CONS FN (CONS (QUOTE is)
                        (COND
                          [(SETQ FN (GETP FN (QUOTE EXPANDFLAG)))
                            (SELECTQ (EVALV FN)
                                     (T (QUOTE (off)))
                                     (NIL (QUOTE (on)))
                                     (QUOTE (in some wierd state]
                          (T (QUOTE (not fixed])

(STRUCLIST?
  [LAMBDA (X)
    (AND (STRUCFORM? X)
         (EQ (FETCH LISTID OF X)
             (QUOTE LIST])

(GETFILENAM
  [LAMBDA (IO)
    (PROG NIL
      LP  (OR [SELECTQ IO
                       [(I INPUT)
                         (INFILEP (PROGN (PRIN1 "input file? " T)
                                         (READ T]
                       (OUTFILEP (PROGN (PRIN1 "output file? " T)
                                        (READ T]
              (PROGN (PRIN1 "can't access" T)
                     (TERPRI T)
                     (GO LP])

(EXPANDER
  [LAMBDA NIL
    (APPLY (CAR NEWFORM)
           (CDR NEWFORM])

(EXPAND
  [LAMBDA (!EXPANDFLG)
    (PROG ((TEM (##)))
          (COND
            ((STRUCLIST? TEM)
              (GENEXPANSION))
            ((STRUCFORM? TEM)
              (/RPLNODE2 TEM (GENAPPLY TEM (AND !EXPANDFLG 
                                                FIXEDFNLIST)
                                       T)))
            (T (ERROR!])

(WRITERESULTS
  [LAMBDA (EXPRESSION)
    (OR [AND (STRUCFORM? EXPRESSION)
             (CAR (NLSETQ (PROG (FIL RSLT)
                                (SETQ FIL (GETFILENAM (QUOTE OUTPUT)))
                                (OUTPUT (OUTFILE FIL))
                                (PRINT EXPRESSION FIL)
                                (SETQ RSLT (CLOSEF FIL))
                                (/RPLNODE2 EXPRESSION
                                           (LIST (QUOTE STRUCFORM)
                                                 (QUOTE READFILE)
                                                 FIL))
                                (RETURN RSLT]
        (QUOTE can't])
)
(RECORD STRUCLIST (SFID LISTID . LISTITEMS) DEFAULT SFID← (QUOTE
STRUCFORM) LISTID← (QUOTE LIST))
(RECORD FORM (FORMID FN . ARGS) DEFAULT FORMID← (QUOTE STRUCFORM))
  (RPAQ FIXEDFNLIST)
  [ADDTOVAR
    USERMACROS
    (#9 NIL (# 9))
    (#8 NIL (# 8))
    (#7 NIL (# 7))
    (#6 NIL (# 6))
    (#5 NIL (# 5))
    (#4 NIL (# 4))
    (#3 NIL (# 3))
    (#2 NIL (# 2))
    (#1 NIL (# 1))
    (!!EXPAND NIL (LCL (LPQ ↑ FORMNOFORM !EXPAND)))
    [!EXPAND NIL (ORR ((E (EXPAND T)
                          T))
                      ((E (QUOTE can't]
    [# (X)
       (IF (NUMBERP (QUOTE X))
           [(IF (STRUCLIST? (##))
                ((COMS (IPLUS X 2)))
                ((LCL (I F (QUOTE ((*ANY* STRUCTURE STRUCFORM)
                                   --))
                         (ADD1 X]
           (E (QUOTE ?]
    (D NIL (LCL NEXTFORM))
    (DO NIL UP MARK 1 (LCL !!EXPAND)
        ←← 1 (IF [AND (NOT (STRUCLIST? (##))
                           (STRUCFORM? (##]
                 (!EXPAND)
                 (NIL))
        @)
    (EXPAND X MARK (LC . X)
            EXPAND ←←)
    [EXPAND NIL (ORR ((E (EXPAND)
                         T))
                     ((E (QUOTE can't]
    (FF NIL FORMNOFORM)
    (FN (X)
        F
        (STRUCFORM X --))
    [FORMNOFORM NIL (LC STRUCFORM (IF (NOFORMIN (CDR (##]
    [GROUP (X Y)
           (IF (STRUCLIST? (##))
               ((COMS (SUBPAIR (QUOTE (Z W))
                               (LIST (IPLUS X 2)
                                     (IPLUS Y 2))
                               (QUOTE (EMBED (Z THRU W)
                                             IN STRUCFORM LIST]
    [ISFORM NIL (IF (STRUCFORM (##]
    (NEXFORM NIL (ORR (ISFORM)
                      (NEXTFORM)))
    (NEXTFORM NIL (ORR (F (STRUCFORM --))
                       (UPFORM)))
    (Q NIL (MBD QUOTE))
    (U NIL UPFORM)
    (UPFORM NIL 0 (← STRUCFORM))
    [W NIL (E (WRITERESULTS (##]
    (WW NIL MARK (LPQ UPFORM)
        (IF (STRUCLIST? (##))
            (W)
            ((MBD STRUCFORM LIST)
             W))
        ←←)
    (COMMANDS NIL (E (MAPCAR USERMACROS (FUNCTION CAR]
  (ADDTOVAR EDITCOMSA COMMANDS WW W UPFORM U Q NEXTFORM NEXFORM 
            ISFORM FORMNOFORM FF EXPAND DO D !EXPAND !!EXPAND #1 #2 
            #3 #4 #5 #6 #7 #8 #9)
  (ADDTOVAR EDITCOMSL GROUP FN EXPAND #)
(DEFLIST(QUOTE(
  (MOLECULES LSTRUC)
  (RINGS LSTRUC)
  (NOFVRINGS LSTRUC)
  (CATALOG LSTRUC)
  (ATTACHFVS LSTRUC)
  (ATTACHBIVALENTS LSTRUC)
  (ATTACHBIVS&LOOPS LSTRUC)
  (STRUCTURESWITHATOMS LSTRUC)
  (PERMRADS LSTRUC)
  (GENMOL LSTRUC)
))(QUOTE VALTYPE))

STOP