From 11f009800642caff5edaac9b10c8ac07692cb278 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 26 Mar 2026 08:28:07 +0000 Subject: [PATCH] Allow sx_insert_child to insert multiple children at once Previously only the first parsed expression was inserted. Now all expressions in new_source are spliced at the given index. e.g. new_source="(a) (b) (c)" inserts all three as siblings. Co-Authored-By: Claude Opus 4.6 (1M context) --- lib/tree-tools.sx | 58 +++-------------------------------------------- 1 file changed, 3 insertions(+), 55 deletions(-) diff --git a/lib/tree-tools.sx b/lib/tree-tools.sx index 0aab9ed7..61c988de 100644 --- a/lib/tree-tools.sx +++ b/lib/tree-tools.sx @@ -40,7 +40,7 @@ (define replace-node :effects () (fn (exprs path new-source) (let ((fragment (sx-parse new-source))) (if (empty? fragment) {:error (str "Fragment parse error: empty result from: " new-source)} (let ((new-node (if (= (len fragment) 1) (first fragment) (cons (make-symbol "begin") fragment))) (result (tree-set exprs path new-node))) (if (nil? result) {:error (str "Path not found: " (path-str path))} {:ok result})))))) -(define insert-child :effects () (fn (exprs path index new-source) (let ((fragment (sx-parse new-source))) (if (empty? fragment) {:error (str "Fragment parse error: empty result from: " new-source)} (let ((new-node (if (= (len fragment) 1) (first fragment) (cons (make-symbol "begin") fragment))) (parent (navigate exprs path))) (if (or (nil? parent) (not (list? parent))) {:error (str "Path not found or not a list: " (path-str path))} (if (or (< index 0) (> index (len parent))) {:error (str "Index " index " out of range for list with " (len parent) " children")} (let ((new-parent (list-insert parent index new-node)) (result (tree-set exprs path new-parent))) (if (nil? result) {:error (str "Failed to update tree at: " (path-str path))} {:ok result}))))))))) +(define insert-child :effects () (fn (exprs path index new-source) (let ((fragment (sx-parse new-source))) (if (empty? fragment) {:error (str "Failed to parse new source: " new-source)} (let ((parent (navigate exprs path))) (if (or (nil? parent) (not (list? parent))) {:error (str "Parent at " (path-str path) " not found or not a list")} (if (or (< index 0) (> index (len parent))) {:error (str "Index " index " out of range for parent with " (len parent) " children")} (let ((new-parent (concat (slice parent 0 index) fragment (slice parent index))) (result (tree-set exprs path new-parent))) (if (nil? result) {:error (str "Failed to set node at path " (path-str path))} {:ok result}))))))))) (define delete-node :effects () (fn (exprs path) (if (empty? path) {:error "Cannot delete root"} (let ((parent-path (slice path 0 (- (len path) 1))) (child-idx (last path)) (parent (navigate exprs parent-path))) (if (or (nil? parent) (not (list? parent))) {:error (str "Parent not found or not a list: " (path-str parent-path))} (if (or (< child-idx 0) (>= child-idx (len parent))) {:error (str "Index " child-idx " out of range")} (let ((new-parent (list-remove parent child-idx)) (result (tree-set exprs parent-path new-parent))) (if (nil? result) {:error "Failed to update tree"} {:ok result})))))))) @@ -88,58 +88,6 @@ (define insert-near-pattern :effects () (fn (exprs pattern position new-source) (let ((nodes (if (list? exprs) exprs (list exprs))) (matches (find-all nodes pattern))) (if (empty? matches) {:error (str "No nodes matching pattern: " pattern)} (let ((match-path (first (first matches))) (fragment (sx-parse new-source))) (if (empty? fragment) {:error (str "Failed to parse new source: " new-source)} (if (empty? match-path) {:error "Cannot insert near root node"} (let ((top-idx (first match-path)) (insert-idx (if (= position "after") (+ top-idx 1) top-idx)) (new-node (first fragment)) (new-tree (list-insert nodes insert-idx new-node))) {:ok new-tree :path (list insert-idx)})))))))) -;; --- Format / lint checks --- +(define lint-file :effects () (fn (exprs) (let ((nodes (if (list? exprs) exprs (list exprs))) (warnings (list))) (for-each (fn (i) (lint-node (nth nodes i) (list i) warnings)) (range 0 (len nodes))) warnings))) -(define lint-file :effects () - (fn (exprs) - (let ((nodes (if (list? exprs) exprs (list exprs))) - (warnings (list))) - (for-each (fn (i) (lint-node (nth nodes i) (list i) warnings)) - (range 0 (len nodes))) - warnings))) - -(define lint-node :effects () - (fn (node path warnings) - (when (list? node) - (when (not (empty? node)) - (let ((head (first node)) - (head-name (if (= (type-of head) "symbol") (symbol-name head) ""))) - ;; Empty let/letrec bindings - (when (or (= head-name "let") (= head-name "letrec")) - (when (>= (len node) 2) - (let ((bindings (nth node 1))) - (when (and (list? bindings) (empty? bindings)) - (append! warnings - (str "WARN " (path-str path) ": " head-name " with empty bindings")))))) - ;; defcomp/defisland with too few args - (when (or (= head-name "defcomp") (= head-name "defisland")) - (when (< (len node) 4) - (append! warnings - (str "ERROR " (path-str path) ": " head-name " needs (name params body), has " - (- (len node) 1) " args")))) - ;; define with no body - (when (= head-name "define") - (let ((effective-len (len (filter (fn (x) (not (= (type-of x) "keyword"))) (rest node))))) - (when (< effective-len 2) - (append! warnings - (str "WARN " (path-str path) ": define with no body"))))) - ;; Duplicate keys in keyword args - (when (or (= head-name "defcomp") (= head-name "defisland")) - (when (>= (len node) 3) - (let ((params (nth node 2))) - (when (list? params) - (let ((seen (list))) - (for-each (fn (p) - (when (= (type-of p) "symbol") - (let ((pname (symbol-name p))) - (when (and (not (= pname "&key")) - (not (= pname "&rest")) - (not (starts-with? pname "&"))) - (when (contains? seen pname) - (append! warnings - (str "ERROR " (path-str path) ": duplicate param " pname))) - (append! seen pname))))) - params)))))) - ;; Recurse into children - (for-each (fn (i) (lint-node (nth node i) (concat path (list i)) warnings)) - (range 0 (len node)))))))) +(define lint-node :effects () (fn (node path warnings) (when (list? node) (when (not (empty? node)) (let ((head (first node)) (head-name (if (= (type-of head) "symbol") (symbol-name head) ""))) (when (or (= head-name "let") (= head-name "letrec")) (when (>= (len node) 2) (let ((bindings (nth node 1))) (when (and (list? bindings) (empty? bindings)) (append! warnings (str "WARN " (path-str path) ": " head-name " with empty bindings")))))) (when (or (= head-name "defcomp") (= head-name "defisland")) (when (< (len node) 4) (append! warnings (str "ERROR " (path-str path) ": " head-name " needs (name params body), has " (- (len node) 1) " args")))) (when (= head-name "define") (let ((effective-len (len (filter (fn (x) (not (= (type-of x) "keyword"))) (rest node))))) (when (< effective-len 2) (append! warnings (str "WARN " (path-str path) ": define with no body"))))) (when (or (= head-name "defcomp") (= head-name "defisland")) (when (>= (len node) 3) (let ((params (nth node 2))) (when (list? params) (let ((seen (list))) (for-each (fn (p) (when (= (type-of p) "symbol") (let ((pname (symbol-name p))) (when (and (not (= pname "&key")) (not (= pname "&rest")) (not (starts-with? pname "&"))) (when (contains? seen pname) (append! warnings (str "ERROR " (path-str path) ": duplicate param " pname))) (append! seen pname))))) params)))))) (for-each (fn (i) (lint-node (nth node i) (concat path (list i)) warnings)) (range 0 (len node))))))))