coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Allow sx_insert_child to insert multiple children at once

Browse Source 
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) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-26 08:28:07 +00:00
parent 2bfae33659
commit 11f0098006
1 changed files with 3 additions and 55 deletions
Download Patch File Download Diff File Expand all files Collapse all files

58
lib/tree-tools.sx
View File

@@ -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))))))))