[m-rev.] diff: some cleanup
Zoltan Somogyi
zs at csse.unimelb.edu.au
Mon Jan 31 20:03:54 AEDT 2011
compiler/superhomogeneous.m:
Fix some style issues.
Break a large predicate into two parts. Change one part from an
if-then-else chain to a switch.
compiler/state_var.m:
Fix some style issues.
Zoltan.
cvs diff: Diffing .
Index: state_var.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/state_var.m,v
retrieving revision 1.33
diff -u -b -r1.33 state_var.m
--- state_var.m 2 Jan 2011 14:37:59 -0000 1.33
+++ state_var.m 31 Jan 2011 03:13:29 -0000
@@ -363,23 +363,26 @@
new_svar_info = svar_info(in_head, 0, map.init, map.init, map.init).
-:- pred svar_info `has_svar_colon_mapping_for` svar.
-:- mode in `has_svar_colon_mapping_for` in is semidet.
+:- pred has_svar_colon_mapping_for(svar_info::in, svar::in) is semidet.
-SInfo `has_svar_colon_mapping_for` StateVar :-
+has_svar_colon_mapping_for(SInfo, StateVar) :-
SInfo ^ svar_colon `contains` StateVar.
-SInfo `has_svar_colon_mapping_for` StateVar :-
+has_svar_colon_mapping_for(SInfo, StateVar) :-
SInfo ^ svar_ctxt = in_atom(_, ParentSInfo),
- ParentSInfo `has_svar_colon_mapping_for` StateVar.
+ has_svar_colon_mapping_for(ParentSInfo, StateVar).
-:- func svar_info `with_updated_svar` svar = svar_info.
+:- pred with_updated_svar(svar::in, svar_info::in, svar_info::out) is det.
-SInfo `with_updated_svar` StateVar =
- ( SInfo ^ svar_ctxt = in_atom(UpdatedStateVars, ParentSInfo) ->
- SInfo ^ svar_ctxt := in_atom(set.insert(UpdatedStateVars, StateVar),
- ParentSInfo)
+with_updated_svar(StateVar, !SInfo) :-
+ SVarContext = !.SInfo ^ svar_ctxt,
+ (
+ SVarContext = in_atom(UpdatedStateVars0, ParentSInfo),
+ set.insert(UpdatedStateVars0, StateVar, UpdatedStateVars),
+ !SInfo ^ svar_ctxt := in_atom(UpdatedStateVars, ParentSInfo)
;
- SInfo
+ ( SVarContext = in_head
+ ; SVarContext = in_body
+ )
).
%-----------------------------------------------------------------------------%
@@ -402,7 +405,7 @@
Var = VarPrime
; map.search(!.SInfo ^ svar_readonly_dot, StateVar, VarPrime) ->
Var = VarPrime
- ; !.SInfo `has_svar_colon_mapping_for` StateVar ->
+ ; has_svar_colon_mapping_for(!.SInfo, StateVar) ->
new_dot_state_var(StateVar, Var, !VarSet, !SInfo),
report_uninitialized_state_var(Context, !.VarSet, StateVar, !Specs)
;
@@ -430,7 +433,7 @@
),
( map.search(ColonMap0, StateVar, VarPrime) ->
Var = VarPrime,
- !:SInfo = !.SInfo `with_updated_svar` StateVar
+ with_updated_svar(StateVar, !SInfo)
;
% Return a dummy variable, and set up a dummy mapping: there is
% no point in mentioning this error twice.
@@ -515,9 +518,9 @@
DotKeys = map.keys(!.SInfo ^ svar_dot),
StateVars = list.merge_and_remove_dups(ColonKeys, DotKeys),
next_svar_mappings(N, StateVars, !VarSet, Colon),
- !:SInfo = !.SInfo ^ svar_ctxt := in_body,
- !:SInfo = !.SInfo ^ svar_num := N,
- !:SInfo = !.SInfo ^ svar_colon := Colon.
+ !SInfo ^ svar_ctxt := in_body,
+ !SInfo ^ svar_num := N,
+ !SInfo ^ svar_colon := Colon.
%-----------------------------------------------------------------------------%
@@ -717,7 +720,7 @@
io.write(Var2, !IO),
io.nl(!IO)
;
- unexpected(this_file, "transform_goal_2: |Vars| != 2")
+ unexpected($module, $pred, "|Vars| != 2")
)
).
@@ -752,7 +755,8 @@
%
:- pred add_then_arm_specific_unifiers(prog_context::in, svars::in,
svar_info::in, svar_info::in, svar_info::in, svar_info::out,
- hlds_goals::in, hlds_goals::out, prog_varset::in, prog_varset::out) is det.
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ prog_varset::in, prog_varset::out) is det.
add_then_arm_specific_unifiers(_, [], _, _, !SInfoT, !Thens, !VarSet).
add_then_arm_specific_unifiers(Context, [StateVar | StateVars],
@@ -828,7 +832,7 @@
svar_info.
reconcile_disj_svar_info(_, []) = _ :-
- unexpected(this_file, "reconcile_disj_svar_info: empty disjunct list").
+ unexpected($module, $pred, "empty disjunct list").
reconcile_disj_svar_info(VarSet, [DisjSInfo | DisjSInfos]) = SInfo :-
% We compute the set of final !. and !: state variables over the whole
% disjunction (not all arms will necessarily include !. and !: mappings
@@ -1019,7 +1023,7 @@
ParentSInfo, !:SInfo)
)
;
- unexpected(this_file, "svar_finish_call: ctxt is not in_atom")
+ unexpected($module, $pred, "ctxt is not in_atom")
).
%-----------------------------------------------------------------------------%
@@ -1045,20 +1049,20 @@
svar_prepare_for_if_then_else_expr(StateVars, !VarSet, !SInfo) :-
SInfo0 = !.SInfo,
!:SInfo = new_svar_info ^ svar_ctxt := in_body,
- !:SInfo = !.SInfo ^ svar_readonly_dot := SInfo0 ^ svar_dot,
- !:SInfo = !.SInfo ^ svar_num := SInfo0 ^ svar_num,
+ !SInfo ^ svar_readonly_dot := SInfo0 ^ svar_dot,
+ !SInfo ^ svar_num := SInfo0 ^ svar_num,
prepare_for_local_state_vars(StateVars, !VarSet, !SInfo).
%-----------------------------------------------------------------------------%
svar_finish_if_then_else_expr_condition(Before, !SInfo) :-
SInfo0 = !.SInfo,
- !:SInfo = !.SInfo ^ svar_readonly_dot := Before ^ svar_readonly_dot,
- !:SInfo = !.SInfo ^ svar_dot :=
+ !SInfo ^ svar_readonly_dot := Before ^ svar_readonly_dot,
+ !SInfo ^ svar_dot :=
(SInfo0 ^ svar_dot) `overlay` (Before ^ svar_dot),
- !:SInfo = !.SInfo ^ svar_colon :=
+ !SInfo ^ svar_colon :=
(SInfo0 ^ svar_colon) `overlay` (Before ^ svar_colon),
- !:SInfo = !.SInfo ^ svar_ctxt := Before ^ svar_ctxt.
+ !SInfo ^ svar_ctxt := Before ^ svar_ctxt.
%-----------------------------------------------------------------------------%
@@ -1076,10 +1080,10 @@
ColonMap0, Nil, DotMap),
map.foldl2(next_colon_mapping(UpdatedStateVars, ColonMap0, N),
ColonMap0, !VarSet, Nil, ColonMap),
- !:SInfo = !.SInfo ^ svar_ctxt := in_body,
- !:SInfo = !.SInfo ^ svar_num := N,
- !:SInfo = !.SInfo ^ svar_dot := DotMap,
- !:SInfo = !.SInfo ^ svar_colon := ColonMap.
+ !SInfo ^ svar_ctxt := in_body,
+ !SInfo ^ svar_num := N,
+ !SInfo ^ svar_dot := DotMap,
+ !SInfo ^ svar_colon := ColonMap.
% If the state variable has been updated (i.e. there was a !:X reference)
% then the next !.X mapping will be the current !:X mapping. Otherwise,
@@ -1287,9 +1291,3 @@
!:Specs = [Spec | !.Specs].
%-----------------------------------------------------------------------------%
-
-:- func this_file = string.
-
-this_file = "state_var.m".
-
-%-----------------------------------------------------------------------------%
Index: superhomogeneous.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/superhomogeneous.m,v
retrieving revision 1.39
diff -u -b -r1.39 superhomogeneous.m
--- superhomogeneous.m 2 Jan 2011 14:37:59 -0000 1.39
+++ superhomogeneous.m 31 Jan 2011 07:11:24 -0000
@@ -202,10 +202,10 @@
do_insert_arg_unifications_2([], [_ | _], _, _, _, _, _, _, !NumAdded, !VarSet,
!ModuleInfo, !QualInfo, !SInfo, !Specs) :-
- unexpected(this_file, "do_insert_arg_unifications_2: length mismatch").
+ unexpected($module, $pred, "length mismatch").
do_insert_arg_unifications_2([_ | _], [], _, _, _, _, _, _, !NumAdded, !VarSet,
!ModuleInfo, !QualInfo, !SInfo, !Specs) :-
- unexpected(this_file, "do_insert_arg_unifications_2: length mismatch").
+ unexpected($module, $pred, "length mismatch").
do_insert_arg_unifications_2([], [], _, _, _, !Goals, _, !NumAdded, !VarSet,
!ModuleInfo, !QualInfo, !SInfo, !Specs).
do_insert_arg_unifications_2([Var | Vars], [Arg | Args], Context, ArgContext,
@@ -287,7 +287,7 @@
!NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
list.append(UnifyConj, !.Goals, !:Goals)
;
- unexpected(this_file, "insert_arg_unifications_with_supplied_contexts")
+ unexpected($module, $pred, "length mismatch")
).
:- pred do_insert_arg_unification(prog_var::in, prog_term::in, prog_context::in,
@@ -301,7 +301,7 @@
MaybeThreshold, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
!SInfo, !Specs) :-
( Arg = term.variable(Var, _) ->
- % Skip unifications of the form `X = X'
+ % Skip unifications of the form `X = X'.
ArgUnifyConj = [],
NumAdded = 0
;
@@ -348,10 +348,10 @@
do_append_arg_unifications_2([], [_ | _], _, _, _, _, _, _, !NumAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
- unexpected(this_file, "do_append_arg_unifications_2: length mismatch").
+ unexpected($module, $pred, "length mismatch").
do_append_arg_unifications_2([_ | _], [], _, _, _, _, _, _, !NumAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
- unexpected(this_file, "do_append_arg_unifications_2: length mismatch").
+ unexpected($module, $pred, "length mismatch").
do_append_arg_unifications_2([], [], _, _, _, !GoalList, _, !NumAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs).
do_append_arg_unifications_2([Var | Vars], [Arg | Args], Context, ArgContext,
@@ -430,8 +430,8 @@
GoalExpr = scope(from_ground_term(LHSVar, Kind), SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo)
;
- % This can happen if we unravel large ground term that happens to
- % be a lambda expression; the conjunction will then be *inside*
+ % This can happen if we unravel a large ground term that happens
+ % to be a lambda expression; the conjunction will then be *inside*
% the rhs_lambda_goal.
Goal = Goal0
)
@@ -453,8 +453,7 @@
goal_info_set_nonlocals(NonLocals, GoalInfo0, GoalInfo),
Goal = hlds_goal(GoalExpr, GoalInfo)
;
- unexpected(this_file,
- "mark_nonlocals_in_ground_term_construct: wrong shape goal")
+ unexpected($module, $pred, "wrong shape goal")
),
mark_nonlocals_in_ground_term_construct(Goals0, Goals).
@@ -535,51 +534,14 @@
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
substitute_state_var_mappings(Args1, Args, !VarSet, !SInfo, !Specs),
(
- % Handle explicit type qualification.
- (
- F = term.atom("with_type")
- ;
- F = term.atom(":")
- ),
- Args = [RVal, DeclType0]
- ->
- % DeclType0 is a prog_term, but it is really a type so we coerce it
- % to a generic term before parsing it.
- term.coerce(DeclType0, DeclType1),
- ContextPieces = [words("In explicit type qualification:")],
- varset.coerce(!.VarSet, GenericVarSet),
- parse_type(DeclType1, GenericVarSet, ContextPieces, DeclTypeResult),
- (
- DeclTypeResult = ok1(DeclType),
- varset.coerce(!.VarSet, DeclVarSet),
- process_type_qualification(X, DeclType, DeclVarSet, Context,
- !ModuleInfo, !QualInfo, !Specs)
- ;
- DeclTypeResult = error1(DeclTypeSpecs),
- % The varset is a prog_varset even though it contains the names
- % of type variables in ErrorTerm, which is a generic term.
- !:Specs = DeclTypeSpecs ++ !.Specs
- ),
- do_unravel_unification(term.variable(X, Context), RVal,
- Context, MainContext, SubContext, Purity, Goal, no, NumAdded,
+ F = term.atom(Atom),
+ maybe_unravel_special_var_functor_unification(X, Atom, Args,
+ FunctorContext, Context, MainContext, SubContext, Purity,
+ GoalPrime, NumAddedPrime,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
- ;
- % Handle unification expressions.
- F = term.atom("@"),
- Args = [LVal, RVal]
->
- do_unravel_unification(term.variable(X, Context), LVal, Context,
- MainContext, SubContext, Purity, Goal1, no, NumAdded1,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- do_unravel_unification(term.variable(X, Context), RVal, Context,
- MainContext, SubContext, Purity, Goal2, no, NumAdded2,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- NumAdded = NumAdded1 + NumAdded2,
- goal_info_init(GoalInfo),
- goal_to_conj_list(Goal1, ConjList1),
- goal_to_conj_list(Goal2, ConjList2),
- list.append(ConjList1, ConjList2, ConjList),
- conj_list_to_goal(ConjList, GoalInfo, Goal)
+ Goal = GoalPrime,
+ NumAdded = NumAddedPrime
;
% Handle higher-order pred and func expressions.
% XXX Why do we use Arg1 instead of Args here?
@@ -622,77 +584,172 @@
Goal = true_goal
)
;
- % Handle higher-order dcg pred expressions. They have the same
- % semantics as higher-order pred expressions, but have two extra
- % arguments, and the goal is expanded as a DCG goal.
- F = term.atom("-->"),
- Args = [PredTerm0, GoalTerm0],
- term.coerce(PredTerm0, PredTerm1),
- parse_purity_annotation(PredTerm1, DCGLambdaPurity, PredTerm),
- parse_dcg_pred_expression(PredTerm, Groundness, EvalMethod, Vars0,
- Modes0, Det)
- ->
- qualify_lambda_mode_list_if_not_opt_imported(Modes0, Modes, Context,
- !QualInfo, !Specs),
- term.coerce(GoalTerm0, GoalTerm),
- ContextPieces = [words("Error:")],
- parse_dcg_pred_goal(GoalTerm, ContextPieces, MaybeParsedGoal,
- DCG0, DCGn, !VarSet),
+ % Handle the usual case.
+ % XXX Why do we use Args1 instead of Args here?
+ RHS = term.functor(F, Args1, FunctorContext),
+ ( try_parse_sym_name_and_args(RHS, FunctorName, FunctorArgsPrime) ->
+ FunctorArgs = FunctorArgsPrime,
+ list.length(FunctorArgs, Arity),
+ ConsId = cons(FunctorName, Arity, cons_id_dummy_type_ctor)
+ ;
+ % float, int or string constant
+ % - any errors will be caught by typechecking
+ list.length(Args, Arity),
+ ConsId = make_functor_cons_id(F, Arity),
+ FunctorArgs = Args
+ ),
(
- MaybeParsedGoal = ok1(ParsedGoal),
- Vars1 = Vars0 ++
- [term.variable(DCG0, Context), term.variable(DCGn, Context)],
- build_lambda_expression(X, Purity, DCGLambdaPurity, Groundness,
- pf_predicate, EvalMethod, Vars1, Modes, Det, ParsedGoal,
- Context, MainContext, SubContext, Goal0, NumAdded, !VarSet,
- !ModuleInfo, !QualInfo, !.SInfo, !Specs),
+ FunctorArgs = [],
+ make_atomic_unification(X, rhs_functor(ConsId, no, []),
+ Context, MainContext, SubContext, Purity, Goal0, !QualInfo),
+ NumAdded = 1,
Goal0 = hlds_goal(GoalExpr, GoalInfo0),
goal_info_set_purity(Purity, GoalInfo0, GoalInfo),
+ % We could wrap a from_ground_term(X) scope around Goal,
+ % but there would be no gain from doing so, whereas the
+ % increase would lead to a slight increase in memory and time
+ % requirements.
Goal = hlds_goal(GoalExpr, GoalInfo)
;
- MaybeParsedGoal = error1(ParsedGoalSpecs),
- !:Specs = ParsedGoalSpecs ++ !.Specs,
- NumAdded = 0,
- Goal = true_goal
+ FunctorArgs = [_ | _],
+ make_fresh_arg_vars(FunctorArgs, HeadVars, !VarSet, !SInfo,
+ !Specs),
+ make_atomic_unification(X, rhs_functor(ConsId, no, HeadVars),
+ Context, MainContext, SubContext, Purity, Goal0, !QualInfo),
+ MainFunctorAdded = 1,
+ ArgContext = ac_functor(ConsId, MainContext, SubContext),
+ % Should this be insert_... rather than append_...?
+ % No, because that causes efficiency problems
+ % with type-checking :-(
+ % But for impure unifications, we need to do this, because
+ % mode reordering can't reorder around the functor unification.
+ ( Purity = purity_pure ->
+ do_append_arg_unifications(HeadVars, FunctorArgs,
+ FunctorContext, ArgContext, Goal0, Goal, no, ArgAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
+ ;
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
+ goal_info_set_purity(Purity, GoalInfo0, GoalInfo1),
+ Goal1 = hlds_goal(GoalExpr0, GoalInfo1),
+ do_insert_arg_unifications(HeadVars, FunctorArgs,
+ FunctorContext, ArgContext, Goal1, Goal, no, ArgAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
+ ),
+ NumAdded = MainFunctorAdded + ArgAdded
+ )
+ ).
+
+ % See whether Atom indicates a term with special syntax.
+ %
+:- pred maybe_unravel_special_var_functor_unification(prog_var::in,
+ string::in, list(prog_term)::in, term.context::in,
+ prog_context::in, unify_main_context::in, unify_sub_contexts::in,
+ purity::in, hlds_goal::out, num_added_goals::out,
+ prog_varset::in, prog_varset::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, svar_info::in, svar_info::out,
+ list(error_spec)::in, list(error_spec)::out) is semidet.
+
+maybe_unravel_special_var_functor_unification(X, Atom, Args,
+ FunctorContext, Context, MainContext, SubContext, Purity,
+ Goal, NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
+ % Switch on Atom.
+ % XXX instead of failing if Atom has the wrong number of arguments or
+ % if the arguments have the wrong shape, we should generate an error
+ % message.
+ (
+ % Handle explicit type qualification.
+ ( Atom = "with_type"
+ ; Atom = ":"
+ ),
+ Args = [RVal, DeclType0],
+
+ require_det (
+ % DeclType0 is a prog_term, but it is really a type,
+ % so we coerce it to a generic term before parsing it.
+ term.coerce(DeclType0, DeclType1),
+ ContextPieces = [words("In explicit type qualification:")],
+ varset.coerce(!.VarSet, GenericVarSet),
+ parse_type(DeclType1, GenericVarSet, ContextPieces,
+ DeclTypeResult),
+ (
+ DeclTypeResult = ok1(DeclType),
+ varset.coerce(!.VarSet, DeclVarSet),
+ process_type_qualification(X, DeclType, DeclVarSet,
+ Context, !ModuleInfo, !QualInfo, !Specs)
+ ;
+ DeclTypeResult = error1(DeclTypeSpecs),
+ % The varset is a prog_varset even though it contains
+ % the names of type variables in ErrorTerm, which is
+ % a generic term.
+ !:Specs = DeclTypeSpecs ++ !.Specs
+ ),
+ do_unravel_unification(term.variable(X, Context), RVal,
+ Context, MainContext, SubContext, Purity, Goal, no,
+ NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
)
;
- % Handle if-then-else expressions
+ % Handle unification expressions.
+ Atom = "@",
+ Args = [LVal, RVal],
+
+ require_det (
+ do_unravel_unification(term.variable(X, Context), LVal, Context,
+ MainContext, SubContext, Purity, GoalL, no, NumAddedL,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
+ do_unravel_unification(term.variable(X, Context), RVal, Context,
+ MainContext, SubContext, Purity, GoalR, no, NumAddedR,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
+ NumAdded = NumAddedL + NumAddedR,
+ goal_info_init(GoalInfo),
+ goal_to_conj_list(GoalL, ConjListL),
+ goal_to_conj_list(GoalR, ConjListR),
+ ConjList = ConjListL ++ ConjListR,
+ conj_list_to_goal(ConjList, GoalInfo, Goal)
+ )
+ ;
+ % Handle if-then-else expressions.
(
- F = term.atom("else"),
+ Atom = "else",
Args = [CondThenTerm, ElseTerm],
CondThenTerm = term.functor(term.atom("if"),
[term.functor(term.atom("then"), [CondTerm0, ThenTerm], _)], _)
;
- F = term.atom(";"),
+ Atom = ";",
Args = [CondThenTerm, ElseTerm],
CondThenTerm = term.functor(term.atom("->"),
[CondTerm0, ThenTerm], _)
- )
- ->
+ ),
+
+ require_det (
term.coerce(CondTerm0, CondTerm),
ContextPieces = [words("Error:")],
- parse_some_vars_goal(CondTerm, ContextPieces, MaybeVarsCond, !VarSet),
+ parse_some_vars_goal(CondTerm, ContextPieces, MaybeVarsCond,
+ !VarSet),
(
MaybeVarsCond = ok3(Vars, StateVars, CondParseTree),
BeforeSInfo = !.SInfo,
svar_prepare_for_if_then_else_expr(StateVars, !VarSet, !SInfo),
map.init(EmptySubst),
- transform_goal(CondParseTree, EmptySubst, CondGoal, CondAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
+ transform_goal(CondParseTree, EmptySubst,
+ CondGoal, CondAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !Specs),
- svar_finish_if_then_else_expr_condition(BeforeSInfo, !SInfo),
+ svar_finish_if_then_else_expr_condition(BeforeSInfo,
+ !SInfo),
do_unravel_unification(term.variable(X, Context), ThenTerm,
Context, MainContext, SubContext, Purity, ThenGoal, no,
- ThenAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
+ ThenAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !Specs),
svar_finish_if_then_else_expr_then_goal(StateVars,
BeforeSInfo, !SInfo),
do_unravel_unification(term.variable(X, Context), ElseTerm,
Context, MainContext, SubContext, Purity, ElseGoal, no,
- ElseAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
+ ElseAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !Specs),
NumAdded = CondAdded + ThenAdded + ElseAdded,
GoalExpr = if_then_else(StateVars ++ Vars,
@@ -705,38 +762,43 @@
NumAdded = 0,
Goal = true_goal
)
+ )
;
% Handle field extraction expressions.
- F = term.atom("^"),
+ Atom = "^",
Args = [InputTerm, FieldNameTerm],
- maybe_parse_field_list(FieldNameTerm, !.VarSet, FieldNames)
- ->
- make_fresh_arg_var(InputTerm, InputTermVar, [], !VarSet, !SInfo,
- !Specs),
+ maybe_parse_field_list(FieldNameTerm, !.VarSet, FieldNames),
+
+ require_det (
+ make_fresh_arg_var(InputTerm, InputTermVar, [],
+ !VarSet, !SInfo, !Specs),
expand_get_field_function_call(Context, MainContext, SubContext,
- FieldNames, X, InputTermVar, Purity, Functor, _, Goal0, CallAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
+ FieldNames, X, InputTermVar, Purity, Functor, _,
+ Goal0, CallAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !SInfo, !Specs),
ArgContext = ac_functor(Functor, MainContext, SubContext),
do_insert_arg_unifications([InputTermVar], [InputTerm],
FunctorContext, ArgContext, Goal0, Goal, no, ArgAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
NumAdded = CallAdded + ArgAdded
+ )
;
% Handle field update expressions.
- F = term.atom(":="),
+ Atom = ":=",
Args = [FieldDescrTerm, FieldValueTerm],
FieldDescrTerm = term.functor(term.atom("^"),
[InputTerm, FieldNameTerm], _),
- maybe_parse_field_list(FieldNameTerm, !.VarSet, FieldNames)
- ->
- make_fresh_arg_var(InputTerm, InputTermVar, [], !VarSet, !SInfo,
- !Specs),
- make_fresh_arg_var(FieldValueTerm, FieldValueVar, [InputTermVar],
+ maybe_parse_field_list(FieldNameTerm, !.VarSet, FieldNames),
+
+ require_det (
+ make_fresh_arg_var(InputTerm, InputTermVar, [],
!VarSet, !SInfo, !Specs),
+ make_fresh_arg_var(FieldValueTerm, FieldValueVar,
+ [InputTermVar], !VarSet, !SInfo, !Specs),
- expand_set_field_function_call(Context, MainContext, SubContext,
- FieldNames, FieldValueVar, InputTermVar, X,
+ expand_set_field_function_call(Context, MainContext,
+ SubContext, FieldNames, FieldValueVar, InputTermVar, X,
Functor, InnerFunctor - FieldSubContext, Goal0, CallAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
@@ -752,59 +814,44 @@
ArgContexts, Context, Goal0, Goal, no, ArgAdded, !VarSet,
!ModuleInfo, !QualInfo, !SInfo, !Specs),
NumAdded = CallAdded + ArgAdded
+ )
;
- % Handle the usual case.
- % XXX Why do we use Args1 instead of Args here?
- RHS = term.functor(F, Args1, FunctorContext),
- ( try_parse_sym_name_and_args(RHS, FunctorName, FunctorArgsPrime) ->
- FunctorArgs = FunctorArgsPrime,
- list.length(FunctorArgs, Arity),
- ConsId = cons(FunctorName, Arity, cons_id_dummy_type_ctor)
- ;
- % float, int or string constant
- % - any errors will be caught by typechecking
- list.length(Args, Arity),
- ConsId = make_functor_cons_id(F, Arity),
- FunctorArgs = Args
- ),
+ % Handle higher-order dcg pred expressions. They have the same
+ % semantics as higher-order pred expressions, but have two extra
+ % arguments, and the goal is expanded as a DCG goal.
+ Atom = "-->",
+ Args = [PredTerm0, GoalTerm0],
+ term.coerce(PredTerm0, PredTerm1),
+ parse_purity_annotation(PredTerm1, DCGLambdaPurity, PredTerm),
+ parse_dcg_pred_expression(PredTerm, Groundness, EvalMethod, Vars0,
+ Modes0, Det),
+
+ require_det (
+ qualify_lambda_mode_list_if_not_opt_imported(Modes0, Modes,
+ Context, !QualInfo, !Specs),
+ term.coerce(GoalTerm0, GoalTerm),
+ ContextPieces = [words("Error:")],
+ parse_dcg_pred_goal(GoalTerm, ContextPieces, MaybeParsedGoal,
+ DCG0, DCGn, !VarSet),
(
- FunctorArgs = [],
- make_atomic_unification(X, rhs_functor(ConsId, no, []),
- Context, MainContext, SubContext, Purity, Goal0, !QualInfo),
- NumAdded = 1,
+ MaybeParsedGoal = ok1(ParsedGoal),
+ Vars1 = Vars0 ++
+ [term.variable(DCG0, Context),
+ term.variable(DCGn, Context)],
+ build_lambda_expression(X, Purity, DCGLambdaPurity,
+ Groundness, pf_predicate, EvalMethod, Vars1, Modes, Det,
+ ParsedGoal, Context, MainContext, SubContext,
+ Goal0, NumAdded, !VarSet, !ModuleInfo,
+ !QualInfo, !.SInfo, !Specs),
Goal0 = hlds_goal(GoalExpr, GoalInfo0),
goal_info_set_purity(Purity, GoalInfo0, GoalInfo),
- % We could wrap a from_ground_term(X) scope around Goal,
- % but there would be no gain from doing so, whereas the
- % increase would lead to a slight increase in memory and time
- % requirements.
Goal = hlds_goal(GoalExpr, GoalInfo)
;
- FunctorArgs = [_ | _],
- make_fresh_arg_vars(FunctorArgs, HeadVars, !VarSet, !SInfo,
- !Specs),
- make_atomic_unification(X, rhs_functor(ConsId, no, HeadVars),
- Context, MainContext, SubContext, Purity, Goal0, !QualInfo),
- MainFunctorAdded = 1,
- ArgContext = ac_functor(ConsId, MainContext, SubContext),
- % Should this be insert_... rather than append_...?
- % No, because that causes efficiency problems
- % with type-checking :-(
- % But for impure unifications, we need to do this, because
- % mode reordering can't reorder around the functor unification.
- ( Purity = purity_pure ->
- do_append_arg_unifications(HeadVars, FunctorArgs,
- FunctorContext, ArgContext, Goal0, Goal, no, ArgAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
- ;
- Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
- goal_info_set_purity(Purity, GoalInfo0, GoalInfo1),
- Goal1 = hlds_goal(GoalExpr0, GoalInfo1),
- do_insert_arg_unifications(HeadVars, FunctorArgs,
- FunctorContext, ArgContext, Goal1, Goal, no, ArgAdded,
- !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
- ),
- NumAdded = MainFunctorAdded + ArgAdded
+ MaybeParsedGoal = error1(ParsedGoalSpecs),
+ !:Specs = ParsedGoalSpecs ++ !.Specs,
+ NumAdded = 0,
+ Goal = true_goal
+ )
)
).
@@ -828,7 +875,7 @@
%-----------------------------------------------------------------------------%
%
-% Code for building lambda expressions
+% Code for building lambda expressions.
%
:- pred build_lambda_expression(prog_var::in, purity::in, purity::in,
@@ -917,8 +964,7 @@
NonOutputLambdaVars = NonOutputLambdaVars0,
OutputLambdaVars = OutputLambdaVars0
;
- unexpected(this_file,
- "mismatched lists in build_lambda_expression.")
+ unexpected($module, $pred, "mismatched lists")
),
map.init(Substitution),
@@ -1089,11 +1135,5 @@
).
%-----------------------------------------------------------------------------%
-
-:- func this_file = string.
-
-this_file = "superhomogeneous.m".
-
-%-----------------------------------------------------------------------------%
:- end_module superhomogeneous.
%-----------------------------------------------------------------------------%
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