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

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

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

(define
  collect-free-symbols
  :effects ()
  (fn
    (node)
    (let
      ((result (list))
        (seen (dict))
        (special-forms
          (dict
            "if"
            true
            "when"
            true
            "cond"
            true
            "case"
            true
            "and"
            true
            "or"
            true
            "let"
            true
            "let*"
            true
            "letrec"
            true
            "lambda"
            true
            "fn"
            true
            "define"
            true
            "defcomp"
            true
            "defisland"
            true
            "defmacro"
            true
            "deftest"
            true
            "begin"
            true
            "do"
            true
            "quote"
            true
            "quasiquote"
            true
            "set!"
            true
            "->"
            true
            "reset"
            true
            "shift"
            true
            "deref"
            true
            "scope"
            true
            "provide"
            true
            "context"
            true
            "emit!"
            true
            "emitted"
            true
            "dynamic-wind"
            true
            "map"
            true
            "filter"
            true
            "reduce"
            true
            "for-each"
            true
            "some"
            true
            "every?"
            true
            "map-indexed"
            true
            "list"
            true
            "dict"
            true
            "str"
            true
            "cons"
            true
            "concat"
            true)))
      (define
        add-sym
        (fn
          (name)
          (when
            (and
              (not (has-key? seen name))
              (not (has-key? special-forms name))
              (not (starts-with? name ":")))
            (dict-set! seen name true)
            (append! result name))))
      (define
        extract-binding-names
        (fn
          (bindings)
          (let
            ((names (dict)))
            (for-each
              (fn
                (b)
                (when
                  (list? b)
                  (let
                    ((name (first b)))
                    (when
                      (= (type-of name) "symbol")
                      (dict-set! names (symbol-name name) true)))))
              bindings)
            names)))
      (define
        walk
        (fn
          (node bound)
          (cond
            (nil? node)
            nil
            (= (type-of node) "symbol")
            (let
              ((name (symbol-name node)))
              (when (not (has-key? bound name)) (add-sym name)))
            (= (type-of node) "keyword")
            nil
            (not (list? node))
            nil
            (empty? node)
            nil
            :else (let
              ((head (first node)) (args (rest node)))
              (if
                (not (= (type-of head) "symbol"))
                (for-each (fn (child) (walk child bound)) node)
                (let
                  ((hname (symbol-name head)))
                  (cond
                    (or (= hname "define") (= hname "defmacro"))
                    (when
                      (>= (len args) 2)
                      (let
                        ((body-start (if (= (type-of (nth args 1)) "keyword") 3 1)))
                        (for-each
                          (fn (child) (walk child bound))
                          (slice args body-start))))
                    (or
                      (= hname "defcomp")
                      (= hname "defisland")
                      (= hname "deftest"))
                    (when
                      (>= (len args) 2)
                      (let
                        ((params (nth args 1)) (param-names (dict)))
                        (when
                          (list? params)
                          (for-each
                            (fn
                              (p)
                              (when
                                (= (type-of p) "symbol")
                                (dict-set! param-names (symbol-name p) true)))
                            params))
                        (let
                          ((new-bound (merge bound param-names)))
                          (for-each
                            (fn (child) (walk child new-bound))
                            (slice args 2)))))
                    (or (= hname "fn") (= hname "lambda"))
                    (when
                      (>= (len args) 2)
                      (let
                        ((params (first args)) (param-names (dict)))
                        (when
                          (list? params)
                          (for-each
                            (fn
                              (p)
                              (cond
                                (= (type-of p) "symbol")
                                (dict-set! param-names (symbol-name p) true)
                                (list? p)
                                (when
                                  (= (type-of (first p)) "symbol")
                                  (dict-set!
                                    param-names
                                    (symbol-name (first p))
                                    true))))
                            params))
                        (let
                          ((new-bound (merge bound param-names)))
                          (for-each
                            (fn (child) (walk child new-bound))
                            (rest args)))))
                    (or (= hname "let") (= hname "let*") (= hname "letrec"))
                    (when
                      (>= (len args) 2)
                      (let
                        ((bindings (first args))
                          (bind-names
                            (if
                              (list? (first args))
                              (extract-binding-names (first args))
                              (dict))))
                        (let
                          ((new-bound (merge bound bind-names)))
                          (when
                            (list? bindings)
                            (for-each
                              (fn
                                (b)
                                (when
                                  (and (list? b) (>= (len b) 2))
                                  (walk
                                    (nth b 1)
                                    (if (= hname "letrec") new-bound bound))))
                              bindings))
                          (for-each
                            (fn (child) (walk child new-bound))
                            (rest args)))))
                    (= hname "quote")
                    nil
                    (= hname "set!")
                    (when
                      (>= (len args) 2)
                      (when
                        (= (type-of (first args)) "symbol")
                        (let
                          ((name (symbol-name (first args))))
                          (when (not (has-key? bound name)) (add-sym name))))
                      (walk (nth args 1) bound))
                    :else (do
                      (when
                        (not (has-key? special-forms hname))
                        (when (not (has-key? bound hname)) (add-sym hname)))
                      (for-each (fn (child) (walk child bound)) args)))))))))
      (walk node (dict))
      result)))