[m-rev.] for review: work around slow hipe compilation

[Peter Wang]

Estimated hours taken: 5
Branches: main

compiler/erl_code_gen.m:
	The HiPE compiler is extremely slow compiling functions containing long
	case statements involving strings.  Workaround: for a string switch
	with many cases, convert the string to an atom and switch on atoms
	instead.


Index: compiler/erl_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_code_gen.m,v
retrieving revision 1.15
diff -u -r1.15 erl_code_gen.m
--- compiler/erl_code_gen.m	20 Jun 2007 05:49:54 -0000	1.15
+++ compiler/erl_code_gen.m	29 Jun 2007 06:36:08 -0000
@@ -586,6 +586,10 @@
 
 duplicate_expr_limit = 10.  % XXX arbitrary
 
+:- func switch_strings_as_atoms_limit = int.
+
+switch_strings_as_atoms_limit = 50. % XXX arbitrary
+
 :- pred erl_gen_switch(prog_var::in, can_fail::in, list(hlds_goal.case)::in,
     code_model::in, instmap::in, prog_context::in, maybe(elds_expr)::in,
     elds_expr::out, erl_gen_info::in, erl_gen_info::out) is det.
@@ -631,12 +635,33 @@
         MaybeSuccessExpr0, MaybeMakeClosure, MaybeSuccessExpr,
         InstMap0, InstMap, !Info),
 
-    % Generate code for each case.
     erl_variable_type(!.Info, Var, VarType),
-    list.map_foldl(
-        erl_gen_case(VarType,
-            CodeModel, InstMap, NonLocalsBoundInCases, MaybeSuccessExpr),
-        CasesList, ErlCases0, !Info),
+    erl_gen_info_get_module_info(!.Info, ModuleInfo),
+    type_util.classify_type(ModuleInfo, VarType) = TypeCategory,
+
+    (if
+        % The HiPE compiler is extremely slow compiling functions containing
+        % long case statements involving strings.  Workaround: for long string
+        % switches, convert the string to an atom and switch on atoms instead.
+        TypeCategory = type_cat_string,
+        list.length(CasesList) > switch_strings_as_atoms_limit
+    then
+        erl_gen_info_new_named_var("Atom", AtomVar, !Info),
+        StringToAtom = elds_eq(expr_from_var(AtomVar),
+            elds_call_builtin("list_to_atom", [expr_from_var(Var)])),
+        MaybeConvertToAtom = yes(StringToAtom),
+        SwitchVar = AtomVar,
+        GenCase = erl_gen_case_on_atom(CodeModel, InstMap,
+            NonLocalsBoundInCases, MaybeSuccessExpr)
+    else
+        MaybeConvertToAtom = no,
+        SwitchVar = Var,
+        GenCase = erl_gen_case(VarType,
+            CodeModel, InstMap, NonLocalsBoundInCases, MaybeSuccessExpr)
+    ),
+
+    % Generate code for each case.
+    list.map_foldl(GenCase, CasesList, ErlCases0, !Info),
     (
         CanFail = can_fail,
         % Add `_ -> fail' default case.
@@ -648,8 +673,9 @@
     ),
 
     % Create the overall switch statement,.
-    CaseExpr = elds_case_expr(expr_from_var(Var), ErlCases),
-    Statement = maybe_join_exprs1(MaybeMakeClosure, CaseExpr).
+    CaseExpr = elds_case_expr(expr_from_var(SwitchVar), ErlCases),
+    Statement = maybe_join_exprs1(MaybeMakeClosure,
+        maybe_join_exprs1(MaybeConvertToAtom, CaseExpr)).
 
 :- pred erl_gen_case(mer_type::in,
     code_model::in, instmap::in, set(prog_var)::in,
@@ -709,6 +735,30 @@
         Size = 0
     ).
 
+:- pred erl_gen_case_on_atom(code_model::in, instmap::in, set(prog_var)::in,
+    maybe(elds_expr)::in, hlds_goal.case::in, elds_case::out, 
+    erl_gen_info::in, erl_gen_info::out) is det.
+
+erl_gen_case_on_atom(CodeModel, InstMap, MustBindNonLocals, MaybeSuccessExpr,
+        case(ConsId, Goal), ELDSCase, !Info) :-
+    ( ConsId = string_const(String0) ->
+        String = String0
+    ;
+        unexpected(this_file, "erl_gen_case_on_atom: non-string const")
+    ),
+    erl_fix_success_expr(InstMap, Goal, MaybeSuccessExpr,
+        MaybeSuccessExprForCase, !Info),
+    erl_gen_goal(CodeModel, InstMap, Goal, MaybeSuccessExprForCase, Statement0,
+        !Info),
+    %
+    % To prevent warnings from the Erlang compiler we must make sure all cases
+    % bind the same set of variables.  This might not be true if the Mercury
+    % compiler knows that a case calls a procedure which throws an exception.
+    %
+    erl_bind_unbound_vars(!.Info, MustBindNonLocals, Goal, InstMap,
+        Statement0, Statement),
+    ELDSCase = elds_case(elds_atom_raw(String), Statement).
+
 %-----------------------------------------------------------------------------%
 % This code is shared by disjunctions and switches.
 
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------