[m-rev.] diff: explicit disjunctions for predicates working on insts
Zoltan Somogyi
zs at unimelb.edu.au
Mon Apr 16 20:48:48 AEST 2012
compiler/add_pragma.m:
compiler/prog_mode.m:
Convert several predicates operating on insts from multiple clauses
to explicit disjunctions, some wrapped in require_complete_switch
scopes.
Make inst_contains_unconstrained_var treat the higher order info
in any insts the same as the one in ground insts. It shouldn't make
any difference now, but maybe later ...
Add XXXs where I think, but am not sure, that the behavior of the
predicate is wrong.
Zoltan.
cvs diff: Diffing .
Index: add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.125
diff -u -b -r1.125 add_pragma.m
--- add_pragma.m 13 Feb 2012 00:11:33 -0000 1.125
+++ add_pragma.m 16 Apr 2012 09:54:34 -0000
@@ -3684,25 +3684,24 @@
inst_name::in, inst_name::in, inst_var_renaming::out) is semidet.
match_inst_names_with_renaming(ModuleInfo, InstNameA, InstNameB, Renaming) :-
+ (
InstNameA = user_inst(Name, ArgsA),
InstNameB = user_inst(Name, ArgsB),
match_corresponding_inst_lists_with_renaming(ModuleInfo,
- ArgsA, ArgsB, map.init, Renaming).
-%
-% XXX The rest of these are introduced by the compiler, it doesn't
-% look like they need any special treatment.
-%
-match_inst_names_with_renaming(_, Inst @ merge_inst(_, _), Inst, map.init).
-match_inst_names_with_renaming(_, Inst @ unify_inst(_, _, _, _), Inst,
- map.init).
-match_inst_names_with_renaming(_, Inst @ ground_inst(_, _, _, _), Inst,
- map.init).
-match_inst_names_with_renaming(_, Inst @ any_inst(_, _, _, _), Inst,
- map.init).
-match_inst_names_with_renaming(_, Inst @ shared_inst(_), Inst, map.init).
-match_inst_names_with_renaming(_, Inst @ mostly_uniq_inst(_), Inst, map.init).
-match_inst_names_with_renaming(_, Inst @ typed_ground(_, _), Inst, map.init).
-match_inst_names_with_renaming(_, Inst @ typed_inst(_, _), Inst, map.init).
+ ArgsA, ArgsB, map.init, Renaming)
+ ;
+ % XXX The rest of these are introduced by the compiler, it doesn't
+ % look like they need any special treatment.
+ ( InstNameA = merge_inst(_, _)
+ ; InstNameA = unify_inst(_, _, _, _)
+ ; InstNameA = ground_inst(_, _, _, _)
+ ; InstNameA = any_inst(_, _, _, _)
+ ; InstNameA = shared_inst(_)
+ ; InstNameA = mostly_uniq_inst(_)
+ ),
+ InstNameB = InstNameA,
+ Renaming = map.init
+ ).
:- pred merge_inst_var_renamings(inst_var_renaming::in,
inst_var_renaming::in, inst_var_renaming::out) is semidet.
Index: prog_mode.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_mode.m,v
retrieving revision 1.27
diff -u -b -r1.27 prog_mode.m
--- prog_mode.m 13 Feb 2012 00:11:46 -0000 1.27
+++ prog_mode.m 16 Apr 2012 10:09:52 -0000
@@ -459,61 +459,85 @@
%-----------------------------------------------------------------------------%
-inst_contains_unconstrained_var(bound(_Uniqueness, BoundInsts)) :-
+inst_contains_unconstrained_var(Inst) :-
+ require_complete_switch [Inst]
+ (
+ Inst = bound(_Uniq, BoundInsts),
list.member(BoundInst, BoundInsts),
BoundInst = bound_functor(_ConsId, ArgInsts),
list.member(ArgInst, ArgInsts),
- inst_contains_unconstrained_var(ArgInst).
-inst_contains_unconstrained_var(ground(_Uniqueness, GroundInstInfo)) :-
+ inst_contains_unconstrained_var(ArgInst)
+ ;
+ ( Inst = ground(_Uniq, GroundInstInfo)
+ ; Inst = any(_Uniq, GroundInstInfo)
+ ),
GroundInstInfo = higher_order(PredInstInfo),
- PredInstInfo = pred_inst_info(_PredOrFunc, Modes, _MaybeArgRegs, _Detism),
+ PredInstInfo = pred_inst_info(_PredOrFunc, Modes, _MaybeArgRegs,
+ _Detism),
list.member(Mode, Modes),
(
- Mode = (Inst -> _)
+ Mode = (SubInst -> _)
;
- Mode = (_ -> Inst)
+ Mode = (_ -> SubInst)
;
- Mode = user_defined_mode(_SymName, Insts),
- list.member(Inst, Insts)
+ Mode = user_defined_mode(_SymName, SubInsts),
+ list.member(SubInst, SubInsts)
),
- inst_contains_unconstrained_var(Inst).
-inst_contains_unconstrained_var(inst_var(_InstVar)).
-inst_contains_unconstrained_var(defined_inst(InstName)) :-
+ inst_contains_unconstrained_var(SubInst)
+ ;
+ Inst = inst_var(_InstVar)
+ ;
+ Inst = defined_inst(InstName),
(
- InstName = user_inst(_, Insts),
- list.member(Inst, Insts),
- inst_contains_unconstrained_var(Inst)
+ InstName = user_inst(_, SubInsts),
+ list.member(SubInst, SubInsts),
+ inst_contains_unconstrained_var(SubInst)
;
- InstName = merge_inst(Inst, _),
- inst_contains_unconstrained_var(Inst)
+ InstName = merge_inst(SubInst, _),
+ inst_contains_unconstrained_var(SubInst)
;
- InstName = merge_inst(_, Inst),
- inst_contains_unconstrained_var(Inst)
+ InstName = merge_inst(_, SubInst),
+ inst_contains_unconstrained_var(SubInst)
;
- InstName = unify_inst(_, Inst, _, _),
- inst_contains_unconstrained_var(Inst)
+ InstName = unify_inst(_, SubInstA, SubInstB, _),
+ (
+ inst_contains_unconstrained_var(SubInstA)
+ ;
+ inst_contains_unconstrained_var(SubInstB)
+ )
+ ;
+ InstName = ground_inst(SubInstName, _, _, _),
+ inst_contains_unconstrained_var(defined_inst(SubInstName))
;
- InstName = unify_inst(_, _, Inst, _),
- inst_contains_unconstrained_var(Inst)
+ InstName = any_inst(SubInstName, _, _, _),
+ inst_contains_unconstrained_var(defined_inst(SubInstName))
;
- InstName = ground_inst(InstName1, _, _, _),
- inst_contains_unconstrained_var(defined_inst(InstName1))
+ InstName = shared_inst(SubInstName),
+ inst_contains_unconstrained_var(defined_inst(SubInstName))
;
- InstName = any_inst(InstName1, _, _, _),
- inst_contains_unconstrained_var(defined_inst(InstName1))
+ InstName = mostly_uniq_inst(SubInstName),
+ inst_contains_unconstrained_var(defined_inst(SubInstName))
;
- InstName = shared_inst(InstName1),
- inst_contains_unconstrained_var(defined_inst(InstName1))
+ InstName = typed_inst(_, SubInstName),
+ inst_contains_unconstrained_var(defined_inst(SubInstName))
+ )
;
- InstName = mostly_uniq_inst(InstName1),
- inst_contains_unconstrained_var(defined_inst(InstName1))
+ Inst = abstract_inst(_SymName, SubInsts),
+ list.member(SubInst, SubInsts),
+ inst_contains_unconstrained_var(SubInst)
+ ;
+ ( Inst = not_reached
+ ; Inst = free
+ ; Inst = free(_)
+ ),
+ fail
;
- InstName = typed_inst(_, InstName1),
- inst_contains_unconstrained_var(defined_inst(InstName1))
+ Inst = constrained_inst_vars(_, _),
+ % XXX Is this the right thing to do here? Just because Inst constrains
+ % SOME of the instvars in it, it does not necessarily constrain all.
+ % What we do here preserves the old behavior of this predicate.
+ fail
).
-inst_contains_unconstrained_var(abstract_inst(_SymName, Insts)) :-
- list.member(Inst, Insts),
- inst_contains_unconstrained_var(Inst).
%-----------------------------------------------------------------------------%
@@ -533,23 +557,30 @@
%-----------------------------------------------------------------------------%
-get_arg_insts(not_reached, _ConsId, Arity, ArgInsts) :-
- list.duplicate(Arity, not_reached, ArgInsts).
-get_arg_insts(ground(Uniq, _PredInst), _ConsId, Arity, ArgInsts) :-
- list.duplicate(Arity, ground(Uniq, none), ArgInsts).
-get_arg_insts(bound(_Uniq, List), ConsId, Arity, ArgInsts) :-
+get_arg_insts(Inst, ConsId, Arity, ArgInsts) :-
+ (
+ Inst = not_reached,
+ list.duplicate(Arity, not_reached, ArgInsts)
+ ;
+ Inst = ground(Uniq, _PredInst),
+ list.duplicate(Arity, ground(Uniq, none), ArgInsts)
+ ;
+ Inst = bound(_Uniq, List),
( get_arg_insts_2(List, ConsId, ArgInsts0) ->
ArgInsts = ArgInsts0
;
% The code is unreachable.
list.duplicate(Arity, not_reached, ArgInsts)
+ )
+ ;
+ ( Inst = free
+ ; Inst = free(_)
+ ),
+ list.duplicate(Arity, free, ArgInsts)
+ ;
+ Inst = any(Uniq, _),
+ list.duplicate(Arity, any(Uniq, none), ArgInsts)
).
-get_arg_insts(free, _ConsId, Arity, ArgInsts) :-
- list.duplicate(Arity, free, ArgInsts).
-get_arg_insts(free(_Type), _ConsId, Arity, ArgInsts) :-
- list.duplicate(Arity, free, ArgInsts).
-get_arg_insts(any(Uniq, _), _ConsId, Arity, ArgInsts) :-
- list.duplicate(Arity, any(Uniq, none), ArgInsts).
:- pred get_arg_insts_2(list(bound_inst)::in, cons_id::in, list(mer_inst)::out)
is semidet.
@@ -568,21 +599,28 @@
mode_id_to_int(mode_id(_, X), X).
%-----------------------------------------------------------------------------%
+%
+% The active part of this code is strip_builtin_qualifier_from_sym_name;
+% the rest is basically just recursive traversals to get there.
+%
- % The interesting part is strip_builtin_qualifier_from_sym_name;
- % the rest is basically just recursive traversals.
strip_builtin_qualifiers_from_mode_list(Modes0, Modes) :-
list.map(strip_builtin_qualifiers_from_mode, Modes0, Modes).
:- pred strip_builtin_qualifiers_from_mode(mer_mode::in, mer_mode::out) is det.
-strip_builtin_qualifiers_from_mode((Initial0 -> Final0), (Initial -> Final)) :-
+strip_builtin_qualifiers_from_mode(Mode0, Mode) :-
+ (
+ Mode0 = (Initial0 -> Final0),
strip_builtin_qualifiers_from_inst(Initial0, Initial),
- strip_builtin_qualifiers_from_inst(Final0, Final).
-strip_builtin_qualifiers_from_mode(user_defined_mode(SymName0, Insts0),
- user_defined_mode(SymName, Insts)) :-
+ strip_builtin_qualifiers_from_inst(Final0, Final),
+ Mode = (Initial -> Final)
+ ;
+ Mode0 = user_defined_mode(SymName0, Insts0),
strip_builtin_qualifiers_from_inst_list(Insts0, Insts),
- strip_builtin_qualifier_from_sym_name(SymName0, SymName).
+ strip_builtin_qualifier_from_sym_name(SymName0, SymName),
+ Mode = user_defined_mode(SymName, Insts)
+ ).
strip_builtin_qualifier_from_cons_id(ConsId0, ConsId) :-
( ConsId0 = cons(Name0, Arity, TypeCtor) ->
@@ -608,28 +646,40 @@
strip_builtin_qualifiers_from_inst_list(Insts0, Insts) :-
list.map(strip_builtin_qualifiers_from_inst, Insts0, Insts).
-strip_builtin_qualifiers_from_inst(inst_var(V), inst_var(V)).
-strip_builtin_qualifiers_from_inst(constrained_inst_vars(Vars, Inst0),
- constrained_inst_vars(Vars, Inst)) :-
- strip_builtin_qualifiers_from_inst(Inst0, Inst).
-strip_builtin_qualifiers_from_inst(not_reached, not_reached).
-strip_builtin_qualifiers_from_inst(free, free).
-strip_builtin_qualifiers_from_inst(free(Type), free(Type)).
-strip_builtin_qualifiers_from_inst(any(Uniq, HOInstInfo0),
- any(Uniq, HOInstInfo)) :-
- strip_builtin_qualifiers_from_ho_inst_info(HOInstInfo0, HOInstInfo).
-strip_builtin_qualifiers_from_inst(ground(Uniq, HOInstInfo0),
- ground(Uniq, HOInstInfo)) :-
- strip_builtin_qualifiers_from_ho_inst_info(HOInstInfo0, HOInstInfo).
-strip_builtin_qualifiers_from_inst(bound(Uniq, BoundInsts0),
- bound(Uniq, BoundInsts)) :-
- strip_builtin_qualifiers_from_bound_inst_list(BoundInsts0, BoundInsts).
-strip_builtin_qualifiers_from_inst(defined_inst(Name0), defined_inst(Name)) :-
- strip_builtin_qualifiers_from_inst_name(Name0, Name).
-strip_builtin_qualifiers_from_inst(abstract_inst(Name0, Args0),
- abstract_inst(Name, Args)) :-
+strip_builtin_qualifiers_from_inst(Inst0, Inst) :-
+ (
+ ( Inst0 = inst_var(_)
+ ; Inst0 = not_reached
+ ; Inst0 = free
+ ; Inst0 = free(_)
+ ),
+ Inst = Inst0
+ ;
+ Inst0 = constrained_inst_vars(Vars, SubInst0),
+ strip_builtin_qualifiers_from_inst(SubInst0, SubInst),
+ Inst = constrained_inst_vars(Vars, SubInst)
+ ;
+ Inst0 = any(Uniq, HOInstInfo0),
+ strip_builtin_qualifiers_from_ho_inst_info(HOInstInfo0, HOInstInfo),
+ Inst = any(Uniq, HOInstInfo)
+ ;
+ Inst0 = ground(Uniq, HOInstInfo0),
+ strip_builtin_qualifiers_from_ho_inst_info(HOInstInfo0, HOInstInfo),
+ Inst = ground(Uniq, HOInstInfo)
+ ;
+ Inst0 = bound(Uniq, BoundInsts0),
+ strip_builtin_qualifiers_from_bound_inst_list(BoundInsts0, BoundInsts),
+ Inst = bound(Uniq, BoundInsts)
+ ;
+ Inst0 = defined_inst(InstName0),
+ strip_builtin_qualifiers_from_inst_name(InstName0, InstName),
+ Inst = defined_inst(InstName)
+ ;
+ Inst0 = abstract_inst(Name0, Args0),
strip_builtin_qualifier_from_sym_name(Name0, Name),
- strip_builtin_qualifiers_from_inst_list(Args0, Args).
+ strip_builtin_qualifiers_from_inst_list(Args0, Args),
+ Inst = abstract_inst(Name, Args)
+ ).
:- pred strip_builtin_qualifiers_from_bound_inst_list(list(bound_inst)::in,
list(bound_inst)::out) is det.
@@ -643,53 +693,67 @@
strip_builtin_qualifiers_from_bound_inst(BoundInst0, BoundInst) :-
BoundInst0 = bound_functor(ConsId0, Insts0),
strip_builtin_qualifier_from_cons_id(ConsId0, ConsId),
- BoundInst = bound_functor(ConsId, Insts),
- list.map(strip_builtin_qualifiers_from_inst, Insts0, Insts).
+ list.map(strip_builtin_qualifiers_from_inst, Insts0, Insts),
+ BoundInst = bound_functor(ConsId, Insts).
:- pred strip_builtin_qualifiers_from_inst_name(inst_name::in, inst_name::out)
is det.
-strip_builtin_qualifiers_from_inst_name(user_inst(SymName0, Insts0),
- user_inst(SymName, Insts)) :-
+strip_builtin_qualifiers_from_inst_name(Inst0, Inst) :-
+ (
+ Inst0 = user_inst(SymName0, Insts0),
strip_builtin_qualifier_from_sym_name(SymName0, SymName),
- strip_builtin_qualifiers_from_inst_list(Insts0, Insts).
-strip_builtin_qualifiers_from_inst_name(merge_inst(InstA0, InstB0),
- merge_inst(InstA, InstB)) :-
+ strip_builtin_qualifiers_from_inst_list(Insts0, Insts),
+ Inst = user_inst(SymName, Insts)
+ ;
+ Inst0 = merge_inst(InstA0, InstB0),
strip_builtin_qualifiers_from_inst(InstA0, InstA),
- strip_builtin_qualifiers_from_inst(InstB0, InstB).
-strip_builtin_qualifiers_from_inst_name(unify_inst(Live, InstA0, InstB0, Real),
- unify_inst(Live, InstA, InstB, Real)) :-
+ strip_builtin_qualifiers_from_inst(InstB0, InstB),
+ Inst = merge_inst(InstA, InstB)
+ ;
+ Inst0 = unify_inst(Live, InstA0, InstB0, Real),
strip_builtin_qualifiers_from_inst(InstA0, InstA),
- strip_builtin_qualifiers_from_inst(InstB0, InstB).
-strip_builtin_qualifiers_from_inst_name(
- ground_inst(InstName0, Live, Uniq, Real),
- ground_inst(InstName, Live, Uniq, Real)) :-
- strip_builtin_qualifiers_from_inst_name(InstName0, InstName).
-strip_builtin_qualifiers_from_inst_name(
- any_inst(InstName0, Live, Uniq, Real),
- any_inst(InstName, Live, Uniq, Real)) :-
- strip_builtin_qualifiers_from_inst_name(InstName0, InstName).
-strip_builtin_qualifiers_from_inst_name(shared_inst(InstName0),
- shared_inst(InstName)) :-
- strip_builtin_qualifiers_from_inst_name(InstName0, InstName).
-strip_builtin_qualifiers_from_inst_name(mostly_uniq_inst(InstName0),
- mostly_uniq_inst(InstName)) :-
- strip_builtin_qualifiers_from_inst_name(InstName0, InstName).
-strip_builtin_qualifiers_from_inst_name(typed_ground(Uniq, Type),
- typed_ground(Uniq, Type)).
-strip_builtin_qualifiers_from_inst_name(typed_inst(Type, InstName0),
- typed_inst(Type, InstName)) :-
- strip_builtin_qualifiers_from_inst_name(InstName0, InstName).
+ strip_builtin_qualifiers_from_inst(InstB0, InstB),
+ Inst = unify_inst(Live, InstA, InstB, Real)
+ ;
+ Inst0 = ground_inst(InstName0, Live, Uniq, Real),
+ strip_builtin_qualifiers_from_inst_name(InstName0, InstName),
+ Inst = ground_inst(InstName, Live, Uniq, Real)
+ ;
+ Inst0 = any_inst(InstName0, Live, Uniq, Real),
+ strip_builtin_qualifiers_from_inst_name(InstName0, InstName),
+ Inst = any_inst(InstName, Live, Uniq, Real)
+ ;
+ Inst0 = shared_inst(InstName0),
+ strip_builtin_qualifiers_from_inst_name(InstName0, InstName),
+ Inst = shared_inst(InstName)
+ ;
+ Inst0 = mostly_uniq_inst(InstName0),
+ strip_builtin_qualifiers_from_inst_name(InstName0, InstName),
+ Inst = mostly_uniq_inst(InstName)
+ ;
+ Inst0 = typed_ground(_Uniq, _Type),
+ Inst = Inst0
+ ;
+ Inst0 = typed_inst(Type, InstName0),
+ strip_builtin_qualifiers_from_inst_name(InstName0, InstName),
+ Inst = typed_inst(Type, InstName)
+ ).
:- pred strip_builtin_qualifiers_from_ho_inst_info(ho_inst_info::in,
ho_inst_info::out) is det.
-strip_builtin_qualifiers_from_ho_inst_info(none, none).
-strip_builtin_qualifiers_from_ho_inst_info(higher_order(Pred0),
- higher_order(Pred)) :-
+strip_builtin_qualifiers_from_ho_inst_info(HOInstInfo0, HOInstInfo) :-
+ (
+ HOInstInfo0 = none,
+ HOInstInfo = none
+ ;
+ HOInstInfo0 = higher_order(Pred0),
Pred0 = pred_inst_info(PorF, Modes0, ArgRegs, Det),
strip_builtin_qualifiers_from_mode_list(Modes0, Modes),
- Pred = pred_inst_info(PorF, Modes, ArgRegs, Det).
+ Pred = pred_inst_info(PorF, Modes, ArgRegs, Det),
+ HOInstInfo = higher_order(Pred)
+ ).
%-----------------------------------------------------------------------------%
:- end_module parse_tree.prog_mode.
Index: unused_imports.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unused_imports.m,v
retrieving revision 1.28
diff -u -b -r1.28 unused_imports.m
--- unused_imports.m 13 Feb 2012 00:11:50 -0000 1.28
+++ unused_imports.m 16 Apr 2012 09:55:48 -0000
@@ -630,11 +630,14 @@
%
:- func item_visibility(import_status) = item_visibility.
-item_visibility(ImportStatus) =
- ( status_is_exported_to_non_submodules(ImportStatus) = yes ->
- visibility_public
+item_visibility(ImportStatus) = Visibility :-
+ Exported = status_is_exported_to_non_submodules(ImportStatus),
+ (
+ Exported = yes,
+ Visibility = visibility_public
;
- visibility_private
+ Exported = no,
+ Visibility = visibility_private
).
%-----------------------------------------------------------------------------%
cvs diff: Diffing notes
--------------------------------------------------------------------------
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