this repo has no description
Translate init.vim to Fennel
+4516
-657
+27
-42
fish/.config/fish/config.fish
+27
-42
fish/.config/fish/config.fish
···
1
-
alias git=hub
2
1
source (direnv hook fish | psub)
3
2
4
-
if test "$EDITOR" = nano
5
-
set -x EDITOR nvim
6
-
end
7
-
8
-
set -x LESS '-SRFXi'
9
-
set -x ERL_AFLAGS '-kernel shell_history enabled'
10
-
11
3
if not functions -q fundle
12
4
eval (curl -sfL https://git.io/fundle-install)
13
5
end
14
6
fundle plugin 'hauleth/agnoster'
7
+
fundle plugin 'oh-my-fish/plugin-foreign-env'
15
8
fundle init
16
9
17
10
ulimit -n 10480
18
11
19
-
set fish_user_paths ~/bin ~/.nix-profile/bin /run/current-system/sw/bin
12
+
# if type nix-locate 2>/dev/null >/dev/null
13
+
# function nix_locate_bin --on-event fish_command_not_found
14
+
# if not test -t 1
15
+
# __fish_default_command_not_found_handler $argv[1]
16
+
# end
20
17
21
-
if type nix-locate 2>/dev/null >/dev/null
22
-
function nix_locate_bin --on-event fish_command_not_found
23
-
if not test -t 1
24
-
__fish_default_command_not_found_handler $argv[1]
25
-
end
18
+
# set -l cmd $argv[1]
19
+
# set -l attrs (nix-locate --minimal --no-group --type x --type s --top-level --whole-name --at-root "/bin/$cmd")
26
20
27
-
set -l cmd $argv[1]
28
-
set -l attrs (nix-locate --minimal --no-group --type x --type s --top-level --whole-name --at-root "/bin/$cmd")
29
-
30
-
switch (count $attrs)
31
-
case 0
32
-
echo "$cmd: command not found" >&2
33
-
case 1
34
-
echo "Found one package with $cmd, trying to run in 1s" >&2
35
-
sleep 1
36
-
if nix-build --no-out-link -A $attrs "<nixpkgs>"
37
-
nix-shell -p $attrs --run (printf "'%s' " $argv)
38
-
return
39
-
else
40
-
echo "Failed to install nixpkgs.$attrs"
41
-
echo "$cmd: command not found"
42
-
end
43
-
case '*'
44
-
echo "$cmd is not installed. You can find it in:" >&2
45
-
printf "\tnix-env -iA nixpkgs.%s\n" $attrs >&2
46
-
end
47
-
end
48
-
end
49
-
50
-
if status --is-interactive
51
-
# env SHELL=fish keychain --eval --quiet -Q | source
52
-
53
-
kitty + complete setup fish | source
54
-
end
21
+
# switch (count $attrs)
22
+
# case 0
23
+
# echo "$cmd: command not found" >&2
24
+
# case 1
25
+
# echo "Found one package with $cmd, trying to run in 1s" >&2
26
+
# sleep 1
27
+
# if nix-build --no-out-link -A $attrs "<nixpkgs>"
28
+
# nix-shell -p $attrs --run (printf "'%s' " $argv)
29
+
# return
30
+
# else
31
+
# echo "Failed to install nixpkgs.$attrs"
32
+
# echo "$cmd: command not found"
33
+
# end
34
+
# case '*'
35
+
# echo "$cmd is not installed. You can find it in:" >&2
36
+
# printf "\tnix-env -iA nixpkgs.%s\n" $attrs >&2
37
+
# end
38
+
# end
39
+
# end
+8
-4
git/.config/git/config
+8
-4
git/.config/git/config
···
3
3
pager = "diff-so-fancy | less --tabs=4 -RFX"
4
4
commentChar = ";"
5
5
6
+
[init]
7
+
defaultBranch = master
8
+
6
9
[user]
7
10
useConfigOnly = true
8
11
···
40
43
[push]
41
44
default = simple
42
45
followTags = true
46
+
gpgSign = if-asked
43
47
[pull]
44
-
ff = only
48
+
rebase = true
45
49
[merge]
46
50
ff = false
47
51
[rebase]
···
88
92
89
93
[color.diff]
90
94
old = magenta
91
-
new = yellow
95
+
new = blue
92
96
93
97
[color.diff-highlight]
94
98
oldNormal = "magenta"
95
99
oldHighlight = "magenta ul"
96
-
newNormal = "yellow"
97
-
newHighlight = "yellow ul"
100
+
newNormal = "blue"
101
+
newHighlight = "blue ul"
98
102
99
103
[pack]
100
104
useSparse = true
git/.config/git/hooks.d/wip-check/pre-push
git/.config/git/hooks.d/wip-check/pre-push
+88
git/.config/git/hooks/hook.sh
+88
git/.config/git/hooks/hook.sh
···
1
+
#!/bin/bash
2
+
3
+
hooks=(post-checkout post-commit post-merge pre-commit pre-push prepare-commit-msg)
4
+
5
+
usage() {
6
+
echo "$0 [install|help]"
7
+
echo 'Version 0.1.0'
8
+
echo 'Copyright (c) Łukasz Niemier <opensource@niemier.pl>'
9
+
echo
10
+
echo 'Simple git hooks management system'
11
+
echo
12
+
echo 'install [hook_dir]'
13
+
echo ' Installs hooks for given repo.'
14
+
echo
15
+
echo ' [hook_dir] - directory where install hooks, defaults to .git/hooks'
16
+
echo ' in current Git working directory'
17
+
echo 'help'
18
+
echo ' display this message'
19
+
echo
20
+
echo 'To use this as default set of hooks when creating new repo then:'
21
+
echo
22
+
echo " 1. Run '$0 ~/.githooks'"
23
+
echo ' 2. Run 'git config --global core.hooksPath ~/.githooks''
24
+
echo
25
+
}
26
+
27
+
install() {
28
+
source="${BASH_SOURCE[0]}"
29
+
HOOK_DIR="${1:-"$(git rev-parse --show-toplevel)/.git/hooks"}"
30
+
31
+
echo "Install handler"
32
+
echo
33
+
34
+
mkdir -p "$HOOK_DIR"
35
+
cp -i "$source" "$HOOK_DIR/hook.sh"
36
+
37
+
echo "Installing hooks"
38
+
echo
39
+
40
+
for hook in "${hooks[@]}"
41
+
do
42
+
echo "Installing $hook"
43
+
ln -si "hook.sh" "$HOOK_DIR/$hook"
44
+
done
45
+
}
46
+
47
+
hook() {
48
+
git_dir=$(git rev-parse --git-dir)
49
+
script="$(basename "$0")"
50
+
PLUG_DIRS=("$(command git config --global --get hooks.path)" "$git_dir/hooks/hooks.d" "$(command git config --worktree --get hooks.path)")
51
+
52
+
test -d "$git_dir"/rebase-merge -o -d "$git_dir"/rebase-apply && exit 0
53
+
54
+
input="$(mktemp)"
55
+
touch "$input"
56
+
trap '{ rm -f "$input"; }' EXIT
57
+
cat - > "$input"
58
+
59
+
for dir in "${PLUG_DIRS[@]}"
60
+
do
61
+
if [ -d "$dir" ]
62
+
then
63
+
find "$dir" -maxdepth 2 -and -name "$script" -print0 2>/dev/null \
64
+
| xargs -0 -n1 -I% sh -c 'input="$1"; shift; if [ -x "$1" ]; then printf "\n## $(basename "$(dirname "$1")")\n" && "$@" < "$input" && echo ok; fi' -- "$input" % "$@"
65
+
retval="$?"
66
+
67
+
if [ ! "$retval" -eq 0 ]
68
+
then
69
+
return "$retval"
70
+
fi
71
+
fi
72
+
done
73
+
}
74
+
75
+
case "$1" in
76
+
install)
77
+
shift
78
+
install "$@"
79
+
exit
80
+
;;
81
+
help|-h|--help|version|-v|-V|--version)
82
+
shift
83
+
usage
84
+
exit
85
+
;;
86
+
*)
87
+
hook "$@"
88
+
esac
+1
-3
git/.config/git/hooks/post-checkout
+1
-3
git/.config/git/hooks/post-checkout
+1
-3
git/.config/git/hooks/post-commit
+1
-3
git/.config/git/hooks/post-commit
+1
-3
git/.config/git/hooks/post-merge
+1
-3
git/.config/git/hooks/post-merge
+1
-3
git/.config/git/hooks/pre-commit
+1
-3
git/.config/git/hooks/pre-commit
+1
-3
git/.config/git/hooks/pre-push
+1
-3
git/.config/git/hooks/pre-push
+1
-3
git/.config/git/hooks/prepare-commit-msg
+1
-3
git/.config/git/hooks/prepare-commit-msg
-5
nix/.config/nixpkgs/config.nix
-5
nix/.config/nixpkgs/config.nix
+36
-21
nix/.config/nixpkgs/darwin/configuration.nix
+36
-21
nix/.config/nixpkgs/darwin/configuration.nix
···
3
3
{
4
4
nixpkgs.config.allowUnfree = true;
5
5
nixpkgs.overlays = [
6
+
(import ../overlays/neovim-nightly.nix)
7
+
(import ../overlays/ctags.nix)
6
8
(import ../overlays/encpipe.nix)
7
9
(import ../overlays/fonts.nix)
8
-
(import ../overlays/ctags.nix)
10
+
(import ../overlays/git-riff.nix)
9
11
];
10
12
11
13
system.defaults.dock.autohide = true;
···
13
15
system.keyboard.enableKeyMapping = true;
14
16
system.keyboard.remapCapsLockToControl = true;
15
17
18
+
environment.variables = {
19
+
EDITOR = "nvim";
20
+
LESS = "-SRFXi";
21
+
ERL_FLAGS = "-kernel shell_history enabled";
22
+
};
23
+
16
24
# List packages installed in system profile. To search by name, run:
17
25
# $ nix-env -qaP | grep wget
18
26
environment.systemPackages = with pkgs; [
19
-
asciinema
27
+
_1password
20
28
bat
21
29
coreutils
22
30
direnv
31
+
nix-direnv
23
32
entr
24
33
findutils
25
34
fzy
···
27
36
gitAndTools.diff-so-fancy
28
37
gitAndTools.git-imerge
29
38
gitAndTools.git-test
39
+
gitAndTools.git-chglog
30
40
gitAndTools.hub
31
41
gitAndTools.tig
32
-
gitFull
42
+
git
43
+
git-riff
33
44
gnupg
34
45
httpie
35
46
imagemagick
36
47
jq
37
48
lnav
38
-
neovim
49
+
neovim-nightly
39
50
neovim-remote
40
51
noti
41
52
pinentry_mac
42
53
ripgrep
43
54
universal-ctags
44
-
w3m
45
-
watchman
55
+
# w3m
56
+
#watchman
46
57
weechat
47
58
];
48
59
···
51
62
fonts.enableFontDir = true;
52
63
fonts.fonts = with pkgs; [
53
64
lato
54
-
iosevka
55
-
iosevkaTerm
65
+
iosevka-ss09
66
+
iosevka-ss09-term
56
67
];
57
68
58
69
# Use a custom configuration.nix location.
···
60
71
environment.darwinConfig = "$HOME/.config/nixpkgs/darwin/configuration.nix";
61
72
62
73
# Auto upgrade nix package and the daemon service.
63
-
services.nix-daemon = {
64
-
enable = true;
65
-
enableSocketListener = true;
66
-
};
74
+
# services.nix-daemon = {
75
+
# enable = true;
76
+
# };
67
77
68
78
services.dnsmasq = {
69
79
enable = true;
80
+
port = 35353;
70
81
addresses = {
71
82
localhost = "127.0.0.1";
72
83
};
73
84
};
74
-
75
-
launchd.user.agents.watchman = {
76
-
serviceConfig.ProgramArguments = ["${pkgs.watchman}/bin/watchman" "--foreground"];
77
-
serviceConfig.KeepAlive = true;
78
-
serviceConfig.RunAtLoad = true;
79
-
};
85
+
launchd.daemons.dnsmasq.serviceConfig.StandardErrorPath = "/var/log/dnsmasq.log";
80
86
81
87
programs.gnupg = {
82
88
agent.enable = false;
···
85
91
86
92
programs.fish = {
87
93
enable = true;
94
+
translateEnvironment = true;
95
+
shellAliases = {
96
+
git = "LC_CTYPE=UTF-8 LANG=C hub";
97
+
};
98
+
};
99
+
programs.zsh = {
100
+
enable = true;
88
101
};
89
102
90
-
nix.package = pkgs.nixStable;
103
+
nix.package = pkgs.nixFlakes;
91
104
# nix.useSandbox = true;
92
105
nix.sandboxPaths = [
93
106
"/System/Library/Frameworks"
···
103
116
104
117
keep-outputs = true
105
118
keep-derivations = true
119
+
120
+
experimental-features = nix-command flakes
106
121
'';
107
122
108
123
# Used for backwards compatibility, please read the changelog before changing.
···
111
126
112
127
# You should generally set this to the total number of logical cores in your system.
113
128
# $ sysctl -n hw.ncpu
114
-
nix.maxJobs = 12;
115
-
nix.buildCores = 12;
129
+
nix.maxJobs = 8;
130
+
nix.buildCores = 8;
116
131
}
+1
-13
nix/.config/nixpkgs/overlays/erlang.nix
+1
-13
nix/.config/nixpkgs/overlays/erlang.nix
···
1
-
self: super:
2
-
3
-
let
4
-
fetchMixDeps = super.callPackage ./erlang/fetch-mix-deps.nix {};
5
-
packages = super.beam.packages.erlang;
6
-
in
7
-
{
8
-
inherit fetchMixDeps;
9
-
10
-
erlangSourcer = packages.callPackage ./erlang/sourcer.nix {};
11
-
erlangLS = packages.callPackage ./erlang/erlang-ls.nix {};
12
-
elixirLS = packages.callPackage ./erlang/elixir-ls.nix {};
13
-
}
1
+
import (builtins.fetchTarball "https://github.com/hauleth/nix-elixir/archive/master.tar.gz")
-7
nix/.config/nixpkgs/overlays/erlang/elixir-ls.json
-7
nix/.config/nixpkgs/overlays/erlang/elixir-ls.json
-65
nix/.config/nixpkgs/overlays/erlang/elixir-ls.nix
-65
nix/.config/nixpkgs/overlays/erlang/elixir-ls.nix
···
1
-
{ stdenv, elixir, rebar3, hex, fetchFromGitHub, fetchMixDeps, git, cacert }:
2
-
3
-
let
4
-
json = builtins.fromJSON (builtins.readFile ./elixir-ls.json);
5
-
in
6
-
stdenv.mkDerivation rec {
7
-
name = "elixir-ls";
8
-
version = json.rev;
9
-
10
-
nativeBuildInputs = [ elixir hex git deps cacert ];
11
-
12
-
deps = fetchMixDeps {
13
-
name = "${name}-${version}";
14
-
inherit src;
15
-
16
-
sha256 = "1j7v56mfa087wi3x8kdcbqq0wsdiw284cwlccvxs1b60rypx5k55";
17
-
};
18
-
19
-
# refresh: nix-prefetch-git https://github.com/elixir-lsp/elixir-ls.git [--rev branchName | --rev sha]
20
-
src = fetchFromGitHub json;
21
-
22
-
dontStrip = true;
23
-
24
-
configurePhase = ''
25
-
runHook preConfigure
26
-
export MIX_ENV=prod
27
-
28
-
export HEX_OFFLINE=1
29
-
export HEX_HOME="$PWD/hex"
30
-
export MIX_HOME="$PWD"
31
-
export MIX_REBAR3="${rebar3}/bin/rebar3"
32
-
export REBAR_GLOBAL_CONFIG_DIR="$out/rebar3"
33
-
export REBAR_CACHE_DIR="$out/rebar3.cache"
34
-
35
-
cp --no-preserve=all -R ${deps} deps
36
-
37
-
mix deps.compile --no-deps-check
38
-
39
-
runHook postConfigure
40
-
'';
41
-
42
-
buildPhase = ''
43
-
runHook preBuild
44
-
45
-
mix do compile --no-deps-check, elixir_ls.release
46
-
47
-
runHook postBuild
48
-
'';
49
-
50
-
installPhase = ''
51
-
mkdir -p $out/bin
52
-
cp -Rv release $out/lib
53
-
54
-
# Prepare the wrapper script
55
-
substitute release/language_server.sh $out/bin/elixir-ls \
56
-
--replace 'exec "''${dir}/launch.sh"' "exec $out/lib/launch.sh"
57
-
chmod +x $out/bin/elixir-ls
58
-
59
-
# prepare the launcher
60
-
substituteInPlace $out/lib/launch.sh \
61
-
--replace "ERL_LIBS=\"\$SCRIPTPATH:\$ERL_LIBS\"" \
62
-
"ERL_LIBS=$out/lib:\$ERL_LIBS" \
63
-
--replace "elixir -e" "${elixir}/bin/elixir -e"
64
-
'';
65
-
}
-6
nix/.config/nixpkgs/overlays/erlang/erlang-ls.json
-6
nix/.config/nixpkgs/overlays/erlang/erlang-ls.json
-13
nix/.config/nixpkgs/overlays/erlang/erlang-ls.nix
-13
nix/.config/nixpkgs/overlays/erlang/erlang-ls.nix
···
1
-
{ rebar3Relx, fetchFromGitHub, git, cacert }:
2
-
3
-
let
4
-
json = builtins.fromJSON (builtins.readFile ./erlang-ls.json);
5
-
in rebar3Relx rec {
6
-
name = "erlang-ls";
7
-
version = json.rev;
8
-
releaseType = "escript";
9
-
10
-
nativeBuildInputs = [ git cacert ];
11
-
12
-
src = fetchFromGitHub json;
13
-
}
-40
nix/.config/nixpkgs/overlays/erlang/fetch-mix-deps.nix
-40
nix/.config/nixpkgs/overlays/erlang/fetch-mix-deps.nix
···
1
-
{ stdenvNoCC, elixir, rebar, rebar3, git, cacert }:
2
-
3
-
let
4
-
fetchMixDeps =
5
-
{ name ? null, src, sha256, env ? "prod" }:
6
-
stdenvNoCC.mkDerivation {
7
-
name = "mix-deps" + (if name != null then "-${name}" else "");
8
-
9
-
nativeBuildInputs = [ elixir git cacert ];
10
-
11
-
inherit src;
12
-
13
-
MIX_ENV = env;
14
-
MIX_REBAR = "${rebar}/bin/rebar";
15
-
MIX_REBAR3 = "${rebar3}/bin/rebar3";
16
-
17
-
configurePhase = ''
18
-
export HEX_HOME="$PWD/hex"
19
-
export MIX_HOME="$PWD/mix"
20
-
export MIX_DEPS_PATH="$out"
21
-
export REBAR_GLOBAL_CONFIG_DIR="$PWD/rebar3"
22
-
export REBAR_CACHE_DIR="$PWD/rebar3.cache"
23
-
24
-
mix local.hex --force
25
-
'';
26
-
27
-
buildPhase = ''
28
-
mix deps.get
29
-
find "$out" -path '*/.git/*' -a ! -name HEAD -exec rm -rf {} +
30
-
'';
31
-
32
-
dontInstall = true;
33
-
34
-
outputHashAlgo = "sha256";
35
-
outputHashMode = "recursive";
36
-
outputHash = sha256;
37
-
38
-
impureEnvVars = stdenvNoCC.lib.fetchers.proxyImpureEnvVars;
39
-
};
40
-
in fetchMixDeps
+7
nix/.config/nixpkgs/overlays/erlang/overlay.json
+7
nix/.config/nixpkgs/overlays/erlang/overlay.json
-6
nix/.config/nixpkgs/overlays/erlang/sourcer.json
-6
nix/.config/nixpkgs/overlays/erlang/sourcer.json
-13
nix/.config/nixpkgs/overlays/erlang/sourcer.nix
-13
nix/.config/nixpkgs/overlays/erlang/sourcer.nix
···
1
-
{ rebar3Relx, fetchFromGitHub, gitMinimal }:
2
-
3
-
let
4
-
json = builtins.fromJSON (builtins.readFile ./sourcer.json);
5
-
in rebar3Relx rec {
6
-
name = "erlang-sourcer";
7
-
version = json.rev;
8
-
releaseType = "escript";
9
-
10
-
nativeBuildInputs = [ gitMinimal ];
11
-
12
-
src = fetchFromGitHub json;
13
-
}
+26
-13
nix/.config/nixpkgs/overlays/fonts.nix
+26
-13
nix/.config/nixpkgs/overlays/fonts.nix
···
1
1
self: super:
2
2
3
+
# @real fox.quick(h){ *is_brown && it_jumps_over(dogs.lazy) }
4
+
# 0123456789 ABC.DEF.GHI.JKL.MNO.PQRS.TUV.WXYZ ß <=`¶^$#%'
5
+
3
6
let
4
-
iosevka = super.iosevka.override {
5
-
set = "ss10";
6
-
privateBuildPlan = {
7
-
family = "Iosevka";
8
-
design = [ "ss10" "cv10" "cv38" "cv62" "calt-logic" ];
9
-
};
7
+
design = [
8
+
"ss09"
9
+
"calt-logic"
10
+
"v-dollar-open"
11
+
"v-g-singlestorey"
12
+
"v-l-zshaped"
13
+
"v-percent-dots"
14
+
"v-y-straight"
15
+
"v-zero-slashed"
16
+
];
17
+
iosevka-ss09 = super.iosevka.override {
18
+
set = "ss09";
19
+
privateBuildPlan = {
20
+
family = "Iosevka";
21
+
inherit design;
10
22
};
11
-
iosevkaTerm = super.iosevka.override {
12
-
set = "term";
13
-
privateBuildPlan = {
14
-
family = "Iosevka Term";
15
-
design = [ "ss10" "cv10" "cv38" "cv62" "term" ];
16
-
};
23
+
};
24
+
iosevka-ss09-term = super.iosevka.override {
25
+
set = "ss09-term";
26
+
privateBuildPlan = {
27
+
family = "Iosevka Term";
28
+
design = design ++ [ "term" ];
17
29
};
30
+
};
18
31
in {
19
-
inherit iosevka iosevkaTerm;
32
+
inherit iosevka-ss09 iosevka-ss09-term;
20
33
}
+27
nix/.config/nixpkgs/overlays/git-riff.nix
+27
nix/.config/nixpkgs/overlays/git-riff.nix
···
1
+
self: super:
2
+
3
+
with super;
4
+
5
+
let
6
+
git-riff = self.stdenv.mkDerivation rec {
7
+
name = "git-riff";
8
+
version = "1.0";
9
+
10
+
src = fetchFromGitHub {
11
+
owner = "hauleth";
12
+
repo = "git-riff";
13
+
rev = "ab17fec9cca47cc3c89575e74257a51dec005711";
14
+
sha256 = "1g86z701yxn9whvkhpaqvmxim4hhhy4qrkjxi7fgzhjzmsamzkxw";
15
+
};
16
+
17
+
dontBuild = true;
18
+
19
+
installPhase = ''
20
+
mkdir -p $out/bin
21
+
mv git-riff $out/bin/git-riff
22
+
chmod +x $out/bin/git-riff
23
+
'';
24
+
};
25
+
in {
26
+
inherit git-riff;
27
+
}
-23
nix/.config/nixpkgs/overlays/mongodb.nix
-23
nix/.config/nixpkgs/overlays/mongodb.nix
···
1
-
self: super:
2
-
3
-
with super;
4
-
5
-
{
6
-
mongodb-4_0 = stdenv.mkDerivation rec {
7
-
name = "mongodb-${version}";
8
-
version = "4.0.11";
9
-
10
-
src = fetchurl {
11
-
url = "https://fastdl.mongodb.org/osx/mongodb-osx-ssl-x86_64-${version}.tgz";
12
-
sha256 = "156ci2zl3dwwfc0pzqkk88ivvz0wwqb7h86zgmk4wxmjr4smzmig";
13
-
};
14
-
15
-
phases = [ "unpackPhase" "installPhase" ];
16
-
17
-
installPhase = ''
18
-
mkdir -p "$out"
19
-
ls -la
20
-
mv bin "$out/bin"
21
-
'';
22
-
};
23
-
}
-13
nix/.config/nixpkgs/overlays/mongodb/forget-build-dependencies.path
-13
nix/.config/nixpkgs/overlays/mongodb/forget-build-dependencies.path
···
1
-
--- a/site_scons/mongo/generators.py
2
-
+++ b/site_scons/mongo/generators.py
3
-
@@ -18,10 +18,7 @@ def default_buildinfo_environment_data():
4
-
('distmod', '$MONGO_DISTMOD', True, True,),
5
-
('distarch', '$MONGO_DISTARCH', True, True,),
6
-
('cc', '$CC_VERSION', True, False,),
7
-
- ('ccflags', '$CCFLAGS', True, False,),
8
-
('cxx', '$CXX_VERSION', True, False,),
9
-
- ('cxxflags', '$CXXFLAGS', True, False,),
10
-
- ('linkflags', '$LINKFLAGS', True, False,),
11
-
('target_arch', '$TARGET_ARCH', True, True,),
12
-
('target_os', '$TARGET_OS', True, False,),
13
-
)
+3
nix/.config/nixpkgs/overlays/neovim-nightly.nix
+3
nix/.config/nixpkgs/overlays/neovim-nightly.nix
+3
vim/.config/nvim/.netrwhist
+3
vim/.config/nvim/.netrwhist
+5
-4
vim/.config/nvim/autoload/plugins.vim
+5
-4
vim/.config/nvim/autoload/plugins.vim
···
34
34
" }}}
35
35
" Git {{{
36
36
call minpac#add('tpope/vim-fugitive')
37
-
call minpac#add('rbong/vim-flog')
38
-
call minpac#add('jreybert/vimagit')
39
37
" }}}
40
38
" Launch screen {{{
41
39
call minpac#add('mhinz/vim-startify') " Required during startup
···
50
48
call minpac#add('tpope/vim-cucumber') " ftplugin
51
49
call minpac#add('tpope/vim-scriptease', {'type': 'opt'}) " ftplugin
52
50
call minpac#add('LnL7/vim-nix')
51
+
call minpac#add('bakpakin/fennel.vim')
52
+
call minpac#add('nvim-treesitter/nvim-treesitter')
53
53
" }}}
54
54
" Completion {{{
55
-
call minpac#add('prabirshrestha/async.vim') " autoload-only
56
-
call minpac#add('prabirshrestha/vim-lsp')
55
+
" call minpac#add('prabirshrestha/async.vim') " autoload-only
56
+
" call minpac#add('prabirshrestha/vim-lsp')
57
57
call minpac#add('Shougo/echodoc.vim')
58
58
call minpac#add('fcpg/vim-complimentary') " autoload-only
59
+
call minpac#add('neovim/nvim-lspconfig')
59
60
" }}}
60
61
" Code manipulation {{{
61
62
call minpac#add('AndrewRadev/splitjoin.vim')
+15
vim/.config/nvim/fnl/langclient.fnl
+15
vim/.config/nvim/fnl/langclient.fnl
···
1
+
(local {:buf_map bmap} (require :utils))
2
+
(local lsp (require :lspconfig))
3
+
4
+
(macro if-capable [client capability body ...]
5
+
(assert body "expected body")
6
+
`(if (. (. ,client :resolved_capabilities) ,capability) (do ,body ,...)))
7
+
8
+
(fn on-attach [client]
9
+
(if-capable client :hover (bmap :n :K ":lua vim.lsp.buf.hover()"))
10
+
(if-capable client :goto_definition (bmap :n :gd ":lua vim.lsp.definition()"))
11
+
(if-capable client :references (bmap :n :gd ":lua vim.lsp.references()"))
12
+
(vim.api.nvim_buf_set_option 0 :omnifunc "v:lua.vim.lsp.omnifunc"))
13
+
14
+
(lsp.elixirls.setup {:cmd ["nix-shell" "--show-trace" "--run" "elixir-ls"]
15
+
:on_attach on-attach})
+213
vim/.config/nvim/fnl/startup.fnl
+213
vim/.config/nvim/fnl/startup.fnl
···
1
+
(local {:map map} (require :utils))
2
+
(local ts (require :nvim-treesitter.configs))
3
+
4
+
(macro g [name value] `(tset vim.g ,name ,value))
5
+
(macro opt [name value]
6
+
(assert (sym? name))
7
+
`(tset vim.o ,(view name) ,(if (= nil value) true value)))
8
+
(macro wopt [name value]
9
+
(assert (sym? name))
10
+
`(tset vim.wo ,(view name) ,(if (= nil value) true value)))
11
+
12
+
(macro on [event pattern cmd]
13
+
`(vim.api.nvim_command (.. "au " ,(view event) " " ,pattern " " ,cmd)))
14
+
15
+
(macro augroup [name ...]
16
+
(let [f (sym "on")]
17
+
`(do
18
+
(vim.api.nvim_command (.. "augroup " ,(view name)))
19
+
(vim.api.nvim_command "au!")
20
+
,...
21
+
(vim.api.nvim_command "augroup END"))))
22
+
23
+
(fn executable? [name]
24
+
(vim.api.nvim_call_function "executable" [name]))
25
+
26
+
(fn colorscheme [name]
27
+
(vim.api.nvim_command (.. "colorscheme " name)))
28
+
29
+
; Colors
30
+
(colorscheme :blame)
31
+
32
+
(opt shell "fish")
33
+
34
+
; MatchIt must be unloaded for MatchPair to work correctly
35
+
(g :loaded_matchit true)
36
+
37
+
; Colors
38
+
(opt termguicolors)
39
+
(opt guicursor "n-v-c-sm:block-Cursor,i-ci-ve:ver25-Cursor,r-cr-o:hor20-Cursor")
40
+
41
+
; Indentation
42
+
(opt shiftwidth 2)
43
+
(opt expandtab)
44
+
(opt textwidth 80)
45
+
(wopt wrap false)
46
+
(wopt linebreak)
47
+
(opt formatoptions "tcqjl")
48
+
49
+
; UI
50
+
(opt lazyredraw)
51
+
(opt updatetime 500)
52
+
(opt title)
53
+
54
+
; Display tabs and trailing spaces visually
55
+
; (opt fillchars "vert:┃,fold:·")
56
+
(opt list)
57
+
; (opt listchars "tab:→\ ,trail:·,nbsp:␣,extends:↦,precedes:↤")
58
+
(opt conceallevel 2)
59
+
60
+
; Ignore case. If your code uses different casing to differentiate files, then
61
+
; you need mental help
62
+
(opt wildignorecase)
63
+
(opt wildmode :full)
64
+
(opt fileignorecase)
65
+
66
+
(opt showmode false)
67
+
68
+
; Autowrite file whenever possible
69
+
(opt hidden false)
70
+
(opt autowriteall)
71
+
72
+
; Keep cursor in the middle
73
+
(let [value 9999
74
+
scrolloff (fn [v] (.. "silent setl scrolloff=" v))]
75
+
(opt scrolloff value)
76
+
(augroup terminal_scrolloff
77
+
(on BufEnter "term://*" (scrolloff 0))
78
+
(on BufLeave "term://*" (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 :syntax)
100
+
(opt foldlevel 999)
101
+
(map :n :<CR> "foldlevel(\".\") ? \"za\" : \"\\<CR>\"" {:expr true})
102
+
103
+
; Completion
104
+
(opt complete ".,w,b,t,k,kspell")
105
+
(opt completeopt "menuone,noselect,noinsert")
106
+
107
+
(g "echodoc#enable_at_startup" true)
108
+
(g "echodoc#type" :virtual)
109
+
110
+
; Clap
111
+
(map :n :<Space><Space> ":Clap files")
112
+
113
+
; Frequently used unimpaired mappings
114
+
(let [unimpaired (fn [char left right]
115
+
(map :n (.. "[" char) left)
116
+
(map :n (.. "]" char) right))]
117
+
(unimpaired :w "gT" "gt")
118
+
(unimpaired :q ":cprev" ":cnext")
119
+
(unimpaired :Q ":cpfile" ":cnfile")
120
+
(unimpaired :l ":lprev" ":lnext")
121
+
(unimpaired :L ":lpfile" ":lnfile"))
122
+
123
+
; Additional "Close" commands
124
+
(map :n :ZS ":wa")
125
+
(map :n :ZA ":qa")
126
+
(map :n :ZX ":cq")
127
+
128
+
; Swap ; and : for easier command line mode
129
+
(let [swap (fn [a b] (map :nx a b) (map :nx b a))]
130
+
(swap ";" ":")
131
+
(map :n "q;" "q:"))
132
+
133
+
; Expand abbreviation when hitted <CR>
134
+
(map :i :<CR> "<C-]><CR>")
135
+
136
+
; Make Vim behaviour consistent
137
+
(map :n :Y :y$)
138
+
139
+
; Code formatting
140
+
(map :n :g= "=aGg``")
141
+
(map :nx :Q "gq")
142
+
(map :n :gQ "gqaG``")
143
+
144
+
; Smart `0`
145
+
; Goes to the beginning of the text at first and later goes to the beginning of
146
+
; the line, alternates afterwards
147
+
(map :n :0 "virtcol('.') - 1 <= indent('.') && col('.') > 1 ? '0' : '_'" {:expr true})
148
+
149
+
(map :n :gK ":Dash")
150
+
(map :n :gq ":call open#open()")
151
+
152
+
; Text object for whole file
153
+
(map :o :aG ":normal! ggVG")
154
+
155
+
; Quickly disable highligh
156
+
(map :n "<Space>," ":nohlsearch")
157
+
158
+
; Terminal mappings
159
+
(map :n "<C-q>" "<Nop>")
160
+
(map :n "<C-q>c" ":term")
161
+
(map :n "<C-q>s" ":split +term")
162
+
(map :n "<C-q>v" ":vsplit +term")
163
+
(map :n "<C-q>t" ":tabnew +term")
164
+
165
+
(map :t "<C-q>" "<C-\\><C-n>")
166
+
(map :n "<C-q>" "<ESC>")
167
+
168
+
; Git mappings
169
+
(let [leader "U"
170
+
git-map (fn [lhs cmd] (map :n (.. leader lhs) (.. ":Git " cmd)))]
171
+
(map :n leader "<nop>")
172
+
(map :n (.. leader leader) (.. leader :u) {:noremap false})
173
+
(git-map :p "push")
174
+
(git-map :s "status")
175
+
(git-map :d "diff")
176
+
(git-map :B "blame")
177
+
(git-map :c "commit")
178
+
(git-map :u "pull")
179
+
(git-map :g "log"))
180
+
181
+
; Split management
182
+
(augroup align-windows
183
+
(on VimEnter "*" "wincmd ="))
184
+
(map :n "<C-w>q" "<plug>(choosewin)")
185
+
(map :n "<C-_>" "<plug>(choosewin)")
186
+
187
+
; Search
188
+
(when (executable? "rg")
189
+
(opt grepprg "rg --vimgrep --no-heading --smart-case")
190
+
(opt grepformat "%f:%l:%c:%m,%f:%l%m,%f %l%m"))
191
+
192
+
; Matchparen
193
+
(g :matchup_matchparen_offscreen {:method :popup})
194
+
195
+
(augroup matchparen
196
+
(let [term "term://*"]
197
+
(on BufEnter term "NoMatchParen")
198
+
(on BufLeave term "DoMatchParen")))
199
+
200
+
; Autoreload Direnv after writing the .envrc
201
+
(when (executable? "direnv")
202
+
(augroup autoreload-envrc
203
+
(on BufWritePost ".envrc" "silent !direnv allow %")))
204
+
205
+
; Clean non-existing buffers on leave
206
+
(augroup autoclean
207
+
(on BufLeave "*" "call utils#cleanup()"))
208
+
209
+
(ts.setup {:ensure_installed :maintained
210
+
:highlight {:enable true}
211
+
:indent {:enable true}})
212
+
213
+
(require :langclient)
+24
vim/.config/nvim/init.lua
+24
vim/.config/nvim/init.lua
···
1
+
-- Fennel loader, default one do not work well with NeoVim so there is custom
2
+
-- one
3
+
local fennel = require('fennel')
4
+
local function fennel_loader(name)
5
+
local basename = name:gsub('%.', '/')
6
+
local paths = {"fnl/"..basename..".fnl", "fnl/"..basename.."/init.fnl"}
7
+
8
+
for _, path in ipairs(paths) do
9
+
local found = vim.api.nvim_get_runtime_file(path, false)
10
+
if #found > 0 then
11
+
return function() return fennel.dofile(found[1]) end
12
+
end
13
+
end
14
+
15
+
return nil
16
+
end
17
+
table.insert(package.loaders, 1, fennel_loader)
18
+
19
+
local u = require('utils')
20
+
21
+
require('startup')
22
+
23
+
-- Load legacy configuration file
24
+
vim.api.nvim_command('runtime! legacy.vim')
-280
vim/.config/nvim/init.vim
-280
vim/.config/nvim/init.vim
···
1
-
" vi: foldmethod=marker foldlevel=0
2
-
scriptencoding utf-8
3
-
4
-
set shell=fish
5
-
6
-
" Plugins {{{
7
-
let g:loaded_netrwPlugin = 1
8
-
let g:loaded_matchit = 1
9
-
10
-
command! -bar PackUpdate call plugins#reload() | call minpac#update()
11
-
command! -bar PackClean call plugins#reload() | call minpac#clean()
12
-
command! -bar PackStatus call plugins#reload() | call minpac#status()
13
-
" }}}
14
-
" Identation {{{
15
-
set shiftwidth=2 expandtab
16
-
17
-
set textwidth=80
18
-
set nowrap linebreak formatoptions+=l
19
-
" }}}
20
-
" User interface {{{
21
-
set lazyredraw
22
-
23
-
set updatetime=500
24
-
25
-
set title
26
-
27
-
" Ignore case. If your code uses different casing to differentiate files, then
28
-
" you need mental help
29
-
set wildignorecase fileignorecase
30
-
set wildmode=full
31
-
" Colors {{{
32
-
set termguicolors
33
-
set guicursor=n-v-c-sm:block-Cursor,i-ci-ve:ver25-Cursor,r-cr-o:hor20-Cursor
34
-
colorscheme blame
35
-
" }}}
36
-
" Ignore all automatic files and folders {{{
37
-
set wildignore+=*.o,*~,**/.git/**,**/tmp/**,**/node_modules/**,**/_build/**,**/deps/**,**/target/**,**/uploads/**
38
-
" }}}
39
-
" Display tabs and trailing spaces visually {{{
40
-
set fillchars=vert:┃,fold:·
41
-
set list listchars=tab:→\ ,trail:·,nbsp:␣,extends:↦,precedes:↤
42
-
set conceallevel=2
43
-
" }}}
44
-
" Do not show current mode down the bottom {{{
45
-
set noshowmode
46
-
" }}}
47
-
" Autowrite files when possible {{{
48
-
set nohidden autowriteall
49
-
" }}}
50
-
" Keep cursor in the middle {{{
51
-
set scrolloff=9999
52
-
" }}}
53
-
" Enable mouse suport {{{
54
-
set mouse=a
55
-
" }}}
56
-
" Hypen is part of the keyword, if you want to substract then add spaces {{{
57
-
set iskeyword+=-
58
-
" }}}
59
-
" Split in CORRECT places {{{
60
-
set splitright splitbelow
61
-
" }}}
62
-
" }}}
63
-
" Diff options {{{
64
-
set diffopt+=indent-heuristic,algorithm:patience
65
-
" }}}
66
-
" Search {{{
67
-
" Smart case searches
68
-
set ignorecase smartcase
69
-
70
-
if exists('+inccommand')
71
-
set inccommand=nosplit
72
-
end
73
-
" }}}
74
-
" Permanent undo {{{
75
-
set undofile
76
-
" }}}
77
-
" Custom configurations {{{
78
-
" Matchparen {{{
79
-
let g:matchup_matchparen_offscreen = {'method': 'popup'}
80
-
81
-
augroup matchparen
82
-
autocmd!
83
-
autocmd BufEnter term://* NoMatchParen
84
-
autocmd BufLeave term://* DoMatchParen
85
-
augroup END
86
-
" }}}
87
-
" Fuzzy file search {{{
88
-
nnoremap <Space><Space> :<C-u>Clap files<CR>
89
-
90
-
let g:clap_provider_grep_opts = '-H --no-heading --vimgrep --smart-case --hidden --glob !.git'
91
-
92
-
let g:clap#provider#files# = {
93
-
\ 'source': 'rg --files --hidden --glob !.git',
94
-
\ 'sink*': function('clap#provider#files#sink_star_impl'),
95
-
\ 'sink': function('clap#provider#files#sink_impl'),
96
-
\ 'support_open_action': v:true,
97
-
\ 'enable_rooter': v:true,
98
-
\ 'syntax': 'clap_files',
99
-
\ 'on_move': function('clap#provider#files#on_move_impl')
100
-
\ }
101
-
" }}}
102
-
" Git shortcuts {{{
103
-
nnoremap U <nop>
104
-
nnoremap Up :<C-u>Gpush<CR>
105
-
nnoremap Us :<C-u>Gstatus<CR>
106
-
nnoremap Ud :<C-u>Gdiff<CR>
107
-
nnoremap UB :<C-u>Gblame<CR>
108
-
nnoremap Uc :<C-u>Gcommit<CR>
109
-
nnoremap Uu :<C-u>Gpull<CR>
110
-
nnoremap Ug :<C-u>Glog<CR>
111
-
nmap UU Uu
112
-
113
-
cabbrev G Git
114
-
cabbrev G! Git!
115
-
" }}}
116
-
" Asynchronous commands {{{
117
-
command! -bang -nargs=* -complete=file Make call asyncdo#run(<bang>0, &makeprg, <f-args>)
118
-
command! -bang -nargs=* -complete=dir Grep call asyncdo#run(<bang>0,
119
-
\ { 'job': &grepprg, 'errorformat': &grepformat },
120
-
\ <f-args>)
121
-
command! -bang -nargs=* -complete=file LMake call asyncdo#lrun(<bang>0, &makeprg, <f-args>)
122
-
command! -bang -nargs=* -complete=dir LGrep call asyncdo#lrun(<bang>0, { 'job': &grepprg, 'errorformat': &grepformat }, <f-args>)
123
-
" }}}
124
-
" Expand abbreviations on enter {{{
125
-
inoremap <CR> <C-]><CR>
126
-
" }}}
127
-
" Smart `0` {{{
128
-
" `0` goes to the beginning of the text on first press and to the beginning
129
-
" of the line on second press. It alternates afterwards.
130
-
nnoremap <expr> 0 virtcol('.') - 1 <= indent('.') && col('.') > 1 ? '0' : '_'
131
-
" }}}
132
-
" File closing {{{
133
-
nnoremap ZS :wa<CR>
134
-
nnoremap ZA :qa<CR>
135
-
nnoremap ZX :cq<CR>
136
-
" }}}
137
-
" Simplify switching to Command mode {{{
138
-
nnoremap ; :
139
-
xnoremap ; :
140
-
nnoremap : ;
141
-
xnoremap : ;
142
-
nnoremap q; q:
143
-
" }}}
144
-
" Fix idiotic vim defaults {{{
145
-
nnoremap Y y$
146
-
" }}}
147
-
" Folding {{{
148
-
set foldmethod=syntax
149
-
set foldlevel=999
150
-
151
-
nnoremap <expr> <CR> foldlevel('.') ? 'za' : "\<CR>"
152
-
" }}}
153
-
" Format {{{
154
-
nnoremap g= =aGg``
155
-
noremap Q gq
156
-
nnoremap gQ gqaG``
157
-
158
-
command! Clean keeppatterns %s/\s\+$//e | set nohlsearch
159
-
" }}}
160
-
" Search {{{
161
-
if executable('rg')
162
-
set grepprg=rg\ --vimgrep\ --no-heading\ --smart-case
163
-
set grepformat=%f:%l:%c:%m,%f:%l%m,%f\ \ %l%m
164
-
elseif executable('ag')
165
-
set grepprg=ag\ --nogroup\ --nocolor\ --vimgrep
166
-
set grepformat^=%f:%l:%c:%m
167
-
endif
168
-
169
-
" Quickly disable highligh
170
-
nnoremap <Space>, :nohlsearch<CR>
171
-
" }}}
172
-
" Cycling {{{
173
-
nnoremap ]w gt
174
-
nnoremap [w gT
175
-
176
-
nnoremap ]q :<C-u>cnext<CR>
177
-
nnoremap [q :<C-u>cprev<CR>
178
-
nnoremap ]Q :<C-u>cnfile<CR>
179
-
nnoremap [Q :<C-u>cpfile<CR>
180
-
181
-
nnoremap ]l :<C-u>lnext<CR>
182
-
nnoremap [l :<C-u>lprev<CR>
183
-
nnoremap ]L :<C-u>lnfile<CR>
184
-
nnoremap [L :<C-u>lpfile<CR>
185
-
" }}}
186
-
" Terminal {{{
187
-
nnoremap <C-q> <Nop>
188
-
nnoremap <C-q>c :<C-u>term<CR>
189
-
nnoremap <C-q>s :<C-u>split +term<CR>
190
-
nnoremap <C-q>v :<C-u>vsplit +term<CR>
191
-
nnoremap <C-q>t :<C-u>tabnew +term<CR>
192
-
193
-
tnoremap <C-q> <C-\><C-n>
194
-
inoremap <C-q> <ESC>
195
-
196
-
if executable('nvr')
197
-
let $EDITOR = 'nvr -cc split -c "set bufhidden=delete" --remote-wait'
198
-
endif
199
-
" }}}
200
-
" Split management {{{
201
-
augroup align_windows
202
-
au!
203
-
au VimResized * wincmd =
204
-
augroup END
205
-
206
-
nmap <C-w>q <plug>(choosewin)
207
-
nmap <C-_> <plug>(choosewin)
208
-
" }}}
209
-
" Startify {{{
210
-
let g:startify_lists = [
211
-
\ {'type': 'sessions', 'header': [' Sessions']},
212
-
\ {'type': 'commands', 'header': [' Wiki']},
213
-
\ ]
214
-
let g:startify_session_dir = '~/.local/share/nvim/site/sessions/'
215
-
let g:startify_session_autoload = v:true
216
-
let g:startify_session_persistence = v:true
217
-
218
-
let g:startify_commands = [
219
-
\ {'w': ['Wiki', 'VimwikiIndex']},
220
-
\ {'d': ['Diary', 'VimwikiDiaryIndex']},
221
-
\ {'t': ['Today', 'VimwikiMakeDiaryNote']},
222
-
\ {'y': ['Yesterday', 'VimwikiMakeYesterdayDiaryNote']},
223
-
\ {'a': ['Tomorrow', 'VimwikiMakeTomorrowDiaryNote']},
224
-
\ ]
225
-
226
-
let g:startify_change_to_dir = v:false
227
-
let g:startify_change_to_vcs_root = v:true
228
-
let g:startify_fortune_use_unicode = v:true
229
-
" }}}
230
-
" }}}
231
-
" Completions {{{
232
-
set complete=.,w,b,t,k,kspell
233
-
set completeopt=menuone,noselect,noinsert
234
-
235
-
set tags^=./**/tags
236
-
237
-
let g:echodoc#enable_at_startup = v:true
238
-
let g:echodoc#type = 'virtual'
239
-
" }}}
240
-
241
-
set sessionoptions=blank,buffers,curdir,folds,tabpages,winsize
242
-
243
-
if executable('direnv')
244
-
augroup autoreload_envrc
245
-
autocmd!
246
-
autocmd BufWritePost .envrc silent !direnv allow %
247
-
augroup END
248
-
endif
249
-
250
-
augroup terminal_scrolloff
251
-
autocmd!
252
-
autocmd BufEnter term://* silent setl scrolloff=0
253
-
autocmd BufLeave term://* silent setl scrolloff=9999
254
-
augroup END
255
-
256
-
augroup hotfix
257
-
autocmd!
258
-
autocmd BufLeave * call utils#cleanup()
259
-
autocmd ColorScheme * highlight LspErrorHighlight gui=underline cterm=underline
260
-
\ | highlight LspWarningHighlight gui=underline cterm=underline
261
-
augroup END
262
-
263
-
" Needed for Projectionist and dadbod
264
-
command! -nargs=* Start <mods> split new <bar> call termopen(<q-args>) <bar> startinsert
265
-
command! -nargs=0 Ctags AsyncDo ctags -R
266
-
command! -nargs=? Dash call dash#open(<f-args>)
267
-
command! Term <mods> split +term <bar> startinsert
268
-
269
-
nnoremap gK :Dash<CR>
270
-
nnoremap gx :<C-u>call open#open()<CR>
271
-
272
-
onoremap aG :<C-u>normal! ggVG<CR>
273
-
274
-
command! Bd b#|bd#
275
-
276
-
packadd! vim-sandwich
277
-
runtime macros/sandwich/keymap/surround.vim
278
-
279
-
" Load custom configuration for given machine
280
-
runtime custom.vim
+85
vim/.config/nvim/legacy.vim
+85
vim/.config/nvim/legacy.vim
···
1
+
" vi: foldmethod=marker foldlevel=0
2
+
scriptencoding utf-8
3
+
4
+
" Plugins {{{
5
+
command! -bar PackUpdate call plugins#reload() | call minpac#update()
6
+
command! -bar PackClean call plugins#reload() | call minpac#clean()
7
+
command! -bar PackStatus call plugins#reload() | call minpac#status()
8
+
" }}}
9
+
" User interface {{{
10
+
" Ignore all automatic files and folders {{{
11
+
set wildignore+=*.o,*~,**/.git/**,**/tmp/**,**/node_modules/**,**/_build/**,**/deps/**,**/target/**,**/uploads/**
12
+
" }}}
13
+
" Hypen is part of the keyword, if you want to substract then add spaces {{{
14
+
set iskeyword+=-
15
+
" }}}
16
+
" }}}
17
+
" Diff options {{{
18
+
set diffopt+=indent-heuristic,algorithm:patience
19
+
" }}}
20
+
" Custom configurations {{{
21
+
" Fuzzy file search {{{
22
+
let g:clap_provider_grep_opts = '-H --no-heading --vimgrep --smart-case --hidden --glob !.git'
23
+
24
+
let g:clap#provider#files# = {
25
+
\ 'source': 'rg --files --hidden --glob !.git',
26
+
\ 'sink*': function('clap#provider#files#sink_star_impl'),
27
+
\ 'sink': function('clap#provider#files#sink_impl'),
28
+
\ 'support_open_action': v:true,
29
+
\ 'enable_rooter': v:true,
30
+
\ 'syntax': 'clap_files',
31
+
\ 'on_move': function('clap#provider#files#on_move_impl')
32
+
\ }
33
+
" }}}
34
+
" Asynchronous commands {{{
35
+
command! -bang -nargs=* -complete=file Make call asyncdo#run(<bang>0, &makeprg, <f-args>)
36
+
command! -bang -nargs=* -complete=dir Grep call asyncdo#run(<bang>0,
37
+
\ { 'job': &grepprg, 'errorformat': &grepformat },
38
+
\ <f-args>)
39
+
command! -bang -nargs=* -complete=file LMake call asyncdo#lrun(<bang>0, &makeprg, <f-args>)
40
+
command! -bang -nargs=* -complete=dir LGrep call asyncdo#lrun(<bang>0, { 'job': &grepprg, 'errorformat': &grepformat }, <f-args>)
41
+
" }}}
42
+
" Format {{{
43
+
command! Clean keeppatterns %s/\s\+$//e | set nohlsearch
44
+
" }}}
45
+
" Terminal {{{
46
+
if executable('nvr')
47
+
let $EDITOR = 'nvr -cc split -c "set bufhidden=delete" --remote-wait'
48
+
endif
49
+
" }}}
50
+
" Startify {{{
51
+
let g:startify_lists = [
52
+
\ {'type': 'sessions', 'header': [' Sessions']},
53
+
\ {'type': 'commands', 'header': [' Wiki']},
54
+
\ ]
55
+
let g:startify_session_dir = '~/.local/share/nvim/site/sessions/'
56
+
let g:startify_session_autoload = v:true
57
+
let g:startify_session_persistence = v:true
58
+
59
+
let g:startify_commands = [
60
+
\ {'w': ['Wiki', 'VimwikiIndex']},
61
+
\ {'d': ['Diary', 'VimwikiDiaryIndex']},
62
+
\ {'t': ['Today', 'VimwikiMakeDiaryNote']},
63
+
\ {'y': ['Yesterday', 'VimwikiMakeYesterdayDiaryNote']},
64
+
\ {'a': ['Tomorrow', 'VimwikiMakeTomorrowDiaryNote']},
65
+
\ ]
66
+
67
+
let g:startify_change_to_dir = v:false
68
+
let g:startify_change_to_vcs_root = v:true
69
+
let g:startify_fortune_use_unicode = v:true
70
+
" }}}
71
+
" }}}
72
+
" Completions {{{
73
+
set tags^=./**/tags
74
+
" }}}
75
+
76
+
" Needed for Projectionist and dadbod
77
+
command! -nargs=* Start <mods> split new <bar> call termopen(<q-args>) <bar> startinsert
78
+
command! -nargs=0 Ctags AsyncDo ctags -R
79
+
command! -nargs=? Dash call dash#open(<f-args>)
80
+
command! Term <mods> split +term <bar> startinsert
81
+
82
+
command! Bd b#|bd#
83
+
84
+
packadd! vim-sandwich
85
+
runtime macros/sandwich/keymap/surround.vim
+3882
vim/.config/nvim/lua/fennel.lua
+3882
vim/.config/nvim/lua/fennel.lua
···
1
+
package.preload["fennel.repl"] = package.preload["fennel.repl"] or function(...)
2
+
local utils = require("fennel.utils")
3
+
local parser = require("fennel.parser")
4
+
local compiler = require("fennel.compiler")
5
+
local specials = require("fennel.specials")
6
+
local function default_read_chunk(parser_state)
7
+
local function _0_()
8
+
if (0 < parser_state["stack-size"]) then
9
+
return ".."
10
+
else
11
+
return ">> "
12
+
end
13
+
end
14
+
io.write(_0_())
15
+
io.flush()
16
+
local input = io.read()
17
+
return (input and (input .. "\n"))
18
+
end
19
+
local function default_on_values(xs)
20
+
io.write(table.concat(xs, "\9"))
21
+
return io.write("\n")
22
+
end
23
+
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
27
+
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
29
+
return (compiler.traceback(tostring(err), 4) .. "\n")
30
+
else
31
+
local _ = _0_0
32
+
return ("%s error: %s\n"):format(errtype, tostring(err))
33
+
end
34
+
end
35
+
return io.write(_1_())
36
+
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 {})
40
+
local spliced_source = {}
41
+
local bind = "local %s = ___replLocals___['%s']"
42
+
for line in lua_source:gmatch("([^\n]+)\n?") do
43
+
table.insert(spliced_source, line)
44
+
end
45
+
for name in pairs(env.___replLocals___) do
46
+
table.insert(spliced_source, 1, bind:format(name, name))
47
+
end
48
+
if ((1 < #spliced_source) and (spliced_source[#spliced_source]):match("^ *return .*$")) then
49
+
table.insert(spliced_source, #spliced_source, save_source)
50
+
end
51
+
return table.concat(spliced_source, "\n")
52
+
end
53
+
local commands = {}
54
+
local function command_3f(input)
55
+
return input:match("^%s*,")
56
+
end
57
+
local function command_docs()
58
+
local _0_
59
+
do
60
+
local tbl_0_ = {}
61
+
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"))
63
+
end
64
+
_0_ = tbl_0_
65
+
end
66
+
return table.concat(_0_, "\n")
67
+
end
68
+
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")})
70
+
end
71
+
do end (compiler.metadata):set(commands.help, "fnl/docstring", "Show this message.")
72
+
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
77
+
package.loaded[module_name] = nil
78
+
_ = nil
79
+
local ok, new = pcall(require, module_name)
80
+
local new0 = nil
81
+
if not ok then
82
+
on_values({new})
83
+
new0 = old
84
+
else
85
+
new0 = new
86
+
end
87
+
if ((type(old) == "table") and (type(new0) == "table")) then
88
+
for k, v in pairs(new0) do
89
+
old[k] = v
90
+
end
91
+
for k in pairs(old) do
92
+
if (nil == new0[k]) then
93
+
old[k] = nil
94
+
end
95
+
end
96
+
package.loaded[module_name] = old
97
+
end
98
+
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
104
+
end
105
+
return on_error("Runtime", _3_())
106
+
end
107
+
end
108
+
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))
117
+
end
118
+
end
119
+
do end (compiler.metadata):set(commands.reload, "fnl/docstring", "Reload the specified module.")
120
+
commands.reset = function(env, _, on_values)
121
+
env.___replLocals___ = {}
122
+
return on_values({"ok"})
123
+
end
124
+
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)
133
+
end
134
+
end
135
+
end
136
+
return nil
137
+
end
138
+
end
139
+
local function run_command(input, read, loop, env, on_values, on_error)
140
+
load_plugin_commands()
141
+
local command_name = input:match(",([^%s/]+)")
142
+
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
149
+
if ("exit" ~= command_name) then
150
+
on_values({"Unknown command", command_name})
151
+
end
152
+
end
153
+
end
154
+
if ("exit" ~= command_name) then
155
+
return loop()
156
+
end
157
+
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]
166
+
else
167
+
k0 = k
168
+
end
169
+
if ((#matches < 2000) and (type(k0) == "string") and (input == k0:sub(0, #input))) then
170
+
table.insert(matches, (prefix .. k0))
171
+
end
172
+
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 = ""
181
+
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]
189
+
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))
194
+
end
195
+
end
196
+
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
203
+
end
204
+
local function repl(options)
205
+
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
219
+
local read_chunk = (opts.readChunk or default_read_chunk)
220
+
local on_values = (opts.onValues or default_on_values)
221
+
local on_error = (opts.onError or default_on_error)
222
+
local pp = (opts.pp or tostring)
223
+
local byte_stream, clear_stream = parser.granulate(read_chunk)
224
+
local chars = {}
225
+
local read, reset = nil, nil
226
+
local function _1_(parser_state)
227
+
local c = byte_stream(parser_state)
228
+
table.insert(chars, c)
229
+
return c
230
+
end
231
+
read, reset = parser.parser(_1_)
232
+
local scope = compiler["make-scope"]()
233
+
opts.useMetadata = (options.useMetadata ~= false)
234
+
if (opts.allowedGlobals == nil) then
235
+
opts.allowedGlobals = specials["current-global-names"](opts.env)
236
+
end
237
+
if opts.registerCompleter then
238
+
local function _3_(...)
239
+
return completer(env, scope, ...)
240
+
end
241
+
opts.registerCompleter(_3_)
242
+
end
243
+
local function print_values(...)
244
+
local vals = {...}
245
+
local out = {}
246
+
env._, env.__ = vals[1], vals
247
+
for i = 1, select("#", ...) do
248
+
table.insert(out, pp(vals[i]))
249
+
end
250
+
return on_values(out)
251
+
end
252
+
local function loop()
253
+
for k in pairs(chars) do
254
+
chars[k] = nil
255
+
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
259
+
if not ok then
260
+
on_error("Parse", parse_ok_3f)
261
+
clear_stream()
262
+
reset()
263
+
return loop()
264
+
elseif command_3f(src_string) then
265
+
return run_command(src_string, read, loop, env, on_values, on_error)
266
+
else
267
+
if parse_ok_3f then
268
+
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
272
+
clear_stream()
273
+
on_error("Compile", msg)
274
+
elseif ((_4_0 == true) and (nil ~= _5_0)) then
275
+
local src = _5_0
276
+
local src0 = nil
277
+
if save_locals_3f then
278
+
src0 = splice_save_locals(env, src)
279
+
else
280
+
src0 = src
281
+
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
285
+
clear_stream()
286
+
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_()
291
+
return print_values(chunk())
292
+
end
293
+
local function _10_(...)
294
+
return on_error("Runtime", ...)
295
+
end
296
+
xpcall(_9_, _10_)
297
+
end
298
+
end
299
+
end
300
+
utils.root.options = old_root_options
301
+
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
+
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)
365
+
end
366
+
else
367
+
appearances[t] = ((appearances[t] or 0) + 1)
368
+
end
369
+
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)
401
+
else
402
+
opener_length = 1
403
+
end
404
+
return (indent + opener_length)
405
+
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
689
+
end
690
+
package.preload["fennel.specials"] = package.preload["fennel.specials"] or function(...)
691
+
local utils = require("fennel.utils")
692
+
local view = require("fennel.view")
693
+
local parser = require("fennel.parser")
694
+
local compiler = require("fennel.compiler")
695
+
local unpack = (table.unpack or _G.unpack)
696
+
local SPECIALS = compiler.scopes.global.specials
697
+
local function wrap_env(env)
698
+
local function _0_(_, key)
699
+
if (type(key) == "string") then
700
+
return env[compiler["global-unmangling"](key)]
701
+
else
702
+
return env[key]
703
+
end
704
+
end
705
+
local function _1_(_, key, value)
706
+
if (type(key) == "string") then
707
+
env[compiler["global-unmangling"](key)] = value
708
+
return nil
709
+
else
710
+
env[key] = value
711
+
return nil
712
+
end
713
+
end
714
+
local function _2_()
715
+
local function putenv(k, v)
716
+
local _3_
717
+
if (type(k) == "string") then
718
+
_3_ = compiler["global-unmangling"](k)
719
+
else
720
+
_3_ = k
721
+
end
722
+
return _3_, v
723
+
end
724
+
return next, utils.kvmap(env, putenv), nil
725
+
end
726
+
return setmetatable({}, {__index = _0_, __newindex = _1_, __pairs = _2_})
727
+
end
728
+
local function current_global_names(env)
729
+
return utils.kvmap((env or _G), compiler["global-unmangling"])
730
+
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
737
+
else
738
+
return assert(load(code, filename, "t", environment0))
739
+
end
740
+
end
741
+
local function doc_2a(tgt, name)
742
+
if not tgt then
743
+
return (name .. " not found")
744
+
else
745
+
local docstring = (((compiler.metadata):get(tgt, "fnl/docstring") or "#<undocumented>")):gsub("\n$", ""):gsub("\n", "\n ")
746
+
local mt = getmetatable(tgt)
747
+
if ((type(tgt) == "function") or ((type(mt) == "table") and (type(mt.__call) == "function"))) then
748
+
local arglist = table.concat(((compiler.metadata):get(tgt, "fnl/arglist") or {"#<unknown-arguments>"}), " ")
749
+
local _0_
750
+
if (#arglist > 0) then
751
+
_0_ = " "
752
+
else
753
+
_0_ = ""
754
+
end
755
+
return string.format("(%s%s%s)\n %s", name, _0_, arglist, docstring)
756
+
else
757
+
return string.format("%s\n %s", name, docstring)
758
+
end
759
+
end
760
+
end
761
+
local function doc_special(name, arglist, docstring)
762
+
compiler.metadata[SPECIALS[name]] = {["fnl/arglist"] = arglist, ["fnl/docstring"] = docstring}
763
+
return nil
764
+
end
765
+
local function compile_do(ast, scope, parent, start)
766
+
local start0 = (start or 2)
767
+
local len = #ast
768
+
local sub_scope = compiler["make-scope"](scope)
769
+
for i = start0, len do
770
+
compiler.compile1(ast[i], sub_scope, parent, {nval = 0})
771
+
end
772
+
return nil
773
+
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 {})
778
+
local len = #ast
779
+
local retexprs = {returned = true}
780
+
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})
783
+
else
784
+
for i = start0, len do
785
+
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
+
local _ = utils["propagate-options"](opts, subopts)
787
+
local subexprs = compiler.compile1(ast[i], sub_scope0, chunk0, subopts)
788
+
if (i ~= len) then
789
+
compiler["keep-side-effects"](subexprs, parent, nil, ast[i])
790
+
end
791
+
end
792
+
end
793
+
compiler.emit(parent, chunk0, ast)
794
+
compiler.emit(parent, "end", ast)
795
+
return (outer_retexprs or retexprs)
796
+
end
797
+
if (opts.target or (opts.nval == 0) or opts.tail) then
798
+
compiler.emit(parent, "do", ast)
799
+
return compile_body(opts.target, opts.tail)
800
+
elseif opts.nval then
801
+
local syms = {}
802
+
for i = 1, opts.nval do
803
+
local s = ((pre_syms and pre_syms[i]) or compiler.gensym(scope))
804
+
syms[i] = s
805
+
retexprs[i] = utils.expr(s, "sym")
806
+
end
807
+
local outer_target = table.concat(syms, ", ")
808
+
compiler.emit(parent, string.format("local %s", outer_target), ast)
809
+
compiler.emit(parent, "do", ast)
810
+
return compile_body(outer_target, opts.tail)
811
+
else
812
+
local fname = compiler.gensym(scope)
813
+
local fargs = nil
814
+
if scope.vararg then
815
+
fargs = "..."
816
+
else
817
+
fargs = ""
818
+
end
819
+
compiler.emit(parent, string.format("local function %s(%s)", fname, fargs), ast)
820
+
utils.hook("do", ast, sub_scope0)
821
+
return compile_body(nil, true, utils.expr((fname .. "(" .. fargs .. ")"), "statement"))
822
+
end
823
+
end
824
+
doc_special("do", {"..."}, "Evaluate multiple forms; return last value.")
825
+
SPECIALS.values = function(ast, scope, parent)
826
+
local len = #ast
827
+
local exprs = {}
828
+
for i = 2, len do
829
+
local subexprs = compiler.compile1(ast[i], scope, parent, {nval = ((i ~= len) and 1)})
830
+
table.insert(exprs, subexprs[1])
831
+
if (i == len) then
832
+
for j = 2, #subexprs do
833
+
table.insert(exprs, subexprs[j])
834
+
end
835
+
end
836
+
end
837
+
return exprs
838
+
end
839
+
doc_special("values", {"..."}, "Return multiple values from a function. Must be in tail position.")
840
+
local function deep_tostring(x, key_3f)
841
+
local elems = {}
842
+
if utils["sequence?"](x) then
843
+
local _0_
844
+
do
845
+
local tbl_0_ = {}
846
+
for _, v in ipairs(x) do
847
+
tbl_0_[(#tbl_0_ + 1)] = deep_tostring(v)
848
+
end
849
+
_0_ = tbl_0_
850
+
end
851
+
return ("[" .. table.concat(_0_, " ") .. "]")
852
+
elseif utils["table?"](x) then
853
+
local _0_
854
+
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))
858
+
end
859
+
_0_ = tbl_0_
860
+
end
861
+
return ("{" .. table.concat(_0_, " ") .. "}")
862
+
elseif (key_3f and (type(x) == "string") and x:find("^[-%w?\\^_!$%&*+./@:|<=>]+$")) then
863
+
return (":" .. x)
864
+
elseif (type(x) == "string") then
865
+
return string.format("%q", x):gsub("\\\"", "\\\\\""):gsub("\"", "\\\"")
866
+
else
867
+
return tostring(x)
868
+
end
869
+
end
870
+
local function set_fn_metadata(arg_list, docstring, parent, fn_name)
871
+
if utils.root.options.useMetadata then
872
+
local args = nil
873
+
local function _0_(v)
874
+
return ("\"%s\""):format(deep_tostring(v))
875
+
end
876
+
args = utils.map(arg_list, _0_)
877
+
local meta_fields = {"\"fnl/arglist\"", ("{" .. table.concat(args, ", ") .. "}")}
878
+
if docstring then
879
+
table.insert(meta_fields, "\"fnl/docstring\"")
880
+
table.insert(meta_fields, ("\"" .. docstring:gsub("%s+$", ""):gsub("\\", "\\\\"):gsub("\n", "\\n"):gsub("\"", "\\\"") .. "\""))
881
+
end
882
+
local meta_str = ("require(\"%s\").metadata"):format((utils.root.options.moduleName or "fennel"))
883
+
return compiler.emit(parent, ("pcall(function() %s:setall(%s, %s) end)"):format(meta_str, fn_name, table.concat(meta_fields, ", ")))
884
+
end
885
+
end
886
+
local function get_fn_name(ast, scope, fn_name, multi)
887
+
if (fn_name and (fn_name[1] ~= "nil")) then
888
+
local _0_
889
+
if not multi then
890
+
_0_ = compiler["declare-local"](fn_name, {}, scope, ast)
891
+
else
892
+
_0_ = compiler["symbol-to-expression"](fn_name, scope)[1]
893
+
end
894
+
return _0_, not multi, 3
895
+
else
896
+
return compiler.gensym(scope), true, 2
897
+
end
898
+
end
899
+
SPECIALS.fn = function(ast, scope, parent)
900
+
local f_scope = nil
901
+
do
902
+
local _0_0 = compiler["make-scope"](scope)
903
+
_0_0["vararg"] = false
904
+
f_scope = _0_0
905
+
end
906
+
local f_chunk = {}
907
+
local fn_sym = utils["sym?"](ast[2])
908
+
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)
910
+
local arg_list = compiler.assert(utils["table?"](ast[index]), "expected parameters table", ast)
911
+
compiler.assert((not multi or not multi["multi-sym-method-call"]), ("unexpected multi symbol " .. tostring(fn_name)), fn_sym)
912
+
local function get_arg_name(arg)
913
+
if utils["varg?"](arg) then
914
+
compiler.assert((arg == arg_list[#arg_list]), "expected vararg as last parameter", ast)
915
+
f_scope.vararg = true
916
+
return "..."
917
+
elseif (utils["sym?"](arg) and (utils.deref(arg) ~= "nil") and not utils["multi-sym?"](utils.deref(arg))) then
918
+
return compiler["declare-local"](arg, {}, f_scope, ast)
919
+
elseif utils["table?"](arg) then
920
+
local raw = utils.sym(compiler.gensym(scope))
921
+
local declared = compiler["declare-local"](raw, {}, f_scope, ast)
922
+
compiler.destructure(arg, raw, ast, f_scope, f_chunk, {declaration = true, nomulti = true, symtype = "arg"})
923
+
return declared
924
+
else
925
+
return compiler.assert(false, ("expected symbol for function parameter: %s"):format(tostring(arg)), ast[2])
926
+
end
927
+
end
928
+
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)]
933
+
else
934
+
index0, docstring = index, nil
935
+
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)"
942
+
else
943
+
_2_ = "%s = function(%s)"
944
+
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
+
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
960
+
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
+
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]))
973
+
end
974
+
end
975
+
doc_special("doc", {"x"}, "Print the docstring and arglist for a function, macro, or special form.")
976
+
local function dot(ast, scope, parent)
977
+
compiler.assert((1 < #ast), "expected table argument", ast)
978
+
local len = #ast
979
+
local _0_ = compiler.compile1(ast[2], scope, parent, {nval = 1})
980
+
local lhs = _0_[1]
981
+
if (len == 2) then
982
+
return tostring(lhs)
983
+
else
984
+
local indices = {}
985
+
for i = 3, len do
986
+
local index = ast[i]
987
+
if ((type(index) == "string") and utils["valid-lua-identifier?"](index)) then
988
+
table.insert(indices, ("." .. index))
989
+
else
990
+
local _1_ = compiler.compile1(index, scope, parent, {nval = 1})
991
+
local index0 = _1_[1]
992
+
table.insert(indices, ("[" .. tostring(index0) .. "]"))
993
+
end
994
+
end
995
+
if (tostring(lhs):find("[{\"0-9]") or ("nil" == tostring(lhs))) then
996
+
return ("(" .. tostring(lhs) .. ")" .. table.concat(indices))
997
+
else
998
+
return (tostring(lhs) .. table.concat(indices))
999
+
end
1000
+
end
1001
+
end
1002
+
SPECIALS["."] = dot
1003
+
doc_special(".", {"tbl", "key1", "..."}, "Look up key1 in tbl table. If more args are provided, do a nested lookup.")
1004
+
SPECIALS.global = function(ast, scope, parent)
1005
+
compiler.assert((#ast == 3), "expected name and value", ast)
1006
+
compiler.destructure(ast[2], ast[3], ast, scope, parent, {forceglobal = true, nomulti = true, symtype = "global"})
1007
+
return nil
1008
+
end
1009
+
doc_special("global", {"name", "val"}, "Set name as a global with val.")
1010
+
SPECIALS.set = function(ast, scope, parent)
1011
+
compiler.assert((#ast == 3), "expected name and value", ast)
1012
+
compiler.destructure(ast[2], ast[3], ast, scope, parent, {noundef = true, symtype = "set"})
1013
+
return nil
1014
+
end
1015
+
doc_special("set", {"name", "val"}, "Set a local variable to a new value. Only works on locals using var.")
1016
+
local function set_forcibly_21_2a(ast, scope, parent)
1017
+
compiler.assert((#ast == 3), "expected name and value", ast)
1018
+
compiler.destructure(ast[2], ast[3], ast, scope, parent, {forceset = true, symtype = "set"})
1019
+
return nil
1020
+
end
1021
+
SPECIALS["set-forcibly!"] = set_forcibly_21_2a
1022
+
local function local_2a(ast, scope, parent)
1023
+
compiler.assert((#ast == 3), "expected name and value", ast)
1024
+
compiler.destructure(ast[2], ast[3], ast, scope, parent, {declaration = true, nomulti = true, symtype = "local"})
1025
+
return nil
1026
+
end
1027
+
SPECIALS["local"] = local_2a
1028
+
doc_special("local", {"name", "val"}, "Introduce new top-level immutable local.")
1029
+
SPECIALS.var = function(ast, scope, parent)
1030
+
compiler.assert((#ast == 3), "expected name and value", ast)
1031
+
compiler.destructure(ast[2], ast[3], ast, scope, parent, {declaration = true, isvar = true, nomulti = true, symtype = "var"})
1032
+
return nil
1033
+
end
1034
+
doc_special("var", {"name", "val"}, "Introduce new mutable local.")
1035
+
SPECIALS.let = function(ast, scope, parent, opts)
1036
+
local bindings = ast[2]
1037
+
local pre_syms = {}
1038
+
compiler.assert((utils["list?"](bindings) or utils["table?"](bindings)), "expected binding table", ast)
1039
+
compiler.assert(((#bindings % 2) == 0), "expected even number of name/value bindings", ast[2])
1040
+
compiler.assert((#ast >= 3), "expected body expression", ast[1])
1041
+
for _ = 1, (opts.nval or 0) do
1042
+
table.insert(pre_syms, compiler.gensym(scope))
1043
+
end
1044
+
local sub_scope = compiler["make-scope"](scope)
1045
+
local sub_chunk = {}
1046
+
for i = 1, #bindings, 2 do
1047
+
compiler.destructure(bindings[i], bindings[(i + 1)], ast, sub_scope, sub_chunk, {declaration = true, nomulti = true, symtype = "let"})
1048
+
end
1049
+
return SPECIALS["do"](ast, scope, parent, opts, 3, sub_chunk, sub_scope, pre_syms)
1050
+
end
1051
+
doc_special("let", {"[name1 val1 ... nameN valN]", "..."}, "Introduces a new scope in which a given set of local bindings are used.")
1052
+
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]
1055
+
local keys = {}
1056
+
for i = 3, (#ast - 1) do
1057
+
local _0_ = compiler.compile1(ast[i], scope, parent, {nval = 1})
1058
+
local key = _0_[1]
1059
+
table.insert(keys, tostring(key))
1060
+
end
1061
+
local value = compiler.compile1(ast[#ast], scope, parent, {nval = 1})[1]
1062
+
local rootstr = tostring(root)
1063
+
local fmtstr = nil
1064
+
if rootstr:match("^{") then
1065
+
fmtstr = "do end (%s)[%s] = %s"
1066
+
else
1067
+
fmtstr = "%s[%s] = %s"
1068
+
end
1069
+
return compiler.emit(parent, fmtstr:format(tostring(root), table.concat(keys, "]["), tostring(value)), ast)
1070
+
end
1071
+
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
+
local function calculate_target(scope, opts)
1073
+
if not (opts.tail or opts.target or opts.nval) then
1074
+
return "iife", true, nil
1075
+
elseif (opts.nval and (opts.nval ~= 0) and not opts.target) then
1076
+
local accum = {}
1077
+
local target_exprs = {}
1078
+
for i = 1, opts.nval do
1079
+
local s = compiler.gensym(scope)
1080
+
accum[i] = s
1081
+
target_exprs[i] = utils.expr(s, "sym")
1082
+
end
1083
+
return "target", opts.tail, table.concat(accum, ", "), target_exprs
1084
+
else
1085
+
return "none", opts.tail, opts.target
1086
+
end
1087
+
end
1088
+
local function if_2a(ast, scope, parent, opts)
1089
+
local do_scope = compiler["make-scope"](scope)
1090
+
local branches = {}
1091
+
local wrapper, inner_tail, inner_target, target_exprs = calculate_target(scope, opts)
1092
+
local body_opts = {nval = opts.nval, tail = inner_tail, target = inner_target}
1093
+
local function compile_body(i)
1094
+
local chunk = {}
1095
+
local cscope = compiler["make-scope"](do_scope)
1096
+
compiler["keep-side-effects"](compiler.compile1(ast[i], cscope, chunk, body_opts), chunk, nil, ast[i])
1097
+
return {chunk = chunk, scope = cscope}
1098
+
end
1099
+
for i = 2, (#ast - 1), 2 do
1100
+
local condchunk = {}
1101
+
local res = compiler.compile1(ast[i], do_scope, condchunk, {nval = 1})
1102
+
local cond = res[1]
1103
+
local branch = compile_body((i + 1))
1104
+
branch.cond = cond
1105
+
branch.condchunk = condchunk
1106
+
branch.nested = ((i ~= 2) and (next(condchunk, nil) == nil))
1107
+
table.insert(branches, branch)
1108
+
end
1109
+
local has_else_3f = ((#ast > 3) and ((#ast % 2) == 0))
1110
+
local else_branch = (has_else_3f and compile_body(#ast))
1111
+
local s = compiler.gensym(scope)
1112
+
local buffer = {}
1113
+
local last_buffer = buffer
1114
+
for i = 1, #branches do
1115
+
local branch = branches[i]
1116
+
local fstr = nil
1117
+
if not branch.nested then
1118
+
fstr = "if %s then"
1119
+
else
1120
+
fstr = "elseif %s then"
1121
+
end
1122
+
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
1129
+
if branch.nested then
1130
+
compiler.emit(last_buffer, branch.condchunk, ast)
1131
+
else
1132
+
for _, v in ipairs(branch.condchunk) do
1133
+
compiler.emit(last_buffer, v, ast)
1134
+
end
1135
+
end
1136
+
compiler.emit(last_buffer, cond_line, ast)
1137
+
compiler.emit(last_buffer, branch.chunk, ast)
1138
+
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
1146
+
compiler.emit(last_buffer, "end", ast)
1147
+
elseif not branches[(i + 1)].nested then
1148
+
local next_buffer = {}
1149
+
compiler.emit(last_buffer, "else", ast)
1150
+
compiler.emit(last_buffer, next_buffer, ast)
1151
+
compiler.emit(last_buffer, "end", ast)
1152
+
last_buffer = next_buffer
1153
+
end
1154
+
end
1155
+
if (wrapper == "iife") then
1156
+
local iifeargs = ((scope.vararg and "...") or "")
1157
+
compiler.emit(parent, ("local function %s(%s)"):format(tostring(s), iifeargs), ast)
1158
+
compiler.emit(parent, buffer, ast)
1159
+
compiler.emit(parent, "end", ast)
1160
+
return utils.expr(("%s(%s)"):format(tostring(s), iifeargs), "statement")
1161
+
elseif (wrapper == "none") then
1162
+
for i = 1, #buffer do
1163
+
compiler.emit(parent, buffer[i], ast)
1164
+
end
1165
+
return {returned = true}
1166
+
else
1167
+
compiler.emit(parent, ("local %s"):format(inner_target), ast)
1168
+
for i = 1, #buffer do
1169
+
compiler.emit(parent, buffer[i], ast)
1170
+
end
1171
+
return target_exprs
1172
+
end
1173
+
end
1174
+
SPECIALS["if"] = if_2a
1175
+
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.")
1176
+
SPECIALS.each = function(ast, scope, parent)
1177
+
compiler.assert((#ast >= 3), "expected body expression", ast[1])
1178
+
local binding = compiler.assert(utils["table?"](ast[2]), "expected binding table", ast)
1179
+
local iter = table.remove(binding, #binding)
1180
+
local destructures = {}
1181
+
local new_manglings = {}
1182
+
local sub_scope = compiler["make-scope"](scope)
1183
+
local function destructure_binding(v)
1184
+
if utils["sym?"](v) then
1185
+
return compiler["declare-local"](v, {}, sub_scope, ast, new_manglings)
1186
+
else
1187
+
local raw = utils.sym(compiler.gensym(sub_scope))
1188
+
destructures[raw] = v
1189
+
return compiler["declare-local"](raw, {}, sub_scope, ast)
1190
+
end
1191
+
end
1192
+
local bind_vars = utils.map(binding, destructure_binding)
1193
+
local vals = compiler.compile1(iter, sub_scope, parent)
1194
+
local val_names = utils.map(vals, tostring)
1195
+
local chunk = {}
1196
+
compiler.emit(parent, ("for %s in %s do"):format(table.concat(bind_vars, ", "), table.concat(val_names, ", ")), ast)
1197
+
for raw, args in utils.stablepairs(destructures) do
1198
+
compiler.destructure(args, raw, ast, sub_scope, chunk, {declaration = true, nomulti = true, symtype = "each"})
1199
+
end
1200
+
compiler["apply-manglings"](sub_scope, new_manglings, ast)
1201
+
compile_do(ast, sub_scope, chunk, 3)
1202
+
compiler.emit(parent, chunk, ast)
1203
+
return compiler.emit(parent, "end", ast)
1204
+
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.")
1206
+
local function while_2a(ast, scope, parent)
1207
+
local len1 = #parent
1208
+
local condition = compiler.compile1(ast[2], scope, parent, {nval = 1})[1]
1209
+
local len2 = #parent
1210
+
local sub_chunk = {}
1211
+
if (len1 ~= len2) then
1212
+
for i = (len1 + 1), len2 do
1213
+
table.insert(sub_chunk, parent[i])
1214
+
parent[i] = nil
1215
+
end
1216
+
compiler.emit(parent, "while true do", ast)
1217
+
compiler.emit(sub_chunk, ("if not %s then break end"):format(condition[1]), ast)
1218
+
else
1219
+
compiler.emit(parent, ("while " .. tostring(condition) .. " do"), ast)
1220
+
end
1221
+
compile_do(ast, compiler["make-scope"](scope), sub_chunk, 3)
1222
+
compiler.emit(parent, sub_chunk, ast)
1223
+
return compiler.emit(parent, "end", ast)
1224
+
end
1225
+
SPECIALS["while"] = while_2a
1226
+
doc_special("while", {"condition", "..."}, "The classic while loop. Evaluates body until a condition is non-truthy.")
1227
+
local function for_2a(ast, scope, parent)
1228
+
local ranges = compiler.assert(utils["table?"](ast[2]), "expected binding table", ast)
1229
+
local binding_sym = table.remove(ast[2], 1)
1230
+
local sub_scope = compiler["make-scope"](scope)
1231
+
local range_args = {}
1232
+
local chunk = {}
1233
+
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])
1235
+
for i = 1, math.min(#ranges, 3) do
1236
+
range_args[i] = tostring(compiler.compile1(ranges[i], sub_scope, parent, {nval = 1})[1])
1237
+
end
1238
+
compiler.emit(parent, ("for %s = %s do"):format(compiler["declare-local"](binding_sym, {}, sub_scope, ast), table.concat(range_args, ", ")), ast)
1239
+
compile_do(ast, sub_scope, chunk, 3)
1240
+
compiler.emit(parent, chunk, ast)
1241
+
return compiler.emit(parent, "end", ast)
1242
+
end
1243
+
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).")
1245
+
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
1252
+
call_string = "(%s):%s(%s)"
1253
+
else
1254
+
call_string = "%s:%s(%s)"
1255
+
end
1256
+
return utils.expr(string.format(call_string, tostring(target), method_string, table.concat(args, ", ")), "statement")
1257
+
end
1258
+
local function nonnative_method_call(ast, scope, parent, target, args)
1259
+
local method_string = tostring(compiler.compile1(ast[3], scope, parent, {nval = 1})[1])
1260
+
local args0 = {tostring(target), unpack(args)}
1261
+
return utils.expr(string.format("%s[%s](%s)", tostring(target), method_string, table.concat(args0, ", ")), "statement")
1262
+
end
1263
+
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])
1265
+
local call = "(function(tgt, m, ...) return tgt[m](tgt, ...) end)(%s, %s)"
1266
+
table.insert(args, 1, method_string)
1267
+
return utils.expr(string.format(call, tostring(target), table.concat(args, ", ")), "statement")
1268
+
end
1269
+
local function method_call(ast, scope, parent)
1270
+
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]
1273
+
local args = {}
1274
+
for i = 4, #ast do
1275
+
local subexprs = nil
1276
+
local _1_
1277
+
if (i ~= #ast) then
1278
+
_1_ = 1
1279
+
else
1280
+
_1_ = nil
1281
+
end
1282
+
subexprs = compiler.compile1(ast[i], scope, parent, {nval = _1_})
1283
+
utils.map(subexprs, tostring, args)
1284
+
end
1285
+
if ((type(ast[3]) == "string") and utils["valid-lua-identifier?"](ast[3])) then
1286
+
return native_method_call(ast, scope, parent, target, args)
1287
+
elseif (target.type == "sym") then
1288
+
return nonnative_method_call(ast, scope, parent, target, args)
1289
+
else
1290
+
return double_eval_protected_method_call(ast, scope, parent, target, args)
1291
+
end
1292
+
end
1293
+
SPECIALS[":"] = method_call
1294
+
doc_special(":", {"tbl", "method-name", "..."}, "Call the named method on tbl with the provided args.\nMethod name doesn't have to be known at compile-time; if it is, use\n(tbl:method-name ...) instead.")
1295
+
SPECIALS.comment = function(ast, _, parent)
1296
+
local els = {}
1297
+
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_())
1303
+
end
1304
+
return compiler.emit(parent, ("-- " .. table.concat(els, " ")), ast)
1305
+
end
1306
+
doc_special("comment", {"..."}, "Comment which will be emitted in Lua output.")
1307
+
local function hashfn_max_used(f_scope, i, max)
1308
+
local max0 = nil
1309
+
if f_scope.symmeta[("$" .. i)].used then
1310
+
max0 = i
1311
+
else
1312
+
max0 = max
1313
+
end
1314
+
if (i < 9) then
1315
+
return hashfn_max_used(f_scope, (i + 1), max0)
1316
+
else
1317
+
return max0
1318
+
end
1319
+
end
1320
+
SPECIALS.hashfn = function(ast, scope, parent)
1321
+
compiler.assert((#ast == 2), "expected one argument", ast)
1322
+
local f_scope = nil
1323
+
do
1324
+
local _0_0 = compiler["make-scope"](scope)
1325
+
_0_0["vararg"] = false
1326
+
_0_0["hashfn"] = true
1327
+
f_scope = _0_0
1328
+
end
1329
+
local f_chunk = {}
1330
+
local name = compiler.gensym(scope)
1331
+
local symbol = utils.sym(name)
1332
+
local args = {}
1333
+
compiler["declare-local"](symbol, {}, scope, ast)
1334
+
for i = 1, 9 do
1335
+
args[i] = compiler["declare-local"](utils.sym(("$" .. i)), {}, f_scope, ast)
1336
+
end
1337
+
local function walker(idx, node, parent_node)
1338
+
if (utils["sym?"](node) and (utils.deref(node) == "$...")) then
1339
+
parent_node[idx] = utils.varg()
1340
+
f_scope.vararg = true
1341
+
return nil
1342
+
else
1343
+
return (utils["list?"](node) or utils["table?"](node))
1344
+
end
1345
+
end
1346
+
utils["walk-tree"](ast[2], walker)
1347
+
compiler.compile1(ast[2], f_scope, f_chunk, {tail = true})
1348
+
local max_used = hashfn_max_used(f_scope, 1, 0)
1349
+
if f_scope.vararg then
1350
+
compiler.assert((max_used == 0), "$ and $... in hashfn are mutually exclusive", ast)
1351
+
end
1352
+
local arg_str = nil
1353
+
if f_scope.vararg then
1354
+
arg_str = utils.deref(utils.varg())
1355
+
else
1356
+
arg_str = table.concat(args, ", ", 1, max_used)
1357
+
end
1358
+
compiler.emit(parent, string.format("local function %s(%s)", name, arg_str), ast)
1359
+
compiler.emit(parent, f_chunk, ast)
1360
+
compiler.emit(parent, "end", ast)
1361
+
return utils.expr(name, "sym")
1362
+
end
1363
+
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)
1365
+
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
1395
+
end
1396
+
SPECIALS[name] = _0_
1397
+
end
1398
+
return doc_special(name, {"a", "b", "..."}, "Arithmetic operator; works the same as Lua but accepts more arguments.")
1399
+
end
1400
+
define_arithmetic_special("+", "0")
1401
+
define_arithmetic_special("..", "''")
1402
+
define_arithmetic_special("^")
1403
+
define_arithmetic_special("-", nil, "")
1404
+
define_arithmetic_special("*", "1")
1405
+
define_arithmetic_special("%")
1406
+
define_arithmetic_special("/", nil, "1")
1407
+
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")
1420
+
doc_special("and", {"a", "b", "..."}, "Boolean operator; works the same as Lua but accepts more arguments.")
1421
+
doc_special("or", {"a", "b", "..."}, "Boolean operator; works the same as Lua but accepts more arguments.")
1422
+
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]
1432
+
return string.format("(%s %s %s)", tostring(lhs), op, tostring(rhs))
1433
+
end
1434
+
local function double_eval_protected_comparator(op, chain_op, ast, scope, parent)
1435
+
local arglist = {}
1436
+
local comparisons = {}
1437
+
local vals = {}
1438
+
local chain = string.format(" %s ", (chain_op or "and"))
1439
+
for i = 2, #ast do
1440
+
table.insert(arglist, tostring(compiler.gensym(scope)))
1441
+
table.insert(vals, tostring(compiler.compile1(ast[i], scope, parent, {nval = 1})[1]))
1442
+
end
1443
+
for i = 1, (#arglist - 1) do
1444
+
table.insert(comparisons, string.format("(%s %s %s)", arglist[i], op, arglist[(i + 1)]))
1445
+
end
1446
+
return string.format("(function(%s) return %s end)(%s)", table.concat(arglist, ","), table.concat(comparisons, chain), table.concat(vals, ","))
1447
+
end
1448
+
local function define_comparator_special(name, lua_op, chain_op)
1449
+
do
1450
+
local op = (lua_op or name)
1451
+
local function opfn(ast, scope, parent)
1452
+
compiler.assert((2 < #ast), "expected at least two arguments", ast)
1453
+
if (3 == #ast) then
1454
+
return native_comparator(op, ast, scope, parent)
1455
+
else
1456
+
return double_eval_protected_comparator(op, chain_op, ast, scope, parent)
1457
+
end
1458
+
end
1459
+
SPECIALS[name] = opfn
1460
+
end
1461
+
return doc_special(name, {"a", "b", "..."}, "Comparison operator; works the same as Lua but accepts more arguments.")
1462
+
end
1463
+
define_comparator_special(">")
1464
+
define_comparator_special("<")
1465
+
define_comparator_special(">=")
1466
+
define_comparator_special("<=")
1467
+
define_comparator_special("=", "==")
1468
+
define_comparator_special("not=", "~=", "or")
1469
+
SPECIALS["~="] = SPECIALS["not="]
1470
+
local function define_unary_special(op, realop)
1471
+
local function opfn(ast, scope, parent)
1472
+
compiler.assert((#ast == 2), "expected one argument", ast)
1473
+
local tail = compiler.compile1(ast[2], scope, parent, {nval = 1})
1474
+
return ((realop or op) .. tostring(tail[1]))
1475
+
end
1476
+
SPECIALS[op] = opfn
1477
+
return nil
1478
+
end
1479
+
define_unary_special("not", "not ")
1480
+
doc_special("not", {"x"}, "Logical operator; works the same as Lua.")
1481
+
define_unary_special("bnot", "~")
1482
+
doc_special("bnot", {"x"}, "Bitwise negation; only works in Lua 5.3+.")
1483
+
define_unary_special("length", "#")
1484
+
doc_special("length", {"x"}, "Returns the length of a table or string.")
1485
+
SPECIALS["#"] = SPECIALS.length
1486
+
SPECIALS.quote = function(ast, scope, parent)
1487
+
compiler.assert((#ast == 2), "expected one argument")
1488
+
local runtime, this_scope = true, scope
1489
+
while this_scope do
1490
+
this_scope = this_scope.parent
1491
+
if (this_scope == compiler.scopes.compiler) then
1492
+
runtime = false
1493
+
end
1494
+
end
1495
+
return compiler["do-quote"](ast[2], scope, parent, runtime)
1496
+
end
1497
+
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))
1505
+
end
1506
+
return v
1507
+
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_()
1511
+
return compiler.scopes.macro
1512
+
end
1513
+
local function _2_(symbol)
1514
+
compiler.assert(compiler.scopes.macro, "must call from macro", ast)
1515
+
return compiler.scopes.macro.manglings[tostring(symbol)]
1516
+
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)
1521
+
compiler.assert(compiler.scopes.macro, "must call from macro", ast)
1522
+
return compiler.macroexpand(form, compiler.scopes.macro)
1523
+
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
1533
+
else
1534
+
local _ = _5_0
1535
+
_6_ = safe_compiler_env
1536
+
end
1537
+
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_})
1539
+
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}
1543
+
local function escapepat(str)
1544
+
return string.gsub(str, "[^%w]", "%%%1")
1545
+
end
1546
+
local function search_module(modulename, pathstring)
1547
+
local pathsepesc = escapepat(pkg_config.pathsep)
1548
+
local pattern = ("([^%s]*)%s"):format(pathsepesc, pathsepesc)
1549
+
local no_dot_module = modulename:gsub("%.", pkg_config.dirsep)
1550
+
local fullpath = ((pathstring or utils["fennel-module"].path) .. pkg_config.pathsep)
1551
+
local function try_path(path)
1552
+
local filename = path:gsub(escapepat(pkg_config.pathmark), no_dot_module)
1553
+
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
1557
+
file:close()
1558
+
return filename
1559
+
end
1560
+
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)))
1566
+
end
1567
+
end
1568
+
return find_in_path(1)
1569
+
end
1570
+
local function make_searcher(options)
1571
+
local function _1_(module_name)
1572
+
local opts = utils.copy(utils.root.options)
1573
+
for k, v in pairs((options or {})) do
1574
+
opts[k] = v
1575
+
end
1576
+
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, ...)
1582
+
end
1583
+
return _3_, filename
1584
+
end
1585
+
end
1586
+
return _1_
1587
+
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)
1592
+
end
1593
+
return allowed
1594
+
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)
1599
+
end
1600
+
local macro_loaded = {}
1601
+
local function metadata_only_fennel(modname)
1602
+
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}
1604
+
end
1605
+
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
1611
+
end
1612
+
return (macro_loaded[modname] or metadata_only_fennel(modname) or _1_())
1613
+
end
1614
+
local function add_macros(macros_2a, ast, scope)
1615
+
compiler.assert(utils["table?"](macros_2a), "expected macros to be table", ast)
1616
+
for k, v in pairs(macros_2a) do
1617
+
compiler.assert((type(v) == "function"), "expected each macro to be function", ast)
1618
+
scope.macros[k] = v
1619
+
end
1620
+
return nil
1621
+
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))
1628
+
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)
1631
+
end
1632
+
return add_macros(macro_loaded[modname], ast, scope, parent)
1633
+
end
1634
+
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
+
local function emit_included_fennel(src, path, opts, sub_chunk)
1636
+
local subscope = compiler["make-scope"](utils.root.scope.parent)
1637
+
local forms = {}
1638
+
if utils.root.options.requireAsInclude then
1639
+
subscope.specials.require = compiler["require-include"]
1640
+
end
1641
+
for _, val in parser.parser(parser["string-stream"](src), path) do
1642
+
table.insert(forms, val)
1643
+
end
1644
+
for i = 1, #forms do
1645
+
local subopts = nil
1646
+
if (i == #forms) then
1647
+
subopts = {tail = true}
1648
+
else
1649
+
subopts = {nval = 0}
1650
+
end
1651
+
utils["propagate-options"](opts, subopts)
1652
+
compiler.compile1(forms[i], subscope, sub_chunk, subopts)
1653
+
end
1654
+
return nil
1655
+
end
1656
+
local function include_path(ast, opts, path, mod, fennel_3f)
1657
+
utils.root.scope.includes[mod] = "fnl/loading"
1658
+
local src = nil
1659
+
do
1660
+
local f = assert(io.open(path))
1661
+
local function close_handlers_0_(ok_0_, ...)
1662
+
f:close()
1663
+
if ok_0_ then
1664
+
return ...
1665
+
else
1666
+
return error(..., 0)
1667
+
end
1668
+
end
1669
+
local function _1_()
1670
+
return f:read("*all"):gsub("[\13\n]*$", "")
1671
+
end
1672
+
src = close_handlers_0_(xpcall(_1_, (package.loaded.fennel or debug).traceback))
1673
+
end
1674
+
local ret = utils.expr(("require(\"" .. mod .. "\")"), "statement")
1675
+
local target = ("package.preload[%q]"):format(mod)
1676
+
local preload_str = (target .. " = " .. target .. " or function(...)")
1677
+
local temp_chunk, sub_chunk = {}, {}
1678
+
compiler.emit(temp_chunk, preload_str, ast)
1679
+
compiler.emit(temp_chunk, sub_chunk)
1680
+
compiler.emit(temp_chunk, "end", ast)
1681
+
for i, v in ipairs(temp_chunk) do
1682
+
table.insert(utils.root.chunk, i, v)
1683
+
end
1684
+
if fennel_3f then
1685
+
emit_included_fennel(src, path, opts, sub_chunk)
1686
+
else
1687
+
compiler.emit(sub_chunk, src, ast)
1688
+
end
1689
+
utils.root.scope.includes[mod] = ret
1690
+
return ret
1691
+
end
1692
+
local function include_circular_fallback(mod, modexpr, fallback, ast)
1693
+
if (utils.root.scope.includes[mod] == "fnl/loading") then
1694
+
compiler.assert(fallback, "circular include detected", ast)
1695
+
return fallback(modexpr)
1696
+
end
1697
+
end
1698
+
SPECIALS.include = function(ast, scope, parent, opts)
1699
+
compiler.assert((#ast == 2), "expected one argument", ast)
1700
+
local modexpr = compiler.compile1(ast[2], scope, parent, {nval = 1})[1]
1701
+
if ((modexpr.type ~= "literal") or ((modexpr[1]):byte() ~= 34)) then
1702
+
if opts.fallback then
1703
+
return opts.fallback(modexpr)
1704
+
else
1705
+
return compiler.assert(false, "module name must be string literal", ast)
1706
+
end
1707
+
else
1708
+
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
1713
+
return include_path(ast, opts, fennel_path, mod, true)
1714
+
else
1715
+
local _ = _1_0
1716
+
local lua_path = search_module(mod, package.path)
1717
+
if lua_path then
1718
+
return include_path(ast, opts, lua_path, mod, false)
1719
+
elseif opts.fallback then
1720
+
return opts.fallback(modexpr)
1721
+
else
1722
+
return compiler.assert(false, ("module not found " .. mod), ast)
1723
+
end
1724
+
end
1725
+
end
1726
+
return (include_circular_fallback(mod, modexpr, opts.fallback, ast) or utils.root.scope.includes[mod] or _2_())
1727
+
end
1728
+
end
1729
+
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.")
1730
+
local function eval_compiler_2a(ast, scope, parent)
1731
+
local env = make_compiler_env(ast, scope, parent)
1732
+
local opts = utils.copy(utils.root.options)
1733
+
opts.scope = compiler["make-scope"](compiler.scopes.compiler)
1734
+
opts.allowedGlobals = macro_globals(env, current_global_names())
1735
+
return load_code(compiler.compile(ast, opts), wrap_env(env))(opts["module-name"], ast.filename)
1736
+
end
1737
+
SPECIALS.macros = function(ast, scope, parent)
1738
+
compiler.assert((#ast == 2), "Expected one table argument", ast)
1739
+
return add_macros(eval_compiler_2a(ast[2], scope, parent), ast, scope, parent)
1740
+
end
1741
+
doc_special("macros", {"{:macro-name-1 (fn [...] ...) ... :macro-name-N macro-body-N}"}, "Define all functions in the given table as macros local to the current scope.")
1742
+
SPECIALS["eval-compiler"] = function(ast, scope, parent)
1743
+
local old_first = ast[1]
1744
+
ast[1] = utils.sym("do")
1745
+
local val = eval_compiler_2a(ast, scope, parent)
1746
+
ast[1] = old_first
1747
+
return val
1748
+
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}
1751
+
end
1752
+
package.preload["fennel.compiler"] = package.preload["fennel.compiler"] or function(...)
1753
+
local utils = require("fennel.utils")
1754
+
local parser = require("fennel.parser")
1755
+
local friend = require("fennel.friend")
1756
+
local unpack = (table.unpack or _G.unpack)
1757
+
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)
1763
+
else
1764
+
_0_ = 0
1765
+
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)}
1767
+
end
1768
+
local function assert_msg(ast, msg)
1769
+
local ast_tbl = nil
1770
+
if ("table" == type(ast)) then
1771
+
ast_tbl = ast
1772
+
else
1773
+
ast_tbl = {}
1774
+
end
1775
+
local m = getmetatable(ast)
1776
+
local filename = ((m and m.filename) or ast_tbl.filename or "unknown")
1777
+
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)
1788
+
end
1789
+
local function assert_compile(condition, msg, ast)
1790
+
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)
1797
+
else
1798
+
friend["assert-compile"](condition, msg, ast, source)
1799
+
end
1800
+
end
1801
+
return condition
1802
+
end
1803
+
scopes.global = make_scope()
1804
+
scopes.global.vararg = true
1805
+
scopes.compiler = make_scope(scopes.global)
1806
+
scopes.macro = scopes.global
1807
+
local serialize_subst = {["\11"] = "\\v", ["\12"] = "\\f", ["\7"] = "\\a", ["\8"] = "\\b", ["\9"] = "\\t", ["\n"] = "n"}
1808
+
local function serialize_string(str)
1809
+
local function _0_(_241)
1810
+
return ("\\" .. _241:byte())
1811
+
end
1812
+
return string.gsub(string.gsub(string.format("%q", str), ".", serialize_subst), "[\128-\255]", _0_)
1813
+
end
1814
+
local function global_mangling(str)
1815
+
if utils["valid-lua-identifier?"](str) then
1816
+
return str
1817
+
else
1818
+
local function _0_(_241)
1819
+
return string.format("_%02x", _241:byte())
1820
+
end
1821
+
return ("__fnl_global__" .. str:gsub("[^%w]", _0_))
1822
+
end
1823
+
end
1824
+
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)
1830
+
return string.char(tonumber(_241:sub(2), 16))
1831
+
end
1832
+
_1_0 = string.gsub(rest, "_[%da-f][%da-f]", _2_)
1833
+
return _1_0
1834
+
else
1835
+
local _ = _0_0
1836
+
return identifier
1837
+
end
1838
+
end
1839
+
local allowed_globals = nil
1840
+
local function global_allowed(name)
1841
+
return (not allowed_globals or utils["member?"](name, allowed_globals))
1842
+
end
1843
+
local function unique_mangling(original, mangling, scope, append)
1844
+
if scope.unmanglings[mangling] then
1845
+
return unique_mangling(original, (original .. append), scope, (append + 1))
1846
+
else
1847
+
return mangling
1848
+
end
1849
+
end
1850
+
local function local_mangling(str, scope, ast, temp_manglings)
1851
+
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
1854
+
raw = ("_" .. str)
1855
+
else
1856
+
raw = str
1857
+
end
1858
+
local mangling = nil
1859
+
local function _1_(_241)
1860
+
return string.format("_%02x", _241:byte())
1861
+
end
1862
+
mangling = string.gsub(string.gsub(raw, "-", "_"), "[^%w_]", _1_)
1863
+
local unique = unique_mangling(mangling, mangling, scope, 0)
1864
+
scope.unmanglings[unique] = str
1865
+
do
1866
+
local manglings = (temp_manglings or scope.manglings)
1867
+
manglings[str] = unique
1868
+
end
1869
+
return unique
1870
+
end
1871
+
local function apply_manglings(scope, new_manglings, ast)
1872
+
for raw, mangled in pairs(new_manglings) do
1873
+
assert_compile(not scope.refedglobals[mangled], ("use of global " .. raw .. " is aliased by a local"), ast)
1874
+
scope.manglings[raw] = mangled
1875
+
end
1876
+
return nil
1877
+
end
1878
+
local function combine_parts(parts, scope)
1879
+
local ret = (scope.manglings[parts[1]] or global_mangling(parts[1]))
1880
+
for i = 2, #parts do
1881
+
if utils["valid-lua-identifier?"](parts[i]) then
1882
+
if (parts["multi-sym-method-call"] and (i == #parts)) then
1883
+
ret = (ret .. ":" .. parts[i])
1884
+
else
1885
+
ret = (ret .. "." .. parts[i])
1886
+
end
1887
+
else
1888
+
ret = (ret .. "[" .. serialize_string(parts[i]) .. "]")
1889
+
end
1890
+
end
1891
+
return ret
1892
+
end
1893
+
local function gensym(scope, base)
1894
+
local append, mangling = 0, ((base or "") .. "_0_")
1895
+
while scope.unmanglings[mangling] do
1896
+
mangling = ((base or "") .. "_" .. append .. "_")
1897
+
append = (append + 1)
1898
+
end
1899
+
scope.unmanglings[mangling] = (base or true)
1900
+
return mangling
1901
+
end
1902
+
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
1913
+
return mangling
1914
+
end
1915
+
return (scope.autogensyms[base] or _1_())
1916
+
end
1917
+
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"))
1924
+
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)
1926
+
return assert_compile(not utils["quoted?"](symbol), string.format("macro tried to bind %s without gensym", name), symbol)
1927
+
end
1928
+
local function declare_local(symbol, meta, scope, ast, temp_manglings)
1929
+
check_binding_valid(symbol, scope, ast)
1930
+
local name = utils.deref(symbol)
1931
+
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)
1934
+
end
1935
+
local function hashfn_arg_name(name, multi_sym_parts, scope)
1936
+
if not scope.hashfn then
1937
+
return nil
1938
+
elseif (name == "$") then
1939
+
return "$1"
1940
+
elseif multi_sym_parts then
1941
+
if (multi_sym_parts and (multi_sym_parts[1] == "$")) then
1942
+
multi_sym_parts[1] = "$1"
1943
+
end
1944
+
return table.concat(multi_sym_parts, ".")
1945
+
end
1946
+
end
1947
+
local function symbol_to_expression(symbol, scope, reference_3f)
1948
+
utils.hook("symbol-to-expression", symbol, scope, reference_3f)
1949
+
local name = symbol[1]
1950
+
local multi_sym_parts = utils["multi-sym?"](name)
1951
+
local name0 = (hashfn_arg_name(name, multi_sym_parts, scope) or name)
1952
+
local parts = (multi_sym_parts or {name0})
1953
+
local etype = (((#parts > 1) and "expression") or "sym")
1954
+
local local_3f = scope.manglings[parts[1]]
1955
+
if (local_3f and scope.symmeta[parts[1]]) then
1956
+
scope.symmeta[parts[1]]["used"] = true
1957
+
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
1961
+
end
1962
+
return utils.expr(combine_parts(parts, scope), etype)
1963
+
end
1964
+
local function emit(chunk, out, ast)
1965
+
if (type(out) == "table") then
1966
+
return table.insert(chunk, out)
1967
+
else
1968
+
return table.insert(chunk, {ast = ast, leaf = out})
1969
+
end
1970
+
end
1971
+
local function peephole(chunk)
1972
+
if chunk.leaf then
1973
+
return chunk
1974
+
elseif ((#chunk >= 3) and (chunk[(#chunk - 2)].leaf == "do") and not chunk[(#chunk - 1)].leaf and (chunk[#chunk].leaf == "end")) then
1975
+
local kid = peephole(chunk[(#chunk - 1)])
1976
+
local new_chunk = {ast = chunk.ast}
1977
+
for i = 1, (#chunk - 3) do
1978
+
table.insert(new_chunk, peephole(chunk[i]))
1979
+
end
1980
+
for i = 1, #kid do
1981
+
table.insert(new_chunk, kid[i])
1982
+
end
1983
+
return new_chunk
1984
+
else
1985
+
return utils.map(chunk, peephole)
1986
+
end
1987
+
end
1988
+
local function flatten_chunk_correlated(main_chunk)
1989
+
local function flatten(chunk, out, last_line, file)
1990
+
local last_line0 = last_line
1991
+
if chunk.leaf then
1992
+
out[last_line0] = ((out[last_line0] or "") .. " " .. chunk.leaf)
1993
+
else
1994
+
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))
1998
+
end
1999
+
last_line0 = flatten(subchunk, out, last_line0, file)
2000
+
end
2001
+
end
2002
+
end
2003
+
return last_line0
2004
+
end
2005
+
local out = {}
2006
+
local last = flatten(main_chunk, out, 1, main_chunk.file)
2007
+
for i = 1, last do
2008
+
if (out[i] == nil) then
2009
+
out[i] = ""
2010
+
end
2011
+
end
2012
+
return table.concat(out, "\n")
2013
+
end
2014
+
local function flatten_chunk(sm, chunk, tab, depth)
2015
+
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
2022
+
else
2023
+
local tab0 = nil
2024
+
do
2025
+
local _0_0 = tab
2026
+
if (_0_0 == true) then
2027
+
tab0 = " "
2028
+
elseif (_0_0 == false) then
2029
+
tab0 = ""
2030
+
elseif (_0_0 == tab) then
2031
+
tab0 = tab
2032
+
elseif (_0_0 == nil) then
2033
+
tab0 = ""
2034
+
else
2035
+
tab0 = nil
2036
+
end
2037
+
end
2038
+
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
2042
+
return (tab0 .. sub:gsub("\n", ("\n" .. tab0)))
2043
+
else
2044
+
return sub
2045
+
end
2046
+
end
2047
+
end
2048
+
return table.concat(utils.map(chunk, parter), "\n")
2049
+
end
2050
+
end
2051
+
local fennel_sourcemap = {}
2052
+
local function make_short_src(source)
2053
+
local source0 = source:gsub("\n", " ")
2054
+
if (#source0 <= 49) then
2055
+
return ("[fennel \"" .. source0 .. "\"]")
2056
+
else
2057
+
return ("[fennel \"" .. source0:sub(1, 46) .. "...\"]")
2058
+
end
2059
+
end
2060
+
local function flatten(chunk, options)
2061
+
local chunk0 = peephole(chunk)
2062
+
if options.correlate then
2063
+
return flatten_chunk_correlated(chunk0), {}
2064
+
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
2075
+
end
2076
+
return ret, sm
2077
+
end
2078
+
end
2079
+
local function make_metadata()
2080
+
local function _0_(self, tgt, key)
2081
+
if self[tgt] then
2082
+
return self[tgt][key]
2083
+
end
2084
+
end
2085
+
local function _1_(self, tgt, key, value)
2086
+
self[tgt] = (self[tgt] or {})
2087
+
self[tgt][key] = value
2088
+
return tgt
2089
+
end
2090
+
local function _2_(self, tgt, ...)
2091
+
local kv_len = select("#", ...)
2092
+
local kvs = {...}
2093
+
if ((kv_len % 2) ~= 0) then
2094
+
error("metadata:setall() expected even number of k/v pairs")
2095
+
end
2096
+
self[tgt] = (self[tgt] or {})
2097
+
for i = 1, kv_len, 2 do
2098
+
self[tgt][kvs[i]] = kvs[(i + 1)]
2099
+
end
2100
+
return tgt
2101
+
end
2102
+
return setmetatable({}, {__index = {get = _0_, set = _1_, setall = _2_}, __mode = "k"})
2103
+
end
2104
+
local function exprs1(exprs)
2105
+
return table.concat(utils.map(exprs, 1), ", ")
2106
+
end
2107
+
local function keep_side_effects(exprs, chunk, start, ast)
2108
+
local start0 = (start or 1)
2109
+
for j = start0, #exprs do
2110
+
local se = exprs[j]
2111
+
if ((se.type == "expression") and (se[1] ~= "nil")) then
2112
+
emit(chunk, string.format("do local _ = %s end", tostring(se)), ast)
2113
+
elseif (se.type == "statement") then
2114
+
local code = tostring(se)
2115
+
emit(chunk, (((code:byte() == 40) and ("do end " .. code)) or code), ast)
2116
+
end
2117
+
end
2118
+
return nil
2119
+
end
2120
+
local function handle_compile_opts(exprs, parent, opts, ast)
2121
+
if opts.nval then
2122
+
local n = opts.nval
2123
+
local len = #exprs
2124
+
if (n ~= len) then
2125
+
if (len > n) then
2126
+
keep_side_effects(exprs, parent, (n + 1), ast)
2127
+
for i = (n + 1), len do
2128
+
exprs[i] = nil
2129
+
end
2130
+
else
2131
+
for i = (#exprs + 1), n do
2132
+
exprs[i] = utils.expr("nil", "literal")
2133
+
end
2134
+
end
2135
+
end
2136
+
end
2137
+
if opts.tail then
2138
+
emit(parent, string.format("return %s", exprs1(exprs)), ast)
2139
+
end
2140
+
if opts.target then
2141
+
local result = exprs1(exprs)
2142
+
local function _2_()
2143
+
if (result == "") then
2144
+
return "nil"
2145
+
else
2146
+
return result
2147
+
end
2148
+
end
2149
+
emit(parent, string.format("%s = %s", opts.target, _2_()), ast)
2150
+
end
2151
+
if (opts.tail or opts.target) then
2152
+
return {returned = true}
2153
+
else
2154
+
local _3_0 = exprs
2155
+
_3_0["returned"] = true
2156
+
return _3_0
2157
+
end
2158
+
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))
2163
+
else
2164
+
return t
2165
+
end
2166
+
end
2167
+
local macro_2a = (utils["sym?"](ast[1]) and scope.macros[utils.deref(ast[1])])
2168
+
if (not macro_2a and multi_sym_parts) then
2169
+
local nested_macro = find_in_table(scope.macros, 1)
2170
+
assert_compile((not scope.macros[multi_sym_parts[1]] or (type(nested_macro) == "function")), "macro not found in imported macro module", ast)
2171
+
return nested_macro
2172
+
else
2173
+
return macro_2a
2174
+
end
2175
+
end
2176
+
local function macroexpand_2a(ast, scope, once)
2177
+
if not utils["list?"](ast) then
2178
+
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
2193
+
else
2194
+
return macroexpand_2a(transformed, scope)
2195
+
end
2196
+
end
2197
+
end
2198
+
end
2199
+
local function compile_special(ast, scope, parent, opts, special)
2200
+
local exprs = (special(ast, scope, parent, opts) or utils.expr("nil", "literal"))
2201
+
local exprs0 = nil
2202
+
if (type(exprs) == "string") then
2203
+
exprs0 = utils.expr(exprs, "expression")
2204
+
else
2205
+
exprs0 = exprs
2206
+
end
2207
+
local exprs2 = nil
2208
+
if utils["expr?"](exprs0) then
2209
+
exprs2 = {exprs0}
2210
+
else
2211
+
exprs2 = exprs0
2212
+
end
2213
+
if not exprs2.returned then
2214
+
return handle_compile_opts(exprs2, parent, opts, ast)
2215
+
elseif (opts.tail or opts.target) then
2216
+
return {returned = true}
2217
+
else
2218
+
return exprs2
2219
+
end
2220
+
end
2221
+
local function compile_function_call(ast, scope, parent, opts, compile1, len)
2222
+
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)
2225
+
for i = 2, len do
2226
+
local subexprs = nil
2227
+
local _0_
2228
+
if (i ~= len) then
2229
+
_0_ = 1
2230
+
else
2231
+
_0_ = nil
2232
+
end
2233
+
subexprs = compile1(ast[i], scope, parent, {nval = _0_})
2234
+
table.insert(fargs, (subexprs[1] or utils.expr("nil", "literal")))
2235
+
if (i == len) then
2236
+
for j = 2, #subexprs do
2237
+
table.insert(fargs, subexprs[j])
2238
+
end
2239
+
else
2240
+
keep_side_effects(subexprs, parent, 2, ast[i])
2241
+
end
2242
+
end
2243
+
local call = string.format("%s(%s)", tostring(fcallee), exprs1(fargs))
2244
+
return handle_compile_opts({utils.expr(call, "statement")}, parent, opts, ast)
2245
+
end
2246
+
local function compile_call(ast, scope, parent, opts, compile1)
2247
+
utils.hook("call", ast, scope)
2248
+
local len = #ast
2249
+
local first = ast[1]
2250
+
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)
2253
+
if special then
2254
+
return compile_special(ast, scope, parent, opts, special)
2255
+
elseif (multi_sym_parts and multi_sym_parts["multi-sym-method-call"]) then
2256
+
local table_with_method = table.concat({unpack(multi_sym_parts, 1, (#multi_sym_parts - 1))}, ".")
2257
+
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)))
2259
+
return compile1(new_ast, scope, parent, opts)
2260
+
else
2261
+
return compile_function_call(ast, scope, parent, opts, compile1, len)
2262
+
end
2263
+
end
2264
+
local function compile_varg(ast, scope, parent, opts)
2265
+
assert_compile(scope.vararg, "unexpected vararg", ast)
2266
+
return handle_compile_opts({utils.expr("...", "varg")}, parent, opts, ast)
2267
+
end
2268
+
local function compile_sym(ast, scope, parent, opts)
2269
+
local multi_sym_parts = utils["multi-sym?"](ast)
2270
+
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
2272
+
if (ast[1] == "nil") then
2273
+
e = utils.expr("nil", "literal")
2274
+
else
2275
+
e = symbol_to_expression(ast, scope, true)
2276
+
end
2277
+
return handle_compile_opts({e}, parent, opts, ast)
2278
+
end
2279
+
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
2299
+
end
2300
+
local function compile_scalar(ast, _scope, parent, opts)
2301
+
local serialize = nil
2302
+
do
2303
+
local _0_0 = type(ast)
2304
+
if (_0_0 == "nil") then
2305
+
serialize = tostring
2306
+
elseif (_0_0 == "boolean") then
2307
+
serialize = tostring
2308
+
elseif (_0_0 == "string") then
2309
+
serialize = serialize_string
2310
+
elseif (_0_0 == "number") then
2311
+
serialize = serialize_number
2312
+
else
2313
+
serialize = nil
2314
+
end
2315
+
end
2316
+
return handle_compile_opts({utils.expr(serialize(ast), "literal")}, parent, opts)
2317
+
end
2318
+
local function compile_table(ast, scope, parent, opts, compile1)
2319
+
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
+
local function write_other_values(k)
2325
+
if ((type(k) ~= "number") or (math.floor(k) ~= k) or (k < 1) or (k > #ast)) then
2326
+
if ((type(k) == "string") and utils["valid-lua-identifier?"](k)) then
2327
+
return {k, k}
2328
+
else
2329
+
local _0_ = compile1(k, scope, parent, {nval = 1})
2330
+
local compiled = _0_[1]
2331
+
local kstr = ("[" .. tostring(compiled) .. "]")
2332
+
return {kstr, k}
2333
+
end
2334
+
end
2335
+
end
2336
+
do
2337
+
local keys = nil
2338
+
do
2339
+
local _0_0 = utils.kvmap(ast, write_other_values)
2340
+
local function _1_(a, b)
2341
+
return (a[1] < b[1])
2342
+
end
2343
+
table.sort(_0_0, _1_)
2344
+
keys = _0_0
2345
+
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)
2349
+
end
2350
+
utils.map(keys, _1_, buffer)
2351
+
end
2352
+
return handle_compile_opts({utils.expr(("{" .. table.concat(buffer, ", ") .. "}"), "expression")}, parent, opts, ast)
2353
+
end
2354
+
local function compile1(ast, scope, parent, opts)
2355
+
local opts0 = (opts or {})
2356
+
local ast0 = macroexpand_2a(ast, scope)
2357
+
if utils["list?"](ast0) then
2358
+
return compile_call(ast0, scope, parent, opts0, compile1)
2359
+
elseif utils["varg?"](ast0) then
2360
+
return compile_varg(ast0, scope, parent, opts0)
2361
+
elseif utils["sym?"](ast0) then
2362
+
return compile_sym(ast0, scope, parent, opts0)
2363
+
elseif (type(ast0) == "table") then
2364
+
return compile_table(ast0, scope, parent, opts0, compile1)
2365
+
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)
2367
+
else
2368
+
return assert_compile(false, ("could not compile value of type " .. type(ast0)), ast0)
2369
+
end
2370
+
end
2371
+
local function destructure(to, from, ast, scope, parent, opts)
2372
+
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"]
2381
+
local symtype0 = ("_" .. (symtype or "dst"))
2382
+
local setter = nil
2383
+
if declaration then
2384
+
setter = "local %s = %s"
2385
+
else
2386
+
setter = "%s = %s"
2387
+
end
2388
+
local new_manglings = {}
2389
+
local function getname(symbol, up1)
2390
+
local raw = symbol[1]
2391
+
assert_compile(not (nomulti and utils["multi-sym?"](raw)), ("unexpected multi symbol " .. raw), up1)
2392
+
if declaration then
2393
+
return declare_local(symbol, nil, scope, symbol, new_manglings)
2394
+
else
2395
+
local parts = (utils["multi-sym?"](raw) or {raw})
2396
+
local meta = scope.symmeta[parts[1]]
2397
+
if ((#parts == 1) and not forceset) then
2398
+
assert_compile(not (forceglobal and meta), string.format("global %s conflicts with local", tostring(symbol)), symbol)
2399
+
assert_compile(not (meta and not meta.var), ("expected var " .. raw), symbol)
2400
+
assert_compile((meta or not noundef), ("expected local " .. parts[1]), symbol)
2401
+
end
2402
+
if forceglobal then
2403
+
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
2406
+
if allowed_globals then
2407
+
table.insert(allowed_globals, raw)
2408
+
end
2409
+
end
2410
+
return symbol_to_expression(symbol, scope)[1]
2411
+
end
2412
+
end
2413
+
local function compile_top_target(lvalues)
2414
+
local inits = nil
2415
+
local function _2_(_241)
2416
+
if scope.manglings[_241] then
2417
+
return _241
2418
+
else
2419
+
return "nil"
2420
+
end
2421
+
end
2422
+
inits = utils.map(lvalues, _2_)
2423
+
local init = table.concat(inits, ", ")
2424
+
local lvalue = table.concat(lvalues, ", ")
2425
+
local plen, plast = #parent, parent[#parent]
2426
+
local ret = compile1(from, scope, parent, {target = lvalue})
2427
+
if declaration then
2428
+
for pi = plen, #parent do
2429
+
if (parent[pi] == plast) then
2430
+
plen = pi
2431
+
end
2432
+
end
2433
+
if ((#parent == (plen + 1)) and parent[#parent].leaf) then
2434
+
parent[#parent]["leaf"] = ("local " .. parent[#parent].leaf)
2435
+
else
2436
+
table.insert(parent, (plen + 1), {ast = ast, leaf = ("local " .. lvalue .. " = " .. init)})
2437
+
end
2438
+
end
2439
+
return ret
2440
+
end
2441
+
local function destructure_sym(left, rightexprs, up1, top_3f)
2442
+
local lname = getname(left, up1)
2443
+
check_binding_valid(left, scope, left)
2444
+
if top_3f then
2445
+
compile_top_target({lname})
2446
+
else
2447
+
emit(parent, setter:format(lname, exprs1(rightexprs)), left)
2448
+
end
2449
+
if declaration then
2450
+
scope.symmeta[utils.deref(left)] = {var = isvar}
2451
+
return nil
2452
+
end
2453
+
end
2454
+
local function destructure_table(left, rightexprs, top_3f, destructure1)
2455
+
local s = gensym(scope, symtype0)
2456
+
local right = nil
2457
+
do
2458
+
local _2_0 = nil
2459
+
if top_3f then
2460
+
_2_0 = exprs1(compile1(from, scope, parent))
2461
+
else
2462
+
_2_0 = exprs1(rightexprs)
2463
+
end
2464
+
if (_2_0 == "") then
2465
+
right = "nil"
2466
+
elseif (nil ~= _2_0) then
2467
+
local right0 = _2_0
2468
+
right = right0
2469
+
else
2470
+
right = nil
2471
+
end
2472
+
end
2473
+
emit(parent, string.format("local %s = %s", s, right), left)
2474
+
for k, v in utils.stablepairs(left) do
2475
+
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
2483
+
destructure_sym(v, {utils.expr(tostring(s))}, left)
2484
+
elseif (utils["sequence?"](left) and (utils.deref(v) == "&as")) then
2485
+
local _, next_sym, trailing = select(k, unpack(left))
2486
+
assert_compile((nil == trailing), "expected &as argument before last parameter", left)
2487
+
destructure_sym(next_sym, {utils.expr(tostring(s))}, left)
2488
+
else
2489
+
local key = nil
2490
+
if (type(k) == "string") then
2491
+
key = serialize_string(k)
2492
+
else
2493
+
key = k
2494
+
end
2495
+
local subexpr = utils.expr(string.format("%s[%s]", s, key), "expression")
2496
+
destructure1(v, {subexpr}, left)
2497
+
end
2498
+
end
2499
+
end
2500
+
return nil
2501
+
end
2502
+
local function destructure_values(left, up1, top_3f, destructure1)
2503
+
local left_names, tables = {}, {}
2504
+
for i, name in ipairs(left) do
2505
+
if utils["sym?"](name) then
2506
+
table.insert(left_names, getname(name, up1))
2507
+
else
2508
+
local symname = gensym(scope, symtype0)
2509
+
table.insert(left_names, symname)
2510
+
tables[i] = {name, utils.expr(symname, "sym")}
2511
+
end
2512
+
end
2513
+
assert_compile(top_3f, "can't nest multi-value destructuring", left)
2514
+
compile_top_target(left_names)
2515
+
if declaration then
2516
+
for _, sym in ipairs(left) do
2517
+
scope.symmeta[utils.deref(sym)] = {var = isvar}
2518
+
end
2519
+
end
2520
+
for _, pair in utils.stablepairs(tables) do
2521
+
destructure1(pair[1], {pair[2]}, left)
2522
+
end
2523
+
return nil
2524
+
end
2525
+
local function destructure1(left, rightexprs, up1, top_3f)
2526
+
if (utils["sym?"](left) and (left[1] ~= "nil")) then
2527
+
destructure_sym(left, rightexprs, up1, top_3f)
2528
+
elseif utils["table?"](left) then
2529
+
destructure_table(left, rightexprs, top_3f, destructure1)
2530
+
elseif utils["list?"](left) then
2531
+
destructure_values(left, up1, top_3f, destructure1)
2532
+
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))
2534
+
end
2535
+
if top_3f then
2536
+
return {returned = true}
2537
+
end
2538
+
end
2539
+
local ret = destructure1(to, nil, ast, true)
2540
+
utils.hook("destructure", from, to, scope)
2541
+
apply_manglings(scope, new_manglings, ast)
2542
+
return ret
2543
+
end
2544
+
local function require_include(ast, scope, parent, opts)
2545
+
opts.fallback = function(e)
2546
+
return utils.expr(string.format("require(%s)", tostring(e)), "statement")
2547
+
end
2548
+
return scopes.global.specials.include(ast, scope, parent, opts)
2549
+
end
2550
+
local function compile_stream(strm, options)
2551
+
local opts = utils.copy(options)
2552
+
local old_globals = allowed_globals
2553
+
local scope = (opts.scope or make_scope(scopes.global))
2554
+
local vals = {}
2555
+
local chunk = {}
2556
+
local _0_ = utils.root
2557
+
_0_["set-reset"](_0_)
2558
+
allowed_globals = opts.allowedGlobals
2559
+
if (opts.indent == nil) then
2560
+
opts.indent = " "
2561
+
end
2562
+
if opts.requireAsInclude then
2563
+
scope.specials.require = require_include
2564
+
end
2565
+
utils.root.chunk, utils.root.scope, utils.root.options = chunk, scope, opts
2566
+
for _, val in parser.parser(strm, opts.filename, opts) do
2567
+
table.insert(vals, val)
2568
+
end
2569
+
for i = 1, #vals do
2570
+
local exprs = compile1(vals[i], scope, chunk, {nval = (((i < #vals) and 0) or nil), tail = (i == #vals)})
2571
+
keep_side_effects(exprs, chunk, nil, vals[i])
2572
+
end
2573
+
allowed_globals = old_globals
2574
+
utils.root.reset()
2575
+
return flatten(chunk, opts)
2576
+
end
2577
+
local function compile_string(str, opts)
2578
+
return compile_stream(parser["string-stream"](str), (opts or {}))
2579
+
end
2580
+
local function compile(ast, opts)
2581
+
local opts0 = utils.copy(opts)
2582
+
local old_globals = allowed_globals
2583
+
local chunk = {}
2584
+
local scope = (opts0.scope or make_scope(scopes.global))
2585
+
local _0_ = utils.root
2586
+
_0_["set-reset"](_0_)
2587
+
allowed_globals = opts0.allowedGlobals
2588
+
if (opts0.indent == nil) then
2589
+
opts0.indent = " "
2590
+
end
2591
+
if opts0.requireAsInclude then
2592
+
scope.specials.require = require_include
2593
+
end
2594
+
utils.root.chunk, utils.root.scope, utils.root.options = chunk, scope, opts0
2595
+
local exprs = compile1(ast, scope, chunk, {tail = true})
2596
+
keep_side_effects(exprs, chunk, nil, ast)
2597
+
allowed_globals = old_globals
2598
+
utils.root.reset()
2599
+
return flatten(chunk, opts0)
2600
+
end
2601
+
local function traceback_frame(info)
2602
+
if ((info.what == "C") and info.name) then
2603
+
return string.format(" [C]: in function '%s'", info.name)
2604
+
elseif (info.what == "C") then
2605
+
return " [C]: in ?"
2606
+
else
2607
+
local remap = fennel_sourcemap[info.source]
2608
+
if (remap and remap[info.currentline]) then
2609
+
info["short-src"] = remap["short-src"]
2610
+
info.currentline = remap[info.currentline]
2611
+
end
2612
+
if (info.what == "Lua") then
2613
+
local function _1_()
2614
+
if info.name then
2615
+
return ("'" .. info.name .. "'")
2616
+
else
2617
+
return "?"
2618
+
end
2619
+
end
2620
+
return string.format(" %s:%d: in function %s", info.short_src, info.currentline, _1_())
2621
+
elseif (info["short-src"] == "(tail call)") then
2622
+
return " (tail call)"
2623
+
else
2624
+
return string.format(" %s:%d: in main chunk", info.short_src, info.currentline)
2625
+
end
2626
+
end
2627
+
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
2632
+
else
2633
+
local lines = {}
2634
+
if (msg0:find("^Compile error") or msg0:find("^Parse error")) then
2635
+
table.insert(lines, msg0)
2636
+
else
2637
+
local newmsg = msg0:gsub("^[^:]*:%d+:%s+", "runtime error: ")
2638
+
table.insert(lines, newmsg)
2639
+
end
2640
+
table.insert(lines, "stack traceback:")
2641
+
local done_3f, level = false, (start or 2)
2642
+
while not done_3f do
2643
+
do
2644
+
local _1_0 = debug.getinfo(level, "Sln")
2645
+
if (_1_0 == nil) then
2646
+
done_3f = true
2647
+
elseif (nil ~= _1_0) then
2648
+
local info = _1_0
2649
+
table.insert(lines, traceback_frame(info))
2650
+
end
2651
+
end
2652
+
level = (level + 1)
2653
+
end
2654
+
return table.concat(lines, "\n")
2655
+
end
2656
+
end
2657
+
local function entry_transform(fk, fv)
2658
+
local function _0_(k, v)
2659
+
if (type(k) == "number") then
2660
+
return k, fv(v)
2661
+
else
2662
+
return fk(k), fv(v)
2663
+
end
2664
+
end
2665
+
return _0_
2666
+
end
2667
+
local function no()
2668
+
return nil
2669
+
end
2670
+
local function mixed_concat(t, joiner)
2671
+
local seen = {}
2672
+
local ret, s = "", ""
2673
+
for k, v in ipairs(t) do
2674
+
table.insert(seen, k)
2675
+
ret = (ret .. s .. v)
2676
+
s = joiner
2677
+
end
2678
+
for k, v in utils.stablepairs(t) do
2679
+
if not seen[k] then
2680
+
ret = (ret .. s .. "[" .. k .. "]" .. "=" .. v)
2681
+
s = joiner
2682
+
end
2683
+
end
2684
+
return ret
2685
+
end
2686
+
local function do_quote(form, scope, parent, runtime_3f)
2687
+
local function q(x)
2688
+
return do_quote(x, scope, parent, runtime_3f)
2689
+
end
2690
+
if utils["varg?"](form) then
2691
+
assert_compile(not runtime_3f, "quoted ... may only be used at compile time", form)
2692
+
return "_VARARG"
2693
+
elseif utils["sym?"](form) then
2694
+
local filename = nil
2695
+
if form.filename then
2696
+
filename = string.format("%q", form.filename)
2697
+
else
2698
+
filename = "nil"
2699
+
end
2700
+
local symstr = utils.deref(form)
2701
+
assert_compile(not runtime_3f, "symbols may only be used at compile time", form)
2702
+
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"))
2704
+
else
2705
+
return string.format("sym('%s', nil, {quoted=true, filename=%s, line=%s})", symstr, filename, (form.line or "nil"))
2706
+
end
2707
+
elseif (utils["list?"](form) and utils["sym?"](form[1]) and (utils.deref(form[1]) == "unquote")) then
2708
+
local payload = form[2]
2709
+
local res = unpack(compile1(payload, scope, parent))
2710
+
return res[1]
2711
+
elseif utils["list?"](form) then
2712
+
local mapped = utils.kvmap(form, entry_transform(no, q))
2713
+
local filename = nil
2714
+
if form.filename then
2715
+
filename = string.format("%q", form.filename)
2716
+
else
2717
+
filename = "nil"
2718
+
end
2719
+
assert_compile(not runtime_3f, "lists may only be used at compile time", form)
2720
+
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, ", "))
2721
+
elseif (type(form) == "table") then
2722
+
local mapped = utils.kvmap(form, entry_transform(q, q))
2723
+
local source = getmetatable(form)
2724
+
local filename = nil
2725
+
if source.filename then
2726
+
filename = string.format("%q", source.filename)
2727
+
else
2728
+
filename = "nil"
2729
+
end
2730
+
local function _1_()
2731
+
if source then
2732
+
return source.line
2733
+
else
2734
+
return "nil"
2735
+
end
2736
+
end
2737
+
return string.format("setmetatable({%s}, {filename=%s, line=%s})", mixed_concat(mapped, ", "), filename, _1_())
2738
+
elseif (type(form) == "string") then
2739
+
return serialize_string(form)
2740
+
else
2741
+
return tostring(form)
2742
+
end
2743
+
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}
2745
+
end
2746
+
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"}}
2752
+
local unpack = (table.unpack or _G.unpack)
2753
+
local function suggest(msg)
2754
+
local suggestion = nil
2755
+
for pat, sug in pairs(suggestions) do
2756
+
local matches = {msg:match(pat)}
2757
+
if (0 < #matches) then
2758
+
if ("table" == type(sug)) then
2759
+
local out = {}
2760
+
for _, s in ipairs(sug) do
2761
+
table.insert(out, s:format(unpack(matches)))
2762
+
end
2763
+
suggestion = out
2764
+
else
2765
+
suggestion = sug(matches)
2766
+
end
2767
+
end
2768
+
end
2769
+
return suggestion
2770
+
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())
2777
+
end
2778
+
_ = nil
2779
+
local codeline = f:read()
2780
+
f:close()
2781
+
return codeline, bytes
2782
+
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)
2792
+
end
2793
+
return codeline, bytes
2794
+
end
2795
+
local function read_line(filename, line, source)
2796
+
if source then
2797
+
return read_line_from_source(source, line)
2798
+
else
2799
+
return read_line_from_file(filename, line)
2800
+
end
2801
+
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)
2810
+
local out = {msg, ""}
2811
+
if (ok and codeline) then
2812
+
table.insert(out, codeline)
2813
+
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
2825
+
end
2826
+
return table.concat(out, "\n")
2827
+
end
2828
+
local function assert_compile(condition, msg, ast, source)
2829
+
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)
2834
+
end
2835
+
return condition
2836
+
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)
2839
+
end
2840
+
return {["assert-compile"] = assert_compile, ["parse-error"] = parse_error}
2841
+
end
2842
+
package.preload["fennel.parser"] = package.preload["fennel.parser"] or function(...)
2843
+
local utils = require("fennel.utils")
2844
+
local friend = require("fennel.friend")
2845
+
local unpack = (table.unpack or _G.unpack)
2846
+
local function granulate(getchunk)
2847
+
local c, index, done_3f = "", 1, false
2848
+
local function _0_(parser_state)
2849
+
if not done_3f then
2850
+
if (index <= #c) then
2851
+
local b = c:byte(index)
2852
+
index = (index + 1)
2853
+
return b
2854
+
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 ~= ""))
2860
+
end
2861
+
if _4_ then
2862
+
local char = _1_0
2863
+
c = char
2864
+
index = 2
2865
+
return c:byte()
2866
+
else
2867
+
local _ = _1_0
2868
+
done_3f = true
2869
+
return nil
2870
+
end
2871
+
end
2872
+
end
2873
+
end
2874
+
local function _1_()
2875
+
c = ""
2876
+
return nil
2877
+
end
2878
+
return _0_, _1_
2879
+
end
2880
+
local function string_stream(str)
2881
+
local str0 = str:gsub("^#!", ";;")
2882
+
local index = 1
2883
+
local function _0_()
2884
+
local r = str0:byte(index)
2885
+
index = (index + 1)
2886
+
return r
2887
+
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)))
2893
+
end
2894
+
local function sym_char_3f(b)
2895
+
local b0 = nil
2896
+
if ("number" == type(b)) then
2897
+
b0 = b
2898
+
else
2899
+
b0 = string.byte(b)
2900
+
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))
2902
+
end
2903
+
local prefixes = {[35] = "hashfn", [39] = "quote", [44] = "unquote", [96] = "quote"}
2904
+
local function parser(getbyte, filename, options)
2905
+
local stack = {}
2906
+
local line = 1
2907
+
local byteindex = 0
2908
+
local lastb = nil
2909
+
local function ungetb(ub)
2910
+
if (ub == 10) then
2911
+
line = (line - 1)
2912
+
end
2913
+
byteindex = (byteindex - 1)
2914
+
lastb = ub
2915
+
return nil
2916
+
end
2917
+
local function getb()
2918
+
local r = nil
2919
+
if lastb then
2920
+
r, lastb = lastb, nil
2921
+
else
2922
+
r = getbyte({["stack-size"] = #stack})
2923
+
end
2924
+
byteindex = (byteindex + 1)
2925
+
if (r == 10) then
2926
+
line = (line + 1)
2927
+
end
2928
+
return r
2929
+
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)
2937
+
else
2938
+
return friend["parse-error"](msg, (filename or "unknown"), (line or "?"), (byteindex_override or byteindex), source)
2939
+
end
2940
+
end
2941
+
local function parse_stream()
2942
+
local whitespace_since_dispatch, done_3f, retval = true
2943
+
local function dispatch(v)
2944
+
local _0_0 = stack[#stack]
2945
+
if (_0_0 == nil) then
2946
+
retval, done_3f, whitespace_since_dispatch = v, true, false
2947
+
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
2954
+
whitespace_since_dispatch = false
2955
+
return table.insert(top, v)
2956
+
end
2957
+
end
2958
+
local function badend()
2959
+
local accum = utils.map(stack, "closer")
2960
+
local _0_
2961
+
if (#stack == 1) then
2962
+
_0_ = ""
2963
+
else
2964
+
_0_ = "s"
2965
+
end
2966
+
return parse_error(string.format("expected closing delimiter%s %s", _0_, string.char(unpack(accum))))
2967
+
end
2968
+
local function skip_whitespace(b)
2969
+
if (b and whitespace_3f(b)) then
2970
+
whitespace_since_dispatch = true
2971
+
return skip_whitespace(getb())
2972
+
elseif (not b and (#stack > 0)) then
2973
+
return badend()
2974
+
else
2975
+
return b
2976
+
end
2977
+
end
2978
+
local function parse_comment(b, contents)
2979
+
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
2984
+
end
2985
+
return parse_comment(getb(), _1_())
2986
+
elseif (options and options.comments) then
2987
+
return dispatch(utils.comment(table.concat(contents)))
2988
+
else
2989
+
return b
2990
+
end
2991
+
end
2992
+
local function open_table(b)
2993
+
if not whitespace_since_dispatch then
2994
+
parse_error(("expected whitespace before opening delimiter " .. string.char(b)))
2995
+
end
2996
+
return table.insert(stack, {bytestart = byteindex, closer = delims[b], filename = filename, line = line})
2997
+
end
2998
+
local function close_list(list)
2999
+
return dispatch(setmetatable(list, getmetatable(utils.list())))
3000
+
end
3001
+
local function close_sequence(tbl)
3002
+
local val = utils.sequence(unpack(tbl))
3003
+
for k, v in pairs(tbl) do
3004
+
getmetatable(val)[k] = v
3005
+
end
3006
+
return dispatch(val)
3007
+
end
3008
+
local function close_curly_table(tbl)
3009
+
local val = {}
3010
+
if ((#tbl % 2) ~= 0) then
3011
+
byteindex = (byteindex - 1)
3012
+
parse_error("expected even number of values in table literal")
3013
+
end
3014
+
setmetatable(val, tbl)
3015
+
for i = 1, #tbl, 2 do
3016
+
if ((tostring(tbl[i]) == ":") and utils["sym?"](tbl[(i + 1)]) and utils["sym?"](tbl[i])) then
3017
+
tbl[i] = tostring(tbl[(i + 1)])
3018
+
end
3019
+
val[tbl[i]] = tbl[(i + 1)]
3020
+
end
3021
+
return dispatch(val)
3022
+
end
3023
+
local function close_table(b)
3024
+
local top = table.remove(stack)
3025
+
if (top == nil) then
3026
+
parse_error(("unexpected closing delimiter " .. string.char(b)))
3027
+
end
3028
+
if (top.closer ~= b) then
3029
+
parse_error(("mismatched closing delimiter " .. string.char(b) .. ", expected " .. string.char(top.closer)))
3030
+
end
3031
+
top.byteend = byteindex
3032
+
if (b == 41) then
3033
+
return close_list(top)
3034
+
elseif (b == 93) then
3035
+
return close_sequence(top)
3036
+
else
3037
+
return close_curly_table(top)
3038
+
end
3039
+
end
3040
+
local function parse_string_loop(chars, b, state)
3041
+
table.insert(chars, b)
3042
+
local state0 = nil
3043
+
do
3044
+
local _0_0 = {state, b}
3045
+
if ((type(_0_0) == "table") and (_0_0[1] == "base") and (_0_0[2] == 92)) then
3046
+
state0 = "backslash"
3047
+
elseif ((type(_0_0) == "table") and (_0_0[1] == "base") and (_0_0[2] == 34)) then
3048
+
state0 = "done"
3049
+
else
3050
+
local _ = _0_0
3051
+
state0 = "base"
3052
+
end
3053
+
end
3054
+
if (b and (state0 ~= "done")) then
3055
+
return parse_string_loop(chars, getb(), state0)
3056
+
else
3057
+
return b
3058
+
end
3059
+
end
3060
+
local function escape_char(c)
3061
+
return ({[10] = "\\n", [11] = "\\v", [12] = "\\f", [13] = "\\r", [7] = "\\a", [8] = "\\b", [9] = "\\t"})[c:byte()]
3062
+
end
3063
+
local function parse_string()
3064
+
table.insert(stack, {closer = 34})
3065
+
local chars = {34}
3066
+
if not parse_string_loop(chars, getb(), "base") then
3067
+
badend()
3068
+
end
3069
+
table.remove(stack)
3070
+
local raw = string.char(unpack(chars))
3071
+
local formatted = raw:gsub("[\7-\13]", escape_char)
3072
+
local load_fn = (rawget(_G, "loadstring") or load)(("return " .. formatted))
3073
+
return dispatch(load_fn())
3074
+
end
3075
+
local function parse_prefix(b)
3076
+
table.insert(stack, {prefix = prefixes[b]})
3077
+
local nextb = getb()
3078
+
if whitespace_3f(nextb) then
3079
+
if (b ~= 35) then
3080
+
parse_error("invalid whitespace after quoting prefix")
3081
+
end
3082
+
table.remove(stack)
3083
+
dispatch(utils.sym("#"))
3084
+
end
3085
+
return ungetb(nextb)
3086
+
end
3087
+
local function parse_sym_loop(chars, b)
3088
+
if (b and sym_char_3f(b)) then
3089
+
table.insert(chars, b)
3090
+
return parse_sym_loop(chars, getb())
3091
+
else
3092
+
if b then
3093
+
ungetb(b)
3094
+
end
3095
+
return chars
3096
+
end
3097
+
end
3098
+
local function parse_number(rawstr)
3099
+
local number_with_stripped_underscores = (not rawstr:find("^_") and rawstr:gsub("_", ""))
3100
+
if rawstr:match("^%d") then
3101
+
dispatch((tonumber(number_with_stripped_underscores) or parse_error(("could not read number \"" .. rawstr .. "\""))))
3102
+
return true
3103
+
else
3104
+
local _0_0 = tonumber(number_with_stripped_underscores)
3105
+
if (nil ~= _0_0) then
3106
+
local x = _0_0
3107
+
dispatch(x)
3108
+
return true
3109
+
else
3110
+
local _ = _0_0
3111
+
return false
3112
+
end
3113
+
end
3114
+
end
3115
+
local function check_malformed_sym(rawstr)
3116
+
if (rawstr:match("^~") and (rawstr ~= "~=")) then
3117
+
return parse_error("illegal character: ~")
3118
+
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))
3120
+
elseif (rawstr:match("[%.:][%.:]") and (rawstr ~= "..") and (rawstr ~= "$...")) then
3121
+
return parse_error(("malformed multisym: " .. rawstr), ((byteindex - #rawstr) + 1 + rawstr:find("[%.:][%.:]")))
3122
+
elseif rawstr:match(":.+[%.:]") then
3123
+
return parse_error(("method must be last component " .. "of multisym: " .. rawstr), ((byteindex - #rawstr) + rawstr:find(":.+[%.:]")))
3124
+
end
3125
+
end
3126
+
local function parse_sym(b)
3127
+
local bytestart = byteindex
3128
+
local rawstr = string.char(unpack(parse_sym_loop({b}, getb())))
3129
+
if (rawstr == "true") then
3130
+
return dispatch(true)
3131
+
elseif (rawstr == "false") then
3132
+
return dispatch(false)
3133
+
elseif (rawstr == "...") then
3134
+
return dispatch(utils.varg())
3135
+
elseif rawstr:match("^:.+$") then
3136
+
return dispatch(rawstr:sub(2))
3137
+
elseif parse_number(rawstr) then
3138
+
return nil
3139
+
elseif check_malformed_sym(rawstr) then
3140
+
return nil
3141
+
else
3142
+
return dispatch(utils.sym(rawstr, nil, {byteend = byteindex, bytestart = bytestart, filename = filename, line = line}))
3143
+
end
3144
+
end
3145
+
local function parse_loop(b)
3146
+
if not b then
3147
+
elseif (b == 59) then
3148
+
parse_comment(getb(), {";"})
3149
+
elseif (type(delims[b]) == "number") then
3150
+
open_table(b)
3151
+
elseif delims[b] then
3152
+
close_table(b)
3153
+
elseif (b == 34) then
3154
+
parse_string(b)
3155
+
elseif prefixes[b] then
3156
+
parse_prefix(b)
3157
+
elseif (sym_char_3f(b) or (b == string.byte("~"))) then
3158
+
parse_sym(b)
3159
+
else
3160
+
parse_error(("illegal character: " .. string.char(b)))
3161
+
end
3162
+
if not b then
3163
+
return nil
3164
+
elseif done_3f then
3165
+
return true, retval
3166
+
else
3167
+
return parse_loop(skip_whitespace(getb()))
3168
+
end
3169
+
end
3170
+
return parse_loop(skip_whitespace(getb()))
3171
+
end
3172
+
local function _0_()
3173
+
stack = {}
3174
+
return nil
3175
+
end
3176
+
return parse_stream, _0_
3177
+
end
3178
+
return {["string-stream"] = string_stream, ["sym-char?"] = sym_char_3f, granulate = granulate, parser = parser}
3179
+
end
3180
+
local utils = nil
3181
+
package.preload["fennel.utils"] = package.preload["fennel.utils"] or function(...)
3182
+
local function stablepairs(t)
3183
+
local keys = {}
3184
+
local succ = {}
3185
+
for k in pairs(t) do
3186
+
table.insert(keys, k)
3187
+
end
3188
+
local function _0_(a, b)
3189
+
return (tostring(a) < tostring(b))
3190
+
end
3191
+
table.sort(keys, _0_)
3192
+
for i, k in ipairs(keys) do
3193
+
succ[k] = keys[(i + 1)]
3194
+
end
3195
+
local function stablenext(tbl, idx)
3196
+
if (idx == nil) then
3197
+
return keys[1], tbl[keys[1]]
3198
+
else
3199
+
return succ[idx], tbl[succ[idx]]
3200
+
end
3201
+
end
3202
+
return stablenext, t, nil
3203
+
end
3204
+
local function map(t, f, out)
3205
+
local out0 = (out or {})
3206
+
local f0 = nil
3207
+
if (type(f) == "function") then
3208
+
f0 = f
3209
+
else
3210
+
local s = f
3211
+
local function _0_(x)
3212
+
return x[s]
3213
+
end
3214
+
f0 = _0_
3215
+
end
3216
+
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)
3221
+
end
3222
+
end
3223
+
return out0
3224
+
end
3225
+
local function kvmap(t, f, out)
3226
+
local out0 = (out or {})
3227
+
local f0 = nil
3228
+
if (type(f) == "function") then
3229
+
f0 = f
3230
+
else
3231
+
local s = f
3232
+
local function _0_(x)
3233
+
return x[s]
3234
+
end
3235
+
f0 = _0_
3236
+
end
3237
+
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)
3246
+
end
3247
+
end
3248
+
return out0
3249
+
end
3250
+
local function copy(from, to)
3251
+
local to0 = (to or {})
3252
+
for k, v in pairs((from or {})) do
3253
+
to0[k] = v
3254
+
end
3255
+
return to0
3256
+
end
3257
+
local function member_3f(x, tbl, n)
3258
+
local _0_0 = tbl[(n or 1)]
3259
+
if (_0_0 == x) then
3260
+
return true
3261
+
elseif (_0_0 == nil) then
3262
+
return false
3263
+
else
3264
+
local _ = _0_0
3265
+
return member_3f(x, tbl, ((n or 1) + 1))
3266
+
end
3267
+
end
3268
+
local function allpairs(tbl)
3269
+
assert((type(tbl) == "table"), "allpairs expects a table")
3270
+
local t = tbl
3271
+
local seen = {}
3272
+
local function allpairs_next(_, state)
3273
+
local next_state, value = next(t, state)
3274
+
if seen[next_state] then
3275
+
return allpairs_next(nil, next_state)
3276
+
elseif next_state then
3277
+
seen[next_state] = true
3278
+
return next_state, value
3279
+
else
3280
+
local meta = getmetatable(t)
3281
+
if (meta and meta.__index) then
3282
+
t = meta.__index
3283
+
return allpairs_next(t)
3284
+
end
3285
+
end
3286
+
end
3287
+
return allpairs_next
3288
+
end
3289
+
local function deref(self)
3290
+
return self[1]
3291
+
end
3292
+
local nil_sym = nil
3293
+
local function list__3estring(self, tostring2)
3294
+
local safe, max = {}, 0
3295
+
for k in pairs(self) do
3296
+
if ((type(k) == "number") and (k > max)) then
3297
+
max = k
3298
+
end
3299
+
end
3300
+
for i = 1, max do
3301
+
safe[i] = (((self[i] == nil) and nil_sym) or self[i])
3302
+
end
3303
+
return ("(" .. table.concat(map(safe, (tostring2 or tostring)), " ", 1, max) .. ")")
3304
+
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}
3309
+
local sequence_marker = {"SEQUENCE"}
3310
+
local vararg = setmetatable({"..."}, {"VARARG", __fennelview = deref, __tostring = deref})
3311
+
local getenv = nil
3312
+
local function _0_()
3313
+
return nil
3314
+
end
3315
+
getenv = ((os and os.getenv) or _0_)
3316
+
local function debug_on_3f(flag)
3317
+
local level = (getenv("FENNEL_DEBUG") or "")
3318
+
return ((level == "all") or level:find(flag))
3319
+
end
3320
+
local function list(...)
3321
+
return setmetatable({...}, list_mt)
3322
+
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
3328
+
end
3329
+
end
3330
+
return setmetatable(s, symbol_mt)
3331
+
end
3332
+
nil_sym = sym("nil")
3333
+
local function sequence(...)
3334
+
return setmetatable({...}, {sequence = sequence_marker})
3335
+
end
3336
+
local function expr(strcode, etype)
3337
+
return setmetatable({strcode, type = etype}, expr_mt)
3338
+
end
3339
+
local function comment_2a(contents)
3340
+
return setmetatable({contents}, comment_mt)
3341
+
end
3342
+
local function varg()
3343
+
return vararg
3344
+
end
3345
+
local function expr_3f(x)
3346
+
return ((type(x) == "table") and (getmetatable(x) == expr_mt) and x)
3347
+
end
3348
+
local function varg_3f(x)
3349
+
return ((x == vararg) and x)
3350
+
end
3351
+
local function list_3f(x)
3352
+
return ((type(x) == "table") and (getmetatable(x) == list_mt) and x)
3353
+
end
3354
+
local function sym_3f(x)
3355
+
return ((type(x) == "table") and (getmetatable(x) == symbol_mt) and x)
3356
+
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
+
local function sequence_3f(x)
3361
+
local mt = ((type(x) == "table") and getmetatable(x))
3362
+
return (mt and (mt.sequence == sequence_marker) and x)
3363
+
end
3364
+
local function comment_3f(x)
3365
+
return ((type(x) == "table") and (getmetatable(x) == comment_mt) and x)
3366
+
end
3367
+
local function multi_sym_3f(str)
3368
+
if sym_3f(str) then
3369
+
return multi_sym_3f(tostring(str))
3370
+
elseif (type(str) ~= "string") then
3371
+
return false
3372
+
else
3373
+
local parts = {}
3374
+
for part in str:gmatch("[^%.%:]+[%.%:]?") do
3375
+
local last_char = part:sub(( - 1))
3376
+
if (last_char == ":") then
3377
+
parts["multi-sym-method-call"] = true
3378
+
end
3379
+
if ((last_char == ":") or (last_char == ".")) then
3380
+
parts[(#parts + 1)] = part:sub(1, ( - 2))
3381
+
else
3382
+
parts[(#parts + 1)] = part
3383
+
end
3384
+
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)
3386
+
end
3387
+
end
3388
+
local function quoted_3f(symbol)
3389
+
return symbol.quoted
3390
+
end
3391
+
local function walk_tree(root, f, custom_iterator)
3392
+
local function walk(iterfn, parent, idx, node)
3393
+
if f(idx, node, parent) then
3394
+
for k, v in iterfn(node) do
3395
+
walk(iterfn, node, k, v)
3396
+
end
3397
+
return nil
3398
+
end
3399
+
end
3400
+
walk((custom_iterator or pairs), nil, nil, root)
3401
+
return root
3402
+
end
3403
+
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"}
3404
+
for i, v in ipairs(lua_keywords) do
3405
+
lua_keywords[v] = i
3406
+
end
3407
+
local function valid_lua_identifier_3f(str)
3408
+
return (str:match("^[%a_][%w_]*$") and not lua_keywords[str])
3409
+
end
3410
+
local propagated_options = {"allowedGlobals", "indent", "correlate", "useMetadata", "env", "compiler-env", "compilerEnv"}
3411
+
local function propagate_options(options, subopts)
3412
+
for _, name in ipairs(propagated_options) do
3413
+
subopts[name] = options[name]
3414
+
end
3415
+
return subopts
3416
+
end
3417
+
local root = nil
3418
+
local function _1_()
3419
+
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"]
3427
+
root.reset = function()
3428
+
root.chunk, root.scope, root.options, root.reset = chunk, scope, options, reset
3429
+
return nil
3430
+
end
3431
+
return root.reset
3432
+
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(...)
3440
+
end
3441
+
end
3442
+
return nil
3443
+
end
3444
+
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}
3446
+
end
3447
+
utils = require("fennel.utils")
3448
+
local parser = require("fennel.parser")
3449
+
local compiler = require("fennel.compiler")
3450
+
local specials = require("fennel.specials")
3451
+
local repl = require("fennel.repl")
3452
+
local view = require("fennel.view")
3453
+
local function get_env(env)
3454
+
if (env == "_COMPILER") then
3455
+
local env0 = specials["make-compiler-env"](nil, compiler.scopes.compiler, {})
3456
+
local mt = getmetatable(env0)
3457
+
mt.__index = _G
3458
+
return specials["wrap-env"](env0)
3459
+
else
3460
+
return (env and specials["wrap-env"](env))
3461
+
end
3462
+
end
3463
+
local function eval(str, options, ...)
3464
+
local opts = utils.copy(options)
3465
+
local _ = nil
3466
+
if ((opts.allowedGlobals == nil) and not getmetatable(opts.env)) then
3467
+
opts.allowedGlobals = specials["current-global-names"](opts.env)
3468
+
_ = nil
3469
+
else
3470
+
_ = nil
3471
+
end
3472
+
local env = get_env(opts.env)
3473
+
local lua_source = compiler["compile-string"](str, opts)
3474
+
local loader = nil
3475
+
local function _1_(...)
3476
+
if opts.filename then
3477
+
return ("@" .. opts.filename)
3478
+
else
3479
+
return str
3480
+
end
3481
+
end
3482
+
loader = specials["load-code"](lua_source, env, _1_(...))
3483
+
opts.filename = nil
3484
+
return loader(...)
3485
+
end
3486
+
local function dofile_2a(filename, options, ...)
3487
+
local opts = utils.copy(options)
3488
+
local f = assert(io.open(filename, "rb"))
3489
+
local source = assert(f:read("*all"), ("Could not read " .. filename))
3490
+
f:close()
3491
+
opts.filename = filename
3492
+
return eval(source, opts, ...)
3493
+
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}
3495
+
utils["fennel-module"] = mod
3496
+
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.
3500
+
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.
3506
+
3507
+
(fn -> [val ...]
3508
+
"Thread-first macro.
3509
+
Take the first value and splice it into the second form as its first argument.
3510
+
The value of the second form is spliced into the first arg of the third, etc."
3511
+
(var x val)
3512
+
(each [_ e (ipairs [...])]
3513
+
(let [elt (if (list? e) e (list e))]
3514
+
(table.insert elt 2 x)
3515
+
(set x elt)))
3516
+
x)
3517
+
3518
+
(fn ->> [val ...]
3519
+
"Thread-last macro.
3520
+
Same as ->, except splices the value into the last position of each form
3521
+
rather than the first."
3522
+
(var x val)
3523
+
(each [_ e (pairs [...])]
3524
+
(let [elt (if (list? e) e (list e))]
3525
+
(table.insert elt x)
3526
+
(set x elt)))
3527
+
x)
3528
+
3529
+
(fn -?> [val ...]
3530
+
"Nil-safe thread-first macro.
3531
+
Same as -> except will short-circuit with nil when it encounters a nil value."
3532
+
(if (= 0 (select "#" ...))
3533
+
val
3534
+
(let [els [...]
3535
+
e (table.remove els 1)
3536
+
el (if (list? e) e (list e))
3537
+
tmp (gensym)]
3538
+
(table.insert el 2 tmp)
3539
+
`(let [,tmp ,val]
3540
+
(if ,tmp
3541
+
(-?> ,el ,(unpack els))
3542
+
,tmp)))))
3543
+
3544
+
(fn -?>> [val ...]
3545
+
"Nil-safe thread-last macro.
3546
+
Same as ->> except will short-circuit with nil when it encounters a nil value."
3547
+
(if (= 0 (select "#" ...))
3548
+
val
3549
+
(let [els [...]
3550
+
e (table.remove els 1)
3551
+
el (if (list? e) e (list e))
3552
+
tmp (gensym)]
3553
+
(table.insert el tmp)
3554
+
`(let [,tmp ,val]
3555
+
(if ,tmp
3556
+
(-?>> ,el ,(unpack els))
3557
+
,tmp)))))
3558
+
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))
3566
+
(table.insert form name)
3567
+
form))
3568
+
3569
+
(fn when [condition body1 ...]
3570
+
"Evaluate body for side-effects only when condition is truthy."
3571
+
(assert body1 "expected body")
3572
+
`(if ,condition
3573
+
(do ,body1 ,...)))
3574
+
3575
+
(fn with-open [closable-bindings ...]
3576
+
"Like `let`, but invokes (v:close) on each binding after evaluating the body.
3577
+
The body is evaluated inside `xpcall` so that bound values will be closed upon
3578
+
encountering an error before propagating it."
3579
+
(let [bodyfn `(fn [] ,...)
3580
+
closer `(fn close-handlers# [ok# ...] (if ok# ...
3581
+
(error ... 0)))
3582
+
traceback `(. (or package.loaded.fennel debug) :traceback)]
3583
+
(for [i 1 (# closable-bindings) 2]
3584
+
(assert (sym? (. closable-bindings i))
3585
+
"with-open only allows symbols in bindings")
3586
+
(table.insert closer 4 `(: ,(. closable-bindings i) :close)))
3587
+
`(let ,closable-bindings ,closer
3588
+
(close-handlers# (xpcall ,bodyfn ,traceback)))))
3589
+
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.
3595
+
3596
+
For example,
3597
+
(collect [k v (pairs {:apple \"red\" :orange \"orange\"})]
3598
+
(values v k))
3599
+
returns
3600
+
{:red \"apple\" :orange \"orange\"}"
3601
+
(assert (and (sequence? iter-tbl) (>= (length iter-tbl) 2))
3602
+
"expected iterator binding table")
3603
+
(assert (not= nil key-value-expr)
3604
+
"expected key-value expression")
3605
+
(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#))
3612
+
3613
+
(fn icollect [iter-tbl value-expr ...]
3614
+
"Returns a sequential table made by running an iterator and evaluating an
3615
+
expression that returns values to be inserted sequentially into the table.
3616
+
This can be thought of as a \"list comprehension\".
3617
+
3618
+
For example,
3619
+
(icollect [_ v (ipairs [1 2 3 4 5])] (when (> v 2) (* v v)))
3620
+
returns
3621
+
[9 16 25]"
3622
+
(assert (and (sequence? iter-tbl) (>= (length iter-tbl) 2))
3623
+
"expected iterator binding table")
3624
+
(assert (not= nil value-expr)
3625
+
"expected table value expression")
3626
+
(assert (= nil ...)
3627
+
"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#))
3632
+
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)))
3638
+
3639
+
(fn pick-args [n f]
3640
+
"Creates a function of arity n that applies its arguments to f.
3641
+
3642
+
For example,
3643
+
(pick-args 2 func)
3644
+
expands to
3645
+
(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.")
3648
+
(let [bindings []]
3649
+
(for [i 1 n] (tset bindings i (gensym)))
3650
+
`(fn ,bindings (,f ,(unpack bindings)))))
3651
+
3652
+
(fn pick-values [n ...]
3653
+
"Like the `values` special, but emits exactly n values.
3654
+
3655
+
For example,
3656
+
(pick-values 2 ...)
3657
+
expands to
3658
+
(let [(_0_ _1_) ...]
3659
+
(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)))
3665
+
(if (= n 0) `(values)
3666
+
`(let [,let-syms ,let-values] (values ,(unpack let-syms))))))
3667
+
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 ?."
3672
+
(let [args [...]
3673
+
has-internal-name? (sym? (. args 1))
3674
+
arglist (if has-internal-name? (. args 2) (. args 1))
3675
+
docstring-position (if has-internal-name? 3 2)
3676
+
has-docstring? (and (> (# args) docstring-position)
3677
+
(= :string (type (. args docstring-position))))
3678
+
arity-check-position (- 4 (if has-internal-name? 0 1)
3679
+
(if has-docstring? 0 1))
3680
+
empty-body? (< (# args) arity-check-position)]
3681
+
(fn check! [a]
3682
+
(if (table? a)
3683
+
(each [_ a (pairs a)]
3684
+
(check! a))
3685
+
(let [as (tostring a)]
3686
+
(and (not (as:match "^?")) (not= as "&") (not= as "_") (not= as "...")))
3687
+
(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 "?"))))))
3693
+
(assert (= :table (type arglist)) "expected arg list")
3694
+
(each [_ a (ipairs arglist)]
3695
+
(check! a))
3696
+
(if empty-body?
3697
+
(table.insert args (sym :nil)))
3698
+
`(fn ,(unpack args))))
3699
+
3700
+
(fn macro [name ...]
3701
+
"Define a single macro."
3702
+
(assert (sym? name) "expected symbol for macro name")
3703
+
(local args [...])
3704
+
`(macros { ,(tostring name) (fn ,(unpack args))}))
3705
+
3706
+
(fn macrodebug [form return?]
3707
+
"Print the resulting form after performing macroexpansion.
3708
+
With a second argument, returns expanded form as a string instead of printing."
3709
+
(let [handle (if return? `do `print)]
3710
+
`(,handle ,(view (macroexpand form _SCOPE)))))
3711
+
3712
+
(fn import-macros [binding1 module-name1 ...]
3713
+
"Binds a table of macros from each macro module according to a binding form.
3714
+
Each binding form can be either a symbol or a k/v destructuring table.
3715
+
Example:
3716
+
(import-macros mymacros :my-macros ; bind to symbol
3717
+
{:macro1 alias : macro2} :proj.macros) ; import by name"
3718
+
(assert (and binding1 module-name1 (= 0 (% (select :# ...) 2)))
3719
+
"expected even number of binding/modulename pairs")
3720
+
(for [i 1 (select :# binding1 module-name1 ...) 2]
3721
+
(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
+
scope (get-scope)
3726
+
subscope (fennel.scope scope)]
3727
+
(_SPECIALS.require-macros `(require-macros ,modname) subscope {} ast)
3728
+
(if (sym? binding)
3729
+
;; 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
+
3734
+
;; 1-level table destructuring for importing individual macros
3735
+
(table? binding)
3736
+
(each [macro-name [import-key] (pairs binding)]
3737
+
(assert (= :function (type (. subscope.macros macro-name)))
3738
+
(.. "macro " macro-name " not found in module "
3739
+
(tostring modname)))
3740
+
(tset scope.macros import-key (. subscope.macros macro-name))))))
3741
+
nil)
3742
+
3743
+
;;; Pattern matching
3744
+
3745
+
(fn match-values [vals pattern unifications match-pattern]
3746
+
(let [condition `(and)
3747
+
bindings []]
3748
+
(each [i pat (ipairs pattern)]
3749
+
(let [(subcondition subbindings) (match-pattern [(. vals i)] pat
3750
+
unifications)]
3751
+
(table.insert condition subcondition)
3752
+
(each [_ b (ipairs subbindings)]
3753
+
(table.insert bindings b))))
3754
+
(values condition bindings)))
3755
+
3756
+
(fn match-table [val pattern unifications match-pattern]
3757
+
(let [condition `(and (= (type ,val) :table))
3758
+
bindings []]
3759
+
(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
3770
+
(let [subval `(. ,val ,k)
3771
+
(subcondition subbindings) (match-pattern [subval] pat
3772
+
unifications)]
3773
+
(table.insert condition subcondition)
3774
+
(each [_ b (ipairs subbindings)]
3775
+
(table.insert bindings b)))))
3776
+
(values condition bindings)))
3777
+
3778
+
(fn match-pattern [vals pattern unifications]
3779
+
"Takes the AST of values and a single pattern and returns a condition
3780
+
to determine if it matches as well as a list of bindings to
3781
+
introduce for the duration of the body if it does match."
3782
+
;; we have to assume we're matching against multiple values here until we
3783
+
;; know we're either in a multi-valued clause (in which case we know the #
3784
+
;; of vals) or we're not, in which case we only care about the first one.
3785
+
(let [[val] vals]
3786
+
(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))))
3792
+
(values `(= ,val ,pattern) [])
3793
+
;; unify a local we've seen already
3794
+
(and (sym? pattern) (. unifications (tostring pattern)))
3795
+
(values `(= ,(. unifications (tostring pattern)) ,val) [])
3796
+
;; bind a fresh local
3797
+
(sym? pattern)
3798
+
(let [wildcard? (: (tostring pattern) :find "^_")]
3799
+
(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]))
3803
+
;; guard clause
3804
+
(and (list? pattern) (sym? (. pattern 2)) (= :? (tostring (. pattern 2))))
3805
+
(let [(pcondition bindings) (match-pattern vals (. pattern 1)
3806
+
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
+
3812
+
;; multi-valued patterns (represented as lists)
3813
+
(list? pattern)
3814
+
(match-values vals pattern unifications match-pattern)
3815
+
;; table patterns
3816
+
(= (type pattern) :table)
3817
+
(match-table val pattern unifications match-pattern)
3818
+
;; literal value
3819
+
(values `(= ,val ,pattern) []))))
3820
+
3821
+
(fn match-condition [vals clauses]
3822
+
"Construct the actual `if` AST for the given match values and clauses."
3823
+
(if (not= 0 (% (length clauses) 2)) ; treat odd final clause as default
3824
+
(table.insert clauses (length clauses) (sym :_)))
3825
+
(let [out `(if)]
3826
+
(for [i 1 (length clauses) 2]
3827
+
(let [pattern (. clauses i)
3828
+
body (. clauses (+ i 1))
3829
+
(condition bindings) (match-pattern vals pattern {})]
3830
+
(table.insert out condition)
3831
+
(table.insert out `(let ,bindings ,body))))
3832
+
out))
3833
+
3834
+
(fn match-val-syms [clauses]
3835
+
"How many multi-valued clauses are there? return a list of that many gensyms."
3836
+
(let [syms (list (gensym))]
3837
+
(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))))))
3842
+
syms))
3843
+
3844
+
(fn match [val ...]
3845
+
"Perform pattern matching on val. See reference for details."
3846
+
(let [clauses [...]
3847
+
vals (match-val-syms clauses)]
3848
+
;; protect against multiple evaluation of the value, bind against as
3849
+
;; many values as we ever match against in the clauses.
3850
+
(list `let [vals val]
3851
+
(match-condition vals clauses))))
3852
+
3853
+
{: -> : ->> : -?> : -?>>
3854
+
: doto : when : with-open
3855
+
: collect : icollect
3856
+
: partial : lambda
3857
+
: pick-args : pick-values
3858
+
: macro : macrodebug : import-macros
3859
+
: match}
3860
+
]===]
3861
+
local module_name = "fennel.macros"
3862
+
local _ = nil
3863
+
local function _0_()
3864
+
return mod
3865
+
end
3866
+
package.preload[module_name] = _0_
3867
+
_ = nil
3868
+
local env = nil
3869
+
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
3874
+
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})
3876
+
for k, v in pairs(built_ins) do
3877
+
compiler.scopes.global.macros[k] = v
3878
+
end
3879
+
compiler.scopes.global.macros["\206\187"] = compiler.scopes.global.macros.lambda
3880
+
package.preload[module_name] = nil
3881
+
end
3882
+
return mod
+52
vim/.config/nvim/lua/utils.lua
+52
vim/.config/nvim/lua/utils.lua
···
1
+
local function tbl_filter(func, t)
2
+
vim.validate{func={func,'c'},t={t,'t'}}
3
+
4
+
local rettab = {}
5
+
for key, entry in pairs(t) do
6
+
if func(key, entry) then
7
+
rettab[key] = entry
8
+
end
9
+
end
10
+
return rettab
11
+
end
12
+
13
+
local function normalise_map(rhs, opts)
14
+
-- If it is command line map, then automaticall add <C-u> for cleaning
15
+
-- selection and <CR> at the end, to fire it up
16
+
if vim.startswith(rhs, ':') and rhs ~= ':' then
17
+
if not vim.startswith(rhs, ':<C-u>') and options["selection"] then
18
+
rhs = '<cmd>' .. rhs:sub(2)
19
+
end
20
+
if not vim.endswith(rhs, '<CR>') and options["cr"] then
21
+
rhs = rhs .. '<CR>'
22
+
end
23
+
end
24
+
25
+
return rhs
26
+
end
27
+
28
+
local function do_map(cb)
29
+
return function(modes, lhs, rhs, opts)
30
+
-- Defaults to non recursive mappings
31
+
options = vim.tbl_extend('force', {noremap = true, selection = true, cr = true}, opts or {})
32
+
33
+
if modes == '' then
34
+
error('Modes must not be empty')
35
+
end
36
+
37
+
local f = function(k, _)
38
+
return not (k == "selection" or k == "cr")
39
+
end
40
+
local map_opts = tbl_filter(f, options)
41
+
local normalised = normalise_map(rhs, options)
42
+
43
+
for mode in modes:gmatch('.') do
44
+
cb(mode, lhs, normalised, map_opts)
45
+
end
46
+
end
47
+
end
48
+
49
+
return {
50
+
map = do_map(vim.api.nvim_set_keymap),
51
+
buf_map = do_map(function(...) vim.api.nvim_buf_set_keymap(0, ...) end)
52
+
}
-69
vim/.config/nvim/plugin/langclient.vim
-69
vim/.config/nvim/plugin/langclient.vim
···
1
-
let g:lsp_log_file = expand('~/vim-lsp.log')
2
-
3
-
func! s:set_colours(...) abort
4
-
endfunc
5
-
6
-
func! s:setup_ls(...) abort
7
-
let l:servers = lsp#get_whitelisted_servers()
8
-
9
-
for l:server in l:servers
10
-
let l:cap = lsp#get_server_capabilities(l:server)
11
-
12
-
if has_key(l:cap, 'completionProvider')
13
-
setlocal omnifunc=lsp#complete
14
-
endif
15
-
16
-
if has_key(l:cap, 'hoverProvider')
17
-
setlocal keywordprg=:LspHover
18
-
endif
19
-
20
-
if has_key(l:cap, 'definitionProvider')
21
-
nmap <silent> <buffer> gd <plug>(lsp-definition)
22
-
endif
23
-
24
-
if has_key(l:cap, 'referencesProvider')
25
-
nmap <silent> <buffer> gr <plug>(lsp-references)
26
-
endif
27
-
endfor
28
-
endfunc
29
-
30
-
func! s:nix_shell(command, ...) abort
31
-
let l:path = a:0 > 0 ? a:1 : a:command
32
-
33
-
return {_->['nix-shell', '--show-trace', '-p', l:path, '--run', a:command]}
34
-
endfunc
35
-
36
-
augroup LSC
37
-
autocmd!
38
-
39
-
autocmd User lsp_setup call lsp#register_server({
40
-
\ 'name': 'ElixirLS',
41
-
\ 'cmd': s:nix_shell('elixir-ls', 'elixirLS'),
42
-
\ 'root_uri':{server_info->lsp#utils#path_to_uri(
43
-
\ lsp#utils#find_nearest_parent_file_directory(
44
-
\ lsp#utils#get_buffer_path(),
45
-
\ ['mix.lock', '.git/']
46
-
\ ))},
47
-
\ 'whitelist': ['elixir', 'eelixir']
48
-
\ })
49
-
50
-
autocmd User lsp_setup call lsp#register_server({
51
-
\ 'name': 'ErlangLS',
52
-
\ 'cmd': s:nix_shell('erlang_ls --transport stdio', 'erlangLS'),
53
-
\ 'root_uri':{server_info->lsp#utils#path_to_uri(
54
-
\ lsp#utils#find_nearest_parent_file_directory(
55
-
\ lsp#utils#get_buffer_path(),
56
-
\ ['rebar.config', '.git/']
57
-
\ ))},
58
-
\ 'whitelist': ['erlang']
59
-
\ })
60
-
61
-
" autocmd User lsp_setup call lsp#register_server({
62
-
" \ 'name': 'RLS',
63
-
" \ 'cmd': s:nix_shell('rls'),
64
-
" \ 'whitelist': ['rust']
65
-
" \ })
66
-
67
-
autocmd User lsp_server_init call <SID>setup_ls()
68
-
autocmd BufEnter * call <SID>setup_ls()
69
-
augroup END