names-from-defs.janet

(import ../lib/location :as l)
(import ../lib/jipper :as j)

(comment

  (def a-def
    "(def a 1)")

  (def a-def-with-tuple-destructuring
    "(def [x y] [8 9])")

  (def a-var-with-struct-destructuring
    "(var {:i i :j j} {:i 1 :j 0})")

  (def a-var
    "(var b {:a 1 :b 2})")

  (def a-comment
    (string "(comment\n"
            "\n"
            "  (def c 3)\n"
            "\n"
            "  c\n"
            "  # =>\n"
            "  3\n"
            "\n"
            "  )"))

  (def a-defn-
    (string "(defn- f\n"
            "  [x]\n"
            "  (def b 2)\n"
            "  (defn c\n"
            "    [y]\n"
            "    (+ y b))\n"
            "  (c x))"))

  (def a-defmacro-
    (string "(defmacro- median-of-three\n"
            "  [x y z]\n"
            "  ~(if (<= ,x ,y)\n"
            "     (if (<= ,y ,z) ,y (if (<= ,z ,x) ,x ,z))\n"
            "     (if (<= ,z ,y) ,y (if (<= ,x ,z) ,x ,z))))"))

  (def a-main-defn
    (string "(defn main\n"
            "  [& args]\n"
            `  (f 9))`))

  (def src
    (string a-def "\n"
            "\n"
            a-defn- "\n"
            "\n"
            a-def-with-tuple-destructuring "\n"
            "\n"
            a-var-with-struct-destructuring "\n"
            "\n"
            a-comment "\n"
            "\n"
            a-defmacro- "\n"
            "\n"
            a-var "\n"
            "\n"
            a-main-defn))

  (var cur-zloc
    (j/zip-down (l/par src)))

  (def non-call-things
    {"def" 1 "def-" 1
     "var" 1 "var-" 1})

  (def call-things
    {"defn" 1 "defn-" 1
     "defmacro" 1 "defmacro-" 1
     "varfn" 1})

  # XXX: defglobal and varglobal...
  (def def-things
    (merge non-call-things
           call-things))

  (def non-calls @[])

  (def calls @[])

  # find effectively top-level defish things and their names
  (while cur-zloc
    (when (match (j/node cur-zloc) [:tuple]
            (when-let [child-zloc (j/down cur-zloc)]
              # XXX: assumes first child is a symbol
              (match (j/node child-zloc) [:symbol _ name]
                (cond
                  (get call-things name)
                  (array/push calls child-zloc)
                  #
                  (get non-call-things name)
                  (array/push non-calls child-zloc))))))
    (set cur-zloc (j/right cur-zloc)))

  # show "def type"s and names of non-call things
  (reduce (fn [acc a-zloc]
            (when-let [b-zloc (j/right-skip-wsc a-zloc)]
              (def a-type (get (j/node a-zloc) 2))
              (match (j/node b-zloc)
                [:symbol _ name]
                (array/push acc [a-type name])
                #
                [:bracket-tuple _ & rest]
                (array/concat acc
                              (keep (fn [[node-type _ node-value]]
                                      (when (= :symbol node-type)
                                        [a-type node-value]))
                                    rest))
                #
                [:tuple _ & rest]
                (array/concat acc
                              (keep (fn [[node-type _ node-value]]
                                      (when (= :symbol node-type)
                                        [a-type node-value]))
                                    rest))
                #
                [:array _ & rest]
                (array/concat acc
                              (keep (fn [[node-type _ node-value]]
                                      (when (= :symbol node-type)
                                        [a-type node-value]))
                                    rest))
                #
                [:bracket-array _ & rest]
                (array/concat acc
                              (keep (fn [[node-type _ node-value]]
                                      (when (= :symbol node-type)
                                        [a-type node-value]))
                                    rest))
                #
                [:struct _ & rest]
                (array/concat acc
                              (keep (fn [[node-type _ node-value]]
                                      (when (= :symbol node-type)
                                        [a-type node-value]))
                                    rest))
                #
                [:table _ & rest]
                (array/concat acc
                              (keep (fn [[node-type _ node-value]]
                                      (when (= :symbol node-type)
                                        [a-type node-value]))
                                    rest)))))
          @[]
          non-calls)
  # =>
  @[["def" "a"]
    ["def" "x"] ["def" "y"]
    ["var" "i"] ["var" "j"]
    ["var" "b"]]

  )