Last active
November 29, 2025 10:50
-
-
Save sogaiu/35530f874f28e8eabeb34ff2f099db32 to your computer and use it in GitHub Desktop.
top-level def extraction test
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| (import ./lib/location :as l) | |
| (import ./lib/jipper :as j) | |
| (comment | |
| (def an-import | |
| "(import ./analyze :as a)") | |
| (def a-def | |
| "(def a 1)") | |
| (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 an-import "\n" | |
| "\n" | |
| a-def "\n" | |
| "\n" | |
| a-defn- "\n" | |
| "\n" | |
| a-comment "\n" | |
| "\n" | |
| a-defmacro- "\n" | |
| "\n" | |
| a-var "\n" | |
| "\n" | |
| a-main-defn)) | |
| (def results @[]) | |
| (var cur-zloc | |
| (j/zip-down (l/par src))) | |
| # XXX: defglobal and varglobal... | |
| (def def-things | |
| {"def" 1 "def-" 1 | |
| "var" 1 "var-" 1 | |
| "defn" 1 "defn-" 1 | |
| "defmacro" 1 "defmacro-" 1 | |
| "varfn" 1}) | |
| # can find top-level "defs" by successively moving "right" | |
| (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] | |
| (when (get def-things name) | |
| (array/push results cur-zloc)))))) | |
| (set cur-zloc (j/right cur-zloc))) | |
| (map |(l/gen (j/node $)) results) | |
| # => | |
| @[a-def | |
| a-defn- | |
| a-defmacro- | |
| a-var | |
| a-main-defn] | |
| ) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment