clone url: git://git.m455.casa/fa
esperbuild/espersrc/fennel-0.7.0/src/fennel/repl.fnl
| 1 | ;; This module is the read/eval/print loop; for coding Fennel interactively. |
| 2 | |
| 3 | ;; The most complex thing it does is locals-saving, which allows locals to be |
| 4 | ;; preserved in between "chunks"; by default Lua throws away all locals after |
| 5 | ;; evaluating each piece of input. |
| 6 | |
| 7 | (local utils (require :fennel.utils)) |
| 8 | (local parser (require :fennel.parser)) |
| 9 | (local compiler (require :fennel.compiler)) |
| 10 | (local specials (require :fennel.specials)) |
| 11 | |
| 12 | (fn default-read-chunk [parser-state] |
| 13 | (io.write (if (< 0 parser-state.stack-size) ".." ">> ")) |
| 14 | (io.flush) |
| 15 | (let [input (io.read)] |
| 16 | (and input (.. input "\n")))) |
| 17 | |
| 18 | (fn default-on-values [xs] |
| 19 | (io.write (table.concat xs "\t")) |
| 20 | (io.write "\n")) |
| 21 | |
| 22 | (fn default-on-error [errtype err lua-source] |
| 23 | (io.write |
| 24 | (match errtype |
| 25 | "Lua Compile" (.. "Bad code generated - likely a bug with the compiler:\n" |
| 26 | "--- Generated Lua Start ---\n" |
| 27 | lua-source |
| 28 | "--- Generated Lua End ---\n") |
| 29 | "Runtime" (.. (compiler.traceback err 4) "\n") |
| 30 | _ (: "%s error: %s\n" :format errtype (tostring err))))) |
| 31 | |
| 32 | (local save-source |
| 33 | (table.concat ["local ___i___ = 1" |
| 34 | "while true do" |
| 35 | " local name, value = debug.getlocal(1, ___i___)" |
| 36 | " if(name and name ~= \"___i___\") then" |
| 37 | " ___replLocals___[name] = value" |
| 38 | " ___i___ = ___i___ + 1" |
| 39 | " else break end end"] "\n")) |
| 40 | |
| 41 | (fn splice-save-locals [env lua-source] |
| 42 | (set env.___replLocals___ (or env.___replLocals___ {})) |
| 43 | (let [spliced-source [] |
| 44 | bind "local %s = ___replLocals___['%s']"] |
| 45 | (each [line (lua-source:gmatch "([^\n]+)\n?")] |
| 46 | (table.insert spliced-source line)) |
| 47 | (each [name (pairs env.___replLocals___)] |
| 48 | (table.insert spliced-source 1 (bind:format name name))) |
| 49 | (when (and (< 1 (# spliced-source)) |
| 50 | (: (. spliced-source (# spliced-source)) :match "^ *return .*$")) |
| 51 | (table.insert spliced-source (# spliced-source) save-source)) |
| 52 | (table.concat spliced-source "\n"))) |
| 53 | |
| 54 | (local commands {}) |
| 55 | |
| 56 | (fn command? [input] (input:match "^%s*,")) |
| 57 | |
| 58 | (fn commands.help [_ _ on-values] |
| 59 | (on-values ["Welcome to Fennel. |
| 60 | This is the REPL where you can enter code to be evaluated. |
| 61 | You can also run these repl commands: |
| 62 | |
| 63 | ,help - show this message |
| 64 | ,reload module-name - reload the specified module |
| 65 | ,reset - erase all repl-local scope |
| 66 | ,exit - leave the repl |
| 67 | |
| 68 | Use (doc something) to see descriptions for individual macros and special forms. |
| 69 | |
| 70 | For more information about the language, see https://fennel-lang.org/reference"])) |
| 71 | |
| 72 | (fn reload [module-name env on-values on-error] |
| 73 | ;; Sandbox the reload inside the limited environment, if present. |
| 74 | (match (pcall (specials.load-code "return require(...)" env) module-name) |
| 75 | (true old) (let [_ (tset package.loaded module-name nil) |
| 76 | (ok new) (pcall require module-name) |
| 77 | ;; keep the old module if reload failed |
| 78 | new (if (not ok) (do (on-values new) old) new)] |
| 79 | ;; if the module isn't a table then we can't make changes |
| 80 | ;; which affect already-loaded code, but if it is then we |
| 81 | ;; should splice new values into the existing table and |
| 82 | ;; remove values that are gone. |
| 83 | (when (and (= (type old) :table) (= (type new) :table)) |
| 84 | (each [k v (pairs new)] |
| 85 | (tset old k v)) |
| 86 | (each [k (pairs old)] |
| 87 | (when (= nil (. new k)) |
| 88 | (tset old k nil))) |
| 89 | (tset package.loaded module-name old)) |
| 90 | (on-values [:ok])) |
| 91 | (false msg) (on-error "Runtime" (pick-values 1 (msg:gsub "\n.*" ""))))) |
| 92 | |
| 93 | (fn commands.reload [read env on-values on-error] |
| 94 | (match (pcall read) |
| 95 | (true true module-sym) (reload (tostring module-sym) env on-values on-error) |
| 96 | (false ?parse-ok ?msg) (on-error "Parse" (or ?msg ?parse-ok)))) |
| 97 | |
| 98 | (fn commands.reset [_ env on-values] |
| 99 | (set env.___replLocals___ {}) |
| 100 | (on-values [:ok])) |
| 101 | |
| 102 | (fn run-command [input read loop env on-values on-error] |
| 103 | (let [command-name (input:match ",([^%s/]+)")] |
| 104 | (match (. commands command-name) |
| 105 | command (command read env on-values on-error) |
| 106 | _ (when (not= "exit" command-name) |
| 107 | (on-values ["Unknown command" command-name]))) |
| 108 | (when (not= "exit" command-name) |
| 109 | (loop)))) |
| 110 | |
| 111 | (fn completer [env scope text] |
| 112 | (let [matches [] |
| 113 | input-fragment (text:gsub ".*[%s)(]+" "")] |
| 114 | (fn add-partials [input tbl prefix] ; add partial key matches in tbl |
| 115 | (each [k (utils.allpairs tbl)] |
| 116 | (let [k (if (or (= tbl env) (= tbl env.___replLocals___)) |
| 117 | (. scope.unmanglings k) |
| 118 | k)] |
| 119 | (when (and (< (# matches) 2000) ; stop explosion on too many items |
| 120 | (= (type k) "string") |
| 121 | (= input (k:sub 0 (# input)))) |
| 122 | (table.insert matches (.. prefix k)))))) |
| 123 | (fn add-matches [input tbl prefix] ; add matches, descending into tbl fields |
| 124 | (let [prefix (if prefix (.. prefix ".") "")] |
| 125 | (if (not (input:find "%.")) ; no more dots, so add matches |
| 126 | (add-partials input tbl prefix) |
| 127 | (let [(head tail) (input:match "^([^.]+)%.(.*)") |
| 128 | raw-head (if (or (= tbl env) (= tbl env.___replLocals___)) |
| 129 | (. scope.manglings head) |
| 130 | head)] |
| 131 | (when (= (type (. tbl raw-head)) "table") |
| 132 | (add-matches tail (. tbl raw-head) (.. prefix head))))))) |
| 133 | |
| 134 | (add-matches input-fragment (or scope.specials [])) |
| 135 | (add-matches input-fragment (or scope.macros [])) |
| 136 | (add-matches input-fragment (or env.___replLocals___ [])) |
| 137 | (add-matches input-fragment env) |
| 138 | (add-matches input-fragment (or env._ENV env._G [])) |
| 139 | matches)) |
| 140 | |
| 141 | (fn repl [options] |
| 142 | (let [old-root-options utils.root.options |
| 143 | env (if options.env |
| 144 | (specials.wrap-env options.env) |
| 145 | (setmetatable {} {:__index (or _G._ENV _G)})) |
| 146 | save-locals? (and (not= options.saveLocals false) |
| 147 | env.debug env.debug.getlocal) |
| 148 | opts {} |
| 149 | _ (each [k v (pairs options)] (tset opts k v)) |
| 150 | read-chunk (or opts.readChunk default-read-chunk) |
| 151 | on-values (or opts.onValues default-on-values) |
| 152 | on-error (or opts.onError default-on-error) |
| 153 | pp (or opts.pp tostring) |
| 154 | ;; make parser |
| 155 | (byte-stream clear-stream) (parser.granulate read-chunk) |
| 156 | chars [] |
| 157 | (read reset) (parser.parser (fn [parser-state] |
| 158 | (let [c (byte-stream parser-state)] |
| 159 | (table.insert chars c) |
| 160 | c))) |
| 161 | scope (compiler.make-scope)] |
| 162 | |
| 163 | ;; use metadata unless we've specifically disabled it |
| 164 | (set opts.useMetadata (not= options.useMetadata false)) |
| 165 | (when (= opts.allowedGlobals nil) |
| 166 | (set opts.allowedGlobals (specials.current-global-names opts.env))) |
| 167 | |
| 168 | (when opts.registerCompleter |
| 169 | (opts.registerCompleter (partial completer env scope))) |
| 170 | |
| 171 | (fn print-values [...] |
| 172 | (let [vals [...] |
| 173 | out []] |
| 174 | (set (env._ env.__) (values (. vals 1) vals)) |
| 175 | ;; utils.map won't work here because of sparse tables |
| 176 | (for [i 1 (select :# ...)] |
| 177 | (table.insert out (pp (. vals i)))) |
| 178 | (on-values out))) |
| 179 | |
| 180 | (fn loop [] |
| 181 | (each [k (pairs chars)] (tset chars k nil)) |
| 182 | (let [(ok parse-ok? x) (pcall read) |
| 183 | src-string (string.char ((or _G.unpack table.unpack) chars))] |
| 184 | (set utils.root.options opts) |
| 185 | (if (not ok) |
| 186 | (do (on-error "Parse" parse-ok?) |
| 187 | (clear-stream) |
| 188 | (reset) |
| 189 | (loop)) |
| 190 | (command? src-string) (run-command src-string read loop env |
| 191 | on-values on-error) |
| 192 | (when parse-ok? ; if this is false, we got eof |
| 193 | (match (pcall compiler.compile x {:correlate opts.correlate |
| 194 | :source src-string |
| 195 | :scope scope |
| 196 | :useMetadata opts.useMetadata |
| 197 | :moduleName opts.moduleName |
| 198 | :assert-compile opts.assert-compile |
| 199 | :parse-error opts.parse-error}) |
| 200 | (false msg) (do (clear-stream) |
| 201 | (on-error "Compile" msg)) |
| 202 | (true src) (let [src (if save-locals? |
| 203 | (splice-save-locals env src) |
| 204 | src)] |
| 205 | (match (pcall specials.load-code src env) |
| 206 | (false msg) (do (clear-stream) |
| 207 | (on-error "Lua Compile" msg src)) |
| 208 | (_ chunk) (xpcall #(print-values (chunk)) |
| 209 | (partial on-error "Runtime"))))) |
| 210 | (set utils.root.options old-root-options) |
| 211 | (loop))))) |
| 212 | (loop))) |