MULTI-ALIST updated to clarify macro names, carrying along because other files got contaminated while waiting

library/MULTI-ALIST

@@ -1,39 +1,40 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "15-Aug-2025 23:02:22" {WMEDLEY}<library>MULTI-ALIST.;23
 15006  
+
(FILECREATED "25-Sep-2025 18:41:59" {WMEDLEY}<library>MULTI-ALIST.;30
 15648  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS MULTI-ALISTCOMS)
+      :CHANGES-TO (FNS EXTENDMULTI-PAIR FETCHMULTI-PAIR)
                   (MACROS FETCHMULTI)
 
-      :PREVIOUS-DATE "15-Aug-2025 08:31:28" {WMEDLEY}<library>MULTI-ALIST.;22)
+      :PREVIOUS-DATE "25-Sep-2025 11:35:45" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>MULTI-ALIST.;28)
 
 
 (PRETTYCOMPRINT MULTI-ALISTCOMS)
 
 (RPAQQ MULTI-ALISTCOMS

-       ((MACROS PUSHMULTI PUTMULTI PUSHMULTI-NEW FPUSHMULTI FPUTMULTI FPUSHMULTI-NEW STOREMULTI)
-        (MACROS GETMULTI GETMULTI-PAIR FGETMULTI FGETMULTI-PAIR FETCHMULTI)
+       ((MACROS PUTMULTI PUSHMULTI PUSHMULTI-NEW SPUTMULTI SPUSHMULTI SPUSHMULTI-NEW STOREMULTI)
+        (MACROS GETMULTI GETMULTI-PAIR SGETMULTI SGETMULTI-PAIR FETCHMULTI)
         (MACROS REMOVEMULTI REMOVEMULTI-ALL)
         (FNS MAPMULTI MAPMULTI1 COLLECTMULTI FETCHMULTI-PAIR EXTENDMULTI-PAIR)
         (FNS GETMULTI-PAIR.EXPAND PUTMULTI.EXPAND)
-        (PROP ARGNAMES PUSHMULTI PUTMULTI PUSHMULTI-NEW REMOVEMULTI FPUSHMULTI FPUTMULTI 
-              FPUSHMULTI-NEW STOREMULTI)
+        (PROP ARGNAMES PUTMULTI PUSHMULTI PUSHMULTI-NEW SPUTMULTI SPUSHMULTI SPUSHMULTI-NEW GETMULTI
+              GETMULTI-PAIR SGETMULTI SGETMULTI-PAIR STOREMULTI REMOVEMULTI)
         (LOCALVARS . T)))
 (DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS PUSHMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'SASSOC 'PUSH)))
+(PUTPROPS PUTMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'ASSOC 'PUT)))
 
-(PUTPROPS PUTMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'SASSOC 'PUT)))
+(PUTPROPS PUSHMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'ASSOC 'PUSH)))
 
-(PUTPROPS PUSHMULTI-NEW
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'SASSOC 'PUSHNEW)))
+(PUTPROPS PUSHMULTI-NEW
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'ASSOC 'PUSHNEW)))
 
-(PUTPROPS FPUSHMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'ASSOC 'PUSH)))
+(PUTPROPS SPUTMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'SASSOC 'PUT)))
 
-(PUTPROPS FPUTMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'ASSOC 'PUT)))
+(PUTPROPS SPUSHMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'SASSOC 'PUSH)))
 
-(PUTPROPS FPUSHMULTI-NEW
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'ASSOC 'PUSHNEW)))
+(PUTPROPS SPUSHMULTI-NEW
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'SASSOC 'PUSHNEW)))
 
 (PUTPROPS STOREMULTI
 MACRO

           [ARGS (LET ((PLACE (CAR ARGS))
@@ -57,27 +58,27 @@
 (PUTPROPS GETMULTI
 MACRO
 ((MULTIALIST . KEYS)
                           (CDR (GETMULTI-PAIR MULTIALIST . KEYS))))
 
-(PUTPROPS GETMULTI-PAIR
 MACRO
 (ARGS (GETMULTI-PAIR.EXPAND
 'SASSOC (CAR ARGS)
+(PUTPROPS GETMULTI-PAIR
 MACRO
 (ARGS (GETMULTI-PAIR.EXPAND
 'ASSOC (CAR ARGS)
                                            (CDR ARGS))))
 
-(PUTPROPS FGETMULTI
 MACRO
 ((MULTIALIST . KEYS)
-                           (CDR (FGETMULTI-PAIR MULTIALIST . KEYS))))
+(PUTPROPS SGETMULTI
 MACRO
 ((MULTIALIST . KEYS)
+                           (CDR (GETMULTI-PAIR MULTIALIST . KEYS))))
 
-(PUTPROPS FGETMULTI-PAIR
 MACRO
 (ARGS (GETMULTI-PAIR.EXPAND
 'ASSOC (CAR ARGS)
+(PUTPROPS SGETMULTI-PAIR
 MACRO
 (ARGS (GETMULTI-PAIR.EXPAND
 'SASSOC (CAR ARGS)
                                             (CDR ARGS))))
 
-(PUTPROPS FETCHMULTI
 MACRO
 ((MULTIALIST KEYS FAST)
-                            (CDR (FETCHMULTI-PAIR
 MULTIALIST KEYS FAST))))
+(PUTPROPS FETCHMULTI
 MACRO
 ((MULTIALIST KEYS SASSOC)
+                            (CDR (FETCHMULTI-PAIR
 MULTIALIST KEYS SASSOC))))
 )
 (DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS REMOVEMULTI
 MACRO
 [ARGS `(CHANGE
 [GETMULTI ,@(for
 ATAIL on
 ARGS while
 (CDR ATAIL)
-                                                          collect
 (CAR ATAIL]
+(PUTPROPS REMOVEMULTI
 MACRO
 [ARGS `(CHANGE
 [SGETMULTI ,@(for
 ATAIL on
 ARGS while
 (CDR ATAIL)
+                                                           collect
 (CAR ATAIL]
                                           (REMOVE ,(CAR (LAST ARGS))
                                                  DATUM])
 
 (PUTPROPS REMOVEMULTI-ALL
 MACRO
 ((MULTIALIST . KEYS)
-                                 (RPLACD (GETMULTI-PAIR MULTIALIST . KEYS)
+                                 (RPLACD (SGETMULTI-PAIR MULTIALIST . KEYS)
                                         NIL)))
 )
 (DEFINEQ
@@ -124,26 +125,28 @@
          $$COLLECT])
 
 (FETCHMULTI-PAIR

-  [LAMBDA (MULTIALIST KEYS FAST)
                             (* ; "Edited 15-Aug-2025 08:08 by rmk")


+  [LAMBDA (MULTIALIST KEYS SASSOC)
                           (* ; "Edited 25-Sep-2025 17:06 by rmk")


+                                                             (* ; "Edited 15-Aug-2025 08:08 by rmk")


                                                              (* ; "Edited 13-Aug-2025 13:30 by rmk")

 
     (* ;; "Parallel to GETMULTI-PAIR but with the keys in a computed list. ")

 
     (CL:UNLESS (LISTP KEYS)
         (ERROR (ERROR "FETCHMULTI-PAIR requires at least 1 key" KEYS)))
-    (for
 KTAIL (LASTPAIR _ (CL:IF FAST
-                               (ASSOC (CAR KEYS)
-                                      MULTIALIST)
+    (for
 KTAIL (LASTPAIR _ (CL:IF SASSOC
                                (SASSOC (CAR KEYS)
+                                      MULTIALIST)
+                               (ASSOC (CAR KEYS)
                                       MULTIALIST))) on
 (CDR KEYS)
-       do
 (SETQ LASTPAIR (CL:IF FAST
-                             (ASSOC (CAR KTAIL)
-                                    LASTPAIR)
+       do
 (SETQ LASTPAIR (CL:IF SASSOC
                              (SASSOC (CAR KTAIL)
+                                    LASTPAIR)
+                             (ASSOC (CAR KTAIL)
                                     LASTPAIR))) finally
 (RETURN LASTPAIR])
 
 (EXTENDMULTI-PAIR

-  [LAMBDA (MULTIALIST KEYS VAL OPTIONS)
                      (* ; "Edited 15-Aug-2025 08:08 by rmk")


+  [LAMBDA (MULTIALIST KEYS VAL OPTIONS)
                      (* ; "Edited 25-Sep-2025 18:37 by rmk")


+                                                             (* ; "Edited 15-Aug-2025 08:08 by rmk")


                                                              (* ; "Edited 13-Aug-2025 14:39 by rmk")


                                                              (* ; "Edited 22-Jan-2025 23:47 by rmk")


                                                             (* ; "Edited 17-Aug-2020 15:05 by rmk:")

@@ -156,19 +159,20 @@
            (ERROR MULTIALIST "is not a MULTI-ALIST"))
     (CL:UNLESS (LISTP KEYS)
            (ERROR "EXTENDMULTI-PAIR requires at least 1 key" KEYS))
-    (for
 K LASTPAIR (FAST _ (EQMEMB 'FAST OPTIONS)) in
 (CDR KEYS)
-       first
 [SETQ LASTPAIR (OR (CL:IF FAST
-                                    (ASSOC (CAR KEYS)
-                                           MULTIALIST)
+    (for
 K LASTPAIR (SASSOC _ (OR (EQ OPTIONS T)
+                                  (EQMEMB 'SASSOC OPTIONS))) in
 (CDR KEYS)
+       first
 [SETQ LASTPAIR (OR (CL:IF SASSOC
                                     (SASSOC (CAR KEYS)
+                                           MULTIALIST)
+                                    (ASSOC (CAR KEYS)
                                            MULTIALIST))
                                 (CAR (ATTACH (CONS (CAR KEYS))
                                             MULTIALIST] 
 
              (* ;; "We have insured a pair headed by (CAR KEYS) at the top level of MULTIALIST.")

- do
 [SETQ LASTPAIR (OR (CL:IF FAST
-                           (ASSOC K (CDR LASTPAIR))
-                           (SASSOC K (CDR LASTPAIR)))
+ do
 [SETQ LASTPAIR (OR (CL:IF SASSOC
+                           (SASSOC K (CDR LASTPAIR))
+                           (ASSOC K (CDR LASTPAIR)))
                        (CAR (PUSH
 (CDR LASTPAIR)
                                   (CONS K] finally
 (CL:UNLESS (LISTP LASTPAIR)
                                                        (ERROR "INVALID MULTI-ALIST" (LIST LASTPAIR 
@@ -185,7 +189,8 @@
 (DEFINEQ
 
 (GETMULTI-PAIR.EXPAND

-  [LAMBDA (ASSOCFN PLACE KEYS)
                               (* ; "Edited 11-Aug-2025 09:56 by rmk")


+  [LAMBDA (ASSOCFN PLACE KEYS)
                               (* ; "Edited 21-Sep-2025 10:31 by rmk")


+                                                             (* ; "Edited 11-Aug-2025 09:56 by rmk")


                                                              (* ; "Edited  8-Aug-2025 12:55 by rmk")


                                                              (* ; "Edited 14-Jun-2025 09:47 by rmk")


                                                              (* ; "Edited 16-Jan-2025 10:27 by rmk")


@@ -193,18 +198,14 @@
                                                             (* ; "Edited 22-Mar-2020 13:21 by rmk:")


                                                             (* ; "Edited 27-Feb-2020 13:44 by rmk:")

 
-    (* ;; 
-
    "This returns the last (key . rest) cell (like ASSOC), NIL if no keys and place is not a list")

+    (* ;; "This returns the last (key . rest) cell (like ASSOC), error here if no keys, runtime error if place is not a list")

 
-    (if
 KEYS
-        then
 `[LET (($$PAIR$$ ,PLACE))
-                   (DECLARE
 (LOCALVARS $$PAIR$$))
-                   ,@(for
 KTAIL on
 KEYS
-                        collect
 (if
 (CDR KTAIL)
-                                    then
 `(SETQ $$PAIR$$ (CDR (,ASSOCFN ,(CAR KTAIL)
-                                                                     $$PAIR$$)))
-                                  else
 `(,ASSOCFN ,(CAR KTAIL)
-                                               $$PAIR$$]
+    (if
 (LISTP KEYS)
+        then
 (for
 KTAIL (FORM _ PLACE) on
 KEYS do
 [SETQ FORM `(,ASSOCFN ,(CAR KTAIL)
+                                                                     ,FORM]
+                                                  (CL:WHEN (CDR KTAIL)
+                                                      [SETQ FORM `(CDR ,FORM])
+                finally
 (RETURN FORM))
       else
 (ERROR "GETMULTI requires at least 1 key" (CONS PLACE KEYS])
 
 (PUTMULTI.EXPAND

@@ -253,27 +254,35 @@
       else
 (ERROR "PUTMULTI requires at least 1 key" ARGS])
 )
 
-(PUTPROPS PUSHMULTI
 ARGNAMES
 (PLACE KEY1...KEYN VAL))
-
 (PUTPROPS PUTMULTI
 ARGNAMES
 (PLACE KEY1...KEYN VAL))
 
+(PUTPROPS PUSHMULTI
 ARGNAMES
 (PLACE KEY1...KEYN VAL))
+
 (PUTPROPS PUSHMULTI-NEW
 ARGNAMES
 (PLACE KEY1...KEYN VAL))
 
-(PUTPROPS REMOVEMULTI
 ARGNAMES
 (MULTIALIST KEY1...KEYN VAL))
+(PUTPROPS SPUTMULTI
 ARGNAMES
 (PLACE KEY1...KEYN VAL))
 
-(PUTPROPS FPUSHMULTI
 ARGNAMES
 (PLACE KEY1...KEYN VAL))
+(PUTPROPS SPUSHMULTI
 ARGNAMES
 (PLACE KEY1...KEYN VAL))
 
-(PUTPROPS FPUTMULTI
 ARGNAMES
 (PLACE KEY1...KEYN VAL))
+(PUTPROPS SPUSHMULTI-NEW
 ARGNAMES
 (PLACE KEY1...KEYN VAL))
 
-(PUTPROPS FPUSHMULTI-NEW
 ARGNAMES
 (PLACE KEY1...KEYN VAL))
+(PUTPROPS GETMULTI
 ARGNAMES
 (PLACE KEY1...KEYN))
+
+(PUTPROPS GETMULTI-PAIR
 ARGNAMES
 (PLACE KEY1...KEYN))
+
+(PUTPROPS SGETMULTI
 ARGNAMES
 (PLACE KEY1...KEYN))
+
+(PUTPROPS SGETMULTI-PAIR
 ARGNAMES
 (PLACE KEY1...KEYN))
 
 (PUTPROPS STOREMULTI
 ARGNAMES
 (PLACE KEYS VAL OPTIONS))
+
+(PUTPROPS REMOVEMULTI
 ARGNAMES
 (MULTIALIST KEY1...KEYN VAL))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (LOCALVARS . T)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3610 10036 (MAPMULTI 3620 . 4766) (MAPMULTI1 4768 . 5825) (COLLECTMULTI 5827 . 6298) (
-FETCHMULTI-PAIR 6300 . 7247) (EXTENDMULTI-PAIR 7249 . 10034)) (10037 14407 (GETMULTI-PAIR.EXPAND 10047
- . 11544) (PUTMULTI.EXPAND 11546 . 14405)))))
+  (FILEMAP (NIL (3720 10430 (MAPMULTI 3730 . 4876) (MAPMULTI1 4878 . 5935) (COLLECTMULTI 5937 . 6408) (
+FETCHMULTI-PAIR 6410 . 7470) (EXTENDMULTI-PAIR 7472 . 10428)) (10431 14805 (GETMULTI-PAIR.EXPAND 10441
+ . 11942) (PUTMULTI.EXPAND 11944 . 14803)))))
 STOP