[m-rev.] For review: Introduce mode information for procedures in prog rep bytecode.

Paul Bone pbone at csse.unimelb.edu.au
Thu Oct 2 12:18:14 AEST 2008


For review by Zoltan.

Note, this will probably break some test cases for the declarative
debugger (but won't break the declarative debugger itself).  I'm
boot checking a decldebug grade now to check (and fix
them).

Estimated hours taken: 3
Branches: main

Modify the program representation bytecode to include mode information for the
head variables of a procedure.

Modes in the program representation bytecode and structure are represented as
an initial instantiation state, and a final instantiation state.  These can
have one of the three values each: free, ground, unknown.  Unknown is used to
map any instantiation state that is not free and not ground, since I'm not
prepared to handle them.

mdbcomp/program_representation.m:
    Introduce new types head_var_rep, var_mode_rep and inst_rep.
    Head variables of a proc_defn_rep structure now use the head_var_rep type.
    Add head_var_to_var function.
    Add code to read in mode information with head variables from progrep
    bytecode.
    Increment the Deep.procrep file format version number.
    Use a higher order abstraction to remove duplicated code.

compiler/prog_rep.m:
    Write out bytecodes for the modes of procedures' head variables.

deep_profiler/program_representation_utils.m:
    Conform to changes in mdbcomp/program_representation.m
    Print out the mode information for each variable in the head of a
    procedure.
    Use a higher order abstraction to remove duplicated code.

browser/declarative_tree.m:
    Conform to changes in mdbcomp/program_representation.m

runtime/mercury_deep_profiling.c:
    Increment the Deep.procrep file format version number.

Index: browser/declarative_tree.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_tree.m,v
retrieving revision 1.60
diff -u -p -b -r1.60 declarative_tree.m
--- browser/declarative_tree.m	21 Sep 2008 12:05:06 -0000	1.60
+++ browser/declarative_tree.m	1 Oct 2008 11:36:24 -0000
@@ -907,7 +907,7 @@ trace_dependency_in_proc_defn_rep(Store,
         StartLoc = cur_goal,
         Contour = Contour0
     ),
-    HeadVars = ProcDefnRep ^ pdr_head_vars,
+    HeadVars = list.map(head_var_to_var, ProcDefnRep ^ pdr_head_vars),
     GoalRep = ProcDefnRep ^ pdr_goal,
     is_traced_grade(AllTraced),
     MaybePrims = make_primitive_list(Store, 
@@ -947,7 +947,7 @@ trace_dependency_in_proc_defn_rep(Store,
 
 proc_defn_rep_is_catch_impl(ProcDefnRep) :-
     GoalRep = ProcDefnRep ^ pdr_goal,
-    HeadVars = ProcDefnRep ^ pdr_head_vars,
+    HeadVars = list.map(head_var_to_var, ProcDefnRep ^ pdr_head_vars),
     GoalExprRep = GoalRep ^ goal_expr_rep,
     HeadVars = [A, B, C, D],
     GoalExprRep = atomic_goal_rep("exception.m", _, [D],
@@ -1581,7 +1581,7 @@ find_variable_in_args(Args, ArgNum, Tota
     subterm_origin(edt_node(R))::out) is det <= annotated_trace(S, R).
 
 traverse_primitives([], Var0, TermPath0, _, ProcDefnRep, Origin) :-
-    HeadVars = ProcDefnRep ^ pdr_head_vars,
+    HeadVars = list.map(head_var_to_var, ProcDefnRep ^ pdr_head_vars),
     ArgPos = find_arg_pos(HeadVars, Var0),
     Origin = origin_input(ArgPos, TermPath0).
 traverse_primitives([Prim | Prims], Var0, TermPath0, Store, ProcDefnRep,
Index: compiler/prog_rep.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_rep.m,v
retrieving revision 1.64
diff -u -p -b -r1.64 prog_rep.m
--- compiler/prog_rep.m	30 Sep 2008 08:18:06 -0000	1.64
+++ compiler/prog_rep.m	2 Oct 2008 00:55:58 -0000
@@ -100,12 +100,14 @@ represent_proc_as_bytecodes(HeadVars, Go
     represent_var_table_as_bytecode(IncludeVarTable, VarNumMap, VarNumRep,
         VarTableBytes, !StackInfo),
     Info = prog_rep_info(FileName, VarTypes, VarNumMap, VarNumRep, ModuleInfo),
+    InstmapDelta = goal_info_get_instmap_delta(GoalInfo),
 
     string_to_byte_list(FileName, FileNameBytes, !StackInfo),
     goal_to_byte_list(Goal, InstMap0, Info, GoalBytes, !StackInfo),
     DetismByte = represent_determinism(ProcDetism),
     ProcRepBytes0 = FileNameBytes ++ VarTableBytes ++
-        vars_to_byte_list(Info, HeadVars) ++ GoalBytes ++ [DetismByte],
+        head_vars_to_byte_list(Info, InstMap0, InstmapDelta, HeadVars) ++
+        GoalBytes ++ [DetismByte],
     int32_to_byte_list(list.length(ProcRepBytes0) + 4, LimitBytes),
     ProcRepBytes = LimitBytes ++ ProcRepBytes0.
 
@@ -552,13 +554,6 @@ vars_to_byte_list(Info, Vars) =
     length_to_byte_list(Vars) ++
     list.condense(list.map(var_to_byte_list(Info), Vars)).
 
-:- func maybe_vars_to_byte_list(prog_rep_info, list(maybe(prog_var))) =
-    list(int).
-
-maybe_vars_to_byte_list(Info, Vars) =
-    length_to_byte_list(Vars) ++
-    list.condense(list.map(maybe_var_to_byte_list(Info), Vars)).
-
 :- func var_to_byte_list(prog_rep_info, prog_var) = list(int).
 
 var_to_byte_list(Info, Var) = Bytes :-
@@ -571,6 +566,13 @@ var_to_byte_list(Info, Var) = Bytes :-
         short_to_byte_list(VarNum, Bytes)
     ).
 
+:- func maybe_vars_to_byte_list(prog_rep_info, list(maybe(prog_var))) =
+    list(int).
+
+maybe_vars_to_byte_list(Info, Vars) =
+    length_to_byte_list(Vars) ++
+    list.condense(list.map(maybe_var_to_byte_list(Info), Vars)).
+
 :- func maybe_var_to_byte_list(prog_rep_info, maybe(prog_var)) = list(int).
 
 maybe_var_to_byte_list(Info, MaybeVar) = Bytes :-
@@ -584,6 +586,50 @@ maybe_var_to_byte_list(Info, MaybeVar) =
         Bytes = [0]
     ).
 
+:- func head_vars_to_byte_list(prog_rep_info, instmap, instmap_delta,
+    list(prog_var)) = list(int).
+
+head_vars_to_byte_list(Info, InitialInstmap, InstmapDelta, Vars) =
+    length_to_byte_list(Vars) ++
+    list.condense(list.map(
+        head_var_to_byte_list(Info, InitialInstmap, InstmapDelta), Vars)).
+
+:- func head_var_to_byte_list(prog_rep_info, instmap, instmap_delta,
+    prog_var) = list(int).
+
+head_var_to_byte_list(Info, InitialInstmap, InstmapDelta, Var) = Bytes :-
+    var_to_byte_list(Info, Var) = VarBytes,
+    ModuleInfo = Info ^ pri_module_info,
+    lookup_var(InitialInstmap, Var, InitialInst),
+    ( instmap_delta_search_var(InstmapDelta, Var, FinalInstPrime) ->
+        FinalInst = FinalInstPrime
+    ;
+        % if the variable is not in the instmap delta, then its instantiation
+        % cannot possibly change.  It has the same instantiation that it begun
+        % with.
+        FinalInst = InitialInst
+    ),
+    Bytes = VarBytes ++ [inst_to_byte(ModuleInfo, InitialInst),
+        inst_to_byte(ModuleInfo, FinalInst)].
+
+:- func inst_to_byte(module_info, mer_inst) = int.
+
+inst_to_byte(ModuleInfo, MerInst) = Byte :-
+    (
+        ( MerInst = free
+        ; MerInst = free(_)
+        )
+    ->
+        InstRep = ir_free
+    ;
+        inst_is_ground(ModuleInfo, MerInst)
+    ->
+        InstRep = ir_ground
+    ;
+        InstRep = ir_unknown
+    ),
+    inst_representation(InstRep, Byte).
+
 :- func length_to_byte_list(list(T)) = list(int).
 
 length_to_byte_list(List) = Bytes :-
Index: deep_profiler/program_representation_utils.m
===================================================================
RCS file: /home/mercury1/repository/mercury/deep_profiler/program_representation_utils.m,v
retrieving revision 1.11
diff -u -p -b -r1.11 program_representation_utils.m
--- deep_profiler/program_representation_utils.m	30 Sep 2008 08:18:09 -0000	1.11
+++ deep_profiler/program_representation_utils.m	2 Oct 2008 00:13:45 -0000
@@ -113,7 +113,7 @@ print_proc_to_strings(ProcRep, Strings) 
     ProcRep = proc_rep(ProcLabel, ProcDefnRep),
     ProcDefnRep = proc_defn_rep(ArgVarReps, GoalRep, VarTable, Detism),
     print_proc_label_to_strings(Detism, ProcLabel, ProcLabelString),
-    print_args_to_strings(VarTable, ArgVarReps, ArgsString),
+    print_args_to_strings(print_head_var, VarTable, ArgVarReps, ArgsString),
     print_goal_to_strings(VarTable, 1, GoalRep, GoalString),
     Strings = ProcLabelString ++ ArgsString ++ cord.singleton(" :-\n") ++
         GoalString ++ nl.
@@ -303,7 +303,7 @@ print_atomic_goal_to_strings(GoalAnnotat
         lookup_var_name(VarTable, VarRep, VarName),
         string.format(" %s %s %s", [s(VarName), s(UnifyOp), s(ConsIdRep)],
             UnifyString),
-        print_args_to_strings(VarTable, ArgReps, ArgsString),
+        print_args_to_strings(lookup_var_name, VarTable, ArgReps, ArgsString),
         Strings0 = cord.cons(UnifyString, ArgsString)
     ;
         (
@@ -318,7 +318,8 @@ print_atomic_goal_to_strings(GoalAnnotat
         lookup_var_name(VarTable, VarRep, VarName),
         string.format(" %s %s %s", [s(VarName), s(UnifyOp), s(ConsIdRep)],
             UnifyString),
-        print_maybe_args_to_strings(VarTable, MaybeArgReps, ArgsString),
+        print_args_to_strings(print_maybe_var, VarTable, MaybeArgReps,
+            ArgsString),
         Strings0 = cord.cons(UnifyString, ArgsString)
     ;
         AtomicGoalRep = unify_assign_rep(TargetRep, SourceRep),
@@ -340,14 +341,14 @@ print_atomic_goal_to_strings(GoalAnnotat
         Strings0 = cord.singleton(String)
     ;
         AtomicGoalRep = pragma_foreign_code_rep(Args),
-        print_args_to_strings(VarTable, Args, ArgsString),
+        print_args_to_strings(lookup_var_name, VarTable, Args, ArgsString),
         Strings0 = cord.singleton(" foreign_proc(") ++ ArgsString ++
             cord.singleton(")")
     ;
         AtomicGoalRep = higher_order_call_rep(HOVarRep, Args),
         lookup_var_name(VarTable, HOVarRep, HOVarName),
         string.format(" %s(", [s(HOVarName)], HeadString),
-        print_args_to_strings(VarTable, Args, ArgsString),
+        print_args_to_strings(lookup_var_name, VarTable, Args, ArgsString),
         Strings0 = cord.singleton(HeadString) ++ ArgsString ++
             cord.singleton(")")
     ;
@@ -355,23 +356,23 @@ print_atomic_goal_to_strings(GoalAnnotat
         lookup_var_name(VarTable, TCIVarRep, TCIVarName),
         string.format(" method %d of %s(", [i(MethodNumber), s(TCIVarName)],
             HeadString),
-        print_args_to_strings(VarTable, Args, ArgsString),
+        print_args_to_strings(lookup_var_name, VarTable, Args, ArgsString),
         Strings0 = cord.singleton(HeadString) ++ ArgsString ++
             cord.singleton(")")
     ;
         AtomicGoalRep = plain_call_rep(Module, Pred, Args),
         string.format(" %s.%s", [s(Module), s(Pred)], HeadString),
-        print_args_to_strings(VarTable, Args, ArgsString),
+        print_args_to_strings(lookup_var_name, VarTable, Args, ArgsString),
         Strings0 = cord.cons(HeadString, ArgsString)
     ;
         AtomicGoalRep = builtin_call_rep(Module, Pred, Args),
         string.format(" builtin %s.%s", [s(Module), s(Pred)], HeadString),
-        print_args_to_strings(VarTable, Args, ArgsString),
+        print_args_to_strings(lookup_var_name, VarTable, Args, ArgsString),
         Strings0 = cord.cons(HeadString, ArgsString)
     ;
         AtomicGoalRep = event_call_rep(Event, Args),
         string.format(" event %s", [s(Event)], HeadString),
-        print_args_to_strings(VarTable, Args, ArgsString),
+        print_args_to_strings(lookup_var_name, VarTable, Args, ArgsString),
         Strings0 = cord.cons(HeadString, ArgsString)
     ),
     detism_to_string(DetismRep, DetismString),
@@ -380,58 +381,53 @@ print_atomic_goal_to_strings(GoalAnnotat
 
 %-----------------------------------------------------------------------------%
 
-:- pred print_args_to_strings(var_table::in, list(var_rep)::in,
-    cord(string)::out) is det.
+:- pred print_args_to_strings(pred(var_table, T, string), var_table,
+    list(T), cord(string)).
+:- mode print_args_to_strings(pred(in, in, out) is det, in, in, out) is det.
 
-print_args_to_strings(VarTable, Args, Strings) :-
+print_args_to_strings(PrintArg, VarTable, Args, Strings) :-
     (
         Args = [],
         Strings = cord.empty
     ;
         Args = [_ | _],
-        print_args_2_to_strings(VarTable, Args, cord.empty, ArgsStr),
+        print_args_2_to_strings(PrintArg, VarTable, Args, cord.empty, ArgsStr),
         Strings = cord.cons("(", cord.snoc(ArgsStr, ")"))
     ).
 
-:- pred print_args_2_to_strings(var_table::in, list(var_rep)::in,
-    cord(string)::in, cord(string)::out) is det.
+:- pred print_args_2_to_strings(pred(var_table, T, string), var_table,
+    list(T), cord(string), cord(string)).
+:- mode print_args_2_to_strings(pred(in, in, out) is det, in, in, in, out) 
+    is det.
 
-print_args_2_to_strings(_, [], _, cord.empty).
-print_args_2_to_strings(VarTable, [VarRep | VarReps], Prefix, Strings) :-
-    lookup_var_name(VarTable, VarRep, VarName),
-    print_args_2_to_strings(VarTable, VarReps, cord.singleton(", "),
+print_args_2_to_strings(_, _, [], _, cord.empty).
+print_args_2_to_strings(PrintArg, VarTable, [Arg | Args], Prefix, Strings) :-
+    PrintArg(VarTable, Arg, ArgName),
+    print_args_2_to_strings(PrintArg, VarTable, Args, cord.singleton(", "),
         ArgsString),
-    Strings = Prefix ++ cord.cons(VarName, ArgsString).
+    Strings = Prefix ++ cord.cons(ArgName, ArgsString).
 
-:- pred print_maybe_args_to_strings(var_table::in, list(maybe(var_rep))::in,
-    cord(string)::out) is det.
+:- pred print_maybe_var(var_table::in, maybe(var_rep)::in, string::out) is det.
 
-print_maybe_args_to_strings(VarTable, MaybeArgs, Strings) :-
-    (
-        MaybeArgs = [],
-        Strings = cord.empty
-    ;
-        MaybeArgs = [_ | _],
-        print_maybe_args_2_to_strings(VarTable, MaybeArgs, cord.empty, ArgsStr),
-        Strings = cord.cons("(", cord.snoc(ArgsStr, ")"))
-    ).
+print_maybe_var(_, no, "_").
+print_maybe_var(VarTable, yes(VarRep), VarName) :-
+    lookup_var_name(VarTable, VarRep, VarName).
 
-:- pred print_maybe_args_2_to_strings(var_table::in, list(maybe(var_rep))::in,
-    cord(string)::in, cord(string)::out) is det.
+:- pred print_head_var(var_table::in, head_var_rep::in, string::out) is det. 
 
-print_maybe_args_2_to_strings(_, [], _, cord.empty).
-print_maybe_args_2_to_strings(VarTable, [MaybeVarRep | MaybeVarReps], Prefix,
-        Strings) :-
-    (
-        MaybeVarRep = no,
-        VarName = "_"
-    ;
-        MaybeVarRep = yes(VarRep),
-        lookup_var_name(VarTable, VarRep, VarName)
-    ),
-    print_maybe_args_2_to_strings(VarTable, MaybeVarReps, cord.singleton(", "),
-        ArgsString),
-    Strings = Prefix ++ cord.cons(VarName, ArgsString).
+print_head_var(VarTable, head_var_rep(VarRep, VarMode), String) :-
+    lookup_var_name(VarTable, VarRep, VarName),
+    VarMode = var_mode_rep(InitialInst, FinalInst),
+    inst_rep_to_string(InitialInst, InitialInstStr),
+    inst_rep_to_string(FinalInst, FinalInstStr),
+    String = string.format("%s::(%s >> %s)", 
+        [s(VarName), s(InitialInstStr), s(FinalInstStr)]).
+
+:- pred inst_rep_to_string(inst_rep::in, string::out) is det.
+
+inst_rep_to_string(ir_free, "free").
+inst_rep_to_string(ir_ground, "ground").
+inst_rep_to_string(ir_unknown, "unknown").
 
 :- func indent(int) = cord(string).
 
Index: mdbcomp/program_representation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/mdbcomp/program_representation.m,v
retrieving revision 1.41
diff -u -p -b -r1.41 program_representation.m
--- mdbcomp/program_representation.m	30 Sep 2008 08:18:11 -0000	1.41
+++ mdbcomp/program_representation.m	1 Oct 2008 11:26:10 -0000
@@ -130,7 +130,7 @@
     --->    proc_defn_rep(
                 % The head variables, in order, including the ones introduced
                 % by the compiler.
-                pdr_head_vars           :: list(var_rep),
+                pdr_head_vars           :: list(head_var_rep),
 
                 % The procedure body.
                 pdr_goal                :: goal_rep(GoalAnnotation),
@@ -304,6 +304,26 @@
 
 :- type var_rep ==  int.
 
+:- type head_var_rep 
+    --->    head_var_rep(
+                head_var_var        :: var_rep,
+                head_var_mode       :: var_mode_rep
+            ).
+
+:- type var_mode_rep
+    --->    var_mode_rep(
+                vm_initial_inst     :: inst_rep,
+                vm_final_inst       :: inst_rep
+            ).
+
+:- type inst_rep
+    --->    ir_free
+    ;       ir_ground
+    ;       ir_unknown.
+                % Instantiation states that arn't understood by the bytecode
+                % representation are grouped within this value.  These include
+                % any and bound.
+
 :- type cons_id_arity_rep
     --->    cons_id_arity_rep(
                 cons_id_rep,
@@ -364,6 +384,8 @@
 :- func atomic_goal_identifiable(atomic_goal_rep) =
     maybe(atomic_goal_id).
 
+:- func head_var_to_var(head_var_rep) = var_rep.
+
 %-----------------------------------------------------------------------------%
 
     % Describe a call site.
@@ -548,6 +570,10 @@
 :- mode determinism_representation(in, out) is det.
 :- mode determinism_representation(out, in) is semidet.
 
+:- pred inst_representation(inst_rep, int).
+:- mode inst_representation(in, out) is det.
+:- mode inst_representation(out, in) is semidet.
+
 :- type bytecode_goal_type
     --->    goal_conj
     ;       goal_disj
@@ -732,6 +758,8 @@ atomic_goal_identifiable(plain_call_rep(
     yes(atomic_goal_id(Module, Name, length(Args))).
 atomic_goal_identifiable(event_call_rep(_, _)) = no.
 
+head_var_to_var(head_var_rep(Var, _)) = Var.
+
 :- pragma foreign_export("C", proc_defn_rep_type = out,
     "ML_proc_defn_rep_type").
 
@@ -887,6 +915,10 @@ determinism_representation(failure_rep, 
 determinism_representation(cc_nondet_rep, 10).
 determinism_representation(cc_multidet_rep, 14).
 
+inst_representation(ir_free, 0).
+inst_representation(ir_ground, 1).
+inst_representation(ir_unknown, 2).
+
 goal_type_to_byte(Type) = TypeInt :-
     goal_type_byte(TypeInt, Type).
 
@@ -1037,7 +1069,7 @@ read_prog_rep_file(FileName, Result, !IO
     %
 :- func procrep_id_string = string.
 
-procrep_id_string = "Mercury deep profiler procrep version 4\n".
+procrep_id_string = "Mercury deep profiler procrep version 5\n".
 
 :- pred read_module_reps(bytecode::in,
     module_map(unit)::in, module_map(unit)::out,
@@ -1090,7 +1122,7 @@ read_proc_rep(ByteCode, StringTable, Pro
     read_string_via_offset(ByteCode, StringTable, FileName, !Pos),
     Info = read_proc_rep_info(FileName),
     read_var_table(ByteCode, StringTable, VarNumRep, VarTable, !Pos),
-    read_vars(VarNumRep, ByteCode, HeadVars, !Pos),
+    read_head_vars(VarNumRep, ByteCode, HeadVars, !Pos),
     read_goal(VarNumRep, ByteCode, StringTable, Info, Goal, !Pos),
     read_determinism(ByteCode, Detism, !Pos),
     ProcDefnRep = proc_defn_rep(HeadVars, Goal, VarTable, Detism),
@@ -1190,7 +1222,7 @@ trace_read_proc_defn_rep(Bytes, LabelLay
         read_string_via_offset(ByteCode, StringTable, FileName, !Pos),
         Info = read_proc_rep_info(FileName),
         read_var_table(ByteCode, StringTable, VarNumRep, VarTable, !Pos),
-        read_vars(VarNumRep, ByteCode, HeadVars, !Pos),
+        read_head_vars(VarNumRep, ByteCode, HeadVars, !Pos),
         read_goal(VarNumRep, ByteCode, StringTable, Info, Goal, !Pos),
         read_determinism(ByteCode, Detism, !Pos),
         ProcDefnRep = proc_defn_rep(HeadVars, Goal, VarTable, Detism),
@@ -1370,21 +1402,8 @@ read_atomic_info(VarNumRep, ByteCode, St
 
 read_goals(VarNumRep, ByteCode, StringTable, Info, Goals, !Pos) :-
     read_length(ByteCode, Len, !Pos),
-    read_goals_2(VarNumRep, ByteCode, StringTable, Info, Len, Goals, !Pos).
-
-:- pred read_goals_2(var_num_rep::in, bytecode::in, string_table::in,
-    read_proc_rep_info::in, int::in, list(goal_rep)::out, int::in, int::out)
-    is semidet.
-
-read_goals_2(VarNumRep, ByteCode, StringTable, Info, N, Goals, !Pos) :-
-    ( N > 0 ->
-        read_goal(VarNumRep, ByteCode, StringTable, Info, Head, !Pos),
-        read_goals_2(VarNumRep, ByteCode, StringTable, Info, N - 1, Tail,
-            !Pos),
-        Goals = [Head | Tail]
-    ;
-        Goals = []
-    ).
+    read_n_items(read_goal(VarNumRep, ByteCode, StringTable, Info), Len, Goals,
+        !Pos). 
 
 :- pred read_cases(var_num_rep::in, bytecode::in, string_table::in,
     read_proc_rep_info::in, list(case_rep(unit))::out, int::in, int::out)
@@ -1392,26 +1411,20 @@ read_goals_2(VarNumRep, ByteCode, String
 
 read_cases(VarNumRep, ByteCode, StringTable, Info, Cases, !Pos) :-
     read_length(ByteCode, Len, !Pos),
-    read_cases_2(VarNumRep, ByteCode, StringTable, Info, Len, Cases, !Pos).
+    read_n_items(read_case(VarNumRep, ByteCode, StringTable, Info), Len, Cases,
+        !Pos).
 
-:- pred read_cases_2(var_num_rep::in, bytecode::in, string_table::in,
-    read_proc_rep_info::in, int::in, list(case_rep(unit))::out,
+:- pred read_case(var_num_rep::in, bytecode::in, string_table::in,
+    read_proc_rep_info::in, case_rep(unit)::out,
     int::in, int::out) is semidet.
 
-read_cases_2(VarNumRep, ByteCode, StringTable, Info, N, Cases, !Pos) :-
-    ( N > 0 ->
+read_case(VarNumRep, ByteCode, StringTable, Info, Case, !Pos) :-
         read_cons_id_arity(ByteCode, StringTable, MainConsId, !Pos),
         read_length(ByteCode, NumOtherConsIds, !Pos),
-        read_n_cons_id_arities(ByteCode, StringTable, NumOtherConsIds,
+    read_n_items(read_cons_id_arity(ByteCode, StringTable), NumOtherConsIds,
             OtherConsIds, !Pos),
         read_goal(VarNumRep, ByteCode, StringTable, Info, Goal, !Pos),
-        Head = case_rep(MainConsId, OtherConsIds, Goal),
-        read_cases_2(VarNumRep, ByteCode, StringTable, Info, N - 1, Tail,
-            !Pos),
-        Cases = [Head | Tail]
-    ;
-        Cases = []
-    ).
+    Case = case_rep(MainConsId, OtherConsIds, Goal).
 
 :- pred read_cons_id_arity(bytecode::in, string_table::in,
     cons_id_arity_rep::out, int::in, int::out) is semidet.
@@ -1421,35 +1434,23 @@ read_cons_id_arity(ByteCode, StringTable
     read_short(ByteCode, ConsIdArity, !Pos),
     ConsId = cons_id_arity_rep(ConsIdFunctor, ConsIdArity).
 
-:- pred read_n_cons_id_arities(bytecode::in, string_table::in, int::in,
-    list(cons_id_arity_rep)::out, int::in, int::out) is semidet.
-
-read_n_cons_id_arities(ByteCode, StringTable, N, ConsIds, !Pos) :-
-    ( N > 0 ->
-        read_cons_id_arity(ByteCode, StringTable, Head, !Pos),
-        read_n_cons_id_arities(ByteCode, StringTable, N - 1, Tail, !Pos),
-        ConsIds = [Head | Tail]
-    ;
-        ConsIds = []
-    ).
-
 :- pred read_vars(var_num_rep::in, bytecode::in, list(var_rep)::out,
     int::in, int::out) is semidet.
 
 read_vars(VarNumRep, ByteCode, Vars, !Pos) :-
     read_length(ByteCode, Len, !Pos),
-    read_vars_2(VarNumRep, ByteCode, Len, Vars, !Pos).
+    read_n_items(read_var(VarNumRep, ByteCode), Len, Vars, !Pos).
 
-:- pred read_vars_2(var_num_rep::in, bytecode::in, int::in,
-    list(var_rep)::out, int::in, int::out) is semidet.
+:- pred read_var(var_num_rep::in, bytecode::in, var_rep::out,
+    int::in, int::out) is semidet.
 
-read_vars_2(VarNumRep, ByteCode, N, Vars, !Pos) :-
-    ( N > 0 ->
-        read_var(VarNumRep, ByteCode, Head, !Pos),
-        read_vars_2(VarNumRep, ByteCode, N - 1, Tail, !Pos),
-        Vars = [Head | Tail]
+read_var(VarNumRep, ByteCode, Var, !Pos) :-
+    (
+        VarNumRep = byte,
+        read_byte(ByteCode, Var, !Pos)
     ;
-        Vars = []
+        VarNumRep = short,
+        read_short(ByteCode, Var, !Pos)
     ).
 
 :- pred read_maybe_vars(var_num_rep::in, bytecode::in,
@@ -1457,39 +1458,43 @@ read_vars_2(VarNumRep, ByteCode, N, Vars
 
 read_maybe_vars(VarNumRep, ByteCode, MaybeVars, !Pos) :-
     read_length(ByteCode, Len, !Pos),
-    read_maybe_vars_2(VarNumRep, ByteCode, Len, MaybeVars, !Pos).
+    read_n_items(read_maybe_var(VarNumRep, ByteCode), Len, MaybeVars, !Pos).
 
-:- pred read_maybe_vars_2(var_num_rep::in, bytecode::in, int::in,
-    list(maybe(var_rep))::out, int::in, int::out) is semidet.
+:- pred read_maybe_var(var_num_rep::in, bytecode::in,
+    maybe(var_rep)::out, int::in, int::out) is semidet.
 
-read_maybe_vars_2(VarNumRep, ByteCode, N, MaybeVars, !Pos) :-
-    ( N > 0 ->
+read_maybe_var(VarNumRep, ByteCode, MaybeVar, !Pos) :-
         read_byte(ByteCode, YesOrNo, !Pos),
         ( YesOrNo = 1 ->
-            read_var(VarNumRep, ByteCode, Head, !Pos),
-            MaybeHead = yes(Head)
+        read_var(VarNumRep, ByteCode, Var, !Pos),
+        MaybeVar = yes(Var)
         ; YesOrNo = 0 ->
-            MaybeHead = no
+        MaybeVar = no
         ;
-            error("read_maybe_vars_2: invalid yes or no flag")
-        ),
-        read_maybe_vars_2(VarNumRep, ByteCode, N - 1, Tail, !Pos),
-        MaybeVars = [MaybeHead | Tail]
-    ;
-        MaybeVars = []
+        error("read_maybe_var: invalid yes or no flag")
     ).
 
-:- pred read_var(var_num_rep::in, bytecode::in, var_rep::out,
+:- pred read_head_vars(var_num_rep::in, bytecode::in,
+    list(head_var_rep)::out, int::in, int::out) is semidet.
+
+read_head_vars(VarNumRep, ByteCode, HeadVars, !Pos) :-
+    read_length(ByteCode, Len, !Pos),
+    read_n_items(read_head_var(VarNumRep, ByteCode), Len, HeadVars, !Pos).
+
+:- pred read_head_var(var_num_rep::in, bytecode::in, head_var_rep::out, 
     int::in, int::out) is semidet.
 
-read_var(VarNumRep, ByteCode, Var, !Pos) :-
-    (
-        VarNumRep = byte,
-        read_byte(ByteCode, Var, !Pos)
-    ;
-        VarNumRep = short,
-        read_short(ByteCode, Var, !Pos)
-    ).
+read_head_var(VarNumRep, ByteCode, HeadVar, !Pos) :-
+    read_var(VarNumRep, ByteCode, Var, !Pos),
+    read_inst(ByteCode, InitialInst, !Pos),
+    read_inst(ByteCode, FinalInst, !Pos),
+    HeadVar = head_var_rep(Var, var_mode_rep(InitialInst, FinalInst)).
+
+:- pred read_inst(bytecode::in, inst_rep::out, int::in, int::out) is semidet.
+
+read_inst(ByteCode, Inst, !Pos) :-
+    read_byte(ByteCode, Byte, !Pos),
+    inst_representation(Inst, Byte).
 
 :- pred read_length(bytecode::in, var_rep::out, int::in, int::out) is semidet.
 
@@ -1553,6 +1558,23 @@ read_switch_can_fail(Bytecode, CanFail, 
         error("read_goal: bad switch_can_fail")
     ).
 
+    % An abstraction to read the given number of items using the higher order
+    % predicate.
+    %
+:- pred read_n_items(pred(T, int, int), int, list(T), int, int).
+:- mode read_n_items(pred(out, in, out) is det, in, out, in, out) is det.
+:- mode read_n_items(pred(out, in, out) is semidet, in, out, in, out) 
+    is semidet.
+
+read_n_items(Read, N, Items, !Pos) :-
+    ( N > 0 ->
+        Read(Item, !Pos),
+        read_n_items(Read, N - 1, TailItems, !Pos),
+        Items = [ Item | TailItems ]
+    ;
+        Items = []
+    ).
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
Index: runtime/mercury_deep_profiling.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_profiling.c,v
retrieving revision 1.33
diff -u -p -b -r1.33 mercury_deep_profiling.c
--- runtime/mercury_deep_profiling.c	21 Sep 2008 12:05:06 -0000	1.33
+++ runtime/mercury_deep_profiling.c	1 Oct 2008 08:17:46 -0000
@@ -711,7 +711,7 @@ MR_write_out_procrep_id_string(FILE *fp)
     ** Must be the same as procrep_id_string in
     ** mdbcomp/program_representation.m
     */
-    const char  *id_string = "Mercury deep profiler procrep version 4\n";
+    const char  *id_string = "Mercury deep profiler procrep version 5\n";
 
     fputs(id_string, fp);
 }

-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 189 bytes
Desc: Digital signature
URL: <http://lists.mercurylang.org/archives/reviews/attachments/20081002/b5400122/attachment.sig>


More information about the reviews mailing list