luerl-1.0/0000755000232200023220000000000014066413134013045 5ustar debalancedebalanceluerl-1.0/get_comp_opts.escript0000644000232200023220000000472014066413134017305 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, HAS_FULL_KEYS, %% NEW_REC_CORE, NEW_RAND, HAS_FLOOR, HAS_CEIL and NEW_STACKTRACE %% depending on version of Erlang. main(_) -> Version = otp_release(), CompOpts = comp_opts(Version), file:write_file("comp_opts.mk", "COMP_OPTS = " ++ CompOpts ++ "\n"). %% Get the release number. %% We have stolen the idea and most of the 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. comp_opts(Version) -> Copts0 = "-DERLANG_VERSION=\\\"" ++ Version ++ "\\\"" ++ " ", Copts0 ++ append_copts(Version, [{"17","HAS_MAPS"}, {"18","HAS_FULL_KEYS"}, {"19","NEW_REC_CORE"}, {"19","NEW_RAND"}, {"20","NEW_BOOL_GUARD"}, {"20","HAS_FLOOR"}, {"20","HAS_CEIL"}, {"21","NEW_STACKTRACE"}]). append_copts(Version, [{Ver,Opt}|Opts]) -> Rest = append_copts(Version, Opts), if Version >= Ver -> "-D" ++ Opt ++ "=true" ++ " " ++ Rest; true -> Rest end; append_copts(_Version, []) -> []. luerl-1.0/README.md0000644000232200023220000000355514066413134014334 0ustar debalancedebalanceLuerl - an implementation of Lua in Erlang ========================================== The migration from Lua 5.2 to 5.3 is very much Work-In-Progress. Please test it but there are as yet no guratantees. -------------------------------------------------------------------------------------------------------------------- Luerl is an implementation of standard Lua 5.3 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](https://erlef.org/slack-invite/luerl) Luerl embraces both [#Erlang](https://twitter.com/hashtag/erlang?src=hash) and [#LuaLang](https://twitter.com/hashtag/lualang?src=hash) communities and ecosystems. luerl-1.0/rebar.config.script0000644000232200023220000000677314066413134016647 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. OTPRelease = fun () -> 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 end, Version = OTPRelease(), %% Collect the macro definitions we will add to the compiler options. %% Collect the macro definitions we will add to the compiler options. %% Named funs would be nicer but not always available. AppendCopts = fun (Version, [{Ver,Opt}|Opts], F) -> Rest = F(Version, Opts, F), if Version >= Ver -> [{d,Opt,true}|Rest]; true -> Rest end; (_Version, [], _F) -> [] end, Copts0 = [{d,'ERLANG_VERSION',Version}], Copts = Copts0 ++ AppendCopts(Version, [{"17",'HAS_MAPS'}, {"18",'HAS_FULL_KEYS'}, {"19",'NEW_REC_CORE'}, {"19",'NEW_RAND'}, {"20",'NEW_BOOL_GUARD'}, {"20",'HAS_FLOOR'}, {"20",'HAS_CEIL'}, {"21",'NEW_STACKTRACE'}], AppendCopts), %% 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, TestConfig = [{cover_enabled, true}, {cover_opts, [verbose]}], Aliases = [{alias, [ {test, [eunit, {ct, "--cover"}, cover]} ]}], Conf1 ++ TestConfig ++ Aliases. luerl-1.0/Emakefile0000644000232200023220000000006314066413134014651 0ustar debalancedebalance%% -*- erlang -*- {'src/luerl*',[{outdir,ebin}]}. luerl-1.0/Makefile0000644000232200023220000000333714066413134014513 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: all compile clean echo examples debug 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: get_comp_opts.escript 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 # this protects the intermediate .erl files from make's auto deletion #.SECONDARY: $(XRL_INTERM) $(YRL_INTERM) luerl-1.0/src/0000755000232200023220000000000014066413134013634 5ustar debalancedebalanceluerl-1.0/src/luerl.app.src0000644000232200023220000000165514066413134016256 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, "1.0"}, {modules, []}, {registered, []}, {applications, [kernel, stdlib]}, {env, []}, {mod, {luerl_app, []}}, {maintainers, ["Robert Virding"]}, {licenses, ["Apache"]}, {links,[{"Github", "https://github.com/rvirding/luerl"}]} ]}. luerl-1.0/src/luerl_lib_bit32.erl0000644000232200023220000001400514066413134017314 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. %% This library has been deprecated in 5.3 but we still keep it. -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_heap: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:args_to_integers(As) of L when is_list(L) -> {[aband(L)], St}; error -> badarg_error('band', As, 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:args_to_integers(As) of [N|_] -> NotN = bnot checkint32(N), {[float(NotN)], St}; error -> badarg_error('bnot', As, St) end. fbor(As, St) -> case luerl_lib:args_to_integers(As) of L when is_list(L) -> {[abor(L)], St}; error -> badarg_error('bor', As, 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:args_to_integers(As) of L when is_list(L) -> {[aband(L) /= 0], St}; error -> badarg_error('btest', As, St) end. fbxor(As, St) -> case luerl_lib:args_to_integers(As) of L when is_list(L) -> {[abxor(L)], St}; error -> badarg_error('bxor', As, 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:args_to_integers(As) of [X,Y|_] -> {[float(checkint32(X) bsl trunc(Y))], St}; _ -> badarg_error('lshift', As, St) end. frshift(As, St) -> case luerl_lib:args_to_integers(As) of [X,Y|_] -> {[float(checkint32(X) bsr trunc(Y))], St}; _ -> badarg_error('rshift', As, St) end. farshift(As, St) -> case luerl_lib:args_to_integers(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:args_to_integers(As) of [X,Y|_] -> {[float(lrotate(checkint32(X), trunc(Y)))], St}; _ -> badarg_error('lrotate', As, St) end. frrotate(As, St) -> case luerl_lib:args_to_integers(As) of [X,Y|_] -> {[float(rrotate(checkint32(X), trunc(Y)))], St}; _ -> badarg_error('rrotate', As, St) end. fextract(As, St) -> case luerl_lib:args_to_integers(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:args_to_integers(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-1.0/src/luerl.hrl0000644000232200023220000001604014066413134015467 0ustar debalancedebalance%% Copyright (c) 2013-2019 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, {tabs, %Table table envs, %Environment table usds, %Userdata table fncs, %Function table g, %Global table %% stk=[], %Current stack cs=[], %Current call stack %% meta=[], %Data type metatables rand, %Random state tag, %Unique tag trace_func=none, %Trace function trace_data %Trace data }). %% Table structure. -record(tstruct, {data, %Data table/array free, %Index free list next %Next index }). %% Metatables for atomic datatypes. -record(meta, {nil=nil, boolean=nil, number=nil, string=nil }). %% Frames for the call stack. %% Call return frame -record(call_frame, {func,args, %Function, arguments lvs, %Local variables env, %Environment is=[],cont=[] %Instructions, continuation }). %% Loop break frame -record(loop_frame, {lvs, %Local variables stk, %Stack env, %Environment is=[],cont=[] %Instructions, continuation }). %% Current line -record(current_line, {line, %Line file %File name }). %% Data types. -record(tref, {i}). %Table reference, index -define(IS_TREF(T), is_record(T, tref)). -record(table, {a,d=[],meta=nil}). %Table type, array, dict, meta -record(eref, {i}). %Environment reference, index -define(IS_EREF(E), is_record(E, eref)). -record(usdref, {i}). %Userdata reference, index -define(IS_USDREF(U), is_record(U, usdref)). -record(userdata, {d,meta=nil}). %Userdata type, data and meta -record(thread, {}). %Thread type %% There are two function types, the Lua one, and the Erlang one. %% The environment with upvalues is defined when the function is %% referenced and can vary if the function is referenced many %% times. Hence it is in the reference not in the the definition. -record(funref, {i,env=[]}). %Function reference -define(IS_FUNREF(F), is_record(F, funref)). -record(lua_func,{anno=[], %Annotation funrefs=[], %Functions directly referenced lsz, %Local var size %% loc=not_used, %Local var block template esz, %Env var size %% env=not_used, %Local env block template pars, %Parameter types b}). %Code block -define(IS_LUAFUNC(F), is_record(F, lua_func)). -record(erl_func,{code}). %Erlang code (fun) -define(IS_ERLFUNC(F), is_record(F, erl_func)). %% Test if it a function, of either sort. -define(IS_FUNCTION(F), (?IS_FUNREF(F) orelse ?IS_ERLFUNC(F))). %% Testing for integers/integer floats or booleans. -define(IS_FLOAT_INT(N), (round(N) == N)). -define(IS_FLOAT_INT(N,I), ((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. %% -define(TS_USE_ARRAY, true). -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_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_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_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. %% Define CATCH to handle deprecated get_stacktrace/0 -ifdef(NEW_STACKTRACE). -define(CATCH(C, E, S), C:E:S ->). -else. -define(CATCH(C, E, S), C:E -> S = erlang:get_stacktrace(),). -endif. luerl-1.0/src/Elixir.Luerl.New.erl0000644000232200023220000000702014066413134017405 0ustar debalancedebalance%% Copyright (c) 2013-2020 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_ex.erl %% Authors : Cees de Groot %% Purpose : Elixir-style wrappers for luerl.erl %% This module just contains functions that forward to luerl.erl, but place %% the VM State arguments in the first position rather than the last. This %% better matches Elixir conventions and allows for using the Elixir pipe %% operator '|>' to chain Luerl function calls. -module('Elixir.Luerl.New'). %% Basic user API to luerl. -export([init/0,gc/1, load/2,load/3,loadfile/2,loadfile/3, load_module/3,load_module_dec/3, do/2,do_dec/2,do/3,do_dec/3, dofile/2,dofile/3,dofile_dec/2,dofile_dec/3, call/3,call_chunk/2,call_chunk/3, call_function/3,call_function_dec/3, call_method/4,call_method_dec/4, get_table_keys/2,get_table_keys_dec/2, set_table_keys/3,set_table_keys_dec/3, get_stacktrace/1 ]). %% Encoding and decoding. -export([encode/2,encode_list/2,decode/2,decode_list/2]). init() -> luerl_new:init(). gc(St) -> luerl_new:gc(St). load(St, Bin) -> luerl_new:load(Bin, St). load(St, Bin, Opts) -> luerl_new:load(Bin, Opts, St). loadfile(St, Name) -> luerl_new:loadfile(Name, St). loadfile(St, Name, Opts) -> luerl_new:loadfile(Name, Opts, St). load_module(St, Lfp, Mod) -> luerl_new:load_module(Lfp, Mod, St). load_module_dec(St, Dfp, Mod) -> luerl_new:load_module_dec(Dfp, Mod, St). do(St, S) -> luerl_new:do(S, St). do(St, S, Opts) -> luerl_new:do(S, Opts, St). do_dec(St, S) -> luerl_new:do_dec(S, St). do_dec(St, S, Opts) -> luerl_new:do_dec(S, Opts, St). dofile(St, Path) -> luerl_new:dofile(Path, St). dofile(St, Path, Opts) -> luerl_new:dofile(Path, Opts, St). dofile_dec(St, Path) -> luerl_new:dofile_dec(Path, St). dofile_dec(St, Path, Opts) -> luerl_new:dofile_dec(Path, Opts, St). call(St, C, Args) -> luerl_new:call(C, Args, St). call_chunk(St, C) -> luerl_new:call_chunk(C, St). call_chunk(St, C, Args) -> luerl_new:call_chunk(C, Args, St). call_function(St, Fp, Args) -> luerl_new:call_function(Fp, Args, St). call_function_dec(St, Dfunc, Dargs) -> luerl_new:call_function_dec(Dfunc, Dargs, St). call_method(St, Obj, Meth, Args) -> luerl_new:call_method(Obj, Meth, Args, St). call_method_dec(St, Dobj, Dmeth, Dargs) -> luerl_new:call_method_dec(Dobj, Dmeth, Dargs, St). get_table_keys(St, Keys) -> luerl_new:get_table_keys(Keys, St). get_table_keys_dec(St, Dkeys) -> luerl_new:get_table_keys_dec(Dkeys, St). set_table_keys(St, Keys, Val) -> luerl_new:set_table_keys(Keys, Val, St). set_table_keys_dec(St, Dkeys, Dval) -> luerl_new:set_table_keys_dec(Dkeys, Dval, St). get_stacktrace(St) -> luerl_new:get_stacktrace(St). encode(St, V) -> luerl_new:encode(V, St). encode_list(St, Ts) -> luerl_new:encode_list(Ts, St). decode(St, V) -> luerl_new:decode(V, St). decode_list(St, Lts) -> luerl_new:decode_list(Lts, St). luerl-1.0/src/luerl_comp_vars.erl0000644000232200023220000003216314066413134017541 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.3 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, CompInfo) -> {ok,Code}. chunk(Code0, #cinfo{opts=Opts}=_Ci) -> %% No local state here! {Code1,_,_,nul} = functiondef(Code0, [], nul), luerl_comp:debug_print(Opts, "cv: ~p\n", [Code1]), {ok,Code1}. %% 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{vars=Vs0,exps=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{vars=Vs1,exps=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{exp=Exp0,rest=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{exp=Exp1,rest=Rest1},Used,Fused,St2}; var(#var{name=N}=V, _, St) -> {V,[N],[],St}. var_rest(#dot{exp=Exp0,rest=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{exp=Exp1,rest=Rest1},Used,Fused,St2}; var_rest(Exp, Loc, St) -> var_last(Exp, Loc, St). var_last(#key{key=Exp0}=K, Loc, St0) -> {Exp1,Used,Fused,St1} = exp(Exp0, Loc, St0), {K#key{key=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{exps=Es0}=R, Loc, St0) -> {Es1,Used,Fused,St1} = explist(Es0, Loc, St0), {R#return_stmt{exps=Es1},[],Used,Fused,St1}. %% block_stmt(Block, LocalVars, State) -> %% {Block,NewVars,UsedVars,FusedVars,State}. block_stmt(#block_stmt{body=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{body=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{body=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{body=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{exp=E0,body=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{exp=E1,body=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{body=B0}=R, _, St0) -> {B1,Used,Fused,St1} = do_block(B0, St0), {R#repeat_stmt{body=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{var=#var{name=N},init=I0,limit=L0,step=S0,body=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,body=B1},[],Used,Fused,St2}. %% genfor_stmt(For, LocalVars, State) -> {For,NewVars,FreeVars,State}. genfor_stmt(#gfor_stmt{vars=Vs,gens=Gs0,body=B0}=For, Loc, St0) -> {Gs1,Gused,Gfused,St1} = explist(Gs0, Loc, St0), Ns = lists:foldl(fun (#var{name=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,body=B1},[],Used,Fused,St2}. %% local_assign_stmt(Local, LocalVars, State) -> {Local,NewVars,FreeVars,State}. local_assign_stmt(#local_assign_stmt{vars=Vs,exps=Es0}=L, Loc, St0) -> {Es1,Used,Fused,St1} = explist(Es0, Loc, St0), New = lists:foldl(fun (#var{name=N}, Ns) -> add_element(N, Ns) end, [], Vs), {L#local_assign_stmt{exps=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{var=#var{name=N},func=F0}=L, _, St0) -> {F1,Used,Fused,St1} = functiondef(F0, nul, St0), New = [N], {L#local_fdef_stmt{func=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{args=Es0}=Op, Loc, St0) -> {Es1,Used,Fused,St1} = explist(Es0, Loc, St0), {Op#op{args=Es1},Used,Fused,St1}; exp(#tabcon{fields=Fs0}=T, Loc, St0) -> {Fs1,Used,Fused,St1} = tableconstructor(Fs0, Loc, St0), {T#tabcon{fields=Fs1},Used,Fused,St1}; exp(E, Loc, St) -> prefixexp(E, Loc, St). prefixexp(#dot{exp=Exp0,rest=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{exp=Exp1,rest=Rest1},Used,Fused,St2}; prefixexp(Exp, Loc, St) -> prefixexp_first(Exp, Loc, St). prefixexp_first(#single{exp=E0}=S, Loc, St0) -> {E1,Used,Fused,St1} = exp(E0, Loc, St0), {S#single{exp=E1},Used,Fused,St1}; prefixexp_first(#var{name=N}=V, _, St) -> {V,[N],[],St}. prefixexp_rest(#dot{exp=Exp0,rest=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{exp=Exp1,rest=Rest1},Used,Fused,St2}; prefixexp_rest(Exp, Loc, St) -> prefixexp_element(Exp, Loc, St). prefixexp_element(#key{key=E0}=K, Loc, St0) -> {E1,Used,Fused,St1} = exp(E0, Loc, St0), {K#key{key=E1},Used,Fused,St1}; prefixexp_element(#fcall{args=As0}=F, Loc, St0) -> {As1,Used,Fused,St1} = explist(As0, Loc, St0), {F#fcall{args=As1},Used,Fused,St1}; prefixexp_element(#mcall{meth=#lit{val=N},args=As0}=M, Loc, St0) -> {As1,Used,Fused,St1} = explist(As0, Loc, St0), {M#mcall{args=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{pars=Ps,body=Ss0}=F, _, St0) -> Loc0 = lists:foldl(fun (#var{name=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{body=Ss1,vars=Vars1},[],Vars1#vars.free,St1}. %% tableconstructor(Fields, LocalVars, State) -> %% {Fields,UsedVars,FusedVars,State}. tableconstructor(Fs0, Loc, St0) -> Fun = fun (#efield{val=V0}=F, {Used0,Fused0,S0}) -> {V1,Vused,Vfused,S1} = exp(V0, Loc, S0), Used1 = union(Vused, Used0), Fused1 = union(Vfused, Fused0), {F#efield{val=V1},{Used1,Fused1,S1}}; (#kfield{key=K0,val=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{key=K1,val=V1},{Used1,Fused1,S2}} end, {Fs1,{Used,Fused,St1}} = lists:mapfoldl(Fun, {[],[],St0}, Fs0), {Fs1,Used,Fused,St1}. luerl-1.0/src/luerl_app.erl0000644000232200023220000000166714066413134016335 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-1.0/src/luerl_comp_peep.erl0000644000232200023220000000721214066413134017514 0ustar debalancedebalance%% Copyright (c) 2013-2019 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.3 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(Code, CompInfo) -> {ok,Code}. %% A chunk is now a list of instructions to define the function. chunk(Is0, #cinfo{opts=Opts}=_Ci) -> Is1 = instrs(Is0, nil), %No local state luerl_comp:debug_print(Opts, "cp: ~p\n", [Is1]), {ok,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([?PUSH_FDEF(Anno,Lsz,Esz,Pars,Fis0)|Is], St) -> Fis1 = instrs(Fis0, St), [?PUSH_FDEF(Anno,Lsz,Esz,Pars,Fis1)|instrs(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(Tis, [])|Is], St) -> instrs([?IF_TRUE(Tis)|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)]; %% Tail calls for when they are implemented in the VM. %% instrs([?FCALL,?POP], _St) -> [?TAIL_FCALL]; %% instrs([?FCALL,?RETURN(_)|_], _St) -> [?TAIL_FCALL]; %% instrs([?MCALL(M),?POP], _St) -> [?TAIL_MCALL(M)]; %% instrs([?MCALL(M),?RETURN(_)|_], _St) -> [?TAIL_MCALL(M)]; %% Nothing to do. instrs([I|Is], St) -> [I|instrs(Is, St)]; instrs([], _) -> []. luerl-1.0/src/NOTES0000644000232200023220000001335514066413134014456 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-1.0/src/luerl_sandbox.erl0000644000232200023220000000634714066413134017213 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, execute], [?LUERL_GLOBAL, os, exit], [?LUERL_GLOBAL, os, getenv], [?LUERL_GLOBAL, os, remove], [?LUERL_GLOBAL, os, rename], [?LUERL_GLOBAL, os, tmpname], [?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-1.0/src/luerl_comp_locf.erl0000644000232200023220000002125214066413134017506 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.3 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, CompInfo) -> %% {ok,Code} | {ok,Code,Warnings} | {error,Error}. chunk(Code0, #cinfo{opts=Opts}=_Ci) -> {Code1,_,nul} = exp(Code0, nul), %No local state here! luerl_comp:debug_print(Opts, "cf: ~p\n", [Code1]), {ok,Code1}. %% 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{vars=Vs0,exps=Es0}=A, St0) -> {Vs1,Vlocf,St1} = assign_loop(Vs0, St0), {Es1,Elocf,St2} = explist(Es0, St1), Locf = Vlocf or Elocf, {A#assign_stmt{vars=Vs1,exps=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{exp=Exp0,rest=Rest0}=D, St0) -> {Exp1,Elocf,St1} = prefixexp_first(Exp0, St0), {Rest1,Rlocf,St2} = var_rest(Rest0, St1), {D#dot{exp=Exp1,rest=Rest1},Elocf or Rlocf,St2}; var(V, St) -> {V,false,St}. var_rest(#dot{exp=Exp0,rest=Rest0}=D, St0) -> {Exp1,Elocf,St1} = prefixexp_element(Exp0, St0), {Rest1,Rlocf,St2} = var_rest(Rest0, St1), {D#dot{exp=Exp1,rest=Rest1},Elocf or Rlocf,St2}; var_rest(Exp, St) -> var_last(Exp, St). var_last(#key{key=Exp0}=K, St0) -> {Exp1,Elocf,St1} = exp(Exp0, St0), {K#key{key=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{exps=Es0}=R, St0) -> {Es1,Locf,St1} = explist(Es0, St0), {R#return_stmt{exps=Es1},Locf,St1}. %% block_stmt(Block, State) -> {Block,LocalFunc,State}. block_stmt(#block_stmt{body=Ss0}=B, St0) -> {Ss1,Sslocf,St1} = stmts(Ss0, St0), {B#block_stmt{body=Ss1,locf=Sslocf},Sslocf,St1}. %% do_block(Block, State) -> {Block,LocalFunc,State}. do_block(#block{body=Ss0}=B, St0) -> {Ss1,Sslocf,St1} = stmts(Ss0, St0), {B#block{body=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{exp=E0,body=B0}=W, St0) -> {E1,Elocf,St1} = exp(E0, St0), {B1,Blocf,St2} = do_block(B0, St1), {W#while_stmt{exp=E1,body=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{body=B0}=R, St0) -> {B1,Blocf,St1} = do_block(B0, St0), {R#repeat_stmt{body=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,body=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,body=B1},Locf,St2}. %% genfor_stmt(For, State) -> {For,LocalFunc,State}. genfor_stmt(#gfor_stmt{gens=Gs0,body=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,body=B1},Locf,St2}. %% local_assign_stmt(Local, State) -> {Local,LocalFunc,State}. local_assign_stmt(#local_assign_stmt{exps=Es0}=L, St0) -> {Es1,Eslocf,St1} = explist(Es0, St0), {L#local_assign_stmt{exps=Es1},Eslocf,St1}. %% local_fdef_stmt(Local, State) -> {Local,LocalFunc,State}. local_fdef_stmt(#local_fdef_stmt{func=F0}=L, St0) -> {F1,_,St1} = functiondef(F0, St0), %Don't care what's in func {L#local_fdef_stmt{func=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{args=Es0}=Op, St0) -> {Es1,Eslocf,St1} = explist(Es0, St0), {Op#op{args=Es1},Eslocf,St1}; exp(#tabcon{fields=Fs0}=T, St0) -> {Fs1,Tlocf,St1} = tableconstructor(Fs0, St0), {T#tabcon{fields=Fs1},Tlocf,St1}; exp(E, St) -> prefixexp(E, St). prefixexp(#dot{exp=Exp0,rest=Rest0}=D, St0) -> {Exp1,Elocf,St1} = prefixexp_first(Exp0, St0), {Rest1,Rlocf,St2} = prefixexp_rest(Rest0, St1), {D#dot{exp=Exp1,rest=Rest1},Elocf or Rlocf,St2}; prefixexp(Exp, St) -> prefixexp_first(Exp, St). prefixexp_first(#single{exp=E0}=S, St0) -> {E1,Elocf,St1} = exp(E0, St0), {S#single{exp=E1},Elocf,St1}; prefixexp_first(V, St) -> {V,false,St}. prefixexp_rest(#dot{exp=Exp0,rest=Rest0}=D, St0) -> {Exp1,Elocf,St1} = prefixexp_element(Exp0, St0), {Rest1,Rlocf,St2} = prefixexp_rest(Rest0, St1), {D#dot{exp=Exp1,rest=Rest1},Elocf or Rlocf,St2}; prefixexp_rest(Exp, St) -> prefixexp_element(Exp, St). prefixexp_element(#key{key=E0}=K, St0) -> {E1,Elocf,St1} = exp(E0, St0), {K#key{key=E1},Elocf,St1}; prefixexp_element(#fcall{args=As0}=F, St0) -> {As1,Aslocf,St1} = explist(As0, St0), {F#fcall{args=As1},Aslocf,St1}; prefixexp_element(#mcall{args=As0}=M, St0) -> {As1,Aslocf,St1} = explist(As0, St0), {M#mcall{args=As1},Aslocf,St1}. %% functiondef(Func, State) -> {Func,LocalFunc,State}. %% We return if there are any internal function definitions within %% the function. functiondef(#fdef{body=Ss0}=F, St0) -> {Ss1,Sslocf,St1} = stmts(Ss0, St0), {F#fdef{body=Ss1,locf=Sslocf},Sslocf,St1}. %% tableconstructor(Fields, State) -> {Fields,LocalFunc,State}. tableconstructor(Fs0, St0) -> Fun = fun (#efield{val=V0}=F, {Locf,S0}) -> {V1,Vlocf,S1} = exp(V0, S0), {F#efield{val=V1},{Locf or Vlocf,S1}}; (#kfield{key=K0,val=V0}=F, {Locf,S0}) -> {K1,Klocf,S1} = exp(K0, S0), {V1,Vlocf,S2} = exp(V0, S1), {F#kfield{key=K1,val=V1},{Locf or Klocf or Vlocf,S2}} end, {Fs1,{Locf,St1}} = lists:mapfoldl(Fun, {false,St0}, Fs0), {Fs1,Locf,St1}. luerl-1.0/src/Elixir.Luerl.erl0000644000232200023220000000643014066413134016661 0ustar debalancedebalance%% Copyright (c) 2013-2020 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_ex.erl %% Authors : Cees de Groot %% Purpose : Elixir-style wrappers for luerl.erl %% This module just contains functions that forward to luerl.erl, but place %% the VM State arguments in the first position rather than the last. This %% better matches Elixir conventions and allows for using the Elixir pipe %% operator '|>' to chain Luerl function calls. -module('Elixir.Luerl'). -export([eval/2,evalfile/2, do/2,dofile/2, load/2,load/3, loadfile/2,loadfile/3, path_loadfile/2,path_loadfile/3,path_loadfile/4, load_module/3,load_module1/3, call/3,call_chunk/3, call_function/3,call_function1/3,function_list/2, call_method/3,call_method1/3,method_list/2, get_table/2,get_table1/2,set_table/3,set_table1/3,set_table1/4, init/0,stop/1,gc/1, encode/2,encode_list/2,decode/2,decode_list/2 ]). eval(St, Chunk) -> luerl:eval(Chunk, St). evalfile(St, Path) -> luerl:evalfile(Path, St). do(St, S) -> luerl:do(S, St). dofile(St, Path) -> luerl:dofile(Path, St). load(St, Bin) -> luerl:load(Bin, St). load(St, Bin, Opts) -> luerl:load(Bin, Opts, St). loadfile(St, Name) -> luerl:loadfile(Name, St). loadfile(St, Name, Opts) -> luerl:loadfile(Name, Opts, St). path_loadfile(St, Name) -> luerl:path_loadfile(Name, St). path_loadfile(St, Dirs, Name) -> luerl:path_loadfile(Dirs, Name, St). path_loadfile(St, Dir, Name, Opts) -> luerl:path_loadfile(Dir, Name, Opts, St). load_module(St, Fp, Mod) -> luerl:load_module(Fp, Mod, St). load_module1(St, Fp, Mod) -> luerl:load_module1(Fp, Mod, St). init() -> luerl:init(). call(St, C, As) -> luerl:call(C, As, St). call_chunk(St, C, As) -> luerl:call_chunk(C, As, St). call_function(St, Fp, As) -> luerl:call_function(Fp, As, St). call_function1(St, Lfp, Las) -> luerl:call_function1(Lfp, Las, St). function_list(St, Ks) -> luerl:function_list(Ks, St). call_method(St, Fp, As) -> luerl:call_method(Fp, As, St). call_method1(St, Fp, Las) -> luerl:call_method1(Fp, Las, St). method_list(St, Ks) -> luerl:method_list(Ks, St). get_table(St, Fp) -> luerl:get_table(Fp, St). get_table1(St, Fp) -> luerl:get_table1(Fp, St). set_table(St, Fp, V) -> luerl:set_table(Fp, V, St). set_table1(St, Lfp, Lv) -> luerl:set_table1(Lfp, Lv, St). set_table1(St, Tab, Key, Lv) -> luerl:set_table1(Tab, Key, Lv, St). stop(St) -> luerl:stop(St). gc(St) -> luerl:gc(St). encode_list(St, Ts) -> luerl:encode_list(Ts, St). encode(St, V) -> luerl:encode(V, St). decode_list(St, Lts) -> luerl:decode_list(Lts, St). decode(St, V) -> luerl:decode(V, St). luerl-1.0/src/luerl_instrs.hrl0000644000232200023220000000602014066413134017066 0ustar debalancedebalance%% Copyright (c) 2019 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.3 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, fcall). -define(TAIL_FCALL, tail_fcall). -define(MCALL(M), {mcall,M}). -define(TAIL_MCALL(M), {tail_mcall,M}). -define(OP(Op,Ac), {op,Op,Ac}). -define(PUSH_FDEF(Anno, Lsz, Esz, Pars, Is), {push_fdef,Anno,Lsz,Esz,Pars,Is}). -define(PUSH_FDEF(FnRef), {push_fdef,FnRef}). %% Control instructions. -define(BLOCK(Lsz, Esz, Is), {block,Lsz,Esz,Is}). -define(BLOCK_OPEN(Lsz, Esz), {block_open,Lsz,Esz}). -define(BLOCK_CLOSE, block_close). -define(WHILE(E, B), {while,E,B}). -define(WHILE_LOOP(Eis, Wis), {while_loop,Eis,Wis}). -define(REPEAT(B), {repeat,B}). -define(REPEAT_LOOP(B), {repeat_loop,B}). -define(AND_THEN(T), {and_then,T}). -define(OR_ELSE(T), {or_else,T}). -define(IF_TRUE(T), {if_true,T}). -define(IF(T, F), {'if',T,F}). -define(NFOR(V, B), {nfor,V,B}). -define(NFOR_LOOP(N, Limit, Step, Fis), {nfor_loop,N,Limit,Step,Fis}). -define(GFOR(Vs, B), {gfor,Vs,B}). -define(GFOR_CALL(Func, Data, Val, Fis), {gfor_call,Func,Data,Val,Fis}). -define(GFOR_LOOP(Func, Data, Fis), {gfor_loop,Func,Data,Fis}). -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}). -define(POP_ARGS(Ac), {pop_args,Ac}). -define(PUSH_ARGS(Al), {push_args,Al}). %% Comment nad line instructiond. -define(COMMENT(C), {comment,C}). -define(CURRENT_LINE(L, File), {current_line,L,File}). luerl-1.0/src/luerl_comp.hrl0000644000232200023220000000735314066413134016514 0ustar debalancedebalance%% Copyright (c) 2013-2019 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. %% Common compiler information -record(cinfo, {lfile=[], %Lua file name vfile=[], %Virtual file name opts=[] %Compiler options }). %% Some useful macros. -define(IF(Test,True,False), case Test of true -> True; false -> False end). -define(WHEN_OPT(Opt,Opts,Fun), ?IF(member(Opt, Opts), Fun(), ok)). -define(DEBUG_PRINT(Format,Args,Opts), ?WHEN_OPT(debug_print, Opts, fun () -> io:fwrite(Format, Args) end)). %% Variable data. -record(vars, {local=[], %Local variables free=[], %Free variables used=[], %Used in sub blocks fused=[] %Used in sub-functions }). %% Define internal data macros. %% Statements. %% The line number here, 'l', can be a line number or annotation list. -record(assign_stmt, {l,vars,exps}). -record(call_stmt, {l,call}). -record(return_stmt, {l,exps}). -record(break_stmt, {l}). -record(block_stmt, {l, body=[], %Block body statements vars=none, %Variable info lsz=none, %Local frame size loc=not_used, %Local var block template esz=none, %Env frame size env=not_used, %Local env block template %%local=none, %Local variables locf=false}). %Local functions -record(while_stmt, {l,exp,body=[]}). -record(repeat_stmt, {l,body=[]}). -record(nfor_stmt, {l, var, %Loop variable init,limit,step, %The init, limit, step values body=[]}). %Loop body -record(gfor_stmt, {l, vars, %Loop variables gens, %Generators body=[]}). %Loop body -record(if_stmt, {l,tests=[],else}). -record(local_assign_stmt, {l,vars,exps}). -record(local_fdef_stmt, {l,var,func}). -record(expr_stmt, {l,exp}). %Pseudo stmt for expressions -record(block, {l, body=[], %Block body statements vars=none, %Variable info lsz=none, %Local frame size loc=not_used, %Local var block template esz=none, %Env frame size env=not_used, %Local env block template locf=false}). %% Expressions. %% The line number here, 'l', can be a line number or annotation list. -record(fdef, {l, pars=[], %Parameters body=[], %Function body statements vars=none, %Variable info lsz=none, %Local frame size loc=not_used, %Local var block template esz=none, %Env frame size env=not_used, %Local env block template %%local=none, %Local variables locf=false}). %Local function -record(lit, {l,val}). %Literal value -record(op, {l,op,args=[]}). -record(dot, {l,exp,rest}). -record(single, {l,exp}). -record(var, {l,name}). -record(fcall, {l,args=[]}). %Function call -record(mcall, {l,meth,args=[]}). %Method call -record(key, {l,key}). -record(tabcon, {l,fields=[]}). %Table constructor -record(efield, {l,val}). -record(kfield, {l,key,val}). %% Variable types. %% The line number here, 'l', can be a line number or annotation list. -record(lvar, {l,n,d,i}). %Local name, depth, index -record(evar, {l,n,d,i}). %Environment name, depth, index -record(gvar, {l,n}). %Global name luerl-1.0/src/ttsets.erl0000644000232200023220000002740214066413134015673 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-1.0/src/luerl_comp_env.erl0000644000232200023220000002775714066413134017373 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.3 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(c_env, {lfs=[], %Variable frames efs=[], %Environment frames vars=none, fs=[], locv=false, %Local variables locf %Local frame }). %% chunk(Code, CompInfo) -> {ok,Code}. chunk(Code0, #cinfo{opts=Opts}=_Ci) -> St0 = #c_env{}, %Local state {Code1,_} = functiondef(Code0, St0), luerl_comp:debug_print(Opts, "ce: ~p\n", [Code1]), {ok,Code1}. %% alloc_frame(State) -> State. %% pop_frame(State) -> State. %% get_frame(State) -> Frame. alloc_frame(#c_env{vars=#vars{},fs=Fs}=St) -> F = new_frame(), St#c_env{fs=[F|Fs]}. pop_frame(#c_env{fs=[_|Fs]}=St) -> St#c_env{fs=Fs}. get_frame(#c_env{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. %% %% We get the size from the index of the last variable of each type added. %% %% NOTE: We can have empty frames here. The emulator knows about this %% and can handle it. %% %% Frame :: {LocalIndex,EnvIndex,Vars} %% Var :: {Name,Type,Index} new_frame() -> {0,0,[]}. 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_local_size({Li,_,_}) -> Li. frame_env_size({_,Ei,_}) -> Ei. add_frame_local_var(N, {Li,Ei,Fs}) -> {Li+1,Ei,[{N,lvar,Li+1}|Fs]}. add_frame_env_var(N, {Li,Ei,Fs}) -> {Li,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. 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 = Ld + 1, Ed1 = Ed + 1, find_fs_var(N, Fs, Ld1, Ed1) end; find_fs_var(_, [], _, _) -> no. %% add_var(Var, State) -> State. %% get_var(Var, State) -> #lvar{} | #evar{} | #gvar{}. add_var(#var{name=N}, St) -> case var_type(N, St) of local -> add_local_var(N, St); env -> add_env_var(N, St) end. add_env_var(V, #c_env{fs=[F0|Fs]}=St) -> F1 = add_frame_env_var(V, F0), St#c_env{fs=[F1|Fs]}. add_local_var(N, #c_env{fs=[F0|Fs]}=St) -> F1 = add_frame_local_var(N, F0), St#c_env{fs=[F1|Fs]}. get_var(#var{l=Line,name=N}, #c_env{fs=Fs}) -> case find_fs_var(N, Fs) of {yes,lvar,Ld,Li} -> #lvar{l=Line,n=N,d=Ld,i=Li}; {yes,evar,Ed,Ei} -> #evar{l=Line,n=N,d=Ed,i=Ei}; no -> #gvar{l=Line,n=N} end. var_type(N, #c_env{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{vars=Vs0,exps=Es0}=A, St0) -> {Vs1,St1} = assign_loop(Vs0, St0), {Es1,St2} = explist(Es0, St1), {A#assign_stmt{vars=Vs1,exps=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{exp=Exp0,rest=Rest0}=D, St0) -> {Exp1,St1} = prefixexp_first(Exp0, St0), {Rest1,St2} = var_rest(Rest0, St1), {D#dot{exp=Exp1,rest=Rest1},St2}; var(#var{}=V0, St) -> V1 = get_var(V0, St), {V1,St}. var_rest(#dot{exp=Exp0,rest=Rest0}=D, St0) -> {Exp1,St1} = prefixexp_element(Exp0, St0), {Rest1,St2} = var_rest(Rest0, St1), {D#dot{exp=Exp1,rest=Rest1},St2}; var_rest(Exp, St) -> var_last(Exp, St). var_last(#key{key=Exp0}=K, St0) -> {Exp1,St1} = exp(Exp0, St0), {K#key{key=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{exps=Es0}=R, St0) -> {Es1,St1} = explist(Es0, St0), {R#return_stmt{exps=Es1},St1}. %% block_stmt(Block, State) -> {Block,State}. block_stmt(#block_stmt{body=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{body=Ss1,lsz=Lsz,esz=Esz},St1}. %% do_block(Block, State) -> {Block,State}. do_block(#block{body=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{body=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, #c_env{vars=OldVars}=St0) -> St1 = alloc_frame(St0#c_env{vars=Vars}), {Ret,St2} = Do(St1), Fr = get_frame(St2), St3 = pop_frame(St2), {Ret,Fr,St3#c_env{vars=OldVars}}. %% while_stmt(While, State) -> {While,State}. while_stmt(#while_stmt{exp=E0,body=B0}=W, St0) -> {E1,St1} = exp(E0, St0), {B1,St2} = do_block(B0, St1), {W#while_stmt{exp=E1,body=B1},St2}. %% repeat_stmt(Repeat, State) -> {Repeat,State}. repeat_stmt(#repeat_stmt{body=B0}=R, St0) -> {B1,St1} = do_block(B0, St0), {R#repeat_stmt{body=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{var=V0,init=I0,limit=L0,step=S0,body=B0}=F, St0) -> {[I1,L1,S1],St1} = explist([I0,L0,S0], St0), {[V1],B1,St2} = for_block([V0], B0, St1), {F#nfor_stmt{var=V1,init=I1,limit=L1,step=S1,body=B1},St2}. %% genfor_stmt(For, State) -> {For,State}. genfor_stmt(#gfor_stmt{vars=Vs0,gens=Gs0,body=B0}=F, St0) -> {Gs1,St1} = explist(Gs0, St0), {Vs1,B1,St2} = for_block(Vs0, B0, St1), {F#gfor_stmt{vars=Vs1,gens=Gs1,body=B1},St2}. for_block(Vs0, #block{body=Ss0,vars=Vars}=B, St0) -> Do = fun (S0) -> Fun = fun (V, Sa) -> Sb = add_var(V, Sa), {get_var(V, 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{body=Ss1,lsz=Lsz,esz=Esz},St1}. %% local_assign_stmt(Local, State) -> {Local,State}. local_assign_stmt(#local_assign_stmt{vars=Vs0,exps=Es0}=L, St0) -> %% io:fwrite("las: ~p\n", [{Es0,St0}]), {Es1,St1} = explist(Es0, St0), %% io:fwrite("las> ~p\n", [{Es1,St1}]), AddVar = fun (V, S0) -> S1 = add_var(V, S0), {get_var(V, S1),S1} end, {Vs1,St2} = lists:mapfoldl(AddVar, St1, Vs0), %% io:fwrite("las> ~p\n", [{Vs1,St2}]), {L#local_assign_stmt{vars=Vs1,exps=Es1},St2}. %% local_fdef_stmt(Local, State) -> {Local,State}. %% Add function name first in case of recursive call. local_fdef_stmt(#local_fdef_stmt{var=V,func=F0}=L, St0) -> St1 = add_var(V, St0), {F1,St2} = functiondef(F0, St1), V1 = get_var(V, St2), %% io:fwrite("lf: ~p\n", [St0]), %% io:fwrite("lf: ~p\n", [St1]), %% io:fwrite("lf: ~p\n", [St2]), {L#local_fdef_stmt{var=V1,func=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{args=Es0}=Op, St0) -> {Es1,St1} = explist(Es0, St0), {Op#op{args=Es1},St1}; exp(#tabcon{fields=Fs0}=T, St0) -> {Fs1,St1} = tableconstructor(Fs0, St0), {T#tabcon{fields=Fs1},St1}; exp(E, St) -> prefixexp(E, St). prefixexp(#dot{exp=Exp0,rest=Rest0}=D, St0) -> {Exp1,St1} = prefixexp_first(Exp0, St0), {Rest1,St2} = prefixexp_rest(Rest0, St1), {D#dot{exp=Exp1,rest=Rest1},St2}; prefixexp(Exp, St) -> prefixexp_first(Exp, St). prefixexp_first(#single{exp=E0}=S, St0) -> {E1,St1} = exp(E0, St0), {S#single{exp=E1},St1}; prefixexp_first(#var{}=V0, St) -> V1 = get_var(V0, St), {V1,St}. prefixexp_rest(#dot{exp=Exp0,rest=Rest0}=D, St0) -> {Exp1,St1} = prefixexp_element(Exp0, St0), {Rest1,St2} = prefixexp_rest(Rest0, St1), {D#dot{exp=Exp1,rest=Rest1},St2}; prefixexp_rest(Exp, St) -> prefixexp_element(Exp, St). prefixexp_element(#key{key=E0}=K, St0) -> {E1,St1} = exp(E0, St0), {K#key{key=E1},St1}; prefixexp_element(#fcall{args=As0}=F, St0) -> {As1,St1} = explist(As0, St0), {F#fcall{args=As1},St1}; prefixexp_element(#mcall{args=As0}=M, St0) -> {As1,St1} = explist(As0, St0), {M#mcall{args=As1},St1}. %% functiondef(Func, State) -> {Func,State}. functiondef(#fdef{pars=Ps0,body=Ss0,vars=Vars}=F, St0) -> Do = fun (S0) -> Fun = fun (V, Sa) -> Sb = add_var(V, Sa), {get_var(V, 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{pars=Ps1,body=Ss1,lsz=Lsz,esz=Esz},St1}. %% tableconstructor(Fields, State) -> {Fields,State}. tableconstructor(Fs0, St0) -> Fun = fun (#efield{val=V0}=F, S0) -> {V1,S1} = exp(V0, S0), {F#efield{val=V1},S1}; (#kfield{key=K0,val=V0}=F, S0) -> {K1,S1} = exp(K0, S0), {V1,S2} = exp(V0, S1), {F#kfield{key=K1,val=V1},S2} end, {Fs1,St1} = lists:mapfoldl(Fun, St0, Fs0), {Fs1,St1}. luerl-1.0/src/luerl_lib_basic.erl0000644000232200023220000003114514066413134017456 0ustar debalancedebalance%% Copyright (c) 2013-2020 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([print/2,tostring/1,tostring/2]). -import(luerl_lib, [lua_error/2,badarg_error/3]). %Shorten these install(St) -> luerl_heap:alloc_table(table(), St). %% table() -> [{FuncName,Function}]. %% Caller will convert this list to the correct format. table() -> [{<<"_VERSION">>,<<"Lua 5.3">>}, %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 basic_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_heap:gc(St)}; %% {[],St}; %No-op for the moment collectgarbage(_, St) -> %Ignore everything else {[],St}. eprint(Args, St) -> lists:foreach(fun (#tref{}=Tref) -> Tab = luerl_heap:get_table(Tref, St), io:format("~w ", [Tab]); (A) -> io:format("~w ", [A]) end, Args), io:nl(), {[],St}. -spec basic_error(_, _) -> no_return(). basic_error([{tref, _}=T|_], St0) -> case luerl_heap:get_metamethod(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; basic_error([M|_], St) -> lua_error({error_call, M}, St); %Never returns! basic_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_heap:get_metamethod(Tref, <<"__ipairs">>, St) of nil -> {[#erl_func{code=fun ipairs_next/2},Tref,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], St); ipairs_next([Tref,K|_], St) -> %% Get the table. #table{a=Arr} = luerl_heap:get_table(Tref, St), Next = K + 1, case array:get(Next, Arr) of nil -> {[nil],St}; V -> {[Next,V],St} end. %% 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_heap:get_metamethod(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{}=Tref,K|_], St) -> %% Get the table. #table{a=Arr,d=Dict} = luerl_heap:get_table(Tref, St), if K == nil -> %% Find the first, start with the array. next_index(0, Arr, Dict, St); is_integer(K), K >= 1 -> next_index(K, Arr, Dict, St); is_float(K) -> case ?IS_FLOAT_INT(K, I) of true when I >= 1 -> next_index(I, Arr, Dict, St); _NegFalse -> %Not integer or negative next_key(K, Dict, St) 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} -> {[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, State) -> {[],State}. %% Receives any number of arguments and prints their values to %% stdout, using the tostring function to convert each argument to a %% string. print is not intended for formatted output, but only as a %% quick way to show a value, for instance for debugging. print(Args, St0) -> St1 = lists:foldl(fun (A, S0) -> {[Str],S1} = tostring([A], S0), io:format("~ts ", [print_string(Str)]), S1 end, St0, Args), io:nl(), {[],St1}. print_string(<>) -> [C|print_string(S)]; print_string(<<_,S/binary>>) -> [$?|print_string(S)]; print_string(<<>>) -> []. %% 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{}=Tref,Key|_], St) -> Val = luerl_heap:raw_get_table_key(Tref, Key, St), {[Val],St}; rawget(As, St) -> badarg_error(rawget, As, St). rawset([Tref,nil=Key,_|_], St) -> lua_error({illegal_index,Tref,Key}, St); rawset([#tref{}=Tref,Key,Val|_], St0) -> St1 = luerl_heap:raw_set_table_key(Tref, Key, Val, St0), {[Tref],St1}; rawset(As, St) -> badarg_error(rawset, As, St). %% 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:arg_to_integer(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) -> {[tonumber(luerl_lib:arg_to_number(Arg))],St}; tonumber([Arg,B|_], St) -> {[tonumber(luerl_lib:arg_to_number(Arg, B))],St}; tonumber(As, St) -> badarg_error(tonumber, As, St). tonumber(Num) when is_number(Num) -> Num; tonumber(_) -> nil. tostring([Arg|_], St) -> case luerl_heap:get_metamethod(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_FLOAT_INT(N), A < 1.0e14 -> %% integer_to_list(round(N)); %% true -> io_lib:write(N) %% end, iolist_to_binary(io_lib:write(N)); tostring(S) when is_binary(S) -> S; tostring(#tref{i=I}) -> iolist_to_binary(["table: ",integer_to_list(I)]); tostring(#usdref{i=I}) -> iolist_to_binary(["userdata: ",integer_to_list(I)]); tostring(#funref{}) -> <<"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(#usdref{}) -> <<"userdata">>; type(#funref{}) -> <<"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([Obj|_], St) -> case luerl_heap:get_metatable(Obj, St) of #tref{}=Meta -> #table{d=Dict} = luerl_heap:get_table(Meta, St), 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{}=Tref, Meta, St0) -> case luerl_heap:get_metamethod(Tref, <<"__metatable">>, St0) of nil -> Upd = fun (Tab) -> Tab#table{meta=Meta} end, St1 = luerl_heap:upd_table(Tref, Upd, St0), {[Tref],St1}; _ -> badarg_error(setmetatable, [Tref], St0) end. %% Do files. dofile(As, St) -> case luerl_lib:conv_list(As, [erl_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, [erl_string,lua_string,lua_string,lua_any]) of [S|_] -> Ret = luerl_comp:string(S), %Compile the string load_ret(Ret, St); error -> badarg_error(load, As, St) end. loadfile(As, St) -> case luerl_lib:conv_list(As, [erl_string,lua_string,lua_any]) of [F|_] -> Ret = luerl_comp:file(F), %Compile the file load_ret(Ret, St); error -> badarg_error(loadfile, As, St) end. loadstring(As, St) -> case luerl_lib:conv_list(As, [erl_string]) of [S] -> Ret = luerl_comp:string(S), %Compile the string load_ret(Ret, St); error -> 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-1.0/src/luerl_sup.erl0000644000232200023220000000243314066413134016354 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-1.0/src/luerl_old.erl0000644000232200023220000000214014066413134016316 0ustar debalancedebalance%% Copyright (c) 2013-2021 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_old.erl %% Authors : Robert Virding, Henning Diedrich %% Purpose : The old basic LUA 5.2 interface. %% This module is just an interface to the older luerl.erl which might %% make it easier to migrate the module names if we decide to do so in %% the future. -module(luerl_old). -export(['$handle_undefined_function'/2]). %% '$handle_undefined_function'(Func, Args) %% We just pass the buck and call the old luerl module. '$handle_undefined_function'(Func, Args) -> apply(luerl, Func, Args). luerl-1.0/src/luerl_lib_io.erl0000644000232200023220000000251714066413134017005 0ustar debalancedebalance%% Copyright (c) 2013-2020 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_heap: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:args_to_strings(As) of error -> badarg_error(write, As, St); Ss -> lists:foreach(fun (S) -> io:format("~s", [S]) end, Ss), {[#userdata{d=standard_io}],St} end. luerl-1.0/src/luerl_parse.yrl0000644000232200023220000002264214066413134016707 0ustar debalancedebalance%% Copyright (c) 2013-2019 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 NUMERAL LITERALSTRING 'and' 'break' 'do' 'else' 'elseif' 'end' 'false' 'for' 'function' 'goto' 'if' 'in' 'local' 'nil' 'not' 'or' 'repeat' 'return' 'then' 'true' 'until' 'while' '+' '-' '*' '/' '//' '%' '^' '&' '|' '~' '>>' '<<' '#' '==' '~=' '<=' '>=' '<' '>' '=' '(' ')' '{' '}' '[' ']' '::' ';' ':' ',' '.' '..' '...' . Rootsymbol chunk. %% uminus needed for '-' as it has duplicate precedences. Left 100 'or'. Left 200 'and'. Left 300 '<' '>' '<=' '>=' '~=' '=='. Left 400 '|'. Left 500 '~'. Left 600 '&'. Left 700 '<<' '>>'. Right 800 '..'. Left 900 '+' '-'. Left 1000 '*' '/' '//' '%'. Unary 1100 'not' '#' uminus. Right 1200 '^'. 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 -> NUMERAL : '$1' . exp -> LITERALSTRING : '$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 -> LITERALSTRING : ['$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 '~=' 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 -> '~' 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-1.0/src/luerl_lib_package.erl0000644000232200023220000001560314066413134017771 0ustar debalancedebalance%% Copyright (c) 2013-2020 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_heap:alloc_table(searchers_table(), St1), {L,St3} = luerl_heap:alloc_table(loaded_table(), St2), {P,St4} = luerl_heap:alloc_table(preload_table(), St3), {T,St5} = luerl_heap: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); error -> 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, St) -> #table{a=Arr} = luerl_heap:get_table(Tref, St), 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; error -> 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; error -> 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-1.0/src/luerl_emul.erl0000644000232200023220000013370214066413134016513 0ustar debalancedebalance%% Copyright (c) 2013-2020 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 basic LUA 5.3 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]). -export([functioncall/3,methodcall/4, set_global_key/3,get_global_key/2, get_table_keys/2,get_table_keys/3, set_table_keys/3,set_table_keys/4, get_table_key/3,set_table_key/4 ]). %% Temporary shadow calls. -export([alloc_table/2,set_userdata/3,get_metamethod/3]). %% 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), begin (get(luerl_itrace) /= undefined) andalso Expr end). %% Temporary shadow calls. gc(St) -> luerl_heap:gc(St). alloc_table(Itab, St) -> luerl_heap:alloc_table(Itab, St). set_userdata(Ref, Data, St) -> luerl_heap:set_userdata(Ref, Data, St). get_metamethod(Obj, Event, St) -> luerl_heap:get_metamethod(Obj, Event, St). %% init() -> State. %% Initialise the basic state. init() -> St1 = luerl_heap:init(), %% Allocate the _G table and initialise the environment {_G,St2} = luerl_lib_basic:install(St1), %Global environment St3 = St2#luerl{g=_G}, %% Now we can start adding libraries. Package MUST be first! St4 = load_lib(<<"package">>, luerl_lib_package, St3), %% Add the other standard libraries. St5 = load_libs([ {<<"bit32">>,luerl_lib_bit32}, {<<"io">>,luerl_lib_io}, {<<"math">>,luerl_lib_math}, {<<"os">>,luerl_lib_os}, {<<"string">>,luerl_lib_string}, {<<"utf8">>,luerl_lib_utf8}, {<<"table">>,luerl_lib_table}, {<<"debug">>,luerl_lib_debug} ], St4), %% Set _G variable to point to it and add it to packages.loaded. St6 = set_global_key(<<"_G">>, _G, St5), set_table_keys([<<"package">>,<<"loaded">>,<<"_G">>], _G, St6). 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_key(Key, Value, State) -> State. %% get_global_key(Key, State) -> {[Val],State}. %% Access elements in the global name table, _G. set_global_key(Key, Val, #luerl{g=G}=St) -> set_table_key(G, Key, Val, St). get_global_key(Key, #luerl{g=G}=St) -> get_table_key(G, Key, St). %% 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} = 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) -> set_table_key(Tab, K, Val, St); set_table_keys(Tab0, [K|Ks], Val, St0) -> {Tab1,St1} = 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, Key, Val, St0) -> case luerl_heap:set_table_key(Tref, Key, Val, St0) of {value,_Val,St1} -> St1; {meta,Meth,Args,St1} -> {_Ret,St2} = functioncall(Meth, Args, St1), St2; {error,Error,St1} -> lua_error(Error, St1) end. get_table_key(Tref, Key, St0) -> case luerl_heap:get_table_key(Tref, Key, St0) of {value,Val,St1} -> {Val,St1}; {meta,Meth,Args,St1} -> {Ret,St2} = functioncall(Meth, Args, St1), {first_value(Ret),St2}; {error,Error,St1} -> lua_error(Error, St1) end. %% 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, EnvStack, State) -> State. %% get_env_var(Depth, Index, EnvStack, State) -> Val. %% We must have the state as the environments are global in the %% state. set_env_var(D, I, Val, Estk, St) -> St1 = set_env_var_1(D, I, Val, Estk, St), %% io:format("******** SEV DONE ~w ~w ********\n", [D,I]), St1. set_env_var_1(1, I, Val, [Eref|_], St) -> luerl_heap:set_env_var(Eref, I, Val, St); set_env_var_1(2, I, Val, [_,Eref|_], St) -> luerl_heap:set_env_var(Eref, I, Val, St); set_env_var_1(D, I, Val, Env, St) -> luerl_heap:set_env_var(lists:nth(D, Env), I, Val, St). get_env_var(D, I, Env, St) -> Val = get_env_var_1(D, I, Env, St), %% io:format("******** GEV DONE ~w ~w ********\n", [D, I]), Val. get_env_var_1(1, I, [Eref|_], St) -> luerl_heap:get_env_var(Eref, I, St); get_env_var_1(2, I, [_,Eref|_], St) -> luerl_heap:get_env_var(Eref, I, St); get_env_var_1(D, I, Env, St) -> luerl_heap:get_env_var(lists:nth(D, Env), I, St). %% load_chunk(FunctionDefCode, State) -> {Function,State}. %% load_chunk(FunctionDefCode, Env, State) -> {Function,State}. %% Load a chunk from the compiler which is a compiled function %% definition whose instructions define everything. Return a callable %% function reference which defines everything and a updated Luerl %% state. load_chunk(Code, St) -> load_chunk(Code, [], St). load_chunk([Code], [], St0) -> {?PUSH_FDEF(Funref),_,St1} = load_chunk_i(Code, [], St0), {Funref,St1}. %% load_chunk_i(Instr, FuncRefs, Status) -> {Instr,FuncRefs,State}. %% load_chunk_is(Instrs, FuncRefs, Status) -> {Instrs,FuncRefs,State}. %% Load chunk instructions. We keep track of the functions refs and %% save the ones directly accessed in each function. This will make %% gc easier as we will not have to step through the function code at %% gc time. load_chunk_is([I0|Is0], Funrs0, St0) -> {I1,Funrs1,St1} = load_chunk_i(I0, Funrs0, St0), {Is1,Funrs2,St2} = load_chunk_is(Is0, Funrs1, St1), {[I1|Is1],Funrs2,St2}; load_chunk_is([], Funrs, St) -> {[],Funrs,St}. %% First the instructions with nested code. %% We include the dymanmic instructions here even though the compiler %% does not generate them. This should make us more future proof. load_chunk_i(?PUSH_FDEF(Anno, Lsz, Esz, Pars, B0), Funrs0, St0) -> {B1,Funrs,St1} = load_chunk_is(B0, [], St0), Fdef = #lua_func{anno=Anno,funrefs=Funrs,lsz=Lsz,esz=Esz,pars=Pars,b=B1}, {Funref,St2} = luerl_heap:alloc_funcdef(Fdef, St1), Funrs1 = ordsets:add_element(Funref, Funrs0), {?PUSH_FDEF(Funref),Funrs1,St2}; load_chunk_i(?BLOCK(Lsz, Esz, B0), Funrs0, St0) -> {B1,Funrs1,St1} = load_chunk_is(B0, Funrs0, St0), {?BLOCK(Lsz, Esz, B1),Funrs1,St1}; load_chunk_i(?REPEAT(B0), Funrs0, St0) -> {B1,Funrs1,St1} = load_chunk_is(B0, Funrs0, St0), {?REPEAT(B1),Funrs1,St1}; load_chunk_i(?REPEAT_LOOP(B0), Funrs0, St0) -> %This is dynamic {B1,Funrs1,St1} = load_chunk_is(B0, Funrs0, St0), {?REPEAT_LOOP(B1),Funrs1,St1}; load_chunk_i(?WHILE(E0, B0), Funrs0, St0) -> {E1,Funrs1,St1} = load_chunk_is(E0, Funrs0, St0), {B1,Funrs2,St2} = load_chunk_is(B0, Funrs1, St1), {?WHILE(E1, B1),Funrs2,St2}; load_chunk_i(?WHILE_LOOP(E0, B0), Funrs0, St0) -> {E1,Funrs1,St1} = load_chunk_is(E0, Funrs0, St0), {B1,Funrs2,St2} = load_chunk_is(B0, Funrs1, St1), {?WHILE_LOOP(E1, B1),Funrs2,St2}; load_chunk_i(?AND_THEN(T0), Funrs0, St0) -> {T1,Funrs1,St1} = load_chunk_is(T0, Funrs0, St0), {?AND_THEN(T1),Funrs1,St1}; load_chunk_i(?OR_ELSE(T0), Funrs0, St0) -> {T1,Funrs1,St1} = load_chunk_is(T0, Funrs0, St0), {?OR_ELSE(T1),Funrs1,St1}; load_chunk_i(?IF_TRUE(T0), Funrs0, St0) -> {T1,Funrs1,St1} = load_chunk_is(T0, Funrs0, St0), {?IF_TRUE(T1),Funrs1,St1}; load_chunk_i(?IF(T0, F0), Funrs0, St0) -> {T1,Funrs1,St1} = load_chunk_is(T0, Funrs0, St0), {F1,Funrs2,St2} = load_chunk_is(F0, Funrs1, St1), {?IF(T1, F1),Funrs2,St2}; load_chunk_i(?NFOR(V, B0), Funrs0, St0) -> {B1,Funrs1,St1} = load_chunk_is(B0, Funrs0, St0), {?NFOR(V, B1),Funrs1,St1}; load_chunk_i(?NFOR_LOOP(N, L, S, B0), Funrs0, St0) -> %This is dynamic {B1,Funrs1,St1} = load_chunk_is(B0, Funrs0, St0), {?NFOR_LOOP(N, L, S, B1),Funrs1,St1}; load_chunk_i(?GFOR(Vs, B0), Funrs0, St0) -> {B1,Funrs1,St1} = load_chunk_is(B0, Funrs0, St0), {?GFOR(Vs, B1),Funrs1,St1}; load_chunk_i(?GFOR_CALL(F, D, V, B0), Funrs0, St0) -> %This is dynamic {B1,Funrs1,St1} = load_chunk_is(B0, Funrs0, St0), {?GFOR_CALL(F, D, V, B1),Funrs1,St1}; load_chunk_i(?GFOR_LOOP(F, D, B0), Funrs0, St0) -> %This is dynamic {B1,Funrs1,St1} = load_chunk_is(B0, Funrs0, St0), {?GFOR_LOOP(F, D, B1),Funrs1,St1}; %% Then the rest which we don't have to worry about. load_chunk_i(I, Funrs, St) -> {I,Funrs,St}. %% call(Function, State) -> {Return,State}. %% call(Function, Args, State) -> {Return,State}. %% functioncall(Function, Args, State) -> {Return,State}. %% methodcall(Object, Method, Args, State) -> {Return,State}. %% These ares called from the outside and expect everything necessary %% to be in the state. call(Func, St) -> call(Func, [], St). call(#funref{}=Funref, Args, St0) -> %Lua function {Ret,St1} = functioncall(Funref, Args, St0), %% Should do GC here. {Ret,St1}; call(#erl_func{}=Func, Args, St0) -> %Erlang function {Ret,St1} = functioncall(Func, Args, St0), %% Should do GC here. {Ret,St1}. functioncall(Func, Args, #luerl{stk=Stk}=St0) -> Fr = #call_frame{func=Func,args=Args,lvs=[],env=[],is=[],cont=[]}, Cs0 = [Fr], {_Lvs,[Ret|_],_Env,Cs1,St1} = functioncall(Func, Args, Stk, Cs0, St0), {Ret,St1#luerl{stk=Stk,cs=Cs1}}. %Reset the stacks methodcall(Obj, Meth, Args, St0) -> %% Get the function to call from object and method. case get_table_key(Obj, Meth, St0) of {nil,St1} -> %No method lua_error({undefined_method,Obj,Meth}, St1); {Func,St1} -> functioncall(Func, [Obj|Args], St1) end. %% emul(Instrs, State). %% emul(Instrs, Continuation, LocalVariables, Stack, Env, CallStack, State). %% The cost of checking the itrace process variable is very slight %% compared to everythin else. emul(Is, St) -> emul(Is, [], {}, [], [], [], St). %% The faster (yeah sure) version. %% emul(Is, Cont, Lvs, Stk, Env, Cs, St) -> %% emul_1(Is, Cont, Lvs, Stk, Env, Cs, St). %% The tracing versions. emul([I|_]=Is, Cont, Lvs, Stk, Env, Cs, St) -> ?ITRACE_DO(begin io:fwrite("Is: ~p\n", [Is]), io:fwrite("Cnt: ~p\n", [Cont]), io:fwrite("Lvs: ~p\n", [Lvs]), io:fwrite("Env: ~p\n", [Env]), io:fwrite("Stk: ~p\n", [Stk]), io:fwrite("Cs: ~p\n", [Cs]), io:fwrite("I: ~p\n", [I]), io:put_chars("--------\n") end), emul_1(Is, Cont, Lvs, Stk, Env, Cs, St); emul([], Cont, Lvs, Stk, Env, Cs, St) -> ?ITRACE_DO(begin io:fwrite("Is: ~p\n", [[]]), io:fwrite("Cnt: ~p\n", [Cont]), io:fwrite("Lvs: ~p\n", [Lvs]), io:fwrite("Env: ~p\n", [Env]), io:fwrite("Stk: ~p\n", [Stk]), io:fwrite("Cs: ~p\n", [Cs]), io:put_chars("--------\n") end), emul_1([], Cont, Lvs, Stk, Env, Cs, St). %% itrace_print(Format, Args) -> %% ?ITRACE_DO(io:fwrite(Format, Args)). %% Expression instructions. emul_1([?PUSH_LIT(L)|Is], Cont, Lvs, Stk, Env, Cs, St) -> emul(Is, Cont, Lvs, [L|Stk], Env, Cs, St); emul_1([?PUSH_LVAR(D, I)|Is], Cont, Lvs, Stk, Env, Cs, St) -> Val = get_local_var(D, I, Lvs), emul(Is, Cont, Lvs, [Val|Stk], Env, Cs, St); emul_1([?PUSH_EVAR(D, I)|Is], Cont, Lvs, Stk, Env, Cs, St) -> Val = get_env_var(D, I, Env, St), emul(Is, Cont, Lvs, [Val|Stk], Env, Cs, St); emul_1([?PUSH_GVAR(Key)|Is], Cont, Lvs, Stk, Env, Cs, St0) -> %% We must handle the metamethod and error here. case luerl_heap:get_global_key(Key, St0) of {value,Val,St1} -> emul(Is, Cont, Lvs, [Val|Stk], Env, Cs, St1); {meta,Meth,Args,St1} -> emul([?FCALL,?SINGLE|Is], Cont, Lvs, [Args,Meth|Stk], Env, Cs, St1); {error,Error,St1} -> lua_error(Error, St1#luerl{stk=Stk,cs=Cs}) end; emul_1([?PUSH_LAST_LIT(L)|Is], Cont, Lvs, Stk, Env, Cs, St) -> emul(Is, Cont, Lvs, [[L]|Stk], Env, Cs, St); emul_1([?PUSH_LAST_LVAR(D, I)|Is], Cont, Lvs, Stk, Env, Cs, St) -> Val = get_local_var(D, I, Lvs), emul(Is, Cont, Lvs, [[Val]|Stk], Env, Cs, St); emul_1([?PUSH_LAST_EVAR(D, I)|Is], Cont, Lvs, Stk, Env, Cs, St) -> Val = get_env_var(D, I, Env, St), emul(Is, Cont, Lvs, [[Val]|Stk], Env, Cs, St); emul_1([?PUSH_LAST_GVAR(Key)|Is], Cont, Lvs, Stk, Env, Cs, St0) -> %% We must handle the metamethod and error here. case luerl_heap:get_global_key(Key, St0) of {value,Val,St1} -> emul(Is, Cont, Lvs, [[Val]|Stk], Env, Cs, St1); {meta,Meth,Args,St1} -> emul([?FCALL|Is], Cont, Lvs, [Args,Meth|Stk], Env, Cs, St1); {error,Error,St1} -> lua_error(Error, St1#luerl{stk=Stk,cs=Cs}) end; emul_1([?STORE_LVAR(D, I)|Is], Cont, Lvs0, [Val|Stk], Env, Cs, St) -> Lvs1 = set_local_var(D, I, Val, Lvs0), emul(Is, Cont, Lvs1, Stk, Env, Cs, St); emul_1([?STORE_EVAR(D, I)|Is], Cont, Lvs, [Val|Stk], Env, Cs, St0) -> St1 = set_env_var(D, I, Val, Env, St0), emul(Is, Cont, Lvs, Stk, Env, Cs, St1); emul_1([?STORE_GVAR(Key)|Is], Cont, Lvs, [Val|Stk], Env, Cs, St0) -> %% We must handle the metamethod and error here. case luerl_heap:set_global_key(Key, Val, St0) of {value,_,St1} -> emul(Is, Cont, Lvs, Stk, Env, Cs, St1); {meta,Meth,Args,St1} -> emul([?FCALL,?POP|Is], Cont, Lvs, [Args,Meth|Stk], Env, Cs, St1); {error,Error,St1} -> lua_error(Error, St1#luerl{stk=Stk,cs=Cs}) end; emul_1([?GET_KEY|Is], Cont, Lvs, [Key,Tab|Stk], Env, Cs, St) -> do_get_key(Is, Cont, Lvs, Stk, Env, Cs, St, Tab, Key); emul_1([?GET_LIT_KEY(Key)|Is], Cont, Lvs, [Tab|Stk], Env, Cs, St) -> %% [?PUSH_LIT(Key),?GET_KEY] do_get_key(Is, Cont, Lvs, Stk, Env, Cs, St, Tab, Key); emul_1([?SET_KEY|Is], Cont, Lvs, [Key,Tab,Val|Stk], Env, Cs, St) -> do_set_key(Is, Cont, Lvs, Stk, Env, Cs, St, Tab, Key, Val); emul_1([?SET_LIT_KEY(Key)|Is], Cont, Lvs, [Tab,Val|Stk], Env, Cs, St) -> %% [?PUSH_LIT(Key),?SET_KEY] do_set_key(Is, Cont, Lvs, Stk, Env, Cs, St, Tab, Key, Val); emul_1([?SINGLE|Is], Cont, Lvs, [Val|Stk], Env, Cs, St) -> emul(Is, Cont, Lvs, [first_value(Val)|Stk], Env, Cs, St); emul_1([?MULTIPLE|Is], Cont, Lvs, [Val|Stk], Env, Cs, St) -> emul(Is, Cont, Lvs, [multiple_value(Val)|Stk], Env, Cs, St); emul_1([?BUILD_TAB(Fc, I)|Is], Cont, Lvs, Stk0, Env, Cs, St0) -> {Tab,Stk1,St1} = build_tab(Fc, I, Stk0, St0), emul(Is, Cont, Lvs, [Tab|Stk1], Env, Cs, St1); emul_1([?FCALL|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_fcall(Is, Cont, Lvs, Stk, Env, Cs, St); emul_1([?TAIL_FCALL|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_tail_fcall(Is, Cont, Lvs, Stk, Env, Cs, St); emul_1([?MCALL(M)|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_mcall(Is, Cont, Lvs, Stk, Env, Cs, St, M); emul_1([?TAIL_MCALL(M)|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_tail_mcall(Is, Cont, Lvs, Stk, Env, Cs, St, M); emul_1([?OP(Op,1)|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_op1(Is, Cont, Lvs, Stk, Env, Cs, St, Op); emul_1([?OP(Op,2)|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_op2(Is, Cont, Lvs, Stk, Env, Cs, St, Op); emul_1([?PUSH_FDEF(Funref)|Is], Cont, Lvs, Stk, Env, Cs, St0) -> %% Update the env field of the function reference with the current %% environment. Funref1 = Funref#funref{env=Env}, emul(Is, Cont, Lvs, [Funref1|Stk], Env, Cs, St0); %% Control instructions. emul_1([?BLOCK(Lsz, Esz, Bis)|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_block(Is, Cont, Lvs, Stk, Env, Cs, St, Lsz, Esz, Bis); emul_1([?BLOCK_OPEN(Lsz, Esz)|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_block_open(Is, Cont, Lvs, Stk, Env, Cs, St, Lsz, Esz); emul_1([?BLOCK_CLOSE|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_block_close(Is, Cont, Lvs, Stk, Env, Cs, St); emul_1([?WHILE(Eis, Wis)|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_while(Is, Cont, Lvs, Stk, Env, Cs, St, Eis, Wis); emul_1([?WHILE_LOOP(Eis, Wis)|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_while_loop(Is, Cont, Lvs, Stk, Env, Cs, St, Eis, Wis); emul_1([?REPEAT(Ris)|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_repeat(Is, Cont, Lvs, Stk, Env, Cs, St, Ris); emul_1([?REPEAT_LOOP(Ris)|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_repeat_loop(Is, Cont, Lvs, Stk, Env, Cs, St, Ris); emul_1([?AND_THEN(Then)|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_and_then(Is, Cont, Lvs, Stk, Env, Cs, St, Then); emul_1([?OR_ELSE(Else)|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_or_else(Is, Cont, Lvs, Stk, Env, Cs, St, Else); emul_1([?IF_TRUE(True)|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_if_true(Is, Cont, Lvs, Stk, Env, Cs, St, True); emul_1([?IF(True, False)|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_if(Is, Cont, Lvs, Stk, Env, Cs, St, True, False); emul_1([?NFOR(V, Fis)|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_numfor(Is, Cont, Lvs, Stk, Env, Cs, St, V, Fis); emul_1([?NFOR_LOOP(N,L,S,Fis)|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_numfor_loop(Is, Cont, Lvs, Stk, Env, Cs, St, N, L, S, Fis); emul_1([?GFOR(Vs, Fis)|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_genfor(Is, Cont, Lvs, Stk, Env, Cs, St, Vs, Fis); emul_1([?GFOR_CALL(Func, Data, Val, Fis)|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_genfor_call(Is, Cont, Lvs, Stk, Env, Cs, St, Func, Data, Val, Fis); emul_1([?GFOR_LOOP(Func, Data, Fis)|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_genfor_loop(Is, Cont, Lvs, Stk, Env, Cs, St, Func, Data, Fis); emul_1([?BREAK|_], _Cont, Lvs, _Stk, _Env, Cs, St) -> do_break(Lvs, Cs, St); emul_1([?RETURN(Ac)|_], _Cont, _Lvs, Stk, _Env, Cs, St) -> do_return(Ac, Stk, Cs, St); %% Stack instructions emul_1([?POP|Is], Cont, Lvs, [_|Stk], Env, Cs, St) -> emul(Is, Cont, Lvs, Stk, Env, Cs, St); emul_1([?POP2|Is], Cont, Lvs, [_,_|Stk], Env, Cs, St) -> emul(Is, Cont, Lvs, Stk, Env, Cs, St); emul_1([?SWAP|Is], Cont, Lvs, [S1,S2|Stk], Env, Cs, St) -> emul(Is, Cont, Lvs, [S2,S1|Stk], Env, Cs, St); emul_1([?DUP|Is], Cont, Lvs, [V|_]=Stk, Env, Cs, St) -> emul(Is, Cont, Lvs, [V|Stk], Env, Cs, St); emul_1([?PUSH_VALS(Vc)|Is], Cont, Lvs, [Vals|Stk0], Env, Cs, St) -> %% Pop value list off the stack and push Vc vals from it. Stk1 = push_vals(Vc, Vals, Stk0), emul(Is, Cont, Lvs, Stk1, Env, Cs, St); emul_1([?POP_VALS(Vc)|Is], Cont, Lvs, Stk0, Env, Cs, St) -> %% Pop Vc vals off the stack, put in a list and push onto the stack. {Vals,Stk1} = pop_vals(Vc, Stk0), emul(Is, Cont, Lvs, [Vals|Stk1], Env, Cs, St); emul_1([?PUSH_ARGS(Al)|Is], Cont, Lvs, [Args|Stk0], Env, Cs, St) -> %% Pop argument list off the stack and push args onto the stack. Stk1 = push_args(Al, Args, Stk0), emul(Is, Cont, Lvs, Stk1, Env, Cs, St); emul_1([?POP_ARGS(Ac)|Is], Cont, Lvs, Stk0, Env, Cs, St) -> %% Pop Ac args off the stack, put in a list and push onto the stack. {Args,Stk1} = pop_vals(Ac, Stk0), emul(Is, Cont, Lvs, [Args|Stk1], Env, Cs, St); emul_1([?COMMENT(_)|Is], Cont, Lvs, Stk, Env, Cs, St) -> %% This just a comment which is ignored. emul(Is, Cont, Lvs, Stk, Env, Cs, St); emul_1([?CURRENT_LINE(Line,File)|Is], Cont, Lvs, Stk, Env, Cs, St) -> do_current_line(Is, Cont, Lvs, Stk, Env, Cs, St, Line, File); emul_1([], [Is|Cont], Lvs, Stk, Env, Cs, St) -> emul(Is, Cont, Lvs, Stk, Env, Cs, St); emul_1([], [], Lvs, Stk, Env, Cs, St) -> {Lvs,Stk,Env,Cs,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) -> Stack. %% Push Count values from ValList 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]). %% push_args(Varlist, ArgList, Stack) -> Stack. %% Use Varlist to push args from ArgList onto the stack. First arg is %% deepest. Tail of VarList determines whether there are varargs. push_args([_V|Vs], [A|As], Stk) -> push_args(Vs, As, [A|Stk]); push_args([_V|Vs], [], Stk) -> push_args(Vs, [], [nil|Stk]); push_args([], _As, Stk) -> Stk; %Drop the rest push_args(_V, As, Stk) -> %Varargs ... save as list [As|Stk]. %% do_set_key(Instrs, LocalVars, Stack, Env, State, Table, Key, Val) -> %% ReturnFromEmul. %% do_get_key(Instrs, LocalVars, Stack, Env, State, Table, Key) -> %% ReturnFromEmul. do_set_key(Is, Cont, Lvs, Stk, Env, Cs, St0, Tab, Key, Val) -> %% We must handle the metamethod and error here. case luerl_heap:set_table_key(Tab, Key, Val, St0) of {value,_,St1} -> emul(Is, Cont, Lvs, Stk, Env, Cs, St1); {meta,Meth,Args,St1} -> emul([?FCALL,?POP|Is], Cont, Lvs, [Args,Meth|Stk], Env, Cs, St1); {error,Error,St1} -> lua_error(Error, St1#luerl{stk=Stk,cs=Cs}) end. do_get_key(Is, Cont, Lvs, Stk, Env, Cs, St0, Tab, Key) -> %% We must handle the metamethod and error here. case luerl_heap:get_table_key(Tab, Key, St0) of {value,Val,St1} -> emul(Is, Cont, Lvs, [Val|Stk], Env, Cs, St1); {meta,Meth,Args,St1} -> emul([?FCALL,?SINGLE|Is], Cont, Lvs, [Args,Meth|Stk], Env, Cs, St1); {error,Error,St1} -> lua_error(Error, St1#luerl{stk=Stk,cs=Cs}) end. %% do_op1(Instrs, LocalVars, Stack, Env, State, Op) -> ReturnFromEmul. %% do_op2(Instrs, LocalVars, Stack, Env, State, Op) -> ReturnFromEmul. do_op1(Is, Cont, Lvs, [A|Stk], Env, Cs, St0, Op) -> case op(Op, A, St0) of {value,Res,St1} -> emul(Is, Cont, Lvs, [Res|Stk], Env, Cs, St1); {meta,Meth,Args,St1} -> emul([?FCALL,?SINGLE|Is], Cont, Lvs, [Args,Meth|Stk], Env, Cs, St1); {error,Error,St1} -> lua_error(Error, St1#luerl{stk=Stk,cs=Cs}) end. do_op2(Is, Cont, Lvs, [A2,A1|Stk], Env, Cs, St0, Op) -> case op(Op, A1, A2, St0) of {value,Res,St1} -> emul(Is, Cont, Lvs, [Res|Stk], Env, Cs, St1); {meta,Meth,Args,St1} -> emul([?FCALL,?SINGLE|Is], Cont, Lvs, [Args,Meth|Stk], Env, Cs, St1); {error,Error,St1} -> lua_error(Error, St1#luerl{stk=Stk,cs=Cs}) end. %% do_break(LocalVars, CallStack, State) -> . do_break(Lvs0, Cs0, St) -> {Bf,Cs1} = find_loop_frame(Cs0, St), #loop_frame{is=Is,cont=Cont,lvs=Lvs1,stk=Stk,env=Env} = Bf, %% Trim the new local variable stack down to original length. Lvs2 = lists:nthtail(length(Lvs0)-length(Lvs1), Lvs0), emul(Is, Cont, Lvs2, Stk, Env, Cs1, St). %% do_return(ArgCount, Stack, Callstack, State) -> . do_return(Ac, Stk0, Cs0, St0) -> {Cf,Cs1} = find_call_frame(Cs0, St0), %Find the first call frame {Ret,Stk1} = pop_vals(Ac, Stk0), %% When tracing bring the state up to date and call the tracer. Tfunc = St0#luerl.trace_func, St1 = if is_function(Tfunc) -> Tfunc(?RETURN(Ret), St0#luerl{stk=Stk1,cs=Cs1}); true -> St0 end, #call_frame{is=Is,cont=Cont,lvs=Lvs,env=Env} = Cf, emul(Is, Cont, Lvs, [Ret|Stk1], Env, Cs1, St1#luerl{cs=Cs1}). find_call_frame([#call_frame{}=Cf|Cs], _St) -> {Cf,Cs}; find_call_frame([_|Cs], St) -> find_call_frame(Cs, St). find_loop_frame([#current_line{}|Cs], St) -> %Skip current line info find_loop_frame(Cs, St); find_loop_frame([#loop_frame{}=Bf|Cs], _St) -> {Bf,Cs}; find_loop_frame(Cs, St) -> lua_error({illegal_op,break}, St#luerl{cs=Cs}). %% do_current_line(Instrs, Continuation, LocalVars, Stack, Env, Stack, State, %% Line, File). do_current_line(Is, Cont, Lvs, Stk, Env, Cs0, St0, Line, File) -> Cs1 = push_current_line(Cs0, Line, File), %Push onto callstack %% When tracing bring the state up to date and call the tracer. Tfunc = St0#luerl.trace_func, St1 = if is_function(Tfunc) -> Tfunc(?CURRENT_LINE(Line, File), St0#luerl{stk=Stk,cs=Cs1}); true -> St0 end, emul(Is, Cont, Lvs, Stk, Env, Cs1, St1). %% push_current_line(CallStack, CurrLine, FileName) -> CallStack. %% Push the current line info on the stack replacing an existing one %% on the top. push_current_line([#current_line{}|Cs], Line, File) -> [#current_line{line=Line,file=File}|Cs]; push_current_line(Cs, Line, File) -> [#current_line{line=Line,file=File}|Cs]. %% do_fcall(Instrs, LocalVars, Stack, Env, State) -> ReturnFromEmul. %% Pop arg list and function from stack and do call. do_fcall(Is, Cont, Lvs, [Args,Func|Stk], Env, Cs, St) -> functioncall(Is, Cont, Lvs, Stk, Env, Cs, St, Func, Args). %% functioncall(Instrs, Cont, LocalVars, Stk, Env, CallStack, State, Func, Args) -> %% %% This is called from within code and continues with Instrs after %% call. It must move everything into State. functioncall(Is, Cont, Lvs, Stk, Env, Cs0, St, Func, Args) -> Fr = #call_frame{func=Func,args=Args,lvs=Lvs,env=Env,is=Is,cont=Cont}, Cs1 = [Fr|Cs0], functioncall(Func, Args, Stk, Cs1, St). %% do_tail_fcall(Instrs, Cont, LocalVars, Stack, Env, State) -> %% ReturnFromEmul. do_tail_fcall(_Is, _Cont, _Lvs, [Args,Func|_Stk], _Env, Cs, St) -> error({tail_fcall,Func,Args,Cs,St}). %% do_mcall(Instrs, Cont, LocalVars, Stack, Env, State, Method) -> do_mcall(Is, Cont, Lvs, [Args,Obj|Stk], Env, Cs, St, M) -> methodcall(Is, Cont, Lvs, Stk, Env, Cs, St, Obj, M, Args). %% methodcall(Instrs, Cont, 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, Cont, Lvs, Stk, Env, Cs, St0, Obj, Meth, Args) -> %% Get the function to call from object and method. case get_table_key(Obj, Meth, St0) of {nil,St1} -> %No method lua_error({undefined_method,Obj,Meth}, St1#luerl{stk=Stk,cs=Cs}); {Func,St1} -> functioncall(Is, Cont, Lvs, Stk, Env, Cs, St1, Func, [Obj|Args]) end. %% do_tail_mcall(Instrs, Cont, LocalVars, Stack, Env, State, Method) -> %% . do_tail_mcall(_Is, _Cont, _Lvs, [Args,Obj|_Stk], _Env, Cs, St, Meth) -> error({tail_mcall,Obj,Meth,Args,Cs,St}). %% functioncall(Function, Args, Stack, CallStack, State) -> {Return,State}. %% Setup environment for function and do the actual call. functioncall(#funref{env=Env}=Funref, Args, Stk, Cs, St0) -> %% When tracing bring the state up to date and call the tracer. Tfunc = St0#luerl.trace_func, St1 = if is_function(Tfunc) -> Tfunc({fcall,Funref,Args}, St0); true -> St0 end, %% Here we must save the stack in state as function may need it. {Func,St2} = luerl_heap:get_funcdef(Funref, St1#luerl{stk=Stk}), call_luafunc(Func, Args, Stk, Env, Cs, St2); functioncall(#erl_func{code=Func}, Args, Stk, Cs, St) -> call_erlfunc(Func, Args, Stk, Cs, St); functioncall(Func, Args, Stk, Cs, St) -> case luerl_heap:get_metamethod(Func, <<"__call">>, St) of nil -> lua_error({undefined_function,Func}, St#luerl{stk=Stk,cs=Cs}); Meta -> functioncall(Meta, [Func|Args], Stk, Cs, St) end. %% call_luafunc(LuaFunc, Args, Stack, Env, State) -> {Return,State}. %% Make the local variable and Env frames and push them onto %% respective stacks and call the function. call_luafunc(#lua_func{lsz=Lsz,esz=Esz,pars=_Pars,b=Fis}, Args, Stk0, Env0, Cs, St0) -> L = make_loc_frame(Lsz), {Eref,St1} = make_env_frame(Esz, St0), Lvs = [L], Stk1 = [Args|Stk0], Env1 = [Eref|Env0], %% Tag = St0#luerl.tag, %% io:fwrite("fc: ~p\n", [{Lvs,Env,St0#luerl.env}]), emul(Fis, [], Lvs, Stk1, Env1, Cs, St1). %% call_erlfunc(ErlFunc, Args, Stack, Env, State) -> {Return,State}. %% Here we must save the stacks in state as function may need it. %% Note we leave the call frame to the erlang function on the call %% stack. It is popped when we return. call_erlfunc(Func, Args, Stk, Cs0, #luerl{stk=Stk0}=St0) -> {Ret,St1} = Func(Args, St0#luerl{stk=Stk,cs=Cs0}), [#call_frame{is=Is,cont=Cont,lvs=Lvs,env=Env}|Cs1] = Cs0, emul(Is, Cont, Lvs, [Ret|Stk], Env, Cs1, St1#luerl{stk=Stk0,cs=Cs1}). %% do_block(Instrs, LocalVars, Stack, Env, State, %% LocalSize, EnvSize, BlockInstrs) -> . %% 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, Cont, Lvs, Stk, Env, Cs, St0, Lsz, Esz, Bis) -> L = make_loc_frame(Lsz), {Eref,St1} = make_env_frame(Esz, St0), emul(Bis, [Is|Cont], [L|Lvs], Stk, [Eref|Env], Cs, St1). %% do_block_open(Instrs, LocalVars, Stack, Env, State, %% LocalSize, EnvSize) -> . %% 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_open(Is, Cont, Lvs, Stk, Env, Cs, St0, Lsz, Esz) -> L = make_loc_frame(Lsz), {Eref,St1} = make_env_frame(Esz, St0), emul(Is, Cont, [L|Lvs], Stk, [Eref|Env], Cs, St1). %% do_block_close(Instrs, LocalVars, Stack, Env, State, %% LocalSize, EnvSize) -> . %% Pop the block local variables and environment variables. do_block_close(Is, Cont, [_|Lvs], Stk, [_|Env], Cs, St) -> emul(Is, Cont, Lvs, Stk, Env, Cs, St). make_env_frame(0, St) -> {not_used,St}; make_env_frame(Esz, St) -> luerl_heap:alloc_environment(Esz, St). %{Eref,St}. make_loc_frame(0) -> not_used; make_loc_frame(Lsz) -> erlang:make_tuple(Lsz, nil). %% do_while(Instrs, Cont, LocalVars, Stack, Env, State, WhileEis, WhileBis) -> %% do_while(Is, Cont, Lvs, Stk, Env, Cs0, St, Eis, Wis) -> %% Add the break frame to the call stack. Fr = #loop_frame{lvs=Lvs,stk=Stk,env=Env,is=Is,cont=Cont}, Cs1 = [Fr|Cs0], emul(Eis, [[?WHILE_LOOP(Eis, Wis)|Is]|Cont], Lvs, Stk, Env, Cs1, St). do_while_loop(Is, Cont, Lvs, [Val|Stk], Env, Cs, St, Eis, Wis) -> case boolean_value(Val) of true -> emul(Wis, [Eis,[?WHILE_LOOP(Eis, Wis)|Is]|Cont], Lvs, Stk, Env, Cs, St); false -> emul([?BREAK|Is], Cont, Lvs, Stk, Env, Cs, St) end. %% do_repeat(Instrs, Cont, LocalVars, Stack, Env, State, RepeatInstrs) -> %% %% We know that at the end of the repear instructions the test value %% is calculated. do_repeat(Is, Cont, Lvs, Stk, Env, Cs0, St, Ris) -> %% Add the break frame to the call stack. Fr = #loop_frame{lvs=Lvs,stk=Stk,env=Env,is=Is,cont=Cont}, Cs1 = [Fr|Cs0], emul(Ris, [[?REPEAT_LOOP(Ris)|Is]|Cont], Lvs, Stk, Env, Cs1, St). do_repeat_loop(Is, Cont, Lvs, [Val|Stk], Env, Cs, St, Ris) -> case boolean_value(Val) of true -> emul([?BREAK|Is], Cont, Lvs, Stk, Env, Cs, St); false -> emul(Ris, [[?REPEAT_LOOP(Ris)|Is]|Cont], Lvs, Stk, Env, Cs, St) end. %% do_and_then(Instrs, Continuation,LocalVars, Stack, Env, State, ThenInstrs) -> %% . %% do_or_else(Instrs, Continuation,LocalVars, Stack, Env, State, ElseInstrs) -> %% . do_and_then(Is, Cont, Lvs, [Val|Stk1]=Stk0, Env, Cs, St, Then) -> %% This is an expression and must always leave a value on stack. case boolean_value(Val) of true -> emul(Then, [Is|Cont], Lvs, Stk1, Env, Cs, St); false -> %% Non true value left on stack. emul(Is, Cont, Lvs, Stk0, Env, Cs, St) end. do_or_else(Is, Cont, Lvs, [Val|Stk1]=Stk0, Env, Cs, St, Else) -> %% This is an expression and must always leave a value on stack. case boolean_value(Val) of true -> %% Non false value left on stack. emul(Is, Cont, Lvs, Stk0, Env, Cs, St); false -> emul(Else, [Is|Cont], Lvs, Stk1, Env, Cs, St) end. %% do_if(Instrs, Continuation, LocalVars, Stack, Env, State, TrueInstrs) -> %% . %% Test value on stack to choose whether to do True instructions. do_if_true(Is, Cont, Lvs, [Val|Stk], Env, Cs, St, True) -> case boolean_value(Val) of true -> emul(True, [Is|Cont], Lvs, Stk, Env, Cs, St); false -> emul(Is, Cont, Lvs, Stk, Env, Cs, St) end. %% do_if(Instrs, LocalVars, Stack, Env, State, TrueInstrs, FalseInstrs) -> %% . %% Test value on stack to choose either True or False instructions. do_if(Is, Cont, Lvs0, [Val|Stk0], Env0, Cs, St0, True, False) -> case boolean_value(Val) of true -> emul(True, [Is|Cont], Lvs0, Stk0, Env0, Cs, St0); false -> emul(False, [Is|Cont], Lvs0, Stk0, Env0, Cs, St0) end. %% do_if(Blocks, Else, Lvs, Stk, Env, St) -> %% 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_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, Cont, Lvs, [Step,Limit,Init|Stk], Env, Cs0, St, _, Fis) -> %% First check if we have numbers. case luerl_lib:args_to_numbers([Init,Limit,Step]) of [I,L,S] -> %% Add the break frame to the call stack. Fr = #loop_frame{lvs=Lvs,stk=Stk,env=Env,is=Is,cont=Cont}, Cs1 = [Fr|Cs0], do_numfor_loop(Is, Cont, Lvs, Stk, Env, Cs1, St, I, L, S, Fis); error -> badarg_error(loop, [Init,Limit,Step], St#luerl{cs=Cs0}) end. do_numfor_loop(Is, Cont, Lvs, Stk, Env, Cs, St, N, Limit, Step, Fis) -> %% itrace_print("nl: ~p\n", [{N,Stk}]), %% Leave the current counter at the top of the stack for code to get. if Step > 0, N =< Limit -> %Keep going emul(Fis, [[?NFOR_LOOP(N+Step, Limit, Step, Fis)|Is]|Cont], Lvs, [N|Stk], Env, Cs, St); Step < 0, N >= Limit -> %Keep going emul(Fis, [[?NFOR_LOOP(N+Step, Limit, Step, Fis)|Is]|Cont], Lvs, [N|Stk], Env, Cs, St); true -> %Done! emul([?BREAK|Is], Cont, Lvs, Stk, Env, Cs, St) end. %% do_genfor(Instrs, LocalVars, Stack, Env, %% CallStack, State, Vars, FromInstrs) -> %% The top of the stack will contain the return values from the explist. do_genfor(Is, Cont, Lvs, [Val|Stk], Env, Cs0, St, _, Fis) -> case Val of %Sneaky, export Func, Data, Var [Func] -> Data = nil, Var = nil; [Func,Data] -> Var = nil; [Func,Data,Var|_] -> ok; Func -> Data = nil, Var = nil end, %% Add the break frame to the call stack. Fr = #loop_frame{lvs=Lvs,stk=Stk,env=Env,is=Is,cont=Cont}, Cs1 = [Fr|Cs0], do_genfor_call(Is, Cont, Lvs, Stk, Env, Cs1, St, Func, Data, Var, Fis). do_genfor_call(Is, Cont, Lvs, Stk, Env, Cs, St, Func, Data, Val, Fis) -> emul([?FCALL,?GFOR_LOOP(Func, Data, Fis)|Is], Cont, Lvs, [[Data,Val],Func|Stk], Env, Cs, St). do_genfor_loop(Is, Cont, Lvs, [Vals|Stk], Env, Cs, St, Func, Data, Fis) -> case boolean_value(Vals) of true -> emul(Fis, [[?GFOR_CALL(Func,Data,hd(Vals),Fis)|Is]|Cont], Lvs, [Vals|Stk], Env, Cs, St); false -> emul([?BREAK|Is], Cont, Lvs, Stk, Env, Cs, St) end. %% 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} = luerl_heap:alloc_table(Fs1, St0), {Tref,Stk1,St1}. build_tab_last(I, [V|Vs]) -> [{I,V}|build_tab_last(I+1, 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, State) -> OpReturn. %% op(Op, Arg1, Arg2, State) -> OpReturn. %% %% OpReturn = {value,Ret,State} | %% {meta,Method,Args,State} | %% {error,Error,State}. %% %% The built-in operators. Always return a single value! op('-', A, St) -> numeric_op('-', A, St, <<"__unm">>, fun (N) -> -N end); op('not', A, St) -> {value,not ?IS_TRUE(A),St}; op('~', A, St) -> integer_op('~', A, St, <<"__bnot">>, fun (N) -> bnot(N) end); op('#', A, St) -> length_op('#', A, St); op(Op, A, St) -> {error,{badarg,Op,[A]},St}. %% Numeric operators. op('+', A1, A2, St) -> numeric_op('+', A1, A2, St, <<"__add">>, fun (N1,N2) -> N1+N2 end); op('-', A1, A2, St) -> numeric_op('-', A1, A2, St, <<"__sub">>, fun (N1,N2) -> N1-N2 end); op('*', A1, A2, St) -> numeric_op('*', A1, A2, St, <<"__mul">>, fun (N1,N2) -> N1*N2 end); op('/', A1, A2, St) -> numeric_op('/', A1, A2, St, <<"__div">>, fun (N1,N2) -> N1/N2 end); %% The '//' and '%' operators are specially handled to avoid first %% converting integers to floats and potentially lose precision. op('//', A1, A2, St) -> numeric_op('//', A1, A2, St, <<"__idiv">>, fun (N1,N2) when is_integer(N1), is_integer(N2) -> Idiv = N1 div N2, Irem = N1 rem N2, if Irem =:= 0 -> Idiv; Idiv < 0 -> Idiv - 1; true -> Idiv end; (N1,N2) -> 0.0 + floor(N1/N2) end); op('%', A1, A2, St) -> numeric_op('%', A1, A2, St, <<"__mod">>, fun (N1,N2) when is_integer(N1), is_integer(N2) -> Irem = N1 rem N2, if (Irem < 0) and (N2 >= 0) -> Irem + N2; (Irem > 0) and (N2 < 0) -> Irem + N2; true -> Irem end; %% if Irem < 0 -> %% if N2 < 0 -> Irem; %% true -> Irem + N2 %% end; %% Irem > 0 -> %% if N2 < 0 -> Irem + N2; %% true -> Irem %% end; %% true -> 0 %Irem =:= 0 %% end; (N1,N2) -> N1 - floor(N1/N2)*N2 end); op('^', A1, A2, St) -> numeric_op('^', A1, A2, St, <<"__pow">>, fun (N1,N2) -> math:pow(N1, N2) end); %% Bitwise operators. %% The '>>' is an arithmetic shift as a logical shift implies a word %% size which we don't have. op('&', A1, A2, St) -> integer_op('&', A1, A2, St, <<"__band">>, fun (N1,N2) -> N1 band N2 end); op('|', A1, A2, St) -> integer_op('|', A1, A2, St, <<"__bor">>, fun (N1,N2) -> N1 bor N2 end); op('~', A1, A2, St) -> integer_op('~', A1, A2, St, <<"__bxor">>, fun (N1,N2) -> N1 bxor N2 end); op('<<', A1, A2, St) -> integer_op('<<', A1, A2, St, <<"__shl">>, fun (N1,N2) -> N1 bsl N2 end); op('>>', A1, A2, St) -> integer_op('>>', A1, A2, St, <<"__shr">>, fun (N1,N2) -> N1 bsr N2 end); %% Relational operators, getting close. op('==', A1, A2, St) -> eq_op('==', A1, A2, St); op('~=', A1, A2, St) -> neq_op('~=', A1, A2, St); op('<=', A1, A2, St) -> le_op('<=', A1, A2, St); op('>=', A1, A2, St) -> le_op('>=', A2, A1, St); op('<', A1, A2, St) -> lt_op('<', A1, A2, St); op('>', A1, A2, St) -> lt_op('>', A2, A1, St); %% String operator. op('..', A1, A2, St) -> concat_op(A1, A2, St); %% Bad args here. op(Op, A1, A2, St) -> {error,{badarg,Op,[A1,A2]}, St}. -ifndef(HAS_FLOOR). %% floor(Number) -> integer(). %% Floor does not exist before 20 so we need to do it ourselves. floor(N) when is_integer(N) -> N; floor(N) when is_float(N) -> round(N - 0.5). -endif. %% length_op(Op, Arg, State) -> OpReturn. %% numeric_op(Op, Arg, State, Event, Raw) -> OpReturn. %% numeric_op(Op, Arg, Arg, State, Event, Raw) -> OpReturn. %% integer_op(Op, Arg, State, Event, Raw) -> OpReturn. %% integer_op(Op, Arg, Arg, State, Event, Raw) -> OpReturn. %% eq_op(Op, Arg, Arg, State) -> OpReturn. %% neq_op(Op, Arg, Arg, State) -> OpReturn. %% lt_op(Op, Arg, Arg, State) -> OpReturn. %% le_op(Op, Arg, Arg, State) -> OpReturn. %% concat_op(Arg, Arg, State) -> OpReturn. %% %% OpReturn = {value,Ret,State} | %% {meta,Method,Args,State} | %% {error,Error,State}. %% %% Together with their metas straight out of the reference %% manual. Note that: %% - numeric_op string args are always floats %% - eq/neq metamethods here must return boolean values and the tests %% themselves are type dependent length_op(_Op, A, St) when is_binary(A) -> {value,byte_size(A),St}; length_op(_Op, A, St) -> case luerl_heap:get_metamethod(A, <<"__len">>, St) of nil -> if ?IS_TREF(A) -> {value,luerl_lib_table:raw_length(A, St),St}; true -> {error,{badarg,'#',[A]}, St} end; Meth -> {meta,Meth,[A],St} end. numeric_op(Op, A, St, E, Raw) -> case luerl_lib:arg_to_number(A) of error -> op_meta(Op, A, E, St); N -> {value,Raw(N),St} end. numeric_op(Op, A1, A2, St, E, Raw) -> case luerl_lib:args_to_numbers(A1, A2) of [N1,N2] -> {value,Raw(N1, N2),St}; error -> op_meta(Op, A1, A2, E, St) end. integer_op(Op, A, St, E, Raw) -> case luerl_lib:arg_to_integer(A) of error -> op_meta(Op, A, E, St); N -> {value,Raw(N),St} end. integer_op(Op, A1, A2, St, E, Raw) -> case luerl_lib:args_to_integers(A1, A2) of [N1,N2] -> {value,Raw(N1, N2),St}; error -> op_meta(Op, A1, A2, E, St) end. eq_op(_Op, A1, A2, St) when A1 == A2 -> {value,true,St}; eq_op(_Op, A1, A2, St) when ?IS_TREF(A1), ?IS_TREF(A2) ; ?IS_USDREF(A1), ?IS_USDREF(A2) -> case get_eqmetamethod(A1, A2, St) of nil -> {value,false,St}; Meth -> Func = fun (Args, St0) -> {Ret,St1} = functioncall(Meth, Args, St0), {[boolean_value(Ret)],St1} end, {meta,#erl_func{code=Func},[A1,A2],St} end; eq_op(_, _, _, St) -> {value,false,St}. neq_op(_Op, A1, A2, St) when A1 == A2 -> {value,false,St}; neq_op(_Op, A1, A2, St) when ?IS_TREF(A1), ?IS_TREF(A2) ; ?IS_USDREF(A1), ?IS_USDREF(A2) -> case get_eqmetamethod(A1, A2, St) of nil -> {value,true,St}; Meth -> Func = fun (Args, St0) -> {Ret,St1} = functioncall(Meth, Args, St0), {[not boolean_value(Ret)],St1} end, {meta,#erl_func{code=Func},[A1,A2],St} end; neq_op(_, _, _, St) -> {value,true,St}. get_eqmetamethod(A1, A2, St) -> %% Must have "same" metamethod here. How do we test? case luerl_heap:get_metamethod(A1, <<"__eq">>, St) of nil -> nil; Meth -> case luerl_heap:get_metamethod(A2, <<"__eq">>, St) of Meth -> Meth; %Must be the same method _ -> nil end end. lt_op(_Op, A1, A2, St) when is_number(A1), is_number(A2) -> {value,A1 < A2,St}; lt_op(_Op, A1, A2, St) when is_binary(A1), is_binary(A2) -> {value,A1 < A2,St}; lt_op(Op, A1, A2, St) -> op_meta(Op, A1, A2, <<"__lt">>, St). le_op(_Op, A1, A2, St) when is_number(A1), is_number(A2) -> {value,A1 =< A2,St}; le_op(_Op, A1, A2, St) when is_binary(A1), is_binary(A2) -> {value,A1 =< A2,St}; le_op(Op, A1, A2, St) -> %% Must check for first __le then __lt metamethods. case luerl_heap:get_metamethod(A1, A2, <<"__le">>, St) of nil -> %% Try for not (Op2 < Op1) instead. case luerl_heap:get_metamethod(A1, A2, <<"__lt">>, St) of nil -> {error,{badarg,Op,[A1,A2]}, St}; Meth -> {meta,Meth,[A2,A1],St} end; Meth -> {meta,Meth,[A1,A2],St} end. concat_op(A1, A2, St) -> case luerl_lib:conv_list([A1,A2], [lua_string,lua_string]) of [S1,S2] -> {value,<>,St}; error -> op_meta('..', A1, A2, <<"__concat">>, St) end. op_meta(Op, A, E, St) -> case luerl_heap:get_metamethod(A, E, St) of nil -> {error,{badarg,Op,[A]}, St}; Meth -> {meta,Meth,[A],St} end. op_meta(Op, A1, A2, E, St) -> case luerl_heap:get_metamethod(A1, A2, E, St) of nil -> {error,{badarg,Op,[A1,A2]},St}; Meth -> {meta,Meth,[A1,A2],St} 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. %% multiple_value(Value) -> [Value]. first_value([V|_]) -> V; first_value([]) -> nil. multiple_value(V) when not is_list(V) -> [V]. luerl-1.0/src/luerl_anno.erl0000644000232200023220000000502214066413134016475 0ustar debalancedebalance%% Copyright (c) 2019 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_anno.erl %% Author : Robert Virding %% Purpose : Handle annotations in the Luerl abstract code. %% We keep the same standard as in the Erlang AST: %% %% - annotations with just the line number can be just the integer. %% - in an aonnotation list the line number is just an integer while %% all other annotations have the format {Key,Value}. -module(luerl_anno). -export([new/0,new/1,new/2,set_line/2,line/1,set/3,get/2]). %% new() -> Anno. %% new(Line) -> Anno. %% new(Key, Val) -> Anno. %% Create an empty annotation, one containing Line and one containing %% a general Key/Val. new() -> []. new(Line) -> Line. new(Key, Val) -> set(Key, Val, new()). %% set_line(Line, Anno) -> Anno. %% line(Anno) -> Line | undefined. %% Specific functions for accessing line numbers in the anno. set_line(Line, Anno) when is_integer(Anno) -> Line; set_line(Line, Anno) -> set_line1(Line, Anno). set_line1(Line, [Old|Anno]) when is_integer(Old) -> [Line|Anno]; set_line1(Line, [A|Anno]) -> [A|set_line1(Line, Anno)]; set_line1(Line, []) -> [Line]. line(Anno) when is_integer(Anno) -> Anno; line(Anno) -> line1(Anno). line1([Line|_]) when is_integer(Line) -> Line; line1([_|Anno]) -> line1(Anno); line1([]) -> undefined. %% set(Key, Value, Anno) -> Anno. %% get(Key, Anno) -> Value | undefined. %% Generic accessing functions for the anno. set(line, Val, Anno) -> set_line(Val, Anno); set(Key, Val, Anno) when is_integer(Anno) -> [Anno,{Key,Val}]; set(Key, Val, Anno) -> set1(Key, Val, Anno). set1(Key, Val, [{Key,_Old}|Anno]) -> [{Key,Val}|Anno]; set1(Key, Val, [A|Anno]) -> [A|set1(Key, Val, Anno)]; set1(Key, Val, []) -> [{Key,Val}]. get(line, Anno) -> line(Anno); %This is untagged get(_Key, Anno) when is_integer(Anno) -> %This is untagged so not Key undefined; get(Key, Anno) -> get1(Key, Anno). get1(Key, [{Key,Val}|_Anno]) -> Val; get1(Key, [_|Anno]) -> get1(Key, Anno); get1(_Key, []) -> undefined. luerl-1.0/src/luerl_lib_utf8.erl0000644000232200023220000001136714066413134017267 0ustar debalancedebalance%% Copyright (c) 2013-2020 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_utf8.erl %% Author : Robert Virding %% Purpose : The utf8 library for Luerl. -module(luerl_lib_utf8). -include("luerl.hrl"). -export([install/1]). -import(luerl_lib, [lua_error/2,badarg_error/3]). %Shorten these install(St) -> luerl_heap:alloc_table(table(), St). table() -> [{<<"char">>,#erl_func{code=fun utf8_char/2}}, {<<"charpattern">>,<<"[\0-\x7F\xC2-\xF4][\x80-\xBF]*">>}, {<<"codes">>,#erl_func{code=fun codes/2}}, {<<"codepoint">>,#erl_func{code=fun codepoint/2}}, {<<"len">>,#erl_func{code=fun utf8_len/2}}, {<<"offset">>,#erl_func{code=fun offset/2}} ]. %% char(...) -> String. %% Receives zero or more integers, converts each one to its %% corresponding UTF-8 byte sequence and returns a string with the %% concatenation of all these sequences. utf8_char(As, St) -> case luerl_lib:args_to_integers(As) of Is when is_list(Is) -> Ss = << <> || I <- Is >>, {[Ss],St}; error -> badarg_error(char, As, St) end. %% len(...) -> Integer. %% Returns the number of UTF-8 characters in string s that start %% between positions i and j (both inclusive). The default for i is 1 %% and for j is -1. If it finds any invalid byte sequence, returns a %% false value plus the position of the first invalid byte. utf8_len(As, St) -> {Str,I,J} = string_args(As, len, St), StrLen = byte_size(Str), Ret = if I > J -> [0]; %Do the same as Lua true -> Bin = binary_part(Str, I - 1, StrLen - I + 1), case bin_len(Bin, StrLen - J, 0) of {ok,Size} -> [Size]; {error,Rest} -> [nil,StrLen - byte_size(Rest) + 1] end end, {Ret,St}. bin_len(Bin, Last, N) when byte_size(Bin) =< Last -> {ok,N}; bin_len(Bin0, Last, N) -> try <<_/utf8,Bin1/binary>> = Bin0, bin_len(Bin1, Last, N+1) catch _:_ -> {error,Bin0} end. %% codepoint(...) -> [Integer]. %% Returns the codepoints (as integers) from all characters in s that %% start between byte position i and j (both included). The default %% for i is 1 and for j is i. It raises an error if it meets any %% invalid byte sequence. codepoint(As, St) -> {Str,I,J} = string_args(As, codepoint, St), StrLen = byte_size(Str), Ret = if I > J -> []; %Do the same as Lua true -> Bin = binary_part(Str, I - 1, StrLen - I + 1), case bin_codepoint(Bin, StrLen - J, []) of {ok,Cps} -> Cps; {error,_} -> badarg_error(codepoint, As, St) end end, {Ret,St}. bin_codepoint(Bin, Last, Cps) when byte_size(Bin) =< Last -> {ok,lists:reverse(Cps)}; bin_codepoint(Bin0, Last, Cps) -> try <> = Bin0, bin_codepoint(Bin1, Last, [C|Cps]) catch _:_ -> {error,Bin0} end. %% codes(String) -> [Fun,String,P]. codes(As, St) -> case luerl_lib:conv_list(As, [lua_string]) of error -> badarg_error(codes, As, St); [Str|_] -> {[#erl_func{code=fun codes_next/2},Str,0],St} end. codes_next([A], St) -> codes_next([A,0], St); codes_next([Str,P|_], St) when byte_size(Str) =< P -> {[nil],St}; codes_next([Str,P|_], St) when is_binary(Str) -> <<_:P/binary,C/utf8,Rest/binary>> = Str, P1 = byte_size(Str) - byte_size(Rest), {[P1,C],St}. %% offset(String, N, ...) -> Integer. -spec offset([_], any()) -> no_return(). offset(As, St) -> _ = string_args(As, offset, St), %% We don't do anything yet. lua_error({'NYI',offset}, St). %% string_args(Args, Op, St) -> {String,I,J}. %% Return the string, i and j values from the arguments. Generate a %% badarg error on bad values. string_args(As, Op, St) -> %% Get the args. Args = luerl_lib:conv_list(As, [lua_string,lua_integer,lua_integer]), case Args of %Cunning here, export A1,A2,A3 [A1,A2,A3|_] -> ok; [A1,A2] -> A3 = byte_size(A1); [A1] -> A2 = 1, A3 = byte_size(A1); error -> A1 = A2 = A3 = ok, badarg_error(Op, As, St) end, StrLen = byte_size(A1), %% Check args and return Str, I, J. Str = A1, I = if A2 > 0, A2 =< StrLen -> A2; A2 < 0, A2 >= -StrLen -> StrLen + A2 + 1; true -> badarg_error(Op, As, St) end, J = if A3 > 0, A3 =< StrLen -> A3; A3 < 0, A3 >= -StrLen -> StrLen + A3 + 1; true -> badarg_error(Op, As, St) end, {Str,I,J}. luerl-1.0/src/luerl.erl0000644000232200023220000003054014066413134015465 0ustar debalancedebalance%% Copyright (c) 2013-2020 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 : The original basic LUA 5.2 interface. -module(luerl). -include("luerl.hrl"). -export([eval/2,evalfile/2, do/2,dofile/2, load/2,load/3, loadfile/2,loadfile/3, path_loadfile/2,path_loadfile/3,path_loadfile/4, load_module/3,load_module1/3, call/3,call_chunk/3, call_function/3,call_function1/3,function_list/2, call_method/3,call_method1/3,method_list/2, get_table/2,get_table1/2,set_table/3,set_table1/3,set_table1/4, init/0,stop/1,gc/1, set_trace_func/2,clear_trace_func/1, set_trace_data/2,get_trace_data/1, get_stacktrace/1 ]). %% Encoding and decoding. -export([encode/2,encode_list/2,decode/2,decode_list/2]). %% luerl:eval(String|Binary|Form, State) -> Result. eval(Chunk, St0) -> try do(Chunk, St0) of {Ret,St1} -> {ok, decode_list(Ret, St1)} catch ?CATCH(_C, E, S) {error, E, S} %{error, {E, R}} ? <- todo: decide end. %% luerl:evalfile(Path, State) -> {ok, Result} | {error,Reason}. evalfile(Path, St0) -> try dofile(Path, St0) of {Ret,St1} -> {ok, decode_list(Ret, St1)} catch ?CATCH(_C, E, S) {error, E, S} %{error, {E, R}} ? <- todo: decide end. %% luerl:do(String|Binary|Form, State) -> {Result, NewState} 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, St0) -> {ok,Func,St1} = loadfile(Path, St0), luerl_emul:call(Func, St1). %% load(String|Binary, State) -> {ok,Function,NewState}. %% load(String|Binary, Options, State) -> {ok,Function,NewState}. load(Bin, St) -> load(Bin, [return], St). load(Bin, Opts, St) when is_binary(Bin) -> load(binary_to_list(Bin), Opts, St); load(Str, Opts, St0) when is_list(Str) -> case luerl_comp:string(Str, Opts) of {ok,Chunk} -> {Func,St1} = luerl_emul:load_chunk(Chunk, St0), {ok,Func,St1}; {error,_,_}=E -> E end. %% loadfile(FileName, State) -> {ok,Function,NewState}. %% loadfile(FileName, Options, State) -> {ok,Function,NewState}. loadfile(Name, St) -> loadfile(Name, [return], St). loadfile(Name, Opts, St0) -> case luerl_comp:file(Name, Opts) 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}. %% path_loadfile(Path, FileName, Options, State) -> %% {ok,Function,FullName,State}. %% When no path is given we use the value of LUA_LOAD_PATH. %% 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, [return], St). path_loadfile(Dirs, Name, St) -> path_loadfile(Dirs, Name, [return], St). path_loadfile([Dir|Dirs], Name, Opts, St0) -> Full = filename:join(Dir, Name), case loadfile(Full, Opts, 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, St) -> call_chunk(C, As, St). 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(TablePath, Args, State) -> {Result,State}. %% call_function1(LuaTablePath | Func, LuaArgs, State) -> {LuaResult,State}. 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, State) -> {Result,State}. %% call_method1(FuncPath | FuncPath, Args, State) -> {Result,State}. 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_heap:gc(St). %% gc(State) -> State. gc(St) -> luerl_heap:gc(St). %% set_trace_func(TraceFunction, State) -> State. %% clear_trace_func(State) -> State. %% get_trace_data(State) -> TraceData. %% set_trace_data(TraceData, State) -> State. %% Set the trace function and access the trace data. set_trace_func(Tfunc, St) -> St#luerl{trace_func=Tfunc}. clear_trace_func(St) -> St#luerl{trace_func=none}. get_trace_data(St) -> St#luerl.trace_data. set_trace_data(Tdata, St) -> St#luerl{trace_data=Tdata}. %% get_stacktrace(State) -> [{FuncName,[{file,FileName},{line,Line}]}]. get_stacktrace(#luerl{cs=Stack}=St) -> Fun = fun (Frame, Acc) -> do_stackframe(Frame, Acc, St) end, {_,Trace} = lists:foldl(Fun, {1,[]}, Stack), lists:reverse(Trace). do_stackframe(#call_frame{func=Funref,args=Args}, {Line,Trace}, St) -> case Funref of #funref{} -> {Func,_} = luerl_heap:get_funcdef(Funref, St), Anno = Func#lua_func.anno, Name = case luerl_anno:get(name, Anno) of undefined -> <<"-no-name-">>; N -> N end, File = luerl_anno:get(file, Anno), {Line,[{Name,Args,[{file,File},{line,Line}]} | Trace]}; #erl_func{} -> {Line,Trace}; %Skip these for now Other -> {Line,[{Other,Args,[{file,<<"-no-file-">>},{line,Line}]} | Trace]} end; do_stackframe(#current_line{line=Line}, {_,Trace}, _St) -> {Line,Trace}; do_stackframe(#loop_frame{}, Acc, _St) -> %Ignore these Acc. %% 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(N, St) when is_number(N) -> {N,St}; %Integers and floats 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,St0}, L), {T,St2} = luerl_heap: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_heap: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) -> decode(LT, St, []). decode(nil, _, _) -> nil; decode(false, _, _) -> false; decode(true, _, _) -> true; decode(B, _, _) when is_binary(B) -> B; decode(N, _, _) when is_number(N) -> N; %Integers and floats decode(#tref{}=T, St, In) -> decode_table(T, St, In); decode(#usdref{}=U, St, _) -> decode_userdata(U, St); decode(#funref{}=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(#erl_func{code=Fun}, _, _) -> Fun; decode(_, _, _) -> error(badarg). %Shouldn't have anything else decode_table(#tref{i=N}=T, St, In0) -> case lists:member(N, In0) of true -> error({recursive_table,T}); %Been here before false -> In1 = [N|In0], %We are in this as well case luerl_heap:get_table(T, St) 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(U, St) -> {#userdata{d=Data},_} = luerl_heap:get_userdata(U, St), {userdata,Data}. luerl-1.0/src/luerl_new.erl0000644000232200023220000002740114066413134016340 0ustar debalancedebalance%% Copyright (c) 2020-2021 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_new.erl %% Authors : Robert Virding %% Purpose : The new basic LUA 5.3 interface. -module(luerl_new). -include("luerl.hrl"). %% Basic user API to luerl. -export([init/0,gc/1, set_trace_func/2,clear_trace_func/1, set_trace_data/2,get_trace_data/1, load/2,load/3,loadfile/2,loadfile/3, load_module/3,load_module_dec/3, do/2,do_dec/2,do/3,do_dec/3, dofile/2,dofile/3,dofile_dec/2,dofile_dec/3, call/3,call_chunk/2,call_chunk/3, call_function/3,call_function_dec/3, call_method/4,call_method_dec/4, get_table_keys/2,get_table_keys_dec/2, set_table_keys/3,set_table_keys_dec/3, get_stacktrace/1 ]). %% Encoding and decoding. -export([encode/2,encode_list/2,decode/2,decode_list/2]). %% init() -> State. init() -> luerl_emul:init(). %% gc(State) -> State. gc(St) -> luerl_heap:gc(St). %% set_trace_func(TraceFunction, State) -> State. %% clear_trace_func(State) -> State. %% get_trace_data(State) -> TraceData. %% set_trace_data(TraceData, State) -> State. %% Set the trace function and access the trace data. set_trace_func(Tfunc, St) -> St#luerl{trace_func=Tfunc}. clear_trace_func(St) -> St#luerl{trace_func=none}. get_trace_data(St) -> St#luerl.trace_data. set_trace_data(Tdata, St) -> St#luerl{trace_data=Tdata}. %% load(String|Binary, State) -> {ok,FuncRef,NewState}. %% load(String|Binary, Options, State) -> {ok,FuncRef,NewState}. load(Bin, St) -> load(Bin, [return], St). load(Bin, Opts, St) when is_binary(Bin) -> load(binary_to_list(Bin), Opts, St); load(Str, Opts, St0) -> case luerl_comp:string(Str, Opts) of {ok,Chunk} -> {FunRef,St1} = luerl_emul:load_chunk(Chunk, St0), {ok,FunRef,St1}; Error -> %Compile error Error end. %% loadfile(FileName, State) -> {ok,FuncRef,NewState}. %% loadfile(FileName, Options, State) -> {ok,FuncRef,NewState}. loadfile(Name, St) -> loadfile(Name, [return], St). loadfile(Name, Opts, St0) -> case luerl_comp:file(Name, Opts) of {ok,Chunk} -> {Func,St1} = luerl_emul:load_chunk(Chunk, St0), {ok,Func,St1}; Error -> Error end. %% load_module(LuaTablePath, ModuleName, State) -> State. %% Load module and add module table to the path. load_module([_|_] = Lfp, Mod, St0) -> {Tab,St1} = Mod:install(St0), luerl_emul:set_table_keys(Lfp, Tab, St1); load_module(_, _, _) -> error(badarg). %% load_module_dec(DecodedTablePath, ModuleName, State) -> State. %% Load module and add module table to the path. load_module_dec([_|_] = Dfp, Mod, St0) -> {Efp,St1} = encode_list(Dfp, St0), load_module(Efp, Mod, St1); load_module_dec(_, _, _) -> error(badarg). %% luerl:do(String|Binary|Form, State) -> %% luerl:do(String|Binary|Form, CompileOptions, State) -> %% {ok,Result,NewState} | {lua_error,Error,State}. do(S, St) -> do(S, [return], St). do(S, Opts, St0) -> case load(S, Opts, St0) of {ok,Func,St1} -> call_function(Func, [], St1); Error -> Error end. do_dec(S, St) -> do_dec(S, [return], St). do_dec(S, Opts, St0) -> case do(S, Opts, St0) of {ok,Eret,St1} -> {ok,decode_list(Eret, St1),St1}; Error -> Error end. %% luerl:dofile(FileName, State) -> %% luerl:dofile(FileName, CompileOptions, State) -> %% {ok,Result,NewState} | {lua_error,Error,State}. dofile(File, St) -> dofile(File, [], St). dofile(File, Opts, St0) -> case loadfile(File, Opts, St0) of {ok,Func,St1} -> call_function(Func, [], St1); Error -> Error end. dofile_dec(File, St) -> dofile_dec(File, [], St). dofile_dec(File, Opts, St0) -> case dofile(File, Opts, St0) of {ok,Eret,St1} -> {ok,decode_list(Eret, St1),St1}; Error -> Error end. %% call(FuncRef, Args, State) -> %% call_chunk(FuncRef, State) -> %% call_chunk(FuncRef, Args, State) -> %% {ok,Return,State} | {lua_error,Error,State}. call(C, As, St) -> call_function(C, As, St). call_chunk(C, St) -> call_chunk(C, [], St). call_chunk(C, As, St) -> call_function(C, As, St). %% call_function(LuaFuncRef, Args, State) -> %% {ok,LuaReturn,State} | {lua_error,Error,State}. call_function(Func, Args, St0) -> try {Ret,St1} = luerl_emul:functioncall(Func, Args, St0), {ok,Ret,St1} catch error:{lua_error,_E,_St} = LuaErr -> LuaErr end. %% call_function_dec(DecodedFuncRef, Args, State) -> %% {ok,DecodedReturn,State} | {lua_error,Error,State}. call_function_dec(Dtpath, Dargs, St0) -> {ok,Efunc,St1} = get_table_keys_dec(Dtpath, St0), {Eargs,St2} = encode_list(Dargs, St1), case call_function(Efunc, Eargs, St2) of {ok,Eret,St3} -> {ok,decode_list(Eret, St3),St3}; LuaError -> LuaError end. %% call_method(LuaObject, Method, Args, State) -> %% {ok,Return,State} | {lua_error,Error,State}. call_method(Obj, Meth, Args, St0) -> try {Ret,St1} = luerl_emul:methodcall(Obj, Meth, Args, St0), {ok,Ret,St1} catch error:{lua_error,_E,_St} = LuaErr -> LuaErr end. %% call_method_dec(DecodedObject, Method, Args, State) -> %% {ok,DecodedReturn,State} | {lua_error,Error,State}. call_method_dec(Dobj, Dmeth, Dargs, St0) -> {ok,Eobj,St1} = get_table_keys_dec(Dobj, St0), {Emeth,St2} = encode(Dmeth, St1), {Eargs,St3} = encode_list(Dargs, St2), case call_method(Eobj, Emeth, Eargs, St3) of {ok,Eret,St4} -> {ok,decode_list(Eret, St4),St4}; LuaError -> LuaError end. %% get_table_keys(Keys, State) -> %% get_table_keys_dec(DecodedKeys, State) -> %% {ok,Return,State} | {lua_error,Error,State}. %% set_table_keys(Keys, Val, State) -> %% set_table_keys_dec(DecodedKeys, DecodedVal, State) -> %% {ok,Return,State} | {lua_error,Error,State}. get_table_keys(Keys, St0) -> try {Ret,St1} = luerl_emul:get_table_keys(Keys, St0), {ok,Ret,St1} catch error:{lua_error,_E,_St} = LuaErr -> LuaErr end. get_table_keys_dec(Dkeys, St0) -> {Ekeys,St1} = encode_list(Dkeys, St0), get_table_keys(Ekeys, St1). set_table_keys(Keys, Val, St0) -> try St1 = luerl_emul:set_table_keys(Keys, Val, St0), {ok,[],St1} catch error:{lua_error,_E,_St} = LuaErr -> LuaErr end. set_table_keys_dec(Dkeys, Dval, St0) -> {Ekeys,St1} = encode_list(Dkeys, St0), {Eval,St2} = encode(Dval, St1), set_table_keys(Ekeys, Eval, St2). %% get_stacktrace(State) -> [{FuncName,[{file,FileName},{line,Line}]}]. get_stacktrace(#luerl{cs=Stack}=St) -> Fun = fun (Frame, Acc) -> do_stackframe(Frame, Acc, St) end, {_,Trace} = lists:foldl(Fun, {1,[]}, Stack), lists:reverse(Trace). do_stackframe(#call_frame{func=Funref,args=Args}, {Line,Trace}, St) -> case Funref of #funref{} -> {Func,_} = luerl_heap:get_funcdef(Funref, St), Anno = Func#lua_func.anno, Name = case luerl_anno:get(name, Anno) of undefined -> <<"-no-name-">>; N -> N end, File = luerl_anno:get(file, Anno), {Line,[{Name,Args,[{file,File},{line,Line}]} | Trace]}; #erl_func{} -> {Line,Trace}; %Skip these for now Other -> {Line,[{Other,Args,[{file,<<"-no-file-">>},{line,Line}]} | Trace]} end; do_stackframe(#current_line{line=Line}, {_,Trace}, _St) -> {Line,Trace}; do_stackframe(#loop_frame{}, Acc, _St) -> %Ignore these Acc. %% 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(N, St) when is_number(N) -> {N,St}; %Integers and floats encode(F, St) when ?IS_MAP(F) -> encode(maps:to_list(F), St); encode(L, St0) when is_list(L) -> %% Encode the table elements in the list. EncTab = 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, {Es,{_,St1}} = lists:mapfoldl(EncTab, {1,St0}, L), {T,St2} = luerl_heap: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_heap: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) -> decode(LT, St, []). decode(nil, _, _) -> nil; decode(false, _, _) -> false; decode(true, _, _) -> true; decode(B, _, _) when is_binary(B) -> B; decode(N, _, _) when is_number(N) -> N; %Integers and floats decode(#tref{}=T, St, In) -> decode_table(T, St, In); decode(#usdref{}=U, St, _) -> decode_userdata(U, St); decode(#funref{}=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(#erl_func{code=Fun}, _, _) -> Fun; decode(_, _, _) -> error(badarg). %Shouldn't have anything else decode_table(#tref{i=N}=T, St, In0) -> case lists:member(N, In0) of true -> error({recursive_table,T}); %Been here before false -> In1 = [N|In0], %We are in this as well case luerl_heap:get_table(T, St) 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(U, St) -> {#userdata{d=Data},_} = luerl_heap:get_userdata(U, St), {userdata,Data}. luerl-1.0/src/luerl_comp_normalise.erl0000644000232200023220000003254714066413134020565 0ustar debalancedebalance%% Copyright (c) 2019 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_normalise.erl %% Author : Robert Virding %% Purpose : A basic LUA 5.3 compiler for Luerl. %% Here we normalise the code and convert it to an internal form. -module(luerl_comp_normalise). -include("luerl.hrl"). -include("luerl_comp.hrl"). -export([chunk/2]). %% chunk(Code, CompInfo) -> {ok,Code} | {error,Reason}. chunk(Code0, #cinfo{opts=Opts}=Ci0) -> %% The chunk is a function. {Code1,_Ci1} = functiondef(Code0, Ci0), luerl_comp:debug_print(Opts, "cn: ~p\n", [Code1]), {ok,Code1}. %% 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 numfor_stmt(Line, V, I, L, {'NUMERAL',Line,1}, 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), Anno = line_file_anno(Line, St2), {#assign_stmt{l=Anno,vars=Cvs,exps=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,key=lit_name(L, N)},St}; var_last({key_field,L,Exp}, St0) -> {Ce,St1} = exp(Exp, St0), {#key{l=L,key=Ce},St1}. %% call_stmt(Line, Exp, State) -> {Call,State}. call_stmt(Line, Exp, St0) -> {Ce,St1} = exp(Exp, St0), Anno = line_file_anno(Line, St1), {#call_stmt{l=Anno,call=Ce},St1}. %% return_stmt(Line, Exps, State) -> {Return,State}. return_stmt(Line, Es, St0) -> {Ces,St1} = explist(Es, St0), Anno = line_file_anno(Line, St1), {#return_stmt{l=Anno,exps=Ces},St1}. %% block_stmt(Line, Stats, State) -> {Block,Stmte}. block_stmt(Line, Ss0, St0) -> {Ss1,St1} = stmts(Ss0, St0), Anno = line_file_anno(Line, St1), {#block_stmt{l=Anno,body=Ss1},St1}. block(Line, Ss0, St0) -> {Ss1,St1} = stmts(Ss0, St0), {#block{l=Line,body=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), Anno = line_file_anno(Line, St2), {#while_stmt{l=Anno,exp=Ce,body=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{body=Cb0#block.body ++ [Ce]}, Anno = line_file_anno(Line, St2), {#repeat_stmt{l=Anno,body=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), Anno = line_file_anno(Line, St2), {#if_stmt{l=Anno,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, lists: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), Anno = line_file_anno(Line, St2), {#nfor_stmt{l=Anno,var=Var,init=I1,limit=L1,step=S1,body=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), Anno = line_file_anno(Line, St2), {#gfor_stmt{l=Anno,vars=Vs1,gens=Gs1,body=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), Anno = line_file_anno(Line, St1), {#assign_stmt{l=Anno,vars=[V],exps=[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 specially 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 parameter 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), Anno = line_file_anno(L, St1), {#fdef{l=Anno,pars=Cp,body=Cb},St1}. functiondef(L, Name0, Ps0, B, St0) -> %% Check if method and transform method to 'NAME' and add self to vars. 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), {F0,St2} = functiondef(L, Ps1, B, St1), %% Add the function name to the annotations. Anno = luerl_anno:set(name, flat_funcname(Name1), F0#fdef.l), F1 = F0#fdef{l=Anno}, {Var,F1,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}. flat_funcname(Name) -> list_to_binary(flat_funcname(Name, [])). flat_funcname({'NAME',_,N}, Rest) -> [N|Rest]; flat_funcname({'.',_,L,R}, Rest) -> flat_funcname(L, [<<".">>|flat_funcname(R, Rest)]). %% 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,key=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,key=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), Anno = line_file_anno(Line, St1), {#local_fdef_stmt{l=Anno,var=Var,func=F},St1}; local_stmt(Line, {assign,_,Ns,Es}, St0) -> {Ces,St1} = explist(Es, St0), {Cns,St2} = lists:mapfoldl(fun (V, St) -> var(V, St) end, St1, Ns), Anno = line_file_anno(Line, St2), {#local_assign_stmt{l=Anno,vars=Cns,exps=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), Anno = line_file_anno(Line, St1), {#expr_stmt{l=Anno,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,val=nil},St}; exp({false,L}, St) -> {#lit{l=L,val=false},St}; exp({true,L}, St) -> {#lit{l=L,val=true},St}; exp({'NUMERAL',L,N}, St) -> {#lit{l=L,val=N},St}; exp({'LITERALSTRING',L,S}, St) -> {#lit{l=L,val=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), {#tabcon{l=L,fields=Cfs},St1}; exp({op,L,Op,A1,A2}, St0) -> {Ca1,St1} = exp(A1, St0), {Ca2,St2} = exp(A2, St1), {#op{l=L,op=Op,args=[Ca1,Ca2]},St2}; exp({op,L,Op,A}, St0) -> {Ca,St1} = exp(A, St0), {#op{l=L,op=Op,args=[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,exp=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,key=lit_name(L, N)},St}; prefixexp_element({key_field,L,Exp}, St0) -> {Ce,St1} = exp(Exp, St0), {#key{l=L,key=Ce},St1}; prefixexp_element({functioncall,L,Args}, St0) -> {Cas,St1} = explist(Args, St0), Anno = line_file_anno(L, St1), {#fcall{l=Anno,args=Cas},St1}; prefixexp_element({methodcall,Lm,{'NAME',Ln,N},Args}, St0) -> {Args1,St1} = explist(Args, St0), Anno = line_file_anno(Lm, St1), {#mcall{l=Anno,meth=lit_name(Ln, N),args=Args1},St1}. dot(L, Exp, Rest) -> #dot{l=L,exp=Exp,rest=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, lists: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,val=Ce},S1}; ({name_field,L,{'NAME',Ln,N},Ve}, S0) -> {Ce,S1} = exp(Ve, S0), %Value {#kfield{l=L,key=lit_name(Ln, N),val=Ce},S1}; ({key_field,L,Ke,Ve}, S0) -> {Ck,S1} = exp(Ke, S0), %Key {Cv,S2} = exp(Ve, S1), %Value {#kfield{l=L,key=Ck,val=Cv},S2} end, {Cfs,St1} = lists:mapfoldl(Fun, St0, Fs), {Cfs,St1}. %% var_name(Line, Name) -> #var{}. %% lit_name(Line, Name) -> #lit{}. lit_name(L, N) -> #lit{l=L,val=N}. var_name(L, N) -> #var{l=L,name=N}. %% line_file_anno(Line, State) -> Anno. %% set_anno(KeyList, Anno) -> Anno. line_file_anno(L, St) -> Anno = luerl_anno:new(L), luerl_anno:set(file, St#cinfo.lfile, Anno). %% set_anno(Ps, Anno) -> %% lists:foldl(fun ({Key,Val}, A) -> luerl_anno:set(Key, Val, A) end, %% Anno, Ps). luerl-1.0/src/luerl_comp_lint.erl0000644000232200023220000001722714066413134017540 0ustar debalancedebalance%% Copyright (c) 2019 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_lint.erl %% Author : Robert Virding %% Purpose : A basic LUA 5.3 error checker for Luerl. %% There isn't much checking which can be done here as most is allowed %% and generates run-time errors or strangeness. So far all we can %% check is the legal use of varargs ... and warn if assignments have %% different number of variables and expressions. -module(luerl_comp_lint). -include("luerl.hrl"). -include("luerl_comp.hrl"). -export([chunk/2,format_error/1]). -record(lint, {opts=[], %Options pars=[], %Local function parameters errors=[], %Errors warnings=[] %Warnings }). %% format_error(Error) -> String. format_error(illegal_varargs) -> "cannot use '...' outside a vararg function"; format_error(assign_mismatch) -> "assign mismatch variables and expressions". %% chunk(Code, Compinfo) -> {ok,Warnings} | {error,Errors,Warnings}. chunk(Code, #cinfo{opts=Opts}=_Ci) -> St0 = #lint{opts=Opts}, St1 = functiondef(Code, St0), return_status(St1). return_status(#lint{errors=[]}=St) -> {ok,St#lint.warnings}; return_status(#lint{errors=Es,warnings=Ws}) -> {error,Es,Ws}. %% stmts(Stmts, State) -> State. stmts([S|Ss], St0) -> St1 = stmt(S, St0), stmts(Ss, St1); stmts([], St) -> St. %% stmt(Stmt, State) -> 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) -> 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{}=For, St) -> local_assign_stmt(For, St); stmt(#local_fdef_stmt{}=For, St) -> local_fdef_stmt(For, St); stmt(#expr_stmt{}=E, St) -> expr_stmt(E, St). %% assign_stmt(Assign, State) -> State. %% call_stmt(Call, State) -> State. %% return_stmt(Return, State) -> State. %% block_stmt(Block, State) -> State. %% while_stmt(While, State) -> State. %% repeat_stmt(Repeat, State) -> State. %% if_stmt(If, State) -> State. %% numfor_stmt(Numfor, State) -> State. %% genfor_stmt(Genfor, State) -> State. %% local_assign_stmt(Assign, State) -> State. %% local_fdef_stmt(Fdef, State) -> State. %% expr_stmt(Expr, State) -> State. assign_stmt(#assign_stmt{vars=Vs,exps=Es}, St0) -> %% Must work more on this to get it right. %% St1 = ?IF(length(Vs) =/= length(Es), %% assign_mismatch_warning(Anno, St0), St0), St1 = St0, St2 = lists:foldl(fun (V, S) -> assign_var(V, S) end, St1, Vs), explist(Es, St2). assign_var(#dot{exp=Exp,rest=Rest}, St0) -> St1 = prefixexp_first(Exp, St0), assign_var_rest(Rest, St1); assign_var(#var{l=Anno,name='...'}, St) -> %% Not allowed to bind ... . illegal_varargs_error(Anno, St); assign_var(_Var, St) -> St. assign_var_rest(#dot{exp=Exp,rest=Rest}, St0) -> St1 = prefixexp_element(Exp, St0), assign_var_rest(Rest, St1); assign_var_rest(Exp, St) -> assign_var_last(Exp, St). assign_var_last(#key{key=Exp}, St) -> exp(Exp, St). call_stmt(#call_stmt{call=Exp}, St) -> exp(Exp, St). return_stmt(#return_stmt{exps=Es}, St) -> explist(Es, St). block_stmt(#block_stmt{body=Ss}, St) -> stmts(Ss, St). while_stmt(#while_stmt{exp=Exp,body=Ss}, St0) -> St1 = exp(Exp, St0), block(Ss, St1). repeat_stmt(#repeat_stmt{body=Ss}, St) -> block(Ss, St). if_stmt(#if_stmt{tests=Ts,else=Else}, St0) -> Fun = fun ({E,B}, S0) -> S1 = exp(E, S0), block(B, S1) end, St1 = lists:foldl(Fun, St0, Ts), block(Else, St1). numfor_stmt(#nfor_stmt{init=I,limit=L,step=S,body=B}, St0) -> St1 = explist([I,L,S], St0), block(B, St1). genfor_stmt(#gfor_stmt{gens=Gs,body=B}, St0) -> St1 = explist(Gs, St0), block(B, St1). local_assign_stmt(#local_assign_stmt{exps=Es}, St0) -> %% Must work more on this to get it right. %% St1 = ?IF(length(Vs) =/= length(Es), %% assign_mismatch_warning(Anno, St0), St0), St1 = St0, explist(Es, St1). local_fdef_stmt(#local_fdef_stmt{func=F}, St) -> functiondef(F, St). expr_stmt(#expr_stmt{exp=Exp}, St) -> exp(Exp, St). %% block(Block, State) -> State. block(#block{body=Ss}, St) -> stmts(Ss, St). %% explist(Exprs, State) -> State. %% exp(Expr, State) -> State. %% prefixexp(Expr, State) -> State. explist(Es, St) -> lists:foldl(fun (E, S) -> exp(E, S) end, St, Es). exp(#lit{}, St) -> St; exp(#fdef{}=F, St) -> functiondef(F, St); exp(#op{args=Es}, St) -> explist(Es, St); exp(#tabcon{fields=Fs}, St) -> tableconstructor(Fs, St); exp(E, St) -> prefixexp(E, St). prefixexp(#dot{exp=Exp,rest=Rest}, St0) -> St1 = prefixexp_first(Exp, St0), prefixexp_rest(Rest, St1); prefixexp(Exp, St) -> prefixexp_first(Exp, St). prefixexp_first(#single{exp=Exp}, St) -> exp(Exp, St); prefixexp_first(#var{}=V, St) -> var(V, St). prefixexp_rest(#dot{exp=Exp,rest=Rest}, St0) -> St1 = prefixexp_element(Exp, St0), prefixexp_rest(Rest, St1); prefixexp_rest(Exp, St) -> prefixexp_element(Exp, St). prefixexp_element(#key{key=Exp}, St) -> exp(Exp, St); prefixexp_element(#fcall{args=Es}, St) -> explist(Es, St); prefixexp_element(#mcall{meth=Lit,args=Es}, St0) -> St1 = lit(Lit, St0), explist(Es, St1). %% functiondef(FuncDef, State) -> State. functiondef(#fdef{pars=Ps,body=Ss}, #lint{pars=Pars}=St0) -> St1 = St0#lint{pars=Ps}, %Use current parameters St2 = stmts(Ss, St1), St2#lint{pars=Pars}. %Reset previous parameters %% tableconstructor(Fields, State) -> State. tableconstructor(Fs, St) -> Fun = fun (#efield{val=Exp}, S) -> exp(Exp, S); (#kfield{key=Key,val=Val}, S0) -> S1 = exp(Key, S0), exp(Val, S1) end, lists:foldl(Fun, St, Fs). %% var(Var, State) -> State. var(#var{l=Anno,name='...'}, St) -> case lists:keymember('...', #var.name, St#lint.pars) of true -> St; false -> illegal_varargs_error(Anno, St) end; var(_Var, St) -> St. %% lit(Lit, State) -> State. lit(#lit{l=Anno,val='...'}, St) -> case lists:keymember('...', #var.name, St#lint.pars) of true -> St; false -> illegal_varargs_error(Anno, St) end; lit(_Lit, St) -> St. %% add_error(Annotation, Error, State) -> State. %% add_warning(Annotation, Warning, State) -> State. %% Add errors/warnings to the state. add_error(Anno, E, #lint{errors=Errs}=St) -> L = luerl_anno:line(Anno), St#lint{errors=Errs ++ [{L,?MODULE,E}]}. %% add_warning(Anno, W, #lint{warnings=Warns}=St) -> %% L = luerl_anno:line(Anno), %% St#lint{warnings=Warns ++ [{L,?MODULE,W}]}. illegal_varargs_error(Anno, St) -> add_error(Anno, illegal_varargs, St). %% assign_mismatch_warning(Anno, St) -> %% add_warning(Anno, assign_mismatch, St). luerl-1.0/src/luerl_scan.xrl0000644000232200023220000002362614066413134016523 0ustar debalancedebalance%% Copyright (c) 2013-2019 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-Fa-f] 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,{'NUMERAL',TokenLine,I}}; _ -> {error,"illegal number"} end. 0[xX]{H}+ : Int = list_to_integer(string:substr(TokenChars, 3), 16), {token,{'NUMERAL',TokenLine,Int}}. %% 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,{'NUMERAL',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,{'NUMERAL',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,{'NUMERAL',TokenLine,F}}; _ -> {error,"illegal number"} end. \.{D}+([eE][-+]?{D}+)? : case catch {ok,list_to_float("0" ++ TokenChars)} of {ok,F} -> {token,{'NUMERAL',TokenLine,F}}; _ -> {error,"illegal number"} end. %% Hexadecimal floats, we have one complex rule to handle bad formats %% more like the Lua parser. 0[xX]{H}*\.?{H}*([pP][+-]?{D}+)? : hex_float_token(TokenChars, TokenLine). %% 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}}. ; : {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. %% comment --ab ... yz --ab([^y]|y[^z])*yz --\[\[([^]]|\][^]])*\]\] : 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_binary(Cs)} of {ok,Name} -> case is_keyword(Name) of true -> {token,{name_string(Name),L}}; false -> {token,{'NAME',L,Name}} end; _ -> {error,"illegal name"} end. name_string(Name) -> binary_to_atom(Name, latin1). %Only latin1 in Lua %% hex_float_token(TokenChars, TokenLine) -> %% {token,{'NUMERAL',TokenLine,Float}} | {error,E}. %% Build a float form a hex float string. hex_float_token(TokenChars, TokenLine) -> Tcs = string:substr(TokenChars, 3), case lists:splitwith(fun (C) -> (C =/= $p) and (C =/= $P) end, Tcs) of {Mcs,[]} when Mcs /= [] -> hex_float(Mcs, [], TokenLine); {Mcs,[_P|Ecs]} when Ecs /= [] -> hex_float(Mcs, Ecs, TokenLine); _Other -> {error,"malformed number"} end. %% hex_float(Mantissa, Exponent) -> {token,{'NUMERAL',Line,Float}} | {error,E}. %% hex_mantissa(Chars) -> {float,Float} | error. %% hex_fraction(Chars, Pow, SoFar) -> Fraction. hex_float(Mcs, [], Line) -> case hex_mantissa(Mcs) of {float,M} -> {token,{'NUMERAL',Line,M}}; error -> {error,"malformed number"} end; hex_float(Mcs, Ecs, Line) -> case hex_mantissa(Mcs) of {float,M} -> case catch list_to_integer(Ecs, 10) of {'EXIT',_} -> {error,"malformed number"}; E -> {token,{'NUMERAL',Line,M * math:pow(2, E)}} end; error -> {error,"malformed number"} end. hex_mantissa(Mcs) -> case lists:splitwith(fun (C) -> C =/= $. end, Mcs) of {[],[]} -> error; %Nothing at all {[],[$.]} -> error; %Only a '.' {[],[$.|Fcs]} -> {float,hex_fraction(Fcs, 16.0, 0.0)}; {Hcs,[]} -> {float,float(list_to_integer(Hcs, 16))}; {Hcs,[$.|Fcs]} -> H = float(list_to_integer(Hcs, 16)), {float,hex_fraction(Fcs, 16.0, H)} end. hex_fraction([C|Cs], Pow, SoFar) when C >= $0, C =< $9 -> hex_fraction(Cs, Pow*16, SoFar + (C - $0)/Pow); hex_fraction([C|Cs], Pow, SoFar) when C >= $a, C =< $f -> hex_fraction(Cs, Pow*16, SoFar + (C - $a + 10)/Pow); hex_fraction([C|Cs], Pow, SoFar) when C >= $A, C =< $F -> hex_fraction(Cs, Pow*16, SoFar + (C - $A + 10)/Pow); hex_fraction([], _Pow, SoFar) -> SoFar. %% string_token(InputChars, Length, Line) -> %% {token,{'LITERALSTRING',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) -> Cs1 = string:substr(Cs0, 2, Len - 2), %Strip quotes case catch {ok,chars(Cs1)} of {ok,Cs2} -> %% Strings are utf8 encoded. %% io:format("before: ~w\n", [Cs2]), Str = case is_valid_utf8(Cs2) of true -> list_to_binary(Cs2); false -> unicode:characters_to_binary(Cs2, unicode, unicode) end, %% io:format("after: ~w\n", [Str]), {token,{'LITERALSTRING',L,Str}}; error -> {error,"illegal string"} end. %% Valid UTF-8 bytes and where they can occur. %% ascii 0 - 7F 0 - 127 %% continutaion 80 - BF 128 - 191 %% first with 1 C2 - DF 194 - 223 %% first with 2 E0 - EF 224 - 239 %% first with 3 F0 - F4 240 - 244 is_valid_utf8([C|Cs]) when C >= 0, C =< 127 -> is_valid_utf8(Cs); is_valid_utf8([F1|Cs]) when F1 >= 194, F1 =< 223 -> is_cont_utf8(1, Cs); is_valid_utf8([F2|Cs]) when F2 >= 224, F2 =< 239 -> is_cont_utf8(2, Cs); is_valid_utf8([F3|Cs]) when F3 >= 240, F3 =< 244 -> is_cont_utf8(3, Cs); is_valid_utf8([]) -> true; is_valid_utf8(_Cs) -> false. is_cont_utf8(1, [C|Cs]) when C >= 128, C =< 191 -> is_valid_utf8(Cs); is_cont_utf8(N, [C|Cs]) when C >= 128, C =< 191 -> is_cont_utf8(N-1, Cs); is_cont_utf8(_N, _Cs) -> false. 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,{'LITERALSTRING',Line,S}}; long_bracket(Line, Cs) -> S = list_to_binary(Cs), {token,{'LITERALSTRING',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. luerl-1.0/src/luerl_comp.txt0000644000232200023220000000743714066413134016551 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-1.0/src/luerl_lib_debug.erl0000644000232200023220000000441614066413134017464 0ustar debalancedebalance%% Copyright (c) 2015-2020 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_heap: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) -> {[luerl_heap:get_metatable(O, St)],St}; getmetatable(As, St) -> badarg_error(getmetatable, As, St). setmetatable([T,M|_], St0) -> St1 = luerl_heap:set_metatable(T, M, St0), {[T],St1}; setmetatable(As, St) -> badarg_error(setmetatable, As, 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-1.0/src/luerl_lib.erl0000644000232200023220000001643114066413134016316 0ustar debalancedebalance%% Copyright (c) 2013-2019 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]). -export([arg_to_list/1,args_to_lists/1,args_to_lists/2]). -export([arg_to_number/1,arg_to_number/2,args_to_numbers/1,args_to_numbers/2]). -export([arg_to_integer/1,args_to_integers/1,args_to_integers/2]). -export([arg_to_string/1,args_to_strings/1,args_to_strings/2]). -export([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({badarg,Where,As}) -> io_lib:format("badarg in ~w: ~w", [Where,As]); format_error({illegal_index,Where,I}) -> io_lib:format("invalid index in ~w: ~w", [Where,I]); format_error({illegal_value,Where,Val}) -> io_lib:format("invalid value in ~w: ~w", [Where,Val]); format_error({illegal_value,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({undefined_function,Name}) -> io_lib:format("undefined function ~w", [Name]); format_error({undefined_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({no_module,Mod}) -> io_lib:format("module '~s' not found", [Mod]). %% boolean_value(Rets) -> boolean(). %% first_value(Rets) -> Value | nil. %% Test first value of return list. boolean_value([V|_]) -> ?IS_TRUE(V); boolean_value([]) -> false. first_value([V|_]) -> V; first_value([]) -> nil. %% bin_to_number(Binary) -> {ok,Number} | error. %% str_to_number(String) -> {ok,Number} | error. %% Use the scanner to process all allowed number syntaxes. bin_to_number(B) -> str_to_number(binary_to_list(B)). str_to_number(S) -> case luerl_scan:string(S) of {ok,[{'NUMERAL',_,N}],_} -> {ok,N}; {ok,[{'+',_},{'NUMERAL',_,N}],_} -> {ok,N}; {ok,[{'-',_},{'NUMERAL',_,N}],_} -> {ok,-N}; _ -> error end. number_to_list(N) -> case ?IS_FLOAT_INT(N, I) of %Is it an "integer"? true -> integer_to_list(I); false -> io_lib:write(N) end. %% arg_to_list(Arg) -> List | 'error'. %% args_to_lists(Args) -> Lists | 'error'. %% args_to_lists(Args, Acc) -> Lists | 'error'. arg_to_list(N) when is_number(N) -> number_to_list(N); arg_to_list(B) when is_binary(B) -> binary_to_list(B); arg_to_list(_) -> error. args_to_lists(As) -> args_to_lists(As, []). args_to_lists(As, Acc) -> to_loop(As, fun arg_to_list/1, Acc). %% arg_to_number(Arg) -> Number | error. %% arg_to_number(Arg, Base) -> Number | error. %% args_to_numbers(Args) -> Numbers | 'error'. %% args_to_numbers(Arg, Arg) -> Numbers | 'error'. %% Strings always result in floats. %% Arg_to_number/2 only generates "integers". Lua does it like that. arg_to_number(N) when is_number(N) -> N; arg_to_number(B) when is_binary(B) -> case bin_to_number(B) of {ok,N} -> float(N); error -> error end; arg_to_number(_) -> error. arg_to_number(A, B) -> case conv_list([A,B], [erl_list,lua_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); _ -> error end end. %% arg_to_number(A, B) -> %% case args_to_numbers([A,B]) of %% [N1,N2] when ?IS_FLOAT_INT(N1) -> %% N1 * math:pow(10,N2); %% error -> error %% end. args_to_numbers(A1, A2) -> case luerl_lib:arg_to_number(A1) of error -> error; N1 -> case luerl_lib:arg_to_number(A2) of error -> error; N2 -> [N1,N2] end end. args_to_numbers(As) -> to_loop(As, fun arg_to_number/1, []). %% arg_to_integer(Arg) -> Integer | 'error'. %% args_to_integers(Args) -> Integers | 'error'. %% args_to_integers(Arg, Arg) -> Integers | 'error'. %% Convert arguments to rounded integers. arg_to_integer(A) -> case arg_to_number(A) of N when is_integer(N) -> N; N when ?IS_FLOAT_INT(N) -> round(N); _Other -> error %Other floats are bad here end. args_to_integers(A1, A2) -> case arg_to_integer(A1) of error -> error; N1 -> case arg_to_integer(A2) of error -> error; N2 -> [N1,N2] end end. args_to_integers(As) -> to_loop(As, fun arg_to_integer/1, []). arg_to_string(N) when is_number(N) -> list_to_binary(number_to_list(N)); arg_to_string(B) when is_binary(B) -> B; arg_to_string(_) -> error. args_to_strings(As) -> args_to_strings(As, []). args_to_strings(As, Acc) -> to_loop(As, fun arg_to_string/1, Acc). %% to_loop(List, Convert, Acc) -> List | 'error'. %% Step over list using foldl and return list or 'error'. We assume %% the list won't be very long so appending is ok. to_loop([A|As], Fun, Acc) -> case Fun(A) of error -> error; %Terminate on error E -> to_loop(As, Fun, Acc ++ [E]) end; to_loop([], _Fun, Acc) -> Acc. %% conv_list(Args, ToTypes) -> List | 'error'. %% conv_list(Args, ToTypes, Done) -> List | 'error'. %% Basically a type driven foldl where we return a list or 'error'. conv_list(As, Tos) -> conv_list(As, Tos, []). conv_list(_, _, error) -> error; %Propagate error conv_list([A|As], [To|Tos], Rs) -> %% Get the right value. Ret = case To of %% Erlang types. erl_list -> arg_to_list(A); erl_string -> arg_to_list(A); %% Lua types. lua_any -> A; lua_integer -> arg_to_integer(A); lua_number -> arg_to_number(A); lua_string -> arg_to_string(A); lua_bool -> ?IS_TRUE(A) end, case Ret of error -> error; %Return error Ret -> conv_list(As, Tos, [Ret|Rs]) end; conv_list([], _, Rs) -> lists:reverse(Rs); %No more arguments, done conv_list(_, [], Rs) -> lists:reverse(Rs). %No more conversions, done luerl-1.0/src/luerl_lib_math.erl0000644000232200023220000002356614066413134017336 0ustar debalancedebalance%% Copyright (c) 2013-2020 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. %% We try to mirror the handling of arguments which occurs in the Lua %% math module. Many functions allow extra arguments but only look at %% the first required ones of the right type and completely ignore the %% rest. %% %% We keep atan2, cosh, sinh tanh, pow, frexp and ldexp even though %% have been deprecated. -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_heap: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}}, {<<"tointeger">>,#erl_func{code=fun tointeger/2}}, {<<"type">>,#erl_func{code=fun type/2}} ]. %% abs(Args, State) -> {[Ret],State}. abs(As, St) -> case get_number_args(As) of [N|_] when is_number(N) -> {[abs(N)],St}; _ -> badarg_error(abs, As, St) end. acos(As, St) -> case get_number_args(As) of [N|_] when is_number(N) -> {[math:acos(N)],St}; _ -> badarg_error(acos, As, St) end. asin(As, St) -> case get_number_args(As) of [N|_] when is_number(N) -> {[math:asin(N)],St}; _ -> badarg_error(asin, As, St) end. atan(As, St) -> case get_number_args(As) of [N1,N2|_] when is_number(N1), is_number(N2) -> {[math:atan2(N1, N2)],St}; [N|_] when is_number(N) -> {[math:atan(N)],St}; _ -> badarg_error(atan, As, St) end. atan2(As, St) -> case get_number_args(As) of [N1,N2|_] when is_number(N1), is_number(N2) -> {[math:atan2(N1, N2)],St}; _ -> badarg_error(atan2, As, St) end. ceil(As, St) -> case get_number_args(As) of [N|_] when is_number(N) -> {[ceil(N)],St}; _ -> badarg_error(ceil, As, St) end. -ifndef(HAS_CEIL). %% ceil(Number) -> integer(). %% Ceil does not exist before 20 so we need to do it ourselves. ceil(N) when is_integer(N) -> N; ceil(N) when is_float(N) -> round(N + 0.5). -endif. cos(As, St) -> case get_number_args(As) of [N|_] when is_number(N) -> {[math:cos(N)],St}; _ -> badarg_error(cos, As, St) end. cosh(As, St) -> case get_number_args(As) of [N|_] when is_number(N) -> {[math:cosh(N)],St}; _ -> badarg_error(cosh, As, St) end. deg(As, St) -> case get_number_args(As) of [N|_] when is_number(N) -> {[180.0*N/math:pi()],St}; _ -> badarg_error(deg, As, St) end. exp(As, St) -> case get_number_args(As) of [N|_] when is_number(N) -> {[math:exp(N)],St}; _ -> badarg_error(exp, As, St) end. floor(As, St) -> case get_number_args(As) of [N|_] when is_number(N) -> {[floor(N)],St}; _ -> badarg_error(floor, As, St) end. -ifndef(HAS_FLOOR). %% floor(Number) -> integer(). %% Floor does not exist before 20 so we need to do it ourselves. floor(N) when is_integer(N) -> N; floor(N) when is_float(N) -> round(N - 0.5). -endif. fmod(As, St) -> case get_number_args(As) of [X,Y|_] when is_number(X), is_number(Y) -> Div = 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 get_number_args(As) of [X|_] when is_number(X) -> %% The sneaky bit! <<_:1,E0:11,M0:52>> = <<(X+0.0)/float>>, 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),E1],St}; _ -> badarg_error(frexp, As, St) end. ldexp(As, St) -> case get_number_args(As) of [M,E|_] when is_float(M), is_integer(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 get_number_args(As) of [N1,N2|_] when is_number(N1), N2 == 10 -> {[math:log10(N1)],St}; %Seeing it is builtin [N1,N2|_] when is_number(N1), is_number(N2) -> {[math:log(N1)/math:log(N2)],St}; [N|_] when is_number(N) -> {[math:log(N)],St}; _ -> badarg_error(log, As, St) end. log10(As, St) -> %For 5.1 backwards compatibility case get_number_args(As) of [N|_] when N == 0 -> {[-500.0],St}; %Bit hacky [N|_] when is_number(N) -> {[math:log10(N)],St}; _ -> badarg_error(log10, As, St) end. max(As, St) -> case luerl_lib:args_to_numbers(As) of [_|_]=Ns -> {[lists:max(Ns)],St}; %At least one number _ -> badarg_error(max, As, St) end. min(As, St) -> case luerl_lib:args_to_numbers(As) of [_|_]=Ns -> {[lists:min(Ns)],St}; %At least one number _ -> badarg_error(min, As, St) end. modf(As, St) -> case get_number_args(As) of [N|_] when is_integer(N) -> {[N,0.0],St}; [N|_] when is_float(N) -> I = trunc(N), %Integral part {[I,float(N-I)],St}; _ -> badarg_error(modf, As, St) end. pow(As, St) -> case get_number_args(As) of [N1,N2|_] when is_number(N1) and is_number(N2) -> {[math:pow(N1, N2)],St}; _ -> badarg_error(pow, As, St) end. rad(As, St) -> case get_number_args(As) of [N|_] when is_number(N) -> {[math:pi()*N/180.0],St}; _ -> badarg_error(sinh, As, St) end. random(As, #luerl{rand=S0}=St) -> case luerl_lib:args_to_integers(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), {[R],St#luerl{rand=S1}}; [M,N] when N >= M -> {R,S1} = ?RAND_UNIFORM(N - M + 1, S0), {[R + M - 1],St#luerl{rand=S1}}; _ -> badarg_error(random, As, St) end. randomseed(As, St) -> case get_number_args(As) of [S|_] when is_number(S) -> %% Split integer or float-64 into three integers. <> = <>, {[],St#luerl{rand=?RAND_SEED(A1, A2, A3)}}; _ -> badarg_error(randomseed, As, St) end. sin(As, St) -> case get_number_args(As) of [N|_] when is_number(N) -> {[math:sin(N)],St}; _ -> badarg_error(sin, As, St) end. sinh(As, St) -> case get_number_args(As) of [N|_] when is_number(N) -> {[math:sinh(N)],St}; _ -> badarg_error(sinh, As, St) end. sqrt(As, St) -> case get_number_args(As) of [N|_] when is_number(N) -> {[math:sqrt(N)],St}; _ -> badarg_error(sqrt, As, St) end. tan(As, St) -> case get_number_args(As) of [N|_] when is_number(N) -> {[math:tan(N)],St}; _ -> badarg_error(tan, As, St) end. tanh(As, St) -> case get_number_args(As) of [N|_] when is_number(N) -> {[math:tanh(N)],St}; _ -> badarg_error(tanh, As, St) end. tointeger(As, St) -> case get_number_args(As) of [N|_] when is_integer(N) -> {[N],St}; [N|_] when is_float(N) -> case trunc(N) of I when I == N -> {[I],St}; _ -> {[nil], St} end; [_|_] -> {[nil],St}; [] -> badarg_error(tointeger, As, St) end. type(As, St) -> %% No conversion here. case As of [N|_] when is_integer(N) -> {[<<"integer">>],St}; [N|_] when is_float(N) -> {[<<"float">>],St}; [_|_] -> {[nil],St}; %Not a number [] -> badarg_error(type, As, St) end. %% get_number_args(Args) -> [Number]. %% Convert args to numbers inserting nil when not possible. This %% allows us to disting between no numbers and an empty list. get_number_args(As) -> lists:map(fun luerl_lib:arg_to_number/1, As). %% get_number_args([A|As]) -> %% case luerl_lib:tonumber(A) of %% N when is_number(N) -> %% [N|get_number_args(As)]; %% nil -> [] %% end; %% get_number_args([]) -> []. luerl-1.0/src/luerl_util.erl0000644000232200023220000001100214066413134016512 0ustar debalancedebalance%% Copyright (c) 2019 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_util.erl %% Purpose : Utility functions for Luer. -module(luerl_util). -export([errname_info/1]). %% Convert error names to errnos and strings. errname_info(Name) -> #{errno => get_errno(Name), errstr => erl_posix_msg:message(Name)}. %% Made using the following command (`errno' from the moreutils package): %% `errno -l | sort -k2 -n | awk '{print "get_errno("tolower($1)") -> "$2";"}'' get_errno(eperm) -> 1; get_errno(enoent) -> 2; get_errno(esrch) -> 3; get_errno(eintr) -> 4; get_errno(eio) -> 5; get_errno(enxio) -> 6; get_errno(e2big) -> 7; get_errno(enoexec) -> 8; get_errno(ebadf) -> 9; get_errno(echild) -> 10; get_errno(eagain) -> 11; get_errno(ewouldblock) -> 11; get_errno(enomem) -> 12; get_errno(eacces) -> 13; get_errno(efault) -> 14; get_errno(enotblk) -> 15; get_errno(ebusy) -> 16; get_errno(eexist) -> 17; get_errno(exdev) -> 18; get_errno(enodev) -> 19; get_errno(enotdir) -> 20; get_errno(eisdir) -> 21; get_errno(einval) -> 22; get_errno(enfile) -> 23; get_errno(emfile) -> 24; get_errno(enotty) -> 25; get_errno(etxtbsy) -> 26; get_errno(efbig) -> 27; get_errno(enospc) -> 28; get_errno(espipe) -> 29; get_errno(erofs) -> 30; get_errno(emlink) -> 31; get_errno(epipe) -> 32; get_errno(edom) -> 33; get_errno(erange) -> 34; get_errno(edeadlk) -> 35; get_errno(edeadlock) -> 35; get_errno(enametoolong) -> 36; get_errno(enolck) -> 37; get_errno(enosys) -> 38; get_errno(enotempty) -> 39; get_errno(eloop) -> 40; get_errno(enomsg) -> 42; get_errno(eidrm) -> 43; get_errno(echrng) -> 44; get_errno(el2nsync) -> 45; get_errno(el3hlt) -> 46; get_errno(el3rst) -> 47; get_errno(elnrng) -> 48; get_errno(eunatch) -> 49; get_errno(enocsi) -> 50; get_errno(el2hlt) -> 51; get_errno(ebade) -> 52; get_errno(ebadr) -> 53; get_errno(exfull) -> 54; get_errno(enoano) -> 55; get_errno(ebadrqc) -> 56; get_errno(ebadslt) -> 57; get_errno(ebfont) -> 59; get_errno(enostr) -> 60; get_errno(enodata) -> 61; get_errno(etime) -> 62; get_errno(enosr) -> 63; get_errno(enonet) -> 64; get_errno(enopkg) -> 65; get_errno(eremote) -> 66; get_errno(enolink) -> 67; get_errno(eadv) -> 68; get_errno(esrmnt) -> 69; get_errno(ecomm) -> 70; get_errno(eproto) -> 71; get_errno(emultihop) -> 72; get_errno(edotdot) -> 73; get_errno(ebadmsg) -> 74; get_errno(eoverflow) -> 75; get_errno(enotuniq) -> 76; get_errno(ebadfd) -> 77; get_errno(eremchg) -> 78; get_errno(elibacc) -> 79; get_errno(elibbad) -> 80; get_errno(elibscn) -> 81; get_errno(elibmax) -> 82; get_errno(elibexec) -> 83; get_errno(eilseq) -> 84; get_errno(erestart) -> 85; get_errno(estrpipe) -> 86; get_errno(eusers) -> 87; get_errno(enotsock) -> 88; get_errno(edestaddrreq) -> 89; get_errno(emsgsize) -> 90; get_errno(eprototype) -> 91; get_errno(enoprotoopt) -> 92; get_errno(eprotonosupport) -> 93; get_errno(esocktnosupport) -> 94; get_errno(enotsup) -> 95; get_errno(eopnotsupp) -> 95; get_errno(epfnosupport) -> 96; get_errno(eafnosupport) -> 97; get_errno(eaddrinuse) -> 98; get_errno(eaddrnotavail) -> 99; get_errno(enetdown) -> 100; get_errno(enetunreach) -> 101; get_errno(enetreset) -> 102; get_errno(econnaborted) -> 103; get_errno(econnreset) -> 104; get_errno(enobufs) -> 105; get_errno(eisconn) -> 106; get_errno(enotconn) -> 107; get_errno(eshutdown) -> 108; get_errno(etoomanyrefs) -> 109; get_errno(etimedout) -> 110; get_errno(econnrefused) -> 111; get_errno(ehostdown) -> 112; get_errno(ehostunreach) -> 113; get_errno(ealready) -> 114; get_errno(einprogress) -> 115; get_errno(estale) -> 116; get_errno(euclean) -> 117; get_errno(enotnam) -> 118; get_errno(enavail) -> 119; get_errno(eisnam) -> 120; get_errno(eremoteio) -> 121; get_errno(edquot) -> 122; get_errno(enomedium) -> 123; get_errno(emediumtype) -> 124; get_errno(ecanceled) -> 125; get_errno(enokey) -> 126; get_errno(ekeyexpired) -> 127; get_errno(ekeyrevoked) -> 128; get_errno(ekeyrejected) -> 129; get_errno(eownerdead) -> 130; get_errno(enotrecoverable) -> 131; get_errno(erfkill) -> 132; get_errno(ehwpoison) -> 133; get_errno(_) -> 0. luerl-1.0/src/luerl_heap.erl0000644000232200023220000006126114066413134016466 0ustar debalancedebalance%% Copyright (c) 2020 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_heap.erl %% Author : Robert Virding %% Purpose : Implements the heap section of the Luerl state. %% %% Note that here we only handle the data in the heap and never call %% anything in either Luerl or Erlang. Those cases where this could %% happen we return values informing the caller to do it. For example %% in the set_table_key and get_table_key functions. -module(luerl_heap). -include("luerl.hrl"). -export([init/0]). %% External interface. -export([gc/1, alloc_table/1,alloc_table/2,free_table/2, get_table/2,set_table/3,upd_table/3, get_global_key/2,set_global_key/3, get_table_key/3,set_table_key/4, raw_get_table_key/3,raw_set_table_key/4, alloc_userdata/2,alloc_userdata/3,get_userdata/2,set_userdata/3, alloc_funcdef/2,get_funcdef/2,set_funcdef/3, alloc_environment/2,get_env_var/3,set_env_var/4, get_metamethod/3,get_metamethod/4, get_metatable/2, set_metatable/3 ]). -import(luerl_lib, [lua_error/2,badarg_error/3]). %% init() -> State %% %% Initialise the heap section of the state and return the state. init() -> St0 = #luerl{meta=#meta{},tag=make_ref()}, init_tables(St0). init_tables(St) -> %% Initialise the table handling. Tst = init_tstruct(), %% Initialise the environment handling. Est = init_tstruct(), %% Initialise the userdata handling. Ust = init_tstruct(), %% Initialise the function def handling. Fst = init_tstruct(), St#luerl{tabs=Tst,envs=Est,usds=Ust,fncs=Fst}. %% init_tstruct() -> #tstruct{}. %% alloc_tstruct(Val, #tstruct{}) -> {Index,#tstruct{}}. %% set_tstruct(Index, Val, #tstruct{}) -> #tstruct{}. %% upd_tstruct(Index, UpdFun, #tstruct{}) -> #tstruct{}. %% del_tstruct(Index, #tstruct{}) -> #tstruct{}. %% %% Functions for accessing tstructs. init_tstruct() -> #tstruct{data=?MAKE_TABLE(),free=[],next=0}. alloc_tstruct(Val, #tstruct{data=D0,free=[N|Ns]}=Tstr) -> D1 = ?SET_TABLE(N, Val, D0), {N,Tstr#tstruct{data=D1,free=Ns}}; alloc_tstruct(Val, #tstruct{data=D0,free=[],next=N}=Tstr) -> D1 = ?SET_TABLE(N, Val, D0), {N,Tstr#tstruct{data=D1,next=N+1}}. set_tstruct(N, Val, #tstruct{data=D0}=Tstr) -> D1 = ?SET_TABLE(N, Val, D0), Tstr#tstruct{data=D1}. upd_tstruct(N, Upd, #tstruct{data=D0}=Tstr) -> D1 = ?UPD_TABLE(N, Upd, D0), Tstr#tstruct{data=D1}. del_tstruct(N, #tstruct{data=D0,free=Ns}=Tstr) -> D1 = ?DEL_TABLE(N, D0), Tstr#tstruct{data=D1,free=[N|Ns]}. -compile({inline,[get_tstruct/2]}). %Such a simple function get_tstruct(N, Tstr) -> ?GET_TABLE(N, Tstr#tstruct.data). %% alloc_table(State) -> {Tref,State} %% %% Allocate an empty table. alloc_table(St) -> alloc_table([], St). %% alloc_table(InitialTable, State) -> {Tref,State} %% %% The InitialTable is [{Key,Value}], there is no longer any need %% to have it as an orddict. alloc_table(Itab, #luerl{tabs=Tst0}=St) -> Tab = create_table(Itab), {N,Tst1} = alloc_tstruct(Tab, Tst0), {#tref{i=N},St#luerl{tabs=Tst1}}. create_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_integer(K), K >= 1 -> {D,array:set(K, V, A)}; ({K,V}, {D,A}) when is_float(K) -> case ?IS_FLOAT_INT(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,meta=nil}. %% free_table(Tref, State) -> State %% %% Delete a table freeing its space. free_table(#tref{i=N}, #luerl{tabs=Tst0}=St) -> Tst1 = del_tstruct(N, Tst0), St#luerl{tabs=Tst1}. %% get_table(Tref, State) -> Table %% %% Get the table referred to by Tref. get_table(#tref{i=N}, #luerl{tabs=Tst}) -> get_tstruct(N, Tst). %% set_table(Tref, Table, State) -> State %% %% Set a new table at the location referred to by Tref %% overwriting the existing one. set_table(#tref{i=N}, Tab, #luerl{tabs=Tst0}=St) -> Tst1 = set_tstruct(N, Tab, Tst0), St#luerl{tabs=Tst1}. %% upd_table(Tref, Fun, State) -> State %% %% Update the table at the location referred to by Tref. upd_table(#tref{i=N}, Upd, #luerl{tabs=Tst0}=St) -> Tst1 = upd_tstruct(N, Upd, Tst0), St#luerl{tabs=Tst1}. %% set_global_key(Key, Value, State) -> %% {value,Value,State} | {meta,Method,Args,State} | {error,Error,State} %% %% Set a key in the global name table _G to value. set_global_key(Key, Val, #luerl{g=G}=St) -> set_table_key(G, Key, Val, St). %% get_global_key(Key, State) -> %% {value,Value,State} | {meta,Method,Args,State} | {error,Error,State} %% %% Get the value of a key in the global name table, _G. get_global_key(Key, #luerl{g=G}=St) -> get_table_key(G, Key, St). %% set_table_key(Table, Key, Val, State) -> %% {value,Value,State} | {meta,Method,Args,State} | {error,Error,State} %% %% We don't make calls to meta methods or generate errors but %% return a value indicating this. Setting a value to 'nil' will clear %% it from the table and the array. We won't add a nil value. set_table_key(#tref{}=Tref, Key, Val, St) when is_integer(Key), Key >= 1 -> set_table_key_int(Tref, Key, Key, Val, St); set_table_key(#tref{}=Tref, Key, Val, St) when is_float(Key) -> case ?IS_FLOAT_INT(Key, I) of true when I >= 1 -> set_table_key_int(Tref, Key, I, Val, St); _NegFalse -> set_table_key_key(Tref, Key, Val, St) end; set_table_key(Tab, nil=Key, _, St) -> {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) -> {error,{illegal_index,Tab,Key},St}. set_table_key_key(#tref{i=N}=Tab, Key, Val, #luerl{tabs=Tst0}=St) -> Ts0 = Tst0#tstruct.data, #table{d=Dict0,meta=Meta}=T = ?GET_TABLE(N, Ts0), 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), Tst1 = Tst0#tstruct{data=Ts1}, {value,[],St#luerl{tabs=Tst1}}; error -> %Key does not exist case get_metamethod_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), Tst1 = Tst0#tstruct{data=Ts1}, {value,[],St#luerl{tabs=Tst1}}; Meth when ?IS_FUNCTION(Meth) -> {meta,Meth,[Tab,Key,Val],St}; Meth -> set_table_key(Meth, Key, Val, St) end end. set_table_key_int(#tref{i=N}=Tab, Key, I, Val, #luerl{tabs=Tst0}=St) -> Ts0 = Tst0#tstruct.data, #table{a=Arr0,meta=Meta}=T = ?GET_TABLE(N, Ts0), case array:get(I, Arr0) of nil -> %Key does not exist case get_metamethod_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), Tst1 = Tst0#tstruct{data=Ts1}, {value,[],St#luerl{tabs=Tst1}}; Meth when ?IS_FUNCTION(Meth) -> {meta,Meth,[Tab,Key,Val],St}; 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), Tst1 = Tst0#tstruct{data=Ts1}, {value,[],St#luerl{tabs=Tst1}} end. %% get_table_key(Table, Key, State) -> %% {value,Value,State} | {meta,Method,Args,State} | {error,Error,State} %% %% We don't make calls to meta methods or generate errors but %% return value indicating this. get_table_key(#tref{}=Tref, Key, St) when is_integer(Key), Key >= 1 -> get_table_key_int(Tref, Key, Key, St); get_table_key(#tref{}=Tref, Key, St) when is_float(Key) -> case ?IS_FLOAT_INT(Key, I) of true when I >= 1 -> get_table_key_int(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 get_metamethod(Tab, <<"__index">>, St) of nil -> {error,{illegal_index,Tab,Key},St}; Meth when ?IS_FUNCTION(Meth) -> {meta,Meth,[Tab,Key],St}; Meth -> %Recurse down the metatable get_table_key(Meth, Key, St) end. get_table_key_key(#tref{i=N}=Tab, Key, #luerl{tabs=#tstruct{data=Ts}}=St) -> #table{d=Dict,meta=Meta} = ?GET_TABLE(N, Ts), case ttdict:find(Key, Dict) of {ok,Val} -> {value,Val,St}; error -> %% Key not present so try metamethod get_table_key_metamethod(Tab, Meta, Key, Ts, St) end. get_table_key_int(#tref{i=N}=T, Key, I, #luerl{tabs=#tstruct{data=Ts}}=St) -> #table{a=A,meta=Meta} = ?GET_TABLE(N, Ts), %Get the table. case array:get(I, A) of nil -> %% Key not present so try metamethod get_table_key_metamethod(T, Meta, Key, Ts, St); Val -> {value,Val,St} end. get_table_key_metamethod(Tab, Meta, Key, Ts, St) -> case get_metamethod_tab(Meta, <<"__index">>, Ts) of nil -> {value,nil,St}; Meth when ?IS_FUNCTION(Meth) -> {meta,Meth,[Tab,Key],St}; Meth -> %Recurse down the metatable get_table_key(Meth, Key, St) end. %% raw_get_table_key(Table, Key, State) -> Value. %% raw_set_table_key(Table, Key, Value, State) -> State. %% %% Get/set key values in tables without metamethods. raw_get_table_key(#tref{i=N}, Key, #luerl{tabs=Tst}) when is_integer(Key), Key >= 1 -> raw_get_table_key_int(N, Key, Tst); raw_get_table_key(#tref{i=N}, Key, #luerl{tabs=Tst}) when is_float(Key) -> case ?IS_FLOAT_INT(Key, I) of true when I >= 1 -> raw_get_table_key_int(N, I, Tst); _NegFalse -> raw_get_table_key_key(N, Key, Tst) end; raw_get_table_key(#tref{i=N}, Key, #luerl{tabs=Tst}) -> raw_get_table_key_key(N, Key, Tst). raw_get_table_key_key(N, Key, Tst) -> #table{d=Dict} = get_tstruct(N, Tst), case ttdict:find(Key, Dict) of {ok,Val} -> Val; error -> nil end. raw_get_table_key_int(N, Key, Tst) -> #table{a=Arr} = get_tstruct(N, Tst), array:get(Key, Arr). raw_set_table_key(#tref{}=Tref, Key, Val, #luerl{tabs=Tst0}=St) when is_integer(Key), Key >= 1 -> Tst1 = raw_set_table_key_int(Tref, Key, Val, Tst0), St#luerl{tabs=Tst1}; raw_set_table_key(#tref{}=Tref, Key, Val, #luerl{tabs=Tst0}=St) when is_float(Key) -> Tst1 = case ?IS_FLOAT_INT(Key, I) of true when I >= 1 -> raw_set_table_key_int(Tref, I, Val, Tst0); _NegFalse -> raw_set_table_key_key(Tref, Key, Val, Tst0) end, St#luerl{tabs=Tst1}. raw_set_table_key_key(#tref{i=N}, Key, Val, Tst0) -> Fun = fun (#table{d=Dict0}=Tab) -> Dict1 = if Val =:= nil -> ttdict:erase(Key, Dict0); true -> ttdict:store(Key, Val, Dict0) end, Tab#table{d=Dict1} end, upd_tstruct(N, Fun, Tst0). raw_set_table_key_int(#tref{i=N}, Key, Val, Tst0) -> Fun = fun (#table{a=Arr0}=Tab) -> %% Default array value is nil. Arr1 = array:set(Key, Val, Arr0), Tab#table{a=Arr1} end, upd_tstruct(N, Fun, Tst0). %% alloc_userdata(Data, State) -> {Usdref,State} %% %% Allocate userdata with empty metadata. alloc_userdata(Data, St) -> alloc_userdata(Data, nil, St). %% alloc_userdata(Data, Meta, State) -> {Usdref,State}. %% %% Allocate userdata setting its metadata. alloc_userdata(Data, Meta, #luerl{usds=Ust0}=St) -> Ud = #userdata{d=Data,meta=Meta}, {N,Ust1} = alloc_tstruct(Ud, Ust0), {#usdref{i=N},St#luerl{usds=Ust1}}. %% get_userdata(Usdref, State) -> {UserData,State} %% %% Get the userdata data. get_userdata(#usdref{i=N}, #luerl{usds=Ust}=St) -> #userdata{} = Udata = get_tstruct(N, Ust), {Udata,St}. %% set_userdata(Usdref, UserData, State) -> State %% %% Set the data in the userdata. set_userdata(#usdref{i=N}, Data, #luerl{usds=Ust0}=St) -> Ust1 = upd_tstruct(N, fun (Ud) -> Ud#userdata{d=Data} end, Ust0), St#luerl{usds=Ust1}. %% make_userdata(Data) -> make_userdata(Data, nil). %% make_userdata(Data, Meta) -> #userdata{d=Data,meta=Meta}. %% alloc_funcdef(Def, State) -> {FunRef,State} alloc_funcdef(Func, #luerl{fncs=Fst0}=St) -> {N,Fst1} = alloc_tstruct(Func, Fst0), {#funref{i=N},St#luerl{fncs=Fst1}}. %% get_funcdef(Funref, State) -> {Fdef,State} %% %% Get the function data referred to by Fref. get_funcdef(#funref{i=N}, #luerl{fncs=Fst}=St) -> Fdef = get_tstruct(N, Fst), {Fdef,St}. %% set_funcdef(Funref, Fdef, State) -> State. %% %% Set the function data referred to by Fref. set_funcdef(#funref{i=N}, Func, #luerl{fncs=Fst0}=St) -> Fst1 = set_tstruct(N, Func, Fst0), St#luerl{fncs=Fst1}. %% get_metamethod(Object1, Object2, Event, State) -> Method | nil %% %% Get the metamethod for object(s). get_metamethod(O1, O2, E, St) -> case get_metamethod(O1, E, St) of nil -> get_metamethod(O2, E, St); M -> M end. get_metamethod(O, E, St) -> Meta = get_metatable(O, St), %Can be nil get_metamethod_tab(Meta, E, St#luerl.tabs#tstruct.data). get_metamethod_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; get_metamethod_tab(_, _, _) -> nil. %Other types have no metatables %% get_metatable(Obj, State) -> MetaTable %% %% Get the metatable of an object or its type metatable. get_metatable(#tref{i=T}, #luerl{tabs=Tst}) -> (get_tstruct(T, Tst))#table.meta; get_metatable(#usdref{i=U}, #luerl{usds=Ust}) -> (get_tstruct(U, Ust))#userdata.meta; get_metatable(nil, #luerl{meta=Meta}) -> Meta#meta.nil; get_metatable(B, #luerl{meta=Meta}) when is_boolean(B) -> Meta#meta.boolean; get_metatable(N, #luerl{meta=Meta}) when is_number(N) -> Meta#meta.number; get_metatable(S, #luerl{meta=Meta}) when is_binary(S) -> Meta#meta.string; get_metatable(_, _) -> nil. %Other types have no metatables %% set_metatable(Obj, MetaTable, State) -> State %% %% Set the metatable of an object or its type metatable. set_metatable(#tref{i=N}, M, #luerl{tabs=Tst0}=St) -> Tst1 = upd_tstruct(N, fun (Tab) -> Tab#table{meta=M} end, Tst0), St#luerl{tabs=Tst1}; set_metatable(#usdref{i=N}, M, #luerl{usds=Ust0}=St) -> Ust1 = upd_tstruct(N, fun (Ud) -> Ud#userdata{meta=M} end, Ust0), St#luerl{usds=Ust1}; set_metatable(nil, M, #luerl{meta=Meta0}=St) -> Meta1 = Meta0#meta{nil=M}, St#luerl{meta=Meta1}; set_metatable(B, M, #luerl{meta=Meta0}=St) when is_boolean(B) -> Meta1 = Meta0#meta{boolean=M}, St#luerl{meta=Meta1}; set_metatable(N, M, #luerl{meta=Meta0}=St) when is_number(N) -> Meta1 = Meta0#meta{number=M}, St#luerl{meta=Meta1}; set_metatable(B, M, #luerl{meta=Meta0}=St) when is_binary(B) -> Meta1 = Meta0#meta{string=M}, St#luerl{meta=Meta1}; set_metatable(_, _, St) -> %Do nothing for the rest St. %% alloc_environment(Size, State) -> {Fref,State} %% %% Allocate the environment in the environemnt table and return %% its eref. alloc_environment(Size, #luerl{envs=Est0}=St) -> Fr = erlang:make_tuple(Size, nil), {N,Est1} = alloc_tstruct(Fr, Est0), {#eref{i=N},St#luerl{envs=Est1}}. %% get_env_var(Eref, Index, State) -> Value. %% set_env_var(Eref, Index, Val, State) -> State. get_env_var(#eref{i=N}, Index, #luerl{envs=Etab}) -> element(Index, get_tstruct(N, Etab)). %% element(Index, ?GET_TABLE(N, Etab#tstruct.data)). set_env_var(#eref{i=N}, Index, Val, #luerl{envs=Est0}=St) -> Est1 = upd_tstruct(N, fun (Fr) -> setelement(Index, Fr, Val) end, Est0), St#luerl{envs=Est1}. %% 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{tabs=#tstruct{data=Tt0,free=Tf0}=Tab0, envs=#tstruct{data=Et0,free=Ef0}=Env0, usds=#tstruct{data=Ut0,free=Uf0}=Usd0, fncs=#tstruct{data=Ft0,free=Ff0}=Fnc0, g=G,stk=Stk,cs=Cs,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=[]}, GcE = #gct{t=Et0,s=[]}, GcU = #gct{t=Ut0,s=[]}, GcF = #gct{t=Ft0,s=[]}, {SeenT,SeenE,SeenU,SeenF} = mark(Root, [Cs], GcT, GcE, GcU, GcF), %% io:format("gc: ~p\n", [{SeenT,SeenF,SeenU}]), %% Free unseen tables and add freed to free list. {Tf1,Tt1} = filter_tables(SeenT, Tf0, Tt0), {Ef1,Et1} = filter_environment(SeenE, Ef0, Et0), {Uf1,Ut1} = filter_userdata(SeenU, Uf0, Ut0), {Ff1,Ft1} = filter_funcdefs(SeenF, Ff0, Ft0), Tab1 = Tab0#tstruct{data=Tt1,free=Tf1}, Env1 = Env0#tstruct{data=Et1,free=Ef1}, Usd1 = Usd0#tstruct{data=Ut1,free=Uf1}, Fnc1 = Fnc0#tstruct{data=Ft1,free=Ff1}, St#luerl{tabs=Tab1,envs=Env1,usds=Usd1,fncs=Fnc1}. %% mark(ToDo, MoreTodo, GcTabs, GcEnv, GcUserdata, GcFuncdefs) -> %% {SeenTabs,SeenFrames,SeenUserdata,SeenFuncdefs}. %% Scan over all live objects and mark seen tables by adding them to %% the seen list. mark([{in_table,_}=_T|Todo], More, GcT, GcE, GcU, GcF) -> %%io:format("gc: ~p\n", [_T]), mark(Todo, More, GcT, GcE, GcU, GcF); mark([#tref{i=T}|Todo], More, #gct{t=Tt,s=Ts0}=GcT, GcE, GcU, GcF) -> case ordsets:is_element(T, Ts0) of true -> %Already done mark(Todo, More, GcT, GcE, GcU, GcF); false -> %Mark it and add to todo Ts1 = ordsets:add_element(T, Ts0), #table{a=Arr,d=Dict,meta=Meta} = ?GET_TABLE(T, Tt), %% Have to be careful when adding 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=Ts1}, GcE, GcU, GcF) end; mark([#eref{i=F}|Todo], More, GcT, #gct{t=Et,s=Es0}=GcE, GcU, GcF) -> case ordsets:is_element(F, Es0) of true -> %Already done mark(Todo, More, GcT, GcE, GcU, GcF); false -> %Mark it and add to todo Es1 = ordsets:add_element(F, Es0), Ses = tuple_to_list(?GET_TABLE(F, Et)), mark(Todo, [Ses|More], GcT, GcE#gct{s=Es1}, GcU, GcF) end; mark([#usdref{i=U}|Todo], More, GcT, GcE, #gct{s=Us0}=GcU, GcF) -> case ordsets:is_element(U, Us0) of true -> %Already done mark(Todo, More, GcT, GcE, GcU, GcF); false -> Us1 = ordsets:add_element(U, Us0), mark(Todo, More, GcT, GcE, GcU#gct{s=Us1}, GcF) end; mark([#funref{i=F,env=Erefs}|ToDo], More, GcT, GcE, GcU, #gct{t=Ft0,s=Fs0}=GcF) -> case ordsets:is_element(F, Fs0) of true -> mark(ToDo, More, GcT, GcE, GcU, GcF); false -> Fs1 = ordsets:add_element(F, Fs0), Fdef = ?GET_TABLE(F, Ft0), %% And mark the function definition. mark([Fdef|ToDo], [Erefs|More], GcT, GcE, GcU, GcF#gct{s=Fs1}) end; mark([#lua_func{funrefs=Funrefs}|Todo], More, GcT, GcE, GcU, GcF) -> %% io:format("push funrefs ~p\n", [Funrefs]), mark(Todo, [Funrefs|More], GcT, GcE, GcU, GcF); %% The call stack. mark([#call_frame{func=Funref,lvs=Lvs,env=Env}|Todo], More0, GcT, GcE, GcU, GcF) -> %% io:format("cf ~p\n", [Funref]), More1 = [ tuple_to_list(Lv) || Lv <- Lvs, is_tuple(Lv) ] ++ [Env|More0], mark([Funref|Todo], More1, GcT, GcE, GcU, GcF); mark([#loop_frame{lvs=Lvs,stk=Stk,env=Env}|Todo], More0, GcT, GcE, GcU, GcF) -> More1 = [ tuple_to_list(Lv) || Lv <- Lvs, is_tuple(Lv) ] ++ [Stk,Env|More0], mark(Todo, More1, GcT, GcE, GcU, GcF); %% Specifically catch these as they would match table key-value pair. mark([#erl_func{}|Todo], More, GcT, GcE, GcU, GcF) -> mark(Todo, More, GcT, GcE, GcU, GcF); mark([#thread{}|Todo], More, GcT, GcE, GcU, GcF) -> mark(Todo, More, GcT, GcE, GcU, GcF); mark([#userdata{meta=Meta}|Todo], More, GcT, GcE, GcU, GcF) -> mark([Meta|Todo], More, GcT, GcE, GcU, GcF); mark([{K,V}|Todo], More, GcT, GcE, GcU, GcF) -> %Table key-value pair %% io:format("mt: ~p\n", [{K,V}]), mark([K,V|Todo], More, GcT, GcE, GcU, GcF); mark([_|Todo], More, GcT, GcE, GcU, GcF) -> %% Can ignore everything else. mark(Todo, More, GcT, GcE, GcU, GcF); mark([], [M|More], GcT, GcE, GcU, GcF) -> mark(M, More, GcT, GcE, GcU, GcF); mark([], [], #gct{s=St}, #gct{s=Se}, #gct{s=Su}, #gct{s=Sf}) -> {St,Se,Su,Sf}. %% filter_tables(Seen, Free, Tables) -> {Free,Tables}. %% filter_environment(Seen, Free, Frames) -> {Free,Frames}. %% filter_userdata(Seen, Free, Frames) -> {Free,Frames}. %% filter_funcdefs(Seen, Free, Frames) -> {Free,Frames}. %% Filter tables/frames/userdata/funcdefs and return updated free %% lists and tables/frames. filter_tables(Seen, Tf0, Tt0) -> %% Update the free list. 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_environment(Seen, Ef0, Et0) -> %% Update the free list. Ef1 = ?FOLD_TABLES(fun (K, _, Free) -> case ordsets:is_element(K, Seen) of true -> Free; false -> [K|Free] end end, Ef0, Et0), Et1 = ?FILTER_TABLES(fun (K, _) -> ordsets:is_element(K, Seen) end, Et0), {Ef1,Et1}. 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}. filter_funcdefs(Seen, Ff0, Ft0) -> %% Update the free list. Ff1 = ?FOLD_TABLES(fun (K, _, Free) -> case ordsets:is_element(K, Seen) of true -> Free; false -> [K|Free] end end, Ff0, Ft0), Ft1 = ?FILTER_TABLES(fun (K, _) -> ordsets:is_element(K, Seen) end, Ft0), {Ff1,Ft1}. luerl-1.0/src/luerl_comp_cg.erl0000644000232200023220000004470314066413134017162 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.3 compiler for Luerl. %% Does code generation in the compiler. In the generated function %% definitions annotations and when we generate the #current_line{} %% instruction we use the virtual filename the compiler has %% generated. This is either the default file name or an explicit one %% given with the {file,FileName} compiler option. -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]). -record(c_cg, {line, %Current line vfile=[] %Current virtual file }). %% chunk(Code, CompInfo) -> {ok,Code}. %% Return a list of instructions to define the chunk function. chunk(Code0, #cinfo{vfile=Vfile,opts=Opts}=_Ci) -> St0 = #c_cg{line=0,vfile=Vfile}, %Get the virtual filename {Code1,_} = functiondef(Code0, St0), luerl_comp:debug_print(Opts, "cg: ~p\n", [Code1]), {ok,Code1}. %% 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) -> %% We KNOW that the annotation is the second element. Line = luerl_anno:line(element(2, S0)), {CurLine,St1} = add_current_line(Line, St0), {S1,St2} = stmt(S0, nul, St1), %% io:format("ss1: ~p\n", [{Loc0,Free0,Used0}]), {Ss1,St3} = stmts(Ss0, St2), {CurLine ++ S1 ++ Ss1,St3}; stmts([], St) -> {[],St}. %% add_current_line(Line, State) -> {CurLine,State}. %% Return currentline instruction and update state if new line. add_current_line(Line, #c_cg{line=Line}=St) -> {[],St}; add_current_line(Line, #c_cg{vfile=Vfile}=St) -> {[?CURRENT_LINE(Line, Vfile)],St#c_cg{line=Line}}. %% 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{vars=Vs,exps=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} = assign_prefixexp(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, St1), {Iv,St3} = assign_prefixexp(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} = assign_prefixexp(V, St2), {Ie ++ Ias ++ Iv,St3}; assign_loop([], Es, St) -> assign_loop_exp(Es, St). %% assign_loop_var(Vars, State) -> {Iassigns,State}. %% Extract necessary number of values from value list on stack. Pad %% with nil. assign_loop_var(Vs, St) -> assign_loop_var(Vs, 1, St). assign_loop_var([V|Vs], Vc, St0) -> {Ias,St1} = assign_loop_var(Vs, Vc+1, St0), {Iv,St2} = assign_prefixexp(V, St1), {Ias ++ Iv,St2}; assign_loop_var([], Vc, St) -> {[?PUSH_VALS(Vc)],St}. %% assign_loop_exp(Exprs, State) -> {Instrs,State}. %% Evaluate remaining expressions and pop the values from the stack. 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}. %% assign_prefixexp(Expr, State) -> {Instrs,State}. %% assign_prefixexp_rest(Expr, State) -> {Instrs,State}. %% assign_prefixexp_element(Expr, State) -> {Instrs,State}. assign_prefixexp(#dot{exp=Exp,rest=Rest}, St0) -> {Ie,St1} = prefixexp_first(Exp, single, St0), {Ir,St2} = assign_prefixexp_rest(Rest, St1), {Ie ++ Ir,St2}; assign_prefixexp(V, St) -> {set_var(V),St}. assign_prefixexp_rest(#dot{exp=Exp,rest=Rest}, St0) -> {Ie,St1} = prefixexp_element(Exp, single, St0), {Ir,St2} = assign_prefixexp_rest(Rest, St1), {Ie ++ Ir,St2}; assign_prefixexp_rest(Exp, St) -> assign_prefixexp_element(Exp, St). assign_prefixexp_element(#key{key=#lit{val=K}}, St) -> {[?SET_LIT_KEY(K)],St}; %[?PUSH_LIT(K),?SET_KEY] assign_prefixexp_element(#key{key=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{exps=Es}, St0) -> {Ies,St1} = explist(Es, multiple, St0), {Ies ++ [?RETURN(length(Es))],St1}. %% block_stmt(Block, State) -> {BlockIs,State}. block_stmt(#block_stmt{body=Ss,lsz=Lsz,esz=Esz}, St0) -> {Iss,St1} = stmts(Ss, St0), {[?BLOCK_OPEN(Lsz, Esz)] ++ Iss ++ [?BLOCK_CLOSE],St1}. %% do_block(Block, Prefix, Postfix, State) -> {Block,State}. %% do_block(Block, State) -> {Block,State}. %% Do_block never returns external new variables. Fits into stmt(). do_block(Block, St) -> do_block(Block, [], [], St). do_block(#block{body=Ss,lsz=Lsz,esz=Esz}, Pre, Post, St0) -> {Iss,St1} = stmts(Ss, St0), {[?BLOCK_OPEN(Lsz, Esz)] ++ Pre ++ Iss ++ Post ++ [?BLOCK_CLOSE],St1}. %% while_stmt(While, State) -> {WhileIs,State}. while_stmt(#while_stmt{exp=E,body=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{body=B}, St0) -> {Ib,St1} = do_block(B, St0), {[?REPEAT(Ib)],St1}. %% if_stmt(If, State) -> {IfIs,State}. %% We generate code which "steps down" the sequence of %% test-block. This means more nested calls but simpler emulator %% code. if_stmt(#if_stmt{tests=Ts,else=E}, St) -> if_tests(Ts, E, St). if_tests([{E,B}], #block{body=[]}, St0) -> Line = luerl_anno:line(element(2, E)), {CurLine,St1} = add_current_line(Line, St0), {Ie,St2} = exp(E, single, St1), {Ib,St3} = do_block(B, St2), {CurLine ++ Ie ++ [?IF_TRUE(Ib)],St3}; if_tests([{E,B}|Ts], Else, St0) -> Line = luerl_anno:line(element(2, E)), {CurLine,St1} = add_current_line(Line, St0), {Ie,St2} = exp(E, single, St1), {Ib,St3} = do_block(B, St2), {Its,St4} = if_tests(Ts, Else, St3), {CurLine ++ Ie ++ [?IF(Ib, Its)],St4}; if_tests([], Else, St0) -> {Ielse,St1} = do_block(Else, St0), {Ielse,St1}. %% numfor_stmt(For, State) -> {ForIs,State}. numfor_stmt(#nfor_stmt{var=V,init=I,limit=L,step=S,body=B}, St0) -> {Ies,St1} = explist([I,L,S], single, St0), {Ib,St2} = do_block(B, set_var(V), [], St1), {Ies ++ [?NFOR(V, Ib)],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}. %% Evaluate the explist to return the generator function, data and %% initial value. The handling of setting the pushing and setting the %% vars in the block come from assign_local_loop. genfor_stmt(Gfor, St) -> genfor_stmt_1(Gfor, St). genfor_stmt_1(#gfor_stmt{vars=Vs,gens=Gs,body=B}, St0) -> {Igs,St1} = explist(Gs, multiple, St0), {Ias,St2} = assign_local_loop_var(Vs, 0, St1), {Ib,St3} = do_block(B, Ias, [], St2), {Igs ++ [?POP_VALS(length(Gs))] ++ [?GFOR(Vs, Ib)],St3}. %% local_assign_stmt(Local, State) -> {Ilocal,State}. %% We must evaluate all expressions, even the unneeded ones. %% Have two versions, run both and see that we get the same result. local_assign_stmt(#local_assign_stmt{vars=Vs,exps=Es}, St) -> R = assign_local_test(Vs, Es, St), R = assign_local(Vs, Es, St). assign_local([V|Vs], [], St0) -> {Ias,St1} = assign_local_loop_var(Vs, St0), {[?PUSH_LIT([])] ++ Ias ++ set_var(V),St1}; assign_local(Vs, Es, St) -> assign_local_loop(Vs, Es, St). assign_local_test([V|Vs], [], St0) -> {Ias,St1} = assign_loop_var(Vs, St0), {[?PUSH_LIT([])] ++ Ias ++ set_var(V),St1}; assign_local_test(Vs, Es, St) -> assign_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, 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(Vars, State) -> {Iassigns,State}. %% Extract necessary number of values from value list on stack. Pad %% with nil. assign_local_loop_var(Vs, St) -> assign_local_loop_var(Vs, 1, 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(Exprs, State) -> {Instrs,State}. %% Evaluate remaining expressions and pop the values from the stack. 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{var=V,func=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{val=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',args=[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',args=[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,args=As}, S, St0) -> {Ias,St1} = explist(As, single, St0), Iop = Ias ++ [?OP(Op,length(As))], {multiple_values(S, Iop),St1}; exp(#tabcon{fields=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{exp=Exp,rest=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{exp=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{exp=Exp,rest=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{key=#lit{val=K}}, S, St) -> {multiple_values(S, [?GET_LIT_KEY(K)]),St}; prefixexp_element(#key{key=E}, S, St0) -> {Ie,St1} = exp(E, single, St0), {Ie ++ multiple_values(S, [?GET_KEY]),St1}; %% prefixexp_element(#fcall{args=[]}, S, St) -> %% Ifs = [?FCALL(0)], %% {single_value(S, Ifs),St}; %Function call returns list %% prefixexp_element(#fcall{args=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(#fcall{args=As}, S, St0) -> {Ias,St1} = explist(As, multiple, St0), Ifs = Ias ++ [?POP_ARGS(length(As)),?FCALL], {single_value(S, Ifs),St1}; %Function call returns list %% prefixexp_element(#mcall{meth=#lit{val=K},args=[]}, S, St) -> %% Ims = [?MCALL(K, 0)], %% {single_value(S, Ims),St}; %Method call returns list %% prefixexp_element(#mcall{meth=#lit{val=K},args=As}, S, St0) -> %% {Ias,St1} = explist(As, multiple, St0), %% Ims = Ias ++ [?MCALL(K, length(As))], %% {single_value(S, Ims),St1}. %Method call returns list prefixexp_element(#mcall{meth=#lit{val=K},args=As}, S, St0) -> {Ias,St1} = explist(As, multiple, St0), Ims = Ias ++ [?POP_ARGS(length(As)),?MCALL(K)], {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. Set %% the local current line to 0 to get correct line numbers inside the %% function. Reset to the original afterwards. functiondef(#fdef{l=Anno0,pars=Ps0,body=Ss,lsz=Lsz,esz=Esz}, #c_cg{line=Line,vfile=Vfile}=St0) -> St1 = St0#c_cg{line=0}, %Set current line to 0 %% Set the functions file annotation to the virtual file. Anno1 = luerl_anno:set(file, Vfile, Anno0), Ps1 = func_pars(Ps0), {Iss,St2} = stmts(Ss, St1), Iss1 = [?PUSH_ARGS(Ps1)] ++ gen_store(Ps1, Iss ++ [?RETURN(0)]), {[?PUSH_FDEF(Anno1,Lsz,Esz,Ps1,Iss1)],St2#c_cg{line=Line}}. 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 %% Experiments testing case where we push the args onto the stack and %% have explicit instructions which pop them ans store them in the LVs %% and Upvs. gen_store([V|Vs], Is) when V > 0 -> gen_store(Vs, [?STORE_LVAR(1, V)|Is]); gen_store([V|Vs], Is) when V < 0 -> gen_store(Vs, [?STORE_EVAR(1, -V)|Is]); gen_store([], Is) -> Is; gen_store(V, Is) when V > 0 -> [?STORE_LVAR(1, V)|Is]; gen_store(V, Is) when V < 0 -> [?STORE_LVAR(1, -V)|Is]. %% 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, St0), {Its,Fc,I,St1}. tc_fields([#efield{val=V}], I0, St0) -> I1 = I0 + 1, %Index of next element {Iv,St1} = exp(V, multiple, St0), {Iv,0,I1,St1}; tc_fields([#efield{val=V}|Fs], I0, St0) -> I1 = I0 + 1, %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{key=K,val=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,St}. luerl-1.0/src/luerl_lib_table.erl0000644000232200023220000004634314066413134017472 0ustar debalancedebalance%% Copyright (c) 2013-2020 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_heap: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{}=Tref|As], St) -> #table{a=Arr,d=Dict} = luerl_heap:get_table(Tref, St), case luerl_lib:conv_list(concat_args(As), [lua_string,lua_integer,lua_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, Sep, I, St) -> #table{a=Arr,d=Dict} = luerl_heap:get_table(Tref, St), J = length_loop(Arr), do_concat(Arr, Dict, Sep, I, J). concat(Tref, Sep, I, J, St) -> #table{a=Arr,d=Dict} = luerl_heap:get_table(Tref, St), 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:arg_to_list(V) of error -> throw({error,{illegal_value,concat,V}}); S -> [S|concat_tab(Arr, Dict, N+1, J)] end; error -> throw({error,{illegal_value,concat,nil}}) end. concat_arr(_, N, J) when N > J -> []; concat_arr(Arr, N, J) -> V = array:get(N, Arr), case luerl_lib:arg_to_list(V) of error -> throw({error,{illegal_value,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,V], St) when ?IS_TREF(Tref) -> #table{a=Arr0} = T = luerl_heap:get_table(Tref, St), Arr1 = do_insert_last(Arr0, V), {[],luerl_heap:set_table(Tref, T#table{a=Arr1}, St)}; insert([Tref,P0,V]=As, St) when ?IS_TREF(Tref) -> #table{a=Arr0} = T = luerl_heap:get_table(Tref, St), Size = length_loop(Arr0), case luerl_lib:arg_to_integer(P0) of P1 when P1 >=1, P1 =< Size+1 -> Arr1 = do_insert(Arr0, P1, V), {[],luerl_heap:set_table(Tref, T#table{a=Arr1}, St)}; _ -> 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], St) when ?IS_TREF(Tref) -> #table{a=Arr0,d=Dict0} = T = luerl_heap:get_table(Tref, St), {Ret,Arr1,Dict1} = do_remove_last(Arr0, Dict0), {Ret,luerl_heap:set_table(Tref, T#table{a=Arr1,d=Dict1}, St)}; remove([Tref,P0|_]=As, St) when ?IS_TREF(Tref) -> #table{a=Arr0,d=Dict0} = T = luerl_heap:get_table(Tref, St), case luerl_lib:arg_to_integer(P0) of P1 when P1 =/= nil -> case do_remove(Arr0, Dict0, P1) of {Ret,Arr1,Dict1} -> {Ret, luerl_heap:set_table(Tref, T#table{a=Arr1,d=Dict1}, St)}; 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), %Indexes are integers! {Tab,St1} = luerl_heap: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{}=Tref|As], St) -> #table{a=Arr,d=Dict} = luerl_heap:get_table(Tref, St), case luerl_lib:args_to_integers(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}; error -> %Not numbers badarg_error(unpack, [Tref|As], St) 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)]. %% length(Table, State) -> {Length,State}. %% raw_length(Table, State) -> Length. %% 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_heap:get_metamethod(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, St) -> #table{a=Arr} = luerl_heap:get_table(Tref, St), 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], St0) when ?IS_TREF(Tref) -> Comp = fun (A, B, St) -> lt_comp(A, B, St) end, St1 = do_sort(Comp, St0, Tref), {[],St1}; sort([Tref,Func|_], St0) when ?IS_TREF(Tref) -> Comp = fun (A, B, St) -> luerl_emul:functioncall(Func, [A,B], St) end, St1 = do_sort(Comp, St0, Tref), {[],St1}; sort(As, St) -> badarg_error(sort, As, St). do_sort(Comp, St0, Tref) -> #table{a=Arr0} = T = luerl_heap:get_table(Tref, St0), 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}]), luerl_heap:set_table(Tref, T#table{a=Arr2}, St1) 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_heap:get_metamethod(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-1.0/src/luerl_comp.erl0000644000232200023220000002356514066413134016514 0ustar debalancedebalance%% Copyright (c) 2013-2019 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.3 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,foreach/2]). -include_lib("kernel/include/file.hrl"). -include("luerl.hrl"). -include("luerl_comp.hrl"). %% The main Lua compiler state. -record(luacomp, {base="", %Base name ldir="", %Lua file dir lfile="", %Lua file odir=".", %Output directory opts=[], %User options code=none, %Code after last pass. cinfo=none, %Common compiler info errors=[], warnings=[] }). -define(NOFILE, "-no-file-"). %% file(Name) -> %% {ok,Chunk} | {error,Error,Warnings} | error}. %% file(Name, Options) -> %% {ok,Chunk} | {error,Error,Warnings} | error}. file(Name) -> file(Name, [verbose,report]). file(Name, Opts) -> St0 = #luacomp{opts=Opts}, St1 = filenames(Name, St0), do_compile(file_passes(), St1). %% string(String) -> %% {ok,Chunk} | {error,Error,Warnings} | error}. %% string(String, Options) -> %% {ok,Chunk} | {error,Error,Warnings} | error}. 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 = #luacomp{opts=Opts,code=Str}, St1 = filenames(?NOFILE, St0), do_compile(list_passes(), St1). %% forms(Forms) -> %% {ok,Chunk} | {error,Error,Warnings} | error}. %% forms(Forms, Options) -> %% {ok,Chunk} | {error,Error,Warnings} | error}. forms(Forms) -> forms(Forms, [verbose,report]). forms(Forms, Opts) -> St0 = #luacomp{opts=Opts,code=Forms}, St1 = filenames(?NOFILE, St0), do_compile(forms_passes(), St1). do_compile(Ps, St0) -> %% The compiler state already contains the filenames. Cinfo = compiler_info(St0), %The compiler info St1 = St0#luacomp{cinfo=Cinfo}, case do_passes(Ps, St1) of {ok,St2} -> do_ok_return(St2); {error, St2} -> do_error_return(St2) end. %% filenames(File, State) -> State. %% The default output dir is the current directory unless an %% explicit one has been given in the options. filenames(?NOFILE, St) -> St#luacomp{lfile=?NOFILE}; filenames(File, St) -> Suffix = ".lua", %% Test for explicit outdir. Odir = prop(outdir, St#luacomp.opts, "."), Ldir = filename:dirname(File), Base = filename:basename(File, Suffix), Lfile = luafile(Ldir, Base, Suffix), St#luacomp{base=Base, ldir=Ldir, lfile=Lfile, odir=Odir}. luafile(".", Base, Suffix) -> Base ++ Suffix; luafile(Dir, Base, Suffix) -> filename:join(Dir, Base ++ Suffix). %% prop(Key, PropList, Default) -> Value | Default. %% Find Key, Val from PropList else Default. prop(Key, [{Key,Val}|_], _Def) -> Val; prop(Key, [_|Plist], Def) -> prop(Key, Plist, Def); prop(_Key, [], Def) -> Def. %% compiler_info(State) -> CompInfo. %% Initialse the #cinfo record passed into all compiler passes. compiler_info(#luacomp{lfile=F,opts=Opts}) -> %% The file option may get a binary so we are helpful. Vfile = iolist_to_binary(prop(file, Opts, F)), #cinfo{lfile=F,vfile=Vfile,opts=Opts}. %% file_passes() -> [Pass]. %% list_passes() -> [Pass]. %% forms_passes() -> [Pass]. %% Build list of passes. 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_init_comp/1}, {do,fun do_comp_normalise/1}, {when_flag,to_norm,{done,fun(St) -> {ok,St} end}}, {do,fun do_comp_lint/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(Passes, State) -> {ok,State} | {error,Reason}. %% Interpret the list of commands in a pass. %% %% Commands can be one of: %% %% {when_flag,Flag,Cmd} %% {unless_flag,Flag,Cmd} %% {do,Fun} %% {done,PrintFun,Ext} 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#luacomp.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#luacomp.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_init_comp(State) -> {ok,State} | {error,State}. %% do_comp_normalise(State) -> {ok,State} | {error,State}. %% do_comp_lint(State) -> {ok,State} | {error,State}. %% do_comp_vars(State) -> {ok,State} | {error,State}. %% do_comp_env(State) -> {ok,State} | {error,State}. %% do_comp_cg(State) -> {ok,State} | {error,State}. %% do_comp_peep(State) -> {ok,State} | {error,State}. %% The actual compiler passes. do_read_file(#luacomp{lfile=Name,opts=Opts}=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,_} -> debug_print(Opts, "scan: ~p\n", [Ts]), {ok,St#luacomp{code=Ts}}; {error,E,L} -> {error,St#luacomp{errors=[{L,io,E}]}} end, file:close(F), Ret; {error,E} -> {error,St#luacomp{errors=[{none,file,E}]}} end. do_scan(#luacomp{code=Str,opts=Opts}=St) -> case luerl_scan:string(Str) of {ok,Ts,_} -> debug_print(Opts, "scan: ~p\n", [Ts]), {ok,St#luacomp{code=Ts}}; {error,E,_} -> {error,St#luacomp{errors=[E]}} end. do_parse(#luacomp{code=Ts,opts=Opts}=St) -> case luerl_parse:chunk(Ts) of {ok,Chunk} -> debug_print(Opts, "parse: ~p\n", [Chunk]), {ok,St#luacomp{code=Chunk}}; {error,E} -> {error,St#luacomp{errors=[E]}} end. do_init_comp(#luacomp{}=St) -> %% Nothing to do here now. {ok,St}. do_comp_normalise(#luacomp{code=Code0,cinfo=Cinfo}=St) -> {ok,Code1} = luerl_comp_normalise:chunk(Code0, Cinfo), {ok,St#luacomp{code=Code1}}. do_comp_lint(#luacomp{code=Code,cinfo=Cinfo}=St) -> case luerl_comp_lint:chunk(Code, Cinfo) of {ok,Ws} -> {ok,St#luacomp{warnings=Ws}}; {error,Es,Ws} -> {error,St#luacomp{errors=Es,warnings=Ws}} end. do_comp_vars(#luacomp{code=Code0,cinfo=Cinfo}=St) -> {ok,Code1} = luerl_comp_vars:chunk(Code0, Cinfo), {ok,St#luacomp{code=Code1}}. %% do_comp_locf(#luacomp{code=Code0,cinfo=Cinfo}=St) -> %% case luerl_comp_locf:chunk(Code0, Cinfo) of %% {ok,Code1} -> {ok,St#luacomp{code=Code1}}; %% {ok,Code1,Ws} -> {ok,St#luacomp{code=Code1,warnings=Ws}}; %% {error,Es} -> {error,St#luacomp{errors=Es}} %% end. do_comp_env(#luacomp{code=Code0,cinfo=Cinfo}=St) -> {ok,Code1} = luerl_comp_env:chunk(Code0, Cinfo), {ok,St#luacomp{code=Code1}}. do_code_gen(#luacomp{code=Code0,cinfo=Cinfo}=St) -> {ok,Code1} = luerl_comp_cg:chunk(Code0, Cinfo), {ok,St#luacomp{code=Code1}}. do_peep_op(#luacomp{code=Code0,cinfo=Cinfo}=St) -> {ok,Code1} = luerl_comp_peep:chunk(Code0, Cinfo), {ok,St#luacomp{code=Code1}}. do_ok_return(#luacomp{lfile=Lfile,opts=Opts,code=C,warnings=Ws}) -> Report = lists:member(report, Opts), ?IF(Report, list_warnings(Lfile, Ws), ok), {ok,C}. do_error_return(#luacomp{lfile=Lfile,opts=Opts,errors=Es,warnings=Ws}) -> Report = lists:member(report, Opts), Return = lists:member(return, Opts), ?IF(Report, begin list_errors(Lfile, Es), list_warnings(Lfile, Ws) end, ok), ?IF(Return, {error,Es,Ws}, error). debug_print(Opts, Format, Args) -> ?DEBUG_PRINT(Format, Args, Opts). list_warnings(F, Ws) -> foreach(fun ({Line,Mod,Warn}) -> Cs = Mod:format_error(Warn), io:format("~s:~w: Warning: ~s\n", [F,Line,Cs]); ({Mod,Warn}) -> Cs = Mod:format_error(Warn), io:format("~s: Warning: ~s\n", [F,Cs]) end, Ws). list_errors(F, Es) -> foreach(fun ({Line,Mod,Error}) -> Cs = Mod:format_error(Error), io:format("~s:~w: ~s\n", [F,Line,Cs]); ({Mod,Error}) -> Cs = Mod:format_error(Error), io:format("~s: ~s\n", [F,Cs]) end, Es). luerl-1.0/src/luerl_lib_string_format.erl0000644000232200023220000002221014066413134021244 0ustar debalancedebalance%% Copyright (c) 2020 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:arg_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}; %% Integer formats. build({$c,Fl,F,_}, [A|As], St) -> N = luerl_lib:arg_to_integer(A), C = N band 255, {adjust_str([C], Fl, F),As,St}; build({$i,Fl,F,P}, [A|As], St) -> I = luerl_lib:arg_to_integer(A), {format_decimal(Fl, F, P, I),As,St}; build({$d,Fl,F,P}, [A|As], St) -> I = luerl_lib:arg_to_integer(A), {format_decimal(Fl, F, P, I),As,St}; build({$o,Fl,F,P}, [A|As], St) -> I = luerl_lib:arg_to_integer(A), {format_octal(Fl, F, P, I),As,St}; build({$x,Fl,F,P}, [A|As], St) -> I = luerl_lib:arg_to_integer(A), {format_hex(Fl, F, P, I),As,St}; build({$X,Fl,F,P}, [A|As], St) -> I = luerl_lib:arg_to_integer(A), {format_HEX(Fl, F, P, I),As,St}; %% Float formats. build({$e,Fl,F,P}, [A|As], St) -> N = luerl_lib:arg_to_number(A), {e_float(Fl, F, P, N),As,St}; build({$E,Fl,F,P}, [A|As], St) -> N = luerl_lib:arg_to_number(A), {e_float(Fl, F, P, N),As,St}; build({$f,Fl,F,P}, [A|As], St) -> N = luerl_lib:arg_to_number(A), {f_float(Fl, F, P, N),As,St}; build({$F,Fl,F,P}, [A|As], St) -> N = luerl_lib:arg_to_number(A), {f_float(Fl, F, P, N),As,St}; build({$g,Fl,F,P}, [A|As], St) -> N = luerl_lib:arg_to_number(A), {g_float(Fl, F, P, N),As,St}; build({$G,Fl,F,P}, [A|As], St) -> N = luerl_lib:arg_to_number(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", [abs(N)])), format_integer(Fl, F, P, N, Str). format_HEX(Fl, F, P, N) -> Str = lists:flatten(io_lib:fwrite("~.16B", [abs(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-1.0/src/luerl_lib_os.erl0000644000232200023220000002003314066413134017010 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 %% For `remove/2'. -include_lib("kernel/include/file.hrl"). %% For `tmpname/2' in `luerl_lib_os'. -define(TMPNAM_MAXTRIES, 100). -define(TMPNAM_TEMPLATE(S), "/tmp/lua_" ++ S). install(St) -> luerl_heap: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}}, {<<"execute">>,#erl_func{code=fun execute/2}}, {<<"exit">>,#erl_func{code=fun lua_exit/2}}, {<<"getenv">>,#erl_func{code=fun getenv/2}}, {<<"remove">>,#erl_func{code=fun remove/2}}, {<<"rename">>,#erl_func{code=fun rename/2}}, {<<"time">>,#erl_func{code=fun time/2}}, {<<"tmpname">>,#erl_func{code=fun tmpname/2}}]. getenv([<<>>|_], St) -> {[nil],St}; getenv([A|_], St) when is_binary(A) ; is_number(A) -> case os:getenv(luerl_lib:arg_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). %% execute([Command|_], State) -> {[Ret,Type,Stat],State}. %% Execute a command and get the return code. We cannot yet properly %% handle if our command terminated with a signal. execute([], St) -> {true,St}; %We have a shell execute([A|_], St) -> case luerl_lib:arg_to_string(A) of S when is_binary(S) -> Opts = [{arg0,"sh"},{args,["-c", S]}, hide,in,eof,exit_status,use_stdio,stderr_to_stdout], P = open_port({spawn_executable,"/bin/sh"}, Opts), N = execute_handle(P), Ret = if N =:= 0 -> true; %Success true -> nil %Error end, {[Ret,<<"exit">>,N],St}; error -> badarg_error(execute, [A], St) end; execute(As, St) -> badarg_error(execute, As, St). execute_handle(P) -> receive {P,{data,D}} -> %% Print stdout/stderr like Lua does. io:put_chars(D), execute_handle(P); {P, {exit_status,N}} -> %% Wait for the eof then close the port. receive {P, eof} -> port_close(P), N end end. %% exit([ExitCode,CloseState|_], State) -> nil. %% Exit the host program. If ExitCode is true, the return code is 0; %% if ExitCode is false, the return code is 1; if ExitCode is a number, the %% return code is this number. The default value for ExitCode is true. %% NOT IMPLEMENTED: %% If the optional second argument CloseState is true, it will close the Lua %% state before exiting. lua_exit([], St) -> lua_exit([true,false], St); lua_exit([C], St) -> lua_exit([C,false], St); lua_exit([Co0|_], St) -> %% lua_exit([Co0,Cl0], St) -> Co1 = case luerl_lib:arg_to_number(Co0) of X when is_integer(X) -> X; error -> case Co0 of false -> 1; true -> 0; error -> badarg_error(exit, [Co0], St) end end, %% Uncomment this if you need the second argument to determine whether to %% destroy the Lua state or not. %% Cl1 = case Cl0 of %% true -> true; %% false -> false; %% _ -> badarg_error(exit, [Cl0], St) %% end, erlang:halt(Co1). %% tmpname([], State) %% Faithfully recreates `tmpnam'(3) in lack of a NIF. tmpname([_|_], St) -> %% Discard extra arguments. tmpname([], St); tmpname([], St) -> Out = tmpname_try(randchar(6, []), 0), %% We make an empty file the programmer will have to close themselves. %% This is done for security reasons. file:write_file(Out, ""), {[list_to_binary(Out)],St}. %% Support function for `tmpname/2' - generates a random filename following a %% template. tmpname_try(_, ?TMPNAM_MAXTRIES) -> %% Exhausted... false; tmpname_try(A, N) -> case file:read_file_info(?TMPNAM_TEMPLATE(A)) of {error,enoent} -> ?TMPNAM_TEMPLATE(A); %% Success, at last! _ -> tmpname_try(randchar(6, []), N+1) end. %% Support function for `tmpname_try/2'. randchar(0, A) -> A; randchar(N, A) -> randchar(N-1, [rand:uniform(26)+96|A]). %% rename([Source,Destination|_], State) %% Renames the file or directory `Source' to `Destination'. If this function %% fails, it returns `nil', plus a string describing the error code and the %% error code. Otherwise, it returns `true'. rename([S,D|_], St) -> case {luerl_lib:arg_to_string(S), luerl_lib:arg_to_string(D)} of {S1,D1} when is_binary(S1) , is_binary(D1) -> case file:rename(S1,D1) of ok -> {[true],St}; {error,R} -> #{errno := En, errstr := Er} = luerl_util:errname_info(R), {[nil,Er,En],St} end; %% These are for throwing a `badmatch' error on the correct argument. {S1,D1} when not is_binary(S1) , not is_binary(D1) -> badarg_error(rename, [S1,D1], St); {S1,D1} when not is_binary(S1) , is_binary(D1) -> badarg_error(rename, [S1], St); {S1,D1} when is_binary(S1) , not is_binary(D1) -> badarg_error(rename, [D1], St) end. %% remove([Path|_], State) %% Deletes the file (or empty directory) with the given `Path'. If this %% function fails, it returns `nil' plus a string describing the error, and the %% error code. Otherwise, it returns `true'. remove([A|_], St) -> case luerl_lib:arg_to_string(A) of A1 when is_binary(A1) -> %% Emulate the underlying call to `remove(3)'. case file:read_file_info(A1) of {ok,#file_info{type=T}} when T == directory ; T == regular -> %% Select the corresponding function. Op = if T == directory -> del_dir; true -> delete end, case file:Op(A) of ok -> {[true],St}; {error,R} -> {remove_geterr(R, A), St} end; {error,R} -> %% Something went wrong. {remove_geterr(R, A), St} end; error -> badarg_error(remove, [A], St) end. %% Utility function to get a preformatted list to return from `remove/2'. remove_geterr(R, F) -> F1 = binary_to_list(F), #{errno := En, errstr := Er} = luerl_util:errname_info(R), [nil, list_to_binary(F1 ++ ": " ++ Er), En]. %% 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-1.0/src/ttdict.erl0000644000232200023220000005542314066413134015644 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-1.0/src/luerl_lib_string.erl0000644000232200023220000005737414066413134017717 0ustar debalancedebalance%% Copyright (c) 2013-2020 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_heap:alloc_table(table(), St0), {M,St2} = luerl_heap: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,lua_integer,lua_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) -> [ N || N <- binary_to_list(S, I, J) ]. %% char(...) -> String %% Return string of the numerical arguments. char([nil], St) -> {[<<>>],St}; char(As, St) -> case luerl_lib:args_to_integers(As) of error -> badarg_error(char, As, St); Bs -> String = list_to_binary(Bs), {[String],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,lua_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} -> [Fs+1,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 [P1,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,lua_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),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:arg_to_list(Repl) of error -> {[],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:arg_to_string(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:arg_to_string(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:arg_to_string(Val) of error -> match_cap(Ca, S); %Use original match Str -> Str end. %% len(String) -> Length. len([A|_], St) when is_binary(A) -> {[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, [erl_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,lua_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 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,lua_integer,lua_string]) of [S,I,Sep] -> if I > 0 -> {[iolist_to_binary([S|lists:duplicate(I-1, [Sep,S])])],St}; true -> {[<<>>],St} end; error -> %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:arg_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,lua_integer,lua_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:arg_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-1.0/examples/0000755000232200023220000000000014066413134014663 5ustar debalancedebalanceluerl-1.0/examples/minibench/0000755000232200023220000000000014066413134016617 5ustar debalancedebalanceluerl-1.0/examples/minibench/Makefile0000644000232200023220000000046514066413134020264 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-1.0/examples/minibench/minibench2.erl0000644000232200023220000001460014066413134021342 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, State2} = luerl:load("a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b; return c", luerl:init()), {T2,_State21} = timer:tc(fun() -> do_loop_state(I2, Chunk2, State2) 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, State3} = luerl:load("a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b; return c", 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, State5} = luerl:load("a = 7.33; b = 9000; c = (33 * a / b) ^ 15 * a + b; return c", 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", luerl:init()) || _ <- 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 do_loop(N, Chunk) when N > 0 -> luerl:do(Chunk, luerl:init()), 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-1.0/examples/minibench/minibench.erl0000644000232200023220000001054414066413134021263 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, State2} = luerl:load("return 1 + 1", luerl:init()), {T2,_State21} = timer:tc(fun() -> do_loop_state(I2, Chunk2, State2) 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", luerl:init()) || _ <- 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 do_loop(N, Chunk) when N > 0 -> luerl:do(Chunk, luerl:init()), 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-1.0/examples/Makefile0000644000232200023220000000024214066413134016321 0ustar debalancedebalanceSUBDIRS ?= hello all clean: @for subdir in $(SUBDIRS); do \ echo $(MAKE) -C $$subdir $@; \ $(MAKE) -C $$subdir $@; \ done .PHONY: all clean luerl-1.0/examples/hello/0000755000232200023220000000000014066413134015766 5ustar debalancedebalanceluerl-1.0/examples/hello/hello_table_new.erl0000644000232200023220000000222214066413134021613 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_new). -export([run/0]). run() -> LuaScript = <<"hello_table = { hello=\"world\" }; return hello_table">>, {ok, [_Table], Lua0} = luerl_new:do(LuaScript, luerl_new:init()), {ok,World, Lua1} = luerl_new:get_table_keys_dec([hello_table, hello], Lua0), {ok,_,Lua2} = luerl_new:set_table_keys_dec([hello_table, hello], there, Lua1), {ok,HelloDict,Lua3} = luerl_new:get_table_keys_dec([hello_table], Lua2), {ok,There, Lua4} = luerl_new:get_table_keys_dec([hello_table, hello], Lua3), io:format("(1) hello ~s ~s - ~p~n", [There, World, HelloDict]), {ok,_,Lua5} = luerl_new:set_table_keys([<<"hello_table">>, <<"goodbye">>], <<"bye">>, Lua4), {ok, Bye, Lua6} = luerl_new:get_table_keys([<<"hello_table">>, <<"goodbye">>], Lua5), {ok, HelloTab, _Lua7} = luerl_new:get_table_keys([<<"hello_table">>], Lua6), io:format("(2) ~s - ~p~n", [Bye, HelloTab]), done. luerl-1.0/examples/hello/hello2-3.lua0000644000232200023220000000031214066413134020012 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-1.0/examples/hello/hello2-8.lua0000644000232200023220000000025214066413134020022 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-1.0/examples/hello/hello_userdata.erl0000644000232200023220000000123414066413134021465 0ustar debalancedebalance%% File : hello_userdata.erl %% Purpose : Brief demonstration of Luerl userdata access. %% Use $ erlc hello_table.erl && erl -pa ../../ebin -s hello_table run -s init stop -noshell -module(hello_userdata). -export([run/0]). run() -> St0 = luerl:init(), U42 = {userdata,42}, %The original decoded data {Uref,St1} = luerl:encode(U42, St0), St2 = luerl:set_table1([<<"u1">>], Uref, St1), St3 = luerl:set_table1([<<"u2">>], Uref, St2), St4 = luerl_heap:set_userdata(Uref, 84, St3), U84 = {userdata,84}, %New decoded data {U84,St5} = luerl:get_table([<<"u1">>], St4), {U84,St6} = luerl:get_table([<<"u2">>], St5), St6. luerl-1.0/examples/hello/Makefile0000644000232200023220000000060314066413134017425 0ustar debalancedebalanceEXAMPLES = hello \ hello2 \ hello_table \ hello_table_new \ hello_userdata \ hello_userdata_new 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-1.0/examples/hello/hello_sandbox.erl0000644000232200023220000000321114066413134021310 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-1.0/examples/hello/hello2-4.lua0000644000232200023220000000023214066413134020014 0ustar debalancedebalance-- File : hello2-4.lua -- Purpose : Demonstration of Luerl interface. -- See : ./examples/hello/hello2.erl return "'(18b) Evidently, Mr. Watson.'"luerl-1.0/examples/hello/hello2-6.lua0000644000232200023220000000025314066413134020021 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-1.0/examples/hello/hello_table.erl0000644000232200023220000000173214066413134020747 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, luerl:init()), {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-1.0/examples/hello/hello2-2.lua0000644000232200023220000000020314066413134020010 0ustar debalancedebalance-- File : hello2-2.lua -- Purpose : Demonstration of Luerl interface. -- See : ./examples/hello/hello2.erl return 2137 * 42luerl-1.0/examples/hello/hello2-7.lua0000644000232200023220000000027014066413134020021 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-1.0/examples/hello/hello_userdata_new.erl0000644000232200023220000000146514066413134022344 0ustar debalancedebalance%% File : hello_userdata_new.erl %% Purpose : Brief demonstration of Luerl userdata access. %% Use $ erlc hello_table.erl && erl -pa ../../ebin -s hello_table run -s init stop -noshell -module(hello_userdata_new). -export([run/0]). run() -> St0 = luerl_new:init(), U42 = {userdata,42}, %The original decoded data {Uref,St1} = luerl_new:encode(U42, St0), {ok,_,St2} = luerl_new:set_table_keys([<<"u1">>], Uref, St1), {ok,_,St3} = luerl_new:set_table_keys([<<"u2">>], Uref, St2), St4 = luerl_heap:set_userdata(Uref, 84, St3), {ok,Uref,St5} = luerl_new:get_table_keys([<<"u1">>], St4), {ok,Uref,St6} = luerl_new:get_table_keys([<<"u2">>], St5), U84 = {userdata,84}, %New decoded data U84 = luerl_new:decode(Uref, St6), St6. luerl-1.0/examples/hello/hello.lua0000644000232200023220000000021614066413134017573 0ustar debalancedebalance-- File : hello.lua -- Purpose : Brief demonstration of Luerl basics - execution of a file. -- See : ./hello.erl print("Hello, File!")luerl-1.0/examples/hello/hello.erl0000644000232200023220000000107714066413134017602 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)!\")", luerl:init()), % execute a file luerl:dofile("./hello.lua", luerl:init()), % separately parse, then execute State0 = luerl:init(), {ok, Chunk, State1} = luerl:load("print(\"Hello, Chunk!\")", State0), {_Ret, _NewState} = luerl:do(Chunk, State1), done. luerl-1.0/examples/hello/hello2-10.lua0000644000232200023220000000021214066413134020067 0ustar debalancedebalance-- File : hello2-10.lua -- Purpose : Returning lua dicts -- See : ./examples/hello/hello2.erl return {1,2,{3,'Hello World!'}} luerl-1.0/examples/hello/hello2-1.lua0000644000232200023220000000022714066413134020015 0ustar debalancedebalance-- File : hello2-1.lua -- Purpose : Demonstration of Luerl interface. -- See : ./examples/hello/hello2.erl print("(6) Hello, File 'hello2-1'!")luerl-1.0/examples/hello/hello2-9.lua0000644000232200023220000000027414066413134020027 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-1.0/examples/hello/hello2.erl0000644000232200023220000001554214066413134017666 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"), St0A = luerl:init(), % execute a string luerl:eval("print(\"(1) Hello, Robert!\")", St0A), luerl:eval(<<"print(\"(2) Hello, Roberto!\")">>, St0A), luerl:do("print(\"(3) Hej, Robert!\")", St0A), luerl:do(<<"print(\"(4) Olà, Roberto!\")">>, St0A), % execute a string, get a result {ok,A} = luerl:eval("return 1 + 1", St0A), {ok,A} = luerl:eval(<<"return 1 + 1">>, St0A), io:format("(5) 1 + 1 = ~p!~n", [A]), % execute a file luerl:evalfile("./hello2-1.lua", St0A), luerl:dofile("./hello2-1.lua", St0A), % execute a file, get a result {ok,B} = luerl:evalfile("./hello2-2.lua", St0A), {B,_} = luerl:dofile("./hello2-2.lua", St0A), io:format("(7) 2137 * 42 = ~p?~n", [B]), % execute a standard function luerl:call_function([print], [<<"(8) Hello, standard print function!">>], St0A), luerl:call_function([print], [<<"(9) Hello, standard print function!">>], St0A), {Result1,_} = luerl:call_function([table,pack], [<<"a">>,<<"b">>,42], St0A), {Result1,_} = luerl:call_function([table,pack], [<<"a">>,<<"b">>,42], St0A), 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: ~ts~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: ~ts = ", [F]), luerl:do("print('(30) F: ' .. a)", State06), % separately parse, then execute {ok,Chunk11,_} = luerl:load("print(\"(31) Hello, \" .. a .. \"!\")", State06), {ok,Chunk11,State07} = luerl:load(<<"print(\"(31) Hello, \" .. a .. \"!\")">>, State06), luerl:eval(Chunk11,State07), luerl:do(Chunk11,State07), % separately parse, then execute a file. The file defines a function old() {ok,Chunk12,St7} = luerl:loadfile("./hello2-8.lua", State07), {ok,Result12} = luerl:eval(Chunk12, St7), {Result12,State07A} = luerl:do(Chunk12,St7), luerl:call_function([old],[],State07A), % separately parse, then execute, get a result {ok,Chunk13,St8} = luerl:load("a = '(30a)' .. a .. ' (this is Greek)'; return a", State07), {ok,Chunk13,_} = luerl:load(<<"a = '(30a)' .. a .. ' (this is Greek)'; return a">>, State07), {ok,Result07} = luerl:eval(Chunk13, St8), {Result07,State08} = luerl:do(Chunk13, St8), 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,St9} = luerl:loadfile("./hello2-9.lua", State08), {ok,Result14} = luerl:eval(Chunk14, St9), {Result14,State14} = luerl:do(Chunk14, St9), 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-1.0/examples/hello/hello2-5.lua0000644000232200023220000000024014066413134020014 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-1.0/examples/euler/0000755000232200023220000000000014066413134015777 5ustar debalancedebalanceluerl-1.0/examples/euler/problem_008.lua0000644000232200023220000000263714066413134020541 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-1.0/examples/euler/problem_002.lua0000644000232200023220000000073514066413134020530 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-1.0/examples/euler/euler.erl0000644000232200023220000000204614066413134017621 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 ~pus)~n", [File, Return, T]); {T, {ok, [Return]}} -> io:format("~s (expected ~p but got ~p in ~pus)~n", [File, Solution, Return, T]); {_, {error, Error, State}} -> io:format("luerl error: ~p~n", [{Error,State}]) end. luerl-1.0/examples/euler/Makefile0000644000232200023220000000044014066413134017435 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-1.0/examples/euler/problem_010.lua0000644000232200023220000000160414066413134020523 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-1.0/examples/euler/problem_004.lua0000644000232200023220000000121214066413134020521 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-1.0/examples/euler/problem_003.lua0000644000232200023220000000111114066413134020516 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-1.0/examples/euler/problem_001.lua0000644000232200023220000000051214066413134020520 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-1.0/examples/euler/problem_006.lua0000644000232200023220000000116714066413134020534 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-1.0/examples/euler/problem_007.lua0000644000232200023220000000147014066413134020532 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-1.0/examples/euler/problem_009.lua0000644000232200023220000000063514066413134020536 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-1.0/examples/euler/problem_005.lua0000644000232200023220000000210714066413134020526 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-1.0/examples/benchmark/0000755000232200023220000000000014066413134016615 5ustar debalancedebalanceluerl-1.0/examples/benchmark/util/0000755000232200023220000000000014066413134017572 5ustar debalancedebalanceluerl-1.0/examples/benchmark/util/extract_bench_keys.lua0000644000232200023220000000013014066413134024133 0ustar debalancedebalancelocal list = {} for key, func in pairs(bench) do list[#list+1] = key end return list luerl-1.0/examples/benchmark/Makefile0000644000232200023220000000044614066413134020261 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-1.0/examples/benchmark/benchmarks.erl0000644000232200023220000000312514066413134021437 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-1.0/examples/benchmark/suites/0000755000232200023220000000000014066413134020131 5ustar debalancedebalanceluerl-1.0/examples/benchmark/suites/factory.lua0000644000232200023220000000622614066413134022311 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-1.0/examples/benchmark/suites/mtvsclosure.lua0000644000232200023220000000106414066413134023223 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-1.0/examples/benchmark/suites/return.lua0000644000232200023220000000063114066413134022153 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-1.0/examples/benchmark/suites/callmap1.lua0000644000232200023220000000142114066413134022324 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-1.0/examples/benchmark/suites/vararg.lua0000644000232200023220000000223414066413134022117 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-1.0/examples/benchmark/suites/accum.lua0000644000232200023220000000516714066413134021735 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-1.0/examples/benchmark/suites/concat.lua0000644000232200023220000000175714066413134022115 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-1.0/examples/benchmark/suites/callmap10.lua0000644000232200023220000000146014066413134022407 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-1.0/examples/benchmark/suites/str_is_empty.lua0000644000232200023220000000110214066413134023347 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-1.0/examples/benchmark/suites/is_integer.lua0000644000232200023220000000300514066413134022762 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-1.0/examples/benchmark/suites/inf.lua0000644000232200023220000000047614066413134021417 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-1.0/examples/benchmark/suites/sort-simple.lua0000644000232200023220000000326614066413134023121 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-1.0/examples/benchmark/suites/tailcall.lua0000644000232200023220000000064714066413134022430 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-1.0/examples/benchmark/suites/nloop_simple.lua0000644000232200023220000000521614066413134023340 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-1.0/examples/benchmark/suites/COPYRIGHT0000644000232200023220000000264614066413134021434 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-1.0/examples/benchmark/suites/tclone.lua0000644000232200023220000001455414066413134022131 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-1.0/examples/benchmark/suites/selectvstable.lua0000644000232200023220000000106114066413134023472 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-1.0/examples/benchmark/suites/chaincall.lua0000644000232200023220000000173514066413134022560 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-1.0/examples/benchmark/suites/arguments.lua0000644000232200023220000001635114066413134022647 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-1.0/examples/benchmark/suites/elseif_large.lua0000644000232200023220000000265614066413134023266 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-1.0/examples/benchmark/suites/nloop.lua0000644000232200023220000000120014066413134021754 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-1.0/examples/benchmark/suites/get.lua0000644000232200023220000000164414066413134021420 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-1.0/examples/benchmark/suites/next_vs_pairs.lua0000644000232200023220000000057214066413134023524 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-1.0/include/0000755000232200023220000000000014066413134014470 5ustar debalancedebalanceluerl-1.0/include/luerl.hrl0000644000232200023220000001604014066413134016323 0ustar debalancedebalance%% Copyright (c) 2013-2019 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, {tabs, %Table table envs, %Environment table usds, %Userdata table fncs, %Function table g, %Global table %% stk=[], %Current stack cs=[], %Current call stack %% meta=[], %Data type metatables rand, %Random state tag, %Unique tag trace_func=none, %Trace function trace_data %Trace data }). %% Table structure. -record(tstruct, {data, %Data table/array free, %Index free list next %Next index }). %% Metatables for atomic datatypes. -record(meta, {nil=nil, boolean=nil, number=nil, string=nil }). %% Frames for the call stack. %% Call return frame -record(call_frame, {func,args, %Function, arguments lvs, %Local variables env, %Environment is=[],cont=[] %Instructions, continuation }). %% Loop break frame -record(loop_frame, {lvs, %Local variables stk, %Stack env, %Environment is=[],cont=[] %Instructions, continuation }). %% Current line -record(current_line, {line, %Line file %File name }). %% Data types. -record(tref, {i}). %Table reference, index -define(IS_TREF(T), is_record(T, tref)). -record(table, {a,d=[],meta=nil}). %Table type, array, dict, meta -record(eref, {i}). %Environment reference, index -define(IS_EREF(E), is_record(E, eref)). -record(usdref, {i}). %Userdata reference, index -define(IS_USDREF(U), is_record(U, usdref)). -record(userdata, {d,meta=nil}). %Userdata type, data and meta -record(thread, {}). %Thread type %% There are two function types, the Lua one, and the Erlang one. %% The environment with upvalues is defined when the function is %% referenced and can vary if the function is referenced many %% times. Hence it is in the reference not in the the definition. -record(funref, {i,env=[]}). %Function reference -define(IS_FUNREF(F), is_record(F, funref)). -record(lua_func,{anno=[], %Annotation funrefs=[], %Functions directly referenced lsz, %Local var size %% loc=not_used, %Local var block template esz, %Env var size %% env=not_used, %Local env block template pars, %Parameter types b}). %Code block -define(IS_LUAFUNC(F), is_record(F, lua_func)). -record(erl_func,{code}). %Erlang code (fun) -define(IS_ERLFUNC(F), is_record(F, erl_func)). %% Test if it a function, of either sort. -define(IS_FUNCTION(F), (?IS_FUNREF(F) orelse ?IS_ERLFUNC(F))). %% Testing for integers/integer floats or booleans. -define(IS_FLOAT_INT(N), (round(N) == N)). -define(IS_FLOAT_INT(N,I), ((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. %% -define(TS_USE_ARRAY, true). -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_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_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_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. %% Define CATCH to handle deprecated get_stacktrace/0 -ifdef(NEW_STACKTRACE). -define(CATCH(C, E, S), C:E:S ->). -else. -define(CATCH(C, E, S), C:E -> S = erlang:get_stacktrace(),). -endif. luerl-1.0/test/0000755000232200023220000000000014066413134014024 5ustar debalancedebalanceluerl-1.0/test/luerl_return_SUITE.erl0000644000232200023220000000404614066413134020227 0ustar debalancedebalance%% Copyright (c) 2019 Ferenc Boroczki %% %% 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_return_SUITE). -include_lib("common_test/include/ct.hrl"). -export([all/0, groups/0]). -export([simple_return/1, fun_return/1, variable_args/1, check_unicode/1]). all() -> [ {group, return} ]. groups() -> [ {return, [parallel], [simple_return, fun_return, variable_args, check_unicode]} ]. simple_return(Config) -> Tests = [ {"simple_return_1.lua", [1]}, {"simple_return_multi.lua", [1, <<"string 2">>, 3.4]} ], run_tests(Config, Tests). fun_return(Config) -> run_and_check(Config, "fun_return_multi.lua", [7, <<"str 1">>, 5.5, 11.0]). variable_args(Config) -> run_tests(Config, [ {"variable_args_1.lua", [99, 88, 77]}, {"variable_args_multi.lua", [9, <<"banana">>, 8]} ]). check_unicode(Config) -> St = run_and_check(Config, "check_unicode.lua", []), check_unicode_call_fun(<<"árvíztűrő tükörfúrógép"/utf8>>, 31, check_hun, St), check_unicode_call_fun(<<"λ"/utf8>>, 2, check_lambda, St), check_unicode_call_fun(<<9810/utf8>>, 3, check_aquarius, St). check_unicode_call_fun(Input, Length, LuaFun, St) -> {[Input, Input, true, Length, Length], _} = luerl:call_function([LuaFun], [Input], St). run_tests(Config, Tests) -> [run_and_check(Config, Script, Expected) || {Script, Expected} <- Tests]. run_and_check(Config, Script, Expected) -> DataDir = ?config(data_dir, Config), ScriptFile = DataDir ++ Script, {Result, St} = luerl:dofile(ScriptFile, luerl:init()), Expected = Result, St. luerl-1.0/test/luerl_return_SUITE_data/0000755000232200023220000000000014066413134020510 5ustar debalancedebalanceluerl-1.0/test/luerl_return_SUITE_data/simple_return_multi.lua0000644000232200023220000000003214066413134025310 0ustar debalancedebalancereturn 1, "string 2", 3.4 luerl-1.0/test/luerl_return_SUITE_data/simple_return_1.lua0000644000232200023220000000001114066413134024313 0ustar debalancedebalancereturn 1 luerl-1.0/test/luerl_return_SUITE_data/check_unicode.lua0000644000232200023220000000125014066413134023774 0ustar debalancedebalancefunction check_hun(erl_str) local lua_str = "árvíztűrő tükörfúrógép" return check_values(erl_str, lua_str, 31) end function check_lambda(erl_str) local lua_str = "λ" return check_values(erl_str, lua_str, 2) end function check_aquarius(erl_str) local lua_str = utf8.char(9810) return check_values(erl_str, lua_str, 3) end function check_values(erl_str, lua_str, length) assert(string.len(lua_str) == length, "invalid lua length") assert(string.len(erl_str) == length, "invalid erl length") assert(lua_str == erl_str, "different values") return erl_str, lua_str, erl_str == lua_str, string.len(erl_str), string.len(lua_str) end luerl-1.0/test/luerl_return_SUITE_data/fun_return_multi.lua0000644000232200023220000000022614066413134024614 0ustar debalancedebalancefunction retfun(value) return value end function retfun2(value) return value, 2 * value end return retfun(7), retfun("str 1"), retfun2(5.5) luerl-1.0/test/luerl_return_SUITE_data/variable_args_multi.lua0000644000232200023220000000054114066413134025226 0ustar debalancedebalancefunction make_table(...) local t = {} for i = 1, select('#', ...), 2 do k = select(i, ...) v = select(i + 1, ...) t[k] = v end return t end print(make_table) local tab = make_table("x", 9, 7, "banana", "z", 8) assert(tab["x"] == 9) assert(tab[7] == "banana") assert(tab.z == 8) return tab["x"], tab[7], tab.z luerl-1.0/test/luerl_return_SUITE_data/variable_args_1.lua0000644000232200023220000000053714066413134024241 0ustar debalancedebalancefunction get_from_table(Map, Key, ...) local Value = Map[Key] if select('#', ...) > 0 then return get_from_table(Value, ...) else return Value end end local tab = { a = { x1 = { x2 = 99 } }, b = 88, c = { d = 77 } } return get_from_table(tab, "a", "x1", "x2"), get_from_table(tab, "b"), get_from_table(tab, "c", "d") luerl-1.0/test/luerl_funcall_tests.erl0000644000232200023220000000751414066413134020610 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, 6], 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], Fun([4])), ?assertEqual([5.0], Fun([4.0])), ?assertEqual([6], 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}, {2,4}, {3,4}, {4,4}, {5,4}]], Fun([4])), ?assertEqual([[{1,4.0}, {2,4.0}, {3,4.0}, {4,4.0}, {5,4.0}]], Fun([4.0])), ?assertEqual([[{1,4}, {2,4}, {3,4}, {4,4}, {5,4}, {6,4}, {7,4}, {8,4}, {9,4}, {10,4}]], 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, TVal), ?assertEqual(nil, MVal). luerl-1.0/rebar.lock0000644000232200023220000000000414066413134015004 0ustar debalancedebalance[]. luerl-1.0/LICENSE0000644000232200023220000002613614066413134014062 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-1.0/ebin/0000755000232200023220000000000014066413134013762 5ustar debalancedebalanceluerl-1.0/ebin/luerl.app0000644000232200023220000000226614066413134015615 0ustar debalancedebalance{application,luerl, [{description,"Luerl - an implementation of Lua on Erlang"}, {vsn,"1.0"}, {modules,['Elixir.Luerl.New','Elixir.Luerl',luerl,luerl_anno, luerl_app,luerl_comp,luerl_comp_cg,luerl_comp_env, luerl_comp_lint,luerl_comp_locf,luerl_comp_normalise, luerl_comp_peep,luerl_comp_vars,luerl_emul,luerl_heap, luerl_init,luerl_lib,luerl_lib_basic,luerl_lib_bit32, luerl_lib_debug,luerl_lib_io,luerl_lib_math, luerl_lib_os,luerl_lib_package,luerl_lib_string, luerl_lib_string_format,luerl_lib_table, luerl_lib_utf8,luerl_new,luerl_old,luerl_parse, luerl_sandbox,luerl_scan,luerl_shell,luerl_sup, luerl_util,ttdict,ttsets]}, {registered,[]}, {applications,[kernel,stdlib]}, {env,[]}, {mod,{luerl_app,[]}}, {maintainers,["Robert Virding"]}, {licenses,["Apache"]}, {links,[{"Github","https://github.com/rvirding/luerl"}]}]}. luerl-1.0/VERSION0000644000232200023220000000000414066413134014107 0ustar debalancedebalance1.0