(define path-str :effects () (fn ((path :as list)) (str "[" (join "," (map str path)) "]")))

(define annotate-tree :effects () (fn (exprs) (let ((nodes (if (list? exprs) exprs (list exprs)))) (let ((result (list))) (for-each (fn (i) (annotate-node (nth nodes i) (list i) 0 result)) (range 0 (len nodes))) (join "\n" result)))))

(define annotate-node :effects () (fn (node path depth result) (let ((indent (join "" (map (fn (_) "  ") (range 0 depth)))) (label (path-str path))) (if (list? node) (if (empty? node) (append! result (str indent label " ()")) (let ((head (first node)) (head-str (node-display head))) (if (and (<= (len node) 4) (not (some (fn (c) (list? c)) (rest node)))) (append! result (str indent label " (" (join " " (map node-display node)) ")")) (do (append! result (str indent label " (" head-str)) (for-each (fn (i) (annotate-node (nth node i) (concat path (list i)) (+ depth 1) result)) (range 1 (len node))) (append! result (str indent "  )")))))) (append! result (str indent label " " (node-display node)))))))

(define node-display :effects () (fn (node) (cond (nil? node) "nil" (= (type-of node) "symbol") (symbol-name node) (= (type-of node) "keyword") (str ":" (keyword-name node)) (= (type-of node) "string") (let ((s (if (> (len node) 40) (str (slice node 0 37) "...") node))) (str "\"" s "\"")) (= (type-of node) "number") (str node) (= (type-of node) "boolean") (if node "true" "false") (list? node) (if (empty? node) "()" (str "(" (node-display (first node)) (if (> (len node) 1) " ..." "") ")")) (= (type-of node) "dict") "{...}" :else (str node))))

(define summarise :effects () (fn (exprs max-depth) (let ((nodes (if (list? exprs) exprs (list exprs))) (result (list))) (for-each (fn (i) (summarise-node (nth nodes i) (list i) 0 max-depth result)) (range 0 (len nodes))) (join "\n" result))))

(define summarise-node :effects () (fn (node path depth max-depth result) (let ((indent (join "" (map (fn (_) "  ") (range 0 depth)))) (label (path-str path))) (if (list? node) (if (empty? node) (append! result (str indent label " ()")) (let ((head (first node)) (head-str (node-display head))) (if (>= depth max-depth) (append! result (str indent label " (" head-str (if (> (len node) 1) (str " ... " (- (len node) 1) " children") "") ")")) (do (append! result (str indent label " (" head-str)) (for-each (fn (i) (summarise-node (nth node i) (concat path (list i)) (+ depth 1) max-depth result)) (range 1 (len node))) (append! result (str indent "  )")))))) (append! result (str indent label " " (node-display node)))))))

(define read-subtree :effects () (fn (exprs path) (let ((node (navigate exprs path))) (if (nil? node) (str "Error: path " (path-str path) " not found") (annotate-tree (list node))))))

(define get-context :effects () (fn (exprs path) (let ((result (list)) (nodes (if (list? exprs) exprs (list exprs)))) (for-each (fn (depth) (let ((prefix (slice path 0 (+ depth 1))) (node (navigate nodes prefix))) (when (not (nil? node)) (let ((label (path-str prefix)) (indent (join "" (map (fn (_) "  ") (range 0 depth)))) (marker (if (= (+ depth 1) (len path)) "→ " "  "))) (if (list? node) (append! result (str indent marker label " " (node-summary node))) (append! result (str indent marker label " " (node-display node)))))))) (range 0 (len path))) (join "\n" result))))

(define node-summary :effects () (fn (node) (if (or (not (list? node)) (empty? node)) (node-display node) (let ((head (node-display (first node))) (child-count (- (len node) 1))) (if (<= child-count 3) (str "(" (join " " (map node-display node)) ")") (str "(" head " " (node-display (nth node 1)) (when (> child-count 1) (str " ... +" (- child-count 1))) ")"))))))

(define find-all :effects () (fn (exprs pattern) (let ((results (list)) (nodes (if (list? exprs) exprs (list exprs)))) (for-each (fn (i) (find-in-node (nth nodes i) (list i) pattern results)) (range 0 (len nodes))) results)))

(define find-in-node :effects () (fn (node path pattern results) (when (node-matches? node pattern) (append! results (list path (node-summary-short node)))) (when (list? node) (for-each (fn (i) (find-in-node (nth node i) (concat path (list i)) pattern results)) (range 0 (len node))))))

(define node-matches? :effects () (fn (node pattern) (cond (= (type-of node) "symbol") (contains? (symbol-name node) pattern) (string? node) (contains? node pattern) (and (list? node) (not (empty? node)) (= (type-of (first node)) "symbol")) (contains? (symbol-name (first node)) pattern) :else false)))

(define node-summary-short :effects () (fn (node) (if (list? node) (if (empty? node) "()" (let ((head (node-display (first node)))) (if (> (len node) 3) (str "(" head " " (node-display (nth node 1)) " ...)") (str "(" (join " " (map node-display node)) ")")))) (node-display node))))

(define get-siblings :effects () (fn (exprs path) (if (empty? path) "Error: root has no siblings" (let ((parent-path (slice path 0 (- (len path) 1))) (target-idx (last path)) (parent (navigate exprs parent-path))) (if (or (nil? parent) (not (list? parent))) (str "Error: parent at " (path-str parent-path) " not found or not a list") (let ((result (list))) (for-each (fn (i) (let ((child (nth parent i)) (child-path (concat parent-path (list i))) (marker (if (= i target-idx) "→ " "  "))) (append! result (str marker (path-str child-path) " " (if (list? child) (node-summary child) (node-display child)))))) (range 0 (len parent))) (join "\n" result)))))))

(define validate :effects () (fn (exprs) (let ((errors (list)) (nodes (if (list? exprs) exprs (list exprs)))) (for-each (fn (i) (validate-node (nth nodes i) (list i) errors)) (range 0 (len nodes))) (if (empty? errors) "OK" (join "\n" errors)))))

(define validate-node :effects () (fn (node path errors) (when (list? node) (when (not (empty? node)) (let ((head (first node))) (when (and (= (type-of head) "symbol") (= (symbol-name head) "letrec") (>= (len node) 2)) (let ((bindings (nth node 1))) (when (list? bindings) (for-each (fn (i) (let ((pair (nth bindings i))) (when (not (and (list? pair) (>= (len pair) 2) (= (type-of (first pair)) "symbol"))) (append! errors (str "WARNING " (path-str (concat path (list 1 i))) ": letrec binding " i " is not a (name value) pair: " (node-display pair)))))) (range 0 (len bindings)))))) (when (and (= (type-of head) "symbol") (or (= (symbol-name head) "defisland") (= (symbol-name head) "defcomp"))) (when (< (len node) 4) (append! errors (str "ERROR " (path-str path) ": " (symbol-name head) " has fewer than 3 args (name params body)")))))) (for-each (fn (i) (validate-node (nth node i) (concat path (list i)) errors)) (range 0 (len node))))))

(define navigate :effects () (fn (exprs path) (let ((nodes (if (list? exprs) exprs (list exprs)))) (reduce (fn (current idx) (if (or (nil? current) (not (list? current)) (>= idx (len current))) nil (nth current idx))) nodes path))))

(define resolve-named-path :effects () (fn (exprs named-path) (let ((segments (if (string? named-path) (split-path-string named-path) named-path)) (nodes (if (list? exprs) exprs (list exprs)))) (let ((result (reduce (fn (state segment) (if (nil? (get state "node")) state (let ((node (get state "node")) (path (get state "path"))) (if (not (list? node)) {:node nil :path path} (let ((idx (find-child-by-name node segment))) (if (nil? idx) {:node nil :path path} {:node (nth node idx) :path (concat path (list idx))})))))) {:node nodes :path (list)} segments))) (get result "path")))))

(define split-path-string :effects () (fn ((s :as string)) (filter (fn (x) (not (= (trim x) ""))) (split s ">"))))

(define find-child-by-name :effects () (fn (node name) (let ((trimmed (trim name)) (result nil)) (for-each (fn (i) (when (nil? result) (let ((child (nth node i))) (when (or (and (= (type-of child) "symbol") (= (symbol-name child) trimmed)) (and (list? child) (not (empty? child)) (= (type-of (first child)) "symbol") (= (symbol-name (first child)) trimmed))) (set! result i))))) (range 0 (len node))) result)))

(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 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}))))))))

(define wrap-node :effects () (fn (exprs path wrapper-source) (let ((fragment (sx-parse wrapper-source))) (if (empty? fragment) {:error (str "Wrapper parse error: empty result from: " wrapper-source)} (let ((wrapper (first fragment)) (target (navigate exprs path))) (if (nil? target) {:error (str "Path not found: " (path-str path))} (let ((filled (replace-placeholder wrapper target))) (if (nil? filled) {:error "Wrapper must contain _ as placeholder for the wrapped node"} (let ((result (tree-set exprs path filled))) (if (nil? result) {:error "Failed to update tree"} {:ok result}))))))))))

(define replace-placeholder :effects () (fn (node replacement) (cond (and (= (type-of node) "symbol") (= (symbol-name node) "_")) replacement (list? node) (let ((found false) (result (map (fn (child) (if found child (if (and (= (type-of child) "symbol") (= (symbol-name child) "_")) (do (set! found true) replacement) (if (list? child) (let ((sub (replace-placeholder child replacement))) (if (nil? sub) child (do (set! found true) sub))) child)))) node))) (if found result nil)) :else nil)))

(define tree-set :effects () (fn (exprs path new-node) (let ((nodes (if (list? exprs) exprs (list exprs)))) (if (empty? path) (if (list? new-node) new-node (list new-node)) (tree-set-inner nodes path 0 new-node)))))

(define tree-set-inner :effects () (fn (node path depth new-node) (if (not (list? node)) nil (let ((idx (nth path depth))) (if (or (< idx 0) (>= idx (len node))) nil (if (= depth (- (len path) 1)) (list-replace node idx new-node) (let ((child (nth node idx)) (new-child (tree-set-inner child path (+ depth 1) new-node))) (if (nil? new-child) nil (list-replace node idx new-child)))))))))

(define list-replace :effects () (fn (lst idx val) (map-indexed (fn (i item) (if (= i idx) val item)) lst)))

(define list-insert :effects () (fn (lst idx val) (concat (slice lst 0 idx) (list val) (slice lst idx))))

(define list-remove :effects () (fn (lst idx) (concat (slice lst 0 idx) (slice lst (+ idx 1)))))

(define tree-diff :effects () (fn (exprs-a exprs-b) (let ((nodes-a (if (list? exprs-a) exprs-a (list exprs-a))) (nodes-b (if (list? exprs-b) exprs-b (list exprs-b))) (results (list))) (diff-children nodes-a nodes-b (list) results) (if (empty? results) "No differences" (join "\n" results)))))

(define diff-children :effects () (fn (list-a list-b path results) (let ((len-a (len list-a)) (len-b (len list-b)) (min-len (if (< len-a len-b) len-a len-b))) (for-each (fn (i) (diff-node (nth list-a i) (nth list-b i) (concat path (list i)) results)) (range 0 min-len)) (when (> len-b min-len) (for-each (fn (i) (append! results (str "ADDED " (path-str (concat path (list i))) " " (node-summary-short (nth list-b i))))) (range min-len len-b))) (when (> len-a min-len) (for-each (fn (i) (append! results (str "REMOVED " (path-str (concat path (list i))) " " (node-summary-short (nth list-a i))))) (range min-len len-a))))))

(define diff-node :effects () (fn (a b path results) (cond (and (list? a) (list? b)) (diff-children a b path results) (and (not (list? a)) (not (list? b))) (when (not (= (node-display a) (node-display b))) (append! results (str "CHANGED " (path-str path) " " (node-display a) " → " (node-display b)))) :else (append! results (str "CHANGED " (path-str path) " " (node-summary-short a) " → " (node-summary-short b))))))

(define path-prefix? :effects () (fn (prefix path) (if (> (len prefix) (len path)) false (let ((result true)) (for-each (fn (i) (when (not (= (nth prefix i) (nth path i))) (set! result false))) (range 0 (len prefix))) result))))

(define path-on-match-route? :effects () (fn (path match-paths) (let ((found false)) (for-each (fn (i) (when (not found) (let ((mp (first (nth match-paths i)))) (when (or (path-prefix? path mp) (path-prefix? mp path)) (set! found true))))) (range 0 (len match-paths))) found)))

(define annotate-focused :effects () (fn (exprs pattern) (let ((nodes (if (list? exprs) exprs (list exprs))) (match-paths (find-all nodes pattern)) (result (list))) (for-each (fn (i) (annotate-node-focused (nth nodes i) (list i) 0 match-paths result)) (range 0 (len nodes))) (join "\n" result))))

(define annotate-node-focused :effects () (fn (node path depth match-paths result) (let ((indent (join "" (map (fn (_) "  ") (range 0 depth)))) (label (path-str path))) (if (list? node) (if (empty? node) (append! result (str indent label " ()")) (let ((head (first node)) (head-str (node-display head)) (on-route (path-on-match-route? path match-paths))) (if on-route (do (append! result (str indent label " (" head-str)) (for-each (fn (i) (annotate-node-focused (nth node i) (concat path (list i)) (+ depth 1) match-paths result)) (range 1 (len node))) (append! result (str indent "  )"))) (append! result (str indent label " (" head-str (if (> (len node) 1) (str " ... " (- (len node) 1) " children") "") ")"))))) (append! result (str indent label " " (node-display node)))))))

(define annotate-paginated :effects () (fn (exprs offset limit) (let ((nodes (if (list? exprs) exprs (list exprs))) (all-lines (list))) (for-each (fn (i) (annotate-node (nth nodes i) (list i) 0 all-lines)) (range 0 (len nodes))) (let ((total (len all-lines)) (end (if (> (+ offset limit) total) total (+ offset limit))) (sliced (slice all-lines offset end)) (header (str ";; Lines " offset "-" end " of " total (if (< end total) " (more available)" " (complete)")))) (str header "\n" (join "\n" sliced))))))

(define rename-symbol :effects () (fn (exprs old-name new-name) (let ((nodes (if (list? exprs) exprs (list exprs)))) (map (fn (node) (rename-in-node node old-name new-name)) nodes))))

(define rename-in-node :effects () (fn (node old-name new-name) (cond (and (= (type-of node) "symbol") (= (symbol-name node) old-name)) (make-symbol new-name) (list? node) (map (fn (child) (rename-in-node child old-name new-name)) node) :else node)))

(define count-renames :effects () (fn (exprs old-name) (let ((nodes (if (list? exprs) exprs (list exprs))) (hits (list))) (count-in-node nodes old-name hits) (len hits))))

(define count-in-node :effects () (fn (node old-name hits) (cond (and (= (type-of node) "symbol") (= (symbol-name node) old-name)) (append! hits true) (list? node) (for-each (fn (child) (count-in-node child old-name hits)) node) :else nil)))

(define replace-by-pattern :effects () (fn (exprs pattern 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 ((target-path (first (first matches))) (fragment (sx-parse new-source))) (if (empty? fragment) {:error (str "Failed to parse new source: " new-source)} (let ((new-node (first fragment)) (result (tree-set nodes target-path new-node))) (if (nil? result) {:error (str "Failed to set node at path " (path-str target-path))} {:ok result :path target-path}))))))))

(define replace-all-by-pattern :effects () (fn (exprs pattern new-source) (let ((nodes (if (list? exprs) exprs (list exprs))) (matches (find-all nodes pattern)) (fragment (sx-parse new-source))) (if (empty? matches) {:error (str "No nodes matching pattern: " pattern)} (if (empty? fragment) {:error (str "Failed to parse new source: " new-source)} (let ((new-node (first fragment)) (current nodes) (count 0)) (for-each (fn (i) (let ((idx (- (- (len matches) 1) i)) (match (nth matches idx)) (target-path (first match)) (result (tree-set current target-path new-node))) (when (not (nil? result)) (set! current result) (set! count (+ count 1))))) (range 0 (len matches))) {:count count :ok current}))))))

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