[m-rev.] for review: trace goals for erlang

Peter Wang wangp at students.csse.unimelb.edu.au
Tue Jun 12 17:55:40 AEST 2007


Estimated hours taken: 6
Branches: main

Support trace goals and trace runtime conditions in Erlang backend.

compiler/elds.m:
	Extend the ELDS to record the environment variables referenced by
	each procedure.

	Extend the ELDS for Erlang send (!) and `receive' statements.

	Add elds_call_self which generates a call to the Erlang builtin
	function `self'.

compiler/elds_to_erlang.m:
	Output `ENVVAR' mkinit_erl directives for all environment variables
	referenced in the module.

	At program startup, call the init_env_vars() function generated by
	mkinit_erl.

compiler/erl_call_gen.m:
	Generate code for the special foreign_procs which are inserted for
	trace goals with runtime conditions.

compiler/erl_code_gen.m:
	Generate code for trace goals.

	Conform to ELDS changes.
	
compiler/erl_code_util.m:
	Extend erl_gen_info to keep track of the environment variables
	referenced by the procedure being generated.

	Conform to ELDS changes.

library/erlang_builtin.m:
	Make the Erlang global server handle messages used by init_env_vars()
	and to evaluate trace runtime conditions.

compiler/simplify.m:
	Don't abort at trace conditions for Erlang target since they are
	supported now.

util/mkinit_erl.c:
	Generate an init_env_vars() function in an _init.erl file.  When called
	at startup, this will cause the Erlang global server to record whether
	each environment variable is set or not.

	Remove the code to check that the environment variable name in an
	ENVVAR directive is suitable for C.  It didn't take into account that
	in Erlang files the ENVVAR directive has a "% " prefix, and also we
	generate the directive so that funny characters will be suitably
	escaped for an Erlang string so the restriction isn't necessary.

Index: compiler/elds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/elds.m,v
retrieving revision 1.11
diff -u -r1.11 elds.m
--- compiler/elds.m	8 Jun 2007 00:47:08 -0000	1.11
+++ compiler/elds.m	12 Jun 2007 07:53:42 -0000
@@ -33,6 +33,7 @@
 :- import_module char.
 :- import_module list.
 :- import_module maybe.
+:- import_module set.
 
 %-----------------------------------------------------------------------------%
 
@@ -67,7 +68,10 @@
     --->    elds_defn(
                 defn_proc_id    :: pred_proc_id,
                 defn_varset     :: prog_varset,
-                defn_body       :: elds_body
+                defn_body       :: elds_body,
+                defn_env_vars   :: set(string)
+                                % The set of environment variables referred to
+                                % by the function body.
             ).
 
 :- type elds_body
@@ -185,7 +189,17 @@
     ;       elds_throw(elds_expr)
 
             % A piece of code to be embedded directly in the generated code.
-    ;       elds_foreign_code(string).
+    ;       elds_foreign_code(string)
+
+            % ExprA ! ExprB
+            %
+    ;       elds_send(elds_expr, elds_expr)
+
+            % receive
+            %   Pattern -> Expr;
+            %   ...
+            % end
+    ;       elds_receive(list(elds_case)).
 
 :- type elds_term
     --->    elds_char(char)
@@ -281,6 +295,7 @@
 
 :- func elds_call_builtin(string, list(elds_expr)) = elds_expr.
 :- func elds_call_element(prog_var, int) = elds_expr.
+:- func elds_call_self = elds_expr.
 
 :- func var_eq_false(prog_var) = elds_expr.
 
@@ -368,6 +383,8 @@
 elds_call_element(Var, Index) = elds_call_builtin("element",
     [elds_term(elds_int(Index)), expr_from_var(Var)]).
 
+elds_call_self = elds_call_builtin("self", []).
+
 var_eq_false(Var) = elds_eq(expr_from_var(Var), elds_term(elds_false)).
 
 term_from_var(Var) = elds_var(Var).
Index: compiler/elds_to_erlang.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/elds_to_erlang.m,v
retrieving revision 1.15
diff -u -r1.15 elds_to_erlang.m
--- compiler/elds_to_erlang.m	12 Jun 2007 06:53:56 -0000	1.15
+++ compiler/elds_to_erlang.m	12 Jun 2007 07:53:42 -0000
@@ -62,6 +62,7 @@
 :- import_module list.
 :- import_module maybe.
 :- import_module pair.
+:- import_module set.
 :- import_module string.
 :- import_module term.
 :- import_module varset.
@@ -130,6 +131,8 @@
         output_atom(ErlangModuleNameStr, !IO),
         io.write_string(":mercury__required_final\n", !IO)
     ),
+    EnvVarNames = elds_get_env_var_names(ProcDefns),
+    set.fold(output_env_var_directive, EnvVarNames, !IO),
     % We always write out ENDINIT so that mkinit_erl doesn't scan the whole
     % file.
     io.write_string("% ENDINIT\n", !IO),
@@ -161,7 +164,7 @@
     bool::in, bool::out, io::di, io::uo) is det.
 
 output_export_ann(ModuleInfo, Defn, !NeedComma, !IO) :-
-    Defn = elds_defn(PredProcId, _, Body),
+    Defn = elds_defn(PredProcId, _, Body, _),
     PredProcId = proc(PredId, _ProcId),
     module_info_pred_info(ModuleInfo, PredId, PredInfo),
     pred_info_get_import_status(PredInfo, ImportStatus),
@@ -273,6 +276,7 @@
         mercury__startup(),
         InitModule = list_to_atom(atom_to_list(?MODULE) ++ ""_init""),
         try
+            InitModule:init_env_vars(),
             InitModule:init_modules(),
             InitModule:init_modules_required(),
             main_2_p_0(),
@@ -327,6 +331,25 @@
 
 %-----------------------------------------------------------------------------%
 
+:- func elds_get_env_var_names(list(elds_defn)) = set(string).
+
+elds_get_env_var_names(ProcDefns) =
+    set.union_list(list.map(elds_get_env_var_names_from_defn, ProcDefns)).
+
+:- func elds_get_env_var_names_from_defn(elds_defn) = set(string).
+
+elds_get_env_var_names_from_defn(ProcDefn) = EnvVarNameSet :-
+    ProcDefn = elds_defn(_, _, _, EnvVarNameSet).
+
+:- pred output_env_var_directive(string::in, io::di, io::uo) is det.
+
+output_env_var_directive(EnvVarName, !IO) :-
+    io.write_string("% ENVVAR ", !IO),
+    write_with_escaping(in_string, EnvVarName, !IO),
+    io.nl(!IO).
+
+%-----------------------------------------------------------------------------%
+
 :- pred output_foreign_body_code(foreign_body_code::in, io::di, io::uo) is det.
 
 output_foreign_body_code(foreign_body_code(_Lang, Code, _Context), !IO) :-
@@ -362,7 +385,7 @@
 %-----------------------------------------------------------------------------%
 
 output_defn(ModuleInfo, Defn, !IO) :-
-    Defn = elds_defn(PredProcId, VarSet, Body),
+    Defn = elds_defn(PredProcId, VarSet, Body, _EnvVarNames),
     (
         Body = body_defined_here(Clause),
         io.nl(!IO),
@@ -544,6 +567,18 @@
         nl(!IO),
         io.write_string(Code, !IO),
         nl_indent_line(Indent, !IO)
+    ;
+        Expr = elds_send(ExprA, ExprB),
+        output_expr(ModuleInfo, VarSet, Indent, ExprA, !IO),
+        io.write_string(" ! ", !IO),
+        output_expr(ModuleInfo, VarSet, Indent, ExprB, !IO)
+    ;
+        Expr = elds_receive(Cases),
+        io.write_string("(receive", !IO),
+            io.write_list(Cases, ";",
+                output_case(ModuleInfo, VarSet, Indent + 1), !IO),
+        nl_indent_line(Indent, !IO),
+        io.write_string("end)", !IO)
     ).
 
 :- pred output_case(module_info::in, prog_varset::in, indent::in,
Index: compiler/erl_call_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_call_gen.m,v
retrieving revision 1.6
diff -u -r1.6 erl_call_gen.m
--- compiler/erl_call_gen.m	4 Jun 2007 06:24:19 -0000	1.6
+++ compiler/erl_call_gen.m	12 Jun 2007 07:53:42 -0000
@@ -546,96 +546,24 @@
 % unused variable warnings were switched off in the Erlang compiler.
 
 erl_gen_foreign_code_call(ForeignArgs, MaybeTraceRuntimeCond,
-        PragmaImpl, CodeModel, _OuterContext, MaybeSuccessExpr, Statement,
+        PragmaImpl, CodeModel, OuterContext, MaybeSuccessExpr, Statement,
         !Info) :-
     (
-        MaybeTraceRuntimeCond = yes(_),
-        sorry(this_file, "trace runtime conditions in Erlang backend")
-    ;
-        MaybeTraceRuntimeCond = no
-    ),
-    (
-        PragmaImpl = fc_impl_ordinary(ForeignCode, _Context),
-        %
-        % In the following, F<n> are input variables to the foreign code (with
-        % fixed names), and G<n> are output variables from the foreign code
-        % (also with fixed names).  The variables V<n> are input variables and
-        % have arbitrary names.  We introduce variables with fixed names using
-        % a lambda function rather than direct assignments in case a single
-        % procedure makes calls to two pieces of foreign code which use the
-        % same fixed names (this can happen due to inlining).
-        %
-        % We generate code for calls to model_det foreign code like this:
-        %
-        %   (fun(F1, F2, ...) ->
-        %       <foreign code>,
-        %       {G1, G2, ...}
-        %   )(V1, V2, ...).
-        %
-        % We generate code for calls to model_semi foreign code like this:
-        %
-        %   (fun(F1, F2, ...) ->
-        %       <foreign code>,
-        %       case SUCCESS_INDICATOR of
-        %           true ->
-        %               {G1, G2, ...};
-        %           false ->
-        %               fail
-        %       end
-        %   )(V1, V2, ...)
-        %
-        % where `SUCCESS_INDICATOR' is a variable that should be set in the
-        % foreign code snippet to `true' or `false'.
-        %
-
-        % Separate the foreign call arguments into inputs and outputs.
-        erl_gen_info_get_module_info(!.Info, ModuleInfo),
-        list.map2(foreign_arg_type_mode, ForeignArgs, ArgTypes, ArgModes),
-        erl_gen_arg_list(ModuleInfo, opt_dummy_args, ForeignArgs, ArgTypes,
-            ArgModes, InputForeignArgs, OutputForeignArgs),
-
-        % Get the variables involved in the call and their fixed names.
-        InputVars = list.map(foreign_arg_var, InputForeignArgs),
-        OutputVars = list.map(foreign_arg_var, OutputForeignArgs),
-        InputVarsNames = list.map(foreign_arg_name, InputForeignArgs),
-        OutputVarsNames = list.map(foreign_arg_name, OutputForeignArgs),
-
-        ForeignCodeExpr = elds_foreign_code(ForeignCode),
-        OutputTuple = elds_term(elds_tuple(
-            exprs_from_fixed_vars(OutputVarsNames))),
-
-        % Create the inner lambda function.
+        PragmaImpl = fc_impl_ordinary(ForeignCode, MaybeContext),
         (
-            CodeModel = model_det,
-            %
-            %   <ForeignCodeExpr>,
-            %   {Outputs, ...}
-            %
-            InnerFunStatement = join_exprs(ForeignCodeExpr, OutputTuple)
-        ;
-            CodeModel = model_semi,
-            %
-            %   <ForeignCodeExpr>,
-            %   case SUCCESS_INDICATOR of
-            %       true -> {Outputs, ...};
-            %       false -> fail
-            %   end
-            %
-            InnerFunStatement = join_exprs(ForeignCodeExpr, MaybePlaceOutputs),
-            MaybePlaceOutputs = elds_case_expr(SuccessInd, [OnTrue, OnFalse]),
-            SuccessInd = elds_term(elds_fixed_name_var("SUCCESS_INDICATOR")),
-            OnTrue = elds_case(elds_true, OutputTuple),
-            OnFalse = elds_case(elds_false, elds_term(elds_fail))
+            MaybeTraceRuntimeCond = no,
+            (
+                MaybeContext = yes(Context)
+            ;
+                MaybeContext = no,
+                Context = OuterContext
+            ),
+            erl_gen_ordinary_pragma_foreign_code(ForeignArgs, ForeignCode,
+                CodeModel, Context, MaybeSuccessExpr, Statement, !Info)
         ;
-            CodeModel = model_non,
-            sorry(this_file, "model_non foreign_procs in Erlang backend")
-        ),
-        InnerFun = elds_fun(elds_clause(terms_from_fixed_vars(InputVarsNames),
-            InnerFunStatement)),
-
-        % Call the inner function with the input variables.
-        erl_make_call(CodeModel, elds_call_ho(InnerFun), InputVars, OutputVars,
-            MaybeSuccessExpr, Statement)
+            MaybeTraceRuntimeCond = yes(TraceRuntimeCond),
+            erl_gen_trace_runtime_cond(TraceRuntimeCond, Statement, !Info)
+        )
     ;
         PragmaImpl = fc_impl_model_non(_, _, _, _, _, _, _, _, _),
         sorry(this_file, "erl_gen_goal_expr: fc_impl_model_non")
@@ -644,6 +572,95 @@
         sorry(this_file, "erl_gen_goal_expr: fc_impl_import")
     ).
 
+%-----------------------------------------------------------------------------%
+
+:- pred erl_gen_ordinary_pragma_foreign_code(list(foreign_arg)::in,
+    string::in, code_model::in, prog_context::in, maybe(elds_expr)::in,
+    elds_expr::out, erl_gen_info::in, erl_gen_info::out) is det.
+
+erl_gen_ordinary_pragma_foreign_code(ForeignArgs, ForeignCode,
+        CodeModel, _OuterContext, MaybeSuccessExpr, Statement, !Info) :-
+    %
+    % In the following, F<n> are input variables to the foreign code (with
+    % fixed names), and G<n> are output variables from the foreign code
+    % (also with fixed names).  The variables V<n> are input variables and
+    % have arbitrary names.  We introduce variables with fixed names using
+    % a lambda function rather than direct assignments in case a single
+    % procedure makes calls to two pieces of foreign code which use the
+    % same fixed names (this can happen due to inlining).
+    %
+    % We generate code for calls to model_det foreign code like this:
+    %
+    %   (fun(F1, F2, ...) ->
+    %       <foreign code>,
+    %       {G1, G2, ...}
+    %   )(V1, V2, ...).
+    %
+    % We generate code for calls to model_semi foreign code like this:
+    %
+    %   (fun(F1, F2, ...) ->
+    %       <foreign code>,
+    %       case SUCCESS_INDICATOR of
+    %           true ->
+    %               {G1, G2, ...};
+    %           false ->
+    %               fail
+    %       end
+    %   )(V1, V2, ...)
+    %
+    % where `SUCCESS_INDICATOR' is a variable that should be set in the
+    % foreign code snippet to `true' or `false'.
+    %
+
+    % Separate the foreign call arguments into inputs and outputs.
+    erl_gen_info_get_module_info(!.Info, ModuleInfo),
+    list.map2(foreign_arg_type_mode, ForeignArgs, ArgTypes, ArgModes),
+    erl_gen_arg_list(ModuleInfo, opt_dummy_args, ForeignArgs, ArgTypes,
+        ArgModes, InputForeignArgs, OutputForeignArgs),
+
+    % Get the variables involved in the call and their fixed names.
+    InputVars = list.map(foreign_arg_var, InputForeignArgs),
+    OutputVars = list.map(foreign_arg_var, OutputForeignArgs),
+    InputVarsNames = list.map(foreign_arg_name, InputForeignArgs),
+    OutputVarsNames = list.map(foreign_arg_name, OutputForeignArgs),
+
+    ForeignCodeExpr = elds_foreign_code(ForeignCode),
+    OutputTuple = elds_term(elds_tuple(
+        exprs_from_fixed_vars(OutputVarsNames))),
+
+    % Create the inner lambda function.
+    (
+        CodeModel = model_det,
+        %
+        %   <ForeignCodeExpr>,
+        %   {Outputs, ...}
+        %
+        InnerFunStatement = join_exprs(ForeignCodeExpr, OutputTuple)
+    ;
+        CodeModel = model_semi,
+        %
+        %   <ForeignCodeExpr>,
+        %   case SUCCESS_INDICATOR of
+        %       true -> {Outputs, ...};
+        %       false -> fail
+        %   end
+        %
+        InnerFunStatement = join_exprs(ForeignCodeExpr, MaybePlaceOutputs),
+        MaybePlaceOutputs = elds_case_expr(SuccessInd, [OnTrue, OnFalse]),
+        SuccessInd = elds_term(elds_fixed_name_var("SUCCESS_INDICATOR")),
+        OnTrue = elds_case(elds_true, OutputTuple),
+        OnFalse = elds_case(elds_false, elds_term(elds_fail))
+    ;
+        CodeModel = model_non,
+        sorry(this_file, "model_non foreign_procs in Erlang backend")
+    ),
+    InnerFun = elds_fun(elds_clause(terms_from_fixed_vars(InputVarsNames),
+        InnerFunStatement)),
+
+    % Call the inner function with the input variables.
+    erl_make_call(CodeModel, elds_call_ho(InnerFun), InputVars, OutputVars,
+        MaybeSuccessExpr, Statement).
+
 :- pred foreign_arg_type_mode(foreign_arg::in, mer_type::out, mer_mode::out)
     is det.
 
@@ -669,6 +686,102 @@
 
 %-----------------------------------------------------------------------------%
 
+:- pred erl_gen_trace_runtime_cond(trace_expr(trace_runtime)::in,
+    elds_expr::out, erl_gen_info::in, erl_gen_info::out) is det.
+
+erl_gen_trace_runtime_cond(TraceRuntimeCond, Statement, !Info) :-
+    % Generate a data representation of the trace runtime condition.
+    erl_generate_runtime_cond_expr(TraceRuntimeCond, CondExpr, !Info),
+
+    % Send the data representation of the condition to the server
+    % for interpretation.
+    %
+    % 'ML_erlang_global_server' !
+    %   {trace_evaluate_runtime_condition, CondExpr, self()},
+    %
+    Send = elds_send(ServerPid, SendMsg),
+    ServerPid = elds_term(elds_atom_raw("ML_erlang_global_server")),
+    SendMsg = elds_term(elds_tuple([
+        elds_term(elds_atom_raw("trace_evaluate_runtime_condition")),
+        CondExpr,
+        elds_call_self
+    ])),
+
+    % Wait for an answer, which will be `true' or `false'.
+    %
+    % receive
+    %   {trace_evaluate_runtime_condition_ack, Result} ->
+    %       Result
+    % end
+    %
+    erl_gen_info_new_named_var("Result", Result, !Info),
+    ResultExpr = expr_from_var(Result),
+
+    Receive = elds_receive([elds_case(AckPattern, ResultExpr)]),
+    AckPattern = elds_tuple([
+        elds_term(elds_atom_raw("trace_evaluate_runtime_condition_ack")),
+        ResultExpr
+    ]),
+
+    SendAndRecv = join_exprs(Send, Receive),
+
+    % case
+    %   (begin <send>, <receive> end)
+    % of
+    %   true  -> {};
+    %   false -> fail
+    % end
+    %
+    Statement = elds_case_expr(SendAndRecv, [TrueCase, FalseCase]),
+    TrueCase  = elds_case(elds_true, elds_term(elds_empty_tuple)),
+    FalseCase = elds_case(elds_false, elds_term(elds_fail)).
+
+    % Instead of generating code which evaluates whether the trace runtime
+    % condition is true, we generate a data representation of the condition and
+    % send it to the "Erlang global server" for interpretation.  The process
+    % dictionary of the server is initialised at startup with whether each
+    % environment variable was set or not, so it makes sense to evaluate the
+    % trace condition in the server.
+    %
+    % The data representation is straightforward:
+    %
+    %   COND  ::=   {env_var, STRING}
+    %           |   {'and', COND, COND}
+    %           |   {'or', COND, COND}
+    %           |   {'not', COND}
+    %
+:- pred erl_generate_runtime_cond_expr(trace_expr(trace_runtime)::in,
+    elds_expr::out, erl_gen_info::in, erl_gen_info::out) is det.
+
+erl_generate_runtime_cond_expr(TraceExpr, CondExpr, !Info) :-
+    (
+        TraceExpr = trace_base(trace_envvar(EnvVar)),
+        erl_gen_info_add_env_var_name(EnvVar, !Info),
+        Args = [
+            elds_term(elds_atom_raw("env_var")),
+            elds_term(elds_string(EnvVar))
+        ]
+    ;
+        TraceExpr = trace_not(ExprA),
+        erl_generate_runtime_cond_expr(ExprA, CondA, !Info),
+        Args = [elds_term(elds_atom_raw("not")), CondA]
+    ;
+        TraceExpr = trace_op(TraceOp, ExprA, ExprB),
+        erl_generate_runtime_cond_expr(ExprA, CondA, !Info),
+        erl_generate_runtime_cond_expr(ExprB, CondB, !Info),
+        (
+            TraceOp = trace_or,
+            Op = "or"
+        ;
+            TraceOp = trace_and,
+            Op = "and"
+        ),
+        Args = [elds_term(elds_atom_raw(Op)), CondA, CondB]
+    ),
+    CondExpr = elds_term(elds_tuple(Args)).
+
+%-----------------------------------------------------------------------------%
+
 :- func this_file = string.
 
 this_file = "erl_call_gen.m".
Index: compiler/erl_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_code_gen.m,v
retrieving revision 1.11
diff -u -r1.11 erl_code_gen.m
--- compiler/erl_code_gen.m	8 Jun 2007 00:47:09 -0000	1.11
+++ compiler/erl_code_gen.m	12 Jun 2007 07:53:42 -0000
@@ -195,16 +195,19 @@
     proc_info::in, list(elds_defn)::in, list(elds_defn)::out) is det.
 
 erl_gen_proc(ModuleInfo, PredId, ProcId, _PredInfo, _ProcInfo, !Defns) :-
-    erl_gen_proc_defn(ModuleInfo, PredId, ProcId, ProcVarSet, ProcBody),
-    ProcDefn = elds_defn(proc(PredId, ProcId), ProcVarSet, ProcBody),
+    erl_gen_proc_defn(ModuleInfo, PredId, ProcId, ProcVarSet, ProcBody,
+        EnvVarNames),
+    ProcDefn = elds_defn(proc(PredId, ProcId), ProcVarSet, ProcBody,
+        EnvVarNames),
     !:Defns = [ProcDefn | !.Defns].
 
     % Generate an ELDS definition for the specified procedure.
     %
 :- pred erl_gen_proc_defn(module_info::in, pred_id::in, proc_id::in,
-    prog_varset::out, elds_body::out) is det.
+    prog_varset::out, elds_body::out, set(string)::out) is det.
 
-erl_gen_proc_defn(ModuleInfo, PredId, ProcId, ProcVarSet, ProcBody) :-
+erl_gen_proc_defn(ModuleInfo, PredId, ProcId, ProcVarSet, ProcBody,
+        EnvVarNames) :-
     module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo),
     pred_info_get_import_status(PredInfo, ImportStatus),
     proc_info_interface_code_model(ProcInfo, CodeModel),
@@ -243,7 +246,8 @@
             ProcBody = body_defined_here(ProcClause)
         ),
 
-        erl_gen_info_get_varset(!.Info, ProcVarSet)
+        erl_gen_info_get_varset(!.Info, ProcVarSet),
+        erl_gen_info_get_env_vars(!.Info, EnvVarNames)
     ).
 
 :- pred erl_gen_proc_body(code_model::in, instmap::in, hlds_goal::in,
@@ -468,9 +472,6 @@
 erl_gen_goal_expr(scope(ScopeReason, Goal), CodeModel, Detism, InstMap,
         Context, MaybeSuccessExpr, Statement, !Info) :-
     (
-        ScopeReason = trace_goal(_, _, _, _, _),
-        sorry(this_file, "trace_goal scope in erlang code generator")
-    ;
         ( ScopeReason = promise_solutions(_, _)
         ; ScopeReason = commit(_)
         ),
@@ -481,6 +482,11 @@
         ; ScopeReason = promise_purity(_, _)
         ; ScopeReason = barrier(_)
         ; ScopeReason = from_ground_term(_)
+        ; ScopeReason = trace_goal(_, _, _, _, _)
+            % Trace goals with run-time conditions are transformed into
+            % if-then-else goals where the condition is a special foreign_proc
+            % call and the then branch is the actual trace goal (i.e. this
+            % goal).  Thus there is nothing special we have to do here.
         ),
         Goal = hlds_goal(GoalExpr, GoalInfo),
         goal_info_get_determinism(GoalInfo, GoalDetism),
@@ -1327,7 +1333,8 @@
     ( 
         search_elds_defn(ProcDefns, PredProcId, TargetProc)
     ->
-        TargetProc = elds_defn(_TargetPPId, _TargetVarSet, TargetBody),
+        TargetProc = elds_defn(_TargetPPId, _TargetVarSet, TargetBody,
+            _EnvVarNames),
         Arity = elds_body_arity(TargetBody),
 
         % ``Name(Vars, ...) -> PredProcId(Vars, ...)''
@@ -1344,7 +1351,7 @@
     elds_defn::out) is semidet.
 
 search_elds_defn([Defn0 | Defns], PredProcId, Defn) :-
-    ( Defn0 = elds_defn(PredProcId, _, _) ->
+    ( Defn0 = elds_defn(PredProcId, _, _, _) ->
         Defn = Defn0
     ;
         search_elds_defn(Defns, PredProcId, Defn)
Index: compiler/erl_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_code_util.m,v
retrieving revision 1.6
diff -u -r1.6 erl_code_util.m
--- compiler/erl_code_util.m	4 Jun 2007 06:24:19 -0000	1.6
+++ compiler/erl_code_util.m	12 Jun 2007 07:53:42 -0000
@@ -76,6 +76,16 @@
     %
 :- pred erl_variable_type(erl_gen_info::in, prog_var::in, mer_type::out) is det.
 
+    % Add the given string as the name of an environment variable used by
+    % the function being generated.
+    %
+:- pred erl_gen_info_add_env_var_name(string::in,
+    erl_gen_info::in, erl_gen_info::out) is det.
+
+    % Get the names of the used environment variables.
+    %
+:- pred erl_gen_info_get_env_vars(erl_gen_info::in, set(string)::out) is det.
+
 %-----------------------------------------------------------------------------%
 %
 % Various utility routines used for ELDS code generation
@@ -207,8 +217,8 @@
 :- type erl_gen_info
     --->    erl_gen_info(
                 % These fields remain constant for each procedure,
-                % except for the varset which can be added to as variables
-                % are introduced.
+                % except for the varset and the set of environment variables,
+                % which can be added to.
 
                 module_info         :: module_info,
                 pred_id             :: pred_id,
@@ -219,7 +229,10 @@
                 % input_vars and output_vars do not include variables of dummy
                 % types.
                 input_vars          :: prog_vars,
-                output_vars         :: prog_vars
+                output_vars         :: prog_vars,
+
+                % Set of environment variables used by this procedure.
+                env_var_names       :: set(string)
             ).
 
 erl_gen_info_init(ModuleInfo, PredId, ProcId) = Info :-
@@ -231,6 +244,7 @@
     pred_info_get_arg_types(PredInfo, HeadTypes),
     erl_gen_arg_list(ModuleInfo, opt_dummy_args,
         HeadVars, HeadTypes, HeadModes, InputVars, OutputVars),
+    EnvVars = set.init,
     Info = erl_gen_info(
         ModuleInfo,
         PredId,
@@ -238,7 +252,8 @@
         VarSet,
         VarTypes,
         InputVars,
-        OutputVars
+        OutputVars,
+        EnvVars
     ).
 
 erl_gen_info_get_module_info(Info, Info ^ module_info).
@@ -281,6 +296,13 @@
     erl_gen_info_get_var_types(Info, VarTypes),
     map.lookup(VarTypes, Var, Type).
 
+erl_gen_info_add_env_var_name(Name, !Info) :-
+    EnvVarNames0 = !.Info ^ env_var_names,
+    set.insert(EnvVarNames0, Name, EnvVarNames),
+    !:Info = !.Info ^ env_var_names := EnvVarNames.
+
+erl_gen_info_get_env_vars(Info, Info ^ env_var_names).
+
 %-----------------------------------------------------------------------------%
 %
 % Various utility routines used for ELDS code generation
@@ -454,6 +476,15 @@
         erl_rename_vars_in_expr(Subn, ExprA0, ExprA),
         Expr = elds_throw(ExprA)
     ;
+        Expr0 = elds_send(ExprA0, ExprB0),
+        erl_rename_vars_in_expr(Subn, ExprA0, ExprA),
+        erl_rename_vars_in_expr(Subn, ExprB0, ExprB),
+        Expr = elds_send(ExprA, ExprB)
+    ;
+        Expr0 = elds_receive(Cases0),
+        erl_rename_vars_in_cases(Subn, Cases0, Cases),
+        Expr = elds_receive(Cases)
+    ;
         ( Expr0 = elds_rtti_ref(_)
         ; Expr0 = elds_foreign_code(_)
         ),
@@ -600,6 +631,13 @@
         Expr = elds_throw(ExprA),
         erl_vars_in_expr(ExprA, !Set)
     ;
+        Expr = elds_send(ExprA, ExprB),
+        erl_vars_in_expr(ExprA, !Set),
+        erl_vars_in_expr(ExprB, !Set)
+    ;
+        Expr = elds_receive(Cases),
+        erl_vars_in_cases(Cases, !Set)
+    ;
         ( Expr = elds_rtti_ref(_)
         ; Expr = elds_foreign_code(_)
         )
@@ -718,6 +756,12 @@
         Expr = elds_throw(ExprA),
         Size = 1 + erl_expr_size(ExprA)
     ;
+        Expr = elds_send(ExprA, ExprB),
+        Size = 1 + erl_expr_size(ExprA) + erl_expr_size(ExprB)
+    ;
+        Expr = elds_receive(Cases),
+        Size = 1 + erl_cases_size(Cases)
+    ;
         Expr = elds_rtti_ref(_),
         Size = 1
     ;
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.211
diff -u -r1.211 simplify.m
--- compiler/simplify.m	28 May 2007 01:06:21 -0000	1.211
+++ compiler/simplify.m	12 Jun 2007 07:53:42 -0000
@@ -1513,11 +1513,13 @@
                             Target = target_c,
                             !:EvalAttributes = default_attributes(lang_c)
                         ;
+                            Target = target_erlang,
+                            !:EvalAttributes = default_attributes(lang_erlang)
+                        ;
                             ( Target = target_il
                             ; Target = target_java
                             ; Target = target_asm
                             ; Target = target_x86_64
-                            ; Target = target_erlang
                             ),
                             sorry(this_file, "NYI: runtime trace conditions "
                                 ++ "in languages other than C")
Index: library/erlang_builtin.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/erlang_builtin.m,v
retrieving revision 1.1
diff -u -r1.1 erlang_builtin.m
--- library/erlang_builtin.m	12 Jun 2007 06:53:58 -0000	1.1
+++ library/erlang_builtin.m	12 Jun 2007 07:53:42 -0000
@@ -72,6 +72,9 @@
 mutable_key(MutableName) ->
     {'ML_mutables', MutableName}.
 
+env_var_key(EnvVarName) ->
+    {'ML_env_vars', EnvVarName}.
+
 global_server_loop() ->
     receive
         {get_mutable, MutableName, From} ->
@@ -83,6 +86,21 @@
             put(mutable_key(MutableName), Value),
             global_server_loop();
 
+        {init_env_var, EnvVarName} ->
+            case os:getenv(EnvVarName) of
+                false ->
+                    Value = false;
+                _ ->
+                    Value = true
+            end,
+            put(env_var_key(EnvVarName), Value),
+            global_server_loop();
+
+        {trace_evaluate_runtime_condition, Cond, From} ->
+            Ret = trace_eval_runtime_cond(Cond),
+            From ! {trace_evaluate_runtime_condition_ack, Ret},
+            global_server_loop();
+
         {stop, From} ->
             From ! {stop_ack};
 
@@ -92,6 +110,15 @@
                 [Any]),
             global_server_loop()
     end.
+
+trace_eval_runtime_cond({env_var, EnvVarName}) ->
+    get(env_var_key(EnvVarName));
+trace_eval_runtime_cond({'not', Cond}) ->
+    not trace_eval_runtime_cond(Cond);
+trace_eval_runtime_cond({'or', CondA, CondB}) ->
+    trace_eval_runtime_cond(CondA) orelse trace_eval_runtime_cond(CondB);
+trace_eval_runtime_cond({'and', CondA, CondB}) ->
+    trace_eval_runtime_cond(CondA) andalso trace_eval_runtime_cond(CondB).
 ").
 
 %-----------------------------------------------------------------------------%
Index: util/mkinit_erl.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/util/mkinit_erl.c,v
retrieving revision 1.1
diff -u -r1.1 mkinit_erl.c
--- util/mkinit_erl.c	8 Jun 2007 00:47:16 -0000	1.1
+++ util/mkinit_erl.c	12 Jun 2007 07:53:42 -0000
@@ -112,7 +112,6 @@
 /*
 ** List of names of environment variables whose values should be sampled
 ** at initialization.
-** NOTE: the Erlang backend does not yet use these.
 */
 static const char   **mercury_env_vars = NULL;
 static int          mercury_env_var_max = 0;
@@ -263,6 +262,13 @@
     output_init_function(PURPOSE_REQ_FINAL,
         req_final_modules, req_final_module_next);
 
+    printf("init_env_vars() -> \n");
+    for (i = 0; i < mercury_env_var_next; i++) {
+        printf("\t'ML_erlang_global_server' ! {init_env_var, \"%s\"},\n",
+            mercury_env_vars[i]);
+    }
+    printf("\tvoid.\n");
+
     if (num_errors > 0) {
         fputs("% Force syntax error, since there were\n", stdout);
         fputs("% errors in the generation of this file\n", stdout);
@@ -503,26 +509,8 @@
         } else if (strncmp(line, envvar_str, envvar_strlen) == 0) {
             char    *envvar_name;
             int     i;
-            int     j;
             MR_bool found;
 
-            /*
-            ** Check that all characters in the name of the environment
-            ** variable are acceptable as components of a C variable name.
-            ** Note that the variable name doesn't have to start with a letter
-            ** because the variable name has a prefix.
-            */
-            for (j = envvar_strlen; MR_isalnumunder(line[j]); j++) {
-                /* VOID */
-            }
-
-            if (line[j] != '\n') {
-                printf("%s: error: bad environment variable name %s\n",
-                    MR_progname, line);
-            }
-
-            line[j] = '\0';     /* overwrite the newline */
-
             envvar_name = line + envvar_strlen;
 
             /*
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list