this repo has no description
Cleanup NeoVim configuration
+4061
-2138
+2
-1
vim/.config/nvim/after/ftplugin/nix.vim
+2
-1
vim/.config/nvim/after/ftplugin/nix.vim
-10
vim/.config/nvim/after/queries/elixir/injections.scm
-10
vim/.config/nvim/after/queries/elixir/injections.scm
vim/.config/nvim/after/syntax/elixir.vim
vim/.config/nvim/after/syntax/elixir.vim
This is a binary file and will not be displayed.
-3
vim/.config/nvim/after/syntax/markdown.vim
-3
vim/.config/nvim/after/syntax/markdown.vim
+30
-41
vim/.config/nvim/fnl/langclient.fnl
+30
-41
vim/.config/nvim/fnl/langclient.fnl
···
1
-
(local {:buf-map bmap} (require :nvim))
2
-
(local lsp (require :lspconfig))
3
-
(local utils (require :lspconfig.util))
4
-
(local picker (require :picker))
5
-
(import-macros logger :nvim.logger)
6
-
(import-macros {: bopt
7
-
: augroup
8
-
: on} :nvim.macros)
9
-
10
-
(fn capable? [client capability]
11
-
(. client.resolved_capabilities capability))
1
+
(import-macros {: use} :relude)
12
2
13
-
; Disable virtual text for diagnostics
14
-
(tset vim.lsp.handlers :textDocument/publishDiagnostics
15
-
(vim.lsp.with
16
-
vim.lsp.diagnostic.on_publish_diagnostics
17
-
{:virtual_text false
18
-
:underline true
19
-
:signs true}))
3
+
(use nvim {: command : opts :buf-map bmap})
4
+
(use picker)
5
+
(use lspconfig)
6
+
(import-macros logger :nvim.logger)
7
+
(import-macros {: augroup} :nvim)
20
8
21
9
(fn on_attach [client]
22
10
(logger.inspect client)
11
+
(local capable? (fn [capability]
12
+
(. client.server_capabilities capability)))
23
13
(augroup lsp-diagnostics
24
-
(on CursorHold :* (vim.diagnostic.open_float nil)))
25
-
(when (capable? client :hover)
14
+
(on CursorHold :* (vim.diagnostic.open_float nil)))
15
+
(when (capable? :hoverProvider)
26
16
(bmap :n :K #(vim.lsp.buf.hover)))
27
-
(when (capable? client :goto_definition)
17
+
(when (capable? :declarationProvider)
18
+
(bmap :n :gD #(vim.lsp.buf.declaration)))
19
+
(when (capable? :definitionProvider)
28
20
(bmap :n :gd #(vim.lsp.buf.definition)))
29
-
(when (capable? client :find_references)
21
+
(when (capable? :referencesProvider)
30
22
(bmap :n :gr #(picker.lsp_references)))
31
-
(when (capable? client :document_formatting)
23
+
(when (capable? :documentFormattingProvider)
32
24
(bmap :n :Q #(vim.lsp.buf.formatting_sync)))
33
-
(when (capable? client :document_symbol)
25
+
(when (capable? :documentSymbolProvider)
34
26
(bmap :n :gO #(picker.lsp_document_symbols)))
35
-
(when (capable? client :completion)
36
-
(bopt omnifunc "v:lua.vim.lsp.omnifunc")))
27
+
(when (capable? :completionProvider)
28
+
(set opts.buffer.omnifunc "v:lua.vim.lsp.omnifunc")))
37
29
38
-
(local capabilities
39
-
(->> (vim.lsp.protocol.make_client_capabilities)
40
-
((. (require :cmp_nvim_lsp) :update_capabilities))))
30
+
(set lspconfig.util.default_config
31
+
(vim.tbl_extend :force lspconfig.util.default_config
32
+
{:autostart false
33
+
: on_attach}))
34
+
35
+
(vim.diagnostic.config
36
+
{:virtual_text false})
41
37
42
-
(lsp.rust_analyzer.setup {: capabilities
43
-
: on_attach
44
-
:settings {
45
-
:trace {:server :verbose}
46
-
}})
38
+
(lspconfig.rust_analyzer.setup {:settings {:trace {:server :verbose}}})
47
39
48
-
(lsp.elixirls.setup {:cmd ["elixir-ls"]
49
-
: capabilities
50
-
: on_attach
40
+
(lspconfig.elixirls.setup {:cmd ["elixir-ls"]
51
41
:settings {:elixirLS {:dialyzerEnabled false}}})
52
42
53
-
(lsp.erlangls.setup {:cmd ["erlang_ls"]
54
-
: capabilities
55
-
: on_attach})
43
+
(lspconfig.erlangls.setup {:cmd ["erlang_ls"]})
56
44
57
-
(lsp.solargraph.setup {: on_attach})
45
+
(augroup lsp-direnv
46
+
(on User :DirenvLoaded (command "LspStart")))
+35
-18
vim/.config/nvim/fnl/nvim/init.fnl
+35
-18
vim/.config/nvim/fnl/nvim/init.fnl
···
1
-
(import-macros logger :nvim.logger)
1
+
; (import-macros logger :nvim.logger)
2
2
3
-
(global __nvim_functions__ {})
3
+
(local {: make-func : maybe-join} (require :nvim.utils))
4
4
5
5
(fn filter [t cb]
6
6
(collect [k v (pairs t)]
···
8
8
9
9
(fn try [value test cb]
10
10
(if (test value) (cb value) value))
11
-
12
-
(fn make-func [func]
13
-
(let [idx (+ (length __nvim_functions__) 1)]
14
-
(tset __nvim_functions__ idx func)
15
-
(.. "__nvim_functions__[" idx "]")))
16
11
17
12
(fn normalise-map [rhs opts]
18
13
(if (= (type rhs) :string)
···
52
47
(fn [...]
53
48
(api.command (.. key " " (table.concat [...] " ")))))}))
54
49
50
+
(local func (setmetatable {}
51
+
{:__index (fn [_ key]
52
+
(fn [...] (api.call_function key [...])))}))
53
+
54
+
(local opts (setmetatable {}
55
+
{:__newindex (fn [_ key val]
56
+
(print (fennel.view {: key : val})))}))
57
+
55
58
(fn ?> [f ...] (let [(ok? val) (f)] (if (and ok? (not= val "")) val (?> ...))))
56
59
57
-
(fn get-opt [key]
58
-
(let [bo #(pcall api.buf_get_option 0 key)
59
-
wo #(pcall api.win_get_option 0 key)
60
-
go #(values true (api.get_option key))]
61
-
(?> bo wo go)))
60
+
(fn set-opt [scope key value]
61
+
(let [len (length key)
62
+
opt (if (key:match "[-+^!]$") (key:sub 1 (- len 1)) key)
63
+
l (lambda [] (vim.split (. scope opt) ","))
64
+
val (match (key:sub len)
65
+
:- (assert false "not-implemented")
66
+
:^ (vim.list_extend value (l))
67
+
:+ (vim.list_extend (l) value)
68
+
_ value)]
69
+
(tset scope opt (maybe-join val))))
62
70
63
-
(fn call [name ...]
64
-
(api.call_function name [...]))
71
+
(fn build-opts [table scope]
72
+
(setmetatable table
73
+
{:__index scope
74
+
:__newindex (fn [_ key val] (set-opt scope key val))
75
+
:__call (fn [table opts]
76
+
(each [key value (pairs opts)]
77
+
(set-opt scope key value)))}))
78
+
79
+
; TODO: Allow setting buffer and window local options
80
+
(local opts (build-opts {:global (build-opts {} vim.go)
81
+
:window (build-opts {} vim.wo)
82
+
:buffer (build-opts {} vim.bo)} vim.o))
65
83
66
84
(fn executable? [name]
67
-
(call :executable name))
85
+
(func.executable name))
68
86
69
87
;; Exports
70
88
(setmetatable {:map (make-map api.set_keymap)
71
89
:buf-map (make-map #(api.buf_set_keymap 0 $...))
72
90
: api
73
91
: ex
74
-
: call
75
-
: make-func
76
-
: get-opt
92
+
: func
93
+
: opts
77
94
: executable?} {:__index api})
+50
vim/.config/nvim/fnl/nvim/macro-init.fnl
+50
vim/.config/nvim/fnl/nvim/macro-init.fnl
···
1
+
; (import-macros logger :nvim.logger)
2
+
3
+
(fn on [event pattern ...]
4
+
"Run command on `event`"
5
+
(let [body (if (list? ...) `(fn [] ,...) ...)]
6
+
`(vim.api.nvim_create_autocmd ,(view event)
7
+
{:pattern ,pattern
8
+
:callback ,body
9
+
:group au-id})))
10
+
11
+
(fn augroup [name ...]
12
+
"Define auto group"
13
+
`(let [,(sym "au-id") (vim.api.nvim_create_augroup ,(view name) {:clear true})]
14
+
(import-macros {: on} :nvim)
15
+
,...
16
+
au-id))
17
+
18
+
(fn command-func [body]
19
+
(let [q-args (sym "q-args")
20
+
f-args (sym "f-args")
21
+
bang (sym "bang")
22
+
lines (sym "lines")
23
+
count (sym "count")
24
+
reg (sym "reg")
25
+
mods (sym "mods")
26
+
smods (sym "smods")]
27
+
`(lambda [arg#]
28
+
(let [{:args ,q-args
29
+
:fargs ,f-args
30
+
:bang ,bang
31
+
:line1 line1#
32
+
:line2 line2#
33
+
:range range#
34
+
:count ,count
35
+
:reg ,reg
36
+
:mods ,mods
37
+
:smods ,smods} arg#
38
+
,lines {:from line1# :to line2# :range range#}]
39
+
,body))))
40
+
41
+
(fn defcommand [name opts ...]
42
+
(assert-compile (string.match (view name) "^%u%w*$") "User defined command must start with uppercase letter" name)
43
+
(let [(body opts) (if (= ... nil) (values opts {}) (values ... opts))
44
+
body (if (list? body) (command-func body) body)]
45
+
`(vim.api.nvim_create_user_command ,(view name) ,body ,opts)))
46
+
47
+
;; Exports
48
+
{: augroup
49
+
: defcommand
50
+
: on}
-94
vim/.config/nvim/fnl/nvim/macros.fnl
-94
vim/.config/nvim/fnl/nvim/macros.fnl
···
1
-
(import-macros logger :nvim.logger)
2
-
3
-
(fn g [name value]
4
-
"Set value for global Vim variable"
5
-
`(tset vim.g ,name ,value))
6
-
7
-
(fn env [name value]
8
-
"Set environment variable"
9
-
(assert (sym? name))
10
-
`(tset vim.env ,(view name) ,(if (= nil value) true value)))
11
-
12
-
(fn set-opt [scope name value]
13
-
(assert (sym? name))
14
-
(let [full-opt (view name)
15
-
len (length full-opt)
16
-
opt (if (full-opt:match "[-+^!]$") (full-opt:sub 1 (- len 1)) full-opt)]
17
-
(match (full-opt:sub len)
18
-
:- (assert false "not implemented")
19
-
:^ `(let [v# ,value]
20
-
(tset ,scope ,opt (if (= (. ,scope ,opt) "") v# (.. v# "," (. ,scope ,opt)))))
21
-
:+ `(let [v# ,value]
22
-
(tset ,scope ,opt (if (= (. ,scope ,opt) "") v# (.. (. ,scope ,opt) "," v#))))
23
-
_ `(tset ,scope ,opt ,(if (= value nil) true value)))))
24
-
25
-
(fn opt [name value]
26
-
"Set Vim option"
27
-
(set-opt `vim.o name value))
28
-
(fn wopt [name value]
29
-
"Set Vim window option"
30
-
(set-opt `vim.wo name value))
31
-
(fn bopt [name value]
32
-
"Set Vim buffer option"
33
-
(set-opt `vim.bo name value))
34
-
35
-
(fn into-func [code]
36
-
`(.. "lua " ((. (require :nvim) :make-func) (fn [] ,code)) "()"))
37
-
38
-
(fn on [event pattern ...]
39
-
"Run command on `event`"
40
-
`(vim.api.nvim_command (.. "au " ,(view event)
41
-
" " ,pattern
42
-
" " ,(into-func ...))))
43
-
44
-
(fn augroup [name ...]
45
-
"Define auto group"
46
-
`(do
47
-
(vim.api.nvim_command ,(.. "augroup " (view name)))
48
-
(vim.api.nvim_command "au!")
49
-
,...
50
-
(vim.api.nvim_command "augroup END")))
51
-
52
-
(fn translate-opts [opts]
53
-
(let [flags (icollect [k v (pairs opts)]
54
-
(match k
55
-
:bar (when v "-bar")
56
-
:bang (when v "-bang")
57
-
:register (when v "-register")
58
-
:buffer (when v "-buffer")
59
-
:range (.. "-range=" v)
60
-
:addr (.. "-addr=" v)
61
-
:complete (.. "-complete=" v)
62
-
:nargs (.. "-nargs=" v)))]
63
-
(table.concat flags " ")))
64
-
65
-
(fn command-func [code]
66
-
(let [bang (sym "bang")
67
-
mods (sym "mods")
68
-
f-args (sym "f-args")
69
-
q-args (sym "q-args")
70
-
reg (sym "reg")
71
-
lines (sym "lines")
72
-
]
73
-
`(.. "lua "
74
-
((. (require :nvim) :make-func) (fn [,bang ,mods ,f-args ,q-args ,reg ,lines] ,code))
75
-
"('<bang>' == '!', '<mods>', {<f-args>}, <q-args>, [[<reg>]], {from=<line1>, to=<line2>, range=<range>})")))
76
-
77
-
(lambda defcommand [name opts ...]
78
-
(assert (string.match (view name) "^%u%w*$"))
79
-
(let [(command opts1) (match ...
80
-
(nil ? (= (type opts) :string)) (values (opts:gsub "|" "<bar>") {})
81
-
(body ? (= (type body) :string)) (values (body:gsub "|" "<bar>") opts)
82
-
_ (values (command-func `(do ,...)) opts))
83
-
flags (translate-opts opts1)]
84
-
`(vim.api.nvim_command (.. "command! " ,flags " " ,(view name) " " ,command))))
85
-
86
-
;; Exports
87
-
{: augroup
88
-
: defcommand
89
-
: env
90
-
: g
91
-
: on
92
-
: opt
93
-
: bopt
94
-
: wopt}
+14
vim/.config/nvim/fnl/nvim/utils.fnl
+14
vim/.config/nvim/fnl/nvim/utils.fnl
···
1
+
(global __nvim_functions__ {})
2
+
3
+
(fn maybe-join [value]
4
+
(if (= (type value) :table)
5
+
(table.concat value ",")
6
+
value))
7
+
8
+
(fn make-func [func]
9
+
(let [idx (+ (length __nvim_functions__) 1)]
10
+
(tset __nvim_functions__ idx func)
11
+
(.. "__nvim_functions__[" idx "]")))
12
+
13
+
{: maybe-join
14
+
: make-func}
+4
-2
vim/.config/nvim/fnl/picker.fnl
+4
-2
vim/.config/nvim/fnl/picker.fnl
+50
-57
vim/.config/nvim/fnl/plugins.fnl
+50
-57
vim/.config/nvim/fnl/plugins.fnl
···
1
-
(local packer (require :packer))
1
+
(import-macros {: use} :relude)
2
+
3
+
(use packer)
2
4
3
5
(fn config [cb]
4
6
(packer.startup
5
-
(fn [-use -use-rocks]
7
+
(fn [-pkg -pkg-rocks]
6
8
(let [super (fn [f] (fn [name ?opts] (f (vim.tbl_extend :keep {1 name} (or ?opts {})))))
7
-
use (super -use)
8
-
use-rocks (super -use-rocks)]
9
-
(cb use use-rocks)))))
9
+
pkg (super -pkg)
10
+
pkg-rocks (super -pkg-rocks)]
11
+
(cb pkg pkg-rocks)))))
10
12
11
-
(config (fn [use use-rocks]
12
-
; Speedup initialisation
13
-
(use :lewis6991/impatient.nvim)
14
-
; Package manager
15
-
(use :wbthomason/packer.nvim)
13
+
(config (fn [pkg pkg-rocks]
16
14
; Color scheme
17
-
(use :hauleth/blame.vim)
15
+
; (pkg :hauleth/blame.vim)
18
16
; Project navigation
19
-
(use :tpope/vim-projectionist)
20
-
(use :justinmk/vim-dirvish)
21
-
(use :tpope/vim-eunuch)
17
+
(pkg :tpope/vim-projectionist)
18
+
(pkg :justinmk/vim-dirvish)
19
+
(pkg :tpope/vim-eunuch)
22
20
23
21
; File picker
24
-
(use :nvim-lua/popup.nvim)
25
-
(use :nvim-lua/plenary.nvim)
26
-
(use :nvim-telescope/telescope.nvim)
27
-
(use :nvim-telescope/telescope-fzy-native.nvim)
22
+
(pkg :nvim-lua/popup.nvim)
23
+
(pkg :nvim-lua/plenary.nvim)
24
+
(pkg :nvim-telescope/telescope.nvim)
25
+
(pkg :nvim-telescope/telescope-fzy-native.nvim)
28
26
29
27
; Git
30
-
(use :tpope/vim-fugitive)
31
-
(use :pwntester/octo.nvim)
28
+
(pkg :tpope/vim-fugitive)
29
+
(pkg :pwntester/octo.nvim)
32
30
33
31
; Launch screen
34
-
(use :mhinz/vim-startify)
32
+
(pkg :mhinz/vim-startify)
35
33
36
34
; Languages
37
-
(use :elixir-editors/vim-elixir)
38
-
(use :nvim-treesitter/nvim-treesitter)
39
-
(use :lepture/vim-jinja)
40
-
;(use :nvim-orgmode/orgmode)
35
+
(pkg :elixir-editors/vim-elixir)
36
+
;(pkg :nvim-orgmode/orgmode)
41
37
42
38
; Tree Sitter
43
-
(use :neovim/nvim-lspconfig)
44
-
(use :nvim-treesitter/playground)
39
+
(pkg :neovim/nvim-lspconfig)
40
+
(pkg :nvim-treesitter/playground)
45
41
46
42
; Code manipulation
47
-
(use :AndrewRadev/splitjoin.vim)
48
-
(use :hauleth/sad.vim)
49
-
(use :tommcdo/vim-exchange)
50
-
(use :tommcdo/vim-lion)
51
-
(use :tpope/vim-commentary)
52
-
(use :machakann/vim-sandwich {:opt true})
53
-
(use :hrsh7th/cmp-nvim-lsp)
54
-
(use :hrsh7th/cmp-buffer)
55
-
(use :hrsh7th/nvim-cmp)
56
-
; (use :L3MON4D3/LuaSnip)
57
-
; (use :saadparwaiz1/cmp_luasnip)
43
+
(pkg :AndrewRadev/splitjoin.vim)
44
+
(pkg :hauleth/sad.vim)
45
+
(pkg :tommcdo/vim-exchange)
46
+
(pkg :tommcdo/vim-lion)
47
+
(pkg :tpope/vim-commentary)
48
+
(pkg :machakann/vim-sandwich {:opt true})
58
49
59
50
; Movements
60
-
(use :wellle/targets.vim {:opt true})
61
-
(use :rhysd/clever-f.vim)
51
+
(pkg :wellle/targets.vim {:opt true})
52
+
(pkg :rhysd/clever-f.vim)
62
53
63
54
; Task running
64
-
(use :hauleth/asyncdo.vim)
65
-
(use :romainl/vim-qf)
66
-
(use :romainl/vim-qlist)
67
-
(use :Olical/vim-enmasse)
68
-
(use :igemnace/vim-makery)
55
+
(pkg :hauleth/asyncdo.vim)
56
+
(pkg :romainl/vim-qf)
57
+
(pkg :romainl/vim-qlist)
58
+
(pkg :Olical/vim-enmasse)
59
+
(pkg :igemnace/vim-makery)
69
60
70
61
; Windows
71
-
(use :t9md/vim-choosewin)
62
+
(pkg :t9md/vim-choosewin)
72
63
73
64
; Utils
74
-
(use :andymass/vim-matchup)
75
-
(use :direnv/direnv.vim)
76
-
(use :hauleth/vim-backscratch)
77
-
(use :https://gitlab.com/hauleth/qfx.vim.git)
78
-
(use :https://gitlab.com/hauleth/smart.vim.git)
79
-
(use :sgur/vim-editorconfig)
80
-
(use :mbbill/undotree)
81
-
(use :tpope/vim-characterize)
82
-
(use :tpope/vim-dadbod)
83
-
(use :tpope/vim-repeat)
84
-
(use :tpope/vim-rsi)
65
+
(pkg :andymass/vim-matchup)
66
+
(pkg :direnv/direnv.vim)
67
+
(pkg :hauleth/vim-backscratch)
68
+
(pkg :https://gitlab.com/hauleth/qfx.vim.git)
69
+
(pkg :https://gitlab.com/hauleth/smart.vim.git)
70
+
(pkg :sgur/vim-editorconfig)
71
+
(pkg :mbbill/undotree)
72
+
(pkg :tpope/vim-characterize)
73
+
(pkg :tpope/vim-dadbod)
74
+
(pkg :tpope/vim-repeat)
75
+
(pkg :tpope/vim-rsi)
76
+
(pkg :andweeb/presence.nvim)
77
+
(pkg :j-hui/fidget.nvim)
85
78
))
+9
vim/.config/nvim/fnl/relude.fnl
+9
vim/.config/nvim/fnl/relude.fnl
···
1
+
(fn use [mod names]
2
+
(assert-compile (sym? mod) "expected symbol" mod)
3
+
(let [mod-name (view mod)
4
+
splitted (vim.split mod-name "." {:plain true})
5
+
last (. splitted (length splitted))
6
+
matcher (if (= names nil) (sym last) names)]
7
+
`(local ,matcher (require ,mod-name))))
8
+
9
+
{: use}
+1
-3
vim/.config/nvim/fnl/startify.fnl
+1
-3
vim/.config/nvim/fnl/startify.fnl
-274
vim/.config/nvim/fnl/startup.fnl
-274
vim/.config/nvim/fnl/startup.fnl
···
1
-
(local {: map
2
-
: command
3
-
: executable?
4
-
: call
5
-
: api
6
-
: get-opt
7
-
: ex} (require :nvim))
8
-
(local picker (require :picker))
9
-
(import-macros logger :nvim.logger)
10
-
(import-macros {: augroup
11
-
: defcommand
12
-
: on
13
-
: env
14
-
: g
15
-
: opt
16
-
: bopt
17
-
: wopt} :nvim.macros)
18
-
19
-
(require :plugins)
20
-
21
-
; Colors
22
-
(ex.colorscheme :blame)
23
-
24
-
(opt shell "fish")
25
-
26
-
; MatchIt must be unloaded for MatchPair to work correctly
27
-
(g :loaded_matchit true)
28
-
(g :matchup_surround_enabled true)
29
-
30
-
(g :choosewin_label "QWERTYUIOP")
31
-
32
-
; Colors
33
-
(opt termguicolors)
34
-
(opt guicursor "n-v-c-sm:block-Cursor,i-ci-ve:ver25-Cursor,r-cr-o:hor20-Cursor")
35
-
36
-
; Indentation
37
-
(opt shiftwidth 2)
38
-
(opt expandtab)
39
-
(bopt expandtab)
40
-
(opt textwidth 80)
41
-
(wopt wrap false)
42
-
(wopt linebreak)
43
-
(opt formatoptions "tcqjl")
44
-
45
-
; UI
46
-
(opt lazyredraw)
47
-
(opt updatetime 500)
48
-
(opt title)
49
-
50
-
; Display tabs and trailing spaces visually
51
-
(opt fillchars "vert:┃,fold:·")
52
-
(opt list)
53
-
(opt listchars "tab:→ ,trail:·,nbsp:␣,extends:↦,precedes:↤")
54
-
(opt conceallevel 2)
55
-
56
-
; Ignore case. If your code uses different casing to differentiate files, then
57
-
; you need mental help
58
-
(opt wildignorecase)
59
-
(opt wildmode :full)
60
-
(opt fileignorecase)
61
-
(opt wildignore "*.o,*~,**/.git/**,**/tmp/**,**/node_modules/**,**/_build/**,**/deps/**,**/target/**,**/uploads/**,*.lock")
62
-
63
-
(opt diffopt+ "indent-heuristic,algorithm:patience")
64
-
(opt tags^ "./**/tags")
65
-
(opt iskeyword+ "-")
66
-
67
-
(opt showmode false)
68
-
69
-
; Autowrite file whenever possible
70
-
(opt hidden false)
71
-
(opt autowriteall)
72
-
73
-
; Keep cursor in the middle
74
-
(let [value 9999]
75
-
(opt scrolloff value)
76
-
(augroup terminal-scrolloff
77
-
(on BufEnter "term://*" (wopt scrolloff 0))
78
-
(on BufLeave "term://*" (wopt scrolloff value))))
79
-
80
-
; XXI century - we have cursors now
81
-
(opt mouse :a)
82
-
83
-
; Split in CORRECT places
84
-
(opt splitright)
85
-
(opt splitbelow)
86
-
87
-
; Searching
88
-
(opt ignorecase)
89
-
(opt smartcase)
90
-
(opt inccommand :nosplit)
91
-
92
-
; Permanent undo
93
-
(opt undofile)
94
-
95
-
; Save only meaningfull data to sessions
96
-
(opt sessionoptions "blank,buffers,curdir,folds,tabpages,winsize")
97
-
98
-
; Folding
99
-
(opt foldmethod :expr)
100
-
(opt foldexpr "nvim_treesitter#foldexpr()")
101
-
(opt foldlevel 999)
102
-
(map :n :<CR> "foldlevel(\".\") ? \"za\" : \"\\<CR>\"" {:expr true})
103
-
104
-
; Completion
105
-
(opt complete ".,w,b,t,k,kspell")
106
-
(opt completeopt "menuone,noselect,noinsert")
107
-
108
-
(g :echodoc#enable_at_startup true)
109
-
(g :echodoc#type :virtual)
110
-
111
-
; Clap
112
-
(map :n :<Space><Space>
113
-
#(picker.find_files))
114
-
115
-
; Frequently used unimpaired mappings
116
-
(let [unimpaired (fn [char left right]
117
-
(map :n (.. "[" char) left)
118
-
(map :n (.. "]" char) right))]
119
-
(unimpaired :w "gT" "gt")
120
-
(unimpaired :q ":cprev" ":cnext")
121
-
(unimpaired :Q ":cpfile" ":cnfile")
122
-
(unimpaired :l ":lprev" ":lnext")
123
-
(unimpaired :L ":lpfile" ":lnfile"))
124
-
125
-
; Additional "Close" commands
126
-
(map :n :ZS ":wa")
127
-
(map :n :ZA ":qa")
128
-
(map :n :ZX ":cq")
129
-
130
-
; Swap ; and : for easier command line mode
131
-
(let [swap (fn [a b] (map :nx a b) (map :nx b a))]
132
-
(swap ";" ":")
133
-
(map :n "q;" "q:"))
134
-
135
-
; Expand abbreviation when hitted <CR>
136
-
(map :i :<CR> "<C-]><CR>")
137
-
138
-
; Make Vim behaviour consistent
139
-
(map :n :Y :y$)
140
-
141
-
; Code formatting
142
-
(map :n :g= "=aGg``")
143
-
(map :nx :Q "gq")
144
-
(map :n :gQ "gqaG``")
145
-
146
-
; Smart `0`
147
-
; Goes to the beginning of the text at first and later goes to the beginning of
148
-
; the line, alternates afterwards
149
-
(map :n :0 "virtcol('.') - 1 <= indent('.') && col('.') > 1 ? '0' : '_'" {:expr true})
150
-
151
-
(map :n :gK ":Dash")
152
-
(map :n :gq (fn []
153
-
(let [name (call :expand "<cfile>")]
154
-
(call :jobstart ["open" name] {:detach true})
155
-
(print "Open" name))))
156
-
157
-
; Text object for whole file
158
-
(map :o :aG ":normal! ggVG")
159
-
160
-
; Quickly disable highligh
161
-
(map :n "<Space>," ":nohlsearch")
162
-
163
-
; Terminal mappings
164
-
(map :n "<C-q>" "<Nop>")
165
-
(map :n "<C-q>c" ":term")
166
-
(map :n "<C-q>s" ":split +term")
167
-
(map :n "<C-q>v" ":vsplit +term")
168
-
(map :n "<C-q>t" ":tabnew +term")
169
-
170
-
(map :t "<C-q>" "<C-\\><C-n>")
171
-
(map :i "<C-q>" "<ESC>")
172
-
(map :n "<C-q>" "<ESC>")
173
-
174
-
(when (executable? "nvr")
175
-
(env EDITOR "nvr -cc split -c 'set bufhidden=delete' --remote-wait"))
176
-
177
-
; Git mappings
178
-
(let [leader "U"
179
-
git-map (fn [lhs cmd] (map :n (.. leader lhs) (.. ":Git " cmd)))]
180
-
(map :n leader "<nop>")
181
-
(map :n (.. leader leader) (.. leader :u) {:noremap false})
182
-
(git-map :p "push")
183
-
(git-map :s "")
184
-
(git-map :d "diff")
185
-
(git-map :B "blame")
186
-
(git-map :c "commit")
187
-
(git-map :u "pull")
188
-
(git-map :g "log"))
189
-
190
-
; Split management
191
-
(map :n "<C-w><C-w>" "<plug>(choosewin)" {:noremap false})
192
-
(map :n "<C-_>" "<plug>(choosewin)" {:noremap false})
193
-
194
-
; Search
195
-
(when (executable? "rg")
196
-
(opt grepprg "rg --vimgrep --no-heading --smart-case")
197
-
(opt grepformat "%f:%l:%c:%m,%f:%l%m,%f %l%m"))
198
-
199
-
; Matchparen
200
-
(g :matchup_matchparen_offscreen {:method :popup})
201
-
202
-
(augroup matchparen
203
-
(let [term "term://*"]
204
-
(on BufEnter term (ex.NoMatchParen))
205
-
(on BufLeave term (ex.DoMatchParen))))
206
-
207
-
; Autoreload Direnv after writing the .envrc
208
-
(when (executable? "direnv")
209
-
(augroup autoreload-envrc
210
-
(on BufWritePost ".envrc" (ex.silent "!direnv allow %"))))
211
-
212
-
; (. (require :orgmode) :setup_ts_grammar)
213
-
214
-
; Setup Lua extensions
215
-
(let [setup (fn [package object] ((. (require package) :setup) object))]
216
-
(setup :startify
217
-
{:lists [{:type "sessions" :header [" Sessions"]}
218
-
{:type "commands" :header [" Wiki"]}]
219
-
:session-dir "~/.local/share/nvim/site/sessions/"
220
-
:session-autoload true
221
-
:session-persistence true
222
-
:change-to-dir false
223
-
:change-to-vcs-root true
224
-
:fortune-use-unicode true})
225
-
(setup :nvim-treesitter.configs
226
-
{:ensure_installed :all
227
-
:highlight {:enable true}
228
-
:matchup {:enable true}
229
-
:indent {:enable true}}))
230
-
; (setup :orgmode {}))
231
-
232
-
(let [cmp (require :cmp)]
233
-
(cmp.setup
234
-
{:sources [{:name "nvim_lsp"}
235
-
{:name "buffer"}]
236
-
:completion {:autocomplete false}
237
-
:snippet {:expand (fn [args]
238
-
((. (require :luasnip) :lsp_expand) args.body))}
239
-
:mapping {"<C-x><C-x>" (cmp.mapping.complete)
240
-
"<C-y>" (cmp.mapping.confirm {:select true})
241
-
"<CR>" (cmp.mapping.confirm)}}))
242
-
243
-
(defcommand Bd "b#|bd#")
244
-
(defcommand BClean
245
-
(->> (call :getbufinfo {:buflisted true})
246
-
(vim.tbl_filter #(= (next $1.windows) nil))
247
-
(#(each [_ v (ipairs $1)]
248
-
(command (.. "bd " v.bufnr))))))
249
-
(defcommand Clean "keeppatterns %s/\\s\\+$//e | set nohlsearch")
250
-
251
-
; Async Make and Grep
252
-
(let [run (fn [args f-args]
253
-
(api.call_function :asyncdo#run (vim.list_extend args f-args)))]
254
-
(defcommand Make {:bang true :nargs :* :complete :file}
255
-
(run [bang (get-opt :makeprg)] f-args))
256
-
(defcommand Grep {:bang true :nargs :+ :complete :dir}
257
-
(run [bang {:job (get-opt :grepprg) :errorformat (get-opt :grepformat)}] f-args)))
258
-
259
-
(defcommand Ctags
260
-
(command :AsyncDo "ctags -R ."))
261
-
(defcommand Start {:nargs :*}
262
-
(let [cmd (call :expand q-args)]
263
-
(command (.. mods " new"))
264
-
(call :termopen cmd)
265
-
(ex.startinsert)))
266
-
(defcommand Dash {:nargs :?}
267
-
(call :dash#open q-args))
268
-
269
-
(do
270
-
(ex.packadd! :vim-sandwich)
271
-
(ex.runtime "macros/sandwich/keymap/surround.vim"))
272
-
273
-
(require :startify)
274
-
(require :langclient)
+268
vim/.config/nvim/init.fnl
+268
vim/.config/nvim/init.fnl
···
1
+
(import-macros {: use} :relude)
2
+
3
+
(use nvim {
4
+
: map
5
+
: command
6
+
: executable?
7
+
: func
8
+
: api
9
+
: opts
10
+
: ex})
11
+
(use picker)
12
+
(import-macros {: augroup
13
+
: defcommand} :nvim)
14
+
15
+
(require :plugins)
16
+
17
+
; Colors
18
+
(ex.colorscheme :blame)
19
+
20
+
(set opts.shell "fish")
21
+
22
+
; MatchIt must be unloaded for MatchPair to work correctly
23
+
(set vim.g.loaded_matchit true)
24
+
(set vim.g.matchup_surround_enabled true)
25
+
26
+
(set vim.g.choosewin_label "QWERTYUIOP")
27
+
28
+
; Colors
29
+
(opts {:termguicolors true
30
+
:guicursor ["n-v-c-sm:block-Cursor" "i-ci-ve:ver25-Cursor" "r-cr-o:hor20-Cursor"]})
31
+
32
+
; Indentation
33
+
(opts {:shiftwidth 2
34
+
:expandtab true
35
+
:textwidth 80
36
+
:wrap false
37
+
:linebreak true
38
+
:formatoptions "tcqjl"})
39
+
40
+
; UI
41
+
(opts {:lazyredraw true
42
+
:updatetime 500
43
+
:title true})
44
+
45
+
; Display tabs and trailing spaces visually
46
+
(opts {:fillchars ["vert:┃" "fold:·"]
47
+
:list true
48
+
:listchars ["tab:→ " "trail:·" "nbsp:␣" "extends:↦" "precedes:↤"]
49
+
:conceallevel 2})
50
+
51
+
; Ignore case. If your code uses different casing to differentiate files, then
52
+
; you need mental help
53
+
(opts {:wildignorecase true
54
+
:wildmode :full
55
+
:fileignorecase true
56
+
:wildignore ["*.o"
57
+
"*~"
58
+
"**/.git/**"
59
+
"**/tmp/**"
60
+
"**/node_modules/**"
61
+
"**/_build/**"
62
+
"**/deps/**"
63
+
"**/target/**"
64
+
"**/uploads/**"
65
+
"*.lock"]})
66
+
67
+
(opts {:diffopt+ ["indent-heuristic" "algorithm:patience"]
68
+
:tags^ ["./**/tags"]
69
+
:iskeyword+ ["-"]})
70
+
71
+
(set opts.showmode false)
72
+
73
+
; Autowrite file whenever possible
74
+
(opts {:hidden false
75
+
:autowriteall true})
76
+
77
+
; Keep cursor in the middle
78
+
(let [value 9999]
79
+
(set opts.scrolloff value)
80
+
(augroup terminal-scrolloff
81
+
(on BufEnter "term://*" (set opts.window.scrolloff 0))
82
+
(on BufLeave "term://*" (set opts.window.scrolloff value))))
83
+
84
+
; XXI century - we have cursors now
85
+
(set opts.mouse :a)
86
+
87
+
; Split in CORRECT places
88
+
(opts {:splitright true
89
+
:splitbelow true})
90
+
91
+
; Searching
92
+
(opts {:ignorecase true
93
+
:smartcase true
94
+
:inccommand :nosplit})
95
+
96
+
; Permanent undo
97
+
(set opts.undofile true)
98
+
99
+
; Save only meaningfull data to sessions
100
+
(set opts.sessionoptions [:blank :buffers :curdir :folds :tabpages :winsize :terminal])
101
+
102
+
; Folding
103
+
(opts {:foldmethod :expr
104
+
:foldexpr "nvim_treesitter#foldexpr()"
105
+
:foldlevel 999})
106
+
(map :n :<CR> "foldlevel(\".\") ? \"za\" : \"\\<CR>\"" {:expr true})
107
+
108
+
; Completion
109
+
(opts {:complete [:. :w :b :t :k :kspell]
110
+
:completeopt [:menuone :noselect :noinsert]})
111
+
112
+
; Clap
113
+
(map :n :<Space><Space>
114
+
#(picker.find_files))
115
+
116
+
; Frequently used unimpaired mappings
117
+
(let [unimpaired (fn [char left right]
118
+
(map :n (.. "[" char) left)
119
+
(map :n (.. "]" char) right))]
120
+
(unimpaired :w "gT" "gt")
121
+
(unimpaired :q ":cprev" ":cnext")
122
+
(unimpaired :Q ":cpfile" ":cnfile")
123
+
(unimpaired :l ":lprev" ":lnext")
124
+
(unimpaired :L ":lpfile" ":lnfile"))
125
+
126
+
; Additional "Close" commands
127
+
(map :n :ZS ":wa")
128
+
(map :n :ZA ":qa")
129
+
(map :n :ZX ":cq")
130
+
131
+
; Swap ; and : for easier command line mode
132
+
(let [swap (fn [a b] (map :nx a b) (map :nx b a))]
133
+
(swap ";" ":")
134
+
(map :n "q;" "q:"))
135
+
136
+
; Expand abbreviation when hitted <CR>
137
+
(map :i :<CR> "<C-]><CR>")
138
+
139
+
; Make Vim behaviour consistent
140
+
(map :n :Y :y$)
141
+
142
+
; Code formatting
143
+
(map :n :g= "=aGg``")
144
+
(map :nx :Q "gq")
145
+
(map :n :gQ "gqaG``")
146
+
147
+
; Smart `0`
148
+
; Goes to the beginning of the text at first and later goes to the beginning of
149
+
; the line, alternates afterwards
150
+
(map :n :0 "virtcol('.') - 1 <= indent('.') && col('.') > 1 ? '0' : '_'" {:expr true})
151
+
152
+
(map :n :gK ":Dash")
153
+
(map :n :gq (fn []
154
+
(let [name (func.expand "<cfile>")]
155
+
(func.jobstart ["open" name] {:detach true})
156
+
(print "Open" name))))
157
+
158
+
; Text object for whole file
159
+
(map :o :aG ":normal! ggVG")
160
+
161
+
; Quickly disable highligh
162
+
(map :n "<Space>," ":nohlsearch")
163
+
164
+
; Terminal mappings
165
+
(map :n "<C-q>" "<Nop>")
166
+
(map :n "<C-q>c" ":term")
167
+
(map :n "<C-q>s" ":split +term")
168
+
(map :n "<C-q>v" ":vsplit +term")
169
+
(map :n "<C-q>t" ":tabnew +term")
170
+
171
+
(map :t "<C-q>" "<C-\\><C-n>")
172
+
(map :i "<C-q>" "<ESC>")
173
+
(map :n "<C-q>" "<ESC>")
174
+
175
+
(when (executable? "nvr")
176
+
(set vim.env.EDITOR "nvr -cc split -c 'set bufhidden=delete' --remote-wait"))
177
+
178
+
; Git mappings
179
+
(let [leader "U"
180
+
git-map (fn [lhs cmd] (map :n (.. leader lhs) (.. ":Git " cmd)))]
181
+
(map :n leader "<nop>")
182
+
(map :n (.. leader leader) (.. leader :u) {:noremap false})
183
+
(git-map :p "push")
184
+
(git-map :s "")
185
+
(git-map :d "diff")
186
+
(git-map :B "blame")
187
+
(git-map :c "commit")
188
+
(git-map :u "pull")
189
+
(git-map :g "log"))
190
+
191
+
; Split management
192
+
(map :n "<C-w><C-w>" "<plug>(choosewin)" {:noremap false})
193
+
(map :n "<C-_>" "<plug>(choosewin)" {:noremap false})
194
+
195
+
; Search
196
+
(when (executable? "rg")
197
+
(opts {:grepprg "rg --vimgrep --no-heading --smart-case"
198
+
:grepformat "%f:%l:%c:%m,%f:%l%m,%f %l%m"}))
199
+
200
+
; Matchparen
201
+
(set vim.g.matchup_matchparen_offscreen {:method :popup})
202
+
203
+
(augroup matchparen
204
+
(let [term "term://*"]
205
+
(on BufEnter term (ex.NoMatchParen))
206
+
(on BufLeave term (ex.DoMatchParen))))
207
+
208
+
; Autoreload Direnv after writing the .envrc
209
+
(when (executable? "direnv")
210
+
(augroup autoreload-envrc
211
+
(on BufWritePost ".envrc" (ex.silent "!direnv allow %"))))
212
+
213
+
; Setup Lua extensions
214
+
(let [setup (fn [package object] ((. (require package) :setup) object))]
215
+
(setup :startify
216
+
{:lists [{:type "sessions" :header [" Sessions"]}
217
+
{:type "commands" :header [" Wiki"]}]
218
+
:session-dir "~/.local/share/nvim/site/sessions/"
219
+
:session-autoload true
220
+
:session-persistence true
221
+
:change-to-dir false
222
+
:change-to-vcs-root true
223
+
:fortune-use-unicode true})
224
+
(setup :nvim-treesitter.configs
225
+
{:highlight {:enable true}
226
+
:matchup {:enable true}
227
+
:indent {:enable true}})
228
+
(setup :fidget {})
229
+
; (setup :orgmode {})
230
+
)
231
+
232
+
(: (require :presence) :setup
233
+
{:auto_update true
234
+
:buttons false
235
+
:blacklist ["Workspace/forte"]})
236
+
237
+
(defcommand Bd "b#|bd#")
238
+
(defcommand BClean
239
+
(->> (func.getbufinfo {:buflisted true})
240
+
(vim.tbl_filter #(= (next $1.windows) nil))
241
+
(#(each [_ v (ipairs $1)]
242
+
(api.buf_delete v.bufnr {})))))
243
+
(defcommand Clean "keeppatterns %s/\\s\\+$//e | set nohlsearch")
244
+
245
+
; Async Make and Grep
246
+
(let [run (fn [args f-args]
247
+
(api.call_function :asyncdo#run (vim.list_extend args f-args)))]
248
+
(defcommand Make {:bang true :nargs :* :complete :file}
249
+
(run [bang opts.makeprg] f-args))
250
+
(defcommand Grep {:bang true :nargs :+ :complete :dir}
251
+
(run [bang {:job opts.grepprg :errorformat opts.grepformat}] f-args)))
252
+
253
+
(defcommand Ctags
254
+
(ex.AsyncDo "ctags -R ."))
255
+
(defcommand Start {:nargs :*}
256
+
(let [cmd (func.expand q-args)]
257
+
(command (.. mods " new"))
258
+
(func.termopen cmd)
259
+
(ex.startinsert)))
260
+
(defcommand Dash {:nargs :?}
261
+
(func.dash#open q-args))
262
+
263
+
(do
264
+
(ex.packadd! :vim-sandwich)
265
+
(ex.runtime "macros/sandwich/keymap/surround.vim"))
266
+
267
+
(require :startify)
268
+
(require :langclient)
-28
vim/.config/nvim/init.lua
-28
vim/.config/nvim/init.lua
···
1
-
require('impatient').enable_profile()
2
-
3
-
-- Fennel loader, default one do not work well with NeoVim so there is custom
4
-
-- one
5
-
_G.fennel = require('fennel')
6
-
local function fennel_loader(name)
7
-
local basename = name:gsub('%.', '/')
8
-
local paths = {"fnl/"..basename..".fnl", "fnl/"..basename.."/init.fnl"}
9
-
10
-
for _, path in ipairs(paths) do
11
-
local found = vim.api.nvim_get_runtime_file(path, false)
12
-
if #found > 0 then
13
-
return function() return fennel.dofile(found[1]) end
14
-
end
15
-
end
16
-
17
-
return nil
18
-
end
19
-
table.insert(package.loaders, 1, fennel_loader)
20
-
21
-
local fennel_paths = ""
22
-
for _, v in pairs(vim.api.nvim_get_runtime_file("fnl/", false)) do
23
-
fennel_paths = fennel_paths .. ";" .. v .. "?.fnl"
24
-
fennel_paths = fennel_paths .. ";" .. v .. "?/init.fnl"
25
-
end
26
-
fennel.path = fennel.path .. fennel_paths
27
-
28
-
require('startup')
+42
vim/.config/nvim/lua/basic.lua
+42
vim/.config/nvim/lua/basic.lua
···
1
+
-- Fennel loader, default one do not work well with NeoVim so there is custom
2
+
-- one
3
+
_G.fennel = require('fennel')
4
+
5
+
-- Load Fennel modules
6
+
local function fennel_loader(name)
7
+
local basename = name:gsub('%.', '/')
8
+
local paths = {"fnl/"..basename..".fnl", "fnl/"..basename.."/init.fnl"}
9
+
10
+
for _, path in ipairs(paths) do
11
+
local found = vim.api.nvim_get_runtime_file(path, false)
12
+
if #found > 0 then
13
+
return function() return fennel.dofile(found[1], {compilerEnv = _G}) end, found[1]
14
+
end
15
+
end
16
+
17
+
return nil
18
+
end
19
+
table.insert(package.loaders, 1, fennel_loader)
20
+
21
+
-- Load Fennel macros
22
+
local function fennel_paths(suffixes)
23
+
local paths = ""
24
+
for _, dir in pairs(vim.api.nvim_get_runtime_file("fnl/", true)) do
25
+
for _, suffix in pairs(suffixes) do
26
+
paths = paths .. ";" .. dir .. "?" .. suffix .. ".fnl"
27
+
end
28
+
end
29
+
30
+
return paths
31
+
end
32
+
fennel["path"] = fennel["path"] .. fennel_paths({"", "/init"})
33
+
fennel["macro-path"] = fennel["macro-path"] .. fennel_paths({"", "/macro-init", "/init"})
34
+
35
+
debug.traceback = fennel.traceback
36
+
37
+
-- Command-mode Fennel execution
38
+
vim.api.nvim_create_user_command('Fennel', function(arg) fennel.eval(arg.args) end, {nargs = '*'})
39
+
40
+
for _, init in pairs(vim.api.nvim_get_runtime_file("init.fnl", false)) do
41
+
fennel.dofile(init, {compilerEnv = _G})
42
+
end
+3555
-1606
vim/.config/nvim/lua/fennel.lua
+3555
-1606
vim/.config/nvim/lua/fennel.lua
···
3
3
local parser = require("fennel.parser")
4
4
local compiler = require("fennel.compiler")
5
5
local specials = require("fennel.specials")
6
+
local view = require("fennel.view")
7
+
local unpack = (table.unpack or _G.unpack)
6
8
local function default_read_chunk(parser_state)
7
-
local function _0_()
9
+
local function _620_()
8
10
if (0 < parser_state["stack-size"]) then
9
11
return ".."
10
12
else
11
13
return ">> "
12
14
end
13
15
end
14
-
io.write(_0_())
16
+
io.write(_620_())
15
17
io.flush()
16
18
local input = io.read()
17
19
return (input and (input .. "\n"))
···
21
23
return io.write("\n")
22
24
end
23
25
local function default_on_error(errtype, err, lua_source)
24
-
local function _1_()
25
-
local _0_0 = errtype
26
-
if (_0_0 == "Lua Compile") then
26
+
local function _622_()
27
+
local _621_ = errtype
28
+
if (_621_ == "Lua Compile") then
27
29
return ("Bad code generated - likely a bug with the compiler:\n" .. "--- Generated Lua Start ---\n" .. lua_source .. "--- Generated Lua End ---\n")
28
-
elseif (_0_0 == "Runtime") then
30
+
elseif (_621_ == "Runtime") then
29
31
return (compiler.traceback(tostring(err), 4) .. "\n")
30
-
else
31
-
local _ = _0_0
32
+
elseif true then
33
+
local _ = _621_
32
34
return ("%s error: %s\n"):format(errtype, tostring(err))
35
+
else
36
+
return nil
33
37
end
34
38
end
35
-
return io.write(_1_())
39
+
return io.write(_622_())
36
40
end
37
-
local save_source = table.concat({"local ___i___ = 1", "while true do", " local name, value = debug.getlocal(1, ___i___)", " if(name and name ~= \"___i___\") then", " ___replLocals___[name] = value", " ___i___ = ___i___ + 1", " else break end end"}, "\n")
38
-
local function splice_save_locals(env, lua_source)
39
-
env.___replLocals___ = (env.___replLocals___ or {})
41
+
local save_source = " ___replLocals___['%s'] = %s"
42
+
local function splice_save_locals(env, lua_source, scope)
40
43
local spliced_source = {}
41
44
local bind = "local %s = ___replLocals___['%s']"
42
45
for line in lua_source:gmatch("([^\n]+)\n?") do
···
46
49
table.insert(spliced_source, 1, bind:format(name, name))
47
50
end
48
51
if ((1 < #spliced_source) and (spliced_source[#spliced_source]):match("^ *return .*$")) then
49
-
table.insert(spliced_source, #spliced_source, save_source)
52
+
for _, name in pairs(scope.manglings) do
53
+
table.insert(spliced_source, #spliced_source, save_source:format(name, name))
54
+
end
55
+
else
50
56
end
51
57
return table.concat(spliced_source, "\n")
52
58
end
59
+
local function completer(env, scope, text)
60
+
local max_items = 2000
61
+
local seen = {}
62
+
local matches = {}
63
+
local input_fragment = text:gsub(".*[%s)(]+", "")
64
+
local stop_looking_3f = false
65
+
local function add_partials(input, tbl, prefix)
66
+
local scope_first_3f = ((tbl == env) or (tbl == env.___replLocals___))
67
+
local tbl_14_auto = matches
68
+
local i_15_auto = #tbl_14_auto
69
+
local function _625_()
70
+
if scope_first_3f then
71
+
return scope.manglings
72
+
else
73
+
return tbl
74
+
end
75
+
end
76
+
for k, is_mangled in utils.allpairs(_625_()) do
77
+
if (max_items <= #matches) then break end
78
+
local val_16_auto
79
+
do
80
+
local lookup_k
81
+
if scope_first_3f then
82
+
lookup_k = is_mangled
83
+
else
84
+
lookup_k = k
85
+
end
86
+
if ((type(k) == "string") and (input == k:sub(0, #input)) and not seen[k] and ((":" ~= prefix:sub(-1)) or ("function" == type(tbl[lookup_k])))) then
87
+
seen[k] = true
88
+
val_16_auto = (prefix .. k)
89
+
else
90
+
val_16_auto = nil
91
+
end
92
+
end
93
+
if (nil ~= val_16_auto) then
94
+
i_15_auto = (i_15_auto + 1)
95
+
do end (tbl_14_auto)[i_15_auto] = val_16_auto
96
+
else
97
+
end
98
+
end
99
+
return tbl_14_auto
100
+
end
101
+
local function descend(input, tbl, prefix, add_matches, method_3f)
102
+
local splitter
103
+
if method_3f then
104
+
splitter = "^([^:]+):(.*)"
105
+
else
106
+
splitter = "^([^.]+)%.(.*)"
107
+
end
108
+
local head, tail = input:match(splitter)
109
+
local raw_head = (scope.manglings[head] or head)
110
+
if (type(tbl[raw_head]) == "table") then
111
+
stop_looking_3f = true
112
+
if method_3f then
113
+
return add_partials(tail, tbl[raw_head], (prefix .. head .. ":"))
114
+
else
115
+
return add_matches(tail, tbl[raw_head], (prefix .. head))
116
+
end
117
+
else
118
+
return nil
119
+
end
120
+
end
121
+
local function add_matches(input, tbl, prefix)
122
+
local prefix0
123
+
if prefix then
124
+
prefix0 = (prefix .. ".")
125
+
else
126
+
prefix0 = ""
127
+
end
128
+
if (not input:find("%.") and input:find(":")) then
129
+
return descend(input, tbl, prefix0, add_matches, true)
130
+
elseif not input:find("%.") then
131
+
return add_partials(input, tbl, prefix0)
132
+
else
133
+
return descend(input, tbl, prefix0, add_matches, false)
134
+
end
135
+
end
136
+
for _, source in ipairs({scope.specials, scope.macros, (env.___replLocals___ or {}), env, env._G}) do
137
+
if stop_looking_3f then break end
138
+
add_matches(input_fragment, source)
139
+
end
140
+
return matches
141
+
end
53
142
local commands = {}
54
143
local function command_3f(input)
55
144
return input:match("^%s*,")
56
145
end
57
146
local function command_docs()
58
-
local _0_
147
+
local _634_
59
148
do
60
-
local tbl_0_ = {}
149
+
local tbl_14_auto = {}
150
+
local i_15_auto = #tbl_14_auto
61
151
for name, f in pairs(commands) do
62
-
tbl_0_[(#tbl_0_ + 1)] = (" ,%s - %s"):format(name, ((compiler.metadata):get(f, "fnl/docstring") or "undocumented"))
152
+
local val_16_auto = (" ,%s - %s"):format(name, ((compiler.metadata):get(f, "fnl/docstring") or "undocumented"))
153
+
if (nil ~= val_16_auto) then
154
+
i_15_auto = (i_15_auto + 1)
155
+
do end (tbl_14_auto)[i_15_auto] = val_16_auto
156
+
else
157
+
end
63
158
end
64
-
_0_ = tbl_0_
159
+
_634_ = tbl_14_auto
65
160
end
66
-
return table.concat(_0_, "\n")
161
+
return table.concat(_634_, "\n")
67
162
end
68
163
commands.help = function(_, _0, on_values)
69
-
return on_values({("Welcome to Fennel.\nThis is the REPL where you can enter code to be evaluated.\nYou can also run these repl commands:\n\n" .. command_docs() .. "\n ,exit - Leave the repl.\n\nUse (doc something) to see descriptions for individual macros and special forms.\n\nFor more information about the language, see https://fennel-lang.org/reference")})
164
+
return on_values({("Welcome to Fennel.\nThis is the REPL where you can enter code to be evaluated.\nYou can also run these repl commands:\n\n" .. command_docs() .. "\n ,exit - Leave the repl.\n\nUse ,doc something to see descriptions for individual macros and special forms.\n\nFor more information about the language, see https://fennel-lang.org/reference")})
70
165
end
71
166
do end (compiler.metadata):set(commands.help, "fnl/docstring", "Show this message.")
72
167
local function reload(module_name, env, on_values, on_error)
73
-
local _0_0, _1_0 = pcall(specials["load-code"]("return require(...)", env), module_name)
74
-
if ((_0_0 == true) and (nil ~= _1_0)) then
75
-
local old = _1_0
76
-
local _ = nil
168
+
local _636_, _637_ = pcall(specials["load-code"]("return require(...)", env), module_name)
169
+
if ((_636_ == true) and (nil ~= _637_)) then
170
+
local old = _637_
171
+
local _
77
172
package.loaded[module_name] = nil
78
173
_ = nil
79
174
local ok, new = pcall(require, module_name)
80
-
local new0 = nil
175
+
local new0
81
176
if not ok then
82
177
on_values({new})
83
178
new0 = old
84
179
else
85
180
new0 = new
86
181
end
182
+
specials["macro-loaded"][module_name] = nil
87
183
if ((type(old) == "table") and (type(new0) == "table")) then
88
184
for k, v in pairs(new0) do
89
185
old[k] = v
90
186
end
91
187
for k in pairs(old) do
92
-
if (nil == new0[k]) then
188
+
if (nil == (new0)[k]) then
93
189
old[k] = nil
190
+
else
94
191
end
95
192
end
96
193
package.loaded[module_name] = old
194
+
else
97
195
end
98
196
return on_values({"ok"})
99
-
elseif ((_0_0 == false) and (nil ~= _1_0)) then
100
-
local msg = _1_0
101
-
local function _3_()
102
-
local _2_0 = msg:gsub("\n.*", "")
103
-
return _2_0
197
+
elseif ((_636_ == false) and (nil ~= _637_)) then
198
+
local msg = _637_
199
+
if (specials["macro-loaded"])[module_name] then
200
+
specials["macro-loaded"][module_name] = nil
201
+
return nil
202
+
else
203
+
local function _642_()
204
+
local _641_ = msg:gsub("\n.*", "")
205
+
return _641_
206
+
end
207
+
return on_error("Runtime", _642_())
104
208
end
105
-
return on_error("Runtime", _3_())
209
+
else
210
+
return nil
211
+
end
212
+
end
213
+
local function run_command(read, on_error, f)
214
+
local _645_, _646_, _647_ = pcall(read)
215
+
if ((_645_ == true) and (_646_ == true) and (nil ~= _647_)) then
216
+
local val = _647_
217
+
return f(val)
218
+
elseif (_645_ == false) then
219
+
return on_error("Parse", "Couldn't parse input.")
220
+
else
221
+
return nil
106
222
end
107
223
end
108
224
commands.reload = function(env, read, on_values, on_error)
109
-
local _0_0, _1_0, _2_0 = pcall(read)
110
-
if ((_0_0 == true) and (_1_0 == true) and (nil ~= _2_0)) then
111
-
local module_sym = _2_0
112
-
return reload(tostring(module_sym), env, on_values, on_error)
113
-
elseif ((_0_0 == false) and true and true) then
114
-
local _3fparse_ok = _1_0
115
-
local _3fmsg = _2_0
116
-
return on_error("Parse", (_3fmsg or _3fparse_ok))
225
+
local function _649_(_241)
226
+
return reload(tostring(_241), env, on_values, on_error)
117
227
end
228
+
return run_command(read, on_error, _649_)
118
229
end
119
230
do end (compiler.metadata):set(commands.reload, "fnl/docstring", "Reload the specified module.")
120
231
commands.reset = function(env, _, on_values)
···
122
233
return on_values({"ok"})
123
234
end
124
235
do end (compiler.metadata):set(commands.reset, "fnl/docstring", "Erase all repl-local scope.")
125
-
local function load_plugin_commands()
126
-
if (utils.root and utils.root.options and utils.root.options.plugins) then
127
-
for _, plugin in ipairs(utils.root.options.plugins) do
128
-
for name, f in pairs(plugin) do
129
-
local _0_0 = name:match("^repl%-command%-(.*)")
130
-
if (nil ~= _0_0) then
131
-
local cmd_name = _0_0
132
-
commands[cmd_name] = (commands[cmd_name] or f)
236
+
commands.complete = function(env, read, on_values, on_error, scope, chars)
237
+
local function _650_()
238
+
return on_values(completer(env, scope, string.char(unpack(chars)):gsub(",complete +", ""):sub(1, -2)))
239
+
end
240
+
return run_command(read, on_error, _650_)
241
+
end
242
+
do end (compiler.metadata):set(commands.complete, "fnl/docstring", "Print all possible completions for a given input symbol.")
243
+
local function apropos_2a(pattern, tbl, prefix, seen, names)
244
+
for name, subtbl in pairs(tbl) do
245
+
if (("string" == type(name)) and (package ~= subtbl)) then
246
+
local _651_ = type(subtbl)
247
+
if (_651_ == "function") then
248
+
if ((prefix .. name)):match(pattern) then
249
+
table.insert(names, (prefix .. name))
250
+
else
251
+
end
252
+
elseif (_651_ == "table") then
253
+
if not seen[subtbl] then
254
+
local _654_
255
+
do
256
+
local _653_ = seen
257
+
_653_[subtbl] = true
258
+
_654_ = _653_
259
+
end
260
+
apropos_2a(pattern, subtbl, (prefix .. name:gsub("%.", "/") .. "."), _654_, names)
261
+
else
262
+
end
263
+
else
264
+
end
265
+
else
266
+
end
267
+
end
268
+
return names
269
+
end
270
+
local function apropos(pattern)
271
+
local names = apropos_2a(pattern, package.loaded, "", {}, {})
272
+
local tbl_14_auto = {}
273
+
local i_15_auto = #tbl_14_auto
274
+
for _, name in ipairs(names) do
275
+
local val_16_auto = name:gsub("^_G%.", "")
276
+
if (nil ~= val_16_auto) then
277
+
i_15_auto = (i_15_auto + 1)
278
+
do end (tbl_14_auto)[i_15_auto] = val_16_auto
279
+
else
280
+
end
281
+
end
282
+
return tbl_14_auto
283
+
end
284
+
commands.apropos = function(_env, read, on_values, on_error, _scope)
285
+
local function _659_(_241)
286
+
return on_values(apropos(tostring(_241)))
287
+
end
288
+
return run_command(read, on_error, _659_)
289
+
end
290
+
do end (compiler.metadata):set(commands.apropos, "fnl/docstring", "Print all functions matching a pattern in all loaded modules.")
291
+
local function apropos_follow_path(path)
292
+
local paths
293
+
do
294
+
local tbl_14_auto = {}
295
+
local i_15_auto = #tbl_14_auto
296
+
for p in path:gmatch("[^%.]+") do
297
+
local val_16_auto = p
298
+
if (nil ~= val_16_auto) then
299
+
i_15_auto = (i_15_auto + 1)
300
+
do end (tbl_14_auto)[i_15_auto] = val_16_auto
301
+
else
302
+
end
303
+
end
304
+
paths = tbl_14_auto
305
+
end
306
+
local tgt = package.loaded
307
+
for _, path0 in ipairs(paths) do
308
+
if (nil == tgt) then break end
309
+
local _662_
310
+
do
311
+
local _661_ = path0:gsub("%/", ".")
312
+
_662_ = _661_
313
+
end
314
+
tgt = tgt[_662_]
315
+
end
316
+
return tgt
317
+
end
318
+
local function apropos_doc(pattern)
319
+
local tbl_14_auto = {}
320
+
local i_15_auto = #tbl_14_auto
321
+
for _, path in ipairs(apropos(".*")) do
322
+
local val_16_auto
323
+
do
324
+
local tgt = apropos_follow_path(path)
325
+
if ("function" == type(tgt)) then
326
+
local _663_ = (compiler.metadata):get(tgt, "fnl/docstring")
327
+
if (nil ~= _663_) then
328
+
local docstr = _663_
329
+
val_16_auto = (docstr:match(pattern) and path)
330
+
else
331
+
val_16_auto = nil
133
332
end
333
+
else
334
+
val_16_auto = nil
134
335
end
135
336
end
337
+
if (nil ~= val_16_auto) then
338
+
i_15_auto = (i_15_auto + 1)
339
+
do end (tbl_14_auto)[i_15_auto] = val_16_auto
340
+
else
341
+
end
342
+
end
343
+
return tbl_14_auto
344
+
end
345
+
commands["apropos-doc"] = function(_env, read, on_values, on_error, _scope)
346
+
local function _667_(_241)
347
+
return on_values(apropos_doc(tostring(_241)))
348
+
end
349
+
return run_command(read, on_error, _667_)
350
+
end
351
+
do end (compiler.metadata):set(commands["apropos-doc"], "fnl/docstring", "Print all functions that match the pattern in their docs")
352
+
local function apropos_show_docs(on_values, pattern)
353
+
for _, path in ipairs(apropos(pattern)) do
354
+
local tgt = apropos_follow_path(path)
355
+
if (("function" == type(tgt)) and (compiler.metadata):get(tgt, "fnl/docstring")) then
356
+
on_values(specials.doc(tgt, path))
357
+
on_values()
358
+
else
359
+
end
360
+
end
361
+
return nil
362
+
end
363
+
commands["apropos-show-docs"] = function(_env, read, on_values, on_error)
364
+
local function _669_(_241)
365
+
return apropos_show_docs(on_values, tostring(_241))
366
+
end
367
+
return run_command(read, on_error, _669_)
368
+
end
369
+
do end (compiler.metadata):set(commands["apropos-show-docs"], "fnl/docstring", "Print all documentations matching a pattern in function name")
370
+
local function resolve(identifier, _670_, scope)
371
+
local _arg_671_ = _670_
372
+
local ___replLocals___ = _arg_671_["___replLocals___"]
373
+
local env = _arg_671_
374
+
local e
375
+
local function _672_(_241, _242)
376
+
return (___replLocals___[_242] or env[_242])
377
+
end
378
+
e = setmetatable({}, {__index = _672_})
379
+
local _673_, _674_ = pcall(compiler["compile-string"], tostring(identifier), {scope = scope})
380
+
if ((_673_ == true) and (nil ~= _674_)) then
381
+
local code = _674_
382
+
return specials["load-code"](code, e)()
383
+
else
136
384
return nil
137
385
end
138
386
end
139
-
local function run_command(input, read, loop, env, on_values, on_error)
140
-
load_plugin_commands()
387
+
commands.find = function(env, read, on_values, on_error, scope)
388
+
local function _676_(_241)
389
+
local _677_
390
+
do
391
+
local _678_ = utils["sym?"](_241)
392
+
if (nil ~= _678_) then
393
+
local _679_ = resolve(_678_, env, scope)
394
+
if (nil ~= _679_) then
395
+
_677_ = debug.getinfo(_679_)
396
+
else
397
+
_677_ = _679_
398
+
end
399
+
else
400
+
_677_ = _678_
401
+
end
402
+
end
403
+
if ((_G.type(_677_) == "table") and ((_677_).what == "Lua") and (nil ~= (_677_).source) and (nil ~= (_677_).linedefined) and (nil ~= (_677_).short_src)) then
404
+
local source = (_677_).source
405
+
local line = (_677_).linedefined
406
+
local src = (_677_).short_src
407
+
local fnlsrc
408
+
do
409
+
local t_682_ = compiler.sourcemap
410
+
if (nil ~= t_682_) then
411
+
t_682_ = (t_682_)[source]
412
+
else
413
+
end
414
+
if (nil ~= t_682_) then
415
+
t_682_ = (t_682_)[line]
416
+
else
417
+
end
418
+
if (nil ~= t_682_) then
419
+
t_682_ = (t_682_)[2]
420
+
else
421
+
end
422
+
fnlsrc = t_682_
423
+
end
424
+
return on_values({string.format("%s:%s", src, (fnlsrc or line))})
425
+
elseif (_677_ == nil) then
426
+
return on_error("Repl", "Unknown value")
427
+
elseif true then
428
+
local _ = _677_
429
+
return on_error("Repl", "No source info")
430
+
else
431
+
return nil
432
+
end
433
+
end
434
+
return run_command(read, on_error, _676_)
435
+
end
436
+
do end (compiler.metadata):set(commands.find, "fnl/docstring", "Print the filename and line number for a given function")
437
+
commands.doc = function(env, read, on_values, on_error, scope)
438
+
local function _687_(_241)
439
+
local name = tostring(_241)
440
+
local path = (utils["multi-sym?"](name) or {name})
441
+
local ok_3f, target = nil, nil
442
+
local function _688_()
443
+
return (utils["get-in"](scope.specials, path) or utils["get-in"](scope.macros, path) or resolve(name, env, scope))
444
+
end
445
+
ok_3f, target = pcall(_688_)
446
+
if ok_3f then
447
+
return on_values({specials.doc(target, name)})
448
+
else
449
+
return on_error("Repl", "Could not resolve value for docstring lookup")
450
+
end
451
+
end
452
+
return run_command(read, on_error, _687_)
453
+
end
454
+
do end (compiler.metadata):set(commands.doc, "fnl/docstring", "Print the docstring and arglist for a function, macro, or special form.")
455
+
commands.compile = function(env, read, on_values, on_error, scope)
456
+
local function _690_(_241)
457
+
local allowedGlobals = specials["current-global-names"](env)
458
+
local ok_3f, result = pcall(compiler.compile, _241, {env = env, scope = scope, allowedGlobals = allowedGlobals})
459
+
if ok_3f then
460
+
return on_values({result})
461
+
else
462
+
return on_error("Repl", ("Error compiling expression: " .. result))
463
+
end
464
+
end
465
+
return run_command(read, on_error, _690_)
466
+
end
467
+
do end (compiler.metadata):set(commands.compile, "fnl/docstring", "compiles the expression into lua and prints the result.")
468
+
local function load_plugin_commands(plugins)
469
+
for _, plugin in ipairs((plugins or {})) do
470
+
for name, f in pairs(plugin) do
471
+
local _692_ = name:match("^repl%-command%-(.*)")
472
+
if (nil ~= _692_) then
473
+
local cmd_name = _692_
474
+
commands[cmd_name] = (commands[cmd_name] or f)
475
+
else
476
+
end
477
+
end
478
+
end
479
+
return nil
480
+
end
481
+
local function run_command_loop(input, read, loop, env, on_values, on_error, scope, chars)
141
482
local command_name = input:match(",([^%s/]+)")
142
483
do
143
-
local _0_0 = commands[command_name]
144
-
if (nil ~= _0_0) then
145
-
local command = _0_0
146
-
command(env, read, on_values, on_error)
147
-
else
148
-
local _ = _0_0
484
+
local _694_ = commands[command_name]
485
+
if (nil ~= _694_) then
486
+
local command = _694_
487
+
command(env, read, on_values, on_error, scope, chars)
488
+
elseif true then
489
+
local _ = _694_
149
490
if ("exit" ~= command_name) then
150
491
on_values({"Unknown command", command_name})
492
+
else
151
493
end
494
+
else
152
495
end
153
496
end
154
497
if ("exit" ~= command_name) then
155
498
return loop()
499
+
else
500
+
return nil
156
501
end
157
502
end
158
-
local function completer(env, scope, text)
159
-
local matches = {}
160
-
local input_fragment = text:gsub(".*[%s)(]+", "")
161
-
local function add_partials(input, tbl, prefix)
162
-
for k in utils.allpairs(tbl) do
163
-
local k0 = nil
164
-
if ((tbl == env) or (tbl == env.___replLocals___)) then
165
-
k0 = scope.unmanglings[k]
503
+
local function try_readline_21(opts, ok, readline)
504
+
if ok then
505
+
if readline.set_readline_name then
506
+
readline.set_readline_name("fennel")
507
+
else
508
+
end
509
+
do
510
+
local rl_opts
511
+
do
512
+
local tbl_11_auto = {keeplines = 1000, histfile = ""}
513
+
for k, v in pairs(readline.set_options({})) do
514
+
local _699_, _700_ = k, v
515
+
if ((nil ~= _699_) and (nil ~= _700_)) then
516
+
local k_12_auto = _699_
517
+
local v_13_auto = _700_
518
+
tbl_11_auto[k_12_auto] = v_13_auto
519
+
else
520
+
end
521
+
end
522
+
rl_opts = tbl_11_auto
523
+
end
524
+
readline.set_options(rl_opts)
525
+
end
526
+
opts.readChunk = function(parser_state)
527
+
local prompt
528
+
if (0 < parser_state["stack-size"]) then
529
+
prompt = ".. "
166
530
else
167
-
k0 = k
531
+
prompt = ">> "
168
532
end
169
-
if ((#matches < 2000) and (type(k0) == "string") and (input == k0:sub(0, #input))) then
170
-
table.insert(matches, (prefix .. k0))
533
+
local str = readline.readline(prompt)
534
+
if str then
535
+
return (str .. "\n")
536
+
else
537
+
return nil
171
538
end
172
539
end
173
-
return nil
174
-
end
175
-
local function add_matches(input, tbl, prefix)
176
-
local prefix0 = nil
177
-
if prefix then
178
-
prefix0 = (prefix .. ".")
179
-
else
180
-
prefix0 = ""
540
+
local completer0 = nil
541
+
opts.registerCompleter = function(repl_completer)
542
+
completer0 = repl_completer
543
+
return nil
181
544
end
182
-
if not input:find("%.") then
183
-
return add_partials(input, tbl, prefix0)
184
-
else
185
-
local head, tail = input:match("^([^.]+)%.(.*)")
186
-
local raw_head = nil
187
-
if ((tbl == env) or (tbl == env.___replLocals___)) then
188
-
raw_head = scope.manglings[head]
545
+
local function repl_completer(text, from, to)
546
+
if completer0 then
547
+
readline.set_completion_append_character("")
548
+
return completer0(text:sub(from, to))
189
549
else
190
-
raw_head = head
191
-
end
192
-
if (type(tbl[raw_head]) == "table") then
193
-
return add_matches(tail, tbl[raw_head], (prefix0 .. head))
550
+
return {}
194
551
end
195
552
end
553
+
readline.set_complete_function(repl_completer)
554
+
return readline
555
+
else
556
+
return nil
196
557
end
197
-
add_matches(input_fragment, (scope.specials or {}))
198
-
add_matches(input_fragment, (scope.macros or {}))
199
-
add_matches(input_fragment, (env.___replLocals___ or {}))
200
-
add_matches(input_fragment, env)
201
-
add_matches(input_fragment, (env._ENV or env._G or {}))
202
-
return matches
558
+
end
559
+
local function should_use_readline_3f(opts)
560
+
return (("dumb" ~= os.getenv("TERM")) and not opts.readChunk and not opts.registerCompleter)
203
561
end
204
-
local function repl(options)
562
+
local function repl(_3foptions)
205
563
local old_root_options = utils.root.options
206
-
local env = nil
207
-
if options.env then
208
-
env = specials["wrap-env"](options.env)
209
-
else
210
-
env = setmetatable({}, {__index = (rawget(_G, "_ENV") or _G)})
211
-
end
212
-
local save_locals_3f = ((options.saveLocals ~= false) and env.debug and env.debug.getlocal)
213
-
local opts = {}
214
-
local _ = nil
215
-
for k, v in pairs(options) do
216
-
opts[k] = v
217
-
end
218
-
_ = nil
564
+
local opts = ((_3foptions and utils.copy(_3foptions)) or {})
565
+
local readline = (should_use_readline_3f(opts) and try_readline_21(opts, pcall(require, "readline")))
566
+
local env = specials["wrap-env"]((opts.env or rawget(_G, "_ENV") or _G))
567
+
local save_locals_3f = (opts.saveLocals ~= false)
219
568
local read_chunk = (opts.readChunk or default_read_chunk)
220
569
local on_values = (opts.onValues or default_on_values)
221
570
local on_error = (opts.onError or default_on_error)
222
-
local pp = (opts.pp or tostring)
571
+
local pp = (opts.pp or view)
223
572
local byte_stream, clear_stream = parser.granulate(read_chunk)
224
573
local chars = {}
225
574
local read, reset = nil, nil
226
-
local function _1_(parser_state)
575
+
local function _706_(parser_state)
227
576
local c = byte_stream(parser_state)
228
577
table.insert(chars, c)
229
578
return c
230
579
end
231
-
read, reset = parser.parser(_1_)
232
-
local scope = compiler["make-scope"]()
233
-
opts.useMetadata = (options.useMetadata ~= false)
580
+
read, reset = parser.parser(_706_)
581
+
opts.env, opts.scope = env, compiler["make-scope"]()
582
+
opts.useMetadata = (opts.useMetadata ~= false)
234
583
if (opts.allowedGlobals == nil) then
235
-
opts.allowedGlobals = specials["current-global-names"](opts.env)
584
+
opts.allowedGlobals = specials["current-global-names"](env)
585
+
else
236
586
end
237
587
if opts.registerCompleter then
238
-
local function _3_(...)
239
-
return completer(env, scope, ...)
588
+
local function _710_()
589
+
local _708_ = env
590
+
local _709_ = opts.scope
591
+
local function _711_(...)
592
+
return completer(_708_, _709_, ...)
593
+
end
594
+
return _711_
240
595
end
241
-
opts.registerCompleter(_3_)
596
+
opts.registerCompleter(_710_())
597
+
else
598
+
end
599
+
load_plugin_commands(opts.plugins)
600
+
if save_locals_3f then
601
+
local function newindex(t, k, v)
602
+
if opts.scope.unmanglings[k] then
603
+
return rawset(t, k, v)
604
+
else
605
+
return nil
606
+
end
607
+
end
608
+
env.___replLocals___ = setmetatable({}, {__newindex = newindex})
609
+
else
242
610
end
243
611
local function print_values(...)
244
612
local vals = {...}
···
253
621
for k in pairs(chars) do
254
622
chars[k] = nil
255
623
end
256
-
local ok, parse_ok_3f, x = pcall(read)
257
-
local src_string = string.char((table.unpack or _G.unpack)(chars))
258
-
utils.root.options = opts
624
+
reset()
625
+
local ok, not_eof_3f, x = pcall(read)
626
+
local src_string = string.char(unpack(chars))
259
627
if not ok then
260
-
on_error("Parse", parse_ok_3f)
628
+
on_error("Parse", not_eof_3f)
261
629
clear_stream()
262
-
reset()
263
630
return loop()
264
631
elseif command_3f(src_string) then
265
-
return run_command(src_string, read, loop, env, on_values, on_error)
632
+
return run_command_loop(src_string, read, loop, env, on_values, on_error, opts.scope, chars)
266
633
else
267
-
if parse_ok_3f then
634
+
if not_eof_3f then
268
635
do
269
-
local _4_0, _5_0 = pcall(compiler.compile, x, {["assert-compile"] = opts["assert-compile"], ["parse-error"] = opts["parse-error"], correlate = opts.correlate, moduleName = opts.moduleName, scope = scope, source = src_string, useMetadata = opts.useMetadata})
270
-
if ((_4_0 == false) and (nil ~= _5_0)) then
271
-
local msg = _5_0
636
+
local _715_, _716_ = nil, nil
637
+
local function _718_()
638
+
local _717_ = opts
639
+
_717_["source"] = src_string
640
+
return _717_
641
+
end
642
+
_715_, _716_ = pcall(compiler.compile, x, _718_())
643
+
if ((_715_ == false) and (nil ~= _716_)) then
644
+
local msg = _716_
272
645
clear_stream()
273
646
on_error("Compile", msg)
274
-
elseif ((_4_0 == true) and (nil ~= _5_0)) then
275
-
local src = _5_0
276
-
local src0 = nil
647
+
elseif ((_715_ == true) and (nil ~= _716_)) then
648
+
local src = _716_
649
+
local src0
277
650
if save_locals_3f then
278
-
src0 = splice_save_locals(env, src)
651
+
src0 = splice_save_locals(env, src, opts.scope)
279
652
else
280
653
src0 = src
281
654
end
282
-
local _7_0, _8_0 = pcall(specials["load-code"], src0, env)
283
-
if ((_7_0 == false) and (nil ~= _8_0)) then
284
-
local msg = _8_0
655
+
local _720_, _721_ = pcall(specials["load-code"], src0, env)
656
+
if ((_720_ == false) and (nil ~= _721_)) then
657
+
local msg = _721_
285
658
clear_stream()
286
659
on_error("Lua Compile", msg, src0)
287
-
elseif (true and (nil ~= _8_0)) then
288
-
local _0 = _7_0
289
-
local chunk = _8_0
290
-
local function _9_()
660
+
elseif (true and (nil ~= _721_)) then
661
+
local _ = _720_
662
+
local chunk = _721_
663
+
local function _722_()
291
664
return print_values(chunk())
292
665
end
293
-
local function _10_(...)
294
-
return on_error("Runtime", ...)
666
+
local function _723_()
667
+
local function _724_(...)
668
+
return on_error("Runtime", ...)
669
+
end
670
+
return _724_
295
671
end
296
-
xpcall(_9_, _10_)
672
+
xpcall(_722_, _723_())
673
+
else
297
674
end
675
+
else
298
676
end
299
677
end
300
678
utils.root.options = old_root_options
301
679
return loop()
302
-
end
303
-
end
304
-
end
305
-
return loop()
306
-
end
307
-
return repl
308
-
end
309
-
package.preload["fennel.view"] = package.preload["fennel.view"] or function(...)
310
-
local type_order = {["function"] = 5, boolean = 2, number = 1, string = 3, table = 4, thread = 7, userdata = 6}
311
-
local function sort_keys(_0_0, _1_0)
312
-
local _1_ = _0_0
313
-
local a = _1_[1]
314
-
local _2_ = _1_0
315
-
local b = _2_[1]
316
-
local ta = type(a)
317
-
local tb = type(b)
318
-
if ((ta == tb) and ((ta == "string") or (ta == "number"))) then
319
-
return (a < b)
320
-
else
321
-
local dta = type_order[ta]
322
-
local dtb = type_order[tb]
323
-
if (dta and dtb) then
324
-
return (dta < dtb)
325
-
elseif dta then
326
-
return true
327
-
elseif dtb then
328
-
return false
329
-
else
330
-
return (ta < tb)
331
-
end
332
-
end
333
-
end
334
-
local function table_kv_pairs(t)
335
-
local assoc_3f = false
336
-
local kv = {}
337
-
local insert = table.insert
338
-
for k, v in pairs(t) do
339
-
if (type(k) ~= "number") then
340
-
assoc_3f = true
341
-
end
342
-
insert(kv, {k, v})
343
-
end
344
-
table.sort(kv, sort_keys)
345
-
if (#kv == 0) then
346
-
return kv, "empty"
347
-
else
348
-
local function _2_()
349
-
if assoc_3f then
350
-
return "table"
351
680
else
352
-
return "seq"
353
-
end
354
-
end
355
-
return kv, _2_()
356
-
end
357
-
end
358
-
local function count_table_appearances(t, appearances)
359
-
if (type(t) == "table") then
360
-
if not appearances[t] then
361
-
appearances[t] = 1
362
-
for k, v in pairs(t) do
363
-
count_table_appearances(k, appearances)
364
-
count_table_appearances(v, appearances)
681
+
return nil
365
682
end
366
-
else
367
-
appearances[t] = ((appearances[t] or 0) + 1)
368
683
end
369
684
end
370
-
return appearances
371
-
end
372
-
local function save_table(t, seen)
373
-
local seen0 = (seen or {len = 0})
374
-
local id = (seen0.len + 1)
375
-
if not seen0[t] then
376
-
seen0[t] = id
377
-
seen0.len = id
378
-
end
379
-
return seen0
380
-
end
381
-
local function detect_cycle(t, seen)
382
-
local seen0 = (seen or {})
383
-
seen0[t] = true
384
-
for k, v in pairs(t) do
385
-
if ((type(k) == "table") and (seen0[k] or detect_cycle(k, seen0))) then
386
-
return true
387
-
end
388
-
if ((type(v) == "table") and (seen0[v] or detect_cycle(v, seen0))) then
389
-
return true
390
-
end
391
-
end
392
-
return nil
393
-
end
394
-
local function visible_cycle_3f(t, options)
395
-
return (options["detect-cycles?"] and detect_cycle(t) and save_table(t, options.seen) and (1 < (options.appearances[t] or 0)))
396
-
end
397
-
local function table_indent(t, indent, id)
398
-
local opener_length = nil
399
-
if id then
400
-
opener_length = (#tostring(id) + 2)
685
+
loop()
686
+
if readline then
687
+
return readline.save_history()
401
688
else
402
-
opener_length = 1
689
+
return nil
403
690
end
404
-
return (indent + opener_length)
405
691
end
406
-
local pp = {}
407
-
local function concat_table_lines(elements, options, multiline_3f, indent, table_type, prefix)
408
-
local indent_str = ("\n" .. string.rep(" ", indent))
409
-
local open = nil
410
-
local function _2_()
411
-
if ("seq" == table_type) then
412
-
return "["
413
-
else
414
-
return "{"
415
-
end
416
-
end
417
-
open = ((prefix or "") .. _2_())
418
-
local close = nil
419
-
if ("seq" == table_type) then
420
-
close = "]"
421
-
else
422
-
close = "}"
423
-
end
424
-
local oneline = (open .. table.concat(elements, " ") .. close)
425
-
local _4_
426
-
if (table_type == "seq") then
427
-
_4_ = options["sequential-length"]
428
-
else
429
-
_4_ = options["associative-length"]
430
-
end
431
-
if (not options["one-line?"] and (multiline_3f or (#elements > _4_) or ((indent + #oneline) > options["line-length"]))) then
432
-
return (open .. table.concat(elements, indent_str) .. close)
433
-
else
434
-
return oneline
435
-
end
436
-
end
437
-
local function pp_associative(t, kv, options, indent, key_3f)
438
-
local multiline_3f = false
439
-
local id = options.seen[t]
440
-
if (options.level >= options.depth) then
441
-
return "{...}"
442
-
elseif (id and options["detect-cycles?"]) then
443
-
return ("@" .. id .. "{...}")
444
-
else
445
-
local visible_cycle_3f0 = visible_cycle_3f(t, options)
446
-
local id0 = (visible_cycle_3f0 and options.seen[t])
447
-
local indent0 = table_indent(t, indent, id0)
448
-
local slength = nil
449
-
local function _3_()
450
-
local _2_0 = rawget(_G, "utf8")
451
-
if _2_0 then
452
-
return _2_0.len
453
-
else
454
-
return _2_0
455
-
end
456
-
end
457
-
local function _4_(_241)
458
-
return #_241
459
-
end
460
-
slength = ((options["utf8?"] and _3_()) or _4_)
461
-
local prefix = nil
462
-
if visible_cycle_3f0 then
463
-
prefix = ("@" .. id0)
464
-
else
465
-
prefix = ""
466
-
end
467
-
local elements = nil
468
-
do
469
-
local tbl_0_ = {}
470
-
for _, _6_0 in pairs(kv) do
471
-
local _7_ = _6_0
472
-
local k = _7_[1]
473
-
local v = _7_[2]
474
-
local _8_
475
-
do
476
-
local k0 = pp.pp(k, options, (indent0 + 1), true)
477
-
local v0 = pp.pp(v, options, (indent0 + slength(k0) + 1))
478
-
multiline_3f = (multiline_3f or k0:find("\n") or v0:find("\n"))
479
-
_8_ = (k0 .. " " .. v0)
480
-
end
481
-
tbl_0_[(#tbl_0_ + 1)] = _8_
482
-
end
483
-
elements = tbl_0_
484
-
end
485
-
return concat_table_lines(elements, options, multiline_3f, indent0, "table", prefix)
486
-
end
487
-
end
488
-
local function pp_sequence(t, kv, options, indent)
489
-
local multiline_3f = false
490
-
local id = options.seen[t]
491
-
if (options.level >= options.depth) then
492
-
return "[...]"
493
-
elseif (id and options["detect-cycles?"]) then
494
-
return ("@" .. id .. "[...]")
495
-
else
496
-
local visible_cycle_3f0 = visible_cycle_3f(t, options)
497
-
local id0 = (visible_cycle_3f0 and options.seen[t])
498
-
local indent0 = table_indent(t, indent, id0)
499
-
local prefix = nil
500
-
if visible_cycle_3f0 then
501
-
prefix = ("@" .. id0)
502
-
else
503
-
prefix = ""
504
-
end
505
-
local elements = nil
506
-
do
507
-
local tbl_0_ = {}
508
-
for _, _3_0 in pairs(kv) do
509
-
local _4_ = _3_0
510
-
local _0 = _4_[1]
511
-
local v = _4_[2]
512
-
local _5_
513
-
do
514
-
local v0 = pp.pp(v, options, indent0)
515
-
multiline_3f = (multiline_3f or v0:find("\n"))
516
-
_5_ = v0
517
-
end
518
-
tbl_0_[(#tbl_0_ + 1)] = _5_
519
-
end
520
-
elements = tbl_0_
521
-
end
522
-
return concat_table_lines(elements, options, multiline_3f, indent0, "seq", prefix)
523
-
end
524
-
end
525
-
local function concat_lines(lines, options, indent, force_multi_line_3f)
526
-
if (#lines == 0) then
527
-
if options["empty-as-sequence?"] then
528
-
return "[]"
529
-
else
530
-
return "{}"
531
-
end
532
-
else
533
-
local oneline = nil
534
-
local _2_
535
-
do
536
-
local tbl_0_ = {}
537
-
for _, line in ipairs(lines) do
538
-
tbl_0_[(#tbl_0_ + 1)] = line:gsub("^%s+", "")
539
-
end
540
-
_2_ = tbl_0_
541
-
end
542
-
oneline = table.concat(_2_, " ")
543
-
if (not options["one-line?"] and (force_multi_line_3f or oneline:find("\n") or ((indent + #oneline) > options["line-length"]))) then
544
-
return table.concat(lines, ("\n" .. string.rep(" ", indent)))
545
-
else
546
-
return oneline
547
-
end
548
-
end
549
-
end
550
-
local function pp_metamethod(t, metamethod, options, indent)
551
-
if (options.level >= options.depth) then
552
-
if options["empty-as-sequence?"] then
553
-
return "[...]"
554
-
else
555
-
return "{...}"
556
-
end
557
-
else
558
-
local _ = nil
559
-
local function _2_(_241)
560
-
return visible_cycle_3f(_241, options)
561
-
end
562
-
options["visible-cycle?"] = _2_
563
-
_ = nil
564
-
local lines, force_multi_line_3f = metamethod(t, pp.pp, options, indent)
565
-
options["visible-cycle?"] = nil
566
-
local _3_0 = type(lines)
567
-
if (_3_0 == "string") then
568
-
return lines
569
-
elseif (_3_0 == "table") then
570
-
return concat_lines(lines, options, indent, force_multi_line_3f)
571
-
else
572
-
local _0 = _3_0
573
-
return error("Error: __fennelview metamethod must return a table of lines")
574
-
end
575
-
end
576
-
end
577
-
local function pp_table(x, options, indent)
578
-
options.level = (options.level + 1)
579
-
local x0 = nil
580
-
do
581
-
local _2_0 = nil
582
-
if options["metamethod?"] then
583
-
local _3_0 = x
584
-
if _3_0 then
585
-
local _4_0 = getmetatable(_3_0)
586
-
if _4_0 then
587
-
_2_0 = _4_0.__fennelview
588
-
else
589
-
_2_0 = _4_0
590
-
end
591
-
else
592
-
_2_0 = _3_0
593
-
end
594
-
else
595
-
_2_0 = nil
596
-
end
597
-
if (nil ~= _2_0) then
598
-
local metamethod = _2_0
599
-
x0 = pp_metamethod(x, metamethod, options, indent)
600
-
else
601
-
local _ = _2_0
602
-
local _4_0, _5_0 = table_kv_pairs(x)
603
-
if (true and (_5_0 == "empty")) then
604
-
local _0 = _4_0
605
-
if options["empty-as-sequence?"] then
606
-
x0 = "[]"
607
-
else
608
-
x0 = "{}"
609
-
end
610
-
elseif ((nil ~= _4_0) and (_5_0 == "table")) then
611
-
local kv = _4_0
612
-
x0 = pp_associative(x, kv, options, indent)
613
-
elseif ((nil ~= _4_0) and (_5_0 == "seq")) then
614
-
local kv = _4_0
615
-
x0 = pp_sequence(x, kv, options, indent)
616
-
else
617
-
x0 = nil
618
-
end
619
-
end
620
-
end
621
-
options.level = (options.level - 1)
622
-
return x0
623
-
end
624
-
local function number__3estring(n)
625
-
local _2_0, _3_0, _4_0 = math.modf(n)
626
-
if ((nil ~= _2_0) and (_3_0 == 0)) then
627
-
local int = _2_0
628
-
return tostring(int)
629
-
else
630
-
local _5_
631
-
do
632
-
local frac = _3_0
633
-
_5_ = (((_2_0 == 0) and (nil ~= _3_0)) and (frac < 0))
634
-
end
635
-
if _5_ then
636
-
local frac = _3_0
637
-
return ("-0." .. tostring(frac):gsub("^-?0.", ""))
638
-
elseif ((nil ~= _2_0) and (nil ~= _3_0)) then
639
-
local int = _2_0
640
-
local frac = _3_0
641
-
return (int .. "." .. tostring(frac):gsub("^-?0.", ""))
642
-
end
643
-
end
644
-
end
645
-
local function colon_string_3f(s)
646
-
return s:find("^[-%w?\\^_!$%&*+./@:|<=>]+$")
647
-
end
648
-
local function make_options(t, options)
649
-
local defaults = {["associative-length"] = 4, ["detect-cycles?"] = true, ["empty-as-sequence?"] = false, ["line-length"] = 80, ["metamethod?"] = true, ["one-line?"] = false, ["sequential-length"] = 10, ["utf8?"] = true, depth = 128}
650
-
local overrides = {appearances = count_table_appearances(t, {}), level = 0, seen = {len = 0}}
651
-
for k, v in pairs((options or {})) do
652
-
defaults[k] = v
653
-
end
654
-
for k, v in pairs(overrides) do
655
-
defaults[k] = v
656
-
end
657
-
return defaults
658
-
end
659
-
pp.pp = function(x, options, indent, key_3f)
660
-
local indent0 = (indent or 0)
661
-
local options0 = (options or make_options(x))
662
-
local tv = type(x)
663
-
local function _3_()
664
-
local _2_0 = getmetatable(x)
665
-
if _2_0 then
666
-
return _2_0.__fennelview
667
-
else
668
-
return _2_0
669
-
end
670
-
end
671
-
if ((tv == "table") or ((tv == "userdata") and _3_())) then
672
-
return pp_table(x, options0, indent0)
673
-
elseif (tv == "number") then
674
-
return number__3estring(x)
675
-
elseif ((tv == "string") and key_3f and colon_string_3f(x)) then
676
-
return (":" .. x)
677
-
elseif (tv == "string") then
678
-
return string.format("%q", x)
679
-
elseif ((tv == "boolean") or (tv == "nil")) then
680
-
return tostring(x)
681
-
else
682
-
return ("#<" .. tostring(x) .. ">")
683
-
end
684
-
end
685
-
local function view(x, options)
686
-
return pp.pp(x, make_options(x, options), 0)
687
-
end
688
-
return view
692
+
return repl
689
693
end
690
694
package.preload["fennel.specials"] = package.preload["fennel.specials"] or function(...)
691
695
local utils = require("fennel.utils")
···
695
699
local unpack = (table.unpack or _G.unpack)
696
700
local SPECIALS = compiler.scopes.global.specials
697
701
local function wrap_env(env)
698
-
local function _0_(_, key)
699
-
if (type(key) == "string") then
702
+
local function _415_(_, key)
703
+
if utils["string?"](key) then
700
704
return env[compiler["global-unmangling"](key)]
701
705
else
702
706
return env[key]
703
707
end
704
708
end
705
-
local function _1_(_, key, value)
706
-
if (type(key) == "string") then
709
+
local function _417_(_, key, value)
710
+
if utils["string?"](key) then
707
711
env[compiler["global-unmangling"](key)] = value
708
712
return nil
709
713
else
···
711
715
return nil
712
716
end
713
717
end
714
-
local function _2_()
718
+
local function _419_()
715
719
local function putenv(k, v)
716
-
local _3_
717
-
if (type(k) == "string") then
718
-
_3_ = compiler["global-unmangling"](k)
720
+
local _420_
721
+
if utils["string?"](k) then
722
+
_420_ = compiler["global-unmangling"](k)
719
723
else
720
-
_3_ = k
724
+
_420_ = k
721
725
end
722
-
return _3_, v
726
+
return _420_, v
723
727
end
724
728
return next, utils.kvmap(env, putenv), nil
725
729
end
726
-
return setmetatable({}, {__index = _0_, __newindex = _1_, __pairs = _2_})
730
+
return setmetatable({}, {__index = _415_, __newindex = _417_, __pairs = _419_})
727
731
end
728
-
local function current_global_names(env)
729
-
return utils.kvmap((env or _G), compiler["global-unmangling"])
732
+
local function current_global_names(_3fenv)
733
+
local mt
734
+
do
735
+
local _422_ = getmetatable(_3fenv)
736
+
if ((_G.type(_422_) == "table") and (nil ~= (_422_).__pairs)) then
737
+
local mtpairs = (_422_).__pairs
738
+
local tbl_11_auto = {}
739
+
for k, v in mtpairs(_3fenv) do
740
+
local _423_, _424_ = k, v
741
+
if ((nil ~= _423_) and (nil ~= _424_)) then
742
+
local k_12_auto = _423_
743
+
local v_13_auto = _424_
744
+
tbl_11_auto[k_12_auto] = v_13_auto
745
+
else
746
+
end
747
+
end
748
+
mt = tbl_11_auto
749
+
elseif (_422_ == nil) then
750
+
mt = (_3fenv or _G)
751
+
else
752
+
mt = nil
753
+
end
754
+
end
755
+
return (mt and utils.kvmap(mt, compiler["global-unmangling"]))
730
756
end
731
-
local function load_code(code, environment, filename)
732
-
local environment0 = (environment or rawget(_G, "_ENV") or _G)
733
-
if (rawget(_G, "setfenv") and rawget(_G, "loadstring")) then
734
-
local f = assert(_G.loadstring(code, filename))
735
-
_G.setfenv(f, environment0)
736
-
return f
757
+
local function load_code(code, _3fenv, _3ffilename)
758
+
local env = (_3fenv or rawget(_G, "_ENV") or _G)
759
+
local _427_, _428_ = rawget(_G, "setfenv"), rawget(_G, "loadstring")
760
+
if ((nil ~= _427_) and (nil ~= _428_)) then
761
+
local setfenv = _427_
762
+
local loadstring = _428_
763
+
local f = assert(loadstring(code, _3ffilename))
764
+
local _429_ = f
765
+
setfenv(_429_, env)
766
+
return _429_
767
+
elseif true then
768
+
local _ = _427_
769
+
return assert(load(code, _3ffilename, "t", env))
737
770
else
738
-
return assert(load(code, filename, "t", environment0))
771
+
return nil
739
772
end
740
773
end
741
774
local function doc_2a(tgt, name)
···
746
779
local mt = getmetatable(tgt)
747
780
if ((type(tgt) == "function") or ((type(mt) == "table") and (type(mt.__call) == "function"))) then
748
781
local arglist = table.concat(((compiler.metadata):get(tgt, "fnl/arglist") or {"#<unknown-arguments>"}), " ")
749
-
local _0_
750
-
if (#arglist > 0) then
751
-
_0_ = " "
782
+
local _431_
783
+
if (0 < #arglist) then
784
+
_431_ = " "
752
785
else
753
-
_0_ = ""
786
+
_431_ = ""
754
787
end
755
-
return string.format("(%s%s%s)\n %s", name, _0_, arglist, docstring)
788
+
return string.format("(%s%s%s)\n %s", name, _431_, arglist, docstring)
756
789
else
757
790
return string.format("%s\n %s", name, docstring)
758
791
end
759
792
end
760
793
end
761
-
local function doc_special(name, arglist, docstring)
762
-
compiler.metadata[SPECIALS[name]] = {["fnl/arglist"] = arglist, ["fnl/docstring"] = docstring}
794
+
local function doc_special(name, arglist, docstring, body_form_3f)
795
+
compiler.metadata[SPECIALS[name]] = {["fnl/arglist"] = arglist, ["fnl/docstring"] = docstring, ["fnl/body-form?"] = body_form_3f}
763
796
return nil
764
797
end
765
-
local function compile_do(ast, scope, parent, start)
766
-
local start0 = (start or 2)
798
+
local function compile_do(ast, scope, parent, _3fstart)
799
+
local start = (_3fstart or 2)
767
800
local len = #ast
768
801
local sub_scope = compiler["make-scope"](scope)
769
-
for i = start0, len do
802
+
for i = start, len do
770
803
compiler.compile1(ast[i], sub_scope, parent, {nval = 0})
771
804
end
772
805
return nil
773
806
end
774
-
SPECIALS["do"] = function(ast, scope, parent, opts, start, chunk, sub_scope, pre_syms)
775
-
local start0 = (start or 2)
776
-
local sub_scope0 = (sub_scope or compiler["make-scope"](scope))
777
-
local chunk0 = (chunk or {})
807
+
SPECIALS["do"] = function(ast, scope, parent, opts, _3fstart, _3fchunk, _3fsub_scope, _3fpre_syms)
808
+
local start = (_3fstart or 2)
809
+
local sub_scope = (_3fsub_scope or compiler["make-scope"](scope))
810
+
local chunk = (_3fchunk or {})
778
811
local len = #ast
779
812
local retexprs = {returned = true}
780
813
local function compile_body(outer_target, outer_tail, outer_retexprs)
781
-
if (len < start0) then
782
-
compiler.compile1(nil, sub_scope0, chunk0, {tail = outer_tail, target = outer_target})
814
+
if (len < start) then
815
+
compiler.compile1(nil, sub_scope, chunk, {tail = outer_tail, target = outer_target})
783
816
else
784
-
for i = start0, len do
817
+
for i = start, len do
785
818
local subopts = {nval = (((i ~= len) and 0) or opts.nval), tail = (((i == len) and outer_tail) or nil), target = (((i == len) and outer_target) or nil)}
786
819
local _ = utils["propagate-options"](opts, subopts)
787
-
local subexprs = compiler.compile1(ast[i], sub_scope0, chunk0, subopts)
820
+
local subexprs = compiler.compile1(ast[i], sub_scope, chunk, subopts)
788
821
if (i ~= len) then
789
822
compiler["keep-side-effects"](subexprs, parent, nil, ast[i])
823
+
else
790
824
end
791
825
end
792
826
end
793
-
compiler.emit(parent, chunk0, ast)
827
+
compiler.emit(parent, chunk, ast)
794
828
compiler.emit(parent, "end", ast)
829
+
utils.hook("do", ast, sub_scope)
795
830
return (outer_retexprs or retexprs)
796
831
end
797
832
if (opts.target or (opts.nval == 0) or opts.tail) then
···
800
835
elseif opts.nval then
801
836
local syms = {}
802
837
for i = 1, opts.nval do
803
-
local s = ((pre_syms and pre_syms[i]) or compiler.gensym(scope))
804
-
syms[i] = s
838
+
local s = ((_3fpre_syms and (_3fpre_syms)[i]) or compiler.gensym(scope))
839
+
do end (syms)[i] = s
805
840
retexprs[i] = utils.expr(s, "sym")
806
841
end
807
842
local outer_target = table.concat(syms, ", ")
···
810
845
return compile_body(outer_target, opts.tail)
811
846
else
812
847
local fname = compiler.gensym(scope)
813
-
local fargs = nil
848
+
local fargs
814
849
if scope.vararg then
815
850
fargs = "..."
816
851
else
817
852
fargs = ""
818
853
end
819
854
compiler.emit(parent, string.format("local function %s(%s)", fname, fargs), ast)
820
-
utils.hook("do", ast, sub_scope0)
821
855
return compile_body(nil, true, utils.expr((fname .. "(" .. fargs .. ")"), "statement"))
822
856
end
823
857
end
824
-
doc_special("do", {"..."}, "Evaluate multiple forms; return last value.")
858
+
doc_special("do", {"..."}, "Evaluate multiple forms; return last value.", true)
825
859
SPECIALS.values = function(ast, scope, parent)
826
860
local len = #ast
827
861
local exprs = {}
···
832
866
for j = 2, #subexprs do
833
867
table.insert(exprs, subexprs[j])
834
868
end
869
+
else
835
870
end
836
871
end
837
872
return exprs
838
873
end
839
874
doc_special("values", {"..."}, "Return multiple values from a function. Must be in tail position.")
840
875
local function deep_tostring(x, key_3f)
841
-
local elems = {}
842
-
if utils["sequence?"](x) then
843
-
local _0_
876
+
if utils["list?"](x) then
877
+
local _440_
878
+
do
879
+
local tbl_14_auto = {}
880
+
local i_15_auto = #tbl_14_auto
881
+
for _, v in ipairs(x) do
882
+
local val_16_auto = deep_tostring(v)
883
+
if (nil ~= val_16_auto) then
884
+
i_15_auto = (i_15_auto + 1)
885
+
do end (tbl_14_auto)[i_15_auto] = val_16_auto
886
+
else
887
+
end
888
+
end
889
+
_440_ = tbl_14_auto
890
+
end
891
+
return ("(" .. table.concat(_440_, " ") .. ")")
892
+
elseif utils["sequence?"](x) then
893
+
local _442_
844
894
do
845
-
local tbl_0_ = {}
895
+
local tbl_14_auto = {}
896
+
local i_15_auto = #tbl_14_auto
846
897
for _, v in ipairs(x) do
847
-
tbl_0_[(#tbl_0_ + 1)] = deep_tostring(v)
898
+
local val_16_auto = deep_tostring(v)
899
+
if (nil ~= val_16_auto) then
900
+
i_15_auto = (i_15_auto + 1)
901
+
do end (tbl_14_auto)[i_15_auto] = val_16_auto
902
+
else
903
+
end
848
904
end
849
-
_0_ = tbl_0_
905
+
_442_ = tbl_14_auto
850
906
end
851
-
return ("[" .. table.concat(_0_, " ") .. "]")
907
+
return ("[" .. table.concat(_442_, " ") .. "]")
852
908
elseif utils["table?"](x) then
853
-
local _0_
909
+
local _444_
854
910
do
855
-
local tbl_0_ = {}
856
-
for k, v in pairs(x) do
857
-
tbl_0_[(#tbl_0_ + 1)] = (deep_tostring(k, true) .. " " .. deep_tostring(v))
911
+
local tbl_14_auto = {}
912
+
local i_15_auto = #tbl_14_auto
913
+
for k, v in utils.stablepairs(x) do
914
+
local val_16_auto = (deep_tostring(k, true) .. " " .. deep_tostring(v))
915
+
if (nil ~= val_16_auto) then
916
+
i_15_auto = (i_15_auto + 1)
917
+
do end (tbl_14_auto)[i_15_auto] = val_16_auto
918
+
else
919
+
end
858
920
end
859
-
_0_ = tbl_0_
921
+
_444_ = tbl_14_auto
860
922
end
861
-
return ("{" .. table.concat(_0_, " ") .. "}")
862
-
elseif (key_3f and (type(x) == "string") and x:find("^[-%w?\\^_!$%&*+./@:|<=>]+$")) then
923
+
return ("{" .. table.concat(_444_, " ") .. "}")
924
+
elseif (key_3f and utils["string?"](x) and x:find("^[-%w?\\^_!$%&*+./@:|<=>]+$")) then
863
925
return (":" .. x)
864
-
elseif (type(x) == "string") then
926
+
elseif utils["string?"](x) then
865
927
return string.format("%q", x):gsub("\\\"", "\\\\\""):gsub("\"", "\\\"")
866
928
else
867
929
return tostring(x)
···
869
931
end
870
932
local function set_fn_metadata(arg_list, docstring, parent, fn_name)
871
933
if utils.root.options.useMetadata then
872
-
local args = nil
873
-
local function _0_(v)
874
-
return ("\"%s\""):format(deep_tostring(v))
934
+
local args
935
+
local function _447_(_241)
936
+
return ("\"%s\""):format(deep_tostring(_241))
875
937
end
876
-
args = utils.map(arg_list, _0_)
938
+
args = utils.map(arg_list, _447_)
877
939
local meta_fields = {"\"fnl/arglist\"", ("{" .. table.concat(args, ", ") .. "}")}
878
940
if docstring then
879
941
table.insert(meta_fields, "\"fnl/docstring\"")
880
942
table.insert(meta_fields, ("\"" .. docstring:gsub("%s+$", ""):gsub("\\", "\\\\"):gsub("\n", "\\n"):gsub("\"", "\\\"") .. "\""))
943
+
else
881
944
end
882
945
local meta_str = ("require(\"%s\").metadata"):format((utils.root.options.moduleName or "fennel"))
883
946
return compiler.emit(parent, ("pcall(function() %s:setall(%s, %s) end)"):format(meta_str, fn_name, table.concat(meta_fields, ", ")))
947
+
else
948
+
return nil
884
949
end
885
950
end
886
951
local function get_fn_name(ast, scope, fn_name, multi)
887
952
if (fn_name and (fn_name[1] ~= "nil")) then
888
-
local _0_
953
+
local _450_
889
954
if not multi then
890
-
_0_ = compiler["declare-local"](fn_name, {}, scope, ast)
955
+
_450_ = compiler["declare-local"](fn_name, {}, scope, ast)
891
956
else
892
-
_0_ = compiler["symbol-to-expression"](fn_name, scope)[1]
957
+
_450_ = (compiler["symbol-to-expression"](fn_name, scope))[1]
893
958
end
894
-
return _0_, not multi, 3
959
+
return _450_, not multi, 3
895
960
else
896
-
return compiler.gensym(scope), true, 2
961
+
return nil, true, 2
962
+
end
963
+
end
964
+
local function compile_named_fn(ast, f_scope, f_chunk, parent, index, fn_name, local_3f, arg_name_list, f_metadata)
965
+
for i = (index + 1), #ast do
966
+
compiler.compile1(ast[i], f_scope, f_chunk, {nval = (((i ~= #ast) and 0) or nil), tail = (i == #ast)})
967
+
end
968
+
local _453_
969
+
if local_3f then
970
+
_453_ = "local function %s(%s)"
971
+
else
972
+
_453_ = "%s = function(%s)"
973
+
end
974
+
compiler.emit(parent, string.format(_453_, fn_name, table.concat(arg_name_list, ", ")), ast)
975
+
compiler.emit(parent, f_chunk, ast)
976
+
compiler.emit(parent, "end", ast)
977
+
set_fn_metadata(f_metadata["fnl/arglist"], f_metadata["fnl/docstring"], parent, fn_name)
978
+
utils.hook("fn", ast, f_scope)
979
+
return utils.expr(fn_name, "sym")
980
+
end
981
+
local function compile_anonymous_fn(ast, f_scope, f_chunk, parent, index, arg_name_list, f_metadata, scope)
982
+
local fn_name = compiler.gensym(scope)
983
+
return compile_named_fn(ast, f_scope, f_chunk, parent, index, fn_name, true, arg_name_list, f_metadata)
984
+
end
985
+
local function get_function_metadata(ast, arg_list, index)
986
+
local f_metadata = {["fnl/arglist"] = arg_list}
987
+
local index_2a = (index + 1)
988
+
local expr = ast[index_2a]
989
+
if (utils["string?"](expr) and (index_2a < #ast)) then
990
+
local _456_
991
+
do
992
+
local _455_ = f_metadata
993
+
_455_["fnl/docstring"] = expr
994
+
_456_ = _455_
995
+
end
996
+
return _456_, index_2a
997
+
elseif (utils["table?"](expr) and (index_2a < #ast)) then
998
+
local _457_
999
+
do
1000
+
local tbl_11_auto = f_metadata
1001
+
for k, v in pairs(expr) do
1002
+
local _458_, _459_ = k, v
1003
+
if ((nil ~= _458_) and (nil ~= _459_)) then
1004
+
local k_12_auto = _458_
1005
+
local v_13_auto = _459_
1006
+
tbl_11_auto[k_12_auto] = v_13_auto
1007
+
else
1008
+
end
1009
+
end
1010
+
_457_ = tbl_11_auto
1011
+
end
1012
+
return _457_, index_2a
1013
+
else
1014
+
return f_metadata, index
897
1015
end
898
1016
end
899
1017
SPECIALS.fn = function(ast, scope, parent)
900
-
local f_scope = nil
1018
+
local f_scope
901
1019
do
902
-
local _0_0 = compiler["make-scope"](scope)
903
-
_0_0["vararg"] = false
904
-
f_scope = _0_0
1020
+
local _462_ = compiler["make-scope"](scope)
1021
+
do end (_462_)["vararg"] = false
1022
+
f_scope = _462_
905
1023
end
906
1024
local f_chunk = {}
907
1025
local fn_sym = utils["sym?"](ast[2])
908
1026
local multi = (fn_sym and utils["multi-sym?"](fn_sym[1]))
909
-
local fn_name, local_fn_3f, index = get_fn_name(ast, scope, fn_sym, multi)
1027
+
local fn_name, local_3f, index = get_fn_name(ast, scope, fn_sym, multi)
910
1028
local arg_list = compiler.assert(utils["table?"](ast[index]), "expected parameters table", ast)
911
1029
compiler.assert((not multi or not multi["multi-sym-method-call"]), ("unexpected multi symbol " .. tostring(fn_name)), fn_sym)
912
1030
local function get_arg_name(arg)
···
914
1032
compiler.assert((arg == arg_list[#arg_list]), "expected vararg as last parameter", ast)
915
1033
f_scope.vararg = true
916
1034
return "..."
917
-
elseif (utils["sym?"](arg) and (utils.deref(arg) ~= "nil") and not utils["multi-sym?"](utils.deref(arg))) then
1035
+
elseif (utils["sym?"](arg) and (tostring(arg) ~= "nil") and not utils["multi-sym?"](tostring(arg))) then
918
1036
return compiler["declare-local"](arg, {}, f_scope, ast)
919
1037
elseif utils["table?"](arg) then
920
1038
local raw = utils.sym(compiler.gensym(scope))
···
922
1040
compiler.destructure(arg, raw, ast, f_scope, f_chunk, {declaration = true, nomulti = true, symtype = "arg"})
923
1041
return declared
924
1042
else
925
-
return compiler.assert(false, ("expected symbol for function parameter: %s"):format(tostring(arg)), ast[2])
1043
+
return compiler.assert(false, ("expected symbol for function parameter: %s"):format(tostring(arg)), ast[index])
926
1044
end
927
1045
end
1046
+
local arg_name_list = utils.map(arg_list, get_arg_name)
1047
+
local f_metadata, index0 = get_function_metadata(ast, arg_list, index)
1048
+
if fn_name then
1049
+
return compile_named_fn(ast, f_scope, f_chunk, parent, index0, fn_name, local_3f, arg_name_list, f_metadata)
1050
+
else
1051
+
return compile_anonymous_fn(ast, f_scope, f_chunk, parent, index0, arg_name_list, f_metadata, scope)
1052
+
end
1053
+
end
1054
+
doc_special("fn", {"name?", "args", "docstring?", "..."}, "Function syntax. May optionally include a name and docstring or a metadata table.\nIf a name is provided, the function will be bound in the current scope.\nWhen called with the wrong number of args, excess args will be discarded\nand lacking args will be nil, use lambda for arity-checked functions.", true)
1055
+
SPECIALS.lua = function(ast, _, parent)
1056
+
compiler.assert(((#ast == 2) or (#ast == 3)), "expected 1 or 2 arguments", ast)
1057
+
local _466_
928
1058
do
929
-
local arg_name_list = utils.map(arg_list, get_arg_name)
930
-
local index0, docstring = nil, nil
931
-
if ((type(ast[(index + 1)]) == "string") and ((index + 1) < #ast)) then
932
-
index0, docstring = (index + 1), ast[(index + 1)]
1059
+
local _465_ = utils["sym?"](ast[2])
1060
+
if (nil ~= _465_) then
1061
+
_466_ = tostring(_465_)
933
1062
else
934
-
index0, docstring = index, nil
1063
+
_466_ = _465_
935
1064
end
936
-
for i = (index0 + 1), #ast do
937
-
compiler.compile1(ast[i], f_scope, f_chunk, {nval = (((i ~= #ast) and 0) or nil), tail = (i == #ast)})
938
-
end
939
-
local _2_
940
-
if local_fn_3f then
941
-
_2_ = "local function %s(%s)"
1065
+
end
1066
+
if ("nil" ~= _466_) then
1067
+
table.insert(parent, {ast = ast, leaf = tostring(ast[2])})
1068
+
else
1069
+
end
1070
+
local _470_
1071
+
do
1072
+
local _469_ = utils["sym?"](ast[3])
1073
+
if (nil ~= _469_) then
1074
+
_470_ = tostring(_469_)
942
1075
else
943
-
_2_ = "%s = function(%s)"
1076
+
_470_ = _469_
944
1077
end
945
-
compiler.emit(parent, string.format(_2_, fn_name, table.concat(arg_name_list, ", ")), ast)
946
-
compiler.emit(parent, f_chunk, ast)
947
-
compiler.emit(parent, "end", ast)
948
-
set_fn_metadata(arg_list, docstring, parent, fn_name)
949
1078
end
950
-
utils.hook("fn", ast, f_scope)
951
-
return utils.expr(fn_name, "sym")
952
-
end
953
-
doc_special("fn", {"name?", "args", "docstring?", "..."}, "Function syntax. May optionally include a name and docstring.\nIf a name is provided, the function will be bound in the current scope.\nWhen called with the wrong number of args, excess args will be discarded\nand lacking args will be nil, use lambda for arity-checked functions.")
954
-
SPECIALS.lua = function(ast, _, parent)
955
-
compiler.assert(((#ast == 2) or (#ast == 3)), "expected 1 or 2 arguments", ast)
956
-
if (ast[2] ~= nil) then
957
-
table.insert(parent, {ast = ast, leaf = tostring(ast[2])})
958
-
end
959
-
if (ast[3] ~= nil) then
1079
+
if ("nil" ~= _470_) then
960
1080
return tostring(ast[3])
961
-
end
962
-
end
963
-
SPECIALS.doc = function(ast, scope, parent)
964
-
assert(utils.root.options.useMetadata, "can't look up doc with metadata disabled.")
965
-
compiler.assert((#ast == 2), "expected one argument", ast)
966
-
local target = utils.deref(ast[2])
967
-
local special_or_macro = (scope.specials[target] or scope.macros[target])
968
-
if special_or_macro then
969
-
return ("print(%q)"):format(doc_2a(special_or_macro, target))
970
1081
else
971
-
local value = tostring(compiler.compile1(ast[2], scope, parent, {nval = 1})[1])
972
-
return ("print(require('%s').doc(%s, '%s'))"):format((utils.root.options.moduleName or "fennel"), value, tostring(ast[2]))
1082
+
return nil
973
1083
end
974
1084
end
975
-
doc_special("doc", {"x"}, "Print the docstring and arglist for a function, macro, or special form.")
976
1085
local function dot(ast, scope, parent)
977
1086
compiler.assert((1 < #ast), "expected table argument", ast)
978
1087
local len = #ast
979
-
local _0_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
980
-
local lhs = _0_[1]
1088
+
local _let_473_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
1089
+
local lhs = _let_473_[1]
981
1090
if (len == 2) then
982
1091
return tostring(lhs)
983
1092
else
984
1093
local indices = {}
985
1094
for i = 3, len do
986
1095
local index = ast[i]
987
-
if ((type(index) == "string") and utils["valid-lua-identifier?"](index)) then
1096
+
if (utils["string?"](index) and utils["valid-lua-identifier?"](index)) then
988
1097
table.insert(indices, ("." .. index))
989
1098
else
990
-
local _1_ = compiler.compile1(index, scope, parent, {nval = 1})
991
-
local index0 = _1_[1]
1099
+
local _let_474_ = compiler.compile1(index, scope, parent, {nval = 1})
1100
+
local index0 = _let_474_[1]
992
1101
table.insert(indices, ("[" .. tostring(index0) .. "]"))
993
1102
end
994
1103
end
···
1032
1141
return nil
1033
1142
end
1034
1143
doc_special("var", {"name", "val"}, "Introduce new mutable local.")
1144
+
local function kv_3f(t)
1145
+
local _478_
1146
+
do
1147
+
local tbl_14_auto = {}
1148
+
local i_15_auto = #tbl_14_auto
1149
+
for k in pairs(t) do
1150
+
local val_16_auto
1151
+
if ("number" ~= type(k)) then
1152
+
val_16_auto = k
1153
+
else
1154
+
val_16_auto = nil
1155
+
end
1156
+
if (nil ~= val_16_auto) then
1157
+
i_15_auto = (i_15_auto + 1)
1158
+
do end (tbl_14_auto)[i_15_auto] = val_16_auto
1159
+
else
1160
+
end
1161
+
end
1162
+
_478_ = tbl_14_auto
1163
+
end
1164
+
return (_478_)[1]
1165
+
end
1035
1166
SPECIALS.let = function(ast, scope, parent, opts)
1036
1167
local bindings = ast[2]
1037
1168
local pre_syms = {}
1038
-
compiler.assert((utils["list?"](bindings) or utils["table?"](bindings)), "expected binding table", ast)
1169
+
compiler.assert((utils["table?"](bindings) and not kv_3f(bindings)), "expected binding sequence", bindings)
1039
1170
compiler.assert(((#bindings % 2) == 0), "expected even number of name/value bindings", ast[2])
1040
-
compiler.assert((#ast >= 3), "expected body expression", ast[1])
1171
+
compiler.assert((3 <= #ast), "expected body expression", ast[1])
1041
1172
for _ = 1, (opts.nval or 0) do
1042
1173
table.insert(pre_syms, compiler.gensym(scope))
1043
1174
end
···
1048
1179
end
1049
1180
return SPECIALS["do"](ast, scope, parent, opts, 3, sub_chunk, sub_scope, pre_syms)
1050
1181
end
1051
-
doc_special("let", {"[name1 val1 ... nameN valN]", "..."}, "Introduces a new scope in which a given set of local bindings are used.")
1182
+
doc_special("let", {"[name1 val1 ... nameN valN]", "..."}, "Introduces a new scope in which a given set of local bindings are used.", true)
1183
+
local function get_prev_line(parent)
1184
+
if ("table" == type(parent)) then
1185
+
return get_prev_line((parent.leaf or parent[#parent]))
1186
+
else
1187
+
return (parent or "")
1188
+
end
1189
+
end
1190
+
local function disambiguate_3f(rootstr, parent)
1191
+
local function _483_()
1192
+
local _482_ = get_prev_line(parent)
1193
+
if (nil ~= _482_) then
1194
+
local prev_line = _482_
1195
+
return prev_line:match("%)$")
1196
+
else
1197
+
return nil
1198
+
end
1199
+
end
1200
+
return (rootstr:match("^{") or _483_())
1201
+
end
1052
1202
SPECIALS.tset = function(ast, scope, parent)
1053
-
compiler.assert((#ast > 3), "expected table, key, and value arguments", ast)
1054
-
local root = compiler.compile1(ast[2], scope, parent, {nval = 1})[1]
1203
+
compiler.assert((3 < #ast), "expected table, key, and value arguments", ast)
1204
+
local root = (compiler.compile1(ast[2], scope, parent, {nval = 1}))[1]
1055
1205
local keys = {}
1056
1206
for i = 3, (#ast - 1) do
1057
-
local _0_ = compiler.compile1(ast[i], scope, parent, {nval = 1})
1058
-
local key = _0_[1]
1207
+
local _let_485_ = compiler.compile1(ast[i], scope, parent, {nval = 1})
1208
+
local key = _let_485_[1]
1059
1209
table.insert(keys, tostring(key))
1060
1210
end
1061
-
local value = compiler.compile1(ast[#ast], scope, parent, {nval = 1})[1]
1211
+
local value = (compiler.compile1(ast[#ast], scope, parent, {nval = 1}))[1]
1062
1212
local rootstr = tostring(root)
1063
-
local fmtstr = nil
1064
-
if rootstr:match("^{") then
1213
+
local fmtstr
1214
+
if disambiguate_3f(rootstr, parent) then
1065
1215
fmtstr = "do end (%s)[%s] = %s"
1066
1216
else
1067
1217
fmtstr = "%s[%s] = %s"
1068
1218
end
1069
-
return compiler.emit(parent, fmtstr:format(tostring(root), table.concat(keys, "]["), tostring(value)), ast)
1219
+
return compiler.emit(parent, fmtstr:format(rootstr, table.concat(keys, "]["), tostring(value)), ast)
1070
1220
end
1071
1221
doc_special("tset", {"tbl", "key1", "...", "keyN", "val"}, "Set the value of a table field. Can take additional keys to set\nnested values, but all parents must contain an existing table.")
1072
1222
local function calculate_target(scope, opts)
···
1077
1227
local target_exprs = {}
1078
1228
for i = 1, opts.nval do
1079
1229
local s = compiler.gensym(scope)
1080
-
accum[i] = s
1230
+
do end (accum)[i] = s
1081
1231
target_exprs[i] = utils.expr(s, "sym")
1082
1232
end
1083
1233
return "target", opts.tail, table.concat(accum, ", "), target_exprs
···
1086
1236
end
1087
1237
end
1088
1238
local function if_2a(ast, scope, parent, opts)
1239
+
compiler.assert((2 < #ast), "expected condition and body", ast)
1089
1240
local do_scope = compiler["make-scope"](scope)
1090
1241
local branches = {}
1091
1242
local wrapper, inner_tail, inner_target, target_exprs = calculate_target(scope, opts)
···
1096
1247
compiler["keep-side-effects"](compiler.compile1(ast[i], cscope, chunk, body_opts), chunk, nil, ast[i])
1097
1248
return {chunk = chunk, scope = cscope}
1098
1249
end
1250
+
if (1 == (#ast % 2)) then
1251
+
table.insert(ast, utils.sym("nil"))
1252
+
else
1253
+
end
1099
1254
for i = 2, (#ast - 1), 2 do
1100
1255
local condchunk = {}
1101
1256
local res = compiler.compile1(ast[i], do_scope, condchunk, {nval = 1})
···
1106
1261
branch.nested = ((i ~= 2) and (next(condchunk, nil) == nil))
1107
1262
table.insert(branches, branch)
1108
1263
end
1109
-
local has_else_3f = ((#ast > 3) and ((#ast % 2) == 0))
1110
-
local else_branch = (has_else_3f and compile_body(#ast))
1264
+
local else_branch = compile_body(#ast)
1111
1265
local s = compiler.gensym(scope)
1112
1266
local buffer = {}
1113
1267
local last_buffer = buffer
1114
1268
for i = 1, #branches do
1115
1269
local branch = branches[i]
1116
-
local fstr = nil
1270
+
local fstr
1117
1271
if not branch.nested then
1118
1272
fstr = "if %s then"
1119
1273
else
1120
1274
fstr = "elseif %s then"
1121
1275
end
1122
1276
local cond = tostring(branch.cond)
1123
-
local cond_line = nil
1124
-
if ((cond == "true") and branch.nested and (i == #branches)) then
1125
-
cond_line = "else"
1126
-
else
1127
-
cond_line = fstr:format(cond)
1128
-
end
1277
+
local cond_line = fstr:format(cond)
1129
1278
if branch.nested then
1130
1279
compiler.emit(last_buffer, branch.condchunk, ast)
1131
1280
else
···
1136
1285
compiler.emit(last_buffer, cond_line, ast)
1137
1286
compiler.emit(last_buffer, branch.chunk, ast)
1138
1287
if (i == #branches) then
1139
-
if has_else_3f then
1140
-
compiler.emit(last_buffer, "else", ast)
1141
-
compiler.emit(last_buffer, else_branch.chunk, ast)
1142
-
elseif (inner_target and (cond_line ~= "else")) then
1143
-
compiler.emit(last_buffer, "else", ast)
1144
-
compiler.emit(last_buffer, ("%s = nil"):format(inner_target), ast)
1145
-
end
1288
+
compiler.emit(last_buffer, "else", ast)
1289
+
compiler.emit(last_buffer, else_branch.chunk, ast)
1146
1290
compiler.emit(last_buffer, "end", ast)
1147
-
elseif not branches[(i + 1)].nested then
1291
+
elseif not (branches[(i + 1)]).nested then
1148
1292
local next_buffer = {}
1149
1293
compiler.emit(last_buffer, "else", ast)
1150
1294
compiler.emit(last_buffer, next_buffer, ast)
1151
1295
compiler.emit(last_buffer, "end", ast)
1152
1296
last_buffer = next_buffer
1297
+
else
1153
1298
end
1154
1299
end
1155
1300
if (wrapper == "iife") then
···
1173
1318
end
1174
1319
SPECIALS["if"] = if_2a
1175
1320
doc_special("if", {"cond1", "body1", "...", "condN", "bodyN"}, "Conditional form.\nTakes any number of condition/body pairs and evaluates the first body where\nthe condition evaluates to truthy. Similar to cond in other lisps.")
1321
+
local function remove_until_condition(bindings)
1322
+
local last_item = bindings[(#bindings - 1)]
1323
+
if ((utils["sym?"](last_item) and (tostring(last_item) == "&until")) or ("until" == last_item)) then
1324
+
table.remove(bindings, (#bindings - 1))
1325
+
return table.remove(bindings)
1326
+
else
1327
+
return nil
1328
+
end
1329
+
end
1330
+
local function compile_until(condition, scope, chunk)
1331
+
if condition then
1332
+
local _let_494_ = compiler.compile1(condition, scope, chunk, {nval = 1})
1333
+
local condition_lua = _let_494_[1]
1334
+
return compiler.emit(chunk, ("if %s then break end"):format(tostring(condition_lua)), utils.expr(condition, "expression"))
1335
+
else
1336
+
return nil
1337
+
end
1338
+
end
1176
1339
SPECIALS.each = function(ast, scope, parent)
1177
-
compiler.assert((#ast >= 3), "expected body expression", ast[1])
1340
+
compiler.assert((3 <= #ast), "expected body expression", ast[1])
1178
1341
local binding = compiler.assert(utils["table?"](ast[2]), "expected binding table", ast)
1342
+
local _ = compiler.assert((2 <= #binding), "expected binding and iterator", binding)
1343
+
local until_condition = remove_until_condition(binding)
1179
1344
local iter = table.remove(binding, #binding)
1180
1345
local destructures = {}
1181
1346
local new_manglings = {}
1182
1347
local sub_scope = compiler["make-scope"](scope)
1183
1348
local function destructure_binding(v)
1349
+
compiler.assert(not utils["string?"](v), ("unexpected iterator clause " .. tostring(v)), binding)
1184
1350
if utils["sym?"](v) then
1185
1351
return compiler["declare-local"](v, {}, sub_scope, ast, new_manglings)
1186
1352
else
1187
1353
local raw = utils.sym(compiler.gensym(sub_scope))
1188
-
destructures[raw] = v
1354
+
do end (destructures)[raw] = v
1189
1355
return compiler["declare-local"](raw, {}, sub_scope, ast)
1190
1356
end
1191
1357
end
1192
1358
local bind_vars = utils.map(binding, destructure_binding)
1193
-
local vals = compiler.compile1(iter, sub_scope, parent)
1359
+
local vals = compiler.compile1(iter, scope, parent)
1194
1360
local val_names = utils.map(vals, tostring)
1195
1361
local chunk = {}
1196
1362
compiler.emit(parent, ("for %s in %s do"):format(table.concat(bind_vars, ", "), table.concat(val_names, ", ")), ast)
···
1198
1364
compiler.destructure(args, raw, ast, sub_scope, chunk, {declaration = true, nomulti = true, symtype = "each"})
1199
1365
end
1200
1366
compiler["apply-manglings"](sub_scope, new_manglings, ast)
1367
+
compile_until(until_condition, sub_scope, chunk)
1201
1368
compile_do(ast, sub_scope, chunk, 3)
1202
1369
compiler.emit(parent, chunk, ast)
1203
1370
return compiler.emit(parent, "end", ast)
1204
1371
end
1205
-
doc_special("each", {"[key value (iterator)]", "..."}, "Runs the body once for each set of values provided by the given iterator.\nMost commonly used with ipairs for sequential tables or pairs for undefined\norder, but can be used with any iterator.")
1372
+
doc_special("each", {"[key value (iterator)]", "..."}, "Runs the body once for each set of values provided by the given iterator.\nMost commonly used with ipairs for sequential tables or pairs for undefined\norder, but can be used with any iterator.", true)
1206
1373
local function while_2a(ast, scope, parent)
1207
1374
local len1 = #parent
1208
-
local condition = compiler.compile1(ast[2], scope, parent, {nval = 1})[1]
1375
+
local condition = (compiler.compile1(ast[2], scope, parent, {nval = 1}))[1]
1209
1376
local len2 = #parent
1210
1377
local sub_chunk = {}
1211
1378
if (len1 ~= len2) then
1212
1379
for i = (len1 + 1), len2 do
1213
1380
table.insert(sub_chunk, parent[i])
1214
-
parent[i] = nil
1381
+
do end (parent)[i] = nil
1215
1382
end
1216
1383
compiler.emit(parent, "while true do", ast)
1217
1384
compiler.emit(sub_chunk, ("if not %s then break end"):format(condition[1]), ast)
···
1223
1390
return compiler.emit(parent, "end", ast)
1224
1391
end
1225
1392
SPECIALS["while"] = while_2a
1226
-
doc_special("while", {"condition", "..."}, "The classic while loop. Evaluates body until a condition is non-truthy.")
1393
+
doc_special("while", {"condition", "..."}, "The classic while loop. Evaluates body until a condition is non-truthy.", true)
1227
1394
local function for_2a(ast, scope, parent)
1228
1395
local ranges = compiler.assert(utils["table?"](ast[2]), "expected binding table", ast)
1396
+
local until_condition = remove_until_condition(ast[2])
1229
1397
local binding_sym = table.remove(ast[2], 1)
1230
1398
local sub_scope = compiler["make-scope"](scope)
1231
1399
local range_args = {}
1232
1400
local chunk = {}
1233
1401
compiler.assert(utils["sym?"](binding_sym), ("unable to bind %s %s"):format(type(binding_sym), tostring(binding_sym)), ast[2])
1234
-
compiler.assert((#ast >= 3), "expected body expression", ast[1])
1402
+
compiler.assert((3 <= #ast), "expected body expression", ast[1])
1403
+
compiler.assert((#ranges <= 3), "unexpected arguments", ranges[4])
1235
1404
for i = 1, math.min(#ranges, 3) do
1236
-
range_args[i] = tostring(compiler.compile1(ranges[i], sub_scope, parent, {nval = 1})[1])
1405
+
range_args[i] = tostring((compiler.compile1(ranges[i], scope, parent, {nval = 1}))[1])
1237
1406
end
1238
1407
compiler.emit(parent, ("for %s = %s do"):format(compiler["declare-local"](binding_sym, {}, sub_scope, ast), table.concat(range_args, ", ")), ast)
1408
+
compile_until(until_condition, sub_scope, chunk)
1239
1409
compile_do(ast, sub_scope, chunk, 3)
1240
1410
compiler.emit(parent, chunk, ast)
1241
1411
return compiler.emit(parent, "end", ast)
1242
1412
end
1243
1413
SPECIALS["for"] = for_2a
1244
-
doc_special("for", {"[index start stop step?]", "..."}, "Numeric loop construct.\nEvaluates body once for each value between start and stop (inclusive).")
1414
+
doc_special("for", {"[index start stop step?]", "..."}, "Numeric loop construct.\nEvaluates body once for each value between start and stop (inclusive).", true)
1245
1415
local function native_method_call(ast, _scope, _parent, target, args)
1246
-
local _0_ = ast
1247
-
local _ = _0_[1]
1248
-
local _0 = _0_[2]
1249
-
local method_string = _0_[3]
1250
-
local call_string = nil
1251
-
if ((target.type == "literal") or (target.type == "expression")) then
1416
+
local _let_498_ = ast
1417
+
local _ = _let_498_[1]
1418
+
local _0 = _let_498_[2]
1419
+
local method_string = _let_498_[3]
1420
+
local call_string
1421
+
if ((target.type == "literal") or (target.type == "varg") or (target.type == "expression")) then
1252
1422
call_string = "(%s):%s(%s)"
1253
1423
else
1254
1424
call_string = "%s:%s(%s)"
···
1256
1426
return utils.expr(string.format(call_string, tostring(target), method_string, table.concat(args, ", ")), "statement")
1257
1427
end
1258
1428
local function nonnative_method_call(ast, scope, parent, target, args)
1259
-
local method_string = tostring(compiler.compile1(ast[3], scope, parent, {nval = 1})[1])
1429
+
local method_string = tostring((compiler.compile1(ast[3], scope, parent, {nval = 1}))[1])
1260
1430
local args0 = {tostring(target), unpack(args)}
1261
1431
return utils.expr(string.format("%s[%s](%s)", tostring(target), method_string, table.concat(args0, ", ")), "statement")
1262
1432
end
1263
1433
local function double_eval_protected_method_call(ast, scope, parent, target, args)
1264
-
local method_string = tostring(compiler.compile1(ast[3], scope, parent, {nval = 1})[1])
1434
+
local method_string = tostring((compiler.compile1(ast[3], scope, parent, {nval = 1}))[1])
1265
1435
local call = "(function(tgt, m, ...) return tgt[m](tgt, ...) end)(%s, %s)"
1266
1436
table.insert(args, 1, method_string)
1267
1437
return utils.expr(string.format(call, tostring(target), table.concat(args, ", ")), "statement")
1268
1438
end
1269
1439
local function method_call(ast, scope, parent)
1270
1440
compiler.assert((2 < #ast), "expected at least 2 arguments", ast)
1271
-
local _0_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
1272
-
local target = _0_[1]
1441
+
local _let_500_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
1442
+
local target = _let_500_[1]
1273
1443
local args = {}
1274
1444
for i = 4, #ast do
1275
-
local subexprs = nil
1276
-
local _1_
1445
+
local subexprs
1446
+
local _501_
1277
1447
if (i ~= #ast) then
1278
-
_1_ = 1
1448
+
_501_ = 1
1279
1449
else
1280
-
_1_ = nil
1450
+
_501_ = nil
1281
1451
end
1282
-
subexprs = compiler.compile1(ast[i], scope, parent, {nval = _1_})
1452
+
subexprs = compiler.compile1(ast[i], scope, parent, {nval = _501_})
1283
1453
utils.map(subexprs, tostring, args)
1284
1454
end
1285
-
if ((type(ast[3]) == "string") and utils["valid-lua-identifier?"](ast[3])) then
1455
+
if (utils["string?"](ast[3]) and utils["valid-lua-identifier?"](ast[3])) then
1286
1456
return native_method_call(ast, scope, parent, target, args)
1287
1457
elseif (target.type == "sym") then
1288
1458
return nonnative_method_call(ast, scope, parent, target, args)
···
1295
1465
SPECIALS.comment = function(ast, _, parent)
1296
1466
local els = {}
1297
1467
for i = 2, #ast do
1298
-
local function _1_()
1299
-
local _0_0 = tostring(ast[i]):gsub("\n", " ")
1300
-
return _0_0
1301
-
end
1302
-
table.insert(els, _1_())
1468
+
table.insert(els, view(ast[i], {["one-line?"] = true}))
1303
1469
end
1304
-
return compiler.emit(parent, ("-- " .. table.concat(els, " ")), ast)
1470
+
return compiler.emit(parent, ("--[[ " .. table.concat(els, " ") .. " ]]"), ast)
1305
1471
end
1306
-
doc_special("comment", {"..."}, "Comment which will be emitted in Lua output.")
1472
+
doc_special("comment", {"..."}, "Comment which will be emitted in Lua output.", true)
1307
1473
local function hashfn_max_used(f_scope, i, max)
1308
-
local max0 = nil
1474
+
local max0
1309
1475
if f_scope.symmeta[("$" .. i)].used then
1310
1476
max0 = i
1311
1477
else
···
1319
1485
end
1320
1486
SPECIALS.hashfn = function(ast, scope, parent)
1321
1487
compiler.assert((#ast == 2), "expected one argument", ast)
1322
-
local f_scope = nil
1488
+
local f_scope
1323
1489
do
1324
-
local _0_0 = compiler["make-scope"](scope)
1325
-
_0_0["vararg"] = false
1326
-
_0_0["hashfn"] = true
1327
-
f_scope = _0_0
1490
+
local _506_ = compiler["make-scope"](scope)
1491
+
do end (_506_)["vararg"] = false
1492
+
_506_["hashfn"] = true
1493
+
f_scope = _506_
1328
1494
end
1329
1495
local f_chunk = {}
1330
1496
local name = compiler.gensym(scope)
···
1335
1501
args[i] = compiler["declare-local"](utils.sym(("$" .. i)), {}, f_scope, ast)
1336
1502
end
1337
1503
local function walker(idx, node, parent_node)
1338
-
if (utils["sym?"](node) and (utils.deref(node) == "$...")) then
1504
+
if (utils["sym?"](node) and (tostring(node) == "$...")) then
1339
1505
parent_node[idx] = utils.varg()
1340
1506
f_scope.vararg = true
1341
1507
return nil
···
1348
1514
local max_used = hashfn_max_used(f_scope, 1, 0)
1349
1515
if f_scope.vararg then
1350
1516
compiler.assert((max_used == 0), "$ and $... in hashfn are mutually exclusive", ast)
1517
+
else
1351
1518
end
1352
-
local arg_str = nil
1519
+
local arg_str
1353
1520
if f_scope.vararg then
1354
-
arg_str = utils.deref(utils.varg())
1521
+
arg_str = tostring(utils.varg())
1355
1522
else
1356
1523
arg_str = table.concat(args, ", ", 1, max_used)
1357
1524
end
···
1361
1528
return utils.expr(name, "sym")
1362
1529
end
1363
1530
doc_special("hashfn", {"..."}, "Function literal shorthand; args are either $... OR $1, $2, etc.")
1364
-
local function define_arithmetic_special(name, zero_arity, unary_prefix, lua_name)
1531
+
local function maybe_short_circuit_protect(ast, i, name, _510_)
1532
+
local _arg_511_ = _510_
1533
+
local mac = _arg_511_["macros"]
1534
+
local call = (utils["list?"](ast) and tostring(ast[1]))
1535
+
if ((("or" == name) or ("and" == name)) and (1 < i) and (mac[call] or ("set" == call) or ("tset" == call) or ("global" == call))) then
1536
+
return utils.list(utils.sym("do"), ast)
1537
+
else
1538
+
return ast
1539
+
end
1540
+
end
1541
+
local function arithmetic_special(name, zero_arity, unary_prefix, ast, scope, parent)
1542
+
local len = #ast
1543
+
local operands = {}
1544
+
local padded_op = (" " .. name .. " ")
1545
+
for i = 2, len do
1546
+
local subast = maybe_short_circuit_protect(ast[i], i, name, scope)
1547
+
local subexprs = compiler.compile1(subast, scope, parent)
1548
+
if (i == len) then
1549
+
utils.map(subexprs, tostring, operands)
1550
+
else
1551
+
table.insert(operands, tostring(subexprs[1]))
1552
+
end
1553
+
end
1554
+
local _514_ = #operands
1555
+
if (_514_ == 0) then
1556
+
local _516_
1557
+
do
1558
+
local _515_ = zero_arity
1559
+
compiler.assert(_515_, "Expected more than 0 arguments", ast)
1560
+
_516_ = _515_
1561
+
end
1562
+
return utils.expr(_516_, "literal")
1563
+
elseif (_514_ == 1) then
1564
+
if unary_prefix then
1565
+
return ("(" .. unary_prefix .. padded_op .. operands[1] .. ")")
1566
+
else
1567
+
return operands[1]
1568
+
end
1569
+
elseif true then
1570
+
local _ = _514_
1571
+
return ("(" .. table.concat(operands, padded_op) .. ")")
1572
+
else
1573
+
return nil
1574
+
end
1575
+
end
1576
+
local function define_arithmetic_special(name, zero_arity, unary_prefix, _3flua_name)
1577
+
local _522_
1365
1578
do
1366
-
local padded_op = (" " .. (lua_name or name) .. " ")
1367
-
local function _0_(ast, scope, parent)
1368
-
local len = #ast
1369
-
if (len == 1) then
1370
-
compiler.assert((zero_arity ~= nil), "Expected more than 0 arguments", ast)
1371
-
return utils.expr(zero_arity, "literal")
1372
-
else
1373
-
local operands = {}
1374
-
for i = 2, len do
1375
-
local subexprs = nil
1376
-
local _1_
1377
-
if (i ~= len) then
1378
-
_1_ = 1
1379
-
else
1380
-
_1_ = nil
1381
-
end
1382
-
subexprs = compiler.compile1(ast[i], scope, parent, {nval = _1_})
1383
-
utils.map(subexprs, tostring, operands)
1384
-
end
1385
-
if (#operands == 1) then
1386
-
if unary_prefix then
1387
-
return ("(" .. unary_prefix .. padded_op .. operands[1] .. ")")
1388
-
else
1389
-
return operands[1]
1390
-
end
1391
-
else
1392
-
return ("(" .. table.concat(operands, padded_op) .. ")")
1393
-
end
1394
-
end
1579
+
local _519_ = (_3flua_name or name)
1580
+
local _520_ = zero_arity
1581
+
local _521_ = unary_prefix
1582
+
local function _523_(...)
1583
+
return arithmetic_special(_519_, _520_, _521_, ...)
1395
1584
end
1396
-
SPECIALS[name] = _0_
1585
+
_522_ = _523_
1397
1586
end
1587
+
SPECIALS[name] = _522_
1398
1588
return doc_special(name, {"a", "b", "..."}, "Arithmetic operator; works the same as Lua but accepts more arguments.")
1399
1589
end
1400
1590
define_arithmetic_special("+", "0")
···
1405
1595
define_arithmetic_special("%")
1406
1596
define_arithmetic_special("/", nil, "1")
1407
1597
define_arithmetic_special("//", nil, "1")
1408
-
define_arithmetic_special("lshift", nil, "1", "<<")
1409
-
define_arithmetic_special("rshift", nil, "1", ">>")
1410
-
define_arithmetic_special("band", "0", "0", "&")
1411
-
define_arithmetic_special("bor", "0", "0", "|")
1412
-
define_arithmetic_special("bxor", "0", "0", "~")
1413
-
doc_special("lshift", {"x", "n"}, "Bitwise logical left shift of x by n bits; only works in Lua 5.3+.")
1414
-
doc_special("rshift", {"x", "n"}, "Bitwise logical right shift of x by n bits; only works in Lua 5.3+.")
1415
-
doc_special("band", {"x1", "x2"}, "Bitwise AND of arguments; only works in Lua 5.3+.")
1416
-
doc_special("bor", {"x1", "x2"}, "Bitwise OR of arguments; only works in Lua 5.3+.")
1417
-
doc_special("bxor", {"x1", "x2"}, "Bitwise XOR of arguments; only works in Lua 5.3+.")
1418
-
define_arithmetic_special("or", "false")
1419
-
define_arithmetic_special("and", "true")
1598
+
SPECIALS["or"] = function(ast, scope, parent)
1599
+
return arithmetic_special("or", "false", nil, ast, scope, parent)
1600
+
end
1601
+
SPECIALS["and"] = function(ast, scope, parent)
1602
+
return arithmetic_special("and", "true", nil, ast, scope, parent)
1603
+
end
1420
1604
doc_special("and", {"a", "b", "..."}, "Boolean operator; works the same as Lua but accepts more arguments.")
1421
1605
doc_special("or", {"a", "b", "..."}, "Boolean operator; works the same as Lua but accepts more arguments.")
1606
+
local function bitop_special(native_name, lib_name, zero_arity, unary_prefix, ast, scope, parent)
1607
+
if (#ast == 1) then
1608
+
return compiler.assert(zero_arity, "Expected more than 0 arguments.", ast)
1609
+
else
1610
+
local len = #ast
1611
+
local operands = {}
1612
+
local padded_native_name = (" " .. native_name .. " ")
1613
+
local prefixed_lib_name = ("bit." .. lib_name)
1614
+
for i = 2, len do
1615
+
local subexprs
1616
+
local _524_
1617
+
if (i ~= len) then
1618
+
_524_ = 1
1619
+
else
1620
+
_524_ = nil
1621
+
end
1622
+
subexprs = compiler.compile1(ast[i], scope, parent, {nval = _524_})
1623
+
utils.map(subexprs, tostring, operands)
1624
+
end
1625
+
if (#operands == 1) then
1626
+
if utils.root.options.useBitLib then
1627
+
return (prefixed_lib_name .. "(" .. unary_prefix .. ", " .. operands[1] .. ")")
1628
+
else
1629
+
return ("(" .. unary_prefix .. padded_native_name .. operands[1] .. ")")
1630
+
end
1631
+
else
1632
+
if utils.root.options.useBitLib then
1633
+
return (prefixed_lib_name .. "(" .. table.concat(operands, ", ") .. ")")
1634
+
else
1635
+
return ("(" .. table.concat(operands, padded_native_name) .. ")")
1636
+
end
1637
+
end
1638
+
end
1639
+
end
1640
+
local function define_bitop_special(name, zero_arity, unary_prefix, native)
1641
+
local _534_
1642
+
do
1643
+
local _530_ = native
1644
+
local _531_ = name
1645
+
local _532_ = zero_arity
1646
+
local _533_ = unary_prefix
1647
+
local function _535_(...)
1648
+
return bitop_special(_530_, _531_, _532_, _533_, ...)
1649
+
end
1650
+
_534_ = _535_
1651
+
end
1652
+
SPECIALS[name] = _534_
1653
+
return nil
1654
+
end
1655
+
define_bitop_special("lshift", nil, "1", "<<")
1656
+
define_bitop_special("rshift", nil, "1", ">>")
1657
+
define_bitop_special("band", "0", "0", "&")
1658
+
define_bitop_special("bor", "0", "0", "|")
1659
+
define_bitop_special("bxor", "0", "0", "~")
1660
+
doc_special("lshift", {"x", "n"}, "Bitwise logical left shift of x by n bits.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
1661
+
doc_special("rshift", {"x", "n"}, "Bitwise logical right shift of x by n bits.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
1662
+
doc_special("band", {"x1", "x2", "..."}, "Bitwise AND of any number of arguments.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
1663
+
doc_special("bor", {"x1", "x2", "..."}, "Bitwise OR of any number of arguments.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
1664
+
doc_special("bxor", {"x1", "x2", "..."}, "Bitwise XOR of any number of arguments.\nOnly works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
1422
1665
doc_special("..", {"a", "b", "..."}, "String concatenation operator; works the same as Lua but accepts more arguments.")
1423
-
local function native_comparator(op, _0_0, scope, parent)
1424
-
local _1_ = _0_0
1425
-
local _ = _1_[1]
1426
-
local lhs_ast = _1_[2]
1427
-
local rhs_ast = _1_[3]
1428
-
local _2_ = compiler.compile1(lhs_ast, scope, parent, {nval = 1})
1429
-
local lhs = _2_[1]
1430
-
local _3_ = compiler.compile1(rhs_ast, scope, parent, {nval = 1})
1431
-
local rhs = _3_[1]
1666
+
local function native_comparator(op, _536_, scope, parent)
1667
+
local _arg_537_ = _536_
1668
+
local _ = _arg_537_[1]
1669
+
local lhs_ast = _arg_537_[2]
1670
+
local rhs_ast = _arg_537_[3]
1671
+
local _let_538_ = compiler.compile1(lhs_ast, scope, parent, {nval = 1})
1672
+
local lhs = _let_538_[1]
1673
+
local _let_539_ = compiler.compile1(rhs_ast, scope, parent, {nval = 1})
1674
+
local rhs = _let_539_[1]
1432
1675
return string.format("(%s %s %s)", tostring(lhs), op, tostring(rhs))
1433
1676
end
1434
1677
local function double_eval_protected_comparator(op, chain_op, ast, scope, parent)
···
1438
1681
local chain = string.format(" %s ", (chain_op or "and"))
1439
1682
for i = 2, #ast do
1440
1683
table.insert(arglist, tostring(compiler.gensym(scope)))
1441
-
table.insert(vals, tostring(compiler.compile1(ast[i], scope, parent, {nval = 1})[1]))
1684
+
table.insert(vals, tostring((compiler.compile1(ast[i], scope, parent, {nval = 1}))[1]))
1442
1685
end
1443
1686
for i = 1, (#arglist - 1) do
1444
1687
table.insert(comparisons, string.format("(%s %s %s)", arglist[i], op, arglist[(i + 1)]))
1445
1688
end
1446
1689
return string.format("(function(%s) return %s end)(%s)", table.concat(arglist, ","), table.concat(comparisons, chain), table.concat(vals, ","))
1447
1690
end
1448
-
local function define_comparator_special(name, lua_op, chain_op)
1691
+
local function define_comparator_special(name, _3flua_op, _3fchain_op)
1449
1692
do
1450
-
local op = (lua_op or name)
1693
+
local op = (_3flua_op or name)
1451
1694
local function opfn(ast, scope, parent)
1452
1695
compiler.assert((2 < #ast), "expected at least two arguments", ast)
1453
1696
if (3 == #ast) then
1454
1697
return native_comparator(op, ast, scope, parent)
1455
1698
else
1456
-
return double_eval_protected_comparator(op, chain_op, ast, scope, parent)
1699
+
return double_eval_protected_comparator(op, _3fchain_op, ast, scope, parent)
1457
1700
end
1458
1701
end
1459
1702
SPECIALS[name] = opfn
···
1466
1709
define_comparator_special("<=")
1467
1710
define_comparator_special("=", "==")
1468
1711
define_comparator_special("not=", "~=", "or")
1469
-
SPECIALS["~="] = SPECIALS["not="]
1470
-
local function define_unary_special(op, realop)
1712
+
local function define_unary_special(op, _3frealop)
1471
1713
local function opfn(ast, scope, parent)
1472
1714
compiler.assert((#ast == 2), "expected one argument", ast)
1473
1715
local tail = compiler.compile1(ast[2], scope, parent, {nval = 1})
1474
-
return ((realop or op) .. tostring(tail[1]))
1716
+
return ((_3frealop or op) .. tostring(tail[1]))
1475
1717
end
1476
1718
SPECIALS[op] = opfn
1477
1719
return nil
···
1479
1721
define_unary_special("not", "not ")
1480
1722
doc_special("not", {"x"}, "Logical operator; works the same as Lua.")
1481
1723
define_unary_special("bnot", "~")
1482
-
doc_special("bnot", {"x"}, "Bitwise negation; only works in Lua 5.3+.")
1724
+
doc_special("bnot", {"x"}, "Bitwise negation; only works in Lua 5.3+ or LuaJIT with the --use-bit-lib flag.")
1483
1725
define_unary_special("length", "#")
1484
1726
doc_special("length", {"x"}, "Returns the length of a table or string.")
1727
+
do end (SPECIALS)["~="] = SPECIALS["not="]
1485
1728
SPECIALS["#"] = SPECIALS.length
1486
1729
SPECIALS.quote = function(ast, scope, parent)
1487
-
compiler.assert((#ast == 2), "expected one argument")
1730
+
compiler.assert((#ast == 2), "expected one argument", ast)
1488
1731
local runtime, this_scope = true, scope
1489
1732
while this_scope do
1490
1733
this_scope = this_scope.parent
1491
1734
if (this_scope == compiler.scopes.compiler) then
1492
1735
runtime = false
1736
+
else
1493
1737
end
1494
1738
end
1495
1739
return compiler["do-quote"](ast[2], scope, parent, runtime)
1496
1740
end
1497
1741
doc_special("quote", {"x"}, "Quasiquote the following form. Only works in macro/compiler scope.")
1498
-
local already_warned_3f = {}
1499
-
local compile_env_warning = ("WARNING: Attempting to %s %s in compile" .. " scope.\nIn future versions of Fennel this will not" .. " be allowed without the\n--no-compiler-sandbox flag" .. " or passing a :compilerEnv globals table in options.\n")
1500
-
local function compiler_env_warn(_, key)
1501
-
local v = _G[key]
1502
-
if (v and io and io.stderr and not already_warned_3f[key]) then
1503
-
already_warned_3f[key] = true
1504
-
do end (io.stderr):write(compile_env_warning:format("use global", key))
1742
+
local macro_loaded = {}
1743
+
local function safe_getmetatable(tbl)
1744
+
local mt = getmetatable(tbl)
1745
+
assert((mt ~= getmetatable("")), "Illegal metatable access!")
1746
+
return mt
1747
+
end
1748
+
local safe_require = nil
1749
+
local function safe_compiler_env()
1750
+
local _543_
1751
+
do
1752
+
local _542_ = rawget(_G, "utf8")
1753
+
if (nil ~= _542_) then
1754
+
_543_ = utils.copy(_542_)
1755
+
else
1756
+
_543_ = _542_
1757
+
end
1758
+
end
1759
+
return {table = utils.copy(table), math = utils.copy(math), string = utils.copy(string), pairs = utils.stablepairs, ipairs = ipairs, select = select, tostring = tostring, tonumber = tonumber, bit = rawget(_G, "bit"), pcall = pcall, xpcall = xpcall, next = next, print = print, type = type, assert = assert, error = error, setmetatable = setmetatable, getmetatable = safe_getmetatable, require = safe_require, rawlen = rawget(_G, "rawlen"), rawget = rawget, rawset = rawset, rawequal = rawequal, _VERSION = _VERSION, utf8 = _543_}
1760
+
end
1761
+
local function combined_mt_pairs(env)
1762
+
local combined = {}
1763
+
local _let_545_ = getmetatable(env)
1764
+
local __index = _let_545_["__index"]
1765
+
if ("table" == type(__index)) then
1766
+
for k, v in pairs(__index) do
1767
+
combined[k] = v
1768
+
end
1769
+
else
1770
+
end
1771
+
for k, v in next, env, nil do
1772
+
combined[k] = v
1505
1773
end
1506
-
return v
1774
+
return next, combined, nil
1507
1775
end
1508
-
local safe_compiler_env = setmetatable({assert = assert, bit = rawget(_G, "bit"), error = error, getmetatable = getmetatable, ipairs = ipairs, math = math, next = next, pairs = pairs, pcall = pcall, print = print, rawequal = rawequal, rawget = rawget, rawlen = rawget(_G, "rawlen"), rawset = rawset, select = select, setmetatable = setmetatable, string = string, table = table, tonumber = tonumber, tostring = tostring, type = type, xpcall = xpcall}, {__index = compiler_env_warn})
1509
-
local function make_compiler_env(ast, scope, parent)
1510
-
local function _1_()
1776
+
local function make_compiler_env(ast, scope, parent, _3fopts)
1777
+
local provided
1778
+
do
1779
+
local _547_ = (_3fopts or utils.root.options)
1780
+
if ((_G.type(_547_) == "table") and ((_547_)["compiler-env"] == "strict")) then
1781
+
provided = safe_compiler_env()
1782
+
elseif ((_G.type(_547_) == "table") and (nil ~= (_547_).compilerEnv)) then
1783
+
local compilerEnv = (_547_).compilerEnv
1784
+
provided = compilerEnv
1785
+
elseif ((_G.type(_547_) == "table") and (nil ~= (_547_)["compiler-env"])) then
1786
+
local compiler_env = (_547_)["compiler-env"]
1787
+
provided = compiler_env
1788
+
elseif true then
1789
+
local _ = _547_
1790
+
provided = safe_compiler_env(false)
1791
+
else
1792
+
provided = nil
1793
+
end
1794
+
end
1795
+
local env
1796
+
local function _549_(base)
1797
+
return utils.sym(compiler.gensym((compiler.scopes.macro or scope), base))
1798
+
end
1799
+
local function _550_()
1511
1800
return compiler.scopes.macro
1512
1801
end
1513
-
local function _2_(symbol)
1802
+
local function _551_(symbol)
1514
1803
compiler.assert(compiler.scopes.macro, "must call from macro", ast)
1515
1804
return compiler.scopes.macro.manglings[tostring(symbol)]
1516
1805
end
1517
-
local function _3_(base)
1518
-
return utils.sym(compiler.gensym((compiler.scopes.macro or scope), base))
1519
-
end
1520
-
local function _4_(form)
1806
+
local function _552_(form)
1521
1807
compiler.assert(compiler.scopes.macro, "must call from macro", ast)
1522
1808
return compiler.macroexpand(form, compiler.scopes.macro)
1523
1809
end
1524
-
local _6_
1525
-
do
1526
-
local _5_0 = utils.root.options
1527
-
if ((type(_5_0) == "table") and (nil ~= _5_0.compilerEnv)) then
1528
-
local compilerEnv = _5_0.compilerEnv
1529
-
_6_ = compilerEnv
1530
-
elseif ((type(_5_0) == "table") and (nil ~= _5_0["compiler-env"])) then
1531
-
local compiler_env = _5_0["compiler-env"]
1532
-
_6_ = compiler_env
1810
+
env = {_AST = ast, _CHUNK = parent, _IS_COMPILER = true, _SCOPE = scope, _SPECIALS = compiler.scopes.global.specials, _VARARG = utils.varg(), ["macro-loaded"] = macro_loaded, unpack = unpack, ["assert-compile"] = compiler.assert, view = view, version = utils.version, metadata = compiler.metadata, ["ast-source"] = utils["ast-source"], list = utils.list, ["list?"] = utils["list?"], ["table?"] = utils["table?"], sequence = utils.sequence, ["sequence?"] = utils["sequence?"], sym = utils.sym, ["sym?"] = utils["sym?"], ["multi-sym?"] = utils["multi-sym?"], comment = utils.comment, ["comment?"] = utils["comment?"], ["varg?"] = utils["varg?"], gensym = _549_, ["get-scope"] = _550_, ["in-scope?"] = _551_, macroexpand = _552_}
1811
+
env._G = env
1812
+
return setmetatable(env, {__index = provided, __newindex = provided, __pairs = combined_mt_pairs})
1813
+
end
1814
+
local function _554_(...)
1815
+
local tbl_14_auto = {}
1816
+
local i_15_auto = #tbl_14_auto
1817
+
for c in string.gmatch((package.config or ""), "([^\n]+)") do
1818
+
local val_16_auto = c
1819
+
if (nil ~= val_16_auto) then
1820
+
i_15_auto = (i_15_auto + 1)
1821
+
do end (tbl_14_auto)[i_15_auto] = val_16_auto
1533
1822
else
1534
-
local _ = _5_0
1535
-
_6_ = safe_compiler_env
1536
1823
end
1537
1824
end
1538
-
return setmetatable({["assert-compile"] = compiler.assert, ["get-scope"] = _1_, ["in-scope?"] = _2_, ["list?"] = utils["list?"], ["multi-sym?"] = utils["multi-sym?"], ["sequence?"] = utils["sequence?"], ["sym?"] = utils["sym?"], ["table?"] = utils["table?"], ["varg?"] = utils["varg?"], _AST = ast, _CHUNK = parent, _IS_COMPILER = true, _SCOPE = scope, _SPECIALS = compiler.scopes.global.specials, _VARARG = utils.varg(), gensym = _3_, list = utils.list, macroexpand = _4_, sequence = utils.sequence, sym = utils.sym, unpack = unpack, view = view}, {__index = _6_})
1825
+
return tbl_14_auto
1539
1826
end
1540
-
local cfg = string.gmatch(package.config, "([^\n]+)")
1541
-
local dirsep, pathsep, pathmark = (cfg() or "/"), (cfg() or ";"), (cfg() or "?")
1542
-
local pkg_config = {dirsep = dirsep, pathmark = pathmark, pathsep = pathsep}
1827
+
local _local_553_ = _554_(...)
1828
+
local dirsep = _local_553_[1]
1829
+
local pathsep = _local_553_[2]
1830
+
local pathmark = _local_553_[3]
1831
+
local pkg_config = {dirsep = (dirsep or "/"), pathmark = (pathmark or ";"), pathsep = (pathsep or "?")}
1543
1832
local function escapepat(str)
1544
1833
return string.gsub(str, "[^%w]", "%%%1")
1545
1834
end
1546
-
local function search_module(modulename, pathstring)
1835
+
local function search_module(modulename, _3fpathstring)
1547
1836
local pathsepesc = escapepat(pkg_config.pathsep)
1548
1837
local pattern = ("([^%s]*)%s"):format(pathsepesc, pathsepesc)
1549
1838
local no_dot_module = modulename:gsub("%.", pkg_config.dirsep)
1550
-
local fullpath = ((pathstring or utils["fennel-module"].path) .. pkg_config.pathsep)
1839
+
local fullpath = ((_3fpathstring or utils["fennel-module"].path) .. pkg_config.pathsep)
1551
1840
local function try_path(path)
1552
1841
local filename = path:gsub(escapepat(pkg_config.pathmark), no_dot_module)
1553
1842
local filename2 = path:gsub(escapepat(pkg_config.pathmark), modulename)
1554
-
local _1_0 = (io.open(filename) or io.open(filename2))
1555
-
if (nil ~= _1_0) then
1556
-
local file = _1_0
1843
+
local _556_ = (io.open(filename) or io.open(filename2))
1844
+
if (nil ~= _556_) then
1845
+
local file = _556_
1557
1846
file:close()
1558
1847
return filename
1848
+
elseif true then
1849
+
local _ = _556_
1850
+
return nil, ("no file '" .. filename .. "'")
1851
+
else
1852
+
return nil
1559
1853
end
1560
1854
end
1561
-
local function find_in_path(start)
1562
-
local _1_0 = fullpath:match(pattern, start)
1563
-
if (nil ~= _1_0) then
1564
-
local path = _1_0
1565
-
return (try_path(path) or find_in_path((start + #path + 1)))
1855
+
local function find_in_path(start, _3ftried_paths)
1856
+
local _558_ = fullpath:match(pattern, start)
1857
+
if (nil ~= _558_) then
1858
+
local path = _558_
1859
+
local _559_, _560_ = try_path(path)
1860
+
if (nil ~= _559_) then
1861
+
local filename = _559_
1862
+
return filename
1863
+
elseif ((_559_ == nil) and (nil ~= _560_)) then
1864
+
local error = _560_
1865
+
local function _562_()
1866
+
local _561_ = (_3ftried_paths or {})
1867
+
table.insert(_561_, error)
1868
+
return _561_
1869
+
end
1870
+
return find_in_path((start + #path + 1), _562_())
1871
+
else
1872
+
return nil
1873
+
end
1874
+
elseif true then
1875
+
local _ = _558_
1876
+
local function _564_()
1877
+
local tried_paths = table.concat((_3ftried_paths or {}), "\n\9")
1878
+
if (_VERSION < "Lua 5.4") then
1879
+
return ("\n\9" .. tried_paths)
1880
+
else
1881
+
return tried_paths
1882
+
end
1883
+
end
1884
+
return nil, _564_()
1885
+
else
1886
+
return nil
1566
1887
end
1567
1888
end
1568
1889
return find_in_path(1)
1569
1890
end
1570
-
local function make_searcher(options)
1571
-
local function _1_(module_name)
1891
+
local function make_searcher(_3foptions)
1892
+
local function _567_(module_name)
1572
1893
local opts = utils.copy(utils.root.options)
1573
-
for k, v in pairs((options or {})) do
1894
+
for k, v in pairs((_3foptions or {})) do
1574
1895
opts[k] = v
1575
1896
end
1576
1897
opts["module-name"] = module_name
1577
-
local _2_0 = search_module(module_name)
1578
-
if (nil ~= _2_0) then
1579
-
local filename = _2_0
1580
-
local function _3_(...)
1581
-
return utils["fennel-module"].dofile(filename, opts, ...)
1898
+
local _568_, _569_ = search_module(module_name)
1899
+
if (nil ~= _568_) then
1900
+
local filename = _568_
1901
+
local _572_
1902
+
do
1903
+
local _570_ = filename
1904
+
local _571_ = opts
1905
+
local function _573_(...)
1906
+
return utils["fennel-module"].dofile(_570_, _571_, ...)
1907
+
end
1908
+
_572_ = _573_
1582
1909
end
1583
-
return _3_, filename
1910
+
return _572_, filename
1911
+
elseif ((_568_ == nil) and (nil ~= _569_)) then
1912
+
local error = _569_
1913
+
return error
1914
+
else
1915
+
return nil
1584
1916
end
1585
1917
end
1586
-
return _1_
1918
+
return _567_
1919
+
end
1920
+
local function dofile_with_searcher(fennel_macro_searcher, filename, opts, ...)
1921
+
local searchers = (package.loaders or package.searchers or {})
1922
+
local _ = table.insert(searchers, 1, fennel_macro_searcher)
1923
+
local m = utils["fennel-module"].dofile(filename, opts, ...)
1924
+
table.remove(searchers, 1)
1925
+
return m
1587
1926
end
1588
-
local function macro_globals(env, globals)
1589
-
local allowed = current_global_names(env)
1590
-
for _, k in pairs((globals or {})) do
1591
-
table.insert(allowed, k)
1927
+
local function fennel_macro_searcher(module_name)
1928
+
local opts
1929
+
do
1930
+
local _575_ = utils.copy(utils.root.options)
1931
+
do end (_575_)["module-name"] = module_name
1932
+
_575_["env"] = "_COMPILER"
1933
+
_575_["requireAsInclude"] = false
1934
+
_575_["allowedGlobals"] = nil
1935
+
opts = _575_
1592
1936
end
1593
-
return allowed
1937
+
local _576_ = search_module(module_name, utils["fennel-module"]["macro-path"])
1938
+
if (nil ~= _576_) then
1939
+
local filename = _576_
1940
+
local _577_
1941
+
if (opts["compiler-env"] == _G) then
1942
+
local _578_ = fennel_macro_searcher
1943
+
local _579_ = filename
1944
+
local _580_ = opts
1945
+
local function _582_(...)
1946
+
return dofile_with_searcher(_578_, _579_, _580_, ...)
1947
+
end
1948
+
_577_ = _582_
1949
+
else
1950
+
local _583_ = filename
1951
+
local _584_ = opts
1952
+
local function _586_(...)
1953
+
return utils["fennel-module"].dofile(_583_, _584_, ...)
1954
+
end
1955
+
_577_ = _586_
1956
+
end
1957
+
return _577_, filename
1958
+
else
1959
+
return nil
1960
+
end
1594
1961
end
1595
-
local function compiler_env_domodule(modname, env, _3fast)
1596
-
local filename = compiler.assert(search_module(modname), (modname .. " module not found."), _3fast)
1597
-
local globals = macro_globals(env, current_global_names())
1598
-
return utils["fennel-module"].dofile(filename, {allowedGlobals = globals, env = env, scope = compiler.scopes.compiler, useMetadata = utils.root.options.useMetadata}, modname, filename)
1962
+
local function lua_macro_searcher(module_name)
1963
+
local _589_ = search_module(module_name, package.path)
1964
+
if (nil ~= _589_) then
1965
+
local filename = _589_
1966
+
local code
1967
+
do
1968
+
local f = io.open(filename)
1969
+
local function close_handlers_8_auto(ok_9_auto, ...)
1970
+
f:close()
1971
+
if ok_9_auto then
1972
+
return ...
1973
+
else
1974
+
return error(..., 0)
1975
+
end
1976
+
end
1977
+
local function _591_()
1978
+
return assert(f:read("*a"))
1979
+
end
1980
+
code = close_handlers_8_auto(_G.xpcall(_591_, (package.loaded.fennel or debug).traceback))
1981
+
end
1982
+
local chunk = load_code(code, make_compiler_env(), filename)
1983
+
return chunk, filename
1984
+
else
1985
+
return nil
1986
+
end
1987
+
end
1988
+
local macro_searchers = {fennel_macro_searcher, lua_macro_searcher}
1989
+
local function search_macro_module(modname, n)
1990
+
local _593_ = macro_searchers[n]
1991
+
if (nil ~= _593_) then
1992
+
local f = _593_
1993
+
local _594_, _595_ = f(modname)
1994
+
if ((nil ~= _594_) and true) then
1995
+
local loader = _594_
1996
+
local _3ffilename = _595_
1997
+
return loader, _3ffilename
1998
+
elseif true then
1999
+
local _ = _594_
2000
+
return search_macro_module(modname, (n + 1))
2001
+
else
2002
+
return nil
2003
+
end
2004
+
else
2005
+
return nil
2006
+
end
1599
2007
end
1600
-
local macro_loaded = {}
1601
-
local function metadata_only_fennel(modname)
2008
+
local function sandbox_fennel_module(modname)
1602
2009
if ((modname == "fennel.macros") or (package and package.loaded and ("table" == type(package.loaded[modname])) and (package.loaded[modname].metadata == compiler.metadata))) then
1603
-
return {metadata = compiler.metadata}
2010
+
return {metadata = compiler.metadata, view = view}
2011
+
else
2012
+
return nil
1604
2013
end
1605
2014
end
1606
-
safe_compiler_env.require = function(modname)
1607
-
local function _1_()
1608
-
local mod = compiler_env_domodule(modname, safe_compiler_env)
1609
-
macro_loaded[modname] = mod
1610
-
return mod
2015
+
local function _599_(modname)
2016
+
local function _600_()
2017
+
local loader, filename = search_macro_module(modname, 1)
2018
+
compiler.assert(loader, (modname .. " module not found."))
2019
+
do end (macro_loaded)[modname] = loader(modname, filename)
2020
+
return macro_loaded[modname]
1611
2021
end
1612
-
return (macro_loaded[modname] or metadata_only_fennel(modname) or _1_())
2022
+
return (macro_loaded[modname] or sandbox_fennel_module(modname) or _600_())
1613
2023
end
2024
+
safe_require = _599_
1614
2025
local function add_macros(macros_2a, ast, scope)
1615
2026
compiler.assert(utils["table?"](macros_2a), "expected macros to be table", ast)
1616
2027
for k, v in pairs(macros_2a) do
1617
2028
compiler.assert((type(v) == "function"), "expected each macro to be function", ast)
1618
-
scope.macros[k] = v
2029
+
compiler["check-binding-valid"](utils.sym(k), scope, ast, {["macro?"] = true})
2030
+
do end (scope.macros)[k] = v
1619
2031
end
1620
2032
return nil
1621
2033
end
1622
-
SPECIALS["require-macros"] = function(ast, scope, parent, real_ast)
1623
-
compiler.assert((#ast == 2), "Expected one module name argument", (real_ast or ast))
1624
-
local filename = (ast[2].filename or ast.filename)
1625
-
local modname_code = compiler.compile(ast[2])
1626
-
local modname = load_code(modname_code, nil, filename)(utils.root.options["module-name"], filename)
1627
-
compiler.assert((type(modname) == "string"), "module name must compile to string", (real_ast or ast))
2034
+
local function resolve_module_name(_601_, _scope, _parent, opts)
2035
+
local _arg_602_ = _601_
2036
+
local filename = _arg_602_["filename"]
2037
+
local second = _arg_602_[2]
2038
+
local filename0 = (filename or (utils["table?"](second) and second.filename))
2039
+
local module_name = utils.root.options["module-name"]
2040
+
local modexpr = compiler.compile(second, opts)
2041
+
local modname_chunk = load_code(modexpr)
2042
+
return modname_chunk(module_name, filename0)
2043
+
end
2044
+
SPECIALS["require-macros"] = function(ast, scope, parent, _3freal_ast)
2045
+
compiler.assert((#ast == 2), "Expected one module name argument", (_3freal_ast or ast))
2046
+
local modname = resolve_module_name(ast, scope, parent, {})
2047
+
compiler.assert(utils["string?"](modname), "module name must compile to string", (_3freal_ast or ast))
1628
2048
if not macro_loaded[modname] then
1629
-
local env = make_compiler_env(ast, scope, parent)
1630
-
macro_loaded[modname] = compiler_env_domodule(modname, env, ast)
2049
+
local loader, filename = search_macro_module(modname, 1)
2050
+
compiler.assert(loader, (modname .. " module not found."), ast)
2051
+
do end (macro_loaded)[modname] = compiler.assert(utils["table?"](loader(modname, filename)), "expected macros to be table", (_3freal_ast or ast))
2052
+
else
2053
+
end
2054
+
if ("import-macros" == tostring(ast[1])) then
2055
+
return macro_loaded[modname]
2056
+
else
2057
+
return add_macros(macro_loaded[modname], ast, scope, parent)
1631
2058
end
1632
-
return add_macros(macro_loaded[modname], ast, scope, parent)
1633
2059
end
1634
2060
doc_special("require-macros", {"macro-module-name"}, "Load given module and use its contents as macro definitions in current scope.\nMacro module should return a table of macro functions with string keys.\nConsider using import-macros instead as it is more flexible.")
1635
2061
local function emit_included_fennel(src, path, opts, sub_chunk)
···
1637
2063
local forms = {}
1638
2064
if utils.root.options.requireAsInclude then
1639
2065
subscope.specials.require = compiler["require-include"]
2066
+
else
1640
2067
end
1641
2068
for _, val in parser.parser(parser["string-stream"](src), path) do
1642
2069
table.insert(forms, val)
1643
2070
end
1644
2071
for i = 1, #forms do
1645
-
local subopts = nil
2072
+
local subopts
1646
2073
if (i == #forms) then
1647
2074
subopts = {tail = true}
1648
2075
else
···
1655
2082
end
1656
2083
local function include_path(ast, opts, path, mod, fennel_3f)
1657
2084
utils.root.scope.includes[mod] = "fnl/loading"
1658
-
local src = nil
2085
+
local src
1659
2086
do
1660
2087
local f = assert(io.open(path))
1661
-
local function close_handlers_0_(ok_0_, ...)
2088
+
local function close_handlers_8_auto(ok_9_auto, ...)
1662
2089
f:close()
1663
-
if ok_0_ then
2090
+
if ok_9_auto then
1664
2091
return ...
1665
2092
else
1666
2093
return error(..., 0)
1667
2094
end
1668
2095
end
1669
-
local function _1_()
1670
-
return f:read("*all"):gsub("[\13\n]*$", "")
2096
+
local function _608_()
2097
+
return assert(f:read("*all")):gsub("[\13\n]*$", "")
1671
2098
end
1672
-
src = close_handlers_0_(xpcall(_1_, (package.loaded.fennel or debug).traceback))
2099
+
src = close_handlers_8_auto(_G.xpcall(_608_, (package.loaded.fennel or debug).traceback))
1673
2100
end
1674
2101
local ret = utils.expr(("require(\"" .. mod .. "\")"), "statement")
1675
2102
local target = ("package.preload[%q]"):format(mod)
···
1678
2105
compiler.emit(temp_chunk, preload_str, ast)
1679
2106
compiler.emit(temp_chunk, sub_chunk)
1680
2107
compiler.emit(temp_chunk, "end", ast)
1681
-
for i, v in ipairs(temp_chunk) do
1682
-
table.insert(utils.root.chunk, i, v)
2108
+
for _, v in ipairs(temp_chunk) do
2109
+
table.insert(utils.root.chunk, v)
1683
2110
end
1684
2111
if fennel_3f then
1685
2112
emit_included_fennel(src, path, opts, sub_chunk)
···
1693
2120
if (utils.root.scope.includes[mod] == "fnl/loading") then
1694
2121
compiler.assert(fallback, "circular include detected", ast)
1695
2122
return fallback(modexpr)
2123
+
else
2124
+
return nil
1696
2125
end
1697
2126
end
1698
2127
SPECIALS.include = function(ast, scope, parent, opts)
1699
2128
compiler.assert((#ast == 2), "expected one argument", ast)
1700
-
local modexpr = compiler.compile1(ast[2], scope, parent, {nval = 1})[1]
2129
+
local modexpr
2130
+
do
2131
+
local _611_, _612_ = pcall(resolve_module_name, ast, scope, parent, opts)
2132
+
if ((_611_ == true) and (nil ~= _612_)) then
2133
+
local modname = _612_
2134
+
modexpr = utils.expr(string.format("%q", modname), "literal")
2135
+
elseif true then
2136
+
local _ = _611_
2137
+
modexpr = (compiler.compile1(ast[2], scope, parent, {nval = 1}))[1]
2138
+
else
2139
+
modexpr = nil
2140
+
end
2141
+
end
1701
2142
if ((modexpr.type ~= "literal") or ((modexpr[1]):byte() ~= 34)) then
1702
2143
if opts.fallback then
1703
2144
return opts.fallback(modexpr)
···
1706
2147
end
1707
2148
else
1708
2149
local mod = load_code(("return " .. modexpr[1]))()
1709
-
local function _2_()
1710
-
local _1_0 = search_module(mod)
1711
-
if (nil ~= _1_0) then
1712
-
local fennel_path = _1_0
2150
+
local oldmod = utils.root.options["module-name"]
2151
+
local _
2152
+
utils.root.options["module-name"] = mod
2153
+
_ = nil
2154
+
local res
2155
+
local function _616_()
2156
+
local _615_ = search_module(mod)
2157
+
if (nil ~= _615_) then
2158
+
local fennel_path = _615_
1713
2159
return include_path(ast, opts, fennel_path, mod, true)
1714
-
else
1715
-
local _ = _1_0
2160
+
elseif true then
2161
+
local _0 = _615_
1716
2162
local lua_path = search_module(mod, package.path)
1717
2163
if lua_path then
1718
2164
return include_path(ast, opts, lua_path, mod, false)
···
1721
2167
else
1722
2168
return compiler.assert(false, ("module not found " .. mod), ast)
1723
2169
end
2170
+
else
2171
+
return nil
1724
2172
end
1725
2173
end
1726
-
return (include_circular_fallback(mod, modexpr, opts.fallback, ast) or utils.root.scope.includes[mod] or _2_())
2174
+
res = ((utils["member?"](mod, (utils.root.options.skipInclude or {})) and opts.fallback(modexpr, true)) or include_circular_fallback(mod, modexpr, opts.fallback, ast) or utils.root.scope.includes[mod] or _616_())
2175
+
utils.root.options["module-name"] = oldmod
2176
+
return res
1727
2177
end
1728
2178
end
1729
2179
doc_special("include", {"module-name-literal"}, "Like require but load the target module during compilation and embed it in the\nLua output. The module must be a string literal and resolvable at compile time.")
···
1731
2181
local env = make_compiler_env(ast, scope, parent)
1732
2182
local opts = utils.copy(utils.root.options)
1733
2183
opts.scope = compiler["make-scope"](compiler.scopes.compiler)
1734
-
opts.allowedGlobals = macro_globals(env, current_global_names())
2184
+
opts.allowedGlobals = current_global_names(env)
1735
2185
return load_code(compiler.compile(ast, opts), wrap_env(env))(opts["module-name"], ast.filename)
1736
2186
end
1737
2187
SPECIALS.macros = function(ast, scope, parent)
···
1743
2193
local old_first = ast[1]
1744
2194
ast[1] = utils.sym("do")
1745
2195
local val = eval_compiler_2a(ast, scope, parent)
1746
-
ast[1] = old_first
2196
+
do end (ast)[1] = old_first
1747
2197
return val
1748
2198
end
1749
-
doc_special("eval-compiler", {"..."}, "Evaluate the body at compile-time. Use the macro system instead if possible.")
1750
-
return {["current-global-names"] = current_global_names, ["load-code"] = load_code, ["macro-loaded"] = macro_loaded, ["make-compiler-env"] = make_compiler_env, ["make-searcher"] = make_searcher, ["search-module"] = search_module, ["wrap-env"] = wrap_env, doc = doc_2a}
2199
+
doc_special("eval-compiler", {"..."}, "Evaluate the body at compile-time. Use the macro system instead if possible.", true)
2200
+
return {doc = doc_2a, ["current-global-names"] = current_global_names, ["load-code"] = load_code, ["macro-loaded"] = macro_loaded, ["macro-searchers"] = macro_searchers, ["make-compiler-env"] = make_compiler_env, ["search-module"] = search_module, ["make-searcher"] = make_searcher, ["wrap-env"] = wrap_env}
1751
2201
end
1752
2202
package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or function(...)
1753
2203
local utils = require("fennel.utils")
···
1755
2205
local friend = require("fennel.friend")
1756
2206
local unpack = (table.unpack or _G.unpack)
1757
2207
local scopes = {}
1758
-
local function make_scope(parent)
1759
-
local parent0 = (parent or scopes.global)
1760
-
local _0_
1761
-
if parent0 then
1762
-
_0_ = ((parent0.depth or 0) + 1)
2208
+
local function make_scope(_3fparent)
2209
+
local parent = (_3fparent or scopes.global)
2210
+
local _257_
2211
+
if parent then
2212
+
_257_ = ((parent.depth or 0) + 1)
1763
2213
else
1764
-
_0_ = 0
2214
+
_257_ = 0
1765
2215
end
1766
-
return {autogensyms = {}, depth = _0_, hashfn = (parent0 and parent0.hashfn), includes = setmetatable({}, {__index = (parent0 and parent0.includes)}), macros = setmetatable({}, {__index = (parent0 and parent0.macros)}), manglings = setmetatable({}, {__index = (parent0 and parent0.manglings)}), parent = parent0, refedglobals = setmetatable({}, {__index = (parent0 and parent0.refedglobals)}), specials = setmetatable({}, {__index = (parent0 and parent0.specials)}), symmeta = setmetatable({}, {__index = (parent0 and parent0.symmeta)}), unmanglings = setmetatable({}, {__index = (parent0 and parent0.unmanglings)}), vararg = (parent0 and parent0.vararg)}
2216
+
return {includes = setmetatable({}, {__index = (parent and parent.includes)}), macros = setmetatable({}, {__index = (parent and parent.macros)}), manglings = setmetatable({}, {__index = (parent and parent.manglings)}), specials = setmetatable({}, {__index = (parent and parent.specials)}), symmeta = setmetatable({}, {__index = (parent and parent.symmeta)}), unmanglings = setmetatable({}, {__index = (parent and parent.unmanglings)}), gensyms = setmetatable({}, {__index = (parent and parent.gensyms)}), autogensyms = setmetatable({}, {__index = (parent and parent.autogensyms)}), vararg = (parent and parent.vararg), depth = _257_, hashfn = (parent and parent.hashfn), refedglobals = {}, parent = parent}
1767
2217
end
1768
2218
local function assert_msg(ast, msg)
1769
-
local ast_tbl = nil
2219
+
local ast_tbl
1770
2220
if ("table" == type(ast)) then
1771
2221
ast_tbl = ast
1772
2222
else
···
1775
2225
local m = getmetatable(ast)
1776
2226
local filename = ((m and m.filename) or ast_tbl.filename or "unknown")
1777
2227
local line = ((m and m.line) or ast_tbl.line or "?")
1778
-
local target = nil
1779
-
local function _1_()
1780
-
if utils["sym?"](ast_tbl[1]) then
1781
-
return utils.deref(ast_tbl[1])
1782
-
else
1783
-
return (ast_tbl[1] or "()")
1784
-
end
1785
-
end
1786
-
target = tostring(_1_())
1787
-
return string.format("Compile error in '%s' %s:%s: %s", target, filename, line, msg)
2228
+
local col = ((m and m.col) or ast_tbl.col or "?")
2229
+
local target = tostring((utils["sym?"](ast_tbl[1]) or ast_tbl[1] or "()"))
2230
+
return string.format("%s:%s:%s Compile error in '%s': %s", filename, line, col, target, msg)
1788
2231
end
1789
2232
local function assert_compile(condition, msg, ast)
1790
2233
if not condition then
1791
-
local _0_ = (utils.root.options or {})
1792
-
local source = _0_["source"]
1793
-
local unfriendly = _0_["unfriendly"]
1794
-
utils.root.reset()
1795
-
if unfriendly then
1796
-
error(assert_msg(ast, msg), 0)
2234
+
local _let_260_ = (utils.root.options or {})
2235
+
local source = _let_260_["source"]
2236
+
local unfriendly = _let_260_["unfriendly"]
2237
+
if (nil == utils.hook("assert-compile", condition, msg, ast, utils.root.reset)) then
2238
+
utils.root.reset()
2239
+
if (unfriendly or not friend or not _G.io or not _G.io.read) then
2240
+
error(assert_msg(ast, msg), 0)
2241
+
else
2242
+
friend["assert-compile"](condition, msg, ast, source)
2243
+
end
1797
2244
else
1798
-
friend["assert-compile"](condition, msg, ast, source)
1799
2245
end
2246
+
else
1800
2247
end
1801
2248
return condition
1802
2249
end
···
1804
2251
scopes.global.vararg = true
1805
2252
scopes.compiler = make_scope(scopes.global)
1806
2253
scopes.macro = scopes.global
1807
-
local serialize_subst = {["\11"] = "\\v", ["\12"] = "\\f", ["\7"] = "\\a", ["\8"] = "\\b", ["\9"] = "\\t", ["\n"] = "n"}
2254
+
local serialize_subst = {["\7"] = "\\a", ["\8"] = "\\b", ["\9"] = "\\t", ["\n"] = "n", ["\11"] = "\\v", ["\12"] = "\\f"}
1808
2255
local function serialize_string(str)
1809
-
local function _0_(_241)
2256
+
local function _264_(_241)
1810
2257
return ("\\" .. _241:byte())
1811
2258
end
1812
-
return string.gsub(string.gsub(string.format("%q", str), ".", serialize_subst), "[\128-\255]", _0_)
2259
+
return string.gsub(string.gsub(string.format("%q", str), ".", serialize_subst), "[\128-\255]", _264_)
1813
2260
end
1814
2261
local function global_mangling(str)
1815
2262
if utils["valid-lua-identifier?"](str) then
1816
2263
return str
1817
2264
else
1818
-
local function _0_(_241)
2265
+
local function _265_(_241)
1819
2266
return string.format("_%02x", _241:byte())
1820
2267
end
1821
-
return ("__fnl_global__" .. str:gsub("[^%w]", _0_))
2268
+
return ("__fnl_global__" .. str:gsub("[^%w]", _265_))
1822
2269
end
1823
2270
end
1824
2271
local function global_unmangling(identifier)
1825
-
local _0_0 = string.match(identifier, "^__fnl_global__(.*)$")
1826
-
if (nil ~= _0_0) then
1827
-
local rest = _0_0
1828
-
local _1_0 = nil
1829
-
local function _2_(_241)
2272
+
local _267_ = string.match(identifier, "^__fnl_global__(.*)$")
2273
+
if (nil ~= _267_) then
2274
+
local rest = _267_
2275
+
local _268_
2276
+
local function _269_(_241)
1830
2277
return string.char(tonumber(_241:sub(2), 16))
1831
2278
end
1832
-
_1_0 = string.gsub(rest, "_[%da-f][%da-f]", _2_)
1833
-
return _1_0
2279
+
_268_ = string.gsub(rest, "_[%da-f][%da-f]", _269_)
2280
+
return _268_
2281
+
elseif true then
2282
+
local _ = _267_
2283
+
return identifier
1834
2284
else
1835
-
local _ = _0_0
1836
-
return identifier
2285
+
return nil
1837
2286
end
1838
2287
end
1839
2288
local allowed_globals = nil
1840
-
local function global_allowed(name)
2289
+
local function global_allowed_3f(name)
1841
2290
return (not allowed_globals or utils["member?"](name, allowed_globals))
1842
2291
end
1843
2292
local function unique_mangling(original, mangling, scope, append)
1844
-
if scope.unmanglings[mangling] then
2293
+
if (scope.unmanglings[mangling] and not scope.gensyms[mangling]) then
1845
2294
return unique_mangling(original, (original .. append), scope, (append + 1))
1846
2295
else
1847
2296
return mangling
1848
2297
end
1849
2298
end
1850
-
local function local_mangling(str, scope, ast, temp_manglings)
2299
+
local function local_mangling(str, scope, ast, _3ftemp_manglings)
1851
2300
assert_compile(not utils["multi-sym?"](str), ("unexpected multi symbol " .. str), ast)
1852
-
local raw = nil
1853
-
if (utils["lua-keywords"][str] or str:match("^%d")) then
2301
+
local raw
2302
+
if ((utils["lua-keywords"])[str] or str:match("^%d")) then
1854
2303
raw = ("_" .. str)
1855
2304
else
1856
2305
raw = str
1857
2306
end
1858
-
local mangling = nil
1859
-
local function _1_(_241)
2307
+
local mangling
2308
+
local function _273_(_241)
1860
2309
return string.format("_%02x", _241:byte())
1861
2310
end
1862
-
mangling = string.gsub(string.gsub(raw, "-", "_"), "[^%w_]", _1_)
2311
+
mangling = string.gsub(string.gsub(raw, "-", "_"), "[^%w_]", _273_)
1863
2312
local unique = unique_mangling(mangling, mangling, scope, 0)
1864
-
scope.unmanglings[unique] = str
2313
+
do end (scope.unmanglings)[unique] = str
1865
2314
do
1866
-
local manglings = (temp_manglings or scope.manglings)
1867
-
manglings[str] = unique
2315
+
local manglings = (_3ftemp_manglings or scope.manglings)
2316
+
do end (manglings)[str] = unique
1868
2317
end
1869
2318
return unique
1870
2319
end
1871
2320
local function apply_manglings(scope, new_manglings, ast)
1872
2321
for raw, mangled in pairs(new_manglings) do
1873
2322
assert_compile(not scope.refedglobals[mangled], ("use of global " .. raw .. " is aliased by a local"), ast)
1874
-
scope.manglings[raw] = mangled
2323
+
do end (scope.manglings)[raw] = mangled
1875
2324
end
1876
2325
return nil
1877
2326
end
···
1890
2339
end
1891
2340
return ret
1892
2341
end
1893
-
local function gensym(scope, base)
1894
-
local append, mangling = 0, ((base or "") .. "_0_")
2342
+
local function next_append()
2343
+
utils.root.scope["gensym-append"] = ((utils.root.scope["gensym-append"] or 0) + 1)
2344
+
return ("_" .. utils.root.scope["gensym-append"] .. "_")
2345
+
end
2346
+
local function gensym(scope, _3fbase, _3fsuffix)
2347
+
local mangling = ((_3fbase or "") .. next_append() .. (_3fsuffix or ""))
1895
2348
while scope.unmanglings[mangling] do
1896
-
mangling = ((base or "") .. "_" .. append .. "_")
1897
-
append = (append + 1)
2349
+
mangling = ((_3fbase or "") .. next_append() .. (_3fsuffix or ""))
1898
2350
end
1899
-
scope.unmanglings[mangling] = (base or true)
2351
+
scope.unmanglings[mangling] = (_3fbase or true)
2352
+
do end (scope.gensyms)[mangling] = true
1900
2353
return mangling
1901
2354
end
2355
+
local function combine_auto_gensym(parts, first)
2356
+
parts[1] = first
2357
+
local last = table.remove(parts)
2358
+
local last2 = table.remove(parts)
2359
+
local last_joiner = ((parts["multi-sym-method-call"] and ":") or ".")
2360
+
table.insert(parts, (last2 .. last_joiner .. last))
2361
+
return table.concat(parts, ".")
2362
+
end
1902
2363
local function autogensym(base, scope)
1903
-
local _0_0 = utils["multi-sym?"](base)
1904
-
if (nil ~= _0_0) then
1905
-
local parts = _0_0
1906
-
parts[1] = autogensym(parts[1], scope)
1907
-
return table.concat(parts, ((parts["multi-sym-method-call"] and ":") or "."))
1908
-
else
1909
-
local _ = _0_0
1910
-
local function _1_()
1911
-
local mangling = gensym(scope, base:sub(1, ( - 2)))
1912
-
scope.autogensyms[base] = mangling
2364
+
local _276_ = utils["multi-sym?"](base)
2365
+
if (nil ~= _276_) then
2366
+
local parts = _276_
2367
+
return combine_auto_gensym(parts, autogensym(parts[1], scope))
2368
+
elseif true then
2369
+
local _ = _276_
2370
+
local function _277_()
2371
+
local mangling = gensym(scope, base:sub(1, ( - 2)), "auto")
2372
+
do end (scope.autogensyms)[base] = mangling
1913
2373
return mangling
1914
2374
end
1915
-
return (scope.autogensyms[base] or _1_())
2375
+
return (scope.autogensyms[base] or _277_())
2376
+
else
2377
+
return nil
1916
2378
end
1917
2379
end
1918
-
local already_warned = {}
1919
-
local function check_binding_valid(symbol, scope, ast)
1920
-
local name = utils.deref(symbol)
1921
-
if (io and io.stderr and name:find("&") and not already_warned[symbol]) then
1922
-
already_warned[symbol] = true
1923
-
do end (io.stderr):write(("-- Warning: & will not be allowed in identifier names in " .. "future versions: " .. symbol.filename .. ":" .. symbol.line .. "\n"))
2380
+
local function check_binding_valid(symbol, scope, ast, _3fopts)
2381
+
local name = tostring(symbol)
2382
+
local macro_3f
2383
+
do
2384
+
local t_279_ = _3fopts
2385
+
if (nil ~= t_279_) then
2386
+
t_279_ = (t_279_)["macro?"]
2387
+
else
2388
+
end
2389
+
macro_3f = t_279_
1924
2390
end
1925
-
assert_compile(not (scope.specials[name] or scope.macros[name]), ("local %s was overshadowed by a special form or macro"):format(name), ast)
2391
+
assert_compile(not name:find("&"), "invalid character: &")
2392
+
assert_compile(not name:find("^%."), "invalid character: .")
2393
+
assert_compile(not (scope.specials[name] or (not macro_3f and scope.macros[name])), ("local %s was overshadowed by a special form or macro"):format(name), ast)
1926
2394
return assert_compile(not utils["quoted?"](symbol), string.format("macro tried to bind %s without gensym", name), symbol)
1927
2395
end
1928
-
local function declare_local(symbol, meta, scope, ast, temp_manglings)
2396
+
local function declare_local(symbol, meta, scope, ast, _3ftemp_manglings)
1929
2397
check_binding_valid(symbol, scope, ast)
1930
-
local name = utils.deref(symbol)
2398
+
local name = tostring(symbol)
1931
2399
assert_compile(not utils["multi-sym?"](name), ("unexpected multi symbol " .. name), ast)
1932
-
scope.symmeta[name] = meta
1933
-
return local_mangling(name, scope, ast, temp_manglings)
2400
+
do end (scope.symmeta)[name] = meta
2401
+
return local_mangling(name, scope, ast, _3ftemp_manglings)
1934
2402
end
1935
2403
local function hashfn_arg_name(name, multi_sym_parts, scope)
1936
2404
if not scope.hashfn then
···
1940
2408
elseif multi_sym_parts then
1941
2409
if (multi_sym_parts and (multi_sym_parts[1] == "$")) then
1942
2410
multi_sym_parts[1] = "$1"
2411
+
else
1943
2412
end
1944
2413
return table.concat(multi_sym_parts, ".")
2414
+
else
2415
+
return nil
1945
2416
end
1946
2417
end
1947
-
local function symbol_to_expression(symbol, scope, reference_3f)
1948
-
utils.hook("symbol-to-expression", symbol, scope, reference_3f)
2418
+
local function symbol_to_expression(symbol, scope, _3freference_3f)
2419
+
utils.hook("symbol-to-expression", symbol, scope, _3freference_3f)
1949
2420
local name = symbol[1]
1950
2421
local multi_sym_parts = utils["multi-sym?"](name)
1951
2422
local name0 = (hashfn_arg_name(name, multi_sym_parts, scope) or name)
1952
2423
local parts = (multi_sym_parts or {name0})
1953
-
local etype = (((#parts > 1) and "expression") or "sym")
2424
+
local etype = (((1 < #parts) and "expression") or "sym")
1954
2425
local local_3f = scope.manglings[parts[1]]
1955
2426
if (local_3f and scope.symmeta[parts[1]]) then
1956
2427
scope.symmeta[parts[1]]["used"] = true
2428
+
else
1957
2429
end
1958
-
assert_compile((not reference_3f or local_3f or global_allowed(parts[1])), ("unknown global in strict mode: " .. parts[1]), symbol)
1959
-
if (allowed_globals and not local_3f) then
1960
-
utils.root.scope.refedglobals[parts[1]] = true
2430
+
assert_compile(not scope.macros[parts[1]], "tried to reference a macro at runtime", symbol)
2431
+
assert_compile((not scope.specials[parts[1]] or ("require" == parts[1])), "tried to reference a special form at runtime", symbol)
2432
+
assert_compile((not _3freference_3f or local_3f or ("_ENV" == parts[1]) or global_allowed_3f(parts[1])), ("unknown identifier in strict mode: " .. tostring(parts[1])), symbol)
2433
+
if (allowed_globals and not local_3f and scope.parent) then
2434
+
scope.parent.refedglobals[parts[1]] = true
2435
+
else
1961
2436
end
1962
2437
return utils.expr(combine_parts(parts, scope), etype)
1963
2438
end
1964
-
local function emit(chunk, out, ast)
2439
+
local function emit(chunk, out, _3fast)
1965
2440
if (type(out) == "table") then
1966
2441
return table.insert(chunk, out)
1967
2442
else
1968
-
return table.insert(chunk, {ast = ast, leaf = out})
2443
+
return table.insert(chunk, {ast = _3fast, leaf = out})
1969
2444
end
1970
2445
end
1971
2446
local function peephole(chunk)
1972
2447
if chunk.leaf then
1973
2448
return chunk
1974
-
elseif ((#chunk >= 3) and (chunk[(#chunk - 2)].leaf == "do") and not chunk[(#chunk - 1)].leaf and (chunk[#chunk].leaf == "end")) then
2449
+
elseif ((3 <= #chunk) and (chunk[(#chunk - 2)].leaf == "do") and not chunk[(#chunk - 1)].leaf and (chunk[#chunk].leaf == "end")) then
1975
2450
local kid = peephole(chunk[(#chunk - 1)])
1976
2451
local new_chunk = {ast = chunk.ast}
1977
2452
for i = 1, (#chunk - 3) do
···
1985
2460
return utils.map(chunk, peephole)
1986
2461
end
1987
2462
end
1988
-
local function flatten_chunk_correlated(main_chunk)
2463
+
local function flatten_chunk_correlated(main_chunk, options)
1989
2464
local function flatten(chunk, out, last_line, file)
1990
2465
local last_line0 = last_line
1991
2466
if chunk.leaf then
1992
2467
out[last_line0] = ((out[last_line0] or "") .. " " .. chunk.leaf)
1993
2468
else
1994
2469
for _, subchunk in ipairs(chunk) do
1995
-
if (subchunk.leaf or (#subchunk > 0)) then
1996
-
if (subchunk.ast and (file == subchunk.ast.file)) then
1997
-
last_line0 = math.max(last_line0, (subchunk.ast.line or 0))
2470
+
if (subchunk.leaf or (0 < #subchunk)) then
2471
+
local source = utils["ast-source"](subchunk.ast)
2472
+
if (file == source.filename) then
2473
+
last_line0 = math.max(last_line0, (source.line or 0))
2474
+
else
1998
2475
end
1999
2476
last_line0 = flatten(subchunk, out, last_line0, file)
2477
+
else
2000
2478
end
2001
2479
end
2002
2480
end
2003
2481
return last_line0
2004
2482
end
2005
2483
local out = {}
2006
-
local last = flatten(main_chunk, out, 1, main_chunk.file)
2484
+
local last = flatten(main_chunk, out, 1, options.filename)
2007
2485
for i = 1, last do
2008
2486
if (out[i] == nil) then
2009
2487
out[i] = ""
2488
+
else
2010
2489
end
2011
2490
end
2012
2491
return table.concat(out, "\n")
2013
2492
end
2014
-
local function flatten_chunk(sm, chunk, tab, depth)
2493
+
local function flatten_chunk(file_sourcemap, chunk, tab, depth)
2015
2494
if chunk.leaf then
2016
-
local code = chunk.leaf
2017
-
local info = chunk.ast
2018
-
if sm then
2019
-
table.insert(sm, ((info and info.line) or ( - 1)))
2020
-
end
2021
-
return code
2495
+
local _let_291_ = utils["ast-source"](chunk.ast)
2496
+
local filename = _let_291_["filename"]
2497
+
local line = _let_291_["line"]
2498
+
table.insert(file_sourcemap, {filename, line})
2499
+
return chunk.leaf
2022
2500
else
2023
-
local tab0 = nil
2501
+
local tab0
2024
2502
do
2025
-
local _0_0 = tab
2026
-
if (_0_0 == true) then
2503
+
local _292_ = tab
2504
+
if (_292_ == true) then
2027
2505
tab0 = " "
2028
-
elseif (_0_0 == false) then
2506
+
elseif (_292_ == false) then
2029
2507
tab0 = ""
2030
-
elseif (_0_0 == tab) then
2508
+
elseif (_292_ == tab) then
2031
2509
tab0 = tab
2032
-
elseif (_0_0 == nil) then
2510
+
elseif (_292_ == nil) then
2033
2511
tab0 = ""
2034
2512
else
2035
-
tab0 = nil
2513
+
tab0 = nil
2036
2514
end
2037
2515
end
2038
2516
local function parter(c)
2039
-
if (c.leaf or (#c > 0)) then
2040
-
local sub = flatten_chunk(sm, c, tab0, (depth + 1))
2041
-
if (depth > 0) then
2517
+
if (c.leaf or (0 < #c)) then
2518
+
local sub = flatten_chunk(file_sourcemap, c, tab0, (depth + 1))
2519
+
if (0 < depth) then
2042
2520
return (tab0 .. sub:gsub("\n", ("\n" .. tab0)))
2043
2521
else
2044
2522
return sub
2045
2523
end
2524
+
else
2525
+
return nil
2046
2526
end
2047
2527
end
2048
2528
return table.concat(utils.map(chunk, parter), "\n")
2049
2529
end
2050
2530
end
2051
-
local fennel_sourcemap = {}
2531
+
local sourcemap = {}
2052
2532
local function make_short_src(source)
2053
2533
local source0 = source:gsub("\n", " ")
2054
2534
if (#source0 <= 49) then
···
2060
2540
local function flatten(chunk, options)
2061
2541
local chunk0 = peephole(chunk)
2062
2542
if options.correlate then
2063
-
return flatten_chunk_correlated(chunk0), {}
2543
+
return flatten_chunk_correlated(chunk0, options), {}
2064
2544
else
2065
-
local sm = {}
2066
-
local ret = flatten_chunk(sm, chunk0, options.indent, 0)
2067
-
if sm then
2068
-
sm.short_src = make_short_src((options.filename or options.source or ret))
2069
-
if options.filename then
2070
-
sm.key = ("@" .. options.filename)
2071
-
else
2072
-
sm.key = ret
2073
-
end
2074
-
fennel_sourcemap[sm.key] = sm
2545
+
local file_sourcemap = {}
2546
+
local src = flatten_chunk(file_sourcemap, chunk0, options.indent, 0)
2547
+
file_sourcemap.short_src = (options.filename or make_short_src((options.source or src)))
2548
+
if options.filename then
2549
+
file_sourcemap.key = ("@" .. options.filename)
2550
+
else
2551
+
file_sourcemap.key = src
2075
2552
end
2076
-
return ret, sm
2553
+
sourcemap[file_sourcemap.key] = file_sourcemap
2554
+
return src, file_sourcemap
2077
2555
end
2078
2556
end
2079
2557
local function make_metadata()
2080
-
local function _0_(self, tgt, key)
2558
+
local function _300_(self, tgt, key)
2081
2559
if self[tgt] then
2082
2560
return self[tgt][key]
2561
+
else
2562
+
return nil
2083
2563
end
2084
2564
end
2085
-
local function _1_(self, tgt, key, value)
2565
+
local function _302_(self, tgt, key, value)
2086
2566
self[tgt] = (self[tgt] or {})
2087
-
self[tgt][key] = value
2567
+
do end (self[tgt])[key] = value
2088
2568
return tgt
2089
2569
end
2090
-
local function _2_(self, tgt, ...)
2570
+
local function _303_(self, tgt, ...)
2091
2571
local kv_len = select("#", ...)
2092
2572
local kvs = {...}
2093
2573
if ((kv_len % 2) ~= 0) then
2094
2574
error("metadata:setall() expected even number of k/v pairs")
2575
+
else
2095
2576
end
2096
2577
self[tgt] = (self[tgt] or {})
2097
2578
for i = 1, kv_len, 2 do
···
2099
2580
end
2100
2581
return tgt
2101
2582
end
2102
-
return setmetatable({}, {__index = {get = _0_, set = _1_, setall = _2_}, __mode = "k"})
2583
+
return setmetatable({}, {__index = {get = _300_, set = _302_, setall = _303_}, __mode = "k"})
2103
2584
end
2104
2585
local function exprs1(exprs)
2105
-
return table.concat(utils.map(exprs, 1), ", ")
2586
+
return table.concat(utils.map(exprs, tostring), ", ")
2106
2587
end
2107
2588
local function keep_side_effects(exprs, chunk, start, ast)
2108
2589
local start0 = (start or 1)
···
2112
2593
emit(chunk, string.format("do local _ = %s end", tostring(se)), ast)
2113
2594
elseif (se.type == "statement") then
2114
2595
local code = tostring(se)
2115
-
emit(chunk, (((code:byte() == 40) and ("do end " .. code)) or code), ast)
2596
+
local disambiguated
2597
+
if (code:byte() == 40) then
2598
+
disambiguated = ("do end " .. code)
2599
+
else
2600
+
disambiguated = code
2601
+
end
2602
+
emit(chunk, disambiguated, ast)
2603
+
else
2116
2604
end
2117
2605
end
2118
2606
return nil
···
2122
2610
local n = opts.nval
2123
2611
local len = #exprs
2124
2612
if (n ~= len) then
2125
-
if (len > n) then
2613
+
if (n < len) then
2126
2614
keep_side_effects(exprs, parent, (n + 1), ast)
2127
2615
for i = (n + 1), len do
2128
2616
exprs[i] = nil
···
2132
2620
exprs[i] = utils.expr("nil", "literal")
2133
2621
end
2134
2622
end
2623
+
else
2135
2624
end
2625
+
else
2136
2626
end
2137
2627
if opts.tail then
2138
2628
emit(parent, string.format("return %s", exprs1(exprs)), ast)
2629
+
else
2139
2630
end
2140
2631
if opts.target then
2141
2632
local result = exprs1(exprs)
2142
-
local function _2_()
2633
+
local function _311_()
2143
2634
if (result == "") then
2144
2635
return "nil"
2145
2636
else
2146
2637
return result
2147
2638
end
2148
2639
end
2149
-
emit(parent, string.format("%s = %s", opts.target, _2_()), ast)
2640
+
emit(parent, string.format("%s = %s", opts.target, _311_()), ast)
2641
+
else
2150
2642
end
2151
2643
if (opts.tail or opts.target) then
2152
2644
return {returned = true}
2153
2645
else
2154
-
local _3_0 = exprs
2155
-
_3_0["returned"] = true
2156
-
return _3_0
2646
+
local _313_ = exprs
2647
+
_313_["returned"] = true
2648
+
return _313_
2157
2649
end
2158
2650
end
2159
-
local function find_macro(ast, scope, multi_sym_parts)
2160
-
local function find_in_table(t, i)
2161
-
if (i <= #multi_sym_parts) then
2162
-
return find_in_table((utils["table?"](t) and t[multi_sym_parts[i]]), (i + 1))
2651
+
local function find_macro(ast, scope)
2652
+
local macro_2a
2653
+
do
2654
+
local _315_ = utils["sym?"](ast[1])
2655
+
if (_315_ ~= nil) then
2656
+
local _316_ = tostring(_315_)
2657
+
if (_316_ ~= nil) then
2658
+
macro_2a = scope.macros[_316_]
2659
+
else
2660
+
macro_2a = _316_
2661
+
end
2163
2662
else
2164
-
return t
2663
+
macro_2a = _315_
2165
2664
end
2166
2665
end
2167
-
local macro_2a = (utils["sym?"](ast[1]) and scope.macros[utils.deref(ast[1])])
2666
+
local multi_sym_parts = utils["multi-sym?"](ast[1])
2168
2667
if (not macro_2a and multi_sym_parts) then
2169
-
local nested_macro = find_in_table(scope.macros, 1)
2668
+
local nested_macro = utils["get-in"](scope.macros, multi_sym_parts)
2170
2669
assert_compile((not scope.macros[multi_sym_parts[1]] or (type(nested_macro) == "function")), "macro not found in imported macro module", ast)
2171
2670
return nested_macro
2172
2671
else
2173
2672
return macro_2a
2174
2673
end
2175
2674
end
2176
-
local function macroexpand_2a(ast, scope, once)
2177
-
if not utils["list?"](ast) then
2675
+
local function propagate_trace_info(_320_, _index, node)
2676
+
local _arg_321_ = _320_
2677
+
local filename = _arg_321_["filename"]
2678
+
local line = _arg_321_["line"]
2679
+
local bytestart = _arg_321_["bytestart"]
2680
+
local byteend = _arg_321_["byteend"]
2681
+
do
2682
+
local src = utils["ast-source"](node)
2683
+
if (("table" == type(node)) and (filename ~= src.filename)) then
2684
+
src.filename, src.line, src["from-macro?"] = filename, line, true
2685
+
src.bytestart, src.byteend = bytestart, byteend
2686
+
else
2687
+
end
2688
+
end
2689
+
return ("table" == type(node))
2690
+
end
2691
+
local function max_n(t)
2692
+
local n = 0
2693
+
for k in pairs(t) do
2694
+
if ("number" == type(k)) then
2695
+
n = math.max(k, n)
2696
+
else
2697
+
end
2698
+
end
2699
+
return n
2700
+
end
2701
+
local function quote_literal_nils(index, node, parent)
2702
+
if (parent and utils["list?"](parent)) then
2703
+
for i = 1, max_n(parent) do
2704
+
local _324_ = parent[i]
2705
+
if (_324_ == nil) then
2706
+
parent[i] = utils.sym("nil")
2707
+
else
2708
+
end
2709
+
end
2710
+
else
2711
+
end
2712
+
return index, node, parent
2713
+
end
2714
+
local function comp(f, g)
2715
+
local function _327_(...)
2716
+
return f(g(...))
2717
+
end
2718
+
return _327_
2719
+
end
2720
+
local function built_in_3f(m)
2721
+
local found_3f = false
2722
+
for _, f in pairs(scopes.global.macros) do
2723
+
if found_3f then break end
2724
+
found_3f = (f == m)
2725
+
end
2726
+
return found_3f
2727
+
end
2728
+
local function macroexpand_2a(ast, scope, _3fonce)
2729
+
local _328_
2730
+
if utils["list?"](ast) then
2731
+
_328_ = find_macro(ast, scope)
2732
+
else
2733
+
_328_ = nil
2734
+
end
2735
+
if (_328_ == false) then
2178
2736
return ast
2179
-
else
2180
-
local macro_2a = find_macro(ast, scope, utils["multi-sym?"](ast[1]))
2181
-
if not macro_2a then
2182
-
return ast
2183
-
else
2184
-
local old_scope = scopes.macro
2185
-
local _ = nil
2186
-
scopes.macro = scope
2187
-
_ = nil
2188
-
local ok, transformed = pcall(macro_2a, unpack(ast, 2))
2189
-
scopes.macro = old_scope
2190
-
assert_compile(ok, transformed, ast)
2191
-
if (once or not transformed) then
2192
-
return transformed
2737
+
elseif (nil ~= _328_) then
2738
+
local macro_2a = _328_
2739
+
local old_scope = scopes.macro
2740
+
local _
2741
+
scopes.macro = scope
2742
+
_ = nil
2743
+
local ok, transformed = nil, nil
2744
+
local function _330_()
2745
+
return macro_2a(unpack(ast, 2))
2746
+
end
2747
+
local function _331_()
2748
+
if built_in_3f(macro_2a) then
2749
+
return tostring
2193
2750
else
2194
-
return macroexpand_2a(transformed, scope)
2751
+
return debug.traceback
2195
2752
end
2196
2753
end
2754
+
ok, transformed = xpcall(_330_, _331_())
2755
+
local _333_
2756
+
do
2757
+
local _332_ = ast
2758
+
local function _334_(...)
2759
+
return propagate_trace_info(_332_, ...)
2760
+
end
2761
+
_333_ = _334_
2762
+
end
2763
+
utils["walk-tree"](transformed, comp(_333_, quote_literal_nils))
2764
+
scopes.macro = old_scope
2765
+
assert_compile(ok, transformed, ast)
2766
+
if (_3fonce or not transformed) then
2767
+
return transformed
2768
+
else
2769
+
return macroexpand_2a(transformed, scope)
2770
+
end
2771
+
elseif true then
2772
+
local _ = _328_
2773
+
return ast
2774
+
else
2775
+
return nil
2197
2776
end
2198
2777
end
2199
2778
local function compile_special(ast, scope, parent, opts, special)
2200
2779
local exprs = (special(ast, scope, parent, opts) or utils.expr("nil", "literal"))
2201
-
local exprs0 = nil
2202
-
if (type(exprs) == "string") then
2780
+
local exprs0
2781
+
if ("table" ~= type(exprs)) then
2203
2782
exprs0 = utils.expr(exprs, "expression")
2204
2783
else
2205
2784
exprs0 = exprs
2206
2785
end
2207
-
local exprs2 = nil
2786
+
local exprs2
2208
2787
if utils["expr?"](exprs0) then
2209
2788
exprs2 = {exprs0}
2210
2789
else
···
2220
2799
end
2221
2800
local function compile_function_call(ast, scope, parent, opts, compile1, len)
2222
2801
local fargs = {}
2223
-
local fcallee = compile1(ast[1], scope, parent, {nval = 1})[1]
2224
-
assert_compile((fcallee.type ~= "literal"), ("cannot call literal value " .. tostring(ast[1])), ast)
2802
+
local fcallee = (compile1(ast[1], scope, parent, {nval = 1}))[1]
2803
+
assert_compile((utils["sym?"](ast[1]) or utils["list?"](ast[1]) or ("string" == type(ast[1]))), ("cannot call literal value " .. tostring(ast[1])), ast)
2225
2804
for i = 2, len do
2226
-
local subexprs = nil
2227
-
local _0_
2805
+
local subexprs
2806
+
local _340_
2228
2807
if (i ~= len) then
2229
-
_0_ = 1
2808
+
_340_ = 1
2230
2809
else
2231
-
_0_ = nil
2810
+
_340_ = nil
2232
2811
end
2233
-
subexprs = compile1(ast[i], scope, parent, {nval = _0_})
2234
-
table.insert(fargs, (subexprs[1] or utils.expr("nil", "literal")))
2812
+
subexprs = compile1(ast[i], scope, parent, {nval = _340_})
2813
+
table.insert(fargs, subexprs[1])
2235
2814
if (i == len) then
2236
2815
for j = 2, #subexprs do
2237
2816
table.insert(fargs, subexprs[j])
···
2240
2819
keep_side_effects(subexprs, parent, 2, ast[i])
2241
2820
end
2242
2821
end
2243
-
local call = string.format("%s(%s)", tostring(fcallee), exprs1(fargs))
2822
+
local pat
2823
+
if ("string" == type(ast[1])) then
2824
+
pat = "(%s)(%s)"
2825
+
else
2826
+
pat = "%s(%s)"
2827
+
end
2828
+
local call = string.format(pat, tostring(fcallee), exprs1(fargs))
2244
2829
return handle_compile_opts({utils.expr(call, "statement")}, parent, opts, ast)
2245
2830
end
2246
2831
local function compile_call(ast, scope, parent, opts, compile1)
···
2248
2833
local len = #ast
2249
2834
local first = ast[1]
2250
2835
local multi_sym_parts = utils["multi-sym?"](first)
2251
-
local special = (utils["sym?"](first) and scope.specials[utils.deref(first)])
2252
-
assert_compile((len > 0), "expected a function, macro, or special to call", ast)
2836
+
local special = (utils["sym?"](first) and scope.specials[tostring(first)])
2837
+
assert_compile((0 < len), "expected a function, macro, or special to call", ast)
2253
2838
if special then
2254
2839
return compile_special(ast, scope, parent, opts, special)
2255
2840
elseif (multi_sym_parts and multi_sym_parts["multi-sym-method-call"]) then
2256
2841
local table_with_method = table.concat({unpack(multi_sym_parts, 1, (#multi_sym_parts - 1))}, ".")
2257
2842
local method_to_call = multi_sym_parts[#multi_sym_parts]
2258
-
local new_ast = utils.list(utils.sym(":", scope), utils.sym(table_with_method, scope), method_to_call, select(2, unpack(ast)))
2843
+
local new_ast = utils.list(utils.sym(":", ast), utils.sym(table_with_method, ast), method_to_call, select(2, unpack(ast)))
2259
2844
return compile1(new_ast, scope, parent, opts)
2260
2845
else
2261
2846
return compile_function_call(ast, scope, parent, opts, compile1, len)
2262
2847
end
2263
2848
end
2264
2849
local function compile_varg(ast, scope, parent, opts)
2265
-
assert_compile(scope.vararg, "unexpected vararg", ast)
2850
+
local _345_
2851
+
if scope.hashfn then
2852
+
_345_ = "use $... in hashfn"
2853
+
else
2854
+
_345_ = "unexpected vararg"
2855
+
end
2856
+
assert_compile(scope.vararg, _345_, ast)
2266
2857
return handle_compile_opts({utils.expr("...", "varg")}, parent, opts, ast)
2267
2858
end
2268
2859
local function compile_sym(ast, scope, parent, opts)
2269
2860
local multi_sym_parts = utils["multi-sym?"](ast)
2270
2861
assert_compile(not (multi_sym_parts and multi_sym_parts["multi-sym-method-call"]), "multisym method calls may only be in call position", ast)
2271
-
local e = nil
2862
+
local e
2272
2863
if (ast[1] == "nil") then
2273
2864
e = utils.expr("nil", "literal")
2274
2865
else
···
2277
2868
return handle_compile_opts({e}, parent, opts, ast)
2278
2869
end
2279
2870
local function serialize_number(n)
2280
-
local _0_0, _1_0, _2_0 = math.modf(n)
2281
-
if ((nil ~= _0_0) and (_1_0 == 0)) then
2282
-
local int = _0_0
2283
-
return tostring(int)
2284
-
else
2285
-
local _3_
2286
-
do
2287
-
local frac = _1_0
2288
-
_3_ = (((_0_0 == 0) and (nil ~= _1_0)) and (frac < 0))
2289
-
end
2290
-
if _3_ then
2291
-
local frac = _1_0
2292
-
return ("-0." .. tostring(frac):gsub("^-?0.", ""))
2293
-
elseif ((nil ~= _0_0) and (nil ~= _1_0)) then
2294
-
local int = _0_0
2295
-
local frac = _1_0
2296
-
return (int .. "." .. tostring(frac):gsub("^-?0.", ""))
2297
-
end
2298
-
end
2871
+
local _348_ = string.gsub(tostring(n), ",", ".")
2872
+
return _348_
2299
2873
end
2300
2874
local function compile_scalar(ast, _scope, parent, opts)
2301
-
local serialize = nil
2875
+
local serialize
2302
2876
do
2303
-
local _0_0 = type(ast)
2304
-
if (_0_0 == "nil") then
2877
+
local _349_ = type(ast)
2878
+
if (_349_ == "nil") then
2305
2879
serialize = tostring
2306
-
elseif (_0_0 == "boolean") then
2880
+
elseif (_349_ == "boolean") then
2307
2881
serialize = tostring
2308
-
elseif (_0_0 == "string") then
2882
+
elseif (_349_ == "string") then
2309
2883
serialize = serialize_string
2310
-
elseif (_0_0 == "number") then
2884
+
elseif (_349_ == "number") then
2311
2885
serialize = serialize_number
2312
2886
else
2313
-
serialize = nil
2887
+
serialize = nil
2314
2888
end
2315
2889
end
2316
2890
return handle_compile_opts({utils.expr(serialize(ast), "literal")}, parent, opts)
2317
2891
end
2318
2892
local function compile_table(ast, scope, parent, opts, compile1)
2319
2893
local buffer = {}
2320
-
for i = 1, #ast do
2321
-
local nval = ((i ~= #ast) and 1)
2322
-
table.insert(buffer, exprs1(compile1(ast[i], scope, parent, {nval = nval})))
2323
-
end
2324
2894
local function write_other_values(k)
2325
-
if ((type(k) ~= "number") or (math.floor(k) ~= k) or (k < 1) or (k > #ast)) then
2895
+
if ((type(k) ~= "number") or (math.floor(k) ~= k) or (k < 1) or (#ast < k)) then
2326
2896
if ((type(k) == "string") and utils["valid-lua-identifier?"](k)) then
2327
2897
return {k, k}
2328
2898
else
2329
-
local _0_ = compile1(k, scope, parent, {nval = 1})
2330
-
local compiled = _0_[1]
2899
+
local _let_351_ = compile1(k, scope, parent, {nval = 1})
2900
+
local compiled = _let_351_[1]
2331
2901
local kstr = ("[" .. tostring(compiled) .. "]")
2332
2902
return {kstr, k}
2333
2903
end
2904
+
else
2905
+
return nil
2334
2906
end
2335
2907
end
2336
2908
do
2337
-
local keys = nil
2909
+
local keys
2338
2910
do
2339
-
local _0_0 = utils.kvmap(ast, write_other_values)
2340
-
local function _1_(a, b)
2341
-
return (a[1] < b[1])
2911
+
local tbl_14_auto = {}
2912
+
local i_15_auto = #tbl_14_auto
2913
+
for k, v in utils.stablepairs(ast) do
2914
+
local val_16_auto = write_other_values(k, v)
2915
+
if (nil ~= val_16_auto) then
2916
+
i_15_auto = (i_15_auto + 1)
2917
+
do end (tbl_14_auto)[i_15_auto] = val_16_auto
2918
+
else
2919
+
end
2342
2920
end
2343
-
table.sort(_0_0, _1_)
2344
-
keys = _0_0
2921
+
keys = tbl_14_auto
2345
2922
end
2346
-
local function _1_(k)
2347
-
local v = tostring(compile1(ast[k[2]], scope, parent, {nval = 1})[1])
2348
-
return string.format("%s = %s", k[1], v)
2923
+
local function _357_(_355_)
2924
+
local _arg_356_ = _355_
2925
+
local k1 = _arg_356_[1]
2926
+
local k2 = _arg_356_[2]
2927
+
local _let_358_ = compile1(ast[k2], scope, parent, {nval = 1})
2928
+
local v = _let_358_[1]
2929
+
return string.format("%s = %s", k1, tostring(v))
2349
2930
end
2350
-
utils.map(keys, _1_, buffer)
2931
+
utils.map(keys, _357_, buffer)
2932
+
end
2933
+
for i = 1, #ast do
2934
+
local nval = ((i ~= #ast) and 1)
2935
+
table.insert(buffer, exprs1(compile1(ast[i], scope, parent, {nval = nval})))
2351
2936
end
2352
2937
return handle_compile_opts({utils.expr(("{" .. table.concat(buffer, ", ") .. "}"), "expression")}, parent, opts, ast)
2353
2938
end
2354
-
local function compile1(ast, scope, parent, opts)
2355
-
local opts0 = (opts or {})
2939
+
local function compile1(ast, scope, parent, _3fopts)
2940
+
local opts = (_3fopts or {})
2356
2941
local ast0 = macroexpand_2a(ast, scope)
2357
2942
if utils["list?"](ast0) then
2358
-
return compile_call(ast0, scope, parent, opts0, compile1)
2943
+
return compile_call(ast0, scope, parent, opts, compile1)
2359
2944
elseif utils["varg?"](ast0) then
2360
-
return compile_varg(ast0, scope, parent, opts0)
2945
+
return compile_varg(ast0, scope, parent, opts)
2361
2946
elseif utils["sym?"](ast0) then
2362
-
return compile_sym(ast0, scope, parent, opts0)
2947
+
return compile_sym(ast0, scope, parent, opts)
2363
2948
elseif (type(ast0) == "table") then
2364
-
return compile_table(ast0, scope, parent, opts0, compile1)
2949
+
return compile_table(ast0, scope, parent, opts, compile1)
2365
2950
elseif ((type(ast0) == "nil") or (type(ast0) == "boolean") or (type(ast0) == "number") or (type(ast0) == "string")) then
2366
-
return compile_scalar(ast0, scope, parent, opts0)
2951
+
return compile_scalar(ast0, scope, parent, opts)
2367
2952
else
2368
2953
return assert_compile(false, ("could not compile value of type " .. type(ast0)), ast0)
2369
2954
end
2370
2955
end
2371
2956
local function destructure(to, from, ast, scope, parent, opts)
2372
2957
local opts0 = (opts or {})
2373
-
local _0_ = opts0
2374
-
local declaration = _0_["declaration"]
2375
-
local forceglobal = _0_["forceglobal"]
2376
-
local forceset = _0_["forceset"]
2377
-
local isvar = _0_["isvar"]
2378
-
local nomulti = _0_["nomulti"]
2379
-
local noundef = _0_["noundef"]
2380
-
local symtype = _0_["symtype"]
2958
+
local _let_360_ = opts0
2959
+
local isvar = _let_360_["isvar"]
2960
+
local declaration = _let_360_["declaration"]
2961
+
local forceglobal = _let_360_["forceglobal"]
2962
+
local forceset = _let_360_["forceset"]
2963
+
local symtype = _let_360_["symtype"]
2381
2964
local symtype0 = ("_" .. (symtype or "dst"))
2382
-
local setter = nil
2965
+
local setter
2383
2966
if declaration then
2384
2967
setter = "local %s = %s"
2385
2968
else
···
2388
2971
local new_manglings = {}
2389
2972
local function getname(symbol, up1)
2390
2973
local raw = symbol[1]
2391
-
assert_compile(not (nomulti and utils["multi-sym?"](raw)), ("unexpected multi symbol " .. raw), up1)
2974
+
assert_compile(not (opts0.nomulti and utils["multi-sym?"](raw)), ("unexpected multi symbol " .. raw), up1)
2392
2975
if declaration then
2393
2976
return declare_local(symbol, nil, scope, symbol, new_manglings)
2394
2977
else
2395
2978
local parts = (utils["multi-sym?"](raw) or {raw})
2396
2979
local meta = scope.symmeta[parts[1]]
2980
+
assert_compile(not raw:find(":"), "cannot set method sym", symbol)
2397
2981
if ((#parts == 1) and not forceset) then
2398
2982
assert_compile(not (forceglobal and meta), string.format("global %s conflicts with local", tostring(symbol)), symbol)
2399
2983
assert_compile(not (meta and not meta.var), ("expected var " .. raw), symbol)
2400
-
assert_compile((meta or not noundef), ("expected local " .. parts[1]), symbol)
2984
+
assert_compile((meta or not opts0.noundef), ("expected local " .. parts[1]), symbol)
2985
+
else
2401
2986
end
2402
2987
if forceglobal then
2403
2988
assert_compile(not scope.symmeta[scope.unmanglings[raw]], ("global " .. raw .. " conflicts with local"), symbol)
2404
-
scope.manglings[raw] = global_mangling(raw)
2405
-
scope.unmanglings[global_mangling(raw)] = raw
2989
+
do end (scope.manglings)[raw] = global_mangling(raw)
2990
+
do end (scope.unmanglings)[global_mangling(raw)] = raw
2406
2991
if allowed_globals then
2407
2992
table.insert(allowed_globals, raw)
2993
+
else
2408
2994
end
2995
+
else
2409
2996
end
2410
2997
return symbol_to_expression(symbol, scope)[1]
2411
2998
end
2412
2999
end
2413
3000
local function compile_top_target(lvalues)
2414
-
local inits = nil
2415
-
local function _2_(_241)
3001
+
local inits
3002
+
local function _366_(_241)
2416
3003
if scope.manglings[_241] then
2417
3004
return _241
2418
3005
else
2419
3006
return "nil"
2420
3007
end
2421
3008
end
2422
-
inits = utils.map(lvalues, _2_)
3009
+
inits = utils.map(lvalues, _366_)
2423
3010
local init = table.concat(inits, ", ")
2424
3011
local lvalue = table.concat(lvalues, ", ")
2425
-
local plen, plast = #parent, parent[#parent]
3012
+
local plast = parent[#parent]
3013
+
local plen = #parent
2426
3014
local ret = compile1(from, scope, parent, {target = lvalue})
2427
3015
if declaration then
2428
3016
for pi = plen, #parent do
2429
3017
if (parent[pi] == plast) then
2430
3018
plen = pi
3019
+
else
2431
3020
end
2432
3021
end
2433
3022
if ((#parent == (plen + 1)) and parent[#parent].leaf) then
2434
3023
parent[#parent]["leaf"] = ("local " .. parent[#parent].leaf)
3024
+
elseif (init == "nil") then
3025
+
table.insert(parent, (plen + 1), {ast = ast, leaf = ("local " .. lvalue)})
2435
3026
else
2436
3027
table.insert(parent, (plen + 1), {ast = ast, leaf = ("local " .. lvalue .. " = " .. init)})
2437
3028
end
3029
+
else
2438
3030
end
2439
3031
return ret
2440
3032
end
···
2447
3039
emit(parent, setter:format(lname, exprs1(rightexprs)), left)
2448
3040
end
2449
3041
if declaration then
2450
-
scope.symmeta[utils.deref(left)] = {var = isvar}
3042
+
scope.symmeta[tostring(left)] = {var = isvar}
3043
+
return nil
3044
+
else
2451
3045
return nil
2452
3046
end
2453
3047
end
3048
+
local unpack_fn = "function (t, k, e)\n local mt = getmetatable(t)\n if 'table' == type(mt) and mt.__fennelrest then\n return mt.__fennelrest(t, k)\n elseif e then\n local rest = {}\n for k, v in pairs(t) do\n if not e[k] then rest[k] = v end\n end\n return rest\n else\n return {(table.unpack or unpack)(t, k)}\n end\n end"
3049
+
local function destructure_kv_rest(s, v, left, excluded_keys, destructure1)
3050
+
local exclude_str
3051
+
local _373_
3052
+
do
3053
+
local tbl_14_auto = {}
3054
+
local i_15_auto = #tbl_14_auto
3055
+
for _, k in ipairs(excluded_keys) do
3056
+
local val_16_auto = string.format("[%s] = true", serialize_string(k))
3057
+
if (nil ~= val_16_auto) then
3058
+
i_15_auto = (i_15_auto + 1)
3059
+
do end (tbl_14_auto)[i_15_auto] = val_16_auto
3060
+
else
3061
+
end
3062
+
end
3063
+
_373_ = tbl_14_auto
3064
+
end
3065
+
exclude_str = table.concat(_373_, ", ")
3066
+
local subexpr = utils.expr(string.format(string.gsub(("(" .. unpack_fn .. ")(%s, %s, {%s})"), "\n%s*", " "), s, tostring(v), exclude_str), "expression")
3067
+
return destructure1(v, {subexpr}, left)
3068
+
end
3069
+
local function destructure_rest(s, k, left, destructure1)
3070
+
local unpack_str = ("(" .. unpack_fn .. ")(%s, %s)")
3071
+
local formatted = string.format(string.gsub(unpack_str, "\n%s*", " "), s, k)
3072
+
local subexpr = utils.expr(formatted, "expression")
3073
+
assert_compile((utils["sequence?"](left) and (nil == left[(k + 2)])), "expected rest argument before last parameter", left)
3074
+
return destructure1(left[(k + 1)], {subexpr}, left)
3075
+
end
2454
3076
local function destructure_table(left, rightexprs, top_3f, destructure1)
2455
3077
local s = gensym(scope, symtype0)
2456
-
local right = nil
3078
+
local right
2457
3079
do
2458
-
local _2_0 = nil
3080
+
local _375_
2459
3081
if top_3f then
2460
-
_2_0 = exprs1(compile1(from, scope, parent))
3082
+
_375_ = exprs1(compile1(from, scope, parent))
2461
3083
else
2462
-
_2_0 = exprs1(rightexprs)
3084
+
_375_ = exprs1(rightexprs)
2463
3085
end
2464
-
if (_2_0 == "") then
3086
+
if (_375_ == "") then
2465
3087
right = "nil"
2466
-
elseif (nil ~= _2_0) then
2467
-
local right0 = _2_0
3088
+
elseif (nil ~= _375_) then
3089
+
local right0 = _375_
2468
3090
right = right0
2469
3091
else
2470
-
right = nil
3092
+
right = nil
2471
3093
end
2472
3094
end
3095
+
local excluded_keys = {}
2473
3096
emit(parent, string.format("local %s = %s", s, right), left)
2474
3097
for k, v in utils.stablepairs(left) do
2475
3098
if not (("number" == type(k)) and tostring(left[(k - 1)]):find("^&")) then
2476
-
if (utils["sym?"](v) and (utils.deref(v) == "&")) then
2477
-
local unpack_str = "{(table.unpack or unpack)(%s, %s)}"
2478
-
local formatted = string.format(unpack_str, s, k)
2479
-
local subexpr = utils.expr(formatted, "expression")
2480
-
assert_compile((utils["sequence?"](left) and (nil == left[(k + 2)])), "expected rest argument before last parameter", left)
2481
-
destructure1(left[(k + 1)], {subexpr}, left)
2482
-
elseif (utils["sym?"](k) and (utils.deref(k) == "&as")) then
3099
+
if (utils["sym?"](k) and (tostring(k) == "&")) then
3100
+
destructure_kv_rest(s, v, left, excluded_keys, destructure1)
3101
+
elseif (utils["sym?"](v) and (tostring(v) == "&")) then
3102
+
destructure_rest(s, k, left, destructure1)
3103
+
elseif (utils["sym?"](k) and (tostring(k) == "&as")) then
2483
3104
destructure_sym(v, {utils.expr(tostring(s))}, left)
2484
-
elseif (utils["sequence?"](left) and (utils.deref(v) == "&as")) then
3105
+
elseif (utils["sequence?"](left) and (tostring(v) == "&as")) then
2485
3106
local _, next_sym, trailing = select(k, unpack(left))
2486
3107
assert_compile((nil == trailing), "expected &as argument before last parameter", left)
2487
3108
destructure_sym(next_sym, {utils.expr(tostring(s))}, left)
2488
3109
else
2489
-
local key = nil
3110
+
local key
2490
3111
if (type(k) == "string") then
2491
3112
key = serialize_string(k)
2492
3113
else
2493
3114
key = k
2494
3115
end
2495
3116
local subexpr = utils.expr(string.format("%s[%s]", s, key), "expression")
3117
+
if (type(k) == "string") then
3118
+
table.insert(excluded_keys, k)
3119
+
else
3120
+
end
2496
3121
destructure1(v, {subexpr}, left)
2497
3122
end
3123
+
else
2498
3124
end
2499
3125
end
2500
3126
return nil
···
2507
3133
else
2508
3134
local symname = gensym(scope, symtype0)
2509
3135
table.insert(left_names, symname)
2510
-
tables[i] = {name, utils.expr(symname, "sym")}
3136
+
do end (tables)[i] = {name, utils.expr(symname, "sym")}
2511
3137
end
2512
3138
end
3139
+
assert_compile(left[1], "must provide at least one value", left)
2513
3140
assert_compile(top_3f, "can't nest multi-value destructuring", left)
2514
3141
compile_top_target(left_names)
2515
3142
if declaration then
2516
3143
for _, sym in ipairs(left) do
2517
-
scope.symmeta[utils.deref(sym)] = {var = isvar}
3144
+
if utils["sym?"](sym) then
3145
+
scope.symmeta[tostring(sym)] = {var = isvar}
3146
+
else
3147
+
end
2518
3148
end
3149
+
else
2519
3150
end
2520
3151
for _, pair in utils.stablepairs(tables) do
2521
3152
destructure1(pair[1], {pair[2]}, left)
···
2530
3161
elseif utils["list?"](left) then
2531
3162
destructure_values(left, up1, top_3f, destructure1)
2532
3163
else
2533
-
assert_compile(false, string.format("unable to bind %s %s", type(left), tostring(left)), (((type(up1[2]) == "table") and up1[2]) or up1))
3164
+
assert_compile(false, string.format("unable to bind %s %s", type(left), tostring(left)), (((type((up1)[2]) == "table") and (up1)[2]) or up1))
2534
3165
end
2535
3166
if top_3f then
2536
3167
return {returned = true}
3168
+
else
3169
+
return nil
2537
3170
end
2538
3171
end
2539
3172
local ret = destructure1(to, nil, ast, true)
2540
-
utils.hook("destructure", from, to, scope)
3173
+
utils.hook("destructure", from, to, scope, opts0)
2541
3174
apply_manglings(scope, new_manglings, ast)
2542
3175
return ret
2543
3176
end
2544
3177
local function require_include(ast, scope, parent, opts)
2545
-
opts.fallback = function(e)
3178
+
opts.fallback = function(e, no_warn)
3179
+
if (not no_warn and ("literal" == e.type)) then
3180
+
utils.warn(("include module not found, falling back to require: %s"):format(tostring(e)))
3181
+
else
3182
+
end
2546
3183
return utils.expr(string.format("require(%s)", tostring(e)), "statement")
2547
3184
end
2548
3185
return scopes.global.specials.include(ast, scope, parent, opts)
···
2553
3190
local scope = (opts.scope or make_scope(scopes.global))
2554
3191
local vals = {}
2555
3192
local chunk = {}
2556
-
local _0_ = utils.root
2557
-
_0_["set-reset"](_0_)
3193
+
do end (function(tgt, m, ...) return tgt[m](tgt, ...) end)(utils.root, "set-reset")
2558
3194
allowed_globals = opts.allowedGlobals
2559
3195
if (opts.indent == nil) then
2560
3196
opts.indent = " "
3197
+
else
2561
3198
end
2562
3199
if opts.requireAsInclude then
2563
3200
scope.specials.require = require_include
3201
+
else
2564
3202
end
2565
3203
utils.root.chunk, utils.root.scope, utils.root.options = chunk, scope, opts
2566
3204
for _, val in parser.parser(strm, opts.filename, opts) do
···
2569
3207
for i = 1, #vals do
2570
3208
local exprs = compile1(vals[i], scope, chunk, {nval = (((i < #vals) and 0) or nil), tail = (i == #vals)})
2571
3209
keep_side_effects(exprs, chunk, nil, vals[i])
3210
+
if (i == #vals) then
3211
+
utils.hook("chunk", vals[i], scope)
3212
+
else
3213
+
end
2572
3214
end
2573
3215
allowed_globals = old_globals
2574
3216
utils.root.reset()
···
2582
3224
local old_globals = allowed_globals
2583
3225
local chunk = {}
2584
3226
local scope = (opts0.scope or make_scope(scopes.global))
2585
-
local _0_ = utils.root
2586
-
_0_["set-reset"](_0_)
3227
+
do end (function(tgt, m, ...) return tgt[m](tgt, ...) end)(utils.root, "set-reset")
2587
3228
allowed_globals = opts0.allowedGlobals
2588
3229
if (opts0.indent == nil) then
2589
3230
opts0.indent = " "
3231
+
else
2590
3232
end
2591
3233
if opts0.requireAsInclude then
2592
3234
scope.specials.require = require_include
3235
+
else
2593
3236
end
2594
3237
utils.root.chunk, utils.root.scope, utils.root.options = chunk, scope, opts0
2595
3238
local exprs = compile1(ast, scope, chunk, {tail = true})
2596
3239
keep_side_effects(exprs, chunk, nil, ast)
3240
+
utils.hook("chunk", ast, scope)
2597
3241
allowed_globals = old_globals
2598
3242
utils.root.reset()
2599
3243
return flatten(chunk, opts0)
···
2604
3248
elseif (info.what == "C") then
2605
3249
return " [C]: in ?"
2606
3250
else
2607
-
local remap = fennel_sourcemap[info.source]
3251
+
local remap = sourcemap[info.source]
2608
3252
if (remap and remap[info.currentline]) then
2609
-
info["short-src"] = remap["short-src"]
2610
-
info.currentline = remap[info.currentline]
3253
+
if ((remap[info.currentline][1] or "unknown") ~= "unknown") then
3254
+
info.short_src = sourcemap[("@" .. remap[info.currentline][1])].short_src
3255
+
else
3256
+
info.short_src = remap.short_src
3257
+
end
3258
+
info.currentline = (remap[info.currentline][2] or -1)
3259
+
else
2611
3260
end
2612
3261
if (info.what == "Lua") then
2613
-
local function _1_()
3262
+
local function _395_()
2614
3263
if info.name then
2615
3264
return ("'" .. info.name .. "'")
2616
3265
else
2617
3266
return "?"
2618
3267
end
2619
3268
end
2620
-
return string.format(" %s:%d: in function %s", info.short_src, info.currentline, _1_())
2621
-
elseif (info["short-src"] == "(tail call)") then
3269
+
return string.format(" %s:%d: in function %s", info.short_src, info.currentline, _395_())
3270
+
elseif (info.short_src == "(tail call)") then
2622
3271
return " (tail call)"
2623
3272
else
2624
3273
return string.format(" %s:%d: in main chunk", info.short_src, info.currentline)
2625
3274
end
2626
3275
end
2627
3276
end
2628
-
local function traceback(msg, start)
2629
-
local msg0 = (msg or "")
2630
-
if ((msg0:find("^Compile error") or msg0:find("^Parse error")) and not utils["debug-on?"]("trace")) then
2631
-
return msg0
3277
+
local function traceback(_3fmsg, _3fstart)
3278
+
local msg = tostring((_3fmsg or ""))
3279
+
if ((msg:find("^Compile error") or msg:find("^Parse error")) and not utils["debug-on?"]("trace")) then
3280
+
return msg
2632
3281
else
2633
3282
local lines = {}
2634
-
if (msg0:find("^Compile error") or msg0:find("^Parse error")) then
2635
-
table.insert(lines, msg0)
3283
+
if (msg:find(":%d+: Compile error") or msg:find(":%d+: Parse error")) then
3284
+
table.insert(lines, msg)
2636
3285
else
2637
-
local newmsg = msg0:gsub("^[^:]*:%d+:%s+", "runtime error: ")
3286
+
local newmsg = msg:gsub("^[^:]*:%d+:%s+", "runtime error: ")
2638
3287
table.insert(lines, newmsg)
2639
3288
end
2640
3289
table.insert(lines, "stack traceback:")
2641
-
local done_3f, level = false, (start or 2)
3290
+
local done_3f, level = false, (_3fstart or 2)
2642
3291
while not done_3f do
2643
3292
do
2644
-
local _1_0 = debug.getinfo(level, "Sln")
2645
-
if (_1_0 == nil) then
3293
+
local _399_ = debug.getinfo(level, "Sln")
3294
+
if (_399_ == nil) then
2646
3295
done_3f = true
2647
-
elseif (nil ~= _1_0) then
2648
-
local info = _1_0
3296
+
elseif (nil ~= _399_) then
3297
+
local info = _399_
2649
3298
table.insert(lines, traceback_frame(info))
3299
+
else
2650
3300
end
2651
3301
end
2652
3302
level = (level + 1)
···
2655
3305
end
2656
3306
end
2657
3307
local function entry_transform(fk, fv)
2658
-
local function _0_(k, v)
3308
+
local function _402_(k, v)
2659
3309
if (type(k) == "number") then
2660
3310
return k, fv(v)
2661
3311
else
2662
3312
return fk(k), fv(v)
2663
3313
end
2664
3314
end
2665
-
return _0_
2666
-
end
2667
-
local function no()
2668
-
return nil
3315
+
return _402_
2669
3316
end
2670
3317
local function mixed_concat(t, joiner)
2671
3318
local seen = {}
···
2679
3326
if not seen[k] then
2680
3327
ret = (ret .. s .. "[" .. k .. "]" .. "=" .. v)
2681
3328
s = joiner
3329
+
else
2682
3330
end
2683
3331
end
2684
3332
return ret
···
2691
3339
assert_compile(not runtime_3f, "quoted ... may only be used at compile time", form)
2692
3340
return "_VARARG"
2693
3341
elseif utils["sym?"](form) then
2694
-
local filename = nil
3342
+
local filename
2695
3343
if form.filename then
2696
3344
filename = string.format("%q", form.filename)
2697
3345
else
2698
3346
filename = "nil"
2699
3347
end
2700
-
local symstr = utils.deref(form)
3348
+
local symstr = tostring(form)
2701
3349
assert_compile(not runtime_3f, "symbols may only be used at compile time", form)
2702
3350
if (symstr:find("#$") or symstr:find("#[:.]")) then
2703
-
return string.format("sym('%s', nil, {filename=%s, line=%s})", autogensym(symstr, scope), filename, (form.line or "nil"))
3351
+
return string.format("sym('%s', {filename=%s, line=%s})", autogensym(symstr, scope), filename, (form.line or "nil"))
2704
3352
else
2705
-
return string.format("sym('%s', nil, {quoted=true, filename=%s, line=%s})", symstr, filename, (form.line or "nil"))
3353
+
return string.format("sym('%s', {quoted=true, filename=%s, line=%s})", symstr, filename, (form.line or "nil"))
2706
3354
end
2707
-
elseif (utils["list?"](form) and utils["sym?"](form[1]) and (utils.deref(form[1]) == "unquote")) then
3355
+
elseif (utils["list?"](form) and utils["sym?"](form[1]) and (tostring(form[1]) == "unquote")) then
2708
3356
local payload = form[2]
2709
3357
local res = unpack(compile1(payload, scope, parent))
2710
3358
return res[1]
2711
3359
elseif utils["list?"](form) then
2712
-
local mapped = utils.kvmap(form, entry_transform(no, q))
2713
-
local filename = nil
3360
+
local mapped
3361
+
local function _407_()
3362
+
return nil
3363
+
end
3364
+
mapped = utils.kvmap(form, entry_transform(_407_, q))
3365
+
local filename
2714
3366
if form.filename then
2715
3367
filename = string.format("%q", form.filename)
2716
3368
else
···
2718
3370
end
2719
3371
assert_compile(not runtime_3f, "lists may only be used at compile time", form)
2720
3372
return string.format(("setmetatable({filename=%s, line=%s, bytestart=%s, %s}" .. ", getmetatable(list()))"), filename, (form.line or "nil"), (form.bytestart or "nil"), mixed_concat(mapped, ", "))
3373
+
elseif utils["sequence?"](form) then
3374
+
local mapped = utils.kvmap(form, entry_transform(q, q))
3375
+
local source = getmetatable(form)
3376
+
local filename
3377
+
if source.filename then
3378
+
filename = string.format("%q", source.filename)
3379
+
else
3380
+
filename = "nil"
3381
+
end
3382
+
local _410_
3383
+
if source then
3384
+
_410_ = source.line
3385
+
else
3386
+
_410_ = "nil"
3387
+
end
3388
+
return string.format("setmetatable({%s}, {filename=%s, line=%s, sequence=%s})", mixed_concat(mapped, ", "), filename, _410_, "(getmetatable(sequence()))['sequence']")
2721
3389
elseif (type(form) == "table") then
2722
3390
local mapped = utils.kvmap(form, entry_transform(q, q))
2723
3391
local source = getmetatable(form)
2724
-
local filename = nil
3392
+
local filename
2725
3393
if source.filename then
2726
3394
filename = string.format("%q", source.filename)
2727
3395
else
2728
3396
filename = "nil"
2729
3397
end
2730
-
local function _1_()
3398
+
local function _413_()
2731
3399
if source then
2732
3400
return source.line
2733
3401
else
2734
3402
return "nil"
2735
3403
end
2736
3404
end
2737
-
return string.format("setmetatable({%s}, {filename=%s, line=%s})", mixed_concat(mapped, ", "), filename, _1_())
3405
+
return string.format("setmetatable({%s}, {filename=%s, line=%s})", mixed_concat(mapped, ", "), filename, _413_())
2738
3406
elseif (type(form) == "string") then
2739
3407
return serialize_string(form)
2740
3408
else
2741
3409
return tostring(form)
2742
3410
end
2743
3411
end
2744
-
return {["apply-manglings"] = apply_manglings, ["compile-stream"] = compile_stream, ["compile-string"] = compile_string, ["declare-local"] = declare_local, ["do-quote"] = do_quote, ["global-mangling"] = global_mangling, ["global-unmangling"] = global_unmangling, ["keep-side-effects"] = keep_side_effects, ["make-scope"] = make_scope, ["require-include"] = require_include, ["symbol-to-expression"] = symbol_to_expression, assert = assert_compile, autogensym = autogensym, compile = compile, compile1 = compile1, destructure = destructure, emit = emit, gensym = gensym, macroexpand = macroexpand_2a, metadata = make_metadata(), scopes = scopes, traceback = traceback}
3412
+
return {compile = compile, compile1 = compile1, ["compile-stream"] = compile_stream, ["compile-string"] = compile_string, ["check-binding-valid"] = check_binding_valid, emit = emit, destructure = destructure, ["require-include"] = require_include, autogensym = autogensym, gensym = gensym, ["do-quote"] = do_quote, ["global-mangling"] = global_mangling, ["global-unmangling"] = global_unmangling, ["apply-manglings"] = apply_manglings, macroexpand = macroexpand_2a, ["declare-local"] = declare_local, ["make-scope"] = make_scope, ["keep-side-effects"] = keep_side_effects, ["symbol-to-expression"] = symbol_to_expression, assert = assert_compile, scopes = scopes, traceback = traceback, metadata = make_metadata(), sourcemap = sourcemap}
2745
3413
end
2746
3414
package.preload["fennel.friend"] = package.preload["fennel.friend"] or function(...)
2747
-
local function ast_source(ast)
2748
-
local m = getmetatable(ast)
2749
-
return ((m and m.line and m) or (("table" == type(ast)) and ast) or {})
2750
-
end
2751
-
local suggestions = {["$ and $... in hashfn are mutually exclusive"] = {"modifying the hashfn so it only contains $... or $, $1, $2, $3, etc"}, ["can't start multisym segment with a digit"] = {"removing the digit", "adding a non-digit before the digit"}, ["cannot call literal value"] = {"checking for typos", "checking for a missing function name"}, ["could not compile value of type "] = {"debugging the macro you're calling not to return a coroutine or userdata"}, ["could not read number (.*)"] = {"removing the non-digit character", "beginning the identifier with a non-digit if it is not meant to be a number"}, ["expected a function.* to call"] = {"removing the empty parentheses", "using square brackets if you want an empty table"}, ["expected binding table"] = {"placing a table here in square brackets containing identifiers to bind"}, ["expected body expression"] = {"putting some code in the body of this form after the bindings"}, ["expected each macro to be function"] = {"ensuring that the value for each key in your macros table contains a function", "avoid defining nested macro tables"}, ["expected even number of name/value bindings"] = {"finding where the identifier or value is missing"}, ["expected even number of values in table literal"] = {"removing a key", "adding a value"}, ["expected local"] = {"looking for a typo", "looking for a local which is used out of its scope"}, ["expected macros to be table"] = {"ensuring your macro definitions return a table"}, ["expected parameters"] = {"adding function parameters as a list of identifiers in brackets"}, ["expected rest argument before last parameter"] = {"moving & to right before the final identifier when destructuring"}, ["expected symbol for function parameter: (.*)"] = {"changing %s to an identifier instead of a literal value"}, ["expected var (.*)"] = {"declaring %s using var instead of let/local", "introducing a new local instead of changing the value of %s"}, ["expected vararg as last parameter"] = {"moving the \"...\" to the end of the parameter list"}, ["expected whitespace before opening delimiter"] = {"adding whitespace"}, ["global (.*) conflicts with local"] = {"renaming local %s"}, ["illegal character: (.)"] = {"deleting or replacing %s", "avoiding reserved characters like \", \\, ', ~, ;, @, `, and comma"}, ["local (.*) was overshadowed by a special form or macro"] = {"renaming local %s"}, ["macro not found in macro module"] = {"checking the keys of the imported macro module's returned table"}, ["macro tried to bind (.*) without gensym"] = {"changing to %s# when introducing identifiers inside macros"}, ["malformed multisym"] = {"ensuring each period or colon is not followed by another period or colon"}, ["may only be used at compile time"] = {"moving this to inside a macro if you need to manipulate symbols/lists", "using square brackets instead of parens to construct a table"}, ["method must be last component"] = {"using a period instead of a colon for field access", "removing segments after the colon", "making the method call, then looking up the field on the result"}, ["mismatched closing delimiter (.), expected (.)"] = {"replacing %s with %s", "deleting %s", "adding matching opening delimiter earlier"}, ["multisym method calls may only be in call position"] = {"using a period instead of a colon to reference a table's fields", "putting parens around this"}, ["unable to bind (.*)"] = {"replacing the %s with an identifier"}, ["unexpected closing delimiter (.)"] = {"deleting %s", "adding matching opening delimiter earlier"}, ["unexpected multi symbol (.*)"] = {"removing periods or colons from %s"}, ["unexpected vararg"] = {"putting \"...\" at the end of the fn parameters if the vararg was intended"}, ["unknown global in strict mode: (.*)"] = {"looking to see if there's a typo", "using the _G table instead, eg. _G.%s if you really want a global", "moving this code to somewhere that %s is in scope", "binding %s as a local in the scope of this code"}, ["unused local (.*)"] = {"fixing a typo so %s is used", "renaming the local to _%s"}, ["use of global (.*) is aliased by a local"] = {"renaming local %s", "refer to the global using _G.%s instead of directly"}}
3415
+
local utils = require("fennel.utils")
3416
+
local utf8_ok_3f, utf8 = pcall(require, "utf8")
3417
+
local suggestions = {["unexpected multi symbol (.*)"] = {"removing periods or colons from %s"}, ["use of global (.*) is aliased by a local"] = {"renaming local %s", "refer to the global using _G.%s instead of directly"}, ["local (.*) was overshadowed by a special form or macro"] = {"renaming local %s"}, ["global (.*) conflicts with local"] = {"renaming local %s"}, ["expected var (.*)"] = {"declaring %s using var instead of let/local", "introducing a new local instead of changing the value of %s"}, ["expected macros to be table"] = {"ensuring your macro definitions return a table"}, ["expected each macro to be function"] = {"ensuring that the value for each key in your macros table contains a function", "avoid defining nested macro tables"}, ["macro not found in macro module"] = {"checking the keys of the imported macro module's returned table"}, ["macro tried to bind (.*) without gensym"] = {"changing to %s# when introducing identifiers inside macros"}, ["unknown identifier in strict mode: (.*)"] = {"looking to see if there's a typo", "using the _G table instead, eg. _G.%s if you really want a global", "moving this code to somewhere that %s is in scope", "binding %s as a local in the scope of this code"}, ["expected a function.* to call"] = {"removing the empty parentheses", "using square brackets if you want an empty table"}, ["cannot call literal value"] = {"checking for typos", "checking for a missing function name"}, ["unexpected vararg"] = {"putting \"...\" at the end of the fn parameters if the vararg was intended"}, ["multisym method calls may only be in call position"] = {"using a period instead of a colon to reference a table's fields", "putting parens around this"}, ["unused local (.*)"] = {"renaming the local to _%s if it is meant to be unused", "fixing a typo so %s is used", "disabling the linter which checks for unused locals"}, ["expected parameters"] = {"adding function parameters as a list of identifiers in brackets"}, ["unable to bind (.*)"] = {"replacing the %s with an identifier"}, ["expected rest argument before last parameter"] = {"moving & to right before the final identifier when destructuring"}, ["expected vararg as last parameter"] = {"moving the \"...\" to the end of the parameter list"}, ["expected symbol for function parameter: (.*)"] = {"changing %s to an identifier instead of a literal value"}, ["could not compile value of type "] = {"debugging the macro you're calling to return a list or table"}, ["expected local"] = {"looking for a typo", "looking for a local which is used out of its scope"}, ["expected body expression"] = {"putting some code in the body of this form after the bindings"}, ["expected binding and iterator"] = {"making sure you haven't omitted a local name or iterator"}, ["expected binding sequence"] = {"placing a table here in square brackets containing identifiers to bind"}, ["expected even number of name/value bindings"] = {"finding where the identifier or value is missing"}, ["may only be used at compile time"] = {"moving this to inside a macro if you need to manipulate symbols/lists", "using square brackets instead of parens to construct a table"}, ["unexpected closing delimiter (.)"] = {"deleting %s", "adding matching opening delimiter earlier"}, ["mismatched closing delimiter (.), expected (.)"] = {"replacing %s with %s", "deleting %s", "adding matching opening delimiter earlier"}, ["expected even number of values in table literal"] = {"removing a key", "adding a value"}, ["expected whitespace before opening delimiter"] = {"adding whitespace"}, ["invalid character: (.)"] = {"deleting or replacing %s", "avoiding reserved characters like \", \\, ', ~, ;, @, `, and comma"}, ["could not read number (.*)"] = {"removing the non-digit character", "beginning the identifier with a non-digit if it is not meant to be a number"}, ["can't start multisym segment with a digit"] = {"removing the digit", "adding a non-digit before the digit"}, ["malformed multisym"] = {"ensuring each period or colon is not followed by another period or colon"}, ["method must be last component"] = {"using a period instead of a colon for field access", "removing segments after the colon", "making the method call, then looking up the field on the result"}, ["$ and $... in hashfn are mutually exclusive"] = {"modifying the hashfn so it only contains $... or $, $1, $2, $3, etc"}, ["tried to reference a macro at runtime"] = {"renaming the macro so as not to conflict with locals"}, ["tried to reference a special form at runtime"] = {"wrapping the special in a function if you need it to be first class"}, ["missing subject"] = {"adding an item to operate on"}, ["expected even number of pattern/body pairs"] = {"checking that every pattern has a body to go with it", "adding _ before the final body"}, ["expected at least one pattern/body pair"] = {"adding a pattern and a body to execute when the pattern matches"}, ["unexpected arguments"] = {"removing an argument", "checking for typos"}, ["unexpected iterator clause"] = {"removing an argument", "checking for typos"}}
2752
3418
local unpack = (table.unpack or _G.unpack)
2753
3419
local function suggest(msg)
2754
3420
local suggestion = nil
···
2764
3430
else
2765
3431
suggestion = sug(matches)
2766
3432
end
3433
+
else
2767
3434
end
2768
3435
end
2769
3436
return suggestion
2770
3437
end
2771
-
local function read_line_from_file(filename, line)
2772
-
local bytes = 0
2773
-
local f = assert(io.open(filename))
2774
-
local _ = nil
2775
-
for _0 = 1, (line - 1) do
2776
-
bytes = (bytes + 1 + #f:read())
3438
+
local function read_line(filename, line, _3fsource)
3439
+
if _3fsource then
3440
+
local matcher = string.gmatch((_3fsource .. "\n"), "(.-)(\13?\n)")
3441
+
for _ = 2, line do
3442
+
matcher()
3443
+
end
3444
+
return matcher()
3445
+
else
3446
+
local f = assert(io.open(filename))
3447
+
local function close_handlers_8_auto(ok_9_auto, ...)
3448
+
f:close()
3449
+
if ok_9_auto then
3450
+
return ...
3451
+
else
3452
+
return error(..., 0)
3453
+
end
3454
+
end
3455
+
local function _178_()
3456
+
for _ = 2, line do
3457
+
f:read()
3458
+
end
3459
+
return f:read()
3460
+
end
3461
+
return close_handlers_8_auto(_G.xpcall(_178_, (package.loaded.fennel or debug).traceback))
2777
3462
end
2778
-
_ = nil
2779
-
local codeline = f:read()
2780
-
f:close()
2781
-
return codeline, bytes
2782
3463
end
2783
-
local function read_line_from_source(source, line)
2784
-
local lines, bytes, codeline = 0, 0
2785
-
for this_line, newline in string.gmatch((source .. "\n"), "(.-)(\13?\n)") do
2786
-
lines = (lines + 1)
2787
-
if (lines == line) then
2788
-
codeline = this_line
2789
-
break
2790
-
end
2791
-
bytes = (bytes + #newline + #this_line)
3464
+
local function sub(str, start, _end)
3465
+
if (_end < start) then
3466
+
return ""
3467
+
elseif utf8_ok_3f then
3468
+
return string.sub(str, utf8.offset(str, start), ((utf8.offset(str, (_end + 1)) or (utf8.len(str) + 1)) - 1))
3469
+
else
3470
+
return string.sub(str, start, math.min(_end, str:len()))
2792
3471
end
2793
-
return codeline, bytes
2794
3472
end
2795
-
local function read_line(filename, line, source)
2796
-
if source then
2797
-
return read_line_from_source(source, line)
3473
+
local function highlight_line(codeline, col, _3fendcol)
3474
+
local endcol = (_3fendcol or col)
3475
+
local eol
3476
+
if utf8_ok_3f then
3477
+
eol = utf8.len(codeline)
2798
3478
else
2799
-
return read_line_from_file(filename, line)
3479
+
eol = string.len(codeline)
2800
3480
end
3481
+
return (sub(codeline, 1, col) .. "\27[7m" .. sub(codeline, (col + 1), (endcol + 1)) .. "\27[0m" .. sub(codeline, (endcol + 2), eol))
2801
3482
end
2802
-
local function friendly_msg(msg, _0_0, source)
2803
-
local _1_ = _0_0
2804
-
local byteend = _1_["byteend"]
2805
-
local bytestart = _1_["bytestart"]
2806
-
local filename = _1_["filename"]
2807
-
local line = _1_["line"]
2808
-
local ok, codeline, bol = pcall(read_line, filename, line, source)
2809
-
local suggestions0 = suggest(msg)
3483
+
local function friendly_msg(msg, _182_, source)
3484
+
local _arg_183_ = _182_
3485
+
local filename = _arg_183_["filename"]
3486
+
local line = _arg_183_["line"]
3487
+
local col = _arg_183_["col"]
3488
+
local endcol = _arg_183_["endcol"]
3489
+
local ok, codeline = pcall(read_line, filename, line, source)
2810
3490
local out = {msg, ""}
2811
3491
if (ok and codeline) then
2812
-
table.insert(out, codeline)
3492
+
if col then
3493
+
table.insert(out, highlight_line(codeline, col, endcol))
3494
+
else
3495
+
table.insert(out, codeline)
3496
+
end
3497
+
else
2813
3498
end
2814
-
if (ok and codeline and bytestart and byteend) then
2815
-
table.insert(out, (string.rep(" ", (bytestart - bol - 1)) .. "^" .. string.rep("^", math.min((byteend - bytestart), ((bol + #codeline) - bytestart)))))
2816
-
end
2817
-
if (ok and codeline and bytestart and not byteend) then
2818
-
table.insert(out, (string.rep("-", (bytestart - bol - 1)) .. "^"))
2819
-
table.insert(out, "")
2820
-
end
2821
-
if suggestions0 then
2822
-
for _, suggestion in ipairs(suggestions0) do
2823
-
table.insert(out, ("* Try %s."):format(suggestion))
2824
-
end
3499
+
for _, suggestion in ipairs((suggest(msg) or {})) do
3500
+
table.insert(out, ("* Try %s."):format(suggestion))
2825
3501
end
2826
3502
return table.concat(out, "\n")
2827
3503
end
2828
3504
local function assert_compile(condition, msg, ast, source)
2829
3505
if not condition then
2830
-
local _1_ = ast_source(ast)
2831
-
local filename = _1_["filename"]
2832
-
local line = _1_["line"]
2833
-
error(friendly_msg(("Compile error in %s:%s\n %s"):format((filename or "unknown"), (line or "?"), msg), ast_source(ast), source), 0)
3506
+
local _let_186_ = utils["ast-source"](ast)
3507
+
local filename = _let_186_["filename"]
3508
+
local line = _let_186_["line"]
3509
+
local col = _let_186_["col"]
3510
+
error(friendly_msg(("Compile error in %s:%s:%s\n %s"):format((filename or "unknown"), (line or "?"), (col or "?"), msg), utils["ast-source"](ast), source), 0)
3511
+
else
2834
3512
end
2835
3513
return condition
2836
3514
end
2837
-
local function parse_error(msg, filename, line, bytestart, source)
2838
-
return error(friendly_msg(("Parse error in %s:%s\n %s"):format(filename, line, msg), {bytestart = bytestart, filename = filename, line = line}, source), 0)
3515
+
local function parse_error(msg, filename, line, col, source)
3516
+
return error(friendly_msg(("Parse error in %s:%s:%s\n %s"):format(filename, line, col, msg), {filename = filename, line = line, col = col}, source), 0)
2839
3517
end
2840
3518
return {["assert-compile"] = assert_compile, ["parse-error"] = parse_error}
2841
3519
end
···
2845
3523
local unpack = (table.unpack or _G.unpack)
2846
3524
local function granulate(getchunk)
2847
3525
local c, index, done_3f = "", 1, false
2848
-
local function _0_(parser_state)
3526
+
local function _188_(parser_state)
2849
3527
if not done_3f then
2850
3528
if (index <= #c) then
2851
3529
local b = c:byte(index)
2852
3530
index = (index + 1)
2853
3531
return b
2854
3532
else
2855
-
local _1_0, _2_0, _3_0 = getchunk(parser_state)
2856
-
local _4_
2857
-
do
2858
-
local char = _1_0
2859
-
_4_ = ((nil ~= _1_0) and (char ~= ""))
3533
+
local _189_ = getchunk(parser_state)
3534
+
local function _190_()
3535
+
local char = _189_
3536
+
return (char ~= "")
2860
3537
end
2861
-
if _4_ then
2862
-
local char = _1_0
3538
+
if ((nil ~= _189_) and _190_()) then
3539
+
local char = _189_
2863
3540
c = char
2864
3541
index = 2
2865
3542
return c:byte()
2866
-
else
2867
-
local _ = _1_0
3543
+
elseif true then
3544
+
local _ = _189_
2868
3545
done_3f = true
2869
3546
return nil
3547
+
else
3548
+
return nil
2870
3549
end
2871
3550
end
3551
+
else
3552
+
return nil
2872
3553
end
2873
3554
end
2874
-
local function _1_()
3555
+
local function _194_()
2875
3556
c = ""
2876
3557
return nil
2877
3558
end
2878
-
return _0_, _1_
3559
+
return _188_, _194_
2879
3560
end
2880
3561
local function string_stream(str)
2881
3562
local str0 = str:gsub("^#!", ";;")
2882
3563
local index = 1
2883
-
local function _0_()
3564
+
local function _195_()
2884
3565
local r = str0:byte(index)
2885
3566
index = (index + 1)
2886
3567
return r
2887
3568
end
2888
-
return _0_
2889
-
end
2890
-
local delims = {[123] = 125, [125] = true, [40] = 41, [41] = true, [91] = 93, [93] = true}
2891
-
local function whitespace_3f(b)
2892
-
return ((b == 32) or ((b >= 9) and (b <= 13)))
3569
+
return _195_
2893
3570
end
3571
+
local delims = {[40] = 41, [41] = true, [91] = 93, [93] = true, [123] = 125, [125] = true}
2894
3572
local function sym_char_3f(b)
2895
-
local b0 = nil
3573
+
local b0
2896
3574
if ("number" == type(b)) then
2897
3575
b0 = b
2898
3576
else
2899
3577
b0 = string.byte(b)
2900
3578
end
2901
-
return ((b0 > 32) and not delims[b0] and (b0 ~= 127) and (b0 ~= 34) and (b0 ~= 39) and (b0 ~= 126) and (b0 ~= 59) and (b0 ~= 44) and (b0 ~= 64) and (b0 ~= 96))
3579
+
return ((32 < b0) and not delims[b0] and (b0 ~= 127) and (b0 ~= 34) and (b0 ~= 39) and (b0 ~= 126) and (b0 ~= 59) and (b0 ~= 44) and (b0 ~= 64) and (b0 ~= 96))
2902
3580
end
2903
3581
local prefixes = {[35] = "hashfn", [39] = "quote", [44] = "unquote", [96] = "quote"}
2904
-
local function parser(getbyte, filename, options)
3582
+
local function char_starter_3f(b)
3583
+
return ((function(_197_,_198_,_199_) return (_197_ < _198_) and (_198_ < _199_) end)(1,b,127) or (function(_200_,_201_,_202_) return (_200_ < _201_) and (_201_ < _202_) end)(192,b,247))
3584
+
end
3585
+
local function parser_fn(getbyte, filename, _203_)
3586
+
local _arg_204_ = _203_
3587
+
local source = _arg_204_["source"]
3588
+
local unfriendly = _arg_204_["unfriendly"]
3589
+
local comments = _arg_204_["comments"]
3590
+
local options = _arg_204_
2905
3591
local stack = {}
2906
-
local line = 1
2907
-
local byteindex = 0
2908
-
local lastb = nil
3592
+
local line, byteindex, col, prev_col, lastb = 1, 0, 0, 0, nil
2909
3593
local function ungetb(ub)
3594
+
if char_starter_3f(ub) then
3595
+
col = (col - 1)
3596
+
else
3597
+
end
2910
3598
if (ub == 10) then
2911
-
line = (line - 1)
3599
+
line, col = (line - 1), prev_col
3600
+
else
2912
3601
end
2913
3602
byteindex = (byteindex - 1)
2914
3603
lastb = ub
···
2922
3611
r = getbyte({["stack-size"] = #stack})
2923
3612
end
2924
3613
byteindex = (byteindex + 1)
3614
+
if (r and char_starter_3f(r)) then
3615
+
col = (col + 1)
3616
+
else
3617
+
end
2925
3618
if (r == 10) then
2926
-
line = (line + 1)
3619
+
line, col, prev_col = (line + 1), 0, col
3620
+
else
2927
3621
end
2928
3622
return r
2929
3623
end
2930
-
local function parse_error(msg, byteindex_override)
2931
-
local _0_ = (options or utils.root.options or {})
2932
-
local source = _0_["source"]
2933
-
local unfriendly = _0_["unfriendly"]
2934
-
utils.root.reset()
2935
-
if unfriendly then
2936
-
return error(string.format("Parse error in %s:%s: %s", (filename or "unknown"), (line or "?"), msg), 0)
3624
+
local function whitespace_3f(b)
3625
+
local function _214_()
3626
+
local t_213_ = options.whitespace
3627
+
if (nil ~= t_213_) then
3628
+
t_213_ = (t_213_)[b]
3629
+
else
3630
+
end
3631
+
return t_213_
3632
+
end
3633
+
return ((b == 32) or (function(_210_,_211_,_212_) return (_210_ <= _211_) and (_211_ <= _212_) end)(9,b,13) or _214_())
3634
+
end
3635
+
local function parse_error(msg, _3fcol_adjust)
3636
+
local col0 = (col + (_3fcol_adjust or -1))
3637
+
if (nil == utils["hook-opts"]("parse-error", options, msg, filename, (line or "?"), col0, source, utils.root.reset)) then
3638
+
utils.root.reset()
3639
+
if (unfriendly or not _G.io or not _G.io.read) then
3640
+
return error(string.format("%s:%s:%s Parse error: %s", filename, (line or "?"), col0, msg), 0)
3641
+
else
3642
+
return friend["parse-error"](msg, filename, (line or "?"), col0, source)
3643
+
end
2937
3644
else
2938
-
return friend["parse-error"](msg, (filename or "unknown"), (line or "?"), (byteindex_override or byteindex), source)
3645
+
return nil
2939
3646
end
2940
3647
end
2941
3648
local function parse_stream()
2942
3649
local whitespace_since_dispatch, done_3f, retval = true
3650
+
local function set_source_fields(source0)
3651
+
source0.byteend, source0.endcol = byteindex, (col - 1)
3652
+
return nil
3653
+
end
2943
3654
local function dispatch(v)
2944
-
local _0_0 = stack[#stack]
2945
-
if (_0_0 == nil) then
3655
+
local _218_ = stack[#stack]
3656
+
if (_218_ == nil) then
2946
3657
retval, done_3f, whitespace_since_dispatch = v, true, false
2947
3658
return nil
2948
-
elseif ((type(_0_0) == "table") and (nil ~= _0_0.prefix)) then
2949
-
local prefix = _0_0.prefix
2950
-
table.remove(stack)
2951
-
return dispatch(utils.list(utils.sym(prefix), v))
2952
-
elseif (nil ~= _0_0) then
2953
-
local top = _0_0
3659
+
elseif ((_G.type(_218_) == "table") and (nil ~= (_218_).prefix)) then
3660
+
local prefix = (_218_).prefix
3661
+
local source0
3662
+
do
3663
+
local _219_ = table.remove(stack)
3664
+
set_source_fields(_219_)
3665
+
source0 = _219_
3666
+
end
3667
+
local list = utils.list(utils.sym(prefix, source0), v)
3668
+
for k, v0 in pairs(source0) do
3669
+
list[k] = v0
3670
+
end
3671
+
return dispatch(list)
3672
+
elseif (nil ~= _218_) then
3673
+
local top = _218_
2954
3674
whitespace_since_dispatch = false
2955
3675
return table.insert(top, v)
3676
+
else
3677
+
return nil
2956
3678
end
2957
3679
end
2958
3680
local function badend()
2959
3681
local accum = utils.map(stack, "closer")
2960
-
local _0_
3682
+
local _221_
2961
3683
if (#stack == 1) then
2962
-
_0_ = ""
3684
+
_221_ = ""
2963
3685
else
2964
-
_0_ = "s"
3686
+
_221_ = "s"
2965
3687
end
2966
-
return parse_error(string.format("expected closing delimiter%s %s", _0_, string.char(unpack(accum))))
3688
+
return parse_error(string.format("expected closing delimiter%s %s", _221_, string.char(unpack(accum))))
2967
3689
end
2968
3690
local function skip_whitespace(b)
2969
3691
if (b and whitespace_3f(b)) then
2970
3692
whitespace_since_dispatch = true
2971
3693
return skip_whitespace(getb())
2972
-
elseif (not b and (#stack > 0)) then
3694
+
elseif (not b and (0 < #stack)) then
2973
3695
return badend()
2974
3696
else
2975
3697
return b
···
2977
3699
end
2978
3700
local function parse_comment(b, contents)
2979
3701
if (b and (10 ~= b)) then
2980
-
local function _1_()
2981
-
local _0_0 = contents
2982
-
table.insert(_0_0, string.char(b))
2983
-
return _0_0
3702
+
local function _225_()
3703
+
local _224_ = contents
3704
+
table.insert(_224_, string.char(b))
3705
+
return _224_
2984
3706
end
2985
-
return parse_comment(getb(), _1_())
2986
-
elseif (options and options.comments) then
2987
-
return dispatch(utils.comment(table.concat(contents)))
3707
+
return parse_comment(getb(), _225_())
3708
+
elseif comments then
3709
+
ungetb(10)
3710
+
return dispatch(utils.comment(table.concat(contents), {line = (line - 1), filename = filename}))
2988
3711
else
2989
-
return b
3712
+
return nil
2990
3713
end
2991
3714
end
2992
3715
local function open_table(b)
2993
3716
if not whitespace_since_dispatch then
2994
3717
parse_error(("expected whitespace before opening delimiter " .. string.char(b)))
3718
+
else
2995
3719
end
2996
-
return table.insert(stack, {bytestart = byteindex, closer = delims[b], filename = filename, line = line})
3720
+
return table.insert(stack, {bytestart = byteindex, closer = delims[b], filename = filename, line = line, col = (col - 1)})
2997
3721
end
2998
3722
local function close_list(list)
2999
3723
return dispatch(setmetatable(list, getmetatable(utils.list())))
···
3005
3729
end
3006
3730
return dispatch(val)
3007
3731
end
3732
+
local function add_comment_at(comments0, index, node)
3733
+
local _228_ = (comments0)[index]
3734
+
if (nil ~= _228_) then
3735
+
local existing = _228_
3736
+
return table.insert(existing, node)
3737
+
elseif true then
3738
+
local _ = _228_
3739
+
comments0[index] = {node}
3740
+
return nil
3741
+
else
3742
+
return nil
3743
+
end
3744
+
end
3745
+
local function next_noncomment(tbl, i)
3746
+
if utils["comment?"](tbl[i]) then
3747
+
return next_noncomment(tbl, (i + 1))
3748
+
else
3749
+
return tbl[i]
3750
+
end
3751
+
end
3752
+
local function extract_comments(tbl)
3753
+
local comments0 = {keys = {}, values = {}, last = {}}
3754
+
while utils["comment?"](tbl[#tbl]) do
3755
+
table.insert(comments0.last, 1, table.remove(tbl))
3756
+
end
3757
+
local last_key_3f = false
3758
+
for i, node in ipairs(tbl) do
3759
+
if not utils["comment?"](node) then
3760
+
last_key_3f = not last_key_3f
3761
+
elseif last_key_3f then
3762
+
add_comment_at(comments0.values, next_noncomment(tbl, i), node)
3763
+
else
3764
+
add_comment_at(comments0.keys, next_noncomment(tbl, i), node)
3765
+
end
3766
+
end
3767
+
for i = #tbl, 1, -1 do
3768
+
if utils["comment?"](tbl[i]) then
3769
+
table.remove(tbl, i)
3770
+
else
3771
+
end
3772
+
end
3773
+
return comments0
3774
+
end
3008
3775
local function close_curly_table(tbl)
3776
+
local comments0 = extract_comments(tbl)
3777
+
local keys = {}
3009
3778
local val = {}
3010
3779
if ((#tbl % 2) ~= 0) then
3011
3780
byteindex = (byteindex - 1)
3012
3781
parse_error("expected even number of values in table literal")
3782
+
else
3013
3783
end
3014
3784
setmetatable(val, tbl)
3015
3785
for i = 1, #tbl, 2 do
3016
3786
if ((tostring(tbl[i]) == ":") and utils["sym?"](tbl[(i + 1)]) and utils["sym?"](tbl[i])) then
3017
3787
tbl[i] = tostring(tbl[(i + 1)])
3788
+
else
3018
3789
end
3019
3790
val[tbl[i]] = tbl[(i + 1)]
3791
+
table.insert(keys, tbl[i])
3020
3792
end
3793
+
tbl.comments = comments0
3794
+
tbl.keys = keys
3021
3795
return dispatch(val)
3022
3796
end
3023
3797
local function close_table(b)
3024
3798
local top = table.remove(stack)
3025
3799
if (top == nil) then
3026
3800
parse_error(("unexpected closing delimiter " .. string.char(b)))
3801
+
else
3027
3802
end
3028
-
if (top.closer ~= b) then
3803
+
if (top.closer and (top.closer ~= b)) then
3029
3804
parse_error(("mismatched closing delimiter " .. string.char(b) .. ", expected " .. string.char(top.closer)))
3805
+
else
3030
3806
end
3031
-
top.byteend = byteindex
3807
+
set_source_fields(top)
3032
3808
if (b == 41) then
3033
3809
return close_list(top)
3034
3810
elseif (b == 93) then
···
3039
3815
end
3040
3816
local function parse_string_loop(chars, b, state)
3041
3817
table.insert(chars, b)
3042
-
local state0 = nil
3818
+
local state0
3043
3819
do
3044
-
local _0_0 = {state, b}
3045
-
if ((type(_0_0) == "table") and (_0_0[1] == "base") and (_0_0[2] == 92)) then
3820
+
local _238_ = {state, b}
3821
+
if ((_G.type(_238_) == "table") and ((_238_)[1] == "base") and ((_238_)[2] == 92)) then
3046
3822
state0 = "backslash"
3047
-
elseif ((type(_0_0) == "table") and (_0_0[1] == "base") and (_0_0[2] == 34)) then
3823
+
elseif ((_G.type(_238_) == "table") and ((_238_)[1] == "base") and ((_238_)[2] == 34)) then
3048
3824
state0 = "done"
3049
-
else
3050
-
local _ = _0_0
3825
+
elseif ((_G.type(_238_) == "table") and ((_238_)[1] == "backslash") and ((_238_)[2] == 10)) then
3826
+
table.remove(chars, (#chars - 1))
3051
3827
state0 = "base"
3828
+
elseif true then
3829
+
local _ = _238_
3830
+
state0 = "base"
3831
+
else
3832
+
state0 = nil
3052
3833
end
3053
3834
end
3054
3835
if (b and (state0 ~= "done")) then
···
3058
3839
end
3059
3840
end
3060
3841
local function escape_char(c)
3061
-
return ({[10] = "\\n", [11] = "\\v", [12] = "\\f", [13] = "\\r", [7] = "\\a", [8] = "\\b", [9] = "\\t"})[c:byte()]
3842
+
return ({[7] = "\\a", [8] = "\\b", [9] = "\\t", [10] = "\\n", [11] = "\\v", [12] = "\\f", [13] = "\\r"})[c:byte()]
3062
3843
end
3063
3844
local function parse_string()
3064
3845
table.insert(stack, {closer = 34})
3065
3846
local chars = {34}
3066
3847
if not parse_string_loop(chars, getb(), "base") then
3067
3848
badend()
3849
+
else
3068
3850
end
3069
3851
table.remove(stack)
3070
3852
local raw = string.char(unpack(chars))
3071
3853
local formatted = raw:gsub("[\7-\13]", escape_char)
3072
-
local load_fn = (rawget(_G, "loadstring") or load)(("return " .. formatted))
3073
-
return dispatch(load_fn())
3854
+
local _242_ = (rawget(_G, "loadstring") or load)(("return " .. formatted))
3855
+
if (nil ~= _242_) then
3856
+
local load_fn = _242_
3857
+
return dispatch(load_fn())
3858
+
elseif (_242_ == nil) then
3859
+
return parse_error(("Invalid string: " .. raw))
3860
+
else
3861
+
return nil
3862
+
end
3074
3863
end
3075
3864
local function parse_prefix(b)
3076
-
table.insert(stack, {prefix = prefixes[b]})
3865
+
table.insert(stack, {prefix = prefixes[b], filename = filename, line = line, bytestart = byteindex, col = (col - 1)})
3077
3866
local nextb = getb()
3078
-
if whitespace_3f(nextb) then
3867
+
if (whitespace_3f(nextb) or (true == delims[nextb])) then
3079
3868
if (b ~= 35) then
3080
3869
parse_error("invalid whitespace after quoting prefix")
3870
+
else
3081
3871
end
3082
3872
table.remove(stack)
3083
3873
dispatch(utils.sym("#"))
3874
+
else
3084
3875
end
3085
3876
return ungetb(nextb)
3086
3877
end
···
3091
3882
else
3092
3883
if b then
3093
3884
ungetb(b)
3885
+
else
3094
3886
end
3095
3887
return chars
3096
3888
end
···
3101
3893
dispatch((tonumber(number_with_stripped_underscores) or parse_error(("could not read number \"" .. rawstr .. "\""))))
3102
3894
return true
3103
3895
else
3104
-
local _0_0 = tonumber(number_with_stripped_underscores)
3105
-
if (nil ~= _0_0) then
3106
-
local x = _0_0
3896
+
local _248_ = tonumber(number_with_stripped_underscores)
3897
+
if (nil ~= _248_) then
3898
+
local x = _248_
3107
3899
dispatch(x)
3108
3900
return true
3901
+
elseif true then
3902
+
local _ = _248_
3903
+
return false
3109
3904
else
3110
-
local _ = _0_0
3111
-
return false
3905
+
return nil
3112
3906
end
3113
3907
end
3114
3908
end
3115
3909
local function check_malformed_sym(rawstr)
3910
+
local function col_adjust(pat)
3911
+
return (rawstr:find(pat) - utils.len(rawstr) - 1)
3912
+
end
3116
3913
if (rawstr:match("^~") and (rawstr ~= "~=")) then
3117
-
return parse_error("illegal character: ~")
3914
+
return parse_error("invalid character: ~")
3118
3915
elseif rawstr:match("%.[0-9]") then
3119
-
return parse_error(("can't start multisym segment " .. "with a digit: " .. rawstr), (((byteindex - #rawstr) + rawstr:find("%.[0-9]")) + 1))
3916
+
return parse_error(("can't start multisym segment with a digit: " .. rawstr), col_adjust("%.[0-9]"))
3120
3917
elseif (rawstr:match("[%.:][%.:]") and (rawstr ~= "..") and (rawstr ~= "$...")) then
3121
-
return parse_error(("malformed multisym: " .. rawstr), ((byteindex - #rawstr) + 1 + rawstr:find("[%.:][%.:]")))
3918
+
return parse_error(("malformed multisym: " .. rawstr), col_adjust("[%.:][%.:]"))
3919
+
elseif ((rawstr ~= ":") and rawstr:match(":$")) then
3920
+
return parse_error(("malformed multisym: " .. rawstr), col_adjust(":$"))
3122
3921
elseif rawstr:match(":.+[%.:]") then
3123
-
return parse_error(("method must be last component " .. "of multisym: " .. rawstr), ((byteindex - #rawstr) + rawstr:find(":.+[%.:]")))
3922
+
return parse_error(("method must be last component of multisym: " .. rawstr), col_adjust(":.+[%.:]"))
3923
+
else
3924
+
return rawstr
3124
3925
end
3125
3926
end
3126
3927
local function parse_sym(b)
3127
-
local bytestart = byteindex
3928
+
local source0 = {bytestart = byteindex, filename = filename, line = line, col = (col - 1)}
3128
3929
local rawstr = string.char(unpack(parse_sym_loop({b}, getb())))
3930
+
set_source_fields(source0)
3129
3931
if (rawstr == "true") then
3130
3932
return dispatch(true)
3131
3933
elseif (rawstr == "false") then
3132
3934
return dispatch(false)
3133
3935
elseif (rawstr == "...") then
3134
-
return dispatch(utils.varg())
3936
+
return dispatch(utils.varg(source0))
3135
3937
elseif rawstr:match("^:.+$") then
3136
3938
return dispatch(rawstr:sub(2))
3137
-
elseif parse_number(rawstr) then
3138
-
return nil
3139
-
elseif check_malformed_sym(rawstr) then
3939
+
elseif not parse_number(rawstr) then
3940
+
return dispatch(utils.sym(check_malformed_sym(rawstr), source0))
3941
+
else
3140
3942
return nil
3141
-
else
3142
-
return dispatch(utils.sym(rawstr, nil, {byteend = byteindex, bytestart = bytestart, filename = filename, line = line}))
3143
3943
end
3144
3944
end
3145
3945
local function parse_loop(b)
···
3156
3956
parse_prefix(b)
3157
3957
elseif (sym_char_3f(b) or (b == string.byte("~"))) then
3158
3958
parse_sym(b)
3959
+
elseif not utils["hook-opts"]("illegal-char", options, b, getb, ungetb, dispatch) then
3960
+
parse_error(("invalid character: " .. string.char(b)))
3159
3961
else
3160
-
parse_error(("illegal character: " .. string.char(b)))
3161
3962
end
3162
3963
if not b then
3163
3964
return nil
···
3169
3970
end
3170
3971
return parse_loop(skip_whitespace(getb()))
3171
3972
end
3172
-
local function _0_()
3173
-
stack = {}
3973
+
local function _255_()
3974
+
stack, line, byteindex, col, lastb = {}, 1, 0, 0, nil
3174
3975
return nil
3175
3976
end
3176
-
return parse_stream, _0_
3977
+
return parse_stream, _255_
3177
3978
end
3178
-
return {["string-stream"] = string_stream, ["sym-char?"] = sym_char_3f, granulate = granulate, parser = parser}
3979
+
local function parser(stream_or_string, _3ffilename, _3foptions)
3980
+
local filename = (_3ffilename or "unknown")
3981
+
local options = (_3foptions or utils.root.options or {})
3982
+
assert(("string" == type(filename)), "expected filename as second argument to parser")
3983
+
if ("string" == type(stream_or_string)) then
3984
+
return parser_fn(string_stream(stream_or_string), filename, options)
3985
+
else
3986
+
return parser_fn(stream_or_string, filename, options)
3987
+
end
3988
+
end
3989
+
return {granulate = granulate, parser = parser, ["string-stream"] = string_stream, ["sym-char?"] = sym_char_3f}
3179
3990
end
3180
-
local utils = nil
3991
+
local utils
3992
+
package.preload["fennel.view"] = package.preload["fennel.view"] or function(...)
3993
+
local type_order = {number = 1, boolean = 2, string = 3, table = 4, ["function"] = 5, userdata = 6, thread = 7}
3994
+
local lua_pairs = pairs
3995
+
local lua_ipairs = ipairs
3996
+
local function pairs(t)
3997
+
local _1_ = getmetatable(t)
3998
+
if ((_G.type(_1_) == "table") and (nil ~= (_1_).__pairs)) then
3999
+
local p = (_1_).__pairs
4000
+
return p(t)
4001
+
elseif true then
4002
+
local _ = _1_
4003
+
return lua_pairs(t)
4004
+
else
4005
+
return nil
4006
+
end
4007
+
end
4008
+
local function ipairs(t)
4009
+
local _3_ = getmetatable(t)
4010
+
if ((_G.type(_3_) == "table") and (nil ~= (_3_).__ipairs)) then
4011
+
local i = (_3_).__ipairs
4012
+
return i(t)
4013
+
elseif true then
4014
+
local _ = _3_
4015
+
return lua_ipairs(t)
4016
+
else
4017
+
return nil
4018
+
end
4019
+
end
4020
+
local function length_2a(t)
4021
+
local _5_ = getmetatable(t)
4022
+
if ((_G.type(_5_) == "table") and (nil ~= (_5_).__len)) then
4023
+
local l = (_5_).__len
4024
+
return l(t)
4025
+
elseif true then
4026
+
local _ = _5_
4027
+
return #t
4028
+
else
4029
+
return nil
4030
+
end
4031
+
end
4032
+
local function sort_keys(_7_, _9_)
4033
+
local _arg_8_ = _7_
4034
+
local a = _arg_8_[1]
4035
+
local _arg_10_ = _9_
4036
+
local b = _arg_10_[1]
4037
+
local ta = type(a)
4038
+
local tb = type(b)
4039
+
if ((ta == tb) and ((ta == "string") or (ta == "number"))) then
4040
+
return (a < b)
4041
+
else
4042
+
local dta = type_order[ta]
4043
+
local dtb = type_order[tb]
4044
+
if (dta and dtb) then
4045
+
return (dta < dtb)
4046
+
elseif dta then
4047
+
return true
4048
+
elseif dtb then
4049
+
return false
4050
+
else
4051
+
return (ta < tb)
4052
+
end
4053
+
end
4054
+
end
4055
+
local function max_index_gap(kv)
4056
+
local gap = 0
4057
+
if (0 < length_2a(kv)) then
4058
+
local i = 0
4059
+
for _, _13_ in ipairs(kv) do
4060
+
local _each_14_ = _13_
4061
+
local k = _each_14_[1]
4062
+
if (gap < (k - i)) then
4063
+
gap = (k - i)
4064
+
else
4065
+
end
4066
+
i = k
4067
+
end
4068
+
else
4069
+
end
4070
+
return gap
4071
+
end
4072
+
local function fill_gaps(kv)
4073
+
local missing_indexes = {}
4074
+
local i = 0
4075
+
for _, _17_ in ipairs(kv) do
4076
+
local _each_18_ = _17_
4077
+
local j = _each_18_[1]
4078
+
i = (i + 1)
4079
+
while (i < j) do
4080
+
table.insert(missing_indexes, i)
4081
+
i = (i + 1)
4082
+
end
4083
+
end
4084
+
for _, k in ipairs(missing_indexes) do
4085
+
table.insert(kv, k, {k})
4086
+
end
4087
+
return nil
4088
+
end
4089
+
local function table_kv_pairs(t, options)
4090
+
local assoc_3f = false
4091
+
local kv = {}
4092
+
local insert = table.insert
4093
+
for k, v in pairs(t) do
4094
+
if ((type(k) ~= "number") or (k < 1)) then
4095
+
assoc_3f = true
4096
+
else
4097
+
end
4098
+
insert(kv, {k, v})
4099
+
end
4100
+
table.sort(kv, sort_keys)
4101
+
if not assoc_3f then
4102
+
if (options["max-sparse-gap"] < max_index_gap(kv)) then
4103
+
assoc_3f = true
4104
+
else
4105
+
fill_gaps(kv)
4106
+
end
4107
+
else
4108
+
end
4109
+
if (length_2a(kv) == 0) then
4110
+
return kv, "empty"
4111
+
else
4112
+
local function _22_()
4113
+
if assoc_3f then
4114
+
return "table"
4115
+
else
4116
+
return "seq"
4117
+
end
4118
+
end
4119
+
return kv, _22_()
4120
+
end
4121
+
end
4122
+
local function count_table_appearances(t, appearances)
4123
+
if (type(t) == "table") then
4124
+
if not appearances[t] then
4125
+
appearances[t] = 1
4126
+
for k, v in pairs(t) do
4127
+
count_table_appearances(k, appearances)
4128
+
count_table_appearances(v, appearances)
4129
+
end
4130
+
else
4131
+
appearances[t] = ((appearances[t] or 0) + 1)
4132
+
end
4133
+
else
4134
+
end
4135
+
return appearances
4136
+
end
4137
+
local function save_table(t, seen)
4138
+
local seen0 = (seen or {len = 0})
4139
+
local id = (seen0.len + 1)
4140
+
if not (seen0)[t] then
4141
+
seen0[t] = id
4142
+
seen0.len = id
4143
+
else
4144
+
end
4145
+
return seen0
4146
+
end
4147
+
local function detect_cycle(t, seen, _3fk)
4148
+
if ("table" == type(t)) then
4149
+
seen[t] = true
4150
+
local _27_, _28_ = next(t, _3fk)
4151
+
if ((nil ~= _27_) and (nil ~= _28_)) then
4152
+
local k = _27_
4153
+
local v = _28_
4154
+
return (seen[k] or detect_cycle(k, seen) or seen[v] or detect_cycle(v, seen) or detect_cycle(t, seen, k))
4155
+
else
4156
+
return nil
4157
+
end
4158
+
else
4159
+
return nil
4160
+
end
4161
+
end
4162
+
local function visible_cycle_3f(t, options)
4163
+
return (options["detect-cycles?"] and detect_cycle(t, {}) and save_table(t, options.seen) and (1 < (options.appearances[t] or 0)))
4164
+
end
4165
+
local function table_indent(indent, id)
4166
+
local opener_length
4167
+
if id then
4168
+
opener_length = (length_2a(tostring(id)) + 2)
4169
+
else
4170
+
opener_length = 1
4171
+
end
4172
+
return (indent + opener_length)
4173
+
end
4174
+
local pp = nil
4175
+
local function concat_table_lines(elements, options, multiline_3f, indent, table_type, prefix, last_comment_3f)
4176
+
local indent_str = ("\n" .. string.rep(" ", indent))
4177
+
local open
4178
+
local function _32_()
4179
+
if ("seq" == table_type) then
4180
+
return "["
4181
+
else
4182
+
return "{"
4183
+
end
4184
+
end
4185
+
open = ((prefix or "") .. _32_())
4186
+
local close
4187
+
if ("seq" == table_type) then
4188
+
close = "]"
4189
+
else
4190
+
close = "}"
4191
+
end
4192
+
local oneline = (open .. table.concat(elements, " ") .. close)
4193
+
if (not options["one-line?"] and (multiline_3f or (options["line-length"] < (indent + length_2a(oneline))) or last_comment_3f)) then
4194
+
local function _34_()
4195
+
if last_comment_3f then
4196
+
return indent_str
4197
+
else
4198
+
return ""
4199
+
end
4200
+
end
4201
+
return (open .. table.concat(elements, indent_str) .. _34_() .. close)
4202
+
else
4203
+
return oneline
4204
+
end
4205
+
end
4206
+
local function utf8_len(x)
4207
+
local n = 0
4208
+
for _ in string.gmatch(x, "[%z\1-\127\192-\247]") do
4209
+
n = (n + 1)
4210
+
end
4211
+
return n
4212
+
end
4213
+
local function comment_3f(x)
4214
+
if ("table" == type(x)) then
4215
+
local fst = x[1]
4216
+
return (("string" == type(fst)) and (nil ~= fst:find("^;")))
4217
+
else
4218
+
return false
4219
+
end
4220
+
end
4221
+
local function pp_associative(t, kv, options, indent)
4222
+
local multiline_3f = false
4223
+
local id = options.seen[t]
4224
+
if (options.depth <= options.level) then
4225
+
return "{...}"
4226
+
elseif (id and options["detect-cycles?"]) then
4227
+
return ("@" .. id .. "{...}")
4228
+
else
4229
+
local visible_cycle_3f0 = visible_cycle_3f(t, options)
4230
+
local id0 = (visible_cycle_3f0 and options.seen[t])
4231
+
local indent0 = table_indent(indent, id0)
4232
+
local slength
4233
+
if options["utf8?"] then
4234
+
slength = utf8_len
4235
+
else
4236
+
local function _37_(_241)
4237
+
return #_241
4238
+
end
4239
+
slength = _37_
4240
+
end
4241
+
local prefix
4242
+
if visible_cycle_3f0 then
4243
+
prefix = ("@" .. id0)
4244
+
else
4245
+
prefix = ""
4246
+
end
4247
+
local items
4248
+
do
4249
+
local tbl_14_auto = {}
4250
+
local i_15_auto = #tbl_14_auto
4251
+
for _, _40_ in ipairs(kv) do
4252
+
local _each_41_ = _40_
4253
+
local k = _each_41_[1]
4254
+
local v = _each_41_[2]
4255
+
local val_16_auto
4256
+
do
4257
+
local k0 = pp(k, options, (indent0 + 1), true)
4258
+
local v0 = pp(v, options, (indent0 + slength(k0) + 1))
4259
+
multiline_3f = (multiline_3f or k0:find("\n") or v0:find("\n"))
4260
+
val_16_auto = (k0 .. " " .. v0)
4261
+
end
4262
+
if (nil ~= val_16_auto) then
4263
+
i_15_auto = (i_15_auto + 1)
4264
+
do end (tbl_14_auto)[i_15_auto] = val_16_auto
4265
+
else
4266
+
end
4267
+
end
4268
+
items = tbl_14_auto
4269
+
end
4270
+
return concat_table_lines(items, options, multiline_3f, indent0, "table", prefix, false)
4271
+
end
4272
+
end
4273
+
local function pp_sequence(t, kv, options, indent)
4274
+
local multiline_3f = false
4275
+
local id = options.seen[t]
4276
+
if (options.depth <= options.level) then
4277
+
return "[...]"
4278
+
elseif (id and options["detect-cycles?"]) then
4279
+
return ("@" .. id .. "[...]")
4280
+
else
4281
+
local visible_cycle_3f0 = visible_cycle_3f(t, options)
4282
+
local id0 = (visible_cycle_3f0 and options.seen[t])
4283
+
local indent0 = table_indent(indent, id0)
4284
+
local prefix
4285
+
if visible_cycle_3f0 then
4286
+
prefix = ("@" .. id0)
4287
+
else
4288
+
prefix = ""
4289
+
end
4290
+
local last_comment_3f = comment_3f(t[#t])
4291
+
local items
4292
+
do
4293
+
local tbl_14_auto = {}
4294
+
local i_15_auto = #tbl_14_auto
4295
+
for _, _45_ in ipairs(kv) do
4296
+
local _each_46_ = _45_
4297
+
local _0 = _each_46_[1]
4298
+
local v = _each_46_[2]
4299
+
local val_16_auto
4300
+
do
4301
+
local v0 = pp(v, options, indent0)
4302
+
multiline_3f = (multiline_3f or v0:find("\n") or v0:find("^;"))
4303
+
val_16_auto = v0
4304
+
end
4305
+
if (nil ~= val_16_auto) then
4306
+
i_15_auto = (i_15_auto + 1)
4307
+
do end (tbl_14_auto)[i_15_auto] = val_16_auto
4308
+
else
4309
+
end
4310
+
end
4311
+
items = tbl_14_auto
4312
+
end
4313
+
return concat_table_lines(items, options, multiline_3f, indent0, "seq", prefix, last_comment_3f)
4314
+
end
4315
+
end
4316
+
local function concat_lines(lines, options, indent, force_multi_line_3f)
4317
+
if (length_2a(lines) == 0) then
4318
+
if options["empty-as-sequence?"] then
4319
+
return "[]"
4320
+
else
4321
+
return "{}"
4322
+
end
4323
+
else
4324
+
local oneline
4325
+
local _50_
4326
+
do
4327
+
local tbl_14_auto = {}
4328
+
local i_15_auto = #tbl_14_auto
4329
+
for _, line in ipairs(lines) do
4330
+
local val_16_auto = line:gsub("^%s+", "")
4331
+
if (nil ~= val_16_auto) then
4332
+
i_15_auto = (i_15_auto + 1)
4333
+
do end (tbl_14_auto)[i_15_auto] = val_16_auto
4334
+
else
4335
+
end
4336
+
end
4337
+
_50_ = tbl_14_auto
4338
+
end
4339
+
oneline = table.concat(_50_, " ")
4340
+
if (not options["one-line?"] and (force_multi_line_3f or oneline:find("\n") or (options["line-length"] < (indent + length_2a(oneline))))) then
4341
+
return table.concat(lines, ("\n" .. string.rep(" ", indent)))
4342
+
else
4343
+
return oneline
4344
+
end
4345
+
end
4346
+
end
4347
+
local function pp_metamethod(t, metamethod, options, indent)
4348
+
if (options.depth <= options.level) then
4349
+
if options["empty-as-sequence?"] then
4350
+
return "[...]"
4351
+
else
4352
+
return "{...}"
4353
+
end
4354
+
else
4355
+
local _
4356
+
local function _55_(_241)
4357
+
return visible_cycle_3f(_241, options)
4358
+
end
4359
+
options["visible-cycle?"] = _55_
4360
+
_ = nil
4361
+
local lines, force_multi_line_3f = metamethod(t, pp, options, indent)
4362
+
options["visible-cycle?"] = nil
4363
+
local _56_ = type(lines)
4364
+
if (_56_ == "string") then
4365
+
return lines
4366
+
elseif (_56_ == "table") then
4367
+
return concat_lines(lines, options, indent, force_multi_line_3f)
4368
+
elseif true then
4369
+
local _0 = _56_
4370
+
return error("__fennelview metamethod must return a table of lines")
4371
+
else
4372
+
return nil
4373
+
end
4374
+
end
4375
+
end
4376
+
local function pp_table(x, options, indent)
4377
+
options.level = (options.level + 1)
4378
+
local x0
4379
+
do
4380
+
local _59_
4381
+
if options["metamethod?"] then
4382
+
local _60_ = x
4383
+
if (nil ~= _60_) then
4384
+
local _61_ = getmetatable(_60_)
4385
+
if (nil ~= _61_) then
4386
+
_59_ = (_61_).__fennelview
4387
+
else
4388
+
_59_ = _61_
4389
+
end
4390
+
else
4391
+
_59_ = _60_
4392
+
end
4393
+
else
4394
+
_59_ = nil
4395
+
end
4396
+
if (nil ~= _59_) then
4397
+
local metamethod = _59_
4398
+
x0 = pp_metamethod(x, metamethod, options, indent)
4399
+
elseif true then
4400
+
local _ = _59_
4401
+
local _65_, _66_ = table_kv_pairs(x, options)
4402
+
if (true and (_66_ == "empty")) then
4403
+
local _0 = _65_
4404
+
if options["empty-as-sequence?"] then
4405
+
x0 = "[]"
4406
+
else
4407
+
x0 = "{}"
4408
+
end
4409
+
elseif ((nil ~= _65_) and (_66_ == "table")) then
4410
+
local kv = _65_
4411
+
x0 = pp_associative(x, kv, options, indent)
4412
+
elseif ((nil ~= _65_) and (_66_ == "seq")) then
4413
+
local kv = _65_
4414
+
x0 = pp_sequence(x, kv, options, indent)
4415
+
else
4416
+
x0 = nil
4417
+
end
4418
+
else
4419
+
x0 = nil
4420
+
end
4421
+
end
4422
+
options.level = (options.level - 1)
4423
+
return x0
4424
+
end
4425
+
local function number__3estring(n)
4426
+
local _70_ = string.gsub(tostring(n), ",", ".")
4427
+
return _70_
4428
+
end
4429
+
local function colon_string_3f(s)
4430
+
return s:find("^[-%w?^_!$%&*+./@|<=>]+$")
4431
+
end
4432
+
local utf8_inits = {{["min-byte"] = 0, ["max-byte"] = 127, ["min-code"] = 0, ["max-code"] = 127, len = 1}, {["min-byte"] = 192, ["max-byte"] = 223, ["min-code"] = 128, ["max-code"] = 2047, len = 2}, {["min-byte"] = 224, ["max-byte"] = 239, ["min-code"] = 2048, ["max-code"] = 65535, len = 3}, {["min-byte"] = 240, ["max-byte"] = 247, ["min-code"] = 65536, ["max-code"] = 1114111, len = 4}}
4433
+
local function utf8_escape(str)
4434
+
local function validate_utf8(str0, index)
4435
+
local inits = utf8_inits
4436
+
local byte = string.byte(str0, index)
4437
+
local init
4438
+
do
4439
+
local ret = nil
4440
+
for _, init0 in ipairs(inits) do
4441
+
if ret then break end
4442
+
ret = (byte and (function(_71_,_72_,_73_) return (_71_ <= _72_) and (_72_ <= _73_) end)(init0["min-byte"],byte,init0["max-byte"]) and init0)
4443
+
end
4444
+
init = ret
4445
+
end
4446
+
local code
4447
+
local function _74_()
4448
+
local code0
4449
+
if init then
4450
+
code0 = (byte - init["min-byte"])
4451
+
else
4452
+
code0 = nil
4453
+
end
4454
+
for i = (index + 1), (index + init.len + -1) do
4455
+
local byte0 = string.byte(str0, i)
4456
+
code0 = (byte0 and code0 and (function(_76_,_77_,_78_) return (_76_ <= _77_) and (_77_ <= _78_) end)(128,byte0,191) and ((code0 * 64) + (byte0 - 128)))
4457
+
end
4458
+
return code0
4459
+
end
4460
+
code = (init and _74_())
4461
+
if (code and (function(_79_,_80_,_81_) return (_79_ <= _80_) and (_80_ <= _81_) end)(init["min-code"],code,init["max-code"]) and not (function(_82_,_83_,_84_) return (_82_ <= _83_) and (_83_ <= _84_) end)(55296,code,57343)) then
4462
+
return init.len
4463
+
else
4464
+
return nil
4465
+
end
4466
+
end
4467
+
local index = 1
4468
+
local output = {}
4469
+
while (index <= #str) do
4470
+
local nexti = (string.find(str, "[\128-\255]", index) or (#str + 1))
4471
+
local len = validate_utf8(str, nexti)
4472
+
table.insert(output, string.sub(str, index, (nexti + (len or 0) + -1)))
4473
+
if (not len and (nexti <= #str)) then
4474
+
table.insert(output, string.format("\\%03d", string.byte(str, nexti)))
4475
+
else
4476
+
end
4477
+
if len then
4478
+
index = (nexti + len)
4479
+
else
4480
+
index = (nexti + 1)
4481
+
end
4482
+
end
4483
+
return table.concat(output)
4484
+
end
4485
+
local function pp_string(str, options, indent)
4486
+
local escs
4487
+
local _88_
4488
+
if (options["escape-newlines?"] and (length_2a(str) < (options["line-length"] - indent))) then
4489
+
_88_ = "\\n"
4490
+
else
4491
+
_88_ = "\n"
4492
+
end
4493
+
local function _90_(_241, _242)
4494
+
return ("\\%03d"):format(_242:byte())
4495
+
end
4496
+
escs = setmetatable({["\7"] = "\\a", ["\8"] = "\\b", ["\12"] = "\\f", ["\11"] = "\\v", ["\13"] = "\\r", ["\9"] = "\\t", ["\\"] = "\\\\", ["\""] = "\\\"", ["\n"] = _88_}, {__index = _90_})
4497
+
local str0 = ("\"" .. str:gsub("[%c\\\"]", escs) .. "\"")
4498
+
if options["utf8?"] then
4499
+
return utf8_escape(str0)
4500
+
else
4501
+
return str0
4502
+
end
4503
+
end
4504
+
local function make_options(t, options)
4505
+
local defaults = {["line-length"] = 80, ["one-line?"] = false, depth = 128, ["detect-cycles?"] = true, ["empty-as-sequence?"] = false, ["metamethod?"] = true, ["prefer-colon?"] = false, ["escape-newlines?"] = false, ["utf8?"] = true, ["max-sparse-gap"] = 10}
4506
+
local overrides = {level = 0, appearances = count_table_appearances(t, {}), seen = {len = 0}}
4507
+
for k, v in pairs((options or {})) do
4508
+
defaults[k] = v
4509
+
end
4510
+
for k, v in pairs(overrides) do
4511
+
defaults[k] = v
4512
+
end
4513
+
return defaults
4514
+
end
4515
+
local function _92_(x, options, indent, colon_3f)
4516
+
local indent0 = (indent or 0)
4517
+
local options0 = (options or make_options(x))
4518
+
local x0
4519
+
if options0.preprocess then
4520
+
x0 = options0.preprocess(x, options0)
4521
+
else
4522
+
x0 = x
4523
+
end
4524
+
local tv = type(x0)
4525
+
local function _95_()
4526
+
local _94_ = getmetatable(x0)
4527
+
if (nil ~= _94_) then
4528
+
return (_94_).__fennelview
4529
+
else
4530
+
return _94_
4531
+
end
4532
+
end
4533
+
if ((tv == "table") or ((tv == "userdata") and _95_())) then
4534
+
return pp_table(x0, options0, indent0)
4535
+
elseif (tv == "number") then
4536
+
return number__3estring(x0)
4537
+
else
4538
+
local function _97_()
4539
+
if (colon_3f ~= nil) then
4540
+
return colon_3f
4541
+
elseif ("function" == type(options0["prefer-colon?"])) then
4542
+
return options0["prefer-colon?"](x0)
4543
+
else
4544
+
return options0["prefer-colon?"]
4545
+
end
4546
+
end
4547
+
if ((tv == "string") and colon_string_3f(x0) and _97_()) then
4548
+
return (":" .. x0)
4549
+
elseif (tv == "string") then
4550
+
return pp_string(x0, options0, indent0)
4551
+
elseif ((tv == "boolean") or (tv == "nil")) then
4552
+
return tostring(x0)
4553
+
else
4554
+
return ("#<" .. tostring(x0) .. ">")
4555
+
end
4556
+
end
4557
+
end
4558
+
pp = _92_
4559
+
local function view(x, _3foptions)
4560
+
return pp(x, make_options(x, _3foptions), 0)
4561
+
end
4562
+
return view
4563
+
end
3181
4564
package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(...)
3182
-
local function stablepairs(t)
3183
-
local keys = {}
3184
-
local succ = {}
4565
+
local view = require("fennel.view")
4566
+
local version = "1.2.1"
4567
+
local function luajit_vm_3f()
4568
+
return ((nil ~= _G.jit) and (type(_G.jit) == "table") and (nil ~= _G.jit.on) and (nil ~= _G.jit.off) and (type(_G.jit.version_num) == "number"))
4569
+
end
4570
+
local function luajit_vm_version()
4571
+
local jit_os
4572
+
if (_G.jit.os == "OSX") then
4573
+
jit_os = "macOS"
4574
+
else
4575
+
jit_os = _G.jit.os
4576
+
end
4577
+
return (_G.jit.version .. " " .. jit_os .. "/" .. _G.jit.arch)
4578
+
end
4579
+
local function fengari_vm_3f()
4580
+
return ((nil ~= _G.fengari) and (type(_G.fengari) == "table") and (nil ~= _G.fengari.VERSION) and (type(_G.fengari.VERSION_NUM) == "number"))
4581
+
end
4582
+
local function fengari_vm_version()
4583
+
return (_G.fengari.RELEASE .. " (" .. _VERSION .. ")")
4584
+
end
4585
+
local function lua_vm_version()
4586
+
if luajit_vm_3f() then
4587
+
return luajit_vm_version()
4588
+
elseif fengari_vm_3f() then
4589
+
return fengari_vm_version()
4590
+
else
4591
+
return ("PUC " .. _VERSION)
4592
+
end
4593
+
end
4594
+
local function runtime_version()
4595
+
return ("Fennel " .. version .. " on " .. lua_vm_version())
4596
+
end
4597
+
local function warn(message)
4598
+
if (_G.io and _G.io.stderr) then
4599
+
return (_G.io.stderr):write(("--WARNING: %s\n"):format(tostring(message)))
4600
+
else
4601
+
return nil
4602
+
end
4603
+
end
4604
+
local len
4605
+
do
4606
+
local _102_, _103_ = pcall(require, "utf8")
4607
+
if ((_102_ == true) and (nil ~= _103_)) then
4608
+
local utf8 = _103_
4609
+
len = utf8.len
4610
+
elseif true then
4611
+
local _ = _102_
4612
+
len = string.len
4613
+
else
4614
+
len = nil
4615
+
end
4616
+
end
4617
+
local function mt_keys_in_order(t, out, used_keys)
4618
+
for _, k in ipairs(getmetatable(t).keys) do
4619
+
if (t[k] and not used_keys[k]) then
4620
+
used_keys[k] = true
4621
+
table.insert(out, k)
4622
+
else
4623
+
end
4624
+
end
3185
4625
for k in pairs(t) do
3186
-
table.insert(keys, k)
4626
+
if not used_keys[k] then
4627
+
table.insert(out, k)
4628
+
else
4629
+
end
3187
4630
end
3188
-
local function _0_(a, b)
3189
-
return (tostring(a) < tostring(b))
4631
+
return out
4632
+
end
4633
+
local function stablepairs(t)
4634
+
local keys
4635
+
local _108_
4636
+
do
4637
+
local t_107_ = getmetatable(t)
4638
+
if (nil ~= t_107_) then
4639
+
t_107_ = (t_107_).keys
4640
+
else
4641
+
end
4642
+
_108_ = t_107_
4643
+
end
4644
+
if _108_ then
4645
+
keys = mt_keys_in_order(t, {}, {})
4646
+
else
4647
+
local _110_
4648
+
do
4649
+
local tbl_14_auto = {}
4650
+
local i_15_auto = #tbl_14_auto
4651
+
for k in pairs(t) do
4652
+
local val_16_auto = k
4653
+
if (nil ~= val_16_auto) then
4654
+
i_15_auto = (i_15_auto + 1)
4655
+
do end (tbl_14_auto)[i_15_auto] = val_16_auto
4656
+
else
4657
+
end
4658
+
end
4659
+
_110_ = tbl_14_auto
4660
+
end
4661
+
local function _112_(_241, _242)
4662
+
return (tostring(_241) < tostring(_242))
4663
+
end
4664
+
table.sort(_110_, _112_)
4665
+
keys = _110_
3190
4666
end
3191
-
table.sort(keys, _0_)
3192
-
for i, k in ipairs(keys) do
3193
-
succ[k] = keys[(i + 1)]
4667
+
local succ
4668
+
do
4669
+
local tbl_11_auto = {}
4670
+
for i, k in ipairs(keys) do
4671
+
local _114_, _115_ = k, keys[(i + 1)]
4672
+
if ((nil ~= _114_) and (nil ~= _115_)) then
4673
+
local k_12_auto = _114_
4674
+
local v_13_auto = _115_
4675
+
tbl_11_auto[k_12_auto] = v_13_auto
4676
+
else
4677
+
end
4678
+
end
4679
+
succ = tbl_11_auto
3194
4680
end
3195
-
local function stablenext(tbl, idx)
3196
-
if (idx == nil) then
3197
-
return keys[1], tbl[keys[1]]
4681
+
local function stablenext(tbl, key)
4682
+
local next_key
4683
+
if (key == nil) then
4684
+
next_key = keys[1]
3198
4685
else
3199
-
return succ[idx], tbl[succ[idx]]
4686
+
next_key = succ[key]
3200
4687
end
4688
+
return next_key, tbl[next_key]
3201
4689
end
3202
4690
return stablenext, t, nil
3203
4691
end
3204
-
local function map(t, f, out)
3205
-
local out0 = (out or {})
3206
-
local f0 = nil
4692
+
local function get_in(tbl, path, _3ffallback)
4693
+
assert(("table" == type(tbl)), "get-in expects path to be a table")
4694
+
if (0 == #path) then
4695
+
return _3ffallback
4696
+
else
4697
+
local _118_
4698
+
do
4699
+
local t = tbl
4700
+
for _, k in ipairs(path) do
4701
+
if (nil == t) then break end
4702
+
local _119_ = type(t)
4703
+
if (_119_ == "table") then
4704
+
t = t[k]
4705
+
else
4706
+
t = nil
4707
+
end
4708
+
end
4709
+
_118_ = t
4710
+
end
4711
+
if (nil ~= _118_) then
4712
+
local res = _118_
4713
+
return res
4714
+
elseif true then
4715
+
local _ = _118_
4716
+
return _3ffallback
4717
+
else
4718
+
return nil
4719
+
end
4720
+
end
4721
+
end
4722
+
local function map(t, f, _3fout)
4723
+
local out = (_3fout or {})
4724
+
local f0
3207
4725
if (type(f) == "function") then
3208
4726
f0 = f
3209
4727
else
3210
-
local s = f
3211
-
local function _0_(x)
3212
-
return x[s]
4728
+
local function _123_(_241)
4729
+
return (_241)[f]
3213
4730
end
3214
-
f0 = _0_
4731
+
f0 = _123_
3215
4732
end
3216
4733
for _, x in ipairs(t) do
3217
-
local _1_0 = f0(x)
3218
-
if (nil ~= _1_0) then
3219
-
local v = _1_0
3220
-
table.insert(out0, v)
4734
+
local _125_ = f0(x)
4735
+
if (nil ~= _125_) then
4736
+
local v = _125_
4737
+
table.insert(out, v)
4738
+
else
3221
4739
end
3222
4740
end
3223
-
return out0
4741
+
return out
3224
4742
end
3225
-
local function kvmap(t, f, out)
3226
-
local out0 = (out or {})
3227
-
local f0 = nil
4743
+
local function kvmap(t, f, _3fout)
4744
+
local out = (_3fout or {})
4745
+
local f0
3228
4746
if (type(f) == "function") then
3229
4747
f0 = f
3230
4748
else
3231
-
local s = f
3232
-
local function _0_(x)
3233
-
return x[s]
4749
+
local function _127_(_241)
4750
+
return (_241)[f]
3234
4751
end
3235
-
f0 = _0_
4752
+
f0 = _127_
3236
4753
end
3237
4754
for k, x in stablepairs(t) do
3238
-
local _1_0, _2_0 = f0(k, x)
3239
-
if ((nil ~= _1_0) and (nil ~= _2_0)) then
3240
-
local key = _1_0
3241
-
local value = _2_0
3242
-
out0[key] = value
3243
-
elseif (nil ~= _1_0) then
3244
-
local value = _1_0
3245
-
table.insert(out0, value)
4755
+
local _129_, _130_ = f0(k, x)
4756
+
if ((nil ~= _129_) and (nil ~= _130_)) then
4757
+
local key = _129_
4758
+
local value = _130_
4759
+
out[key] = value
4760
+
elseif (nil ~= _129_) then
4761
+
local value = _129_
4762
+
table.insert(out, value)
4763
+
else
3246
4764
end
3247
4765
end
3248
-
return out0
4766
+
return out
3249
4767
end
3250
-
local function copy(from, to)
3251
-
local to0 = (to or {})
4768
+
local function copy(from, _3fto)
4769
+
local tbl_11_auto = (_3fto or {})
3252
4770
for k, v in pairs((from or {})) do
3253
-
to0[k] = v
4771
+
local _132_, _133_ = k, v
4772
+
if ((nil ~= _132_) and (nil ~= _133_)) then
4773
+
local k_12_auto = _132_
4774
+
local v_13_auto = _133_
4775
+
tbl_11_auto[k_12_auto] = v_13_auto
4776
+
else
4777
+
end
3254
4778
end
3255
-
return to0
4779
+
return tbl_11_auto
3256
4780
end
3257
-
local function member_3f(x, tbl, n)
3258
-
local _0_0 = tbl[(n or 1)]
3259
-
if (_0_0 == x) then
4781
+
local function member_3f(x, tbl, _3fn)
4782
+
local _135_ = tbl[(_3fn or 1)]
4783
+
if (_135_ == x) then
3260
4784
return true
3261
-
elseif (_0_0 == nil) then
3262
-
return false
4785
+
elseif (_135_ == nil) then
4786
+
return nil
4787
+
elseif true then
4788
+
local _ = _135_
4789
+
return member_3f(x, tbl, ((_3fn or 1) + 1))
3263
4790
else
3264
-
local _ = _0_0
3265
-
return member_3f(x, tbl, ((n or 1) + 1))
4791
+
return nil
3266
4792
end
3267
4793
end
3268
4794
local function allpairs(tbl)
···
3277
4803
seen[next_state] = true
3278
4804
return next_state, value
3279
4805
else
3280
-
local meta = getmetatable(t)
3281
-
if (meta and meta.__index) then
3282
-
t = meta.__index
3283
-
return allpairs_next(t)
4806
+
local _137_ = getmetatable(t)
4807
+
if ((_G.type(_137_) == "table") and true) then
4808
+
local __index = (_137_).__index
4809
+
if ("table" == type(__index)) then
4810
+
t = __index
4811
+
return allpairs_next(t)
4812
+
else
4813
+
return nil
4814
+
end
4815
+
else
4816
+
return nil
3284
4817
end
3285
4818
end
3286
4819
end
···
3290
4823
return self[1]
3291
4824
end
3292
4825
local nil_sym = nil
3293
-
local function list__3estring(self, tostring2)
3294
-
local safe, max = {}, 0
4826
+
local function list__3estring(self, _3ftostring2)
4827
+
local safe = {}
4828
+
local max = 0
3295
4829
for k in pairs(self) do
3296
-
if ((type(k) == "number") and (k > max)) then
4830
+
if ((type(k) == "number") and (max < k)) then
3297
4831
max = k
4832
+
else
3298
4833
end
3299
4834
end
3300
4835
for i = 1, max do
3301
4836
safe[i] = (((self[i] == nil) and nil_sym) or self[i])
3302
4837
end
3303
-
return ("(" .. table.concat(map(safe, (tostring2 or tostring)), " ", 1, max) .. ")")
4838
+
return ("(" .. table.concat(map(safe, (_3ftostring2 or view)), " ", 1, max) .. ")")
3304
4839
end
3305
-
local symbol_mt = {"SYMBOL", __fennelview = deref, __tostring = deref}
3306
-
local expr_mt = {"EXPR", __tostring = deref}
3307
-
local list_mt = {"LIST", __fennelview = list__3estring, __tostring = list__3estring}
3308
-
local comment_mt = {"COMMENT", __fennelview = deref, __tostring = deref}
4840
+
local function comment_view(c)
4841
+
return c, true
4842
+
end
4843
+
local function sym_3d(a, b)
4844
+
return ((deref(a) == deref(b)) and (getmetatable(a) == getmetatable(b)))
4845
+
end
4846
+
local function sym_3c(a, b)
4847
+
return (a[1] < tostring(b))
4848
+
end
4849
+
local symbol_mt = {__fennelview = deref, __tostring = deref, __eq = sym_3d, __lt = sym_3c, "SYMBOL"}
4850
+
local expr_mt
4851
+
local function _142_(x)
4852
+
return tostring(deref(x))
4853
+
end
4854
+
expr_mt = {__tostring = _142_, "EXPR"}
4855
+
local list_mt = {__fennelview = list__3estring, __tostring = list__3estring, "LIST"}
4856
+
local comment_mt = {__fennelview = comment_view, __tostring = deref, __eq = sym_3d, __lt = sym_3c, "COMMENT"}
3309
4857
local sequence_marker = {"SEQUENCE"}
3310
-
local vararg = setmetatable({"..."}, {"VARARG", __fennelview = deref, __tostring = deref})
3311
-
local getenv = nil
3312
-
local function _0_()
4858
+
local varg_mt = {__fennelview = deref, __tostring = deref, "VARARG"}
4859
+
local getenv
4860
+
local function _143_()
3313
4861
return nil
3314
4862
end
3315
-
getenv = ((os and os.getenv) or _0_)
4863
+
getenv = ((os and os.getenv) or _143_)
3316
4864
local function debug_on_3f(flag)
3317
4865
local level = (getenv("FENNEL_DEBUG") or "")
3318
4866
return ((level == "all") or level:find(flag))
···
3320
4868
local function list(...)
3321
4869
return setmetatable({...}, list_mt)
3322
4870
end
3323
-
local function sym(str, scope, source)
3324
-
local s = {str, scope = scope}
3325
-
for k, v in pairs((source or {})) do
3326
-
if (type(k) == "string") then
3327
-
s[k] = v
4871
+
local function sym(str, _3fsource)
4872
+
local _144_
4873
+
do
4874
+
local tbl_11_auto = {str}
4875
+
for k, v in pairs((_3fsource or {})) do
4876
+
local _145_, _146_ = nil, nil
4877
+
if (type(k) == "string") then
4878
+
_145_, _146_ = k, v
4879
+
else
4880
+
_145_, _146_ = nil
4881
+
end
4882
+
if ((nil ~= _145_) and (nil ~= _146_)) then
4883
+
local k_12_auto = _145_
4884
+
local v_13_auto = _146_
4885
+
tbl_11_auto[k_12_auto] = v_13_auto
4886
+
else
4887
+
end
3328
4888
end
4889
+
_144_ = tbl_11_auto
3329
4890
end
3330
-
return setmetatable(s, symbol_mt)
4891
+
return setmetatable(_144_, symbol_mt)
3331
4892
end
3332
4893
nil_sym = sym("nil")
3333
4894
local function sequence(...)
3334
4895
return setmetatable({...}, {sequence = sequence_marker})
3335
4896
end
3336
4897
local function expr(strcode, etype)
3337
-
return setmetatable({strcode, type = etype}, expr_mt)
4898
+
return setmetatable({type = etype, strcode}, expr_mt)
3338
4899
end
3339
-
local function comment_2a(contents)
3340
-
return setmetatable({contents}, comment_mt)
4900
+
local function comment_2a(contents, _3fsource)
4901
+
local _let_149_ = (_3fsource or {})
4902
+
local filename = _let_149_["filename"]
4903
+
local line = _let_149_["line"]
4904
+
return setmetatable({filename = filename, line = line, contents}, comment_mt)
3341
4905
end
3342
-
local function varg()
3343
-
return vararg
4906
+
local function varg(_3fsource)
4907
+
local _150_
4908
+
do
4909
+
local tbl_11_auto = {"..."}
4910
+
for k, v in pairs((_3fsource or {})) do
4911
+
local _151_, _152_ = nil, nil
4912
+
if (type(k) == "string") then
4913
+
_151_, _152_ = k, v
4914
+
else
4915
+
_151_, _152_ = nil
4916
+
end
4917
+
if ((nil ~= _151_) and (nil ~= _152_)) then
4918
+
local k_12_auto = _151_
4919
+
local v_13_auto = _152_
4920
+
tbl_11_auto[k_12_auto] = v_13_auto
4921
+
else
4922
+
end
4923
+
end
4924
+
_150_ = tbl_11_auto
4925
+
end
4926
+
return setmetatable(_150_, varg_mt)
3344
4927
end
3345
4928
local function expr_3f(x)
3346
4929
return ((type(x) == "table") and (getmetatable(x) == expr_mt) and x)
3347
4930
end
3348
4931
local function varg_3f(x)
3349
-
return ((x == vararg) and x)
4932
+
return ((type(x) == "table") and (getmetatable(x) == varg_mt) and x)
3350
4933
end
3351
4934
local function list_3f(x)
3352
4935
return ((type(x) == "table") and (getmetatable(x) == list_mt) and x)
···
3354
4937
local function sym_3f(x)
3355
4938
return ((type(x) == "table") and (getmetatable(x) == symbol_mt) and x)
3356
4939
end
3357
-
local function table_3f(x)
3358
-
return ((type(x) == "table") and (x ~= vararg) and (getmetatable(x) ~= list_mt) and (getmetatable(x) ~= symbol_mt) and x)
3359
-
end
3360
4940
local function sequence_3f(x)
3361
4941
local mt = ((type(x) == "table") and getmetatable(x))
3362
4942
return (mt and (mt.sequence == sequence_marker) and x)
···
3364
4944
local function comment_3f(x)
3365
4945
return ((type(x) == "table") and (getmetatable(x) == comment_mt) and x)
3366
4946
end
4947
+
local function table_3f(x)
4948
+
return ((type(x) == "table") and not varg_3f(x) and (getmetatable(x) ~= list_mt) and (getmetatable(x) ~= symbol_mt) and not comment_3f(x) and x)
4949
+
end
4950
+
local function string_3f(x)
4951
+
return (type(x) == "string")
4952
+
end
3367
4953
local function multi_sym_3f(str)
3368
4954
if sym_3f(str) then
3369
4955
return multi_sym_3f(tostring(str))
···
3375
4961
local last_char = part:sub(( - 1))
3376
4962
if (last_char == ":") then
3377
4963
parts["multi-sym-method-call"] = true
4964
+
else
3378
4965
end
3379
4966
if ((last_char == ":") or (last_char == ".")) then
3380
4967
parts[(#parts + 1)] = part:sub(1, ( - 2))
···
3382
4969
parts[(#parts + 1)] = part
3383
4970
end
3384
4971
end
3385
-
return ((#parts > 0) and (str:match("%.") or str:match(":")) and not str:match("%.%.") and (str:byte() ~= string.byte(".")) and (str:byte(( - 1)) ~= string.byte(".")) and parts)
4972
+
return ((0 < #parts) and (str:match("%.") or str:match(":")) and not str:match("%.%.") and (str:byte() ~= string.byte(".")) and (str:byte(( - 1)) ~= string.byte(".")) and parts)
3386
4973
end
3387
4974
end
3388
4975
local function quoted_3f(symbol)
3389
4976
return symbol.quoted
3390
4977
end
3391
-
local function walk_tree(root, f, custom_iterator)
4978
+
local function ast_source(ast)
4979
+
if (table_3f(ast) or sequence_3f(ast)) then
4980
+
return (getmetatable(ast) or {})
4981
+
elseif ("table" == type(ast)) then
4982
+
return ast
4983
+
else
4984
+
return {}
4985
+
end
4986
+
end
4987
+
local function walk_tree(root, f, _3fcustom_iterator)
3392
4988
local function walk(iterfn, parent, idx, node)
3393
4989
if f(idx, node, parent) then
3394
4990
for k, v in iterfn(node) do
3395
4991
walk(iterfn, node, k, v)
3396
4992
end
3397
4993
return nil
4994
+
else
4995
+
return nil
3398
4996
end
3399
4997
end
3400
-
walk((custom_iterator or pairs), nil, nil, root)
4998
+
walk((_3fcustom_iterator or pairs), nil, nil, root)
3401
4999
return root
3402
5000
end
3403
5001
local lua_keywords = {"and", "break", "do", "else", "elseif", "end", "false", "for", "function", "if", "in", "local", "nil", "not", "or", "repeat", "return", "then", "true", "until", "while", "goto"}
···
3414
5012
end
3415
5013
return subopts
3416
5014
end
3417
-
local root = nil
3418
-
local function _1_()
5015
+
local root
5016
+
local function _160_()
3419
5017
end
3420
-
root = {chunk = nil, options = nil, reset = _1_, scope = nil}
3421
-
root["set-reset"] = function(_2_0)
3422
-
local _3_ = _2_0
3423
-
local chunk = _3_["chunk"]
3424
-
local options = _3_["options"]
3425
-
local reset = _3_["reset"]
3426
-
local scope = _3_["scope"]
5018
+
root = {chunk = nil, scope = nil, options = nil, reset = _160_}
5019
+
root["set-reset"] = function(_161_)
5020
+
local _arg_162_ = _161_
5021
+
local chunk = _arg_162_["chunk"]
5022
+
local scope = _arg_162_["scope"]
5023
+
local options = _arg_162_["options"]
5024
+
local reset = _arg_162_["reset"]
3427
5025
root.reset = function()
3428
5026
root.chunk, root.scope, root.options, root.reset = chunk, scope, options, reset
3429
5027
return nil
3430
5028
end
3431
5029
return root.reset
3432
5030
end
3433
-
local function hook(event, ...)
3434
-
if (root.options and root.options.plugins) then
3435
-
for _, plugin in ipairs(root.options.plugins) do
3436
-
local _3_0 = plugin[event]
3437
-
if (nil ~= _3_0) then
3438
-
local f = _3_0
3439
-
f(...)
5031
+
local warned = {}
5032
+
local function check_plugin_version(_163_)
5033
+
local _arg_164_ = _163_
5034
+
local name = _arg_164_["name"]
5035
+
local versions = _arg_164_["versions"]
5036
+
local plugin = _arg_164_
5037
+
if (not member_3f(version:gsub("-dev", ""), (versions or {})) and not warned[plugin]) then
5038
+
warned[plugin] = true
5039
+
return warn(string.format("plugin %s does not support Fennel version %s", (name or "unknown"), version))
5040
+
else
5041
+
return nil
5042
+
end
5043
+
end
5044
+
local function hook_opts(event, _3foptions, ...)
5045
+
local plugins
5046
+
local function _167_(...)
5047
+
local t_166_ = _3foptions
5048
+
if (nil ~= t_166_) then
5049
+
t_166_ = (t_166_).plugins
5050
+
else
5051
+
end
5052
+
return t_166_
5053
+
end
5054
+
local function _170_(...)
5055
+
local t_169_ = root.options
5056
+
if (nil ~= t_169_) then
5057
+
t_169_ = (t_169_).plugins
5058
+
else
5059
+
end
5060
+
return t_169_
5061
+
end
5062
+
plugins = (_167_(...) or _170_(...))
5063
+
if plugins then
5064
+
local result = nil
5065
+
for _, plugin in ipairs(plugins) do
5066
+
if result then break end
5067
+
check_plugin_version(plugin)
5068
+
local _172_ = plugin[event]
5069
+
if (nil ~= _172_) then
5070
+
local f = _172_
5071
+
result = f(...)
5072
+
else
5073
+
result = nil
3440
5074
end
3441
5075
end
5076
+
return result
5077
+
else
3442
5078
return nil
3443
5079
end
3444
5080
end
3445
-
return {["comment?"] = comment_3f, ["debug-on?"] = debug_on_3f, ["expr?"] = expr_3f, ["list?"] = list_3f, ["lua-keywords"] = lua_keywords, ["member?"] = member_3f, ["multi-sym?"] = multi_sym_3f, ["propagate-options"] = propagate_options, ["quoted?"] = quoted_3f, ["sequence?"] = sequence_3f, ["sym?"] = sym_3f, ["table?"] = table_3f, ["valid-lua-identifier?"] = valid_lua_identifier_3f, ["varg?"] = varg_3f, ["walk-tree"] = walk_tree, allpairs = allpairs, comment = comment_2a, copy = copy, deref = deref, expr = expr, hook = hook, kvmap = kvmap, list = list, map = map, path = table.concat({"./?.fnl", "./?/init.fnl", getenv("FENNEL_PATH")}, ";"), root = root, sequence = sequence, stablepairs = stablepairs, sym = sym, varg = varg}
5081
+
local function hook(event, ...)
5082
+
return hook_opts(event, root.options, ...)
5083
+
end
5084
+
return {warn = warn, allpairs = allpairs, stablepairs = stablepairs, copy = copy, ["get-in"] = get_in, kvmap = kvmap, map = map, ["walk-tree"] = walk_tree, ["member?"] = member_3f, list = list, sequence = sequence, sym = sym, varg = varg, expr = expr, comment = comment_2a, ["comment?"] = comment_3f, ["expr?"] = expr_3f, ["list?"] = list_3f, ["multi-sym?"] = multi_sym_3f, ["sequence?"] = sequence_3f, ["sym?"] = sym_3f, ["table?"] = table_3f, ["varg?"] = varg_3f, ["quoted?"] = quoted_3f, ["string?"] = string_3f, ["valid-lua-identifier?"] = valid_lua_identifier_3f, ["lua-keywords"] = lua_keywords, hook = hook, ["hook-opts"] = hook_opts, ["propagate-options"] = propagate_options, root = root, ["debug-on?"] = debug_on_3f, ["ast-source"] = ast_source, version = version, ["runtime-version"] = runtime_version, len = len, path = table.concat({"./?.fnl", "./?/init.fnl", getenv("FENNEL_PATH")}, ";"), ["macro-path"] = table.concat({"./?.fnl", "./?/init-macros.fnl", "./?/init.fnl", getenv("FENNEL_MACRO_PATH")}, ";")}
3446
5085
end
3447
5086
utils = require("fennel.utils")
3448
5087
local parser = require("fennel.parser")
···
3450
5089
local specials = require("fennel.specials")
3451
5090
local repl = require("fennel.repl")
3452
5091
local view = require("fennel.view")
3453
-
local function get_env(env)
5092
+
local function eval_env(env, opts)
3454
5093
if (env == "_COMPILER") then
3455
-
local env0 = specials["make-compiler-env"](nil, compiler.scopes.compiler, {})
3456
-
local mt = getmetatable(env0)
3457
-
mt.__index = _G
5094
+
local env0 = specials["make-compiler-env"](nil, compiler.scopes.compiler, {}, opts)
5095
+
if (opts.allowedGlobals == nil) then
5096
+
opts.allowedGlobals = specials["current-global-names"](env0)
5097
+
else
5098
+
end
3458
5099
return specials["wrap-env"](env0)
3459
5100
else
3460
5101
return (env and specials["wrap-env"](env))
3461
5102
end
3462
5103
end
3463
-
local function eval(str, options, ...)
5104
+
local function eval_opts(options, str)
3464
5105
local opts = utils.copy(options)
3465
-
local _ = nil
3466
-
if ((opts.allowedGlobals == nil) and not getmetatable(opts.env)) then
5106
+
if (opts.allowedGlobals == nil) then
3467
5107
opts.allowedGlobals = specials["current-global-names"](opts.env)
3468
-
_ = nil
3469
5108
else
3470
-
_ = nil
3471
5109
end
3472
-
local env = get_env(opts.env)
5110
+
if (not opts.filename and not opts.source) then
5111
+
opts.source = str
5112
+
else
5113
+
end
5114
+
if (opts.env == "_COMPILER") then
5115
+
opts.scope = compiler["make-scope"](compiler.scopes.compiler)
5116
+
else
5117
+
end
5118
+
return opts
5119
+
end
5120
+
local function eval(str, options, ...)
5121
+
local opts = eval_opts(options, str)
5122
+
local env = eval_env(opts.env, opts)
3473
5123
local lua_source = compiler["compile-string"](str, opts)
3474
-
local loader = nil
3475
-
local function _1_(...)
5124
+
local loader
5125
+
local function _735_(...)
3476
5126
if opts.filename then
3477
5127
return ("@" .. opts.filename)
3478
5128
else
3479
5129
return str
3480
5130
end
3481
5131
end
3482
-
loader = specials["load-code"](lua_source, env, _1_(...))
5132
+
loader = specials["load-code"](lua_source, env, _735_(...))
3483
5133
opts.filename = nil
3484
5134
return loader(...)
3485
5135
end
···
3491
5141
opts.filename = filename
3492
5142
return eval(source, opts, ...)
3493
5143
end
3494
-
local mod = {["compile-stream"] = compiler["compile-stream"], ["compile-string"] = compiler["compile-string"], ["list?"] = utils["list?"], ["load-code"] = specials["load-code"], ["macro-loaded"] = specials["macro-loaded"], ["make-searcher"] = specials["make-searcher"], ["search-module"] = specials["search-module"], ["sequence?"] = utils["sequence?"], ["string-stream"] = parser["string-stream"], ["sym-char?"] = parser["sym-char?"], ["sym?"] = utils["sym?"], compile = compiler.compile, compile1 = compiler.compile1, compileStream = compiler["compile-stream"], compileString = compiler["compile-string"], doc = specials.doc, dofile = dofile_2a, eval = eval, gensym = compiler.gensym, granulate = parser.granulate, list = utils.list, loadCode = specials["load-code"], macroLoaded = specials["macro-loaded"], makeSearcher = specials["make-searcher"], make_searcher = specials["make-searcher"], mangle = compiler["global-mangling"], metadata = compiler.metadata, parser = parser.parser, path = utils.path, repl = repl, scope = compiler["make-scope"], searchModule = specials["search-module"], searcher = specials["make-searcher"](), sequence = utils.sequence, stringStream = parser["string-stream"], sym = utils.sym, traceback = compiler.traceback, unmangle = compiler["global-unmangling"], varg = utils.varg, version = "0.8.0", view = view}
5144
+
local function syntax()
5145
+
local body_3f = {"when", "with-open", "collect", "icollect", "fcollect", "lambda", "\206\187", "macro", "match", "match-try", "accumulate", "doto"}
5146
+
local binding_3f = {"collect", "icollect", "fcollect", "each", "for", "let", "with-open", "accumulate"}
5147
+
local define_3f = {"fn", "lambda", "\206\187", "var", "local", "macro", "macros", "global"}
5148
+
local out = {}
5149
+
for k, v in pairs(compiler.scopes.global.specials) do
5150
+
local metadata = (compiler.metadata[v] or {})
5151
+
do end (out)[k] = {["special?"] = true, ["body-form?"] = metadata["fnl/body-form?"], ["binding-form?"] = utils["member?"](k, binding_3f), ["define?"] = utils["member?"](k, define_3f)}
5152
+
end
5153
+
for k, v in pairs(compiler.scopes.global.macros) do
5154
+
out[k] = {["macro?"] = true, ["body-form?"] = utils["member?"](k, body_3f), ["binding-form?"] = utils["member?"](k, binding_3f), ["define?"] = utils["member?"](k, define_3f)}
5155
+
end
5156
+
for k, v in pairs(_G) do
5157
+
local _736_ = type(v)
5158
+
if (_736_ == "function") then
5159
+
out[k] = {["global?"] = true, ["function?"] = true}
5160
+
elseif (_736_ == "table") then
5161
+
for k2, v2 in pairs(v) do
5162
+
if (("function" == type(v2)) and (k ~= "_G")) then
5163
+
out[(k .. "." .. k2)] = {["function?"] = true, ["global?"] = true}
5164
+
else
5165
+
end
5166
+
end
5167
+
out[k] = {["global?"] = true}
5168
+
else
5169
+
end
5170
+
end
5171
+
return out
5172
+
end
5173
+
local mod = {list = utils.list, ["list?"] = utils["list?"], sym = utils.sym, ["sym?"] = utils["sym?"], ["multi-sym?"] = utils["multi-sym?"], sequence = utils.sequence, ["sequence?"] = utils["sequence?"], ["table?"] = utils["table?"], comment = utils.comment, ["comment?"] = utils["comment?"], varg = utils.varg, ["varg?"] = utils["varg?"], ["sym-char?"] = parser["sym-char?"], parser = parser.parser, compile = compiler.compile, ["compile-string"] = compiler["compile-string"], ["compile-stream"] = compiler["compile-stream"], eval = eval, repl = repl, view = view, dofile = dofile_2a, ["load-code"] = specials["load-code"], doc = specials.doc, metadata = compiler.metadata, traceback = compiler.traceback, version = utils.version, ["runtime-version"] = utils["runtime-version"], ["ast-source"] = utils["ast-source"], path = utils.path, ["macro-path"] = utils["macro-path"], ["macro-loaded"] = specials["macro-loaded"], ["macro-searchers"] = specials["macro-searchers"], ["search-module"] = specials["search-module"], ["make-searcher"] = specials["make-searcher"], searcher = specials["make-searcher"](), syntax = syntax, gensym = compiler.gensym, scope = compiler["make-scope"], mangle = compiler["global-mangling"], unmangle = compiler["global-unmangling"], compile1 = compiler.compile1, ["string-stream"] = parser["string-stream"], granulate = parser.granulate, loadCode = specials["load-code"], make_searcher = specials["make-searcher"], makeSearcher = specials["make-searcher"], searchModule = specials["search-module"], macroPath = utils["macro-path"], macroSearchers = specials["macro-searchers"], macroLoaded = specials["macro-loaded"], compileStream = compiler["compile-stream"], compileString = compiler["compile-string"], stringStream = parser["string-stream"], runtimeVersion = utils["runtime-version"]}
5174
+
mod.install = function(_3fopts)
5175
+
table.insert((package.searchers or package.loaders), specials["make-searcher"](_3fopts))
5176
+
return mod
5177
+
end
3495
5178
utils["fennel-module"] = mod
3496
5179
do
3497
-
local builtin_macros = [===[;; This module contains all the built-in Fennel macros. Unlike all the other
3498
-
;; modules that are loaded by the old bootstrap compiler, this runs in the
3499
-
;; compiler scope of the version of the compiler being defined.
5180
+
local builtin_macros = [===[;; These macros are awkward because their definition cannot rely on the any
5181
+
;; built-in macros, only special forms. (no when, no icollect, etc)
3500
5182
3501
-
;; The code for these macros is somewhat idiosyncratic because it cannot use any
3502
-
;; macros which have not yet been defined.
3503
-
3504
-
;; TODO: some of these macros modify their arguments; we should stop doing that,
3505
-
;; but in a way that preserves file/line metadata.
5183
+
(fn copy [t]
5184
+
(let [out []]
5185
+
(each [_ v (ipairs t)] (table.insert out v))
5186
+
(setmetatable out (getmetatable t))))
3506
5187
3507
-
(fn -> [val ...]
5188
+
(fn ->* [val ...]
3508
5189
"Thread-first macro.
3509
5190
Take the first value and splice it into the second form as its first argument.
3510
5191
The value of the second form is spliced into the first arg of the third, etc."
3511
5192
(var x val)
3512
5193
(each [_ e (ipairs [...])]
3513
-
(let [elt (if (list? e) e (list e))]
5194
+
(let [elt (if (list? e) (copy e) (list e))]
3514
5195
(table.insert elt 2 x)
3515
5196
(set x elt)))
3516
5197
x)
3517
5198
3518
-
(fn ->> [val ...]
5199
+
(fn ->>* [val ...]
3519
5200
"Thread-last macro.
3520
5201
Same as ->, except splices the value into the last position of each form
3521
5202
rather than the first."
3522
5203
(var x val)
3523
-
(each [_ e (pairs [...])]
3524
-
(let [elt (if (list? e) e (list e))]
5204
+
(each [_ e (ipairs [...])]
5205
+
(let [elt (if (list? e) (copy e) (list e))]
3525
5206
(table.insert elt x)
3526
5207
(set x elt)))
3527
5208
x)
3528
5209
3529
-
(fn -?> [val ...]
5210
+
(fn -?>* [val ?e ...]
3530
5211
"Nil-safe thread-first macro.
3531
5212
Same as -> except will short-circuit with nil when it encounters a nil value."
3532
-
(if (= 0 (select "#" ...))
5213
+
(if (= nil ?e)
3533
5214
val
3534
-
(let [els [...]
3535
-
e (table.remove els 1)
3536
-
el (if (list? e) e (list e))
5215
+
(let [el (if (list? ?e) (copy ?e) (list ?e))
3537
5216
tmp (gensym)]
3538
5217
(table.insert el 2 tmp)
3539
5218
`(let [,tmp ,val]
3540
-
(if ,tmp
3541
-
(-?> ,el ,(unpack els))
5219
+
(if (not= nil ,tmp)
5220
+
(-?> ,el ,...)
3542
5221
,tmp)))))
3543
5222
3544
-
(fn -?>> [val ...]
5223
+
(fn -?>>* [val ?e ...]
3545
5224
"Nil-safe thread-last macro.
3546
5225
Same as ->> except will short-circuit with nil when it encounters a nil value."
3547
-
(if (= 0 (select "#" ...))
5226
+
(if (= nil ?e)
3548
5227
val
3549
-
(let [els [...]
3550
-
e (table.remove els 1)
3551
-
el (if (list? e) e (list e))
5228
+
(let [el (if (list? ?e) (copy ?e) (list ?e))
3552
5229
tmp (gensym)]
3553
5230
(table.insert el tmp)
3554
5231
`(let [,tmp ,val]
3555
-
(if ,tmp
3556
-
(-?>> ,el ,(unpack els))
5232
+
(if (not= ,tmp nil)
5233
+
(-?>> ,el ,...)
3557
5234
,tmp)))))
3558
5235
3559
-
(fn doto [val ...]
3560
-
"Evaluates val and splices it into the first argument of subsequent forms."
3561
-
(let [name (gensym)
3562
-
form `(let [,name ,val])]
3563
-
(each [_ elt (pairs [...])]
3564
-
(table.insert elt 2 name)
3565
-
(table.insert form elt))
5236
+
(fn ?dot [tbl ...]
5237
+
"Nil-safe table look up.
5238
+
Same as . (dot), except will short-circuit with nil when it encounters
5239
+
a nil value in any of subsequent keys."
5240
+
(let [head (gensym :t)
5241
+
lookups `(do
5242
+
(var ,head ,tbl)
5243
+
,head)]
5244
+
(each [_ k (ipairs [...])]
5245
+
;; Kinda gnarly to reassign in place like this, but it emits the best lua.
5246
+
;; With this impl, it emits a flat, concise, and readable set of ifs
5247
+
(table.insert lookups (# lookups) `(if (not= nil ,head)
5248
+
(set ,head (. ,head ,k)))))
5249
+
lookups))
5250
+
5251
+
(fn doto* [val ...]
5252
+
"Evaluate val and splice it into the first argument of subsequent forms."
5253
+
(assert (not= val nil) "missing subject")
5254
+
(let [rebind? (or (not (sym? val))
5255
+
(multi-sym? val))
5256
+
name (if rebind? (gensym) val)
5257
+
form (if rebind? `(let [,name ,val]) `(do))]
5258
+
(each [_ elt (ipairs [...])]
5259
+
(let [elt (if (list? elt) (copy elt) (list elt))]
5260
+
(table.insert elt 2 name)
5261
+
(table.insert form elt)))
3566
5262
(table.insert form name)
3567
5263
form))
3568
5264
3569
-
(fn when [condition body1 ...]
5265
+
(fn when* [condition body1 ...]
3570
5266
"Evaluate body for side-effects only when condition is truthy."
3571
5267
(assert body1 "expected body")
3572
5268
`(if ,condition
3573
-
(do ,body1 ,...)))
5269
+
(do
5270
+
,body1
5271
+
,...)))
3574
5272
3575
-
(fn with-open [closable-bindings ...]
5273
+
(fn with-open* [closable-bindings ...]
3576
5274
"Like `let`, but invokes (v:close) on each binding after evaluating the body.
3577
5275
The body is evaluated inside `xpcall` so that bound values will be closed upon
3578
5276
encountering an error before propagating it."
3579
-
(let [bodyfn `(fn [] ,...)
3580
-
closer `(fn close-handlers# [ok# ...] (if ok# ...
3581
-
(error ... 0)))
5277
+
(let [bodyfn `(fn []
5278
+
,...)
5279
+
closer `(fn close-handlers# [ok# ...]
5280
+
(if ok# ... (error ... 0)))
3582
5281
traceback `(. (or package.loaded.fennel debug) :traceback)]
3583
-
(for [i 1 (# closable-bindings) 2]
5282
+
(for [i 1 (length closable-bindings) 2]
3584
5283
(assert (sym? (. closable-bindings i))
3585
5284
"with-open only allows symbols in bindings")
3586
5285
(table.insert closer 4 `(: ,(. closable-bindings i) :close)))
3587
-
`(let ,closable-bindings ,closer
3588
-
(close-handlers# (xpcall ,bodyfn ,traceback)))))
5286
+
`(let ,closable-bindings
5287
+
,closer
5288
+
(close-handlers# (_G.xpcall ,bodyfn ,traceback)))))
3589
5289
3590
-
(fn collect [iter-tbl key-value-expr ...]
3591
-
"Returns a table made by running an iterator and evaluating an expression
3592
-
that returns key-value pairs to be inserted sequentially into the table.
3593
-
This can be thought of as a \"table comprehension\". The provided key-value
3594
-
expression must return either 2 values, or nil.
5290
+
(fn extract-into [iter-tbl]
5291
+
(var (into iter-out found?) (values [] (copy iter-tbl)))
5292
+
(for [i (length iter-tbl) 2 -1]
5293
+
(let [item (. iter-tbl i)]
5294
+
(if (or (= `&into item)
5295
+
(= :into item))
5296
+
(do
5297
+
(assert (not found?) "expected only one &into clause")
5298
+
(set found? true)
5299
+
(set into (. iter-tbl (+ i 1)))
5300
+
(table.remove iter-out i)
5301
+
(table.remove iter-out i)))))
5302
+
(assert (or (not found?) (sym? into) (table? into) (list? into))
5303
+
"expected table, function call, or symbol in &into clause")
5304
+
(values into iter-out))
5305
+
5306
+
(fn collect* [iter-tbl key-expr value-expr ...]
5307
+
"Return a table made by running an iterator and evaluating an expression that
5308
+
returns key-value pairs to be inserted sequentially into the table. This can
5309
+
be thought of as a table comprehension. The body should provide two expressions
5310
+
(used as key and value) or nil, which causes it to be omitted.
3595
5311
3596
5312
For example,
3597
5313
(collect [k v (pairs {:apple \"red\" :orange \"orange\"})]
3598
5314
(values v k))
3599
5315
returns
3600
-
{:red \"apple\" :orange \"orange\"}"
3601
-
(assert (and (sequence? iter-tbl) (>= (length iter-tbl) 2))
5316
+
{:red \"apple\" :orange \"orange\"}
5317
+
5318
+
Supports an &into clause after the iterator to put results in an existing table.
5319
+
Supports early termination with an &until clause."
5320
+
(assert (and (sequence? iter-tbl) (<= 2 (length iter-tbl)))
3602
5321
"expected iterator binding table")
3603
-
(assert (not= nil key-value-expr)
3604
-
"expected key-value expression")
5322
+
(assert (not= nil key-expr) "expected key and value expression")
5323
+
(assert (= nil ...)
5324
+
"expected 1 or 2 body expressions; wrap multiple expressions with do")
5325
+
(let [kv-expr (if (= nil value-expr) key-expr `(values ,key-expr ,value-expr))
5326
+
(into iter) (extract-into iter-tbl)]
5327
+
`(let [tbl# ,into]
5328
+
(each ,iter
5329
+
(match ,kv-expr
5330
+
(k# v#) (tset tbl# k# v#)))
5331
+
tbl#)))
5332
+
5333
+
(fn seq-collect [how iter-tbl value-expr ...]
5334
+
"Common part between icollect and fcollect for producing sequential tables.
5335
+
5336
+
Iteration code only deffers in using the for or each keyword, the rest
5337
+
of the generated code is identical."
5338
+
(assert (not= nil value-expr) "expected table value expression")
3605
5339
(assert (= nil ...)
3606
-
"expected exactly one body expression. Wrap multiple expressions with do")
3607
-
`(let [tbl# {}]
3608
-
(each ,iter-tbl
3609
-
(match ,key-value-expr
3610
-
(k# v#) (tset tbl# k# v#)))
3611
-
tbl#))
5340
+
"expected exactly one body expression. Wrap multiple expressions in do")
5341
+
(let [(into iter) (extract-into iter-tbl)]
5342
+
`(let [tbl# ,into]
5343
+
;; believe it or not, using a var here has a pretty good performance
5344
+
;; boost: https://p.hagelb.org/icollect-performance.html
5345
+
(var i# (length tbl#))
5346
+
(,how ,iter
5347
+
(let [val# ,value-expr]
5348
+
(when (not= nil val#)
5349
+
(set i# (+ i# 1))
5350
+
(tset tbl# i# val#))))
5351
+
tbl#)))
3612
5352
3613
-
(fn icollect [iter-tbl value-expr ...]
3614
-
"Returns a sequential table made by running an iterator and evaluating an
5353
+
(fn icollect* [iter-tbl value-expr ...]
5354
+
"Return a sequential table made by running an iterator and evaluating an
3615
5355
expression that returns values to be inserted sequentially into the table.
3616
-
This can be thought of as a \"list comprehension\".
5356
+
This can be thought of as a table comprehension. If the body evaluates to nil
5357
+
that element is omitted.
3617
5358
3618
5359
For example,
3619
-
(icollect [_ v (ipairs [1 2 3 4 5])] (when (> v 2) (* v v)))
5360
+
(icollect [_ v (ipairs [1 2 3 4 5])]
5361
+
(when (not= v 3)
5362
+
(* v v)))
3620
5363
returns
3621
-
[9 16 25]"
3622
-
(assert (and (sequence? iter-tbl) (>= (length iter-tbl) 2))
5364
+
[1 4 16 25]
5365
+
5366
+
Supports an &into clause after the iterator to put results in an existing table.
5367
+
Supports early termination with an &until clause."
5368
+
(assert (and (sequence? iter-tbl) (<= 2 (length iter-tbl)))
3623
5369
"expected iterator binding table")
3624
-
(assert (not= nil value-expr)
3625
-
"expected table value expression")
5370
+
(seq-collect 'each iter-tbl value-expr ...))
5371
+
5372
+
(fn fcollect* [iter-tbl value-expr ...]
5373
+
"Return a sequential table made by advancing a range as specified by
5374
+
for, and evaluating an expression that returns values to be inserted
5375
+
sequentially into the table. This can be thought of as a range
5376
+
comprehension. If the body evaluates to nil that element is omitted.
5377
+
5378
+
For example,
5379
+
(fcollect [i 1 10 2]
5380
+
(when (not= i 3)
5381
+
(* i i)))
5382
+
returns
5383
+
[1 25 49 81]
5384
+
5385
+
Supports an &into clause after the range to put results in an existing table.
5386
+
Supports early termination with an &until clause."
5387
+
(assert (and (sequence? iter-tbl) (< 2 (length iter-tbl)))
5388
+
"expected range binding table")
5389
+
(seq-collect 'for iter-tbl value-expr ...))
5390
+
5391
+
(fn accumulate* [iter-tbl body ...]
5392
+
"Accumulation macro.
5393
+
5394
+
It takes a binding table and an expression as its arguments. In the binding
5395
+
table, the first form starts out bound to the second value, which is an initial
5396
+
accumulator. The rest are an iterator binding table in the format `each` takes.
5397
+
5398
+
It runs through the iterator in each step of which the given expression is
5399
+
evaluated, and the accumulator is set to the value of the expression. It
5400
+
eventually returns the final value of the accumulator.
5401
+
5402
+
For example,
5403
+
(accumulate [total 0
5404
+
_ n (pairs {:apple 2 :orange 3})]
5405
+
(+ total n))
5406
+
returns 5"
5407
+
(assert (and (sequence? iter-tbl) (<= 4 (length iter-tbl)))
5408
+
"expected initial value and iterator binding table")
5409
+
(assert (not= nil body) "expected body expression")
3626
5410
(assert (= nil ...)
3627
5411
"expected exactly one body expression. Wrap multiple expressions with do")
3628
-
`(let [tbl# []]
3629
-
(each ,iter-tbl
3630
-
(tset tbl# (+ (length tbl#) 1) ,value-expr))
3631
-
tbl#))
5412
+
(let [accum-var (. iter-tbl 1)
5413
+
accum-init (. iter-tbl 2)]
5414
+
`(do
5415
+
(var ,accum-var ,accum-init)
5416
+
(each ,[(unpack iter-tbl 3)]
5417
+
(set ,accum-var ,body))
5418
+
,(if (list? accum-var)
5419
+
(list (sym :values) (unpack accum-var))
5420
+
accum-var))))
3632
5421
3633
-
(fn partial [f ...]
3634
-
"Returns a function with all arguments partially applied to f."
3635
-
(let [body (list f ...)]
3636
-
(table.insert body _VARARG)
3637
-
`(fn [,_VARARG] ,body)))
5422
+
(fn double-eval-safe? [x type]
5423
+
(or (= :number type) (= :string type) (= :boolean type)
5424
+
(and (sym? x) (not (multi-sym? x)))))
3638
5425
3639
-
(fn pick-args [n f]
3640
-
"Creates a function of arity n that applies its arguments to f.
5426
+
(fn partial* [f ...]
5427
+
"Return a function with all arguments partially applied to f."
5428
+
(assert f "expected a function to partially apply")
5429
+
(let [bindings []
5430
+
args []]
5431
+
(each [_ arg (ipairs [...])]
5432
+
(if (double-eval-safe? arg (type arg))
5433
+
(table.insert args arg)
5434
+
(let [name (gensym)]
5435
+
(table.insert bindings name)
5436
+
(table.insert bindings arg)
5437
+
(table.insert args name))))
5438
+
(let [body (list f (unpack args))]
5439
+
(table.insert body _VARARG)
5440
+
;; only use the extra let if we need double-eval protection
5441
+
(if (= 0 (length bindings))
5442
+
`(fn [,_VARARG] ,body)
5443
+
`(let ,bindings
5444
+
(fn [,_VARARG] ,body))))))
5445
+
5446
+
(fn pick-args* [n f]
5447
+
"Create a function of arity n that applies its arguments to f.
3641
5448
3642
5449
For example,
3643
5450
(pick-args 2 func)
3644
5451
expands to
3645
5452
(fn [_0_ _1_] (func _0_ _1_))"
3646
-
(assert (and (= (type n) :number) (= n (math.floor n)) (>= n 0))
3647
-
"Expected n to be an integer literal >= 0.")
5453
+
(if (and _G.io _G.io.stderr)
5454
+
(_G.io.stderr:write
5455
+
"-- WARNING: pick-args is deprecated and will be removed in the future.\n"))
5456
+
(assert (and (= (type n) :number) (= n (math.floor n)) (<= 0 n))
5457
+
(.. "Expected n to be an integer literal >= 0, got " (tostring n)))
3648
5458
(let [bindings []]
3649
-
(for [i 1 n] (tset bindings i (gensym)))
3650
-
`(fn ,bindings (,f ,(unpack bindings)))))
5459
+
(for [i 1 n]
5460
+
(tset bindings i (gensym)))
5461
+
`(fn ,bindings
5462
+
(,f ,(unpack bindings)))))
3651
5463
3652
-
(fn pick-values [n ...]
3653
-
"Like the `values` special, but emits exactly n values.
5464
+
(fn pick-values* [n ...]
5465
+
"Evaluate to exactly n values.
3654
5466
3655
5467
For example,
3656
5468
(pick-values 2 ...)
3657
5469
expands to
3658
5470
(let [(_0_ _1_) ...]
3659
5471
(values _0_ _1_))"
3660
-
(assert (and (= :number (type n)) (>= n 0) (= n (math.floor n)))
3661
-
"Expected n to be an integer >= 0")
3662
-
(let [let-syms (list)
3663
-
let-values (if (= 1 (select :# ...)) ... `(values ,...))]
3664
-
(for [i 1 n] (table.insert let-syms (gensym)))
5472
+
(assert (and (= :number (type n)) (<= 0 n) (= n (math.floor n)))
5473
+
(.. "Expected n to be an integer >= 0, got " (tostring n)))
5474
+
(let [let-syms (list)
5475
+
let-values (if (= 1 (select "#" ...)) ... `(values ,...))]
5476
+
(for [i 1 n]
5477
+
(table.insert let-syms (gensym)))
3665
5478
(if (= n 0) `(values)
3666
-
`(let [,let-syms ,let-values] (values ,(unpack let-syms))))))
5479
+
`(let [,let-syms ,let-values]
5480
+
(values ,(unpack let-syms))))))
3667
5481
3668
-
(fn lambda [...]
3669
-
"Function literal with arity checking.
3670
-
Will throw an exception if a declared argument is passed in as nil, unless
3671
-
that argument name begins with ?."
5482
+
(fn lambda* [...]
5483
+
"Function literal with nil-checked arguments.
5484
+
Like `fn`, but will throw an exception if a declared argument is passed in as
5485
+
nil, unless that argument's name begins with a question mark."
3672
5486
(let [args [...]
3673
5487
has-internal-name? (sym? (. args 1))
3674
5488
arglist (if has-internal-name? (. args 2) (. args 1))
3675
5489
docstring-position (if has-internal-name? 3 2)
3676
-
has-docstring? (and (> (# args) docstring-position)
5490
+
has-docstring? (and (< docstring-position (length args))
3677
5491
(= :string (type (. args docstring-position))))
3678
5492
arity-check-position (- 4 (if has-internal-name? 0 1)
3679
5493
(if has-docstring? 0 1))
3680
-
empty-body? (< (# args) arity-check-position)]
5494
+
empty-body? (< (length args) arity-check-position)]
3681
5495
(fn check! [a]
3682
5496
(if (table? a)
3683
5497
(each [_ a (pairs a)]
3684
5498
(check! a))
3685
5499
(let [as (tostring a)]
3686
-
(and (not (as:match "^?")) (not= as "&") (not= as "_") (not= as "...")))
5500
+
(and (not (as:match "^?")) (not= as "&") (not= as "_")
5501
+
(not= as "...") (not= as "&as")))
3687
5502
(table.insert args arity-check-position
3688
-
`(assert (not= nil ,a)
3689
-
(string.format "Missing argument %s on %s:%s"
3690
-
,(tostring a)
3691
-
,(or a.filename "unknown")
3692
-
,(or a.line "?"))))))
5503
+
`(_G.assert (not= nil ,a)
5504
+
,(: "Missing argument %s on %s:%s" :format
5505
+
(tostring a)
5506
+
(or a.filename :unknown)
5507
+
(or a.line "?"))))))
5508
+
3693
5509
(assert (= :table (type arglist)) "expected arg list")
3694
5510
(each [_ a (ipairs arglist)]
3695
5511
(check! a))
···
3697
5513
(table.insert args (sym :nil)))
3698
5514
`(fn ,(unpack args))))
3699
5515
3700
-
(fn macro [name ...]
5516
+
(fn macro* [name ...]
3701
5517
"Define a single macro."
3702
5518
(assert (sym? name) "expected symbol for macro name")
3703
5519
(local args [...])
3704
-
`(macros { ,(tostring name) (fn ,(unpack args))}))
5520
+
`(macros {,(tostring name) (fn ,(unpack args))}))
3705
5521
3706
-
(fn macrodebug [form return?]
5522
+
(fn macrodebug* [form return?]
3707
5523
"Print the resulting form after performing macroexpansion.
3708
5524
With a second argument, returns expanded form as a string instead of printing."
3709
5525
(let [handle (if return? `do `print)]
3710
5526
`(,handle ,(view (macroexpand form _SCOPE)))))
3711
5527
3712
-
(fn import-macros [binding1 module-name1 ...]
3713
-
"Binds a table of macros from each macro module according to a binding form.
5528
+
(fn import-macros* [binding1 module-name1 ...]
5529
+
"Bind a table of macros from each macro module according to a binding form.
3714
5530
Each binding form can be either a symbol or a k/v destructuring table.
3715
5531
Example:
3716
5532
(import-macros mymacros :my-macros ; bind to symbol
3717
5533
{:macro1 alias : macro2} :proj.macros) ; import by name"
3718
-
(assert (and binding1 module-name1 (= 0 (% (select :# ...) 2)))
5534
+
(assert (and binding1 module-name1 (= 0 (% (select "#" ...) 2)))
3719
5535
"expected even number of binding/modulename pairs")
3720
-
(for [i 1 (select :# binding1 module-name1 ...) 2]
5536
+
(for [i 1 (select "#" binding1 module-name1 ...) 2]
5537
+
;; delegate the actual loading of the macros to the require-macros
5538
+
;; special which already knows how to set up the compiler env and stuff.
5539
+
;; this is weird because require-macros is deprecated but it works.
3721
5540
(let [(binding modname) (select i binding1 module-name1 ...)
3722
-
;; generate a subscope of current scope, use require-macros
3723
-
;; to bring in macro module. after that, we just copy the
3724
-
;; macros from subscope to scope.
3725
5541
scope (get-scope)
3726
-
subscope (fennel.scope scope)]
3727
-
(_SPECIALS.require-macros `(require-macros ,modname) subscope {} ast)
5542
+
;; if the module-name is an expression (and not just a string) we
5543
+
;; patch our expression to have the correct source filename so
5544
+
;; require-macros can pass it down when resolving the module-name.
5545
+
expr `(import-macros ,modname)
5546
+
filename (if (list? modname) (. modname 1 :filename) :unknown)
5547
+
_ (tset expr :filename filename)
5548
+
macros* (_SPECIALS.require-macros expr scope {} binding)]
3728
5549
(if (sym? binding)
3729
5550
;; bind whole table of macros to table bound to symbol
3730
-
(do (tset scope.macros (. binding 1) {})
3731
-
(each [k v (pairs subscope.macros)]
3732
-
(tset (. scope.macros (. binding 1)) k v)))
3733
-
5551
+
(tset scope.macros (. binding 1) macros*)
3734
5552
;; 1-level table destructuring for importing individual macros
3735
5553
(table? binding)
3736
5554
(each [macro-name [import-key] (pairs binding)]
3737
-
(assert (= :function (type (. subscope.macros macro-name)))
5555
+
(assert (= :function (type (. macros* macro-name)))
3738
5556
(.. "macro " macro-name " not found in module "
3739
5557
(tostring modname)))
3740
-
(tset scope.macros import-key (. subscope.macros macro-name))))))
5558
+
(tset scope.macros import-key (. macros* macro-name))))))
3741
5559
nil)
3742
5560
3743
5561
;;; Pattern matching
···
3754
5572
(values condition bindings)))
3755
5573
3756
5574
(fn match-table [val pattern unifications match-pattern]
3757
-
(let [condition `(and (= (type ,val) :table))
5575
+
(let [condition `(and (= (_G.type ,val) :table))
3758
5576
bindings []]
3759
5577
(each [k pat (pairs pattern)]
3760
-
(if (and (sym? pat) (= "&" (tostring pat)))
3761
-
(do (assert (not (. pattern (+ k 2)))
3762
-
"expected rest argument before last parameter")
3763
-
(table.insert bindings (. pattern (+ k 1)))
3764
-
(table.insert bindings [`(select ,k ((or table.unpack
3765
-
_G.unpack)
3766
-
,val))]))
3767
-
(and (= :number (type k))
3768
-
(= "&" (tostring (. pattern (- k 1)))))
3769
-
nil ; don't process the pattern right after &; already got it
5578
+
(if (= pat `&)
5579
+
(let [rest-pat (. pattern (+ k 1))
5580
+
rest-val `(select ,k ((or table.unpack _G.unpack) ,val))
5581
+
subcondition (match-table `(pick-values 1 ,rest-val)
5582
+
rest-pat unifications match-pattern)]
5583
+
(if (not (sym? rest-pat))
5584
+
(table.insert condition subcondition))
5585
+
(assert (= nil (. pattern (+ k 2)))
5586
+
"expected & rest argument before last parameter")
5587
+
(table.insert bindings rest-pat)
5588
+
(table.insert bindings [rest-val]))
5589
+
(= k `&as)
5590
+
(do
5591
+
(table.insert bindings pat)
5592
+
(table.insert bindings val))
5593
+
(and (= :number (type k)) (= `&as pat))
5594
+
(do
5595
+
(assert (= nil (. pattern (+ k 2)))
5596
+
"expected &as argument before last parameter")
5597
+
(table.insert bindings (. pattern (+ k 1)))
5598
+
(table.insert bindings val))
5599
+
;; don't process the pattern right after &/&as; already got it
5600
+
(or (not= :number (type k)) (and (not= `&as (. pattern (- k 1)))
5601
+
(not= `& (. pattern (- k 1)))))
3770
5602
(let [subval `(. ,val ,k)
3771
5603
(subcondition subbindings) (match-pattern [subval] pat
3772
5604
unifications)]
···
3776
5608
(values condition bindings)))
3777
5609
3778
5610
(fn match-pattern [vals pattern unifications]
3779
-
"Takes the AST of values and a single pattern and returns a condition
5611
+
"Take the AST of values and a single pattern and returns a condition
3780
5612
to determine if it matches as well as a list of bindings to
3781
5613
introduce for the duration of the body if it does match."
3782
5614
;; we have to assume we're matching against multiple values here until we
···
3784
5616
;; of vals) or we're not, in which case we only care about the first one.
3785
5617
(let [[val] vals]
3786
5618
(if (or (and (sym? pattern) ; unification with outer locals (or nil)
3787
-
(not= :_ (tostring pattern)) ; never unify _
3788
-
(or (in-scope? pattern)
3789
-
(= :nil (tostring pattern))))
3790
-
(and (multi-sym? pattern)
3791
-
(in-scope? (. (multi-sym? pattern) 1))))
5619
+
(not= "_" (tostring pattern)) ; never unify _
5620
+
(or (in-scope? pattern) (= :nil (tostring pattern))))
5621
+
(and (multi-sym? pattern) (in-scope? (. (multi-sym? pattern) 1))))
3792
5622
(values `(= ,val ,pattern) [])
3793
5623
;; unify a local we've seen already
3794
5624
(and (sym? pattern) (. unifications (tostring pattern)))
···
3797
5627
(sym? pattern)
3798
5628
(let [wildcard? (: (tostring pattern) :find "^_")]
3799
5629
(if (not wildcard?) (tset unifications (tostring pattern) val))
3800
-
(values (if (or wildcard? (string.find (tostring pattern) "^?"))
3801
-
true `(not= ,(sym :nil) ,val))
3802
-
[pattern val]))
5630
+
(values (if (or wildcard? (string.find (tostring pattern) "^?")) true
5631
+
`(not= ,(sym :nil) ,val)) [pattern val]))
3803
5632
;; guard clause
3804
-
(and (list? pattern) (sym? (. pattern 2)) (= :? (tostring (. pattern 2))))
5633
+
(and (list? pattern) (= (. pattern 2) `?))
3805
5634
(let [(pcondition bindings) (match-pattern vals (. pattern 1)
3806
5635
unifications)
3807
-
condition `(and ,pcondition)]
3808
-
(for [i 3 (# pattern)] ; splice in guard clauses
3809
-
(table.insert condition (. pattern i)))
3810
-
(values `(let ,bindings ,condition) bindings))
3811
-
5636
+
condition `(and ,(unpack pattern 3))]
5637
+
(values `(and ,pcondition
5638
+
(let ,bindings
5639
+
,condition)) bindings))
3812
5640
;; multi-valued patterns (represented as lists)
3813
5641
(list? pattern)
3814
5642
(match-values vals pattern unifications match-pattern)
···
3821
5649
(fn match-condition [vals clauses]
3822
5650
"Construct the actual `if` AST for the given match values and clauses."
3823
5651
(if (not= 0 (% (length clauses) 2)) ; treat odd final clause as default
3824
-
(table.insert clauses (length clauses) (sym :_)))
5652
+
(table.insert clauses (length clauses) (sym "_")))
3825
5653
(let [out `(if)]
3826
5654
(for [i 1 (length clauses) 2]
3827
5655
(let [pattern (. clauses i)
3828
5656
body (. clauses (+ i 1))
3829
5657
(condition bindings) (match-pattern vals pattern {})]
3830
5658
(table.insert out condition)
3831
-
(table.insert out `(let ,bindings ,body))))
5659
+
(table.insert out `(let ,bindings
5660
+
,body))))
3832
5661
out))
3833
5662
3834
5663
(fn match-val-syms [clauses]
3835
5664
"How many multi-valued clauses are there? return a list of that many gensyms."
3836
5665
(let [syms (list (gensym))]
3837
5666
(for [i 1 (length clauses) 2]
3838
-
(if (list? (. clauses i))
3839
-
(each [valnum (ipairs (. clauses i))]
3840
-
(if (not (. syms valnum))
3841
-
(tset syms valnum (gensym))))))
5667
+
(let [clause (if (and (list? (. clauses i)) (= `? (. clauses i 2)))
5668
+
(. clauses i 1)
5669
+
(. clauses i))]
5670
+
(if (list? clause)
5671
+
(each [valnum (ipairs clause)]
5672
+
(if (not (. syms valnum))
5673
+
(tset syms valnum (gensym)))))))
3842
5674
syms))
3843
5675
3844
-
(fn match [val ...]
3845
-
"Perform pattern matching on val. See reference for details."
5676
+
(fn match* [val ...]
5677
+
;; Old implementation of match macro, which doesn't directly support
5678
+
;; `where' and `or'. New syntax is implemented in `match-where',
5679
+
;; which simply generates old syntax and feeds it to `match*'.
3846
5680
(let [clauses [...]
3847
5681
vals (match-val-syms clauses)]
3848
5682
;; protect against multiple evaluation of the value, bind against as
3849
5683
;; many values as we ever match against in the clauses.
3850
-
(list `let [vals val]
3851
-
(match-condition vals clauses))))
5684
+
(list `let [vals val] (match-condition vals clauses))))
5685
+
5686
+
;; Construction of old match syntax from new syntax
5687
+
5688
+
(fn partition-2 [seq]
5689
+
;; Partition `seq` by 2.
5690
+
;; If `seq` has odd amount of elements, the last one is dropped.
5691
+
;;
5692
+
;; Input: [1 2 3 4 5]
5693
+
;; Output: [[1 2] [3 4]]
5694
+
(let [firsts []
5695
+
seconds []
5696
+
res []]
5697
+
(for [i 1 (length seq) 2]
5698
+
(let [first (. seq i)
5699
+
second (. seq (+ i 1))]
5700
+
(table.insert firsts (if (not= nil first) first `nil))
5701
+
(table.insert seconds (if (not= nil second) second `nil))))
5702
+
(each [i v1 (ipairs firsts)]
5703
+
(let [v2 (. seconds i)]
5704
+
(if (not= nil v2)
5705
+
(table.insert res [v1 v2]))))
5706
+
res))
5707
+
5708
+
(fn transform-or [[_ & pats] guards]
5709
+
;; Transforms `(or pat pats*)` lists into match `guard` patterns.
5710
+
;;
5711
+
;; (or pat1 pat2), guard => [(pat1 ? guard) (pat2 ? guard)]
5712
+
(let [res []]
5713
+
(each [_ pat (ipairs pats)]
5714
+
(table.insert res (list pat `? (unpack guards))))
5715
+
res))
5716
+
5717
+
(fn transform-cond [cond]
5718
+
;; Transforms `where` cond into sequence of `match` guards.
5719
+
;;
5720
+
;; pat => [pat]
5721
+
;; (where pat guard) => [(pat ? guard)]
5722
+
;; (where (or pat1 pat2) guard) => [(pat1 ? guard) (pat2 ? guard)]
5723
+
(if (and (list? cond) (= (. cond 1) `where))
5724
+
(let [second (. cond 2)]
5725
+
(if (and (list? second) (= (. second 1) `or))
5726
+
(transform-or second [(unpack cond 3)])
5727
+
:else
5728
+
[(list second `? (unpack cond 3))]))
5729
+
:else
5730
+
[cond]))
5731
+
5732
+
(fn match-where [val ...]
5733
+
"Perform pattern matching on val. See reference for details.
5734
+
5735
+
Syntax:
5736
+
5737
+
(match data-expression
5738
+
pattern body
5739
+
(where pattern guard guards*) body
5740
+
(where (or pattern patterns*) guard guards*) body)"
5741
+
(assert (not= val nil) "missing subject")
5742
+
(assert (= 0 (math.fmod (select :# ...) 2))
5743
+
"expected even number of pattern/body pairs")
5744
+
(assert (not= 0 (select :# ...))
5745
+
"expected at least one pattern/body pair")
5746
+
(let [conds-bodies (partition-2 [...])
5747
+
match-body []]
5748
+
(each [_ [cond body] (ipairs conds-bodies)]
5749
+
(each [_ cond (ipairs (transform-cond cond))]
5750
+
(table.insert match-body cond)
5751
+
(table.insert match-body body)))
5752
+
(match* val (unpack match-body))))
5753
+
5754
+
(fn match-try-step [expr else pattern body ...]
5755
+
(if (= nil pattern body)
5756
+
expr
5757
+
;; unlike regular match, we can't know how many values the value
5758
+
;; might evaluate to, so we have to capture them all in ... via IIFE
5759
+
;; to avoid double-evaluation.
5760
+
`((fn [...]
5761
+
(match ...
5762
+
,pattern ,(match-try-step body else ...)
5763
+
,(unpack else)))
5764
+
,expr)))
3852
5765
3853
-
{: -> : ->> : -?> : -?>>
3854
-
: doto : when : with-open
3855
-
: collect : icollect
3856
-
: partial : lambda
3857
-
: pick-args : pick-values
3858
-
: macro : macrodebug : import-macros
3859
-
: match}
5766
+
(fn match-try* [expr pattern body ...]
5767
+
"Perform chained pattern matching for a sequence of steps which might fail.
5768
+
5769
+
The values from the initial expression are matched against the first pattern.
5770
+
If they match, the first body is evaluated and its values are matched against
5771
+
the second pattern, etc.
5772
+
5773
+
If there is a (catch pat1 body1 pat2 body2 ...) form at the end, any mismatch
5774
+
from the steps will be tried against these patterns in sequence as a fallback
5775
+
just like a normal match. If there is no catch, the mismatched values will be
5776
+
returned as the value of the entire expression."
5777
+
(let [clauses [pattern body ...]
5778
+
last (. clauses (length clauses))
5779
+
catch (if (= `catch (and (= :table (type last)) (. last 1)))
5780
+
(let [[_ & e] (table.remove clauses)] e) ; remove `catch sym
5781
+
[`_# `...])]
5782
+
(assert (= 0 (math.fmod (length clauses) 2))
5783
+
"expected every pattern to have a body")
5784
+
(assert (= 0 (math.fmod (length catch) 2))
5785
+
"expected every catch pattern to have a body")
5786
+
(match-try-step expr catch (unpack clauses))))
5787
+
5788
+
{:-> ->*
5789
+
:->> ->>*
5790
+
:-?> -?>*
5791
+
:-?>> -?>>*
5792
+
:?. ?dot
5793
+
:doto doto*
5794
+
:when when*
5795
+
:with-open with-open*
5796
+
:collect collect*
5797
+
:icollect icollect*
5798
+
:fcollect fcollect*
5799
+
:accumulate accumulate*
5800
+
:partial partial*
5801
+
:lambda lambda*
5802
+
:pick-args pick-args*
5803
+
:pick-values pick-values*
5804
+
:macro macro*
5805
+
:macrodebug macrodebug*
5806
+
:import-macros import-macros*
5807
+
:match match-where
5808
+
:match-try match-try*}
3860
5809
]===]
3861
5810
local module_name = "fennel.macros"
3862
-
local _ = nil
3863
-
local function _0_()
5811
+
local _
5812
+
local function _739_()
3864
5813
return mod
3865
5814
end
3866
-
package.preload[module_name] = _0_
5815
+
package.preload[module_name] = _739_
3867
5816
_ = nil
3868
-
local env = nil
5817
+
local env
3869
5818
do
3870
-
local _1_0 = specials["make-compiler-env"](nil, compiler.scopes.compiler, {})
3871
-
_1_0["utils"] = utils
3872
-
_1_0["fennel"] = mod
3873
-
env = _1_0
5819
+
local _740_ = specials["make-compiler-env"](nil, compiler.scopes.compiler, {})
5820
+
do end (_740_)["utils"] = utils
5821
+
_740_["fennel"] = mod
5822
+
env = _740_
3874
5823
end
3875
-
local built_ins = eval(builtin_macros, {allowedGlobals = false, env = env, filename = "src/fennel/macros.fnl", moduleName = module_name, scope = compiler.scopes.compiler, useMetadata = true})
5824
+
local built_ins = eval(builtin_macros, {env = env, scope = compiler.scopes.compiler, allowedGlobals = false, useMetadata = true, filename = "src/fennel/macros.fnl", moduleName = module_name})
3876
5825
for k, v in pairs(built_ins) do
3877
5826
compiler.scopes.global.macros[k] = v
3878
5827
end
+1
-1
vim/.config/nvim/plugin/pack-delayed.vim
+1
-1
vim/.config/nvim/plugin/pack-delayed.vim