Merge pull request #511 from tuncer/memo

Add and use memoization server

4 files changed, 310 insertions, 22 deletions

diff --git a/ebin/rebar.app b/ebin/rebar.app
index 9ebc83c..975fabc 100644
--- a/ebin/rebar.app
+++ b/ebin/rebar.app
@@ -45,7 +45,8 @@
               rebar_xref,
               rebar_metacmds,
               rebar_getopt,
-              rebar_mustache ]},
+              rebar_mustache,
+              rmemo ]},
   {registered, []},
   {applications,
    [
diff --git a/src/rebar.erl b/src/rebar.erl
index b2358c7..dcfb353 100644
--- a/src/rebar.erl
+++ b/src/rebar.erl
@@ -214,6 +214,12 @@ run_aux(BaseConfig, Commands) ->
         {error,{already_started,crypto}} -> ok
     end,
 
+    %% Make sure memoization server is running
+    case rmemo:start() of
+        {ok, _} -> ok;
+        {error, {already_started, _}} -> ok
+    end,
+
     %% Convert command strings to atoms
     CommandAtoms = [list_to_atom(C) || C <- Commands],
 
diff --git a/src/rebar_utils.erl b/src/rebar_utils.erl
index f1aeef0..9681756 100644
--- a/src/rebar_utils.erl
+++ b/src/rebar_utils.erl
@@ -237,9 +237,11 @@ prop_check(false, Msg, Args) -> ?ABORT(Msg, Args).
 
 %% Convert all the entries in the code path to absolute paths.
 expand_code_path() ->
-    CodePath = lists:foldl(fun(Path, Acc) ->
-                                   [filename:absname(Path) | Acc]
-                           end, [], code:get_path()),
+    CodePath = lists:foldl(
+                 fun(Path, Acc) ->
+                         Path1 = rmemo:call(filename, absname, [Path]),
+                         [Path1 | Acc]
+                 end, [], code:get_path()),
     code:set_path(lists:reverse(CodePath)).
 
 %%
@@ -403,30 +405,15 @@ patch_env(Config, [E | Rest]) ->
 %% ====================================================================
 
 otp_release() ->
-    %% NOTE: All and any pdict use has been erased from rebar a long
-    %% time ago in a big refactoring, and while extra processes (think
-    %% base_compiler) may have to re-cache the vsn string, this is
-    %% tolerable as an exception. After all, it's a write-once value.
-    %%
-    %% We cache the return of otp_release1, since otherwise, we're
-    %% repeatedly reading the same file off the hard drive and
-    %% generating warnings if they aren't there.
-    case erlang:get(otp_release_cache) of
-        undefined ->
-            Vsn = otp_release1(erlang:system_info(otp_release)),
-            erlang:put(otp_release_cache, Vsn),
-            Vsn;
-        Vsn ->
-            Vsn
-    end.
+    rmemo:call(fun otp_release_1/1, [(erlang:system_info(otp_release))]).
 
 %% If OTP <= R16, otp_release is already what we want.
-otp_release1([$R,N|_]=Rel) when is_integer(N) ->
+otp_release_1([$R,N|_]=Rel) when is_integer(N) ->
     Rel;
 %% If OTP >= 17.x, erlang:system_info(otp_release) returns just the
 %% major version number, we have to read the full version from
 %% a file. See http://www.erlang.org/doc/system_principles/versions.html
-otp_release1(Rel) ->
+otp_release_1(Rel) ->
     Files = [
              filename:join([code:root_dir(), "releases", Rel, "OTP_VERSION"]),
              filename:join([code:root_dir(), "OTP_VERSION"])
diff --git a/src/rmemo.erl b/src/rmemo.erl
new file mode 100644
index 0000000..54a8626
--- /dev/null
+++ b/src/rmemo.erl
@@ -0,0 +1,294 @@
+%%% -*- mode: erlang;erlang-indent-level: 4;indent-tabs-mode: nil -*-
+%%% ex: ft=erlang ts=4 sw=4 et
+%%%
+%%%-------------------------------------------------------------------
+%%% @author Tuncer Ayaz
+%%% @copyright 2015, Tuncer Ayaz
+%%% @doc
+%%% memoization server
+%%% @end
+%%%-------------------------------------------------------------------
+%%%
+%%% Copyright (c) 2015 Tuncer Ayaz
+%%%
+%%% Permission to use, copy, modify, and/or distribute this software
+%%% for any purpose with or without fee is hereby granted, provided
+%%% that the above copyright notice and this permission notice appear
+%%% in all copies.
+%%%
+%%% THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+%%% WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+%%% WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
+%%% AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
+%%% CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
+%%% LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
+%%% NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+%%% CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+%% rebar-specific modifications:
+%% 1. rename to rmemo.erl
+%% 2. add support for R13 (see ets_tab/0)
+
+-module(rmemo).
+
+-behaviour(gen_server).
+
+%% API
+-export(
+   [
+    start/0,
+    start_link/0,
+    stop/0,
+    call/2,
+    call/3
+   ]).
+
+%% gen_server callbacks
+-export(
+   [
+    init/1,
+    handle_call/3,
+    handle_cast/2,
+    handle_info/2,
+    terminate/2,
+    code_change/3
+   ]).
+
+-define(SERVER, ?MODULE).
+-define(TABLE, ?MODULE).
+
+-record(state,
+        {
+          ets_tab :: ets:tab()
+        }).
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+
+
+%%--------------------------------------------------------------------
+%% @doc
+%% Start the server
+%% @end
+%%--------------------------------------------------------------------
+-type reason() :: term().
+-type error() :: {error, reason()}.
+-type start_res() :: {ok, pid()} | 'ignore' | error().
+-spec start() -> start_res().
+start() ->
+    gen_server:start({local, ?SERVER}, ?MODULE, [], []).
+
+%%--------------------------------------------------------------------
+%% @doc
+%% Start the server
+%% @end
+%%--------------------------------------------------------------------
+-type start_link_res() :: start_res().
+-spec start_link() -> start_link_res().
+start_link() ->
+    gen_server:start_link({local, ?SERVER}, ?MODULE, [], []).
+
+%%--------------------------------------------------------------------
+%% @doc
+%% Stop the server
+%% @end
+%%--------------------------------------------------------------------
+stop() ->
+    gen_server:cast(?SERVER, stop).
+
+%%--------------------------------------------------------------------
+%% @doc
+%% Call function and memoize result
+%%
+%% Instead of
+%%
+%% <code>Res = Fun(A1, A2, [List1])</code>
+%%
+%% you call
+%%
+%% <code>Res = memo:call(Fun, [A1, A2, [List1]])</code>
+%%
+%% or instead of
+%%
+%% <code>
+%% Res = mod:expensive_function(A1, A2, [List1])
+%% </code>
+%%
+%% you call
+%%
+%% <code>
+%% Res = memo:call(fun mod:expensive_function/3, [A1, A2, [List1]])
+%% </code>
+%%
+%% and any subsequent call will fetch the cached result and avoid the
+%% computation.
+%%
+%% This is of course only useful for expensive computations that are
+%% known to produce the same result given same arguments. It's worth
+%% mentioning that your call should be side-effect free, as naturally
+%% those won't be replayed.
+%%
+%% @end
+%%--------------------------------------------------------------------
+-type fun_args() :: list().
+-spec call(fun(), fun_args()) -> term().
+call(F, A) ->
+    call_1({F, A}).
+
+%%--------------------------------------------------------------------
+%% @doc
+%% Call function and memoize result
+%%
+%% Instead of
+%%
+%% <code>Res = mod:expensive_function(A1, A2, [List1])</code>
+%%
+%% you call
+%%
+%% <code>Res = memo:call(mod, expensive_function, [A1, A2, [List1]])</code>
+%%
+%% and any subsequent call will fetch the cached result and avoid the
+%% computation.
+%%
+%% This is of course only useful for expensive computations that are
+%% known to produce the same result given same arguments. It's worth
+%% mentioning that your call should be side-effect free, as naturally
+%% those won't be replayed.%%
+%%
+%% @end
+%%--------------------------------------------------------------------
+%% fun() is not just the name of a fun, so we define an alias for
+%% atom() for call(M, F, A).
+-type fun_name() :: atom().
+-spec call(module(), fun_name(), fun_args()) -> term().
+call(M, F, A) when is_list(A) ->
+    call_1({M, F, A}).
+
+%%%===================================================================
+%%% gen_server callbacks
+%%%===================================================================
+
+%%--------------------------------------------------------------------
+%% @private
+%% @doc
+%% Initialize the server
+%% @end
+%%--------------------------------------------------------------------
+init(_) ->
+    {ok,
+     #state{
+        ets_tab = ets_tab()
+       }
+    }.
+
+-spec ets_tab() -> ets:tab().
+ets_tab() ->
+    ErtsApp = filename:join(code:lib_dir(erts, ebin), "erts.app"),
+    Concurrency =
+        %% If erts.app exists, we run on at least R14. That means we
+        %% can use ets read_concurrency.
+        %% TODO: Remove and revert to vanilla memo.erl from
+        %% https://github.com/tuncer/memo once we require at least
+        %% R14B and drop support for R13.
+        case filelib:is_regular(ErtsApp) of
+            true ->
+                [{read_concurrency, true}];
+            false ->
+                []
+        end,
+    ets:new(
+      ?TABLE,
+      [
+       named_table,
+       protected,
+       set
+      ]
+      ++ Concurrency
+     ).
+
+%%--------------------------------------------------------------------
+%% @private
+%% @doc
+%% Handle call messages
+%% @end
+%%--------------------------------------------------------------------
+handle_call({save, Key, Res}, _From, State) ->
+    {reply, save(Key, Res), State};
+handle_call(_Request, _From, State) ->
+    {reply, {error, undefined_call}, State}.
+
+%%--------------------------------------------------------------------
+%% @private
+%% @doc
+%% Handle cast messages
+%% @end
+%%--------------------------------------------------------------------
+handle_cast(stop, State) ->
+    {stop, normal, State};
+handle_cast(_Msg, State) ->
+    {noreply, State}.
+
+%%--------------------------------------------------------------------
+%% @private
+%% @doc
+%% Handle all non call/cast messages
+%% @end
+%%--------------------------------------------------------------------
+handle_info(_Info, State) ->
+    {noreply, State}.
+
+%%--------------------------------------------------------------------
+%% @private
+%% @doc
+%% This function is called by a gen_server when it is about to
+%% terminate. It should be the opposite of Module:init/1 and do any
+%% necessary cleaning up. When it returns, the gen_server terminates
+%% with Reason. The return value is ignored.
+%% @end
+%%--------------------------------------------------------------------
+terminate(_Reason, _State) ->
+    ok.
+
+%%--------------------------------------------------------------------
+%% @private
+%% @doc
+%% Convert process state when code is changed
+%% @end
+%%--------------------------------------------------------------------
+code_change(_OldVsn, State, _Extra) ->
+    {ok, State}.
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
+
+-type call() :: {module(), fun_name(), fun_args()} | {fun(), fun_args()}.
+-spec call_1(call()) -> term().
+call_1(Call) ->
+    Key = key(Call),
+    case ets:lookup(?TABLE, Key) of
+        [] ->
+            Res = apply(Call),
+            true = gen_server:call(?SERVER, {save, Key, Res}, infinity),
+            Res;
+        [{Key, Mem}] ->
+            Mem
+    end.
+
+-type key_args() :: call().
+-type key() :: non_neg_integer().
+-spec key(key_args()) -> key().
+key(Call) ->
+    erlang:phash2(Call).
+
+-spec apply(call()) -> term().
+apply({F, A}) ->
+    erlang:apply(F, A);
+apply({M, F, A}) ->
+    erlang:apply(M, F, A).
+
+-type val() :: term().
+-spec save(key(), val()) -> true.
+save(K, V) ->
+    ets:insert(?TABLE, {K, V}).