luerl-0.4/0000755000232200023220000000000013450242205013043 5ustar debalancedebalanceluerl-0.4/test/0000755000232200023220000000000013450242205014022 5ustar debalancedebalanceluerl-0.4/test/luerl_funcall_tests.erl0000644000232200023220000000737513450242205020613 0ustar debalancedebalance%%% @author Hans-Christian Esperer %%% @copyright (C) 2015, Hans-Christian Esperer %%% Licensed under the Apache License, Version 2.0 (the "License"); %%% you may not use this file except in compliance with the License. %%% You may obtain a copy of the License at %%% %%% http://www.apache.org/licenses/LICENSE-2.0 %%% %%% Unless required by applicable law or agreed to in writing, %%% software distributed under the License is distributed on an "AS %%% IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either %%% express or implied. See the License for the specific language %%% governing permissions and limitations under the License. %%% %%% @doc %% %%% @end %%% Created : 11 Jan 2015 by Hans-Christian Esperer -module(luerl_funcall_tests). -include_lib("eunit/include/eunit.hrl"). external_fun_test() -> State = luerl:init(), F = fun([A], S) -> {[A + 2, [A + 3, A + 4]], S} end, State1 = luerl:set_table([<<"testFun">>], F, State), {_, State2} = luerl:do(<<"function test(i)\n local a, b = testFun(i)\n return (a == i + 2), (b[1] == i + 3), (b[2] == i + 4) end">>, State1), {Res, _State3} = luerl:call_function([test], [2], State2), [BoolVal, BoolVal2, BoolVal3] = Res, ?assertEqual(true, BoolVal), ?assertEqual(true, BoolVal2), ?assertEqual(true, BoolVal3). external_nostate_fun_test() -> State = luerl:init(), F = fun([A]) -> [A + 2, [A + 3, A + 4]] end, State1 = luerl:set_table([<<"testFun">>], F, State), Chunk = <<"function test(i)\n" " local a, b = testFun(i)\n" " return (a == i + 2), (b[1] == i + 3), (b[2] == i + 4)\n" "end">>, {_, State2} = luerl:do(Chunk, State1), {Res, _State3} = luerl:call_function([test], [2], State2), [BoolVal, BoolVal2, BoolVal3] = Res, ?assertEqual(true, BoolVal), ?assertEqual(true, BoolVal2), ?assertEqual(true, BoolVal3). return_lib_function_test() -> State = luerl:init(), {_, State1} = luerl:do(<<"function test()\n return string.find end\n">>, State), {[Fun], _State2} = luerl:call_function([test], [1], State1), {Res, _State3} = Fun([<<"barfooblafasel">>, <<"foo">>], State1), ?assertEqual([4.0, 6.0], Res). define_fun_in_lua_test() -> State = luerl:init(), Chunk = <<"function mkadder(incby)\n" " return function(i)\n" " print(\"Call into Luerl!\")\n" " return i + incby\n" " end\n" "end\n">>, {_, State1} = luerl:do(Chunk, State), {[Fun], _State2} = luerl:call_function([mkadder], [1], State1), {[Fun2], _State3} = luerl:call_function([mkadder], [2], State1), ?assertEqual([5.0], Fun([4])), ?assertEqual([6.0], Fun2([4])). define_fun2_in_lua_test() -> State = luerl:init(), Chunk = <<"function mklist(numentries)\n" " return function(entryval)\n" " local list = {}\n" " for i = 1,numentries do\n" " list[i] = entryval\n" " end\n" " return list\n" " end\n" "end\n">>, {_, State1} = luerl:do(Chunk, State), {[Fun], _State2} = luerl:call_function([mklist], [5], State1), {[Fun2], _State3} = luerl:call_function([mklist], [10], State1), ?assertEqual([[{1,4.0}, {2,4.0}, {3,4.0}, {4,4.0}, {5,4.0}]], Fun([4])), ?assertEqual([[{1,4.0}, {2,4.0}, {3,4.0}, {4,4.0}, {5,4.0}, {6,4.0}, {7,4.0}, {8,4.0}, {9,4.0}, {10,4.0}]], Fun2([4])). newindex_metamethod_test() -> State = luerl:init(), Chunk = <<"local t = {}\n" "local m = setmetatable({}, {__newindex = function (tab, key, value)\n" "t[key] = value\n" "end})\n\n" "m[123] = 456\n" "return t[123], m[123]">>, {[TVal, MVal], _State1} = luerl:do(Chunk, State), ?assertEqual(456.0, TVal), ?assertEqual(nil, MVal). luerl-0.4/README.md0000644000232200023220000000320013450242205014315 0ustar debalancedebalanceLuerl - an implementation of Lua in Erlang ========================================== Luerl is an implementation of standard Lua 5.2 written in Erlang/OTP. Lua is a powerful, efficient, lightweight, embeddable scripting language common in games, IoT devices, AI bots, machine learning and scientific computing research. It supports procedural, object-oriented, functional, data-driven, reactive, organizational programming and data description. Being an extension language, Lua has no notion of a "main" program: it works as a library embedded in a host simple called the embedding program. The host program can invoke functions to execute a piece of Lua code, can write and read Lua variables, and can call Erlang functions by Lua code. Through the use of Erlang functions, Luerl can be augmented to cope with a wide range of different domains, creating a customized language sharing a syntactical framework. Luerl is implemented as a library, written in clean Erlang/OTP. For more information, read the [documentation](https://github.com/rvirding/luerl/wiki) and follow the [get started](https://github.com/rvirding/luerl/wiki/0.2-Getting-started) tutorial. You may also browse the [examples](https://github.com/rvirding/luerl/tree/develop/examples) and learn from the [luerl_demo](https://github.com/nonsensews/luerl_demo) source code. Join the Community ------------------ [Luerl on Slack](https://luerl.slack.com), join by requesting an invite [here](http://luerl-slack.herokuapp.com/) Luerl embraces both [#Erlang](https://twitter.com/hashtag/erlang?src=hash) and [#LuaLang](https://twitter.com/hashtag/lualang?src=hash) communities and ecosystems. luerl-0.4/LICENSE0000644000232200023220000002613613450242205014060 0ustar debalancedebalance Apache License Version 2.0, January 2004 http://www.apache.org/licenses/ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 1. Definitions. "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: (a) You must give any other recipients of the Work or Derivative Works a copy of this License; and (b) You must cause any modified files to carry prominent notices stating that You changed the files; and (c) You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and (d) If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS APPENDIX: How to apply the Apache License to your work. To apply the Apache License to your work, attach the following boilerplate notice, with the fields enclosed by brackets "[]" replaced with your own identifying information. (Don't include the brackets!) The text should be enclosed in the appropriate comment syntax for the file format. We also recommend that a file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. Copyright [yyyy] [name of copyright owner] Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. luerl-0.4/Makefile0000644000232200023220000000333313450242205014505 0ustar debalancedebalance# Copyright (c) 2016 Robert Virding # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # Makefile for Luerl # Building from .xrl, .yrl and .erl # Intermediaries from leex and yecc stay in ./src SRCDIR =./src EBINDIR =./ebin ESRCS := $(notdir $(wildcard $(SRCDIR)/*.erl)) XSRCS := $(notdir $(wildcard $(SRCDIR)/*.xrl)) YSRCS := $(notdir $(wildcard $(SRCDIR)/*.yrl)) EBINS = $(ESRCS:.erl=.beam) $(XSRCS:.xrl=.beam) $(YSRCS:.yrl=.beam) ERLCFLAGS = -W1 ERLC = erlc all: compile .PHONY: compile clean echo examples compile: comp_opts.mk $(addprefix $(EBINDIR)/, $(EBINS)) $(EBINDIR)/%.beam: $(SRCDIR)/%.erl $(SRCDIR)/luerl.hrl comp_opts.mk @ mkdir -p $(EBINDIR) $(ERLC) $(ERLCFLAGS) -o $(EBINDIR) $(COMP_OPTS) $(ERLCFLAGS) $< %.erl: %.xrl $(ERLC) -o $(SRCDIR) $< %.erl: %.yrl $(ERLC) -o $(SRCDIR) $< comp_opts.mk: escript get_comp_opts.escript -include comp_opts.mk clean: @ rm -f $(EBINDIR)/*.beam @ rm -f *.beam @ rm -f erl_crash.dump @ rm comp_opts.mk $(MAKE) -C examples clean echo: echo $(OBJECTS) examples: all $(MAKE) -C examples debug: ERLCFLAGS="+debug_info" make all .PHONY: all examples clean # this protects the intermediate .erl files from make's auto deletion #.SECONDARY: $(XRL_INTERM) $(YRL_INTERM) luerl-0.4/examples/0000755000232200023220000000000013450242205014661 5ustar debalancedebalanceluerl-0.4/examples/hello/0000755000232200023220000000000013450242205015764 5ustar debalancedebalanceluerl-0.4/examples/hello/hello2-7.lua0000644000232200023220000000027013450242205020017 0ustar debalancedebalance-- File : hello2-7.lua -- Purpose : Demonstration of Luerl interface. -- See : ./examples/hello/hello2.erl a = "(28a) οἶδα οὐκ εἰδώς, oîda ouk eidōs" return a luerl-0.4/examples/hello/hello2-1.lua0000644000232200023220000000022713450242205020013 0ustar debalancedebalance-- File : hello2-1.lua -- Purpose : Demonstration of Luerl interface. -- See : ./examples/hello/hello2.erl print("(6) Hello, File 'hello2-1'!")luerl-0.4/examples/hello/hello2-6.lua0000644000232200023220000000025313450242205020017 0ustar debalancedebalance-- File : hello2-6.lua -- Purpose : Demonstration of Luerl interface. -- See : ./examples/hello/hello2.erl a = 'new contents of a' print('(27) (a) ' .. a) return aluerl-0.4/examples/hello/hello2-10.lua0000644000232200023220000000021213450242205020065 0ustar debalancedebalance-- File : hello2-10.lua -- Purpose : Returning lua dicts -- See : ./examples/hello/hello2.erl return {1,2,{3,'Hello World!'}} luerl-0.4/examples/hello/Makefile0000644000232200023220000000047713450242205017434 0ustar debalancedebalanceEXAMPLES = hello \ hello2 \ hello_table ROOTDIR = ../.. SRCDIR = $(ROOTDIR)/src BEAMDIR = $(ROOTDIR)/ebin all: $(EXAMPLES) clean: rm -f *.beam erl_crash.dump .SECONDARY: %.beam: %.erl $(SRCDIR)/*.hrl erlc -I $(SRCDIR) $< %: %.beam erl -pa $(BEAMDIR) -s $@ run -s init stop -noshell .PHONY: all clean luerl-0.4/examples/hello/hello2-2.lua0000644000232200023220000000020313450242205020006 0ustar debalancedebalance-- File : hello2-2.lua -- Purpose : Demonstration of Luerl interface. -- See : ./examples/hello/hello2.erl return 2137 * 42luerl-0.4/examples/hello/hello.lua0000644000232200023220000000021613450242205017571 0ustar debalancedebalance-- File : hello.lua -- Purpose : Brief demonstration of Luerl basics - execution of a file. -- See : ./hello.erl print("Hello, File!")luerl-0.4/examples/hello/hello_sandbox.erl0000644000232200023220000000321113450242205021306 0ustar debalancedebalance%% File : hello_sandbox.erl %% Purpose : Brief demonstration of Luerl sandbox basics. %% Use $ erlc hello_sandbox.erl && erl -pa ./ebin -s hello_sandbox run -s init stop -noshell %% Or $ make hello_sandbox -module(hello_sandbox). -export([run/0]). run() -> %% sandboxing globals St0 = luerl_sandbox:init(), {error, {lua_error, Reason, _}} = luerl_sandbox:run("return os.getenv(\"HOME\")"), io:format("os.getenv with sandbox: ~p~n",[Reason]), %% customizing sandbox {[<<"number">>], _} = luerl_sandbox:run("return type(1)", luerl:init()), {error, {lua_error, _, _}} = luerl_sandbox:run("return type(1)", luerl_sandbox:init([['_G', type]])), %% using sandboxed state outside of runner try luerl:do("return os.getenv(\"HOME\")", St0) catch _:_ -> io:format("catch error with os.getenv(\"HOME\") with sandbox~n", []) end, %% script runner with reduction counting and process flags MaxReductions = 100, ProcessFlags = [{priority, low}], Timeout = 1000, {error, {reductions, R0}} = luerl_sandbox:run("a={}; for i=1,1000000 do a[i] = 5 end", St0, MaxReductions), io:format("killed process with reductions ~p > 100~n",[R0]), {error, {reductions, R1}} = luerl_sandbox:run("x = 'a'; while true do x = x .. x end", luerl:init(), MaxReductions, ProcessFlags, Timeout), io:format("killed process with reductions ~p > 100~n",[R1]), %% unlimited reductions UnlimitedReductions = 0, {[], _} = luerl_sandbox:run("a={}; for i=1,10 do a[i] = 5 end", St0, UnlimitedReductions), io:format("Finished running with unlimited reductions ~n",[]), done. luerl-0.4/examples/hello/hello2.erl0000644000232200023220000001541213450242205017660 0ustar debalancedebalance%% File : hello2.erl %% File : luerl/examples/hello/hello2.erl %% Purpose : Demonstration of the Luerl interface. %% Author : Henning Diedrich %% Use : $ cd examples/hello && erlc hello2.erl && erl -pa ../../ebin -s hello2 run -s init stop -noshell %% Or : $ make examples -module(hello2). -export([run/0]). run() -> io:format("-------------------------------------------~n"), io:format("This is an assortment of samples and tests.~n"), io:format("-------------------------------------------~n"), io:format("It's a comprehensive demo of the interface.~n"), io:format("Please check out the source to learn more.~n"), % execute a string luerl:eval("print(\"(1) Hello, Robert!\")"), luerl:eval(<<"print(\"(2) Hello, Roberto!\")">>), luerl:do("print(\"(3) Hej, Robert!\")"), luerl:do(<<"print(\"(4) Olà, Roberto!\")">>), % execute a string, get a result {ok,A} = luerl:eval("return 1 + 1"), {ok,A} = luerl:eval(<<"return 1 + 1">>), io:format("(5) 1 + 1 = ~p!~n", [A]), % execute a file luerl:evalfile("./hello2-1.lua"), luerl:dofile("./hello2-1.lua"), % execute a file, get a result {ok,B} = luerl:evalfile("./hello2-2.lua"), {B,_} = luerl:dofile("./hello2-2.lua"), io:format("(7) 2137 * 42 = ~p?~n", [B]), % execute a standard function luerl:call_function([print], [<<"(8) Hello, standard print function!">>]), luerl:call_function([print], [<<"(9) Hello, standard print function!">>], luerl:init()), {Result1,_} = luerl:call_function([table,pack], [<<"a">>,<<"b">>,42]), {Result1,_} = luerl:call_function([table,pack], [<<"a">>,<<"b">>,42], luerl:init()), io:format("(10) ~p?~n", [Result1]), % separately parse, then execute (doubles (11) and Chunk1 as assertion) St1A = luerl:init(), {ok,Chunk1,St1B} = luerl:load("print(\"(11) Hello, Chunk 1!\")", St1A), {ok,Chunk1,_} = luerl:load(<<"print(\"(11) Hello, Chunk 1!\")">>, St1A), luerl:eval(Chunk1, St1B), luerl:do(Chunk1, St1B), % separately parse, then execute (doubles (12) and Chunk2 as assertion) St2A = luerl:init(), {ok,Chunk2,St2B} = luerl:load("function chunk2() print(\"(12) Hello, Chunk 2!\") end", St2A), {ok,Chunk2,_} = luerl:load(<<"function chunk2() print(\"(12) Hello, Chunk 2!\") end">>, St2A), {ok,Result2} = luerl:eval(Chunk2, St2B), {Result2,St2C} = luerl:do(Chunk2, St2B), {Result2,St2D} = luerl:do(<<"function chunk2() print(\"(12) Hello, Chunk 2!\") end">>, St2A), luerl:call_function([chunk2], [], St2C), luerl:call_function([chunk2], [], St2D), % separately parse, then execute a file. The file defines a function no() St3A = luerl:init(), {ok,Chunk3,St3B} = luerl:loadfile("./hello2-3.lua", St3A), {ok,Result3} = luerl:eval(Chunk3, St3B), {Result3,St3C} = luerl:do(Chunk3, St3B), {[],_} = luerl:call_function([no], [], St3C), % separately parse, then execute, get a result St4A = luerl:init(), {ok,Chunk4,St4B} = luerl:load("return '(17b) Marvelous wheater today, isn°t it!'", St4A), {ok,Chunk4,_} = luerl:load(<<"return '(17b) Marvelous wheater today, isn°t it!'">>, St4A), {ok,Result4} = luerl:eval(Chunk4, St4B), {Result4,_} = luerl:do(Chunk4, St4B), io:format("(17) And I say: ~p~n", [Result4]), % separately parse, then execute a file, get a result St5A = luerl:init(), {ok,Chunk5,St5B} = luerl:loadfile("./hello2-4.lua", St5A), {ok,Result5} = luerl:eval(Chunk5, St5B), {Result5,_} = luerl:do(Chunk5, St5B), io:format("(18) And he says: ~p~n", [Result5]), % Same as above, passing State in all times. % create state New = luerl:init(), {_,_New2} = luerl:do("print '(19) hello generix'", New), % change state {_,State0} = luerl:do("a = 1000", New), {_,State01} = luerl:do("a = 1000", New), % execute a string, using passed in State0 luerl:eval("print('(20) ' .. a)", State0), luerl:eval(<<"print('(21) ' .. a+1)">>, State0), luerl:do("print('(22) ' .. a+2)", State0), luerl:do(<<"print('(23) ' .. a+3)">>, State0), % execute a string, get a result from passed in State0 {ok,E} = luerl:eval("return 4 * a", State0), {ok,E} = luerl:eval(<<"return 4 * a">>, State0), {E,_} = luerl:do("return 4 * a", State0), {E,_} = luerl:do(<<"return 4 * a">>, State0), io:format("(24) 4 x a = ~p!~n", [E]), % execute a string, get a result, change State0 {Z,State02} = luerl:do("a = 123; return a * 3", State01), {Z,State03} = luerl:do(<<"return (3 * a)">>, State02), io:format("(25) a = ~p~n", [Z]), % execute a file using passed in state luerl:evalfile("./hello2-5.lua", State03), luerl:dofile("./hello2-5.lua", State03), % execute a file that changes the State0 {_,State04} = luerl:dofile("./hello2-6.lua", State03), luerl:do("print('(27) (b) ' .. a)", State04), % execute a file, get a result {ok,F} = luerl:evalfile("./hello2-7.lua", State04), {F,State05} = luerl:dofile("./hello2-7.lua", State04), io:format("(28) F: ~s~n", [F]), % execute a file that changes the State0, and get a value back {F,State06} = luerl:dofile("./hello2-7.lua", State05), io:format("(29) F: ~s = ", [F]), luerl:do("print('(30) F: ' .. a)", State06), % separately parse, then execute {ok,Chunk11,_} = luerl:load("print(\"(31) Hello, \" .. a .. \"!\")", State06), {ok,Chunk11,_} = luerl:load(<<"print(\"(31) Hello, \" .. a .. \"!\")">>, State06), luerl:eval(Chunk11,State06), luerl:do(Chunk11,State06), % separately parse, then execute a file. The file defines a function old() {ok,Chunk12,St6} = luerl:loadfile("./hello2-8.lua", State06), {ok,Result12} = luerl:eval(Chunk12, St6), {Result12,State06A} = luerl:do(Chunk12,St6), luerl:call_function([old],[],State06A), % separately parse, then execute, get a result {ok,Chunk13,St7} = luerl:load("a = '(30a)' .. a .. ' (this is Greek)'; return a", State06), {ok,Chunk13,_} = luerl:load(<<"a = '(30a)' .. a .. ' (this is Greek)'; return a">>, State06), {ok,Result07} = luerl:eval(Chunk13, St7), {Result07,State07} = luerl:do(Chunk13, St7), io:format("(34) And again I said: ~s~n", [Result07]), % separately parse, then execute a file, get a result. The file defines confirm(p) {ok,Chunk14,St8} = luerl:loadfile("./hello2-9.lua", State07), {ok,Result14} = luerl:eval(Chunk14, St8), {Result14,State14} = luerl:do(Chunk14, St8), io:format("(35) And twice: ~s~n", [Result14]), {Result14A,_} = luerl:call_function([confirm], [<<"Is it?">>], State14), io:format("(36) Well: ~s~n", [Result14A]), % execute a file, get the decoded result of a table {ok,Result15} = luerl:evalfile("./hello2-10.lua", State14), io:format("(37) Decoded table: ~p~n", [Result15]), io:format("done~n"). luerl-0.4/examples/hello/hello2-4.lua0000644000232200023220000000023213450242205020012 0ustar debalancedebalance-- File : hello2-4.lua -- Purpose : Demonstration of Luerl interface. -- See : ./examples/hello/hello2.erl return "'(18b) Evidently, Mr. Watson.'"luerl-0.4/examples/hello/hello2-3.lua0000644000232200023220000000031213450242205020010 0ustar debalancedebalance-- File : hello2-3.lua -- Purpose : Demonstration of Luerl interface. -- See : ./examples/hello/hello2.erl function no() print("(16) No!") end print("(15) Maybe ...") return "(X) Yes!"luerl-0.4/examples/hello/hello2-5.lua0000644000232200023220000000024013450242205020012 0ustar debalancedebalance-- File : hello2-5.lua -- Purpose : Demonstration of Luerl interface. -- See : ./examples/hello/hello2.erl print ("(26) hello2-5.lua talking. a: " .. a)luerl-0.4/examples/hello/hello.erl0000644000232200023220000000104313450242205017571 0ustar debalancedebalance%% File : hello.erl %% Purpose : Brief demonstration of Luerl basics. %% Use $ erlc hello.erl && erl -pa ./ebin -s hello run -s init stop -noshell %% Or $ make hello -module(hello). -export([run/0]). run() -> % execute a string luerl:do("print(\"Hello, Robert(o)!\")"), % execute a file luerl:dofile("./hello.lua"), % separately parse, then execute State0 = luerl:init(), {ok, Chunk, State1} = luerl:load("print(\"Hello, Chunk!\")", State0), {_Ret, _NewState} = luerl:do(Chunk, State1), done. luerl-0.4/examples/hello/hello2-8.lua0000644000232200023220000000025213450242205020020 0ustar debalancedebalance-- File : hello2-8.lua -- Purpose : Demonstration of Luerl interface. -- See : ./examples/hello/hello2.erl function old() print "(33) old" end print "(32) News!"luerl-0.4/examples/hello/hello2-9.lua0000644000232200023220000000027413450242205020025 0ustar debalancedebalance-- File : hello2-9.lua -- Purpose : Demonstration of Luerl interface. -- See : ./examples/hello/hello2.erl function confirm(p) return p .. ' (it really is)' end return confirm(a)luerl-0.4/examples/hello/hello_table.erl0000644000232200023220000000171313450242205020744 0ustar debalancedebalance%% File : hello_table.erl %% Purpose : Brief demonstration of Luerl table access. %% Use $ erlc hello_table.erl && erl -pa ../../ebin -s hello_table run -s init stop -noshell -module(hello_table). -export([run/0]). run() -> LuaScript = <<"hello_table = { hello=\"world\" }; return hello_table">>, {[_Table], Lua0} = luerl:do(LuaScript), {World, Lua1} = luerl:get_table([hello_table, hello], Lua0), Lua2 = luerl:set_table([hello_table, hello], there, Lua1), {HelloDict,Lua3} = luerl:get_table([hello_table], Lua2), {There, Lua4} = luerl:get_table([hello_table, hello], Lua3), io:format("(1) hello ~s ~s - ~p~n", [There, World, HelloDict]), Lua5 = luerl:set_table1([<<"hello_table">>, <<"goodbye">>], <<"bye">>, Lua4), {Bye, Lua6} = luerl:get_table1([<<"hello_table">>, <<"goodbye">>], Lua5), {HelloTab, _Lua7} = luerl:get_table1([<<"hello_table">>], Lua6), io:format("(2) ~s - ~p~n", [Bye, HelloTab]), done. luerl-0.4/examples/euler/0000755000232200023220000000000013450242205015775 5ustar debalancedebalanceluerl-0.4/examples/euler/problem_007.lua0000644000232200023220000000147013450242205020530 0ustar debalancedebalance-- By listing the first six prime numbers: 2, 3, 5, 7, 11, and 13, we can see that the 6th prime is 13. -- What is the 10 001st prime number? -- LIMIT = 10001 LIMIT = 113 function primes(count) found_primes = { 2 } local function divisible_by_known_primes(num) for _, v in ipairs(found_primes) do if num % v == 0 then return true end end return false end local function next_prime(found_primes, _) val = found_primes[#found_primes] repeat val = (val == 2) and 3 or val + 2 until(not divisible_by_known_primes(val)) table.insert(found_primes, val) if #found_primes > count then return nil else return val end end return next_prime, found_primes, 3 end for ii in primes(LIMIT) do highest = ii end print(highest) return highest luerl-0.4/examples/euler/problem_009.lua0000644000232200023220000000063513450242205020534 0ustar debalancedebalance-- A Pythagorean triplet is a set of three natural numbers, a b c, for which, -- a2 + b2 = c2 -- For example, 32 + 42 = 9 + 16 = 25 = 52. -- There exists exactly one Pythagorean triplet for which a + b + c = 1000. -- Find the product abc. for a = 2, 499 do for b = 2, 499 do c = (1000 - a) - b if a^2 + b^2 == c^2 then answer = a*b*c print(answer) return answer end end end luerl-0.4/examples/euler/problem_001.lua0000644000232200023220000000051213450242205020516 0ustar debalancedebalance-- If we list all the natural numbers below 10 that are multiples of 3 or 5, we get 3, 5, 6 and 9. The sum of these multiples is 23. -- Find the sum of all the multiples of 3 or 5 below 1000. LIMIT = 1000 sum = 0 for ii = 1, (LIMIT-1) do if (ii%3 == 0) or (ii%5 == 0) then sum = sum + ii end end print(sum) return sum luerl-0.4/examples/euler/Makefile0000644000232200023220000000044013450242205017433 0ustar debalancedebalanceEXAMPLES = euler ROOTDIR = ../.. SRCDIR = $(ROOTDIR)/src BEAMDIR = $(ROOTDIR)/ebin all: $(EXAMPLES) clean: rm -f *.beam erl_crash.dump .SECONDARY: %.beam: %.erl $(SRCDIR)/*.hrl erlc -I $(SRCDIR) $< %: %.beam erl -pa $(BEAMDIR) -s $@ run -s init stop -noshell .PHONY: all clean luerl-0.4/examples/euler/problem_003.lua0000644000232200023220000000111113450242205020514 0ustar debalancedebalance-- The prime factors of 13195 are 5, 7, 13 and 29. -- What is the largest prime factor of the number 600851475143 ? -- NUMBER_TO_FACTOR = 600851475143 NUMBER_TO_FACTOR = 13195 limit = math.sqrt(NUMBER_TO_FACTOR) primes = { 3 } function divisible_by_any(val, array) for ii, num in ipairs(array) do if (val % num) == 0 then return true end end return false end for ii = 5, limit, 2 do if not divisible_by_any(ii, primes) then table.insert(primes, ii) if NUMBER_TO_FACTOR % ii == 0 then factor = ii end end end print(factor) return factor luerl-0.4/examples/euler/problem_008.lua0000644000232200023220000000263713450242205020537 0ustar debalancedebalance-- Find the greatest product of five consecutive digits in the 1000-digit number. -- NUMBER = "7316717653133062491922511967442657474235534919493496983520312774506326239578318016984801869478851843858615607891129494954595017379583319528532088055111254069874715852386305071569329096329522744304355766896648950445244523161731856403098711121722383113622298934233803081353362766142828064444866452387493035890729629049156044077239071381051585930796086670172427121883998797908792274921901699720888093776657273330010533678812202354218097512545405947522435258490771167055601360483958644670632441572215539753697817977846174064955149290862569321978468622482839722413756570560574902614079729686524145351004748216637048440319989000889524345065854122758866688116427171479924442928230863465674813919123162824586178664583591245665294765456828489128831426076900422421902267105562632111110937054421750694165896040807198403850962455444362981230987879927244284909188845801561660979191338754992005240636899125607176060588611646710940507754100225698315520005593572972571636269561882670428252483600823257530420752963450" NUMBER = "11111222221" largest = 0 for ii = 1, (#NUMBER-5) do digits = string.sub(NUMBER, ii, ii+5) sum = string.sub(digits, 1, 1) * string.sub(digits, 2, 2) * string.sub(digits, 3, 3) * string.sub(digits, 4, 4) * string.sub(digits, 5, 5) largest = (sum > largest) and sum or largest end print(largest) return largest luerl-0.4/examples/euler/problem_005.lua0000644000232200023220000000210713450242205020524 0ustar debalancedebalance-- 2520 is the smallest number that can be divided by each of the numbers from 1 to 10 without any remainder. -- What is the smallest positive number that is evenly divisible by all of the numbers from 1 to 20? LIMIT = 20 function prime_factors(n) local function factor(_, val) if n > 1 then while n % val > 0 do val = val + ( val == 2 and 1 or 2) if val * val > n then val = n end end n = n / val return val end end return factor, nil, 2 end function factorize(number) factors = {} for p in prime_factors(number) do factors[p] = factors[p] and factors[p] + 1 or 1 end return factors end function collapse(dict1, dict2) dict = {} for key, val in pairs(dict1) do dict[key] = math.max(val, dict2[key] or 0) end for key, val in pairs(dict2) do dict[key] = math.max(val, dict1[key] or 0) end return dict end factors = {} for ii = 2, LIMIT do factors = collapse(factors, factorize(ii)) end product = 1 for key, val in pairs(factors) do product = product * (key ^ val) end print(product) return product luerl-0.4/examples/euler/euler.erl0000644000232200023220000000202413450242205017613 0ustar debalancedebalance%% File : euler.erl %% Purpose : Running complex lua with luerl %% Use: erlc -I ../../src euler.erl && erl -pa ../../ebin -s euler run -s init stop -noshell %% Or: make -module(euler). -export([run/0, run/2]). run() -> run("./problem_001.lua", 233168), run("./problem_002.lua", 4613732), run("./problem_003.lua", 29), run("./problem_004.lua", 36863), run("./problem_005.lua", 232792560), run("./problem_006.lua", 25164150), run("./problem_007.lua", 617), run("./problem_008.lua", 32), run("./problem_009.lua", 31875000), run("./problem_010.lua", 277050.0), ok. run(File, Solution) -> Lua0 = luerl:init(), {ok, Form, Lua1} = luerl:loadfile(File, Lua0), case timer:tc(luerl, eval, [Form, Lua1]) of {T, {ok, [Return]}} when Return == Solution -> io:format("~s (returned ~p in ~p)~n", [File, Return, T]); {T, {ok, [Return]}} -> io:format("~s (expected ~p but got ~p in ~p)~n", [File, Solution, Return, T]); {_, {error, Error}} -> io:format("luerl error: ~p~n", [Error]) end. luerl-0.4/examples/euler/problem_010.lua0000644000232200023220000000160413450242205020521 0ustar debalancedebalance-- The sum of the primes below 10 is 2 + 3 + 5 + 7 = 17. -- Find the sum of all the primes below two million. -- LIMIT = 2000000 LIMIT = 2000 function primes_below(limit) found_primes = { } local function divisible_by_known_primes(num) for _, v in ipairs(found_primes) do if num % v == 0 then return true end end return false end local function next_prime(found_primes, last_prime) if last_prime == nil then table.insert(found_primes, 2) return 2 end val = found_primes[#found_primes] repeat val = (val == 2) and 3 or val + 2 until(not divisible_by_known_primes(val)) table.insert(found_primes, val) if val > limit then return nil else return val end end return next_prime, found_primes, nil end sum = 0 for ii in primes_below(LIMIT) do sum = sum + ii end print(sum) return sum luerl-0.4/examples/euler/problem_006.lua0000644000232200023220000000116713450242205020532 0ustar debalancedebalance-- The sum of the squares of the first ten natural numbers is, -- 12 + 22 + ... + 102 = 385 -- The square of the sum of the first ten natural numbers is, -- (1 + 2 + ... + 10)2 = 552 = 3025 -- Hence the difference between the sum of the squares of the first ten natural numbers and the square of the sum is 3025 385 = 2640. -- Find the difference between the sum of the squares of the first one hundred natural numbers and the square of the sum. LIMIT = 100 sum, sum_squares = 0, 0 for ii = 1, LIMIT do sum, sum_squares = sum + ii, sum_squares + (ii * ii) end answer = (sum*sum) - sum_squares print(answer) return answer luerl-0.4/examples/euler/problem_002.lua0000644000232200023220000000073513450242205020526 0ustar debalancedebalance-- Each new term in the Fibonacci sequence is generated by adding the previous two terms. -- By starting with 1 and 2, the first 10 terms will be: -- 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, ... -- By considering the terms in the Fibonacci sequence whose values do not exceed four million, -- find the sum of the even-valued terms. LIMIT = 4000000 a, b, sum = 1, 2, 0 while b <= LIMIT do if b % 2 == 0 then sum = sum + b end a, b = b, a + b end print(sum) return sum luerl-0.4/examples/euler/problem_004.lua0000644000232200023220000000121213450242205020517 0ustar debalancedebalance-- A palindromic number reads the same both ways. The largest palindrome made from the product of two 2-digit numbers is 9009 = 91 99. -- Find the largest palindrome made from the product of two 3-digit numbers. function is_palindrome(number) local str = number .. '' for ii = 1, (#str / 2) do if string.byte(str,ii) ~= string.byte(str, -ii) then return false end end return true end LOW = 100 --HIGH = 999 HIGH = 199 highest = 0 for ii = LOW, HIGH do for jj = LOW, HIGH do num = ii * jj if is_palindrome(num) then highest = (num > highest) and num or highest end end end print(highest) return highest luerl-0.4/examples/Makefile0000644000232200023220000000024213450242205016317 0ustar debalancedebalanceSUBDIRS ?= hello all clean: @for subdir in $(SUBDIRS); do \ echo $(MAKE) -C $$subdir $@; \ $(MAKE) -C $$subdir $@; \ done .PHONY: all clean luerl-0.4/examples/minibench/0000755000232200023220000000000013450242205016615 5ustar debalancedebalanceluerl-0.4/examples/minibench/Makefile0000644000232200023220000000046513450242205020262 0ustar debalancedebalanceEXAMPLES = minibench \ minibench2 ROOTDIR = ../.. SRCDIR = $(ROOTDIR)/src BEAMDIR = $(ROOTDIR)/ebin all: $(EXAMPLES) clean: rm -f *.beam erl_crash.dump .SECONDARY: %.beam: %.erl $(SRCDIR)/*.hrl erlc -I $(SRCDIR) $< %: %.beam erl -pa $(BEAMDIR) -s $@ run -s init stop -noshell .PHONY: all clean luerl-0.4/examples/minibench/minibench.erl0000644000232200023220000001066013450242205021260 0ustar debalancedebalance%% File : mini.erl %% Author : Henning Diedrich %% File : luerl/examples/minibench/minibench.erl %% Purpose : Benchmark for frequent calls to small Luerl scripts %% Author : Henning Diedrich %% Use $ cd ./examples/minibench %% $ erlc minibench.erl %% $ erl -pa ../../ebin -s minibench run -s init stop -noshell %% Or $ make minibench -module(minibench). -export([run/0]). run() -> io:format("----------------------------------------------------------~n"), io:format("This is a benchmark of frequent fast calls into Luerl.~n"), % I. eval and execute io:format("----------------------------------------------------------~n"), io:format("Init state, parse and execute '1 + 1'~n"), I1 = 100000, {T1,_State} = timer:tc(fun() -> do_loop(I1, "return 1 + 1") end), io:format("Adding Up: ~p microseconds for ~p x calling Lua and returning the result of 1 + 1.~n", [T1,I1]), io:format("Per call: ~p microseconds.~n", [T1/I1]), % II. eval once, then only execute io:format("----------------------------------------------------------~n"), io:format("Init state, and execute pre-parsed '1 + 1'~n"), I2 = 100000, {ok, Chunk2, _St} = luerl:load("return 1 + 1"), {T2,_State21} = timer:tc(fun() -> do_loop(I2, Chunk2) end), io:format("Adding Up: ~p microseconds for ~p x calling Lua and returning the result of 1 + 1.~n", [T2,I2]), io:format("Per call: ~p microseconds.~n", [T2/I2]), % III. eval once, then only execute io:format("----------------------------------------------------------~n"), io:format("Execute pre-parse execute '1 + 1', re-using same state~n"), I3 = 100000, State3 = luerl:init(), {ok, Chunk3, State31} = luerl:load("return 1 + 1", State3), {T3,_State31} = timer:tc(fun() -> do_loop_state(I3, Chunk3, State31) end), io:format("Adding Up: ~p microseconds for ~p x calling Lua and returning the result of 1 + 1.~n", [T3,I3]), io:format("Per call: ~p microseconds.~n", [T3/I3]), % IV. measure but state initialization io:format("----------------------------------------------------------~n"), io:format("Pure initialization of Lua state~n"), I4 = 100000, {T4,_State41} = timer:tc(fun() -> [luerl:init() || _ <- lists:seq(1,I4)] end), io:format("Adding Up: ~p microseconds for ~p x initializing Lua state.~n", [T4,I4]), io:format("Per call: ~p microseconds.~n", [T4/I4]), % V. eval once, then only execute, re-use previous state io:format("----------------------------------------------------------~n"), io:format("Execute pre-parsed '1 + 1', re-using state from last result~n"), I5 = 100000, State5 = luerl:init(), {ok, Chunk5, State51} = luerl:load("return 1 + 1", State5), {T5,_State51} = timer:tc(fun() -> do_loop_chain(I5, Chunk5, State51) end), io:format("Adding Up: ~p microseconds for ~p x calling Lua and returning the result of 1 + 1.~n", [T5,I5]), io:format("Per call: ~p microseconds.~n", [T5/I5]), % VI. measure but parsing io:format("----------------------------------------------------------~n"), io:format("Pure parsing~n"), I6 = 100000, {T6,_State61} = timer:tc(fun() -> [luerl:load("return 1 + 1") || _ <- lists:seq(1,I6)] end), io:format("Adding Up: ~p microseconds for ~p x calling Lua and returning the result of 1 + 1.~n", [T6,I6]), io:format("Per call: ~p microseconds.~n", [T6/I6]), % VII. Parse and execute io:format("----------------------------------------------------------~n"), io:format("Parse and execute '1 + 1', re-using state~n"), I7 = 100000, State7 = luerl:init(), {T7,_State71} = timer:tc(fun() -> do_loop_state(I7, "return 1 + 1", State7) end), io:format("Adding Up: ~p microseconds for ~p x calling Lua and returning the result of 1 + 1.~n", [T7,I7]), io:format("Per call: ~p microseconds.~n", [T7/I7]), done. % helper selffeed(State, _Chunk, 0) -> State; selffeed(State, Chunk, I) -> {ok,[2.0],State1} = luerl:do(Chunk, State), selffeed(State1, Chunk, I-1). do_loop(N, Chunk) when N > 0 -> luerl:do(Chunk), do_loop(N-1, Chunk); do_loop(0, _) -> ok. do_loop_state(N, Chunk, State) when N > 0 -> luerl:do(Chunk, State), do_loop_state(N-1, Chunk, State); do_loop_state(0, _, _) -> ok. do_loop_chain(N, Chunk, State0) when N > 0 -> {_,State1} = luerl:do(Chunk, State0), do_loop_chain(N-1, Chunk, State1); do_loop_chain(0, _, _) -> ok. luerl-0.4/examples/minibench/minibench2.erl0000644000232200023220000001473413450242205021350 0ustar debalancedebalance%% File : minibench2.erl %% Author : Henning Diedrich %% File : luerl/examples/minibench/minibench.erl %% Purpose : Benchmark for frequent calls to small Luerl scripts %% Author : Henning Diedrich %% Use $ cd ./examples/minibench %% $ erlc minibench.erl %% $ erl -pa ../../ebin -s minibench run -s init stop -noshell %% Or $ make minibench -module(minibench2). -export([run/0]). run() -> io:format("----------------------------------------------------------~n"), io:format("This is a benchmark of frequent fast calls into Luerl.~n"), % I. eval and execute io:format("----------------------------------------------------------~n"), io:format("Init state, parse and execute 'a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b'~n"), I1 = 10000, {T1,_State} = timer:tc(fun() -> do_loop(I1, "a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b; return c") end), io:format("Adding Up: ~p microseconds for ~p x calling Lua and returning the result of a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b.~n", [T1,I1]), io:format("Per call: ~p microseconds.~n", [T1/I1]), % II. eval once, then only execute io:format("----------------------------------------------------------~n"), io:format("Init state, and execute pre-parsed 'a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b'~n"), I2 = 10000, {ok, Chunk2, _St2} = luerl:load("a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b; return c"), {T2,_State21} = timer:tc(fun() -> do_loop(I2, Chunk2) end), io:format("Adding Up: ~p microseconds for ~p x calling Lua and returning the result of a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b.~n", [T2,I2]), io:format("Per call: ~p microseconds.~n", [T2/I2]), % III. eval once, then only execute io:format("----------------------------------------------------------~n"), io:format("Execute pre-parse execute 'a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b', re-using same state~n"), I3 = 10000, {ok, Chunk3, _St3} = luerl:load("a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b; return c"), State3 = luerl:init(), {T3,_State31} = timer:tc(fun() -> do_loop_state(I3, Chunk3, State3) end), io:format("Adding Up: ~p microseconds for ~p x calling Lua and returning the result of a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b.~n", [T3,I3]), io:format("Per call: ~p microseconds.~n", [T3/I3]), % IV. measure but state initialization io:format("----------------------------------------------------------~n"), io:format("Pure initialization of Lua state~n"), I4 = 10000, {T4,_State41} = timer:tc(fun() -> [luerl:init() || _ <- lists:seq(1,I4)] end), io:format("Adding Up: ~p microseconds for ~p x initializing a Lua state.~n", [T4,I4]), io:format("Per call: ~p microseconds.~n", [T4/I4]), % V. eval once, then only execute, re-use previous state io:format("----------------------------------------------------------~n"), io:format("Execute pre-parsed 'a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b', re-using state from last result~n"), I5 = 10000, {ok, Chunk5, _St5} = luerl:load("a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b; return c"), State5 = luerl:init(), {T5,_State51} = timer:tc(fun() -> do_loop_chain(I5, Chunk5, State5) end), io:format("Adding Up: ~p microseconds for ~p x calling Lua and returning the result of a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b.~n", [T5,I5]), io:format("Per call: ~p microseconds.~n", [T5/I5]), % Vb. function call, re-use previous state io:format("----------------------------------------------------------~n"), io:format("Execute pre-parsed function with 'a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b', re-using state from last result~n"), I5b = 10000, State5b = luerl:init(), {[],State5b1} = luerl:do("function OneAndOne() a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b; return c end", State5b), io:format("-"), {T5b,_State5b1} = timer:tc(fun() -> do_loop_state(I5b, "return OneAndOne()", State5b1) end), io:format("Adding Up: ~p microseconds for ~p x calling Lua and returning the result of a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b.~n", [T5b,I5b]), io:format("Per call: ~p microseconds.~n", [T5b/I5b]), % Vc. empty function call, re-use previous state io:format("----------------------------------------------------------~n"), io:format("Execute empty function, re-using state from last result~n"), I5c = 10000, State5c = luerl:init(), {[],State5c1} = luerl:do("function EmptyFunc() end", State5c), io:format("-"), {T5c,_State5c1} = timer:tc(fun() -> do_loop_state(I5c, "EmptyFunc()", State5c1) end), io:format("Adding Up: ~p microseconds for ~p x calling empty function.~n", [T5c,I5c]), io:format("Per call: ~p microseconds.~n", [T5c/I5c]), % VI. measure but parsing io:format("----------------------------------------------------------~n"), io:format("Pure parsing~n"), I6 = 10000, {T6,_State61} = timer:tc(fun() -> [luerl:load("a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b; return c") || _ <- lists:seq(1,I6)] end), io:format("Adding Up: ~p microseconds for ~p x calling Lua and returning the result of a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b.~n", [T6,I6]), io:format("Per call: ~p microseconds.~n", [T6/I6]), % VII. Parse and execute io:format("----------------------------------------------------------~n"), io:format("Parse and execute 'a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b', re-using state~n"), I7 = 10000, State7 = luerl:init(), {T7,_State71} = timer:tc(fun() -> do_loop_state(I7, "a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b; return c", State7) end), io:format("Adding Up: ~p microseconds for ~p x calling Lua and returning the result of a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b.~n", [T7,I7]), io:format("Per call: ~p microseconds.~n", [T7/I7]), done. % helper selffeed(State, Chunk, 0) -> State; selffeed(State, Chunk, I) -> {_,State1} = luerl:do(Chunk, State), selffeed(State1, Chunk, I-1). do_loop(N, Chunk) when N > 0 -> luerl:do(Chunk), do_loop(N-1, Chunk); do_loop(0, _) -> ok. do_loop_state(N, Chunk, State) when N > 0 -> luerl:do(Chunk, State), do_loop_state(N-1, Chunk, State); do_loop_state(0, _, _) -> ok. do_loop_chain(N, Chunk, State0) when N > 0 -> {_,State1} = luerl:do(Chunk, State0), do_loop_chain(N-1, Chunk, State1); do_loop_chain(0, _, _) -> ok. luerl-0.4/examples/benchmark/0000755000232200023220000000000013450242205016613 5ustar debalancedebalanceluerl-0.4/examples/benchmark/benchmarks.erl0000644000232200023220000000312513450242205021435 0ustar debalancedebalance%% File : benchmarks.erl %% Purpose : Benchmarks runner for luerl %% Use: erlc -I ../src benchmark.erl && erl -pa ../ebin -s benchmark run -s init stop -noshell %% Or: make -module(benchmarks). -export([run/0, run/1]). -export([benchmarks/1, do_benchmark/2, do_iteration/3]). -define(DEFAULT_ITER, 1000). run() -> Files = filelib:wildcard("suites/*.lua"), [run(File) || File <- Files], ok. run(File) -> Lua0 = luerl:init(), {ok, Form, Lua1} = luerl:loadfile(File, Lua0), {_Resp, Lua2} = luerl:do(Form, Lua1), report_file(File), [do_benchmark(Benchmark, Lua2) || Benchmark <- benchmarks(Lua2)], {ok, Lua2}. do_benchmark(Benchmark, Lua) -> Iter = num_iterations(Lua), report_benchmark(Benchmark), {Time, _Resp} = timer:tc(?MODULE, do_iteration, [Iter, Benchmark, Lua]), report_time(Time), ok. do_iteration(0, _Benchmark, _Lua) -> ok; do_iteration(Iter, Benchmark, Lua) -> luerl:call_method1([<<"bench">>, Benchmark], [], Lua), do_iteration(Iter - 1, Benchmark, Lua). num_iterations(Lua) -> case luerl:eval("return NUM_ITERATIONS", Lua) of {ok, [Iter]} when is_number(Iter) -> round(Iter); _any -> ?DEFAULT_ITER end. benchmarks(Lua0) -> {ok, Chunk, Lua1} = luerl:loadfile("util/extract_bench_keys.lua", Lua0), {ok, [Benchmarks]} = luerl:eval(Chunk, Lua1), [Key || {_Index, Key} <- Benchmarks]. report_file(File) -> io:format("~n~s ms~n", [string:left(File, 26)]). report_benchmark(Benchmark) -> io:format(" ~s", [string:left(binary_to_list(Benchmark), 24, $.)]). report_time(Time) -> io:format(" ~p~n", [Time / 1000]). luerl-0.4/examples/benchmark/util/0000755000232200023220000000000013450242205017570 5ustar debalancedebalanceluerl-0.4/examples/benchmark/util/extract_bench_keys.lua0000644000232200023220000000013013450242205024131 0ustar debalancedebalancelocal list = {} for key, func in pairs(bench) do list[#list+1] = key end return list luerl-0.4/examples/benchmark/Makefile0000644000232200023220000000044613450242205020257 0ustar debalancedebalanceEXAMPLES = benchmarks ROOTDIR = ../.. SRCDIR = $(ROOTDIR)/src BEAMDIR = $(ROOTDIR)/ebin all: $(EXAMPLES) clean: rm -f *.beam erl_crash.dump .SECONDARY: %.beam: %.erl $(SRCDIR)/*.hrl erlc -I $(SRCDIR) $< %: %.beam erl -pa $(BEAMDIR) -s $@ run -s init stop -noshell .PHONY: all clean luerl-0.4/examples/benchmark/suites/0000755000232200023220000000000013450242205020127 5ustar debalancedebalanceluerl-0.4/examples/benchmark/suites/concat.lua0000644000232200023220000000175713450242205022113 0ustar debalancedebalancelocal table_concat, table_insert = table.concat, table.insert NUM_ITERATIONS = 1 bench = {} bench.raw_concat = function() local self = "string 0\n" for i = 1, 1000 do self = self .. "string " .. i .. "\n" end return self end bench.raw_plus_1 = function() local self = { "string 0\n" } for i = 1, 1000 do self[#self + 1] = "string " self[#self + 1] = i self[#self + 1] = "\n" end return table_concat(self) end bench.raw_insert = function() local self = { "string 0\n" } for i = 1, 1000 do table_insert(self, "string ") table_insert(self, i ) table_insert(self, "\n" ) end return table_concat(self) end bench.mixed_plus_1 = function() local self = {"string 0\n"} for i = 1,1000 do self[#self + 1] = "string " .. i .. "\n" end return table_concat(self) end bench.mixed_insert = function() local self = {"string 0\n"} for i = 1, 1000 do table_insert(self, "string " .. i .. "\n") end return table_concat(self) end return bench luerl-0.4/examples/benchmark/suites/nloop.lua0000644000232200023220000000120013450242205021752 0ustar debalancedebalancelocal ipairs = ipairs local t = {} for i = 1, 55 do t[i] = i end t[51] = nil -- A hole bench = {} -- Bench function does: -- 1. Set all table elements to 0 until the first hole. -- 2. Return hole position. bench.loop_ipairs = function() local j for i, v in ipairs(t) do t[i] = 0 j = i end return j + 1 end bench.loop_for = function() local n = #t local j = n for i = 1, n do local v = t[i] if v == nil then j = i break end t[i] = 0 end return j end bench.loop_while = function() local i = 1 while t[i] ~= nil do t[i] = 0 i = i + 1 end return i end return bench luerl-0.4/examples/benchmark/suites/arguments.lua0000644000232200023220000001635113450242205022645 0ustar debalancedebalancelocal select, tostring, assert, type, error = select, tostring, assert, type, error -------------------------------------------------------------------------------- local run_plain_assert = function(a, b, c) assert(type(a) == "number") assert(type(b) == "boolean") assert(type(c) == "string") end -------------------------------------------------------------------------------- local run_assert_is do local make_assert_is = function(typename) return function(v, msg) if type(v) == typename then return v end error( (msg or "assertion failed") .. ": expected `" .. typename .. "', got `" .. type(v) .. "'", 3 ) end end local assert_is_number = make_assert_is("number") local assert_is_boolean = make_assert_is("boolean") local assert_is_string = make_assert_is("string") run_assert_is = function(a, b, c) assert_is_number(a) assert_is_boolean(b) assert_is_string(c) end end -------------------------------------------------------------------------------- local run_arguments_select_simple do local arguments_select = function(...) local nargs = select("#", ...) for i = 1, nargs, 2 do local expected_type, value = select(i, ...) if type(value) ~= expected_type then error( "bad argument #" .. ((i + 1) / 2) .. " type: expected `" .. expected_type .. "', got `" .. type(value) .. "'", 3 ) end end end run_arguments_select_simple = function(a, b, c) arguments_select( "number", a, "boolean", b, "string", c ) end end -------------------------------------------------------------------------------- local run_arguments_recursive_simple do -- Simplified lua-nucleo version, equivalent to the others. local function impl(arg_n, expected_type, value, ...) -- Points error on function, calling function which calls *arguments() if type(value) ~= expected_type then error( "argument #"..arg_n..": expected `"..tostring(expected_type) .. "', got `"..type(value).."'", 3 + arg_n ) end -- If have at least one more type, check it return ((...) ~= nil) and impl(arg_n + 1, ...) or true end local arguments_recursive = function(...) local nargs = select('#', ...) return (nargs > 0) and impl(1, ...) or true end run_arguments_recursive_simple = function(a, b, c) arguments_recursive( "number", a, "boolean", b, "string", c ) end end -------------------------------------------------------------------------------- local run_arguments_recursive_lua_nucleo do -- Taken directly from lua-nucleo local lua51_types = { ["nil"] = true; ["boolean"] = true; ["number"] = true; ["string"] = true; ["table"] = true; ["function"] = true; ["thread"] = true; ["userdata"] = true; } local function impl(is_optional, arg_n, expected_type, value, ...) -- Points error on function, calling function which calls *arguments() if type(value) ~= expected_type then if not lua51_types[expected_type] then error( "argument #"..arg_n..": bad expected type `"..tostring(expected_type).."'", 3 + arg_n ) end if not is_optional or value ~= nil then error( (is_optional and "optional" or "") .. "argument #"..arg_n..": expected `"..tostring(expected_type) .. "', got `"..type(value).."'", 3 + arg_n ) end end -- If have at least one more type, check it return ((...) ~= nil) and impl(is_optional, arg_n + 1, ...) or true end local arguments_recursive = function(...) local nargs = select('#', ...) return (nargs > 0) and ( (nargs % 2 == 0) and impl(false, 1, ...) -- Not optional or error("arguments: bad call, dangling argument detected") ) or true end run_arguments_recursive_lua_nucleo = function(a, b, c) arguments_recursive( "number", a, "boolean", b, "string", c ) end end -------------------------------------------------------------------------------- -- TODO: Add a version with full-blown validation. local run_arguments_unroll_simple do -- TODO: Put a code-generation metatable over cache -- and pre-populate it for cases with (1-10) * 2 arguments. -- If __index sees odd number, it should crash -- with dangling argument error. local arguments_cache = { [6] = function(t1, v1, t2, v2, t3, v3) if type(v1) ~= t1 then error( "argument #1: expected `"..tostring(t1) .. "', got `"..type(v1).."'", 4 ) end if type(v2) ~= t2 then error( "argument #2: expected `"..tostring(t2) .. "', got `"..type(v2).."'", 4 ) end if type(v3) ~= t3 then error( "argument #3: expected `"..tostring(t3) .. "', got `"..type(v3).."'", 4 ) end end; } local arguments = function(...) local n = select("#", ...) -- Assuming cache is pre-populated for all possible use-cases return assert(arguments_cache[n])(...) end run_arguments_unroll_simple = function(a, b, c) arguments( "number", a, "boolean", b, "string", c ) end end -------------------------------------------------------------------------------- local run_arguments_hardcoded_simple do -- Not much real-word meaning, just for comparison with -- run_arguments_unroll_simple. local hardcoded_arguments_6 = function(t1, v1, t2, v2, t3, v3) if type(v1) ~= t1 then error( "argument #1: expected `"..tostring(t1) .. "', got `"..type(v1).."'", 2 ) end if type(v2) ~= t2 then error( "argument #2: expected `"..tostring(t2) .. "', got `"..type(v2).."'", 2 ) end if type(v3) ~= t3 then error( "argument #3: expected `"..tostring(t3) .. "', got `"..type(v3).."'", 2 ) end end run_arguments_hardcoded_simple = function(a, b, c) hardcoded_arguments_6( "number", a, "boolean", b, "string", c ) end end -------------------------------------------------------------------------------- bench = { } bench.plain_assert = function() run_plain_assert(42, true, "aaa") end bench.assert_is = function() run_assert_is(42, true, "aaa") end bench.assert_is_alloc = function() -- Imitating args table allocation. -- Needed to compensate plain Lua interpreter -- compatibility mode. local a, b, c = { }, { }, { } run_assert_is(42, true, "aaa") end bench.args_select_simple = function() run_arguments_select_simple(42, true, "aaa") end bench.args_recursive_simp = function() run_arguments_recursive_simple(42, true, "aaa") end bench.args_recursive_ln = function() run_arguments_recursive_lua_nucleo(42, true, "aaa") end bench.args_unroll_simple = function() run_arguments_unroll_simple(42, true, "aaa") end bench.args_hard_simple = function() run_arguments_hardcoded_simple(42, true, "aaa") end return bench luerl-0.4/examples/benchmark/suites/selectvstable.lua0000644000232200023220000000106113450242205023470 0ustar debalancedebalancelocal select = select local select_test = function(...) local nargs = select("#", ...) local r = { } for i = 1, nargs do r[#r + 1] = select(i, ...) * 2 end return r end local table_test = function(...) local nargs = select("#", ...) -- Still have to do this in case of nils local args = { ... } local r = { } for i = 1, nargs do r[#r + 1] = args[i] * 2 end return r end bench = { } bench.select = function() return select_test(3, 5, 1, 9, 7) end bench.table = function() return table_test(3, 5, 1, 9, 7) end return bench luerl-0.4/examples/benchmark/suites/tclone.lua0000644000232200023220000001455413450242205022127 0ustar debalancedebalance-------------------------------------------------------------------------------- -- tclone.lua: tclone benchmark -------------------------------------------------------------------------------- local type, pairs, assert, error, unpack, next, newproxy = type, pairs, assert, error, unpack, next, newproxy local math_randomseed, math_random = math.randomseed, math.random local string_char = string.char local table_concat = table.concat -- local coroutine_create = coroutine.create -------------------------------------------------------------------------------- math_randomseed(123456) -------------------------------------------------------------------------------- -- -- Current lua-nucleo version (a166af) -- local tclone_nucleo do local function impl(t, visited) local t_type = type(t) if t_type ~= "table" then return t end assert(not visited[t], "recursion detected") visited[t] = true local r = { } for k, v in pairs(t) do r[impl(k, visited)] = impl(v, visited) end visited[t] = nil return r end tclone_nucleo = function(t) return impl(t, { }) end end -- -- tclone2 by Dimiter "malkia" Stanev -- http://article.gmane.org/gmane.comp.lang.lua.general/82378 -- local tclone2 do local function impl(t, visited, rtimes) local t_type = type(t) if t_type ~= "table" then return t end -- Don't remember all visited[t] levels -- Just remember every once in a 128 times -- If there is a recursion it'll still be detected -- But 128 stack levels deeper assert(not visited[t], "recursion detected (with some latency)") if rtimes == 128 then rtimes = 1 visited[t] = t end local r = { } for k, v in pairs(t) do r[impl(k, visited, rtimes + 1)] = impl(v, visited, rtimes + 1) end if rtimes == 1 then visited[t] = nil end return r end tclone2 = function(t) return impl(t, { }, 1) end end -- -- tclone5 by Dimiter "malkia" Stanev -- http://article.gmane.org/gmane.comp.lang.lua.general/82379 -- local tclone5 do local function impl(t, visited, rtimes) if visited[t] then error("recursion detected") end if rtimes == 128 then rtimes = 1 visited[t] = true end local r = { } for k, v in pairs(t) do if type(k) == "table" then if type(v) == "table" then r[impl(k, visited, rtimes + 1)] = impl(v, visited, rtimes + 1) else r[impl(k, visited, rtimes + 1)] = v end elseif type(v) == "table" then r[k] = impl(v, visited, rtimes + 1) else r[k] = v end end if rtimes == 1 then visited[t] = nil end return r end tclone5 = function(t) if type(t) == "table" then return impl(t, { }, 1) end return t end end -- -- tclone6 by Dimiter "malkia" Stanev -- http://article.gmane.org/gmane.comp.lang.lua.general/82601 -- With a fix in while condition -- local tclone6 do local function impl(t, visited, rtimes) if visited[t] then error("recursion detected") end if rtimes == 128 then rtimes = 1 visited[t] = true end local r = { } local k, v = next(t) while k ~= nil do if type(k) == "table" then if type(v) == "table" then r[impl(k, visited, rtimes + 1)] = impl(v, visited, rtimes + 1) else r[impl(k, visited, rtimes + 1)] = v end elseif type(v) == "table" then r[k] = impl(v, visited, rtimes + 1) else r[k] = v end k, v = next(t, k) end if rtimes == 1 then visited[t] = nil end return r end tclone6 = function(t) if type(t) == "table" then return impl(t, { }, 1) end return t end end -------------------------------------------------------------------------------- -- TODO: From lua-nucleo/test/table.lua. -- Make that avaliable to other projects and reuse. local function gen_random_dataset(num, nesting, visited, random) random = random or math_random nesting = nesting or 1 visited = visited or {} num = num or random(0, 10) local gen_str = function() local len = random(1, 64) local t = {} for i = 1, len do t[i] = string_char(random(0, 255)) end return table_concat(t) end local gen_bool = function() return random() >= 0.5 end local gen_udata = function() return newproxy() end local gen_func = function() return function() end end -- local gen_thread = function() return coroutine_create(function() end) end local gen_nil = function() return nil end local gen_visited_link = function() if #visited > 1 then return visited[random(1, #visited)] else return gen_str() end end local generators = { gen_bool; gen_bool; gen_bool; function() return random(-10, 10) end; gen_str; gen_str; gen_str; --[[ gen_thread; gen_thread; gen_func; gen_func; gen_udata; gen_udata;--]] --gen_visited_link; function() if nesting >= 10 then return nil end local t = { } visited[#visited + 1] = t local n = random(0, 10 - nesting) for i = 1, n do local k = gen_random_dataset(1, nesting + 1, visited, random) if k == nil then k = "(nil)" end t[k] = gen_random_dataset(1, nesting + 1, visited, random) end return t end } local t = {} visited[#visited + 1] = t for i = 1, num do local n = random(1, #generators) t[i] = generators[n]() end return unpack(t, 1, num) end -------------------------------------------------------------------------------- local DATA = { gen_random_dataset(20) } -------------------------------------------------------------------------------- bench = { } -------------------------------------------------------------------------------- bench.lua_nucleo = function() local data = tclone_nucleo(DATA) assert(data ~= DATA) -- TODO: Check equality. end bench.tclone2 = function() local data = tclone2(DATA) assert(data ~= DATA) -- TODO: Check equality. end bench.tclone5 = function() local data = tclone5(DATA) assert(data ~= DATA) -- TODO: Check equality. end bench.tclone6 = function() local data = tclone5(DATA) assert(data ~= DATA) -- TODO: Check equality. end -------------------------------------------------------------------------------- return bench luerl-0.4/examples/benchmark/suites/COPYRIGHT0000644000232200023220000000264613450242205021432 0ustar debalancedebalanceLuamarca is licensed under the terms of the MIT license reproduced below. This means that Luamarca is free software and can be used for both academic and commercial purposes at absolutely no cost. =============================================================================== Copyright (C) 2008-2009 Luamarca authors Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =============================================================================== (end of COPYRIGHT) luerl-0.4/examples/benchmark/suites/is_integer.lua0000644000232200023220000000300513450242205022760 0ustar debalancedebalancelocal math_floor = math.floor bench = {} local integer, noninteger = 12345, 12345.67 local noop = function(a) return a end local isint_floor = function(a) if a == math_floor(a) then return true end return false end local isint_floor_direct = function(a) return (a == math_floor(a)) end local isint_mod = function(a) if a % 1 == 0 then return true end return false end local isint_mod_direct = function(a) return (a % 1 == 0) end local isint_bits = function(a) if (a + 2^52) - 2^52 == a then return true end return false end local isint_bits_direct = function(a) return (a + 2^52) - 2^52 == a end bench.noop_int = function() noop(integer) end bench.noop_nonint = function() noop(noninteger) end bench.floor_int = function() isint_floor(integer) end bench.floor_nonint = function() isint_floor(noninteger) end bench.floor_int_direct = function() isint_floor_direct(integer) end bench.floor_nonint_direct = function() isint_floor_direct(noninteger) end bench.mod_int = function() isint_mod(integer) end bench.mod_nonint = function() isint_mod(noninteger) end bench.mod_int_direct = function() isint_mod_direct(integer) end bench.mod_nonint_direct = function() isint_mod_direct(noninteger) end bench.bits_int = function() isint_bits(integer) end bench.bits_nonint = function() isint_bits(noninteger) end bench.bits_int_direct = function() isint_bits_direct(integer) end bench.bits_nonint_direct = function() isint_bits_direct(noninteger) end return bench luerl-0.4/examples/benchmark/suites/chaincall.lua0000644000232200023220000000173513450242205022556 0ustar debalancedebalancebench = {} local function chain() return chain end local function plain() -- No-op end bench.chain_upval = function() chain () () () () () () () () () () -- 10 calls end bench.plain_upval = function() plain () plain () plain () plain () plain () plain () plain () plain () plain () plain () -- 10 calls end bench.plain_chain_upval = function() chain () chain () chain () chain () chain () chain () chain () chain () chain () chain () -- 10 calls end bench.chain_local = function() local chain = chain chain () () () () () () () () () () -- 10 calls end bench.plain_local = function() local plain = plain plain () plain () plain () plain () plain () plain () plain () plain () plain () plain () -- 10 calls end bench.plain_chain_local = function() local chain = chain chain () chain () chain () chain () chain () chain () chain () chain () chain () chain () -- 10 calls end return bench luerl-0.4/examples/benchmark/suites/callmap10.lua0000644000232200023220000000146013450242205022405 0ustar debalancedebalancelocal noop = function() end local plain_call = function(a) noop() end local if_call = function(a) if a == "a1" then noop() elseif a == "a2" then noop() elseif a == "a3" then noop() elseif a == "a4" then noop() elseif a == "a5" then noop() elseif a == "a6" then noop() elseif a == "a7" then noop() elseif a == "a8" then noop() elseif a == "a9" then noop() elseif a == "a10" then noop() end end local map = { } for i = 1, 10 do map["a"..i] = noop end local map_call = function(a) map[a]() end local do_bench = function(fn) return function() for i = 1, 10 do fn("a"..i) end end end bench = { noop = do_bench(noop); plain_call = do_bench(plain_call); if_call = do_bench(if_call); map_call = do_bench(map_call); } return bench luerl-0.4/examples/benchmark/suites/mtvsclosure.lua0000644000232200023220000000106413450242205023221 0ustar debalancedebalancelocal setmetatable = setmetatable local mt = { __call = function(t, v) t[#t + 1] = v end } local call_setmetatable = function() return setmetatable({ }, mt) end local create_closure = function() local t = {} return function(v) t[#t + 1] = v end end local mt_obj = call_setmetatable() local fn_obj = create_closure() bench = { } bench.call_setmetatable = call_setmetatable bench.create_closure = create_closure -- bench.use_setmetatable = function() -- mt_obj("boo!") -- end bench.use_closure = function() fn_obj("boo!") end return bench luerl-0.4/examples/benchmark/suites/sort-simple.lua0000644000232200023220000000326613450242205023117 0ustar debalancedebalancelocal table_sort = table.sort local math_random, math_randomseed = math.random, math.randomseed -------------------------------------------------------------------------------- math_randomseed(12345) -------------------------------------------------------------------------------- -- TODO: Benchmark some pure-lua qsort local DATA_SIZE = 1e1 local generate_data = function() local t = { } for i = 1, DATA_SIZE do t[i] = math_random() end return t end local less = function(lhs, rhs) return lhs < rhs end local bubble_sort = function(t) for i = 2, #t do local switched = false for j = #t, i, -1 do if t[j] < t[j - 1] then t[j], t[j - 1] = t[j - 1], t[j] switched = true end end if switched == false then return t end end return t end local bubble_sort_cb = function(t, less) for i = 2, #t do local switched = false for j = #t, i, -1 do if less(t[j], t[j - 1]) then t[j], t[j - 1] = t[j - 1], t[j] switched = true end end if switched == false then return t end end return t end -------------------------------------------------------------------------------- bench = { } bench.generate_only = function() local data = generate_data() return true end bench.tsort_nocallback = function() local data = generate_data() return table_sort(data) end bench.tsort_callback = function() local data = generate_data() return table_sort(data, less) end bench.bubble_nocallback = function() local data = generate_data() return bubble_sort(data) end bench.bubble_callback = function() local data = generate_data() return bubble_sort_cb(data, less) end return bench luerl-0.4/examples/benchmark/suites/elseif_large.lua0000644000232200023220000000265613450242205023264 0ustar debalancedebalance-- TODO: ?! Is this benchmark still relevant? local tostring, assert, loadstring, ipairs = tostring, assert, loadstring, ipairs local table_concat = table.concat local math_floor = math.floor local noop = function() end local plain_call = function(a) noop() end local make_plain_call = function() return plain_call end local make_elseifs = function(n) local buf = { } local _ = function(v) buf[#buf + 1] = tostring(v) end _ "local noop = function() end " _ "return function(a)" _ " if a == 'a" _(1) _"' then noop()" for i = 2, n do _ " elseif a == 'a" _(i) _"' then noop()" end _ " else error('unknown param') end" _ " end" return assert(loadstring(table_concat(buf)))() end local make_callmaps = function(n) local buf = { } local _ = function(v) buf[#buf + 1] = tostring(v) end _ "local noop = function() end " _ "local map = {" for i = 1, n do _ "a" _(i) _ " = noop;" end _ "} " _ "return function(a) assert(map[a])() end" return assert(loadstring(table_concat(buf)))() end local bench_fn = function(fn, n) return function() fn("a" .. math_floor(n / 2 + 0.5)) end end local mark_fn = function(make, n) return bench_fn(make(n), n) end bench = { } for _, i in ipairs { 1, 5, 10, 15, 20, 100, 250, 500, 1000 } do bench["plain_"..i] = mark_fn(make_plain_call, i) bench["callmap_"..i] = mark_fn(make_callmaps, i) bench["elseif_"..i] = mark_fn(make_elseifs, i) end return bench luerl-0.4/examples/benchmark/suites/callmap1.lua0000644000232200023220000000142113450242205022322 0ustar debalancedebalancelocal noop = function() end local plain_call = function(a) noop() end local if_call = function(a) if a == "a1" then noop() elseif a == "a2" then noop() elseif a == "a3" then noop() elseif a == "a4" then noop() elseif a == "a5" then noop() elseif a == "a6" then noop() elseif a == "a7" then noop() elseif a == "a8" then noop() elseif a == "a9" then noop() elseif a == "a10" then noop() end end local map = { } for i = 1, 10 do map["a"..i] = noop end local map_call = function(a) map[a]() end local do_bench = function(fn) return function() fn("a"..1) end end bench = { noop = do_bench(noop); plain_call = do_bench(plain_call); if_call = do_bench(if_call); map_call = do_bench(map_call); } return bench luerl-0.4/examples/benchmark/suites/factory.lua0000644000232200023220000000622613450242205022307 0ustar debalancedebalancelocal pairs, setmetatable = pairs, setmetatable local clone_table = function(t) local r = {} for k, v in pairs(t) do r[k] = v end return r end local inplace = function() local factory do factory = function() return { method1 = function(self) end; method2 = function(self) end; method3 = function(self) end; method4 = function(self) end; method5 = function(self) end; method6 = function(self) end; method7 = function(self) end; method8 = function(self) end; method9 = function(self) end; method10 = function(self) end; } end end return factory end local plain = function() local factory do local method1 = function(self) end local method2 = function(self) end local method3 = function(self) end local method4 = function(self) end local method5 = function(self) end local method6 = function(self) end local method7 = function(self) end local method8 = function(self) end local method9 = function(self) end local method10 = function(self) end factory = function() return { method1 = method1; method2 = method2; method3 = method3; method4 = method4; method5 = method5; method6 = method6; method7 = method7; method8 = method8; method9 = method9; method10 = method10; } end end return factory end local mt = function() local factory do local mt = { __index = { method1 = function(self) end; method2 = function(self) end; method3 = function(self) end; method4 = function(self) end; method5 = function(self) end; method6 = function(self) end; method7 = function(self) end; method8 = function(self) end; method9 = function(self) end; method10 = function(self) end; }; } factory = function() return setmetatable({}, mt) end end return factory end local clone = function() local factory do local proto = { method1 = function(self) end; method2 = function(self) end; method3 = function(self) end; method4 = function(self) end; method5 = function(self) end; method6 = function(self) end; method7 = function(self) end; method8 = function(self) end; method9 = function(self) end; method10 = function(self) end; } factory = function() return clone_table(proto) end end return factory end local invoker = function(factory) local obj = factory() return function() obj:method1() obj:method2() obj:method3() obj:method4() obj:method5() obj:method6() obj:method7() obj:method8() obj:method9() obj:method10() end end bench = { inplace_init = inplace; plain_init = plain; metatable_init = mt; clone_init = clone; inplace_call = inplace(); plain_call = plain(); metatable_call = mt(); clone_call = clone(); inplace_method = invoker(inplace()); plain_method = invoker(plain()); metatable_method = invoker(mt()); clone_method = invoker(clone()); } return bench luerl-0.4/examples/benchmark/suites/str_is_empty.lua0000644000232200023220000000110213450242205023345 0ustar debalancedebalancelocal empty_string = "" bench = { } bench.noop = function() local a = "" return true end bench.empty_constant = function() local a = "" return a == "" end bench.empty_upvalue = function() local a = "" return a == empty_string end bench.empty_size = function() local a = "" return #a == 0 end bench.nonempty_constant = function() local a = "nonempty" return a == "" end bench.nonempty_upvalue = function() local a = "nonempty" return a == empty_string end bench.nonempty_size = function() local a = "nonempty" return #a == 0 end return bench luerl-0.4/examples/benchmark/suites/get.lua0000644000232200023220000000164413450242205021416 0ustar debalancedebalancelocal rawget = rawget local t = { true, a = true } local get = function(t, k) return t[k] end bench = { } bench.nonnil_num_plain = function() return t[1] end bench.nonnil_num_get = function() return get(t, 1) end bench.nonnil_num_rawget = function() return rawget(t, 1) end bench.nonnil_str_plain = function() return t["a"] end bench.nonnil_str_sugar = function() return t.a end bench.nonnil_str_get = function() return get(t, "a") end bench.nonnil_str_rawget = function() return rawget(t, "a") end bench.nil_num_plain = function() return t[2] end bench.nil_num_get = function() return get(t, 2) end bench.nil_num_rawget = function() return rawget(t, 2) end bench.nil_str_plain = function() return t["b"] end bench.nil_str_sugar = function() return t.b end bench.nil_str_get = function() return get(t, "b") end bench.nil_str_rawget = function() return rawget(t, "b") end return bench luerl-0.4/examples/benchmark/suites/return.lua0000644000232200023220000000063113450242205022151 0ustar debalancedebalancebench = {} local function no_ret() end local function ret_nil() return nil end local function ret_true() return true end local function ret_self() return ret_self end bench.no_ret = function() local a = no_ret() end bench.ret_nil = function() local a = ret_nil() end bench.ret_true = function() local a = ret_true() end bench.ret_self = function() local a = ret_self() end return bench luerl-0.4/examples/benchmark/suites/accum.lua0000644000232200023220000000516713450242205021733 0ustar debalancedebalancelocal assert, loadstring = assert, loadstring local pairs, ipairs, next = pairs, ipairs, next local table_concat = table.concat -------------------------------------------------------------------------------- local DATA = { 006.635; 009.210; 011.345; 013.277; 015.086; 016.812; 018.475; 020.090; 021.666; 023.209; 024.725; 026.217; 027.688; 029.141; 030.578; 032.000; 033.409; 034.805; 036.191; 037.566; 038.932; 040.289; 041.638; 042.980; 044.314; 045.642; 046.963; 048.278; 049.588; 050.892; 052.191; 053.486; 054.776; 056.061; 057.342; 058.619; 059.893; 061.162; 062.428; 063.691; 064.950; 066.206; 067.459; 068.710; 069.957; 071.201; 072.443; 073.683; 074.919; 076.154; 077.386; 078.616; 079.843; 081.069; 082.292; 083.513; 084.733; 085.950; 087.166; 088.379; 089.591; 090.802; 092.010; 093.217; 094.422; 095.626; 096.828; 098.028; 099.228; 100.425; 101.621; 102.816; 104.010; 105.202; 106.393; 107.583; 108.771; 109.958; 111.144; 112.329; 113.512; 114.695; 115.876; 117.057; 118.236; 119.414; 120.591; 121.767; 122.942; 124.116; 125.289; 126.462; 127.633; 128.803; 129.973; 131.141; 132.309; 133.476; 134.642; } local DATA_SIZE = #DATA -------------------------------------------------------------------------------- local accum_unrolled do local buf = { "return function(t, c) c = c or 0; " } for i = 1, DATA_SIZE do buf[#buf + 1] = "c = c + t["..i.."]; " end buf[#buf + 1] = "return c; end" local fn = assert(loadstring(table_concat(buf))) accum_unrolled = assert(fn()) end local accum_numeric_for = function(t, c) c = c or 0 for i = 1, #t do c = c + t[i] end return c end local accum_numeric_while = function(t, c) c = c or 0 local i = 1 local v = t[i] while v ~= nil do c = c + v i = i + 1 v = t[i] end return c end local accum_ipairs = function(t, c) c = c or 0 for _, v in ipairs(t) do c = c + v end return c end local accum_pairs = function(t, c) c = c or 0 for _, v in pairs(t) do c = c + v end return c end local accum_next = function(t, c) c = c or 0 local k, v = next(t) while k ~= nil do c = c + v k, v = next(t, k) end return c end -------------------------------------------------------------------------------- bench = { } bench.unrolled = function() return accum_unrolled(DATA) end bench.numeric_while = function() return accum_numeric_while(DATA) end bench.numeric_for = function() return accum_numeric_for(DATA) end bench.ipairs = function() return accum_ipairs(DATA) end bench.pairs = function() return accum_pairs(DATA) end bench.next = function() return accum_next(DATA) end return table.pack(bench) luerl-0.4/examples/benchmark/suites/inf.lua0000644000232200023220000000047613450242205021415 0ustar debalancedebalancelocal tonumber = tonumber local math_huge = math.huge bench = {} -- bench.e309 = function() -- local inf = 1e309 -- end bench.huge = function() local inf = math_huge end -- bench.divide = function() -- local inf = 1/0 -- end -- bench.tonumber = function() -- local inf = tonumber("inf") -- end return bench luerl-0.4/examples/benchmark/suites/tailcall.lua0000644000232200023220000000064713450242205022426 0ustar debalancedebalancelocal ret = function(t) t[1] = true return t end local noret = function(t) t[1] = true end bench = { } bench.tailcall_local = function() local t = {} return ret(t) end bench.tailcall_nolocal = function() return ret({}) end bench.notailcall_return = function() local t = {} ret(t) return t end bench.notailcall_noreturn = function() local t = {} noret(t) return t end return table.pack(bench) luerl-0.4/examples/benchmark/suites/next_vs_pairs.lua0000644000232200023220000000057213450242205023522 0ustar debalancedebalancelocal pairs, next = pairs, next local t = {} for i = 1, 50 do t[i] = i -- Array part t[i * 256] = i -- Hash part end bench = {} bench.pairs = function() local sum = 0 for k, v in pairs(t) do sum = sum + v end end bench.next = function() local sum = 0 local k, v = next(t) while k ~= nil do sum = sum + v k, v = next(t, k) end end return bench luerl-0.4/examples/benchmark/suites/vararg.lua0000644000232200023220000000223413450242205022115 0ustar debalancedebalancelocal noop = function() end local vararg_callback = function(...) end local call_noargs = function(fn) fn() end local call_vararg = function(fn, ...) fn(...) end local call_3 = function(fn, a, b, c) fn(a, b, c) end NUM_ITER = 1000 bench = { } bench.noop = noop bench.vararg_callback = vararg_callback bench.call_noargs_noop_nil = function() call_noargs(noop) end bench.call_noargs_vararg_nil = function() call_noargs(vararg_callback) end bench.call_vararg_noop_nil = function() call_noargs(noop) end bench.call_vararg_vararg_nil = function() call_noargs(vararg_callback) end bench.call_3_noop_nil = function() call_3(noop) end bench.call_3_vararg_nil = function() call_3(vararg_callback) end bench.call_noargs_noop_3 = function() call_noargs(noop, 1, 2, 3) end bench.call_noargs_vararg_3 = function() call_noargs(vararg_callback, 1, 2, 3) end bench.call_vararg_noop_3 = function() call_noargs(noop, 1, 2, 3) end bench.call_vararg_vararg_3 = function() call_noargs(vararg_callback, 1, 2, 3) end bench.call_3_noop_3 = function() call_3(noop, 1, 2, 3) end bench.call_3_vararg_3 = function() call_3(vararg_callback, 1, 2, 3) end return bench luerl-0.4/examples/benchmark/suites/nloop_simple.lua0000644000232200023220000000521613450242205023336 0ustar debalancedebalancelocal ipairs = ipairs local t5, t25, t50 = {}, {}, {} do for i = 1, 10 do t5[i] = i end t5[6] = nil for i = 1, 30 do t25[i] = i end t25[26] = nil for i = 1, 55 do t50[i] = i end t50[51] = nil end local do_nothing = function() end bench = {} local do_loop_ipairs = function(t) for i, v in ipairs(t) do end end local do_loop_numfor = function(t) for i = 1, #t do if t[i] == nil then break end end end local do_loop_while = function(t) local i = 1 while t[i] ~= nil do i = i + 1 end end bench.loop_ipairs_50 = function() do_loop_ipairs(t50) do_nothing(t50) -- Padding to get equivalent number of function calls. do_nothing(t50) do_nothing(t50) do_nothing(t50) do_nothing(t50) do_nothing(t50) do_nothing(t50) do_nothing(t50) do_nothing(t50) end bench.loop_numfor_50 = function() do_loop_numfor(t50) do_nothing(t50) do_nothing(t50) do_nothing(t50) do_nothing(t50) do_nothing(t50) do_nothing(t50) do_nothing(t50) do_nothing(t50) do_nothing(t50) end bench.loop_while_50 = function() do_loop_while(t50) do_nothing(t50) do_nothing(t50) do_nothing(t50) do_nothing(t50) do_nothing(t50) do_nothing(t50) do_nothing(t50) do_nothing(t50) do_nothing(t50) end bench.loop_ipairs_25 = function() do_loop_ipairs(t25) do_loop_ipairs(t25) do_nothing(t25) do_nothing(t25) do_nothing(t25) do_nothing(t25) do_nothing(t25) do_nothing(t25) do_nothing(t25) do_nothing(t25) end bench.loop_numfor_25 = function() do_loop_numfor(t25) do_loop_numfor(t25) do_nothing(t25) do_nothing(t25) do_nothing(t25) do_nothing(t25) do_nothing(t25) do_nothing(t25) do_nothing(t25) do_nothing(t25) end bench.loop_while_25 = function() do_loop_while(t25) do_loop_while(t25) do_nothing(t25) do_nothing(t25) do_nothing(t25) do_nothing(t25) do_nothing(t25) do_nothing(t25) do_nothing(t25) do_nothing(t25) end bench.loop_ipairs_5 = function() do_loop_ipairs(t5) do_loop_ipairs(t5) do_loop_ipairs(t5) do_loop_ipairs(t5) do_loop_ipairs(t5) do_loop_ipairs(t5) do_loop_ipairs(t5) do_loop_ipairs(t5) do_loop_ipairs(t5) do_loop_ipairs(t5) end bench.loop_numfor_5 = function() do_loop_numfor(t5) do_loop_numfor(t5) do_loop_numfor(t5) do_loop_numfor(t5) do_loop_numfor(t5) do_loop_numfor(t5) do_loop_numfor(t5) do_loop_numfor(t5) do_loop_numfor(t5) do_loop_numfor(t5) end bench.loop_while_5 = function() do_loop_while(t5) do_loop_while(t5) do_loop_while(t5) do_loop_while(t5) do_loop_while(t5) do_loop_while(t5) do_loop_while(t5) do_loop_while(t5) do_loop_while(t5) do_loop_while(t5) end return bench luerl-0.4/Emakefile0000644000232200023220000000006313450242205014647 0ustar debalancedebalance%% -*- erlang -*- {'src/luerl*',[{outdir,ebin}]}. luerl-0.4/rebar.lock0000644000232200023220000000000413450242205015002 0ustar debalancedebalance[]. luerl-0.4/get_comp_opts.escript0000644000232200023220000000457513450242205017313 0ustar debalancedebalance#! /usr/bin/env escript %% -*- mode: erlang; indent-tabs-mode: nil -*- %% Define a number of compiler options. We first work out the current %% Erlang version and from the we can define the various options. %% Bloody useful. -define(IF(Test,True,False), case Test of true -> True; false -> False end). %% Define the makefile variables HAS_MAPS and HAS_FULL_KEYS depending %% on whether this version of erlang has maps (17) and general map %% keys (18), or NEW_CORE_REC for new core definition of records (19). -define(HAS_MAPS_OPT, "-DHAS_MAPS=true"). -define(FULL_KEYS_OPT, "-DHAS_FULL_KEYS=true"). -define(NEW_REC_OPT, "-DNEW_REC_CORE=true"). -define(NEW_RAND_OPT, "-DNEW_RAND=true"). main(_) -> Version = otp_release(), CompOpts = comp_opts(Version), file:write_file("comp_opts.mk", "COMP_OPTS = " ++ CompOpts ++ "\n"). comp_opts(Version) -> Copts0 = "-DERLANG_VERSION=\\\"" ++ Version ++ "\\\"", Copts1 = ?IF(Version >= "17", Copts0 ++ " " ++ ?HAS_MAPS_OPT, Copts0), Copts2 = ?IF(Version >= "18", Copts1 ++ " " ++ ?FULL_KEYS_OPT, Copts1), Copts3 = ?IF(Version >= "19", Copts2 ++ append_copts([?NEW_REC_OPT,?NEW_RAND_OPT]), Copts2), Copts3. append_copts([Copt|Copts]) -> " " ++ Copt ++ append_copts(Copts); append_copts([]) -> []. %% Get the major release number. %% We have stolen the idea for this code from rebar3. otp_release() -> case erlang:system_info(otp_release) of [$R,N1|Rest] when is_integer(N1) -> %% If OTP <= R16, take the digits. [N1|Rest]; Rel -> %% If OTP >= 17.x, erlang:system_info(otp_release) returns %% just the major version number. File = filename:join([code:root_dir(),"releases",Rel,"OTP_VERSION"]), case file:read_file(File) of {error, _} -> Rel; {ok, Vsn} -> Size = byte_size(Vsn), %% The shortest vsn string consists of at least %% two digits followed by "\n". Therefore, it's %% safe to assume Size >= 3. case binary:part(Vsn, {Size, -3}) of <<"**\n">> -> binary:bin_to_list(Vsn, {0, Size - 3}); _ -> binary:bin_to_list(Vsn, {0, Size - 1}) end end end. luerl-0.4/rebar.config.script0000644000232200023220000000546213450242205016637 0ustar debalancedebalance%% -*- mode: erlang; indent-tabs-mode: nil -*- Conf0 = CONFIG, %The original config %% Do a deep set stepping down a list of keys replacing/adding last %% with value. Named funs would be nicer but not always available. SetConf = fun ([K], Val, Ps, _F) -> %% Replace the whole K field with Val. [Val|proplists:delete(K, Ps)]; ([K|Ks], Val, Ps, F) -> %% Step down and build coming up. case lists:keyfind(K, 1, Ps) of {K,Kps} -> lists:keyreplace(K, 1, Ps, {K,F(Ks, Val, Kps, F)}); false -> Ps ++ [{K,F(Ks, Val, [], F)}] end end, %% Get the release number. %% We have stolen the idea and most of the code from rebar3. Version = case erlang:system_info(otp_release) of [$R,N1|Rest] when is_integer(N1) -> %% If OTP <= R16, take the digits. [N1|Rest]; Rel -> File = filename:join([code:root_dir(),"releases",Rel,"OTP_VERSION"]), case file:read_file(File) of {error, _} -> Rel; {ok, Vsn} -> Size = byte_size(Vsn), %% The shortest vsn string consists of at least %% two digits followed by "\n". Therefore, it's %% safe to assume Size >= 3. case binary:part(Vsn, {Size, -3}) of <<"**\n">> -> binary:bin_to_list(Vsn, {0, Size - 3}); _ -> binary:bin_to_list(Vsn, {0, Size - 1}) end end end, %% Collect the macro definitions we will add to the compiler options. %% Erlc macro definitions. HasOpt = {d,'HAS_MAPS',true}, FullOpt = {d,'HAS_FULL_KEYS',true}, RecOpt = {d,'NEW_REC_CORE',true}, RandOpt = {d,'NEW_RAND',true}, Copts0 = [{d,'ERLANG_VERSION',Version}], Copts1 = if Version >= "17" -> Copts0 ++ [HasOpt]; true -> Copts0 end, Copts2 = if Version >= "18" -> Copts1 ++ [FullOpt]; true -> Copts1 end, Copts3 = if Version >= "19" -> Copts2 ++ [RecOpt,RandOpt]; true -> Copts2 end, Copts = Copts3, %This is it %% Ensure they are in erl_opts. Conf1 = case lists:keyfind(erl_opts, 1, Conf0) of {erl_opts,Opts} -> %Existing erl_opts NewOpts = {erl_opts,Opts ++ Copts}, lists:keyreplace(erl_opts, 1, Conf0, NewOpts); false -> %No erl_opts Conf0 ++ [{erl_opts,Copts}] end, Conf1. luerl-0.4/src/0000755000232200023220000000000013450242205013632 5ustar debalancedebalanceluerl-0.4/src/luerl_lib_io.erl0000644000232200023220000000252013450242205016775 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_lib_io.erl %% Author : Robert Virding %% Purpose : The io library for Luerl. %% This is a quick hack to get io working. It will be improved in time. -module(luerl_lib_io). -include("luerl.hrl"). -export([install/1]). -import(luerl_lib, [lua_error/2,badarg_error/3]). %Shorten this install(St) -> luerl_emul:alloc_table(table(), St). %% table() -> [{FuncName,Function}]. table() -> [{<<"flush">>,#erl_func{code=fun flush/2}}, {<<"write">>,#erl_func{code=fun write/2}} ]. flush(_, St) -> {[true],St}. write(As, St) -> case luerl_lib:conv_list(As, [lua_string]) of nil -> badarg_error(write, As, St); Ss -> lists:foreach(fun (S) -> io:format("~s", [S]) end, Ss), {[#userdata{d=standard_io}],St} end. luerl-0.4/src/luerl_comp_env.erl0000644000232200023220000003107113450242205017351 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_comp_env.erl %% Author : Robert Virding %% Purpose : A basic LUA 5.2 compiler for Luerl. %% Does variable and stack analysis in the compiler -module(luerl_comp_env). -include("luerl.hrl"). -include("luerl_comp.hrl"). -export([chunk/2]). -import(ordsets, [is_element/2,intersection/2,subtract/2]). %% Local state. -record(st, {lfs=[], %Variable frames efs=[], %Environment frames vars=none, fs=[], locv=false, %Local variables locf %Local frame }). %% chunk(St0) -> {ok,St0}; chunk(#code{code=C0}=Code, Opts) -> St0 = #st{}, %Local state {C1,_} = functiondef(C0, St0), luerl_comp:debug_print(Opts, "ce: ~p\n", [C1]), {ok,Code#code{code=C1}}. %% push_frame(State) -> State. %% pop_frame(State) -> State. %% get_frame(State) -> Frame. push_frame(#st{vars=#vars{local=Lo,fused=Fu},fs=Fs}=St) -> Lsz = length(subtract(Lo, Fu)), Esz = length(intersection(Lo, Fu)), F = new_frame(Lsz, Esz), St#st{fs=[F|Fs]}. pop_frame(#st{fs=[_|Fs]}=St) -> St#st{fs=Fs}. get_frame(#st{fs=[F|_]}) -> F. %% new_frame(LocalSize, EnvSize) -> Frame. %% We know frame will be tuples which we index from 1. Also Lua has %% the feature that every time you add a local variable you get a new %% version of it which shadows the old one. We handle this by keeping %% them in reverse order and always pushing variable to front of %% list. %% %% The size parameters aren't the true size, they are only the number %% of *different* variables. We will only use them as an indicator %% whether each frame contains local and enviroment variables. The %% true size we get at the end from the index value. %% %% {HasLocal,LocalIndex,HasEnv,EnvIndex,Vars} new_frame(Lsz, Esz) -> {Lsz>0,0,Esz>0,0,[]}. %Use size to indicate presence find_frame_var(N, {_,_,_,_,Fs}) -> find_frame_var_1(N, Fs). find_frame_var_1(N, [{N,Type,I}|_]) -> {yes,Type,I}; find_frame_var_1(N, [_|F]) -> find_frame_var_1(N, F); find_frame_var_1(_, []) -> no. frame_depth_incr({false,_,false,_,_}, Ld, Ed) -> {Ld,Ed}; %No vars at all frame_depth_incr({false,_,true,_,_}, Ld, Ed) -> {Ld,Ed+1}; %No local variables frame_depth_incr({true,_,false,_,_}, Ld, Ed) -> {Ld+1,Ed}; %No env variables frame_depth_incr({true,_,true,_,_}, Ld, Ed) -> {Ld+1,Ed+1}. %Both variables frame_local_size({_,Li,_,_,_}) -> Li. %Use the index for the size frame_env_size({_,_,_,Ei,_}) -> Ei. add_frame_local_var(N, {Lsz,Li,Esz,Ei,Fs}) -> {Lsz,Li+1,Esz,Ei,[{N,lvar,Li+1}|Fs]}. add_frame_env_var(N, {Lsz,Li,Esz,Ei,Fs}) -> {Lsz,Li,Esz,Ei+1,[{N,evar,Ei+1}|Fs]}. %% find_fs_var(Name, FrameStack) -> {yes,Type,Depth,Index} | no. %% Find a variable in the frame stack returning its depth and %% index. N.B. that we DON'T increment the local or env depth for %% unless their is actually any local or env variables %% respectively. This ensures that there are no empty frames in the %% stacks. The emulator assumes this. find_fs_var(N, Fs) -> find_fs_var(N, Fs, 1, 1). find_fs_var(N, [F|Fs], Ld, Ed) -> case find_frame_var(N, F) of {yes,lvar,Li} -> {yes,lvar,Ld,Li}; {yes,evar,Ei} -> {yes,evar,Ed,Ei}; no -> {Ld1,Ed1} = frame_depth_incr(F, Ld, Ed), find_fs_var(N, Fs, Ld1, Ed1) end; find_fs_var(_, [], _, _) -> no. %% add_var(Name, State) -> State. %% get_var(Name, State) -> #lvar{} | #evar{} | #gvar{}. add_var(N, St) -> case var_type(N, St) of local -> add_local_var(N, St); env -> add_env_var(N, St) end. add_env_var(N, #st{fs=[F0|Fs]}=St) -> F1 = add_frame_env_var(N, F0), St#st{fs=[F1|Fs]}. add_local_var(N, #st{fs=[F0|Fs]}=St) -> F1 = add_frame_local_var(N, F0), St#st{fs=[F1|Fs]}. get_var(N, #st{fs=Fs}) -> case find_fs_var(N, Fs) of {yes,lvar,Ld,Li} -> #lvar{n=N,d=Ld,i=Li}; {yes,evar,Ed,Ei} -> #evar{n=N,d=Ed,i=Ei}; no -> #gvar{n=N} end. var_type(N, #st{vars=#vars{fused=Fused}}) -> case is_element(N, Fused) of true -> env; false -> local end. %% stmt(Stmts, State) -> {Stmts,State}. stmts([S0|Ss0], St0) -> {S1,St1} = stmt(S0, nul, St0), %% io:format("ss1: ~p\n", [{Loc0,Free0,Used0}]), {Ss1,St2} = stmts(Ss0, St1), {[S1|Ss1],St2}; stmts([], St) -> {[],St}. %% stmt(Stmt, State) -> {Stmt,State}. stmt(#assign_stmt{}=A, _, St) -> assign_stmt(A, St); stmt(#call_stmt{}=C, _, St) -> call_stmt(C, St); stmt(#return_stmt{}=R, _, St) -> return_stmt(R, St); stmt(#break_stmt{}=B, _, St) -> {B,St}; stmt(#block_stmt{}=B, _, St) -> block_stmt(B, St); stmt(#while_stmt{}=W, _, St) -> while_stmt(W, St); stmt(#repeat_stmt{}=R, _, St) -> repeat_stmt(R, St); stmt(#if_stmt{}=I, _, St) -> if_stmt(I, St); stmt(#nfor_stmt{}=F, _, St) -> numfor_stmt(F, St); stmt(#gfor_stmt{}=F, _, St) -> genfor_stmt(F, St); stmt(#local_assign_stmt{}=L, _, St) -> local_assign_stmt(L, St); stmt(#local_fdef_stmt{}=L, _, St) -> local_fdef_stmt(L, St); stmt(#expr_stmt{}=E, _, St) -> expr_stmt(E, St). %% assign_stmt(Assign, State) -> {Assign,State}. assign_stmt(#assign_stmt{vs=Vs0,es=Es0}=A, St0) -> {Vs1,St1} = assign_loop(Vs0, St0), {Es1,St2} = explist(Es0, St1), {A#assign_stmt{vs=Vs1,es=Es1},St2}. assign_loop([V0|Vs0], St0) -> {V1,St1} = var(V0, St0), {Vs1,St2} = assign_loop(Vs0, St1), {[V1|Vs1],St2}; assign_loop([], St) -> {[],St}. var(#dot{e=Exp0,r=Rest0}=D, St0) -> {Exp1,St1} = prefixexp_first(Exp0, St0), {Rest1,St2} = var_rest(Rest0, St1), {D#dot{e=Exp1,r=Rest1},St2}; var(#var{n=N}, St) -> V = get_var(N, St), {V,St}. var_rest(#dot{e=Exp0,r=Rest0}=D, St0) -> {Exp1,St1} = prefixexp_element(Exp0, St0), {Rest1,St2} = var_rest(Rest0, St1), {D#dot{e=Exp1,r=Rest1},St2}; var_rest(Exp, St) -> var_last(Exp, St). var_last(#key{k=Exp0}=K, St0) -> {Exp1,St1} = exp(Exp0, St0), {K#key{k=Exp1},St1}. %% call_stmt(Call, State) -> {Call,State}. call_stmt(#call_stmt{call=Exp0}=C, St0) -> {Exp1,St1} = exp(Exp0, St0), {C#call_stmt{call=Exp1},St1}. %% return_stmt(Return, State) -> {Return,State}. return_stmt(#return_stmt{es=Es0}=R, St0) -> {Es1,St1} = explist(Es0, St0), {R#return_stmt{es=Es1},St1}. %% block_stmt(Block, State) -> {Block,State}. block_stmt(#block_stmt{ss=Ss0,vars=Vars}=B, St0) -> Do = fun(S) -> stmts(Ss0, S) end, {Ss1,Fr,St1} = with_block(Do, Vars, St0), Lsz = frame_local_size(Fr), Esz = frame_env_size(Fr), {B#block_stmt{ss=Ss1,lsz=Lsz,esz=Esz},St1}. %% do_block(Block, State) -> {Block,State}. do_block(#block{ss=Ss0,vars=Vars}=B, St0) -> Do = fun(S) -> stmts(Ss0, S) end, {Ss1,Fr,St1} = with_block(Do, Vars, St0), Lsz = frame_local_size(Fr), Esz = frame_env_size(Fr), {B#block{ss=Ss1,lsz=Lsz,esz=Esz},St1}. %% with_block(Do, Vars, State) -> {Ret,State}. %% with_block(Do, Env, Vars, State) -> {Ret,State}. %% Do a block initialising/clearing frames. We always push a local %% frame even if it not used. with_block(Do, Vars, #st{vars=OldVars}=St0) -> St1 = push_frame(St0#st{vars=Vars}), {Ret,St2} = Do(St1), Fr = get_frame(St2), St3 = pop_frame(St2), {Ret,Fr,St3#st{vars=OldVars}}. %% while_stmt(While, State) -> {While,State}. while_stmt(#while_stmt{e=E0,b=B0}=W, St0) -> {E1,St1} = exp(E0, St0), {B1,St2} = do_block(B0, St1), {W#while_stmt{e=E1,b=B1},St2}. %% repeat_stmt(Repeat, State) -> {Repeat,State}. repeat_stmt(#repeat_stmt{b=B0}=R, St0) -> {B1,St1} = do_block(B0, St0), {R#repeat_stmt{b=B1},St1}. %% if_stmt(If, State) -> {If,State}. if_stmt(#if_stmt{tests=Ts0,else=E0}=I, St0) -> {Ts1,St1} = if_tests(Ts0, St0), {E1,St2} = do_block(E0, St1), {I#if_stmt{tests=Ts1,else=E1},St2}. if_tests([{E0,B0}|Ts0], St0) -> {E1,St1} = exp(E0, St0), {B1,St2} = do_block(B0, St1), {Ts1,St3} = if_tests(Ts0, St2), {[{E1,B1}|Ts1],St3}; if_tests([], St) -> {[],St}. %% numfor_stmt(For, State) -> {For,State}. numfor_stmt(#nfor_stmt{v=V0,init=I0,limit=L0,step=S0,b=B0}=F, St0) -> {[I1,L1,S1],St1} = explist([I0,L0,S0], St0), {[V1],B1,St2} = for_block([V0], B0, St1), {F#nfor_stmt{v=V1,init=I1,limit=L1,step=S1,b=B1},St2}. %% genfor_stmt(For, State) -> {For,State}. genfor_stmt(#gfor_stmt{vs=Vs0,gens=Gs0,b=B0}=F, St0) -> {Gs1,St1} = explist(Gs0, St0), {Vs1,B1,St2} = for_block(Vs0, B0, St1), {F#gfor_stmt{vs=Vs1,gens=Gs1,b=B1},St2}. for_block(Vs0, #block{ss=Ss0,vars=Vars}=B, St0) -> Do = fun (S0) -> Fun = fun (#var{n=N}, Sa) -> Sb = add_var(N, Sa), {get_var(N, Sb),Sb} end, {Vs1,S1} = lists:mapfoldl(Fun, S0, Vs0), {Ss1,S2} = stmts(Ss0, S1), {{Vs1,Ss1},S2} end, {{Vs1,Ss1},Fr,St1} = with_block(Do, Vars, St0), Lsz = frame_local_size(Fr), Esz = frame_env_size(Fr), {Vs1,B#block{ss=Ss1,lsz=Lsz,esz=Esz},St1}. %% local_assign_stmt(Local, State) -> {Local,State}. local_assign_stmt(#local_assign_stmt{vs=Vs0,es=Es0}=L, St0) -> %% io:fwrite("las: ~p\n", [{Es0,St0}]), {Es1,St1} = explist(Es0, St0), %% io:fwrite("las> ~p\n", [{Es1,St1}]), AddVar = fun (#var{n=N}, S0) -> S1 = add_var(N, S0), {get_var(N, S1),S1} end, {Vs1,St2} = lists:mapfoldl(AddVar, St1, Vs0), %% io:fwrite("las> ~p\n", [{Vs1,St2}]), {L#local_assign_stmt{vs=Vs1,es=Es1},St2}. %% local_fdef_stmt(Local, State) -> {Local,State}. %% Add function name first in case of recursive call. local_fdef_stmt(#local_fdef_stmt{v=#var{n=N},f=F0}=L, St0) -> St1 = add_var(N, St0), {F1,St2} = functiondef(F0, St1), V1 = get_var(N, St2), %% io:fwrite("lf: ~p\n", [St0]), %% io:fwrite("lf: ~p\n", [St1]), %% io:fwrite("lf: ~p\n", [St2]), {L#local_fdef_stmt{v=V1,f=F1},St2}. %% expr_stmt(Expr, State) -> {Call,State}. %% The expression pseudo statement. This will return a single value. expr_stmt(#expr_stmt{exp=Exp0}=E, St0) -> {Exp1,St1} = exp(Exp0, St0), {E#expr_stmt{exp=Exp1},St1}. %% explist(Exprs, State) -> {Exprs,State}. %% exp(Expr, State) -> {Expr,State}. %% prefixexp(Expr, State) -> {Expr,State}. explist([E0|Es0], St0) -> {E1,St1} = exp(E0, St0), {Es1,St2} = explist(Es0, St1), {[E1|Es1],St2}; explist([], St) -> {[],St}. %No expressions at all exp(#lit{}=L, St) -> {L,St}; %Nothing to do exp(#fdef{}=F, St) -> functiondef(F, St); exp(#op{as=Es0}=Op, St0) -> {Es1,St1} = explist(Es0, St0), {Op#op{as=Es1},St1}; exp(#tc{fs=Fs0}=T, St0) -> {Fs1,St1} = tableconstructor(Fs0, St0), {T#tc{fs=Fs1},St1}; exp(E, St) -> prefixexp(E, St). prefixexp(#dot{e=Exp0,r=Rest0}=D, St0) -> {Exp1,St1} = prefixexp_first(Exp0, St0), {Rest1,St2} = prefixexp_rest(Rest0, St1), {D#dot{e=Exp1,r=Rest1},St2}; prefixexp(Exp, St) -> prefixexp_first(Exp, St). prefixexp_first(#single{e=E0}=S, St0) -> {E1,St1} = exp(E0, St0), {S#single{e=E1},St1}; prefixexp_first(#var{n=N}, St) -> V = get_var(N, St), {V,St}. prefixexp_rest(#dot{e=Exp0,r=Rest0}=D, St0) -> {Exp1,St1} = prefixexp_element(Exp0, St0), {Rest1,St2} = prefixexp_rest(Rest0, St1), {D#dot{e=Exp1,r=Rest1},St2}; prefixexp_rest(Exp, St) -> prefixexp_element(Exp, St). prefixexp_element(#key{k=E0}=K, St0) -> {E1,St1} = exp(E0, St0), {K#key{k=E1},St1}; prefixexp_element(#fcall{as=As0}=F, St0) -> {As1,St1} = explist(As0, St0), {F#fcall{as=As1},St1}; prefixexp_element(#mcall{as=As0}=M, St0) -> {As1,St1} = explist(As0, St0), {M#mcall{as=As1},St1}. %% functiondef(Func, State) -> {Func,State}. functiondef(#fdef{ps=Ps0,ss=Ss0,vars=Vars}=F, St0) -> Do = fun (S0) -> Fun = fun (#var{n=N}, Sa) -> Sb = add_var(N, Sa), {get_var(N, Sb),Sb} end, {Ps1,S1} = lists:mapfoldl(Fun, S0, Ps0), {Ss1,S2} = stmts(Ss0, S1), {{Ps1,Ss1},S2} end, {{Ps1,Ss1},Fr,St1} = with_block(Do, Vars, St0), Lsz = frame_local_size(Fr), Esz = frame_env_size(Fr), {F#fdef{ps=Ps1,ss=Ss1,lsz=Lsz,esz=Esz},St1}. %% tableconstructor(Fields, State) -> {Fields,State}. tableconstructor(Fs0, St0) -> Fun = fun (#efield{v=V0}=F, S0) -> {V1,S1} = exp(V0, S0), {F#efield{v=V1},S1}; (#kfield{k=K0,v=V0}=F, S0) -> {K1,S1} = exp(K0, S0), {V1,S2} = exp(V0, S1), {F#kfield{k=K1,v=V1},S2} end, {Fs1,St1} = lists:mapfoldl(Fun, St0, Fs0), {Fs1,St1}. luerl-0.4/src/luerl_lib_math.erl0000644000232200023220000001713413450242205017326 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_lib_math.erl %% Author : Robert Virding %% Purpose : The math library for Luerl. -module(luerl_lib_math). -include("luerl.hrl"). -export([install/1,fmod/2,frexp/2]). -import(luerl_lib, [lua_error/2,badarg_error/3]). %Shorten this %% Use the correct random number module. -ifdef(NEW_RAND). -define(RAND_UNIFORM(S), rand:uniform_s(S)). -define(RAND_UNIFORM(L, S), rand:uniform_s(L, S)). -define(RAND_SEED(), rand:seed_s(exs1024)). -define(RAND_SEED(S1,S2,S3), rand:seed_s(exs1024, {S1,S2,S3})). -else. -define(RAND_UNIFORM(S), random:uniform_s(S)). -define(RAND_UNIFORM(L, S), random:uniform_s(L, S)). -define(RAND_SEED(), random:seed0()). -define(RAND_SEED(S1,S2,S3), %Naughty, copied from source {(abs(S1) rem (30269-1) + 1), %PRIME1 (abs(S2) rem (30307-1) + 1), %PRIME2 (abs(S3) rem (30323-1) + 1)}). %PRIME3 -endif. install(St0) -> St1 = St0#luerl{rand=?RAND_SEED()}, %Default initial random seed luerl_emul:alloc_table(table(), St1). table() -> [{<<"abs">>,#erl_func{code=fun abs/2}}, {<<"acos">>,#erl_func{code=fun acos/2}}, {<<"asin">>,#erl_func{code=fun asin/2}}, {<<"atan">>,#erl_func{code=fun atan/2}}, {<<"atan2">>,#erl_func{code=fun atan2/2}}, {<<"ceil">>,#erl_func{code=fun ceil/2}}, {<<"cos">>,#erl_func{code=fun cos/2}}, {<<"cosh">>,#erl_func{code=fun cosh/2}}, {<<"deg">>,#erl_func{code=fun deg/2}}, {<<"exp">>,#erl_func{code=fun exp/2}}, {<<"floor">>,#erl_func{code=fun floor/2}}, {<<"fmod">>,#erl_func{code=fun fmod/2}}, {<<"frexp">>,#erl_func{code=fun frexp/2}}, {<<"huge">>,1.7976931348623157e308}, %From the specs {<<"ldexp">>,#erl_func{code=fun ldexp/2}}, {<<"log">>,#erl_func{code=fun log/2}}, {<<"log10">>,#erl_func{code=fun log10/2}}, %For 5.1 backwards compatibility {<<"max">>,#erl_func{code=fun max/2}}, {<<"min">>,#erl_func{code=fun min/2}}, {<<"modf">>,#erl_func{code=fun modf/2}}, {<<"pi">>,math:pi()}, {<<"pow">>,#erl_func{code=fun pow/2}}, {<<"rad">>,#erl_func{code=fun rad/2}}, {<<"random">>,#erl_func{code=fun random/2}}, {<<"randomseed">>,#erl_func{code=fun randomseed/2}}, {<<"sin">>,#erl_func{code=fun sin/2}}, {<<"sinh">>,#erl_func{code=fun sinh/2}}, {<<"sqrt">>,#erl_func{code=fun sqrt/2}}, {<<"tan">>,#erl_func{code=fun tan/2}}, {<<"tanh">>,#erl_func{code=fun tanh/2}} ]. %% abs(Args, State) -> {[Ret],State}. abs(As, St) -> case luerl_lib:tonumbers(As) of [N|_] -> {[abs(N)],St}; _ -> badarg_error(abs, As, St) end. acos(As, St) -> case luerl_lib:tonumbers(As) of [N|_] -> {[math:acos(N)],St}; nil -> badarg_error(acos, As, St) end. asin(As, St) -> case luerl_lib:tonumbers(As) of [N|_] -> {[math:asin(N)],St}; _ -> badarg_error(asin, As, St) end. atan(As, St) -> case luerl_lib:tonumbers(As) of [N|_] -> {[math:atan(N)],St}; _ -> badarg_error(atan, As, St) end. atan2(As, St) -> case luerl_lib:tonumbers(As) of [N1,N2|_] -> {[math:atan2(N1, N2)],St}; _ -> badarg_error(atan2, As, St) end. ceil(As, St) -> case luerl_lib:tonumbers(As) of [N|_] when round(N) == N -> {[N],St}; [N|_] -> {[float(round(N + 0.5))],St}; _ -> badarg_error(ceil, As, St) end. cos(As, St) -> case luerl_lib:tonumbers(As) of [N|_] -> {[math:cos(N)],St}; _ -> badarg_error(cos, As, St) end. cosh(As, St) -> case luerl_lib:tonumbers(As) of [N|_] -> {[math:cosh(N)],St}; _ -> badarg_error(cosh, As, St) end. deg(As, St) -> case luerl_lib:tonumbers(As) of [N|_] -> {[180.0*N/math:pi()],St}; _ -> badarg_error(deg, As, St) end. exp(As, St) -> case luerl_lib:tonumbers(As) of [N|_] -> {[math:exp(N)],St}; _ -> badarg_error(exp, As, St) end. floor(As, St) -> case luerl_lib:tonumbers(As) of [N|_] when round(N) == N -> {[N],St}; [N|_] -> {[float(round(N - 0.5))],St}; _ -> badarg_error(floor, As, St) end. fmod(As, St) -> case luerl_lib:tonumbers(As) of [X,Y|_] -> Div = float(trunc(X/Y)), Rem = X - Div*Y, {[Rem],St}; _ -> badarg_error(fmod, As, St) end. frexp(As, St) -> %M,E such that X = M*2^E case luerl_lib:tonumbers(As) of [X|_] -> <<_:1,E0:11,M0:52>> = <>, %The sneaky bit! Two52 = 1 bsl 52, M1 = (M0 bor Two52)/Two52, if M1 >= 1.0 -> M2 = M1/2, E1 = E0 - 1022; %Export M2, E1 M1 < 0.5 -> M2 = M1*2.0, E1 = E0 - 1024; true -> M2 = M1, E1 = E0 - 1023 end, {[float(M2),float(E1)],St}; _ -> badarg_error(frexp, As, St) end. ldexp(As, St) -> case luerl_lib:conv_list(As, [lua_number,lua_integer]) of [M,E] -> {[M*math:pow(2, E)],St}; %% <> = <<0:1,E:11,M:52>>, %% {[X],St}; _ -> badarg_error(ldexp, As, St) end. log(As, St) -> case luerl_lib:tonumbers(As) of [N] -> {[math:log(N)],St}; [N,10.0|_] -> {[math:log10(N)],St}; %Seeing it is builtin [N1,N2|_] -> {[math:log(N1)/math:log(N2)],St}; _ -> badarg_error(log, As, St) end. log10(As, St) -> %For 5.1 backwards compatibility case luerl_lib:tonumbers(As) of [0.0|_] -> {[-500.0],St}; %Bit hacky [N|_] -> {[math:log10(N)],St}; _ -> badarg_error(log10, As, St) end. max(As, St) -> case luerl_lib:tonumbers(As) of [_|_]=Ns -> {[lists:max(Ns)],St}; _ -> badarg_error(max, As, St) end. min(As, St) -> case luerl_lib:tonumbers(As) of [_|_]=Ns -> {[lists:min(Ns)],St}; _ -> badarg_error(min, As, St) end. modf(As, St) -> case luerl_lib:tonumbers(As) of [N|_] -> I = float(trunc(N)), %Integral part {[I,N-I],St}; _ -> badarg_error(modf, As, St) end. pow(As, St) -> case luerl_lib:tonumbers(As) of [N1,N2|_] -> {[math:pow(N1, N2)],St}; _ -> badarg_error(pow, As, St) end. rad(As, St) -> case luerl_lib:tonumbers(As) of [N|_] -> {[math:pi()*N/180.0],St}; _ -> badarg_error(sinh, As, St) end. random(As, #luerl{rand=S0}=St) -> case luerl_lib:to_ints(As) of [] -> %0.0 - 1.0 {R,S1} = ?RAND_UNIFORM(S0), {[R],St#luerl{rand=S1}}; [M] when M >= 1 -> {R,S1} = ?RAND_UNIFORM(M, S0), {[float(R)],St#luerl{rand=S1}}; [M,N] when N >= M -> {R,S1} = ?RAND_UNIFORM(N - M + 1, S0), {[float(R + M - 1)],St#luerl{rand=S1}}; _ -> badarg_error(random, As, St) end. randomseed(As, St) -> case luerl_lib:tonumbers(As) of [S|_] -> %% Split float-64 into three integers. <> = <>, {[],St#luerl{rand=?RAND_SEED(A1, A2, A3)}}; _ -> badarg_error(randomseed, As, St) end. sin(As, St) -> case luerl_lib:tonumbers(As) of [N|_] -> {[math:sin(N)],St}; _ -> badarg_error(sin, As, St) end. sinh(As, St) -> case luerl_lib:tonumbers(As) of [N|_] -> {[math:sinh(N)],St}; _ -> badarg_error(sinh, As, St) end. sqrt(As, St) -> case luerl_lib:tonumbers(As) of [N|_] -> {[math:sqrt(N)],St}; _ -> badarg_error(sqrt, As, St) end. tan(As, St) -> case luerl_lib:tonumbers(As) of [N|_] -> {[math:tan(N)],St}; _ -> badarg_error(tan, As, St) end. tanh(As, St) -> case luerl_lib:tonumbers(As) of [N|_] -> {[math:tanh(N)],St}; _ -> badarg_error(tanh, As, St) end. luerl-0.4/src/luerl_comp_peep.erl0000644000232200023220000000716013450242205017514 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_comp_peep.erl %% Author : Robert Virding %% Purpose : A basic LUA 5.2 compiler for Luerl. %% Does peep-hole optimisation in the compiler. -module(luerl_comp_peep). -include("luerl.hrl"). -include("luerl_comp.hrl"). -include("luerl_instrs.hrl"). -export([chunk/2]). %% chunk(St0, Opts) -> {ok,St0}. %% A chunk is now a list of instructions to define the function. chunk(#code{code=Is0}=Code, Opts) -> Is1 = instrs(Is0, nil), %No local state luerl_comp:debug_print(Opts, "cp: ~p\n", [Is1]), {ok,Code#code{code=Is1}}. %% Combining instructions. instrs([?PUSH_LIT(L),?GET_KEY|Is], St) -> instrs([?GET_LIT_KEY(L)|Is], St); instrs([?PUSH_LIT(L),?SET_KEY|Is], St) -> instrs([?SET_LIT_KEY(L)|Is], St); %% Must check these properly, probably seldom used anyway. %% instrs([?STORE_EVAR(D, I),?PUSH_EVAR(D, I)|Is], St) -> %% instrs([?DUP,?STORE_EVAR(D, I)|Is], St); %% instrs([?STORE_LVAR(D, I),?PUSH_LVAR(D, I)|Is], St) -> %% instrs([?DUP,?STORE_LVAR(D, I)|Is], St); %% instrs([?STORE_GVAR(K),?PUSH_GVAR(K)|Is], St) -> %% instrs([?DUP,?STORE_EVAR(D, I)|Is], St); instrs([?PUSH_LIT(L),?MULTIPLE|Is], St) -> instrs([?PUSH_LAST_LIT(L)|Is], St); instrs([?PUSH_LVAR(D, I),?MULTIPLE|Is], St) -> instrs([?PUSH_LAST_LVAR(D, I)|Is], St); instrs([?PUSH_EVAR(D, I),?MULTIPLE|Is], St) -> instrs([?PUSH_LAST_EVAR(D, I)|Is], St); instrs([?PUSH_GVAR(K),?MULTIPLE|Is], St) -> instrs([?PUSH_LAST_GVAR(K)|Is], St); instrs([?POP,?POP|Is], St) -> instrs([?POP2|Is], St); %% Doing sub instructions. instrs([?FDEF(Lsz,Esz,Pars,Fis0)|Is], St) -> Fis1 = instrs(Fis0, St), [?FDEF(Lsz,Esz,Pars,Fis1)|instrs(Is, St)]; instrs([?BLOCK(0,0,Bis)|Is], St) -> %No need for block instrs(Bis ++ Is, St); instrs([?BLOCK(Lsz,Esz,Bis0)|Is], St) -> Bis1 = instrs(Bis0, St), [?BLOCK(Lsz,Esz,Bis1)|instrs(Is, St)]; instrs([?REPEAT(Ris0)|Is], St) -> Ris1 = instrs(Ris0, St), [?REPEAT(Ris1)|instrs(Is, St)]; instrs([?WHILE(Eis0, Wis0)|Is], St) -> Eis1 = instrs(Eis0, St), Wis1 = instrs(Wis0, St), [?WHILE(Eis1, Wis1)|instrs(Is, St)]; instrs([?AND_THEN(Tis0)|Is], St) -> Tis1 = instrs(Tis0, St), [?AND_THEN(Tis1)|instrs(Is, St)]; instrs([?OR_ELSE(Fis0)|Is], St) -> Fis1 = instrs(Fis0, St), [?OR_ELSE(Fis1)|instrs(Is, St)]; instrs([?IF_TRUE(Tis0)|Is], St) -> Tis1 = instrs(Tis0, St), [?IF_TRUE(Tis1)|instrs(Is, St)]; instrs([?IF_FALSE(Fis0)|Is], St) -> Fis1 = instrs(Fis0, St), [?IF_FALSE(Fis1)|instrs(Is, St)]; instrs([?IF(Tis, [])|Is], St) -> instrs([?IF_TRUE(Tis)|Is], St); instrs([?IF([], Fis)|Is], St) -> %This should never happen instrs([?IF_FALSE(Fis)|Is], St); instrs([?IF(Tis0, Fis0)|Is], St) -> Tis1 = instrs(Tis0, St), Fis1 = instrs(Fis0, St), [?IF(Tis1, Fis1)|instrs(Is, St)]; instrs([?NFOR(V, Fis0)|Is], St) -> Fis1 = instrs(Fis0, St), [?NFOR(V, Fis1)|instrs(Is, St)]; instrs([?GFOR(Vs, Fis0)|Is], St) -> Fis1 = instrs(Fis0, St), [?GFOR(Vs, Fis1)|instrs(Is, St)]; %% Nothing to do. instrs([I|Is], St) -> [I|instrs(Is, St)]; instrs([], _) -> []. luerl-0.4/src/luerl_lib_string_format.erl0000644000232200023220000002215513450242205021252 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_lib_string_format.erl %% Author : Robert Virding %% Purpose : The string formatting for Luerl. -module(luerl_lib_string_format). -include("luerl.hrl"). -export([format/3]). format(F, As, St0) -> {Str,St1} = format_loop(luerl_lib:to_list(F), As, St0), {[iolist_to_binary(Str)],St1}. format_loop(Fmt, As, St) -> format_loop(Fmt, As, St, []). format_loop([$%|Fmt0], As0, St0, Acc) -> {Format,Fmt1} = collect(Fmt0), {Out,As1,St1} = build(Format, As0, St0), format_loop(Fmt1, As1, St1, [Out|Acc]); format_loop([$\\,C|Fmt], As, St, Acc) -> format_loop(Fmt, As, St, [C|Acc]); format_loop([C|Fmt], As, St, Acc) -> format_loop(Fmt, As, St, [C|Acc]); format_loop([], _, St, Acc) -> %Ignore extra arguments {lists:reverse(Acc),St}. %% collect(Format) -> {{C,Flags,Field,Precision},Format}. %% Collect a conversion specification. collect(Fmt0) -> {Fl,Fmt1} = flags(Fmt0), %The flags characters {F,Fmt2} = field_width(Fmt1), %The field width {P,Fmt3} = precision(Fmt2), %The precision {C,Fmt4} = collect_cc(Fmt3), %The control character {{C,Fl,F,P},Fmt4}. %% Handling the flags of a format. %% Yes, we should use a tuple or record, but this is much more fun. -define(FL_NONE, 0). -define(FL_H, 2#00001). -define(FL_Z, 2#00010). -define(FL_M, 2#00100). -define(FL_S, 2#01000). -define(FL_P, 2#10000). -define(SET_BIT(FL,B), (FL bor (B))). -define(ANY_BITS(Fl, B), ((Fl band (B)) =/= 0)). -define(ALL_BITS(Fl, B), ((Fl band (B)) =:= (B))). -define(NO_BITS(Fl, B), ((Fl band (B)) =:= 0)). flags(Fmt) -> flags(Fmt, ?FL_NONE). flags([$#|Fmt], Fl) -> flags(Fmt, ?SET_BIT(Fl, ?FL_H)); flags([$0|Fmt], Fl) -> flags(Fmt, ?SET_BIT(Fl, ?FL_Z)); flags([$-|Fmt], Fl) -> flags(Fmt, ?SET_BIT(Fl, ?FL_M)); flags([$\s|Fmt], Fl) -> flags(Fmt, ?SET_BIT(Fl, ?FL_S)); flags([$+|Fmt], Fl) -> flags(Fmt, ?SET_BIT(Fl, ?FL_P)); flags(Fmt, Fl) -> {Fl,Fmt}. field_width(Fmt) -> field_value(Fmt). precision([$.|Fmt]) -> field_value(Fmt); precision(Fmt) -> {none,Fmt}. collect_cc([C|Fmt]) -> {C,Fmt}; collect_cc([]) -> {none,[]}. field_value([C|_]=Fmt) when C >= $0, C =< $9 -> field_value(Fmt, 0); field_value(Fmt) -> {none,Fmt}. field_value([C|Fmt], F) when C >= $0, C =< $9 -> field_value(Fmt, 10*F + (C - $0)); field_value(Fmt, F) -> {F,Fmt}. %% build({C,Flags,Field,Precision}, Args) -> {Out,Args}. %% Build a string from the conversion specification. %% Implemented conversions are d,i o,u,x,X e,E f,F g,G c s %. %% No length modifiers, h L l, no conversions n p S C allowed. build({$q,_,_,_}, [A|As], St0) -> %% No triming or adjusting of the $q string, we only get all of %% it. Use an RE to split string on quote needing characters. {[S0],St1} = luerl_lib_basic:tostring([A], St0), RE = "([\\0-\\39\\\n\\\"\\\\\\177-\\237])", %You don't really want to know! Ss0 = re:split(S0, RE, [{return,binary},trim]), Ss1 = build_q(Ss0), {[$",Ss1,$"],As,St1}; build({$s,Fl,F,P}, [A|As], St0) -> {[S0],St1} = luerl_lib_basic:tostring([A], St0), S1 = trim_bin(S0, P), {adjust_bin(S1, Fl, F),As,St1}; build({$c,Fl,F,_}, [A|As], St) -> N = luerl_lib:tonumber(A), C = if is_number(N), N >= 0, N < 256 -> trunc(N); is_number(N) -> $? end, {adjust_str([C], Fl, F),As,St}; %% Integer formats. build({$i,Fl,F,P}, [A|As], St) -> I = luerl_lib:to_int(A), {format_decimal(Fl, F, P, I),As,St}; build({$d,Fl,F,P}, [A|As], St) -> I = luerl_lib:to_int(A), {format_decimal(Fl, F, P, I),As,St}; build({$o,Fl,F,P}, [A|As], St) -> I = luerl_lib:to_int(A), {format_octal(Fl, F, P, I),As,St}; build({$x,Fl,F,P}, [A|As], St) -> I = luerl_lib:to_int(A), {format_hex(Fl, F, P, I),As,St}; build({$X,Fl,F,P}, [A|As], St) -> I = luerl_lib:to_int(A), {format_HEX(Fl, F, P, I),As,St}; %% Float formats. build({$e,Fl,F,P}, [A|As], St) -> N = luerl_lib:tonumber(A), {e_float(Fl, F, P, N),As,St}; build({$E,Fl,F,P}, [A|As], St) -> N = luerl_lib:tonumber(A), {e_float(Fl, F, P, N),As,St}; build({$f,Fl,F,P}, [A|As], St) -> N = luerl_lib:tonumber(A), {f_float(Fl, F, P, N),As,St}; build({$F,Fl,F,P}, [A|As], St) -> N = luerl_lib:tonumber(A), {f_float(Fl, F, P, N),As,St}; build({$g,Fl,F,P}, [A|As], St) -> N = luerl_lib:tonumber(A), {g_float(Fl, F, P, N),As,St}; build({$G,Fl,F,P}, [A|As], St) -> N = luerl_lib:tonumber(A), {g_float(Fl, F, P, N),As,St}; %% Literal % format. build({$%,?FL_NONE,none,none}, As, St) -> %No flags, field or precision! {"%",As,St}. %% format_decimal(Flags, Field, Precision, Number) -> String. %% format_octal(Flags, Field, Precision, Number) -> String. %% format_hex(Flags, Field, Precision, Number) -> String. %% format_HEX(Flags, Field, Precision, Number) -> String. %% format_integer(Flags, Field, Precision, Number, String) -> String. %% Print integer Number with base Base. This is a bit messy as we are %% following string.format handling. format_decimal(Fl, F, P, N) -> Str = integer_to_list(abs(N), 10), format_integer(Fl, F, P, N, Str). format_octal(Fl, F, P, N) -> Str = integer_to_list(abs(N), 8), format_integer(Fl, F, P, N, Str). format_hex(Fl, F, P, N) -> Str = lists:flatten(io_lib:fwrite("~.16b", [N])), format_integer(Fl, F, P, N, Str). format_HEX(Fl, F, P, N) -> Str = lists:flatten(io_lib:fwrite("~.16B", [N])), format_integer(Fl, F, P, N, Str). format_integer(Fl, F, P, N, Str0) -> Sign = sign(Fl, N), if P =/= none -> Str1 = Sign ++ lists:flatten(adjust_str(Str0, ?FL_Z, P)), adjust_str(Str1, (Fl band ?FL_M), F); ?ANY_BITS(Fl, ?FL_M) -> Str1 = Sign ++ Str0, adjust_str(Str1, Fl, F); ?ANY_BITS(Fl, ?FL_Z), F =/= none -> Str1 = adjust_str(Str0, ?FL_Z, F-length(Sign)), Sign ++ Str1; true -> Str1 = Sign ++ Str0, adjust_str(Str1, Fl, F) end. %% e_float(Flags, Field, Precision, Number) -> String. %% f_float(Flags, Field, Precision, Number) -> String. %% g_float(Flags, Field, Precision, Number) -> String. %% Print float Number in e/f/g format. e_float(Fl, F, P, N) -> format_float(Fl, F, e_float_precision(P), "~.*e", N). f_float(Fl, F, P, N) -> format_float(Fl, F, f_float_precision(P), "~.*f", N). g_float(Fl, F, P, N) -> format_float(Fl, F, g_float_precision(P), "~.*g", N). format_float(Fl, F, P, Format, N) -> Str0 = lists:flatten(io_lib:format(Format, [P,abs(N)])), Sign = sign(Fl, N), if ?ANY_BITS(Fl, ?FL_M) -> Str1 = Sign ++ Str0, adjust_str(Str1, Fl, F); ?ANY_BITS(Fl, ?FL_Z) -> Str1 = adjust_str(Str0, ?FL_Z, F-length(Sign)), Sign ++ Str1; true -> Str1 = Sign ++ Str0, adjust_str(Str1, Fl, F) end. e_float_precision(none) -> 7; e_float_precision(P) -> P+1. f_float_precision(none) -> 6; f_float_precision(P) -> P. g_float_precision(none) -> 6; g_float_precision(P) -> P. %% sign(Flags, Number) -> SignString. sign(_, N) when N < 0 -> "-"; %Always sign when N<0 sign(Fl, _) -> if ?ALL_BITS(Fl, ?FL_P) -> "+"; %+ flag has priority ?ALL_BITS(Fl, ?FL_S) -> " "; true -> "" end. trim_bin(Bin, Prec) when is_integer(Prec), byte_size(Bin) > Prec -> binary:part(Bin, 0, Prec); trim_bin(Bin, _) -> Bin. %% adjust_bin(Binary, Flags, Field) -> iolist(). %% adjust_str(String, Flags, Field) -> iolist(). adjust_bin(Bin, ?FL_NONE, none) -> Bin; adjust_bin(Bin, Fl, F) when is_integer(F), byte_size(Bin) < F -> Size = byte_size(Bin), Padding = lists:duplicate(F-Size, pad_char(Fl, F)), if ?ALL_BITS(Fl, ?FL_M) -> [Bin,Padding]; true -> [Padding,Bin] end; adjust_bin(Bin, _, _) -> Bin. adjust_str(Str, ?FL_NONE, none) -> Str; adjust_str(Str, Fl, F) when is_integer(F), length(Str) < F -> Size = length(Str), Padding = lists:duplicate(F-Size, pad_char(Fl, F)), if ?ALL_BITS(Fl, ?FL_M) -> [Str,Padding]; true -> [Padding,Str] end; adjust_str(Str, _, _) -> Str. %% pad_char(Flags, Field) -> Char. pad_char(Fl, F) -> if ?ALL_BITS(Fl, ?FL_M) -> $\s; %'-' forces padding to " " ?ALL_BITS(Fl, ?FL_Z), F =/= none -> $0; true -> $\s end. build_q([<<>>|Ss]) -> build_q(Ss); build_q([<<$\n>>|Ss]) -> [$\\,$\n|build_q(Ss)]; build_q([<<$">>|Ss]) -> [$\\,$"|build_q(Ss)]; build_q([<<$\\>>|Ss]) -> [$\\,$\\|build_q(Ss)]; build_q([<>=B1|Ss0]) when C1 >=0, C1 =< 31 -> case Ss0 of [<>|_] when C2 >= $0, C2 =< $9 -> [io_lib:format("\\~.3.0w", [C1])|build_q(Ss0)]; [<<>>|Ss1] -> build_q([B1|Ss1]); _ -> [io_lib:format("\\~w", [C1])|build_q(Ss0)] end; build_q([<>|Ss0]) when B >= 127, B =< 159 -> [io_lib:write(B)|build_q(Ss0)]; build_q([S|Ss]) -> [S|build_q(Ss)]; build_q([]) -> []. luerl-0.4/src/luerl_lib_os.erl0000644000232200023220000000373313450242205017016 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_lib_os.erl %% Author : Robert Virding %% Purpose : The os library for Luerl. -module(luerl_lib_os). -include("luerl.hrl"). -export([install/1]). -import(luerl_lib, [lua_error/2,badarg_error/3]). %Shorten this install(St) -> luerl_emul:alloc_table(table(), St). table() -> [{<<"clock">>,#erl_func{code=fun clock/2}}, {<<"date">>,#erl_func{code=fun date/2}}, {<<"difftime">>,#erl_func{code=fun difftime/2}}, {<<"getenv">>,#erl_func{code=fun getenv/2}}, {<<"time">>,#erl_func{code=fun time/2}}]. getenv([<<>>|_], St) -> {[nil],St}; getenv([A|_], St) when is_binary(A) ; is_number(A) -> case os:getenv(luerl_lib:to_list(A)) of Env when is_list(Env) -> {[list_to_binary(Env)],St}; false -> {[nil],St} end; getenv(As, St) -> badarg_error(getenv, As, St). %% Time functions. clock(As, St) -> Type = case As of %Choose which we want [<<"runtime">>|_] -> runtime; _ -> wall_clock end, {Tot,_} = erlang:statistics(Type), %Milliseconds {[Tot*1.0e-3],St}. date(_, St) -> {{Ye,Mo,Da},{Ho,Mi,Sec}} = calendar:local_time(), Str = io_lib:fwrite("~w-~.2.0w-~.2.0w ~.2.0w:~.2.0w:~.2.0w", [Ye,Mo,Da,Ho,Mi,Sec]), {[iolist_to_binary(Str)],St}. difftime([A1,A2|_], St) -> {[A2-A1],St}. time(_, St) -> %Time since 1 Jan 1970 {Mega,Sec,Micro} = os:timestamp(), {[1.0e6*Mega+Sec+Micro*1.0e-6],St}. luerl-0.4/src/luerl_instrs.hrl0000644000232200023220000000470013450242205017067 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_instrs.hrl %% Author : Robert Virding %% Purpose : Internal LUA 5.2 instructions. %% Expression instructions. -define(PUSH_LIT(L), {push_lit,L}). -define(PUSH_LVAR(D,I), {push_lvar,D,I}). -define(PUSH_EVAR(D, I), {push_evar,D,I}). -define(PUSH_GVAR(K), {push_gvar,K}). -define(PUSH_LAST_LIT(L), {push_last_lit,L}). %[?PUSH_LIT,?MULTIPLE] -define(PUSH_LAST_LVAR(D,I), {push_last_lvar,D,I}). -define(PUSH_LAST_EVAR(D, I), {push_last_evar,D,I}). -define(PUSH_LAST_GVAR(K), {push_last_gvar,K}). -define(STORE_LVAR(D, I), {store_lvar,D,I}). -define(STORE_EVAR(D, I), {store_evar,D,I}). -define(STORE_GVAR(K), {store_gvar,K}). -define(GET_KEY, get_key). %Acc = Stk[Acc] -define(GET_LIT_KEY(K), {get_lit_key,K}). %[?PUSH_LIT(K),?GET_KEY] -define(SET_KEY, set_key). %Stk[ -define(SET_LIT_KEY(K), {set_lit_key,K}). %[?PUSH_LIT(K),?SET_KEY] -define(SINGLE, single). %Ensure single value -define(MULTIPLE, multiple). %Ensure multiple value -define(BUILD_TAB(Fc, I), {build_tab,Fc,I}). -define(FCALL(Ac), {fcall,Ac}). -define(TAIL_FCALL(Ac), {tail_fcall,Ac}). -define(MCALL(M, Ac), {mcall,M,Ac}). -define(TAIL_MCALL(M, Ac), {tail_mcall,M,Ac}). -define(OP(Op,Ac), {op,Op,Ac}). -define(FDEF(Lsz, Esz, Pars, Is), {fdef,Lsz,Esz,Pars,Is}). %% Control instructions. -define(BLOCK(Lsz, Esz, Is), {block,Lsz,Esz,Is}). -define(WHILE(E, B), {while,E,B}). -define(REPEAT(B), {repeat,B}). -define(AND_THEN(T), {and_then,T}). -define(OR_ELSE(T), {or_else,T}). -define(IF_TRUE(T), {if_true,T}). -define(IF_FALSE(T), {if_false,T}). -define(IF(T, F), {'if',T,F}). -define(NFOR(V, B), {nfor,V,B}). -define(GFOR(Vs, B), {gfor,Vs,B}). -define(BREAK, break). -define(RETURN(Ac), {return,Ac}). %% Stack instructions. -define(PUSH, push). -define(POP, pop). -define(POP2, pop2). -define(SWAP, swap). -define(DUP, dup). -define(PUSH_VALS(Vc), {push_vals,Vc}). -define(POP_VALS(Vc), {pop_vals,Vc}). luerl-0.4/src/luerl.hrl0000644000232200023220000001260413450242205015467 0ustar debalancedebalance%% Copyright (c) 2013-2018 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl.hrl %% Author : Robert Virding %% Purpose : The basic macros/records for Luerl. %% We include the whole environment in one structure even if fields %% come from logically different parts. This make it easier to pass %% around but does mean that there will be more explicit fiddleling to %% get it right. See block/2 and functioncall/4 for examples of this. -record(luerl, {ttab,tfree,tnext, %Table table, free, next ftab,ffree,fnext, %Frame table, free, next utab,ufree,unext, %Userdata table, free, next g, %Global table %% stk=[], %Current stack %% meta=[], %Data type metatables rand, %Random state tag %Unique tag }). -record(heap, {ttab,tfree,tnext, ftab,ffree,fnext, utab,ufree,unext}). %% -record(etab, {tabs=[],free=[],next=0}). %Tables structure %% -record(eenv, {env=[]}). %Environment %% -record(luerl, {tabs,env}). %Full state %% Metatables for atomic datatypes. -record(meta, {nil=nil, boolean=nil, number=nil, string=nil}). %% Data types. -record(tref, {i}). %Table reference, index -record(table, {a,d=[],m=nil}). %Table type, array, dict, meta -record(uref, {i}). %Userdata reference, index -record(userdata, {d,m=nil}). %Userdata type, data and meta -record(thread, {}). %Thread type %% There are two function types, the Lua one, and the Erlang one. -record(lua_func,{lsz, %Local var size esz, %Env var size env, %Environment pars, %Parameters b}). %Code block -record(erl_func,{code}). %Erlang code (fun) -record(fref, {i}). %Frame reference, index %% Test if it a function, of either sort. -define(IS_FUNCTION(F), (is_record(F, lua_func) orelse is_record(F, erl_func))). -define(IS_INTEGER(N), (float(round(N)) =:= N)). -define(IS_INTEGER(N,I), (float(I=round(N)) =:= N)). -define(IS_TRUE(X), (((X) =/= nil) and ((X) =/= false))). %% Different methods for storing tables in the global data #luerl{}. %% Access through macros to allow testing with different storage %% methods. This is inefficient with ETS tables where it would %% probably be better to use bags and acces with match/select. %% Set which table store to use. We check if we have full maps before %% we use them just to protect ourselves. -ifdef(HAS_FULL_KEYS). -define(TS_USE_MAPS, true). -else. -define(TS_USE_ARRAY, true). -endif. -ifdef(TS_USE_MAPS). -define(MAKE_TABLE(), maps:new()). -define(GET_TABLE(N, Ts), maps:get(N, Ts)). -define(SET_TABLE(N, T, Ts), maps:put(N, T, Ts)). -define(UPD_TABLE(N, Upd, Ts), maps:update_with(N, Upd, Ts)). -define(DEL_TABLE(N, Ts), maps:remove(N, Ts)). -define(FILTER_TABLES(Pred, Ts), maps:filter(Pred, Ts)). -define(FOLD_TABLES(Fun, Acc, Ts), maps:fold(Fun, Acc, Ts)). -endif. -ifdef(TS_USE_ORDDICT). %% Using orddict to handle tables. -define(MAKE_TABLE(), orddict:new()). -define(GET_TABLE(N, Ts), orddict:fetch(N, Ts)). -define(SET_TABLE(N, T, Ts), orddict:store(N, T, Ts)). -define(UPD_TABLE(N, Upd, Ts), orddict:update(N, Upd, Ts)). -define(DEL_TABLE(N, Ts), orddict:erase(N, Ts)). -define(FILTER_TABLES(Pred, Ts), orddict:filter(Pred, Ts)). -define(FOLD_TABLES(Fun, Acc, Ts), orddict:fold(Fun, Acc, Ts)). -endif. -ifdef(TS_USE_ARRAY). %% Use arrays to handle tables. -define(MAKE_TABLE(), array:new()). -define(GET_TABLE(N, Ar), array:get(N, Ar)). -define(SET_TABLE(N, T, Ar), array:set(N, T, Ar)). -define(UPD_TABLE(N, Upd, Ar), array:set(N, (Upd)(array:get(N, Ar)), Ar)). -define(DEL_TABLE(N, Ar), array:reset(N, Ar)). -define(FILTER_TABLES(Pred, Ar), ((fun (___Def) -> ___Fil = fun (___K, ___V) -> case Pred(___K, ___V) of true -> ___V; false -> ___Def end end, array:sparse_map(___Fil, Ar) end)(array:default(Ar)))). -define(FOLD_TABLES(Fun, Acc, Ar), array:sparse_foldl(Fun, Acc, Ar)). -endif. -ifdef(TS_USE_PD). %% Use the process dictionary to handle tables. -define(MAKE_TABLE(), ok). -define(GET_TABLE(N, Pd), get(N)). -define(SET_TABLE(N, T, Pd), put(N, T)). -define(UPD_TABLE(N, Upd, Pd), put(N, (Upd)(get(N)))). -define(DEL_TABLE(N, Pd), erase(N)). -define(FILTER_TABLES(Pred, Pd), Pd). %This needs work -define(FOLD_TABLES(Fun, Acc, Pd), Pd). %This needs work -endif. -ifdef(TS_USE_ETS). %% Use ETS to handle tables. Must get return values right! -define(MAKE_TABLE(),ets:new(luerl_tables, [set])). -define(GET_TABLE(N, E), ets:lookup_element(E, N, 2)). -define(SET_TABLE(N, T, E), begin ets:insert(E, {N,T}), E end). -define(UPD_TABLE(N, Upd, E), begin ets:update_element(E, N, {2,(Upd)(ets:lookup_element(E, N, 2))}), E end). -define(DEL_TABLE(N, E), begin ets:delete(E, N), E end). -define(FILTER_TABLES(Pred, E), E). %This needs work -define(FOLD_TABLES(Fun, Acc, E), ets:foldl(fun ({___K, ___T}, ___Acc) -> Fun(___K, ___T, ___Acc) end, Acc, E)). -endif. luerl-0.4/src/luerl.erl0000644000232200023220000002563213450242205015471 0ustar debalancedebalance%% Copyright (c) 2013-2018 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl.erl %% Authors : Robert Virding, Henning Diedrich %% Purpose : Basic LUA 5.2 interface. -module(luerl). -include("luerl.hrl"). -export([eval/1,eval/2,evalfile/1,evalfile/2, do/1,do/2,dofile/1,dofile/2, load/1,load/2,loadfile/1,loadfile/2,path_loadfile/2,path_loadfile/3, load_module/3,load_module1/3, call/2,call/3,call_chunk/2,call_chunk/3, call_function/2,call_function/3,call_function1/3,function_list/2, get_table/2,get_table1/2,set_table/3,set_table1/3,set_table1/4, call_method/2,call_method/3,call_method1/3,method_list/2, init/0,stop/1,gc/1, encode/2,encode_list/2,decode/2,decode_list/2]). %% luerl:eval(String|Binary|Form[, State]) -> Result. eval(Chunk) -> eval(Chunk, init()). eval(Chunk, St0) -> try do(Chunk, St0) of {Ret,St1} -> {ok, decode_list(Ret, St1)} catch _E:R -> {error, R} % {error, {E, R}} ? <- todo: decide end. %% luerl:evalfile(Path[, State]) -> {ok, Result} | {error,Reason}. evalfile(Path) -> evalfile(Path, init()). evalfile(Path, St0) -> try dofile(Path, St0) of {Ret,St1} -> {ok, decode_list(Ret, St1)} catch _E:R -> {error, R} % {error, {E, R}} ? <- todo: decide end. %% luerl:do(String|Binary|Form[, State]) -> {Result, NewState} do(SBC) -> do(SBC, init()). do(S, St0) when is_binary(S); is_list(S) -> {ok,Func,St1} = load(S, St0), luerl_emul:call(Func, St1); do(Func, St) -> luerl_emul:call(Func, St). %% luerl:dofile(Path[, State]) -> {Result, NewState}. dofile(Path) -> dofile(Path, init()). dofile(Path, St0) -> {ok,Func,St1} = loadfile(Path, St0), luerl_emul:call(Func, St1). %% load(String|Binary) -> {ok,Function,NewState}. load(Str) -> load(Str, init()). load(Bin, St) when is_binary(Bin) -> load(binary_to_list(Bin), St); load(Str, St0) when is_list(Str) -> case luerl_comp:string(Str) of {ok,Chunk} -> {Func,St1} = luerl_emul:load_chunk(Chunk, St0), {ok,Func,St1}; {error,_,_}=E -> E end. %% loadfile(FileName) -> {ok,Function,NewState}. %% loadfile(FileName, State) -> {ok,Function,NewState}. loadfile(Name) -> loadfile(Name, init()). loadfile(Name, St0) -> case luerl_comp:file(Name) of {ok,Chunk} -> {Func,St1} = luerl_emul:load_chunk(Chunk, St0), {ok,Func,St1}; {error,_,_}=E -> E end. %% path_loadfile(FileName, State) -> {ok,Function,FullName,State}. %% path_loadfile(Path, FileName, State) -> {ok,Function,FullName,State}. %% We manually step down the path to get the correct handling of %% filenames by the compiler. path_loadfile(Name, St) -> Path = case os:getenv("LUA_LOAD_PATH") of false -> []; %You get what you asked for Env -> %% Get path separator depending on os type. Sep = case os:type() of {win32,_} -> ";"; _ -> ":" %Unix end, string:tokens(Env, Sep) %Split into path list end, path_loadfile(Path, Name, St). path_loadfile([Dir|Dirs], Name, St0) -> Full = filename:join(Dir, Name), case loadfile(Full, St0) of {ok,Func,St1} -> {ok,Func,Full,St1}; {error,[{_,_,enoent}],_} -> %Couldn't find the file path_loadfile(Dirs, Name, St0); Error -> Error end; path_loadfile([], _, _) -> {error,[{none,file,enoent}],[]}. %% load_module(TablePath, ModuleName, State) -> State. %% load_module1(LuaTablePath, ModuleName, State) -> State. %% Load module and add module table to the path. load_module(Fp, Mod, St0) when is_list(Fp) -> {Lfp,St1} = encode_list(Fp, St0), load_module1(Lfp, Mod, St1); load_module(_, _,_) -> error(badarg). load_module1(Lfp, Mod, St0) -> {Tab,St1} = Mod:install(St0), luerl_emul:set_table_keys(Lfp, Tab, St1). %% init() -> State. init() -> luerl_emul:init(). %% call(Chunk, Args, State) -> {Result,State} call(C, As) -> call_chunk(C, As). call(C, As, St) -> call_chunk(C, As, St). call_chunk(C, As) -> call_chunk(C, As, init()). call_chunk(C, As, St0) -> {Las,St1} = encode_list(As, St0), {Lrs,St2} = luerl_emul:call(C, Las, St1), Rs = decode_list(Lrs, St2), {Rs,St2}. %% call_function(Table, Args) -> {Result,State}. %% call_function(TablePath, Args, State) -> {Result,State}. %% call_function1(LuaTablePath | Func, LuaArgs, State) -> {LuaResult,State}. call_function(Fp, As) -> call_function(Fp, As, init()). call_function(Fp, As, St0) -> %% Encode the input arguments. {Lfp,St1} = encode_list(Fp, St0), {Las,St2} = encode_list(As, St1), %% Find the function definition and call function. {Lrs,St3} = call_function1(Lfp, Las, St2), Rs = decode_list(Lrs, St3), {Rs,St3}. call_function1(Lfp, Las, St0) when is_list(Lfp) -> {F,St1} = luerl_emul:get_table_keys(Lfp, St0), luerl_emul:functioncall(F, Las, St1); call_function1(F, Las, St) -> luerl_emul:functioncall(F, Las, St). %% function_list(Keys, State) -> {V,State}. %% Go down a list of keys and return final value. function_list(Ks, St) -> luerl_emul:get_table_keys(Ks, St). %% call_method(FuncPath, Args) -> {Result,State}. %% call_method(FuncPath, Args, State) -> {Result,State}. %% call_method1(FuncPath | FuncPath, Args, State) -> {Result,State}. call_method(Fp, As) -> call_method(Fp, As, init()). call_method(Fp, As, St0) -> %% Encode the input arguments. {Lfp,St1} = encode_list(Fp, St0), {Las,St2} = encode_list(As, St1), %% Find the object and method definition and call method. {O,M,St3} = method_list(Lfp, St2), {Lrs,St4} = luerl_emul:functioncall(M, [O|Las], St3), Rs = decode_list(Lrs, St4), {Rs,St4}. call_method1(Fp, Las, St0) -> %% Find the object and method definition and call method. {O,M,St1} = method_list(Fp, St0), luerl_emul:functioncall(M, [O|Las], St1). method_list([G|Ks], St0) -> {First,St1} = luerl_emul:get_global_key(G, St0), method_list(First, Ks, St1). method_list(Tab, [K], St0) -> {Func,St1} = luerl_emul:get_table_key(Tab, K, St0), {Tab,Func,St1}; method_list(Tab, [K|Ks], St0) -> {Next,St1} = luerl_emul:get_table_key(Tab, K, St0), method_list(Next, Ks, St1); method_list(_, _, _) -> error(badarg). %% get_table(TablePath, State) -> {Result, State}. %% Go down a list of keys and return decoded final value. get_table(Fp, St0) when is_list(Fp) -> {Lfp,St1} = encode_list(Fp, St0), {V,St2} = luerl_emul:get_table_keys(Lfp, St1), Vd = decode(V, St2), {Vd,St2}; get_table(_,_) -> error(badarg). %% get_table1(LuaTablePath, State) -> {LuaResult, State}. get_table1(Fp, St) when is_list(Fp) -> luerl_emul:get_table_keys(Fp, St); get_table1(_,_) -> error(badarg). %% set_table(TablePath, Value, State) -> State. %% Go down a list of keys and set final key to Value. set_table(Fp, V, St0) when is_list(Fp) -> {Lfp,St1} = encode_list(Fp, St0), {Lv, St2} = encode(V, St1), set_table1(Lfp, Lv, St2); set_table(_,_,_) -> error(badarg). %% set_table1(LuaTablePath, Value, State) -> State. %% Must explicitly read table key to get set_table1(Lfp, Lv, St) -> luerl_emul:set_table_keys(Lfp, Lv, St). %% set_table1(Table, Key, Value, State) -> State. %% Must explicitly read table key to get set_table1(Tab, Key, Lv, St) -> luerl_emul:set_table_key(Tab, Key, Lv, St). %% stop(State) -> GCedState. stop(St) -> luerl_emul:gc(St). %% gc(State) -> State. gc(St) -> luerl_emul:gc(St). %% Define IS_MAP/1 macro for is_map/1 bif. -ifdef(HAS_MAPS). -define(IS_MAP(T), is_map(T)). -else. -define(IS_MAP(T), false). -endif. %% encode_list([Term], State) -> {[LuerlTerm],State}. %% encode(Term, State) -> {LuerlTerm,State}. encode_list(Ts, St) -> lists:mapfoldl(fun encode/2, St, Ts). encode(nil, St) -> {nil,St}; encode(false, St) -> {false,St}; encode(true, St) -> {true,St}; encode(B, St) when is_binary(B) -> {B,St}; encode(A, St) when is_atom(A) -> {atom_to_binary(A, latin1),St}; encode(I, St) when is_integer(I) -> {float(I),St}; encode(F, St) when is_float(F) -> {F,St}; encode(F, St) when ?IS_MAP(F) -> encode(maps:to_list(F), St); encode(L, St0) when is_list(L) -> {Es,{_,St1}} = lists:mapfoldl(fun ({K0,V0}, {I,S0}) -> {K1,S1} = encode(K0, S0), {V1,S2} = encode(V0, S1), {{K1,V1},{I,S2}}; (V0, {I,S0}) -> {V1,S1} = encode(V0, S0), {{I,V1},{I+1,S1}} end, {1.0,St0}, L), {T,St2} = luerl_emul:alloc_table(Es, St1), {T,St2}; %No more to do for now encode(F, St) when is_function(F, 2) -> F1 = fun(Args, State) -> Args1 = decode_list(Args, State), {Res, State1} = F(Args1, State), encode_list(Res, State1) end, {#erl_func{code=F1}, St}; encode(F, St) when is_function(F, 1) -> F1 = fun(Args, State) -> Args1 = decode_list(Args, State), Res = F(Args1), encode_list(Res, State) end, {#erl_func{code=F1}, St}; encode({userdata,Data}, St) -> luerl_emul:alloc_userdata(Data, St); encode(_, _) -> error(badarg). %Can't encode anything else %% decode_list([LuerlTerm], State) -> [Term]. %% decode(LuerlTerm, State) -> Term. %% In decode we track of which tables we have seen to detect %% recursive references and generate an error when that occurs. decode_list(Lts, St) -> lists:map(fun (Lt) -> decode(Lt, St) end, Lts). decode(LT, St) -> %% Catch errors to clean up call stack. try decode(LT, St, []) catch error:E -> erlang:raise(error, E, [{?MODULE,decode,2}]) end. decode(nil, _, _) -> nil; decode(false, _, _) -> false; decode(true, _, _) -> true; decode(B, _, _) when is_binary(B) -> B; decode(N, _, _) when is_number(N) -> N; decode(#tref{i=N}, St, In) -> decode_table(N, St, In); decode(#uref{i=N}, St, _) -> decode_userdata(N, St); decode(#erl_func{code=Fun}, _, _) -> Fun; decode(#lua_func{}=Fun, State, _) -> F = fun(Args) -> {Args1, State1} = encode_list(Args, State), {Ret, State2} = luerl_emul:functioncall(Fun, Args1, State1), decode_list(Ret, State2) end, F; %Just a bare fun decode(_, _, _) -> error(badarg). %Shouldn't have anything else decode_table(N, St, In0) -> case lists:member(N, In0) of true -> error(recursive_data); %Been here before false -> In1 = [N|In0], %We are in this as well case ?GET_TABLE(N, St#luerl.ttab) of #table{a=Arr,d=Dict} -> Fun = fun (K, V, Acc) -> [{decode(K, St, In1),decode(V, St, In1)}|Acc] end, Ts = ttdict:fold(Fun, [], Dict), array:sparse_foldr(Fun, Ts, Arr); _Undefined -> error(badarg) end end. decode_userdata(N, St) -> #userdata{d=Data} = ?GET_TABLE(N, St#luerl.utab), {userdata,Data}. luerl-0.4/src/luerl_emul.erl0000644000232200023220000014347013450242205016514 0ustar debalancedebalance%% Copyright (c) 2013-2018 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_emul.erl %% Author : Robert Virding %% Purpose : A very basic LUA 5.2 machine emulator. %% First version of emulator. Compiler so far only explicitly handles %% local/global variables. %% %% We explicitly mirror the parser rules which generate the AST and do %% not try to fold similar structures into common code. While this %% means we get more code it also becomes more explicit and clear what %% we are doing. It may also allow for specific optimisations. And %% example is that we DON'T fold 'var' and 'funcname' even though they %% are almost the same. %% %% Issues: how should we handle '...'? Now we treat it as any (local) %% variable. -module(luerl_emul). -include("luerl.hrl"). -include("luerl_comp.hrl"). -include("luerl_instrs.hrl"). %% Basic interface. -export([init/0,gc/1]). -export([call/2,call/3,emul/2]). -export([load_chunk/2,load_chunk/3,load_function/2,load_function/3]). %% Internal functions which can be useful "outside". -export([alloc_table/1,alloc_table/2,free_table/2, functioncall/3,methodcall/4, get_table_keys/2,get_table_keys/3, set_table_keys/3,set_table_keys/4, get_table_key/3,set_table_key/4, alloc_userdata/2,alloc_userdata/3,get_userdata/2,set_userdata/3, getmetatable/2, getmetamethod/3,getmetamethod/4]). %% Currently unused internal functions, to suppress warnings. -export([set_global_name/3,set_global_key/3, get_global_name/2,get_global_key/2]). %% For testing. -export([pop_vals/2,push_vals/3]). -import(luerl_lib, [lua_error/2,badarg_error/3]). %% -compile(inline). %For when we are optimising %% -compile({inline,[boolean_value/1,first_value/1]}). %% -define(ITRACE_DO(Expr), ok). -define(ITRACE_DO(Expr), (get(itrace) /= undefined) andalso Expr). %% init() -> State. %% Initialise the basic state. init() -> %% Initialise the general stuff. St0 = #luerl{meta=#meta{},tag=make_ref()}, %% Initialise the table handling. St1 = St0#luerl{ttab=?MAKE_TABLE(),tfree=[],tnext=0}, %% Initialise the frame handling. St2 = St1#luerl{ftab=array:new(),ffree=[],fnext=0}, %% Initialise the userdata handling. St3 = St2#luerl{utab=?MAKE_TABLE(),ufree=[],unext=0}, %% Allocate the _G table and initialise the environment {_G,St4} = luerl_lib_basic:install(St3), %Global environment St5 = St4#luerl{g=_G}, %% Now we can start adding libraries. Package MUST be first! St6 = load_lib(<<"package">>, luerl_lib_package, St5), %% Add the other standard libraries. St7 = load_libs([ {<<"bit32">>,luerl_lib_bit32}, {<<"io">>,luerl_lib_io}, {<<"math">>,luerl_lib_math}, {<<"os">>,luerl_lib_os}, {<<"string">>,luerl_lib_string}, {<<"table">>,luerl_lib_table}, {<<"debug">>,luerl_lib_debug} ], St6), %% Set _G variable to point to it and add it packages.loaded. St8 = set_global_key(<<"_G">>, _G, St7), set_table_keys([<<"package">>,<<"loaded">>,<<"_G">>], _G, St8). load_libs(Libs, St) -> Fun = fun ({Key,Mod}, S) -> load_lib(Key, Mod, S) end, lists:foldl(Fun, St, Libs). %% load_lib(Key, Module, State) -> State. load_lib(Key, Mod, St0) -> {Tab,St1} = Mod:install(St0), %% Add key to global and to package.loaded. St2 = set_global_key(Key, Tab, St1), set_table_keys([<<"package">>,<<"loaded">>,Key], Tab, St2). %% set_global_name(Name, Value, State) -> State. %% set_global_key(Key, Value, State) -> State. %% get_global_name(Name, State) -> {[Val],State}. %% get_global_key(Key, State) -> {[Val],State}. %% Access elements in the global name table, _G. set_global_name(Name, Val, St) -> set_global_key(atom_to_binary(Name, latin1), Val, St). set_global_key(Key, Val, #luerl{g=G}=St) -> set_table_key(G, Key, Val, St). get_global_name(Name, St) -> get_global_key(atom_to_binary(Name, latin1), St). get_global_key(Key, #luerl{g=G}=St) -> get_table_key(G, Key, St). %% alloc_frame(Frame, State) -> {Fref,State}. %% Allocate the frame in the frame table and return its fref. alloc_frame(Fr, #luerl{ftab=Ft0,ffree=[N|Ns]}=St) -> Ft1 = array:set(N, Fr, Ft0), {#fref{i=N},St#luerl{ftab=Ft1,ffree=Ns}}; alloc_frame(Fr, #luerl{ftab=Ft0,ffree=[],fnext=N}=St) -> Ft1 = array:set(N, Fr, Ft0), {#fref{i=N},St#luerl{ftab=Ft1,fnext=N+1}}. %% alloc_table(State) -> {Tref,State}. %% alloc_table(InitialTable, State) -> {Tref,State}. %% free_table(Tref, State) -> State. %% The InitialTable is [{Key,Value}], there is no longer any need to %% have it as an orddict. alloc_table(St) -> alloc_table([], St). alloc_table(Itab, #luerl{ttab=Ts0,tfree=[N|Ns]}=St) -> T = init_table(Itab), %% io:fwrite("it1: ~p\n", [{N,T}]), Ts1 = ?SET_TABLE(N, T, Ts0), {#tref{i=N},St#luerl{ttab=Ts1,tfree=Ns}}; alloc_table(Itab, #luerl{ttab=Ts0,tfree=[],tnext=N}=St) -> T = init_table(Itab), %% io:fwrite("it2: ~p\n", [{N,T}]), Ts1 = ?SET_TABLE(N, T, Ts0), {#tref{i=N},St#luerl{ttab=Ts1,tnext=N+1}}. init_table(Itab) -> D0 = ttdict:new(), A0 = array:new([{default,nil}]), %Arrays with 'nil' as default Init = fun ({_,nil}, {D,A}) -> {D,A}; %Ignore nil values ({K,V}, {D,A}) when is_number(K) -> case ?IS_INTEGER(K, I) of true when I >= 1 -> {D,array:set(I, V, A)}; _NegFalse -> {ttdict:store(K, V, D),A} end; ({K,V}, {D,A}) -> {ttdict:store(K, V, D),A} end, {D1,A1} = lists:foldl(Init, {D0,A0}, Itab), #table{a=A1,d=D1,m=nil}. free_table(#tref{i=N}, #luerl{ttab=Ts0,tfree=Ns}=St) -> %% io:fwrite("ft: ~p\n", [{N,?GET_TABLE(N, Ts0)}]), Ts1 = ?DEL_TABLE(N, Ts0), St#luerl{ttab=Ts1,tfree=[N|Ns]}. %% get_table_keys(Keys, State) -> {Value,State}. %% get_table_keys(Tab, Keys, State) -> {Value,State}. %% Search down tables which stops when no more tables. get_table_keys(Keys, St) -> get_table_keys(St#luerl.g, Keys, St). get_table_keys(Tab, [K|Ks], St0) -> {Val,St1} = luerl_emul:get_table_key(Tab, K, St0), get_table_keys(Val, Ks, St1); get_table_keys(Val, [], St) -> {Val,St}. %% set_table_keys(Keys, Val, State) -> State. %% set_table_keys(Tab, Keys, Val, State) -> State. %% Setter down tables. set_table_keys(Keys, Val, St) -> set_table_keys(St#luerl.g, Keys, Val, St). set_table_keys(Tab, [K], Val, St) -> luerl_emul:set_table_key(Tab, K, Val, St); set_table_keys(Tab0, [K|Ks], Val, St0) -> {Tab1,St1} = luerl_emul:get_table_key(Tab0, K, St0), set_table_keys(Tab1, Ks, Val, St1). %% set_table_key(Tref, Key, Value, State) -> State. %% get_table_key(Tref, Key, State) -> {Val,State}. %% Access tables, as opposed to the environment (which are also %% tables). Setting a value to 'nil' will clear it from the array but %% not from the table; however, we won't add a nil value. %% NOTE: WE ALWAYS RETURN A SINGLE VALUE! set_table_key(#tref{}=Tref, Key, Val, St) when is_number(Key) -> case ?IS_INTEGER(Key, I) of true when I >= 1 -> set_table_int_key(Tref, Key, I, Val, St); _NegFalse -> set_table_key_key(Tref, Key, Val, St) end; set_table_key(Tab, nil=Key, _, St) -> lua_error({illegal_index,Tab,Key}, St); set_table_key(#tref{}=Tref, Key, Val, St) -> set_table_key_key(Tref, Key, Val, St); set_table_key(Tab, Key, _, St) -> lua_error({illegal_index,Tab,Key}, St). set_table_key_key(#tref{i=N}=Tab, Key, Val, #luerl{ttab=Ts0}=St) -> #table{d=Dict0,m=Meta}=T = ?GET_TABLE(N, Ts0), %Get the table case ttdict:find(Key, Dict0) of {ok,_} -> %Key exists Dict1 = if Val =:= nil -> ttdict:erase(Key, Dict0); true -> ttdict:store(Key, Val, Dict0) end, Ts1 = ?SET_TABLE(N, T#table{d=Dict1}, Ts0), St#luerl{ttab=Ts1}; error -> %Key does not exist case getmetamethod_tab(Meta, <<"__newindex">>, Ts0) of nil -> %% Only add non-nil value. Dict1 = if Val =:= nil -> Dict0; true -> ttdict:store(Key, Val, Dict0) end, Ts1 = ?SET_TABLE(N, T#table{d=Dict1}, Ts0), St#luerl{ttab=Ts1}; Meth when ?IS_FUNCTION(Meth) -> {_Ret, St1} = functioncall(Meth, [Tab,Key,Val], St), St1; Meth -> set_table_key(Meth, Key, Val, St) end end. set_table_int_key(#tref{i=N}=Tab, Key, I, Val, #luerl{ttab=Ts0}=St) -> #table{a=Arr0,m=Meta}=T = ?GET_TABLE(N, Ts0), %Get the table case array:get(I, Arr0) of nil -> %Key does not exist case getmetamethod_tab(Meta, <<"__newindex">>, Ts0) of nil -> %% Only add non-nil value, slightly faster (?) Arr1 = if Val =:= nil -> Arr0; true -> array:set(I, Val, Arr0) end, Ts1 = ?SET_TABLE(N, T#table{a=Arr1}, Ts0), St#luerl{ttab=Ts1}; Meth when ?IS_FUNCTION(Meth) -> {_Ret, St1} = functioncall(Meth, [Tab,Key,Val], St), St1; Meth -> set_table_key(Meth, Key, Val, St) end; _ -> %Key exists %% Can do this as 'nil' is default value of array. Arr1 = array:set(I, Val, Arr0), Ts1 = ?SET_TABLE(N, T#table{a=Arr1}, Ts0), St#luerl{ttab=Ts1} end. get_table_key(#tref{}=Tref, Key, St) when is_number(Key) -> case ?IS_INTEGER(Key, I) of true when I >= 1 -> get_table_int_key(Tref, Key, I, St); _NegFalse -> get_table_key_key(Tref, Key, St) end; get_table_key(#tref{}=Tref, Key, St) -> get_table_key_key(Tref, Key, St); get_table_key(Tab, Key, St) -> %Just find the metamethod case getmetamethod(Tab, <<"__index">>, St) of nil -> lua_error({illegal_index,Tab,Key}, St); Meth when ?IS_FUNCTION(Meth) -> {Vs,St1} = functioncall(Meth, [Tab,Key], St), {first_value(Vs),St1}; Meth -> %Recurse down the metatable get_table_key(Meth, Key, St) end. get_table_key_key(#tref{i=N}=T, Key, #luerl{ttab=Ts}=St) -> #table{d=Dict,m=Meta} = ?GET_TABLE(N, Ts), %Get the table. case ttdict:find(Key, Dict) of {ok,Val} -> {Val,St}; error -> %% Key not present so try metamethod get_table_metamethod(T, Meta, Key, Ts, St) end. get_table_int_key(#tref{i=N}=T, Key, I, #luerl{ttab=Ts}=St) -> #table{a=A,m=Meta} = ?GET_TABLE(N, Ts), %Get the table. case array:get(I, A) of nil -> %% Key not present so try metamethod get_table_metamethod(T, Meta, Key, Ts, St); Val -> {Val,St} end. get_table_metamethod(T, Meta, Key, Ts, St) -> case getmetamethod_tab(Meta, <<"__index">>, Ts) of nil -> {nil,St}; Meth when ?IS_FUNCTION(Meth) -> {Vs,St1} = functioncall(Meth, [T,Key], St), {first_value(Vs),St1}; Meth -> %Recurse down the metatable get_table_key(Meth, Key, St) end. %% alloc_userdata(Data, State) -> {Uref,State}. %% alloc_userdata(Data, Meta, State) -> {Uref,State}. %% set_userdata(Uref, UserData, State) -> State. %% get_userdata(Uref, State) -> {UserData,State}. alloc_userdata(Data, St) -> alloc_userdata(Data, nil, St). alloc_userdata(Data, Meta, #luerl{utab=Us0,ufree=[N|Ns]}=St) -> Us1 = ?SET_TABLE(N, #userdata{d=Data,m=Meta}, Us0), {#uref{i=N},St#luerl{utab=Us1,ufree=Ns}}; alloc_userdata(Data, Meta, #luerl{utab=Us0,ufree=[],unext=N}=St) -> Us1 = ?SET_TABLE(N, #userdata{d=Data,m=Meta}, Us0), {#uref{i=N},St#luerl{utab=Us1,unext=N+1}}. set_userdata(#uref{i=N}, #userdata{}=Udata, #luerl{utab=Us0}=St) -> Us1 = ?SET_TABLE(N, Udata, Us0), St#luerl{utab=Us1}. get_userdata(#uref{i=N}, #luerl{utab=Us}=St) -> #userdata{} = Udata = ?GET_TABLE(N, Us), {Udata,St}. %% make_userdata(Data) -> make_userdata(Data, nil). %% make_userdata(Data, Meta) -> #userdata{d=Data,m=Meta}. %% set_local_var(Depth, Index, Var, Frames) -> Frames. %% get_local_var(Depth, Index, Frames) -> Val. set_local_var(1, I, V, [F|Fs]) -> [setelement(I, F, V)|Fs]; set_local_var(D, I, V, [F|Fs]) -> [F|set_local_var(D-1, I, V, Fs)]. get_local_var(1, I, [F|_]) -> element(I, F); get_local_var(D, I, [_|Fs]) -> get_local_var(D-1, I, Fs). %% set_env_var(Depth, Index, Val, Env, State) -> State. %% get_env_var(Depth, Index, Env, State) -> Val. %% We must have the state as the environments are global in the %% state. set_env_var(D, I, Val, Env, #luerl{ftab=Ft0}=St) -> Ft1 = set_env_var_1(D, I, Val, Env, Ft0), St#luerl{ftab=Ft1}. set_env_var_1(1, I, V, [#fref{i=N}|_], Ft) -> F = setelement(I, array:get(N, Ft), V), array:set(N, F, Ft); set_env_var_1(2, I, V, [_,#fref{i=N}|_], Ft) -> F = setelement(I, array:get(N, Ft), V), array:set(N, F, Ft); set_env_var_1(D, I, V, Fps, Ft) -> #fref{i=N} = lists:nth(D, Fps), F = setelement(I, array:get(N, Ft), V), array:set(N, F, Ft). get_env_var(D, I, Env, #luerl{ftab=Ft}) -> get_env_var_1(D, I, Env, Ft). get_env_var_1(1, I, [#fref{i=N}|_], Ft) -> element(I, array:get(N, Ft)); get_env_var_1(2, I, [_,#fref{i=N}|_], Ft) -> element(I, array:get(N, Ft)); get_env_var_1(D, I, Fps, Ft) -> #fref{i=N} = lists:nth(D, Fps), element(I, array:get(N, Ft)). %% set_global_var(Var, Val, State) -> State. %% get_global_var(Var, State) -> {Val,State}. %% _G a normal table with metatable so we must use the table %% functions. However we can optimise a bit as we KNOW that _G is a %% table and the var is always a normal non-integer key. set_global_var(Var, Val, #luerl{g=G}=St) -> set_table_key_key(G, Var, Val, St). get_global_var(Var, #luerl{g=G}=St) -> get_table_key_key(G, Var, St). %% load_chunk(FunctionDefCode, State) -> {Function,State}. %% load_chunk(FunctionDefCode, Env, State) -> {Function,State}. %% Load a chunk from the compiler. load_chunk(Code, St) -> load_chunk(Code, [], St). load_chunk(#code{code=Code}, Env, St) -> load_function(Code, Env, St). %% load_function(FunctionDefCode, State) -> {Function,State}. %% load_function(FunctionDefCode, Env, State) -> {Function,State}. %% Load a compilefunction definition instructions returning a callable %% function. Currently it does nothing with the state. load_function(F, St) -> load_function(F, [], St). load_function([?FDEF(Lsz, Esz, Pars, Is)], Env, St) -> do_fdef(Lsz, Esz, Pars, Is, Env, St). %% call(Function, State) -> {Return,State}. %% call(Function, Args, State) -> {Return,State}. call(Func, St) -> call(Func, [], St). call(#lua_func{}=Func, Args, St0) -> %Already defined {Ret,St1} = functioncall(Func, Args, St0), %% Should do GC here. {Ret,St1}; call(#erl_func{}=Func, Args, St0) -> %Internal erlang function {Ret,St1} = functioncall(Func, Args, St0), %% Should do GC here. {Ret,St1}. itrace_print(Format, Args) -> ?ITRACE_DO(io:fwrite(Format, Args)). %% exp(_, _) -> %% error(boom). -record(call_frame, {lvs,env}). %Save these for the GC %% emul(Instrs, State). %% emul(Instrs, LocalVariables, Stack, Env, State). emul(Is, St) -> emul(Is, {}, [], [], St). emul([I|_]=Is, Lvs, Stk, Env, St) -> ?ITRACE_DO(begin io:fwrite("~p\n", [{Lvs,Env}]), stack_print(Stk), io:fwrite("-> ~p\n", [I]) end), emul_1(Is, Lvs, Stk, Env, St); emul([], Lvs, Stk, Env, St) -> ?ITRACE_DO(begin io:fwrite("~p\n", [{Lvs,Env}]), stack_print(Stk), io:fwrite("-> []\n") end), emul_1([], Lvs, Stk, Env, St). stack_print([#call_frame{}|_]) -> io:fwrite(" ...\n"); stack_print([E|St]) -> io:fwrite(" ~p", [E]), stack_print(St); stack_print([]) -> io:nl(). %% Expression instructions. emul_1([?PUSH_LIT(L)|Is], Lvs, Stk, Env, St) -> emul(Is, Lvs, [L|Stk], Env, St); emul_1([?PUSH_LVAR(D, I)|Is], Lvs, Stk, Env, St) -> Val = get_local_var(D, I, Lvs), emul(Is, Lvs, [Val|Stk], Env, St); emul_1([?PUSH_EVAR(D, I)|Is], Lvs, Stk, Env, St) -> %% io:fwrite("pe: ~p\n", [{D,I,St#luerl.env}]), Val = get_env_var(D, I, Env, St), emul(Is, Lvs, [Val|Stk], Env, St); emul_1([?PUSH_GVAR(K)|Is], Lvs, Stk, Env, St0) -> {Val,St1} = get_global_var(K, St0), emul(Is, Lvs, [Val|Stk], Env, St1); emul_1([?PUSH_LAST_LIT(L)|Is], Lvs, Stk, Env, St) -> emul(Is, Lvs, [[L]|Stk], Env, St); emul_1([?PUSH_LAST_LVAR(D, I)|Is], Lvs, Stk, Env, St) -> Val = get_local_var(D, I, Lvs), emul(Is, Lvs, [[Val]|Stk], Env, St); emul_1([?PUSH_LAST_EVAR(D, I)|Is], Lvs, Stk, Env, St) -> %% io:fwrite("pe: ~p\n", [{D,I,St#luerl.env}]), Val = get_env_var(D, I, Env, St), emul(Is, Lvs, [[Val]|Stk], Env, St); emul_1([?PUSH_LAST_GVAR(K)|Is], Lvs, Stk, Env, St0) -> {Val,St1} = get_global_var(K, St0), emul(Is, Lvs, [[Val]|Stk], Env, St1); emul_1([?STORE_LVAR(D, I)|Is], Lvs0, [V|Stk], Env, St) -> Lvs1 = set_local_var(D, I, V, Lvs0), emul(Is, Lvs1, Stk, Env, St); emul_1([?STORE_EVAR(D, I)|Is], Lvs, [V|Stk], Env, St0) -> St1 = set_env_var(D, I, V, Env, St0), emul(Is, Lvs, Stk, Env, St1); emul_1([?STORE_GVAR(K)|Is], Lvs, [V|Stk], Env, St0) -> St1 = set_global_var(K, V, St0), emul(Is, Lvs, Stk, Env, St1); emul_1([?GET_KEY|Is], Lvs, [Key,Tab|Stk], Env, St0) -> {Val,St1} = get_table_key(Tab, Key, St0), emul(Is, Lvs, [Val|Stk], Env, St1); emul_1([?GET_LIT_KEY(K)|Is], Lvs, [Tab|Stk], Env, St0) -> %% [?PUSH_LIT(K),?GET_KEY] {Val,St1} = get_table_key(Tab, K, St0), emul(Is, Lvs, [Val|Stk], Env, St1); emul_1([?SET_KEY|Is], Lvs, [Key,Tab,Val|Stk], Env, St0) -> St1 = set_table_key(Tab, Key, Val, St0), emul_1(Is, Lvs, Stk, Env, St1); emul_1([?SET_LIT_KEY(Key)|Is], Lvs, [Tab,Val|Stk], Env, St0) -> %% [?PUSH_LIT(K),?SET_KEY] St1 = set_table_key(Tab, Key, Val, St0), emul_1(Is, Lvs, Stk, Env, St1); emul_1([?SINGLE|Is], Lvs, [Val|Stk], Env, St) -> emul(Is, Lvs, [first_value(Val)|Stk], Env, St); emul_1([?MULTIPLE|Is], Lvs, [Val|Stk], Env, St) -> emul(Is, Lvs, [multiple_value(Val)|Stk], Env, St); emul_1([?BUILD_TAB(Fc, I)|Is], Lvs, Stk0, Env, St0) -> {Tab,Stk1,St1} = build_tab(Fc, I, Stk0, St0), emul(Is, Lvs, [Tab|Stk1], Env, St1); emul_1([?FCALL(0)|Is], Lvs, Stk, Env, St) -> do_fcall_0(Is, Lvs, Stk, Env, St); emul_1([?FCALL(1)|Is], Lvs, Stk, Env, St) -> do_fcall_1(Is, Lvs, Stk, Env, St); emul_1([?FCALL(2)|Is], Lvs, Stk, Env, St) -> do_fcall_2(Is, Lvs, Stk, Env, St); emul_1([?FCALL(Ac)|Is], Lvs, Stk, Env, St) -> do_fcall(Is, Lvs, Stk, Env, St, Ac); emul_1([?TAIL_FCALL(Ac)|Is], Lvs, Stk, Env, St) -> do_tail_fcall(Is, Lvs, Stk, Env, St, Ac); emul_1([?MCALL(K, 0)|Is], Lvs, Stk, Env, St) -> do_mcall_0(Is, Lvs, Stk, Env, St, K); emul_1([?MCALL(K, 1)|Is], Lvs, Stk, Env, St) -> do_mcall_1(Is, Lvs, Stk, Env, St, K); emul_1([?MCALL(K, 2)|Is], Lvs, Stk, Env, St) -> do_mcall_2(Is, Lvs, Stk, Env, St, K); emul_1([?MCALL(K, Ac)|Is], Lvs, Stk, Env, St) -> do_mcall(Is, Lvs, Stk, Env, St, K, Ac); emul_1([?OP(Op,1)|Is], Lvs, Stk, Env, St) -> do_op1(Is, Lvs, Stk, Env, St, Op); emul_1([?OP(Op,2)|Is], Lvs, Stk, Env, St) -> do_op2(Is, Lvs, Stk, Env, St, Op); emul_1([?FDEF(Lsz, Esz, Pars, Fis)|Is], Lvs, Stk, Env, St0) -> {Func,St1} = do_fdef(Lsz, Esz, Pars, Fis, Env, St0), emul(Is, Lvs, [Func|Stk], Env, St1); %% Control instructions. emul_1([?BLOCK(Lsz, Esz, Bis)|Is], Lvs0, Stk0, Env0, St0) -> {Lvs1,Stk1,Env1,St1} = do_block(Bis, Lvs0, Stk0, Env0, St0, Lsz, Esz), emul(Is, Lvs1, Stk1, Env1, St1); emul_1([?WHILE(Eis, Wis)|Is], Lvs, Stk, Env, St) -> do_while(Is, Lvs, Stk, Env, St, Eis, Wis); emul_1([?REPEAT(Ris)|Is], Lvs, Stk, Env, St) -> do_repeat(Is, Lvs, Stk, Env, St, Ris); emul_1([?AND_THEN(T)|Is], Lvs, [Val|Stk1]=Stk0, Env, St0) -> %% This is an expression and must always leave a value on stack. case boolean_value(Val) of true -> {Lvs1,Stk2,Env1,St1} = emul(T, Lvs, Stk1, Env, St0), emul(Is, Lvs1, Stk2, Env1, St1); false -> emul(Is, Lvs, Stk0, Env, St0) end; emul_1([?OR_ELSE(T)|Is], Lvs, [Val|Stk1]=Stk0, Env, St0) -> %% This is an expression and must always leave a value on stack. case boolean_value(Val) of true -> emul(Is, Lvs, Stk0, Env, St0); false -> {Lvs1,Stk2,Env1,St1} = emul(T, Lvs, Stk1, Env, St0), emul(Is, Lvs1, Stk2, Env1, St1) end; emul_1([?IF_TRUE(T)|Is], Lvs, [Val|Stk0], Env, St0) -> %% This is a statement and pops the boolean value. case boolean_value(Val) of true -> {Lvs1,Stk1,Env1,St1} = emul(T, Lvs, Stk0, Env, St0), emul(Is, Lvs1, Stk1, Env1, St1); false -> emul(Is, Lvs, Stk0, Env, St0) end; emul_1([?IF_FALSE(T)|Is], Lvs, [Val|Stk0], Env, St0) -> %% This is a statement and pops the boolean value. case boolean_value(Val) of true -> emul(Is, Lvs, Stk0, Env, St0); false -> {Lvs1,Stk1,Env1,St1} = emul(T, Lvs, Stk0, Env, St0), emul(Is, Lvs1, Stk1, Env1, St1) end; emul_1([?IF(True, False)|Is], Lvs0, Stk0, Env0, St0) -> {Lvs1,Stk1,Env1,St1} = do_if(Lvs0, Stk0, Env0, St0, True, False), emul(Is, Lvs1, Stk1, Env1, St1); emul_1([?NFOR(V, Fis)|Is], Lvs, Stk, Env, St) -> do_numfor(Is, Lvs, Stk, Env, St, V, Fis); emul_1([?GFOR(Vs, Fis)|Is], Lvs, Stk, Env, St) -> do_genfor(Is, Lvs, Stk, Env, St, Vs, Fis); emul_1([?BREAK|_], Lvs, Stk, Env, St) -> throw({break,St#luerl.tag,Lvs,Stk,Env,St}); emul_1([?RETURN(0)|_], _, _, _, St) -> throw({return,St#luerl.tag,[],St}); emul_1([?RETURN(Ac)|_], _, Stk, _, St) -> {Ret,_} = pop_vals(Ac, Stk), throw({return,St#luerl.tag,Ret,St}); %% Stack instructions emul_1([?POP|Is], Lvs, [_|Stk], Env, St) -> %Just pop top off stack emul(Is, Lvs, Stk, Env, St); emul_1([?POP2|Is], Lvs, [_,_|Stk], Env, St) -> %Just pop top 2 off stack emul(Is, Lvs, Stk, Env, St); emul_1([?SWAP|Is], Lvs, [S1,S2|Stk], Env, St) -> emul(Is, Lvs, [S2,S1|Stk], Env, St); emul_1([?DUP|Is], Lvs, [V|_]=Stk, Env, St) -> emul_1(Is, Lvs, [V|Stk], Env, St); emul_1([?PUSH_VALS(Vc)|Is], Lvs, [Vals|Stk0], Env, St) -> %% Pop list off the stack and push Vc vals from it. Stk1 = push_vals(Vc, Vals, Stk0), emul(Is, Lvs, Stk1, Env, St); emul_1([?POP_VALS(Vc)|Is], Lvs, Stk0, Env, St) -> %% Pop Vc vals off the stack, put in a list and push. {Vals,Stk1} = pop_vals(Vc, Stk0), emul(Is, Lvs, [Vals|Stk1], Env, St); emul_1([], Lvs, Stk, Env, St) -> {Lvs,Stk,Env,St}. %% pop_vals(Count, Stack) -> {ValList,Stack}. %% pop_vals(Count, Stack, ValList) -> {ValList,Stack}. %% Pop Count values off the stack and push onto the value list. %% First value is deepest. Always generates list. pop_vals(0, Stk) -> {[],Stk}; pop_vals(C, [Vtail|Stk]) -> %This a list tail pop_vals(C-1, Stk, Vtail). pop_vals(0, Stk, Vs) -> {Vs,Stk}; pop_vals(1, [V|Stk], Vs) -> {[V|Vs],Stk}; pop_vals(2, [V2,V1|Stk], Vs) -> {[V1,V2|Vs],Stk}; pop_vals(C, [V2,V1|Stk], Vs) -> pop_vals(C-2, Stk, [V1,V2|Vs]). %% push_vals(Count, ValList, Stack) -> {LastVal,Stack}. %% Push Count values from value list onto the stack. First value is %% deepest. Fill with 'nil' if not enough values. push_vals(0, _, Stk) -> Stk; push_vals(C, [V|Vs], Stk) -> push_vals(C-1, Vs, [V|Stk]); push_vals(C, [], Stk) -> push_vals(C-1, [], [nil|Stk]). %% do_block(Instrs, LocalVars, Stack, Env, State, %% LocalSize, EnvSize, BlockInstrs) -> ReturnFromEmul. %% Local vars may have been updated so must continue with returned %% version. We also continue with returned stack. There should be no %% changes in the env. %% do_block(Is, Lvs0, Stk0, Env, St0, 0, 0, Bis) -> %% %% No variables at all. %% {Lvs1,Stk1,_,St1} = emul(Bis, Lvs0, Stk0, Env, St0), %% emul(Is, Lvs1, Stk1, Env, St1); %% do_block(Is, Lvs0, Stk0, Env, St0, 0, Esz, Bis) -> %% %% No local variables, only env variables. %% E = erlang:make_tuple(Esz, nil), %% {Fref,St1} = alloc_frame(E, St0), %% {Lvs1,Stk1,_,St2} = emul(Bis, Lvs0, Stk0, [Fref|Env], St1), %% emul(Is, Lvs1, Stk1, Env, St2); %% do_block(Is, Lvs0, Stk0, Env, St0, Lsz, 0, Bis) -> %% %% No env variables, only local variables. %% L = erlang:make_tuple(Lsz, nil), %% {[_|Lvs1],Stk1,_,St1} = emul(Bis, [L|Lvs0], Stk0, Env, St0), %% emul(Is, Lvs1, Stk1, Env, St1); %% do_block(Is, Lvs0, Stk0, Env, St0, Lsz, Esz, Bis) -> %% %% Both local and env variables. %% L = erlang:make_tuple(Lsz, nil), %% E = erlang:make_tuple(Esz, nil), %% {Fref,St1} = alloc_frame(E, St0), %% {[_|Lvs1],Stk1,_,St2} = emul(Bis, [L|Lvs0], Stk0, [Fref|Env], St1), %% emul(Is, Lvs1, Stk1, Env, St2). %% do_block(BlockInstrs, LocalVars, Stack, Env, State, %% LocalSize, EnvSize) -> {LocalVars,Stack,Env,State}. %% Local vars may have been updated so must continue with returned %% version. We also continue with returned stack. There should be no %% changes in the env. do_block(Bis, Lvs, Stk, Env, St, 0, 0) -> %% No variables at all. emul(Bis, Lvs, Stk, Env, St); do_block(Bis, Lvs0, Stk0, Env0, St0, 0, Esz) -> %% No local variables, only env variables. E = erlang:make_tuple(Esz, nil), {Fref,St1} = alloc_frame(E, St0), {Lvs1,Stk1,[_|Env1],St2} = emul(Bis, Lvs0, Stk0, [Fref|Env0], St1), {Lvs1,Stk1,Env1,St2}; do_block(Bis, Lvs0, Stk0, Env0, St0, Lsz, 0) -> %% No env variables, only local variables. L = erlang:make_tuple(Lsz, nil), {[_|Lvs1],Stk1,Env1,St1} = emul(Bis, [L|Lvs0], Stk0, Env0, St0), {Lvs1,Stk1,Env1,St1}; do_block(Bis, Lvs0, Stk0, Env0, St0, Lsz, Esz) -> %% Both local and env variables. L = erlang:make_tuple(Lsz, nil), E = erlang:make_tuple(Esz, nil), {Fref,St1} = alloc_frame(E, St0), {[_|Lvs1],Stk1,[_|Env1],St2} = emul(Bis, [L|Lvs0], Stk0, [Fref|Env0], St1), {Lvs1,Stk1,Env1,St2}. %% do_op1(Instrs, LocalVars, Stack, Env, State, Op) -> ReturnFromEmul. %% do_op2(Instrs, LocalVars, Stack, Env, State, Op) -> ReturnFromEmul. do_op1(Is, Lvs, [A|Stk], Env, St, Op) -> case op(Op, A) of {ok,Res} -> emul(Is, Lvs, [Res|Stk], Env, St); {meta,Meta} -> functioncall(Is, Lvs, Stk, Env, St, #erl_func{code=Meta}, []); {error,E} -> lua_error(E, St) end. do_op2(Is, Lvs, [A2,A1|Stk], Env, St, Op) -> case op(Op, A1, A2) of {ok,Res} -> emul(Is, Lvs, [Res|Stk], Env, St); {meta,Meta} -> functioncall(Is, Lvs, Stk, Env, St, #erl_func{code=Meta}, []); {error,E} -> lua_error(E, St) end. %% do_fdef(LocalSize, EnvSize, Pars, Instrs, Env, State) -> {Function,State}. do_fdef(Lsz, Esz, Pars, Is, Env, St) -> {#lua_func{lsz=Lsz,esz=Esz,pars=Pars,env=Env,b=Is},St}. %% do_fcall_0(Instrs, LocalVars, Stack, Env, State) -> %% do_fcall_1(Instrs, LocalVars, Stack, Env, State) -> %% do_fcall_2(Instrs, LocalVars, Stack, Env, State) -> %% do_fcall(Instrs, LocalVars, Stack, Env, State, ArgCount) -> %% ReturnFromEmul. do_fcall_0(Is, Lvs, [Func|Stk], Env, St) -> functioncall(Is, Lvs, Stk, Env, St, Func, []). do_fcall_1(Is, Lvs, [Alast,Func|Stk], Env, St) -> functioncall(Is, Lvs, Stk, Env, St, Func, Alast). do_fcall_2(Is, Lvs, [Alast,A1,Func|Stk], Env, St) -> functioncall(Is, Lvs, Stk, Env, St, Func, [A1|Alast]). do_fcall(Is, Lvs, Stk0, Env, St, Ac) -> {Args,Stk1} = pop_vals(Ac, Stk0), %Pop arguments [Func|Stk2] = Stk1, %Get function functioncall(Is, Lvs, Stk2, Env, St, Func, Args). %% functioncall(Function, Args, State) -> {Return,State}. %% This is called from "within" things, for example metamethods, and %% expects everything necessary to be in the state. functioncall(Func, Args, #luerl{stk=Stk}=St0) -> {Ret,St1} = functioncall(Func, Args, Stk, St0), {Ret,St1}. %% functioncall(Instrs, LocalVars, Stk, Env, State, Func, Args) -> %% This is called from within code and continues with Instrs after %% call. It must move everything into State. functioncall(Is, Lvs, Stk0, Env, St0, Func, Args) -> Fr = #call_frame{lvs=Lvs,env=Env}, Stk1 = [Fr|Stk0], {Ret,St1} = functioncall(Func, Args, Stk1, St0), emul(Is, Lvs, [Ret|Stk0], Env, St1). %% do_tail_fcall(Instrs, Acc, LocalVars, Stack, Env, State, ArgCount) -> %% ReturnFromEmul. do_tail_fcall(_Is, _Var, Stk, _Env, _St, 0) -> error({boom,[],Stk}); do_tail_fcall(_Is, _Var, Stk0, _Env, _St, Ac) -> {Args,Stk1} = pop_vals(Ac, Stk0), %Pop arguments [Func|Stk2] = Stk1, %Get function error({boom,Func,Args,Stk2}). %% do_mcall_0(Instrs, LocalVars, Stack, Env, State, Method) -> %% do_mcall_1(Instrs, LocalVars, Stack, Env, State, Method) -> %% do_mcall_2(Instrs, LocalVars, Stack, Env, State, Method) -> %% do_mcall(Instrs, LocalVars, Stack, Env, State, Method, ArgCount) -> %% ReturnFromEmul. do_mcall_0(Is, Lvs, [Obj|Stk], Env, St, M) -> %% The object is in the acc. methodcall(Is, Lvs, Stk, Env, St, Obj, M, []). do_mcall_1(Is, Lvs, [Alast,Obj|Stk], Env, St, M) -> %% The object is on the stack and the argument is in the acc. methodcall(Is, Lvs, Stk, Env, St, Obj, M, Alast). do_mcall_2(Is, Lvs, [Alast,A1,Obj|Stk], Env, St, M) -> %% The object and 1st argument are on the stack, the 2nd is in the acc. methodcall(Is, Lvs, Stk, Env, St, Obj, M, [A1|Alast]). do_mcall(Is, Lvs, Stk0, Env, St, M, Ac) -> {Args,Stk1} = pop_vals(Ac, Stk0), %Pop arguments [Obj|Stk2] = Stk1, %Get function methodcall(Is, Lvs, Stk2, Env, St, Obj, M, Args). %% methodcall(Object, Method, Args, State) -> {Return,State}. %% This is called from "within" things, for example metamethods, and %% expects everything necessary to be in the state. methodcall(Obj, M, Args, St0) -> %% Get the function to call from object and method. case get_table_key(Obj, M, St0) of {nil,St1} -> %No method lua_error({undef_method,Obj,M}, St1); {Val,St1} -> {Ret,St2} = functioncall(Val, [Obj|Args], St1#luerl.stk, St1), {Ret,St2} end. %% methodcall(Instrs, Var, Stk, Env, State, Object, Method, Args) -> %% This is called from within code and continues with Instrs after %% call. It must move everything into State. methodcall(Is, Lvs, Stk0, Env, St0, Obj, M, Args) -> %% Get the function to call from object and method. case get_table_key(Obj, M, St0) of {nil,St1} -> %No method lua_error({undef_method,Obj,M}, St1); {Val,St1} -> Fr = #call_frame{lvs=Lvs,env=Env}, Stk1 = [Fr|Stk0], {Ret,St2} = functioncall(Val, [Obj|Args], Stk1, St1), emul(Is, Lvs, [Ret|Stk0], Env, St2) end. %% functioncall(Function, Args, Stack, State) -> {Return,State}. %% Setup environment for function and do the actual call. functioncall(#lua_func{lsz=0,esz=0,env=Env,b=Fis}, _, Stk, St0) -> %% No variables at all. functioncall(Fis, [], Stk, Env, St0); functioncall(#lua_func{lsz=0,esz=Esz,pars=Pars,env=Env,b=Fis}, Args, Stk, St0) -> %% No local variables, only env variables. E0 = erlang:make_tuple(Esz, nil), E1 = assign_env_pars(Pars, Args, E0), {Fref,St1} = alloc_frame(E1, St0), {Ret,St2} = functioncall(Fis, [], Stk, [Fref|Env], St1), {Ret,St2}; functioncall(#lua_func{lsz=Lsz,esz=0,pars=Pars,env=Env,b=Fis}, Args, Stk, St0) -> %% No env variables, only local variables. L0 = erlang:make_tuple(Lsz, nil), L1 = assign_local_pars(Pars, Args, L0), {Ret,St1} = functioncall(Fis, [L1], Stk, Env, St0), {Ret,St1}; functioncall(#lua_func{lsz=Lsz,esz=Esz,pars=Pars,env=Env,b=Fis}, Args, Stk, St0) -> L0 = erlang:make_tuple(Lsz, nil), E0 = erlang:make_tuple(Esz, nil), {L1,E1} = assign_pars(Pars, Args, L0, E0), {Fref,St1} = alloc_frame(E1, St0), {Ret,St2} = functioncall(Fis, [L1], Stk, [Fref|Env], St1), {Ret,St2}; functioncall(#erl_func{code=Func}, Args, Stk, #luerl{stk=Stk0}=St0) -> %% Here we must save the stack in state as function may need it. {Ret,St1} = Func(Args, St0#luerl{stk=Stk}), {Ret,St1#luerl{stk=Stk0}}; %Replace it functioncall(Func, Args, Stk, St) -> case getmetamethod(Func, <<"__call">>, St) of nil -> lua_error({undef_function,Func}, St); Meta -> functioncall(Meta, [Func|Args], Stk, St) end. functioncall(Fis, Lvs, Stk, Env, St0) -> Tag = St0#luerl.tag, %% Must use different St names else they become 'unsafe'. %% io:fwrite("fc: ~p\n", [{Lvs,Env,St0#luerl.env}]), try {_,_,_,Sta} = emul(Fis, Lvs, Stk, Env, St0), %%io:fwrite("fr: ~p\n", [{Tag,[]}]), {[],Sta} %No return, no arguments catch throw:{return,Tag,Ret,Stb} -> %%io:fwrite("fr: ~p\n", [{Tag,Ret,Stb#luerl.env}]), {Ret,Stb}; throw:{break,Tag,_,_,_,St} -> lua_error({illegal_op,break}, St) end. assign_local_pars([V|Vs], [A|As], Var) -> assign_local_pars(Vs, As, setelement(V, Var, A)); assign_local_pars([_|Vs], [], Var) -> assign_local_pars(Vs, [], Var); %Var default is nil assign_local_pars([], _, Var) -> Var; %No vararg, drop remain args assign_local_pars(V, As, Var) -> %This is a vararg! setelement(V, Var, As). assign_env_pars([V|Vs], [A|As], Var) -> assign_env_pars(Vs, As, setelement(-V, Var, A)); assign_env_pars([_|Vs], [], Var) -> assign_env_pars(Vs, [], Var); %Var default is nil assign_env_pars([], _, Var) -> Var; %No vararg, drop remain args assign_env_pars(V, As, Var) -> %This is a vararg! setelement(-V, Var, As). assign_pars([V|Vs], [A|As], L, E) when V > 0 -> assign_pars(Vs, As, setelement(V, L, A), E); assign_pars([V|Vs], [A|As], L, E) -> %V < 0 assign_pars(Vs, As, L, setelement(-V, E, A)); assign_pars([_|Vs], [], L, E) -> assign_pars(Vs, [], L, E); %Var default is nil assign_pars([], _, L, E) -> {L,E}; %No vararg, drop remain args assign_pars(V, As, L, E) when V > 0 -> %This is a vararg! {setelement(V, L, As),E}; assign_pars(V, As, L, E) -> %This is a vararg! {L,setelement(-V, E, As)}. %% do_repeat(Instrs, LocalVars, Stack, Env, State, RepeatInstrs) -> do_repeat(Is, Lvs, Stk, Env, St, Ris) -> Do = fun (S) -> repeat_loop(Ris, Lvs, Stk, Env, S) end, loop_block(Is, Lvs, Stk, Env, St, Do). repeat_loop(Ris, Lvs0, Stk0, Env0, St0) -> {Lvs1,[Val|Stk1],Env1,St1} = emul(Ris, Lvs0, Stk0, Env0, St0), case boolean_value(Val) of true -> {Lvs1,St1}; false -> repeat_loop(Ris, Lvs1, Stk1, Env1, St1) end. %% do_while(Instrs, LocalVars, Stack, Env, State, WhileEis, WhileBis) -> %% do_while(Is, Lvs, Stk, Env, St, Eis, Wis) -> Do = fun (S) -> while_loop(Eis, Lvs, Stk, Env, S, Wis) end, loop_block(Is, Lvs, Stk, Env, St, Do). while_loop(Eis, Lvs0, Stk0, Env0, St0, Wis) -> {Lvs1,[Val|Stk1],Env1,St1} = emul(Eis, Lvs0, Stk0, Env0, St0), case boolean_value(Val) of true -> {Lvs2,Stk2,Env2,St2} = emul(Wis, Lvs1, Stk1, Env1, St1), while_loop(Eis, Lvs2, Stk2, Env2, St2, Wis); false -> {Lvs1,St1} end. loop_block(Is, Lvs0, Stk, Env, St0, Do) -> Tag = St0#luerl.tag, {Lvs2,St1} = try Do(St0) catch throw:{break,Tag,Lvs1,_,_,St} -> {Lvs1,St} end, %% Trim local variable stack. Lvs3 = lists:nthtail(length(Lvs2)-length(Lvs0), Lvs2), emul(Is, Lvs3, Stk, Env, St1). %% do_if(Blocks, Else, Lvs, Stk, Env, Sy) -> %% do_if_blocks(Blocks, Else, Lvs, Stk, Env, St). %% do_if_blocks([{T,B}|Ts], Else, Lvs0, Stk0, Env0, St0) -> %% {Lvs1,[Val|Stk1],Env1,St1} = emul(T, Lvs0, Stk0, Env0, St0), %% case boolean_value(Val) of %% true -> emul(B, Lvs1, Stk1, Env1, St1); %% false -> do_if_blocks(Ts, Lvs1, Stk1, Env1, St1) %% end; %% do_if_blocks([], Else, Lvs, Stk, Env, St) -> %% emul(Else, Lvs, Stk, Env, St). %% do_if(LocalVars, Stack, Env, State, TrueInstrs, FalseInstrs) -> %% {LocalVars,Stack,Env,State}. do_if(Lvs, [Val|Stk], Env, St, True, False) -> case boolean_value(Val) of true -> emul(True, Lvs, Stk, Env, St); false -> emul(False, Lvs, Stk, Env, St) end. %% do_if_block([?BLOCK(Lsz, Esz, Bis)], Lvs0, Stk0, Env0, St0, Is) -> %% {Lvs1,Stk1,Env1,St1} = do_block(Bis, Lvs0, Stk0, Env0, St0, Lsz, Esz), %% emul(Is, Lvs1, Stk1, Env1, St1); %% do_if_block(Bis, Lvs0, Stk0, Env0, St0, Is) -> %% {Lvs1,Stk1,Env1,St1} = emul(Bis, Lvs0, Stk0, Env0, St0), %% emul(Is, Lvs1, Stk1, Env1, St1). %% do_numfor(Instrs, LocalVars, Stack, Env, State, Varname, FromInstrs) -> %% do_numfor(Is, Lvs, [Step,Limit,Init|Stk], Env, St, _, Fis) -> %% First check if we have numbers. case luerl_lib:tonumbers([Init,Limit,Step]) of [I,L,S] -> Do = fun (St_) -> numfor_loop(I, L, S, Fis, Lvs, Stk, Env, St_) end, loop_block(Is, Lvs, Stk, Env, St, Do); nil -> badarg_error(loop, [Init,Limit,Step], St) end. numfor_loop(N, Limit, Step, Fis, Lvs0, Stk0, Env0, St0) -> %% Leave the counter at the top of the stack for code to get. itrace_print("nl: ~p\n", [{N,Stk0}]), if Step > 0.0, N =< Limit -> %Keep going {Lvs1,Stk1,Env1,St1} = emul(Fis, Lvs0, [N|Stk0], Env0, St0), numfor_loop(N+Step, Limit, Step, Fis, Lvs1, Stk1, Env1, St1); Step < 0.0, N >= Limit -> %Keep going {Lvs1,Stk1,Env1,St1} = emul(Fis, Lvs0, [N|Stk0], Env0, St0), numfor_loop(N+Step, Limit, Step, Fis, Lvs1, Stk1, Env1, St1); true -> {Lvs0,St0} %Done! end. %% do_genfor(Instrs, LocalVars, Stack, Env, State, Vars, FromInstrs) -> do_genfor(Is, Lvs, [Val|Stk], Env, St, _, Fis) -> case Val of %Export F, T, V [F] -> T = nil, V = nil; [F,T] -> V = nil; [F,T,V|_] -> ok; F -> T = nil, V = nil end, Do = fun (St_) -> genfor_loop(F, T, V, Fis, Lvs, Stk, Env, St_) end, loop_block(Is, Lvs, Stk, Env, St, Do). genfor_loop(Func, Tab, Val, Fis, Lvs0, Stk, Env, St0) -> {Vals,St1} = functioncall(Func, [Tab,Val], Stk, St0), case boolean_value(Vals) of true -> {Lvs1,_,_,St2} = emul(Fis, Lvs0, [Vals|Stk], Env, St1), genfor_loop(Func, Tab, hd(Vals), Fis, Lvs1, Stk, Env, St2); false -> {Lvs0,St1} end. %% getmetamethod(Object1, Object2, Event, State) -> Metod | nil. %% getmetamethod(Object, Event, State) -> Method | nil. %% Get the metamethod for object(s). getmetamethod(O1, O2, E, St) -> case getmetamethod(O1, E, St) of nil -> getmetamethod(O2, E, St); M -> M end. getmetamethod(O, E, St) -> Meta = getmetatable(O, St), %Can be nil getmetamethod_tab(Meta, E, St#luerl.ttab). getmetatable(#tref{i=T}, #luerl{ttab=Ts}) -> (?GET_TABLE(T, Ts))#table.m; getmetatable(#uref{i=U}, #luerl{utab=Us}) -> (?GET_TABLE(U, Us))#userdata.m; getmetatable(nil, #luerl{meta=Meta}) -> Meta#meta.nil; getmetatable(B, #luerl{meta=Meta}) when is_boolean(B) -> Meta#meta.boolean; getmetatable(N, #luerl{meta=Meta}) when is_number(N) -> Meta#meta.number; getmetatable(S, #luerl{meta=Meta}) when is_binary(S) -> Meta#meta.string; getmetatable(_, _) -> nil. %Other types have no metatables getmetamethod_tab(#tref{i=M}, E, Ts) -> #table{d=Mdict} = ?GET_TABLE(M, Ts), case ttdict:find(E, Mdict) of {ok,Mm} -> Mm; error -> nil end; getmetamethod_tab(_, _, _) -> nil. %Other types have no metatables %% build_tab(FieldCount, Index, Stack, State) -> {TableRef,Stack,State}. %% FieldCount is how many Key/Value pairs are on the stack, Index is %% the index of the next value in the acc. build_tab(Fc, I, [Last|Stk0], St0) -> Fs0 = build_tab_last(I, Last), {Fs1,Stk1} = build_tab_loop(Fc, Stk0, Fs0), %% io:fwrite("bt: ~p\n", [{Fc,I,Acc,Fs0,Fs1}]), {Tref,St1} = alloc_table(Fs1, St0), {Tref,Stk1,St1}. build_tab_last(I, [V|Vs]) -> [{I,V}|build_tab_last(I+1.0, Vs)]; build_tab_last(_, []) -> []; build_tab_last(_, Last) -> error({boom,build_tab_acc,Last}). build_tab_loop(0, Stk, Fs) -> {Fs,Stk}; build_tab_loop(C, [V,K|Stk], Fs) -> build_tab_loop(C-1, Stk, [{K,V}|Fs]). %% op(Op, Arg) -> {ok,Ret} | {meta,Func} | {error,Error}. %% op(Op, Arg1, Arg2) -> {ok,Ret} | {meta,Func} | {error,Error}. %% The built-in operators. Always return a single value! op('-', A) -> numeric_op('-', A, <<"__unm">>, fun (N) -> -N end); op('not', A) -> {ok,not ?IS_TRUE(A)}; %% op('not', false) -> {[true]}; %% op('not', nil) -> {[true]}; %% op('not', _) -> {[false]}; %Everything else is false op('#', B) when is_binary(B) -> {ok,float(byte_size(B))}; op('#', #tref{}=T) -> {meta,fun (_, St) -> luerl_lib_table:length(T, St) end}; op(Op, A) -> {error,{badarg,Op,[A]}}. %% Numeric operators. op('+', A1, A2) -> numeric_op('+', A1, A2, <<"__add">>, fun (N1,N2) -> N1+N2 end); op('-', A1, A2) -> numeric_op('-', A1, A2, <<"__sub">>, fun (N1,N2) -> N1-N2 end); op('*', A1, A2) -> numeric_op('*', A1, A2, <<"__mul">>, fun (N1,N2) -> N1*N2 end); op('/', A1, A2) -> numeric_op('/', A1, A2, <<"__div">>, fun (N1,N2) -> N1/N2 end); op('%', A1, A2) -> numeric_op('%', A1, A2, <<"__mod">>, fun (N1,N2) -> N1 - floor(N1/N2)*N2 end); op('^', A1, A2) -> numeric_op('^', A1, A2, <<"__pow">>, fun (N1,N2) -> math:pow(N1, N2) end); %% Relational operators, getting close. op('==', A1, A2) -> eq_op('==', A1, A2); op('~=', A1, A2) -> neq_op('~=', A1, A2); op('<=', A1, A2) -> le_op('<=', A1, A2); op('>=', A1, A2) -> le_op('>=', A2, A1); op('<', A1, A2) -> lt_op('<', A1, A2); op('>', A1, A2) -> lt_op('>', A2, A1); %% String operator. op('..', A1, A2) -> concat_op(A1, A2); %% Bad args here. op(Op, A1, A2) -> {error,{badarg,Op,[A1,A2]}}. %% We need a floor to do the mod in the same way as Lua. This doesn't %% exist before 20 so we have to do it ourselves. floor(X) -> T = float(trunc(X)), if X >= 0.0 -> T; X =:= T -> T; true -> T - 1.0 end. %% numeric_op(Op, Arg, Event, Raw) -> {ok,Res} | {meta,Meta}. %% numeric_op(Op, Arg, Arg, Event, Raw) -> {ok,Res} | {meta,Meta}. %% eq_op(Op, Arg, Arg) -> {ok,Res} | {meta,Meta}. %% neq_op(Op, Arg, Arg) -> {ok,Res} | {meta,Meta}. %% lt_op(Op, Arg, Arg) -> {ok,Res} | {meta,Meta}. %% le_op(Op, Arg, Arg) -> {ok,Res} | {meta,Meta}. %% concat_op(Op, Arg, Arg) -> {ok,Res} | {meta,Meta}. %% Together with their metas straight out of the reference manual. numeric_op(Op, A, E, Raw) -> case luerl_lib:tonumber(A) of nil -> %Neither number nor string {meta,fun (_, St) -> numeric_meta(Op, A, E, St) end}; N -> {ok,Raw(N)} end. numeric_op(Op, A1, A2, E, Raw) -> case luerl_lib:tonumber(A1) of nil -> {meta,fun (_, St) -> numeric_meta(Op, A1, A2, E, St) end}; N1 -> case luerl_lib:tonumber(A2) of nil -> {meta,fun (_, St) -> numeric_meta(Op, A1, A2, E, St) end}; N2 -> {ok,Raw(N1, N2)} end end. numeric_meta(Op, A, E, St0) -> case getmetamethod(A, E, St0) of nil -> badarg_error(Op, [A], St0); %No meta method Meta -> {Ret,St1} = functioncall(Meta, [A], St0), {first_value(Ret),St1} end. numeric_meta(Op, A1, A2, E, St0) -> case getmetamethod(A1, A2, E, St0) of nil -> badarg_error(Op, [A1,A2], St0); %No meta methods Meta -> {Ret,St1} = functioncall(Meta, [A1,A2], St0), {first_value(Ret),St1} end. eq_op(_Op, A1, A2) when A1 =:= A2 -> {ok,true}; eq_op(_Op, A1, A2) -> {meta,fun (_, St) -> eq_meta(A1, A2, St) end}. neq_op(_Op, A1, A2) when A1 =:= A2 -> {ok,false}; neq_op(_Op, A1, A2) -> {meta,fun (_, St0) -> {Ret,St1} = eq_meta(A1, A2, St0), {not Ret,St1} end}. eq_meta(A1, A2, St0) -> %% Must have "same" metamethod here. How do we test? case getmetamethod(A1, <<"__eq">>, St0) of nil -> {false,St0}; %Tweren't no method Meta -> case getmetamethod(A2, <<"__eq">>, St0) of Meta -> %Must be the same method {Ret,St1} = functioncall(Meta, [A1,A2], St0), {boolean_value(Ret),St1}; _ -> {false,St0} end end. lt_op(_Op, A1, A2) when is_number(A1), is_number(A2) -> {ok,A1 < A2}; lt_op(_Op, A1, A2) when is_binary(A1), is_binary(A2) -> {ok,A1 < A2}; lt_op(Op, A1, A2) -> {meta,fun (_, St) -> lt_meta(Op, A1, A2, St) end}. lt_meta(Op, A1, A2, St0) -> case getmetamethod(A1, A2, <<"__lt">>, St0) of nil -> badarg_error(Op, [A1,A2], St0); Meta -> {Ret,St1} = functioncall(Meta, [A1,A2], St0), {boolean_value(Ret),St1} end. le_op(_Op, A1, A2) when is_number(A1), is_number(A2) -> {ok,A1 =< A2}; le_op(_Op, A1, A2) when is_binary(A1), is_binary(A2) -> {ok,A1 =< A2}; le_op(Op, A1, A2) -> {meta,fun (_, St) -> le_meta(Op, A1, A2, St) end}. le_meta(Op, A1, A2, St0) -> %% Must check for first __le then __lt metamethods. case getmetamethod(A1, A2, <<"__le">>, St0) of nil -> %% Try for not (Op2 < Op1) instead. case getmetamethod(A1, A2, <<"__lt">>, St0) of nil -> badarg_error(Op, [A1,A2], St0); Meta -> {Ret,St1} = functioncall(Meta, [A2,A1], St0), {not boolean_value(Ret),St1} end; Meta -> {Ret,St1} = functioncall(Meta, [A1,A2], St0), {boolean_value(Ret),St1} end. concat_op(A1, A2) -> case luerl_lib:tostring(A1) of nil -> {meta,fun (_, St) -> concat_meta(A1, A2, St) end}; S1 -> case luerl_lib:tostring(A2) of nil -> {meta,fun (_, St) -> concat_meta(A1, A2, St) end}; S2 -> {ok,<>} end end. concat_meta(A1, A2, St0) -> case getmetamethod(A1, A2, <<"__concat">>, St0) of nil -> badarg_error('..', [A1,A2], St0); Meta -> {Ret,St1} = functioncall(Meta, [A1,A2], St0), {first_value(Ret),St1} end. %% boolean_value(Rets) -> boolean(). %% Return the "boolean" value of a value/function return list. boolean_value([nil|_]) -> false; boolean_value([false|_]) -> false; boolean_value([_|_]) -> true; boolean_value([]) -> false; boolean_value(nil) -> false; boolean_value(false) -> false; boolean_value(_) -> true. %% first_value(Rets) -> Value. first_value([V|_]) -> V; first_value([]) -> nil. %%multiple_value(nil) -> []; %Or maybe [nil]? multiple_value(V) -> [V]. %% gc(State) -> State. %% The garbage collector. Its main job is to reclaim unused tables %% and frames. It is a mark/sweep collector which passes over all %% objects and marks tables and frames which it has seen. All unseen %% tables and frames are then freed and their indexes added to the %% free lists. -record(gct, {t,s}). %Gc table info table, seen gc(#luerl{ttab=Tt0,tfree=Tf0,ftab=Ft0,ffree=Ff0,utab=Ut0,ufree=Uf0, g=G,stk=Stk,meta=Meta}=St) -> %% The root set consisting of global table and stack. Root = [Meta#meta.nil,Meta#meta.boolean,Meta#meta.number,Meta#meta.string, G|Stk], %% Mark all seen tables and frames, i.e. return them. GcT = #gct{t=Tt0,s=[]}, GcF = #gct{t=Ft0,s=[]}, GcU = #gct{t=Ut0,s=[]}, {SeenT,SeenF,SeenU} = mark(Root, [], GcT, GcF, GcU), %% io:format("gc: ~p\n", [{SeenT,SeenF,SeenU}]), %% Free unseen tables and add freed to free list. {Tf1,Tt1} = filter_tables(SeenT, Tf0, Tt0), {Ff1,Ft1} = filter_frames(SeenF, Ff0, Ft0), {Uf1,Ut1} = filter_userdata(SeenU, Uf0, Ut0), St#luerl{ttab=Tt1,tfree=Tf1,ftab=Ft1,ffree=Ff1,utab=Ut1,ufree=Uf1}. %% mark(ToDo, MoreTodo, GcTabs, GcFrames, GcUserdata) -> %% {SeenTabs,SeenFrames,SeenUserdata}. %% Scan over all live objects and mark seen tables by adding them to %% the seen list. mark([{in_table,_}=_T|Todo], More, GcT, GcF, GcU) -> %%io:format("gc: ~p\n", [_T]), mark(Todo, More, GcT, GcF, GcU); mark([#tref{i=T}|Todo], More, #gct{s=St0,t=Tt}=GcT, GcF, GcU) -> case ordsets:is_element(T, St0) of true -> %Already done mark(Todo, More, GcT, GcF, GcU); false -> %Mark it and add to todo St1 = ordsets:add_element(T, St0), #table{a=Arr,d=Dict,m=Meta} = ?GET_TABLE(T, Tt), %% Have to be careful where add Tab and Meta as Tab is %% [{Key,Val}], Arr is array and Meta is %% nil|#tref{i=M}. We want lists. Aes = array:sparse_to_list(Arr), Des = ttdict:to_list(Dict), mark([Meta|Todo], [[{in_table,T}],Des,Aes,[{in_table,-T}]|More], GcT#gct{s=St1}, GcF, GcU) end; mark([#fref{i=F}|Todo], More, GcT, #gct{s=Sf0,t=Ft}=GcF, GcU) -> case ordsets:is_element(F, Sf0) of true -> %Already done mark(Todo, More, GcT, GcF, GcU); false -> %Mark it and add to todo Sf1 = ordsets:add_element(F, Sf0), Ses = tuple_to_list(array:get(F, Ft)), mark(Todo, [Ses|More], GcT, GcF#gct{s=Sf1}, GcU) end; mark([#uref{i=U}|Todo], More, GcT, GcF, #gct{s=Su0}=GcU) -> case ordsets:is_element(U, Su0) of true -> %Already done mark(Todo, More, GcT, GcF, GcU); false -> Su1 = ordsets:add_element(U, Su0), mark(Todo, More, GcT, GcF, GcU#gct{s=Su1}) end; mark([#lua_func{env=Env}|Todo], More, GcT, GcF, GcU) -> mark(Todo, [Env|More], GcT, GcF, GcU); %% Catch these as they would match table key-value pair. mark([#erl_func{}|Todo], More, GcT, GcF, GcU) -> mark(Todo, More, GcT, GcF, GcU); mark([#thread{}|Todo], More, GcT, GcF, GcU) -> mark(Todo, More, GcT, GcF, GcU); mark([#userdata{m=Meta}|Todo], More, GcT, GcF, GcU) -> mark([Meta|Todo], More, GcT, GcF, GcU); mark([#call_frame{lvs=Lvs,env=Env}|Todo], More0, GcT, GcF, GcU) -> More1 = [ tuple_to_list(Lv) || Lv <- Lvs ] ++ [Env|More0], mark(Todo, More1, GcT, GcF, GcU); mark([{K,V}|Todo], More, GcT, GcF, GcU) -> %Table key-value pair %%io:format("mt: ~p\n", [{K,V}]), mark([K,V|Todo], More, GcT, GcF, GcU); mark([_|Todo], More, GcT, GcF, GcU) -> %Can ignore everything else mark(Todo, More, GcT, GcF, GcU); mark([], [M|More], GcT, GcF, GcU) -> mark(M, More, GcT, GcF, GcU); mark([], [], #gct{s=St}, #gct{s=Sf}, #gct{s=Su}) -> {St,Sf,Su}. %% filter_tables(Seen, Free, Tables) -> {Free,Tables}. %% filter_frames(Seen, Free, Frames) -> {Free,Frames}. %% Filter tables/frames and return updated free lists and %% tables/frames. filter_tables(Seen, Tf0, Tt0) -> Tf1 = ?FOLD_TABLES(fun (K, _, Free) -> case ordsets:is_element(K, Seen) of true -> Free; false -> [K|Free] end end, Tf0, Tt0), Tt1 = ?FILTER_TABLES(fun (K, _) -> ordsets:is_element(K, Seen) end, Tt0), {Tf1,Tt1}. filter_frames(Seen, Ff0, Ft0) -> %% Unfortunately there is no array:sparse_mapfoldl. Ff1 = array:sparse_foldl(fun (F, _, Free) -> case ordsets:is_element(F, Seen) of true -> Free; false -> [F|Free] end end, Ff0, Ft0), Ft1 = array:sparse_map(fun (F, Fd) -> case ordsets:is_element(F, Seen) of true -> Fd; false -> undefined end end, Ft0), {Ff1,Ft1}. filter_userdata(Seen, Uf0, Ut0) -> %% Update the free list. Uf1 = ?FOLD_TABLES(fun (K, _, Free) -> case ordsets:is_element(K, Seen) of true -> Free; false -> [K|Free] end end, Uf0, Ut0), %% Reclaim free table slots. Ut1 = ?FILTER_TABLES(fun (K, _) -> ordsets:is_element(K, Seen) end, Ut0), {Uf1,Ut1}. luerl-0.4/src/luerl_comp_locf.erl0000644000232200023220000002067613450242205017515 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_comp_locf.erl %% Author : Robert Virding %% Purpose : A basic LUA 5.2 compiler for Luerl. %% Does local function analysis. -module(luerl_comp_locf). -include("luerl.hrl"). -include("luerl_comp.hrl"). -export([chunk/2]). -import(ordsets, [add_element/2,is_element/2,union/1,union/2, subtract/2,intersection/2]). chunk(#code{code=C0}=Code, Opts) -> {C1,_,nul} = exp(C0, nul), %No local state here! luerl_comp:debug_print(Opts, "cf: ~p\n", [C1]), {ok,Code#code{code=C1}}. %% stmt(Stmts, State) -> {Stmts,LocalFunc,State}. stmts([S0|Ss0], St0) -> {S1,Slocf,St1} = stmt(S0, St0), {Ss1,Sslocf,St2} = stmts(Ss0, St1), Locf = Slocf or Sslocf, {[S1|Ss1],Locf,St2}; stmts([], St) -> {[],false,St}. %% stmt(Stmt, State) -> {Stmt,LocalFunc,State}. stmt(#assign_stmt{}=A, St) -> assign_stmt(A, St); stmt(#call_stmt{}=C, St) -> call_stmt(C, St); stmt(#return_stmt{}=R, St) -> return_stmt(R, St); stmt(#break_stmt{}=B, St) -> {B,false,St}; stmt(#block_stmt{}=B, St) -> block_stmt(B, St); stmt(#while_stmt{}=W, St) -> while_stmt(W, St); stmt(#repeat_stmt{}=R, St) -> repeat_stmt(R, St); stmt(#if_stmt{}=If, St) -> if_stmt(If, St); stmt(#nfor_stmt{}=For, St) -> numfor_stmt(For, St); stmt(#gfor_stmt{}=For, St) -> genfor_stmt(For, St); stmt(#local_assign_stmt{}=L, St) -> local_assign_stmt(L, St); stmt(#local_fdef_stmt{}=L, St) -> local_fdef_stmt(L, St); stmt(#expr_stmt{}=E, St) -> expr_stmt(E, St). %% assign_stmt(Assign, State) -> {Assign,LocalFunc,State}. assign_stmt(#assign_stmt{vs=Vs0,es=Es0}=A, St0) -> {Vs1,Vlocf,St1} = assign_loop(Vs0, St0), {Es1,Elocf,St2} = explist(Es0, St1), Locf = Vlocf or Elocf, {A#assign_stmt{vs=Vs1,es=Es1},Locf,St2}. assign_loop([V0|Vs0], St0) -> {V1,Vlocf,St1} = var(V0, St0), {Vs1,Vslocf,St2} = assign_loop(Vs0, St1), Locf = Vlocf or Vslocf, {[V1|Vs1],Locf,St2}; assign_loop([], St) -> {[],false,St}. var(#dot{e=Exp0,r=Rest0}=D, St0) -> {Exp1,Elocf,St1} = prefixexp_first(Exp0, St0), {Rest1,Rlocf,St2} = var_rest(Rest0, St1), {D#dot{e=Exp1,r=Rest1},Elocf or Rlocf,St2}; var(V, St) -> {V,false,St}. var_rest(#dot{e=Exp0,r=Rest0}=D, St0) -> {Exp1,Elocf,St1} = prefixexp_element(Exp0, St0), {Rest1,Rlocf,St2} = var_rest(Rest0, St1), {D#dot{e=Exp1,r=Rest1},Elocf or Rlocf,St2}; var_rest(Exp, St) -> var_last(Exp, St). var_last(#key{k=Exp0}=K, St0) -> {Exp1,Elocf,St1} = exp(Exp0, St0), {K#key{k=Exp1},Elocf,St1}. %% call_stmt(Call, State) -> {Call,LocalFunc,State}. call_stmt(#call_stmt{call=Exp0}=C, St0) -> {Exp1,Locf,St1} = exp(Exp0, St0), {C#call_stmt{call=Exp1},Locf,St1}. %% return_stmt(Return, State) -> {Return,LocalFunc,State}. return_stmt(#return_stmt{es=Es0}=R, St0) -> {Es1,Locf,St1} = explist(Es0, St0), {R#return_stmt{es=Es1},Locf,St1}. %% block_stmt(Block, State) -> {Block,LocalFunc,State}. block_stmt(#block_stmt{ss=Ss0}=B, St0) -> {Ss1,Sslocf,St1} = stmts(Ss0, St0), {B#block_stmt{ss=Ss1,locf=Sslocf},Sslocf,St1}. %% do_block(Block, State) -> {Block,LocalFunc,State}. do_block(#block{ss=Ss0}=B, St0) -> {Ss1,Sslocf,St1} = stmts(Ss0, St0), {B#block{ss=Ss1,locf=Sslocf},Sslocf,St1}. %% while_stmt(While, State) -> {While,LocalFunc,State}. %% The test expression is done in the context of the surrounding %% block. while_stmt(#while_stmt{e=E0,b=B0}=W, St0) -> {E1,Elocf,St1} = exp(E0, St0), {B1,Blocf,St2} = do_block(B0, St1), {W#while_stmt{e=E1,b=B1},Elocf or Blocf,St2}. %% repeat_stmt(Repeat, State) -> {Repeat,LocalFunc,State}. %% The test expression is done in the context of the repeat block. repeat_stmt(#repeat_stmt{b=B0}=R, St0) -> {B1,Blocf,St1} = do_block(B0, St0), {R#repeat_stmt{b=B1},Blocf,St1}. %% if_stmt(If, State) -> {If,LocalFunc,State}. %% The block info includes anything from the test expressions even %% though we keep them separate. if_stmt(#if_stmt{tests=Ts0,else=E0}=If, St0) -> {Ts1,Tlocf,St1} = if_tests(Ts0, St0), {E1,Elocf,St2} = do_block(E0, St1), Locf = Tlocf or Elocf, {If#if_stmt{tests=Ts1,else=E1},Locf,St2}. if_tests([{E0,B0}|Ts0], St0) -> {E1,Elocf,St1} = exp(E0, St0), {B1,Blocf,St2} = do_block(B0, St1), {Ts1,Tslocf,St3} = if_tests(Ts0, St2), Locf = Elocf or Blocf or Tslocf, {[{E1,B1}|Ts1],Locf,St3}; if_tests([], St) -> {[],false,St}. %% numfor_stmt(For, State) -> {For,LocalFunc,State}. numfor_stmt(#nfor_stmt{init=I0,limit=L0,step=S0,b=B0}=For, St0) -> {[I1,L1,S1],Eslocf,St1} = explist([I0,L0,S0], St0), {B1,Blocf,St2} = do_block(B0, St1), Locf = Eslocf or Blocf, {For#nfor_stmt{init=I1,limit=L1,step=S1,b=B1},Locf,St2}. %% genfor_stmt(For, State) -> {For,LocalFunc,State}. genfor_stmt(#gfor_stmt{gens=Gs0,b=B0}=For, St0) -> {Gs1,Glocf,St1} = explist(Gs0, St0), {B1,Blocf,St2} = do_block(B0, St1), Locf = Glocf or Blocf, {For#gfor_stmt{gens=Gs1,b=B1},Locf,St2}. %% local_assign_stmt(Local, State) -> {Local,LocalFunc,State}. local_assign_stmt(#local_assign_stmt{es=Es0}=L, St0) -> {Es1,Eslocf,St1} = explist(Es0, St0), {L#local_assign_stmt{es=Es1},Eslocf,St1}. %% local_fdef_stmt(Local, State) -> {Local,LocalFunc,State}. local_fdef_stmt(#local_fdef_stmt{f=F0}=L, St0) -> {F1,_,St1} = functiondef(F0, St0), %Don't care what's in func {L#local_fdef_stmt{f=F1},true,St1}. %% expr_stmt(Expr, State) -> {Expr,LocalFunc,State}. %% The expression pseudo statement. This will return a single value. expr_stmt(#expr_stmt{exp=Exp0}=E, St0) -> {Exp1,Locf,St1} = exp(Exp0, St0), {E#expr_stmt{exp=Exp1},Locf,St1}. %% explist(Exprs, State) -> {Exprs,LocalFunc,State}. %% exp(Expr, State) -> {Expr,LocalFunc,State}. explist([E0|Es0], St0) -> {E1,Elocf,St1} = exp(E0, St0), {Es1,Eslocf,St2} = explist(Es0, St1), {[E1|Es1],Elocf or Eslocf,St2}; explist([], St) -> {[],false,St}. %No expressions at all exp(#lit{}=L, St) -> {L,false,St}; %Nothing to do exp(#fdef{}=F0, St0) -> {F1,_,St1} = functiondef(F0, St0), %Don't care what's in func {F1,true,St1}; exp(#op{as=Es0}=Op, St0) -> {Es1,Eslocf,St1} = explist(Es0, St0), {Op#op{as=Es1},Eslocf,St1}; exp(#tc{fs=Fs0}=T, St0) -> {Fs1,Tlocf,St1} = tableconstructor(Fs0, St0), {T#tc{fs=Fs1},Tlocf,St1}; exp(E, St) -> prefixexp(E, St). prefixexp(#dot{e=Exp0,r=Rest0}=D, St0) -> {Exp1,Elocf,St1} = prefixexp_first(Exp0, St0), {Rest1,Rlocf,St2} = prefixexp_rest(Rest0, St1), {D#dot{e=Exp1,r=Rest1},Elocf or Rlocf,St2}; prefixexp(Exp, St) -> prefixexp_first(Exp, St). prefixexp_first(#single{e=E0}=S, St0) -> {E1,Elocf,St1} = exp(E0, St0), {S#single{e=E1},Elocf,St1}; prefixexp_first(V, St) -> {V,false,St}. prefixexp_rest(#dot{e=Exp0,r=Rest0}=D, St0) -> {Exp1,Elocf,St1} = prefixexp_element(Exp0, St0), {Rest1,Rlocf,St2} = prefixexp_rest(Rest0, St1), {D#dot{e=Exp1,r=Rest1},Elocf or Rlocf,St2}; prefixexp_rest(Exp, St) -> prefixexp_element(Exp, St). prefixexp_element(#key{k=E0}=K, St0) -> {E1,Elocf,St1} = exp(E0, St0), {K#key{k=E1},Elocf,St1}; prefixexp_element(#fcall{as=As0}=F, St0) -> {As1,Aslocf,St1} = explist(As0, St0), {F#fcall{as=As1},Aslocf,St1}; prefixexp_element(#mcall{as=As0}=M, St0) -> {As1,Aslocf,St1} = explist(As0, St0), {M#mcall{as=As1},Aslocf,St1}. %% functiondef(Func, State) -> {Func,LocalFunc,State}. %% We return if there are any internal function definitions within %% the function. functiondef(#fdef{ss=Ss0}=F, St0) -> {Ss1,Sslocf,St1} = stmts(Ss0, St0), {F#fdef{ss=Ss1,locf=Sslocf},Sslocf,St1}. %% tableconstructor(Fields, State) -> {Fields,LocalFunc,State}. tableconstructor(Fs0, St0) -> Fun = fun (#efield{v=V0}=F, {Locf,S0}) -> {V1,Vlocf,S1} = exp(V0, S0), {F#efield{v=V1},{Locf or Vlocf,S1}}; (#kfield{k=K0,v=V0}=F, {Locf,S0}) -> {K1,Klocf,S1} = exp(K0, S0), {V1,Vlocf,S2} = exp(V0, S1), {F#kfield{k=K1,v=V1},{Locf or Klocf or Vlocf,S2}} end, {Fs1,{Locf,St1}} = lists:mapfoldl(Fun, {false,St0}, Fs0), {Fs1,Locf,St1}. luerl-0.4/src/luerl_comp.hrl0000644000232200023220000000527513450242205016513 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_comp.hrl %% Author : Robert Virding %% Purpose : Internal LUA 5.2 compiler definitions. %% The code compile info. -record(code, {code=none, %Code cst=none %Shared compiler state }). %% Compiler state passed between passes. -record(cst, {}). %Nothing yet %% Variable data. -record(vars, {local=[],free=[], %Local, free variables used=[], %Used in sub blocks fused=[] %Used in sub-functions }). %% Define internal data macros. %% Statements. -record(assign_stmt, {l,vs,es}). -record(call_stmt, {l,call}). -record(return_stmt, {l,es}). -record(break_stmt, {l}). -record(block_stmt, {l,ss=[], %Block statement vars=none, %Variable info lsz=none, %Local frame size lf=[], %Local frame esz=none, %Env frame size ef=[], %Env frame local=none, %Local variables locf=false}). %Local functions -record(while_stmt, {l,e,b=[]}). -record(repeat_stmt, {l,b=[]}). -record(nfor_stmt, {l,v,init,limit,step,b=[]}). -record(gfor_stmt, {l,vs,gens,b=[]}). -record(if_stmt, {l,tests=[],else}). -record(local_assign_stmt, {l,vs,es}). -record(local_fdef_stmt, {l,v,f}). -record(expr_stmt, {l,exp}). %Pseudo stmt for expressions -record(block, {l,ss=[], %Sub-blocks vars=none, %Variable info lsz=none, %Local frame size lf=[], %Local frame esz=none, %Env frame size ef=[], locf=false}). %% Expressions. -record(fdef, {l,ps=[],ss=[], vars=none, %Variable info lsz=none, %Local frame size lf=[], esz=none, %Env frame size ef=[], local=none, %Local variables locf=false}). %Local function -record(lit, {l,v}). -record(op, {l,op,as=[]}). -record(single, {l,e}). -record(dot, {l,e,r}). -record(var, {l,n}). -record(fcall, {l,as=[]}). -record(mcall, {l,m,as=[]}). -record(key, {l,k}). -record(tc, {l,fs=[]}). -record(efield, {l,v}). -record(kfield, {l,k,v}). %% Variable types. -record(lvar, {n,d,i}). %Local name, depth, index -record(evar, {n,d,i}). %Environment name, depth, index -record(gvar, {n}). %Global name luerl-0.4/src/luerl_comp.txt0000644000232200023220000000743713450242205016547 0ustar debalancedebalance---------------------------------------------------------------------- function f (x) local y=5 do local z=10 do local a=7 x=x+y+z+a end z=z+x end return x end ^D main (3 instructions at 0x100100e40) 0+ params, 2 slots, 1 upvalue, 0 locals, 1 constant, 1 function 1 [1] CLOSURE 0 0 ; 0x100101020 2 [1] SETTABUP 0 -1 0 ; _ENV "f" 3 [1] RETURN 0 1 constants (1) for 0x100100e40: 1 "f" locals (0) for 0x100100e40: upvalues (1) for 0x100100e40: 0 _ENV 1 0 function (9 instructions at 0x100101020) 1 param, 5 slots, 0 upvalues, 4 locals, 3 constants, 0 functions 1 [1] LOADK 1 -1 ; 5 2 [1] LOADK 2 -2 ; 10 3 [1] LOADK 3 -3 ; 7 4 [1] ADD 4 0 1 5 [1] ADD 4 4 2 6 [1] ADD 0 4 3 7 [1] ADD 2 2 0 8 [1] RETURN 0 2 9 [1] RETURN 0 1 constants (3) for 0x100101020: 1 5 2 10 3 7 locals (4) for 0x100101020: 0 x 1 10 1 y 2 10 2 z 3 8 3 a 4 7 upvalues (0) for 0x100101020: ---------------------------------------------------------------------- function f (x) local y=5 if x>y then local z=x+y x=z else local w=x-y x=w end end ^D main (3 instructions at 0x100100e40) 0+ params, 2 slots, 1 upvalue, 0 locals, 1 constant, 1 function 1 [1] CLOSURE 0 0 ; 0x100101020 2 [1] SETTABUP 0 -1 0 ; _ENV "f" 3 [1] RETURN 0 1 constants (1) for 0x100100e40: 1 "f" locals (0) for 0x100100e40: upvalues (1) for 0x100100e40: 0 _ENV 1 0 function (9 instructions at 0x100101020) 1 param, 3 slots, 0 upvalues, 4 locals, 1 constant, 0 functions 1 [1] LOADK 1 -1 ; 5 2 [1] LT 0 1 0 3 [1] JMP 0 3 ; to 7 4 [1] ADD 2 0 1 5 [1] MOVE 0 2 6 [1] JMP 0 2 ; to 9 7 [1] SUB 2 0 1 8 [1] MOVE 0 2 9 [1] RETURN 0 1 constants (1) for 0x100101020: 1 5 locals (4) for 0x100101020: 0 x 1 10 1 y 2 10 2 z 5 6 3 w 8 9 upvalues (0) for 0x100101020: ---------------------------------------------------------------------- function f (x) local y=x do local y=z x=x+y end y=y-x return y end ^D main (3 instructions at 0x100100e40) 0+ params, 2 slots, 1 upvalue, 0 locals, 1 constant, 1 function 1 [1] CLOSURE 0 0 ; 0x100101020 2 [1] SETTABUP 0 -1 0 ; _ENV "f" 3 [1] RETURN 0 1 constants (1) for 0x100100e40: 1 "f" locals (0) for 0x100100e40: upvalues (1) for 0x100100e40: 0 _ENV 1 0 function (6 instructions at 0x100101020) 1 param, 3 slots, 1 upvalue, 3 locals, 1 constant, 0 functions 1 [1] MOVE 1 0 2 [1] GETTABUP 2 0 -1 ; _ENV "z" 3 [1] ADD 0 0 2 4 [1] SUB 1 1 0 5 [1] RETURN 1 2 6 [1] RETURN 0 1 constants (1) for 0x100101020: 1 "z" locals (3) for 0x100101020: 0 x 1 7 1 y 2 7 2 y 3 4 upvalues (1) for 0x100101020: 0 _ENV 0 0 ---------------------------------------------------------------------- function f (x) local y=5 for z=x,x*y,2*x do local m x=x+m+z z=z+1 end end ^D main (3 instructions at 0x100100e40) 0+ params, 2 slots, 1 upvalue, 0 locals, 1 constant, 1 function 1 [1] CLOSURE 0 0 ; 0x100101020 2 [1] SETTABUP 0 -1 0 ; _ENV "f" 3 [1] RETURN 0 1 constants (1) for 0x100100e40: 1 "f" locals (0) for 0x100100e40: upvalues (1) for 0x100100e40: 0 _ENV 1 0 function (11 instructions at 0x100101020) 1 param, 8 slots, 0 upvalues, 7 locals, 3 constants, 0 functions 1 [1] LOADK 1 -1 ; 5 2 [1] MOVE 2 0 3 [1] MUL 3 0 1 4 [1] MUL 4 -2 0 ; 2 - 5 [1] FORPREP 2 4 ; to 10 6 [1] LOADNIL 6 0 7 [1] ADD 7 0 6 8 [1] ADD 0 7 5 9 [1] ADD 5 5 -3 ; - 1 10 [1] FORLOOP 2 -5 ; to 6 11 [1] RETURN 0 1 constants (3) for 0x100101020: 1 5 2 2 3 1 locals (7) for 0x100101020: 0 x 1 12 1 y 2 12 2 (for index) 5 11 3 (for limit) 5 11 4 (for step) 5 11 5 z 6 10 6 m 7 10 upvalues (0) for 0x100101020: ---------------------------------------------------------------------- luerl-0.4/src/luerl_lib_basic.erl0000644000232200023220000003234313450242205017455 0ustar debalancedebalance%% Copyright (c) 2013-2018 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_lib_basic.erl %% Author : Robert Virding %% Purpose : The basic library for Luerl. -module(luerl_lib_basic). -include("luerl.hrl"). %% The basic entry point to set up the function table. -export([install/1]). %% Export some functions which can be called from elsewhere. -export([tostring/1,tostring/2]). -import(luerl_lib, [lua_error/2,badarg_error/3]). %Shorten these install(St) -> luerl_emul:alloc_table(table(), St). %% table() -> [{FuncName,Function}]. %% Caller will convert this list to the correct format. table() -> [{<<"_VERSION">>,<<"Lua 5.2">>}, %We are optimistic {<<"assert">>,#erl_func{code=fun assert/2}}, {<<"collectgarbage">>,#erl_func{code=fun collectgarbage/2}}, {<<"dofile">>,#erl_func{code=fun dofile/2}}, {<<"eprint">>,#erl_func{code=fun eprint/2}}, {<<"error">>,#erl_func{code=fun error/2}}, {<<"getmetatable">>,#erl_func{code=fun getmetatable/2}}, {<<"ipairs">>,#erl_func{code=fun ipairs/2}}, {<<"load">>,#erl_func{code=fun load/2}}, {<<"loadfile">>,#erl_func{code=fun loadfile/2}}, {<<"loadstring">>,#erl_func{code=fun loadstring/2}}, %For Lua 5.1 compatibility {<<"next">>,#erl_func{code=fun next/2}}, {<<"pairs">>,#erl_func{code=fun pairs/2}}, {<<"pcall">>,#erl_func{code=fun pcall/2}}, {<<"print">>,#erl_func{code=fun print/2}}, {<<"rawequal">>,#erl_func{code=fun rawequal/2}}, {<<"rawget">>,#erl_func{code=fun rawget/2}}, {<<"rawlen">>,#erl_func{code=fun rawlen/2}}, {<<"rawset">>,#erl_func{code=fun rawset/2}}, {<<"select">>,#erl_func{code=fun select/2}}, {<<"setmetatable">>,#erl_func{code=fun setmetatable/2}}, {<<"tonumber">>,#erl_func{code=fun tonumber/2}}, {<<"tostring">>,#erl_func{code=fun tostring/2}}, {<<"type">>,#erl_func{code=fun type/2}}, {<<"unpack">>,#erl_func{code=fun unpack/2}} %For Lua 5.1 compatibility ]. assert(As, St) -> case luerl_lib:boolean_value(As) of true -> {As,St}; false -> M = case As of [_,M0|_] -> M0; _ -> <<"assertion failed">> end, lua_error({assert_error,M}, St) end. collectgarbage([], St) -> collectgarbage([<<"collect">>], St); collectgarbage([<<"collect">>|_], St) -> %% {[],luerl_emul:gc(St)}; {[],St}; %No-op for the moment collectgarbage(_, St) -> %Ignore everything else {[],St}. eprint(Args, St) -> lists:foreach(fun (#tref{i=N}) -> T = ?GET_TABLE(N, St#luerl.ttab), io:format("~w ", [T]); (A) -> io:format("~w ", [A]) end, Args), io:nl(), {[],St}. -spec error(_, _) -> no_return(). error([{tref, _}=T|_], St0) -> case luerl_emul:getmetamethod(T, <<"__tostring">>, St0) of nil -> lua_error({error_call, T}, St0); Meta -> {[Ret|_], St1} = luerl_emul:functioncall(Meta, [T], St0), lua_error({error_call, Ret}, St1) end; error([M|_], St) -> lua_error({error_call, M}, St); %Never returns! error(As, St) -> badarg_error(error, As, St). %% ipairs(Args, State) -> {[Func,Table,FirstKey],State}. %% Return a function which on successive calls returns successive %% key-value pairs of integer keys. ipairs([#tref{}=Tref|_], St) -> case luerl_emul:getmetamethod(Tref, <<"__ipairs">>, St) of nil -> {[#erl_func{code=fun ipairs_next/2},Tref,0.0],St}; Meta -> luerl_emul:functioncall(Meta, [Tref], St) end; ipairs(As, St) -> badarg_error(ipairs, As, St). ipairs_next([A], St) -> ipairs_next([A,0.0], St); ipairs_next([#tref{i=T},K|_], St) -> #table{a=Arr} = ?GET_TABLE(T, St#luerl.ttab), %Get the table case ?IS_INTEGER(K, I) of true when I >= 0 -> Next = I + 1, case raw_get_index(Arr, Next) of nil -> {[nil],St}; V -> {[float(Next),V],St} end; _NegFalse -> lua_error({invalid_key,ipairs,K}, St) end; ipairs_next(As, St) -> badarg_error(ipairs, As, St). %% pairs(Args, State) -> {[Func,Table,Key],State}. %% Return a function to step over all the key-value pairs in a table. pairs([#tref{}=Tref|_], St) -> case luerl_emul:getmetamethod(Tref, <<"__pairs">>, St) of nil -> {[#erl_func{code=fun next/2},Tref,nil],St}; Meta -> luerl_emul:functioncall(Meta, [Tref], St) end; pairs(As, St) -> badarg_error(pairs, As, St). %% next(Args, State) -> {[Key,Value] | [nil], State}. %% Given a table and a key return the next key-value pair in the %% table, or nil if there is no next key. The key 'nil' gives the %% first key-value pair. next([A], St) -> next([A,nil], St); next([#tref{i=T},K|_], St) -> #table{a=Arr,d=Dict} = ?GET_TABLE(T, St#luerl.ttab), %Get the table if K == nil -> %% Find the first, start with the array. %% io:format("n: ~p\n", [{Arr,Dict}]), next_index(0, Arr, Dict, St); is_number(K) -> case ?IS_INTEGER(K, I0) of true when I0 >= 1 -> next_index(I0, Arr, Dict, St); _NegFalse -> next_key(K, Dict, St) %Not integer or negative end; true -> next_key(K, Dict, St) end; next(As, St) -> badarg_error(next, As, St). next_index(I0, Arr, Dict, St) -> case next_index_loop(I0+1, Arr, array:size(Arr)) of {I1,V} -> {[float(I1),V],St}; none -> %% Nothing in the array, take table instead. first_key(Dict, St) end. next_index_loop(I, Arr, S) when I < S -> case array:get(I, Arr) of nil -> next_index_loop(I+1, Arr, S); V -> {I,V} end; next_index_loop(_, _, _) -> none. first_key(Dict, St) -> case ttdict:first(Dict) of {ok,{K,V}} -> {[K,V],St}; error -> {[nil],St} end. next_key(K, Dict, St) -> case ttdict:next(K, Dict) of {ok,{N,V}} -> {[N,V],St}; error -> {[nil],St} end. print(Args, St0) -> St1 = lists:foldl(fun (A, S0) -> {Str,S1} = tostring([A], S0), io:format("~s ", [Str]), S1 end, St0, Args), io:nl(), {[],St1}. %% rawequal([Arg,Arg|_], State) -> {[Bool],State}. %% rawlen([Object|_], State) -> {[Length],State}. %% rawget([Table,Key|_], State) -> {[Val],State)}. %% rawset([Table,Key,Value|_]], State) -> {[Table],State)}. rawequal([A1,A2|_], St) -> {[A1 =:= A2],St}; rawequal(As, St) -> badarg_error(rawequal, As, St). rawlen([A|_], St) when is_binary(A) -> {[float(byte_size(A))],St}; rawlen([#tref{}=T|_], St) -> {[luerl_lib_table:raw_length(T, St)],St}; rawlen(As, St) -> badarg_error(rawlen, As, St). rawget([#tref{i=N},K|_], St) when is_number(K) -> #table{a=Arr,d=Dict} = ?GET_TABLE(N, St#luerl.ttab), %Get the table. V = case ?IS_INTEGER(K, I) of true when I >= 1 -> %Array index raw_get_index(Arr, I); _NegFalse -> %Negative or false raw_get_key(Dict, K) end, {[V],St}; rawget([#tref{i=N},K|_], St) -> #table{d=Dict} = ?GET_TABLE(N, St#luerl.ttab), %Get the table. V = raw_get_key(Dict, K), {[V],St}; rawget(As, St) -> badarg_error(rawget, As, St). rawset([#tref{i=N}=Tref,K,V|_], #luerl{ttab=Ts0}=St) when is_number(K) -> #table{a=Arr0,d=Dict0}=T = ?GET_TABLE(N, Ts0), Ts1 = case ?IS_INTEGER(K, I) of true when I >= 1 -> Arr1 = raw_set_index(Arr0, I, V), ?SET_TABLE(N, T#table{a=Arr1}, Ts0); _NegFalse -> %Negative or false Dict1 = raw_set_key(Dict0, K, V), ?SET_TABLE(N, T#table{d=Dict1}, Ts0) end, {[Tref],St#luerl{ttab=Ts1}}; rawset([Tref,nil=K,_|_], St) -> lua_error({illegal_index,Tref,K}, St); rawset([#tref{i=N}=Tref,K,V|_], #luerl{ttab=Ts0}=St) -> #table{d=Dict0}=T = ?GET_TABLE(N, Ts0), Dict1 = raw_set_key(Dict0, K, V), Ts1 = ?SET_TABLE(N, T#table{d=Dict1}, Ts0), {[Tref],St#luerl{ttab=Ts1}}; rawset(As, St) -> badarg_error(rawset, As, St). %% raw_get_index(Array, Index) -> nil | Value. %% raw_get_key(Dict, Key) -> nil | Value. raw_get_index(Arr, I) -> array:get(I, Arr). raw_get_key(Dict, K) -> case ttdict:find(K, Dict) of {ok,V} -> V; error -> nil end. raw_set_index(Arr, I, V) -> array:set(I, V, Arr). raw_set_key(Dict, K, nil) -> ttdict:erase(K, Dict); raw_set_key(Dict, K, V) -> ttdict:store(K, V, Dict). %% select(Args, State) -> {[Element],State}. select([<<$#>>|As], St) -> {[float(length(As))],St}; select([A|As], St) -> %%io:fwrite("sel:~p\n", [[A|As]]), Len = length(As), case luerl_lib:to_int(A) of N when is_integer(N), N > 0 -> {select_front(N, As, Len),St}; N when is_integer(N), N < 0 -> {select_back(-N, As, Len),St}; _ -> badarg_error(select, [A|As], St) end; select(As, St) -> badarg_error(select, As, St). select_front(N, As, Len) when N =< Len -> lists:nthtail(N-1, As); select_front(_, _, _) -> []. select_back(N, As, Len) when N =< Len -> lists:nthtail(Len-N, As); select_back(_, As, _) -> As. tonumber([Arg], St) -> {[luerl_lib:tonumber(Arg)],St}; tonumber([Arg,B|_], St) -> {[luerl_lib:tonumber(Arg, B)],St}; tonumber(As, St) -> badarg_error(tonumber, As, St). tostring([Arg|_], St) -> case luerl_emul:getmetamethod(Arg, <<"__tostring">>, St) of nil -> {[tostring(Arg)],St}; M when ?IS_FUNCTION(M) -> luerl_emul:functioncall(M, [Arg], St) %Return {R,St1} end. tostring(nil) -> <<"nil">>; tostring(false) -> <<"false">>; tostring(true) -> <<"true">>; tostring(N) when is_number(N) -> A = abs(N), %% Print really big/small "integers" as floats as well. S = if ?IS_INTEGER(N), A < 1.0e14 -> integer_to_list(round(N)); true -> io_lib:write(N) end, iolist_to_binary(S); tostring(S) when is_binary(S) -> S; tostring(#tref{i=I}) -> iolist_to_binary(["table: ",io_lib:write(I)]); tostring(#uref{}) -> <<"userdata">>; tostring(#lua_func{}) -> <<"function:">>; %Functions defined in Lua tostring(#erl_func{}) -> <<"function:">>; %Internal functions tostring(#thread{}) -> <<"thread">>; tostring(_) -> <<"unknown">>. type([Arg|_], St) -> {[type(Arg)],St}. %Only one return value! type(nil) -> <<"nil">>; type(N) when is_number(N) -> <<"number">>; type(S) when is_binary(S) -> <<"string">>; type(B) when is_boolean(B) -> <<"boolean">>; type(#tref{}) -> <<"table">>; type(#uref{}) -> <<"userdata">>; type(#lua_func{}) -> <<"function">>; %Functions defined in Lua type(#erl_func{}) -> <<"function">>; %Internal functions type(#thread{}) -> <<"thread">>; type(_) -> <<"unknown">>. %% getmetatable([Value|_], State) -> {Table,State}. %% setmetatable([Table,Table|nil|_], State) -> {Table,State}. %% Can only set the metatable of tables here. Return tables for all %% values, for tables and userdata it is the table of the object, %% else the metatable for the type. getmetatable([O|_], St) -> case luerl_emul:getmetatable(O, St) of #tref{i=N}=Meta -> #table{d=Dict} = ?GET_TABLE(N, St#luerl.ttab), case ttdict:find(<<"__metatable">>, Dict) of {ok,MM} -> {[MM],St}; error -> {[Meta],St} end; nil -> {[nil],St} end. setmetatable([#tref{}=T,#tref{}=M|_], St) -> do_setmetatable(T, M, St); setmetatable([#tref{}=T,nil|_], St) -> do_setmetatable(T, nil, St); setmetatable(As, St) -> badarg_error(setmetatable, As, St). do_setmetatable(#tref{i=N}=T, M, St) -> case luerl_emul:getmetamethod(T, <<"__metatable">>, St) of nil -> Ts = ?UPD_TABLE(N, fun (Tab) -> Tab#table{m=M} end, St#luerl.ttab), {[T],St#luerl{ttab=Ts}}; _ -> badarg_error(setmetatable, [T], St) end. %% Do files. dofile(As, St) -> case luerl_lib:conv_list(As, [string]) of [File] -> Ret = luerl_comp:file(File), %Compile the file dofile_ret(Ret, As, St); _ -> badarg_error(dofile, As, St) end. dofile_ret({ok,Chunk}, _, St0) -> {Func,St1} = luerl_emul:load_chunk(Chunk, St0), luerl_emul:call(Func, [], St1); dofile_ret({error,_,_}, As, St) -> badarg_error(dofile, As, St). %% Load string and files. load(As, St) -> case luerl_lib:conv_list(As, [string,lua_string,lua_string,lua_any]) of [S|_] -> Ret = luerl_comp:string(S), %Compile the string load_ret(Ret, St); nil -> badarg_error(load, As, St) end. loadfile(As, St) -> case luerl_lib:conv_list(As, [string,lua_string,lua_any]) of [F|_] -> Ret = luerl_comp:file(F), %Compile the file load_ret(Ret, St); nil -> badarg_error(loadfile, As, St) end. loadstring(As, St) -> case luerl_lib:conv_list(As, [string]) of [S] -> Ret = luerl_comp:string(S), %Compile the string load_ret(Ret, St); nil -> badarg_error(loadstring, As, St) end. load_ret({ok,Chunk}, St0) -> {Func,St1} = luerl_emul:load_chunk(Chunk, St0), {[Func],St1}; load_ret({error,[{_,Mod,E}|_],_}, St) -> Msg = iolist_to_binary(Mod:format_error(E)), {[nil,Msg],St}. pcall([F|As], St0) -> try {Rs,St1} = luerl_emul:functioncall(F, As, St0), {[true|Rs],St1} catch %% Only catch Lua errors here, signal system errors. error:{lua_error,{error_call, E},St2} -> {[false,E],St2}; error:{lua_error,E,St2} -> %% Basic formatting for now. Msg = iolist_to_binary(luerl_lib:format_error(E)), {[false,Msg],St2} end. %% Lua 5.1 compatibility functions. unpack(As, St) -> luerl_lib_table:unpack(As, St). luerl-0.4/src/ttsets.erl0000644000232200023220000002740213450242205015671 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : ttsets.erl %% Author : Robert Virding %% Purpose : Set as a 2-3 tree. %% This implementation uses 2-3 trees. The description of the tree %% restructuring which is used comes from Prof. Lyn Turbak's notes for %% CS230 Data Structures at Wellesley College. -module(ttsets). %% Standard interface. -export([new/0,is_set/1,size/1,to_list/1,from_list/1]). -export([is_element/2,add_element/2,del_element/2]). -export([union/2,union/1,intersection/2,intersection/1]). -export([is_disjoint/2,subtract/2,is_subset/2]). -export([fold/3,filter/2]). %% Extended interface. -export([foreach/2]). -compile({no_auto_import,[size/1]}). %We mean our own size/1 -ifdef(DEBUG). -export([check_depth/1]). -endif. %% Data structure: %% - {Left,Element,Right} %% - {Left,Element,Middle,Element,Right} %% - empty %% %% The term order is an arithmetic total order, so we should not %% test exact equality for the keys. (If we do, then it becomes %% possible that neither `>', `<', nor `=:=' matches.) Testing '<' %% and '>' first is statistically better than testing for %% equality, and also allows us to skip the test completely in the %% remaining case. -type ttset() :: empty | {empty,any(),empty} | {any(),any(),any()} | {empty,any(),empty,any(),empty} | {any(),any(),any(),any(),any()}. -export_type([ttset/0]). -spec new() -> Set::ttset(). %% Return a new empty set. new() -> empty. %The empty set -spec is_set(Set::ttset()) -> boolean(). %% Return 'true' if Set is a set, else 'false'. is_set(empty) -> true; is_set({A,_,B}) -> is_set(A) andalso is_set(B); is_set({A,_,B,_,C}) -> is_set(A) andalso is_set(B) andalso is_set(C); is_set(_) -> false. -spec size(Set::ttset()) -> non_neg_integer(). %% Return the number of elements in Set. size(empty) -> 0; size({A,_,B}) -> size(A) + size(B) + 1; size({A,_,B,_,C}) -> size(A) + size(B) + size(C) + 2. -spec to_list(Set::ttset()) -> [Element::any()]. %% Return the elements in Set as a list. to_list(D) -> to_list(D, []). to_list(empty, Tail) -> Tail; to_list({A,X,B}, Tail) -> to_list(A, [X|to_list(B, Tail)]); to_list({A,X,B,Y,C}, Tail) -> to_list(A, [X|to_list(B, [Y|to_list(C, Tail)])]). -spec from_list([Element::any()]) -> Dict::ttset(). %% Build a set from the elements in list. from_list(List) -> lists:foldl(fun (E, S) -> add_element(E, S) end, new(), List). -spec is_element(Element::any(), Set::ttset()) -> boolean(). %% Return 'true' if Element is an element of Set, else 'false'. is_element(_, empty) -> false; is_element(E, {A,X,_}) when E < X -> is_element(E, A); is_element(E, {_,X,B}) when E > X -> is_element(E, B); is_element(_, {_,_,_}) -> true; is_element(E, {A,X,_,_,_}) when E < X -> is_element(E, A); is_element(E, {_,X,B,Y,C}) when E > X -> if E < Y -> is_element(E, B); %Middle E > Y -> is_element(E, C); %Right true -> true end; is_element(_, {_,_,_,_,_}) -> true. -spec add_element(Element::any(), Set::ttset()) -> Set::ttset(). %% Return Set with Element inserted in it. add_element(E, T) -> %% Store and check for a returned "Up" node. case add_aux(E, T) of {up,Lu,Eu,Ru} -> {Lu,Eu,Ru}; Node -> Node end. add_aux(E, empty) -> {up,empty,E,empty}; %"Up" node add_aux(E, {empty,X,empty}=N) -> %% Special case to avoid creating temporary "up" nodes. %% It helps a little bit, but not much. if E < X -> {empty,E,empty,X,empty}; E > X -> {empty,X,empty,E,empty}; true -> N end; add_aux(E, {A,X,B}=N) -> if E < X -> %Down the left add_up2_l(add_aux(E, A), X, B); E > X -> %Down the right add_up2_r(A, X, add_aux(E, B)); true -> N %Replace current value end; add_aux(E, {A,X,B,Y,C}) when E < X -> add_up3_l(add_aux(E, A), X, B, Y, C); add_aux(E, {A,X,B,Y,C}=N) when E > X -> if E < Y -> %Down the middle add_up3_m(A, X, add_aux(E, B), Y, C); E > Y -> %Down the right add_up3_r(A, X, B, Y, add_aux(E, C)); true -> N end; add_aux(_, {_,_,_,_,_}=N) -> N. %% add_up2_l/r(L, X, R) -> {L,X,M,X,R} | {L,X,R}. add_up2_l({up,Lu,X,Ru}, Y, R) -> {Lu,X,Ru,Y,R}; add_up2_l(L, X, R) -> {L,X,R}. add_up2_r(L, X, {up,Lu,Y,Ru}) -> {L,X,Lu,Y,Ru}; add_up2_r(L, X, R) -> {L,X,R}. %% add_up3_l/m/r(L, X, M, Y, R) -> %% {up,L,X,R} | {L,X,M,Y,R}. add_up3_l({up,Lu,X,Ru}, Y, M, Z, R) -> {up,{Lu,X,Ru},Y,{M,Z,R}}; add_up3_l(L, X, M, Y, R) -> {L,X,M,Y,R}. add_up3_m(L, X, {up,Lu,Y,Ru}, Z, R) -> {up,{L,X,Lu},Y,{Ru,Z,R}}; add_up3_m(L, X, M, Y, R) -> {L,X,M,Y,R}. add_up3_r(L, X, M, Y, {up,Lu,Z,Ru}) -> {up,{L,X,M},Y,{Lu,Z,Ru}}; add_up3_r(L, X, M, Y, R) -> {L,X,M,Y,R}. -spec del_element(Element::any(), Set::ttset()) -> Set::ttset(). %% Return Set but with Element removed. del_element(E, T) -> case del_aux(E, T) of {up,T1} -> T1; T1 -> T1 end. del_aux(_, empty) -> empty; %No element del_aux(E, {empty,X,empty}=N) -> if E < X; E > X -> N; %No element true -> {up,empty} end; del_aux(E, {A,X,B}) -> if E < X -> %Down the left del_up2_l(del_aux(E, A), X, B); E > X -> %Down the right del_up2_r(A, X, del_aux(E, B)); true -> {Bm,B1}= del_min(B), del_up2_r(A, Bm, B1) end; del_aux(E, {empty,X,empty,Y,empty}=N) -> if E < X -> N; %No element E > X -> if E < Y -> N; %No element E > Y -> N; true -> {empty,X,empty} end; true -> {empty,Y,empty} end; del_aux(E, {A,X,B,Y,C}) when E < X -> del_up3_l(del_aux(E, A), X, B, Y, C); del_aux(E, {A,X,B,Y,C}) when E > X -> if E < Y -> del_up3_m(A, X, del_aux(E, B), Y, C); E > Y -> del_up3_r(A, X, B, Y, del_aux(E, C)); true -> {Cm,C1} = del_min(C), del_up3_r(A, X, B, Cm, C1) end; del_aux(_, {A,_,B,Y,C}) -> {Bm,B1} = del_min(B), del_up3_m(A, Bm, B1, Y, C). del_min(T) -> %%io:format("em: ~p\n-> ~p\n", [T,T1]), del_min1(T). del_min1({empty,X,empty}) -> {X,{up,empty}}; del_min1({A,X,B}) -> {Min,A1} = del_min1(A), {Min,del_up2_l(A1, X, B)}; del_min1({empty,X,empty,Y,empty}) -> {X,{empty,Y,empty}}; del_min1({A,X,B,Y,C}) -> {Min,A1} = del_min1(A), {Min,del_up3_l(A1, X, B, Y, C)}. %% del_up2_l/r(L, X, R) -> Node | {up,Node}. %% We use the same naming of nodes and keys as in the text. It makes %% checking the rules easier. del_up2_l({up,L}, X, {M,Y,R}) -> %1.1 {up,{L,X,M,Y,R}}; del_up2_l({up,A}, X, {B,Y,C,Z,D}) -> %2.1 {{A,X,B},Y,{C,Z,D}}; del_up2_l(L, X, R) -> {L,X,R}. del_up2_r({L,X,M}, Y, {up,R}) -> %1.2 {up,{L,X,M,Y,R}}; del_up2_r({A,X,B,Y,C}, Z, {up,D}) -> %2.2 {{A,X,B},Y,{C,Z,D}}; del_up2_r(L, X, R) -> {L,X,R}. %% del_up2_r(L, X, {up,R}) -> del_up2_r1(L, X, R); %% del_up2_r(L, X, R) -> {L,K,V,R}. %% del_up2_r1({L,X,M}, Y, R) -> %1.2 %% {up,{L,X,M,Y,R}}; %% del_up2_r1({A,X,B,Y,C}, Z, D) -> %2.2 %% {{A,X,B},Y,{C,Z,D}}. %% del_up3_l/m/r(L, X, M, Y, R) -> Node | {up,Node}. %% We use the same naming of nodes and keys as in the text. It makes %% checking the rules easier. N.B. there are alternate valid choices %% for the middle case! del_up3_l({up,A}, X, {B,Y,C}, Z, D) -> %3a.1 {{A,X,B,Y,C},Z,D}; del_up3_l({up,A}, W, {B,X,C,Y,D}, Z, E) -> %4a.1 {{A,W,B},X,{C,Y,D},Z,E}; del_up3_l(A, X, B, Y, C) -> {A,X,B,Y,C}. del_up3_m({A,X,B}, Y, {up,C}, Z, D) -> %3a.2 {{A,X,B,Y,C},Z,D}; del_up3_m(A, X, {up,B}, Y, {C,Z,D}) -> %3b.1 {A,X,{B,Y,C,Z,D}}; del_up3_m({A,W,B,X,C}, Y, {up,D}, Z, E) -> %4a.2 {{A,W,B},X,{C,Y,D},Z,E}; del_up3_m(A, W, {up,B}, X, {C,Y,D,Z,E}) -> %4b.1 {A,W,{B,X,C},Y,{D,Z,E}}; del_up3_m(A, X, B, Y, C) -> {A,X,B,Y,C}. del_up3_r(A, X, {B,Y,C}, Z, {up,D}) -> %3b.2 {A,X,{B,Y,C,Z,D}}; del_up3_r(A, W, {B,X,C,Y,D}, Z, {up,E}) -> %4b.2 {A,W,{B,X,C},Y,{D,Z,E}}; del_up3_r(A, X, B, Y, C) -> {A,X,B,Y,C}. -spec union(Set1::ttset(), Set2::ttset()) -> Set::ttset(). %% Return the union of Set1 and Set2. union(S1, S2) -> fold(fun (E, S) -> add_element(E, S) end, S2, S1). -spec union(Sets::[ttset()]) -> Set::ttset(). %% Return the union of the list of sets. union([S1,S2|Ss]) -> %% Do our own unions here to try and fold over smaller set. U0 = union(Ss), U1 = fold(fun (E, S) -> add_element(E, S) end, U0, S2), fold(fun (E, S) -> add_element(E, S) end, U1, S1); union([S]) -> S; union([]) -> empty. -spec intersection(Set1::ttset(), Set2::ttset()) -> Set::ttset(). %% Return the intersection of Set1 and Set2. intersection(S1, S2) -> filter(fun (E) -> is_element(E, S1) end, S2). -spec intersection(Sets::[ttset()]) -> Set::ttset(). %% Return the intersection of the list of sets. intersection([S]) -> S; intersection([S|Ss]) -> lists:foldl(fun (S1, I) -> intersection(S1, I) end, S, Ss). -spec is_disjoint(Set1::ttset(), Set2::ttset()) -> boolean(). %% Check whether Set1 and Set2 are disjoint. is_disjoint(S1, S2) -> fold(fun (E, Dis) -> Dis andalso (not is_element(E, S2)) end, true, S1). -spec subtract(Set1::ttset(), Set2::ttset()) -> Set::ttset(). %% Return all and only the elements in Set1 which are not elements of Set2. subtract(S1, S2) -> filter(fun (E) -> not is_element(E, S2) end, S1). -spec is_subset(Set1::ttset(), Set2::ttset()) -> boolean(). %% Return 'true' when every element of Set1 is also an element of %% Set2, else 'false'. is_subset(S1, S2) -> fold(fun (E, Sub) -> Sub andalso is_element(E, S2) end, true, S1). -spec fold(Fun::fun(), Acc::any(), Set::ttset()) -> any(). %% Apply Fun to each element in Set. Do it left to right, even if %% this is not specified. fold(_, Acc, empty) -> Acc; fold(F, Acc0, {A,X,B}) -> Acc1 = F(X, fold(F, Acc0, A)), fold(F, Acc1, B); fold(F, Acc0, {A,X,B,Y,C}) -> Acc1 = F(X, fold(F, Acc0, A)), Acc2 = F(Y, fold(F, Acc1, B)), fold(F, Acc2, C). -spec filter(Fun::fun(), Set::ttset()) -> Set::ttset(). %% Apply Fun to each element in Dict. Do it left to right, even if %% this is not specified. filter(F, S) -> filter(F, S, new()). filter(_, empty, New) -> New; filter(F, {A,X,B}, New0) -> New1 = filter(F, A, New0), New2 = case F(X) of true -> add_element(X, New1); false -> New1 end, filter(F, B, New2); filter(F, {A,X,B,Y,C}, New0) -> New1 = filter(F, A, New0), New2 = case F(X) of true -> add_element(X, New1); false -> New1 end, New3 = filter(F, B, New2), New4 = case F(Y) of true -> add_element(Y, New3); false -> New3 end, filter(F, C, New4). %% Extended interface. -spec foreach(Fun::fun(), Set::ttset()) -> ok. %% Apply Fun to each element in Set. Do it left to right, even if %% this is not specified. foreach(_, empty) -> ok; foreach(F, {A,X,B}) -> foreach(F, A), F(X), foreach(F, B); foreach(F, {A,X,B,Y,C}) -> foreach(F, A), F(X), foreach(F, B), F(Y), foreach(F, C). -ifdef(DEBUG). %% Check the depth of all the leaves, should all be the same. check_depth(T) -> check_depth(T, 1, orddict:new()). check_depth(empty, D, Dd) -> orddict:update_counter(D, 1, Dd); check_depth({L,_,R}, D, Dd0) -> Dd1 = orddict:update_counter(two, 1, Dd0), Dd2 = check_depth(L, D+1, Dd1), check_depth(R, D+1, Dd2); check_depth({L,_,M,_,R}, D, Dd0) -> Dd1 = orddict:update_counter(three, 1, Dd0), Dd2 = check_depth(L, D+1, Dd1), Dd3 = check_depth(M, D+1, Dd2), check_depth(R, D+1, Dd3). -endif. luerl-0.4/src/luerl_sup.erl0000644000232200023220000000243313450242205016352 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. -module(luerl_sup). -behaviour(supervisor). %% API -export([start_link/0]). %% Supervisor callbacks -export([init/1]). %% Helper macro for declaring children of supervisor -define(CHILD(I, Type), {I, {I, start_link, []}, permanent, 5000, Type, [I]}). %% =================================================================== %% API functions %% =================================================================== start_link() -> supervisor:start_link({local, ?MODULE}, ?MODULE, []). %% =================================================================== %% Supervisor callbacks %% =================================================================== init([]) -> {ok, { {one_for_one, 5, 10}, []} }. luerl-0.4/src/luerl_comp.erl0000644000232200023220000004442613450242205016511 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_comp.erl %% Author : Robert Virding %% Purpose : A basic LUA 5.2 compiler for Luerl. %% This is the main loop of the Luerl compiler. While we can handle %% errors in this loop they should never occur as Lua basically allows %% almost everything that gets past the parser. The only exception are %% goto's to undefined labels, but we don't handle goto's yet. %% %% We also have the first pass here. It normalises the code and %% converts to an internal form. -module(luerl_comp). -export([file/1,file/2,string/1,string/2,forms/1,forms/2]). -export([debug_print/3]). -import(lists, [member/2,keysearch/3,mapfoldl/3]). -include_lib("kernel/include/file.hrl"). -include("luerl.hrl"). -include("luerl_comp.hrl"). -record(comp, {base="", %Base name odir=".", %Output directory lfile="", %Lua file bfile="", %Beam file cfile="", %Core file opts=[], %User options mod=[], %Module name ret=file, %What is returned [Val] | [] code=none, %Code after last pass. errors=[], warnings=[] }). file(Name) -> file(Name, [verbose,report]). file(Name, Opts) -> St0 = #comp{opts=Opts}, St1 = filenames(Name, St0), compile(file_passes(), St1). %% filenames(File, State) -> State. %% The default output dir is the current directory unless an %% explicit one has been given in the options. filenames(File, St) -> %% Test for explicit outdir. Odir = case keysearch(outdir, 1, St#comp.opts) of {value,{outdir,D}} -> D; false -> "." end, Dir = filename:dirname(File), Base = filename:basename(File, ".lua"), Lfile = filename:join(Dir, Base ++ ".lua"), Bfile = Base ++ ".beam", Cfile = Base ++ ".core", St#comp{base=Base, lfile=Lfile, odir=Odir, bfile=filename:join(Odir, Bfile), cfile=filename:join(Odir, Cfile)}. string(Str) -> string(Str, [verbose,report]). string(Str, Opts) when is_binary(Str) -> string(binary_to_list(Str), Opts); string(Str, Opts) when is_list(Str) -> St0 = #comp{opts=Opts,code=Str}, St1 = filenames("-no-file-", St0), compile(list_passes(), St1). forms(Forms) -> forms(Forms, [verbose,report]). forms(Forms, Opts) -> St0 = #comp{opts=Opts,code=Forms}, St1 = filenames("-no-file-", St0), compile(forms_passes(), St1). compile(Ps, St0) -> case do_passes(Ps, St0) of {ok,St1} -> do_ok_return(St1); {error, St1} -> do_error_return(St1) end. %% file_passes() -> [Pass]. %% list_passes() -> [Pass]. %% forms_passes() -> [Pass]. %% do_passes(Passes, State) -> {ok,State} | {error,Reason}. %% {when_flag,Flag,Cmd} %% {unless_flag,Flag,Cmd} %% {do,Fun} %% {done,PrintFun,Ext} file_passes() -> %Reading from file [{do,fun do_read_file/1}, {do,fun do_parse/1}| forms_passes()]. list_passes() -> %Scanning string [{do,fun do_scan/1}, {do,fun do_parse/1}| forms_passes()]. forms_passes() -> %Doing the forms [{do,fun do_pass_1/1}, {do,fun do_comp_vars/1}, {when_flag,to_vars,{done,fun(St) -> {ok,St} end}}, %% {do,fun do_comp_locf/1}, {do,fun do_comp_env/1}, {when_flag,to_env,{done,fun(St) -> {ok,St} end}}, {do,fun do_code_gen/1}, {unless_flag,no_iopt,{do,fun do_peep_op/1}}]. do_passes([{do,Fun}|Ps], St0) -> case Fun(St0) of {ok,St1} -> do_passes(Ps, St1); {error,St1} -> {error,St1} end; do_passes([{when_flag,Flag,Cmd}|Ps], St) -> case member(Flag, St#comp.opts) of true -> do_passes([Cmd|Ps], St); false -> do_passes(Ps, St) end; do_passes([{unless_flag,Flag,Cmd}|Ps], St) -> case member(Flag, St#comp.opts) of true -> do_passes(Ps, St); false -> do_passes([Cmd|Ps], St) end; do_passes([{done,Fun}|_], St) -> Fun(St); do_passes([], St) -> {ok,St}. %% do_read_file(State) -> {ok,State} | {error,State}. %% do_scan(State) -> {ok,State} | {error,State}. %% do_parse(State) -> {ok,State} | {error,State}. %% do_pass_1(State) -> {ok,State} | {error,State}. %% The actual compiler passes. do_read_file(#comp{lfile=Name}=St) -> %% Read the bytes in a file skipping an initial # line or Windows BOM. case file:open(Name, [read]) of {ok,F} -> %% Check if first line a script or Windows BOM, if so skip it. case io:get_line(F, '') of "#" ++ _ -> ok; %Skip line [239,187,191|_] -> file:position(F, 3); %Skip BOM _ -> file:position(F, bof) %Get it all end, %% Now read the file. Ret = case io:request(F, {get_until,latin1,'',luerl_scan,tokens,[1]}) of {ok,Ts,_} -> {ok,St#comp{code=Ts}}; {error,E,L} -> {error,St#comp{errors=[{L,io,E}]}} end, file:close(F), Ret; {error,E} -> {error,St#comp{errors=[{none,file,E}]}} end. do_scan(#comp{code=Str}=St) -> case luerl_scan:string(Str) of {ok,Ts,_} -> {ok,St#comp{code=Ts}}; {error,E,_} -> {error,St#comp{errors=[E]}} end. do_parse(#comp{code=Ts}=St) -> case luerl_parse:chunk(Ts) of {ok,Chunk} -> {ok,St#comp{code=Chunk}}; {error,E} -> {error,St#comp{errors=[E]}} end. do_pass_1(#comp{code=C0,opts=Opts}=St) -> {ok,C1} = chunk(C0, Opts), {ok,St#comp{code=C1}}. do_comp_vars(St) -> case luerl_comp_vars:chunk(St#comp.code, St#comp.opts) of {ok,C1} -> {ok,St#comp{code=C1}}; {ok,C1,Ws} -> {ok,St#comp{code=C1,warnings=Ws}}; {error,Es} -> {error,St#comp{errors=Es}} end. %% do_comp_locf(St) -> %% case luerl_comp_locf:chunk(St#comp.code, St#comp.opts) of %% {ok,C1} -> {ok,St#comp{code=C1}}; %% {ok,C1,Ws} -> {ok,St#comp{code=C1,warnings=Ws}}; %% {error,Es} -> {error,St#comp{errors=Es}} %% end. do_comp_env(St) -> case luerl_comp_env:chunk(St#comp.code, St#comp.opts) of {ok,C1} -> {ok,St#comp{code=C1}}; {ok,C1,Ws} -> {ok,St#comp{code=C1,warnings=Ws}}; {error,Es} -> {error,St#comp{errors=Es}} end. do_code_gen(St) -> case luerl_comp_cg:chunk(St#comp.code, St#comp.opts) of {ok,C1} -> {ok,St#comp{code=C1}}; {ok,C1,Ws} -> {ok,St#comp{code=C1,warnings=Ws}}; {error,Es} -> {error,St#comp{errors=Es}} end. do_peep_op(St) -> case luerl_comp_peep:chunk(St#comp.code, St#comp.opts) of {ok,C1} -> {ok,St#comp{code=C1}}; {ok,C1,Ws} -> {ok,St#comp{code=C1,warnings=Ws}}; {error,Es} -> {error,St#comp{errors=Es}} end. do_ok_return(#comp{code=C}) -> {ok,C}. do_error_return(#comp{errors=Es,warnings=Ws}) -> {error,Es,Ws}. debug_print(Opts, Format, Args) -> case member(debug_print, Opts) of true -> io:fwrite(Format, Args); false -> ok end. %% The first pass (pass_1). %% Here we normalise the code and convert it to an internal form. %% chunk(Code, Options) -> {ok,Code} | {error,Reason}. chunk(Code0, Opts) -> Cst = #cst{}, %Initialise common state {Code1,nil} = functiondef(Code0, nil), %This is local! debug_print(Opts, "c: ~p\n", [Code1]), {ok,#code{code=Code1,cst=Cst}}. %% stmts([{local,L,{functiondef,_,Name,_,_}=F}|Ss], St) -> %% %% Need to split this to handle recursive definitions. %% stmts([{local,L,{assign,L,[Name],[{nil,L}]}},F|Ss], St); stmts([{';',_}|Ss], St) -> stmts(Ss, St); %No-op so we drop it stmts([S0|Ss0], St0) -> {S1,St1} = stmt(S0, St0), {Ss1,St2} = stmts(Ss0, St1), {[S1|Ss1],St2}; stmts([], St) -> {[],St}. %% stmt(Statement, State) -> {CStat,State}. %% Do a statement. The ';' statement will caught and removed in stmts/2. stmt({assign,Line,Vs,Es}, St) -> assign_stmt(Line, Vs, Es, St); stmt({return,Line,Es}, St) -> return_stmt(Line, Es, St); stmt({break,L}, St) -> %Interesting {#break_stmt{l=L},St}; stmt({block,Line,B}, St) -> block_stmt(Line, B, St); stmt({while,Line,Exp,B}, St) -> while_stmt(Line, Exp, B, St); stmt({repeat,Line,B,Exp}, St) -> repeat_stmt(Line, B, Exp, St); stmt({'if',Line,Tests,Else}, St) -> if_stmt(Line, Tests, Else, St); stmt({for,Line,V,I,L,B}, St) -> %Default step of 1.0 numfor_stmt(Line, V, I, L, {'NUMBER',Line,1.0}, B, St); stmt({for,Line,V,I,L,S,B}, St) -> numfor_stmt(Line, V, I, L, S, B, St); stmt({for,Line,Ns,Gs,B}, St) -> genfor_stmt(Line, Ns, Gs, B, St); stmt({functiondef,Line,Fname,Ps,B}, St) -> fdef_stmt(Line, Fname, Ps, B, St); stmt({local,Line,Local}, St) -> local_stmt(Line, Local, St); stmt(Exp, St) -> %This is really just a call Line = element(2, Exp), call_stmt(Line, Exp, St). %% assign_stmt(Line, Vars, Exps, State) -> {Assign,State}. assign_stmt(Line, Vs, Es, St0) -> {Ces,St1} = explist(Es, St0), {Cvs,St2} = assign_loop(Vs, St1), {#assign_stmt{l=Line,vs=Cvs,es=Ces},St2}. assign_loop([V|Vs], St0) -> {Cv,St1} = var(V, St0), {Cvs,St2} = assign_loop(Vs, St1), {[Cv|Cvs],St2}; assign_loop([], St) -> {[],St}. %% var(VarExp, State) -> {VarExp,State}. %% Step down the prefixexp sequence evaluating as we go, stop at the %% END and return a key and a table where to put data. This is a %% prefixexp with different tail. var({'.',L,Exp,Rest}, St0) -> {Ce,St1} = prefixexp_first(Exp, St0), {Cr,St2} = var_rest(Rest, St1), {dot(L, Ce, Cr),St2}; var({'NAME',L,N}, St) -> {var_name(L, N),St}. var_rest({'.',L,Exp,Rest}, St0) -> {Ce,St1} = prefixexp_element(Exp, St0), {Cr,St2} = var_rest(Rest, St1), {dot(L, Ce, Cr),St2}; var_rest(Exp, St) -> var_last(Exp, St). var_last({'NAME',L,N}, St) -> %% Transform this to a key_field with the name string. NO! {#key{l=L,k=lit_name(L, N)},St}; var_last({key_field,L,Exp}, St0) -> {Ce,St1} = exp(Exp, St0), {#key{l=L,k=Ce},St1}. %% call_stmt(Line, Exp, State) -> {Call,State}. call_stmt(Line, Exp, St0) -> {Ce,St1} = exp(Exp, St0), {#call_stmt{l=Line,call=Ce},St1}. %% return_stmt(Line, Exps, State) -> {Return,State}. return_stmt(Line, Es, St0) -> {Ces,St1} = explist(Es, St0), {#return_stmt{l=Line,es=Ces},St1}. %% block_stmt(Line, Stats, State) -> {Block,Stmte}. block_stmt(Line, Ss0, St0) -> {Ss1,St1} = stmts(Ss0, St0), {#block_stmt{l=Line,ss=Ss1},St1}. block(Line, Ss0, St0) -> {Ss1,St1} = stmts(Ss0, St0), {#block{l=Line,ss=Ss1},St1}. %% while_stmt(Line, Exp, Block, State) -> {While,State}. while_stmt(Line, Exp, B, St0) -> {Ce,St1} = exp(Exp, St0), {Cb,St2} = block(Line, B, St1), {#while_stmt{l=Line,e=Ce,b=Cb},St2}. %% repeat_stmt(Line, Block, Exp, State) -> {Repeat,State}. %% Append the test expression into the block as a single value %% expression. repeat_stmt(Line, B, Exp, St0) -> {Cb0,St1} = block(Line, B, St0), {Ce,St2} = expr_stmt(Line, {single,Line,Exp}, St1), Cb1 = Cb0#block{ss=Cb0#block.ss ++ [Ce]}, {#repeat_stmt{l=Line,b=Cb1},St2}. %% if_stmt(Line, Test, Else, State) -> {If,State}. if_stmt(Line, Tests, Else, St0) -> {Cts,St1} = if_tests(Line, Tests, St0), {Ce,St2} = block(Line, Else, St1), {#if_stmt{l=Line,tests=Cts,else=Ce},St2}. if_tests(L, Ts, St) -> Test = fun ({T,B}, S0) -> {Ct,S1} = exp(T, S0), {Cb,S2} = block(L, B, S1), {{Ct,Cb},S2} end, mapfoldl(Test, St, Ts). %% numfor_stmt(Line, Var, Init, Limit, Step, Stmts, State) -> {NumFor,State}. numfor_stmt(Line, {'NAME',Ln,N}, I0, L0, S0, Ss, St0) -> Var = var_name(Ln, N), {[I1,L1,S1],St1} = explist([I0,L0,S0], St0), {B,St2} = block(Line, Ss, St1), {#nfor_stmt{l=Line,v=Var,init=I1,limit=L1,step=S1,b=B},St2}. %% genfor_stmt(Line, Vars, Generators, Stmts, State) -> {GenFor,State}. genfor_stmt(Line, Vs0, Gs0, Ss, St0) -> Vs1 = [ var_name(Ln, N) || {'NAME',Ln,N} <- Vs0 ], {Gs1,St1} = explist(Gs0, St0), {B,St2} = block(Line, Ss, St1), {#gfor_stmt{l=Line,vs=Vs1,gens=Gs1,b=B},St2}. %% fdef_stmt(Line, Name, Pars, Stmts, State) -> {Fdef,State}. %% Transform this to an assign. fdef_stmt(Line, Fname, Ps, B, St0) -> {V,F,St1} = functiondef(Line, Fname, Ps, B, St0), {#assign_stmt{l=Line,vs=[V],es=[F]},St1}. %% functiondef(FunctionDef, State) -> {CFunc,State}. %% functiondef(Line, Pars, Block, State) -> {CFunc,State}. %% functiondef(Line, Name, Pars, Block, State) -> {Var,CFunc,State}. %% Have to handle the case where the function is a "method". All this %% really means is that the function has an extra parameter 'self' %% prepended to the paramter list. functiondef({functiondef,L,Ps,B}, St) -> functiondef(L, Ps, B, St). functiondef(L, Ps, Stmts, St0) -> {Cp,Cb,St1} = function_block(Ps, Stmts, St0), {#fdef{l=L,ps=Cp,ss=Cb},St1}. functiondef(L, Name0, Ps0, B, St0) -> %% Check if method and transform method to 'NAME'. case is_method(Name0) of %Export Name1 and Ps1 {yes,Name1} -> Ps1 = [{'NAME',L,self}|Ps0]; no -> Name1 = Name0, Ps1 = Ps0 end, {Var,St1} = funcname(Name1, St0), {F,St2} = functiondef(L, Ps1, B, St1), {Var,F,St2}. is_method({'NAME',_,_}) -> no; is_method({'.',L,N,Rest0}) -> case is_method(Rest0) of {yes,Rest1} -> {yes,{'.',L,N,Rest1}}; no -> no %No change end; is_method({method,_,{'NAME',_,_}=N}) -> {yes,N}. %% funcname(FuncNameExp, State) -> {CFuncNameExp,State}. funcname({'.',L,Exp,Rest}, St0) -> {Ce,St1} = funcname_first(Exp, St0), {Cr,St2} = funcname_rest(Rest, St1), {dot(L, Ce, Cr),St2}; funcname({'NAME',L,N}, St) -> {var_name(L, N),St}. funcname_first({'NAME',L,N}, St) -> {var_name(L, N),St}. funcname_rest({'.',L,Exp,Rest}, St0) -> {Ce,St1} = funcname_element(Exp, St0), {Cr,St2} = funcname_rest(Rest, St1), {dot(L, Ce, Cr),St2}; funcname_rest(Exp, St) -> funcname_last(Exp, St). funcname_element({'NAME',L,N}, St) -> %% Transform this to key_field with the name string. {#key{l=L,k=lit_name(L, N)},St}. %% Method call has been transformed away funcname_last({'NAME',L,N}, St) -> %% Transform this to key_field with the name string. {#key{l=L,k=lit_name(L, N)},St}. %% local_stmt(Line, Local, State) -> {Assign,State}. %% Create and assign local variables. local_stmt(Line, {functiondef,Lf,Name,Ps,B}, St0) -> {Var,F,St1} = functiondef(Lf, Name, Ps, B, St0), {#local_fdef_stmt{l=Line,v=Var,f=F},St1}; local_stmt(Line, {assign,_,Ns,Es}, St0) -> {Ces,St1} = explist(Es, St0), {Cns,St2} = mapfoldl(fun (V, St) -> var(V, St) end, St1, Ns), {#local_assign_stmt{l=Line,vs=Cns,es=Ces},St2}. %% expr_stmt(Line, Exp, State) -> {Call,State}. %% The expression pseudo statement. This will return a single value. expr_stmt(Line, Exp, St0) -> {Ce,St1} = exp(Exp, St0), {#expr_stmt{l=Line,exp=Ce},St1}. %% explist(Exprs, State) -> {Ins,State}. %% exp(Expression, State) -> {Ins,State}. explist([E|Es], St0) -> {Ce,St1} = exp(E, St0), {Ces,St2} = explist(Es, St1), {[Ce|Ces],St2}; explist([], St) -> {[],St}. %No expressions at all exp({nil,L}, St) -> {#lit{l=L,v=nil},St}; exp({false,L}, St) -> {#lit{l=L,v=false},St}; exp({true,L}, St) -> {#lit{l=L,v=true},St}; exp({'NUMBER',L,N}, St) -> {#lit{l=L,v=N},St}; exp({'STRING',L,S}, St) -> {#lit{l=L,v=S},St}; exp({'...',L}, St) -> {var_name(L, '...'),St}; %% {#lit{l=L,v='...'},St}; exp({functiondef,L,Ps,B}, St0) -> {Cf,St1} = functiondef(L, Ps, B, St0), {Cf,St1}; exp({table,L,Fs}, St0) -> {Cfs,St1} = tableconstructor(Fs, St0), {#tc{l=L,fs=Cfs},St1}; exp({op,L,Op,A1,A2}, St0) -> {Ca1,St1} = exp(A1, St0), {Ca2,St2} = exp(A2, St1), {#op{l=L,op=Op,as=[Ca1,Ca2]},St2}; exp({op,L,Op,A}, St0) -> {Ca,St1} = exp(A, St0), {#op{l=L,op=Op,as=[Ca]},St1}; exp(E, St) -> prefixexp(E, St). %% prefixexp(PrefixExp, State) -> {CPrefixExp,State}. prefixexp({'.',L,Exp,Rest}, St0) -> {Ce,St1} = prefixexp_first(Exp, St0), {Cr,St2} = prefixexp_rest(Rest, St1), {dot(L, Ce, Cr),St2}; prefixexp(P, St) -> prefixexp_first(P, St). prefixexp_first({'NAME',L,N}, St) -> {var_name(L, N),St}; prefixexp_first({single,L,E}, St0) -> {Ce,St1} = exp(E, St0), {#single{l=L,e=Ce},St1}. prefixexp_rest({'.',L,Exp,Rest}, St0) -> {Ce,St1} = prefixexp_element(Exp, St0), {Cr,St2} = prefixexp_rest(Rest, St1), {dot(L, Ce, Cr),St2}; prefixexp_rest(Exp, St) -> prefixexp_element(Exp, St). prefixexp_element({'NAME',L,N}, St) -> %% Transform this to a key_field with the name string {#key{l=L,k=lit_name(L, N)},St}; prefixexp_element({key_field,L,Exp}, St0) -> {Ce,St1} = exp(Exp, St0), {#key{l=L,k=Ce},St1}; prefixexp_element({functioncall,L,Args}, St0) -> {Cas,St1} = explist(Args, St0), {#fcall{l=L,as=Cas},St1}; prefixexp_element({methodcall,Lm,{'NAME',Ln,N},Args}, St0) -> {Args1,St1} = explist(Args, St0), {#mcall{l=Lm,m=lit_name(Ln, N),as=Args1},St1}. dot(L, Exp, Rest) -> #dot{l=L,e=Exp,r=Rest}. function_block(Pars, Stmts, St0)-> {Cps,St1} = make_local_pars(Pars, St0), {Cs,St2} = stmts(Stmts, St1), %% io:format("fb: ~p\n", [{St3#comp.fs}]), {Cps,Cs,St2}. make_local_pars(Ps, St) -> Add = fun ({'NAME',L,N}, S) -> {var_name(L, N),S}; ({'...',L}, S) -> {var_name(L, '...'),S} end, mapfoldl(Add, St, Ps). %% tableconstrutor(Fields, State) -> {Instrs,State}. %% Build the instructions to construct a table. We could be smarter %% here and recognise already uses keys and only actually insert the %% last one. Or we could pre-order the table elements so the keys are %% already sorted. We can't unpack the last field if it is a multiple %% value efield as this must be done at run-time. tableconstructor(Fs, St0) -> %% N.B. this fun is for a MAPFOLDL!! Fun = fun ({exp_field,L,Ve}, S0) -> {Ce,S1} = exp(Ve, S0), %Value {#efield{l=L,v=Ce},S1}; ({name_field,L,{'NAME',Ln,N},Ve}, S0) -> {Ce,S1} = exp(Ve, S0), %Value {#kfield{l=L,k=lit_name(Ln, N),v=Ce},S1}; ({key_field,L,Ke,Ve}, S0) -> {Ck,S1} = exp(Ke, S0), %Key {Cv,S2} = exp(Ve, S1), %Value {#kfield{l=L,k=Ck,v=Cv},S2} end, {Cfs,St1} = mapfoldl(Fun, St0, Fs), {Cfs,St1}. %% name_string(Name) -> String. %% var_name(Line, Name) -> #var{}. %% lit_name(Line, Name) -> #lit{}. name_string(Name) -> atom_to_binary(Name, latin1). lit_name(L, N) -> #lit{l=L,v=name_string(N)}. var_name(L, N) -> #var{l=L,n=name_string(N)}. luerl-0.4/src/luerl_app.erl0000644000232200023220000000166713450242205016333 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. -module(luerl_app). -behaviour(application). %% Application callbacks -export([start/2, stop/1]). %% =================================================================== %% Application callbacks %% =================================================================== start(_StartType, _StartArgs) -> luerl_sup:start_link(). stop(_State) -> ok. luerl-0.4/src/luerl_sandbox.erl0000644000232200023220000000605613450242205017206 0ustar debalancedebalance%% Copyright (c) 2013-2017 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_sandbox.erl %% Authors : Tyler Butchart %% Purpose : Reduction limiting luerl sandbox. -module(luerl_sandbox). -export([init/0,init/1,init/2, run/1,run/2,run/3,run/4,run/5]). -define(LUERL_GLOBAL, '_G'). -define(SANDBOXED_VALUE, sandboxed). -define(SANDBOXED_GLOBALS, [ [?LUERL_GLOBAL, io], [?LUERL_GLOBAL, file], [?LUERL_GLOBAL, os, getenv], [?LUERL_GLOBAL, package], [?LUERL_GLOBAL, load], [?LUERL_GLOBAL, loadfile], [?LUERL_GLOBAL, require], [?LUERL_GLOBAL, dofile], [?LUERL_GLOBAL, load], [?LUERL_GLOBAL, loadfile], [?LUERL_GLOBAL, loadstring] ]). -define(TIMEOUT, 100). %% init([, State|TablePaths[, TablePaths]]) -> State init() -> init(luerl:init()). init(TablePaths) when is_list(TablePaths) -> init(luerl:init(), TablePaths); init(St) -> init(St, ?SANDBOXED_GLOBALS). init(St, []) -> luerl:gc(St); init(St0, [Path|Tail]) -> St1 = luerl:set_table(Path, ?SANDBOXED_VALUE, St0), init(St1, Tail). %% run(String|Binary|Form[, State[, MaxReductions|Flags[, Flags[, Timeout]]]]) -> {Term,State}|{error,Term} run(S) -> run(S, init()). run(S, St) -> run(S, St, 0, []). run(S, St, MaxR) when is_integer(MaxR) -> run(S, St, MaxR, []); run(S, St, Flags) when is_list(Flags) -> run(S, St, 0, Flags). run(S, St, MaxR, Flags) -> run(S, St, MaxR, Flags, ?TIMEOUT). run(S, St, 0, Flags, Timeout) -> Runner = start(self(), S, St, Flags), receive_response(Runner, Timeout); run(S, St, MaxR, Flags, Timeout) -> Runner = start(self(), S, St, Flags), case wait_reductions(Runner, MaxR) of {killed, R} -> {error, {reductions, R}}; ok -> receive_response(Runner, Timeout) end. start(Parent, S, St, Flags) -> spawn_opt(fun() -> try Reply = luerl:do(S, St), erlang:send(Parent, {self(), Reply}) catch error:Reason -> erlang:send(Parent, {self(), {error, Reason}}) end end, Flags). wait_reductions(Runner, MaxR) -> case process_info(Runner, reductions) of undefined -> ok; {reductions, R} when R >= MaxR -> exit(Runner, kill), {killed, R}; {reductions, _} -> wait_reductions(Runner, MaxR) end. receive_response(Runner, Timeout) -> receive {Runner, Reply} -> Reply; {error, Error} -> Error after Timeout -> {error, timeout} end. luerl-0.4/src/luerl_comp_cg.erl0000644000232200023220000003475713450242205017170 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_comp_cg.erl %% Author : Robert Virding %% Purpose : A basic LUA 5.2 compiler for Luerl. %% Does code generation in the compiler. -module(luerl_comp_cg). -include("luerl.hrl"). -include("luerl_comp.hrl"). -include("luerl_instrs.hrl"). -export([chunk/2]). -import(ordsets, [add_element/2,is_element/2,union/1,union/2, subtract/2,intersection/2,new/0]). %% chunk(St0, Opts) -> {ok,St0}. %% Return a list of instructions to define the chunk function. chunk(#code{code=C0}=Code, Opts) -> {Is,nul} = functiondef(C0, nul), %No local state luerl_comp:debug_print(Opts, "cg: ~p\n", [Is]), {ok,Code#code{code=Is}}. %% set_var(Var) -> SetIs. %% get_var(Var) -> GetIs. %% These return a LIST of instructions for setting/getting variable. set_var(#lvar{d=D,i=I}) -> [?STORE_LVAR(D, I)]; set_var(#evar{d=D,i=I}) -> [?STORE_EVAR(D, I)]; set_var(#gvar{n=N}) -> [?STORE_GVAR(N)]. get_var(#lvar{d=D,i=I}) -> [?PUSH_LVAR(D, I)]; get_var(#evar{d=D,i=I}) -> [?PUSH_EVAR(D, I)]; get_var(#gvar{n=N}) -> [?PUSH_GVAR(N)]. %% stmt(Stmts, State) -> {Istmts,State}. stmts([S0|Ss0], St0) -> {S1,St1} = stmt(S0, nul, St0), %% io:format("ss1: ~p\n", [{Loc0,Free0,Used0}]), {Ss1,St2} = stmts(Ss0, St1), {S1 ++ Ss1,St2}; stmts([], St) -> {[],St}. %% stmt(Stmt, LocalVars, State) -> {Istmt,State}. stmt(#assign_stmt{}=A, _, St) -> assign_stmt(A, St); stmt(#call_stmt{}=C, _, St) -> call_stmt(C, St); stmt(#return_stmt{}=R, _, St) -> return_stmt(R, St); stmt(#break_stmt{}, _, St) -> {[?BREAK],St}; stmt(#block_stmt{}=B, _, St) -> block_stmt(B, St); stmt(#while_stmt{}=W, _, St) -> while_stmt(W, St); stmt(#repeat_stmt{}=R, _, St) -> repeat_stmt(R, St); stmt(#if_stmt{}=I, _, St) -> if_stmt(I, St); stmt(#nfor_stmt{}=F, _, St) -> numfor_stmt(F, St); stmt(#gfor_stmt{}=F, _, St) -> genfor_stmt(F, St); stmt(#local_assign_stmt{}=L, _, St) -> local_assign_stmt(L, St); stmt(#local_fdef_stmt{}=L, _, St) -> local_fdef_stmt(L, St); stmt(#expr_stmt{}=E, _, St) -> expr_stmt(E, St). %% assign_stmt(Assign, State) -> {AssignIs,State}. %% We must evaluate all expressions, even the unneeded ones. assign_stmt(#assign_stmt{vs=Vs,es=Es}, St) -> assign_loop(Vs, Es, St). %% assign_loop(Vars, Exps, State) -> {Iassigns,State}. %% Must be careful with pushing and popping values here. Make sure %% all non-last values are singleton. %% %% This could most likely be folded together with assign_local_loop/3. assign_loop([V], [E], St0) -> %Remove unnecessary ?PUSH_VALS {Ie,St1} = exp(E, single, St0), %Last argument to one variable {Iv,St2} = var(V, St1), {Ie ++ Iv,St2}; assign_loop([V|Vs], [E], St0) -> {Ie,St1} = exp(E, multiple, St0), %Last argument to rest of vars {Ias,St2} = assign_loop_var(Vs, 1, St1), {Iv,St3} = var(V, St2), {Ie ++ Ias ++ Iv,St3}; assign_loop([V|Vs], [E|Es], St0) -> {Ie,St1} = exp(E, single, St0), %Not last argument! {Ias,St2} = assign_loop(Vs, Es, St1), {Iv,St3} = var(V, St2), {Ie ++ Ias ++ Iv,St3}; assign_loop([], Es, St) -> assign_loop_exp(Es, St). assign_loop_var([V|Vs], Vc, St0) -> {Ias,St1} = assign_loop_var(Vs, Vc+1, St0), {Iv,St2} = var(V, St1), {Ias ++ Iv,St2}; assign_loop_var([], Vc, St) -> {[?PUSH_VALS(Vc)],St}. assign_loop_exp([E|Es], St0) -> {Ie,St1} = exp(E, single, St0), %It will be dropped anyway {Ias,St2} = assign_loop_exp(Es, St1), {Ie ++ Ias ++ [?POP],St2}; %Pop unneeded value off stack assign_loop_exp([], St) -> {[],St}. var(#dot{e=Exp,r=Rest}, St0) -> {Ie,St1} = prefixexp_first(Exp, single, St0), {Ir,St2} = var_rest(Rest, St1), {Ie ++ Ir,St2}; var(V, St) -> {set_var(V),St}. var_rest(#dot{e=Exp,r=Rest}, St0) -> {Ie,St1} = prefixexp_element(Exp, single, St0), {Ir,St2} = var_rest(Rest, St1), {Ie ++ Ir,St2}; var_rest(Exp, St) -> var_last(Exp, St). var_last(#key{k=#lit{v=K}}, St) -> {[?SET_LIT_KEY(K)],St}; %[?PUSH_LIT(K),?SET_KEY] var_last(#key{k=Exp}, St0) -> {Ie,St1} = exp(Exp, single, St0), {Ie ++ [?SET_KEY],St1}. %% call_stmt(Call, State) -> {CallIs,State}. %% Must pop function return value list from stack. call_stmt(#call_stmt{call=Exp}, St0) -> {Ie,St1} = exp(Exp, multiple, St0), {Ie ++ [?POP],St1}. %% return_stmt(Return, State) -> {ReturnIs,State}. %% Can ignore any value left on stack here. return_stmt(#return_stmt{es=Es}, St0) -> {Ies,St1} = explist(Es, multiple, St0), {Ies ++ [?RETURN(length(Es))],St1}. %% block_stmt(Block, State) -> {BlockIs,State}. block_stmt(#block_stmt{ss=Ss,lsz=Lsz,esz=Esz}, St0) -> {Iss,St1} = stmts(Ss, St0), {[?BLOCK(Lsz, Esz, Iss)],St1}. %% do_block(Block, State) -> {Block,State}. %% Do_block never returns external new variables. Fits into stmt(). do_block(#block{ss=Ss,lsz=Lsz,esz=Esz}, St0) -> {Iss,St1} = stmts(Ss, St0), {[?BLOCK(Lsz, Esz, Iss)],St1}. %% while_stmt(While, State) -> {WhileIs,State}. while_stmt(#while_stmt{e=E,b=B}, St0) -> {Ie,St1} = exp(E, single, St0), {Ib,St2} = do_block(B, St1), {[?WHILE(Ie, Ib)],St2}. %% repeat_stmt(Repeat, State) -> {RepeatIs,State}. repeat_stmt(#repeat_stmt{b=B}, St0) -> {Ib,St1} = do_block(B, St0), {[?REPEAT(Ib)],St1}. %% if_stmt(If, State) -> {If,State}. if_stmt(#if_stmt{tests=Ts,else=E}, St) -> if_tests(Ts, E, St). if_tests([{E,B}], #block{ss=[]}, St0) -> {Ie,St1} = exp(E, single, St0), {Ib,St2} = do_block(B, St1), {Ie ++ [?IF_TRUE(Ib)],St2}; if_tests([{E,B}|Ts], Else, St0) -> {Ie,St1} = exp(E, single, St0), {Ib,St2} = do_block(B, St1), {Its,St3} = if_tests(Ts, Else, St2), {Ie ++ [?IF(Ib, Its)],St3}; if_tests([], Else, St0) -> {Ie,St1} = do_block(Else, St0), {Ie,St1}. %% numfor_stmt(For, State) -> {ForIs,State}. numfor_stmt(#nfor_stmt{v=V,init=I,limit=L,step=S,b=B}, St0) -> {Ies,St1} = explist([I,L,S], single, St0), {Ib,St2} = do_block(B, St1), [?BLOCK(Lsz, Esz, Is)] = Ib, ForBlock = [?BLOCK(Lsz, Esz, set_var(V) ++ Is)], {Ies ++ [?NFOR(V,ForBlock)],St2}. %% %% An experiment to put the block *outside* the for loop. %% numfor_stmt(#nfor_stmt{v=V,init=I,limit=L,step=S,b=B}, St0) -> %% {Ies,St1} = explist([I,L,S], single, St0), %% {Ib,St2} = do_block(B, St1), %% [?BLOCK(Lsz, Esz, Is)] = Ib, %% ForBlock = [?BLOCK(Lsz, Esz, [?NFOR(V,set_var(V) ++ Is)])], %% {Ies ++ ForBlock,St2}. %% genfor_stmt(For, State) -> {ForIs,State}. genfor_stmt(#gfor_stmt{vs=[V|Vs],gens=Gs,b=B}, St0) -> {Igs,St1} = explist(Gs, multiple, St0), {Ias,St2} = assign_local_loop_var(Vs, 1, St1), {Ib,St3} = do_block(B, St2), [?BLOCK(Lsz, Esz, Is)] = Ib, ForBlock = [?BLOCK(Lsz, Esz, Ias ++ set_var(V) ++ Is)], {Igs ++ [?POP_VALS(length(Gs))] ++ [?GFOR(Vs,ForBlock)],St3}. %% local_assign_stmt(Local, State) -> {Ilocal,State}. %% We must evaluate all expressions, even the unneeded ones. local_assign_stmt(#local_assign_stmt{vs=Vs,es=Es}, St) -> assign_local(Vs, Es, St). assign_local([V|Vs], [], St0) -> {Ias,St1} = assign_local_loop_var(Vs, 1, St0), {[?PUSH_LIT([])] ++ Ias ++ set_var(V),St1}; assign_local(Vs, Es, St) -> assign_local_loop(Vs, Es, St). %% assign_local_loop(Vars, Exps, State) -> {Iassigns,State}. %% Must be careful with pushing and popping values here. Make sure %% all non-last values are singleton. %% %% This could most likely be folded together with assign_loop/3. assign_local_loop([V], [E], St0) -> %Remove unnecessary ?PUSH_VALS {Ie,St1} = exp(E, single, St0), %Last argument to one variable! {Ie ++ set_var(V),St1}; assign_local_loop([V|Vs], [E], St0) -> {Ie,St1} = exp(E, multiple, St0), %Last argument to many vars! {Ias,St2} = assign_local_loop_var(Vs, 1, St1), {Ie ++ Ias ++ set_var(V),St2}; assign_local_loop([V|Vs], [E|Es], St0) -> {Ie,St1} = exp(E, single, St0), %Not last argument! {Ias,St2} = assign_local_loop(Vs, Es, St1), {Ie ++ Ias ++ set_var(V),St2}; assign_local_loop([], Es, St) -> assign_local_loop_exp(Es, St). %% assign_local_loop_var([V|Vs], Vc, St0) -> %% {Ias,St1} = assign_local_loop_var(Vs, Vc+1, St0), %% {Ias ++ [?PUSH_LIT(nil)] ++ set_var(V),St1}; %% assign_local_loop_var([], Vc, St) -> %% {[],St}. assign_local_loop_var([V|Vs], Vc, St0) -> {Ias,St1} = assign_local_loop_var(Vs, Vc+1, St0), {Ias ++ set_var(V),St1}; assign_local_loop_var([], Vc, St) -> {[?PUSH_VALS(Vc)],St}. assign_local_loop_exp([E|Es], St0) -> {Ie,St1} = exp(E, single, St0), %It will be dropped anyway {Ias,St2} = assign_local_loop_exp(Es, St1), {Ie ++ Ias ++ [?POP],St2}; %Pop value off stack assign_local_loop_exp([], St) -> {[],St}. %% local_fdef_stmt(Local, State) -> {ILocal,State}. local_fdef_stmt(#local_fdef_stmt{v=V,f=F}, St0) -> {If,St1} = functiondef(F, St0), {If ++ set_var(V),St1}. %% expr_stmt(Expr, State) -> {ExprIs,State}. %% The expression pseudo statement. This will return a single value %% which we leave on the stack. expr_stmt(#expr_stmt{exp=Exp}, St0) -> {Ie,St1} = exp(Exp, single, St0), {Ie,St1}. %% explist(Exprs, Values, State) -> {Instrs,State}. %% exp(Expr, Values, State) -> {Instrs,State}. %% Values determines if we are to only return the first value of a %% list of values. Values multiple makes us a return a list! explist([E], S, St) -> exp(E, S, St); %Append values to output? explist([E|Es], S, St0) -> {Ie,St1} = exp(E, single, St0), {Ies,St2} = explist(Es, S, St1), {Ie ++ Ies,St2}; explist([], _, St) -> {[],St}. %No expressions at all exp(#lit{v=L}, S, St) -> Is = [?PUSH_LIT(L)], {multiple_values(S, Is),St}; exp(#fdef{}=F, S, St0) -> {If,St1} = functiondef(F, St0), {multiple_values(S, If), St1}; exp(#op{op='and',as=[A1,A2]}, S, St0) -> {Ia1,St1} = exp(A1, S, St0), {Ia2,St2} = exp(A2, S, St1), {Ia1 ++ [?AND_THEN(Ia2)],St2}; %Must handle single/multiple exp(#op{op='or',as=[A1,A2]}, S, St0) -> {Ia1,St1} = exp(A1, S, St0), {Ia2,St2} = exp(A2, S, St1), {Ia1 ++ [?OR_ELSE(Ia2)],St2}; %Must handle single/multiple exp(#op{op=Op,as=As}, S, St0) -> {Ias,St1} = explist(As, single, St0), Iop = Ias ++ [?OP(Op,length(As))], {multiple_values(S, Iop),St1}; exp(#tc{fs=Fs}, S, St0) -> {Its,Fc,I,St1} = tableconstructor(Fs, St0), {Its ++ multiple_values(S, [?BUILD_TAB(Fc,I)]),St1}; exp(#lvar{n= <<"...">>}=V, S, St) -> %Can be either local or frame {single_value(S, get_var(V)),St}; exp(#evar{n= <<"...">>}=V, S, St) -> {single_value(S, get_var(V)),St}; exp(E, S, St) -> prefixexp(E, S, St). %% single_value(Values, Instrs) -> Instrs. %% multiple_values(Values, Instrs) -> Instrs. %% Ensure either single value or multiple value. single_value(single, Is) -> Is ++ [?SINGLE]; single_value(multiple, Is) -> Is. multiple_values(single, Is) -> Is; multiple_values(multiple, Is) -> Is ++ [?MULTIPLE]. %% prefixexp(Expr, Values, State) -> {Instrs,State}. %% prefixexp_rest(Expr, Values, State) -> {Instrs,State}. %% prefixexp_first(Expr, Values, State) -> {Instrs,State}. %% prefixexp_element(Expr, Values, State) -> {Instrs,State}. %% Single determines if we are to only return the first value of a %% list of values. Single false makes us a return a list! prefixexp(#dot{e=Exp,r=Rest}, S, St0) -> {Ie,St1} = prefixexp_first(Exp, single, St0), {Ir,St2} = prefixexp_rest(Rest, S, St1), {Ie ++ Ir,St2}; prefixexp(Exp, S, St) -> prefixexp_first(Exp, S, St). prefixexp_first(#single{e=E}, S, St0) -> {Ie,St1} = exp(E, single, St0), %Will make it single {multiple_values(S, Ie),St1}; prefixexp_first(Var, S, St) -> {multiple_values(S, get_var(Var)),St}. prefixexp_rest(#dot{e=Exp,r=Rest}, S, St0) -> {Ie,St1} = prefixexp_element(Exp, single, St0), {Ir,St2} = prefixexp_rest(Rest, S, St1), {Ie ++ Ir,St2}; prefixexp_rest(Exp, S, St) -> prefixexp_element(Exp, S, St). prefixexp_element(#key{k=#lit{v=K}}, S, St) -> {multiple_values(S, [?GET_LIT_KEY(K)]),St}; prefixexp_element(#key{k=E}, S, St0) -> {Ie,St1} = exp(E, single, St0), {Ie ++ multiple_values(S, [?GET_KEY]),St1}; prefixexp_element(#fcall{as=[]}, S, St) -> Ifs = [?FCALL(0)], {single_value(S, Ifs),St}; %Function call returns list prefixexp_element(#fcall{as=As}, S, St0) -> {Ias,St1} = explist(As, multiple, St0), Ifs = Ias ++ [?FCALL(length(As))], {single_value(S, Ifs),St1}; %Function call returns list prefixexp_element(#mcall{m=#lit{v=K},as=[]}, S, St) -> Ims = [?MCALL(K, 0)], {single_value(S, Ims),St}; %Method call returns list prefixexp_element(#mcall{m=#lit{v=K},as=As}, S, St0) -> {Ias,St1} = explist(As, multiple, St0), Ims = Ias ++ [?MCALL(K, length(As))], {single_value(S, Ims),St1}. %Method call returns list %% functiondef(Func, State) -> {Func,State}. %% This will return a single value which we leave on the stack. functiondef(#fdef{ps=Ps0,ss=Ss,lsz=Lsz,esz=Esz}, St0) -> Ps1 = func_pars(Ps0), {Iss,St1} = stmts(Ss, St0), {[?FDEF(Lsz,Esz,Ps1,Iss)],St1}. func_pars([#evar{n= <<"...">>,i=I}]) -> -I; %Tail is index for varargs func_pars([#lvar{n= <<"...">>,i=I}]) -> I; func_pars([#evar{i=I}|Ps]) -> [-I|func_pars(Ps)]; func_pars([#lvar{i=I}|Ps]) -> [I|func_pars(Ps)]; func_pars([]) -> []. %No varargs %% tableconstructor(Fields, State) -> {Ifields,FieldCount,Index,State}. %% FieldCount is how many Key/Value pairs are on the stack, Index is %% the index of the next value in the last value pushed. Make sure %% that the last value is a multiple. tableconstructor(Fs, St0) -> {Its,Fc,I,St1} = tc_fields(Fs, 0.0, St0), {Its,Fc,I,St1}. tc_fields([#efield{v=V}], I0, St0) -> I1 = I0 + 1.0, %Index of next element {Iv,St1} = exp(V, multiple, St0), {Iv,0,I1,St1}; tc_fields([#efield{v=V}|Fs], I0, St0) -> I1 = I0 + 1.0, %Index of next element {Iv,St1} = exp(V, single, St0), {Ifs,Fc,I2,St2} = tc_fields(Fs, I1, St1), {[?PUSH_LIT(I1)] ++ Iv ++ Ifs,Fc+1,I2,St2}; tc_fields([#kfield{k=K,v=V}|Fs], I0, St0) -> {Ik,St1} = exp(K, single, St0), {Iv,St2} = exp(V, single, St1), {Ifs,Fc,I1,St3} = tc_fields(Fs, I0, St2), {Ik ++ Iv ++ Ifs,Fc+1,I1,St3}; tc_fields([], _, St) -> {[?PUSH_LIT([])],0,1.0,St}. luerl-0.4/src/luerl_lib_bit32.erl0000644000232200023220000001375513450242205017325 0ustar debalancedebalance%% Copyright (c) 2014-2018 Łukasz Biedrycki %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_lib_bit32.erl %% Author : Łukasz Biedrycki %% Purpose : The bit32 library for Luerl. -module(luerl_lib_bit32). -include("luerl.hrl"). -export([install/1]). -import(luerl_lib, [badarg_error/3]). %Shorten this -define(MOST_SIGNIFICANT, 16#80000000). -define(LEAST_SIGNIFICANT, 16#00000001). -define(DEFAULT_BAND, 4294967295). -define(DEFAULT_BOR, 0). -define(DEFAULT_BXOR, 0). install(St) -> luerl_emul:alloc_table(table(), St). table() -> [{<<"band">>,#erl_func{code=fun fband/2}}, {<<"bnot">>,#erl_func{code=fun fbnot/2}}, {<<"bor">>,#erl_func{code=fun fbor/2}}, {<<"btest">>,#erl_func{code=fun fbtest/2}}, {<<"bxor">>,#erl_func{code=fun fbxor/2}}, {<<"lshift">>,#erl_func{code=fun flshift/2}}, {<<"rshift">>,#erl_func{code=fun frshift/2}}, {<<"arshift">>,#erl_func{code=fun farshift/2}}, {<<"lrotate">>,#erl_func{code=fun flrotate/2}}, {<<"rrotate">>,#erl_func{code=fun frrotate/2}}, {<<"extract">>,#erl_func{code=fun fextract/2}}, {<<"replace">>,#erl_func{code=fun freplace/2}} ]. fband(As, St) -> case luerl_lib:tointegers(As) of nil -> badarg_error('band', As, St); L when is_list(L) -> {[aband(L)], St} end. aband([]) -> ?DEFAULT_BAND; aband([X|T]) -> aband(T, checkint32(X)). aband([], A) -> float(A); aband([X|T], A) -> aband(T, checkint32(X) band A). fbnot(As, St) -> case luerl_lib:tointegers(As) of [N|_] -> NotN = bnot checkint32(N), {[float(NotN)], St}; _ -> badarg_error('bnot', As, St) end. fbor(As, St) -> case luerl_lib:tointegers(As) of nil -> badarg_error('bor', As, St); L when is_list(L) -> {[abor(L)], St} end. abor([]) -> ?DEFAULT_BOR; abor([X|T]) -> abor(T, checkint32(X)). abor([], A) -> float(A); abor([X|T], A) -> abor(T, checkint32(X) bor A). fbtest(As, St) -> case luerl_lib:tointegers(As) of nil -> badarg_error('btest', As, St); L when is_list(L) -> {[aband(L) /= 0], St} end. fbxor(As, St) -> case luerl_lib:tointegers(As) of nil -> badarg_error('bxor', As, St); L when is_list(L) -> {[abxor(L)], St} end. abxor([]) -> ?DEFAULT_BXOR; abxor([X|T]) -> abxor(T, checkint32(X)). abxor([], A) -> float(A); abxor([X|T], A) -> abxor(T, checkint32(X) bxor A). flshift(As, St) -> case luerl_lib:tointegers(As) of [X,Y|_] -> {[float(checkint32(X) bsl trunc(Y))], St}; _ -> badarg_error('lshift', As, St) end. frshift(As, St) -> case luerl_lib:tointegers(As) of [X,Y|_] -> {[float(checkint32(X) bsr trunc(Y))], St}; _ -> badarg_error('rshift', As, St) end. farshift(As, St) -> case luerl_lib:tointegers(As) of [X,Y|_] -> Disp = trunc(Y), case Disp > 0 of true -> {[float(checkint32(X) bsr trunc(Y))], St}; false -> {[float(checkint32(X) bsl abs(trunc(Y)))], St} end; _ -> badarg_error('arshift', As, St) end. flrotate(As, St) -> case luerl_lib:tointegers(As) of [X,Y|_] -> {[float(lrotate(checkint32(X), trunc(Y)))], St}; _ -> badarg_error('lrotate', As, St) end. frrotate(As, St) -> case luerl_lib:tointegers(As) of [X,Y|_] -> {[float(rrotate(checkint32(X), trunc(Y)))], St}; _ -> badarg_error('rrotate', As, St) end. fextract(As, St) -> case luerl_lib:tointegers(As) of [N,Field,Width|_] -> {[float(extract(N, Field, Width, As, St))], St}; [N,Field|_] -> {[float(extract(N, Field, 1, As, St))], St}; _ -> badarg_error('extract', As, St) end. freplace(As, St) -> case luerl_lib:tointegers(As) of [N,V,Field,Width|_] -> {[float(replace(N, V, Field, Width, As, St))], St}; [N,V,Field|_] -> {[float(replace(N, V, Field, 1, As, St))], St}; _ -> badarg_error('replace', As, St) end. %% Internal lrotate(X, Y) when Y < 0 -> rrotate(X, abs(Y)); lrotate(X, Y) when Y == 0 -> X; lrotate(X1, Y) -> Most = X1 band ?MOST_SIGNIFICANT, X2 = uint32(X1 bsl 1), X3 = X2 bor (Most bsr 31), lrotate(X3, Y - 1). rrotate(X, Y) when Y < 0 -> lrotate(X, abs(Y)); rrotate(X, Y) when Y == 0 -> X; rrotate(X1, Y) -> Least = X1 band ?LEAST_SIGNIFICANT, X2 = X1 bsr 1, X3 = X2 bor (Least bsl 31), rrotate(X3, Y - 1). uint32(N) -> <> = <>, Res. checkint32(N) -> uint32(trunc(N)). ge0(N, Where, As, St) -> case N >= 0 of true -> N; false -> badarg_error(Where, As, St) end. gt0(N, Where, As, St) -> case N > 0 of true -> N; false -> badarg_error(Where, As, St) end. le(N, V, Where, As, St) -> case N =< V of true -> N; false -> badarg_error(Where, As, St) end. extract(N1, Field1, Width1, As, St) -> N2 = checkint32(N1), Field2 = trunc(Field1), Width2 = trunc(Width1), _ = ge0(Field2, 'extract', As, St), _ = gt0(Width2, 'extract', As, St), _ = le(Field2 + Width2, 32, 'extract', As, St), trunc(N2 / math:pow(2, Field2)) rem trunc(math:pow(2, Width2)). replace(N1, V1, Field1, Width1, As, St) -> N2 = checkint32(N1), V2 = checkint32(V1), Field2 = trunc(Field1), Width2 = trunc(Width1), _ = ge0(Field2, 'replace', As, St), _ = gt0(Width2, 'replace', As, St), _ = le(Field2 + Width2, 32, 'extract', As, St), Field3 = trunc(math:pow(2, Field2)), Width3 = trunc(math:pow(2, Width2)), FW = Field3 * Width3, (N2 rem Field3) + (V2 rem Width3) * Field3 + trunc(N2 div FW) * FW. luerl-0.4/src/luerl_lib_package.erl0000644000232200023220000001560113450242205017765 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_lib_package.erl %% Author : Robert Virding %% Purpose : The package library for Luerl. %% These functions sometimes behave strangely in the Lua 5.2 %% libraries, but we try to follow them. Most of these functions KNOW %% that a table is a ttdict! We know that the erlang array has default %% value 'nil'. -module(luerl_lib_package). -include_lib("kernel/include/file.hrl"). -include("luerl.hrl"). %% The basic entry point to set up the function table. -export([install/1]). %% Export some functions which can be called from elsewhere. -export([search_path/5]). -import(luerl_lib, [lua_error/2,badarg_error/3]). %Shorten this install(St0) -> St1 = luerl_emul:set_global_key(<<"require">>, #erl_func{code=fun require/2}, St0), {S,St2} = luerl_emul:alloc_table(searchers_table(), St1), {L,St3} = luerl_emul:alloc_table(loaded_table(), St2), {P,St4} = luerl_emul:alloc_table(preload_table(), St3), {T,St5} = luerl_emul:alloc_table(table(S, L, P), St4), {T,St5}. %% table() -> [{FuncName,Function}]. %% meta_table() -> [{TableName,Function}]. %% searchers_table() %% preloaded_table() %% loaded_table() table(S, L, P) -> [{<<"config">>,config()}, {<<"loaded">>,L}, {<<"preload">>,P}, {<<"path">>,path()}, {<<"searchers">>,S}, {<<"searchpath">>,#erl_func{code=fun searchpath/2}} ]. searchers_table() -> [{1.0,#erl_func{code=fun preload_searcher/2}}, {2.0,#erl_func{code=fun lua_searcher/2}}]. preload_table() -> []. loaded_table() -> []. %% meta_table() -> %% [{<<"__index">>,#erl_func{code=fun meta_values/2}} %% ]. %% config() %% path() %% meta_values() %% Generate initial data for tables. config() -> <<"/\n",";\n","?\n","!\n","-\n">>. %The defaults path() -> case os:getenv("LUA_PATH") of false -> <<"./?.lua;./?/init.lua">>; %Default path Path -> list_to_binary(Path) end. %% meta_values([_,<<"bert">>], St) -> %% {[<<"/\n",";\n","?\n","!\n","-\n">>],St}; %% meta_values(_, St) -> {[nil],St}. %Default undefined key %% searchpath(Name, Path [, Sep [, Rep]]) -> [File] | [nil|Files]. searchpath(As, St) -> case luerl_lib:conv_list(search_args(As), [lua_string,lua_string,lua_string,lua_string]) of [N,P,S,R] -> %Name, path, sep, rep Ret = case search_path(N, P, S, R, []) of {ok,File} -> [File]; {error,Tried} -> [nil,Tried] end, {Ret,St}; _ -> badarg_error(searchpath, As, St) end. search_args([N,P]) -> [N,P,<<".">>,<<"/">>]; search_args([N,P,S]) -> [N,P,S,<<"/">>]; search_args(As) -> As. %% search_path(Name, Path, Sep, Rep, Tried) -> {ok,File} | {error,Tried}. %% Search for a file in a path. Callable from Erlang. search_path(N0, P, S, R, Tried) -> N1 = binary:replace(N0, S, R, [global]), Ts = binary:split(P, <<";">>, [global]), search_path_loop(N1, Ts, Tried). search_path_loop(Name, [T|Ts], Tried) -> File = binary:replace(T, <<"?">>, Name, [global]), %% Test if file can be opened for reading. case file:read_file_info(File) of {ok,#file_info{access=A}} when A =:= read; A =:= read_write -> {ok,File}; _ -> search_path_loop(Name, Ts, Tried ++ [$',File,$',$\s]) end; search_path_loop(_, [], Tried) -> %Couldn't find it {error,iolist_to_binary(Tried)}. -spec require([_], _) -> {_,_} | no_return(). %To keep dialyzer quiet %% require([File|_], State) ->{Value,State}. %% Main require interface. require(As, St) -> case luerl_lib:conv_list(As, [lua_string]) of [Mod] -> do_require(Mod, St); nil -> badarg_error(require, As, St) end. do_require(Mod, St0) -> {Pt,St1} = luerl_emul:get_global_key(<<"package">>, St0), case luerl_emul:get_table_keys(Pt, [<<"loaded">>,Mod], St1) of {nil,St2} -> %Not loaded {Ss,St3} = luerl_emul:get_table_key(Pt, <<"searchers">>, St2), {[Ldr|Extra],St4} = search_loaders(Mod, Ss, St3), {Val,St5} = luerl_emul:functioncall(Ldr, [Mod|Extra], St4), require_ret(Mod, Val, Pt, St5); {Val,St2} -> {[Val],St2} %Already loaded end. require_ret(Mod, Val, Pt, St0) -> Res = case luerl_lib:first_value(Val) of nil -> true; %Assign true to loaded entry __tmp -> __tmp end, St1 = luerl_emul:set_table_keys(Pt, [<<"loaded">>,Mod], Res, St0), {[Res],St1}. search_loaders(Mod, #tref{i=N}, #luerl{ttab=Ts}=St) -> #table{a=Arr} = ?GET_TABLE(N, Ts), Ls = array:sparse_to_list(Arr), search_loaders_loop(Mod, Ls, <<>>, St). search_loaders_loop(Mod, [nil|Ls], Estr, St) -> %Could find some of these search_loaders_loop(Mod, Ls, Estr, St); search_loaders_loop(Mod, [L|Ls], Estr, St0) -> %Try the next loader %% Call the searcher function case luerl_emul:functioncall(L, [Mod], St0) of %% Searcher found a loader. {[F|_],_}=Ret when ?IS_FUNCTION(F) -> Ret; %% Searcher found no loader. {[S|_],St1} when is_binary(S) -> Estr1 = <>, %Append new info string search_loaders_loop(Mod, Ls, Estr1, St1); {_,St1} -> %Should be nil or [] search_loaders_loop(Mod, Ls, Estr, St1) end; search_loaders_loop(Mod, [], Estr, St) -> %No successful loader found lua_error({no_module,Mod,Estr}, St). %% preload_searcher() %% lua_searcher() %% Predefined search functions in package.searchers. These must be Lua %% callable functions as they are visible. preload_searcher(As, St0) -> case luerl_lib:conv_list(As, [lua_string]) of [Mod] -> {Pre,St1} = luerl_emul:get_table_keys([<<"package">>,<<"preload">>], St0), case luerl_emul:get_table_key(Pre, Mod, St1) of {nil,St2} -> {[],St2}; {Val,St2} -> {[Val],St2} %Return the chunk end; nil -> badarg_error(preload_searcher, As, St0) end. lua_searcher(As, St0) -> case luerl_lib:conv_list(As, [lua_string]) of [Mod] -> {Path,St1} = luerl_emul:get_table_keys([<<"package">>,<<"path">>], St0), case search_path(Mod, Path, <<".">>, <<"/">>, []) of {ok,File} -> Ret = luerl_comp:file(binary_to_list(File)), lua_searcher_ret(Ret, File, St1); {error,Tried} -> {[Tried],St1} end; nil -> badarg_error(lua_searcher, As, St0) end. lua_searcher_ret({ok,Chunk}, File, St0) -> %% Wrap chunk in function to be consistent. {Func,St1} = luerl_emul:load_chunk(Chunk, St0), {[Func,File],St1}; lua_searcher_ret({error,[{_,Mod,E}|_],_}, _, St) -> Msg = iolist_to_binary(Mod:format_error(E)), {[Msg],St}. luerl-0.4/src/luerl_lib_debug.erl0000644000232200023220000000716113450242205017462 0ustar debalancedebalance%% Copyright (c) 2015-2018 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_lib_debug.erl %% Author : Robert Virding %% Purpose : The debug library for Luerl. %% This is a very rudimentary debug module which contains those %% functions which need no detailed information about the internals. -module(luerl_lib_debug). -include("luerl.hrl"). %% The basic entry point to set up the function table. -export([install/1]). -import(luerl_lib, [lua_error/2,badarg_error/3]). %Shorten this install(St) -> luerl_emul:alloc_table(table(), St). %% table() -> [{FuncName,Function}]. table() -> [{<<"getmetatable">>,#erl_func{code=fun getmetatable/2}}, {<<"getuservalue">>,#erl_func{code=fun getuservalue/2}}, {<<"setmetatable">>,#erl_func{code=fun setmetatable/2}}, {<<"setuservalue">>,#erl_func{code=fun setuservalue/2}} ]. %% getmetatable([Value|_], State) -> {[Table],State}. %% setmetatable([Table,Table|nil|_], State) -> {[Table],State}. %% Can set the metatable of all types here. Return tables for all %% values, for tables and userdata it is the table of the object, %% else the metatable for the type. getmetatable([O|_], St) -> {[do_getmetatable(O, St)],St}; getmetatable(As, St) -> badarg_error(getmetatable, As, St). do_getmetatable(#tref{i=T}, #luerl{ttab=Ts}) -> (?GET_TABLE(T, Ts))#table.m; do_getmetatable(#uref{i=U}, #luerl{utab=Us}) -> (?GET_TABLE(U, Us))#table.m; do_getmetatable(nil, #luerl{meta=Meta}) -> Meta#meta.nil; do_getmetatable(B, #luerl{meta=Meta}) when is_boolean(B) -> Meta#meta.boolean; do_getmetatable(N, #luerl{meta=Meta}) when is_number(N) -> Meta#meta.number; do_getmetatable(S, #luerl{meta=Meta}) when is_binary(S) -> Meta#meta.string; do_getmetatable(_, _) -> nil. %Other types have no metatables setmetatable([T,M|_], St) -> do_setmetatable(T, M, St); setmetatable(As, St) -> badarg_error(setmetatable, As, St). do_setmetatable(#tref{i=N}=T, M, #luerl{ttab=Ts0}=St) -> Ts1 = ?UPD_TABLE(N, fun (Tab) -> Tab#table{m=M} end, Ts0), {[T],St#luerl{ttab=Ts1}}; do_setmetatable(#uref{i=N}=U, M, #luerl{utab=Us0}=St) -> Us1 = ?UPD_TABLE(N, fun (Tab) -> Tab#table{m=M} end, Us0), {[U],St#luerl{utab=Us1}}; do_setmetatable(nil, M, #luerl{meta=Meta0}=St) -> Meta1 = Meta0#meta{nil=M}, {[nil],St#luerl{meta=Meta1}}; do_setmetatable(B, M, #luerl{meta=Meta0}=St) when is_boolean(B) -> Meta1 = Meta0#meta{boolean=M}, {[B],St#luerl{meta=Meta1}}; do_setmetatable(N, M, #luerl{meta=Meta0}=St) when is_number(N) -> Meta1 = Meta0#meta{number=M}, {[N],St#luerl{meta=Meta1}}; do_setmetatable(B, M, #luerl{meta=Meta0}=St) when is_binary(B) -> Meta1 = Meta0#meta{string=M}, {[B],St#luerl{meta=Meta1}}; do_setmetatable(D, _, St) -> %Do nothing for the rest {[D],St}. %% getuservalue([User|_], State) -> {[Value],State}. %% setuservalue([User,Value|_], State) -> {[User],State}. %% These are basically no-ops. getuservalue([_|_], St) -> {[nil],St}; getuservalue(As, St) -> badarg_error(getuservalue, As, St). setuservalue([U,_|_], St) -> {[U],St}; setuservalue(As, St) -> badarg_error(setuservalue, As, St). luerl-0.4/src/luerl_comp_vars.erl0000644000232200023220000003161013450242205017533 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_comp_vars.erl %% Author : Robert Virding %% Purpose : A basic LUA 5.2 compiler for Luerl. %% Does variable and stack analysis in the compiler -module(luerl_comp_vars). -include("luerl.hrl"). -include("luerl_comp.hrl"). -export([chunk/2]). -import(ordsets, [add_element/2,del_element/2,is_element/2, union/1,union/2,subtract/2,intersection/2]). chunk(#code{code=C0}=Code, Opts) -> {C1,_,_,nul} = functiondef(C0, [], nul), %No local state here! luerl_comp:debug_print(Opts, "cv: ~p\n", [C1]), {ok,Code#code{code=C1}}. %% stmts(Stmts, VarData, State) -> %% {Stmts,NewVarData,State}. %% Main problem here is to calculate local/free/used variables in the %% right order. Must do everything going forwards. stmts([S0|Ss0], Vars0, St0) -> {S1,New,Used,Fused,St1} = stmt(S0, nul, St0), Vars1 = update_vars(Vars0, New, Used, Fused), %% io:format("ss1: ~p\n", [Vars0]), %% io:format("ss1> ~p\n", [{New,Used,Fused}]), %% io:format("ss1> ~p\n", [Vars1]), {Ss1,Vars2,St2} = stmts(Ss0, Vars1, St1), {[S1|Ss1],Vars2,St2}; stmts([], Vars, St) -> {[],Vars,St}. update_vars(#vars{local=Lo,free=Fr,used=Us,fused=Fu}, New, Used, Fused) -> Aused = union(Used, Fused), %All used Free = subtract(Aused, Lo), #vars{local=union(New, Lo), free=union(Free, Fr), used=union(Used, Us), fused=union(Fused, Fu)}. %% stmt(Stmt, LocalVars, State) -> {Stmt,NewVars,UsedVars,FusedVars,State}. stmt(#assign_stmt{}=A, Loc, St) -> assign_stmt(A, Loc, St); stmt(#call_stmt{}=C, Loc, St) -> call_stmt(C, Loc, St); stmt(#return_stmt{}=R, Loc, St) -> return_stmt(R, Loc, St); stmt(#break_stmt{}=B, _, St) -> {B,[],[],[],St}; stmt(#block_stmt{}=B, Loc, St) -> block_stmt(B, Loc, St); stmt(#while_stmt{}=W, Loc, St) -> while_stmt(W, Loc, St); stmt(#repeat_stmt{}=R, Loc, St) -> repeat_stmt(R, Loc, St); stmt(#if_stmt{}=If, Loc, St) -> if_stmt(If, Loc, St); stmt(#nfor_stmt{}=For, Loc, St) -> numfor_stmt(For, Loc, St); stmt(#gfor_stmt{}=For, Loc, St) -> genfor_stmt(For, Loc, St); stmt(#local_assign_stmt{}=L, Loc, St) -> local_assign_stmt(L, Loc, St); stmt(#local_fdef_stmt{}=L, Loc, St) -> local_fdef_stmt(L, Loc, St); stmt(#expr_stmt{}=E, Loc, St) -> %Expressions "statement" expr_stmt(E, Loc, St). %% assign_stmt(Assign, LocalVars, State) -> %% {Assign,NewVars,UsedVars,FusedVars,State}. assign_stmt(#assign_stmt{vs=Vs0,es=Es0}=A, Loc, St0) -> {Vs1,Vused,Vfused,St1} = assign_loop(Vs0, Loc, St0), {Es1,Eused,Efused,St2} = explist(Es0, Loc, St1), Used = union(Vused, Eused), Fused = union(Vfused, Efused), {A#assign_stmt{vs=Vs1,es=Es1},[],Used,Fused,St2}. assign_loop([V0|Vs0], Loc, St0) -> {V1,Vused,Vfused,St1} = var(V0, Loc, St0), {Vs1,Vsused,Vsfused,St2} = assign_loop(Vs0, Loc, St1), Used = union(Vused, Vsused), Fused = union(Vfused, Vsfused), {[V1|Vs1],Used,Fused,St2}; assign_loop([], _, St) -> {[],[],[],St}. var(#dot{e=Exp0,r=Rest0}=D, Loc, St0) -> {Exp1,Eused,Efused,St1} = prefixexp_first(Exp0, Loc, St0), {Rest1,Rused,Rfused,St2} = var_rest(Rest0, Loc, St1), Used = union(Eused, Rused), Fused = union(Efused, Rfused), {D#dot{e=Exp1,r=Rest1},Used,Fused,St2}; var(#var{n=N}=V, _, St) -> {V,[N],[],St}. var_rest(#dot{e=Exp0,r=Rest0}=D, Loc, St0) -> {Exp1,Eused,Efused,St1} = prefixexp_element(Exp0, Loc, St0), {Rest1,Rused,Rfused,St2} = var_rest(Rest0, Loc, St1), Used = union(Eused, Rused), Fused = union(Efused, Rfused), {D#dot{e=Exp1,r=Rest1},Used,Fused,St2}; var_rest(Exp, Loc, St) -> var_last(Exp, Loc, St). var_last(#key{k=Exp0}=K, Loc, St0) -> {Exp1,Used,Fused,St1} = exp(Exp0, Loc, St0), {K#key{k=Exp1},Used,Fused,St1}. %% call_stmt(Call, LocalVars, State) -> %% {Call,NewVars,UsedVars,FusedVars,State}. call_stmt(#call_stmt{call=Exp0}=C, Loc, St0) -> {Exp1,Used,Fused,St1} = exp(Exp0, Loc, St0), {C#call_stmt{call=Exp1},[],Used,Fused,St1}. %% return_stmt(Return, LocalVars, State) -> %% {Return,NewVars,UsedVars,FusedVars,State}. return_stmt(#return_stmt{es=Es0}=R, Loc, St0) -> {Es1,Used,Fused,St1} = explist(Es0, Loc, St0), {R#return_stmt{es=Es1},[],Used,Fused,St1}. %% block_stmt(Block, LocalVars, State) -> %% {Block,NewVars,UsedVars,FusedVars,State}. block_stmt(#block_stmt{ss=Ss0}=B, _, St0) -> Vars0 = #vars{local=[],free=[],used=[],fused=[]}, {Ss1,Vars1,St1} = stmts(Ss0, Vars0, St0), %% Be careful what we export, adjust Used and Fused for locals. #vars{local=Bloc,used=Bused,fused=Bfused} = Vars1, Used = subtract(Bused, Bloc), Fused = subtract(Bfused, Bloc), {B#block_stmt{ss=Ss1,vars=Vars1},[],Used,Fused,St1}. %% do_block(Block, State) -> {Block,UsedVars,FusedVars,State}. %% do_block(Block, LocalVars, State) -> {Block,UsedVars,FusedVars,State}. %% Do_block never returns external new variables as it never exports %% variables. do_block(B, St) -> do_block(B, [], St). do_block(#block{ss=Ss0}=B, Loc, St0) -> Vars0 = #vars{local=Loc,free=[],used=[],fused=[]}, {Ss1,Vars1,St1} = stmts(Ss0, Vars0, St0), %% Be careful what we export, adjust Used and Fused for locals. #vars{local=Bloc,used=Bused,fused=Bfused} = Vars1, Used = subtract(Bused, Bloc), Fused = subtract(Bfused, Bloc), {B#block{ss=Ss1,vars=Vars1},Used,Fused,St1}. %% while_stmt(While, LocalVars, State) -> %% {While,NewVars,UsedVars,FusedVars,State}. %% While_stmt never returns external new variables. The test %% expression is done in the context of the surrounding block. while_stmt(#while_stmt{e=E0,b=B0}=W, Loc, St0) -> {E1,Eused,Efused,St1} = exp(E0, Loc, St0), {B1,Bused,Bfused,St2} = do_block(B0, St1), Used = union(Eused, Bused), Fused = union(Efused, Bfused), {W#while_stmt{e=E1,b=B1},[],Used,Fused,St2}. %% repeat_stmt(Repeat, LocalVars, State) -> %% {Repeat,NewVars,UsedVars,FusedVars,State}. %% Repeat_stmt never returns external new variables. The test %% expression is done in the context of the repeat block and is %% already inside the block. repeat_stmt(#repeat_stmt{b=B0}=R, _, St0) -> {B1,Used,Fused,St1} = do_block(B0, St0), {R#repeat_stmt{b=B1},[],Used,Fused,St1}. %% if_stmt(If, LocalVars, State) -> {If,NewVars,FreeVars,State}. %% The block info includes anything from the test expressions even %% though we keep them separate. if_stmt(#if_stmt{tests=Ts0,else=E0}=If, Loc, St0) -> {Ts1,Tused,Tfused,St1} = if_tests(Ts0, Loc, St0), {E1,Eused,Efused,St2} = do_block(E0, St1), Used = union(Tused, Eused), Fused = union(Tfused, Efused), {If#if_stmt{tests=Ts1,else=E1},[],Used,Fused,St2}. if_tests([{E0,B0}|Ts0], Loc, St0) -> {E1,Eused,Efused,St1} = exp(E0, Loc, St0), {B1,Bused,Bfused,St2} = do_block(B0, St1), {Ts1,Tsused,Tsfused,St3} = if_tests(Ts0, Loc, St2), Used = union([Eused,Bused,Tsused]), Fused = union([Efused,Bfused,Tsfused]), {[{E1,B1}|Ts1],Used,Fused,St3}; if_tests([], _, St) -> {[],[],[],St}. %% numfor_stmt(For, LocalVars, State) -> %% {For,NewVars,UsedVars,FusedVars,State}. numfor_stmt(#nfor_stmt{v=#var{n=N},init=I0,limit=L0,step=S0,b=B0}=For, Loc, St0) -> {[I1,L1,S1],Esused,Esfused,St1} = explist([I0,L0,S0], Loc, St0), {B1,Bused,Bfused,St2} = do_block(B0, [N], St1), %% Be careful what we export, adjust Used and Fused for N. Used = union(Esused, del_element(N, Bused)), Fused = union(Esfused, del_element(N, Bfused)), {For#nfor_stmt{init=I1,limit=L1,step=S1,b=B1},[],Used,Fused,St2}. %% genfor_stmt(For, LocalVars, State) -> {For,NewVars,FreeVars,State}. genfor_stmt(#gfor_stmt{vs=Vs,gens=Gs0,b=B0}=For, Loc, St0) -> {Gs1,Gused,Gfused,St1} = explist(Gs0, Loc, St0), Ns = lists:foldl(fun (#var{n=N}, Ns) -> add_element(N, Ns) end, [], Vs), {B1,Bused,Bfused,St2} = do_block(B0, Ns, St1), %% Be careful what we export, adjust Used and Fused for Ns. Used = union(Gused, subtract(Bused, Ns)), Fused = union(Gfused, subtract(Bfused, Ns)), {For#gfor_stmt{gens=Gs1,b=B1},[],Used,Fused,St2}. %% local_assign_stmt(Local, LocalVars, State) -> {Local,NewVars,FreeVars,State}. local_assign_stmt(#local_assign_stmt{vs=Vs,es=Es0}=L, Loc, St0) -> {Es1,Used,Fused,St1} = explist(Es0, Loc, St0), New = lists:foldl(fun (#var{n=N}, Ns) -> add_element(N, Ns) end, [], Vs), {L#local_assign_stmt{es=Es1},New,Used,Fused,St1}. %% local_fdef_stmt(Local, LocalVars, State) -> %% {Local,NewVars,FreeVars,UsedVars,State}. %% We explicitly handle used variables here as we want the function %% name to be included in Used in recursive function calls. local_fdef_stmt(#local_fdef_stmt{v=#var{n=N},f=F0}=L, _, St0) -> {F1,Used,Fused,St1} = functiondef(F0, nul, St0), New = [N], {L#local_fdef_stmt{f=F1},New,Used,Fused,St1}. %% exp_stmt(Expr, LocalVars, State) -> %% {Expr,NewVars,UsedVars,FusedVars,State}. %% This will return a single value. expr_stmt(#expr_stmt{exp=Exp0}=E, Loc, St0) -> {Exp1,Used,Fused,St1} = exp(Exp0, Loc, St0), {E#expr_stmt{exp=Exp1},[],Used,Fused,St1}. %% explist(Exprs, LocalVars, State) -> {Exprs,UsedVars,FusedVars,State}. %% exp(Expr, LocalVars, State) -> {Expr,UsedVars,FusedVars,State}. %% prefixexp(Expr, LocalVars, State) -> {Expr,UsedVars,FusedVars,State}. %% An expression can never create new local variables. explist([E0|Es0], Loc, St0) -> {E1,Eused,Efused,St1} = exp(E0, Loc, St0), {Es1,Esused,Esfused,St2} = explist(Es0, Loc, St1), Used = union(Eused, Esused), Fused = union(Efused, Esfused), {[E1|Es1],Used,Fused,St2}; explist([], _, St) -> {[],[],[],St}. %No expressions at all exp(#lit{}=L, _, St) -> {L,[],[],St}; %Nothing to do exp(#fdef{}=F, _, St) -> functiondef(F, nul, St); exp(#op{as=Es0}=Op, Loc, St0) -> {Es1,Used,Fused,St1} = explist(Es0, Loc, St0), {Op#op{as=Es1},Used,Fused,St1}; exp(#tc{fs=Fs0}=T, Loc, St0) -> {Fs1,Used,Fused,St1} = tableconstructor(Fs0, Loc, St0), {T#tc{fs=Fs1},Used,Fused,St1}; exp(E, Loc, St) -> prefixexp(E, Loc, St). prefixexp(#dot{e=Exp0,r=Rest0}=D, Loc, St0) -> {Exp1,Eused,Efused,St1} = prefixexp_first(Exp0, Loc, St0), {Rest1,Rused,Rfused,St2} = prefixexp_rest(Rest0, Loc, St1), Used = union(Eused, Rused), Fused = union(Efused, Rfused), {D#dot{e=Exp1,r=Rest1},Used,Fused,St2}; prefixexp(Exp, Loc, St) -> prefixexp_first(Exp, Loc, St). prefixexp_first(#single{e=E0}=S, Loc, St0) -> {E1,Used,Fused,St1} = exp(E0, Loc, St0), {S#single{e=E1},Used,Fused,St1}; prefixexp_first(#var{n=N}=V, _, St) -> {V,[N],[],St}. prefixexp_rest(#dot{e=Exp0,r=Rest0}=D, Loc, St0) -> {Exp1,Eused,Efused,St1} = prefixexp_element(Exp0, Loc, St0), {Rest1,Rused,Rfused,St2} = prefixexp_rest(Rest0, Loc, St1), Used = union(Eused, Rused), Fused = union(Efused, Rfused), {D#dot{e=Exp1,r=Rest1},Used,Fused,St2}; prefixexp_rest(Exp, Loc, St) -> prefixexp_element(Exp, Loc, St). prefixexp_element(#key{k=E0}=K, Loc, St0) -> {E1,Used,Fused,St1} = exp(E0, Loc, St0), {K#key{k=E1},Used,Fused,St1}; prefixexp_element(#fcall{as=As0}=F, Loc, St0) -> {As1,Used,Fused,St1} = explist(As0, Loc, St0), {F#fcall{as=As1},Used,Fused,St1}; prefixexp_element(#mcall{m=#lit{v=N},as=As0}=M, Loc, St0) -> {As1,Used,Fused,St1} = explist(As0, Loc, St0), {M#mcall{as=As1},add_element(N, Used),Fused,St1}. %% functiondef(Func, LocalVars, State) -> {Func,UsedVars,FusedVars,State}. %% All the variables "used" in the function which are not local %% become "fused" externally. functiondef(#fdef{ps=Ps,ss=Ss0}=F, _, St0) -> Loc0 = lists:foldl(fun (#var{n=N}, Vs) -> add_element(N, Vs); (_, Vs) -> Vs end, [], Ps), Vars0 = #vars{local=Loc0,free=[],used=[],fused=[]}, {Ss1,Vars1,St1} = stmts(Ss0, Vars0, St0), %% Make all free variables "fused" in outside block. {F#fdef{ss=Ss1,vars=Vars1},[],Vars1#vars.free,St1}. %% tableconstructor(Fields, LocalVars, State) -> %% {Fields,UsedVars,FusedVars,State}. tableconstructor(Fs0, Loc, St0) -> Fun = fun (#efield{v=V0}=F, {Used0,Fused0,S0}) -> {V1,Vused,Vfused,S1} = exp(V0, Loc, S0), Used1 = union(Vused, Used0), Fused1 = union(Vfused, Fused0), {F#efield{v=V1},{Used1,Fused1,S1}}; (#kfield{k=K0,v=V0}=F, {Used0,Fused0,S0}) -> {K1,Kused,Kfused,S1} = exp(K0, Loc, S0), {V1,Vused,Vfused,S2} = exp(V0, Loc, S1), Used1 = union([Kused,Vused,Used0]), Fused1 = union([Kfused,Vfused,Fused0]), {F#kfield{k=K1,v=V1},{Used1,Fused1,S2}} end, {Fs1,{Used,Fused,St1}} = lists:mapfoldl(Fun, {[],[],St0}, Fs0), {Fs1,Used,Fused,St1}. luerl-0.4/src/luerl_parse.yrl0000644000232200023220000002151613450242205016704 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_parse.yrl %% Author : Robert Virding %% Purpose : Parser for LUA 5.2. %% The Grammar rules here are taken directly from the LUA 5.2 %% manual. Unfortunately it is not an LALR(1) grammar but I have %% included a fix by Florian Weimer which makes it %% so, but it needs some after processing. Actually his fix was %% unnecessarily complex and all that was needed was to change one %% rule for statements. Expect 2. %Suppress shift/reduce warning Nonterminals chunk block stats stat semi retstat label_stat while_stat repeat_stat if_stat if_elseif if_else for_stat local_decl funcname dottedname varlist var namelist explist exp prefixexp args functioncall functiondef funcbody parlist tableconstructor fieldlist fields field fieldsep binop unop uminus. Terminals NAME NUMBER STRING 'and' 'break' 'do' 'else' 'elseif' 'end' 'false' 'for' 'function' 'goto' 'if' 'in' 'local' 'nil' 'not' 'or' 'repeat' 'return' 'then' 'true' 'until' 'while' '+' '-' '*' '/' '%' '^' '#' '==' '~=' '<=' '>=' '<' '>' '=' '(' ')' '{' '}' '[' ']' '::' ';' ':' ',' '.' '..' '...' . Rootsymbol chunk. Left 100 'or'. Left 200 'and'. Left 300 '<' '>' '<=' '>=' '~=' '=='. Right 400 '..'. Left 500 '+' '-'. Left 600 '*' '/' '%'. Unary 700 'not' '#' uminus. Right 800 '^'. chunk -> block : '$1' . %% block ::= {stat} [retstat] block -> stats : '$1' . block -> stats retstat : '$1' ++ ['$2'] . retstat -> return semi : {return,line('$1'),[]} . retstat -> return explist semi : {return,line('$1'),'$2'} . semi -> ';' . %semi is never returned semi -> '$empty' . stats -> '$empty' : [] . stats -> stats stat : '$1' ++ ['$2'] . stat -> ';' : '$1' . stat -> varlist '=' explist : {assign,line('$2'),'$1','$3'} . %% Following functioncall rule removed to stop reduce-reduce conflict. %% Replaced with a prefixexp which should give the same. We hope! %%stat -> functioncall : '$1' . stat -> prefixexp : check_functioncall('$1') . stat -> label_stat : '$1' . stat -> 'break' : {break,line('$1')} . stat -> 'goto' NAME : {goto,line('$1'),'$2'} . stat -> 'do' block 'end' : {block,line('$1'),'$2'} . stat -> while_stat : '$1' . stat -> repeat_stat : '$1' . stat -> if_stat : '$1' . stat -> for_stat : '$1' . stat -> function funcname funcbody : functiondef(line('$1'),'$2','$3') . stat -> local local_decl : {local,line('$1'),'$2'} . label_stat -> '::' NAME '::' : {label,line('$1'),'$2'} . while_stat -> 'while' exp 'do' block 'end' : {while,line('$1'),'$2','$4'} . repeat_stat -> 'repeat' block 'until' exp : {repeat,line('$1'),'$2','$4'} . %% stat ::= if exp then block {elseif exp then block} [else block] end if_stat -> 'if' exp 'then' block if_elseif if_else 'end' : {'if',line('$1'),[{'$2','$4'}|'$5'],'$6'} . if_elseif -> if_elseif 'elseif' exp 'then' block : '$1' ++ [{'$3','$5'}] . if_elseif -> '$empty' : [] . if_else -> 'else' block : '$2' . if_else -> '$empty' : [] . %An empty block %% stat ::= for Name '=' exp ',' exp [',' exp] do block end %% stat ::= for namelist in explist do block end for_stat -> 'for' NAME '=' explist do block end : numeric_for(line('$1'), '$2', '$4', '$6') . for_stat -> 'for' namelist 'in' explist 'do' block 'end' : generic_for(line('$1'), '$2', '$4', '$6') . %% funcname ::= Name {'.' Name} [':' Name] funcname -> dottedname ':' NAME : dot_append(line('$2'), '$1', {method,line('$2'),'$3'}) . funcname -> dottedname : '$1' . local_decl -> function NAME funcbody : functiondef(line('$1'),'$2','$3') . local_decl -> namelist : {assign,line(hd('$1')),'$1',[]} . local_decl -> namelist '=' explist : {assign,line('$2'),'$1','$3'} . dottedname -> NAME : '$1'. dottedname -> dottedname '.' NAME : dot_append(line('$2'), '$1', '$3') . varlist -> var : ['$1'] . varlist -> varlist ',' var : '$1' ++ ['$3'] . var -> NAME : '$1' . var -> prefixexp '[' exp ']' : dot_append(line('$2'), '$1', {key_field,line('$2'),'$3'}) . var -> prefixexp '.' NAME : dot_append(line('$2'), '$1', '$3') . namelist -> NAME : ['$1'] . namelist -> namelist ',' NAME : '$1' ++ ['$3'] . explist -> exp : ['$1'] . explist -> explist ',' exp : '$1' ++ ['$3'] . exp -> 'nil' : '$1' . exp -> 'false' : '$1' . exp -> 'true' : '$1' . exp -> NUMBER : '$1' . exp -> STRING : '$1' . exp -> '...' : '$1' . exp -> functiondef : '$1' . exp -> prefixexp : '$1' . exp -> tableconstructor : '$1' . exp -> binop : '$1' . exp -> unop : '$1' . prefixexp -> var : '$1' . prefixexp -> functioncall : '$1' . prefixexp -> '(' exp ')' : {single,line('$1'),'$2'} . functioncall -> prefixexp args : dot_append(line('$1'), '$1', {functioncall,line('$1'), '$2'}) . functioncall -> prefixexp ':' NAME args : dot_append(line('$2'), '$1', {methodcall,line('$2'),'$3','$4'}) . args -> '(' ')' : [] . args -> '(' explist ')' : '$2' . args -> tableconstructor : ['$1'] . %Syntactic sugar args -> STRING : ['$1'] . %Syntactic sugar functiondef -> 'function' funcbody : functiondef(line('$1'), '$2'). funcbody -> '(' ')' block 'end' : {[],'$3'} . funcbody -> '(' parlist ')' block 'end' : {'$2','$4'} . parlist -> namelist : '$1' . parlist -> namelist ',' '...' : '$1' ++ ['$3'] . parlist -> '...' : ['$1'] . tableconstructor -> '{' '}' : {table,line('$1'),[]} . tableconstructor -> '{' fieldlist '}' : {table,line('$1'),'$2'} . fieldlist -> fields : '$1' . fieldlist -> fields fieldsep : '$1' . fields -> field : ['$1'] . fields -> fields fieldsep field : '$1' ++ ['$3'] . field -> '[' exp ']' '=' exp : {key_field,line('$1'),'$2','$5'} . field -> NAME '=' exp : {name_field,line('$1'),'$1','$3'} . field -> exp : {exp_field,line('$1'),'$1'} . fieldsep -> ',' . fieldsep -> ';' . %% exp ::= exp binop exp %% exp ::= unop exp %% We have to write them these way for the prioriies to work. binop -> exp '+' exp : {op,line('$2'),cat('$2'),'$1','$3'}. binop -> exp '-' exp : {op,line('$2'),cat('$2'),'$1','$3'}. binop -> exp '*' exp : {op,line('$2'),cat('$2'),'$1','$3'}. binop -> exp '/' exp : {op,line('$2'),cat('$2'),'$1','$3'}. binop -> exp '%' exp : {op,line('$2'),cat('$2'),'$1','$3'}. binop -> exp '^' exp : {op,line('$2'),cat('$2'),'$1','$3'}. binop -> exp '==' exp : {op,line('$2'),cat('$2'),'$1','$3'}. binop -> exp '~=' exp : {op,line('$2'),cat('$2'),'$1','$3'}. binop -> exp '<=' exp : {op,line('$2'),cat('$2'),'$1','$3'}. binop -> exp '>=' exp : {op,line('$2'),cat('$2'),'$1','$3'}. binop -> exp '<' exp : {op,line('$2'),cat('$2'),'$1','$3'}. binop -> exp '>' exp : {op,line('$2'),cat('$2'),'$1','$3'}. binop -> exp '..' exp : {op,line('$2'),cat('$2'),'$1','$3'}. binop -> exp 'and' exp : {op,line('$2'),cat('$2'),'$1','$3'}. binop -> exp 'or' exp : {op,line('$2'),cat('$2'),'$1','$3'}. unop -> 'not' exp : {op,line('$1'),cat('$1'),'$2'} . unop -> '#' exp : {op,line('$1'),cat('$1'),'$2'} . unop -> uminus : '$1' . uminus -> '-' exp : {op,line('$1'),'-','$2'} . Erlang code. -export([chunk/1]). %% chunk(Tokens) -> FunctionDef | Error. %% Return the parse as a callable nameless function definition. chunk(Ts) -> case parse(Ts) of {error,_}=Error -> Error; {ok,Body} -> {ok,{functiondef,1,[{'...',1}],Body}} end. cat(T) -> element(1, T). line(T) -> element(2, T). %% numeric_for(Line, LoopVar, [Init,Test,Upd], Block). numeric_for(Line, Var, [Init,Limit], Block) -> {for,Line,Var,Init,Limit,Block}; numeric_for(Line, Var, [Init,Limit,Step], Block) -> {for,Line,Var,Init,Limit,Step,Block}; numeric_for(Line, _, _, _) -> %Wrong number of expressions return_error(Line, "illegal for"). %% generic_for(Line, Names, ExpList, Block). generic_for(Line, Names, Exps, Block) -> {for,Line,Names,Exps,Block}. %% functiondef(Line, Name, {Parameters,Body}). %% functiondef(Line, {Parameters,Body}). functiondef(Line, Name, {Pars,Body}) -> {functiondef,Line,Name,Pars,Body}. functiondef(Line, {Pars,Body}) -> {functiondef,Line,Pars,Body}. %% dot_append(DotList, Last) -> DotList. %% Append Last to the end of a dotlist. dot_append(Line, {'.',L,H,T}, Last) -> {'.',L,H,dot_append(Line, T, Last)}; dot_append(Line, H, Last) -> {'.',Line,H,Last}. %% check_functioncall(PrefixExp) -> PrefixExp. %% Check that the PrefixExp is a proper function call/method. check_functioncall({functioncall,_,_}=C) -> C; check_functioncall({methodcall,_,_,_}=M) -> M; check_functioncall({'.',L,H,T}) -> {'.',L,H,check_functioncall(T)}; check_functioncall(Other) -> return_error(line(Other),"illegal call"). luerl-0.4/src/luerl.app.src0000644000232200023220000000165713450242205016256 0ustar debalancedebalance%% Copyright (c) 2013-2018 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. {application, luerl, [{description, "Luerl - an implementation of Lua on Erlang"}, {vsn, "0.3.1"}, {modules, []}, {registered, []}, {applications, [kernel, stdlib]}, {env, []}, {mod, {luerl_app, []}}, {maintainers, ["Robert Virding"]}, {licenses, ["Apache"]}, {links,[{"Github", "https://github.com/rvirding/luerl"}]} ]}. luerl-0.4/src/luerl_lib.erl0000644000232200023220000001553713450242205016322 0ustar debalancedebalance%% Copyright (c) 2013-2018 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_lib.erl %% Author : Robert Virding %% Purpose : Luerl libraries. %% A collection of useful functions. Those with '_' in their names %% generate Erlang data types while those with generate Lua data types %% (floats and binaries). -module(luerl_lib). -include("luerl.hrl"). -export([lua_error/2,badarg_error/3,format_error/1]). -export([boolean_value/1,first_value/1]). -export([number_to_list/1,to_list/1,to_lists/1,to_lists/2, to_int/1,to_ints/1,to_ints/2]). -export([tonumber/1,tonumber/2,tonumbers/1,tonumbers/2,tointeger/1, tointegers/1,tointegers/2,tostring/1,tostrings/1,tostrings/2, conv_list/2,conv_list/3]). -spec lua_error(_,_) -> no_return(). -spec badarg_error(_,_,_) -> no_return(). lua_error(E, St) -> error({lua_error,E,St}). badarg_error(What, Args, St) -> lua_error({badarg,What,Args}, St). %% format_error(LuaError) -> ErrorString. %% Some of these use same text as Lua error string, so be careful if %% modifying them. format_error({undefined_method, Name, Args0, Line}) -> io_lib:format("undefined_method ~w with args: ~p on line ~p", [Name, Args0, Line]); format_error({badarg,Where,As}) -> io_lib:format("badarg in ~w: ~w", [Where,As]); format_error({method_on_nil, Key}) -> io_lib:format("undefined method ~w on nil", [Key]); format_error({illegal_key,Tab,Key}) -> io_lib:format("invalid key in ~w: ~w", [Tab,Key]); format_error({illegal_index,Where,I}) -> io_lib:format("invalid index in ~w: ~w", [Where,I]); format_error({illegal_val,Where,Val}) -> io_lib:format("invalid value in ~w: ~w", [Where,Val]); format_error({illegal_val,Val}) -> io_lib:format("invalid value: ~w", [Val]); format_error({illegal_comp,Where}) -> io_lib:format("illegal comparison in ~w", [Where]); format_error({invalid_order,Where}) -> %Keep text! io_lib:format("invalid order function in ~w", [Where]); format_error({undef_function,Name}) -> io_lib:format("undefined function ~w", [Name]); format_error({undef_method,Obj,Name}) -> io_lib:format("undefined method in ~w: ~w", [Obj,Name]); %% Pattern errors. format_error(invalid_pattern) -> %Keep text! io_lib:format("malformed pattern", []); format_error(invalid_capture) -> %Keep text! io_lib:format("malformed pattern", []); format_error({invalid_char_class,C}) -> %Keep text! io_lib:format("malformed pattern (class ~c)", [C]); format_error(invalid_char_set) -> %Keep text! io_lib:format("malformed pattern (missing ']')", []); %% Illegal or undefined ops. format_error({illegal_op,Op}) -> io_lib:format("illegal op: ~w", [Op]); format_error({undefined_op,Op}) -> io_lib:format("undefined op: ~w", [Op]); format_error({no_module,Mod}) -> io_lib:format("module '~s' not found", [Mod]). %% boolean_value(Rets) -> boolean(). %% first_value(Rets) -> Value | nil. boolean_value([nil|_]) -> false; boolean_value([false|_]) -> false; boolean_value([_|_]) -> true; boolean_value([]) -> false. first_value([V|_]) -> V; first_value([]) -> nil. to_list(N) when is_number(N) -> number_to_list(N); to_list(B) when is_binary(B) -> binary_to_list(B); to_list(_) -> nil. to_lists(As) -> to_lists(As, []). to_lists(As, Acc) -> to_loop(As, fun to_list/1, Acc). to_int(N) when is_number(N) -> round(N); to_int(B) when is_binary(B) -> case bin_to_float(B) of {ok,N} -> round(N); error -> nil end; to_int(_) -> nil. to_ints(As) -> to_ints(As, []). to_ints(As, Acc) -> to_loop(As, fun to_int/1, Acc). %% bin_to_float(Binary) -> {ok,Number} | error. %% str_to_float(String) -> {ok,Number} | error. %% Use the scanner to process all allowed number syntaxes. bin_to_float(B) -> str_to_float(binary_to_list(B)). str_to_float(S) -> case luerl_scan:string(S) of {ok,[{'NUMBER',_,N}],_} -> {ok,N}; {ok,[{'+',_},{'NUMBER',_,N}],_} -> {ok,N}; {ok,[{'-',_},{'NUMBER',_,N}],_} -> {ok,-N}; _ -> error end. number_to_list(N) -> I = round(N), case I == N of %Is it an "integer"? true -> integer_to_list(I); false -> io_lib:write(N) end. %% tonumber(Arg) -> Number | nil. %% tonumber(Arg, Base) -> Number | nil. %% Tonumber/2 only generates "integers". Lua does it like that. tonumber(N) when is_number(N) -> N; tonumber(B) when is_binary(B) -> case bin_to_float(B) of {ok,N} -> N; error -> nil end; tonumber(_) -> nil. tonumber(A, B) -> case conv_list([A,B], [list,integer]) of [N0,Base] -> case catch begin [N1] = string:tokens(N0, [9,10,11,12,13,32,160]), {ok,list_to_integer(N1, Base)} end of {ok,I} -> float(I); _ -> nil end end. %% tonumber(A, B) -> %% case tonumbers([A,B]) of %% [N1,N2] when ?IS_INTEGER(N1) -> %% N1 * math:pow(10,N2); %% nil -> nil %% end. tointeger(A) -> case tonumber(A) of nil -> nil; N -> float(round(N)) end. tonumbers(As) -> tonumbers(As, []). tonumbers(As, Acc) -> to_loop(As, fun tonumber/1, Acc). tointegers(As) -> tointegers(As, []). tointegers(As, Acc) -> to_loop(As, fun tointeger/1, Acc). tostring(N) when is_number(N) -> list_to_binary(number_to_list(N)); tostring(B) when is_binary(B) -> B; tostring(_) -> nil. tostrings(As) -> tostrings(As, []). tostrings(As, Acc) -> to_loop(As, fun tostring/1, Acc). %% to_loop(List, Convert, Acc) -> List | nil. to_loop(As, Fun, Acc) -> lists:foldr(fun (_, nil) -> nil; %Propagate nil (A, Ns) -> case Fun(A) of nil -> nil; %Propagate nil N -> [N|Ns] end end, Acc, As). %% conv_list(Args, ToTypes) -> List | nil. %% conv_list(Args, ToTypes, Done) -> List | nil. %% Basically a type driven foldr where we return a list or nil. conv_list(As, Tos) -> conv_list(As, Tos, []). conv_list(_, _, nil) -> nil; %Propagate nil conv_list([A|As], [To|Tos], Rs0) -> case conv_list(As, Tos, Rs0) of nil -> nil; %Propagate nil Rs1 -> %% Get the right value. Ret = case To of %% Erlang types. list -> to_list(A); integer -> to_int(A); string -> to_list(A); %% Lua types. lua_any -> A; lua_integer -> tointeger(A); lua_number -> tonumber(A); lua_string -> tostring(A); lua_bool -> ?IS_TRUE(A) end, case Ret of nil -> nil; %Propagate nil Ret -> [Ret|Rs1] end end; conv_list([], _, Acc) -> Acc; %No more arguments, done conv_list(_, [], Acc) -> Acc. %No more conversions, done luerl-0.4/src/luerl_lib_string.erl0000644000232200023220000005731713450242205017712 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_lib_string.erl %% Author : Robert Virding %% Purpose : The string library for Luerl. -module(luerl_lib_string). -include("luerl.hrl"). %% The basic entry point to set up the function table. -export([install/1]). %% Export some test functions. -export([test_gsub/3,test_match_pat/3,test_pat/1, test_byte/3,test_do_find/4,test_sub/2,test_sub/3]). -import(luerl_lib, [lua_error/2,badarg_error/3]). %Shorten this %%-compile([bin_opt_info]). %For when we are optimising install(St0) -> {T,St1} = luerl_emul:alloc_table(table(), St0), {M,St2} = luerl_emul:alloc_table(metatable(T), St1), Meta0 = St2#luerl.meta, Meta1 = Meta0#meta{string=M}, {T,St2#luerl{meta=Meta1}}. %% metatable(Table) -> [{TableName,Table}]. %% table() -> [{FuncName,Function}]. metatable(T) -> %String type metatable [{<<"__index">>,T}]. table() -> %String table [{<<"byte">>,#erl_func{code=fun byte/2}}, {<<"char">>,#erl_func{code=fun char/2}}, {<<"dump">>,#erl_func{code=fun dump/2}}, {<<"find">>,#erl_func{code=fun find/2}}, {<<"format">>,#erl_func{code= fun format/2}}, {<<"gmatch">>,#erl_func{code=fun gmatch/2}}, {<<"gsub">>,#erl_func{code=fun gsub/2}}, {<<"len">>,#erl_func{code=fun len/2}}, {<<"lower">>,#erl_func{code=fun lower/2}}, {<<"match">>,#erl_func{code=fun match/2}}, {<<"rep">>,#erl_func{code=fun rep/2}}, {<<"reverse">>,#erl_func{code=fun reverse/2}}, {<<"sub">>,#erl_func{code=fun sub/2}}, {<<"upper">>,#erl_func{code=fun upper/2}} ]. %% byte(String [, I [, J]] ) -> [Code] %% Return numerical codes of string between I and J. byte(As, St) -> case luerl_lib:conv_list(As, [lua_string,integer,integer]) of [S|Is] -> Bs = do_byte(S, byte_size(S), Is), {Bs,St}; _ -> badarg_error(byte, As, St) %nil or [] end. test_byte(S, I, J) -> do_byte(S, byte_size(S), I, J). do_byte(_, 0, _) -> [nil]; do_byte(S, Len, []) -> do_byte(S, Len, 1, 1); do_byte(S, Len, [I]) -> do_byte(S, Len, I, I); do_byte(S, Len, [I,J]) -> do_byte(S, Len, I, J). do_byte(S, Len, I0, J0) -> %The same as for sub I1 = do_sub_m(Len, I0), J1 = do_sub_m(Len, J0), do_byte_ij(S, Len, I1, J1). do_byte_ij(S, Len, I, J) when I < 1 -> do_byte_ij(S, Len, 1, J); do_byte_ij(S, Len, I, J) when J > Len -> do_byte_ij(S, Len, I, Len); do_byte_ij(_, _, I, J) when I > J -> [nil]; do_byte_ij(S, _, I, J) -> [ float(N) || N <- binary_to_list(S, I, J) ]. %% char(...) -> String %% Return string of the numerical arguments. char([nil], St) -> {[<<>>],St}; char(As, St) -> case catch list_to_binary(luerl_lib:to_ints(As)) of {'EXIT',_} -> badarg_error(char, As, St); B -> {[B],St} end. %% dump(Function) -> String. %% Return a string with binary representation of Function. -spec dump([_], _) -> no_return(). dump(As, St) -> badarg_error(dump, As, St). %% find(String, Pattern [, Init [, Plain]]) -> [Indice]. %% Return first occurrence of Pattern in String. find(As, St0) -> try do_find(As, St0) catch throw:{error,E,St1} -> lua_error(E, St1); throw:{error,E} -> lua_error(E, St0) end. do_find([A1,A2], St) -> do_find([A1,A2,1.0], St); do_find([A1,A2,A3], St) -> do_find([A1,A2,A3,nil], St); do_find(As, St) -> case luerl_lib:conv_list(As, [lua_string,lua_string,integer,lua_bool]) of [S,P,I,Pl] -> {do_find(S, byte_size(S), P, I, Pl),St}; _ -> throw({error,{badarg,find,As},St}) %nil, [_] or [] end. test_do_find(S, Pat, I, Pl) -> do_find(S, byte_size(S), Pat, I, Pl). %% do_find(String, Length, Pattern, Start, Plain) -> [Return]. %% Adjust the starting index and find the string. do_find(_, L, _, I, _) when I > L+1 -> [nil]; do_find(S, L, Pat, I, Pl) when I < -L -> do_find(S, L, Pat, 1, Pl); do_find(S, L, Pat, I, Pl) when I < 0 -> do_find(S, L, Pat, L+I+1, Pl); do_find(S, L, Pat, 0, Pl) -> do_find(S, L, Pat, 1, Pl); do_find(S, L, Pat, I, true) -> %Plain text search string case binary:match(S, Pat, [{scope,{I-1,L-I+1}}]) of {Fs,Fl} -> [float(Fs+1),float(Fs+Fl)]; nomatch -> [nil] end; do_find(S, L, Pat0, I, false) -> %Pattern search string case pat(binary_to_list(Pat0)) of {ok,{Pat1,_},_} -> L1 = L - I + 1, %Length of substring S1 = binary_part(S, I-1, L1), %Start searching from I case match_loop(S1, L1, Pat1, 1) of [{_,P,Len}|Cas] -> %Matches P1 = P + I - 1, %Position in original string [float(P1),float(P1+Len-1)|match_caps(Cas, S, I)]; [] -> [nil] %No match end; {error,E} -> throw({error,E}) end. %% format(Format, ...) -> [String]. %% Format a string. All errors are badarg errors. %% Do all the work in luerl_string_format but generate errors here. format([F|As], St0) -> try luerl_lib_string_format:format(F, As, St0) catch %% If we have a specific error, default is badarg. throw:{error,E,St1} -> lua_error(E, St1); throw:{error,E} -> lua_error(E, St0); _:_ -> badarg_error(format, [F|As], St0) end; format(As, St) -> badarg_error(format, As, St). -spec gmatch([_], _) -> no_return(). %To keep dialyzer quiet %% gmatch(String, Pattern) -> [Function]. gmatch(As, St) -> badarg_error(gmatch, As, St). %% gsub(String, Pattern, Repl [, N]) -> [String] gsub(As, St0) -> try do_gsub(As, St0) catch throw:{error,E,St1} -> lua_error(E, St1); throw:{error,E} -> lua_error(E, St0) end. do_gsub(As, St) -> case luerl_lib:conv_list(As, [lua_string,lua_string,lua_any,integer]) of [S,P,R,N] when N > 0 -> do_gsub(S, byte_size(S), P, R, N, St); [S,P,R] -> %'all' bigger than any number do_gsub(S, byte_size(S), P, R, all, St); _ -> throw({error,{badarg,gsub,As},St}) end. test_gsub(S, P, N) -> {ok,{Pat,_},_} = pat(binary_to_list(P)), gsub_match_loop(S, byte_size(S), Pat, 1, 1, N). do_gsub(S, L, Pat0, R, N, St0) -> case pat(binary_to_list(Pat0)) of {ok,{Pat1,_},_} -> Fs = gsub_match_loop(S, L, Pat1, 1, 1, N), {Ps,St1} = gsub_repl_loop(Fs, S, 1, L, R, St0), {[iolist_to_binary(Ps),float(length(Fs))],St1}; {error,E} -> throw({error,E}) end. %% gsub_match_loop(S, L, Pat, I, C, N) -> [Cas]. %% Return the list of Cas's for each match. gsub_match_loop(_, _, _, _, C, N) when C > N -> []; gsub_match_loop(<<>>, _, Pat, I, _, _) -> %It can still match at end! case match_pat(<<>>, Pat, I) of {match,Cas,_,_} -> [Cas]; nomatch -> [] end; gsub_match_loop(S0, L, Pat, I0, C, N) -> case match_pat(S0, Pat, I0) of {match,Cas,_,I0} -> %Zero length match S1 = binary_part(S0, 1, L-I0), [Cas|gsub_match_loop(S1, L, Pat, I0+1, C+1, N)]; {match,Cas,S1,I1} -> [Cas|gsub_match_loop(S1, L, Pat, I1, C+1, N)]; nomatch -> S1 = binary_part(S0, 1, L-I0), gsub_match_loop(S1, L, Pat, I0+1, C, N) end. %% gsub_repl_loop([Cas], String, Index, Length, Reply, State) -> %% {iolist,State}. %% Build the return string as an iolist processing each match and %% filling in with the original string. gsub_repl_loop([[{_,F,Len}|_]=Cas|Fs], S, I, L, R, St0) -> %% io:fwrite("grl: ~p\n", [{Cas,S,R}]), {Rep,St1} = gsub_repl(Cas, S, R, St0), %% io:fwrite("grl->~p\n", [{Rep}]), {Ps,St2} = gsub_repl_loop(Fs, S, F+Len, L, R, St1), {[binary_part(S, I-1, F-I),Rep|Ps],St2}; gsub_repl_loop([], S, I, L, _, St) -> {[binary_part(S, I-1, L-I+1)],St}. gsub_repl(Cas, S, #tref{}=T, St0) -> case Cas of %Export both Ca and Key [Ca] -> Key = match_cap(Ca, S); [Ca,Ca1|_] -> Key = match_cap(Ca1, S) end, {R,St1} = luerl_emul:get_table_key(T, Key, St0), {[gsub_repl_val(S, R, Ca)],St1}; gsub_repl(Cas0, S, Repl, St0) when ?IS_FUNCTION(Repl) -> case Cas0 of %Export both Ca and Args [Ca] -> Args = [match_cap(Ca, S)]; [Ca|Cas] -> Args = match_caps(Cas, S) end, {Rs,St1} = luerl_emul:functioncall(Repl, Args, St0), {[gsub_repl_val(S, luerl_lib:first_value(Rs), Ca)],St1}; gsub_repl(Cas, S, Repl, St) -> %Replace string case luerl_lib:to_list(Repl) of nil -> {[],St}; R -> {gsub_repl_str(Cas, S, R),St} end. gsub_repl_str(Cas, S, [$%,$%|R]) -> [$%|gsub_repl_str(Cas, S, R)]; gsub_repl_str(Cas, S, [$%,$0|R]) -> Cstr = luerl_lib:tostring(match_cap(hd(Cas), S)), %Force to string [Cstr|gsub_repl_str(Cas, S, R)]; gsub_repl_str(Cas, S, [$%,C|R]) when C >= $1, C =< $9 -> case lists:keysearch(C-$0, 1, Cas) of {value,Ca} -> Cstr = luerl_lib:tostring(match_cap(Ca, S)), %Force to string! [Cstr|gsub_repl_str(Cas, S, R)]; false -> throw({error,{illegal_index,capture,C-$0}}) end; gsub_repl_str(Cas, S, [C|R]) -> [C|gsub_repl_str(Cas, S, R)]; gsub_repl_str(_, _, []) -> []. %% Return string or original match. gsub_repl_val(S, Val, Ca) -> case luerl_lib:tostring(Val) of nil -> match_cap(Ca, S); %Use original match Str -> Str end. %% len(String) -> Length. len([A|_], St) when is_binary(A) -> {[float(byte_size(A))],St}; len([A|_], St) when is_number(A) -> {[length(luerl_lib:number_to_list(A))],St}; len(As, St) -> badarg_error(len, As, St). %% lower(String) -> String. lower(As, St) -> case luerl_lib:conv_list(As, [list]) of [S] -> {[list_to_binary(string:to_lower(S))],St}; _ -> badarg_error(lower, As, St) %nil or [] end. %% match(String, Pattern [, Init]) -> [Match]. match(As, St0) -> try do_match(As, St0) catch throw:{error,E,St1} -> lua_error(E, St1); throw:{error,E} -> lua_error(E, St0) end. do_match([A1,A2], St) -> do_match([A1,A2,1.0], St); do_match(As, St) -> case luerl_lib:conv_list(As, [lua_string,lua_string,integer]) of [S,P,I] -> {do_match(S, byte_size(S), P, I),St}; _ -> throw({error,{badarg,match,As},St}) end. %% do_match(String, Length, Pattern, Start) -> [Return]. %% Adjust the starting index and find the match. do_match(_, L, _, I) when I > L -> [nil]; %Shuffle values do_match(S, L, Pat, I) when I < -L -> do_match(S, L, Pat, 1); do_match(S, L, Pat, I) when I < 0 -> do_match(S, L, Pat, L+I+1); do_match(S, L, Pat, 0) -> do_match(S, L, Pat, 1); do_match(S, L, Pat0, I) -> case pat(binary_to_list(Pat0)) of %"Compile" the pattern {ok,{Pat1,_},_} -> L1 = L - I + 1, %Length of substring S1 = binary_part(S, I-1, L1), %Start searching from I case match_loop(S1, L1, Pat1, 1) of [{_,P,Len}] -> %Only top level match P1 = P + I - 1, %Position in original string [binary_part(S, P1-1, Len)]; [_|Cas] -> %Have sub matches match_caps(Cas, S1); [] -> [nil] %No match end; {error,E} -> throw({error,E}) end. %% match_loop(String, Length, Pattern, Index) -> Cas | []. %% Step down the string trying to find a match. match_loop(S, L, Pat, I) when I > L -> %It can still match at end! case match_pat(S, Pat, I) of {match,Cas,_,_} -> Cas; nomatch -> [] %Now we haven't found it end; match_loop(S0, L, Pat, I) -> case match_pat(S0, Pat, I) of {match,Cas,_,_} -> Cas; nomatch -> S1 = binary_part(S0, 1, L-I), match_loop(S1, L, Pat, I+1) end. %% match_cap(Capture, String [, Init]) -> Capture. %% match_caps(Captures, String [, Init]) -> Captures. %% Get the captures. The string is the whole string not just from %% Init. match_cap(Ca, S) -> match_cap(Ca, S, 1). match_cap({_,P,Len}, _, I) when Len < 0 -> %Capture position float(P+I-1); match_cap({_,P,Len}, S, I) -> %Capture binary_part(S, P+I-2, Len). %Binaries count from 0 match_caps(Cas, S) -> match_caps(Cas, S, 1). match_caps(Cas, S, I) -> [ match_cap(Ca, S, I) || Ca <- Cas ]. %% rep(String, N [, Separator]) -> [String]. rep([A1,A2], St) -> rep([A1,A2,<<>>], St); rep([_,_,_|_]=As, St) -> case luerl_lib:conv_list(As, [lua_string,integer,lua_string]) of [S,I,Sep] -> if I > 0 -> {[iolist_to_binary([S|lists:duplicate(I-1, [Sep,S])])],St}; true -> {[<<>>],St} end; nil -> %Error or bad values badarg_error(rep, As, St) end; rep(As, St) -> badarg_error(rep, As, St). %% reverse([String], State) -> {[Res],St}. reverse([A|_], St) when is_binary(A) ; is_number(A) -> S = luerl_lib:to_list(A), {[list_to_binary(lists:reverse(S))],St}; reverse(As, St) -> badarg_error(reverse, As, St). %% sub([String, I [, J]], State) -> {[Res],State}. sub(As, St) -> case luerl_lib:conv_list(As, [lua_string,integer,integer]) of [S,I|Js] -> Len = byte_size(S), Sub = do_sub(S, Len, I, Js), %Just I, or both I and J {[Sub],St}; _ -> badarg_error(sub, As, St) %nil, [_] or [] end. test_sub(S, I) -> do_sub(S, byte_size(S), I, []). test_sub(S, I, J) -> do_sub(S, byte_size(S), I, [J]). do_sub(S, _, 0, []) -> S; %Special case this do_sub(S, Len, I, []) -> do_sub_1(S, Len, I, Len); do_sub(S, Len, I, [J]) -> do_sub_1(S, Len, I, J). do_sub_1(S, Len, I0, J0) -> I1 = do_sub_m(Len, I0), J1 = do_sub_m(Len, J0), do_sub_ij(S, Len, I1, J1). do_sub_m(Len, I) when I < 0 -> Len+I+1; %Negative count from end do_sub_m(_, I) -> I. do_sub_ij(S, Len, I, J) when I < 1 -> do_sub_ij(S, Len, 1, J); do_sub_ij(S, Len, I, J) when J > Len -> do_sub_ij(S, Len, I, Len); do_sub_ij(_, _, I, J) when I > J -> <<>>; do_sub_ij(S, _, I, J) -> binary:part(S, I-1, J-I+1). %Zero-based, yuch! upper([A|_], St) when is_binary(A) ; is_number(A) -> S = luerl_lib:to_list(A), {[list_to_binary(string:to_upper(S))],St}; upper(As, St) -> badarg_error(upper, As, St). %% This is the pattern grammar used. It may actually be overkill to %% first parse the pattern as the pattern is relativey simple and we %% should be able to do it in one pass. %% %% pat -> seq : '$1'. %% seq -> single seq : ['$1'|'$2']. %% seq -> single : '$1'. %% single -> "(" seq ")" . %% single -> "[" class "]" : {char_class,char_class('$2')} %% single -> "[" "^" class "]" : {comp_class,char_class('$3')} %% single -> char "*" . %% single -> char "+" . %% single -> char "-" . %% single -> char "?" . %% single -> char . %% char -> "%" class . %% char -> "." . %% char -> char . %% The actual parser is a recursive descent implementation of the %% grammar. We leave ^ $ as normal characters and handle them %% specially in matching. pat(Cs0) -> case catch seq(Cs0, 0, 1, []) of {error,E} -> {error,E}; {P,0,Sn} -> {ok,{P,0},Sn}; {_,_,_} -> {error,invalid_capture} end. test_pat(P) -> pat(P). seq([$^|Cs], Sd, Sn, P) -> single(Cs, Sd, Sn, ['^'|P]); seq([_|_]=Cs, Sd, Sn, P) -> single(Cs, Sd, Sn, P); seq([], Sd, Sn, P) -> {lists:reverse(P),Sd,Sn}. single([$(|Cs], Sd, Sn, P) -> single(Cs, Sd+1, Sn+1, [{'(',Sn}|P]); single([$)|_], 0, _, _) -> throw({error,invalid_capture}); single([$)|Cs], Sd, Sn, P) -> single(Cs, Sd-1, Sn, [')'|P]); single([$[|Cs], Sd, Sn, P) -> char_set(Cs, Sd, Sn, P); single([$.|Cs], Sd, Sn, P) -> singlep(Cs, Sd, Sn, ['.'|P]); single([$%|Cs], Sd, Sn, P) -> char_class(Cs, Sd, Sn, P); single([$$], Sd, Sn, P) -> {lists:reverse(P, ['\$']),Sd,Sn}; single([C|Cs], Sd, Sn, P) -> singlep(Cs, Sd, Sn, [C|P]); single([], Sd, Sn, P) -> {lists:reverse(P),Sd,Sn}. singlep([$*|Cs], Sd, Sn, [Char|P]) -> single(Cs, Sd, Sn, [{kclosure,Char}|P]); singlep([$+|Cs], Sd, Sn, [Char|P]) -> single(Cs, Sd, Sn, [{pclosure,Char}|P]); singlep([$-|Cs], Sd, Sn, [Char|P]) -> single(Cs, Sd, Sn, [{mclosure,Char}|P]); singlep([$?|Cs], Sd, Sn, [Char|P]) -> single(Cs, Sd, Sn, [{optional,Char}|P]); singlep(Cs, Sd, Sn, P) -> single(Cs, Sd, Sn, P). char_set([$^|Cs], Sd, Sn, P) -> char_set(Cs, Sd, Sn, P, comp_set); char_set(Cs, Sd, Sn, P) -> char_set(Cs, Sd, Sn, P, char_set). char_set(Cs0, Sd, Sn, P, Tag) -> case char_set(Cs0) of {Set,[$]|Cs1]} -> singlep(Cs1, Sd, Sn, [{Tag,Set}|P]); {_,_} -> throw({error,invalid_char_set}) end. char_set([$]|Cs]) -> char_set(Cs, [$]]); %Must special case this char_set(Cs) -> char_set(Cs, []). char_set([$]|_]=Cs, Set) -> {Set,Cs}; %We are at the end char_set([$%,C|Cs], Set) -> char_set(Cs, [char_class(C)|Set]); char_set([C1,$-,C2|Cs], Set) when C2 =/= $] -> char_set(Cs, [{C1,C2}|Set]); char_set([C|Cs], Set) -> char_set(Cs, [C|Set]); char_set([], Set) -> {Set,[]}. %We are at the end %% char_class([$f,$[|Cs], Sd, Sn, P) -> %% char_set(Cs, Sd, Sn, [frontier|P]); char_class([$f|_], _, _, _) -> throw({error,invalid_pattern}); char_class([$b,L,R|Cs], Sd, Sn, P) -> singlep(Cs, Sd, Sn, [{balance,L,R}|P]); char_class([C|Cs], Sd, Sn, P) -> singlep(Cs, Sd, Sn, [char_class(C)|P]); char_class([], _, _, _) -> throw({error,invalid_pattern}). char_class($a) -> 'a'; char_class($A) -> 'A'; char_class($c) -> 'c'; char_class($C) -> 'C'; char_class($d) -> 'd'; char_class($D) -> 'D'; char_class($g) -> 'g'; char_class($G) -> 'G'; char_class($l) -> 'l'; char_class($L) -> 'L'; char_class($p) -> 'p'; char_class($P) -> 'P'; char_class($s) -> 's'; char_class($S) -> 'S'; char_class($u) -> 'u'; char_class($U) -> 'U'; char_class($w) -> 'w'; char_class($W) -> 'W'; char_class($x) -> 'x'; char_class($X) -> 'X'; char_class($z) -> 'z'; %Deprecated char_class($Z) -> 'Z'; char_class(C) -> %Only non-alphanum allowed case is_w_char(C) of true -> throw({error,{invalid_char_class,C}}); false -> C end. test_match_pat(S, P, I) -> {ok,{Pat,_},_} = pat(P), io:fwrite("tdm: ~p\n", [{Pat}]), match_pat(S, Pat, I). %% match_pat(String, Pattern, Index) -> {match,[Capture],Rest,Index} | nomatch. %% Try and match the pattern with the string *at the current %% position*. No searching. match_pat(S0, P0, I0) -> case match_pat(P0, S0, I0, [{0,I0}], []) of {match,S1,I1,_,Cas} ->{match,Cas,S1,I1}; {nomatch,_,_,_,_,_} -> nomatch end. match_pat(['\$']=Ps, Cs, I, Ca, Cas) -> %Match only end of string case Cs of <<>> -> match_pat([], <<>>, I, Ca, Cas); _ -> {nomatch,Ps,Cs,I,Ca,Cas} end; match_pat(['^'|Ps]=Ps0, Cs, I, Ca, Cas) -> %Match beginning of string if I =:= 1 -> match_pat(Ps, Cs, 1, Ca, Cas); true -> {nomatch,Ps0,Cs,I,Cs,Cas} end; match_pat([{'(',Sn},')'|P], Cs, I, Ca, Cas) -> match_pat(P, Cs, I, Ca, save_cap(Sn, I, -1, Cas)); match_pat([{'(',Sn}|P], Cs, I, Ca, Cas) -> match_pat(P, Cs, I, [{Sn,I}|Ca], Cas); match_pat([')'|P], Cs, I, [{Sn,S}|Ca], Cas) -> match_pat(P, Cs, I, Ca, save_cap(Sn, S, I-S, Cas)); match_pat([{kclosure,P}=K|Ps], Cs, I, Ca, Cas) -> %%io:fwrite("dm: ~p\n", [{[P,K|Ps],Cs,I,Ca,Cas}]), case match_pat([P,K|Ps], Cs, I, Ca, Cas) of %First try with it {match,_,_,_,_}=M -> M; {nomatch,_,_,_,_,_} -> %Else try without it match_pat(Ps, Cs, I, Ca, Cas) end; match_pat([{pclosure,P}|Ps], Cs, I, Ca, Cas) -> %The easy way match_pat([P,{kclosure,P}|Ps], Cs, I, Ca, Cas); match_pat([{mclosure,P}=K|Ps], Cs, I, Ca, Cas) -> case match_pat(Ps, Cs, I, Ca, Cas) of %First try without it {match,_,_,_,_}=M -> M; {nomatch,_,_,_,_,_} -> %Else try with it match_pat([P,K|Ps], Cs, I, Ca, Cas) end; match_pat([{optional,P}|Ps], Cs, I, Ca, Cas) -> case match_pat([P|Ps], Cs, I, Ca, Cas) of %First try with it {match,_,_,_,_}=M -> M; {nomatch,_,_,_,_,_} -> %Else try without it match_pat(Ps, Cs, I, Ca, Cas) end; match_pat([{char_set,Set}|Ps]=Ps0, <>=Cs0, I, Ca, Cas) -> case match_char_set(Set, C) of true -> match_pat(Ps, Cs, I+1, Ca, Cas); false -> {nomatch,Ps0,Cs0,I,Ca,Cas} end; match_pat([{comp_set,Set}|Ps]=Ps0, <>=Cs0, I, Ca, Cas) -> case match_char_set(Set, C) of true -> {nomatch,Ps0,Cs0,I,Ca,Cas}; false -> match_pat(Ps, Cs, I+1, Ca, Cas) end; match_pat([{balance,L,R}|Ps]=Ps0, <>=Cs0, I0, Ca, Cas) -> case balance(Cs1, I0+1, L, R, 1) of {ok,Cs2,I1} -> match_pat(Ps, Cs2, I1, Ca, Cas); error -> {nomatch,Ps0,Cs0,I0,Ca,Cas} end; match_pat(['.'|Ps], <<_,Cs/binary>>, I, Ca, Cas) -> %Matches anything match_pat(Ps, Cs, I+1, Ca, Cas); match_pat([A|Ps]=Ps0, <>=Cs0, I, Ca, Cas) when is_atom(A) -> case match_class(A, C) of true -> match_pat(Ps, Cs, I+1, Ca, Cas); false -> {nomatch,Ps0,Cs0,I,Ca,Cas} end; match_pat([C|Ps], <>, I, Ca, Cas) -> match_pat(Ps, Cs, I+1, Ca, Cas); match_pat([], Cs, I, [{Sn,S}|Ca], Cas) -> {match,Cs,I,Ca,[{Sn,S,I-S}|Cas]}; match_pat(Ps, Cs, I, Ca, Cas) -> {nomatch,Ps,Cs,I,Ca,Cas}. %% save_cap(N, Position, Length, Captures) -> Captures. %% Add a new capture to the list in the right place, ordered. save_cap(N, P, L, [{N1,_,_}=Ca|Cas]) when N > N1 -> [Ca|save_cap(N, P, L, Cas)]; save_cap(N, P, L, Cas) -> [{N,P,L}|Cas]. %% MUST first check for right char, this in case of L == R! balance(<>, I, L, R, D) -> if D =:= 1 -> {ok,Cs,I+1}; true -> balance(Cs, I+1, L, R, D-1) end; balance(<>, I, L, R, D) -> balance(Cs, I+1, L, R, D+1); balance(<<_,Cs/binary>>, I, L, R, D) -> balance(Cs, I+1, L, R, D); balance(<<>>, _, _, _, _) -> error. match_class('a', C) -> is_a_char(C); match_class('A', C) -> not is_a_char(C); match_class('c', C) -> is_c_char(C); match_class('C', C) -> not is_c_char(C); match_class('d', C) -> is_d_char(C); match_class('D', C) -> not is_d_char(C); match_class('g', C) -> is_g_char(C); match_class('G', C) -> not is_g_char(C); match_class('l', C) -> is_l_char(C); match_class('L', C) -> not is_l_char(C); match_class('p', C) -> is_p_char(C); match_class('P', C) -> not is_p_char(C); match_class('s', C) -> is_s_char(C); match_class('S', C) -> not is_s_char(C); match_class('u', C) -> is_u_char(C); match_class('U', C) -> not is_u_char(C); match_class('w', C) -> is_w_char(C); match_class('W', C) -> not is_w_char(C); match_class('x', C) -> is_x_char(C); match_class('X', C) -> not is_x_char(C); match_class('z', C) -> is_z_char(C); %Deprecated match_class('Z', C) -> not is_z_char(C). match_char_set([{C1,C2}|_], C) when C >= C1, C=< C2 -> true; match_char_set([A|Set], C) when is_atom(A) -> match_class(A, C) orelse match_char_set(Set, C); match_char_set([C|_], C) -> true; match_char_set([_|Set], C) -> match_char_set(Set, C); match_char_set([], _) -> false. %% Test for various character types. is_a_char(C) -> %All letters is_l_char(C) orelse is_u_char(C). is_c_char(C) when C >= 0, C =< 31 -> true; %All control characters is_c_char(C) when C >= 128, C =< 159 -> true; is_c_char(_) -> false. is_d_char(C) -> (C >= $0) and (C =< $9). %All digits is_g_char(C) when C >= 33, C =< 126 -> true; %All printable characters is_g_char(C) when C >= 161, C =< 255 -> true; is_g_char(_) -> false. is_l_char(C) when C >= $a, C =< $z -> true; %All lowercase letters is_l_char(C) when C >= 224, C =< 246 -> true; is_l_char(C) when C >= 248, C =< 255 -> true; is_l_char(_) -> false. is_p_char(C) when C >= 33, C =< 47 -> true; %All punctutation characters is_p_char(C) when C >= 58, C =< 63 -> true; is_p_char(C) when C >= 91, C =< 96 -> true; is_p_char(126) -> true; is_p_char(C) when C >= 161, C =< 191 -> true; is_p_char(215) -> true; is_p_char(247) -> true; is_p_char(_) -> false. is_s_char(C) when C >= 9, C =< 13 -> true; %Space characters is_s_char(32) -> true; is_s_char(160) -> true; is_s_char(_) -> false. is_u_char(C) when C >= $A, C =< $Z -> true; %All uppercase letters is_u_char(C) when C >= 192, C =< 214 -> true; is_u_char(C) when C >= 216, C =< 223 -> true; is_u_char(_) -> false. is_w_char(C) -> %All alphanumeric characters is_a_char(C) orelse is_d_char(C). is_x_char(C) when C >= $a, C =< $f -> true; %All hexadecimal characters is_x_char(C) when C >= $A, C =< $F -> true; is_x_char(C) -> is_d_char(C). is_z_char(C) -> C =:= 0. %The zero character, deprecated %% match_class('a', C) -> (char_table(C) band ?_A) =/= 0; %% match_class('A', C) -> (char_table(C) band ?_A) =:= 0. %% char_table(C) when C >= 0, C =< 31 -> ?_C; %% char_table(C) when C >= 65, C =< 91 -> ?_U bor ?_A; %% char_table(C) when C >= 97, C =< 123 -> ?_L; luerl-0.4/src/ttdict.erl0000644000232200023220000005542313450242205015642 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : ttdict.erl %% Author : Robert Virding %% Purpose : Key-Value dictionary as a 2-3 tree. %% This implementation uses 2-3 trees. The description of the tree %% restructuring which is used comes from Prof. Lyn Turbak's notes for %% CS230 Data Structures at Wellesley College. -module(ttdict). %% Standard interface. -export([new/0,is_key/2,to_list/1,from_list/1,size/1]). -export([fetch/2,find/2,fetch_keys/1,erase/2]). -export([store/3,append/3,append_list/3]). -export([update_val/3,update/3,update/4,update_counter/3]). -export([fold/3,map/2,filter/2,merge/3]). %% Extended interface. -export([foreach/2,mapfold/3]). %% Special interface. -export([first/1,last/1,next/2,prev/2]). %% Deprecated interface. -export([dict_to_list/1,list_to_dict/1]). -deprecated([{dict_to_list,1},{list_to_dict,1}]). -compile({no_auto_import,[size/1]}). %We mean our own size/1 -ifdef(DEBUG). -export([check_depth/1]). -endif. %% Data structure: %% - {Left,Key,Val,Right} %% - {Left,Key,Val,Middle,Key,Val,Right} %% - empty %% %% The term order is an arithmetic total order, so we should not %% test exact equality for the keys. (If we do, then it becomes %% possible that neither `>', `<', nor `=:=' matches.) Testing '<' %% and '>' first is statistically better than testing for %% equality, and also allows us to skip the test completely in the %% remaining case. %% %% In all the functions we test keys from left to right in the %% structure. This might not always be the best choice (is there any %% best choice?) but it makes the code consistent. -type ttdict() :: empty | {empty,any(),any(),empty} | {any(),any(),any(),any()} | {empty,any(),any(),empty,any(),any(),empty} | {any(),any(),any(),any(),any(),any(),any()}. -export_type([ttdict/0]). -spec new() -> Dict when Dict :: ttdict(). new() -> empty. %The empty dict -spec is_key(Key, Dict) -> boolean() when Key :: term(), Dict :: ttdict(). is_key(_, empty) -> false; is_key(Key, {L,Xk,_,_}) when Key < Xk -> is_key(Key, L); is_key(Key, {_,Xk,_,R}) when Key > Xk -> is_key(Key, R); is_key(_, {_,_,_,_}) -> true; %Key == Xk is_key(Key, {L,Xk,_,_,_,_,_}) when Key < Xk -> is_key(Key, L); is_key(Key, {_,Xk,_,M,Yk,_,R}) when Key > Xk -> if Key < Yk -> is_key(Key, M); Key > Yk -> is_key(Key, R); true -> true %Key == Yk end; is_key(_, {_,_,_,_,_,_,_}) -> true. %Key == Xk -spec to_list(Dict) -> List when Dict :: ttdict(), List :: [{Key :: term(),Value :: term()}]. to_list(D) -> to_list(D, []). to_list(empty, Tail) -> Tail; to_list({L,Xk,Xv,R}, Tail) -> to_list(L, [{Xk,Xv}|to_list(R, Tail)]); to_list({L,Xk,Xv,M,Yk,Yv,R}, Tail) -> to_list(L, [{Xk,Xv}|to_list(M, [{Yk,Yv}|to_list(R, Tail)])]). -spec from_list(List) -> Dict when List :: [{Key :: term(),Value :: term()}], Dict :: ttdict(). from_list(List) -> lists:foldl(fun ({K,V}, D) -> store(K, V, D) end, new(), List). -spec size(Dict) -> non_neg_integer() when Dict :: ttdict(). size(empty) -> 0; size({L,_,_,R}) -> size(L) + size(R) + 1; size({L,_,_,M,_,_,R}) -> size(L) + size(M) + size(R) + 2. -spec fetch(Key, Dict) -> Value when Key :: term(), Dict :: ttdict(), Value :: term(). fetch(K, {L,Xk,_,_}) when K < Xk -> fetch(K, L); fetch(K, {_,Xk,_,R}) when K > Xk -> fetch(K, R); fetch(_, {_,_,Xv,_}) -> Xv; fetch(K, {L,Xk,_,_,_,_,_}) when K < Xk -> fetch(K, L); fetch(K, {_,Xk,_,M,Yk,Yv,R}) when K > Xk -> if K < Yk -> fetch(K, M); %Middle K > Yk -> fetch(K, R); %Right true -> Yv end; fetch(_, {_,_,Xv,_,_,_,_}) -> Xv; fetch(_, empty) -> error(badarg). -spec find(Key, Dict) -> {ok,Value} | error when Key :: term(), Dict :: ttdict(), Value :: term(). find(K, {L,Xk,_,_}) when K < Xk -> find(K, L); find(K, {_,Xk,_,B}) when K > Xk -> find(K, B); find(_, {_,_,Xv,_}) -> {ok,Xv}; find(K, {L,Xk,_,_,_,_,_}) when K < Xk -> find(K, L); find(K, {_,Xk,_,M,Yk,Yv,R}) when K > Xk -> if K < Yk -> find(K, M); %Middle K > Yk -> find(K, R); %Right true -> {ok,Yv} end; find(_, {_,_,Xv,_,_,_,_}) -> {ok,Xv}; find(_, empty) -> error. -spec fetch_keys(Dict) -> Keys when Dict :: ttdict(), Keys :: [term()]. fetch_keys(D) -> fetch_keys(D, []). fetch_keys(empty, Tail) -> Tail; fetch_keys({L,Xk,_,R}, Tail) -> fetch_keys(L, [Xk|fetch_keys(R, Tail)]); fetch_keys({L,Xk,_,M,Yk,_,R}, Tail) -> fetch_keys(L, [Xk|fetch_keys(M, [Yk|fetch_keys(R, Tail)])]). -spec store(Key, Value, Dict1) -> Dict2 when Key :: term(), Value :: term(), Dict1 :: ttdict(), Dict2 :: ttdict(). store(Key, Val, T) -> %% Store and check for a returned "Up" node. case store_aux(Key, Val, T) of {up,Lu,Ku,Vu,Ru} -> {Lu,Ku,Vu,Ru}; Node -> Node end. store_aux(Key, Val, empty) -> {up,empty,Key,Val,empty}; %"Up" node store_aux(Key, Val, {empty,K,V,empty}) -> %% Special case to avoid creating temporary "up" nodes. %% It helps a little bit, but not much. if Key < K -> {empty,Key,Val,empty,K,V,empty}; Key > K -> {empty,K,V,empty,Key,Val,empty}; true -> {empty,K,Val,empty} end; store_aux(Key, Val, {L,K,V,R}) -> if Key < K -> %Down the left store_up2_l(store_aux(Key, Val, L), K, V, R); Key > K -> %Down the right store_up2_r(L, K, V, store_aux(Key, Val, R)); true -> {L,K,Val,R} %Replace current value end; store_aux(Key, Val, {L,Xk,Xv,M,Yk,Yv,R}) when Key < Xk -> store_up3_l(store_aux(Key, Val, L), Xk, Xv, M, Yk, Yv, R); store_aux(Key, Val, {L,Xk,Xv,M,Yk,Yv,R}) when Key > Xk -> if Key < Yk -> %Down the middle store_up3_m(L, Xk, Xv, store_aux(Key, Val, M), Yk, Yv, R); Key > Yk -> %Down the right store_up3_r(L, Xk, Xv, M, Yk, Yv, store_aux(Key, Val, R)); true -> {L,Xk,Xv,M,Yk,Val,R} end; store_aux(_, Val, {L,Xk,_,M,Yk,Yv,R}) -> %Key == Xk {L,Xk,Val,M,Yk,Yv,R}. -spec append(Key, Value, Dict1) -> Dict2 when Key :: term(), Value :: term(), Dict1 :: ttdict(), Dict2 :: ttdict(). append(Key, Val, T) -> %% Append and check for a returned "Up" node. case append_aux(Key, [Val], T) of {up,Lu,Ku,Vu,Ru} -> {Lu,Ku,Vu,Ru}; Node -> Node end. -spec append_list(Key, Values, Dict1) -> Dict2 when Key :: term(), Values :: [Value :: term()], Dict1 :: ttdict(), Dict2 :: ttdict(). append_list(Key, Val, T) -> %% Append and check for a returned "Up" node. case append_aux(Key, Val, T) of {up,Lu,Ku,Vu,Ru} -> {Lu,Ku,Vu,Ru}; Node -> Node end. append_aux(Key, Val, empty) -> {up,empty,Key,Val,empty}; %"Up" node append_aux(Key, Val, {L,K,V,R}) -> if Key < K -> %Down the left store_up2_l(append_aux(Key, Val, L), K, V, R); Key > K -> %Down the right store_up2_r(L, K, V, append_aux(Key, Val, R)); true -> {L,Key,V ++ Val,R} %Append to current value end; append_aux(Key, Val, {L,Xk,Xv,M,Yk,Yv,R}) when Key < Xk -> store_up3_l(append_aux(Key, Val, L), Xk, Xv, M, Yk, Yv, R); append_aux(Key, Val, {L,Xk,Xv,M,Yk,Yv,R}) when Key > Xk -> if Key < Yk -> store_up3_m(L, Xk, Xv, append_aux(Key, Val, M), Yk, Yv, R); Key > Yk -> store_up3_r(L, Xk, Xv, M, Yk, Yv, append_aux(Key, Val, R)); true -> {L,Xk,Xv,M,Key,Yv ++ Val,R} end; append_aux(Key, Val, {L,_,Xv,M,Yk,Yv,R}) -> {L,Key,Xv ++ Val,M,Yk,Yv,R}. -spec update_val(Key, Value, Dict1) -> Dict2 when Key :: term(), Value :: term(), Dict1 :: ttdict(), Dict2 :: ttdict(). update_val(Key, Val, {L,Xk,Xv,R}) -> if Key < Xk -> {update_val(Key, Val, L),Xk,Xv,R}; Key > Xk -> {L,Xk,Xv,update_val(Key, Val, R)}; true -> {L,Xk,Val,R} end; update_val(Key, Val, {L,Xk,Xv,M,Yk,Yv,R}) when Key < Xk -> {update_val(Key, Val, L),Xk,Xv,M,Yk,Yv,R}; update_val(Key, Val, {L,Xk,Xv,M,Yk,Yv,R}) when Key > Xk -> if Key < Yk -> {L,Xk,Xv,update_val(Key, Val, M),Yk,Yv,R}; Key > Yk -> {L,Xk,Xv,M,Yk,Yv,update_val(Key, Val, R)}; true -> {L,Xk,Xv,M,Yk,Val,R} end; update_val(_, Val, {L,Xk,_,M,Yk,Yv,R}) -> %Key == Xk {L,Xk,Val,M,Yk,Yv,R}. -spec update(Key, Fun, Dict1) -> Dict2 when Key :: term(), Fun :: fun((Value1 :: term()) -> Value2 :: term()), Dict1 :: ttdict(), Dict2 :: ttdict(). update(Key, Fun, {L,Xk,Xv,R}) -> if Key < Xk -> {update(Key, Fun, L),Xk,Xv,R}; Key > Xk -> {L,Xk,Xv,update(Key, Fun, R)}; true -> {L,Xk,Fun(Xv),R} %Key == Xk end; update(Key, Fun, {L,Xk,Xv,M,Yk,Yv,R}) when Key < Xk -> {update(Key, Fun, L),Xk,Xv,M,Yk,Yv,R}; update(Key, Fun, {L,Xk,Xv,M,Yk,Yv,R}) when Key > Xk -> if Key < Yk -> {L,Xk,Xv,update(Key, Fun, M),Yk,Yv,R}; Key > Yk -> {L,Xk,Xv,M,Yk,Yv,update(Key, Fun, R)}; true -> {L,Xk,Xv,M,Yk,Fun(Yv),R} end; update(_, Fun, {L,Xk,Xv,M,Yk,Yv,R}) -> %Key == Xk {L,Xk,Fun(Xv),M,Yk,Yv,R}. -spec update(Key, Fun, Initial, Dict1) -> Dict2 when Key :: term, Initial :: term(), Fun :: fun((Value :: term()) -> Value2 :: term()), Dict1 :: ttdict(), Dict2 :: ttdict(). update(Key, Fun, I, T) -> case update_aux(Key, Fun, I, T) of {up,Lu,Ku,Vu,Ru} -> {Lu,Ku,Vu,Ru}; Node -> Node end. update_aux(Key, _, I, empty) -> {up,empty,Key,I,empty}; update_aux(Key, Fun, I, {L,Xk,Xv,R}) -> if Key < Xk -> store_up2_l(update_aux(Key, Fun, I, L), Xk, Xv, R); Key > Xk -> store_up2_r(L, Xk, Xv, update_aux(Key, Fun, I, R)); true -> {L,Xk,Fun(Xv),R} end; update_aux(Key, Fun, I, {L,Xk,Xv,M,Yk,Yv,R}) when Key < Xk -> store_up3_l(update_aux(Key, Fun, I, L), Xk, Xv, M, Yk, Yv, R); update_aux(Key, Fun, I, {L,Xk,Xv,M,Yk,Yv,R}) when Key > Xk -> if Key < Yk -> store_up3_m(L, Xk, Xv, update_aux(Key, Fun, I, M), Yk, Yv, R); Key > Yk -> store_up3_r(L, Xk, Xv, M, Yk, Yv, update_aux(Key, Fun, I, R)); true -> {L,Xk,Xv,M,Key,Fun(Yv),R} end; update_aux(_, Fun, _, {L,Xk,Xv,M,Yk,Yv,R}) -> %Key == Xk {L,Xk,Fun(Xv),M,Yk,Yv,R}. -spec update_counter(Key, Increment, Dict1) -> Dict2 when Key :: term(), Increment :: number(), Dict1 :: ttdict(), Dict2 :: ttdict(). update_counter(Key, I, T) -> case update_counter_aux(Key, I, T) of {up,Lu,Ku,Vu,Ru} -> {Lu,Ku,Vu,Ru}; Node -> Node end. update_counter_aux(Key, I, empty) -> {up,empty,Key,I,empty}; update_counter_aux(Key, I, {L,Xk,Xv,R}) -> if Key < Xk -> store_up2_l(update_counter_aux(Key, I, L), Xk, Xv, R); Key > Xk -> store_up2_r(L, Xk, Xv, update_counter_aux(Key, I, R)); true -> {L,Xk,Xv+I,R} end; update_counter_aux(Key, I, {L,Xk,Xv,M,Yk,Yv,R}) when Key < Xk -> store_up3_l(update_counter_aux(Key, I, L), Xk, Xv, M, Yk, Yv, R); update_counter_aux(Key, I, {L,Xk,Xv,M,Yk,Yv,R}) when Key > Xk -> if Key < Yk -> store_up3_m(L, Xk, Xv, update_counter_aux(Key, I, M), Yk, Yv, R); Key > Yk -> store_up3_r(L, Xk, Xv, M, Yk, Yv, update_counter_aux(Key, I, R)); true -> {L,Xk,Xv,M,Yk,Yv+I,R} end; update_counter_aux(_, I, {L,Xk,Xv,B,Yk,Yv,R}) -> %Key == Xk {L,Xk,Xv+I,B,Yk,Yv,R}. %% store_up2_l/r(L, K, V, R) -> {L,Xk,Xv,M,Yk,Yv,R} | {L,K,V,R}. store_up2_l({up,Lu,Ku,Vu,Ru}, K, V, R) -> {Lu,Ku,Vu,Ru,K,V,R}; store_up2_l(L, K, V, R) -> {L,K,V,R}. store_up2_r(L, K, V, {up,Lu,Ku,Vu,Ru}) -> {L,K,V,Lu,Ku,Vu,Ru}; store_up2_r(L, K, V, R) -> {L,K,V,R}. %% store_up3_l/m/r(L, Xk, Xv, M, Yk, Yv, R) -> %% {up,L,K,V,R} | {L,Xk,Xv,M,Yk,Yv,R}. store_up3_l({up,Lu,Ku,Vu,Ru}, Xk, Xv, M, Yk, Yv, R) -> {up,{Lu,Ku,Vu,Ru},Xk,Xv,{M,Yk,Yv,R}}; store_up3_l(L, Xk, Xv, M, Yk, Yv, R) -> {L,Xk,Xv,M,Yk,Yv,R}. store_up3_m(L, Xk, Xv, {up,Lu,Ku,Vu,Ru}, Yk, Yv, R) -> {up,{L,Xk,Xv,Lu},Ku,Vu,{Ru,Yk,Yv,R}}; store_up3_m(L, Xk, Xv, M, Yk, Yv, R) -> {L,Xk,Xv,M,Yk,Yv,R}. store_up3_r(L, Xk, Xv, M, Yk, Yv, {up,Lu,Ku,Vu,Ru}) -> {up,{L,Xk,Xv,M},Yk,Yv,{Lu,Ku,Vu,Ru}}; store_up3_r(L, Xk, Xv, M, Yk, Yv, R) -> {L,Xk,Xv,M,Yk,Yv,R}. -spec erase(Key, Dict1) -> Dict2 when Key :: term(), Dict1 :: ttdict(), Dict2 :: ttdict(). erase(Key, T) -> case erase_aux(Key, T) of {up,T1} -> T1; %??? T1 -> T1 end. erase_aux(_, empty) -> empty; %No element erase_aux(Key, {empty,Xk,_,empty}=N) -> if Key < Xk; Key > Xk -> N; %No element true -> {up,empty} end; erase_aux(Key, {L,Xk,Xv,R}) -> if Key < Xk -> %Down the left erase_up2_l(erase_aux(Key, L), Xk, Xv, R); Key > Xk -> %Down the right erase_up2_r(L, Xk, Xv, erase_aux(Key, R)); true -> {{Km,Vm},R1}= erase_min(R), erase_up2_r(L, Km, Vm, R1) end; erase_aux(Key, {empty,Xk,Xv,empty,Yk,Yv,empty}=N) -> if Key < Xk -> N; %No element Key > Xk -> if Key < Yk -> N; %No element Key > Yk -> N; true -> {empty,Xk,Xv,empty} end; true -> {empty,Yk,Yv,empty} end; erase_aux(Key, {L,Xk,Xv,M,Yk,Yv,R}) when Key < Xk -> erase_up3_l(erase_aux(Key, L), Xk, Xv, M, Yk, Yv, R); erase_aux(Key, {L,Xk,Xv,M,Yk,Yv,R}) when Key > Xk -> if Key < Yk -> erase_up3_m(L, Xk, Xv, erase_aux(Key, M), Yk, Yv, R); Key > Yk -> erase_up3_r(L, Xk, Xv, M, Yk, Yv, erase_aux(Key, R)); true -> {{Km,Vm},R1} = erase_min(R), erase_up3_r(L, Xk, Xv, M, Km, Vm, R1) end; erase_aux(_, {L,_,_,M,Yk,Yv,R}) -> {{Km,Vm},M1} = erase_min(M), erase_up3_m(L, Km, Vm, M1, Yk, Yv, R). erase_min(T) -> %%io:format("em: ~p\n-> ~p\n", [T,T1]), erase_min1(T). erase_min1({empty,Xk,Xv,empty}) -> {{Xk,Xv},{up,empty}}; erase_min1({L,Xk,Xv,R}) -> {Min,L1} = erase_min1(L), {Min,erase_up2_l(L1, Xk, Xv, R)}; erase_min1({empty,Xk,Xv,empty,Yk,Yv,empty}) -> {{Xk,Xv},{empty,Yk,Yv,empty}}; erase_min1({L,Xk,Xv,M,Yk,Yv,R}) -> {Min,L1} = erase_min1(L), {Min,erase_up3_l(L1, Xk, Xv, M, Yk, Yv, R)}. %% erase_up2_l/r(L, K, V, R) -> Node | {up,Node}. %% We use the same naming of nodes and keys as in the text. It makes %% checking the rules easier. erase_up2_l({up,L}, Xk, Xv, {M,Yk,Yv,R}) -> %1.1 {up,{L,Xk,Xv,M,Yk,Yv,R}}; erase_up2_l({up,A}, Xk, Xv, {B,Yk,Yv,C,Zk,Zv,D}) -> %2.1 {{A,Xk,Xv,B},Yk,Yv,{C,Zk,Zv,D}}; erase_up2_l(L, K, V, R) -> {L,K,V,R}. erase_up2_r({L,Xk,Xv,M}, Yk, Yv, {up,R}) -> %1.2 {up,{L,Xk,Xv,M,Yk,Yv,R}}; erase_up2_r({A,Xk,Xv,B,Yk,Yv,C}, Zk, Zv, {up,D}) -> %2.2 {{A,Xk,Xv,B},Yk,Yv,{C,Zk,Zv,D}}; erase_up2_r(L, K, V, R) -> {L,K,V,R}. %% erase_up2_r(L, K, V, {up,R}) -> erase_up2_r1(L, K, V, R); %% erase_up2_r(L, K, V, R) -> {L,K,V,R}. %% erase_up2_r1({L,Xk,Xv,M}, Yk, Yv, R) -> %1.2 %% {up,{L,Xk,Xv,M,Yk,Yv,R}}; %% erase_up2_r1({A,Xk,Xv,B,Yk,Yv,C}, Zk, Zv, D) -> %2.2 %% {{A,Xk,Xv,B},Yk,Yv,{C,Zk,Zv,D}}. %% erase_up3_l/m/r(L, Xk, Xv, M, Yk, Yv, R) -> Node | {up,Node}. %% We use the same naming of nodes and keys as in the text. It makes %% checking the rules easier. N.B. there are alternate valid choices %% for the middle case! erase_up3_l({up,A}, Xk, Xv, {B,Yk,Yv,C}, Zk, Zv, D) -> %3a.1 {{A,Xk,Xv,B,Yk,Yv,C},Zk,Zv,D}; erase_up3_l({up,A}, Wk, Wv, {B,Xk,Xv,C,Yk,Yv,D}, Zk, Zv, E) -> %4a.1 {{A,Wk,Wv,B},Xk,Xv,{C,Yk,Yv,D},Zk,Zv,E}; erase_up3_l(A, Xk, Xv, B, Yk, Yv, C) -> {A,Xk,Xv,B,Yk,Yv,C}. erase_up3_m({A,Xk,Xv,B}, Yk, Yv, {up,C}, Zk, Zv, D) -> %3a.2 {{A,Xk,Xv,B,Yk,Yv,C},Zk,Zv,D}; erase_up3_m(A, Xk, Xv, {up,B}, Yk, Yv, {C,Zk,Zv,D}) -> %3b.1 {A,Xk,Xv,{B,Yk,Yv,C,Zk,Zv,D}}; erase_up3_m({A,Wk,Wv,B,Xk,Xv,C}, Yk, Yv, {up,D}, Zk, Zv, E) -> %4a.2 {{A,Wk,Wv,B},Xk,Xv,{C,Yk,Yv,D},Zk,Zv,E}; erase_up3_m(A, Wk, Wv, {up,B}, Xk, Xv, {C,Yk,Yv,D,Zk,Zv,E}) -> %4b.1 {A,Wk,Wv,{B,Xk,Xv,C},Yk,Yv,{D,Zk,Zv,E}}; erase_up3_m(A, Xk, Xv, B, Yk, Yv, C) -> {A,Xk,Xv,B,Yk,Yv,C}. erase_up3_r(A, Xk, Xv, {B,Yk,Yv,C}, Zk, Zv, {up,D}) -> %3b.2 {A,Xk,Xv,{B,Yk,Yv,C,Zk,Zv,D}}; erase_up3_r(A, Wk, Wv, {B,Xk,Xv,C,Yk,Yv,D}, Zk, Zv, {up,E}) -> %4b.2 {A,Wk,Wv,{B,Xk,Xv,C},Yk,Yv,{D,Zk,Zv,E}}; erase_up3_r(A, Xk, Xv, B, Yk, Yv, C) -> {A,Xk,Xv,B,Yk,Yv,C}. -spec fold(Fun, Acc0, Dict) -> Acc1 when Fun :: fun((Key, Value, AccIn) -> AccOut), Key :: term(), Value :: term(), Acc0 :: term(), Acc1 :: term(), AccIn :: term(), AccOut :: term(), Dict :: ttdict(). %% Apply Fun to each element in Dict. Do it left to right, even if %% this is not specified. fold(_, Acc, empty) -> Acc; fold(F, Acc, {L,Xk,Xv,R}) -> fold(F, F(Xk, Xv, fold(F, Acc, R)), L); fold(F, Acc, {L,Xk,Xv,M,Yk,Yv,R}) -> fold(F, F(Xk, Xv, fold(F, F(Yk, Yv, fold(F, Acc, R)), M)), L). -spec map(Fun, Dict1) -> Dict2 when Fun :: fun((Key :: term(), Value1 :: term()) -> Value2 :: term()), Dict1 :: ttdict(), Dict2 :: ttdict(). %% Apply Fun to each element in Dict. Do it left to right, even if %% this is not specified. map(_, empty) -> empty; map(F, {A,Xk,Xv,B}) -> {map(F, A),Xk,F(Xk, Xv),map(F, B)}; map(F, {A,Xk,Xv,B,Yk,Yv,C}) -> {map(F, A),Xk,F(Xk, Xv),map(F, B),Yk,F(Yk, Yv),map(F, C)}. -spec filter(Pred, Dict1) -> Dict2 when Pred :: fun((Key :: term(), Value :: term()) -> boolean()), Dict1 :: ttdict(), Dict2 :: ttdict(). %% Apply Fun to each element in Dict. Do it left to right, even if %% this is not specified. filter(F, D) -> filter(F, D, new()). filter(_, empty, New) -> New; filter(F, {L,Xk,Xv,R}, New0) -> New1 = filter(F, L, New0), New2 = case F(Xk, Xv) of true -> store(Xk, Xv, New1); false -> New1 end, filter(F, R, New2); filter(F, {L,Xk,Xv,M,Yk,Yv,R}, New0) -> New1 = filter(F, L, New0), New2 = case F(Xk, Xv) of true -> store(Xk, Xv, New1); false -> New1 end, New3 = filter(F, M, New2), New4 = case F(Yk, Yv) of true -> store(Yk, Yv, New3); false -> New3 end, filter(F, R, New4). -spec merge(Fun, Dict1, Dict2) -> Dict3 when Fun :: fun((Key :: term(), Value1 :: term(), Value2 :: term()) -> Value :: term()), Dict1 :: ttdict(), Dict2 :: ttdict(), Dict3 :: ttdict(). merge(F, D1, D2) -> fold(fun (K, V2, D) -> update(K, fun(V1) -> F(K, V1, V2) end, V2, D) end, D1, D2). %% Extended interface. -spec foreach(Fun, Dict) -> ok when Fun :: fun((Key :: term(), Value :: term()) -> term()), Dict :: ttdict(). %% Apply Fun to each element in Dict. Do it left to right, even if %% this is not specified. foreach(_, empty) -> ok; foreach(F, {L,Xk,Xv,R}) -> foreach(F, L), F(Xk, Xv), foreach(F, R); foreach(F, {L,Xk,Xv,M,Yk,Yv,R}) -> foreach(F, L), F(Xk, Xv), foreach(F, M), F(Yk, Yv), foreach(F, R). -spec mapfold(Fun, Acc0, Dict1) -> {Dict2,Acc1} when Fun :: fun((Key, Value1, AccIn) -> {Value2,AccOut}), Acc0 :: term(), Acc1 :: term(), Key :: term(), Value1 :: term(), Value2 :: term(), AccIn :: term(), AccOut :: term(), Dict1 :: ttdict(), Dict2 :: ttdict(). %% Apply Fun to each element in Dict. Do it left to right, even if %% this is not specified. mapfold(_, Acc, empty) -> {empty,Acc}; mapfold(F, Acc0, {L0,Xk,Xv0,R0}) -> {L1,Acc1} = mapfold(F, Acc0, L0), {Xv1,Acc2} = F(Xk, Xv0, Acc1), {R1,Acc3} = mapfold(F, Acc2, R0), {{L1,Xk,Xv1,R1},Acc3}; mapfold(F, Acc0, {L0,Xk,Xv0,M0,Yk,Yv0,R0}) -> {L1,Acc1} = mapfold(F, Acc0, L0), {Xv1,Acc2} = F(Xk, Xv0, Acc1), {M1,Acc3} = mapfold(F, Acc2, M0), {Yv1,Acc4} = F(Yk, Yv0, Acc3), {R1,Acc5} = mapfold(F, Acc4, R0), {{L1,Xk,Xv1,M1,Yk,Yv1,R1},Acc5}. %% Special interface. -spec first(Dict) -> error | {ok,{Key1,Value}} when Key1 :: term(), Value :: term(), Dict :: ttdict(). first(empty) -> error; first({L,Xk,Xv,_}) -> case first(L) of error -> {ok,{Xk,Xv}}; First -> First end; first({L,Xk,Xv,_,_,_,_}) -> case first(L) of error -> {ok,{Xk,Xv}}; First -> First end. -spec last(Dict) -> error | {ok,{Key1,Value}} when Key1 :: term(), Value :: term(), Dict :: ttdict(). last(empty) -> error; last({_,Xk,Xv,R}) -> case last(R) of error -> {ok,{Xk,Xv}}; Last -> Last end; last({_,_,_,_,Yk,Yv,R}) -> case last(R) of error -> {ok,{Yk,Yv}}; Last -> Last end. -spec next(Key, Dict) -> error | {ok,{Key1,Value}} when Key :: term(), Key1 :: term(), Value :: term(), Dict :: ttdict(). next(_, empty) -> error; next(K, {L,Xk,Xv,_}) when K < Xk -> case next(K, L) of error -> {ok,{Xk,Xv}}; Next -> Next end; next(K, {_,Xk,_,R}) when K > Xk -> next(K, R); next(_, {_,_,_,R}) -> first(R); %when K == Xk next(K, {L,Xk,Xv,_,_,_,_}) when K < Xk -> case next(K, L) of error -> {ok,{Xk,Xv}}; Next -> Next end; next(K, {_,Xk,_,M,Yk,Yv,R}) when K > Xk -> if K < Yk -> case next(K, M) of error -> {ok,{Yk,Yv}}; Next -> Next end; K > Yk -> next(K, R); true -> first(R) %when K == Yk end; next(_, {_,_,_,M,Yk,Yv,_}) -> %when K == Xk case first(M) of error -> {ok,{Yk,Yv}}; First -> First end. -spec prev(Key, Dict) -> error | {ok,{Key1,Value}} when Key :: term(), Key1 :: term(), Value :: term(), Dict :: ttdict(). %% Go from right to left here as it makes it easier to understand %% what is going on. prev(_, empty) -> error; prev(K, {_,Xk,Xv,R}) when K > Xk -> case prev(K, R) of error -> {ok,{Xk,Xv}}; Prev -> Prev end; prev(K, {L,Xk,_,_}) when K < Xk -> prev(K, L); prev(_, {L,_,_,_}) -> last(L); %when K == Xk prev(K, {_,_,_,_,Yk,Yv,R}) when K > Yk -> case prev(K, R) of error -> {ok,{Yk,Yv}}; Prev -> Prev end; prev(K, {L,Xk,Xv,M,Yk,_,_}) when K < Yk -> if K > Xk -> case prev(K, M) of error -> {ok,{Xk,Xv}}; Prev -> Prev end; K < Xk -> prev(K, L); true -> last(L) %when K == Xk end; prev(_, {_,Xk,Xv,M,_,_,_}) -> %when K == Yk case last(M) of error -> {ok,{Xk,Xv}}; Prev -> Prev end. %% Deprecated interface. %% dict_to_list(Dictionary) -> [{Key,Value}]. dict_to_list(D) -> to_list(D). %% list_to_dict([{Key,Value}]) -> Dictionary. list_to_dict(L) -> from_list(L). -ifdef(DEBUG). %% Check the depth of all the leaves, should all be the same. check_depth(T) -> check_depth(T, 1, orddict:new()). check_depth(empty, D, Dd) -> orddict:update_counter(D, 1, Dd); check_depth({L,_,_,R}, D, Dd0) -> Dd1 = orddict:update_counter(two, 1, Dd0), Dd2 = check_depth(L, D+1, Dd1), check_depth(R, D+1, Dd2); check_depth({L,_,_,M,_,_,R}, D, Dd0) -> Dd1 = orddict:update_counter(three, 1, Dd0), Dd2 = check_depth(L, D+1, Dd1), Dd3 = check_depth(M, D+1, Dd2), check_depth(R, D+1, Dd3). -endif. luerl-0.4/src/NOTES0000644000232200023220000001335513450242205014454 0ustar debalancedebalance Copyright (c) 2013 Robert Virding Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. Implementation Notes -------------------- Syntax ------ We are almost able to represent the Lua syntax as an LALR(1) grammar. The only place this doesn't work is when a statement can be a function call as it clashes when it can also be a varlist. We get around this by using the more general prefixexp and doing a post-test to check that it is a functioncall. This works together with the varlist. Data ---- For the Lua data types we internally use the corresponding Erlang: nil - nil true/false - true/false strings - binaries numbers - floats tables - #table{} with array for keys 1..n, ordict for rest userdata - #userdata{} function - #function{} or {function,Fun} thread - #thread{} See luerl.hrl for the field names of the records. All tables are combinations of ttdicts and arrays. In each table an array is used for integer keys >= 1 while an ttdict is used for all other keys. We use this information when building/processing tables. Seems like Lua internaly stores elements as a (unordered) sequence of key-value elements, except maybe for the table part. Some tests show that using ttdicts for all elements results the system being 10-20% slower and using more memory. So using the array module for positive integer keys seems a reasonable choice. Direct read/write access is fast, but "shifting" access for example in table.insert/remove is not that efficient. Most table functions work after a fashion even in the "undefined" case all the elements don't have keys only in 1..n, but it seems like the order in which elements were added affects the outcome. We don't have any such information available. We do try to do something reasonable that sort of mirrors the Lua functions. Should we or should we be strict? The table table can be either an ordict, an array, use the process dictionary, or an ETS table; these are accessed through macros. To use ETS would need a bigger change as copying the whole table for each access would be very inefficient. Either use bags and have one per table or use sets and have the ETS key as {Tab,Key}. Machine ------- The VM is a hybrid. It uses normal Erlang function calls for Luerl calls and blocks and has a small instruction set for operations inside a block. This should make it not too difficult to compile down to straight Erlang in the future. Blocks keep variables in tuples. There are two variable types depending on how they are defined: - Local variables that are used in this block and sub-blocks, but not used in any functions defined in the blocks. These are kept in a stack of tuples, the LocalVars or Lvs, and referenced by offset in stack and offset in tuple. - Environemnt variables that are defined in functions which are defined in this block or in sub-blocks. This mean they must be kept around as long as the functions are alive and are stored in the global heap as each invocation can modify them. They are kept in a stack of references, the EnvironmentVars or Evs, to tuples in the global heap and referenced by offset in stack and offset in tuple. A function contains a reference to the stack of environment variables which existed when it was created. Note that the mutable nature of Lua data means that these can be modified and the changes must be visible to every function which references them. There is also a stack containing arguments and temporary values. This is stack is "global" in the sense that it is passed through all calls and blocks. It is also passed as an argument into functions implemented in Erlang. This is so that event of a Lua/Luerl GC the collector uses the stack to determine which data in the global heap is to be saved. The VM is a pure stack machine. To handle multiple return values we always return a list of values. The only place this is not done is in luerl_eval.erl when getting values from the environment where we can only have one value. This means a lot of calls to first_value/1 in luerl_emul.erl, but the consistency is worth it. Similarily all the arguments in a function call are passed in a list. The function then unpacks the list into its arguments, including '...'. All of the predefined libraries have an install/1 function. This is called when initialising Luerl; it does any library specific initialisation necessary and returns a table containing the functions in the library. We create a unique tag which is saved in the environment. This is used so we can implement 'break' with a simple throw. The thrown value includes the tag so we can uniquely catch it and not get confused with a throw/error/exit from the erlang code. Compiler -------- The compiler has state at different levels: - In luerl_comp there is #comp{} containing code, options and errors. - In the #cst{} between the compiler modules for data outside the code. This empty so far. - Inside and local to the compiler modules. All the compiler modules are written so that they chain a status argument through their code, even if it not used. When they are not used we just send the atom 'nil' through and check it comes out "the other end". Lua implementation "features" ----------------------------- When "integers" are wanted then float input values are often "rounded" to the correct float value. So 1.3 --> 1.0 and 3.7 --> 4.0. luerl-0.4/src/luerl_lib_table.erl0000644000232200023220000004634513450242205017472 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_lib_table.erl %% Author : Robert Virding %% Purpose : The table library for Luerl. %% These functions sometimes behave strangely in the Lua 5.2 %% libraries, but we try to follow them. Most of these functions KNOW %% that a table is a ttdict! We know that the erlang array has default %% value 'nil'. -module(luerl_lib_table). -include("luerl.hrl"). %% The basic entry point to set up the function table. -export([install/1]). %% Export some functions which can be called from elsewhere. -export([concat/4,concat/5,raw_length/2,length/2,unpack/2]). %% Export some test functions. -export([test_concat/1, test_insert/2,test_insert/3, test_remove/2,test_remove/3]). -import(luerl_lib, [lua_error/2,badarg_error/3]). %Shorten this install(St) -> luerl_emul:alloc_table(table(), St). %% table() -> [{FuncName,Function}]. table() -> [{<<"concat">>,#erl_func{code=fun concat/2}}, {<<"insert">>,#erl_func{code=fun insert/2}}, {<<"pack">>,#erl_func{code=fun pack/2}}, {<<"remove">>,#erl_func{code=fun remove/2}}, {<<"sort">>,#erl_func{code=fun sort/2}}, {<<"unpack">>,#erl_func{code=fun unpack/2}} ]. %% concat - concat the elements of a list into a string. concat(As, St0) -> try do_concat(As, St0) catch throw:{error,E,St1} -> lua_error(E, St1); throw:{error,E} -> lua_error(E, St0) end. do_concat([#tref{i=N}|As], St) -> #table{a=Arr,d=Dict} = ?GET_TABLE(N, St#luerl.ttab), case luerl_lib:conv_list(concat_args(As), [lua_string,integer,integer]) of [Sep,I] -> {[do_concat(Arr, Dict, Sep, I, length_loop(Arr))],St}; [Sep,I,J] -> {[do_concat(Arr, Dict, Sep, I, J)],St}; _ -> throw({error,{badarg,concat,As},St}) end; do_concat(As, St) -> throw({error,{badarg,concat,As},St}). %% concat(Table, Sep, I, State) -> string(). %% concat(Table, Sep, I, J, State) -> string(). %% Concatenate elements in a list into a string. Callable from %% Erlang. concat(#tref{i=N}, Sep, I, St) -> #table{a=Arr,d=Dict} = ?GET_TABLE(N, St#luerl.ttab), J = length_loop(Arr), do_concat(Arr, Dict, Sep, I, J). concat(#tref{i=N}, Sep, I, J, St) -> #table{a=Arr,d=Dict} = ?GET_TABLE(N, St#luerl.ttab), do_concat(Arr, Dict, Sep, I, J). test_concat(As) -> concat_args(As). concat_args([]) -> concat_args([<<>>]); concat_args([nil|As]) -> concat_args([<<>>|As]); concat_args([Sep]) -> [Sep,1.0]; concat_args([Sep,nil|As]) -> concat_args([Sep,1.0|As]); concat_args([Sep,I]) -> [Sep,I]; concat_args([Sep,I,nil|_]) -> [Sep,I]; concat_args([Sep,I,J|_]) -> [Sep,I,J]. do_concat(Arr, Dict, Sep, I, J) -> Conc = concat_table(Arr, Dict, I, J), concat_join(Conc, Sep). concat_table(Arr, Dict, I, J) -> concat_tab(Arr, Dict, I, J). %% This and unpack_loop are very similar. %% First scan over table up to 0 then the array. We have the indexes %% and limits as integers and explicitly use '==' to compare with %% float values in table. concat_tab(_, _, N, J) when N > J -> []; %Done concat_tab(Arr, _, N, J) when N > 0 -> %Done with table concat_arr(Arr, N, J); concat_tab(Arr, Dict, N, J) -> case ttdict:find(N, Dict) of {ok,V} -> case luerl_lib:to_list(V) of nil -> throw({error,{illegal_val,concat,V}}); S -> [S|concat_tab(Arr, Dict, N+1, J)] end; error -> throw({error,{illegal_val,concat,nil}}) end. concat_arr(_, N, J) when N > J -> []; concat_arr(Arr, N, J) -> V = array:get(N, Arr), case luerl_lib:to_list(V) of nil -> throw({error,{illegal_val,concat,V}}); S -> [S|concat_arr(Arr, N+1, J)] end. concat_join([E], _) -> list_to_binary(E); concat_join([E1|Es], Sep) -> iolist_to_binary([E1|[ [Sep,E] || E <- Es ]]); concat_join([], _) -> <<>>. %% insert(Table, [Pos,] Value) -> [] %% Insert an element into a list shifting following elements. insert([#tref{i=N},V], St) -> Ts0 = St#luerl.ttab, #table{a=Arr0} = T = ?GET_TABLE(N, Ts0), Arr1 = do_insert_last(Arr0, V), Ts1 = ?SET_TABLE(N, T#table{a=Arr1}, Ts0), {[],St#luerl{ttab=Ts1}}; insert([#tref{i=N},P0,V]=As, St) -> Ts0 = St#luerl.ttab, #table{a=Arr0} = T = ?GET_TABLE(N, Ts0), Size = length_loop(Arr0), case luerl_lib:to_int(P0) of P1 when P1 >=1, P1 =< Size+1 -> Arr1 = do_insert(Arr0, P1, V), Ts1 = ?SET_TABLE(N, T#table{a=Arr1}, Ts0), {[],St#luerl{ttab=Ts1}}; _ -> badarg_error(insert, As, St) end; insert(As, St) -> badarg_error(insert, As, St). test_insert(A, V) -> do_insert_last(A, V). test_insert(A, N, V) -> do_insert(A, N, V). %% do_insert_last(Array, V) -> Array. %% Get the "length" of the first bit and put value in first slot %% after that. do_insert_last(Arr, V) -> Len = length_loop(Arr), %Get "length" array:set(Len+1, V, Arr). %Set the value %% do_insert(Array, P, V) -> Array. %% We only insert elements inside the "proper" 1..n table. do_insert(Arr, P, V) -> %Go to the array part insert_array(Arr, P, V). insert_array(Arr0, N, Here) -> %Put this at N shifting up case array:get(N, Arr0) of nil -> array:set(N, Here, Arr0); %Just fill hole Next -> %Take value for next slot Arr1 = array:set(N, Here, Arr0), insert_array(Arr1, N+1, Next) end. %% remove(Table [,Pos]) -> Value. %% Remove an element from a list shifting following elements. remove([#tref{i=N}], St) -> Ts0 = St#luerl.ttab, #table{a=Arr0,d=Dict0} = T = ?GET_TABLE(N, Ts0), {Ret,Arr1,Dict1} = do_remove_last(Arr0, Dict0), Ts1 = ?SET_TABLE(N, T#table{a=Arr1,d=Dict1}, Ts0), {Ret,St#luerl{ttab=Ts1}}; remove([#tref{i=N},P0|_]=As, St) -> Ts0 = St#luerl.ttab, #table{a=Arr0,d=Dict0} = T = ?GET_TABLE(N, Ts0), case luerl_lib:to_int(P0) of P1 when P1 =/= nil -> case do_remove(Arr0, Dict0, P1) of {Ret,Arr1,Dict1} -> Ts1 = ?SET_TABLE(N, T#table{a=Arr1,d=Dict1}, Ts0), {Ret,St#luerl{ttab=Ts1}}; badarg -> badarg_error(remove, As, St) end; _ -> badarg_error(remove, As, St) %nil or P < 1 end; remove(As, St) -> badarg_error(remove, As, St). test_remove(Arr, Dict) -> do_remove_last(Arr, Dict). test_remove(Arr, Dict, N) -> do_remove(Arr, Dict, N). %% do_remove_last(Array, Dict) -> {Return,Array,Dict}. %% Find the length and remove the last element. Return it even if it %% is nil. do_remove_last(Arr0, Dict0) -> case length_loop(Arr0) of 0 -> do_remove_0(Arr0, Dict0); Size -> Val = array:get(Size, Arr0), Arr1 = array:set(Size, nil, Arr0), {[Val],Arr1,Dict0} end. do_remove_0(Arr, Dict0) -> case ttdict:find(0.0, Dict0) of {ok,Val} -> Dict1 = ttdict:erase(0.0, Dict0), {[Val],Arr,Dict1}; error -> {[nil],Arr,Dict0} end. %% do_remove(Array, Dict, P) -> {Return,Array,Dict} | badarg. %% Don't ask, it tries to emulate the "real" Lua, where we can't %% remove elements elements outside of the "proper" 1..n dict. do_remove(Arr, Dict, P) -> do_remove(Arr, Dict, P, length_loop(Arr)). do_remove(Arr, Dict, 0, 0) -> do_remove_0(Arr, Dict); do_remove(Arr, Dict, 1, 0) -> {[nil],Arr,Dict}; do_remove(Arr0, Dict, P, Size) when P >= 1, P =< Size+1 -> Ret = array:get(P, Arr0), Arr1 = remove_array_1(Arr0, P), {[Ret],Arr1,Dict}; do_remove(_, _, _, _) -> badarg. remove_array_1(Arr0, N) -> There = array:get(N+1, Arr0), %Next value Arr1 = array:set(N, There, Arr0), if There =:= nil -> Arr1; %End if next a nil true -> remove_array_1(Arr1, N+1) end. %% pack - pack arguments in to a table. pack(As, St0) -> T = pack_loop(As, 0.0), %Indexes are floats! {Tab,St1} = luerl_emul:alloc_table(T, St0), {[Tab],St1}. pack_loop([E|Es], N) -> [{N+1,E}|pack_loop(Es, N+1)]; pack_loop([], N) -> [{<<"n">>,N}]. %% unpack - unpack table into return values. unpack([#tref{i=N}=T|As], St) -> #table{a=Arr,d=Dict} = ?GET_TABLE(N, St#luerl.ttab), case luerl_lib:to_ints(unpack_args(As)) of [I] -> Unp = do_unpack(Arr, Dict, I, length_loop(Arr)), %% io:fwrite("unp: ~p\n", [{Arr,I,Start,Unp}]), {Unp,St}; [I,J] -> Unp = do_unpack(Arr, Dict, I, J), %% io:fwrite("unp: ~p\n", [{Arr,I,J,Start,Unp}]), {Unp,St}; nil -> badarg_error(unpack, [T|As], St) %Not numbers end; unpack([], St) -> badarg_error(unpack, [], St). %% unpack_args(Args) -> Args. %% Fix args for unpack getting defaults right and handling 'nil'. unpack_args([]) -> unpack_args([1.0]); %Just start from the beginning unpack_args([nil|As]) -> unpack_args([1.0|As]); unpack_args([I]) -> [I]; %Only one argument unpack_args([I,nil|_]) -> [I]; %Goto the default end unpack_args([I,J|_]) -> [I,J]. %Only use two arguments %% This and concat_table are very similar. %% First scan over table up to 0 then the array. We have the indexes %% and limits as integers and explicitly use '==' to compare with %% float values in table. do_unpack(Arr, Dict, I, J) -> unpack_tab(Arr, Dict, I, J). unpack_tab(_, _, N, J) when N > J -> []; %Done unpack_tab(Arr, _, N, J) when N > 0 -> %Done with table unpack_arr(Arr, N, J); unpack_tab(Arr, Dict, N, J) -> E = case ttdict:find(N, Dict) of {ok,V} -> V; error -> nil end, [E|unpack_tab(Arr, Dict, N+1, J)]. unpack_arr(_, N, J) when N > J -> []; unpack_arr(Arr, N, J) -> [array:get(N, Arr)|unpack_arr(Arr, N+1, J)]. %% raw_length(Table, State) -> Length. %% length(Table, State) -> {Length,State}. %% The length of a table is the number of numeric keys in sequence %% from 1. Except if 1 is nil followed by non-nil. Don't ask! length(#tref{}=T, St0) -> Meta = luerl_emul:getmetamethod(T, <<"__len">>, St0), if ?IS_TRUE(Meta) -> {Ret,St1} = luerl_emul:functioncall(Meta, [T], St0), {luerl_lib:first_value(Ret),St1}; true -> {raw_length(T, St0),St0} end. raw_length(#tref{i=N}, St) -> #table{a=Arr} = ?GET_TABLE(N, St#luerl.ttab), float(length_loop(Arr)). length_loop(Arr) -> case {array:get(1, Arr),array:get(2, Arr)} of {nil,nil} -> 0; {nil,_} -> length_loop(3, Arr); {_,nil} -> 1; {_,_} -> length_loop(3, Arr) end. length_loop(I, Arr) -> case array:get(I, Arr) of nil -> I-1; _ -> length_loop(I+1, Arr) end. %% sort(Table [,SortFun]) %% Sort the elements of the list after their values. sort([#tref{i=N}], St0) -> Comp = fun (A, B, St) -> lt_comp(A, B, St) end, St1 = do_sort(Comp, St0, N), {[],St1}; sort([#tref{i=N},Func|_], St0) -> Comp = fun (A, B, St) -> luerl_emul:functioncall(Func, [A,B], St) end, St1 = do_sort(Comp, St0, N), {[],St1}; sort(As, St) -> badarg_error(sort, As, St). do_sort(Comp, St0, N) -> #table{a=Arr0}=T = ?GET_TABLE(N, St0#luerl.ttab), case array:to_list(Arr0) of [] -> St0; %Nothing to do [E0|Es0] -> %% 1st element index 0, skip it and then prepend it again {Es1,St1} = merge_sort(Comp, St0, Es0), Arr2 = array:from_list([E0|Es1], nil), %% io:fwrite("so: ~p\n", [{Arr0,Arr1,Arr2}]), Ts0 = St1#luerl.ttab, Ts1 = ?SET_TABLE(N, T#table{a=Arr2}, Ts0), St1#luerl{ttab=Ts1} end. %% lt_comp(O1, O2, State) -> {[Bool],State}. %% Proper Lua '<' comparison. lt_comp(O1, O2, St) when is_number(O1), is_number(O2) -> {[O1 =< O2],St}; lt_comp(O1, O2, St) when is_binary(O1), is_binary(O2) -> {[O1 =< O2],St}; lt_comp(O1, O2, St0) -> case luerl_emul:getmetamethod(O1, O2, <<"__lt">>, St0) of nil -> lua_error({illegal_comp,sort}, St0); Meta -> {Ret,St1} = luerl_emul:functioncall(Meta, [O1,O2], St0), {[luerl_lib:boolean_value(Ret)],St1} end. %% sort(A,B,C) -> sort_up(A,B,C). %% sort_up(A,B,[X,Y|L]) -> %% case X =< Y of %% true -> merge_dn([Y,X], sort_dn(A, B, L), []); %% false -> merge_dn([X,Y], sort_dn(A, B, L), []) %% end; %% sort_up(A,B,[X]) -> [X]; %% sort_up(A,B,[]) -> []. %% sort_dn(A,B,[X,Y|L]) -> %% case X =< Y of %% true -> merge_up([X,Y], sort_up(A, B, L), []); %% false -> merge_up([Y,X], sort_up(A, B, L), []) %% end; %% sort_dn(A,B,[X]) -> [X]; %% sort_dn(A,B,[]) -> []. %% merge(A,B,C) -> %% merge_dn(A,B,C). %% %% merge_up(L1, L2, Acc) %% %% L1, L2 increasing, Acc will be decreasing %% merge_up([X|Xs]=Xs0, [Y|Ys]=Ys0, Acc) -> %% case X =< Y of %% true -> merge_up(Xs, Ys0, [X|Acc]); %% false -> merge_up(Xs0, Ys, [Y|Acc]) %% end; %% merge_up([X|Xs], [], Acc) -> merge_up(Xs, [], [X|Acc]); %% merge_up([], [Y|Ys], Acc) -> merge_up([], Ys, [Y|Acc]); %% merge_up([], [], Acc) -> Acc. %% %% merge_dn(L1, L2, Acc) %% %% L1, L2 decreasing, Acc will be increasing %% merge_dn([X|Xs]=Xs0, [Y|Ys]=Ys0, Acc) -> %% case X =< Y of %% true -> merge_dn(Xs0, Ys, [Y|Acc]); %% false -> merge_dn(Xs, Ys0, [X|Acc]) %% end; %% merge_dn([X|Xs], [], Acc) -> merge_dn(Xs, [], [X|Acc]); %% merge_dn([], [Y|Ys], Acc) -> merge_dn([], Ys, [Y|Acc]); %% merge_dn([], [], Acc) -> Acc. %% merge_sort(CompFun, State, List) -> {SortedList,State}. %% The code here has been taken from the sort/2 code in lists.erl and %% converted to chain State through all calls to the comparison %% function. merge_sort(_, St, []) -> {[],St}; merge_sort(_, St, [_] = L) -> {L,St}; merge_sort(Fun, St0, [X, Y|T]) -> {Ret,St1} = Fun(X, Y, St0), case luerl_lib:boolean_value(Ret) of true -> fsplit_1(Y, X, Fun, St1, T, [], []); false -> fsplit_2(Y, X, Fun, St1, T, [], []) end. %% Ascending. fsplit_1(Y, X, Fun, St0, [Z|L], R, Rs) -> {Ret1,St1} = Fun(Y, Z, St0), case luerl_lib:boolean_value(Ret1) of true -> fsplit_1(Z, Y, Fun, St1, L, [X|R], Rs); false -> {Ret2,St2} = Fun(X, Z, St1), case luerl_lib:boolean_value(Ret2) of true -> fsplit_1(Y, Z, Fun, St2, L, [X|R], Rs); false when R == [] -> fsplit_1(Y, X, Fun, St2, L, [Z], Rs); false -> fsplit_1_1(Y, X, Fun, St2, L, R, Rs, Z) end end; fsplit_1(Y, X, Fun, St, [], R, Rs) -> rfmergel([[Y, X|R]|Rs], [], Fun, St, asc). fsplit_1_1(Y, X, Fun, St0, [Z|L], R, Rs, S) -> {Ret1,St1} = Fun(Y, Z, St0), case luerl_lib:boolean_value(Ret1) of true -> fsplit_1_1(Z, Y, Fun, St1, L, [X|R], Rs, S); false -> {Ret2,St2} = Fun(X, Z, St1), case luerl_lib:boolean_value(Ret2) of true -> fsplit_1_1(Y, Z, Fun, St2, L, [X|R], Rs, S); false -> {Ret3,St3} = Fun(S, Z, St2), case luerl_lib:boolean_value(Ret3) of true -> fsplit_1(Z, S, Fun, St3, L, [], [[Y, X|R]|Rs]); false -> fsplit_1(S, Z, Fun, St3, L, [], [[Y, X|R]|Rs]) end end end; fsplit_1_1(Y, X, Fun, St, [], R, Rs, S) -> rfmergel([[S], [Y, X|R]|Rs], [], Fun, St, asc). %% Descending. fsplit_2(Y, X, Fun, St0, [Z|L], R, Rs) -> {Ret1,St1} = Fun(Y, Z, St0), case luerl_lib:boolean_value(Ret1) of false -> fsplit_2(Z, Y, Fun, St1, L, [X|R], Rs); true -> {Ret2,St2} = Fun(X, Z, St1), case luerl_lib:boolean_value(Ret2) of false -> fsplit_2(Y, Z, Fun, St2, L, [X|R], Rs); true when R == [] -> fsplit_2(Y, X, Fun, St2, L, [Z], Rs); true -> fsplit_2_1(Y, X, Fun, St2, L, R, Rs, Z) end end; fsplit_2(Y, X, Fun, St, [], R, Rs) -> fmergel([[Y, X|R]|Rs], [], Fun, St, desc). fsplit_2_1(Y, X, Fun, St0, [Z|L], R, Rs, S) -> {Ret1,St1} = Fun(Y, Z, St0), case luerl_lib:boolean_value(Ret1) of false -> fsplit_2_1(Z, Y, Fun, St1, L, [X|R], Rs, S); true -> {Ret2,St2} = Fun(X, Z, St1), case luerl_lib:boolean_value(Ret2) of false -> fsplit_2_1(Y, Z, Fun, St2, L, [X|R], Rs, S); true -> {Ret3,St3} = Fun(S, Z, St2), case luerl_lib:boolean_value(Ret3) of false -> fsplit_2(Z, S, Fun, St3, L, [], [[Y, X|R]|Rs]); true -> fsplit_2(S, Z, Fun, St3, L, [], [[Y, X|R]|Rs]) end end end; fsplit_2_1(Y, X, Fun, St, [], R, Rs, S) -> fmergel([[S], [Y, X|R]|Rs], [], Fun, St, desc). fmergel([T1, [H2|T2]|L], Acc, Fun, St0, asc) -> {L1,St1} = fmerge2_1(T1, H2, Fun, St0, T2, []), fmergel(L, [L1|Acc], Fun, St1, asc); fmergel([[H2|T2], T1|L], Acc, Fun, St0, desc) -> {L1,St1} = fmerge2_1(T1, H2, Fun, St0, T2, []), fmergel(L, [L1|Acc], Fun, St1, desc); fmergel([L], [], _Fun, St, _O) -> {L,St}; fmergel([L], Acc, Fun, St, O) -> rfmergel([lists:reverse(L, [])|Acc], [], Fun, St, O); fmergel([], Acc, Fun, St, O) -> rfmergel(Acc, [], Fun, St, O). rfmergel([[H2|T2], T1|L], Acc, Fun, St0, asc) -> {L1,St1} = rfmerge2_1(T1, H2, Fun, St0, T2, []), rfmergel(L, [L1|Acc], Fun, St1, asc); rfmergel([T1, [H2|T2]|L], Acc, Fun, St0, desc) -> {L1,St1} = rfmerge2_1(T1, H2, Fun, St0, T2, []), rfmergel(L, [L1|Acc], Fun, St1, desc); rfmergel([L], Acc, Fun, St, O) -> fmergel([lists:reverse(L, [])|Acc], [], Fun, St, O); rfmergel([], Acc, Fun, St, O) -> fmergel(Acc, [], Fun, St, O). %% merge(Fun, T1, [H2 | T2]) when is_function(Fun, 2) -> %% lists:reverse(fmerge2_1(T1, H2, Fun, T2, []), []); %% merge(Fun, T1, []) when is_function(Fun, 2) -> %% T1. %% Elements from the first list are prioritized. fmerge2_1([H1|T1], H2, Fun, St0, T2, M) -> {Ret,St1} = Fun(H1, H2, St0), case luerl_lib:boolean_value(Ret) of true -> fmerge2_1(T1, H2, Fun, St1, T2, [H1|M]); false -> fmerge2_2(H1, T1, Fun, St1, T2, [H2|M]) end; fmerge2_1([], H2, _Fun, St, T2, M) -> {lists:reverse(T2, [H2|M]),St}. fmerge2_2(H1, T1, Fun, St0, [H2|T2], M) -> {Ret,St1} = Fun(H1, H2, St0), case luerl_lib:boolean_value(Ret) of true -> fmerge2_1(T1, H2, Fun, St1, T2, [H1|M]); false -> fmerge2_2(H1, T1, Fun, St1, T2, [H2|M]) end; fmerge2_2(H1, T1, _Fun, St, [], M) -> {lists:reverse(T1, [H1|M]),St}. %% rmerge(Fun, T1, [H2 | T2]) when is_function(Fun, 2) -> %% lists:reverse(rfmerge2_1(T1, H2, Fun, T2, []), []); %% rmerge(Fun, T1, []) when is_function(Fun, 2) -> %% T1. rfmerge2_1([H1|T1], H2, Fun, St0, T2, M) -> {Ret,St1} = Fun(H1, H2, St0), case luerl_lib:boolean_value(Ret) of true -> rfmerge2_2(H1, T1, Fun, St1, T2, [H2|M]); false -> rfmerge2_1(T1, H2, Fun, St1, T2, [H1|M]) end; rfmerge2_1([], H2, _Fun, St, T2, M) -> {lists:reverse(T2, [H2|M]),St}. rfmerge2_2(H1, T1, Fun, St0, [H2|T2], M) -> {Ret,St1} = Fun(H1, H2, St0), case luerl_lib:boolean_value(Ret) of true -> rfmerge2_2(H1, T1, Fun, St1, T2, [H2|M]); false -> rfmerge2_1(T1, H2, Fun, St1, T2, [H1|M]) end; rfmerge2_2(H1, T1, _Fun, St, [], M) -> {lists:reverse(T1, [H1|M]),St}. luerl-0.4/src/luerl_scan.xrl0000644000232200023220000001640113450242205016512 0ustar debalancedebalance%% Copyright (c) 2013 Robert Virding %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at %% %% http://www.apache.org/licenses/LICENSE-2.0 %% %% Unless required by applicable law or agreed to in writing, software %% distributed under the License is distributed on an "AS IS" BASIS, %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. %% File : luerl_scan.xrl %% Author : Robert Virding %% Purpose : Token definitions for LUA. Definitions. D = [0-9] H = [0-9A-Za-z] U = [A-Z] L = [a-z] Rules. %% Names/identifiers. ({U}|{L}|_)({U}|{L}|_|{D})* : name_token(TokenChars, TokenLine). %% Numbers, we separately parse (Erlang) integers and floats. %% Integers. {D}+ : case catch {ok,list_to_integer(TokenChars)} of {ok,I} -> {token,{'NUMBER',TokenLine,float(I)}}; _ -> {error,"illegal number"} end. 0[xX]{H}+ : base_token(string:substr(TokenChars, 3), 16, TokenLine). %% Floats, we have separate rules to make them easier to handle. {D}+\.{D}+([eE][-+]?{D}+)? : case catch {ok,list_to_float(TokenChars)} of {ok,F} -> {token,{'NUMBER',TokenLine,F}}; _ -> {error,"illegal number"} end. {D}+[eE][-+]?{D}+ : [M,E] = string:tokens(TokenChars, "eE"), case catch {ok,list_to_float(M ++ ".0e" ++ E)} of {ok,F} -> {token,{'NUMBER',TokenLine,F}}; _ -> {error,"illegal number"} end. {D}+\.([eE][-+]?{D}+)? : [M|E] = string:tokens(TokenChars, "."), case catch {ok,list_to_float(lists:append([M,".0"|E]))} of {ok,F} -> {token,{'NUMBER',TokenLine,F}}; _ -> {error,"illegal number"} end. \.{D}+([eE][-+]?{D}+)? : case catch {ok,list_to_float("0" ++ TokenChars)} of {ok,F} -> {token,{'NUMBER',TokenLine,F}}; _ -> {error,"illegal number"} end. %% Strings. %% Handle the illegal newlines in string_token. \"(\\.|\\\n|[^"\\])*\" : string_token(TokenChars, TokenLen, TokenLine). \'(\\.|\\\n|[^'\\])*\' : string_token(TokenChars, TokenLen, TokenLine). \[\[([^]]|\][^]])*\]+\] : %% Strip quotes. Cs = string:substr(TokenChars, 3, TokenLen - 4), long_bracket(TokenLine, Cs). %% Other known tokens. \+ : {token,{'+',TokenLine}}. \- : {token,{'-',TokenLine}}. \* : {token,{'*',TokenLine}}. \/ : {token,{'/',TokenLine}}. \% : {token,{'%',TokenLine}}. \^ : {token,{'^',TokenLine}}. \# : {token,{'#',TokenLine}}. == : {token,{'==',TokenLine}}. ~= : {token,{'~=',TokenLine}}. <= : {token,{'<=',TokenLine}}. >= : {token,{'>=',TokenLine}}. < : {token,{'<',TokenLine}}. > : {token,{'>',TokenLine}}. = : {token,{'=',TokenLine}}. \( : {token,{'(',TokenLine}}. \) : {token,{')',TokenLine}}. \{ : {token,{'{',TokenLine}}. \} : {token,{'}',TokenLine}}. \[ : {token,{'[',TokenLine}}. \] : {token,{']',TokenLine}}. :: : {token,{'::',TokenLine}}. ; : {token,{';',TokenLine}}. : : {token,{':',TokenLine}}. , : {token,{',',TokenLine}}. \. : {token,{'.',TokenLine}}. \.\. : {token,{'..',TokenLine}}. \.\.\. : {token,{'...',TokenLine}}. [\011-\015\s\240]+ : skip_token. %Mirror Lua here %% Comments, either -- or --[[ ]]. %%--(\[([^[\n].*|\[\n|[^[\n].*|\n) : skip_token. --\n : skip_token. --[^[\n].* : skip_token. --\[\n : skip_token. --\[[^[\n].* : skip_token. %% --aa([^b]|b[^b])*b+b --\[\[([^]]|\][^]])*\]+\] : skip_token. --\[\[([^]]|\][^]])* : {error,"unfinished long comment"}. Erlang code. -export([is_keyword/1]). %% name_token(Chars, Line) -> %% {token,{'NAME',Line,Symbol}} | {Name,Line} | {error,E}. %% Build a name from list of legal characters, else error. name_token(Cs, L) -> case catch {ok,list_to_atom(Cs)} of {ok,Name} -> case is_keyword(Name) of true -> {token,{Name,L}}; false -> {token,{'NAME',L,Name}} end; _ -> {error,"illegal name"} end. %% base_token(Chars, Base, Line) -> Integer. %% Convert a string of Base characters into a number. We know that %% the strings only contain the correct character. base_token(Cs, B, L) -> case base1(Cs, B, 0) of {I,[]} -> {token,{'NUMBER',L,float(I)}}; {_,_} -> {error,"illegal based number"} end. base1([C|Cs], Base, SoFar) when C >= $0, C =< $9, C < Base + $0 -> Next = SoFar * Base + (C - $0), base1(Cs, Base, Next); base1([C|Cs], Base, SoFar) when C >= $a, C =< $f, C < Base + $a - 10 -> Next = SoFar * Base + (C - $a + 10), base1(Cs, Base, Next); base1([C|Cs], Base, SoFar) when C >= $A, C =< $F, C < Base + $A - 10 -> Next = SoFar * Base + (C - $A + 10), base1(Cs, Base, Next); base1([C|Cs], _Base, SoFar) -> {SoFar,[C|Cs]}; base1([], _Base, N) -> {N,[]}. %% string_token(InputChars, Length, Line) -> %% {token,{'STRING',Line,Cs}} | {error,E}. %% Convert an input string into the corresponding string %% characters. We know that the input string is correct. string_token(Cs0, Len, L) -> Cs = string:substr(Cs0, 2, Len - 2), %Strip quotes case catch {ok,chars(Cs)} of {ok,S} -> {token,{'STRING',L,list_to_binary(S)}}; error -> {error,"illegal string"} end. chars([$\\,C1|Cs0]) when C1 >= $0, C1 =< $9 -> %1-3 decimal digits I1 = C1 - $0, case Cs0 of [C2|Cs1] when C2 >= $0, C2 =< $9 -> I2 = C2 - $0, case Cs1 of [C3|Cs2] when C3 >= $0, C3 =< $9 -> [100*I1 + 10*I2 + (C3-$0)|chars(Cs2)]; _ -> [10*I1 + I2|chars(Cs1)] end; _ -> [I1|chars(Cs0)] end; chars([$\\,$x,C1,C2|Cs]) -> %2 hex digits case hex_char(C1) and hex_char(C2) of true -> [hex_val(C1)*16+hex_val(C2)|chars(Cs)]; false -> throw(error) end; chars([$\\,$z|Cs]) -> chars(skip_space(Cs)); %Skip blanks chars([$\\,C|Cs]) -> [escape_char(C)|chars(Cs)]; chars([$\n|_]) -> throw(error); chars([C|Cs]) -> [C|chars(Cs)]; chars([]) -> []. skip_space([C|Cs]) when C >= 0, C =< $\s -> skip_space(Cs); skip_space(Cs) -> Cs. hex_char(C) when C >= $0, C =< $9 -> true; hex_char(C) when C >= $a, C =< $f -> true; hex_char(C) when C >= $A, C =< $F -> true; hex_char(_) -> false. hex_val(C) when C >= $0, C =< $9 -> C - $0; hex_val(C) when C >= $a, C =< $f -> C - $a + 10; hex_val(C) when C >= $A, C =< $F -> C - $A + 10. escape_char($n) -> $\n; %\n = LF escape_char($r) -> $\r; %\r = CR escape_char($t) -> $\t; %\t = TAB escape_char($v) -> $\v; %\v = VT escape_char($b) -> $\b; %\b = BS escape_char($f) -> $\f; %\f = FF escape_char($e) -> $\e; %\e = ESC escape_char($s) -> $\s; %\s = SPC escape_char($d) -> $\d; %\d = DEL escape_char(C) -> C. long_bracket(Line, [$\n|Cs]) -> S = list_to_binary(Cs), {token,{'STRING',Line,S}}; long_bracket(Line, Cs) -> S = list_to_binary(Cs), {token,{'STRING',Line,S}}. %% is_keyword(Name) -> boolean(). %% Test if the name is a keyword. is_keyword('and') -> true; is_keyword('break') -> true; is_keyword('do') -> true; is_keyword('else') -> true; is_keyword('elseif') -> true; is_keyword('end') -> true; is_keyword('false') -> true; is_keyword('for') -> true; is_keyword('function') -> true; is_keyword('goto') -> true; is_keyword('if') -> true; is_keyword('in') -> true; is_keyword('local') -> true; is_keyword('nil') -> true; is_keyword('not') -> true; is_keyword('or') -> true; is_keyword('repeat') -> true; is_keyword('return') -> true; is_keyword('then') -> true; is_keyword('true') -> true; is_keyword('until') -> true; is_keyword('while') -> true; is_keyword(_) -> false.