JSON-GET indexes arrays with integer attributes (#2140)

Author: rmkaplan

lispusers/JSON

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "13-May-2024 22:37:13" {WMEDLEY}<lispusers>JSON.;36
 9198   
+
(FILECREATED " 7-May-2025 13:57:04" {WMEDLEY}<lispusers>JSON.;38
 9891   
 
       :EDIT-BY rmk
 
       :CHANGES-TO (FNS JSON-GET)
 
-      :PREVIOUS-DATE "13-May-2024 19:23:02" {WMEDLEY}<lispusers>JSON.;33)
+      :PREVIOUS-DATE "13-May-2024 22:37:13" {WMEDLEY}<lispusers>JSON.;36)
 
 
 (PRETTYCOMPRINT JSONCOMS)
@@ -177,14 +177,24 @@
          NIL])
 
 (JSON-GET

-  [LAMBDA (OBJECT ATTRIBUTES)
                                (* ; "Edited 13-May-2024 22:35 by rmk")


+  [LAMBDA (OBJECT ATTRIBUTES)
                                (* ; "Edited  7-May-2025 13:56 by rmk")


+                                                             (* ; "Edited 13-May-2024 22:35 by rmk")


                                                              (* ; "Edited 30-Apr-2024 14:26 by rmk")

 
     (* ;; "Returns the value at the end of a chain of ATTRIBUTES in OBJECT")

 
-    (for
 A (OBJ _ OBJECT) inside
 ATTRIBUTES do
 (if
 (EQ 'OBJECT (CAR (LISTP OBJ)))
-                                                   then
 [SETQ OBJ (CADR (ASSOC A (CDR OBJ]
-                                                 else
 (RETURN NIL)) finally
 (RETURN OBJ])
+    (for
 A (OBJ _ OBJECT) inside
 ATTRIBUTES do
 (SELECTQ (CAR (LISTP OBJ))
+                                                   (OBJECT [SETQ OBJ (CADR (ASSOC A (CDR OBJ])
+                                                   (ARRAY (CL:UNLESS (AND (FIXP A)
+                                                                          (IGEQ A 0))
+                                                                 (ERROR A 
+                                                                        " cannot index a JSON array")
+                                                                 )
+
+                                                          (* ;; "ADD1 because zero-origin")

+
+                                                          [SETQ OBJ (CAR (NTH OBJ (ADD1 A])
+                                                   (RETURN NIL)) finally
 (RETURN OBJ])
 )
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (DECLARE%: EVAL@COMPILE 
@@ -201,7 +211,7 @@
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (559 8839 (JSON-PARSE 569 . 915) (JSON-VALUE 917 . 1286) (JSON-SKIP 1288 . 1562) (
+  (FILEMAP (NIL (559 9532 (JSON-PARSE 569 . 915) (JSON-VALUE 917 . 1286) (JSON-SKIP 1288 . 1562) (
 JSON-STRING 1564 . 2362) (JSON-ARRAY 2364 . 3502) (JSON-OBJECT 3504 . 4961) (JSON-AVPAIR 4963 . 5405) 
-(JSON-NUMBER 5407 . 6921) (JSON-ATOM 6923 . 8230) (JSON-GET 8232 . 8837)))))
+(JSON-NUMBER 5407 . 6921) (JSON-ATOM 6923 . 8230) (JSON-GET 8232 . 9530)))))
 STOP