%% ---------------------------------------------------------------------
  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 <-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.
%%
%% Alternatively, you may use this file under the terms of the GNU Lesser
  General Public License ( the " LGPL " ) as published by the Free Software
  Foundation ; either version 2.1 , or ( at your option ) any later version .
%% If you wish to allow use of your version of this file only under the
%% terms of the LGPL, you should delete the provisions above and replace
%% them with the notice and other provisions required by the LGPL; see
%% </>. If you do not delete the provisions
%% above, a recipient may use your version of this file under the terms of
  either the Apache License or the LGPL .
%%
  @author   <  >
   2012 - 2015  
  @doc Parse transform for merl . Enables the use of automatic metavariables
%% and using quasi-quotes in matches and case switches. Also optimizes calls
%% to functions in `merl' by partially evaluating them, turning strings to
%% templates, etc., at compile-time.
%%
%% Using `-include_lib("syntax_tools/include/merl.hrl").' enables this
  transform , unless the macro ` MERL_NO_TRANSFORM ' is defined first .

-module(merl_transform).

-export([parse_transform/2]).

%% NOTE: We cannot use inline metavariables or any other parse transform
%% features in this module, because it must be possible to compile it with
%% the parse transform disabled!
-include("merl.hrl").

%% TODO: unroll calls to switch? it will probably get messy

  TODO : use  to make resulting code independent of merl at runtime ?

parse_transform(Forms, _Options) ->
    erl_syntax:revert_forms(expand(erl_syntax:form_list(Forms))).

expand(Tree0) ->
    Tree = pre(Tree0),
    post(case erl_syntax:subtrees(Tree) of
             [] ->
                 Tree;
             Gs ->
                 erl_syntax:update_tree(Tree,
                                        [[expand(T) || T <- G] || G <- Gs])
         end).

pre(T) ->
    merl:switch(
      T,
      [{?Q("merl:quote(_@line, _@text) = _@expr"),
        fun ([{expr,_}, {line,Line}, {text,Text}]) ->
                erl_syntax:is_literal(Text) andalso erl_syntax:is_literal(Line)
        end,
        fun ([{expr,Expr}, {line,Line}, {text,Text}]) ->
                pre_expand_match(Expr, erl_syntax:concrete(Line),
                                 erl_syntax:concrete(Text))
        end},
       {?Q(["case _@expr of",
            "  merl:quote(_@_, _@text) when _@__@_ -> _@@_; _@_@_ -> 0",
            "end"]),
        fun case_guard/1,
        fun (As) -> case_body(As, T) end},
       fun () -> T end
      ]).

case_guard([{expr,_}, {text,Text}]) ->
    erl_syntax:is_literal(Text).

case_body([{expr,Expr}, {text,_Text}], T) ->
    pre_expand_case(Expr, erl_syntax:case_expr_clauses(T), get_location(T)).

post(T) ->
    merl:switch(
      T,
      [{?Q("merl:_@function(_@@args)"),
        [{fun ([{args, As}, {function, F}]) ->
                  lists:all(fun erl_syntax:is_literal/1, [F|As])
          end,
          fun ([{args, As}, {function, F}]) ->
                  Line = get_location(F),
                  [F1|As1] = lists:map(fun erl_syntax:concrete/1, [F|As]),
                  eval_call(Line, F1, As1, T)
          end},
         fun ([{args, As}, {function, F}]) ->
                 merl:switch(
                   F,
                   [{?Q("qquote"), fun ([]) -> expand_qquote(As, T, 1) end},
                    {?Q("subst"), fun ([]) -> expand_template(F, As, T) end},
                    {?Q("match"), fun ([]) -> expand_template(F, As, T) end},
                    fun () -> T end
                   ])
         end]},
       fun () -> T end]).

expand_qquote([Line, Text, Env], T, _) ->
    case erl_syntax:is_literal(Line) of
        true ->
            expand_qquote([Text, Env], T, erl_syntax:concrete(Line));
        false ->
            T
    end;
expand_qquote([Text, Env], T, Line) ->
    case erl_syntax:is_literal(Text) of
        true ->
            As = [Line, erl_syntax:concrete(Text)],
            case eval_call(Line, quote, As, failed) of
                failed ->
                    T;
                T1 ->
                    %% expand further if possible
                    expand(merl:qquote(Line, "merl:subst(_@tree, _@env)",
                                       [{tree, T1},
                                        {env, Env}]))
            end;
        false ->
            T
    end;
expand_qquote(_As, T, _StartPos) ->
    T.

expand_template(F, [Pattern | Args], T) ->
    case erl_syntax:is_literal(Pattern) of
        true ->
            Line = get_location(Pattern),
            As = [erl_syntax:concrete(Pattern)],
            merl:qquote(Line, "merl:_@function(_@pattern, _@args)",
               [{function, F},
                {pattern, eval_call(Line, template, As, T)},
                {args, Args}]);
        false ->
            T
    end;
expand_template(_F, _As, T) ->
    T.

eval_call(Line, F, As, T) ->
    try apply(merl, F, As) of
        T1 when F =:= quote ->
  lift metavariables in a template to Erlang variables
            Template = merl:template(T1),
            Vars = merl:template_vars(Template),
            case lists:any(fun is_inline_metavar/1, Vars) of
                true when is_list(T1) ->
                    merl:qquote(Line, "merl:tree([_@template])",
                                [{template, merl:meta_template(Template)}]);
                true ->
                    merl:qquote(Line, "merl:tree(_@template)",
                                [{template, merl:meta_template(Template)}]);
                false ->
                    merl:term(T1)
            end;
        T1 ->
            merl:term(T1)
    catch
        throw:_Reason -> T
    end.

pre_expand_match(Expr, Line, Text) ->
    {Template, Out, _Vars} = rewrite_pattern(Line, Text),
    merl:qquote(Line, "{ok, _@out} = merl:match(_@template, _@expr)",
                [{expr, Expr},
                 {out, Out},
                 {template, erl_syntax:abstract(Template)}]).

rewrite_pattern(Line, Text) ->
    %% we must rewrite the metavariables in the pattern to use lowercase,
  and then use real matching to bind the Erlang - level variables
    T0 = merl:template(merl:quote(Line, Text)),
    Vars = [V || V <- merl:template_vars(T0), is_inline_metavar(V)],
    {merl:alpha(T0, [{V, var_to_tag(V)} || V <- Vars]),
     erl_syntax:list([erl_syntax:tuple([erl_syntax:abstract(var_to_tag(V)),
                                        erl_syntax:variable(var_name(V))])
                      || V <- Vars]),
     Vars}.

var_name(V) when is_integer(V) ->
    V1 = if V > 99, (V rem 100) =:= 99 ->
                 V div 100;
            V > 9, (V rem 10) =:= 9 ->
                 V div 10;
            true -> V
         end,
    list_to_atom("Q" ++ integer_to_list(V1));
var_name(V) -> V.

var_to_tag(V) when is_integer(V) -> V;
var_to_tag(V) ->
    list_to_atom(string:lowercase(atom_to_list(V))).

pre_expand_case(Expr, Clauses, Line) ->
    merl:qquote(Line, "merl:switch(_@expr, _@clauses)",
                [{clauses, erl_syntax:list([pre_expand_case_clause(C)
                                            || C <- Clauses])},
                 {expr, Expr}]).

pre_expand_case_clause(T) ->
    %% note that the only allowed non ``?Q(...) -> ...'' clause is ``_ -> ...''
    merl:switch(
      T,
      [{?Q("(merl:quote(_@line, _@text)) when _@__@guard -> _@@body"),
        fun ([{body,_}, {guard,_}, {line,Line}, {text,Text}]) ->
                erl_syntax:is_literal(Text) andalso erl_syntax:is_literal(Line)
        end,
        fun ([{body,Body}, {guard,Guard}, {line,Line}, {text,Text}]) ->
                pre_expand_case_clause(Body, Guard, erl_syntax:concrete(Line),
                                       erl_syntax:concrete(Text))
        end},
       {?Q("_ -> _@@body"),
        fun (Env) -> merl:qquote("fun () -> _@body end", Env) end}
      ]).

pre_expand_case_clause(Body, Guard, Line, Text) ->
    %% this is similar to a meta-match ``?Q("...") = Term''
    %% (note that the guards may in fact be arbitrary expressions)
    {Template, Out, Vars} = rewrite_pattern(Line, Text),
    GuardExprs = rewrite_guard(Guard),
    Param = [{body, Body},
             {guard,GuardExprs},
             {out, Out},
             {template, erl_syntax:abstract(Template)},
             {unused, dummy_uses(Vars)}],
    case GuardExprs of
        [] ->
            merl:qquote(Line, ["{_@template, ",
                               " fun (_@out) -> _@unused, _@body end}"],
                        Param);
        _ ->
            merl:qquote(Line, ["{_@template, ",
                               " fun (_@out) -> _@unused, _@guard end, ",
                               " fun (_@out) -> _@unused, _@body end}"],
                        Param)
    end.

%% We have to insert dummy variable uses at the beginning of the "guard" and
%% "body" function bodies to avoid warnings for unused variables in the
  generated code . ( Expansions at the Erlang level ca n't be marked up as
%% compiler generated to allow later compiler stages to ignore them.)
dummy_uses(Vars) ->
    [?Q("_ = _@var", [{var, erl_syntax:variable(var_name(V))}])
     || V <- Vars].

rewrite_guard([]) -> [];
rewrite_guard([D]) -> [make_orelse(erl_syntax:disjunction_body(D))].

make_orelse([]) -> [];
make_orelse([C]) -> make_andalso(erl_syntax:conjunction_body(C));
make_orelse([C | Cs]) ->
    ?Q("_@expr orelse _@rest",
       [{expr, make_andalso(erl_syntax:conjunction_body(C))},
        {rest, make_orelse(Cs)}]).

make_andalso([E]) -> E;
make_andalso([E | Es]) ->
    ?Q("_@expr andalso _@rest", [{expr, E}, {rest, make_andalso(Es)}]).

is_inline_metavar(Var) when is_atom(Var) ->
    is_erlang_var(atom_to_list(Var));
is_inline_metavar(Var) when is_integer(Var) ->
    Var > 9 andalso (Var rem 10) =:= 9;
is_inline_metavar(_) -> false.

is_erlang_var([C|_]) when C >= $A, C =< $Z ; C >= $À, C =< $Þ, C /= $× ->
    true;
is_erlang_var(_) ->
    false.

get_location(T) ->
    Pos = erl_syntax:get_pos(T),
    case erl_anno:is_anno(Pos) of
        true ->
            erl_anno:location(Pos);
        false ->
            Pos
    end.

 ---------------------------------------------------------------------
 not use this file except in compliance with the License. You may obtain
 a copy of the License at <-2.0>

 Unless required by applicable law or agreed to in writing, software
 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.

 Alternatively, you may use this file under the terms of the GNU Lesser
 If you wish to allow use of your version of this file only under the
 terms of the LGPL, you should delete the provisions above and replace
 them with the notice and other provisions required by the LGPL; see
 </>. If you do not delete the provisions
 above, a recipient may use your version of this file under the terms of

 and using quasi-quotes in matches and case switches. Also optimizes calls
 to functions in `merl' by partially evaluating them, turning strings to
 templates, etc., at compile-time.

 Using `-include_lib("syntax_tools/include/merl.hrl").' enables this
 NOTE: We cannot use inline metavariables or any other parse transform
 features in this module, because it must be possible to compile it with
 the parse transform disabled!
 TODO: unroll calls to switch? it will probably get messy
 expand further if possible
 we must rewrite the metavariables in the pattern to use lowercase,
 note that the only allowed non ``?Q(...) -> ...'' clause is ``_ -> ...''
 this is similar to a meta-match ``?Q("...") = Term''
 (note that the guards may in fact be arbitrary expressions)
 We have to insert dummy variable uses at the beginning of the "guard" and
 "body" function bodies to avoid warnings for unused variables in the
 compiler generated to allow later compiler stages to ignore them.)
  Licensed under the Apache License , Version 2.0 ( the " License " ) ; you may
  distributed under the License is distributed on an " AS IS " BASIS ,
  General Public License ( the " LGPL " ) as published by the Free Software
  Foundation ; either version 2.1 , or ( at your option ) any later version .
  either the Apache License or the LGPL .
  @author   <  >
   2012 - 2015  
  @doc Parse transform for merl . Enables the use of automatic metavariables
  transform , unless the macro ` MERL_NO_TRANSFORM ' is defined first .

-module(merl_transform).

-export([parse_transform/2]).

-include("merl.hrl").


  TODO : use  to make resulting code independent of merl at runtime ?

parse_transform(Forms, _Options) ->
    erl_syntax:revert_forms(expand(erl_syntax:form_list(Forms))).

expand(Tree0) ->
    Tree = pre(Tree0),
    post(case erl_syntax:subtrees(Tree) of
             [] ->
                 Tree;
             Gs ->
                 erl_syntax:update_tree(Tree,
                                        [[expand(T) || T <- G] || G <- Gs])
         end).

pre(T) ->
    merl:switch(
      T,
      [{?Q("merl:quote(_@line, _@text) = _@expr"),
        fun ([{expr,_}, {line,Line}, {text,Text}]) ->
                erl_syntax:is_literal(Text) andalso erl_syntax:is_literal(Line)
        end,
        fun ([{expr,Expr}, {line,Line}, {text,Text}]) ->
                pre_expand_match(Expr, erl_syntax:concrete(Line),
                                 erl_syntax:concrete(Text))
        end},
       {?Q(["case _@expr of",
            "  merl:quote(_@_, _@text) when _@__@_ -> _@@_; _@_@_ -> 0",
            "end"]),
        fun case_guard/1,
        fun (As) -> case_body(As, T) end},
       fun () -> T end
      ]).

case_guard([{expr,_}, {text,Text}]) ->
    erl_syntax:is_literal(Text).

case_body([{expr,Expr}, {text,_Text}], T) ->
    pre_expand_case(Expr, erl_syntax:case_expr_clauses(T), get_location(T)).

post(T) ->
    merl:switch(
      T,
      [{?Q("merl:_@function(_@@args)"),
        [{fun ([{args, As}, {function, F}]) ->
                  lists:all(fun erl_syntax:is_literal/1, [F|As])
          end,
          fun ([{args, As}, {function, F}]) ->
                  Line = get_location(F),
                  [F1|As1] = lists:map(fun erl_syntax:concrete/1, [F|As]),
                  eval_call(Line, F1, As1, T)
          end},
         fun ([{args, As}, {function, F}]) ->
                 merl:switch(
                   F,
                   [{?Q("qquote"), fun ([]) -> expand_qquote(As, T, 1) end},
                    {?Q("subst"), fun ([]) -> expand_template(F, As, T) end},
                    {?Q("match"), fun ([]) -> expand_template(F, As, T) end},
                    fun () -> T end
                   ])
         end]},
       fun () -> T end]).

expand_qquote([Line, Text, Env], T, _) ->
    case erl_syntax:is_literal(Line) of
        true ->
            expand_qquote([Text, Env], T, erl_syntax:concrete(Line));
        false ->
            T
    end;
expand_qquote([Text, Env], T, Line) ->
    case erl_syntax:is_literal(Text) of
        true ->
            As = [Line, erl_syntax:concrete(Text)],
            case eval_call(Line, quote, As, failed) of
                failed ->
                    T;
                T1 ->
                    expand(merl:qquote(Line, "merl:subst(_@tree, _@env)",
                                       [{tree, T1},
                                        {env, Env}]))
            end;
        false ->
            T
    end;
expand_qquote(_As, T, _StartPos) ->
    T.

expand_template(F, [Pattern | Args], T) ->
    case erl_syntax:is_literal(Pattern) of
        true ->
            Line = get_location(Pattern),
            As = [erl_syntax:concrete(Pattern)],
            merl:qquote(Line, "merl:_@function(_@pattern, _@args)",
               [{function, F},
                {pattern, eval_call(Line, template, As, T)},
                {args, Args}]);
        false ->
            T
    end;
expand_template(_F, _As, T) ->
    T.

eval_call(Line, F, As, T) ->
    try apply(merl, F, As) of
        T1 when F =:= quote ->
  lift metavariables in a template to Erlang variables
            Template = merl:template(T1),
            Vars = merl:template_vars(Template),
            case lists:any(fun is_inline_metavar/1, Vars) of
                true when is_list(T1) ->
                    merl:qquote(Line, "merl:tree([_@template])",
                                [{template, merl:meta_template(Template)}]);
                true ->
                    merl:qquote(Line, "merl:tree(_@template)",
                                [{template, merl:meta_template(Template)}]);
                false ->
                    merl:term(T1)
            end;
        T1 ->
            merl:term(T1)
    catch
        throw:_Reason -> T
    end.

pre_expand_match(Expr, Line, Text) ->
    {Template, Out, _Vars} = rewrite_pattern(Line, Text),
    merl:qquote(Line, "{ok, _@out} = merl:match(_@template, _@expr)",
                [{expr, Expr},
                 {out, Out},
                 {template, erl_syntax:abstract(Template)}]).

rewrite_pattern(Line, Text) ->
  and then use real matching to bind the Erlang - level variables
    T0 = merl:template(merl:quote(Line, Text)),
    Vars = [V || V <- merl:template_vars(T0), is_inline_metavar(V)],
    {merl:alpha(T0, [{V, var_to_tag(V)} || V <- Vars]),
     erl_syntax:list([erl_syntax:tuple([erl_syntax:abstract(var_to_tag(V)),
                                        erl_syntax:variable(var_name(V))])
                      || V <- Vars]),
     Vars}.

var_name(V) when is_integer(V) ->
    V1 = if V > 99, (V rem 100) =:= 99 ->
                 V div 100;
            V > 9, (V rem 10) =:= 9 ->
                 V div 10;
            true -> V
         end,
    list_to_atom("Q" ++ integer_to_list(V1));
var_name(V) -> V.

var_to_tag(V) when is_integer(V) -> V;
var_to_tag(V) ->
    list_to_atom(string:lowercase(atom_to_list(V))).

pre_expand_case(Expr, Clauses, Line) ->
    merl:qquote(Line, "merl:switch(_@expr, _@clauses)",
                [{clauses, erl_syntax:list([pre_expand_case_clause(C)
                                            || C <- Clauses])},
                 {expr, Expr}]).

pre_expand_case_clause(T) ->
    merl:switch(
      T,
      [{?Q("(merl:quote(_@line, _@text)) when _@__@guard -> _@@body"),
        fun ([{body,_}, {guard,_}, {line,Line}, {text,Text}]) ->
                erl_syntax:is_literal(Text) andalso erl_syntax:is_literal(Line)
        end,
        fun ([{body,Body}, {guard,Guard}, {line,Line}, {text,Text}]) ->
                pre_expand_case_clause(Body, Guard, erl_syntax:concrete(Line),
                                       erl_syntax:concrete(Text))
        end},
       {?Q("_ -> _@@body"),
        fun (Env) -> merl:qquote("fun () -> _@body end", Env) end}
      ]).

pre_expand_case_clause(Body, Guard, Line, Text) ->
    {Template, Out, Vars} = rewrite_pattern(Line, Text),
    GuardExprs = rewrite_guard(Guard),
    Param = [{body, Body},
             {guard,GuardExprs},
             {out, Out},
             {template, erl_syntax:abstract(Template)},
             {unused, dummy_uses(Vars)}],
    case GuardExprs of
        [] ->
            merl:qquote(Line, ["{_@template, ",
                               " fun (_@out) -> _@unused, _@body end}"],
                        Param);
        _ ->
            merl:qquote(Line, ["{_@template, ",
                               " fun (_@out) -> _@unused, _@guard end, ",
                               " fun (_@out) -> _@unused, _@body end}"],
                        Param)
    end.

  generated code . ( Expansions at the Erlang level ca n't be marked up as
dummy_uses(Vars) ->
    [?Q("_ = _@var", [{var, erl_syntax:variable(var_name(V))}])
     || V <- Vars].

rewrite_guard([]) -> [];
rewrite_guard([D]) -> [make_orelse(erl_syntax:disjunction_body(D))].

make_orelse([]) -> [];
make_orelse([C]) -> make_andalso(erl_syntax:conjunction_body(C));
make_orelse([C | Cs]) ->
    ?Q("_@expr orelse _@rest",
       [{expr, make_andalso(erl_syntax:conjunction_body(C))},
        {rest, make_orelse(Cs)}]).

make_andalso([E]) -> E;
make_andalso([E | Es]) ->
    ?Q("_@expr andalso _@rest", [{expr, E}, {rest, make_andalso(Es)}]).

is_inline_metavar(Var) when is_atom(Var) ->
    is_erlang_var(atom_to_list(Var));
is_inline_metavar(Var) when is_integer(Var) ->
    Var > 9 andalso (Var rem 10) =:= 9;
is_inline_metavar(_) -> false.

is_erlang_var([C|_]) when C >= $A, C =< $Z ; C >= $À, C =< $Þ, C /= $× ->
    true;
is_erlang_var(_) ->
    false.

get_location(T) ->
    Pos = erl_syntax:get_pos(T),
    case erl_anno:is_anno(Pos) of
        true ->
            erl_anno:location(Pos);
        false ->
            Pos
    end.
