├── .gitignore ├── LICENSE ├── Makefile ├── README.md ├── bin ├── kapok ├── kapokc └── kutest ├── doc └── guide │ ├── data-type.md │ ├── expression.md │ ├── function.md │ ├── index.md │ ├── macro.md │ ├── namespace.md │ ├── project-tools.md │ ├── take-the-red-pill.md │ └── variable.md ├── example ├── fibonacci.kpk ├── hello-world.kpk ├── ring-echo.kpk └── sieve-of-eratosthenes.kpk └── lib ├── kapok ├── ebin │ └── .gitignore ├── lib │ ├── kapok.char.kpk │ ├── kapok.code-server.kpk │ ├── kapok.core.kpk │ ├── kapok.inspect.algebra.kpk │ ├── kapok.inspect.kpk │ ├── kapok.io.kpk │ ├── kapok.module.kpk │ ├── kapok.protocol.kpk │ └── kapok.time.kpk ├── rebar.config ├── src │ ├── kapok.app.src │ ├── kapok.erl │ ├── kapok.hrl │ ├── kapok_app.erl │ ├── kapok_ast.erl │ ├── kapok_cli.erl │ ├── kapok_code.erl │ ├── kapok_compiler.erl │ ├── kapok_ctx.erl │ ├── kapok_dispatch.erl │ ├── kapok_env.erl │ ├── kapok_erl.erl │ ├── kapok_error.erl │ ├── kapok_macro.erl │ ├── kapok_parser.yrl │ ├── kapok_rewrite.erl │ ├── kapok_scanner.erl │ ├── kapok_sup.erl │ ├── kapok_symbol_table.erl │ ├── kapok_trans.erl │ ├── kapok_trans_bitstring.erl │ ├── kapok_trans_collection.erl │ ├── kapok_trans_special_form.erl │ ├── kapok_utils.erl │ └── kapok_version.erl └── test │ ├── compiler │ ├── compiler-test.kpk │ └── scanner-test.kpk │ └── syntax │ ├── attribute-test.kpk │ ├── bind-test.kpk │ ├── case-test.kpk │ ├── data-type-test.kpk │ ├── fn-test.kpk │ ├── funcall-test.kpk │ ├── let-test.kpk │ ├── macro-test.kpk │ ├── ns-test.kpk │ ├── send-receive-test.kpk │ ├── sforms-test.kpk │ └── try-catch-test.kpk └── unittest ├── lib ├── kapok.unittest.cli.kpk └── kapok.unittest.kpk └── test └── unittest-test.kpk /.gitignore: -------------------------------------------------------------------------------- 1 | *.beam 2 | erl_crash.dump 3 | ebin/ 4 | .rebar/ 5 | .eunit/ 6 | lib/kapok/src/kapok_parser.erl 7 | 8 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 7 | 8 | 1. Definitions. 9 | 10 | "License" shall mean the terms and conditions for use, reproduction, 11 | and distribution as defined by Sections 1 through 9 of this document. 12 | 13 | "Licensor" shall mean the copyright owner or entity authorized by 14 | the copyright owner that is granting the License. 15 | 16 | "Legal Entity" shall mean the union of the acting entity and all 17 | other entities that control, are controlled by, or are under common 18 | control with that entity. For the purposes of this definition, 19 | "control" means (i) the power, direct or indirect, to cause the 20 | direction or management of such entity, whether by contract or 21 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 22 | outstanding shares, or (iii) beneficial ownership of such entity. 23 | 24 | "You" (or "Your") shall mean an individual or Legal Entity 25 | exercising permissions granted by this License. 26 | 27 | "Source" form shall mean the preferred form for making modifications, 28 | including but not limited to software source code, documentation 29 | source, and configuration files. 30 | 31 | "Object" form shall mean any form resulting from mechanical 32 | transformation or translation of a Source form, including but 33 | not limited to compiled object code, generated documentation, 34 | and conversions to other media types. 35 | 36 | "Work" shall mean the work of authorship, whether in Source or 37 | Object form, made available under the License, as indicated by a 38 | copyright notice that is included in or attached to the work 39 | (an example is provided in the Appendix below). 40 | 41 | "Derivative Works" shall mean any work, whether in Source or Object 42 | form, that is based on (or derived from) the Work and for which the 43 | editorial revisions, annotations, elaborations, or other modifications 44 | represent, as a whole, an original work of authorship. For the purposes 45 | of this License, Derivative Works shall not include works that remain 46 | separable from, or merely link (or bind by name) to the interfaces of, 47 | the Work and Derivative Works thereof. 48 | 49 | "Contribution" shall mean any work of authorship, including 50 | the original version of the Work and any modifications or additions 51 | to that Work or Derivative Works thereof, that is intentionally 52 | submitted to Licensor for inclusion in the Work by the copyright owner 53 | or by an individual or Legal Entity authorized to submit on behalf of 54 | the copyright owner. For the purposes of this definition, "submitted" 55 | means any form of electronic, verbal, or written communication sent 56 | to the Licensor or its representatives, including but not limited to 57 | communication on electronic mailing lists, source code control systems, 58 | and issue tracking systems that are managed by, or on behalf of, the 59 | Licensor for the purpose of discussing and improving the Work, but 60 | excluding communication that is conspicuously marked or otherwise 61 | designated in writing by the copyright owner as "Not a Contribution." 62 | 63 | "Contributor" shall mean Licensor and any individual or Legal Entity 64 | on behalf of whom a Contribution has been received by Licensor and 65 | subsequently incorporated within the Work. 66 | 67 | 2. Grant of Copyright License. Subject to the terms and conditions of 68 | this License, each Contributor hereby grants to You a perpetual, 69 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 70 | copyright license to reproduce, prepare Derivative Works of, 71 | publicly display, publicly perform, sublicense, and distribute the 72 | Work and such Derivative Works in Source or Object form. 73 | 74 | 3. Grant of Patent License. Subject to the terms and conditions of 75 | this License, each Contributor hereby grants to You a perpetual, 76 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 77 | (except as stated in this section) patent license to make, have made, 78 | use, offer to sell, sell, import, and otherwise transfer the Work, 79 | where such license applies only to those patent claims licensable 80 | by such Contributor that are necessarily infringed by their 81 | Contribution(s) alone or by combination of their Contribution(s) 82 | with the Work to which such Contribution(s) was submitted. If You 83 | institute patent litigation against any entity (including a 84 | cross-claim or counterclaim in a lawsuit) alleging that the Work 85 | or a Contribution incorporated within the Work constitutes direct 86 | or contributory patent infringement, then any patent licenses 87 | granted to You under this License for that Work shall terminate 88 | as of the date such litigation is filed. 89 | 90 | 4. Redistribution. You may reproduce and distribute copies of the 91 | Work or Derivative Works thereof in any medium, with or without 92 | modifications, and in Source or Object form, provided that You 93 | meet the following conditions: 94 | 95 | (a) You must give any other recipients of the Work or 96 | Derivative Works a copy of this License; and 97 | 98 | (b) You must cause any modified files to carry prominent notices 99 | stating that You changed the files; and 100 | 101 | (c) You must retain, in the Source form of any Derivative Works 102 | that You distribute, all copyright, patent, trademark, and 103 | attribution notices from the Source form of the Work, 104 | excluding those notices that do not pertain to any part of 105 | the Derivative Works; and 106 | 107 | (d) If the Work includes a "NOTICE" text file as part of its 108 | distribution, then any Derivative Works that You distribute must 109 | include a readable copy of the attribution notices contained 110 | within such NOTICE file, excluding those notices that do not 111 | pertain to any part of the Derivative Works, in at least one 112 | of the following places: within a NOTICE text file distributed 113 | as part of the Derivative Works; within the Source form or 114 | documentation, if provided along with the Derivative Works; or, 115 | within a display generated by the Derivative Works, if and 116 | wherever such third-party notices normally appear. The contents 117 | of the NOTICE file are for informational purposes only and 118 | do not modify the License. You may add Your own attribution 119 | notices within Derivative Works that You distribute, alongside 120 | or as an addendum to the NOTICE text from the Work, provided 121 | that such additional attribution notices cannot be construed 122 | as modifying the License. 123 | 124 | You may add Your own copyright statement to Your modifications and 125 | may provide additional or different license terms and conditions 126 | for use, reproduction, or distribution of Your modifications, or 127 | for any such Derivative Works as a whole, provided Your use, 128 | reproduction, and distribution of the Work otherwise complies with 129 | the conditions stated in this License. 130 | 131 | 5. Submission of Contributions. Unless You explicitly state otherwise, 132 | any Contribution intentionally submitted for inclusion in the Work 133 | by You to the Licensor shall be under the terms and conditions of 134 | this License, without any additional terms or conditions. 135 | Notwithstanding the above, nothing herein shall supersede or modify 136 | the terms of any separate license agreement you may have executed 137 | with Licensor regarding such Contributions. 138 | 139 | 6. Trademarks. This License does not grant permission to use the trade 140 | names, trademarks, service marks, or product names of the Licensor, 141 | except as required for reasonable and customary use in describing the 142 | origin of the Work and reproducing the content of the NOTICE file. 143 | 144 | 7. Disclaimer of Warranty. Unless required by applicable law or 145 | agreed to in writing, Licensor provides the Work (and each 146 | Contributor provides its Contributions) on an "AS IS" BASIS, 147 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 148 | implied, including, without limitation, any warranties or conditions 149 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 150 | PARTICULAR PURPOSE. You are solely responsible for determining the 151 | appropriateness of using or redistributing the Work and assume any 152 | risks associated with Your exercise of permissions under this License. 153 | 154 | 8. Limitation of Liability. In no event and under no legal theory, 155 | whether in tort (including negligence), contract, or otherwise, 156 | unless required by applicable law (such as deliberate and grossly 157 | negligent acts) or agreed to in writing, shall any Contributor be 158 | liable to You for damages, including any direct, indirect, special, 159 | incidental, or consequential damages of any character arising as a 160 | result of this License or out of the use or inability to use the 161 | Work (including but not limited to damages for loss of goodwill, 162 | work stoppage, computer failure or malfunction, or any and all 163 | other commercial damages or losses), even if such Contributor 164 | has been advised of the possibility of such damages. 165 | 166 | 9. Accepting Warranty or Additional Liability. While redistributing 167 | the Work or Derivative Works thereof, You may choose to offer, 168 | and charge a fee for, acceptance of support, warranty, indemnity, 169 | or other liability obligations and/or rights consistent with this 170 | License. However, in accepting such obligations, You may act only 171 | on Your own behalf and on Your sole responsibility, not on behalf 172 | of any other Contributor, and only if You agree to indemnify, 173 | defend, and hold each Contributor harmless for any liability 174 | incurred by, or claims asserted against, such Contributor by reason 175 | of your accepting any such warranty or additional liability. 176 | 177 | END OF TERMS AND CONDITIONS 178 | 179 | APPENDIX: How to apply the Apache License to your work. 180 | 181 | To apply the Apache License to your work, attach the following 182 | boilerplate notice, with the fields enclosed by brackets "[]" 183 | replaced with your own identifying information. (Don't include 184 | the brackets!) The text should be enclosed in the appropriate 185 | comment syntax for the file format. We also recommend that a 186 | file or class name and description of purpose be included on the 187 | same "printed page" as the copyright notice for easier 188 | identification within third-party archives. 189 | 190 | Copyright [yyyy] [name of copyright owner] 191 | 192 | Licensed under the Apache License, Version 2.0 (the "License"); 193 | you may not use this file except in compliance with the License. 194 | You may obtain a copy of the License at 195 | 196 | http://www.apache.org/licenses/LICENSE-2.0 197 | 198 | Unless required by applicable law or agreed to in writing, software 199 | distributed under the License is distributed on an "AS IS" BASIS, 200 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 201 | See the License for the specific language governing permissions and 202 | limitations under the License. 203 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for Kapok 2 | # -*- mode: Makefile -*- 3 | 4 | 5 | MKDIR := mkdir -p 6 | RM := rm -rf 7 | CP := cp -rf 8 | REBAR := rebar 9 | ERL := erl 10 | ERLC := erlc 11 | ESCRIPT := escript 12 | KAPOKC := kapokc 13 | KUTEST := kutest 14 | 15 | QUIET := @ 16 | # add local bin into PATH 17 | export PATH := $(CURDIR)/bin:$(PATH) 18 | 19 | lib_dir := $(CURDIR)/lib 20 | # sort the libs according to their names to preserve compilation orders 21 | lib_names := $(sort $(patsubst $(lib_dir)/%,%,$(wildcard $(lib_dir)/*))) 22 | other_files := $(CURDIR)/erl_crash.dump 23 | 24 | # strip the CURDIR prefix and get the related path for output absolute path 25 | # $(call related-path,absolute-path) 26 | define related-path 27 | $(patsubst $(CURDIR)/%,%,$1) 28 | endef 29 | 30 | # get files with specified suffix in specified directory 31 | # $(call get-files-in-dir,dir-name,suffix) 32 | define get-files-in-dir 33 | $(patsubst %.$2,%,$(notdir $(wildcard $1/*.$2))) 34 | endef 35 | 36 | # filter out the specified word list from another word list 37 | # $(call filter-out-list,to-remove-list,word-list) 38 | define filter-out-list 39 | $(strip \ 40 | $(foreach w,$2, \ 41 | $(if $(findstring $w,$1) \ 42 | ,, \ 43 | $w))) 44 | endef 45 | 46 | # calculate beam file from module 47 | # $(call modules-to-beams,destination,modules...) 48 | define modules-to-beams 49 | $(addprefix $1/,$(addsuffix .beam,$2)) 50 | endef 51 | 52 | # ensure directory's existence 53 | # $(call ensure-dir,path) 54 | define ensure-dir 55 | $(QUIET) [ -d "$1" ] || $(MKDIR) $1 56 | endef 57 | 58 | # check the existence of command 59 | # $(call check-cmd,cmd-name) 60 | define check-cmd 61 | $(QUIET) if ! which "$1" > /dev/null; \ 62 | then echo "command" "$1" "not found"; exit 1; fi 63 | endef 64 | 65 | # generate path options for erlang compiler 66 | # $(call get-path-options,project-root-dir) 67 | define get-path-options 68 | $(shell find $1/lib -type d -name ebin | sed -e 's#\(.*\)# -pa \1 #' | tr -d '\n') 69 | endef 70 | 71 | ERL_PATH_OPTIONS := $(call get-path-options,$(CURDIR)) 72 | ERL_OPTIONS := -noshell $(ERL_PATH_OPTIONS) 73 | 74 | # call erl command line 75 | # $(call erl,file,function,arguments...) 76 | define erl 77 | $(QUIET) $(ERL) $(ERL_OPTIONS) -s $1 $2 $3 -s init stop 78 | endef 79 | 80 | KAPOKC_OPTIONS := $(ERL_PATH_OPTIONS) 81 | KAPOK_OPTIONS := 82 | 83 | # call kapokc command line 84 | # $(call kapokc,file,outdir) 85 | define kapokc 86 | $(QUIET) $(KAPOKC) $(KAPOKC_OPTIONS) -o "$2" "$1" 87 | endef 88 | 89 | # call unittest command line to test a project 90 | define unittest 91 | $(QUIET) $(KUTEST) $1 92 | endef 93 | 94 | # generate the targets with specified prefix for specified modules 95 | # $(call gen-target,prefix,module...) 96 | define gen-target 97 | $(addprefix $1,$2) 98 | endef 99 | 100 | # echo the message that about to build the specified type package 101 | # $(call echo-build,type,module) 102 | define echo-build 103 | $(QUIET) printf "=== build %s %s ===\n" $1 $2 104 | endef 105 | 106 | # define the build vars for specified lib 107 | # $(call gen-build-vars,lib) 108 | define gen-build-vars 109 | 110 | ifeq "$(strip $1)" "kapok" 111 | 112 | lib_$1_dir := $(lib_dir)/$1 113 | $1_src_dir := $$(lib_$1_dir)/src 114 | $1_lib_dir := $$(lib_$1_dir)/lib 115 | $1_test_dir := $$(lib_$1_dir)/test 116 | $1_beam_output_dir := $$(lib_$1_dir)/ebin 117 | 118 | $1_modules := $$(call get-files-in-dir,$$($1_src_dir),erl) 119 | $1_parser_src_file := $$($1_src_dir)/kapok_parser.erl 120 | $1_core_lib_files := \ 121 | kapok.core.kpk \ 122 | kapok.module.kpk \ 123 | kapok.code-server.kpk \ 124 | kapok.protocol.kpk 125 | $1_core_lib_modules := $$(patsubst %.kpk,%,$$($1_core_lib_files)) 126 | $1_lib_files := \ 127 | kapok.char.kpk \ 128 | kapok.inspect.algebra.kpk \ 129 | kapok.inspect.kpk \ 130 | kapok.io.kpk \ 131 | kapok.time.kpk 132 | 133 | $1_lib_modules := $$(patsubst %.kpk,%,$$($1_lib_files)) 134 | $1_beam_files := $$(call modules-to-beams,$$($1_beam_output_dir),$$($1_modules)) 135 | $1_core_lib_beam_files := $$(call modules-to-beams,$$($1_beam_output_dir),$$($1_core_lib_modules)) 136 | $1_lib_beam_files := $$(call modules-to-beams,$$($1_beam_output_dir),$$($1_lib_modules)) 137 | 138 | else 139 | 140 | lib_$1_dir := $(lib_dir)/$1 141 | $1_lib_dir := $$(lib_$1_dir)/lib 142 | $1_beam_output_dir := $$(lib_$1_dir)/ebin 143 | 144 | $1_lib_files := $$(call get-files-in-dir,$$($1_lib_dir),kpk) 145 | $1_lib_beam_files := $$(call modules-to-beams,$$($1_beam_output_dir),$$($1_lib_files)) 146 | 147 | endif 148 | 149 | endef 150 | 151 | 152 | # define the build rules for specified lib 153 | # $(call gen-build-rules,lib,build-prefix,test-prefix,clean-prefix) 154 | define gen-build-rules 155 | 156 | ifeq "$(strip $1)" "kapok" 157 | 158 | .PHONY : $2$1 $2$1-compiler $2$1-core-libs $2$1-libs $3$1 $4$1 159 | 160 | $2$1: $2$1-compiler $2$1-core-libs $2$1-libs 161 | 162 | $2$1-compiler: $($1_parser_src_file) $($1_beam_files) 163 | 164 | $($1_parser_src_file): $($1_src_dir)/%.erl: $($1_src_dir)/%.yrl 165 | 166 | $($1_parser_src_file): 167 | $(call echo-build,lib,$1) 168 | $(QUIET) echo "--- generate parser and build source files ---" 169 | $(QUIET) cd $(lib_$1_dir) && $(REBAR) compile 170 | 171 | # TODO add $($1_parser_src_file) as an dependency 172 | $($1_beam_files): $($1_beam_output_dir)/%.beam: $($1_src_dir)/%.erl 173 | 174 | $($1_beam_files): 175 | $(call echo-build,lib,$1) 176 | $(QUIET) echo "--- build source file ---" 177 | $(QUIET) cd $(lib_$1_dir) && $(REBAR) compile 178 | 179 | $2$1-core-libs: $($1_core_lib_beam_files) 180 | 181 | $($1_core_lib_beam_files): $($1_beam_files) 182 | $($1_core_lib_beam_files): $($1_beam_output_dir)/%.beam: $($1_lib_dir)/%.kpk 183 | 184 | $($1_core_lib_beam_files): 185 | $(QUIET) echo "--- build core libs ---" 186 | $(call erl,kapok_compiler,core) 187 | 188 | $2$1-libs: $($1_lib_beam_files) 189 | $($1_lib_beam_files): $($1_beam_files) $($1_core_lib_beam_files) 190 | 191 | $($1_lib_beam_files): $($1_beam_output_dir)/%.beam: $($1_lib_dir)/%.kpk 192 | $(QUIET) printf "Compile '%s'\n" $$(call related-path,$$<) 193 | $$(call kapokc,$$<,$$(dir $$@)) 194 | 195 | $3$1: $2$1 196 | $$(call unittest,$$(lib_$1_dir)) 197 | 198 | $4$1: 199 | $(QUIET) $(RM) $($1_parser_src_file) $($1_beam_files) \ 200 | $($1_core_lib_beam_files) $($1_lib_beam_files) $($1_beam_output_dir)/*.beam 201 | 202 | else 203 | 204 | .PHONY : $2$1 $2$1-libs $3$1 $4$1 205 | 206 | $2$1: $2$1-libs 207 | 208 | $2$1-libs: $($1_lib_beam_files) 209 | 210 | $($1_lib_beam_files): $($1_beam_output_dir)/%.beam: $($1_lib_dir)/%.kpk 211 | $(QUIET) printf "Compile '%s'\n" $$(call related-path,$$<) 212 | $$(call kapokc,$$<,$$(dir $$@)) 213 | 214 | $3$1: 215 | $$(call unittest,$$(lib_$1_dir)) 216 | 217 | $4$1: 218 | $(QUIET) $(RM) $($1_lib_beam_files) 219 | 220 | endif 221 | 222 | endef 223 | 224 | define gen-build-for 225 | $(eval $(call gen-build-vars,$1)) 226 | $(eval $(call gen-build-rules,$1,$2,$3,$4)) 227 | endef 228 | 229 | 230 | .PHONY : all build test clean 231 | 232 | all: build 233 | 234 | build: $(foreach l,$(lib_names),$(call gen-target,build-,$l)) 235 | test: build $(foreach l,$(lib_names),$(call gen-target,test-,$l)) 236 | clean: $(foreach l,$(lib_names),$(call gen-target,clean-,$l)) 237 | $(QUIET) $(RM) $(other_files) 238 | 239 | # add eval call to expand multiple line definitions of variables and rules 240 | $(eval $(foreach l,$(lib_names),$(call gen-build-for,$l,build-,test-,clean-))) 241 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Kapok 2 | ========== 3 | 4 | Kapok is a dynamic, functional, general-purpose programming language. It's a dialect of Lisp, and shares with Lisp the code-as-data philosophy and a powerful macro system. Kapok leverages the Erlang VM, which known for running low-latency, scalable and fault-tolerant systems. 5 | 6 | Kapok is designed with goals as below: 7 | 8 | 1. Has syntax like Clojure 9 | 1. Keep max compatible with the Erlang ecosystem 10 | 1. Be compatible with Elixir to leverage its protocol, lazy interfaces, and a rich set of useful libraries, in terms of unicode string, file, etc. 11 | 1. (TODO)Shipped with powerful tools, e.g. project management tool, editor integration, etc. 12 | 13 | ### Documentation 14 | 15 | * [Language Guide](doc/guide/index.md) 16 | 17 | -------------------------------------------------------------------------------- /bin/kapok: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # kapok compiling/executing script 3 | 4 | usage() { 5 | echo "Usage: `basename $0` [options] [kapok file] 6 | 7 | -v Prints version and exit 8 | -pa \"path\" Prepends the given path to Erlang code path (*) 9 | -pz \"path\" Appends the given path to Erlang code path (*) 10 | --erl \"Options\" Options to be passed down to erlang runtime 11 | 12 | ** Options marked with (*) can be given more than once 13 | ** Options given after the kapok file or -- are passed down to the execute code 14 | ** Options can be passed to the erlang runtime using KAPOK_ERL_OPTIONS or --erl" >&2 15 | } 16 | 17 | if [ $# -eq 0 ] || [ "$1" = "--help" ] || [ "$1" = "-h" ]; then 18 | usage 19 | exit 1 20 | fi 21 | 22 | readlink_f() { 23 | cd "$(dirname "$1")" > /dev/null 24 | filename="$(basename "$1")" 25 | if [ -L "$filename" ]; then 26 | readlink_f "$(readlink "$filename")" 27 | else 28 | echo "$(pwd -P)/$filename" 29 | fi 30 | } 31 | 32 | MODE="kapok" 33 | ERL_EXEC="erl" 34 | ERL_OPTIONS="" 35 | I=1 36 | 37 | while [ $I -le $# ]; do 38 | Step=1 39 | eval "PEEK=\${$I}" 40 | case "$PEEK" in 41 | +kapokc) 42 | MODE="kapokc" 43 | ;; 44 | -v) 45 | ;; 46 | esac 47 | I=$(expr $I + $Step) 48 | done 49 | 50 | PROGRAM=$(readlink_f "$0") 51 | PROGRAM_DIR=$(dirname "$PROGRAM") 52 | PATH_OPTIONS=$(find "$PROGRAM_DIR"/../lib/* -type d -name ebin | sed -e 's#\(.*\)# -pa \1 #' | tr -d '\n') 53 | 54 | ERL_OPTIONS="-noshell -s kapok start_cli $ERL_OPTIONS" 55 | 56 | exec "${ERL_EXEC}" ${PATH_OPTIONS} ${KAPOK_ERL_OPTIONS} ${ERL_OPTIONS} -extra "$@" 57 | -------------------------------------------------------------------------------- /bin/kapokc: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # kapok compiler script 3 | 4 | usage() { 5 | echo "Usage: `basename $0` [kapok options] [compiler options] [kapok files] 6 | 7 | -o The directory to output compiled files 8 | --debug Print debug messages 9 | --verbose Print informationaal messages 10 | 11 | ** Options given after -- are passed down to the execuded code 12 | ** Options can be passed to the erlang runtime using KAPOK_ERL_OPTIONS 13 | ** Options can be passed to the erlang compiler using ERL_COMPILER_OPTIONS" >&2 14 | } 15 | 16 | if [ $# -eq 0 ] || [ "$1" = "--help" ] || [ "$1" = "-h" ]; then 17 | usage 18 | exit 1 19 | fi 20 | 21 | readlink_f() { 22 | cd "$(dirname "$1")" > /dev/null 23 | filename="$(basename "$1")" 24 | if [ -L "$filename" ]; then 25 | readlink_f "$(readlink "$filename")" 26 | else 27 | echo "$(pwd -P)/$filename" 28 | fi 29 | } 30 | 31 | PROGRAM=$(readlink_f "$0") 32 | PROGRAM_DIR=$(dirname "$PROGRAM") 33 | exec "$PROGRAM_DIR"/kapok +kapokc "$@" 34 | -------------------------------------------------------------------------------- /bin/kutest: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # kapok unittest tool 3 | 4 | usage() { 5 | echo "Usage: `basename $0` [options]" 6 | } 7 | 8 | if [ $# -eq 0 ] || [ "$1" = "--help" ] || [ "$1" = "-h" ]; then 9 | usage 10 | exit 1 11 | fi 12 | 13 | readlink_f() { 14 | cd "$(dirname "$1")" > /dev/null 15 | filename="$(basename "$1")" 16 | if [ -L "$filename" ]; then 17 | readlink_f "$(readlink "$filename")" 18 | else 19 | echo "$(pwd -P)/$filename" 20 | fi 21 | } 22 | 23 | PROGRAM=$(readlink_f "$0") 24 | PROGRAM_DIR=$(dirname "$PROGRAM") 25 | kapok $PROGRAM_DIR/../lib/unittest/lib/kapok.unittest.cli.kpk "$@" 26 | -------------------------------------------------------------------------------- /doc/guide/function.md: -------------------------------------------------------------------------------- 1 | Function 2 | ========== 3 | 4 | Kapok is a functional programming language. As in any other functional programming language, function plays a important role in code. We have discussed how to define anonymous functions in expressions using the `fn` form. Here we will talk about how to define named function in the top level of a namespace. 5 | 6 | #### Public, Private 7 | 8 | There are two types of functions/macros accessibility, public and private. A private function/macro is accessable only inside the same namespace, while a publice function/macro could also be called in any other module. A public function is equal to an exported function in Erlang, while a private function is not exported. 9 | 10 | #### Define a function 11 | 12 | The special form `defn` is used to define public functions, and `defn-` is to define private functions. Both share the same syntax: 13 | 14 | ```clojure 15 | ;; define a public function with a single clause 16 | (defn function [arguments] guard 17 | body) 18 | 19 | ;; define a public function with multiple clauses 20 | (defn function 21 | ([arguments1] guard1 22 | body1) 23 | ([arguments2] guard2 24 | body2) 25 | ...) 26 | ``` 27 | 28 | "function" should be an identifier. "arguments" is a literal list which is parenthesized in square brackets. "guard" is optional and "body" could contains multiple expressions. The value evaluated by last expression of "body" is the value of whole function clause. For example: 29 | 30 | ```clojure 31 | (defn sum [l] (&when (list? l)) 32 | (seq.reduce l (fn [x acc] (+ x acc)))) 33 | ``` 34 | 35 | This example defines a function `sum` to sum a list of numbers. It accepts a single argument `l`. In the function clause guard, it checks whether the argument `l` is of type list. If `l` is a list, it uses the protocol function `seq.reduce` to traverse the list and calculate the sum. Otherwise an exception is raised due to no function clause matches the given argument. 36 | 37 | If we want `sum` to accept a tuple of numbers as the argument, we could write a new clause for the argument being a tuple: 38 | 39 | ```clojure 40 | (defn sum [l] (&when (list? l)) 41 | (seq.reduce l (fn [x acc] (+ x acc)))) 42 | 43 | (defn sum [t] (&when (tuple? t)) 44 | (sum (erlang.tuple_to_list t))) 45 | ``` 46 | 47 | Just like what's in Erlang, it's ok for the function `sum` to have two clauses, where each clause handles a different type of argument. In the clause body for the tuple argument, first the tuple argument is converted to a list, then `sum` is called using the list to run code of the previous clause. It works because the Erlang VM supports tail recursion. The definition code could also be merged into a single `defn` form: 48 | 49 | ```clojure 50 | (defn sum 51 | ([l] (&when (list? l)) 52 | (seq.reduce l (fn [x acc] (+ x acc)))) 53 | 54 | ([t] (&when (tuple? t)) 55 | (sum (elang.tuple_to_list t)))) 56 | ``` 57 | 58 | In the above examples, if the keyword `defn` is replaced by `defn-`, then the code still works except that we get a private function instead of a public function. 59 | 60 | #### Function arguments 61 | 62 | Kapok supports four types of arguments: normal, optional, rest, keyword, just like what's in Common Lisp. A normal argument is the arguments which are listed one by one in the argument list of function definition, each of them represents a standalone actual argument. For example: 63 | 64 | ```clojure 65 | (defn add [x y] 66 | (+ x y)) 67 | ;; (add 1 2) ;=> 3 68 | ``` 69 | 70 | Function `add` takes two arguments `x`, `y` and return their sum as result. And then we call `add` with two actual arguments `1`, `2`, so that in the definition, argument `x` get the value `1` and argument `y` get the value `2`. The format of calling `add` is similar to its definition. 71 | 72 | An optional argument is the argument after keyword `&optional` in a function definition, which could be omitted when calling the function. For example: 73 | 74 | ```clojure 75 | (defn f [&optional (a 1) (b 0)] 76 | (+ a b)) 77 | ;; (f ) ;=> 1 78 | ;; (f 2) ;=> 2 79 | ;; (f 2 3) ;=> 5 80 | ``` 81 | 82 | Here we define a function `f` with two optional argument `a` and `b`, `a` has the default value 1 and `b` has the default value 0. If no actual argument is provided for an argument when the function is called, it would take the default value as its value. In this example, if we call `f` without any argument, local `a` would be 1 and local `b` would be 2. The optional argument could only be omitted from right to left, which means if an argument, e.g. `a` needs to be omitted, then all arguments right to `a`, in this case only `b`, need to be omitted. So if we call `f` with only one actual argument, the argument would to be bound to `a`. 83 | 84 | A rest argument is the last argument after keyword `&rest` in a function definition, which bundles all the tailing actual arguments. For example: 85 | 86 | ```clojure 87 | (defn add [&rest l] 88 | (seq.reduce l 0 (fn [x acc] (+ a acc)))) 89 | ;; (add ) ;=> 0 90 | ;; (add 1) ;=> 1 91 | ;; (add 1 2) ;=> 3 92 | ;; (add 1 2 3 4 5) ;=> 15 93 | ``` 94 | 95 | In this example, all the actual arguments are packed into `l`, just like we write: 96 | 97 | ```clojure 98 | (defn add [l] 99 | ;; body 100 | ...) 101 | ;; (add [1 2 3 4 5]) ;=> 15 102 | ``` 103 | 104 | A keyword argument is the last argument in a function definition, which bundles all the tailing actual arguments in key-value pairs. For example: 105 | 106 | ```clojure 107 | (defn sum [&key a b] 108 | (+ a b)) 109 | ;; (sum :b 2 :a 1) ;=> 3 110 | ``` 111 | 112 | In this example, all the actual arguments are packed into key-value pairs, and then inside the function body, the corresponding values of keys are mapped to locals `a`, `b`. You may notice that when `sum` is called, the order of key `a`, `b` is not the same as they're in the definition. It's equivalent to: 113 | 114 | ```clojure 115 | (defn sum [map] 116 | (+ (maps.get #a map) 117 | (maps.get #b map))) 118 | ;; (sum #{:b 2 119 | :a 1}) ;=> 3 120 | ``` 121 | 122 | As these four types of arguments could be combined in a function, there are serverl combinations of function arguments: 123 | 124 | 1. normal + optional 125 | 1. normal + rest 126 | 1. normal + key 127 | 1. optional normal + optional + rest 128 | 129 | Only these combinations are valid, others would cause compile errors. The first three combination is plain simple. Let's take a look at an example for the last one: 130 | 131 | ```clojure 132 | ;; define a function with normal + optional + rest arguments 133 | (defn f1 [a &optional b &rest c] 134 | ...) 135 | 136 | (f1 1) ;; a == 1, b == :nil, c == [] 137 | (f1 1 2) ;; a == 1, b == 2, c == [] 138 | (f1 1 2 3) ;; a == 1, b == 2, c == [3] 139 | (f1 1 2 3 4) ;; a == 1, b == 2, c == [3 4] 140 | ``` 141 | 142 | The argument binding from left to right. If the previous one is bound, it will try to bind the tailing to left arguments. 143 | 144 | #### Macro 145 | 146 | Macros are a special functions that when they are called, they are expanded in compile time insteed of runtime. Macros use keywords `defmacro`, `defmacro-` rather than `defn`, `defn-`. Similarly, `defmacro` is for public macros, while `defmacro-` is for private macros. 147 | 148 | There are three macro special forms to make our life easier when defining macros: `\`` (backquote), `~` (unquote), `~@` (unquote splicing). They works like what's in Clojure or any other Lisp dialet. 149 | 150 | Take the `if` macro in standard library for example: 151 | 152 | ```clojure 153 | (defmacro if [test then &optional else] 154 | `(case (kapok.core.#true? ~test) 155 | (:true ~then) 156 | (:false ~else))) 157 | ``` 158 | 159 | When macro `if` is called in the code, the calling code ast is passed as the arguments "test", "then", "else". And then this macro expands its result and insert it right the place. Assume we call this macro in a context: 160 | 161 | ```clojure 162 | (defn call-if [] 163 | (if (check-stat) 164 | (do-something) 165 | (do-something-else))) 166 | ``` 167 | 168 | When the `if` macro is expanded, this definition of `call-if` would become: 169 | 170 | ```clojure 171 | (defn call-if [] 172 | (case (kapok.core.#true (check-stat)) 173 | (:true (do-something)) 174 | (:false (do-something-else)))) 175 | ``` 176 | 177 | Like any other Lisp dialet, the macro expansion is done at the early phase of the compilation before the code is compiled to Erlang VM binary code. 178 | -------------------------------------------------------------------------------- /doc/guide/index.md: -------------------------------------------------------------------------------- 1 | Language Guide 2 | ========== 3 | 4 | **Kapok is a dynamic, functional, general-purpose programming language**. It's a dialect of Lisp, and shares with Lisp the code-as-data philosophy and a powerful macro system. Kapok leverages the Erlang VM, which known for running low-latency, scalable and fault-tolerant systems. 5 | 6 | 1. [Take the Red Pill](./take-the-red-pill.md) 7 | 1. [Variable and Pattern Matching](./variable.md) 8 | 1. [Data Type](./data-type.md) 9 | 1. [Expression](./expression.md) 10 | 1. [Function](./function.md) 11 | 1. [Macro](./macro.md) 12 | 1. [Namespace](./namespace.md) 13 | 1. [Project and Tools](./project-tools.md) 14 | 15 | -------------------------------------------------------------------------------- /doc/guide/macro.md: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kapok-lang/kapok/4272f990fe495e595d2afe38605dbca560bbe072/doc/guide/macro.md -------------------------------------------------------------------------------- /doc/guide/namespace.md: -------------------------------------------------------------------------------- 1 | Namespace 2 | ========== 3 | 4 | Namespaces in Kapok are like namespaces in Clojure, which are named space to hold function definitions. They are roughly analogous to packages in Java and modules in Python and Ruby. The difference is that Kapok is a functional programming language and does not support constant and variables in namespace. 5 | 6 | Every Kapok namespace is implemented and transformed to a Erlang module, with the name of Kapok namespace mapping to the corresponding Erlang module name. One special form `ns` could be used to define a namespace. A basic namespace declaration looks as below: 7 | 8 | ```clojure 9 | (ns some-module) 10 | 11 | ;; the followings are function/macro definitions 12 | ``` 13 | 14 | This defines a namespace called `some-module`, and the function/macro definitions follow this `ns` special form. The namespace must be defined before the function/macro definitions, like what we usually do in Clojure (in Erlang, module declaration is written at the start of a module as well). A namespace is usually put into a single file, and it is a must that a single source file only contains a single namespace. It is recommand that the source file have the same name as namespace, although it is not a must. For example 15 | 16 | ```clojure 17 | ;; the content of file my-domain.example.kpk 18 | (ns my-domain.example) 19 | 20 | (defn do-something [] 21 | ;; .... 22 | ) 23 | ``` 24 | 25 | Both the module name and the file name without suffix are `my-domain.example`. Keeping them the same would make it easier to search for namespaces, no matter for project management tools or human. 26 | 27 | You might notice that the namespace name in previous example is not a identifier, since it contains a dot(`.`) charactor, which is not a valid identifier charactor. When dot characters are put between identifiers, they are composed to new syntax entity called a dot-identifier. A dot-identifier could be used as the namespace name, first element of a list call (to call a remote function of another namespace). The dot character is to separate the identifiers and to form a name hierarchy, like domain. In Clojure, dot character is used for package hierarchy, and slash(/) character is used between packages and their members, e.g. 28 | 29 | ```clojure 30 | ;; call a function true? in namespace clojure.core 31 | (clojure.core/true? nil) 32 | ``` 33 | 34 | In Kapok, we use dot character for both of these occasions. 35 | 36 | ```clojure 37 | ;; call a function true? in namespace core 38 | (core.true? :nil) 39 | ``` 40 | 41 | The `ns` special form could have `require` and `use` clauses. The `require` clause could have `:as` argument. And the `use` clause could have `:as`, `:only`, `:exclude`, `:rename` arguments. These examples below would show how to use them: 42 | 43 | ```clojure 44 | (ns example-for-require 45 | (require io) ;; require a single erlang module 'io' 46 | (require (base64 :as bs)) ;; require a single erlang module 'base64' and give it an alias 'bs' 47 | (require compile ;; require multiple erlang modules 48 | (rand :as r) 49 | re) 50 | (require atom) ;; require a kapok standard library namespace 51 | ) 52 | ``` 53 | 54 | ```clojure 55 | (ns example-for-use 56 | (use lists) ;; use a single erlang module 'lists' 57 | (use (erlang :as er ;; use a erlang module 'erlang' and give it an alias 'er' 58 | :only (apply node) ;; only import apply/2 and node/0 from module 'erlang' 59 | :rename ((apply ap)) ;; rename 'apply' to 'ap' 60 | )) 61 | (use process ;; use multiple modules/namespaces 62 | (core :exclude (abs)) ;; :exclude agrument 63 | gb_sets) 64 | ) 65 | ``` 66 | 67 | `:as`, `:rename` are used to give aliases to modules/namespaces or functions/macros. When there is name clash, or a shorter name is wanted, aliases would be helpful. Since `:only` is inclusive, but `:exclude` is exclusive, they could not be used together in the same use clause. 68 | 69 | Another special form to define a namespace is `defns`, it's similar to `ns` except that the namespace code ends at the end of `defns` form, not the end of file. For example: 70 | 71 | ```clojure 72 | (defns example-for-defns 73 | ;; parenthesize the require/use section, make it distinguished with `defn` etc. 74 | ((require io) 75 | (use (kapok (seq)))) 76 | 77 | (defn f [l] 78 | ...) 79 | ) 80 | ``` 81 | 82 | At the start of the `defns` form, the require/use section is parenthesized to distinguish them from the later definitions. 83 | -------------------------------------------------------------------------------- /doc/guide/project-tools.md: -------------------------------------------------------------------------------- 1 | Project and Tools 2 | ========== 3 | -------------------------------------------------------------------------------- /doc/guide/take-the-red-pill.md: -------------------------------------------------------------------------------- 1 | Take the Red Pill 2 | ========== 3 | 4 | ## Installing Kapok 5 | 6 | Currently Kapok doesn't have a pre-compiled release, so you need to compile it from source. There are dependencies to be set up before doing the compilation. 7 | 8 | ### Dependencies 9 | 10 | To compile from source in platform Unix/Linux or Mac OS, these packages must be installed first: make, erlang, rebar 2. Because the Elixir standard library is widely used in Kapok source code, it's also needed to compile Kapok. 11 | 12 | #### Mac OS X 13 | 14 | Update the homebrew to latest before you use homebrew to install these packages, like: 15 | 16 | ```shell 17 | $ brew update 18 | $ brew install erlang rebar 19 | ``` 20 | 21 | #### Unix/Linux 22 | 23 | * Debian/Ubuntu 24 | 25 | Since `yecc` is in a standalone package `erlang-parsetools`, you need to install it besides the package `erlang`. 26 | 27 | ```shell 28 | $ sudo aptitude install erlang erlang-parsetools rebar 29 | ``` 30 | 31 | * Other distributions 32 | 33 | Check and install erlang(with yecc), rebar 2 via package manager of your distribution or via source code. 34 | 35 | ### Prepare Elixir 36 | 37 | Install Elixir using package manager, or compile it from source, and then set environment variable `KAPOK_ERL_OPTIONS` to its beam path: 38 | 39 | ``` 40 | $ git clone https://github.com/elixir-lang/elixir.git 41 | $ cd elixir 42 | $ make 43 | $ export KAPOK_ERL_OPTIONS="-pz /path/to/elixir/lib/elixir/ebin" 44 | ``` 45 | 46 | ### Compiling from source 47 | 48 | Download the latest release, unpack it and then run `make` inside the unpacked directory. 49 | 50 | Or you could compile from the master branch: 51 | 52 | ```shell 53 | $ git clone https://github.com/kapok-lang/kapok.git 54 | $ cd kapok 55 | $ make 56 | ``` 57 | 58 | After the compiling is done, you are ready to run the `kapok` and `kapokc` commands from the bin directory. It is recommanded that you [add Kapak's bin path to your PATH environment variable](#setting-path-enviroment-variable) to ease development. 59 | 60 | ### Setting PATH enviroment variable 61 | 62 | It is highly recommended to add Kapok's bin path to your PATH enviroment variable to ease development. 63 | 64 | On Unix systems, you need to find your shell profile file, and then add to the end of this file the following line reflecting the path to your Kapok installation: 65 | 66 | ```shell 67 | export PATH="$PATH:/path/to/kapok/bin" 68 | ``` 69 | -------------------------------------------------------------------------------- /doc/guide/variable.md: -------------------------------------------------------------------------------- 1 | Variable and Pattern Matching 2 | ========== 3 | 4 | Immutable data plays an important role in functional programming language. Just like what's in Erlang, variables in Kapok are immutable. It means that once a variable is bound, it's illegal to be rebound. The idea behind keeping this variable immutability in Kapok is that it helps us to program better, and it's easy for Kapok to utilize the immutability of Erlang and map the Kapok code to Erlang code. 5 | 6 | Just like what's in Lisp, there is a keyword `let` used to bind variables. But there is no `setq` or any similar operation to perform imperative style assignment/re-assignment. And it supports pattern matching. Yeah, this good feature from Erlang is kept. In summury, it looks closer to Clojure other than any other older Lisp dialet, when talking about variable binding and pattern matching in Kapok. 7 | 8 | To declare, bind and use a variable, first we need to took a look at identifiers. 9 | 10 | ### Identifier 11 | 12 | Identifiers are the names which refer to namespaces, functions, variables, etc. They're called symbols in Lisp. There are two kinds of identifiers in Kapok: identifier, and dot identifier. 13 | 14 | Identifier must begin with a non-numeric character, and in addition to any alphanumeric characters, it could contain these characters: 15 | 16 | ```text 17 | ! $ % * + - / < = > ? @ ^ _ | ~ & # 18 | ``` 19 | 20 | like symbols in other Lisp dialects, the valid characters for identifiers are far more than non-Lisp language. For example, valid characters for identifiers in Python could only contain alphanumeric characters and underscore. Notice that the last a few characters are preserved for some other keywords or literal types, as listed below: 21 | 22 | 23 | | preserved identifiers | note | 24 | | --- | --- | 25 | | ~ ~@ | macro unquote, unquote splicing keyword | 26 | | &optional &rest &key &when &and &or | function argument and guard specification | 27 | | #"string" | literal list string | 28 | | #'atom' #atom | literal atom | 29 | 30 | Since there are preversed keywords which starts with `~ & #`, it will not work using `~ & #` as the start of normal identifiers for functions or variables. But you could use them in any position after the first char in a normal identifier, as long as it would not cause conflicts with the preserved keywords. 31 | 32 | Also notice that identifiers in other Erlang VM based programming languages have fewer valid characters. For example, identifiers in Elixir contain only alphanumeric characters and underscore. If you need to write a Kapok module for Elixir code(or Erlang code, in a similar case) to call, please make sure the identifier name to be compactible. 33 | 34 | Like what's in Erlang, if an identifier that starts with underscore(\_) or is just an underscore(\_), the Kapok compiler would not report warning if the identifier is not used. If an identifier is a single underscore, it acts like a placeholder. For example, if we didn’t need to capture a value during the pattern matching, we could specify the special variable _ (an underscore). This acts like a variable but immediately discards any value given to it — in a pattern match, it is like a wildcard saying, “I’ll accept any value here.” 35 | 36 | The dot character(.) is not a valid character of an identifier. If the dot character occurs between two identifiers, it represents a namespaced-identifier, which is called dot-identifier in whole. A dot-identifier evaluates to the named value in the specified namespace. For example, we could specify a simple namespace in the ns special form, as 37 | 38 | ```clojure 39 | (ns some-namespace 40 | ;; ... 41 | ) 42 | 43 | (defn f [] 44 | ;; ... 45 | ) 46 | ``` 47 | 48 | Or call a function of this namespace like this 49 | 50 | ```clojure 51 | (some-namespace.f) 52 | ``` 53 | 54 | Similarly, we could specify a embedded namespace in the ns form using dot-identifier. Multiple dot characters could occur in an dot-identifier, which is a way to specify multiple levels of namespaces and their hierarchy. For example 55 | 56 | ```clojure 57 | (ns some-namespace.some-inner-namspace.some-innermost-namespace 58 | ;; ... 59 | ) 60 | 61 | (defn f [] 62 | ;; ... 63 | ) 64 | ``` 65 | 66 | the above codes are valid, the `f` function could be called in this way: 67 | 68 | ``` 69 | (some-namespace.some-inner-namespace.some-innermost-namespace.f) 70 | ``` 71 | 72 | Besides function calls, the dot-identifiers could be used in namespace names, struct names and protocol names. It's not allowed to be used as variable names or function names because there is no hierarchy needed for them. 73 | 74 | ### Binding and Pattern Matching 75 | 76 | The `let` form is a special form to define local bindings in Kapok. It supports pattern matching in Clojure style. 77 | 78 | A local binding is a named reference which is lexically scoped to the extent of the let expression. It's also called local variable or locals. For example, this is a function in Python: 79 | 80 | ```python 81 | def f(x, y): 82 | l = x * x + 1; 83 | m = y * 2 + x; 84 | return l * m + m 85 | ``` 86 | 87 | is equivalent to this Kapok function: 88 | 89 | ```clojure 90 | (defn f [x y] 91 | (let [l (+ (* x x) 1) 92 | m (+ (* y 2) x)] 93 | (+ (* l m) m))) 94 | ``` 95 | 96 | the `l` and `m` locals in the respective function bodies both refer to an intermediate value. They're declared in the list as the first argument of the let form, which is called binding list. Inside the binding list, every two expressions match in a pair to declare a local: a pattern and a value. We will talk about them later in pattern matching. Following the binding list, it's is the body of let form, which could contain one or more than one expression. Locals are usual in common programming language. In Kapok, all locals are immutable. you can override a local binding within a nested `let` form, but there is no way to change its value within the scope of a single let form. 97 | 98 | Occasionally, you will want to evaluate an expression in the binding list without a local refered to its result. In these cases, an underscore could be used as the local name, or as the prefix of local name, so that the compiler know that this value is going to be unused intentionally. For example, 99 | 100 | ```clojure 101 | (let [x (get-value) 102 | _ (print "value: ~p" x)] 103 | (+ 1 x) 104 | ) 105 | ``` 106 | 107 | The `print` expression will be evaluated and the result will be marked as unused. Otherwise if a local without underscore prefix is unused within tho context of a `let`'s body, the compiler will trigger a warning for this unused variable. 108 | 109 | In the binding list, it supports destructuring like Clojure. In Erlang, a similar concept of destructuring is called pattern matching. Destructuring is somewhat different from pattern matching. In Kapok, the semantics follows closer to Erlang, so we stick to the name pattern matching. The pattern matching works for two kinds of structure: 110 | 111 | #### 1. sequential collection 112 | 113 | Sequential collections include the types of lists, tuples, bitstring(and binary), list strings, binary strings. 114 | 115 | For every element in the collection, a local must be declared in the pattern part. For example, we could write this code to do pattern matching for a list: 116 | 117 | ``` 118 | (let [[x _y z] [42 "foo" 99.2]] 119 | (+ x z)) 120 | ``` 121 | 122 | No ommit is allowed in pattern, which is different from Clojure. For example, it's legal to do destructuring like 123 | 124 | ```clojure 125 | (def v [42 "foo" 99.2 [5 12]]) 126 | ;= #'user/v 127 | (let [[x y z] v] 128 | (+ x z)) 129 | ;= 141.2 130 | ``` 131 | 132 | But it's illegal to omit `[5 12]` in `v` in the pattern part in Kapok. 133 | 134 | It shares the same syntax to pattern match a sequential collection, and declare a sequential collection. The syntax is consistent in this way. For example, the following code show how to pattern match each type of sequential collections: 135 | 136 | ``` 137 | (let [;; list 138 | [a _ _] [1 2 3] 139 | ;; tuple 140 | {b _} {4 5} 141 | ;; bitstring 142 | <<(c (:size 5)) (_ (:size 15))>> <<(6 (:size 5)) (7 (:size 3)) (8 (:size 12))>> 143 | ;; binary 144 | << d _ _ >> << 9 10 11 >> 145 | ;; list string 146 | [e & _] #"hello" 147 | ;; binary string 148 | << f _ _ _ _ >> "hello" 149 | ] 150 | ;; body 151 | ... 152 | ) 153 | ``` 154 | 155 | #### 2. map collection 156 | 157 | We could do pattern matching for maps. Conceptually it's identical to pattern matching for sequential collection. The difference is that we only have to write the key value pair in the pattern part for what we want to match. For example 158 | 159 | ``` 160 | (let [;; map 161 | #{:k1 value} #{:k1 100 162 | :k2 200}] 163 | ;; body 164 | (+ 1 value) 165 | ) 166 | ;;=> 101 167 | ``` 168 | 169 | We omit `:k2` in the pattern and fetch whatever value of `:k1`, refer it as the local `value` and access it in the body of the let form. 170 | 171 | Please notice that set collection is not supported in pattern matching. 172 | 173 | -------------------------------------------------------------------------------- /example/fibonacci.kpk: -------------------------------------------------------------------------------- 1 | (ns fibonacci 2 | (require (kapok (io)))) 3 | 4 | (defn fibo [0] 5 | 0) 6 | 7 | (defn fibo [1] 8 | 1) 9 | 10 | (defn fibo [n] (&when (> n 0)) 11 | (+ (fibo (- n 1)) 12 | (fibo (- n 2)))) 13 | 14 | (defn main [] 15 | (let [n 4] 16 | (io.format #"fibonacci(~B) => ~B~n" n (fibo n)))) 17 | -------------------------------------------------------------------------------- /example/hello-world.kpk: -------------------------------------------------------------------------------- 1 | (ns hello-world 2 | (require (kapok (io)))) 3 | 4 | (defn main [] 5 | (io.format #"Hello, ~s~n" #"World")) 6 | 7 | -------------------------------------------------------------------------------- /example/ring-echo.kpk: -------------------------------------------------------------------------------- 1 | (ns ring-echo 2 | (use (kapok (io)))) 3 | 4 | (defn repeatedly [n n f acc] 5 | (lists.reverse [(f) & acc])) 6 | 7 | (defn repeatedly [i n f acc] 8 | (repeatedly (+ 1 i) n f [(f) & acc])) 9 | 10 | (defn repeatedly [n f] 11 | (repeatedly 1 n f [])) 12 | 13 | (defn- do-times [n n f] 14 | (f)) 15 | 16 | (defn- do-times [i n f] 17 | (f) 18 | (do-times (+ 1 i) n f)) 19 | 20 | (defn- do-times [n f] 21 | (do-times 1 n f)) 22 | 23 | (defn process [m main] 24 | (receive 25 | ({{first, left}, pidlist, c, message} 26 | (case pidlist 27 | ([h & t] (send h {{first left} t c message})) 28 | ([] (case c 29 | (m (send first {#exit left})) 30 | (_ (send first {{first, left}, left, (+ 1 c) message}))))) 31 | (process m main)) 32 | ({#exit, pidlist} 33 | (case pidlist 34 | ([h & t] (send h {#exit, t})) 35 | ([] #ok)) 36 | (io.format #"process exit.~n") 37 | (send main #ok)) 38 | (other 39 | (io.format #"oh no, something goes wrong! receiving ~p~n" other)) 40 | (after 1000 41 | (io.format #"unexpected timeout") 42 | (throw #'unexpected timeout'))) 43 | ) 44 | 45 | (defn main [] 46 | (let [p 5 47 | m 10 48 | main (erlang.self) 49 | ;; construct process list 50 | pids (repeatedly p (fn [] 51 | (spawn (fn [] (process m main)))))] 52 | ;; start to echo in process ring 53 | (case pids 54 | ([first & left] 55 | (send first {{first left} left 1 #"here is the message"})) 56 | ([] 57 | (io.format #"error: no process to run") 58 | (erlang.exit #"no process to run"))) 59 | ;; make sure all processes are exit 60 | (do-times p (fn [] 61 | (receive 62 | (_message #ok)))))) 63 | 64 | -------------------------------------------------------------------------------- /example/sieve-of-eratosthenes.kpk: -------------------------------------------------------------------------------- 1 | (ns sieve-of-eratosthenes 2 | (require lists 3 | (kapok (io)))) 4 | 5 | (defn- sieve [[] primes] 6 | (lists.reverse primes)) 7 | 8 | (defn- sieve [[h & t] primes] 9 | (sieve (lists.filter (fn [x] 10 | (!= (rem x h) 0)) 11 | t) 12 | [h & primes])) 13 | 14 | (defn sieve [v] 15 | (sieve (lists.seq 2 v) [])) 16 | 17 | (defn main [] 18 | (let [v 1000] 19 | (io.format #"run sieve(~B) return: ~p~n" v (sieve v)))) 20 | -------------------------------------------------------------------------------- /lib/kapok/ebin/.gitignore: -------------------------------------------------------------------------------- 1 | # This ignore file is a hack to add parent dir "ebin" to git repository 2 | # Include this file and track it always 3 | !.gitignore 4 | -------------------------------------------------------------------------------- /lib/kapok/lib/kapok.char.kpk: -------------------------------------------------------------------------------- 1 | (ns kapok.char 2 | "This module contains macros and functions manipulate chars." 3 | ) 4 | 5 | (defmacro upper? [c] 6 | `(op-and (>= ~c $A) 7 | (<= ~c $Z))) 8 | 9 | (defmacro lower? [c] 10 | `(op-and (>= ~c $a) 11 | (<= ~c $z))) 12 | 13 | (defmacro alpha? [c] 14 | `(op-or (kapok.char.#upper? ~c) 15 | (kapok.char.#lower? ~c))) 16 | 17 | (defmacro digit? [c] 18 | `(op-and (>= ~c $0) 19 | (<= ~c $9))) 20 | 21 | (defmacro identifier-start? [c] 22 | `(op-or (kapok.char.#alpha? ~c) 23 | (in ~c [$! $\\ $% $* $+ $- $/ $< $= $> $? $@ $^ $_ $|]))) 24 | 25 | (defmacro identifier-tail? [c] 26 | `(op-or (kapok.char.#digit? ~c) 27 | (in ~c [$~ $& $#]))) 28 | 29 | (defmacro identifier-char? [c] 30 | `(op-or (kapok.char.#identifier-start? ~c) 31 | (kapok.char.#identifier-tail? ~c))) 32 | 33 | -------------------------------------------------------------------------------- /lib/kapok/lib/kapok.code-server.kpk: -------------------------------------------------------------------------------- 1 | (ns kapok.code-server 2 | (require erlang 3 | code) 4 | (use (kapok.core))) 5 | 6 | (defn ensure-loaded [module] (&when (atom? module)) 7 | """Ensure the given module is loaded. 8 | 9 | If the module is already loaded, this works as no-op. If the module 10 | was not yet loaded, it tries to load it. 11 | 12 | If it succeeds loading the module, it returns `{#module module}`. 13 | If not, returns `{#error reason}` with the error reason.""" 14 | (code.ensure_loaded module)) 15 | 16 | (defn ensure-loaded? [module] 17 | """Ensures the given module is loaded. 18 | 19 | Similar to `(ensure-loaded 1)`, but returns `:true`if the module 20 | is already loaded or was successfully loaded. Returns `:false` otherwise. 21 | 22 | ## Examples 23 | 24 | kapok> (code-server.ensure-loaded? atom) 25 | :true 26 | 27 | """ 28 | (match? {#module module} 29 | (ensure-loaded module))) 30 | 31 | (defn ensure-compiled [module] (&when (atom? module)) 32 | """Ensures the given module is compiled and loaded. 33 | 34 | If the module is already loaded, it works as no-op. If the module was 35 | not loaded yet, it checks if it needs to be compiled first then 36 | tries to load it. 37 | 38 | If it succeeds loading the module, it returns `{#module module}`. 39 | If not, returns `{#error reason}` with the error reason.""" 40 | (case (code.ensure_loaded module) 41 | ({#error #nofile} 42 | (try (do 43 | (module.__info__ #module) 44 | {#module module}) 45 | (catch 46 | ((#error error) error)))) 47 | (other 48 | other))) 49 | 50 | (defn ensure-compiled? [module] 51 | """Ensures the given module is compiled and loaded. 52 | 53 | Similar to `(ensure-compiled 1)`, but returns `:true` if the module 54 | is already loaded or was successfully loaded and compiled. 55 | Return `:false` otherwise. 56 | """ 57 | (match? {#module module} 58 | (ensure-compiled module))) 59 | -------------------------------------------------------------------------------- /lib/kapok/lib/kapok.inspect.algebra.kpk: -------------------------------------------------------------------------------- 1 | (ns kapok.inspect.algebra 2 | (require (Elixir.Map :as map) 3 | (Elixir.System :as system) 4 | (Elixir.Process :as process) 5 | (Eilxir.IO :as io) 6 | (Elixir.Inspect.Algebra :as alg) 7 | (kapok (inspect)))) 8 | 9 | (defn 10 | #{:check_remote_call :false} 11 | to-doc 12 | """Converts an Kapok structure to an algebra document 13 | according to the inspect protocol. 14 | """ 15 | 16 | ([#{:__struct__ _} &as struct opts] 17 | (if (map.get opts #structs) 18 | (try (inspect.inspect struct opts) 19 | (catch 20 | (e 21 | (let [st (system.stacktrace)] 22 | ;; Because we try to raise a nice error message in case 23 | ;; we can't inspect a struct, there is a chance the error 24 | ;; message itself relies on the struct being printed, so 25 | ;; we need to trap the inspected messages to guarantee 26 | ;; we won't try to render any failed instruct when building 27 | ;; the error message. 28 | (if (process.get #inspect-trap) 29 | (inspect.map.inspect struct opts) 30 | (try (do 31 | (process.put #inspect-trap :true) 32 | (let [res1 (inspect.map.inspect struct opts) 33 | res2 (io.iodata_to_binary (alg.format res1 #infinity)) 34 | message (io_lib.format "got ~p with message ~s while inspecting ~p" 35 | [(inspect (map.get e #__struct__)) 36 | (exception.message e) 37 | res2]) 38 | exception (inspect.error.exception [{#message message}])] 39 | (if (access.get opts #safe) 40 | (inspect.inspect exception opts) 41 | (reraise exception st)))) 42 | (after 43 | (process.delete #inspect-trap)))))))) 44 | (inspect.map.inspect struct opts)))) 45 | 46 | (defn 47 | #{:check_remote_call :false} 48 | to-doc [arg opts] 49 | (inspect.inspect arg opts)) 50 | -------------------------------------------------------------------------------- /lib/kapok/lib/kapok.inspect.kpk: -------------------------------------------------------------------------------- 1 | (defprotocol kapok.inspect 2 | """The `inspect` protocol is responsible for converting any Kapok 3 | data structure into an algebra document. This document is then 4 | formetted, either in pretty printing format or a regular one. 5 | 6 | The `(inspect 2)` function receives the entity to be inspected 7 | followed by the inspecting options, represented by the struct 8 | `inspect.opts`. 9 | 10 | Inspection is done using the functions available in `Elixir.Inspect.Algebra`. 11 | 12 | ## Examples 13 | 14 | Many times, inspecting a structure can be implemented in function 15 | of existing entities. For example, here is `hashset`'s `inspect` 16 | implementation: 17 | 18 | (defimpl inspect HashSet 19 | (use Elixir.Inspect.Algebra) 20 | (defn inspect [dict opts] 21 | (concat ["#HashSet<" (to_doc (hashset.to-list dict) opts) ">"]))) 22 | 23 | The `concat` function comes from `Elixir.Inspect.Algebra` and it 24 | concatenates algebra documents together. In the example above, 25 | it is concatenating the string `"HashSet<"` (all strings are 26 | valid algebra documents that keep their) formatting when pretty 27 | printed), the document returned by `(inspect.algebra.to-doc 2)` and the 28 | other string `">"`. 29 | 30 | Since regular strings are valid entities in an algebra document, 31 | an implementation of inspect may simply return a string, 32 | although that will devoid it of any pretty-printing. 33 | 34 | # Error handling 35 | 36 | In case there is an error while you structure is being inspected, 37 | Kapok will automatically fall back to a raw representation. 38 | 39 | You can however access the underlying error by invoking the inspect 40 | implementation directly. For example, to test inspect.hashset above, 41 | you can invoke it as: 42 | 43 | (inspect.hashset.inspect (hashset.new) (inspect.opts.new)) 44 | 45 | """ 46 | 47 | (inspect [thing opts]) 48 | ) 49 | 50 | (defimpl kapok.inspect Integer 51 | (require (Elixir.Inspect.Algebra :as alg)) 52 | 53 | (defn inspect [term #{:base base} &as opts] 54 | (-> (Elixir.Integer.to_string term (base-to-value base)) 55 | (prepend-prefix base) 56 | (alg.color #number opts))) 57 | 58 | (defn- base-to-value [base] 59 | (case base 60 | (#binary 2) 61 | (#decimal 10) 62 | (#octal 8) 63 | (#hex 16))) 64 | 65 | (defn- prepend-prefix [value #decimal] 66 | value) 67 | (defn- prepend-prefix [<< $- (value :binary) >> base] 68 | << $- ((prepend-prefix value base) :binary) >>) 69 | (defn- prepend-prefix [value base] 70 | (let [prefix (case base 71 | (#binary "2r") 72 | (#octal "0") 73 | (#hex "0x"))] 74 | << (prefix :binary) (value :binary) >>)) 75 | ) 76 | 77 | (defimpl kapok.inspect Float 78 | (require io_lib_format 79 | (Elixir.IO :as io)) 80 | 81 | (defn inspect [term _opts] 82 | (io.iodata_to_binary (io_lib_format.fwrite_g term))) 83 | ) 84 | 85 | (defimpl kapok.inspect BitString 86 | (require lists 87 | (Elixir.Integer :as integer) 88 | (Elixir.Map :as map) 89 | (Elixir.Inspect.Algebra :as alg) 90 | (Elixir.IO :as io) 91 | (kapok (inspect.Integer))) 92 | 93 | (defn inspect [term opts] (&when (binary? term)) 94 | (let [#{:binaries bins 95 | :base base 96 | :printable_limit printable-limit} opts] 97 | (if (and (== base #decimal) 98 | (or (== bins #as_strings) 99 | (and (== bins #infer) 100 | (Elixir.String.printable? term printable-limit)))) 101 | (let [inspected (case (escape term $" printable-limit) 102 | ({escaped ""} [$" escaped $"]) 103 | ({escaped _} [$" escaped " ..." $"]))] 104 | (alg.color (io.iodata_to_binary inspected) #string opts)) 105 | (inspect-bitstring term opts)))) 106 | 107 | (defn inspect [term opts] 108 | (inspect-bitstring term opts)) 109 | 110 | (defn- inspect-bitstring ["" opts] 111 | (alg.color "<< >>" #binary opts)) 112 | 113 | (defn- inspect-bitstring [bitstring opts] 114 | (let [left (alg.color "<< " #binary opts) 115 | right (alg.color " >>" #binary opts) 116 | inner (each-bit bitstring (map.get opts #limit) opts)] 117 | (alg.group (alg.concat (alg.concat left (alg.nest inner 2)) right)))) 118 | 119 | (defn- each-bit [_ 0 _] 120 | " ...") 121 | 122 | (defn- each-bit [<< >> _counter _opts] 123 | #doc_nil) 124 | 125 | (defn- each-bit [<<(h (:size 8))>> _counter opts] 126 | (inspect.Integer.inspect h opts)) 127 | 128 | (defn- each-bit [<< h (t :bitstring)>> counter opts] 129 | (alg.flex_glue 130 | (inspect.Integer.inspect h opts) 131 | (each-bit t (decrement counter) opts))) 132 | 133 | (defn- each-bit [bitstring _counter opts] 134 | (let [size (bit-size bitstring) 135 | <<(h (:size size))>> bitstring] 136 | << "(" ((inspect.Integer.inspect h opts) :binary) 137 | " (:size " ((integer.to_string size) :binary) "))" >>)) 138 | 139 | (defn- decrement [#infinity] 140 | #infinity) 141 | (defn- decrement [counter] 142 | (dec counter)) 143 | 144 | ;; Escaping 145 | 146 | (defn- escape-map [$\a] << $\\ $a >>) 147 | (defn- escape-map [$\b] << $\\ $b >>) 148 | (defn- escape-map [$\d] << $\\ $d >>) 149 | (defn- escape-map [$\e] << $\\ $e >>) 150 | (defn- escape-map [$\f] << $\\ $f >>) 151 | (defn- escape-map [$\n] << $\\ $n >>) 152 | (defn- escape-map [$\r] << $\\ $r >>) 153 | (defn- escape-map [$\t] << $\\ $t >>) 154 | (defn- escape-map [$\v] << $\\ $v >>) 155 | (defn- escape-map [$\\] << $\\ $\\ >>) 156 | (defn- escape-map [_] :false) 157 | 158 | (defn escape [other char &optional (count #infinity) (fun (fn escape-map 1))] 159 | (escape other char count [] fun)) 160 | 161 | (defn- escape [binary _char 0 acc _fun] 162 | {(lists.reverse acc) binary}) 163 | 164 | (defn- escape [<< char (t :binary) >> char count acc fun] 165 | (escape t char (decrement count) [<< $\\ char >> & acc] fun)) 166 | 167 | (defn- escape [<< (h :utf8) (t :binary) >> char count acc fun] 168 | (let [value (fun h) 169 | escaped (or value (escape-char h))] 170 | (escape t char (decrement count) [escaped & acc] fun))) 171 | 172 | (defn- escape [<< (a (:size 4)) (b (:size 4)) (t :binary) >> char count acc fun] 173 | (escape t char (decrement count) [<< $\\ $x ((to-hex a)) ((to-hex b)) >> & acc] fun)) 174 | 175 | (defn- escape [<< >> _char _count acc _fun] 176 | {(lists.reverse acc) << >>}) 177 | 178 | (defn- escape-char [0] "\\0") 179 | 180 | (defn- escape-char [65279] "\\uFEFF") 181 | 182 | (defn- escape-char [char] (&when (&or (&and (>= char 0x20) (<= char 0x7E)) 183 | (&and (>= char 0xA0) (<= char 0xD7FF)) 184 | (&and (>= char 0xE000) (<= char 0xFFFD)) 185 | (&and (>= char 0x10000) (<= char 0x10FFFF)))) 186 | << (char :utf8) >>) 187 | 188 | (defn- escape-char [char] (&when (< char 0x100)) 189 | (let [<<(a (:size 4)) (b (:size 4))>> <<(char (:size 8))>>] 190 | << $\\ $x ((to-hex a)) ((to-hex b)) >>)) 191 | 192 | (defn- escape-char [char] (&when (< char 0x10000)) 193 | (let [<<(a (:size 4)) 194 | (b (:size 4)) 195 | (c (:size 4)) 196 | (d (:size 4))>> <<(char (:size 16))>>] 197 | << $\\ $x ${ ((to-hex a)) ((to-hex b)) ((to-hex c)) ((to-hex d)) $} >>)) 198 | 199 | (defn- escape-char [char] (&when (< char 0x1000000)) 200 | (let [<<(a (:size 4)) 201 | (b (:size 4)) 202 | (c (:size 4)) 203 | (d (:size 4)) 204 | (e (:size 4)) 205 | (f (:size 4))>> <<(char (:size 24))>>] 206 | << $\\ $x ${ ((to-hex a)) 207 | ((to-hex b)) 208 | ((to-hex c)) 209 | ((to-hex d)) 210 | ((to-hex e)) 211 | ((to-hex f)) $} >>)) 212 | 213 | (defn- to-hex [c] (&when (&and (>= c 0) (<= c 9))) 214 | (+ c $0)) 215 | (defn- to-hex [c] (&when (&and (>= c 10) (<= c 15))) 216 | (+ (- c 10) $A)) 217 | 218 | ) 219 | 220 | (defimpl kapok.inspect Atom 221 | (require (Elixir.Inspect.Algebra :as alg) 222 | (Elixir.IO :as io) 223 | (kapok (char 224 | (inspect.BitString :as bs)))) 225 | (use (kapok ((core :exclude (inspect))))) 226 | 227 | (defn inspect [atom opts] 228 | (let [{doc key} 229 | (case atom 230 | (:false {":false" #boolean}) 231 | (:true {":true" #boolean}) 232 | (:nil {":nil" #boolean}) 233 | (#'' {"#''" #atom}) 234 | (_ (let [b (Elixir.Atom.to_string atom) 235 | d (if (valid-atom-identifier? b) 236 | << "#" (b :binary) >> 237 | (let [{escaped _} (bs.escape b $') 238 | eb (io.iodata_to_binary escaped)] 239 | << $# $' (eb :binary) $' >>))] 240 | {d #atom})))] 241 | (alg.color doc key opts))) 242 | 243 | ;; Detect if atom is an simple atom which consists of identifier characters 244 | ;; (no need to quote). 245 | (defn- valid-atom-identifier? [<<>>] 246 | :true) 247 | 248 | (defn- valid-atom-identifier? [<< h (t :binary) >>] 249 | (&when (char.identifier-char? h)) 250 | (valid-atom-identifier? t)) 251 | 252 | (defn- valid-atom-identifier? [_] 253 | :false) 254 | ) 255 | 256 | (defimpl kapok.inspect List 257 | (require (Elixir.IO :as io) 258 | (Elixir.List :as list) 259 | (Elixir.Inspect.Algebra :as alg) 260 | (kapok (inspect.BitString))) 261 | 262 | (defn inspect [[] opts] 263 | (alg.color "[]" #list opts)) 264 | 265 | ;; TODO remove #char_list and :as_char_lists handling according to Elixir 2.0 266 | (defn inspect [term opts] 267 | (let [#{:charlists lists 268 | :char_lists lists-deprecated 269 | :printable_limit printable-limit} opts 270 | lists1 (if (and (== lists #infer) 271 | (!= lists-deprecated #infer)) 272 | (case lists-deprecated 273 | (#as_char_lists 274 | (io.warn 275 | "the :char_list inspect option and its #as_char_lists value are deprecated, use the :charlists option and its #as_charlists value instead") 276 | #as_charlists) 277 | (_ 278 | (io.warn 279 | "the :char_lists inspect option is deprecated, use :charlists instead") 280 | lists-deprecated)) 281 | lists) 282 | open (alg.color "[" #list opts) 283 | sep "" 284 | close (alg.color "]" #list opts)] 285 | (cond 286 | (or (== lists1 #as_charlists) 287 | (and (== lists1 #infer) 288 | (list.ascii_printable? term printable-limit))) 289 | (let [inspected (case (inspect.BitString.escape 290 | (io.chardata_to_string term) $" printable-limit) 291 | ({escaped ""} [$# $" escaped $"]) 292 | ({escaped _} [$# $" escaped " ..." $"]))] 293 | (io.iodata_to_binary inspected)) 294 | :true 295 | (alg.container_doc open term close opts 296 | (fn kapok.inspect.algebra to-doc 2) 297 | #[:separator sep])))) 298 | ) 299 | 300 | (defimpl kapok.inspect Tuple 301 | (require (Elixir.Tuple :as tuple) 302 | (Elixir.Inspect.Algebra :as alg)) 303 | 304 | (defn inspect [term opts] 305 | (let [open (alg.color "{" #tuple opts) 306 | sep "" 307 | close (alg.color "}" #tuple opts) 308 | container-opts #[:separator sep :break #flex]] 309 | (alg.container_doc open (tuple.to_list term) close opts 310 | (fn kapok.inspect.algebra to-doc 2) container-opts))) 311 | ) 312 | 313 | (defimpl kapok.inspect Map 314 | (require maps 315 | (Elixir.Inspect.Algebra :as alg) 316 | (kapok (inspect.List))) 317 | 318 | (defn inspect [map opts] 319 | (inspect map "" opts)) 320 | 321 | (defn inspect [map name opts] 322 | (let [map1 (maps.to_list map) 323 | open (alg.color << "#" (name :binary) "{" >> #map opts) 324 | sep (alg.color "," #map opts) 325 | close (alg.color "}" #map opts)] 326 | (alg.container_doc open map1 close opts (traverse-fun opts) 327 | #[:separator sep :break #strict]))) 328 | 329 | (defn- traverse-fun [opts] 330 | (fn [kv o] 331 | (to-map kv o (alg.color (alg.break) #map opts)))) 332 | 333 | (defn- to-map [{key value} opts sep] 334 | (alg.concat (alg.concat (kapok.inspect.algebra.to-doc key opts) sep) 335 | (kapok.inspect.algebra.to-doc value opts))) 336 | ) 337 | 338 | (defimpl kapok.inspect PID 339 | (require erlang 340 | (Elixir.IO :as io)) 341 | 342 | (defn inspect [pid _opts] 343 | << "#PID" ((io.iodata_to_binary (erlang.pid_to_list pid)) :binary) >>) 344 | ) 345 | 346 | (defimpl kapok.inspect Port 347 | (require erlang 348 | (Elixir.IO :as io)) 349 | 350 | (defn inspect [port _opts] 351 | (io.iodata_to_binary (erlang.port_to_list port))) 352 | ) 353 | 354 | (defimpl kapok.inspect Reference 355 | (require erlang 356 | (Elixir.IO :as io)) 357 | 358 | (defn inspect [ref _opts] 359 | (let [(op-++ #"#Ref" rest) (erlang.ref_to_list ref)] 360 | << "#Reference" ((io.iodata_to_binary rest) :binary) >>)) 361 | ) 362 | 363 | (defimpl kapok.inspect Any 364 | (require maps 365 | (kapok ((inspect.Atom :as ins-atom) 366 | (inspect.Map :as ins-map)))) 367 | 368 | (defn inspect [#{:__struct__ module} &as struct opts] 369 | (try (module.__struct__) 370 | ((dunder (if (== (maps.keys dunder) (maps.keys struct)) 371 | (let [pruned (maps.remove #__exception__ 372 | (maps.remove #__struct__ struct)) 373 | colorless-opts (maps.put #syntax_colors #[] opts)] 374 | (ins-map.inspect pruned 375 | (ins-atom.inspect module colorless-opts) 376 | opts)) 377 | (inspect.Map.inspect struct opts)))) 378 | (catch 379 | (_ (ins-map.inspect struct opts))))) 380 | ) 381 | -------------------------------------------------------------------------------- /lib/kapok/lib/kapok.io.kpk: -------------------------------------------------------------------------------- 1 | (ns kapok.io 2 | (require io 3 | io_lib)) 4 | 5 | (defn format [format &rest data] 6 | (io.#format format data)) 7 | 8 | (defn format-to [io-device format &rest data] 9 | (io.#format (map-dev io-device) format data)) 10 | 11 | (defalias fwrite format) 12 | (defalias fwrite-to format-to) 13 | 14 | (defn sformat [format &rest data] 15 | (io_lib.#format format data)) 16 | 17 | (defalias sfwrite sformat) 18 | 19 | (defn- map-dev [#stdio] #standard_io) 20 | (defn- map-dev [#stderr] #standard_error) 21 | (defn- map-dev [other] (&when (&or (atom? other) 22 | (pid? other) 23 | (tuple? other))) 24 | other) 25 | 26 | -------------------------------------------------------------------------------- /lib/kapok/lib/kapok.module.kpk: -------------------------------------------------------------------------------- 1 | (ns kapok.module 2 | """This module provides many functions to deal with modules during 3 | compilation time.""" 4 | (require erlang) 5 | (use kapok.core)) 6 | 7 | (defn concat [args] (&when (list? args)) 8 | (binary-to-atom (do-concat args) #utf8)) 9 | 10 | (defn concat [left right] 11 | (concat [left right])) 12 | 13 | (defn safe-concat [args] (&when (list? args)) 14 | (binary-to-existing-atom (do-concat args) #utf8)) 15 | 16 | (defn- atom-to-binary [atom encoding] 17 | (erlang.atom_to_binary atom encoding)) 18 | 19 | (defn- binary-to-atom [binary encoding] 20 | (erlang.binary_to_atom binary encoding)) 21 | 22 | (defn- binary-to-existing-atom [binary encoding] 23 | (erlang.binary_to_existing_atom binary encoding)) 24 | 25 | (defn- do-concat [args] 26 | (do-concat args <<"">>)) 27 | 28 | (defn- do-concat [[h & t] acc] (&when (&and (atom? h) 29 | (!== h :nil))) 30 | (do-concat [(atom-to-binary h #utf8) & t] acc)) 31 | 32 | (defn- do-concat [[:nil & t] acc] 33 | (do-concat t acc)) 34 | 35 | (defn- do-concat [[h & t] acc] (&when (binary? h)) 36 | (let [new-acc (case acc 37 | (<<"">> 38 | <<(h :binary)>>) 39 | (_ 40 | <<(acc :binary) "." (h :binary)>>))] 41 | (do-concat t new-acc))) 42 | 43 | (defn- do-concat [[] acc] 44 | acc) 45 | -------------------------------------------------------------------------------- /lib/kapok/lib/kapok.time.kpk: -------------------------------------------------------------------------------- 1 | (ns kapok.time 2 | (require erlang)) 3 | 4 | (defn date [] 5 | """Returns the current date as {year, month, day}. 6 | 7 | The time zone and Daylight Saving Time correction depend on the underlying OS. 8 | 9 | ## Examples 10 | 11 | kapok> (date) 12 | {1995, 2, 19} 13 | 14 | """ 15 | (erlang.date)) 16 | -------------------------------------------------------------------------------- /lib/kapok/rebar.config: -------------------------------------------------------------------------------- 1 | %% -*- mode: erlang -*- 2 | 3 | %% leex options 4 | {xrl_opts, []}. 5 | 6 | %% leex files to compile first 7 | {xrl_first_files, []}. 8 | 9 | %% yecc options 10 | {yrl_opts, []}. 11 | 12 | %% yecc files to compile first 13 | {yrl_first_files, []}. 14 | 15 | 16 | -------------------------------------------------------------------------------- /lib/kapok/src/kapok.app.src: -------------------------------------------------------------------------------- 1 | {application, kapok, 2 | [{description, "kapok"}, 3 | {vsn, "0.0.1"}, 4 | {modules, [kapok]}, 5 | {registered, [kapok_env, kapok_symbol_table, kapok_code]}, 6 | {applications, [kernel,stdlib]}, 7 | {mod, {kapok, []}}, 8 | {env, []} 9 | ]}. 10 | -------------------------------------------------------------------------------- /lib/kapok/src/kapok.erl: -------------------------------------------------------------------------------- 1 | %% Main entry point for Kapok functions. 2 | -module(kapok). 3 | -behaviour(application). 4 | -export([start_cli/0]). 5 | -include("kapok.hrl"). 6 | 7 | %% OTP Application API 8 | 9 | -export([start/2, stop/1, config_change/3]). 10 | 11 | start(_Type, _Args) -> 12 | %% In case there is a shell, we can't really change its 13 | %% encoding, so we just set binary to true. Otherwise 14 | %% we must set the encoding as the user with no shell 15 | %% has encoding set to latin1. 16 | Opts = 17 | case init:get_argument(noshell) of 18 | {ok, _} -> [binary, {encoding, utf8}]; 19 | error -> [binary] 20 | end, 21 | 22 | ok = io:setopts(standard_io, Opts), 23 | 24 | %% TODO: Remove this once we support only OTP >18 25 | ok = case io:setopts(standard_error, [{encoding, utf8}]) of 26 | ok -> ok; 27 | {error, _} -> io:setopts(standard_error, [{unicode, true}]) %% OTP 17.3 and earlier 28 | end, 29 | 30 | case file:native_name_encoding() of 31 | latin1 -> 32 | io:format(standard_error, 33 | "warning: the VM is running with native name encoding of latin1 which may cause " 34 | "Kapok to malfunction as it expects utf8. Please ensure your locale is set to UTF-8" 35 | " (which can be verified by running \"locale\" in your shell)~n", []); 36 | _ -> 37 | ok 38 | end, 39 | 40 | CompilerOpts = [{docs, true}, {debug_info, true}, {warnings_as_errors, false}], 41 | Config = [{at_exit, []}, {compiler_options, orddict:from_list(CompilerOpts)}], 42 | Tid = kapok_env:new(Config), 43 | case kapok_sup:start_link() of 44 | {ok, Sup} -> 45 | {ok, Sup, Tid}; 46 | {error, _Reason} = Error -> 47 | Error 48 | end. 49 | 50 | stop(Tid) -> 51 | kapok_env:shutdown(Tid). 52 | 53 | config_change(_Changed, _New, _Remove) -> 54 | ok. 55 | 56 | %% Boot and process given options. Invoked by Kapok's script. 57 | 58 | start_cli() -> 59 | {ok, _} = application:ensure_all_started(?MODULE), 60 | 61 | kapok_cli:main(init:get_plain_arguments()). 62 | -------------------------------------------------------------------------------- /lib/kapok/src/kapok.hrl: -------------------------------------------------------------------------------- 1 | %% Scanner helper records and macros 2 | 3 | -record(kapok_scanner_scope, 4 | {file, 5 | terminators=[], 6 | check_terminators=true, 7 | existing_atoms_only=false 8 | }). 9 | 10 | %% Sign 11 | -define(is_sign(S), (S == $+ orelse S == $-)). 12 | 13 | %% Numbers 14 | -define(is_hex(S), (?is_digit(S) orelse (S >= $A andalso S =< $F) orelse (S >= $a andalso S =< $f))). 15 | -define(is_octal(S), (S >= $0 andalso S =< $7)). 16 | -define(is_n_base(S, N), ((N =< 10 andalso (S >= $0 andalso S < ($0 + N))) orelse ?is_digit(S) orelse (S >= $A andalso S < ($A + N - 10)) orelse (S >= $a andalso S < ($a + N - 10)))). 17 | 18 | %% Digits and letters 19 | -define(is_digit(S), (S >= $0 andalso S =< $9)). 20 | -define(is_upcase(S), (S >= $A andalso S =< $Z)). 21 | -define(is_downcase(S), (S >= $a andalso S =< $z)). 22 | 23 | %% Quotes 24 | -define(is_single_quote(S), (S == $')). 25 | 26 | %% Identifiers 27 | -define(is_identifier_start(S), 28 | (?is_upcase(S) orelse ?is_downcase(S) orelse (S == $!) orelse (S == $$) orelse (S == $%) orelse (S == $*) orelse (S == $+) orelse (S == $-) orelse (S == $/) orelse (S == $<) orelse (S == $=) orelse (S == $>) orelse (S == $?) orelse (S == $@) orelse (S == $^) orelse (S == $_) orelse (S == $|))). 29 | -define(is_identifier_char(S), (?is_identifier_start(S) orelse ?is_digit(S) orelse (S == $~) orelse (S == $&) orelse (S == $#))). 30 | 31 | %% Spaces 32 | -define(is_horizontal_space(S), (S == $\s orelse S == $\t)). 33 | -define(is_vertical_space(S), (S == $\r orelse S == $\n)). 34 | -define(is_space(S), (?is_horizontal_space(S) orelse ?is_vertical_space(S))). 35 | -define(is_invalid_space(S), (S == 16#A0)). 36 | 37 | 38 | %% Other compiler helper macros 39 | 40 | -define(line(Opts), kapok_utils:meta_line(Opts)). 41 | -define(m(M, K), maps:get(K, M)). 42 | 43 | -define(is_op(C), (C == '+' orelse C == '-')). 44 | -define(is_number(C), (C == 'number')). 45 | -define(is_keyword_or_atom(C), (C == 'keyword' orelse C == 'atom')). 46 | -define(is_id(C), (C == 'identifier')). 47 | -define(is_local_id(C), (?is_id(C) orelse ?is_keyword_or_atom(C))). 48 | -define(is_dot(C), (C == 'dot')). 49 | -define(is_id_or_dot(C), (?is_id(C) orelse ?is_dot(C))). 50 | -define(is_local_id_or_dot(C), (?is_local_id(C) orelse ?is_dot(C))). 51 | -define(is_list(C), (C == 'list' orelse C == 'literal_list')). 52 | -define(is_cons_list(C), (C == 'cons_list')). 53 | -define(is_parameter_list(C), (C == 'literal_list' orelse C == 'cons_list')). 54 | -define(is_parameter_keyword(C), (C == 'keyword_optional' orelse C == 'keyword_rest' orelse C == 'keyword_key')). 55 | -define(is_string(C), (C == 'list_string' orelse C == 'binary_string')). 56 | 57 | -define(is_ns(Id), (Id == 'ns')). 58 | -define(is_def_ns(Id), (Id == 'defns')). 59 | -define(is_def_fn(Id), (Id == 'defn' orelse Id == 'defn-')). 60 | -define(is_def_macro(Id), (Id == 'defmacro' orelse Id == 'defmacro-')). 61 | -define(is_def_alias(Id), (Id == 'defalias' orelse Id == 'defalias-')). 62 | -define(is_def(Id), (?is_def_fn(Id) orelse ?is_def_macro(Id) orelse ?is_def_alias(Id))). 63 | -define(is_var_arg_op(Id), (Id == 'op-and' orelse Id == 'op-or' orelse Id == 'op-xor')). 64 | -define(is_short_circuit_op(Id), (Id == 'op-andalso' orelse Id == 'op-orelse')). 65 | -define(is_list_op(Id), (Id == 'op-++')). 66 | -define(is_behaviour(Id), (Id == 'behavior' orelse Id == 'behaviour')). 67 | -define(is_attribute(Id), (Id == 'attribute')). 68 | -define(is_attr(Id), (?is_behaviour(Id) orelse ?is_attribute(Id))). 69 | -define(is_special_form(Id), (Id == 'ns' orelse ?is_def(Id) orelse ?is_attr(Id))). 70 | 71 | %% standdard libraries ns name 72 | -define(STDLIB_NS, 'kapok'). 73 | 74 | %% default source file suffix 75 | -define(SOURCE_FILE_SUFFIX, ".kpk"). 76 | -define(BEAM_FILE_SUFFIX, ".beam"). 77 | -------------------------------------------------------------------------------- /lib/kapok/src/kapok_app.erl: -------------------------------------------------------------------------------- 1 | -module(kapok_app). 2 | 3 | -behaviour(application). 4 | 5 | %% Application callbacks 6 | -export([start/2, stop/1]). 7 | 8 | %% =================================================================== 9 | %% Application callbacks 10 | %% =================================================================== 11 | 12 | start(_StartType, _StartArgs) -> 13 | kapok_sup:start_link(). 14 | 15 | stop(_State) -> 16 | ok. 17 | -------------------------------------------------------------------------------- /lib/kapok/src/kapok_cli.erl: -------------------------------------------------------------------------------- 1 | %% Command line functionals. 2 | -module(kapok_cli). 3 | -export([main/1, 4 | run/1]). 5 | -include("kapok.hrl"). 6 | 7 | %% config hold all infos parsed from command line options and arguments. 8 | blank_config() -> 9 | #{commands => [], 10 | compile => [], 11 | compiler_options => [], 12 | outdir => ".", 13 | pa => [], 14 | pz => [], 15 | halt => true, 16 | errors => []}. 17 | 18 | %% Public API 19 | main(Args) -> 20 | {Config, _} = parse_args(Args), 21 | run(fun(_) -> 22 | Errors = process_commands(Config), 23 | if 24 | Errors =/= [] -> 25 | lists:map(fun(E) -> io:format(standard_error, "~s~n", [E]) end, 26 | Errors); 27 | true -> ok 28 | end 29 | end, 30 | ?m(Config, halt)). 31 | 32 | %% run the specified fun on child process 33 | run(Fun) -> 34 | run(Fun, true). 35 | run(Fun, Halt) -> 36 | Res = exec_fun(Fun, {ok, 0}), 37 | if 38 | element(0, Res) == shutdown; Halt -> 39 | {_, Int} = at_exit(Res), 40 | erlang:halt(Int); 41 | true -> ok 42 | end. 43 | 44 | %% spawn a new child process to run the specified fun, and monitor it 45 | exec_fun(Fun, Res) when is_function(Fun, 1) andalso is_tuple(Res) -> 46 | Parent = self(), 47 | {Pid, Ref} = erlang:spawn_monitor( 48 | fun() -> 49 | try Fun(element(1, Res)) of 50 | _ -> Parent ! {self(), Res} 51 | catch 52 | exit:{shutdown, Int} when is_integer(Int) -> 53 | Parent ! {self(), {shutdown, Int}}, 54 | exit({shutdown, Int}); 55 | exit:Reason 56 | when Reason == normal; 57 | Reason == shutdown; 58 | tuple_size(Reason) =:= 2, element(0, Reason) == shutdown -> 59 | Parent ! {self(), {shutdown, 0}}, 60 | exit(Reason); 61 | Kind:Reason -> 62 | Stacktrace = erlang:get_stacktrace(), 63 | print_error(Kind, Reason, Stacktrace), 64 | Parent ! {self(), {shutdown, 1}}, 65 | erlang:raise(Kind, Reason, Stacktrace) 66 | end 67 | end), 68 | receive 69 | {Pid, Res2} -> 70 | erlang:demonitor(Ref, [flush]), 71 | Res2; 72 | {'DOWN', Ref, _, _, Other} -> 73 | print_error({'EXIT', Pid}, Other, []), 74 | {shutdown, 1} 75 | end. 76 | 77 | %% run exit hooks on exit 78 | at_exit(Res) -> 79 | Hooks = kapok_env:get(at_exit), 80 | Res1 = lists:foldl(fun exec_fun/2, Res, Hooks), 81 | {Res1, 0}. 82 | 83 | %% Helpers 84 | 85 | print_error(Kind, Reason, Stacktrace) -> 86 | io:format(standard_error, "~w: ~p~n~p~n", [Kind, Reason, Stacktrace]). 87 | 88 | %% try to parse the shared option, if there is no more shared option then invoke Callback. 89 | shared_option(List, Config, Callback) -> 90 | case parse_shared_args(List, #{errors := Errors} = Config) of 91 | {[H|T], _} when H == hd(List) -> 92 | Error = io_lib:format("Unknown option: ~p", [H]), 93 | Callback(T, Config#{errors => [Error | Errors]}); 94 | {NewList, NewConfig} -> 95 | Callback(NewList, NewConfig) 96 | end. 97 | 98 | %% Parse shared options 99 | parse_shared_args([Opt | _T], _Config) when Opt == "-v"; Opt == "--version" -> 100 | io:format("Kapok ~s~n", [kapok_version:version()]), 101 | erlang:halt(); 102 | parse_shared_args(["-pa", Path | T], #{pa := PA} = Config) -> 103 | Paths = expand_path(Path), 104 | lists:map(fun code:add_patha/1, Paths), 105 | parse_shared_args(T, Config#{pa => PA ++ Paths}); 106 | parse_shared_args(["-pz", Path | T], #{pz := PZ} = Config) -> 107 | Paths = expand_path(Path), 108 | lists:map(fun code:add_pathz/1, Paths), 109 | parse_shared_args(T, Config#{pz => PZ ++ Paths}); 110 | parse_shared_args(Left, Config) -> 111 | {Left, Config}. 112 | 113 | 114 | expand_path(Path) -> 115 | Path1 = filename:absname(expand_home(Path), cwd()), 116 | case wildcard(Path1) of 117 | [] -> [Path1]; 118 | List -> List 119 | end. 120 | 121 | wildcard(Path) -> 122 | filelib:wildcard(Path). 123 | 124 | cwd() -> 125 | case file:get_cwd() of 126 | {ok, Dir} -> Dir; 127 | _ -> nil 128 | end. 129 | 130 | expand_home(Path) -> 131 | Parts = filename:split(Path), 132 | case Parts of 133 | [] -> Path; 134 | [H|T] -> expand_home(H, T) 135 | end. 136 | expand_home("~", Left) -> 137 | Home = os:getenv("HOME"), 138 | expand_home(Home, Left); 139 | expand_home("~" ++ User, Left) -> 140 | Home = filename:join(filename:dirname(os:getenv("HOME")), User), 141 | expand_home(Home, Left); 142 | expand_home(Home, Left) -> 143 | filename:join([Home | Left]). 144 | 145 | %% Parse init options 146 | parse_args(Args) -> 147 | parse_args(Args, blank_config()). 148 | parse_args(["--" | T], Config) -> 149 | {Config, T}; 150 | parse_args(["+kapokc" | T], Config) -> 151 | parse_compiler_args(T, Config); 152 | parse_args([H|T] = List, #{commands := Commands} = Config) -> 153 | case H of 154 | "-" ++ _Rest -> shared_option(List, Config, fun parse_args/2); 155 | _ -> {Config#{commands := [{file, H} | Commands]}, T} 156 | end; 157 | parse_args([], Config) -> 158 | {Config, []}. 159 | 160 | %% Parse compiler options 161 | 162 | parse_compiler_args(["--" | T], Config) -> 163 | {Config, T}; 164 | parse_compiler_args(["-o", Outdir | T], Config) -> 165 | parse_compiler_args(T, Config#{outdir => Outdir}); 166 | parse_compiler_args(["--debug" | T], #{compiler_options := Options} = Config) -> 167 | parse_compiler_args(T, Config#{compiler_options => [{debug, true} | Options]}); 168 | parse_compiler_args(["--verbose" | T], #{compiler_options := Options} = Config) -> 169 | parse_compiler_args(T, Config#{compiler_options => [{verbose, true} | Options]}); 170 | parse_compiler_args([H|T] = List, #{compile := Compile} = Config) -> 171 | case H of 172 | "-" ++ _Rest -> 173 | shared_option(List, Config, fun parse_compiler_args/2); 174 | _ -> 175 | Pattern = case is_dir(H) of 176 | true -> io_lib:format("~s/**/*~s", [H, ?SOURCE_FILE_SUFFIX]); 177 | false -> H 178 | end, 179 | parse_compiler_args(T, Config#{compile => [Pattern | Compile]}) 180 | end; 181 | parse_compiler_args([], #{compile := Compile, commands := Commands} = Config) -> 182 | {Config#{commands => [{compile, Compile} | Commands]}, []}. 183 | 184 | is_dir(Path) -> 185 | kapok_utils:read_file_type(Path) == {ok, 'directory'}. 186 | 187 | is_regular(Path) -> 188 | kapok_utils:read_file_type(Path) == {ok, 'regular'}. 189 | 190 | %% Process commands 191 | process_commands(Config) -> 192 | Options = orddict:from_list(?m(Config, compiler_options)), 193 | kapok_env:update_in(compiler_options, Options), 194 | Results = lists:map(fun(C) -> process_command(C, Config) end, 195 | lists:reverse(?m(Config, commands))), 196 | Errors = [Msg || {error, Msg} <- Results], 197 | lists:reverse(?m(Config, errors)) ++ Errors. 198 | 199 | process_command({file, File}, _Config) -> 200 | case is_regular(File) of 201 | true -> exec_file(File); 202 | false -> {error, io_lib:format("Invalid file: ~p", [File])} 203 | end; 204 | process_command({compile, Patterns}, #{outdir := Outdir} = _Config) -> 205 | kapok_env:put(outdir, Outdir), 206 | %% ensure all parent dirs exist or be created successfully 207 | _ = filelib:ensure_dir(Outdir), 208 | 209 | case filter_multiple_patterns(Patterns) of 210 | {ok, []} -> 211 | {error, "No files matched provided pattern(s)"}; 212 | {ok, Files} -> 213 | lists:map(fun compile_file/1, Files); 214 | {missing, Missing} -> 215 | {error, io_lib:format("No files matched pattern(s) ~s", [join_string_list(Missing, ",")])} 216 | end. 217 | 218 | filter_pattern(Pattern) -> 219 | lists:filter(fun is_regular/1, lists:usort(wildcard(Pattern))). 220 | 221 | filter_multiple_patterns(Patterns) -> 222 | {Match, Missing} = lists:foldl(fun(Pattern, {Match, Missing}) -> 223 | case filter_pattern(Pattern) of 224 | [] -> {Match, [Pattern | Missing]}; 225 | Files -> {Files ++ Match, Missing} 226 | end 227 | end, 228 | {[], []}, 229 | Patterns), 230 | case Missing of 231 | [] -> {ok, lists:usort(Match)}; 232 | _ -> {missing, lists:usort(Missing)} 233 | end. 234 | 235 | join_string_list(List, Sep) when is_list(List) -> 236 | L = lists:foldl(fun(E, Acc) -> 237 | case Acc of 238 | [] -> [E]; 239 | _ -> [E, Sep | Acc] 240 | end 241 | end, 242 | [], 243 | List), 244 | lists:foldl(fun(E, Acc) -> E++Acc end, [], L). 245 | 246 | exec_file(File) -> 247 | kapok_compiler:file(list_to_binary(File)). 248 | 249 | compile_file(File) -> 250 | kapok_compiler:file(list_to_binary(File)). 251 | -------------------------------------------------------------------------------- /lib/kapok/src/kapok_code.erl: -------------------------------------------------------------------------------- 1 | %% Code server for kapok compilation. 2 | -module(kapok_code). 3 | -behaviour(gen_server). 4 | -export([is_loaded/1, 5 | load_ns_for/3, 6 | get_module/1]). 7 | -export([start_link/0, init/1, handle_call/3, handle_cast/2, handle_info/2, 8 | terminate/2, code_change/3]). 9 | -include("kapok.hrl"). 10 | 11 | %% Map namespace to Erlang module with randomly generated name. 12 | 13 | %% Public API 14 | is_loaded(Ns) -> 15 | gen_server:call(?MODULE, {is_loaded, Ns}). 16 | 17 | load_ns_for(Ns, FAP, Ctx) -> 18 | gen_server:call(?MODULE, {load_ns_for, Ns, FAP, Ctx}). 19 | 20 | get_module(Ns) -> 21 | gen_server:call(?MODULE, {get_module, Ns}). 22 | 23 | 24 | %% gen_server API 25 | 26 | start_link() -> 27 | gen_server:start_link({local, ?MODULE}, ?MODULE, [], []). 28 | 29 | init([]) -> 30 | {ok, maps:new()}. 31 | 32 | handle_call({is_loaded, Ns}, _From, NsToModules) -> 33 | {reply, ns_is_loaded(Ns, NsToModules), NsToModules}; 34 | handle_call({load_ns_for, Ns, FAP, Ctx}, _From, NsToModules) -> 35 | {Name, State} = case get_ns(Ns, NsToModules) of 36 | unloaded -> 37 | load_ns(Ns, Ctx, NsToModules); 38 | {loaded, LoadedName} -> 39 | case kapok_dispatch:is_macro_loaded(LoadedName, FAP, Ctx) of 40 | true -> 41 | %% skip to load the specified namespace again 42 | %% if it's loaded already and the specified FAP available. 43 | {LoadedName, NsToModules}; 44 | false -> 45 | unload_ns(LoadedName), 46 | NsToModules1 = remove_ns(Ns, NsToModules), 47 | load_ns(Ns, Ctx, NsToModules1) 48 | end 49 | end, 50 | {reply, {ok, Name}, State}; 51 | handle_call({get_module, Ns}, _From, NsToModules) -> 52 | R = case get_ns(Ns, NsToModules) of 53 | unloaded -> unloaded; 54 | {loaded, LoadedName} -> {ok, LoadedName} 55 | end, 56 | {reply, R, NsToModules}. 57 | 58 | handle_cast({_, _}, State) -> 59 | {noreply, State}. 60 | 61 | handle_info({_, _}, State) -> 62 | {noreply, State}. 63 | 64 | terminate(_Reason, _State) -> 65 | ok. 66 | 67 | code_change(_OldVsn, State, _Extra) -> 68 | {ok, State}. 69 | 70 | %% helper functions. 71 | 72 | ns_is_loaded(Ns, NsToModules) -> 73 | has_ns(Ns, NsToModules) orelse is_loaded_to_evm(Ns). 74 | 75 | has_ns(Ns, NsToModules) -> 76 | maps:is_key(Ns, NsToModules). 77 | 78 | is_loaded_to_evm(Module) -> 79 | case code:is_loaded(Module) of 80 | {file, _} -> true; 81 | false -> false 82 | end. 83 | 84 | get_ns(Ns, NsToModules) -> 85 | case has_ns(Ns, NsToModules) of 86 | true -> 87 | {loaded, maps:get(Ns, NsToModules)}; 88 | false -> 89 | case is_loaded_to_evm(Ns) of 90 | true -> 91 | %% This module is load to evm but not recorded in `kapok_code`. 92 | {loaded, Ns}; 93 | false -> 94 | unloaded 95 | end 96 | end. 97 | 98 | add_ns(Ns, Module, NsToModules) -> 99 | maps:put(Ns, Module, NsToModules). 100 | 101 | remove_ns(Ns, NsToModules) -> 102 | maps:remove(Ns, NsToModules). 103 | 104 | load_ns(Ns, Ctx, NsToModules) -> 105 | Next = next(Ns), 106 | STOptions = [%% export all macros, nomatter public or private 107 | export_all_macro, 108 | %% ignore suspended def clauses 109 | ignore_suspended_def_clauses], 110 | ErlOptions = [%% Turns off warnings for unused local functions. 111 | %% It's possible that there are other functions rather than the 112 | %% called macro definitions. No need to issue warnings in this case. 113 | nowarn_unused_function], 114 | Callback = fun(_Module, _Binary) -> ok end, 115 | kapok_ast:build_namespace(Ns, Next, Ctx, STOptions, ErlOptions, Callback), 116 | %% update internal state 117 | {Next, add_ns(Ns, Next, NsToModules)}. 118 | 119 | next(Ns) -> 120 | kapok_utils:gensym(Ns). 121 | 122 | unload_ns(Ns) -> 123 | %% remove the old module 124 | code:delete(Ns), 125 | ok. 126 | -------------------------------------------------------------------------------- /lib/kapok/src/kapok_compiler.erl: -------------------------------------------------------------------------------- 1 | %% Compiler for kapok 2 | -module(kapok_compiler). 3 | -export([file/1, 4 | string/2, 5 | string_to_ast/4, 6 | 'string_to_ast!'/4, 7 | eval/2, 8 | eval/3, 9 | eval_ast/2, 10 | eval_ast/3]). 11 | -export([core/0]). 12 | -import(kapok_utils, [to_binary/1]). 13 | -include("kapok.hrl"). 14 | 15 | %% Public API 16 | 17 | %% Compilation entry points. 18 | 19 | file(File) when is_binary(File)-> 20 | {ok, Bin} = file:read_file(File), 21 | Contents = kapok_utils:characters_to_list(Bin), 22 | string(Contents, File). 23 | 24 | string(String, File) -> 25 | Ast = 'string_to_ast!'(String, 1, File, []), 26 | Ctx = kapok_ctx:ctx_for_eval([{line, 1}, {file, File}]), 27 | kapok_ast:compile(Ast, Ctx). 28 | 29 | %% Convertion 30 | 31 | %% Converts a given string (char list) into AST. 32 | string_to_ast(String, StartLine, File, Options) when is_integer(StartLine), is_binary(File) -> 33 | case kapok_scanner:scan(String, StartLine, [{file, File}|Options]) of 34 | {ok, Tokens, _EndLocation} -> 35 | try kapok_parser:parse(Tokens) of 36 | {ok, Forms} -> {ok, Forms}; 37 | {error, {_Line, _Module, _ErrorDescription}} = E -> E 38 | catch 39 | {error, {_Line, _Module, _ErrorDescription}} = E -> E 40 | end; 41 | {error, {Location, Module, ErrorDescription}, _Rest, _SoFar} -> 42 | {Line, _} = Location, 43 | {error, {Line, Module, ErrorDescription}} 44 | end. 45 | 46 | 'string_to_ast!'(String, StartLine, File, Options) -> 47 | case string_to_ast(String, StartLine, File, Options) of 48 | {ok, Forms} -> 49 | Forms; 50 | {error, {Line, Module, ErrorDesc}} -> 51 | kapok_error:parse_error(Line, File, Module, ErrorDesc) 52 | end. 53 | 54 | 55 | %% Converts AST to erlang abstract format 56 | ast_to_abstract_format(Ast, Ctx) -> 57 | kapok_trans:translate(Ast, Ctx). 58 | 59 | %% Evaluation 60 | 61 | %% String Evaluation 62 | eval(String, Bindings) -> 63 | eval(String, Bindings, []). 64 | 65 | eval(String, Bindings, Options) when is_list(Options) -> 66 | eval(String, Bindings, kapok_ctx:ctx_for_eval(Options)); 67 | eval(String, Bindings, #{line := Line, file := File} = Ctx) 68 | when is_list(String), is_list(Bindings), is_integer(Line), is_binary(File) -> 69 | Ast = 'string_to_ast!'(String, Line, File, []), 70 | eval_ast(Ast, Bindings, Ctx). 71 | 72 | %% AST Evaluation 73 | eval_ast(Ast, Bindings, Options) when is_list(Options) -> 74 | eval_ast(Ast, Bindings, kapok_ctx:ctx_for_eval(Options)); 75 | eval_ast(Ast, Bindings, Ctx) -> 76 | {_, Ctx1} = kapok_ctx:add_bindings(Ctx, Bindings), 77 | eval_ast(Ast, Ctx1). 78 | eval_ast(Ast, Ctx) -> 79 | {Forms, TCtx1} = ast_to_abstract_format(Ast, Ctx), 80 | kapok_erl:eval_abstract_format(Forms, TCtx1). 81 | 82 | %% CORE HANDLING 83 | 84 | core() -> 85 | compile_libs([{core, true}], fun core_libs/0). 86 | 87 | compile_libs(Options, Fun) -> 88 | {ok, _} = application:ensure_all_started(kapok), 89 | AllOptions = orddict:merge(fun (_K, V1, _V2) -> V1 end, 90 | orddict:from_list(Options), 91 | orddict:from_list([{docs, false}])), 92 | kapok_env:update_in(compiler_options, AllOptions), 93 | lists:foreach(fun (F) -> load_lib(list_to_binary(F)) end, Fun()). 94 | 95 | load_lib(File) -> 96 | InDir = "lib/kapok/lib", 97 | OutDir = <<"lib/kapok/ebin">>, 98 | kapok_env:put(outdir, OutDir), 99 | F = list_to_binary(filename:join(InDir, binary_to_list(File))), 100 | try 101 | io:format("Compile '~s'~n", [F]), 102 | _Ctx = file(F) 103 | catch 104 | Kind:Reason -> 105 | io:format("~p: ~p~nstacktrace: ~p~n", [Kind, Reason, erlang:get_stacktrace()]), 106 | erlang:halt(1) 107 | end. 108 | 109 | core_libs() -> 110 | ["kapok.core.kpk", 111 | "kapok.module.kpk", 112 | "kapok.code-server.kpk", 113 | "kapok.protocol.kpk" 114 | ]. 115 | -------------------------------------------------------------------------------- /lib/kapok/src/kapok_ctx.erl: -------------------------------------------------------------------------------- 1 | %% The compilation time context for a module 2 | -module(kapok_ctx). 3 | -export([new_ctx/0, 4 | add_require/3, 5 | add_require/4, 6 | add_use/3, 7 | add_use/5, 8 | reset_use/2, 9 | add_function/4, 10 | add_macro/4, 11 | reset_macro_context/1, 12 | push_scope/1, 13 | pop_scope/1, 14 | add_var/3, 15 | add_let_var/3, 16 | add_dot_let_var/3, 17 | add_bindings/2, 18 | get_var/3, 19 | get_var_current_scope/3, 20 | ctx_for_eval/1, 21 | reset_ctx/1, 22 | get_metadata/1, 23 | update_metadata/2, 24 | set_metadata/2, 25 | metadata_check_remote_call/1]). 26 | -import(kapok_env, [get_compiler_opt/1]). 27 | -include("kapok.hrl"). 28 | 29 | new_macro_context() -> 30 | #{'__struct__' => 'kapok.macro-context', 31 | backquote_level => 0, %% the level in backquote form (probably embedded) 32 | unquote_level => 0, %% the level in unquote form (probably embedded) 33 | form => nil %% the body of current macro 34 | }. 35 | 36 | new_scope() -> 37 | #{'__struct__' => 'kapok.scope', 38 | parent => nil, %% parent scope 39 | vars => [] %% a set of defined variables 40 | }. 41 | 42 | new_ctx() -> 43 | #{'__struct__' => 'kapok.ctx', 44 | namespace => nil, %% the current namespace 45 | file => <<"nofile">>, %% the current filename 46 | line => 1, %% the current line 47 | def_kind => nil, %% the kind of def* 48 | def_fap => nil, %% the {Fun, Arity, ParameterType} of def* 49 | def_ast => nil, %% the ast of def* 50 | context => nil, %% can be fn_pattern, let_pattern, case_pattern, guards, or nil 51 | macro_context => new_macro_context(), %% 52 | metadata => #{}, %% metadata for compilation 53 | requires => [], %% a dict of modules(and aliases) required in 'name -> original' 54 | uses => [], %% a dict of modules used in 'module -> use arguments' 55 | functions => [], %% a dict of imported functions(and aliases) by 'module -> [fun...]' 56 | macros => [], %% a dict of imported macros(aliases) by 'module -> [macro...]' 57 | scope => new_scope() %% the current scope 58 | }. 59 | 60 | add_require(Meta, Ctx, Require) when is_atom(Require) -> 61 | add_require(Meta, Ctx, Require, Require). 62 | add_require(Meta, #{requires := Requires} = Ctx, Alias, Original) 63 | when is_atom(Alias), is_atom(Original) -> 64 | case orddict:find(Alias, Requires) of 65 | {ok, Original} -> 66 | %% Skip when the specified require is added already. 67 | Ctx; 68 | {ok, Other} -> 69 | kapok_error:compile_error(Meta, ?m(Ctx, file), 70 | "invalid require ~p as ~p, it conflicts with the previous ~p as ~p", 71 | [Alias, Original, Alias, Other]); 72 | error -> 73 | Requires1 = orddict:store(Alias, Original, Requires), 74 | Ctx#{requires => Requires1} 75 | end. 76 | 77 | delete_require(#{requires := Requires} = Ctx, Original) -> 78 | Requires1 = orddict:filter(fun(_K, V) -> V /= Original end, Requires), 79 | Ctx#{requires => Requires1}. 80 | 81 | add_use(Meta, #{uses := Uses} = Ctx, Module) -> 82 | Ctx#{uses => orddict:store(Module, [{meta, Meta}], Uses)}. 83 | 84 | add_use(_Meta, #{uses := Uses} = Ctx, Module, Key, Value) -> 85 | case orddict:find(Module, Uses) of 86 | {ok, Args} -> 87 | NewArgs = orddict:store(Key, Value, Args), 88 | Ctx#{uses => orddict:store(Module, NewArgs, Uses)}; 89 | error -> 90 | NewArgs = [{Key, Value}], 91 | Ctx#{uses => orddict:store(Module, NewArgs, Uses)} 92 | end. 93 | 94 | reset_use(Ctx, Module) -> 95 | Ctx1 = delete_require(Ctx, Module), 96 | Ctx2 = delete_use(Ctx1, Module), 97 | Ctx3 = delete_function(Ctx2, Module), 98 | delete_macro(Ctx3, Module). 99 | 100 | delete_use(#{uses := Uses} = Ctx, Module) -> 101 | Ctx#{uses => orddict:erase(Module, Uses)}. 102 | 103 | add_function(_Meta, #{functions := Functions} = Ctx, Module, ToImports) -> 104 | case orddict:find(Module, Functions) of 105 | {ok, Imports} -> 106 | NewImports = ordsets:union(Imports, ordsets:from_list(ToImports)), 107 | Ctx#{functions => orddict:store(Module, NewImports, Functions)}; 108 | error -> 109 | NewImports = ordsets:from_list(ToImports), 110 | Ctx#{functions => orddict:store(Module, NewImports, Functions)} 111 | end. 112 | 113 | delete_function(#{functions := Functions} = Ctx, Module) -> 114 | Ctx#{functions => orddict:erase(Module, Functions)}. 115 | 116 | add_macro(_Meta, #{macros := Macros} = Ctx, Module, ToImports) -> 117 | case orddict:find(Module, Macros) of 118 | {ok, Imports} -> 119 | NewImports = ordsets:union(Imports, ordsets:from_list(ToImports)), 120 | Ctx#{macros => orddict:store(Module, NewImports, Macros)}; 121 | error -> 122 | NewImports = ordsets:from_list(ToImports), 123 | Ctx#{macros => orddict:store(Module, NewImports, Macros)} 124 | end. 125 | 126 | delete_macro(#{macros := Macros} = Ctx, Module) -> 127 | Ctx#{macros => orddict:erase(Module, Macros)}. 128 | 129 | reset_macro_context(Ctx) -> 130 | Ctx#{macro_context => new_macro_context()}. 131 | 132 | push_scope(#{scope := Scope} = Ctx) -> 133 | NewScope = (new_scope())#{parent => Scope}, 134 | Ctx#{scope => NewScope}. 135 | 136 | pop_scope(#{scope := Scope} = Ctx) -> 137 | case maps:get(parent, Scope) of 138 | nil -> Ctx; 139 | ParentScope -> Ctx#{scope => ParentScope} 140 | end. 141 | 142 | keywords() -> 143 | %% TODO re-check all the keywords are included 144 | ['ns', 'defn', 'defn-', 'defmacro', 'defmacro-', 'defalias', 145 | 'let', 'do', 'case', 'fn', 'try', 'catch', 'send', 'receive']. 146 | 147 | var_exist(Vars, Var) -> 148 | Var =/= '_' andalso orddict:is_key(Var, Vars). 149 | 150 | is_valid_var_name(Var) -> 151 | Keywords = ordsets:from_list(keywords()), 152 | case ordsets:is_element(Var, Keywords) of 153 | true -> false; 154 | false -> true 155 | end. 156 | 157 | add_var(Meta, Ctx, Var) -> 158 | add_var(Meta, Ctx, Var, Var). 159 | 160 | add_let_var(Meta, Ctx, Var) -> 161 | V = atom_to_list(Var), 162 | Prefix = case V of 163 | [$_ | _T] -> "_VAR"; 164 | _ -> "VAR" 165 | end, 166 | Name = kapok_utils:gensym_plain(io_lib:format("~s_~s_", [Prefix, V])), 167 | add_var(Meta, Ctx, Var, Name). 168 | 169 | add_dot_let_var(Meta, Ctx, Prefix) -> 170 | Name = kapok_utils:gensym_plain(io_lib:format("~s_", [Prefix])), 171 | add_var(Meta, Ctx, Name, Name). 172 | 173 | add_var(Meta, #{scope := Scope} = Ctx, Var, Name) -> 174 | case is_valid_var_name(Var) of 175 | true -> ok; 176 | false -> kapok_error:compile_error(Meta, ?m(Ctx, file), "invalid var name: ~s", [Var]) 177 | end, 178 | Vars = maps:get(vars, Scope), 179 | case var_exist(Vars, Var) of 180 | true -> kapok_error:compile_error(Meta, ?m(Ctx, file), 181 | "redeclare symbol: ~p, vars: ~p", [Var, Vars]); 182 | false -> ok 183 | end, 184 | NewVars = orddict:store(Var, Name, Vars), 185 | Ctx1 = Ctx#{scope => Scope#{vars => NewVars}}, 186 | {Name, Ctx1}. 187 | 188 | add_bindings(Ctx, Bindings) -> 189 | lists:mapfoldl(fun({K, _V}, C) -> add_var([], C, K) end, Ctx, Bindings). 190 | 191 | get_var(Meta, #{scope := Scope} = Ctx, Var) -> 192 | get_var_at_scope(Meta, Ctx, Scope, Var, true). 193 | 194 | get_var_current_scope(Meta, #{scope := Scope} = Ctx, Var) -> 195 | get_var_at_scope(Meta, Ctx, Scope, Var, false). 196 | 197 | get_var_at_scope(_Meta, _Ctx, nil, _Var, _Recursive) -> 198 | error; 199 | get_var_at_scope(Meta, Ctx, Scope, Var, Recursive) -> 200 | Vars = maps:get(vars, Scope), 201 | case orddict:find(Var, Vars) of 202 | {ok, _Name} = R -> 203 | R; 204 | error -> 205 | case Recursive of 206 | true -> 207 | Parent = maps:get(parent, Scope), 208 | get_var_at_scope(Meta, Ctx, Parent, Var, Recursive); 209 | false -> 210 | error 211 | end 212 | end. 213 | 214 | %% EVAL HOOKS 215 | 216 | setup_ctx(Ctx) -> 217 | case get_compiler_opt(core) of 218 | true -> Ctx; 219 | false -> kapok_ast:add_uses(Ctx, kapok_dispatch:default_uses()) 220 | end. 221 | 222 | reset_ctx(Ctx) -> 223 | New = ctx_for_eval([]), 224 | New#{file => ?m(Ctx, file), 225 | line => ?m(Ctx, line)}. 226 | 227 | ctx_for_eval(Opts) -> 228 | Ctx = ctx_for_eval((new_ctx())#{requires := kapok_dispatch:default_requires()}, 229 | Opts), 230 | setup_ctx(Ctx). 231 | 232 | ctx_for_eval(Ctx, Opts) -> 233 | Namespace = case lists:keyfind(namespace, 1, Opts) of 234 | {namespace, V} -> V; 235 | false -> nil 236 | end, 237 | 238 | File = case lists:keyfind(file, 1, Opts) of 239 | {file, FileOpt} when is_binary(FileOpt) -> FileOpt; 240 | false -> ?m(Ctx, file) 241 | end, 242 | 243 | Line = case lists:keyfind(line, 1, Opts) of 244 | {line, LineOpt} when is_integer(LineOpt) -> LineOpt; 245 | false -> ?m(Ctx, line) 246 | end, 247 | 248 | Requires = case lists:keyfind(requires, 1, Opts) of 249 | {requires, RequiresOpt} when is_list(RequiresOpt) -> 250 | lists:map(fun({_Alias, _Original} = E) -> E; 251 | (Require) when is_atom(Require) -> {Require, Require} 252 | end, 253 | RequiresOpt); 254 | false -> ?m(Ctx, requires) 255 | end, 256 | 257 | Functions = case lists:keyfind(functions, 1, Opts) of 258 | {functions, FunctionsOpt} when is_list(FunctionsOpt) -> FunctionsOpt; 259 | false -> ?m(Ctx, functions) 260 | end, 261 | 262 | Macros = case lists:keyfind(macros, 1, Opts) of 263 | {macros, MacrosOpt} when is_list(MacrosOpt) -> MacrosOpt; 264 | false -> ?m(Ctx, macros) 265 | end, 266 | 267 | Ctx#{ 268 | namespace := Namespace, 269 | file := File, 270 | line := Line, 271 | requires := Requires, 272 | functions := Functions, 273 | macros := Macros 274 | }. 275 | 276 | 277 | %% metadata 278 | 279 | get_metadata(#{metadata := M} = _Ctx) -> 280 | M. 281 | 282 | update_metadata(#{metadata := M} = Ctx, Metadata) -> 283 | M1 = maps:merge(M, Metadata), 284 | {Ctx#{metadata => M1}, M}. 285 | 286 | set_metadata(#{metadata := M} = Ctx, Metadata) -> 287 | {Ctx#{metadata => Metadata}, M}. 288 | 289 | metadata_check_remote_call(#{metadata := Metadata} = _Ctx) -> 290 | case maps:find(check_remote_call, Metadata) of 291 | {ok, V} -> V; 292 | error -> true 293 | end. 294 | -------------------------------------------------------------------------------- /lib/kapok/src/kapok_dispatch.erl: -------------------------------------------------------------------------------- 1 | %% Helper module for dispatching names(module/function/macro/var) and their references. 2 | -module(kapok_dispatch). 3 | -export([default_requires/0, 4 | default_uses/0, 5 | find_module/3, 6 | find_local_macro/5, 7 | find_remote_macro/6, 8 | find_local_function/2, 9 | find_imported_local_function/3, 10 | find_remote_function/4, 11 | is_macro_loaded/3, 12 | filter_fa/2, 13 | format_error/1]). 14 | -import(kapok_ctx, [metadata_check_remote_call/1]). 15 | -include("kapok.hrl"). 16 | 17 | default_requires() -> 18 | L = [{'kapok_macro', 'kapok_macro'}], 19 | orddict:from_list(L). 20 | 21 | default_uses() -> 22 | [{'kapok.core', 'core'}, 23 | {'kapok.protocol', 'protocol'}]. 24 | 25 | %% get the original module name in case module is an alias or rename. 26 | find_module(_Meta, Module, Ctx) -> 27 | Requires = ?m(Ctx, requires), 28 | case orddict:find(Module, Requires) of 29 | {ok, M1} -> M1; 30 | error -> Module 31 | end. 32 | 33 | %% find local/remote macro/function 34 | 35 | find_local_macro(Meta, FunArity, FunMeta, Args, #{namespace := Namespace} = Ctx) -> 36 | %% check whether the FunArity refers to a macro in current namespace 37 | %% which is defined previously. 38 | Macros = kapok_symbol_table:namespace_macros(Namespace), 39 | case filter_fa(FunArity, Macros) of 40 | [{F, A, P}] -> 41 | {{local, {F, A, P}}, Ctx}; 42 | [] -> 43 | find_import_macro(Meta, FunArity, FunMeta, Args, Ctx) 44 | end. 45 | 46 | find_import_macro(Meta, FunArity, FunMeta, Args, Ctx) -> 47 | {D, Ctx1} = find_dispatch(Meta, FunArity, Ctx), 48 | R = case D of 49 | {macro, MFAP} -> 50 | {remote, MFAP}; 51 | {function, {M, F, A, P}} -> 52 | rewrite_function(Meta, M, F, FunMeta, A, P, Args); 53 | false -> 54 | false 55 | end, 56 | {R, Ctx1}. 57 | 58 | find_remote_macro(Meta, Module, FunArity, FunMeta, Args, Ctx) -> 59 | Original = find_module(Meta, Module, Ctx), 60 | Uses = ?m(Ctx, uses), 61 | case orddict:find(Original, Uses) of 62 | {ok, _} -> 63 | %% Original is declared in ns use clause. 64 | %% Load all the import macros/functions from the specified module if necessary, 65 | %% and then find the specified FunArity. 66 | {D, Ctx1} = find_dispatch(Meta, Original, FunArity, Ctx), 67 | case D of 68 | {macro, MFAP} -> 69 | {{remote, MFAP}, Ctx1}; 70 | {function, {M, F, A, P}} -> 71 | {rewrite_function(Meta, M, F, FunMeta, A, P, Args), Ctx1}; 72 | false -> 73 | find_optional_remote_macro(Meta, Original, FunArity, FunMeta, Args, Ctx1) 74 | end; 75 | error -> 76 | find_optional_remote_macro(Meta, Original, FunArity, FunMeta, Args, Ctx) 77 | end. 78 | 79 | find_optional_remote_macro(Meta, Module, FunArity, FunMeta, Args, Ctx) -> 80 | {D, Ctx1} = find_optional_dispatch(Meta, Module, FunArity, Ctx), 81 | R = case D of 82 | {macro, MFAP} -> 83 | {remote, MFAP}; 84 | {function, {M, F, A, P}} -> 85 | rewrite_function(Meta, M, F, FunMeta, A, P, Args); 86 | unknown_module -> 87 | false; 88 | false -> 89 | false 90 | end, 91 | {R, Ctx1}. 92 | 93 | find_local_function(FunArity, #{def_fap := FAP} = Ctx) -> 94 | case filter_fa(FunArity, [FAP]) of 95 | [{F, A, P}] -> 96 | %% match current function definition 97 | {F, A, P}; 98 | [] -> 99 | %% find in macros/functions of current namespace 100 | Namespace = maps:get(namespace, Ctx), 101 | Locals = kapok_symbol_table:namespace_locals(Namespace), 102 | case filter_fa(FunArity, Locals) of 103 | [{F, A, P}] -> {F, A, P}; 104 | [] -> false 105 | end 106 | end. 107 | 108 | find_imported_local_function(Meta, FunArity, Ctx) -> 109 | {D, Ctx1} = find_dispatch(Meta, FunArity, Ctx), 110 | R = case D of 111 | {Tag, MFAP} when Tag == macro; Tag == function -> MFAP; 112 | false -> false 113 | end, 114 | {R, Ctx1}. 115 | 116 | find_remote_function(Meta, Module, FunArity, Ctx) -> 117 | Original = find_module(Meta, Module, Ctx), 118 | Uses = ?m(Ctx, uses), 119 | case orddict:find(Original, Uses) of 120 | {ok, _} -> 121 | {D, Ctx1} = find_dispatch(Meta, Original, FunArity, Ctx), 122 | case D of 123 | {Tag, MFAP} when Tag == macro; Tag == function -> 124 | {MFAP, Ctx1}; 125 | false -> 126 | find_optional_remote_function(Meta, Original, FunArity, Ctx1) 127 | end; 128 | error -> 129 | find_optional_remote_function(Meta, Original, FunArity, Ctx) 130 | end. 131 | 132 | find_optional_remote_function(Meta, Module, {Fun, Arity} = FunArity, Ctx) -> 133 | {D, Ctx1} = find_optional_dispatch(Meta, Module, FunArity, Ctx), 134 | R = case D of 135 | {Tag, MFAP} when Tag == macro; Tag == function -> 136 | MFAP; 137 | unknown_module -> 138 | case metadata_check_remote_call(Ctx) of 139 | true -> false; 140 | _ -> {Module, Fun, Arity, 'normal'} 141 | end; 142 | Atom when is_atom(Atom) -> 143 | Atom 144 | end, 145 | {R, Ctx1}. 146 | 147 | is_macro_loaded(Module, FAP, Ctx) -> 148 | lists:member(FAP, get_macros([], Module, Ctx)). 149 | 150 | find_optional_dispatch(Meta, Module, FunArity, Ctx) -> 151 | case code:ensure_loaded(Module) of 152 | {module, Module} -> 153 | FunImports = orddict:from_list([{Module, get_optional_functions(Module)}]), 154 | MacroImports = orddict:from_list([{Module, get_optional_macros(Module)}]), 155 | do_find_dispatch(Meta, FunArity, FunImports, MacroImports, Ctx); 156 | {error, _} -> 157 | {unknown_module, Ctx} 158 | end. 159 | 160 | find_dispatch(Meta, Module, FunArity, Ctx) -> 161 | Ctx1 = ensure_uses_imported(Ctx), 162 | %% TODO check whether module is a require alias 163 | FunList = case orddict:find(Module, ?m(Ctx1, functions)) of 164 | {ok, L1} -> L1; 165 | error -> [] 166 | end, 167 | FunImports = orddict:from_list([{Module, FunList}]), 168 | MacroList = case orddict:find(Module, ?m(Ctx1, macros)) of 169 | {ok, L2} -> L2; 170 | error -> [] 171 | end, 172 | MacroImports = orddict:from_list([{Module, MacroList}]), 173 | do_find_dispatch(Meta, FunArity, FunImports, MacroImports, Ctx1). 174 | 175 | find_dispatch(Meta, FunArity, Ctx) -> 176 | Ctx1 = ensure_uses_imported(Ctx), 177 | do_find_dispatch(Meta, FunArity, ?m(Ctx1, functions), ?m(Ctx1, macros), Ctx1). 178 | 179 | do_find_dispatch(Meta, {Fun, Arity} = FunArity, FunImports, MacroImports, Ctx) -> 180 | FunMatch = filter_import(FunArity, FunImports), 181 | MacroMatch = filter_import({Fun, Arity}, MacroImports), 182 | case {FunMatch, MacroMatch} of 183 | {[], [Match]} -> 184 | {M, [{F, A, P}]} = Match, 185 | {{macro, {M, F, A, P}}, Ctx}; 186 | {[Match], []} -> 187 | {M, [{F, A, P}]} = Match, 188 | {{function, {M, F, A, P}}, Ctx}; 189 | {[], []} -> 190 | {false, Ctx}; 191 | _ -> 192 | [First, Second | _T] = FunMatch ++ MacroMatch, 193 | Error = {ambiguous_call, {Fun, Arity, First, Second}}, 194 | kapok_error:form_error(Meta, ?m(Ctx, file), ?MODULE, Error) 195 | end. 196 | 197 | filter_import(FunArity, List) when is_list(List) -> 198 | lists:foldl(fun({Module, Imports}, Acc) -> 199 | case filter_fa(FunArity, Imports) of 200 | [] -> Acc; 201 | R -> orddict:store(Module, R, Acc) 202 | end 203 | end, 204 | [], 205 | List). 206 | 207 | filter_fa({Fun, Arity} = FunArity, FAList) when is_list(FAList) -> 208 | ordsets:fold( 209 | fun({F, A} = FA, Acc) when is_number(A) andalso FA == FunArity -> 210 | [{F, A, 'normal'} | Acc]; 211 | ({Alias, {F, A, P}}, Acc) when (P == 'normal' orelse P == 'key'), {Alias, A} == FunArity -> 212 | [{F, A, P} | Acc]; 213 | ({Alias, {F, A, 'rest'}}, Acc) when (Alias == Fun) andalso (A =< Arity) -> 214 | [{F, A, 'rest'} | Acc]; 215 | ({F, A, P} = FAP, Acc) when (P == 'normal' orelse P == 'key'), {F, A} == FunArity -> 216 | [FAP | Acc]; 217 | ({F, A, 'rest'} = FAP, Acc) when (F == Fun) andalso (A =< Arity) -> 218 | [FAP | Acc]; 219 | (_, Acc) -> 220 | Acc 221 | end, 222 | [], 223 | FAList). 224 | 225 | ensure_uses_imported(#{uses := Uses} = Ctx) -> 226 | lists:foldl(fun({Module, Args}, C) -> 227 | {ok, Meta} = orddict:find(meta, Args), 228 | case module_is_imported(Module, C) of 229 | true -> C; 230 | false -> import_module(Meta, Module, Args, C) 231 | end 232 | end, 233 | Ctx, 234 | Uses). 235 | 236 | module_is_imported(Module, #{functions := Functions, macros := Macros}) -> 237 | orddict:is_key(Module, Functions) orelse orddict:is_key(Module, Macros). 238 | 239 | import_module(Meta, Module, Args, Ctx) -> 240 | {Functions, Macros} = get_exports(Meta, Module, Args, Ctx), 241 | Ctx1 = case Functions of 242 | [] -> Ctx; 243 | _ -> kapok_ctx:add_function(Meta, Ctx, Module, Functions) 244 | end, 245 | Ctx2 = case Macros of 246 | [] -> Ctx1; 247 | _ -> kapok_ctx:add_macro(Meta, Ctx1, Module, Macros) 248 | end, 249 | Ctx2. 250 | 251 | get_exports(Meta, Module, Args, Ctx) -> 252 | Functions = get_functions(Meta, Module, Ctx), 253 | Macros = get_macros(Meta, Module, Ctx), 254 | {filter_exports(Functions, Args), 255 | filter_exports(Macros, Args)}. 256 | 257 | ensure_loaded(Meta, Module, Ctx) -> 258 | case code:ensure_loaded(Module) of 259 | {module, Module} -> 260 | ok; 261 | {error, What} -> 262 | kapok_error:compile_error(Meta, ?m(Ctx, file), 263 | "fail to load module: ~p due to load error: ~p", [Module, What]) 264 | end. 265 | 266 | get_optional_functions(Module) -> 267 | Fun = fun({F, A}) -> {F, A, 'normal'}; 268 | ({_F, _A, _P} = FAP) -> FAP 269 | end, 270 | try 271 | L = Module:'__info__'(functions), 272 | ordsets:from_list(lists:map(Fun, L)) 273 | catch 274 | error:undef -> 275 | try 276 | L1 = Module:module_info(exports), 277 | ordsets:from_list(lists:map(Fun, L1)) 278 | catch 279 | error:undef -> [] 280 | end 281 | end. 282 | 283 | get_functions(Meta, Module, Ctx) -> 284 | ensure_loaded(Meta, Module, Ctx), 285 | Fun = fun({F, A}) -> {F, A, 'normal'}; 286 | ({_F, _A, _P} = FAP) -> FAP 287 | end, 288 | try 289 | L = Module:'__info__'(functions), 290 | ordsets:from_list(lists:map(Fun, L)) 291 | catch 292 | error:undef -> 293 | try 294 | L1 = Module:module_info(exports), 295 | ordsets:from_list(lists:map(Fun, L1)) 296 | catch 297 | error:undef -> 298 | kapok_error:compile_error(Meta, ?m(Ctx, file), 299 | "fail to get exports for unloaded module: ~p", [Module]) 300 | end 301 | end. 302 | 303 | get_optional_macros(Module) -> 304 | try 305 | L = Module:'__info__'(macros), 306 | Fun = fun({F, A}) -> {F, A, 'normal'}; 307 | ({_F, _A, _P} = FAP) -> FAP 308 | end, 309 | ordsets:from_list(lists:map(Fun, L)) 310 | catch 311 | error:undef -> [] 312 | end. 313 | 314 | get_macros(Meta, Module, Ctx) -> 315 | ensure_loaded(Meta, Module, Ctx), 316 | try 317 | L = Module:'__info__'(macros), 318 | Fun = fun({F, A}) -> {F, A, 'normal'}; 319 | ({_F, _A, _P} = FAP) -> FAP 320 | end, 321 | ordsets:from_list(lists:map(Fun, L)) 322 | catch 323 | error:undef -> [] 324 | end. 325 | 326 | filter_exports(Exports, Args) -> 327 | ordsets:from_list(lists:foldl(fun filter_exports_by/2, Exports, Args)). 328 | filter_exports_by({'only', Includes}, Exports) -> 329 | lists:filter(fun(FAP) -> 330 | Match = lists:filter(fun(E) -> match_fa(E, FAP) end, Includes), 331 | case Match of 332 | [] -> false; 333 | _ -> true 334 | end 335 | end, 336 | Exports); 337 | filter_exports_by({'exclude', Excludes}, Exports) -> 338 | lists:filter(fun(FAP) -> 339 | Match = lists:filter(fun(E) -> match_fa(E, FAP) end, Excludes), 340 | case Match of 341 | [] -> true; 342 | _ -> false 343 | end 344 | end, 345 | Exports); 346 | filter_exports_by({'rename', Renames}, Exports) -> 347 | lists:foldl(fun({Fun, Arity, ParaType} = FAP, Acc) -> 348 | New = lists:foldl(fun({Alias, {F, A}}, Acc0) -> 349 | case (F == Fun) andalso (A == Arity) of 350 | true -> [{Alias, {Fun, Arity, ParaType}} | Acc0]; 351 | _ -> Acc0 352 | end; 353 | ({Alias, F}, Acc0) -> 354 | case (F == Fun) of 355 | true -> [{Alias, {Fun, Arity, ParaType}} | Acc0]; 356 | _ -> Acc0 357 | end 358 | end, 359 | [], 360 | Renames), 361 | case New of 362 | [] -> [FAP | Acc]; 363 | _ -> New ++ [FAP | Acc] 364 | end 365 | end, 366 | [], 367 | Exports); 368 | filter_exports_by(_, Exports) -> 369 | Exports. 370 | 371 | match_fa({F, A}, {Fun, Arity, _ParaType}) -> 372 | (F == Fun) andalso (A == Arity); 373 | match_fa(Name, {Fun, _Arity, _ParaType}) when is_atom(Name) -> 374 | Name == Fun. 375 | 376 | rewrite_function(Meta, Module, Fun, FunMeta, Arity, ParaType, Args) -> 377 | case kapok_rewrite:inline(Module, Fun, Arity, ParaType) of 378 | {M, F, _A, _P} -> 379 | Dot = {dot, FunMeta, {{identifier, FunMeta, M}, {identifier, FunMeta, F}}}, 380 | Ast = {list, Meta, [Dot | Args]}, 381 | {rewrite, Ast}; 382 | false -> 383 | case kapok_rewrite:rewrite(Meta, Module, Fun, FunMeta, Arity, ParaType, Args) of 384 | false -> 385 | false; 386 | Ast -> 387 | {rewrite, Ast} 388 | end 389 | end. 390 | 391 | %% ERROR HANDLING 392 | 393 | format_error({ambiguous_call, {M, F, A, FAP1, FAP2}}) -> 394 | io_lib:format("find function ~ts:~ts/~B duplicates in ~p and ~p", [M, F, A, FAP1, FAP2]); 395 | format_error({ambiguous_call, {F, A, FAP1, FAP2}}) -> 396 | io_lib:format("function ~ts/~B imported from both ~p and ~p, call in ambiguous", 397 | [F, A, FAP1, FAP2]). 398 | -------------------------------------------------------------------------------- /lib/kapok/src/kapok_env.erl: -------------------------------------------------------------------------------- 1 | -module(kapok_env). 2 | -compile({no_auto_import, [get/1]}). 3 | -export([get_compiler_opt/1]). 4 | -export([new/1, shutdown/1, put/2, get/1, update/2, update_in/2, get_and_put/2, delete/1]). 5 | -export([start_link/0, init/1, handle_call/3, handle_cast/2, handle_info/2, 6 | code_change/3, terminate/2]). 7 | -behaviour(gen_server). 8 | 9 | %% Helper APIs which wrap public APIs 10 | 11 | get_compiler_opt(Key) -> 12 | Options = kapok_env:get(compiler_options), 13 | case lists:keyfind(Key, 1, Options) of 14 | false -> false; 15 | {Key, Value} -> Value 16 | end. 17 | 18 | %% Public API 19 | 20 | new(Opts) -> 21 | Tid = ets:new(?MODULE, [named_table, public, {read_concurrency, true}]), 22 | true = ets:insert_new(?MODULE, Opts), 23 | Tid. 24 | 25 | shutdown(Tid) -> 26 | ets:delete(Tid). 27 | 28 | put(Key, Value) -> 29 | gen_server:call(?MODULE, {put, Key, Value}). 30 | 31 | get(Key) -> 32 | case ets:lookup(?MODULE, Key) of 33 | [{_, Value}] -> Value; 34 | [] -> nil 35 | end. 36 | 37 | update(Key, Fun) -> 38 | gen_server:call(?MODULE, {update, Key, Fun}). 39 | 40 | update_in(Key, Orddict) when is_list(Orddict) -> 41 | Merge = fun(_, _, Value) -> Value end, 42 | Update = fun(undefined) -> Orddict ; 43 | (Old) when is_list(Old) -> orddict:merge(Merge, Old, Orddict) end, 44 | kapok_env:update(Key, Update). 45 | 46 | get_and_put(Key, Value) -> 47 | gen_server:call(?MODULE, {get_and_put, Key, Value}). 48 | 49 | delete(Key) -> 50 | gen_server:call(?MODULE, {delete, Key}). 51 | 52 | 53 | %% gen_server API 54 | 55 | start_link() -> 56 | gen_server:start_link({local, ?MODULE}, ?MODULE, ?MODULE, []). 57 | 58 | init(Tid) -> 59 | %% ets table must be writable 60 | public = ets:info(Tid, protection), 61 | {ok, Tid}. 62 | 63 | handle_call({put, Key, Value}, _From, Tid) -> 64 | ets:insert(Tid, {Key, Value}), 65 | {reply, ok, Tid}; 66 | handle_call({update, Key, Fun}, _From, Tid) -> 67 | Value = Fun(get(Key)), 68 | ets:insert(Tid, {Key, Value}), 69 | {reply, Value, Tid}; 70 | handle_call({get_and_put, Key, Value}, _From, Tid) -> 71 | OldValue = get(Key), 72 | ets:insert(Tid, {Key, Value}), 73 | {reply, OldValue, Tid}; 74 | handle_call({delete, Key}, _From, Tid) -> 75 | ets:delete(Tid, Key), 76 | {reply, ok, Tid}. 77 | 78 | handle_cast(Cast, Tid) -> 79 | {stop, {bad_cast, Cast}, Tid}. 80 | 81 | handle_info(_Msg, Tid) -> 82 | {noreply, Tid}. 83 | 84 | code_change(_OldVsn, Tid, _Extra) -> 85 | {ok, Tid}. 86 | 87 | terminate(_Reason, _Tid) -> 88 | ok. 89 | -------------------------------------------------------------------------------- /lib/kapok/src/kapok_erl.erl: -------------------------------------------------------------------------------- 1 | %% Module for handling Erlang Abstract Code and dealing with Erlang VM. 2 | -module(kapok_erl). 3 | -export([eval_abstract_format/2, 4 | module/4]). 5 | -import(kapok_env, [get_compiler_opt/1]). 6 | -include("kapok.hrl"). 7 | 8 | 9 | %% Abstract Format Evaluation 10 | eval_abstract_format(Forms, Ctx) when is_list(Forms) -> 11 | lists:mapfoldl(fun eval_abstract_format/2, Ctx, Forms); 12 | eval_abstract_format(Form, #{scope := Scope} = Ctx) -> 13 | case Form of 14 | {atom, _, Atom} -> 15 | {Atom, Ctx}; 16 | _ -> 17 | Vars = maps:get(vars, Scope), 18 | {value, Value, NewBindings} = eval_erl(Form, Vars, Ctx), 19 | {Value, Ctx#{scope => Scope#{vars => orddict:from_list(NewBindings)}}} 20 | end. 21 | 22 | eval_erl(Form, Bindings, Ctx) -> 23 | case erl_eval:check_command([Form], Bindings) of 24 | ok -> ok; 25 | {error, Desc} -> kapok_error:handle_file_error(?m(Ctx, file), Desc) 26 | end, 27 | 28 | %% Below must be all one line for locations to be the same when the stacktrace 29 | %% needs to be extended to the full stacktrace. 30 | try 31 | erl_eval:expr(Form, Bindings) 32 | catch 33 | Class:Exception -> erlang:raise(Class, Exception, get_stacktrace()) 34 | end. 35 | 36 | get_stacktrace() -> 37 | Stacktrace = erlang:get_stacktrace(), 38 | %% eval_eval and eval_bits can call :erlang.raise/3 without the full 39 | %% stacktrace. When this occurs re-add the current stacktrace so that no 40 | %% stack information is lost. 41 | try 42 | throw(stack) 43 | catch 44 | throw:stack -> 45 | %% Ignore stack item for current function. 46 | [_ | CurrentStack] = erlang:get_stacktrace(), 47 | get_stacktrace(Stacktrace, CurrentStack) 48 | end. 49 | 50 | %% The stacktrace did not include the current stack, re-add it. 51 | get_stacktrace([], CurrentStack) -> 52 | CurrentStack; 53 | %% The stacktrace includes the current stack. 54 | get_stacktrace(CurrentStack, CurrentStack) -> 55 | CurrentStack; 56 | get_stacktrace([StackItem | Stacktrace], CurrentStack) -> 57 | [StackItem | get_stacktrace(Stacktrace, CurrentStack)]. 58 | 59 | 60 | %% Compile the module by forms based on the scope information 61 | %% executes the callback in case of success. This automatically 62 | %% handles errors and warnings. Used by this module and kapok_ast. 63 | module(Forms, Options, Ctx, Callback) -> 64 | Final = case (get_compiler_opt(debug_info) == true) orelse 65 | lists:member(debug_info, Options) of 66 | true -> [debug_info] ++ Options ++ env_options(); 67 | false -> Options ++ env_options() 68 | end, 69 | compile_module(Forms, Final, Ctx, Callback). 70 | 71 | compile_module(Forms, Options, #{file := File} = _Ctx, Callback) -> 72 | Source = kapok_utils:characters_to_list(File), 73 | case get_compiler_opt(debug) of 74 | true -> io:format("--- compile_module ---~n~p~n------~n", [Forms]); 75 | false -> ok 76 | end, 77 | case compile:noenv_forms([no_auto_import() | Forms], [return, {source, Source} | Options]) of 78 | {ok, ModuleName, Binary, Warning} -> 79 | format_warnings(Warning), 80 | {module, Module} = code:load_binary(ModuleName, binary_to_list(File), Binary), 81 | Callback(Module, Binary); 82 | {error, Errors, Warnings} -> 83 | format_warnings(Warnings), 84 | format_errors(Errors) 85 | end. 86 | 87 | no_auto_import() -> 88 | {attribute, 0, compile, no_auto_import}. 89 | 90 | env_options() -> 91 | case kapok_env:get(erl_compiler_options) of 92 | nil -> 93 | kapok_env:update(erl_compiler_options, fun env_options/1); 94 | Options -> 95 | Options 96 | end. 97 | 98 | env_options(nil) -> 99 | Key = "ERL_COMPILER_OPTIONS", 100 | case os:getenv(Key) of 101 | false -> 102 | []; 103 | Str when is_list(Str) -> 104 | case erl_scan:string(Str) of 105 | {ok, Tokens, _} -> 106 | case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of 107 | {ok, List} when is_list(List) -> List; 108 | {ok, Term} -> [Term]; 109 | {error, _Reason} -> 110 | io:format("Ignoring bad term in ~ts~n", [Key]), 111 | [] 112 | end; 113 | {error, _, _} -> 114 | io:format("Ignoring bad term in ~ts~n", [Key]), 115 | [] 116 | end 117 | end; 118 | env_options(Options) -> 119 | Options. 120 | 121 | %% ERROR HANDLING 122 | 123 | format_errors([]) -> 124 | exit({nocompile, "compilation failed but no error was raised"}); 125 | format_errors(Errors) -> 126 | lists:foreach(fun({File, Each}) -> 127 | BinFile = kapok_utils:characters_to_binary(File), 128 | lists:foreach(fun(Error) -> 129 | kapok_error:handle_file_error(BinFile, Error) 130 | end, 131 | Each) 132 | end, 133 | Errors). 134 | 135 | format_warnings(Warnings) -> 136 | lists:foreach(fun({File, Each}) -> 137 | BinFile = kapok_utils:characters_to_binary(File), 138 | lists:foreach(fun(Warning) -> 139 | kapok_error:handle_file_warning(BinFile, Warning) 140 | end, 141 | Each) 142 | end, 143 | Warnings). 144 | -------------------------------------------------------------------------------- /lib/kapok/src/kapok_error.erl: -------------------------------------------------------------------------------- 1 | %% A bunch of helpers to help to deal with errors in Kapok source code. 2 | %% This is not exposed in the Kapok language. 3 | -module(kapok_error). 4 | -export([form_error/4, 5 | compile_error/3, 6 | compile_error/4, 7 | parse_error/4, 8 | warn/2, 9 | warn/3, 10 | handle_file_warning/2, 11 | handle_file_error/2 12 | ]). 13 | -include("kapok.hrl"). 14 | 15 | warn(Line, File, Warning) when is_integer(Line), is_binary(File) -> 16 | warn(file_format(Line, File), Warning). 17 | 18 | warn(Caller, Warning) -> 19 | io:put_chars(standard_error, [Caller, "warning: ", Warning, $\n]), 20 | ok. 21 | 22 | %% General form error. 23 | 24 | form_error(Meta, File, Module, ErrorDesc) -> 25 | compile_error(Meta, File, format_error(Module, ErrorDesc)). 26 | 27 | %% Compilation error. 28 | 29 | compile_error(Meta, File, Message) when is_list(Message) -> 30 | compile_error(Meta, File, kapok_utils:characters_to_binary(Message)); 31 | compile_error(Meta, File, Message) when is_binary(Message) -> 32 | raise(Meta, File, 'CompileError', Message). 33 | 34 | compile_error(Meta, File, Format, Args) -> 35 | compile_error(Meta, File, io_lib:format(Format, Args)). 36 | 37 | %% Tokenization/parsing error. 38 | 39 | parse_error(Line, File, Module, ErrorDesc) -> 40 | Message = format_error(Module, ErrorDesc), 41 | raise(Line, File, 'SyntaxError', kapok_utils:characters_to_binary(Message)). 42 | 43 | %% Handle warnings and errors from Erlang land (called during module compilation) 44 | 45 | %% Default behaviour 46 | handle_file_warning(File, {Line, Module, Desc}) -> 47 | Message = format_error(Module, Desc), 48 | warn(Line, File, Message). 49 | 50 | 51 | handle_file_error(File, {Line, erl_lint, {unsafe_to_atom, Var, {In, _Where}}}) -> 52 | Translated = case In of 53 | 'orelse' -> 'or'; 54 | 'andalso' -> 'and'; 55 | _ -> In 56 | end, 57 | Message = io_lib:format("cannot define variable ~ts inside ~ts", [Var, Translated]), 58 | raise(Line, File, 'CompileError', kapok_utils:characters_to_binary(Message)); 59 | 60 | %% Default behaviour 61 | handle_file_error(File, {Line, Module, Desc}) -> 62 | Message = format_error(Module, Desc), 63 | raise(Line, File, 'CompileError', kapok_utils:characters_to_binary(Message)). 64 | 65 | 66 | %% Helpers 67 | 68 | raise(Meta, File, Kind, Message) when is_list(Meta), is_binary(File), is_binary(Message) -> 69 | Line = ?line(Meta), 70 | raise(Line, File, Kind, Message); 71 | raise(Line, File, Kind, Message) when is_binary(File), is_binary(Message) -> 72 | io:format("~p, file: ~p, line: ~p, ~s\n\n", [Kind, File, Line, Message]), 73 | %% reset stacktrace 74 | Stacktrace = try 75 | throw(ok) 76 | catch 77 | ok -> erlang:get_stacktrace() 78 | end, 79 | Exception = {Kind, File, Line, Message}, 80 | erlang:raise(error, Exception, tl(Stacktrace)). 81 | 82 | file_format(0, File) -> 83 | io_lib:format("~ts: ", [kapok_utils:relative_to_cwd(File)]); 84 | file_format(Line, File) -> 85 | io_lib:format("~ts:~w: ", [kapok_utils:relative_to_cwd(File), Line]). 86 | 87 | 88 | format_error(Module, ErrorDesc) when is_atom(Module) -> 89 | Message = Module:format_error(ErrorDesc), 90 | case Message of 91 | [H | _] when is_list(H) -> 92 | string:join(Message, ""); 93 | _ -> 94 | Message 95 | end. 96 | -------------------------------------------------------------------------------- /lib/kapok/src/kapok_macro.erl: -------------------------------------------------------------------------------- 1 | -module(kapok_macro). 2 | -export(['__info__'/1, 3 | expand/2, 4 | expand_n/3, 5 | expand_1/2, 6 | append/2, 7 | 'list*'/2]). 8 | -import(kapok_scanner, [token_meta/1, token_text/1]). 9 | -import(kapok_parser, [is_plain_dot/1, plain_dot_name/1, plain_dot_mf/1]). 10 | -import(kapok_env, [get_compiler_opt/1]). 11 | -include("kapok.hrl"). 12 | 13 | '__info__'(functions) -> 14 | []; 15 | '__info__'(macros) -> 16 | [{append, 2, 'normal'}, 17 | {'list*', 2, 'normal'}]. 18 | 19 | %% Expending macros. 20 | 21 | expand(List, Ctx) when is_list(List) -> 22 | lists:mapfoldl(fun expand/2, Ctx, List); 23 | expand(Ast, Ctx) -> 24 | {EAst, ECtx, Expanded} = expand_1(Ast, Ctx), 25 | case Expanded of 26 | true -> expand(EAst, ECtx); 27 | false -> {EAst, ECtx} 28 | end. 29 | 30 | expand_n(Ast, Ctx, N) when N == 0 -> 31 | {Ast, Ctx}; 32 | expand_n(Ast, Ctx, N) when N > 0 -> 33 | {EAst, ECtx, Expanded} = expand_1(Ast, Ctx), 34 | case Expanded of 35 | true -> expand_n(EAst, ECtx, N-1); 36 | false -> {EAst, ECtx} 37 | end. 38 | 39 | %% a list of ast 40 | expand_1(List, Ctx) when is_list(List) -> 41 | expand_list(List, Ctx); 42 | 43 | %% special forms 44 | %% TODO restore this __MODULE__ to macro after `ns`, `defn` is refactored to macros. 45 | %% expand_1({list, Meta, [{identifier, _, '__MODULE__'}]}, Ctx) -> 46 | %% io:format("*** expend __MODULE__ to: ~p ***~n", [?m(Ctx, namespace)]), 47 | %% {{atom, Meta, ?m(Ctx, namespace)}, Ctx, true}; 48 | 49 | %% suppress the expansion of code in special forms `ns', `defns' to avoid 50 | %% the verbose error report when using Elixir libraries in ns form, 51 | %% which happens to output messages like: 52 | %% 53 | %% =ERROR REPORT==== 16-Mar-2018::17:49:08 === 54 | %% Loading of /path/to/elixir/lib/elixir/ebin/Elixir.beam failed: badfile 55 | %% 56 | %% =ERROR REPORT==== 16-Mar-2018::17:49:08 === 57 | %% beam/beam_load.c(1412): Error loading module 'Elixir': 58 | %% module name in object code is elixir 59 | %% 60 | expand_1({list, _, [{identifier, _, Id} | _T]} = Ast, Ctx) 61 | when ?is_ns(Id); ?is_def_ns(Id) -> 62 | {Ast, Ctx, false}; 63 | 64 | expand_1({list, Meta, [{identifier, _, Id} = Def | T]}, Ctx) when ?is_def(Id) -> 65 | %% TODO move defs into `core' as predefined macros 66 | {ET, ECtx, Expanded} = expand_1(T, Ctx), 67 | {{list, Meta, [Def | ET]}, ECtx, Expanded}; 68 | 69 | expand_1({list, Meta, [{identifier, IdMeta, Id} | Args]} = Ast, Ctx) -> 70 | Arity = length(Args), 71 | {R, Ctx1} = kapok_dispatch:find_local_macro(Meta, {Id, Arity}, IdMeta, Args, Ctx), 72 | case R of 73 | {local, {F, A, P} = FAP} -> 74 | %% to call a previously defined macro in the namespace 75 | Namespace = ?m(Ctx1, namespace), 76 | {ok, Module} = kapok_code:load_ns_for(Namespace, FAP, Ctx1), 77 | NewArgs = kapok_trans:construct_new_args('expand', Arity, A, P, Args), 78 | {EAst, ECtx} = expand_macro_named(Meta, Module, F, A, NewArgs, Ctx1), 79 | {EAst, ECtx, true}; 80 | {remote, {M, F, A, P}} -> 81 | %% to call a macro defined in another module 82 | NewArgs = kapok_trans:construct_new_args('expand', Arity, A, P, Args), 83 | {EAst, ECtx} = expand_macro_named(Meta, M, F, A, NewArgs, Ctx1), 84 | {EAst, ECtx, true}; 85 | {rewrite, Ast1} -> 86 | {Ast1, Ctx1, true}; 87 | false -> 88 | expand_list(Ast, Ctx1) 89 | end; 90 | expand_1({list, Meta, [{dot, DotMeta, _} = Dot | Args]} = Ast, Ctx) -> 91 | case is_plain_dot(Dot) of 92 | true -> 93 | {Module, Fun} = plain_dot_mf(Dot), 94 | Arity = length(Args), 95 | {R, Ctx1} = kapok_dispatch:find_remote_macro(Meta, Module, {Fun, Arity}, DotMeta, Args, Ctx), 96 | case R of 97 | {remote, {M, F, A, P}} -> 98 | NewArgs = kapok_trans:construct_new_args('expand', Arity, A, P, Args), 99 | {EAst, ECtx} = expand_macro_named(Meta, M, F, A, NewArgs, Ctx1), 100 | {EAst, ECtx, true}; 101 | {rewrite, Ast1} -> 102 | {Ast1, Ctx1, true}; 103 | false -> 104 | expand_list(Ast, Ctx1) 105 | end; 106 | false -> 107 | expand_list(Ast, Ctx) 108 | end; 109 | %% list and literal list 110 | expand_1({Category, _, _} = Ast, Ctx) when ?is_list(Category) -> 111 | expand_list(Ast, Ctx); 112 | %% cons_list and dot 113 | expand_1({Category, Meta, {Head, Tail}}, Ctx) when ?is_cons_list(Category); ?is_dot(Category) -> 114 | {EHead, ECtx1, Expanded1} = expand_1(Head, Ctx), 115 | {ETail, ECtx2, Expanded2} = expand_1(Tail, ECtx1), 116 | {{Category, Meta, {EHead, ETail}}, ECtx2, Expanded1 orelse Expanded2}; 117 | %% non-list collections 118 | expand_1({Category, Meta, Args}, Ctx) 119 | when Category == 'bitstring', is_list(Args); 120 | Category == 'tuple'; 121 | Category == 'map'; 122 | Category == 'set' -> 123 | {EArgs, ECtx, Expanded} = expand_1(Args, Ctx), 124 | {{Category, Meta, EArgs}, ECtx, Expanded}; 125 | 126 | %% bind 127 | expand_1({Category, Meta, {Arg, Id}}, Ctx) when Category == bind -> 128 | {EArg, ECtx1, Expanded1} = expand_1(Arg, Ctx), 129 | {EId, ECtx2, Expended2} = expand_1(Id, ECtx1), 130 | {{Category, Meta, {EArg, EId}}, ECtx2, Expanded1 orelse Expended2}; 131 | 132 | %% macro special forms 133 | 134 | %% quote 135 | expand_1({Category, Meta, Arg}, Ctx) when Category =:= quote -> 136 | {EArg, ECtx, Expanded} = expand_1(Arg, Ctx), 137 | {{Category, Meta, EArg}, ECtx, Expanded}; 138 | 139 | %% backquote, unquote, unquote_splicing 140 | expand_1({Category, _Meta, _Arg} = Ast, Ctx) when Category =:= quote; 141 | Category =:= backquote; 142 | Category =:= unquote; 143 | Category =:= unquote_splicing -> 144 | %% don't expand backquote since its evaluation is meant to be delayed. 145 | {Ast, Ctx, false}; 146 | 147 | %% atom 148 | expand_1(Ast, Ctx) -> 149 | {Ast, Ctx, false}. 150 | 151 | expand_list({Category, Meta, List}, Ctx) when ?is_list(Category), is_list(List) -> 152 | {EList, ECtx, Expanded} = expand_list(List, Ctx), 153 | {{Category, Meta, EList}, ECtx, Expanded}; 154 | expand_list(List, Ctx) when is_list(List) -> 155 | {EList, {ECtx, Expanded}} = lists:mapfoldl(fun(Ast, {Ctx1, Expanded1}) -> 156 | {EAst, ECtx1, Expanded2} = expand_1(Ast, Ctx1), 157 | {EAst, {ECtx1, Expanded2 orelse Expanded1}} 158 | end, 159 | {Ctx, false}, 160 | List), 161 | {EList, ECtx, Expanded}. 162 | 163 | 164 | %% macro expansion helper functions 165 | 166 | expand_macro_named(Meta, Receiver, Name, Arity, Args, Ctx) -> 167 | case get_compiler_opt(debug) of 168 | true -> io:format("macro ~s:~s/~B args:~n~p~n", [Receiver, Name, Arity, Args]); 169 | false -> ok 170 | end, 171 | Fun = fun Receiver:Name/Arity, 172 | Result = expand_macro_fun(Meta, Fun, Receiver, Name, Args, Ctx), 173 | case get_compiler_opt(debug) of 174 | true -> io:format("macro ~s:~s/~B result:~n~p~n", [Receiver, Name, Arity, Result]); 175 | false -> ok 176 | end, 177 | {Result, Ctx}. 178 | 179 | expand_macro_fun(Meta, Fun, Receiver, Name, Args, Ctx) -> 180 | %% TODO push meta, name, ctx into process cache 181 | %% and then pop it when macro finishs. 182 | Line = ?line(Meta), 183 | try 184 | apply(Fun, Args) 185 | catch 186 | Kind:Reason -> 187 | Arity = length(Args), 188 | MFA = {Receiver, Name, Arity}, 189 | Info = [{Receiver, Name, Arity, [{file, "expand macro"}]}, caller(Line, Ctx)], 190 | erlang:raise(Kind, Reason, prune_stacktrace(erlang:get_stacktrace(), MFA, Info, nil)) 191 | end. 192 | 193 | caller(Line, #{namespace := Namespace} = Ctx) -> 194 | {Namespace, undefined, undefined, location(Line, Ctx)}. 195 | 196 | location(Line, Ctx) -> 197 | [{file, kapok_utils:characters_to_list(?m(Ctx, file))}, 198 | {line, Line}]. 199 | 200 | %% We've reached the invoked macro, skip it with the rest 201 | prune_stacktrace([{M, F, A, _} | _], {M, F, A}, Info, _Ctx) -> 202 | Info; 203 | %% We've reached the expand/dispatch internals, skip it with the rest 204 | prune_stacktrace([{Mod, _, _, _} | _], _MFA, Info, _Ctx) 205 | when Mod == kapok_dispatch; Mod == kapok_macro -> 206 | Info; 207 | prune_stacktrace([H|T], MFA, Info, Ctx) -> 208 | [H|prune_stacktrace(T, MFA, Info, Ctx)]; 209 | prune_stacktrace([], _MFA, Info, _Ctx) -> 210 | Info. 211 | 212 | 213 | %% List building after evaluating macros. 214 | 215 | append(Ast1, Ast2) -> 216 | RAst = do_append(Ast1, Ast2), 217 | case get_compiler_opt(debug) of 218 | true -> io:format("--- call kapok_macro:append() ---~nAst1: ~p~nAst2: ~p~nresult: ~p~n===~n", 219 | [Ast1, Ast2, RAst]); 220 | false -> ok 221 | end, 222 | RAst. 223 | 224 | do_append({Category1, Meta1, List1}, {Category2, _, List2}) 225 | when ?is_list(Category1), ?is_list(Category2), is_list(List1), is_list(List2) -> 226 | {Category2, Meta1, lists:append(List1, List2)}; 227 | do_append(List1, {Category2, Meta2, List2}) 228 | when ?is_list(Category2), is_list(List1), is_list(List2) -> 229 | {Category2, Meta2, lists:append(List1, List2)}; 230 | do_append(Ast1, Ast2) -> 231 | kapok_error:compile_error(token_meta(Ast1), 232 | <<"in macro:append()">>, 233 | "invalid arguments, (~s, ~s)", 234 | [token_text(Ast1), token_text(Ast2)]). 235 | 236 | 'list*'(Ast1, Ast2) -> 237 | Ctx = kapok_ctx:ctx_for_eval([{line, ?LINE}, {file, kapok_utils:to_binary(?FILE)}]), 238 | %% Expend just once for `Ast2', which is always `kapok_macro:append' for the tail 239 | %% of a backquote list tail. 240 | {EAst2, _} = expand_n(Ast2, Ctx, 1), 241 | RAst = 'do_list*'(Ast1, EAst2), 242 | case get_compiler_opt(debug) of 243 | true -> io:format("--- call kapok_macro:list*() ---~nAst1: ~p~nAst2: ~p~nresult: ~p~n===~n", 244 | [Ast1, EAst2, RAst]); 245 | false -> ok 246 | end, 247 | RAst. 248 | 249 | 'do_list*'({Category1, Meta1, List1}, {Category2, _Meta2, List2}) 250 | when ?is_list(Category1), is_list(List1), ?is_list(Category2), is_list(List2) -> 251 | {Category1, Meta1, lists:append(List1, List2)}; 252 | 'do_list*'(Ast1, Ast2) -> 253 | kapok_error:compile_error(token_meta(Ast1), 254 | <<"in macro:list*()">>, 255 | "invalid arguments: (~s, ~s)", 256 | [token_text(Ast1), token_text(Ast2)]). 257 | -------------------------------------------------------------------------------- /lib/kapok/src/kapok_parser.yrl: -------------------------------------------------------------------------------- 1 | %% 2 | Header "%% THIS FILE IS AUTO-GENERATED BY YECC. " 3 | "%% DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING.". 4 | 5 | Nonterminals 6 | grammar 7 | expression expression_list expressions 8 | number signed_number 9 | keyword_expr atom_expr local_id_expr 10 | bitstring_arg commas_bitstring_arg bitstring_arg_list bitstring_args bitstring_collection 11 | quote_expr backquote_expr unquote_expr unquote_splicing_expr macro_expr 12 | non_dot_expr value 13 | collection_value comma_collection_value collection_value_list collection_values 14 | open_paren close_paren open_bracket close_bracket list_collection cons_list 15 | open_bang_bracket keyword_list 16 | open_curly close_curly tuple_collection 17 | paired_comma_collection_values paired_collection_value_list paired_collection_values 18 | unpaired_collection_value_list unpaired_collection_values open_bang_curly map_collection 19 | open_percent_curly set_collection 20 | dot_op dot_value dot_expr 21 | . 22 | 23 | Terminals 24 | hex_number octal_number n_base_number char_number integer float '+' '-' 25 | binary_string list_string identifier '.' 26 | keyword keyword_safe keyword_unsafe atom atom_safe atom_unsafe 27 | '(' ')' '[' '#[' ']' '{' '%{' '#{' '}' '<<' '>>' ',' 28 | unquote_splicing backquote quote unquote 29 | keyword_as keyword_optional keyword_rest keyword_key keyword_cons 30 | keyword_when keyword_and keyword_or 31 | . 32 | 33 | Rootsymbol grammar. 34 | 35 | %% MAIN FLOW OF EXPRESSIONS 36 | 37 | grammar -> expressions : '$1'. 38 | grammar -> '$empty' : nil. 39 | 40 | % expression as represented in list format 41 | expression -> value : '$1'. 42 | 43 | expression_list -> expression : ['$1']. 44 | expression_list -> expression_list expression : ['$2' | '$1']. 45 | 46 | expressions -> expression_list : lists:reverse('$1'). 47 | 48 | %% Value 49 | 50 | %% Literals 51 | %% number 52 | number -> hex_number : build_number('$1'). 53 | number -> octal_number : build_number('$1'). 54 | number -> n_base_number : build_number('$1'). 55 | number -> char_number : build_number('$1'). 56 | number -> integer : build_number('$1'). 57 | number -> float : build_number('$1'). 58 | 59 | value -> non_dot_expr : '$1'. 60 | value -> dot_expr : '$1'. 61 | 62 | non_dot_expr -> number : '$1'. 63 | non_dot_expr -> signed_number : '$1'. 64 | %% function argument and pattern guard keywords 65 | non_dot_expr -> keyword_optional : '$1'. 66 | non_dot_expr -> keyword_rest : '$1'. 67 | non_dot_expr -> keyword_key : '$1'. 68 | non_dot_expr -> keyword_when : '$1'. 69 | non_dot_expr -> keyword_and : '$1'. 70 | non_dot_expr -> keyword_or : '$1'. 71 | %% includes dot_value 72 | non_dot_expr -> dot_value : '$1'. 73 | %% macro 74 | %% macro_expr is included in `dot_value' 75 | %% strings 76 | non_dot_expr -> binary_string : '$1'. 77 | non_dot_expr -> list_string : '$1'. 78 | %% collections 79 | non_dot_expr -> bitstring_collection : '$1'. 80 | %% list_collection is included in `dot_value' 81 | non_dot_expr -> cons_list: '$1'. 82 | non_dot_expr -> keyword_list: '$1'. 83 | non_dot_expr -> tuple_collection : '$1'. 84 | non_dot_expr -> map_collection : '$1'. 85 | non_dot_expr -> set_collection : '$1'. 86 | 87 | %% signed number 88 | signed_number -> '+' : build_signed_number('$1'). 89 | signed_number -> '-' : build_signed_number('$1'). 90 | 91 | %% keyword 92 | keyword_expr -> keyword : build_keyword_atom('$1'). 93 | keyword_expr -> keyword_safe : build_quoted_keyword_atom('$1', true). 94 | keyword_expr -> keyword_unsafe : build_quoted_keyword_atom('$1', false). 95 | 96 | %% atom 97 | atom_expr -> atom : build_keyword_atom('$1'). 98 | atom_expr -> atom_safe : build_quoted_keyword_atom('$1', true). 99 | atom_expr -> atom_unsafe : build_quoted_keyword_atom('$1', false). 100 | 101 | 102 | %% local id, includes identifier, keyword, and atom 103 | local_id_expr -> identifier : '$1'. 104 | local_id_expr -> keyword_expr : '$1'. 105 | local_id_expr -> atom_expr : '$1'. 106 | 107 | %% dot 108 | dot_op -> '.' : '$1'. 109 | 110 | dot_value -> local_id_expr : '$1'. 111 | dot_value -> list_collection : '$1'. 112 | dot_value -> macro_expr : '$1'. 113 | 114 | dot_expr -> dot_expr dot_op dot_value : build_dot('$2', '$1', '$3'). 115 | dot_expr -> dot_value dot_op dot_value : build_dot('$2', '$1', '$3'). 116 | 117 | %% Macro syntaxs 118 | macro_expr -> quote_expr : '$1'. 119 | macro_expr -> backquote_expr : '$1'. 120 | macro_expr -> unquote_expr : '$1'. 121 | macro_expr -> unquote_splicing_expr : '$1'. 122 | 123 | quote_expr -> quote value : build_quote('$1', '$2'). 124 | backquote_expr -> backquote value : build_backquote('$1', '$2'). 125 | unquote_expr -> unquote non_dot_expr : build_unquote('$1', '$2'). 126 | unquote_splicing_expr -> unquote_splicing list_collection : build_unquote_splicing('$1', '$2'). 127 | unquote_splicing_expr -> unquote_splicing identifier : build_unquote_splicing('$1', '$2'). 128 | 129 | %%% Collections 130 | 131 | %% Bitstring 132 | 133 | bitstring_arg -> value : build_bitstring_element('$1'). 134 | commas_bitstring_arg -> bitstring_arg : '$1'. 135 | commas_bitstring_arg -> ',' bitstring_arg : '$2'. 136 | bitstring_arg_list -> bitstring_arg : ['$1']. 137 | bitstring_arg_list -> bitstring_arg_list commas_bitstring_arg : ['$2' | '$1']. 138 | 139 | bitstring_args -> bitstring_arg_list : lists:reverse('$1'). 140 | 141 | bitstring_collection -> '<<' '>>' : build_bitstring('$1', []). 142 | bitstring_collection -> '<<' bitstring_args '>>' : build_bitstring('$1', '$2'). 143 | bitstring_collection -> '<<' list_string '>>' : build_bitstring('$1', '$2'). 144 | bitstring_collection -> '<<' binary_string '>>' : build_bitstring('$1', '$2'). 145 | 146 | %% List 147 | 148 | collection_value -> value: '$1'. 149 | collection_value -> value keyword_as identifier: build_bind('$2', '$1', '$3'). 150 | 151 | comma_collection_value -> collection_value : '$1'. 152 | comma_collection_value -> ',' collection_value : '$2'. 153 | 154 | collection_value_list -> collection_value : ['$1']. 155 | collection_value_list -> collection_value_list comma_collection_value : ['$2' | '$1']. 156 | 157 | collection_values -> collection_value_list : lists:reverse('$1'). 158 | 159 | open_bracket -> '[' : '$1'. 160 | close_bracket -> ']' : '$1'. 161 | open_paren -> '(' : '$1'. 162 | close_paren -> ')' : '$1'. 163 | 164 | list_collection -> open_bracket close_bracket : build_literal_list('$1', []). 165 | list_collection -> open_bracket collection_values close_bracket : build_literal_list('$1', '$2'). 166 | list_collection -> open_paren close_paren : build_list('$1', []). 167 | list_collection -> open_paren collection_values close_paren: build_list('$1', '$2'). 168 | 169 | cons_list -> open_bracket collection_values keyword_cons value close_bracket : build_cons_list('$3', '$2', '$4'). 170 | cons_list -> open_paren collection_values keyword_cons value close_paren : build_cons_list('$3', '$2', '$4'). 171 | 172 | open_bang_bracket -> '#[' : '$1'. 173 | 174 | keyword_list -> open_bang_bracket close_bracket : build_keyword_list('$1', []). 175 | keyword_list -> open_bang_bracket paired_collection_values close_bracket : build_keyword_list('$1', '$2'). 176 | keyword_list -> open_bang_bracket unpaired_collection_values close_bracket : throw_unpaired_values('$1', "keyword list"). 177 | 178 | %% Tuple 179 | open_curly -> '{' : '$1'. 180 | close_curly -> '}' : '$1'. 181 | 182 | tuple_collection -> open_curly close_curly : build_tuple('$1', []). 183 | tuple_collection -> open_curly collection_values close_curly: build_tuple('$1', '$2'). 184 | 185 | %% Map 186 | 187 | paired_comma_collection_values -> comma_collection_value comma_collection_value : ['$2', '$1']. 188 | 189 | paired_collection_value_list -> collection_value comma_collection_value : ['$2', '$1']. 190 | paired_collection_value_list -> paired_collection_value_list paired_comma_collection_values : lists:append('$2', '$1'). 191 | 192 | paired_collection_values -> paired_collection_value_list : lists:reverse('$1'). 193 | 194 | unpaired_collection_value_list -> collection_value : ['$1']. 195 | unpaired_collection_value_list -> paired_collection_value_list comma_collection_value : ['$2' | '$1']. 196 | 197 | unpaired_collection_values -> unpaired_collection_value_list : lists:reverse('$1'). 198 | 199 | open_bang_curly -> '#{' : '$1'. 200 | 201 | map_collection -> open_bang_curly close_curly : build_map('$1', []). 202 | map_collection -> open_bang_curly paired_collection_values close_curly : build_map('$1', '$2'). 203 | map_collection -> open_bang_curly unpaired_collection_values close_curly : throw_unpaired_values('$1', "map"). 204 | 205 | %% Set 206 | 207 | open_percent_curly -> '%{' : '$1'. 208 | 209 | set_collection -> open_percent_curly close_curly : build_set('$1', []). 210 | set_collection -> open_percent_curly collection_values close_curly : build_set('$1', '$2'). 211 | 212 | Erlang code. 213 | 214 | -import(kapok_scanner, [token_category/1, 215 | token_meta/1, 216 | token_symbol/1, 217 | token_text/1]). 218 | -export([is_identifier/1, is_plain_dot/1, plain_dot_name/1, plain_dot_mf/1]). 219 | -include("kapok.hrl"). 220 | 221 | %% Build token 222 | 223 | build_number(Token) -> 224 | {number, token_meta(Token), token_symbol(Token)}. 225 | 226 | build_signed_number(Sign) -> 227 | {token_category(Sign), token_meta(Sign), build_number(token_symbol(Sign))}. 228 | 229 | build_keyword_atom(Token) -> 230 | {token_category(Token), token_meta(Token), token_symbol(Token)}. 231 | 232 | build_quoted_keyword_atom(Token, Safe) -> 233 | Op = binary_to_atom_op(Safe), 234 | C = token_category(Token), 235 | [Type, _] = string:tokens(atom_to_list(C), "_"), 236 | {list_to_atom(Type), token_meta(Token), erlang:Op(token_symbol(Token), utf8)}. 237 | 238 | binary_to_atom_op(true) -> binary_to_existing_atom; 239 | binary_to_atom_op(false) -> binary_to_atom. 240 | 241 | build_dot(Dot, Left, Right) -> 242 | {dot, token_meta(Dot), {Left, Right}}. 243 | 244 | build_bitstring_element({number, Meta, _} = Token) -> 245 | {list, Meta, [Token]}; 246 | 247 | build_bitstring_element({Category, Meta, _} = Token) when ?is_string(Category) -> 248 | {list, Meta, [Token]}; 249 | 250 | build_bitstring_element({identifier, Meta, _} = Token) -> 251 | {list, Meta, [Token]}; 252 | 253 | build_bitstring_element({list, _, _} = Token) -> 254 | Token; 255 | 256 | build_bitstring_element(Token) -> 257 | throw_invalid_bitstring_element(Token). 258 | 259 | build_bitstring(Marker, Args) -> 260 | {bitstring, token_meta(Marker), Args}. 261 | 262 | build_quote(Marker, Arg) -> 263 | {quote, token_meta(Marker), Arg}. 264 | 265 | build_backquote(Marker, Arg) -> 266 | {backquote, token_meta(Marker), Arg}. 267 | 268 | build_unquote(Marker, Arg) -> 269 | {unquote, token_meta(Marker), Arg}. 270 | 271 | build_unquote_splicing(Marker, Arg) -> 272 | {unquote_splicing, token_meta(Marker), Arg}. 273 | 274 | build_bind(Keyword, Value, Id) -> 275 | {bind, token_meta(Keyword), {Value, Id}}. 276 | 277 | build_literal_list(Marker, Args) -> 278 | {literal_list, token_meta(Marker), Args}. 279 | 280 | build_list(Marker, Args) -> 281 | {list, token_meta(Marker), Args}. 282 | 283 | build_cons_list(Marker, Head, Tail) -> 284 | {cons_list, token_meta(Marker), {Head, Tail}}. 285 | 286 | build_keyword_list(Marker, Args) -> 287 | {nil, RT} = lists:foldl(fun (K, {nil, Acc}) -> 288 | {K, Acc}; 289 | (V, {K, Acc}) -> 290 | {nil, [build_tuple(K, [K, V]) | Acc]} 291 | end, 292 | {nil, []}, 293 | Args), 294 | Tuples = lists:reverse(RT), 295 | build_literal_list(Marker, Tuples). 296 | 297 | build_tuple(Marker, Args) -> 298 | {tuple, token_meta(Marker), Args}. 299 | 300 | build_map(Marker, Args) -> 301 | {map, token_meta(Marker), Args}. 302 | 303 | build_set(Marker, Args) -> 304 | {set, token_meta(Marker), Args}. 305 | 306 | %% Helper Functions 307 | 308 | is_identifier({C, _, _}) when ?is_id(C) -> 309 | true; 310 | is_identifier(_) -> 311 | false. 312 | 313 | is_plain_dot({C, _, {Left, Right}}) when ?is_dot(C) -> 314 | is_plain_dot(Left) andalso is_plain_dot(Right); 315 | is_plain_dot({C, _, _}) when ?is_local_id(C) -> 316 | true; 317 | is_plain_dot(_) -> 318 | false. 319 | 320 | plain_dot_name({C, _, {Left, Right}}) when ?is_dot(C) -> 321 | NameLeft = plain_dot_name(Left), 322 | NameRight = plain_dot_name(Right), 323 | list_to_atom(string:join([atom_to_list(NameLeft), atom_to_list(NameRight)], ".")); 324 | plain_dot_name({C, _, Arg}) when ?is_local_id(C) -> 325 | Arg. 326 | 327 | plain_dot_mf({C, _, {Left, Right}}) when ?is_dot(C) -> 328 | NameLeft = plain_dot_name(Left), 329 | NameRight = plain_dot_name(Right), 330 | {NameLeft, NameRight}. 331 | 332 | %% Errors 333 | throw(Line, ErrorDesc) -> 334 | throw({error, {Line, ?MODULE, ErrorDesc}}). 335 | 336 | throw_unpaired_values(Marker, Type) -> 337 | Message = io_lib:format("unpaired values for ~s", [Type]), 338 | throw(?line(token_meta(Marker)), Message). 339 | 340 | throw_invalid_bitstring_element(Token) -> 341 | Message = io_lib:format("invalid bitstring element: ~s", [token_text(Token)]), 342 | throw(?line(token_meta(Token)), Message). 343 | -------------------------------------------------------------------------------- /lib/kapok/src/kapok_rewrite.erl: -------------------------------------------------------------------------------- 1 | %% Rewrite local/remote call when translating AST to Erlang Abstract Format 2 | -module(kapok_rewrite). 3 | -export([rewrite/7, inline/4]). 4 | 5 | %% Convenience variables 6 | 7 | -define(inline_nfun(M, F, A), inline(M, F, A, 'normal')). 8 | -define(nfun(M, F, A), {M, F, A, 'normal'}). 9 | 10 | %% Inline 11 | 12 | %% Inlines functions means to transform function calls to their erlang module equivalent. 13 | %% Rules for inlining are straight-forward, the same arugment arity and order are kept. 14 | %% There are two main reasons to inline these functions: 15 | %% 1. Efficiency. To avoid another function call. 16 | %% 2. Syntax Limit. Only a limited predicates and built-in functions are allowed in guards. 17 | 18 | ?inline_nfun('kapok.atom', 'to-char-list', 1) -> ?nfun(erlang, atom_to_list, 1); 19 | 20 | %% guard predicates 21 | ?inline_nfun('kapok.core', 'atom?', 1) -> ?nfun(erlang, is_atom, 1); 22 | ?inline_nfun('kapok.core', 'binary?', 1) -> ?nfun(erlang, is_binary, 1); 23 | ?inline_nfun('kapok.core', 'bitstring?', 1) -> ?nfun(erlang, is_bitstring, 1); 24 | ?inline_nfun('kapok.core', 'boolean?', 1) -> ?nfun(erlang, is_boolean, 1); 25 | ?inline_nfun('kapok.core', 'float?', 1) -> ?nfun(erlang, is_float, 1); 26 | ?inline_nfun('kapok.core', 'function?', 1) -> ?nfun(erlang, is_function, 1); 27 | ?inline_nfun('kapok.core', 'function?', 2) -> ?nfun(erlang, is_function, 2); 28 | ?inline_nfun('kapok.core', 'integer?', 1) -> ?nfun(erlang, is_integer, 1); 29 | ?inline_nfun('kapok.core', 'list?', 1) -> ?nfun(erlang, is_list, 1); 30 | ?inline_nfun('kapok.core', 'map?', 1) -> ?nfun(erlang, is_map, 1); 31 | ?inline_nfun('kapok.core', 'number?', 1) -> ?nfun(erlang, is_number, 1); 32 | ?inline_nfun('kapok.core', 'pid?', 1) -> ?nfun(erlang, is_pid, 1); 33 | ?inline_nfun('kapok.core', 'pmod?', 1) -> ?nfun(erlang, is_pmod, 1); 34 | ?inline_nfun('kapok.core', 'port?', 1) -> ?nfun(erlang, is_port, 1); 35 | ?inline_nfun('kapok.core', 'reference?', 1) -> ?nfun(erlang, is_reference, 1); 36 | ?inline_nfun('kapok.core', 'tuple?', 1) -> ?nfun(erlang, is_tuple, 1); 37 | 38 | %% guard built-in functions 39 | ?inline_nfun('kapok.core', 'abs', 1) -> ?nfun(erlang, abs, 1); 40 | ?inline_nfun('kapok.core', 'bit-size', 1) -> ?nfun(erlang, bit_size, 1); 41 | ?inline_nfun('kapok.core', 'byte-size', 1) -> ?nfun(erlang, byte_size, 1); 42 | ?inline_nfun('kapok.core', 'number-to-float', 1) -> ?nfun(erlang, float, 1); 43 | ?inline_nfun('kapok.core', 'hd', 1) -> ?nfun(erlang, hd, 1); 44 | ?inline_nfun('kapok.core', 'head', 1) -> ?nfun(erlang, hd, 1); 45 | ?inline_nfun('kapok.core', 'length', 1) -> ?nfun(erlang, length, 1); 46 | ?inline_nfun('kapok.core', 'node', 0) -> ?nfun(erlang, node, 0); 47 | ?inline_nfun('kapok.core', 'node', 1) -> ?nfun(erlang, node, 1); 48 | ?inline_nfun('kapok.core', 'round', 1) -> ?nfun(erlang, round, 1); 49 | ?inline_nfun('kapok.core', 'self', 0) -> ?nfun(erlang, self, 0); 50 | ?inline_nfun('kapok.core', 'tail', 1) -> ?nfun(erlang, tl, 1); 51 | ?inline_nfun('kapok.core', 'tl', 1) -> ?nfun(erlang, tl, 1); 52 | ?inline_nfun('kapok.core', 'trunc', 1) -> ?nfun(erlang, trunc, 1); 53 | ?inline_nfun('kapok.core', 'tuple-size', 1) -> ?nfun(erlang, tuple_size, 1); 54 | 55 | %% term comparators 56 | ?inline_nfun('kapok.core', '<', 2) -> ?nfun(erlang, '<', 2); 57 | ?inline_nfun('kapok.core', '>', 2) -> ?nfun(erlang, '>', 2); 58 | ?inline_nfun('kapok.core', '<=', 2) -> ?nfun(erlang, '=<', 2); 59 | ?inline_nfun('kapok.core', '>=', 2) -> ?nfun(erlang, '>=', 2); 60 | ?inline_nfun('kapok.core', '==', 2) -> ?nfun(erlang, '==', 2); 61 | ?inline_nfun('kapok.core', '!=', 2) -> ?nfun(erlang, '/=', 2); 62 | ?inline_nfun('kapok.core', '===', 2) -> ?nfun(erlang, '=:=', 2); 63 | ?inline_nfun('kapok.core', '!==', 2) -> ?nfun(erlang, '=/=', 2); 64 | 65 | %% arithmetic operators 66 | %% unary +/- is handled by the parser, we just handle binary +/- here. 67 | ?inline_nfun('kapok.core', '+', 2) -> ?nfun(erlang, '+', 2); 68 | ?inline_nfun('kapok.core', '-', 2) -> ?nfun(erlang, '-', 2); 69 | ?inline_nfun('kapok.core', '*', 2) -> ?nfun(erlang, '*', 2); 70 | ?inline_nfun('kapok.core', '/', 2) -> ?nfun(erlang, '/', 2); 71 | ?inline_nfun('kapok.core', 'div', 2) -> ?nfun(erlang, 'div', 2); 72 | ?inline_nfun('kapok.core', 'rem', 2) -> ?nfun(erlang, 'rem', 2); 73 | ?inline_nfun('kapok.core', 'bit-not', 1) -> ?nfun(erlang, 'bnot', 1); 74 | ?inline_nfun('kapok.core', 'bnot', 1) -> ?nfun(erlang, 'bnot', 1); 75 | ?inline_nfun('kapok.core', 'bit-and', 2) -> ?nfun(erlang, 'band', 2); 76 | ?inline_nfun('kapok.core', 'band', 2) -> ?nfun(erlang, 'band', 2); 77 | ?inline_nfun('kapok.core', 'bit-or', 2) -> ?nfun(erlang, 'bor', 2); 78 | ?inline_nfun('kapok.core', 'bor', 2) -> ?nfun(erlang, 'bor', 2); 79 | ?inline_nfun('kapok.core', 'bit-xor', 2) -> ?nfun(erlang, 'bxor', 2); 80 | ?inline_nfun('kapok.core', 'bxor', 2) -> ?nfun(erlang, 'bxor', 2); 81 | ?inline_nfun('kapok.core', 'bit-shift-left', 2) -> ?nfun(erlang, 'bsl', 2); 82 | ?inline_nfun('kapok.core', 'bsl', 2) -> ?nfun(erlang, 'bsl', 2); 83 | ?inline_nfun('kapok.core', 'bit-shift-right', 2) -> ?nfun(erlang, 'bsr', 2); 84 | ?inline_nfun('kapok.core', 'bsr', 2) -> ?nfun(erlang, 'bsr', 2); 85 | 86 | %% integer 87 | ?inline_nfun('kapok.integer', 'to-string', 1) -> ?nfun(erlang, integer_to_binary, 1); 88 | ?inline_nfun('kapok.integer', 'to-string', 2) -> ?nfun(erlang, integer_to_binary, 2); 89 | ?inline_nfun('kapok.integer', 'to-char-list', 1) -> ?nfun(erlang, integer_to_list, 1); 90 | ?inline_nfun('kapok.integer', 'to-char-list', 2) -> ?nfun(erlang, integer_to_list, 2); 91 | 92 | %% list 93 | ?inline_nfun('kapok.list', 'to-atom', 1) -> ?nfun(erlang, list_to_atom, 1); 94 | ?inline_nfun('kapok.list', 'to-existing-atom', 1) -> ?nfun(erlang, list_to_existing_atom, 1); 95 | ?inline_nfun('kapok.list', 'to-float', 1) -> ?nfun(erlang, list_to_float, 1); 96 | ?inline_nfun('kapok.list', 'to-integer', 1) -> ?nfun(erlang, list_to_integer, 1); 97 | ?inline_nfun('kapok.list', 'to-integer', 2) -> ?nfun(erlang, list_to_integer, 2); 98 | ?inline_nfun('kapok.list', 'to-tuple', 2) -> ?nfun(erlang, list_to_tuple, 1); 99 | 100 | %% tuple 101 | ?inline_nfun('kapok.tuple', 'append', 2) -> ?nfun(erlang, append_element, 2); 102 | ?inline_nfun('kapok.tuple', 'to-list', 1) -> ?nfun(erlang, tuple_to_list, 1); 103 | 104 | inline(_M, _F, _A, _P) -> 105 | %% TODO add impl 106 | false. 107 | 108 | 109 | %% Rewrite rules 110 | %% Rewrite rules are more complex than regular inlining code. 111 | %% It receives all remote call arguments and return quoted 112 | %% expressions with the new enviroment. 113 | 114 | 115 | rewrite(Meta, Module, Fun, FunMeta, _Arity, _ParaType, Args) -> 116 | case rewrite(Module, Fun, Args) of 117 | {M, F, Args1} -> 118 | Dot = {dot, FunMeta, {{identifier, FunMeta, M}, {identifier, FunMeta, F}}}, 119 | {list, Meta, [Dot | Args1]}; 120 | {F, Args1} -> 121 | Id = {identifier, FunMeta, F}, 122 | {list, Meta, [Id | Args1]}; 123 | false -> 124 | false 125 | end. 126 | 127 | %% Simple rewrite rules 128 | 129 | rewrite('kapok.core', 'elem', [Tuple, Index]) -> 130 | {erlang, element, [increment(Index), Tuple]}; 131 | rewrite('kapok.core', 'set-elem', [Tuple, Index, Value]) -> 132 | {erlang, setelement, [increment(Index), Tuple, Value]}; 133 | rewrite('kapok.tuple', 'duplicate', [Data, Size]) -> 134 | {erlang, make_tuple, [Size, Data]}; 135 | rewrite('kapok.tuple', 'insert-at', [Tuple, Index, Term]) -> 136 | {erlang, insert_element, [increment(Index), Tuple, Term]}; 137 | rewrite('kapok.tuple', 'delete-at', [Tuple, Index]) -> 138 | {erlang, delete_element, [increment(Index), Tuple]}; 139 | rewrite(_Receiver, _Fun, _Args) -> 140 | false. 141 | 142 | %% Helpers 143 | 144 | increment(Expr) -> 145 | Dot = {dot, [], {{dot, [], {{identifier, [], 'kapok'}, 146 | {identifier, [], 'core'}}}, 147 | {identifier, [], '+'}}}, 148 | {list, [], [Dot, {number, [], 1}, Expr]}. 149 | 150 | %% rewrite core.set-elem/3, index + 1 151 | -------------------------------------------------------------------------------- /lib/kapok/src/kapok_sup.erl: -------------------------------------------------------------------------------- 1 | -module(kapok_sup). 2 | -behaviour(supervisor). 3 | 4 | %% API 5 | -export([start_link/0]). 6 | 7 | %% Supervisor callbacks 8 | -export([init/1]). 9 | 10 | %% Helper macro for declaring children of supervisor 11 | -define(CHILD(I, Type), {I, {I, start_link, []}, permanent, 2000, Type, [I]}). 12 | 13 | %% =================================================================== 14 | %% API functions 15 | %% =================================================================== 16 | 17 | start_link() -> 18 | supervisor:start_link({local, ?MODULE}, ?MODULE, []). 19 | 20 | %% =================================================================== 21 | %% Supervisor callbacks 22 | %% =================================================================== 23 | 24 | init([]) -> 25 | Workers = [ 26 | ?CHILD(kapok_env, worker), 27 | ?CHILD(kapok_symbol_table, worker), 28 | ?CHILD(kapok_code, worker) 29 | ], 30 | {ok, {{one_for_one, 5, 10}, Workers}}. 31 | -------------------------------------------------------------------------------- /lib/kapok/src/kapok_trans_bitstring.erl: -------------------------------------------------------------------------------- 1 | %% bitstring 2 | -module(kapok_trans_bitstring). 3 | -export([translate/3]). 4 | -include("kapok.hrl"). 5 | 6 | %% Expand 7 | 8 | %% Translate 9 | 10 | translate(Meta, {Category, Meta1, Arg}, Ctx) when ?is_string(Category) -> 11 | {{bin, 12 | ?line(Meta), 13 | [{bin_element, ?line(Meta1), {string, ?line(Meta1), binary_to_list(Arg)}, default, default}]}, 14 | Ctx}; 15 | 16 | translate(Meta, Args, Ctx) when is_list(Args) -> 17 | build_bitstring(fun kapok_trans:translate/2, Args, Meta, Ctx). 18 | 19 | build_bitstring(Fun, Args, Meta, Ctx) -> 20 | {Result, TCtx} = build_bitstring_element(Fun, Args, Meta, Ctx, []), 21 | {{bin, ?line(Meta), lists:reverse(Result)}, TCtx}. 22 | 23 | build_bitstring_element(_Fun, [], _Meta, Ctx, Acc) -> 24 | {Acc, Ctx}; 25 | 26 | build_bitstring_element(Fun, [Arg | Left], Meta, Ctx, Acc) -> 27 | {V, Size, Types} = extract_element_spec(Arg, Ctx#{context := nil}), 28 | build_bitstring_element(Fun, Left, Meta, Ctx, Acc, V, Size, Types). 29 | 30 | build_bitstring_element(Fun, Args, Meta, Ctx, Acc, {C, _, V}, default, Types) when C == list_string -> 31 | Element = 32 | case types_allow_splice(Types, []) of 33 | true -> 34 | {bin_element, ?line(Meta), {string, 0, binary_to_list(V)}}; 35 | false -> 36 | case types_require_conversion(Types) of 37 | true -> 38 | {bin_element, ?line(Meta), {string, 0, kapok_utils:characters_to_list(V)}, default, Types}; 39 | false -> 40 | kapok_error:compile_error( 41 | Meta, 42 | ?m(Ctx, file), 43 | "invalid types for literal list string in bitstring. Accepted types are: " 44 | "little, big, utf8, utf16, utf32, bits, bytes, binary, bitstring") 45 | end 46 | end, 47 | build_bitstring_element(Fun, Args, Meta, Ctx, [Element|Acc]); 48 | 49 | build_bitstring_element(_Fun, _Args, Meta, Ctx, _Acc, {C, _, _}, _Size, _Types) when C == list_string -> 50 | kapok_error:compile_error(Meta, ?m(Ctx, file), 51 | "size is not supported for literal string in bitstring"); 52 | 53 | build_bitstring_element(Fun, Args, Meta, Ctx, Acc, V, Size, Types) -> 54 | {Expr, TCtx} = Fun(V, Ctx), 55 | case Expr of 56 | {bin, _, Elements} -> 57 | case (Size == default) andalso types_allow_splice(Types, Elements) of 58 | true -> build_bitstring_element(Fun, Args, Meta, TCtx, lists:reverse(Elements, Acc)); 59 | false -> build_bitstring_element(Fun, Args, Meta, TCtx, 60 | [{bin_element, ?line(Meta), Expr, Size, Types}|Acc]) 61 | end; 62 | _ -> 63 | build_bitstring_element(Fun, Args, Meta, TCtx, 64 | [{bin_element, ?line(Meta), Expr, Size, Types}|Acc]) 65 | end. 66 | 67 | %% Extra bitstring element specifiers 68 | extract_element_spec({list, _Meta, [H|T]}, Ctx) -> 69 | {Size, TypeSpecList} = extract_element_size_tsl(T, Ctx), 70 | {H, Size, TypeSpecList}. 71 | 72 | %% Extra bitstring element size and type spec list 73 | extract_element_size_tsl([], _Ctx) -> 74 | {default, default}; 75 | extract_element_size_tsl(L, _Ctx) -> 76 | extract_element_size_tsl(L, _Ctx, {default, []}). 77 | 78 | extract_element_size_tsl([], _Ctx, {Size, TypeSpecList}) -> 79 | L = case TypeSpecList of 80 | [] -> default; 81 | X -> X 82 | end, 83 | {Size, L}; 84 | extract_element_size_tsl([{list, _Meta, [{keyword, _, size}, SizeExpr]}|T], 85 | Ctx, 86 | {_, TypeSpecList}) -> 87 | {Size, _} = kapok_trans:translate(SizeExpr, Ctx), 88 | extract_element_size_tsl(T, Ctx, {Size, TypeSpecList}); 89 | extract_element_size_tsl([{list, _Meta, [{keyword, _, unit}, UnitExpr]}|T], 90 | Ctx, 91 | {Size, TypeSpecList}) -> 92 | {Unit, _} = kapok_trans:translate(UnitExpr, Ctx), 93 | {integer, _, Value} = Unit, 94 | extract_element_size_tsl(T, Ctx, {Size, [{unit, Value}|TypeSpecList]}); 95 | extract_element_size_tsl([{keyword, _, Other}|T], Ctx, {Size, TypeSpecList}) -> 96 | extract_element_size_tsl(T, Ctx, {Size, [Other|TypeSpecList]}). 97 | 98 | %% Check whether the given type rerquire conversion 99 | types_require_conversion([End|T]) when End == little; End == big -> 100 | types_require_conversion(T); 101 | types_require_conversion([UTF|T]) when UTF == utf8; UTF == utf16; UTF == utf32 -> 102 | types_require_conversion(T); 103 | types_require_conversion([]) -> true; 104 | types_require_conversion(_) -> false. 105 | 106 | %% Check whether the given type allows splice. 107 | types_allow_splice([bytes], Elements) -> is_byte_size(Elements, 0); 108 | types_allow_splice([binary], Elements) -> is_byte_size(Elements, 0); 109 | types_allow_splice([bits], _) -> true; 110 | types_allow_splice([bitstring], _) -> true; 111 | types_allow_splice(default, _) -> true; 112 | types_allow_splice(_, _) -> false. 113 | 114 | %% check the total size of all elements in a bitstring. 115 | is_byte_size([Element|T], Acc) -> 116 | case element_size(Element) of 117 | {unknown, Unit} when Unit rem 8 == 0 -> is_byte_size(T, Acc); 118 | {unknown, _Unit} -> false; 119 | {Size, Unit} -> is_byte_size(T, Size * Unit + Acc) 120 | end; 121 | is_byte_size([], Size) -> 122 | Size rem 8 == 0. 123 | 124 | %% get the size of element 125 | element_size({bin_element, _, _, default, Types}) -> {unknown, unit_size(Types)}; 126 | element_size({bin_element, _, _, {integer, _, Size}, Types}) -> {Size, unit_size(Types)}; 127 | element_size({bin_element, _, _, _Size, Types}) -> {unknown, unit_size(Types)}. 128 | 129 | %% get unit size 130 | %% The default value of `Type' is integer, 131 | %% and the default value of `Unit' for integer type is 1. 132 | unit_size(Types) -> unit_size(Types, 1). 133 | unit_size([binary|T], _) -> unit_size(T, 8); 134 | unit_size([{unit, Size}|_], _) -> Size; 135 | unit_size([_|T], Guess) -> unit_size(T, Guess); 136 | unit_size([], Guess) -> Guess. 137 | -------------------------------------------------------------------------------- /lib/kapok/src/kapok_trans_collection.erl: -------------------------------------------------------------------------------- 1 | %% For translating collections. 2 | -module(kapok_trans_collection). 3 | -export([build_tuple/2, 4 | build_map_from/2, 5 | build_list/1, 6 | translate_tuple/3, 7 | translate_map/3, 8 | translate_set/3, 9 | translate_list/2, 10 | translate_cons_list/3 11 | ]). 12 | -import(kapok_scanner, [token_meta/1]). 13 | -include("kapok.hrl"). 14 | 15 | %% tuple 16 | translate_tuple(Meta, Arg, Ctx) -> 17 | {TArg, TCtx} = kapok_trans:translate(Arg, Ctx), 18 | {build_tuple(Meta, TArg), TCtx}. 19 | 20 | build_tuple(Meta, TArg) when is_list(Meta) -> 21 | build_tuple(?line(Meta), TArg); 22 | build_tuple(Line, TArg) when is_integer(Line) -> 23 | {tuple, Line, TArg}. 24 | 25 | %% map 26 | translate_map(Meta, Args, #{context := Context} = Ctx) -> 27 | FieldType = case Context of 28 | C when C == fn_pattern; C == let_pattern; C == case_pattern -> 29 | map_field_exact; 30 | _ -> 31 | map_field_assoc 32 | end, 33 | {TFields, TCtx} = build_map(Meta, FieldType, Args, Ctx), 34 | {{map, ?line(Meta), TFields}, TCtx}. 35 | 36 | build_map(Meta, FieldType, Args, Ctx) -> 37 | build_map(Meta, FieldType, Args, [], Ctx). 38 | 39 | build_map(_Meta, _FieldType, [], Acc, Ctx) -> 40 | {lists:reverse(Acc), Ctx}; 41 | build_map(Meta, _FieldType, [H], _Acc, Ctx) -> 42 | kapok_error:compile_error(Meta, ?m(Ctx, file), "unpaired values in map ~p", [H]); 43 | build_map(Meta, FieldType, [K, V | Left], Acc, Ctx) -> 44 | {TK, TCtx} = kapok_trans:translate(K, Ctx), 45 | {TV, TCtx1} = kapok_trans:translate(V, TCtx), 46 | Field = {FieldType, ?line(kapok_scanner:token_meta(K)), TK, TV}, 47 | build_map(Meta, FieldType, Left, [Field | Acc], TCtx1). 48 | 49 | build_map_from(Meta, TranslatedPairs) -> 50 | TFields = lists:map(fun({{_, Line, _} = K, V}) -> 51 | {map_field_assoc, Line, K, V} 52 | end, 53 | TranslatedPairs), 54 | {map, ?line(Meta), TFields}. 55 | 56 | %% set 57 | translate_set(Meta, Args, #{context := Context} = Ctx) -> 58 | case Context of 59 | C when C == fn_pattern; C == let_pattern; C == case_pattern -> 60 | kapok_error:compile_error(Meta, ?m(Ctx, file), "unsupported set in pattern"); 61 | _ -> ok 62 | end, 63 | {TArgs, TCtx} = translate_list(Args, Ctx), 64 | kapok_trans:translate_remote_call(Meta, 'gb_sets', 'from_list', [TArgs], TCtx). 65 | 66 | %% list 67 | translate_list({Category, Meta, List}, Ctx) when ?is_list(Category) -> 68 | {TList, TCtx} = translate_list(List, Ctx), 69 | {{Category, Meta, TList}, TCtx}; 70 | translate_list(L, Ctx) when is_list(L) -> 71 | translate_list(L, [], Ctx). 72 | translate_list([H|T], Acc, Ctx) -> 73 | {Erl, TCtx} = kapok_trans:translate(H, Ctx), 74 | translate_list(T, [Erl|Acc], TCtx); 75 | translate_list([], Acc, Ctx) -> 76 | {build_list_reversed(Acc), Ctx}. 77 | 78 | build_list(L) -> 79 | build_list_reversed(lists:reverse(L)). 80 | build_list_reversed(R) -> 81 | build_list_reversed(R, {nil, 0}). 82 | build_list_reversed([H|T], Acc) -> 83 | build_list_reversed(T, {cons, 0, H, Acc}); 84 | build_list_reversed([], Acc) -> 85 | Acc. 86 | 87 | %% cons_list 88 | translate_cons_list(Head, Tail, Ctx) -> 89 | translate_cons_list(Head, [], Tail, Ctx). 90 | 91 | translate_cons_list([], Acc, Tail, Ctx) -> 92 | {TTail, TCtx} = kapok_trans:translate(Tail, Ctx), 93 | L = lists:foldl(fun(X, Acc1) -> 94 | Line = erlang:element(2, X), 95 | {cons, Line, X, Acc1} 96 | end, 97 | TTail, 98 | Acc), 99 | {L, TCtx}; 100 | translate_cons_list([H | T], Acc, Tail, Ctx) -> 101 | {TH, TCtx} = kapok_trans:translate(H, Ctx), 102 | translate_cons_list(T, [TH | Acc], Tail, TCtx). 103 | -------------------------------------------------------------------------------- /lib/kapok/src/kapok_utils.erl: -------------------------------------------------------------------------------- 1 | %% Helper functions used throughout kapok source code. 2 | 3 | -module(kapok_utils). 4 | -export([meta_line/1, 5 | meta_column/1, 6 | meta_order/1, 7 | characters_to_list/1, 8 | characters_to_binary/1, 9 | to_binary/1, 10 | read_file_type/1, 11 | read_link_type/1, 12 | relative_to_cwd/1, 13 | gensym_plain/1, 14 | gensym/0, 15 | gensym/1 16 | ]). 17 | -include_lib("kernel/include/file.hrl"). 18 | 19 | meta_line(TupleList) when is_list(TupleList) -> 20 | find_key(line, TupleList). 21 | 22 | meta_column(TupleList) when is_list(TupleList) -> 23 | find_key(column, TupleList). 24 | 25 | meta_order(TupleList) when is_list(TupleList) -> 26 | find_key(order, TupleList). 27 | 28 | find_key(Key, TupleList) when is_list(TupleList) -> 29 | case lists:keyfind(Key, 1, TupleList) of 30 | {Key, Value} when is_integer(Value) -> Value; 31 | false -> 0 32 | end. 33 | 34 | characters_to_list(List) when is_list(List) -> 35 | List; 36 | characters_to_list(Data) -> 37 | unicode:characters_to_list(Data). 38 | 39 | characters_to_binary(Bin) when is_binary(Bin) -> 40 | Bin; 41 | characters_to_binary(List) when is_list(List) -> 42 | case unicode:characters_to_binary(List) of 43 | Result when is_binary(Result) -> 44 | Result; 45 | {error, Encoded, Rest} -> 46 | throw({invalid, Encoded, Rest}); 47 | {incomplete, Encoded, Rest} -> 48 | throw({incomplete, Encoded, Rest}) 49 | end. 50 | 51 | to_binary(List) when is_list(List) -> unicode:characters_to_binary(List); 52 | to_binary(Atom) when is_atom(Atom) -> atom_to_binary(Atom, utf8). 53 | 54 | read_file_type(File) -> 55 | case file:read_file_info(File) of 56 | {ok, #file_info{type = Type}} -> {ok, Type}; 57 | {error, _} = Error -> Error 58 | end. 59 | 60 | read_link_type(File) -> 61 | case file:read_link_info(File) of 62 | {ok, #file_info{type = Type}} -> {ok, Type}; 63 | {error, _} = Error -> Error 64 | end. 65 | 66 | relative_to_cwd(Path) -> 67 | %% TODO add external path library call 68 | Path. 69 | 70 | gensym_plain(Prefix) -> 71 | gensym("~s~s", [Prefix, gensym_random()]). 72 | 73 | gensym() -> 74 | gensym("#:G~s", [gensym_random()]). 75 | 76 | gensym(Prefix) -> 77 | gensym("#:|~s~s|", [Prefix, gensym_random()]). 78 | 79 | gensym(Format, Args) -> 80 | erlang:list_to_atom(lists:flatten(io_lib:format(Format, Args))). 81 | 82 | gensym_random() -> 83 | X = erlang:phash2({erlang:node(), erlang:timestamp(), crypto:strong_rand_bytes(16)}), 84 | lists:map(fun(E) -> io_lib:format("~.16B", [E]) end, 85 | erlang:binary_to_list(binary:encode_unsigned(X))). 86 | -------------------------------------------------------------------------------- /lib/kapok/src/kapok_version.erl: -------------------------------------------------------------------------------- 1 | -module(kapok_version). 2 | %% simple module just to hold the version info. 3 | -export([version/0]). 4 | 5 | version() -> 6 | "0.0.1". 7 | -------------------------------------------------------------------------------- /lib/kapok/test/compiler/compiler-test.kpk: -------------------------------------------------------------------------------- 1 | (ns compiler-test 2 | (require erl_scan 3 | erl_parse 4 | io 5 | kapok_compiler) 6 | (use kapok.unittest)) 7 | 8 | 9 | (defn erl-to-abstract-format [string] 10 | (case (erl_scan.#string string) 11 | ({#ok tokens _end-location} 12 | (let [{#ok expr_list} (erl_parse.parse_exprs tokens)] 13 | expr_list)) 14 | ({#error error_info error_location} 15 | (erlang.throw {"scan error, location: ~w, error: ~s~n" 16 | [error_location error_info]})))) 17 | 18 | (defn eval-erlang-expr [string] 19 | (let [eaf (erl-to-abstract-format string) 20 | [expr] eaf 21 | {#value, value, _new-bindings} (erl_eval.#expr expr [])] 22 | value)) 23 | 24 | (defn eval-kapok-expr [string] 25 | (let [{values, _ctx} (kapok_compiler.eval string []) 26 | [value & _] values] 27 | value)) 28 | 29 | (defn main [] 30 | 31 | (test "compile local call" 32 | (assert (=== (eval-erlang-expr #"self().") 33 | (eval-kapok-expr #"(self)")))) 34 | 35 | (test "compile remote call" 36 | (assert (=== (eval-erlang-expr #"erlang:self().") 37 | (eval-kapok-expr #"(erlang.self)")))) 38 | 39 | (test "compile list" 40 | (let [l1 (eval-erlang-expr #"[1 | [2]].") 41 | l2 (eval-erlang-expr #"[1, 2].") 42 | l3 (eval-kapok-expr #"[1 2]")] 43 | (assert (=== l1 l2)) 44 | (assert (=== l2 l3)))) 45 | 46 | (test "compile binary" 47 | (let [b1 (eval-erlang-expr #"<<256:8/big-unsigned-integer-unit:1>>.") 48 | b2 (eval-kapok-expr #"<<(256 (:size 8) :big :unsigned :integer (:unit 1))>>")] 49 | (assert (=== b1 b2)))) 50 | ) 51 | -------------------------------------------------------------------------------- /lib/kapok/test/compiler/scanner-test.kpk: -------------------------------------------------------------------------------- 1 | (ns scanner-test 2 | (require kapok_scanner 3 | lists 4 | erlang 5 | (kapok (io))) 6 | (use kapok.unittest)) 7 | 8 | (defn scan [string] 9 | (let [{#ok, tokens, _locations} (kapok_scanner.scan string 1 [])] 10 | tokens)) 11 | 12 | (defn scan-1 [string] 13 | (let [tokens (scan string)] 14 | (case tokens 15 | ([token] token) 16 | (_ 17 | (io.format "tokens: ~p~n" tokens) 18 | (erlang.throw "expect only one token"))))) 19 | 20 | (defn scan-error [string] 21 | (let [{#error error_info _ _} (kapok_scanner.scan string 1 []) 22 | {_ _module error_desc} error_info] 23 | error_desc)) 24 | 25 | (defn main [] 26 | (test "scan unquote keyword" 27 | (let [chars [;; upper cases 28 | "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" 29 | "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" 30 | ;; lower cases 31 | "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" 32 | "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z" 33 | ;; digits 34 | "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" 35 | ;; punctuation chars and special chars 36 | "!" "$" "%" "*" "+" "-" "/" "<" "=" ">" "?" "@" "_" "|" 37 | ;; special chars for other data types, keywords, etc. 38 | "~" "&" "#" "^" 39 | ]] 40 | (lists.map (fn [e] 41 | (let [c (erlang.binary_to_list e) 42 | l (lists.append #":" c) 43 | a (erlang.list_to_atom c)] 44 | (assert (=== {#keyword [{#line 1} {#column 1}] a} 45 | (scan-1 l))))) 46 | chars))) 47 | 48 | (test "scan quote keyword" 49 | (assert (=== {#keyword_unsafe [{#line 1} {#column 1}] <<"foo bar">>} 50 | (scan-1 #":'foo bar'")))) 51 | 52 | (test "scan keyword" 53 | (assert (=== {#keyword [{#line 1} {#column 1}] #f0_1} (scan-1 #":f0_1")))) 54 | 55 | (test "scan char" 56 | (let [cases [;; simple escape char 57 | {97 "$a"} 58 | {99 "$c"} 59 | ;; special escape chars 60 | {7 "$\\a"} 61 | {8 "$\\b"} 62 | {127 "$\\d"} 63 | {27 "$\\e"} 64 | {12 "$\\f"} 65 | {10 "$\\n"} 66 | {13 "$\\r"} 67 | {32 "$\\s"} 68 | {9 "$\\t"} 69 | {11 "$\\v"} 70 | ;; escape escape 71 | {92 "$\\\\"} 72 | ;; hex char notation 73 | {0 "$\\x0"} 74 | {7 "$\\x7"} 75 | {10 "$\\xa"} 76 | {12 "$\\xc"} 77 | ;; utf-8 char notation 78 | {10 "$\\x{a}"} 79 | {171 "$\\x{ab}"} 80 | {2748 "$\\x{abc}"} 81 | {43981 "$\\x{abcd}"} 82 | {703710 "$\\x{abcde}"} 83 | {1092557 "$\\x{10abcd}"}]] 84 | (lists.map (fn [{n b}] 85 | (let [l (erlang.binary_to_list b)] 86 | (assert (=== {#char_number [{#line 1} {#column 1}] n} 87 | (scan-1 l))))) 88 | cases))) 89 | 90 | (test "scan integer" 91 | (let [cases [;; naive notation 92 | {123 "123"} 93 | ]] 94 | (lists.map (fn [{n b}] 95 | (let [l (erlang.binary_to_list b)] 96 | (assert (=== {#integer [{#line 1} {#column 1}] n} 97 | (scan-1 l))))) 98 | cases)) 99 | (let [cases [{[{#integer [{#line 1} {#column 1}] 123} {#',' [{#line 1} {#column 4}]}] 100 | "123,"} 101 | {[{#integer [{#line 1} {#column 3}] 123} {#integer [{#line 1} {#column 8}] 456}] 102 | " 123 456 "} 103 | {[{#integer [{#line 2} {#column 1}] 123}] "\n123\n"} 104 | ;; signed 105 | {[{#'+' [{#line 1} {#column 1}] {#integer [{#line 1} {#column 2}] 234}}] "+234"} 106 | ;; hex, octal and n base notation 107 | {[{#hex_number [{#line 1} {#column 1}] 255}] 108 | "0xFF"} 109 | {[{#octal_number [{#line 1} {#column 1} ] 63}] 110 | "077"} 111 | {[{#n_base_number [{#line 1} {#column 1}] 3}] 112 | "2r11"} 113 | {[{#+ [{#line 1} {#column 1}] {#n_base_number [{#line 1} {#column 2}] 3}}] 114 | "+2r11"} 115 | {[{#- [{#line 1} {#column 1}] {#n_base_number [{#line 1} {#column 2}] 3}}] 116 | "-2r11"} 117 | {[{#n_base_number [{#line 1} {#column 1}] 20}] 118 | "10r20"} 119 | {[{#+ [{#line 1} {#column 1}] {#n_base_number [{#line 1} {#column 2}] 20}}] 120 | "+10r20"} 121 | {[{#- [{#line 1} {#column 1}] {#n_base_number [{#line 1} {#column 2}] 20}}] 122 | "-10r20"} 123 | {[{#n_base_number [{#line 1} {#column 1}] 72}] 124 | "36r20"} 125 | {[{#+ [{#line 1} {#column 1}] {#n_base_number [{#line 1} {#column 2}] 72}}] 126 | "+36r20"} 127 | {[{#- [{#line 1} {#column 1}] {#n_base_number [{#line 1} {#column 2}] 72}}] 128 | "-36r20"} 129 | ]] 130 | (lists.map (fn [{expected b}] 131 | (let [l (erlang.binary_to_list b)] 132 | (assert (=== expected 133 | (scan l))))) 134 | cases)) 135 | ) 136 | 137 | (test "scan float" 138 | (let [cases [;; simple float 139 | {12.3 "12.3"} 140 | ]] 141 | (lists.map (fn [{n b}] 142 | (let [l (erlang.binary_to_list b)] 143 | (assert (=== {#float [{#line 1} {#column 1}] n} (scan-1 l))))) 144 | cases)) 145 | (let [cases [;; 146 | {[{#float [{#line 1} {#column 1}] 12.3} {#',' [{#line 1} {#column 5}]}] 147 | "12.3,"} 148 | {[{#float [{#line 2} {#column 1}] 12.3}] 149 | "\n12.3\n"} 150 | {[{#float [{#line 1} {#column 3}] 12.3} {#float [{#line 1} {#column 9}] 45.6}] 151 | " 12.3 45.6 "} 152 | ;; scientific 153 | {[{#float [{#line 1} {#column 1}] 0.1}] "1.0e-1"} 154 | ;; signed 155 | {[{#'-' [{#line 1} {#column 1}] {#float [{#line 1} {#column 2}] 23.4}}] "-23.4"} 156 | ]] 157 | (lists.map (fn [{expected b}] 158 | (let [l (erlang.binary_to_list b)] 159 | (assert (=== expected 160 | (scan l))))) 161 | cases))) 162 | 163 | (test "scan comment" 164 | (let [cases [;; 165 | {[{#integer [{#line 1} {#column 1}] 1} {#integer [{#line 2} {#column 1}] 2}] 166 | "1 ;; comment\n2"} 167 | {[{#integer [{#line 1} {#column 1}] 1} {#integer [{#line 3} {#column 1}] 2}] 168 | "1\n;; comment ...\n2"} 169 | ]] 170 | (lists.map (fn [{expected b}] 171 | (let [l (erlang.binary_to_list b)] 172 | (assert (=== expected 173 | (scan l))))) 174 | cases))) 175 | 176 | (test "scan identifier" 177 | (let [cases [{#'abc' "abc "} 178 | {#'Tp!#$*+=<=>?@^_|' "Tp!#$*+=<=>?@^_|"} 179 | ]] 180 | (lists.map (fn [{a b}] 181 | (let [l (erlang.binary_to_list b)] 182 | (assert (=== {#identifier [{#line 1} {#column 1}] a} 183 | (scan-1 l))))) 184 | cases))) 185 | 186 | (test "scan dot identifier" 187 | (let [cases [{[{#identifier [{#line 1} {#column 1}] #'foo'} 188 | {#'.' [{#line 1} {#column 4}]} 189 | {#identifier [{#line 1} {#column 5}] #'bar'} 190 | {#'.' [{#line 1} {#column 8}]} 191 | {#identifier [{#line 1} {#column 9}] #'baz'}] 192 | "foo.bar.baz"}]] 193 | (lists.map (fn [{expected b}] 194 | (let [l (erlang.binary_to_list b)] 195 | (assert (=== expected 196 | (scan l))))) 197 | cases))) 198 | 199 | (test "scan space" 200 | (assert (=== [{#identifier [{#line 1} {#column 1}] #'foo'} 201 | {#integer [{#line 1} {#column 6}] 2}] 202 | (scan #"foo 2"))) 203 | (let [space 16rA0 204 | str (lists.append #"foo" (lists.append [space] #"2")) 205 | error_desc (scan-error str)] 206 | (assert (=== {#invalid_space space #"2"} error_desc))) 207 | ) 208 | 209 | (test "scan newline" 210 | (let [cases [{[{#identifier [{#line 1} {#column 1}] #'foo'} 211 | {#'.' [{#line 2} {#column 1}]} 212 | {#identifier [{#line 2} {#column 2}] #'bar'}] 213 | "foo\n.bar"} 214 | {[{#integer [{#line 1} {#column 1}] 1} 215 | {#unquote_splicing [{#line 2} {#column 1}]} 216 | {#integer [{#line 2} {#column 3}] 2}] 217 | "1\n~@2"} 218 | ]] 219 | (lists.map (fn [{expected b}] 220 | (let [l (erlang.binary_to_list b)] 221 | (assert (=== expected 222 | (scan l))))) 223 | cases) 224 | )) 225 | 226 | (test "scan string" 227 | (let [cases [{#binary_string 1 "foo" #"\"foo\""} 228 | {#binary_string 1 "f\"" #"\"f\\\"\""} 229 | {#list_string 2 "foo" #"#\"foo\""} 230 | {#binary_string 1 "" #"\"\""} 231 | {#list_string 2 "" #"#\"\""} 232 | ]] 233 | (lists.map (fn [{type column value l}] 234 | (assert (=== {type [{#line 1} {#column column}] value} 235 | (scan-1 l)))) 236 | cases))) 237 | 238 | (test "scan collections" 239 | (let [cases [ 240 | ;; bitstring 241 | {[{#'<<' [{#line 1} {#column 2}]} 242 | {#integer [{#line 1} {#column 5}] 1} 243 | {#'>>' [{#line 1} {#column 7}]}] 244 | " << 1 >> "} 245 | ;; list 246 | {[{#'(' [{#line 1} {#column 2}]} 247 | {#integer [{#line 1} {#column 4}] 1} 248 | {#')' [{#line 1} {#column 6}]}] 249 | " ( 1 ) "} 250 | {[{#'[' [{#line 1} {#column 2}]} 251 | {#integer [{#line 1} {#column 4}] 1} 252 | {#']' [{#line 1} {#column 6}]}] 253 | " [ 1 ] "} 254 | ;; tuple 255 | {[{#'{' [{#line 1} {#column 2}]}, 256 | {#integer [{#line 1} {#column 4}] 1} 257 | {#'}' [{#line 1} {#column 6}]}] 258 | " { 1 } "} 259 | ;; map 260 | {[{#'#{' [{#line 1} {#column 2}]} 261 | {#integer [{#line 1} {#column 5}] 1} 262 | {#'}' [{#line 1} {#column 7}]}] 263 | " #{ 1 } "} 264 | ;; set 265 | {[{#'%{' [{#line 1} {#column 2}]} 266 | {#integer [{#line 1} {#column 5}] 1} 267 | {#'}' [{#line 1} {#column 7}]}] 268 | " %{ 1 } "}]] 269 | (lists.map (fn [{expected b}] 270 | (let [l (erlang.binary_to_list b)] 271 | (assert (=== expected 272 | (scan l))))) 273 | cases))) 274 | ) 275 | -------------------------------------------------------------------------------- /lib/kapok/test/syntax/attribute-test.kpk: -------------------------------------------------------------------------------- 1 | (ns attribute-test.attr 2 | (use kapok.unittest)) 3 | 4 | ;; TODO test pre-defined attributes 5 | ;; behavior 6 | ;; file 7 | 8 | ;; user-defined attributes 9 | (attribute vsn 1050) 10 | (attribute date 20170927) 11 | 12 | ;; call 'attribute-test.attr':module_info(attributes) in erlang will returns: 13 | ;; [{vsn,[1050]}, 14 | ;; {date,[20170927]}] 15 | 16 | ;; define a function with the same name as the top level 17 | ;; `attribute' name 18 | (defn attribute [a b] 19 | (+ a b)) 20 | 21 | (defn attribute [a] 22 | (attribute a 1)) 23 | 24 | (ns attribute-test.usage 25 | (require io lists) 26 | (use (attribute-test.attr :as attr)) 27 | (use kapok.unittest)) 28 | 29 | (defn main [] 30 | (test "test attribute" 31 | (assert (=== 2 32 | (attribute 1))) 33 | (let [attributes (attr.module_info #attributes) 34 | {_, vsn} (lists.keyfind #vsn, 1, attributes) 35 | {_, date} (lists.keyfind #date, 1, attributes)] 36 | (assert (=== [1050] vsn)) 37 | (assert (=== [20170927] date)))) 38 | ) 39 | -------------------------------------------------------------------------------- /lib/kapok/test/syntax/bind-test.kpk: -------------------------------------------------------------------------------- 1 | (ns bind-test 2 | (use kapok.unittest)) 3 | 4 | 5 | (defn f [a &as aa b &as bb] 6 | {[a b] [aa bb]} 7 | ) 8 | 9 | (defn g [{a &as aa _} &as b] 10 | {a aa b}) 11 | 12 | (defn main [] 13 | (test "test bind to function args" 14 | (assert (=== {[1 2] [1 2]} 15 | (f 1 2))) 16 | (assert (=== {1 1 {1 2}} 17 | (g {1 2})))) 18 | 19 | (test "test bind to let pattern" 20 | (assert (=== {[1 2] [1 2]} 21 | (let [[a &as aa b &as bb] [1 2]] 22 | {[a b] [aa bb]}))) 23 | (assert (=== {1 1 {1 2}} 24 | (let [{a &as aa _} &as b {1 2}] 25 | {a aa b})))) 26 | ) 27 | -------------------------------------------------------------------------------- /lib/kapok/test/syntax/case-test.kpk: -------------------------------------------------------------------------------- 1 | (ns case-test 2 | (use kapok.unittest)) 3 | 4 | (defn f [i] 5 | (case i 6 | (0 :false) 7 | (1 :true) 8 | (2 #match) 9 | (3 #error) 10 | (_ i))) 11 | 12 | (defn main [] 13 | (test "test case" 14 | (assert (=== :true 15 | (let [x (f 4)] 16 | (case x 17 | (_ (&when (atom? x)) 18 | #match) 19 | (_ (&when (integer? x)) 20 | (let [_ (inc 1)] 21 | #ignore) 22 | :true) 23 | (_ 24 | :false)))))) 25 | ) 26 | -------------------------------------------------------------------------------- /lib/kapok/test/syntax/data-type-test.kpk: -------------------------------------------------------------------------------- 1 | (ns data-type 2 | (require erlang maps gb_sets) 3 | (use kapok.unittest)) 4 | 5 | (defn to-int [bin] 6 | (erlang.list_to_integer (erlang.binary_to_list bin))) 7 | 8 | (defn to-float [bin] 9 | (erlang.list_to_float (erlang.binary_to_list bin))) 10 | 11 | (defn main [] 12 | (test "test all data-type" 13 | ;; integer 14 | ;; tranditional notation 15 | (assert (=== 123 (to-int "123"))) 16 | (assert (=== +123 (to-int "123"))) 17 | (assert (=== -123 (to-int "-123"))) 18 | ;; octal notation 19 | (assert (=== 040 (to-int "32"))) 20 | (assert (=== +040 (to-int "+32"))) 21 | (assert (=== -040 (to-int "-32"))) 22 | ;; hex notation 23 | (assert (=== 0xff (to-int "255"))) 24 | (assert (=== +0xff (to-int "+255"))) 25 | (assert (=== -0xff (to-int "-255"))) 26 | ;; n base notation 27 | (assert (=== 2r111 (to-int "7"))) 28 | (assert (=== +2r111 (to-int "+7"))) 29 | (assert (=== -2r111 (to-int "-7"))) 30 | (assert (=== 10r20 (to-int "20"))) 31 | (assert (=== +10r20 (to-int "+20"))) 32 | (assert (=== -10r20 (to-int "-20"))) 33 | (assert (=== 36r20 (to-int "72"))) 34 | (assert (=== +36r20 (to-int "+72"))) 35 | (assert (=== -36r20 (to-int "-72"))) 36 | 37 | ;; float 38 | (assert (=== 3.1415 (to-float "3.1415"))) 39 | (assert (=== +3.1415 (to-float "+3.1415"))) 40 | (assert (=== -3.1415 (to-float "-3.1415"))) 41 | (assert (=== 314.15E-2 (to-float "3.1415"))) 42 | (assert (=== +314.15E-2 (to-float "+3.1415"))) 43 | (assert (=== -314.15E-2 (to-float "-3.1415"))) 44 | 45 | ;; char 46 | (assert (=== $a (to-int "97"))) 47 | (assert (=== $c (to-int "99"))) 48 | ;; special escape chars 49 | (assert (=== $\a (to-int "7"))) 50 | (assert (=== $\b (to-int "8"))) 51 | (assert (=== $\d (to-int "127"))) 52 | (assert (=== $\e (to-int "27"))) 53 | (assert (=== $\f (to-int "12"))) 54 | (assert (=== $\n (to-int "10"))) 55 | (assert (=== $\r (to-int "13"))) 56 | (assert (=== $\s (to-int "32"))) 57 | (assert (=== $\t (to-int "9"))) 58 | (assert (=== $\v (to-int "11"))) 59 | ;; escape escape 60 | (assert (=== $\\ (to-int "92"))) 61 | ;; hex notation 62 | (assert (=== $\xa (to-int "10"))) 63 | (assert (=== $\x61 $a)) 64 | ;; utf-8 code point 65 | (assert (=== $\x{a} $\xa)) 66 | (assert (=== $\x{ab} $\xab)) 67 | (assert (=== $\x{abc} (to-int "2748"))) 68 | (assert (=== $\x{abcd} (to-int "43981"))) 69 | (assert (=== $\x{abcde} (to-int "703710"))) 70 | (assert (=== $\x{10abcd} (to-int "1092557"))) 71 | 72 | ;; string 73 | ;; list string 74 | (assert (=== #"hello, world!" (erlang.atom_to_list #'hello, world!'))) 75 | (assert (=== #"hello, 76 | world!" 77 | (erlang.atom_to_list #'hello,\nworld!'))) 78 | (assert (=== #"hello, \"world\"!" 79 | (erlang.atom_to_list #'hello, "world"!'))) 80 | ;; binary string 81 | (assert (=== "hello, world!" (erlang.list_to_binary #"hello, world!"))) 82 | (assert (=== "hello, 83 | world!" 84 | (erlang.list_to_binary #"hello, 85 | world!"))) 86 | (assert (=== "hello, \"world\"!" 87 | (erlang.list_to_binary #"hello, \"world\"!"))) 88 | (assert (=== """hello, "world"!""" 89 | "hello, \"world\"!")) 90 | (assert (=== '''hello, "world"!''' 91 | "hello, \"world\"!")) 92 | 93 | ;; atom 94 | (assert (=== #atom (erlang.list_to_atom #"atom"))) 95 | (assert (=== #'atom has space' (erlang.list_to_atom #"atom has space"))) 96 | 97 | ;; keyword 98 | (assert (=== :true (erlang.list_to_atom #"true"))) 99 | (assert (=== #'atom has space' (erlang.list_to_atom #"atom has space"))) 100 | 101 | ;; boolean 102 | (assert (=== :true (true? :true))) 103 | (assert (=== :false (false? :true))) 104 | (assert (=== :true (true? :true))) 105 | (assert (=== :false (true? :false))) 106 | 107 | ;; comment 108 | ;; Comments occur all over this file. It's uneccesary to make 109 | ;; an independent test case for it. 110 | 111 | ;; collections 112 | ;; bitstring, binary 113 | (assert (=== <<#"hello">> 114 | (erlang.list_to_binary #"hello"))) 115 | (assert (=== <<"hello">> 116 | (erlang.list_to_binary #"hello"))) 117 | (assert (=== <<$h $e $l $l $o>> 118 | (erlang.list_to_binary #"hello"))) 119 | (assert (=== <<($h (:size 8)) ($e (:size 8)) ($l (:size 8)) ($l (:size 8)) ($o (:size 8))>> 120 | (erlang.list_to_binary #"hello"))) 121 | (assert (=== <<($h (:size 8) :little :unsigned :integer (:unit 1)) 122 | ($e (:size 8) :little :unsigned :integer (:unit 1)) 123 | ($l (:size 8) :little :unsigned :integer (:unit 1)) 124 | ($l (:size 8) :little :unsigned :integer (:unit 1)) 125 | ($o (:size 8) :little :unsigned :integer (:unit 1))>> 126 | (erlang.list_to_binary #"hello"))) 127 | ;; list 128 | ;; literal list 129 | (assert (=== [$h $e $l $l $o] 130 | #"hello")) 131 | ;; general list evaluated to a function call 132 | (assert (=== (to-int "100") 133 | 100)) 134 | ;; cons list 135 | (assert (=== [$h $e $l $l & [$o]] 136 | #"hello")) 137 | ;; tuple 138 | (assert (=== {1 2 3} 139 | (erlang.list_to_tuple [1 2 3]))) 140 | ;; map 141 | (assert (=== #{#a 1 #b 2} 142 | (maps.from_list [{#a 1} {#b 2}]))) 143 | ;; set 144 | (assert (=== %{1 2 3} 145 | (gb_sets.from_list [1 2 3]))) 146 | ) 147 | ) 148 | -------------------------------------------------------------------------------- /lib/kapok/test/syntax/fn-test.kpk: -------------------------------------------------------------------------------- 1 | (ns fn-test 2 | (require lists) 3 | (use kapok.unittest)) 4 | 5 | (defn g [e] 6 | (inc e)) 7 | 8 | (defn main [] 9 | ;; there are several formats to define a lambda function(alias, fn): 10 | ;; 1. (fn function-name arity) 11 | ;; a fn to existing local function with specified arity 12 | ;; 2. (fn module function arity) 13 | ;; a fn to existing remote function with specified arity 14 | ;; 3. (fn [args] (&when guard) body) 15 | ;; (fn [args] body) 16 | ;; a single clause fn definition with optioinal guard 17 | ;; 4. (fn 18 | ;; ([args 1] (&when guard 1) clause 1 body) 19 | ;; ([args 2] clause 2 body) 20 | ;; ...) 21 | ;; a multiple clauses fn definition with optional guard to each clause 22 | ;; 5. (fn name [args] (&when guard) body) 23 | ;; (fn name [args] body) 24 | ;; a single clause named fn definition with optional guard 25 | ;; 6. (fn name 26 | ;; ([args 1] (&when guard 1) clause 1 body) 27 | ;; ([args 2] clause 2 body) 28 | ;; ...) 29 | ;; a multiple clause named fn definition with optional guard to each clause 30 | ;; Since fn is temporariry defined and used, no doc is needed or supported. 31 | 32 | (test "test fn to local call" 33 | (let [f (fn g 1)] 34 | (assert (=== [2 3] 35 | (lists.map f [1 2]))))) 36 | 37 | (test "test fn to remote call" 38 | (let [f (fn core - 1)] 39 | (assert (=== [-1 -2] 40 | (lists.map f [1 2]))))) 41 | 42 | (test "test unnamed fn" 43 | (let [f1 (fn [e] (&when (integer? e)) 44 | (inc e)) 45 | f2 (fn [e] 46 | (inc e)) 47 | f3 (fn 48 | ([{x y}] (+ x y)) 49 | ([e] (inc e)))] 50 | (assert (=== [2 3] 51 | (lists.map f1 [1 2]))) 52 | (assert (=== [2 3] 53 | (lists.map f2 [1 2]))) 54 | (assert (=== [3 7] 55 | (lists.map f3 [{1 2} {3 4}]))) 56 | (assert (=== [2 3] 57 | (lists.map f3 [1 2]))))) 58 | 59 | (test "test named fn" 60 | (let [f1 (fn fibonacci-1 [n] (&when (integer? n)) 61 | (case n 62 | (0 0) 63 | (1 1) 64 | (_ (+ (fibonacci-1 (- n 1)) 65 | (fibonacci-1 (- n 2)))))) 66 | f2 (fn fibonacci-2 [n] 67 | (case n 68 | (0 0) 69 | (1 1) 70 | (_ (+ (fibonacci-2 (- n 1)) 71 | (fibonacci-2 (- n 2)))))) 72 | f3 (fn fibonacci-3 ([n] (&when (=== n 0)) 0) 73 | ([n] (&when (=== n 1)) 1) 74 | ([n] (+ (fibonacci-3 (- n 1)) 75 | (fibonacci-3 (- n 2)))))] 76 | (assert (=== 8 (f1 6))) 77 | (assert (=== 8 (f2 6))) 78 | (assert (=== 8 (f3 6))) 79 | ;; The names `fibonacci-1', `fibonacci-2', `fibonacci-3' are inacessible 80 | ;; outside their definition, just like what's in erlang. 81 | ;; (assert (=== 8 (fibonacci-1 6))) 82 | ))) 83 | -------------------------------------------------------------------------------- /lib/kapok/test/syntax/funcall-test.kpk: -------------------------------------------------------------------------------- 1 | (ns funcall-test.impl 2 | (use kapok.unittest)) 3 | 4 | (defn f [] 5 | "function without argument." 6 | []) 7 | 8 | (defn f [a] 9 | "function with one argument." 10 | [a]) 11 | 12 | (defn f [a b] 13 | "function with two argument" 14 | [a b]) 15 | 16 | (defn g [a &rest l] 17 | "function with a rest argument." 18 | [a l]) 19 | 20 | ;; another way to write a rest argument 21 | ;; use `&'(cons_list) instead of `&rest' 22 | (defn h [a & l] 23 | "function with a rest argument." 24 | [a l]) 25 | 26 | (defn m [a &optional b] 27 | [a b]) 28 | 29 | (defn n [a &optional b &rest c] 30 | [a b c]) 31 | 32 | (defn p [a &key (b 100) c (d #none)] 33 | [a b c d]) 34 | 35 | (defmacro gen-test [message] 36 | `(test ~message 37 | ;; It's not a good practice to define a macro to be called 38 | ;; outside this module just using local calls. 39 | ;; Here we write it this way for simplicity. 40 | (assert (=== (f) 41 | [])) 42 | (assert (=== (f 1) 43 | [1])) 44 | (assert (=== (f 1 2) 45 | [1 2])) 46 | (assert (=== (g 1) 47 | [1 []])) 48 | (assert (=== (g 1 2) 49 | [1 [2]])) 50 | (assert (=== (h 1) 51 | [1 []])) 52 | (assert (=== (h 1 2) 53 | [1 [2]])) 54 | (assert (=== (m 1) 55 | [1 :nil])) 56 | (assert (=== (m 1 2) 57 | [1 2])) 58 | (assert (=== (n 1) 59 | [1 :nil []])) 60 | (assert (=== (n 1 2) 61 | [1 2 []])) 62 | (assert (=== (n 1 2 3) 63 | [1 2 [3]])) 64 | (assert (=== (p 1) 65 | [1 100 :nil #none])) 66 | (assert (=== (p 1 :c #world :b "hello" :d 2017) 67 | [1 "hello" #world 2017]))) 68 | ) 69 | 70 | (defn main [] 71 | (gen-test "test local call") 72 | ) 73 | 74 | (ns funcall-test.call 75 | (use funcall-test.impl) 76 | (use kapok.unittest)) 77 | 78 | (defn main [] 79 | (gen-test "test remote call") 80 | ) 81 | -------------------------------------------------------------------------------- /lib/kapok/test/syntax/let-test.kpk: -------------------------------------------------------------------------------- 1 | (ns let-test 2 | (require erlang) 3 | (use kapok.unittest)) 4 | 5 | (defn main [] 6 | (test "test simple let" 7 | (let [a (erlang.list_to_integer #"100")] 8 | (assert (=== a 100)))) 9 | 10 | (test "test embedded let" 11 | (let [a 100] 12 | (assert (=== a 100)) 13 | (let [a 200] 14 | (assert (=== a 200))))) 15 | 16 | (test "test destructing let" 17 | (let [;; list 18 | [a _ _] [1 2 3] 19 | ;; tuple 20 | {b _} {4 5} 21 | ;; bitstring 22 | <<(c (:size 5)) (_ (:size 15))>> <<(6 (:size 5)) (7 (:size 3)) (8 (:size 12))>> 23 | ;; binary 24 | << d _ _ >> << 9 10 11 >> 25 | ;; list string 26 | [e & _] #"hello" 27 | ;; binary string 28 | << f _ _ _ _ >> "hello" 29 | ;; map 30 | #{#k1 value} #{#k1 100 31 | #k2 200} 32 | ] 33 | (assert (=== a 1)) 34 | (assert (=== b 4)) 35 | (assert (=== c 6)) 36 | (assert (=== d 9)) 37 | (assert (=== e $h)) 38 | (assert (=== f $h)) 39 | (assert (=== value 100)))) 40 | ) 41 | -------------------------------------------------------------------------------- /lib/kapok/test/syntax/macro-test.kpk: -------------------------------------------------------------------------------- 1 | (ns macro-test.inner 2 | "A namespace for testing macro privacy." 3 | (use kapok.unittest)) 4 | 5 | (defmacro j [] 6 | 'x) 7 | 8 | (defmacro- k [] 9 | 'x) 10 | 11 | (defn main [] 12 | (test "test local macro call" 13 | (let [x 2] 14 | (assert (=== (k) ;; `(k)' evaluates to `x' 15 | 2))))) 16 | 17 | (ns macro-test 18 | "A namespace for testing macro primitives." 19 | (use kapok.unittest) 20 | (use macro-test.inner)) 21 | 22 | (defn p [a] 23 | (inc a)) 24 | 25 | (defmacro f [fun &rest args] 26 | `(~fun ~@args)) 27 | 28 | (defmacro g [a &rest list] 29 | `[~a ~@list]) 30 | 31 | (defn main [] 32 | 33 | (test "test remote macro call" 34 | (let [x 1] 35 | (assert (=== (j) ;; `(j)' evaluates to `x' 36 | 1)))) 37 | 38 | (test "test macro primitives" 39 | (assert (=== (f p 1) 40 | 2)) 41 | (assert (=== (g 1 2) 42 | [1 2]))) 43 | ) 44 | -------------------------------------------------------------------------------- /lib/kapok/test/syntax/ns-test.kpk: -------------------------------------------------------------------------------- 1 | ;; A namespace for testing namespace. 2 | ;; -*- Kapok -*- 3 | 4 | 5 | ;; TODO add test case to declare and import/use namespace with dot name. 6 | 7 | 8 | (ns ns-use-test 9 | "A namespace for testing ns use clause." 10 | (use (erlang 11 | :as erl 12 | :only (;; use only along rename, be sure to list every functions 13 | ;; which are used and listed ase rename targets 14 | list_to_atom) 15 | :rename (;; rename a function used below 16 | (list_to_atom to-atom) 17 | ;; rename a function unused 18 | ((list_to_integer 2) to-int))) 19 | kapok.unittest 20 | (io_lib 21 | :as verbose-name-iolib 22 | :exclude (fread 23 | (print 1))))) 24 | 25 | (defn main [] 26 | (test "test ns use" 27 | (assert (=== :true 28 | ;; Use directly the rename function 29 | (to-atom #"true"))) 30 | (assert (=== :true 31 | ;; Use the alias namespace name and renamed function 32 | ;; to access the `list_to_integer' function. 33 | (erl.to-atom #"true"))) 34 | (assert (=== [#"abc"] 35 | ;; Use the functions in a namespace whose functions 36 | ;; are selectively import by `:exclude' 37 | (verbose-name-iolib.format "~s" ["abc"]))))) 38 | 39 | (ns ns-require-test 40 | "A namespace for testing ns require clause." 41 | (require 42 | io_lib 43 | (erlang :as erl)) 44 | (use kapok.unittest)) 45 | 46 | (defn main [] 47 | (test "test ns require" 48 | (assert (=== :true 49 | ;; use the origial namespace name 50 | (erlang.list_to_atom #"true"))) 51 | (assert (=== :true 52 | ;; use the namespace alias 53 | (erl.list_to_atom #"true"))) 54 | (assert (=== [#"abc"] 55 | ;; use the simply required namespace 56 | (io_lib.format "~s" ["abc"]))))) 57 | 58 | (defns ns-test.defns-test 59 | "A embedded namespace for testing `defns`." 60 | ((require (io_lib :as verbose-name-iolib)) 61 | (use (erlang 62 | :as erl 63 | :only (list_to_atom) 64 | :rename ((list_to_atom to-atom)))) 65 | (use kapok.unittest)) 66 | 67 | (defn main [] 68 | (test "test defns" 69 | (assert (=== :true 70 | (erl.list_to_atom #"true"))) 71 | (assert (=== :true 72 | (to-atom #"true"))) 73 | (assert (=== [#"abc"] 74 | (verbose-name-iolib.format "~s" ["abc"]))))) 75 | ) 76 | 77 | (defns ns-test.defns-twice-test 78 | "A embedded namespace for testing `defns` occurs twice in the same file." 79 | ((require io_lib) 80 | (use (erlang :only (list_to_atom) 81 | :rename ((list_to_atom to-atom))) 82 | kapok.unittest)) 83 | 84 | (defn main [] 85 | (test "test defns twice" 86 | (assert (=== :true 87 | (to-atom #"true"))))) 88 | ) 89 | -------------------------------------------------------------------------------- /lib/kapok/test/syntax/send-receive-test.kpk: -------------------------------------------------------------------------------- 1 | (ns send-receive-test 2 | (use kapok.unittest)) 3 | 4 | (defn- child [] 5 | (receive 6 | ({pid n} 7 | (send pid (inc n))))) 8 | 9 | (defn- calc-timeout [] 10 | 10) 11 | 12 | (defn- plus-one [n] 13 | (let [child-pid (spawn (fn child 0))] 14 | (send child-pid {(self) n}) 15 | (receive 16 | (m (&when (integer? m)) 17 | m) 18 | (after (calc-timeout) 19 | (throw "timeout"))))) 20 | 21 | (defn main [] 22 | (test "test send receive" 23 | (let [n 1] 24 | (assert (=== (inc n) 25 | (plus-one n))))) 26 | ) 27 | -------------------------------------------------------------------------------- /lib/kapok/test/syntax/sforms-test.kpk: -------------------------------------------------------------------------------- 1 | (ns sforms-test 2 | "A namespace for testing special forms." 3 | (use kapok.unittest)) 4 | 5 | (defn main [] 6 | (test "test do" 7 | (assert (=== 1 8 | (do 9 | (inc 0)))) 10 | (assert (=== 2 11 | (do 12 | (let [_ (inc 0)] 13 | #ok) 14 | (inc 1))))) 15 | ) 16 | -------------------------------------------------------------------------------- /lib/kapok/test/syntax/try-catch-test.kpk: -------------------------------------------------------------------------------- 1 | (ns try-catch-test 2 | (use kapok.unittest)) 3 | 4 | (defn- generate-exception [1] 5 | """dummy doc for this function""" 6 | #a) 7 | 8 | (defn- generate-exception [2] 9 | (erlang.throw #a)) 10 | 11 | (defn- generate-exception [3] 12 | (erlang.exit #a)) 13 | 14 | (defn- generate-exception [4] 15 | {#EXIT, #a}) 16 | 17 | (defn- generate-exception [5] 18 | (erlang.error #a)) 19 | 20 | (defn- do-nothing [] 21 | #ok) 22 | 23 | (defn- catcher [n] 24 | (try (generate-exception n) 25 | ((val {n #normal val})) 26 | (catch 27 | ((:throw x) {n #caught #thrown x}) 28 | ((:exit x) {n #caught #exited x}) 29 | ((:error x) {n #caught #error x})) 30 | (after 31 | (do-nothing) 32 | (do-nothing)))) 33 | 34 | (defn- catcher-all [n] 35 | (try (generate-exception n) 36 | ((val {n #normal val})) 37 | (catch 38 | ((kind reason) {n kind reason})))) 39 | 40 | (defn main [] 41 | (test "test try catch" 42 | (assert (=== {1 #normal #a} 43 | (catcher 1))) 44 | (assert (=== {2 #caught #thrown #a} 45 | (catcher 2))) 46 | (assert (=== {3 #caught #exited #a} 47 | (catcher 3))) 48 | (assert (=== {4 #normal {#EXIT #a}} 49 | (catcher 4))) 50 | (assert (=== {5 #caught #error #a} 51 | (catcher 5))) 52 | (assert (=== {2 :throw #a} 53 | (catcher-all 2))))) 54 | -------------------------------------------------------------------------------- /lib/unittest/lib/kapok.unittest.cli.kpk: -------------------------------------------------------------------------------- 1 | (ns kapok.unittest.cli 2 | (require erlang 3 | init 4 | file 5 | io 6 | io_lib 7 | maps 8 | re 9 | (Elixir.File :as libfile))) 10 | 11 | (defn exit [message] 12 | (io.format message) 13 | (erlang.exit message)) 14 | 15 | (defn exit [format args] 16 | (let [message (io_lib.#format format args)] 17 | (exit message))) 18 | 19 | (defn- blank-arguements [] 20 | #{#command [] 21 | #dir ""}) 22 | 23 | (defn- parse-args [[_program dir & _t] acc] 24 | (let [acc1 (maps.put #command #test acc) 25 | acc2 (maps.put #dir dir acc1)] 26 | acc2)) 27 | 28 | (defn- parse-args [args _acc] 29 | (exit "invalid args: ~p~n" [args])) 30 | 31 | (defn- parse-args [args] 32 | (parse-args args (blank-arguements))) 33 | 34 | (defn is-test-file [path] 35 | (case (filelib.is_file path) 36 | (:true 37 | (case (re.run (filename.basename path) ".*-test.kpk") 38 | (#match :true) 39 | ({#match, _} :true) 40 | (#nomatch :false))) 41 | (:false 42 | :false))) 43 | 44 | (defn iterate-dir [dir fun] 45 | (when (libfile.exists? dir) 46 | (case (file.list_dir dir) 47 | ({#ok filenames} 48 | (lists.foreach fun 49 | (lists.map (fn [file] 50 | (filename.join dir file)) 51 | filenames))) 52 | ({#error reason} 53 | (exit "fail to iterate dir: ~p, reason: ~p~n" [dir reason]))))) 54 | 55 | (defn test-project [dir] 56 | (let [test-dir (filename.join dir #"test") 57 | fun (fn itor [path] 58 | (when (libfile.exists? path) 59 | (if (filelib.is_dir path) 60 | (iterate-dir path itor) 61 | (when (is-test-file path) 62 | (io.format "--- Run ~s ---~n" [path]) 63 | (let [cmd (io_lib.format "kapok ~p" [path]) 64 | out (os.#cmd cmd)] 65 | (io.format "~s" [out]))))))] 66 | (io.format "--- run tests for project: ~s ---~n" [dir]) 67 | (iterate-dir test-dir fun)) 68 | ) 69 | 70 | (defn- process-args [args] 71 | (let [command (maps.get #command args)] 72 | (case command 73 | (#test 74 | (let [dir (maps.get #dir args)] 75 | (test-project dir)))))) 76 | 77 | (defn main [] 78 | (let [plain-args (init.get_plain_arguments) 79 | args (parse-args plain-args)] 80 | (process-args args) 81 | )) 82 | -------------------------------------------------------------------------------- /lib/unittest/lib/kapok.unittest.kpk: -------------------------------------------------------------------------------- 1 | (ns kapok.unittest 2 | (require erlang io io_lib maps)) 3 | 4 | (defn error [file line message] 5 | (let [stacktrace (try (erlang.throw #ok) 6 | (catch (#ok (erlang.get_stacktrace)))) 7 | exception {file line message}] 8 | (erlang.raise #error exception (erlang.tl stacktrace)))) 9 | 10 | (defn error [file line format args] 11 | (error file line (io_lib.#format format args))) 12 | 13 | (defmacro assert [args] 14 | (let [file (maps.get #file _&ctx) 15 | line (meta-line (maps.get #meta _&ctx))] 16 | (case args 17 | ({#list _ [op left right]} 18 | `(case ~args 19 | (:true #ok) 20 | (_ 21 | (#io.#format "~nassert failed~n op: ~p~n left: ~p~n eval: ~p~nright: ~p~n eval: ~p~n~n" 22 | ['~op '~left ~left '~right ~right]) 23 | (kapok.unittest.#error ~file ~line "assert failed")))) 24 | (_ 25 | (error file line "invalid assert args: ~p~n" [args]))))) 26 | 27 | (defmacro test [message &rest body] 28 | `(do 29 | (#io.#format "test: ~s~n" [~message]) 30 | ~@body)) 31 | -------------------------------------------------------------------------------- /lib/unittest/test/unittest-test.kpk: -------------------------------------------------------------------------------- 1 | (ns unittest-test 2 | (use kapok.unittest)) 3 | 4 | (defn f [] 5 | 1) 6 | 7 | (defn main [] 8 | (test "unittest test case" 9 | (assert (=== 1 (f))) 10 | (try (assert (=== 2 (f))) 11 | (catch ((#error _) #ok))))) 12 | --------------------------------------------------------------------------------