[m-rev.] For review: State Variables
Ralph Becket
rafe at cs.mu.OZ.AU
Thu Jun 6 15:06:42 AEST 2002
Simon Taylor, Wednesday, 15 May 2002:
> On 09-May-2002, Ralph Becket <rafe at cs.mu.OZ.AU> wrote:
> > Simon Taylor, Monday, 6 May 2002:
Type class instance declarations with in-line methods are now handled
correctly. A test case has been added:
tests/general/state_vars_typeclasses.{m,exp}
Index: state_vars_typeclasses.m
===================================================================
RCS file: state_vars_typeclasses.m
diff -N state_vars_typeclasses.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ state_vars_typeclasses.m 5 Jun 2002 07:04:44 -0000
@@ -0,0 +1,35 @@
+%------------------------------------------------------------------------------%
+% state_vars_typeclasses.m
+% Ralph Becket <rafe at cs.mu.oz.au>
+% Fri May 31 14:28:03 EST 2002
+% vim: ft=mercury ff=unix ts=4 sw=4 et wm=0 tw=0
+%
+%------------------------------------------------------------------------------%
+
+:- module state_vars_typeclasses.
+
+:- interface.
+
+:- import_module io.
+
+
+:- pred main(io::di, io::uo) is det.
+
+
+:- implementation.
+
+:- import_module int, string, list.
+
+
+:- typeclass foo(T) where [ func f(T) = T, pred p(T::in, T::out) is det ].
+
+:- instance foo(int) where [
+ p(!X),
+ f(!.X) = !:X + 1
+].
+
+
+main(!IO) :-
+ p(1, A),
+ B = f(1),
+ format("p(1, %d).\nf(1) = %d.\n", [i(A), i(B)], !IO).
Index: state_vars_typeclasses.exp
===================================================================
RCS file: state_vars_typeclasses.exp
diff -N state_vars_typeclasses.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ state_vars_typeclasses.exp 5 Jun 2002 07:05:32 -0000
@@ -0,0 +1,2 @@
+p(1, 1).
+f(1) = 2.
> > > On 02-May-2002, Ralph Becket <rafe at cs.mu.OZ.AU> wrote:
> > > > + % Handle !.X state variable references.
> > > > + { F = term__atom("!.") },
> > > > + { Args = [term__variable(StateVar)] }
> > > > + ->
> > > > + dot(Context, StateVar, Var, VarSet0, VarSet,
> > > > + SInfo0, SInfo),
> > > > + { Goal = svar_unification(Context, X, Var) },
> > > > + { Info = Info0 }
> > > > + ;
> > > > + % Handle !:X state variable references.
> > > > + { F = term__atom("!:") },
> > > > + { Args = [term__variable(StateVar)] }
> > > > + ->
> > > > + colon(Context, StateVar, Var, VarSet0, VarSet,
> > > > + SInfo0, SInfo),
> > > > + { Goal = svar_unification(Context, X, Var) },
> > > > + { Info = Info0 }
> > >
> > > The way you've done this the type and mode error messages for
> > > state variable references will be really awful.
> >
> > Fixed.
>
> Where are the test cases for the error messages?
Added: tests/invalid:
Index: state_vars_test1.m
===================================================================
RCS file: state_vars_test1.m
diff -N state_vars_test1.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ state_vars_test1.m 30 May 2002 06:33:02 -0000
@@ -0,0 +1,27 @@
+%------------------------------------------------------------------------------%
+% state_vars_test1.m
+% Ralph Becket <rafe at cs.mu.oz.au>
+% Thu May 30 14:22:14 EST 2002
+% vim: ft=mercury ff=unix ts=4 sw=4 et wm=0 tw=0
+%
+%------------------------------------------------------------------------------%
+
+:- module state_vars_test1.
+
+:- interface.
+
+:- implementation.
+
+:- import_module int.
+
+:- pred p(int::in, int::out) is det.
+
+ % Illegally refers to !:X in an if-then-else expr.
+ %
+p(!X) :-
+ !:X = !.X +
+ ( if max(0, !.X, !:X)
+ then 1
+ else 2
+ ).
+
Index: state_vars_test2.m
===================================================================
RCS file: state_vars_test2.m
diff -N state_vars_test2.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ state_vars_test2.m 30 May 2002 06:33:34 -0000
@@ -0,0 +1,27 @@
+%------------------------------------------------------------------------------%
+% state_vars_test2.m
+% Ralph Becket <rafe at cs.mu.oz.au>
+% Thu May 30 14:22:14 EST 2002
+% vim: ft=mercury ff=unix ts=4 sw=4 et wm=0 tw=0
+%
+%------------------------------------------------------------------------------%
+
+:- module state_vars_test2.
+
+:- interface.
+
+:- implementation.
+
+:- import_module int.
+
+:- pred p(int::in, int::out) is det.
+
+ % Illegally refers to !:Y, which has not been explicitly introduced.
+ %
+p(!X) :-
+ !:X = !.X +
+ ( if max(0, !.X, !:Y)
+ then 1
+ else 2
+ ).
+
Index: state_vars_test3.m
===================================================================
RCS file: state_vars_test3.m
diff -N state_vars_test3.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ state_vars_test3.m 30 May 2002 06:33:55 -0000
@@ -0,0 +1,23 @@
+%------------------------------------------------------------------------------%
+% state_vars_test3.m
+% Ralph Becket <rafe at cs.mu.oz.au>
+% Thu May 30 14:22:14 EST 2002
+% vim: ft=mercury ff=unix ts=4 sw=4 et wm=0 tw=0
+%
+%------------------------------------------------------------------------------%
+
+:- module state_vars_test3.
+
+:- interface.
+
+:- implementation.
+
+:- import_module int.
+
+:- pred p(int::out) is det.
+
+ % Warning about referring to "uninitialized" !.X.
+ %
+p(!:X) :-
+ !.X = 1.
+
Index: state_vars_test4.m
===================================================================
RCS file: state_vars_test4.m
diff -N state_vars_test4.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ state_vars_test4.m 30 May 2002 06:34:15 -0000
@@ -0,0 +1,22 @@
+%------------------------------------------------------------------------------%
+% state_vars_test4.m
+% Ralph Becket <rafe at cs.mu.oz.au>
+% Thu May 30 14:22:14 EST 2002
+% vim: ft=mercury ff=unix ts=4 sw=4 et wm=0 tw=0
+%
+%------------------------------------------------------------------------------%
+
+:- module state_vars_test4.
+
+:- interface.
+
+:- implementation.
+
+:- import_module int.
+
+:- func f(int) = int.
+
+ % Illegally uses !Y as a func result.
+ %
+f(!X) = !Y.
+
Index: state_vars_test5.m
===================================================================
RCS file: state_vars_test5.m
diff -N state_vars_test5.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ state_vars_test5.m 30 May 2002 06:34:32 -0000
@@ -0,0 +1,22 @@
+%------------------------------------------------------------------------------%
+% state_vars_test5.m
+% Ralph Becket <rafe at cs.mu.oz.au>
+% Thu May 30 14:22:14 EST 2002
+% vim: ft=mercury ff=unix ts=4 sw=4 et wm=0 tw=0
+%
+%------------------------------------------------------------------------------%
+
+:- module state_vars_test5.
+
+:- interface.
+
+:- implementation.
+
+:- import_module list, int.
+
+:- func f(list(int)) = int.
+
+ % Illegally uses !X as a lambda arg.
+ %
+f(Xs) = foldl(func(!X) = !.X * !:X, Xs, 1).
+
Index: state_vars_test1.err_exp
===================================================================
RCS file: state_vars_test1.err_exp
diff -N state_vars_test1.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ state_vars_test1.err_exp 6 Jun 2002 03:29:43 -0000
@@ -0,0 +1,8 @@
+state_vars_test1.m: 1: Warning: interface for module `state_vars_test1' does not export anything.
+state_vars_test1.m:023: Error: cannot use !:X in this context;
+
+state_vars_test1.m:023: however !.X may be used here.
+state_vars_test1.m:023: In clause for predicate `state_vars_test1:p/2':
+state_vars_test1.m:023: warning: variable `X' occurs only once in this scope.
+state_vars_test1.m:022: Warning: the condition of this if-then-else cannot fail.
+For more information, try recompiling with `-E'.
Index: state_vars_test2.err_exp
===================================================================
RCS file: state_vars_test2.err_exp
diff -N state_vars_test2.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ state_vars_test2.err_exp 6 Jun 2002 03:29:44 -0000
@@ -0,0 +1,7 @@
+state_vars_test2.m: 1: Warning: interface for module `state_vars_test2' does not export anything.
+state_vars_test2.m:023: Error: state variable !:Y is not visible in this context.
+
+state_vars_test2.m:023: In clause for predicate `state_vars_test2:p/2':
+state_vars_test2.m:023: warning: variable `Y' occurs only once in this scope.
+state_vars_test2.m:022: Warning: the condition of this if-then-else cannot fail.
+For more information, try recompiling with `-E'.
Index: state_vars_test3.err_exp
===================================================================
RCS file: state_vars_test3.err_exp
diff -N state_vars_test3.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ state_vars_test3.err_exp 6 Jun 2002 03:29:45 -0000
@@ -0,0 +1,5 @@
+state_vars_test3.m: 1: Warning: interface for module `state_vars_test3' does not export anything.
+state_vars_test3.m:022: Warning: reference to unitialized state variable !.X.
+state_vars_test3_init.o: In function `mercury_init':
+state_vars_test3_init.o(.text+0x2b6): undefined reference to `<predicate 'main'/2 mode 0>'
+collect2: ld returned 1 exit status
Index: state_vars_test4.err_exp
===================================================================
RCS file: state_vars_test4.err_exp
diff -N state_vars_test4.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ state_vars_test4.err_exp 6 Jun 2002 03:29:45 -0000
@@ -0,0 +1,9 @@
+state_vars_test4.m: 1: Warning: interface for module `state_vars_test4' does not export anything.
+state_vars_test4.m:021: Error: clause for function `state_vars_test4:f/2'
+state_vars_test4.m:021: without preceding `func' declaration.
+state_vars_test4.m:021: Error: !Y cannot be a function result.
+
+state_vars_test4.m:021: You probably meant !.Y or !:Y.
+state_vars_test4.m:017: Error: no clauses for function `state_vars_test4:f/1'.
+state_vars_test4.m:021: Error: no clauses for function `state_vars_test4:f/2'.
+For more information, try recompiling with `-E'.
Index: state_vars_test5.err_exp
===================================================================
RCS file: state_vars_test5.err_exp
diff -N state_vars_test5.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ state_vars_test5.err_exp 6 Jun 2002 03:29:46 -0000
@@ -0,0 +1,9 @@
+state_vars_test5.m: 1: Warning: interface for module `state_vars_test5' does not export anything.
+state_vars_test5.m:021: Error: !X cannot be a lambda argument.
+
+state_vars_test5.m:021: Perhaps you meant !.X or !:X.
+state_vars_test5.m:021: In clause for `f(in) = out':
+state_vars_test5.m:021: in argument 1 of call to function `list:foldl/3':
+state_vars_test5.m:021: mode error: variable `V_5' has instantiatedness `free',
+state_vars_test5.m:021: expected instantiatedness was `(func((ground -> ground), (ground -> ground)) = (free -> ground) is det)'.
+For more information, try recompiling with `-E'.
> > > > -get_conj(Goal, Subst, Conj0, VarSet0, Conj, VarSet, Info0, Info) -->
> > > > +get_conj(Goal, Subst, Conj0, VarSet0, Conj, VarSet, Info0, Info,
> > > > + SInfo0, SInfo) -->
> > > > (
> > > > { Goal = (A,B) - _Context }
> > > > ->
> > > > - get_conj(B, Subst, Conj0, VarSet0, Conj1, VarSet1,
> > > > - Info0, Info1),
> > > > - get_conj(A, Subst, Conj1, VarSet1, Conj, VarSet, Info1, Info)
> > > > + get_conj(A, Subst, Conj0, VarSet0, Conj1, VarSet1,
> > > > + Info0, Info1, SInfo0, SInfo1),
> > > > + get_conj(B, Subst, Conj1, VarSet1, Conj, VarSet,
> > > > + Info1, Info, SInfo1, SInfo)
> > > > ;
> > > > transform_goal(Goal, VarSet0, Subst, Goal1, VarSet,
> > > > - Info0, Info),
> > > > + Info0, Info, SInfo0, SInfo),
> > > > { goal_to_conj_list(Goal1, ConjList) },
> > > > { list__append(ConjList, Conj0, Conj) }
> > > > ).
> > >
> > > You're now building Conj in reverse, so ConjList needs to be reversed
> > > before adding it to Conj0 (same for get_par_conj and get_disj).
> >
> > The lists are reversed in the respective callers.
>
> Conj0 and Conj are reversed, ConjList isn't. I'd suggest s/Conj/RevConj/
> to avoid confusion (and in get_par_conj and get_disj).
Done. Also renamed to get_rev_conj and get_rev_par_conj.
> > > > +finish_if_then_else(Context, Then0, Then, Else0, Else, VarSet0, VarSet,
> > > > + SInfoT, SInfoE, SInfo) :-
> > > > + SInfo0 = SInfoT,
> > > > + N = int__max(SInfoT ^ num, SInfoE ^ num),
> > > > + next_svar_info(N, VarSet0, VarSet, SInfo0, SInfo),
> > > > +
> > > > + goal_info_init(Context, GoalInfo),
> > > > +
> > > > + goal_to_conj_list(Then0, ThenGoals0),
> > > > + ThenUnifiers = svar_unifiers(Context, SInfo ^ dot, SInfoT ^ dot),
> > > > + conj_list_to_goal(ThenGoals0 ++ ThenUnifiers, GoalInfo, Then),
> > > > +
> > > > + goal_to_conj_list(Else0, ElseGoals0),
> > > > + ElseUnifiers = svar_unifiers(Context, SInfo ^ dot, SInfoE ^ dot),
> > > > + conj_list_to_goal(ElseGoals0 ++ ElseUnifiers, GoalInfo, Else).
> > >
> > > This doesn't handle code like the following properly:
> > >
> > > ( p(!X) ->
> > > q
> > > ;
> > > r(!X)
> > > ).
> >
> > Fixed.
>
> I'm not totally convinced. You should document somewhere
> how this case is handled. There should also be a test case.
You were right. Fixed and tested.
> > --- make_hlds.m 2 May 2002 03:54:54 -0000
> > +++ make_hlds.m 9 May 2002 08:26:46 -0000
> > @@ -3991,31 +4007,43 @@
> > ModuleInfo - QualInfo - ClausesInfo) -->
> > (
> > { InstanceClause = clause(CVarSet, PredOrFunc, PredName,
> > - HeadTerms, Body) }
> > + HeadTerms0, Body) }
>
> You should add a test for state variables in instance clauses.
>
> > +:- pred report_svar_unify_error(prog_context, prog_varset, svar, io, io).
> > +:- mode report_svar_unify_error(in, in, in, di, uo) is det.
> > +
> > +report_svar_unify_error(Context, VarSet, StateVar) -->
> > + { Name = varset__lookup_name(VarSet, StateVar) },
> > + prog_out__write_context(Context),
> > + report_warning(string__format("\
> > +Error: !%s cannot appear as a unification argument.\n", [s(Name)])),
> > + globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
> > + (
> > + { VerboseErrors = yes },
> > + prog_out__write_context(Context),
> > + report_warning(string__format("\
> > + You probably meant !.%s or !:%s.\n", [s(Name), s(Name)]))
> > + ;
> > + { VerboseErrors = no }
> > + ).
>
> The `--verbose-errors' part is short enough that you could just
> always include it in the message.
Done.
> > @@ -7614,7 +7689,7 @@
> > :- mode build_lambda_expression(in, in, in, in, in, in, in, in,
> > in, in, in, out, out, in, out, in, di, uo) is det.
> >
> > -build_lambda_expression(X, PredOrFunc, EvalMethod, Args, Modes, Det,
> > +build_lambda_expression(X, PredOrFunc, EvalMethod, Args0, Modes, Det,
> > ParsedGoal, VarSet0, Context, MainContext, SubContext,
> > Goal, VarSet, Info1, Info, SInfo0) -->
> > %
> > @@ -7652,56 +7727,75 @@
> > % corresponding to the function result term is a new variable,
> > % to avoid the function result term becoming lambda-quantified.
> > %
> > - { list__length(Args, NumArgs) },
> > - { varset__new_vars(VarSet0, NumArgs, LambdaVars, VarSet1) },
> > - { map__init(Substitution) },
> > - { prepare_for_head(SInfo0, SInfo1) },
> > - { hlds_goal__true_goal(Head0) },
> > - { ArgContext = head(PredOrFunc, NumArgs) },
> > + (
> > + { illegal_state_var_func_result(PredOrFunc, Args0, StateVar) }
> > + ->
> > + report_illegal_func_svar_result(Context, VarSet0, StateVar),
> > + { true_goal(Goal) },
> > + { VarSet = VarSet0 },
> > + { Info = Info1 }
> > + ;
> > + { prepare_for_lambda(SInfo0, SInfo1) },
> > + { Args1 = expand_bang_state_var_args(Args0) },
>
> That's not right. The following example should be an error.
> (pred(!X::in, !:X::out) is det :- ...)
Fixed. !X is forbidden as a lamba head argument.
> > +:- func reconciled_disj_svar_info(prog_varset, hlds_goal_svar_infos) =
> > + svar_info.
>
> This whole section needs more documentation.
Done.
diff -u make_hlds.m make_hlds.m
--- make_hlds.m 2 May 2002 03:54:54 -0000
+++ make_hlds.m 6 Jun 2002 03:26:37 -0000
@@ -16,6 +16,9 @@
% super-homogenous form, and introduce implicit quantification.
%
% XXX we should record each error using module_info_incr_errors.
+%
+% XXX For state variables, we should allow quantifiers around if-then-else
+% expressions.
% WISHLIST - we should handle explicit module quantification
@@ -117,7 +120,7 @@
:- import_module libs__options, libs__globals.
:- import_module string, char, int, set, bintree, map, multi_map, require.
-:- import_module bag, term, varset, getopt, assoc_list, term_io, counter.
+:- import_module bag, term, varset, getopt, assoc_list, term_io.
parse_tree_to_hlds(module(Name, Items), MQInfo0, EqvMap, Module, QualInfo,
UndefTypes, UndefModes) -->
@@ -409,9 +412,6 @@
{ Pragma = foreign_proc(_, _, _, _, _, _) },
{ Module = Module0 }
;
- % Note that we check during add_item_clause that we have
- % defined a foreign_type which is usable by the back-end
- % we are compiling on.
{ Pragma = foreign_type(ForeignType, _MercuryType, Name) },
{ varset__init(VarSet) },
@@ -566,11 +566,11 @@
add_pred_marker(Module0, "promise_semipure", Name, Arity,
ImportStatus, Context, promised_semipure, [], Module)
;
- % Handle pragma termination_info decls later on, in pass 3 --
- % we need to add function default modes before handling
- % these pragmas
- { Pragma = termination_info(_, _, _, _, _) },
- { Module = Module0 }
+ { Pragma = termination_info(PredOrFunc, SymName, ModeList,
+ MaybeArgSizeInfo, MaybeTerminationInfo) },
+ add_pragma_termination_info(PredOrFunc, SymName, ModeList,
+ MaybeArgSizeInfo, MaybeTerminationInfo, Context,
+ Module0, Module)
;
{ Pragma = terminates(Name, Arity) },
add_pred_marker(Module0, "terminates", Name, Arity,
@@ -804,25 +804,10 @@
add_pragma_type_spec(Pragma, Context, Module0, Module,
Info0, Info)
;
- { Pragma = termination_info(PredOrFunc, SymName, ModeList,
- MaybeArgSizeInfo, MaybeTerminationInfo) }
- ->
- add_pragma_termination_info(PredOrFunc, SymName, ModeList,
- MaybeArgSizeInfo, MaybeTerminationInfo, Context,
- Module0, Module),
- { Info = Info0 }
- ;
- { Pragma = foreign_type(_, _, Name) }
- ->
- check_foreign_type(Name, Context, Module0, Module),
+ % don't worry about any pragma decs but c_code, tabling,
+ % type_spec and fact_table here
+ { Module = Module0 },
{ Info = Info0 }
- ;
- % don't worry about any pragma declarations other than the
- % clause-like pragmas (c_code, tabling and fact_table),
- % foreign_type and the termination_info pragma here,
- % since they've already been handled earlier, in pass 2
- { Module = Module0 },
- { Info = Info0 }
).
add_item_clause(promise(PromiseType, Goal, VarSet, UnivVars),
@@ -1933,22 +1918,9 @@
module_info_set_types(Module0, Types, Module)
}
;
- { merge_foreign_type_bodies(Body, Body_2, NewBody) }
- ->
- { hlds_data__set_type_defn(TVarSet_2, Params_2,
- NewBody, Status, Context, T3) },
- { map__det_update(Types0, TypeCtor, T3, Types) },
- { module_info_set_types(Module0, Types, Module) }
- ;
- % otherwise issue an error message if the second
- % definition wasn't read while reading .opt files.
- { Status = opt_imported }
- ->
- { Module = Module0 }
- ;
- { module_info_incr_errors(Module0, Module) },
- multiple_def_error(Status, Name, Arity, "type", Context,
- OrigContext, _)
+ { Module = Module0 },
+ multiple_def_error(Status, Name, Arity, "type",
+ Context, OrigContext, _)
)
;
{ map__set(Types0, TypeCtor, T, Types) },
@@ -2024,109 +1996,6 @@
)
).
- % check_foreign_type ensures that if we are generating code for
- % a specific backend that the foreign type has a representation
- % on that backend.
-:- pred check_foreign_type(sym_name::in, prog_context::in,
- module_info::in, module_info::out, io::di, io::uo) is det.
-
-check_foreign_type(Name, Context, Module0, Module) -->
- { TypeCtor = Name - 0 },
- { module_info_types(Module0, Types) },
- { TypeStr = error_util__describe_sym_name_and_arity(Name/0) },
- (
- { map__search(Types, TypeCtor, Defn) },
- { hlds_data__get_type_defn_body(Defn, Body) },
- { Body = foreign_type(MaybeIL, MaybeC) }
- ->
- { module_info_globals(Module0, Globals) },
- generating_code(GeneratingCode),
- ( { GeneratingCode = yes } ->
- io_lookup_bool_option(very_verbose, VeryVerbose),
- { VeryVerbose = yes ->
- VerboseErrorPieces = [
- nl,
- words("There are representations for"),
- words("this type on other back-ends,"),
- words("but none for this back-end.")
- ]
- ;
- VerboseErrorPieces = []
- },
- { globals__get_target(Globals, Target) },
- ( { Target = c },
- ( { MaybeC = yes(_) },
- { Module = Module0 }
- ; { MaybeC = no },
- { ErrorPieces = [
- words("Error: no C pragma"),
- words("foreign_type declaration for"),
- fixed(TypeStr) | VerboseErrorPieces
- ] },
- error_util__write_error_pieces(Context,
- 0, ErrorPieces),
- { module_info_incr_errors(Module0, Module) }
- )
- ; { Target = il },
- ( { MaybeIL = yes(_) },
- { Module = Module0 }
- ; { MaybeIL = no },
- { ErrorPieces = [
- words("Error: no IL pragma"),
- words("foreign_type declaration for"),
- fixed(TypeStr) | VerboseErrorPieces
- ] },
- error_util__write_error_pieces(Context, 0,
- ErrorPieces),
- { module_info_incr_errors(Module0, Module) }
- )
- ; { Target = java },
- { Module = Module0 }
- ; { Target = asm },
- { Module = Module0 }
- )
- ;
- { Module = Module0 }
- )
- ;
- { error("check_foreign_type: unable to find foreign type") }
- ).
-
- % Do the options imply that we will generate code for a specific
- % back-end?
-:- pred generating_code(bool::out, io::di, io::uo) is det.
-
-generating_code(bool__not(NotGeneratingCode)) -->
- io_lookup_bool_option(make_short_interface, MakeShortInterface),
- io_lookup_bool_option(make_interface, MakeInterface),
- io_lookup_bool_option(make_private_interface, MakePrivateInterface),
- io_lookup_bool_option(make_transitive_opt_interface,
- MakeTransOptInterface),
- io_lookup_bool_option(generate_source_file_mapping, GenSrcFileMapping),
- io_lookup_bool_option(generate_dependencies, GenDepends),
- io_lookup_bool_option(convert_to_mercury, ConvertToMercury),
- io_lookup_bool_option(typecheck_only, TypeCheckOnly),
- io_lookup_bool_option(errorcheck_only, ErrorCheckOnly),
- io_lookup_bool_option(output_grade_string, OutputGradeString),
- { bool__or_list([MakeShortInterface, MakeInterface,
- MakePrivateInterface, MakeTransOptInterface,
- GenSrcFileMapping, GenDepends, ConvertToMercury,
- TypeCheckOnly, ErrorCheckOnly, OutputGradeString],
- NotGeneratingCode) }.
-
-:- pred merge_foreign_type_bodies(hlds_type_body::in,
- hlds_type_body::in, hlds_type_body::out) is semidet.
-
-merge_foreign_type_bodies(foreign_type(MaybeILA, MaybeCA),
- foreign_type(MaybeILB, MaybeCB),
- foreign_type(MaybeIL, MaybeC)) :-
- merge_maybe(MaybeILA, MaybeILB, MaybeIL),
- merge_maybe(MaybeCA, MaybeCB, MaybeC).
-
-:- pred merge_maybe(maybe(T)::in, maybe(T)::in, maybe(T)::out) is semidet.
-merge_maybe(yes(T), no, yes(T)).
-merge_maybe(no, yes(T), yes(T)).
-
:- pred make_status_abstract(import_status, import_status).
:- mode make_status_abstract(in, out) is det.
@@ -2773,11 +2642,12 @@
di, uo) is det.
module_add_instance_defn(Module0, InstanceModuleName, Constraints, ClassName,
- Types, Body, VarSet, Status, Context, Module) -->
+ Types, Body0, VarSet, Status, Context, Module) -->
{ module_info_classes(Module0, Classes) },
{ module_info_instances(Module0, Instances0) },
{ list__length(Types, ClassArity) },
{ ClassId = class_id(ClassName, ClassArity) },
+ { Body = expand_bang_state_var_args_in_instance_method_heads(Body0) },
(
{ map__search(Classes, ClassId, _) }
->
@@ -3582,12 +3452,9 @@
:- mode module_add_clause(in, in, in, in, in, in, in, in, in,
out, in, out, di, uo) is det.
-module_add_clause(ModuleInfo0, ClauseVarSet, PredOrFunc, PredName, Args0, Body,
+module_add_clause(ModuleInfo0, ClauseVarSet, PredOrFunc, PredName, Args, Body,
Status, Context, GoalType, ModuleInfo,
Info0, Info) -->
-
- { Args = expand_dot_colon_state_var_args(Args0) },
-
globals__io_lookup_bool_option(very_verbose, VeryVerbose),
( { VeryVerbose = yes } ->
io__write_string("% Processing clause for "),
@@ -3713,15 +3580,26 @@
:- mode module_add_clause(in, in, in, in, in, in, in, in, in,
out, in, out, di, uo) is det.
-module_add_clause(ModuleInfo0, ClauseVarSet, PredOrFunc, PredName, Args, Body,
+module_add_clause(ModuleInfo0, ClauseVarSet, PredOrFunc, PredName, Args0, Body,
Status, Context, GoalType, ModuleInfo,
Info0, Info) -->
+
+ { IllegalSVarResult =
+ ( if illegal_state_var_func_result(PredOrFunc, Args0, SVar)
+ then yes(SVar)
+ else no
+ ) },
+ { ArityAdjustment = ( if IllegalSVarResult = yes(_) then -1 else 0 ) },
+
+ { Args = expand_bang_state_var_args(Args0) },
+
globals__io_lookup_bool_option(very_verbose, VeryVerbose),
( { VeryVerbose = yes } ->
io__write_string("% Processing clause for "),
hlds_out__write_pred_or_func(PredOrFunc),
io__write_string(" `"),
- { list__length(Args, PredArity) },
+ { list__length(Args, PredArity0) },
+ { PredArity = PredArity0 + ArityAdjustment },
{ adjust_func_arity(PredOrFunc, OrigArity, PredArity) },
prog_out__write_sym_name_and_arity(PredName/OrigArity),
io__write_string("'...\n")
@@ -3733,7 +3611,8 @@
% (If it's not there, call maybe_undefined_pred_error
% and insert an implicit declaration for the predicate.)
{ module_info_name(ModuleInfo0, ModuleName) },
- { list__length(Args, Arity) },
+ { list__length(Args, Arity0) },
+ { Arity = Arity0 + ArityAdjustment },
{ module_info_get_predicate_table(ModuleInfo0, PredicateTable0) },
(
{ predicate_table_search_pf_sym_arity(PredicateTable0,
@@ -3790,6 +3669,29 @@
PredInfo1 = PredInfo0
},
(
+ { IllegalSVarResult = yes(StateVar) }
+ ->
+ report_illegal_func_svar_result(Context, ClauseVarSet,
+ StateVar),
+ { ModuleInfo = ModuleInfo1 },
+ { Info = Info0 }
+ ;
+ { pred_info_pragma_goal_type(PredInfo1) },
+ { get_mode_annotations(Args, _, empty, ModeAnnotations) },
+ { ModeAnnotations = empty ; ModeAnnotations = none }
+ ->
+ % If we have a pragma foreign_proc for this procedure
+ % already, and we are trying to add a non-mode specific
+ % Mercury clause
+ { module_info_incr_errors(ModuleInfo1, ModuleInfo) },
+ prog_out__write_context(Context),
+ io__write_string("Error: non mode-specific clause for "),
+ hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
+ io__write_string("\n"),
+ prog_out__write_context(Context),
+ io__write_string(" with `:- pragma foreign_proc' declaration preceding.\n"),
+ { Info = Info0 }
+ ;
%
% User-supplied clauses for field access functions are
% not allowed -- the clauses are always generated by the
@@ -3956,28 +3858,12 @@
)
;
{ ModeAnnotations = empty },
- { pred_info_pragma_goal_type(PredInfo) ->
- % We are only allowed to mix foreign procs and
- % mode specific clauses, so make this clause
- % mode specific but apply to all modes.
- pred_info_all_procids(PredInfo, ProcIds)
- ;
- % this means the clauses applies to all modes
- ProcIds = []
- },
+ { ProcIds = [] }, % this means the clauses applies to all modes
{ ModuleInfo = ModuleInfo0 },
{ Info = Info0 }
;
{ ModeAnnotations = none },
- { pred_info_pragma_goal_type(PredInfo) ->
- % We are only allowed to mix foreign procs and
- % mode specific clauses, so make this clause
- % mode specific but apply to all modes.
- pred_info_all_procids(PredInfo, ProcIds)
- ;
- % this means the clauses applies to all modes
- ProcIds = []
- },
+ { ProcIds = [] }, % this means the clauses applies to all modes
{ ModuleInfo = ModuleInfo0 },
{ Info = Info0 }
;
@@ -4119,31 +4005,43 @@
ModuleInfo - QualInfo - ClausesInfo) -->
(
{ InstanceClause = clause(CVarSet, PredOrFunc, PredName,
- HeadTerms, Body) }
+ HeadTerms0, Body) }
->
- { PredArity = list__length(HeadTerms) },
- { adjust_func_arity(PredOrFunc, Arity, PredArity) },
- % The tvarset argument is only used for explicit type
- % qualifications, of which there are none in this clause,
- % so it is set to a dummy value.
- { varset__init(TVarSet0) },
-
- { ProcIds = [] }, % means this clause applies to _every_
- % mode of the procedure
- { GoalType = none }, % goal is not a promise
- clauses_info_add_clause(ClausesInfo0, ProcIds,
- CVarSet, TVarSet0, HeadTerms, Body, Context, Status,
- PredOrFunc, Arity, GoalType, Goal,
- VarSet, _TVarSet, ClausesInfo, Warnings,
- ModuleInfo0, ModuleInfo, QualInfo0, QualInfo),
-
- % warn about singleton variables
- maybe_warn_singletons(VarSet,
- PredOrFunc - PredName/Arity, ModuleInfo, Goal),
-
- % warn about variables with overlapping scopes
- maybe_warn_overlap(Warnings, VarSet,
- PredOrFunc - PredName/Arity)
+ (
+ { illegal_state_var_func_result(PredOrFunc, HeadTerms0,
+ StateVar) }
+ ->
+ report_illegal_func_svar_result(Context, CVarSet,
+ StateVar),
+ { ModuleInfo = ModuleInfo0 },
+ { QualInfo = QualInfo0 },
+ { ClausesInfo = ClausesInfo0 }
+ ;
+ { HeadTerms = expand_bang_state_var_args(HeadTerms0) },
+ { PredArity = list__length(HeadTerms) },
+ { adjust_func_arity(PredOrFunc, Arity, PredArity) },
+ % The tvarset argument is only used for explicit type
+ % qualifications, of which there are none in this clause,
+ % so it is set to a dummy value.
+ { varset__init(TVarSet0) },
+
+ { ProcIds = [] }, % means this clause applies to _every_
+ % mode of the procedure
+ { GoalType = none }, % goal is not a promise
+ clauses_info_add_clause(ClausesInfo0, ProcIds,
+ CVarSet, TVarSet0, HeadTerms, Body, Context,
+ Status, PredOrFunc, Arity, GoalType, Goal,
+ VarSet, _TVarSet, ClausesInfo, Warnings,
+ ModuleInfo0, ModuleInfo, QualInfo0, QualInfo),
+
+ % warn about singleton variables
+ maybe_warn_singletons(VarSet,
+ PredOrFunc - PredName/Arity, ModuleInfo, Goal),
+
+ % warn about variables with overlapping scopes
+ maybe_warn_overlap(Warnings, VarSet,
+ PredOrFunc - PredName/Arity)
+ )
;
{ error("produce_clause: invalid instance item") }
).
@@ -4369,31 +4267,9 @@
% tagged as opt_imported only if/when we see a clause (including
% a `pragma c_code' clause) for them
{ Status = opt_imported ->
- pred_info_set_import_status(PredInfo0, opt_imported, PredInfo1a)
- ;
- PredInfo1a = PredInfo0
- },
- {
- % If this procedure was previously defined as clauses only
- % then we need to turn all the non mode-specific clauses
- % into mode-specific clauses.
- pred_info_clause_goal_type(PredInfo1a)
- ->
- pred_info_clauses_info(PredInfo1a, CInfo0),
- clauses_info_clauses(CInfo0, ClauseList0),
- ClauseList = list__map(
- (func(C) =
- ( C = clause([], Goal, mercury, Ctxt) ->
- clause(AllProcIds, Goal, mercury, Ctxt)
- ;
- C
- ) :-
- pred_info_all_procids(PredInfo1a, AllProcIds)
- ), ClauseList0),
- clauses_info_set_clauses(CInfo0, ClauseList, CInfo),
- pred_info_set_clauses_info(PredInfo1a, CInfo, PredInfo1)
+ pred_info_set_import_status(PredInfo0, opt_imported, PredInfo1)
;
- PredInfo1 = PredInfo1a
+ PredInfo1 = PredInfo0
},
(
{ pred_info_is_imported(PredInfo1) }
@@ -4407,6 +4283,23 @@
io__write_string(".\n"),
{ Info = Info0 }
;
+ { pred_info_clause_goal_type(PredInfo1) },
+ { pred_info_clauses_info(PredInfo1, CInfo) },
+ { clauses_info_clauses(CInfo, ClauseList) },
+ { list__member(clause([], _, mercury, _), ClauseList) }
+
+ ->
+ { module_info_incr_errors(ModuleInfo1, ModuleInfo) },
+ prog_out__write_context(Context),
+ io__write_string("Error: `:- pragma foreign_proc' (or `pragma c_code')\n"),
+ prog_out__write_context(Context),
+ io__write_string("declaration for "),
+ hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
+ io__write_string("\n"),
+ prog_out__write_context(Context),
+ io__write_string(" with preceding non-mode specific clauses.\n"),
+ { Info = Info0 }
+ ;
% Don't add clauses for foreign languages other
% than the ones we can generate code for.
{ not list__member(PragmaForeignLanguage, BackendForeignLangs) }
@@ -5297,8 +5190,7 @@
transform(Subst, HeadVars, Args, Body, VarSet1, Context, PredOrFunc,
Arity, GoalType, Goal0, VarSet, Warnings,
transform_info(Module0, Info1),
- transform_info(Module, Info2),
- new_svar_info),
+ transform_info(Module, Info2)),
{ TVarSet = Info2 ^ tvarset },
{ qual_info_get_found_syntax_error(Info2, FoundError) },
{ qual_info_set_found_syntax_error(no, Info2, Info) },
@@ -5504,7 +5396,7 @@
clauses_info_add_pragma_foreign_proc(ClausesInfo0, Purity, Attributes0, PredId,
ProcId, PVarSet, PVars, OrigArgTypes, PragmaImpl0, Context,
PredOrFunc, PredName, Arity, ClausesInfo, ModuleInfo0,
- ModuleInfo, Info, Info) -->
+ ModuleInfo, Info0, Info) -->
{ ClausesInfo0 = clauses_info(VarSet0, VarTypes, TVarNameMap,
VarTypes1, HeadVars, ClauseList, TI_VarMap, TCI_VarMap,
@@ -5538,10 +5430,8 @@
% substitutions, and they will be.
insert_arg_unifications(HeadVars, TermArgs, Context,
head(PredOrFunc, Arity), yes, HldsGoal0, VarSet1,
- HldsGoal1, VarSet2,
- transform_info(ModuleInfo1, Info0),
- transform_info(ModuleInfo, Info),
- new_svar_info, _),
+ HldsGoal1, VarSet2, transform_info(ModuleInfo1, Info0),
+ transform_info(ModuleInfo, Info)),
{
map__init(EmptyVarTypes),
implicitly_quantify_clause_body(HeadVars,
@@ -5578,47 +5468,33 @@
:- pred transform(prog_substitution, list(prog_var), list(prog_term), goal,
prog_varset, prog_context, pred_or_func, arity, goal_type,
hlds_goal, prog_varset, list(quant_warning),
- transform_info, transform_info, svar_info,
+ transform_info, transform_info,
io__state, io__state).
:- mode transform(in, in, in, in, in, in, in, in, in, out, out, out,
- in, out, in, di, uo) is det.
-
-transform(Subst, HeadVars, Args0, Body0, VarSet0, Context, PredOrFunc,
- Arity, GoalType, Goal, VarSet, Warnings, Info0, Info,
- SInfo0, IO0, IO) :-
-
- term__apply_substitution_to_list(Args0, Subst, Args),
-
- hlds_goal__true_goal(Head0),
-
- prepare_for_head(SInfo0, SInfo1),
+ in, out, di, uo) is det.
- ( if GoalType = promise(_) then
- VarSet1 = VarSet0,
- Head = Head0,
- Info1 = Info0,
- SInfo2 = SInfo1,
- IO1 = IO0
- else
- ArgContext = head(PredOrFunc, Arity),
+transform(Subst, HeadVars, Args0, Body, VarSet0, Context, PredOrFunc,
+ Arity, GoalType, Goal, VarSet, Warnings, Info0, Info) -->
+ transform_goal(Body, VarSet0, Subst, Goal1, VarSet1, Info0, Info1),
+ { term__apply_substitution_to_list(Args0, Subst, Args) },
+
+ % The head variables of an assertion will always be
+ % variables, so it is unnecessary to insert unifications.
+ (
+ { GoalType = promise(_) }
+ ->
+ { VarSet2 = VarSet1 },
+ { Goal2 = Goal1 },
+ { Info2 = Info0 }
+ ;
+ { ArgContext = head(PredOrFunc, Arity) },
insert_arg_unifications(HeadVars, Args, Context, ArgContext,
- no, Head0, VarSet0, Head, VarSet1, Info0, Info1,
- SInfo1, SInfo2, IO0, IO1)
+ no, Goal1, VarSet1, Goal2, VarSet2, Info1, Info2)
),
-
- prepare_for_body(FinalSVarMap, VarSet1, VarSet2, SInfo2, SInfo3),
-
- transform_goal(Body0, VarSet2, Subst, Body, VarSet3, Info1, Info2,
- SInfo3, SInfo, IO1, IO),
-
- finish_head_and_body(Context, FinalSVarMap, Head, Body, Goal0,
- SInfo),
-
- VarTypes2 = Info2 ^ qual_info ^ vartypes,
- implicitly_quantify_clause_body(HeadVars, Goal0, VarSet3, VarTypes2,
- Goal, VarSet, VarTypes, Warnings),
-
- Info = Info2 ^ qual_info ^ vartypes := VarTypes.
+ { VarTypes2 = Info2 ^ qual_info ^ vartypes },
+ { implicitly_quantify_clause_body(HeadVars, Goal2, VarSet2, VarTypes2,
+ Goal, VarSet, VarTypes, Warnings) },
+ { Info = Info2 ^ qual_info ^ vartypes := VarTypes }.
%-----------------------------------------------------------------------------%
@@ -5638,6 +5514,7 @@
( { MultipleArgs = [_ | _] } ->
{ ClausesInfo = ClausesInfo0 },
{ ModuleInfo = ModuleInfo1 },
+ { Info = Info0 },
prog_out__write_context(Context),
io__write_string(
"In `:- pragma foreign_proc' declaration for "),
@@ -5663,7 +5540,12 @@
io__write_string(" in the argument list.\n"),
io__set_exit_status(1)
;
+ % merge the varsets of the proc and the new pragma_c_code
{
+ varset__merge_subst(VarSet0, PVarSet, VarSet1, Subst),
+ map__apply_to_list(Args0, Subst, TermArgs),
+ term__term_list_to_var_list(TermArgs, Args),
+
% build the pragma_c_code
goal_info_init(GoalInfo0),
goal_info_set_context(GoalInfo0, Context, GoalInfo1),
@@ -5671,12 +5553,24 @@
% this foreign code is inlined
add_goal_info_purity_feature(GoalInfo1, Purity, GoalInfo),
HldsGoal0 = foreign_proc(Attributes, PredId,
- ProcId, HeadVars, ArgInfo, OrigArgTypes, PragmaImpl)
- - GoalInfo,
- ModuleInfo = ModuleInfo1,
+ ProcId, Args, ArgInfo, OrigArgTypes, PragmaImpl)
+ - GoalInfo
+ },
+ % Apply unifications with the head args.
+ % Since the set of head vars and the set vars in the
+ % pragma foreign code are disjoint, the
+ % unifications can be implemented as
+ % substitutions, and they will be.
+ insert_arg_unifications(HeadVars, TermArgs, Context,
+ head(PredOrFunc, Arity), yes, HldsGoal0, VarSet1,
+ HldsGoal1, VarSet2,
+ transform_info(ModuleInfo1, Info0),
+ transform_info(ModuleInfo, Info),
+ new_svar_info, _),
+ {
map__init(EmptyVarTypes),
implicitly_quantify_clause_body(HeadVars,
- HldsGoal0, VarSet0, EmptyVarTypes,
+ HldsGoal1, VarSet2, EmptyVarTypes,
HldsGoal, VarSet, _, _Warnings),
NewClause = clause([ProcId], HldsGoal,
foreign_language(NewLang), Context),
@@ -5709,33 +5603,49 @@
:- pred transform(prog_substitution, list(prog_var), list(prog_term), goal,
prog_varset, prog_context, pred_or_func, arity, goal_type,
hlds_goal, prog_varset, list(quant_warning),
- transform_info, transform_info,
- io__state, io__state).
+ transform_info, transform_info, io__state, io__state).
:- mode transform(in, in, in, in, in, in, in, in, in, out, out, out,
in, out, di, uo) is det.
-transform(Subst, HeadVars, Args0, Body, VarSet0, Context, PredOrFunc,
- Arity, GoalType, Goal, VarSet, Warnings, Info0, Info) -->
- transform_goal(Body, VarSet0, Subst, Goal1, VarSet1, Info0, Info1),
- { term__apply_substitution_to_list(Args0, Subst, Args) },
-
- % The head variables of an assertion will always be
- % variables, so it is unnecessary to insert unifications.
- (
- { GoalType = promise(_) }
- ->
- { VarSet2 = VarSet1 },
- { Goal2 = Goal1 },
- { Info2 = Info0 }
- ;
- { ArgContext = head(PredOrFunc, Arity) },
+transform(Subst, HeadVars, Args0, Body0, VarSet0, Context, PredOrFunc,
+ Arity, GoalType, Goal, VarSet, Warnings, Info0, Info,
+ IO0, IO) :-
+
+ prepare_for_head(SInfo0),
+
+ term__apply_substitution_to_list(Args0, Subst, Args1),
+
+ substitute_state_var_mappings(Args1, Args, VarSet0, VarSet1,
+ SInfo0, SInfo1, IO0, IO1),
+
+ hlds_goal__true_goal(Head0),
+
+ ( if GoalType = promise(_) then
+ VarSet2 = VarSet1,
+ Head = Head0,
+ Info1 = Info0,
+ SInfo2 = SInfo1,
+ IO2 = IO1
+ else
+ ArgContext = head(PredOrFunc, Arity),
insert_arg_unifications(HeadVars, Args, Context, ArgContext,
- Goal1, VarSet1, Goal2, VarSet2, Info1, Info2)
+ no, Head0, VarSet1, Head, VarSet2, Info0, Info1,
+ SInfo1, SInfo2, IO1, IO2)
),
- { VarTypes2 = Info2 ^ qual_info ^ vartypes },
- { implicitly_quantify_clause_body(HeadVars, Goal2, VarSet2, VarTypes2,
- Goal, VarSet, VarTypes, Warnings) },
- { Info = Info2 ^ qual_info ^ vartypes := VarTypes }.
+
+ prepare_for_body(FinalSVarMap, VarSet2, VarSet3, SInfo2, SInfo3),
+
+ transform_goal(Body0, VarSet3, Subst, Body, VarSet4, Info1, Info2,
+ SInfo3, SInfo, IO2, IO),
+
+ finish_head_and_body(Context, FinalSVarMap, Head, Body, Goal0,
+ SInfo),
+
+ VarTypes2 = Info2 ^ qual_info ^ vartypes,
+ implicitly_quantify_clause_body(HeadVars, Goal0, VarSet4, VarTypes2,
+ Goal, VarSet, VarTypes, Warnings),
+
+ Info = Info2 ^ qual_info ^ vartypes := VarTypes.
%-----------------------------------------------------------------------------%
@@ -5765,13 +5675,17 @@
:- mode transform_goal_2(in, in, in, in, out, out, in, out, in, out, di, uo)
is det.
-transform_goal_2(fail, _, VarSet, _, disj([]) - GoalInfo, VarSet,
- Info, Info, SInfo, SInfo) -->
- { goal_info_init(GoalInfo) }.
+transform_goal_2(fail, _, VarSet0, _, disj([]) - GoalInfo, VarSet,
+ Info, Info, SInfo0, SInfo) -->
+ { goal_info_init(GoalInfo) },
+ { prepare_for_next_conjunct(set__init, VarSet0, VarSet,
+ SInfo0, SInfo) }.
-transform_goal_2(true, _, VarSet, _, conj([]) - GoalInfo, VarSet,
- Info, Info, SInfo, SInfo) -->
- { goal_info_init(GoalInfo) }.
+transform_goal_2(true, _, VarSet0, _, conj([]) - GoalInfo, VarSet,
+ Info, Info, SInfo0, SInfo) -->
+ { goal_info_init(GoalInfo) },
+ { prepare_for_next_conjunct(set__init, VarSet0, VarSet,
+ SInfo0, SInfo) }.
% Convert `all [Vars] Goal' into `not some [Vars] not Goal'.
transform_goal_2(all(Vars0, Goal0), Context, VarSet0, Subst, Goal, VarSet,
@@ -5810,15 +5724,15 @@
if_then_else(Vars, A, B, C) - GoalInfo, VarSet,
Info0, Info, SInfo0, SInfo) -->
{ substitute_vars(Vars0, Subst, Vars) },
- transform_goal(A0, VarSet0, Subst, A, VarSet1, Info0, Info1,
- SInfo0, SInfo1),
+ transform_goal(A0, VarSet0, Subst, A, VarSet1, Info0, Info1,
+ SInfo0, SInfoA),
transform_goal(B0, VarSet1, Subst, B1, VarSet2, Info1, Info2,
- SInfo1, SInfoB),
+ SInfoA, SInfoB),
transform_goal(C0, VarSet2, Subst, C1, VarSet3, Info2, Info,
SInfo0, SInfoC),
{ goal_info_init(GoalInfo) },
- { finish_if_then_else(Context, B1, B, C1, C, VarSet3, VarSet,
- SInfoB, SInfoC, SInfo) }.
+ { finish_if_then_else(Context, GoalInfo, B1, B, C1, C,
+ SInfo0, SInfoA, SInfoB, SInfoC, SInfo, VarSet3, VarSet) }.
transform_goal_2(if_then(Vars0, A0, B0), Context, Subst, VarSet0,
Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
@@ -5826,41 +5740,40 @@
Context, Subst, VarSet0, Goal, VarSet, Info0, Info,
SInfo0, SInfo).
-transform_goal_2(not(A0), Context, VarSet0, Subst, Goal, VarSet, Info0, Info,
+transform_goal_2(not(A0), _, VarSet0, Subst, Goal, VarSet, Info0, Info,
SInfo0, SInfo) -->
- transform_goal(A0, VarSet0, Subst, A, VarSet1, Info0, Info,
+ transform_goal(A0, VarSet0, Subst, A, VarSet, Info0, Info,
SInfo0, SInfo1),
{ goal_info_init(GoalInfo) },
- { Goal0 = not(A) - GoalInfo },
- { finish_negation(Context, Goal0, Goal, VarSet1, VarSet,
- SInfo0, SInfo1, SInfo) }.
+ { Goal = not(A) - GoalInfo },
+ { finish_negation(SInfo0, SInfo1, SInfo) }.
transform_goal_2((A0, B0), _, VarSet0, Subst, Goal, VarSet, Info0, Info,
SInfo0, SInfo) -->
- get_conj(A0, Subst, [], VarSet0, L0, VarSet1, Info0, Info1,
+ get_rev_conj(A0, Subst, [], VarSet0, R0, VarSet1, Info0, Info1,
SInfo0, SInfo1),
- get_conj(B0, Subst, L0, VarSet1, L1, VarSet, Info1, Info,
+ get_rev_conj(B0, Subst, R0, VarSet1, R, VarSet, Info1, Info,
SInfo1, SInfo),
- { L = list__reverse(L1) },
+ { L = list__reverse(R) },
{ goal_info_init(GoalInfo) },
{ conj_list_to_goal(L, GoalInfo, Goal) }.
transform_goal_2((A0 & B0), _, VarSet0, Subst, Goal, VarSet, Info0, Info,
SInfo0, SInfo) -->
- get_par_conj(B0, Subst, [], VarSet0, L0, VarSet1, Info0, Info1,
+ get_rev_par_conj(B0, Subst, [], VarSet0, R0, VarSet1, Info0, Info1,
SInfo0, SInfo1),
- get_par_conj(A0, Subst, L0, VarSet1, L1, VarSet, Info1, Info,
+ get_rev_par_conj(A0, Subst, R0, VarSet1, R, VarSet, Info1, Info,
SInfo1, SInfo),
- { L = list__reverse(L1) },
+ { L = list__reverse(R) },
{ goal_info_init(GoalInfo) },
{ par_conj_list_to_goal(L, GoalInfo, Goal) }.
transform_goal_2((A0 ; B0), Context, VarSet0, Subst, Goal, VarSet, Info0, Info,
SInfo0, SInfo) -->
get_disj(B0, Subst, [], VarSet0, L0, VarSet1, Info0, Info1, SInfo0),
- get_disj(A0, Subst, L0, VarSet1, L1, VarSet2, Info1, Info, SInfo0),
- { finish_disjunction(Context, L1, L, VarSet2, VarSet, SInfo) },
- { goal_info_init(GoalInfo) },
+ get_disj(A0, Subst, L0, VarSet1, L1, VarSet, Info1, Info, SInfo0),
+ { finish_disjunction(Context, VarSet, L1, L, SInfo) },
+ { goal_info_init(Context, GoalInfo) },
{ disj_list_to_goal(L, GoalInfo, Goal) }.
transform_goal_2(implies(P, Q), Context, VarSet0, Subst, Goal, VarSet,
@@ -5870,7 +5783,7 @@
transform_goal_2(TransformedGoal, Context, VarSet0, Subst,
Goal, VarSet, Info0, Info, SInfo0, SInfo).
-transform_goal_2(equivalent(P0, Q0), Context, VarSet0, Subst, Goal, VarSet,
+transform_goal_2(equivalent(P0, Q0), _, VarSet0, Subst, Goal, VarSet,
Info0, Info, SInfo0, SInfo) -->
%
% `P <=> Q' is defined as `(P => Q), (Q => P)',
@@ -5882,16 +5795,15 @@
{ goal_info_init(GoalInfo) },
transform_goal(P0, VarSet0, Subst, P, VarSet1, Info0, Info1,
SInfo0, SInfo1),
- transform_goal(Q0, VarSet1, Subst, Q, VarSet2, Info1, Info,
+ transform_goal(Q0, VarSet1, Subst, Q, VarSet, Info1, Info,
SInfo1, SInfo2),
- { Goal0 = shorthand(bi_implication(P, Q)) - GoalInfo },
- { finish_equivalence(Context, Goal0, Goal, VarSet2, VarSet,
- SInfo0, SInfo2, SInfo) }.
+ { Goal = shorthand(bi_implication(P, Q)) - GoalInfo },
+ { finish_equivalence(SInfo0, SInfo2, SInfo) }.
transform_goal_2(call(Name, Args0, Purity), Context, VarSet0, Subst, Goal,
VarSet, Info0, Info, SInfo0, SInfo) -->
{ prepare_for_call(SInfo0, SInfo1) },
- { Args1 = expand_dot_colon_state_var_args(Args0) },
+ { Args1 = expand_bang_state_var_args(Args0) },
(
{ Name = unqualified("\\=") },
{ Args1 = [LHS, RHS] }
@@ -5988,28 +5900,63 @@
{ record_called_pred_or_func(predicate, Name, Arity,
Info0, Info1) },
insert_arg_unifications(HeadVars, Args,
- Context, call(CallId),
- Goal0, VarSet1, Goal, VarSet, Info1, Info)
- ).
+ Context, call(CallId), no,
+ Goal0, VarSet1, Goal, VarSetX, Info1, Info,
+ SInfo1, SInfoX)
+ ),
+ { finish_call(VarSetX, VarSet, SInfoX, SInfo) }.
transform_goal_2(unify(A0, B0, Purity), Context, VarSet0, Subst, Goal, VarSet,
- Info0, Info) -->
- { term__apply_substitution(A0, Subst, A) },
- { term__apply_substitution(B0, Subst, B) },
- unravel_unification(A, B, Context, explicit, [],
- VarSet0, Purity, Goal, VarSet, Info0, Info).
-
+ Info0, Info, SInfo0, SInfo) -->
+ % It is an error for the left or right hand side of a
+ % unification to be !X (it may be !.X or !:X, however).
+ %
+ ( if { A0 = functor(atom("!"), [variable(StateVarA)], _) } then
+ report_svar_unify_error(Context, VarSet0, StateVarA),
+ { true_goal(Goal) },
+ { VarSet = VarSet0 },
+ { Info = Info0 },
+ { SInfo = SInfo0 }
+ else if { B0 = functor(atom("!"), [variable(StateVarB)], _) } then
+ report_svar_unify_error(Context, VarSet0, StateVarB),
+ { true_goal(Goal) },
+ { VarSet = VarSet0 },
+ { Info = Info0 },
+ { SInfo = SInfo0 }
+ else
+ { prepare_for_call(SInfo0, SInfo1) },
+ { term__apply_substitution(A0, Subst, A) },
+ { term__apply_substitution(B0, Subst, B) },
+ unravel_unification(A, B, Context, explicit, [],
+ VarSet0, Purity, Goal, VarSet1, Info0, Info,
+ SInfo1, SInfo2),
+ { finish_call(VarSet1, VarSet, SInfo2, SInfo) }
+ ).
+
+
+:- pred report_svar_unify_error(prog_context, prog_varset, svar, io, io).
+:- mode report_svar_unify_error(in, in, in, di, uo) is det.
+
+report_svar_unify_error(Context, VarSet, StateVar) -->
+ { Name = varset__lookup_name(VarSet, StateVar) },
+ prog_out__write_context(Context),
+ report_warning(string__format("\
+Error: !%s cannot appear as a unification argument.\n", [s(Name)])),
+ prog_out__write_context(Context),
+ report_warning(string__format("\
+ You probably meant !.%s or !:%s.\n", [s(Name), s(Name)])).
+
:- inst dcg_record_syntax_op = bound("=^"; ":=").
:- pred transform_dcg_record_syntax(string, list(prog_term), prog_context,
prog_varset, hlds_goal, prog_varset, transform_info,
- transform_info, io__state, io__state).
+ transform_info, svar_info, svar_info, io__state, io__state).
:- mode transform_dcg_record_syntax(in(dcg_record_syntax_op),
- in, in, in, out, out, in, out, di, uo) is det.
+ in, in, in, out, out, in, out, in, out, di, uo) is det.
transform_dcg_record_syntax(Operator, ArgTerms0, Context, VarSet0,
- Goal, VarSet, Info0, Info) -->
+ Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
{ goal_info_init(Context, GoalInfo) },
(
{ ArgTerms0 = [LHSTerm, RHSTerm,
@@ -6560,8 +6507,9 @@
{ record_called_pred_or_func(PredOrFunc, SymName,
InsertArity, Info0, Info1) },
insert_arg_unifications(AllArgs, AllArgTerms,
- Context, call(CallId),
- Goal0, VarSet3, Goal, VarSet, Info1, Info)
+ Context, call(CallId), no, Goal0,
+ VarSet3, Goal, VarSet, Info1, Info,
+ SInfo0, SInfo)
;
{ invalid_goal(UpdateStr, Args0, GoalInfo,
Goal, VarSet0, VarSet) },
@@ -6621,8 +6569,8 @@
insert_arg_unifications(AllArgs,
[term__variable(LambdaVar), AditiState0Term,
AditiStateTerm],
- Context, CallId, no, UpdateConj,
- VarSet7, UpdateGoal, VarSet, Info4, Info, SInfo2, SInfo)
+ Context, CallId, no, UpdateConj, VarSet7, UpdateGoal,
+ VarSet, Info4, Info)
;
%
% Second syntax -
@@ -6663,12 +6611,11 @@
{ parse_goal(GoalTerm, VarSet1, ParsedGoal, VarSet2) },
{ map__init(Substitution) },
transform_goal(ParsedGoal, VarSet2, Substitution,
- PredGoal0, VarSet3, Info0, Info1),
+ PredGoal0, VarSet3, Info0, Info1, SInfo0, SInfo1),
{ ArgContext = head(PredOrFunc, PredArity) },
insert_arg_unifications(HeadArgs, HeadArgs1, Context,
- ArgContext, PredGoal0, VarSet3, PredGoal1, VarSet4,
- Info1, Info2),
-
+ ArgContext, no, PredGoal0, VarSet3, PredGoal1, VarSet4,
+ Info1, Info2, SInfo1, SInfo2),
% Quantification will reduce this down to
% the proper set of nonlocal arguments.
{ goal_util__goal_vars(PredGoal, LambdaGoalVars0) },
@@ -6738,8 +6685,8 @@
insert_arg_unifications(AllArgs,
[term__variable(LambdaVar), AditiState0Term,
AditiStateTerm],
- Context, CallId, UpdateConj, VarSet7, UpdateGoal,
- VarSet, Info4, Info)
+ Context, CallId, no, UpdateConj,
+ VarSet7, UpdateGoal, VarSet, Info4, Info, SInfo2, SInfo)
;
%
% Second syntax -
@@ -6779,7 +6726,8 @@
{ record_called_pred_or_func(PredOrFunc, SymName, Arity,
Info0, Info1) },
insert_arg_unifications(OtherArgs, OtherArgs0, Context, CallId,
- Call, VarSet1, UpdateGoal, VarSet, Info1, Info)
+ no, Call, VarSet1, UpdateGoal,
+ VarSet, Info1, Info, SInfo0, SInfo)
;
{ invalid_goal(Descr, Args0, GoalInfo,
UpdateGoal, VarSet0, VarSet) },
@@ -6901,23 +6849,22 @@
:- pred insert_arg_unifications(list(prog_var), list(prog_term),
prog_context, arg_context, bool, hlds_goal, prog_varset,
hlds_goal, prog_varset, transform_info, transform_info,
- svar_info, svar_info, io__state, io__state).
+ io__state, io__state).
:- mode insert_arg_unifications(in, in, in, in, in, in, in, out,
- out, in, out, in, out, di, uo) is det.
+ out, in, out, di, uo) is det.
insert_arg_unifications(HeadVars, Args, Context, ArgContext, ForPragmaC,
- Goal0, VarSet0, Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
+ Goal0, VarSet0, Goal, VarSet, Info0, Info) -->
( { HeadVars = [] } ->
{ Goal = Goal0 },
{ VarSet = VarSet0 },
- { Info = Info0 },
- { SInfo = SInfo0 }
+ { Info = Info0 }
;
{ Goal0 = _ - GoalInfo0 },
{ goal_to_conj_list(Goal0, List0) },
insert_arg_unifications_2(HeadVars, Args, Context, ArgContext,
ForPragmaC, 0, List0, VarSet0, List, VarSet,
- Info0, Info, SInfo0, SInfo),
+ Info0, Info),
{ goal_info_set_context(GoalInfo0, Context, GoalInfo) },
{ conj_list_to_goal(List, GoalInfo, Goal) }
).
@@ -6925,59 +6872,55 @@
:- pred insert_arg_unifications_2(list(prog_var), list(prog_term),
prog_context, arg_context, bool, int, list(hlds_goal),
prog_varset, list(hlds_goal), prog_varset,
- transform_info, transform_info, svar_info, svar_info,
- io__state, io__state).
+ transform_info, transform_info, io__state, io__state).
:- mode insert_arg_unifications_2(in, in, in, in, in, in, in, in,
- out, out, in, out, in, out, di, uo) is det.
+ out, out, in, out, di, uo) is det.
-insert_arg_unifications_2([], [_|_], _, _, _, _, _, _, _, _, _, _, _, _) -->
+insert_arg_unifications_2([], [_|_], _, _, _, _, _, _, _, _, _, _) -->
{ error("insert_arg_unifications_2: length mismatch") }.
-insert_arg_unifications_2([_|_], [], _, _, _, _, _, _, _, _, _, _, _, _) -->
+insert_arg_unifications_2([_|_], [], _, _, _, _, _, _, _, _, _, _) -->
{ error("insert_arg_unifications_2: length mismatch") }.
insert_arg_unifications_2([], [], _, _, _, _, List, VarSet, List, VarSet,
- Info, Info, SInfo, SInfo) --> [].
+ Info, Info) --> [].
insert_arg_unifications_2([Var|Vars], [Arg|Args], Context, ArgContext,
- ForPragmaC, N0, List0, VarSet0, List, VarSet,
- Info0, Info, SInfo0, SInfo) -->
+ ForPragmaC, N0, List0, VarSet0, List, VarSet, Info0, Info) -->
{ N1 is N0 + 1 },
insert_arg_unification(Var, Arg, Context, ArgContext,
ForPragmaC, N1, List0, VarSet0, List1, VarSet1, ArgUnifyConj,
- Info0, Info1, SInfo0, SInfo1),
+ Info0, Info1),
(
{ ArgUnifyConj = [] }
->
insert_arg_unifications_2(Vars, Args, Context, ArgContext,
ForPragmaC, N1, List1, VarSet1, List, VarSet,
- Info1, Info, SInfo1, SInfo)
+ Info1, Info)
;
insert_arg_unifications_2(Vars, Args, Context, ArgContext,
ForPragmaC, N1, List1, VarSet1, List2, VarSet,
- Info1, Info, SInfo1, SInfo),
+ Info1, Info),
{ list__append(ArgUnifyConj, List2, List) }
).
:- pred insert_arg_unifications_with_supplied_contexts(list(prog_var),
list(prog_term), assoc_list(int, arg_context), prog_context,
hlds_goal, prog_varset, hlds_goal, prog_varset,
- transform_info, transform_info, svar_info, svar_info,
- io__state, io__state).
-:- mode insert_arg_unifications_with_supplied_contexts(in, in, in, in, in,
- in, out, out, in, out, in, out, di, uo) is det.
+ transform_info, transform_info, io__state, io__state).
+:- mode insert_arg_unifications_with_supplied_contexts(in, in, in, in, in, in,
+ out, out, in, out, di, uo) is det.
insert_arg_unifications_with_supplied_contexts(ArgVars,
ArgTerms, ArgContexts, Context, Goal0, VarSet0,
- Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
+ Goal, VarSet, Info0, Info) -->
( { ArgVars = [] } ->
{ Goal = Goal0 },
{ VarSet = VarSet0 },
- { Info = Info0 },
- { SInfo = SInfo0 }
+ { Info = Info0 }
;
{ Goal0 = _ - GoalInfo0 },
{ goal_to_conj_list(Goal0, GoalList0) },
insert_arg_unifications_with_supplied_contexts_2(ArgVars,
ArgTerms, ArgContexts, Context, GoalList0,
- VarSet0, GoalList, VarSet, Info0, Info, SInfo0, SInfo),
+ VarSet0, GoalList, VarSet, Info0, Info),
{ goal_info_set_context(GoalInfo0, Context, GoalInfo) },
{ conj_list_to_goal(GoalList, GoalInfo, Goal) }
).
@@ -6993,7 +6936,17 @@
% that each unification gets reduced to superhomogeneous form.
% It also gets passed a `arg_context', which indicates
% where the terms came from.
+
% We never insert unifications of the form X = X.
+ % If ForPragmaC is yes, we process unifications of the form
+ % X = Y by substituting the var expected by the outside environment
+ % (the head variable) for the variable inside the goal (which was
+ % created just for the pragma_c_code goal), while giving the headvar
+ % the name of the just eliminated variable. The result will be
+ % a proc_info in which the head variables have meaningful names
+ % and the body goal is just a pragma C code. Without this special
+ % treatment, the body goal will be a conjunction, which would
+ % complicate the handling of code generation for nondet pragma C codes.
:- type arg_context
--->
@@ -7011,80 +6964,89 @@
).
:- pred insert_arg_unifications(list(prog_var), list(prog_term),
- prog_context, arg_context, hlds_goal, prog_varset,
+ prog_context, arg_context, bool, hlds_goal, prog_varset,
hlds_goal, prog_varset, transform_info, transform_info,
- io__state, io__state).
-:- mode insert_arg_unifications(in, in, in, in, in, in, out,
- out, in, out, di, uo) is det.
+ svar_info, svar_info, io__state, io__state).
+:- mode insert_arg_unifications(in, in, in, in, in, in, in, out,
+ out, in, out, in, out, di, uo) is det.
-insert_arg_unifications(HeadVars, Args, Context, ArgContext,
- Goal0, VarSet0, Goal, VarSet, Info0, Info) -->
+insert_arg_unifications(HeadVars, Args0, Context, ArgContext, ForPragmaC,
+ Goal0, VarSet0, Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
( { HeadVars = [] } ->
{ Goal = Goal0 },
{ VarSet = VarSet0 },
- { Info = Info0 }
+ { Info = Info0 },
+ { SInfo = SInfo0 }
;
{ Goal0 = _ - GoalInfo0 },
{ goal_to_conj_list(Goal0, List0) },
+ substitute_state_var_mappings(Args0, Args, VarSet0, VarSet1,
+ SInfo0, SInfo1),
insert_arg_unifications_2(HeadVars, Args, Context, ArgContext,
- 0, List0, VarSet0, List, VarSet,
- Info0, Info),
+ ForPragmaC, 0, List0, VarSet1, List, VarSet,
+ Info0, Info, SInfo1, SInfo),
{ goal_info_set_context(GoalInfo0, Context, GoalInfo) },
{ conj_list_to_goal(List, GoalInfo, Goal) }
).
:- pred insert_arg_unifications_2(list(prog_var), list(prog_term),
- prog_context, arg_context, int, list(hlds_goal),
+ prog_context, arg_context, bool, int, list(hlds_goal),
prog_varset, list(hlds_goal), prog_varset,
- transform_info, transform_info, io__state, io__state).
-:- mode insert_arg_unifications_2(in, in, in, in, in, in, in,
- out, out, in, out, di, uo) is det.
+ transform_info, transform_info, svar_info, svar_info,
+ io__state, io__state).
+:- mode insert_arg_unifications_2(in, in, in, in, in, in, in, in,
+ out, out, in, out, in, out, di, uo) is det.
-insert_arg_unifications_2([], [_|_], _, _, _, _, _, _, _, _, _) -->
+insert_arg_unifications_2([], [_|_], _, _, _, _, _, _, _, _, _, _, _, _) -->
{ error("insert_arg_unifications_2: length mismatch") }.
-insert_arg_unifications_2([_|_], [], _, _, _, _, _, _, _, _, _) -->
+insert_arg_unifications_2([_|_], [], _, _, _, _, _, _, _, _, _, _, _, _) -->
{ error("insert_arg_unifications_2: length mismatch") }.
-insert_arg_unifications_2([], [], _, _, _, List, VarSet, List, VarSet,
- Info, Info) --> [].
+insert_arg_unifications_2([], [], _, _, _, _, List, VarSet, List, VarSet,
+ Info, Info, SInfo, SInfo) --> [].
insert_arg_unifications_2([Var|Vars], [Arg|Args], Context, ArgContext,
- N0, List0, VarSet0, List, VarSet, Info0, Info) -->
+ ForPragmaC, N0, List0, VarSet0, List, VarSet,
+ Info0, Info, SInfo0, SInfo) -->
{ N1 is N0 + 1 },
insert_arg_unification(Var, Arg, Context, ArgContext,
- N1, List0, VarSet0, List1, VarSet1, ArgUnifyConj,
- Info0, Info1),
+ ForPragmaC, N1, List0, VarSet0, List1, VarSet1, ArgUnifyConj,
+ Info0, Info1, SInfo0, SInfo1),
(
{ ArgUnifyConj = [] }
->
insert_arg_unifications_2(Vars, Args, Context, ArgContext,
- N1, List1, VarSet1, List, VarSet,
- Info1, Info)
+ ForPragmaC, N1, List1, VarSet1, List, VarSet,
+ Info1, Info, SInfo1, SInfo)
;
insert_arg_unifications_2(Vars, Args, Context, ArgContext,
- N1, List1, VarSet1, List2, VarSet,
- Info1, Info),
+ ForPragmaC, N1, List1, VarSet1, List2, VarSet,
+ Info1, Info, SInfo1, SInfo),
{ list__append(ArgUnifyConj, List2, List) }
).
:- pred insert_arg_unifications_with_supplied_contexts(list(prog_var),
list(prog_term), assoc_list(int, arg_context), prog_context,
hlds_goal, prog_varset, hlds_goal, prog_varset,
- transform_info, transform_info, io__state, io__state).
-:- mode insert_arg_unifications_with_supplied_contexts(in, in, in, in, in, in,
- out, out, in, out, di, uo) is det.
+ transform_info, transform_info, svar_info, svar_info,
+ io__state, io__state).
+:- mode insert_arg_unifications_with_supplied_contexts(in, in, in, in, in,
+ in, out, out, in, out, in, out, di, uo) is det.
insert_arg_unifications_with_supplied_contexts(ArgVars,
- ArgTerms, ArgContexts, Context, Goal0, VarSet0,
- Goal, VarSet, Info0, Info) -->
+ ArgTerms0, ArgContexts, Context, Goal0, VarSet0,
+ Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
( { ArgVars = [] } ->
{ Goal = Goal0 },
{ VarSet = VarSet0 },
- { Info = Info0 }
+ { Info = Info0 },
+ { SInfo = SInfo0 }
;
{ Goal0 = _ - GoalInfo0 },
{ goal_to_conj_list(Goal0, GoalList0) },
+ substitute_state_var_mappings(ArgTerms0, ArgTerms,
+ VarSet0, VarSet1, SInfo0, SInfo1),
insert_arg_unifications_with_supplied_contexts_2(ArgVars,
ArgTerms, ArgContexts, Context, GoalList0,
- VarSet0, GoalList, VarSet, Info0, Info),
+ VarSet1, GoalList, VarSet, Info0, Info, SInfo1, SInfo),
{ goal_info_set_context(GoalInfo0, Context, GoalInfo) },
{ conj_list_to_goal(GoalList, GoalInfo, Goal) }
).
@@ -7112,7 +7074,7 @@
{ Terms = [Term | Terms1] },
{ ArgContexts = [ArgNumber - ArgContext | ArgContexts1] }
->
- insert_arg_unification(Var, Term, Context, ArgContext,
+ insert_arg_unification(Var, Term, Context, ArgContext, no,
ArgNumber, List0, VarSet0, List1, VarSet1,
UnifyConj, Info0, Info1, SInfo0, SInfo1),
insert_arg_unifications_with_supplied_contexts_2(Vars1, Terms1,
@@ -7124,15 +7086,16 @@
).
:- pred insert_arg_unification(prog_var, prog_term,
- prog_context, arg_context, int,
+ prog_context, arg_context, bool, int,
list(hlds_goal), prog_varset, list(hlds_goal), prog_varset,
list(hlds_goal), transform_info, transform_info,
- io__state, io__state).
-:- mode insert_arg_unification(in, in, in, in, in,
- in, in, out, out, out, in, out, di, uo) is det.
+ svar_info, svar_info, io__state, io__state).
+:- mode insert_arg_unification(in, in, in, in, in, in,
+ in, in, out, out, out, in, out, in, out, di, uo) is det.
-insert_arg_unification(Var, Arg, Context, ArgContext, N1,
- List0, VarSet0, List1, VarSet1, ArgUnifyConj, Info0, Info) -->
+insert_arg_unification(Var, Arg, Context, ArgContext, ForPragmaC, N1,
+ List0, VarSet0, List1, VarSet1, ArgUnifyConj,
+ Info0, Info, SInfo0, SInfo) -->
(
{ Arg = term__variable(Var) }
->
@@ -7143,11 +7106,29 @@
{ List1 = List0 },
{ SInfo = SInfo0 }
;
+ { Arg = term__variable(ArgVar) },
+ { ForPragmaC = yes }
+ ->
+ % Handle unifications of the form `X = Y' by substitution
+ % if this is safe.
+ { Info = Info0 },
+ { ArgUnifyConj = [] },
+ { map__init(Subst0) },
+ { map__det_insert(Subst0, ArgVar, Var, Subst) },
+ { goal_util__rename_vars_in_goals(List0, no, Subst, List1) },
+ { varset__search_name(VarSet0, ArgVar, ArgVarName) ->
+ varset__name_var(VarSet0, Var, ArgVarName, VarSet1)
+ ;
+ VarSet1 = VarSet0
+ },
+ { SInfo = SInfo0 }
+ ;
{ arg_context_to_unify_context(ArgContext, N1,
UnifyMainContext, UnifySubContext) },
unravel_unification(term__variable(Var), Arg,
Context, UnifyMainContext, UnifySubContext,
- VarSet0, pure, Goal, VarSet1, Info0, Info),
+ VarSet0, pure, Goal, VarSet1, Info0, Info,
+ SInfo0, SInfo),
{ goal_to_conj_list(Goal, ArgUnifyConj) },
{ List1 = List0 }
).
@@ -7163,7 +7144,7 @@
:- mode append_arg_unifications(in, in, in, in, in, in,
out, out, in, out, in, out, di, uo) is det.
-append_arg_unifications(HeadVars, Args, Context, ArgContext, Goal0,
+append_arg_unifications(HeadVars, Args0, Context, ArgContext, Goal0,
VarSet0, Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
( { HeadVars = [] } ->
{ Goal = Goal0 },
@@ -7173,9 +7154,11 @@
;
{ Goal0 = _ - GoalInfo },
{ goal_to_conj_list(Goal0, List0) },
+ substitute_state_var_mappings(Args0, Args, VarSet0, VarSet1,
+ SInfo0, SInfo1),
append_arg_unifications_2(HeadVars, Args, Context, ArgContext,
- 0, List0, VarSet0, List, VarSet, Info0, Info,
- SInfo0, SInfo),
+ 0, List0, VarSet1, List, VarSet, Info0, Info,
+ SInfo1, SInfo),
{ conj_list_to_goal(List, GoalInfo, Goal) }
).
@@ -7302,9 +7285,26 @@
:- mode unravel_unification(in, in, in, in, in, in, in, out, out,
in, out, in, out, di, uo) is det.
+unravel_unification(LHS0, RHS0, Context, MainContext, SubContext,
+ VarSet0, Purity, Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
+ substitute_state_var_mapping(LHS0, LHS,
+ VarSet0, VarSet1, SInfo0, SInfo1),
+ substitute_state_var_mapping(RHS0, RHS,
+ VarSet1, VarSet2, SInfo1, SInfo2),
+ unravel_unification_2(LHS, RHS, Context, MainContext, SubContext,
+ VarSet2, Purity, Goal, VarSet, Info0, Info, SInfo2, SInfo).
+
+
+:- pred unravel_unification_2(prog_term, prog_term, prog_context,
+ unify_main_context, unify_sub_contexts, prog_varset,
+ purity, hlds_goal, prog_varset, transform_info, transform_info,
+ svar_info, svar_info, io__state, io__state).
+:- mode unravel_unification_2(in, in, in, in, in, in, in, out, out,
+ in, out, in, out, di, uo) is det.
+
% `X = Y' needs no unravelling.
-unravel_unification(term__variable(X), term__variable(Y), Context,
+unravel_unification_2(term__variable(X), term__variable(Y), Context,
MainContext, SubContext, VarSet0, Purity, Goal, VarSet,
Info0, Info, SInfo, SInfo) -->
{ make_atomic_unification(X, var(Y), Context, MainContext,
@@ -7321,40 +7321,25 @@
% NewVar3 = A3.
% In the trivial case `X = c', no unravelling occurs.
-unravel_unification(term__variable(X), RHS,
+unravel_unification_2(term__variable(X), RHS,
Context, MainContext, SubContext, VarSet0, Purity,
Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
- { RHS = term__functor(F, Args, FunctorContext) },
+ { RHS = term__functor(F, Args0, FunctorContext) },
+ { Args1 = expand_bang_state_var_args(Args0) },
+ substitute_state_var_mappings(Args1, Args, VarSet0, VarSet1,
+ SInfo0, SInfo1),
(
- % Handle !.X state variable references.
- { F = term__atom("!.") },
- { Args = [term__variable(StateVar)] }
- ->
- dot(Context, StateVar, Var, VarSet0, VarSet,
- SInfo0, SInfo),
- { Goal = svar_unification(Context, X, Var) },
- { Info = Info0 }
- ;
- % Handle !:X state variable references.
- { F = term__atom("!:") },
- { Args = [term__variable(StateVar)] }
- ->
- colon(Context, StateVar, Var, VarSet0, VarSet,
- SInfo0, SInfo),
- { Goal = svar_unification(Context, X, Var) },
- { Info = Info0 }
- ;
% Handle explicit type qualification.
{ F = term__atom("with_type") },
{ Args = [RVal, DeclType0] }
->
{ convert_type(DeclType0, DeclType) },
- { varset__coerce(VarSet0, DeclVarSet) },
+ { varset__coerce(VarSet1, DeclVarSet) },
process_type_qualification(X, DeclType, DeclVarSet,
Context, Info0, Info1),
unravel_unification(term__variable(X), RVal,
- Context, MainContext, SubContext, VarSet0,
- Purity, Goal, VarSet, Info1, Info, SInfo0, SInfo)
+ Context, MainContext, SubContext, VarSet1,
+ Purity, Goal, VarSet, Info1, Info, SInfo1, SInfo)
;
% Handle unification expressions.
{ F = term__atom("@") },
@@ -7362,12 +7347,12 @@
->
unravel_unification(term__variable(X), LVal,
Context, MainContext, SubContext,
- VarSet0, Purity, Goal1, VarSet1, Info0, Info1,
- SInfo0, SInfo1),
+ VarSet1, Purity, Goal1, VarSet2, Info0, Info1,
+ SInfo1, SInfo2),
unravel_unification(term__variable(X), RVal,
Context, MainContext, SubContext,
- VarSet1, Purity, Goal2, VarSet, Info1, Info,
- SInfo1, SInfo),
+ VarSet2, Purity, Goal2, VarSet, Info1, Info,
+ SInfo2, SInfo),
{ goal_info_init(GoalInfo) },
{ goal_to_conj_list(Goal1, ConjList1) },
{ goal_to_conj_list(Goal2, ConjList2) },
@@ -7411,12 +7396,12 @@
Context, Info1, Info2),
{ Det = Det1 },
{ term__coerce(GoalTerm1, GoalTerm) },
- { parse_goal(GoalTerm, VarSet0, ParsedGoal, VarSet1) },
+ { parse_goal(GoalTerm, VarSet1, ParsedGoal, VarSet2) },
build_lambda_expression(X, PredOrFunc, EvalMethod, Vars1,
- Modes, Det, ParsedGoal, VarSet1,
+ Modes, Det, ParsedGoal, VarSet2,
Context, MainContext, SubContext, Goal, VarSet,
- Info2, Info, SInfo0),
- { SInfo = SInfo0 }
+ Info2, Info, SInfo1),
+ { SInfo = SInfo1 }
;
{
% handle higher-order dcg pred expressions -
@@ -7433,15 +7418,15 @@
make_hlds__qualify_lambda_mode_list(Modes0, Modes,
Context, Info0, Info1),
{ term__coerce(GoalTerm0, GoalTerm) },
- { parse_dcg_pred_goal(GoalTerm, VarSet0,
- ParsedGoal, DCG0, DCGn, VarSet1) },
+ { parse_dcg_pred_goal(GoalTerm, VarSet1,
+ ParsedGoal, DCG0, DCGn, VarSet2) },
{ list__append(Vars0, [term__variable(DCG0),
term__variable(DCGn)], Vars1) },
build_lambda_expression(X, predicate, EvalMethod, Vars1,
- Modes, Det, ParsedGoal, VarSet1,
+ Modes, Det, ParsedGoal, VarSet2,
Context, MainContext, SubContext, Goal0, VarSet,
- Info1, Info, SInfo0),
- { SInfo = SInfo0 },
+ Info1, Info, SInfo1),
+ { SInfo = SInfo1 },
{ Goal0 = GoalExpr - GoalInfo0 },
{ add_goal_info_purity_feature(GoalInfo0, Purity, GoalInfo) },
{ Goal = GoalExpr - GoalInfo }
@@ -7459,21 +7444,21 @@
ElseTerm]
},
{ term__coerce(IfTerm0, IfTerm) },
- { parse_some_vars_goal(IfTerm, VarSet0, Vars,
+ { parse_some_vars_goal(IfTerm, VarSet1, Vars,
IfParseTree, VarSet11) }
->
- { prepare_for_if_then_else_expr_condition(SInfo0, SInfo1) },
+ { prepare_for_if_then_else_expr_condition(SInfo1, SInfo2) },
check_expr_purity(Purity, Context, Info0, Info1),
{ map__init(EmptySubst) },
transform_goal(IfParseTree, VarSet11, EmptySubst,
- IfGoal, VarSet22, Info1, Info2, SInfo1, SInfo2),
- { finish_if_then_else_expr_condition(SInfo0, SInfo2, SInfo3) },
+ IfGoal, VarSet22, Info1, Info2, SInfo2, SInfo3),
+ { finish_if_then_else_expr_condition(SInfo1, SInfo3, SInfo4) },
unravel_unification(term__variable(X), ThenTerm,
Context, MainContext, SubContext, VarSet22,
- pure, ThenGoal, VarSet33, Info2, Info3, SInfo3, SInfo4),
+ pure, ThenGoal, VarSet33, Info2, Info3, SInfo4, SInfo5),
unravel_unification(term__variable(X), ElseTerm,
Context, MainContext, SubContext, VarSet33, pure,
- ElseGoal, VarSet, Info3, Info, SInfo4, SInfo),
+ ElseGoal, VarSet, Info3, Info, SInfo5, SInfo),
{ IfThenElse = if_then_else(Vars, IfGoal,
ThenGoal, ElseGoal) },
{ goal_info_init(Context, GoalInfo) },
@@ -7487,16 +7472,16 @@
->
check_expr_purity(Purity, Context, Info0, Info1),
{ make_fresh_arg_var(InputTerm, InputTermVar, [],
- VarSet0, VarSet1) },
+ VarSet1, VarSet2) },
expand_get_field_function_call(Context, MainContext,
SubContext, FieldNames, X, InputTermVar,
- VarSet1, VarSet2, Functor, _, Goal0, Info1, Info2,
- SInfo0, SInfo1),
+ VarSet2, VarSet3, Functor, _, Goal0, Info1, Info2,
+ SInfo1, SInfo2),
{ ArgContext = functor(Functor, MainContext, SubContext) },
append_arg_unifications([InputTermVar], [InputTerm],
FunctorContext, ArgContext, Goal0,
- VarSet2, Goal, VarSet, Info2, Info, SInfo1, SInfo)
+ VarSet3, Goal, VarSet, Info2, Info, SInfo2, SInfo)
;
% handle field update expressions
{ F = term__atom(":=") },
@@ -7508,30 +7493,30 @@
->
check_expr_purity(Purity, Context, Info0, Info1),
{ make_fresh_arg_var(InputTerm, InputTermVar, [],
- VarSet0, VarSet1) },
+ VarSet1, VarSet2) },
{ make_fresh_arg_var(FieldValueTerm, FieldValueVar,
- [InputTermVar], VarSet1, VarSet2) },
+ [InputTermVar], VarSet2, VarSet3) },
expand_set_field_function_call(Context, MainContext,
SubContext, FieldNames, FieldValueVar, InputTermVar, X,
- VarSet2, VarSet3, Functor,
+ VarSet3, VarSet4, Functor,
InnerFunctor - FieldSubContext, Goal0, Info1, Info2,
- SInfo0, SInfo1),
+ SInfo1, SInfo2),
{ TermArgContext = functor(Functor, MainContext, SubContext) },
{ TermArgNumber = 1 },
append_arg_unification(InputTermVar, InputTerm,
FunctorContext, TermArgContext, TermArgNumber,
- TermUnifyConj, VarSet3, VarSet4, Info2, Info3,
- SInfo1, SInfo2),
+ TermUnifyConj, VarSet4, VarSet5, Info2, Info3,
+ SInfo2, SInfo3),
{ FieldArgContext = functor(InnerFunctor,
MainContext, FieldSubContext) },
{ FieldArgNumber = 2 },
append_arg_unification(FieldValueVar, FieldValueTerm,
FunctorContext, FieldArgContext, FieldArgNumber,
- FieldUnifyConj, VarSet4, VarSet, Info3, Info,
- SInfo2, SInfo),
+ FieldUnifyConj, VarSet5, VarSet, Info3, Info,
+ SInfo3, SInfo),
{ Goal0 = _ - GoalInfo0 },
{ goal_to_conj_list(Goal0, GoalList0) },
@@ -7560,11 +7545,11 @@
{ add_goal_info_purity_feature(GoalInfo0, Purity,
GoalInfo) },
{ Goal = GoalExpr - GoalInfo },
- { VarSet = VarSet0 },
- { SInfo = SInfo0 }
+ { VarSet = VarSet1 },
+ { SInfo = SInfo1 }
;
- { make_fresh_arg_vars(FunctorArgs, VarSet0,
- HeadVars, VarSet1) },
+ { make_fresh_arg_vars(FunctorArgs, VarSet1,
+ HeadVars, VarSet2) },
{ make_atomic_unification(X,
functor(ConsId, HeadVars), Context,
MainContext, SubContext, Goal0,
@@ -7580,16 +7565,17 @@
( { Purity = pure } ->
append_arg_unifications(HeadVars, FunctorArgs,
FunctorContext, ArgContext, Goal0,
- VarSet1, Goal, VarSet,
- Info1, Info, SInfo0, SInfo)
+ VarSet2, Goal, VarSet,
+ Info1, Info, SInfo1, SInfo)
;
{ Goal0 = GoalExpr - GoalInfo0 },
{ add_goal_info_purity_feature(GoalInfo0,
Purity, GoalInfo) },
{ Goal1 = GoalExpr - GoalInfo },
insert_arg_unifications(HeadVars, FunctorArgs,
- FunctorContext, ArgContext, Goal1,
- VarSet1, Goal, VarSet, Info1, Info)
+ FunctorContext, ArgContext, no, Goal1,
+ VarSet2, Goal, VarSet,
+ Info1, Info, SInfo1, SInfo)
)
)
).
@@ -7597,7 +7583,7 @@
% Handle `f(...) = X' in the same way as `X = f(...)'.
-unravel_unification(term__functor(F, As, FC), term__variable(Y),
+unravel_unification_2(term__functor(F, As, FC), term__variable(Y),
C, MC, SC, VarSet0, Purity, Goal, VarSet, Info0, Info,
SInfo0, SInfo) -->
unravel_unification(term__variable(Y),
@@ -7611,7 +7597,7 @@
% Note that we can't simplify it yet, because we might simplify
% away type errors.
-unravel_unification(term__functor(LeftF, LeftAs, LeftC),
+unravel_unification_2(term__functor(LeftF, LeftAs, LeftC),
term__functor(RightF, RightAs, RightC),
Context, MainContext, SubContext, VarSet0,
Purity, Goal, VarSet, Info0, Info, SInfo0, SInfo) -->
@@ -7695,7 +7681,7 @@
:- mode build_lambda_expression(in, in, in, in, in, in, in, in,
in, in, in, out, out, in, out, in, di, uo) is det.
-build_lambda_expression(X, PredOrFunc, EvalMethod, Args, Modes, Det,
+build_lambda_expression(X, PredOrFunc, EvalMethod, Args0, Modes, Det,
ParsedGoal, VarSet0, Context, MainContext, SubContext,
Goal, VarSet, Info1, Info, SInfo0) -->
%
@@ -7733,46 +7719,82 @@
% corresponding to the function result term is a new variable,
% to avoid the function result term becoming lambda-quantified.
%
- { list__length(Args, NumArgs) },
- { varset__new_vars(VarSet0, NumArgs, LambdaVars, VarSet1) },
- { map__init(Substitution) },
- transform_goal(ParsedGoal, VarSet1, Substitution,
- HLDS_Goal0, VarSet2, Info1, Info2),
- { ArgContext = head(PredOrFunc, NumArgs) },
- insert_arg_unifications(LambdaVars, Args, Context, ArgContext,
- HLDS_Goal0, VarSet2, HLDS_Goal1, VarSet, Info2, Info3),
-
- %
- % Now figure out which variables we need to explicitly existentially
- % quantify.
- %
- {
- PredOrFunc = predicate,
- QuantifiedArgs = Args
+ (
+ { illegal_state_var_func_result(PredOrFunc, Args0, StateVar) }
+ ->
+ report_illegal_func_svar_result(Context, VarSet0, StateVar),
+ { true_goal(Goal) },
+ { VarSet = VarSet0 },
+ { Info = Info1 }
;
- PredOrFunc = function,
- pred_args_to_func_args(Args, QuantifiedArgs, _ReturnValTerm)
- },
- { term__vars_list(QuantifiedArgs, QuantifiedVars0) },
- { list__sort_and_remove_dups(QuantifiedVars0, QuantifiedVars) },
+ { lambda_args_contain_bang_state_var(Args0, StateVar) }
+ ->
+ report_illegal_bang_svar_lambda_arg(Context, VarSet0, StateVar),
+ { true_goal(Goal) },
+ { VarSet = VarSet0 },
+ { Info = Info1 }
+ ;
+ { prepare_for_lambda(SInfo0, SInfo1) },
+ { Args1 = expand_bang_state_var_args(Args0) },
+ substitute_state_var_mappings(Args1, Args, VarSet0, VarSet1,
+ SInfo1, SInfo2),
- { goal_info_init(Context, GoalInfo) },
- { HLDS_Goal = some(QuantifiedVars, can_remove, HLDS_Goal0) - GoalInfo },
+ { list__length(Args, NumArgs) },
+ { varset__new_vars(VarSet1, NumArgs, LambdaVars, VarSet2) },
+ { map__init(Substitution) },
+ { hlds_goal__true_goal(Head0) },
+ { ArgContext = head(PredOrFunc, NumArgs) },
- %
- % We set the lambda nonlocals here to anything that could possibly
- % be nonlocal. Quantification will reduce this down to
- % the proper set of nonlocal arguments.
- %
- { goal_util__goal_vars(HLDS_Goal, LambdaGoalVars0) },
- { set__delete_list(LambdaGoalVars0, LambdaVars, LambdaGoalVars1) },
- { set__delete_list(LambdaGoalVars1, QuantifiedVars, LambdaGoalVars2) },
- { set__to_sorted_list(LambdaGoalVars2, LambdaNonLocals) },
-
- { make_atomic_unification(X,
- lambda_goal(PredOrFunc, EvalMethod, modes_are_ok,
- LambdaNonLocals, LambdaVars, Modes, Det, HLDS_Goal),
- Context, MainContext, SubContext, Goal, Info3, Info) }.
+ insert_arg_unifications(LambdaVars, Args, Context, ArgContext,
+ no, Head0, VarSet2, Head, VarSet3, Info1, Info2,
+ SInfo2, SInfo3),
+
+ { prepare_for_body(FinalSVarMap, VarSet3, VarSet4,
+ SInfo3, SInfo4) },
+
+ transform_goal(ParsedGoal, VarSet4, Substitution,
+ Body, VarSet, Info2, Info3, SInfo4, SInfo5),
+
+ { finish_head_and_body(Context, FinalSVarMap,
+ Head, Body, HLDS_Goal0, SInfo5) },
+
+ %
+ % Now figure out which variables we need to
+ % explicitly existentially quantify.
+ %
+ {
+ PredOrFunc = predicate,
+ QuantifiedArgs = Args
+ ;
+ PredOrFunc = function,
+ pred_args_to_func_args(Args, QuantifiedArgs,
+ _ReturnValTerm)
+ },
+ { term__vars_list(QuantifiedArgs, QuantifiedVars0) },
+ { list__sort_and_remove_dups(QuantifiedVars0, QuantifiedVars) },
+
+ { goal_info_init(Context, GoalInfo) },
+ { HLDS_Goal = some(QuantifiedVars, can_remove, HLDS_Goal0) -
+ GoalInfo },
+
+ %
+ % We set the lambda nonlocals here to anything that
+ % could possibly be nonlocal. Quantification will
+ % reduce this down to the proper set of nonlocal arguments.
+ %
+ { goal_util__goal_vars(HLDS_Goal, LambdaGoalVars0) },
+ { set__delete_list(LambdaGoalVars0, LambdaVars,
+ LambdaGoalVars1) },
+ { set__delete_list(LambdaGoalVars1, QuantifiedVars,
+ LambdaGoalVars2) },
+ { set__to_sorted_list(LambdaGoalVars2, LambdaNonLocals) },
+
+ { make_atomic_unification(X,
+ lambda_goal(PredOrFunc, EvalMethod, modes_are_ok,
+ LambdaNonLocals, LambdaVars, Modes, Det,
+ HLDS_Goal),
+ Context, MainContext, SubContext, Goal, Info3, Info) }
+ ).
%-----------------------------------------------------------------------------%
@@ -7955,54 +7977,55 @@
%-----------------------------------------------------------------------------%
-% get_conj(Goal, Conj0, Subst, Conj) :
+% get_rev_conj(Goal, Conj0, Subst, Conj) :
% Goal is a tree of conjuncts. Flatten it into a list (applying Subst),
-% append Conj0, and return the result in Conj.
+% append Conj0, and return the result in reverse order in Conj.
-:- pred get_conj(goal, prog_substitution, list(hlds_goal), prog_varset,
+:- pred get_rev_conj(goal, prog_substitution, list(hlds_goal), prog_varset,
list(hlds_goal), prog_varset, transform_info, transform_info,
svar_info, svar_info, io__state, io__state).
-:- mode get_conj(in, in, in, in, out, out, in, out, in, out, di, uo) is det.
+:- mode get_rev_conj(in, in, in, in, out, out, in, out, in, out, di, uo) is det.
-get_conj(Goal, Subst, Conj0, VarSet0, Conj, VarSet, Info0, Info,
- SInfo0, SInfo) -->
+get_rev_conj(Goal, Subst, RevConj0, VarSet0, RevConj,
+ VarSet, Info0, Info, SInfo0, SInfo) -->
(
{ Goal = (A,B) - _Context }
->
- get_conj(A, Subst, Conj0, VarSet0, Conj1, VarSet1,
- Info0, Info1, SInfo0, SInfo1),
- get_conj(B, Subst, Conj1, VarSet1, Conj, VarSet,
- Info1, Info, SInfo1, SInfo)
+ get_rev_conj(A, Subst, RevConj0, VarSet0, RevConj1,
+ VarSet1, Info0, Info1, SInfo0, SInfo1),
+ get_rev_conj(B, Subst, RevConj1, VarSet1, RevConj,
+ VarSet, Info1, Info, SInfo1, SInfo)
;
transform_goal(Goal, VarSet0, Subst, Goal1, VarSet,
Info0, Info, SInfo0, SInfo),
{ goal_to_conj_list(Goal1, ConjList) },
- { list__append(ConjList, Conj0, Conj) }
+ { RevConj = list__reverse(ConjList) ++ RevConj0 }
).
-% get_par_conj(Goal, ParConj0, Subst, ParConj) :
+% get_rev_par_conj(Goal, ParConj0, Subst, ParConj) :
% Goal is a tree of conjuncts. Flatten it into a list (applying Subst),
-% append ParConj0, and return the result in ParConj.
+% append ParConj0, and return the result in reverse order in ParConj.
-:- pred get_par_conj(goal, prog_substitution, list(hlds_goal), prog_varset,
+:- pred get_rev_par_conj(goal, prog_substitution, list(hlds_goal), prog_varset,
list(hlds_goal), prog_varset, transform_info, transform_info,
svar_info, svar_info, io__state, io__state).
-:- mode get_par_conj(in, in, in, in, out, out, in, out, in, out, di, uo) is det.
+:- mode get_rev_par_conj(in, in, in, in, out, out, in, out, in, out,
+ di, uo) is det.
-get_par_conj(Goal, Subst, ParConj0, VarSet0, ParConj, VarSet, Info0, Info,
- SInfo0, SInfo) -->
+get_rev_par_conj(Goal, Subst, RevParConj0, VarSet0, RevParConj,
+ VarSet, Info0, Info, SInfo0, SInfo) -->
(
{ Goal = (A & B) - _Context }
->
- get_par_conj(A, Subst, ParConj0, VarSet0, ParConj1, VarSet1,
- Info0, Info1, SInfo0, SInfo1),
- get_par_conj(B, Subst, ParConj1, VarSet1, ParConj, VarSet,
- Info1, Info, SInfo1, SInfo)
+ get_rev_par_conj(A, Subst, RevParConj0, VarSet0, RevParConj1,
+ VarSet1, Info0, Info1, SInfo0, SInfo1),
+ get_rev_par_conj(B, Subst, RevParConj1, VarSet1, RevParConj,
+ VarSet, Info1, Info, SInfo1, SInfo)
;
transform_goal(Goal, VarSet0, Subst, Goal1, VarSet,
Info0, Info, SInfo0, SInfo),
{ goal_to_par_conj_list(Goal1, ParConjList) },
- { list__append(ParConjList, ParConj0, ParConj) }
+ { RevParConj = list__reverse(ParConjList) ++ RevParConj0 }
).
% get_disj(Goal, Subst, Disj0, Disj) :
@@ -8779,21 +8802,6 @@
%------------------------------------------------------------------------------%
-% % Compute the svar_info for the following atomic conjunct. We update
-% % the set of updated state variables, reset the set of locally updated
-% % state variables, make the new `!.' mappings match the old `!:'
-% % mappings and construct new `!:' mappings for those state variables
-% % that were updated.
-% %
-% :- func next_conj(svar_info) = svar_info.
-%
-% next_conj(SInfo0) = SInfo :-
-% LocalUSVs0 = SInfo0 ^ locally_updated_svars,
-% USVs = (SInfo0 ^ updated_svars) `union` LocalUSVs,
-% Dot = SInfo0 ^ colon,
-%
-%------------------------------------------------------------------------------%
-
% This synonym improves code legibility.
%
:- type svar == prog_var.
@@ -8858,6 +8866,19 @@
%------------------------------------------------------------------------------%
+ % Obtain the mapping for a !.X state variable reference and
+ % update the svar_info.
+ %
+ % If we are processing the head of a clause or lambda, we
+ % incrementally accumulate the mappings.
+ %
+ % Otherwise, the mapping must already be present for a local
+ % or `external' state variable (i.e. one that may be visible,
+ % but not updatable, in the current context.)
+ %
+ % Note that if !.X does not appear in the head then !:X must
+ % appear before !.X can be referenced.
+ %
:- pred dot(prog_context, svar, prog_var,
prog_varset, prog_varset, svar_info, svar_info, io, io).
:- mode dot(in, in, out, in, out, in, out, di, uo) is det.
@@ -8892,25 +8913,31 @@
else if SInfo0 ^ colon `contains` StateVar then
new_dot_state_var(StateVar, Var,
VarSet0, VarSet, SInfo0, SInfo),
- prog_out__write_context(Context, IO0, IO1),
- report_warning(string__format("\
-Warning: reference to unitialized state variable !.%s.\n",
- [s(varset__lookup_name(VarSet, StateVar))]),
- IO1, IO)
+ report_unitialized_state_var(Context, VarSet, StateVar,
+ IO0, IO)
else
Var = StateVar,
VarSet = VarSet0,
SInfo = SInfo0,
- prog_out__write_context(Context, IO0, IO1),
- report_warning(string__format("\
-Error: reference to !.%s, no such state variable in scope.\n",
- [s(varset__lookup_name(VarSet, StateVar))]),
- IO1, IO)
+ report_non_visible_state_var(Context, VarSet, StateVar,
+ IO0, IO)
)
).
%------------------------------------------------------------------------------%
+ % Obtain the mapping for a !:X state variable reference.
+ %
+ % If we are processing the head of a clause or lambda, we
+ % incrementally accumulate the mappings.
+ %
+ % Otherwise, the mapping must already be present for a local
+ % state variable (`externally' visible state variables cannot
+ % be updated.)
+ %
+ % We also keep track of which state variables have been updated
+ % in an atomic context.
+ %
:- pred colon(prog_context, svar, prog_var,
prog_varset, prog_varset, svar_info, svar_info, io, io).
:- mode colon(in, in, out, in, out, in, out, di, uo) is det.
@@ -8941,19 +8968,11 @@
Var = StateVar,
VarSet = VarSet0,
SInfo = SInfo0,
- Name = varset__lookup_name(VarSet0, StateVar),
- prog_out__write_context(Context, IO0, IO1),
- report_warning(string__format("\
-Error: reference to !:%s, no such state variable in scope.\n", [s(Name)]),
- IO1, IO2),
- ( if SInfo0 ^ external_dot `contains` StateVar then
- prog_out__write_context(Context, IO2, IO3),
- report_warning(string__format("\
- (although state variable !.%s is in scope.)\n", [s(Name)]),
- IO3, IO)
- else
- IO = IO2
- )
+ PError = ( if SInfo0 ^ external_dot `contains` StateVar
+ then report_illegal_state_var_update
+ else report_non_visible_state_var
+ ),
+ PError(Context, VarSet, StateVar, IO0, IO)
)
).
@@ -8990,7 +9009,20 @@
Name = varset__lookup_name(VarSet0, StateVar),
NameD = string__format("STATE_VARIABLE_%s_%d", [s(Name), i(N)]),
varset__new_named_var(VarSet0, NameD, VarD, VarSet),
- SInfo = ( SInfo0 ^ dot ^ elem(StateVar) := VarD ).
+ SInfo = ( SInfo0 ^ dot ^ elem(StateVar) := VarD ).
+
+
+:- pred new_colon_state_var(svar, prog_var,
+ prog_varset, prog_varset, svar_info, svar_info).
+:- mode new_colon_state_var(in, out, in, out, in, out) is det.
+
+new_colon_state_var(StateVar, VarC, VarSet0, VarSet, SInfo0, SInfo) :-
+ N = SInfo0 ^ num,
+ Name = varset__lookup_name(VarSet0, StateVar),
+ NameC = string__format("STATE_VARIABLE_%s_%d", [s(Name), i(N)]),
+ varset__new_named_var(VarSet0, NameC, VarC, VarSet),
+ SInfo = ( SInfo0 ^ colon ^ elem(StateVar) := VarC ).
+
:- pred new_final_state_var(svar, prog_var,
prog_varset, prog_varset, svar_info, svar_info).
@@ -9004,18 +9036,26 @@
%------------------------------------------------------------------------------%
- % This is called either for a top-level clause or for a lambda.
- % In the latter case, we need to make the current !.Xs external
+ % Prepare for the head of a new clause.
+ %
+:- pred prepare_for_head(svar_info).
+:- mode prepare_for_head(out) is det.
+
+prepare_for_head(new_svar_info).
+
+%------------------------------------------------------------------------------%
+
+ % We need to make the current !.Xs external
% ("read-only") and clear the !.Xs and !:Xs.
%
% While processing the head, any state variables therein are
% implicitly scoped over the body and have !. and !: mappings
% set up.
%
-:- pred prepare_for_head(svar_info, svar_info).
-:- mode prepare_for_head(in, out) is det.
+:- pred prepare_for_lambda(svar_info, svar_info).
+:- mode prepare_for_lambda(in, out) is det.
-prepare_for_head(SInfo0, SInfo) :-
+prepare_for_lambda(SInfo0, SInfo) :-
SInfo = ( new_svar_info ^ external_dot := SInfo0 ^ dot ).
%------------------------------------------------------------------------------%
@@ -9093,7 +9133,7 @@
:- mode add_new_local_state_var(in, in, out, in, out) is det.
add_new_local_state_var(StateVar, VarSet0, VarSet, SInfo0, SInfo) :-
- new_local_state_var(StateVar, _, _, VarSet0, VarSet, SInfo0, SInfo).
+ new_colon_state_var(StateVar, _, VarSet0, VarSet, SInfo0, SInfo).
%------------------------------------------------------------------------------%
@@ -9130,47 +9170,92 @@
%------------------------------------------------------------------------------%
- % We have to add unifiers to the Then and Else clauses of an
+ % We have to add unifiers to the Then and Else arms of an
% if-then-else to make sure all the state variables match up.
%
+ % More to the point, we have to add unifiers to the Then arm
+ % for any new state variable mappings produced in the condition.
+ %
% We construct new mappings for the state variables and then
% add unifiers.
%
-:- pred finish_if_then_else(prog_context,
+:- pred finish_if_then_else(prog_context, hlds_goal_info,
hlds_goal, hlds_goal, hlds_goal, hlds_goal,
- prog_varset, prog_varset, svar_info, svar_info, svar_info).
-:- mode finish_if_then_else(in, in, out, in, out, in, out, in, in, out) is det.
-
-finish_if_then_else(Context, Then0, Then, Else0, Else, VarSet0, VarSet,
- SInfoT, SInfoE, SInfo) :-
- SInfo0 = SInfoT,
- N = int__max(SInfoT ^ num, SInfoE ^ num),
- next_svar_info(N, VarSet0, VarSet, SInfo0, SInfo),
+ svar_info, svar_info, svar_info, svar_info, svar_info,
+ prog_varset, prog_varset).
+:- mode finish_if_then_else(in, in, in, out, in, out, in, in, in, in, out,
+ in, out) is det.
+
+finish_if_then_else(Context, GoalInfo, Then0, Then, Else0, Else,
+ SInfo0, SInfoC, SInfoT0, SInfoE, SInfo,
+ VarSet0, VarSet) :-
+
+ % Add unifiers to the Then arm for state variables that
+ % acquired new mappings in the condition, but not in the
+ % Them arm itself. This is because the new mappings
+ % appear only in a negated context.
+ %
+ StateVars = list__merge_and_remove_dups(map__keys(SInfoT0 ^ dot),
+ map__keys(SInfoE ^ dot)),
+ goal_to_conj_list(Then0, Thens0),
+ add_then_arm_specific_unifiers(Context, StateVars,
+ SInfo0, SInfoC, SInfoT0, SInfoT,
+ Thens0, Thens, VarSet0, VarSet),
+ conj_list_to_goal(Thens, GoalInfo, Then1),
- goal_info_init(Context, GoalInfo),
+ % Calculate the svar_info with the highest numbered
+ % mappings from each arm.
+ %
+ DisjSInfos = [{Then1, SInfoT}, {Else0, SInfoE}],
+ SInfo = reconciled_disj_svar_info(VarSet, DisjSInfos),
- goal_to_conj_list(Then0, ThenGoals0),
- ThenUnifiers = svar_unifiers(Context, SInfo ^ dot, SInfoT ^ dot),
- conj_list_to_goal(ThenGoals0 ++ ThenUnifiers, GoalInfo, Then),
-
- goal_to_conj_list(Else0, ElseGoals0),
- ElseUnifiers = svar_unifiers(Context, SInfo ^ dot, SInfoE ^ dot),
- conj_list_to_goal(ElseGoals0 ++ ElseUnifiers, GoalInfo, Else).
+ % Add unifiers to each arm to ensure they both construct
+ % the same final state variable mappings.
+ %
+ Then = add_disj_unifiers(Context, GoalInfo, SInfo, StateVars,
+ {Then1, SInfoT}),
+ Else = add_disj_unifiers(Context, GoalInfo, SInfo, StateVars,
+ {Else0, SInfoE}).
+
+
+ % If a new mapping was produced for state variable X in the
+ % condition-goal (i.e. the condition refers to !:X), but not
+ % in the then-goal, then we have to add a new unifier !:X = !.X
+ % to the then-goal because the new mapping was created in a
+ % negated context.
+ %
+:- pred add_then_arm_specific_unifiers(prog_context, svars,
+ svar_info, svar_info, svar_info, svar_info,
+ hlds_goals, hlds_goals, prog_varset, prog_varset).
+:- mode add_then_arm_specific_unifiers(in, in, in, in, in, out,
+ in, out, in, out) is det.
+
+add_then_arm_specific_unifiers(_, [],
+ _, _, SInfoT, SInfoT,
+ Thens, Thens, VarSet, VarSet).
+
+add_then_arm_specific_unifiers(Context, [StateVar | StateVars],
+ SInfo0, SInfoC, SInfoT0, SInfoT,
+ Thens0, Thens, VarSet0, VarSet) :-
+ ( if /* the condition refers to !:X, but the then-goal doesn't */
+ SInfoC ^ dot ^ elem(StateVar) \= SInfo0 ^ dot ^ elem(StateVar),
+ SInfoT0 ^ dot ^ elem(StateVar) = SInfoC ^ dot ^ elem(StateVar)
+ then
+ Dot0 = SInfoT0 ^ dot ^ det_elem(StateVar),
+ new_dot_state_var(StateVar, Dot, VarSet0, VarSet1,
+ SInfoT0, SInfoT1),
+ Thens1 = [svar_unification(Context, Dot, Dot0) | Thens0]
+ else
+ SInfoT1 = SInfoT0,
+ Thens1 = Thens0,
+ VarSet1 = VarSet0
+ ),
+ add_then_arm_specific_unifiers(Context, StateVars,
+ SInfo0, SInfoC, SInfoT1, SInfoT,
+ Thens1, Thens, VarSet1, VarSet).
%------------------------------------------------------------------------------%
-:- pred next_svar_info(int, prog_varset, prog_varset, svar_info, svar_info).
-:- mode next_svar_info(in, in, out, in, out) is det.
-
-next_svar_info(N, VarSet0, VarSet, SInfo0, SInfo) :-
- StateVars = map__keys(SInfo0 ^ dot),
- next_svar_mappings(N + 1, StateVars, VarSet0, VarSet1, Dot),
- next_svar_mappings(N + 2, StateVars, VarSet1, VarSet, Colon),
- SInfo = ((( SInfo0 ^ num := N + 2 )
- ^ dot := Dot )
- ^ colon := Colon ).
-
-
:- pred next_svar_mappings(int, svars, prog_varset, prog_varset, svar_map).
:- mode next_svar_mappings(in, in, in, out, out) is det.
@@ -9194,68 +9279,192 @@
% so we construct new mappings for the state variables and then
% add unifiers from their pre-negated goal mappings.
%
-:- pred finish_negation(prog_context, hlds_goal, hlds_goal,
- prog_varset, prog_varset, svar_info, svar_info, svar_info).
-:- mode finish_negation(in, in, out, in, out, in, in, out) is det.
-
-finish_negation(Context, Goal0, Goal, VarSet0, VarSet,
- SInfoBefore, SInfoNeg, SInfo) :-
- SInfo0 = SInfoBefore,
- N = SInfoNeg ^ num,
- next_svar_info(N, VarSet0, VarSet, SInfo0, SInfo),
+:- pred finish_negation(svar_info, svar_info, svar_info).
+:- mode finish_negation(in, in, out) is det.
- goal_info_init(Context, GoalInfo),
-
- goal_to_conj_list(Goal0, Goals0),
- Unifiers = svar_unifiers(Context, SInfo ^ dot, SInfo0 ^ dot),
- conj_list_to_goal(Goals0 ++ Unifiers, GoalInfo, Goal).
+finish_negation(SInfoBefore, SInfoNeg, SInfo) :-
+ SInfo = (( SInfoBefore ^ num := SInfoNeg ^ num )
+ ^ colon := SInfoNeg ^ colon ).
%------------------------------------------------------------------------------%
% We have to make sure that all arms of a disjunction produce the
- % same state variable bindings.
+ % same state variable bindings by adding unifiers as necessary.
%
-:- pred finish_disjunction(prog_context, hlds_goal_svar_infos, hlds_goals,
- prog_varset, prog_varset, svar_info).
-:- mode finish_disjunction(in, in, out, in, out, out) is det.
-
-finish_disjunction(_, [], _, _, _, _) :-
- error("make_hlds__finish_disjunction: empty disjunct list").
-
-finish_disjunction(Context, DisjSInfos, Disjs, VarSet0, VarSet, SInfo) :-
- DisjSInfos = [{_, SInfo0} | _],
- N = list__foldl(
- func({_, SI}, N0) = int__max(SI ^ num, N0),
- DisjSInfos,
- SInfo0 ^ num
- ),
- next_svar_info(N, VarSet0, VarSet, SInfo0, SInfo),
-
+:- pred finish_disjunction(prog_context, prog_varset, hlds_goal_svar_infos,
+ hlds_goals, svar_info).
+:- mode finish_disjunction(in, in, in, out, out) is det.
+
+finish_disjunction(Context, VarSet, DisjSInfos, Disjs, SInfo) :-
+ SInfo = reconciled_disj_svar_info(VarSet, DisjSInfos),
+ StateVars = map__keys(SInfo ^ dot),
goal_info_init(Context, GoalInfo),
+ Disjs = list__map(
+ add_disj_unifiers(Context, GoalInfo, SInfo, StateVars),
+ DisjSInfos).
- Disjs = list__map(
- ( func({G0, SI}) = G :-
- goal_to_conj_list(G0, Gs0),
- Us = svar_unifiers(Context,
- SInfo ^ dot, SI ^ dot),
- conj_list_to_goal(Gs0 ++ Us, GoalInfo, G)
- ),
- DisjSInfos
- ).
+
+ % Each arm of a disjunction may have a different mapping for
+ % !.X and/or !:X. The reconciled svar_info for the disjunction
+ % takes the highest numbered mapping for each disjunct (each
+ % state variable mapping for !.X or !:X will have a name of
+ % the form `STATE_VARIABLE_X_n' for some number `n'.)
+ %
+:- func reconciled_disj_svar_info(prog_varset, hlds_goal_svar_infos) =
+ svar_info.
+
+reconciled_disj_svar_info(_, []) = _ :-
+ error("make_hlds__reconciled_disj_svar_info: empty disjunct list").
+
+reconciled_disj_svar_info(VarSet, [{_, SInfo0} | DisjSInfos]) = SInfo :-
+
+ % We compute the set of final !. and !: state variables
+ % over the whole disjunction (not all arms will necessarily
+ % include !. and !: mappings for all state variables).
+ %
+ Dots0 = set__sorted_list_to_set(map__keys(SInfo0 ^ dot)),
+ Colons0 = set__sorted_list_to_set(map__keys(SInfo0 ^ colon)),
+ Dots = union_dot_svars(Dots0, DisjSInfos),
+ Colons = union_colon_svars(Colons0, DisjSInfos),
+
+ % Then we update SInfo0 to take the highest numbered
+ % !. and !: mapping for each state variable.
+ %
+ SInfo = list__foldl(
+ reconciled_svar_infos(VarSet, Dots, Colons),
+ DisjSInfos,
+ SInfo0
+ ).
+
+
+:- func union_dot_svars(svar_set, hlds_goal_svar_infos) = svar_set.
+
+union_dot_svars(Dots, [] ) = Dots.
+
+union_dot_svars(Dots, [{_, SInfo} | DisjSInfos]) =
+ union_dot_svars(
+ Dots `union`
+ set__sorted_list_to_set(map__keys(SInfo ^ dot)),
+ DisjSInfos
+ ).
+
+
+:- func union_colon_svars(svar_set, hlds_goal_svar_infos) = svar_set.
+
+union_colon_svars(Colons, [] ) = Colons.
+
+union_colon_svars(Colons, [{_, SInfo} | DisjSInfos]) =
+ union_colon_svars(
+ Colons `union`
+ set__sorted_list_to_set(map__keys(SInfo ^ colon)),
+ DisjSInfos
+ ).
+
+
+:- func reconciled_svar_infos(prog_varset, svar_set, svar_set,
+ hlds_goal_svar_info, svar_info) = svar_info.
+
+reconciled_svar_infos(VarSet, Dots, Colons,
+ {_, SInfoX}, SInfo0) = SInfo :-
+ SInfo1 = set__fold(
+ reconciled_svar_infos_dots(VarSet, SInfoX),
+ Dots,
+ SInfo0
+ ),
+ SInfo = set__fold(
+ reconciled_svar_infos_colons(VarSet, SInfoX),
+ Colons,
+ SInfo1
+ ).
+
+
+:- func reconciled_svar_infos_dots(prog_varset, svar_info, svar, svar_info) =
+ svar_info.
+
+reconciled_svar_infos_dots(VarSet, SInfoX, StateVar, SInfo0) = SInfo :-
+ ( if
+ DotX = SInfoX ^ dot ^ elem(StateVar),
+ Dot0 = SInfo0 ^ dot ^ elem(StateVar)
+ then
+ NameX = varset__lookup_name(VarSet, DotX) `with_type` string,
+ Name0 = varset__lookup_name(VarSet, Dot0) `with_type` string,
+ compare(RDot, NameX, Name0),
+ (
+ RDot = (<),
+ SInfo = ( SInfo0 ^ dot ^ elem(StateVar) := Dot0 )
+ ;
+ RDot = (=),
+ SInfo = SInfo0
+ ;
+ RDot = (>),
+ SInfo = ( SInfo0 ^ dot ^ elem(StateVar) := DotX )
+ )
+ else
+ SInfo = SInfo0
+ ).
+
+
+:- func reconciled_svar_infos_colons(prog_varset, svar_info, svar, svar_info) =
+ svar_info.
+
+reconciled_svar_infos_colons(VarSet, SInfoX, StateVar, SInfo0) = SInfo :-
+ ( if
+ ColonX = SInfoX ^ colon ^ elem(StateVar),
+ Colon0 = SInfo0 ^ colon ^ elem(StateVar)
+ then
+ NameX = varset__lookup_name(VarSet, ColonX) `with_type` string,
+ Name0 = varset__lookup_name(VarSet, Colon0) `with_type` string,
+ compare(RColon, NameX, Name0),
+ (
+ RColon = (<),
+ SInfo = ( SInfo0 ^ colon ^ elem(StateVar) := Colon0 )
+ ;
+ RColon = (=),
+ SInfo = SInfo0
+ ;
+ RColon = (>),
+ SInfo = ( SInfo0 ^ colon ^ elem(StateVar) := ColonX )
+ )
+ else
+ SInfo = SInfo0
+ ).
+
+
+:- func add_disj_unifiers(prog_context, hlds_goal_info, svar_info, svars,
+ hlds_goal_svar_info) = hlds_goal.
+
+add_disj_unifiers(Context, GoalInfo, SInfo, StateVars, {GoalX, SInfoX}) =
+ Goal :-
+ Unifiers = list__foldl(add_disj_unifier(Context, SInfo, SInfoX),
+ StateVars, []),
+ goal_to_conj_list(GoalX, GoalsX),
+ conj_list_to_goal(GoalsX ++ Unifiers, GoalInfo, Goal).
+
+
+:- func add_disj_unifier(prog_context, svar_info, svar_info, svar,
+ hlds_goals) = hlds_goals.
+
+add_disj_unifier(Context, SInfo, SInfoX, StateVar, Unifiers) =
+ ( if
+ Dot = SInfo ^ dot ^ elem(StateVar),
+ DotX = SInfoX ^ dot ^ elem(StateVar),
+ Dot \= DotX
+ then
+ [svar_unification(Context, Dot, DotX) | Unifiers]
+ else
+ Unifiers
+ ).
%------------------------------------------------------------------------------%
% We treat equivalence goals as if they were negations (they are
% in a negated context after all.)
%
-:- pred finish_equivalence(prog_context, hlds_goal, hlds_goal,
- prog_varset, prog_varset, svar_info, svar_info, svar_info).
-:- mode finish_equivalence(in, in, out, in, out, in, in, out) is det.
-
-finish_equivalence(Context, Goal0, Goal, VarSet0, VarSet,
- SInfoBefore, SInfoEqv, SInfo) :-
- finish_negation(Context, Goal0, Goal, VarSet0, VarSet,
- SInfoBefore, SInfoEqv, SInfo).
+:- pred finish_equivalence(svar_info, svar_info, svar_info).
+:- mode finish_equivalence(in, in, out) is det.
+
+finish_equivalence(SInfoBefore, SInfoEqv, SInfo) :-
+ finish_negation(SInfoBefore, SInfoEqv, SInfo).
%------------------------------------------------------------------------------%
@@ -9281,11 +9490,16 @@
% "updated" state variables, or we've just emerged, in which case
% we need to set up the svar_info for the next conjunct.
%
+ % (We can still be in an atomic context if, for example, we've
+ % been processing a function call which must appear as an
+ % expression and hence occur inside an atomic context.)
+ %
:- pred finish_call(prog_varset, prog_varset, svar_info, svar_info).
:- mode finish_call(in, out, in, out) is det.
finish_call(VarSet0, VarSet, SInfo0, SInfo) :-
- ( if SInfo0 ^ ctxt = in_atom(UpdatedStateVars, ParentSInfo) then
+ ( if SInfo0 ^ ctxt = in_atom(UpdatedStateVars, ParentSInfo0) then
+ ParentSInfo = ( ParentSInfo0 ^ dot := SInfo0 ^ dot ),
( if ParentSInfo ^ ctxt = in_atom(_, GrandParentSInfo) then
VarSet = VarSet0,
SInfo = ( ParentSInfo ^ ctxt :=
@@ -9309,9 +9523,10 @@
:- mode prepare_for_if_then_else_expr_condition(in, out) is det.
prepare_for_if_then_else_expr_condition(SInfo0, SInfo) :-
- SInfo = ((( SInfo0 ^ ctxt := in_body )
- ^ dot := map__init )
- ^ colon := map__init ).
+ SInfo = (((( SInfo0 ^ ctxt := in_body )
+ ^ external_dot := SInfo0 ^ dot )
+ ^ dot := map__init )
+ ^ colon := map__init ).
%------------------------------------------------------------------------------%
@@ -9384,7 +9599,7 @@
% If the state variable has been updated (i.e. there was a !:X
% reference) then create a new mapping for the next !:X.
% Otherwise, the next !:X mapping is the same as the current
- % !.X mapping.
+ % !:X mapping.
%
:- pred next_colon_mapping(svar_set, svar_map, int, svar, prog_var,
prog_varset, prog_varset, svar_map, svar_map).
@@ -9414,25 +9629,199 @@
%------------------------------------------------------------------------------%
-:- func expand_dot_colon_state_var_args(list(prog_term)) = list(prog_term).
+ % Replace !X args with two args !.X, !:X in that order.
+ %
+:- func expand_bang_state_var_args(list(prog_term)) = list(prog_term).
-expand_dot_colon_state_var_args(Args0) =
- list__foldr(expand_dot_colon_state_var, Args0, []).
+expand_bang_state_var_args(Args) =
+ list__foldr(expand_bang_state_var, Args, []).
-:- func expand_dot_colon_state_var(prog_term, list(prog_term)) =
+:- func expand_bang_state_var(prog_term, list(prog_term)) =
list(prog_term).
-expand_dot_colon_state_var(T @ variable(_), Ts) = [T | Ts].
+expand_bang_state_var(T @ variable(_), Ts) = [T | Ts].
-expand_dot_colon_state_var(T @ functor(Const, Args, Ctxt), Ts) =
- ( if Const = atom("!"), Args = [variable(_SVar)] then
+expand_bang_state_var(T @ functor(Const, Args, Ctxt), Ts) =
+ ( if Const = atom("!"), Args = [variable(_StateVar)] then
[ functor(atom("!."), Args, Ctxt),
functor(atom("!:"), Args, Ctxt)
| Ts ]
else
[ T | Ts ]
).
+
+%------------------------------------------------------------------------------%
+
+:- func expand_bang_state_var_args_in_instance_method_heads(instance_body) =
+ instance_body.
+
+expand_bang_state_var_args_in_instance_method_heads(abstract) = abstract.
+
+expand_bang_state_var_args_in_instance_method_heads(concrete(Methods)) =
+ concrete(list__map(expand_method_bsvs, Methods)).
+
+
+:- func expand_method_bsvs(instance_method) = instance_method.
+
+expand_method_bsvs(IM) = IM :-
+ IM = instance_method(_, _, name(_), _, _).
+
+expand_method_bsvs(IM0) = IM :-
+ IM0 = instance_method(PredOrFunc, Method, clauses(Cs0), Arity0, Ctxt),
+ Cs = list__map(expand_item_bsvs, Cs0),
+ % Note that the condition should always succeed...
+ %
+ ( if Cs = [clause(_, _, _, Args, _) | _]
+ then adjust_func_arity(PredOrFunc, Arity, list__length(Args))
+ else Arity = Arity0
+ ),
+ IM = instance_method(PredOrFunc, Method, clauses(Cs), Arity, Ctxt).
+
+
+ % The instance method clause items will all be clause items.
+ %
+:- func expand_item_bsvs(item) = item.
+
+expand_item_bsvs(Item) =
+ ( if Item = clause(VarSet, PredOrFunc, SymName, Args, Body)
+ then clause(VarSet, PredOrFunc, SymName,
+ expand_bang_state_var_args(Args), Body)
+ else Item
+ ).
+
+%------------------------------------------------------------------------------%
+
+ % Given a list of argument terms, substitute !.X and !:X with
+ % the corresponding state variable mappings. Any !X should
+ % already have been expanded into !.X, !:X via a call to
+ % expand_bang_state_var_args/1.
+ %
+:- pred substitute_state_var_mappings(list(prog_term), list(prog_term),
+ prog_varset, prog_varset, svar_info, svar_info, io, io).
+:- mode substitute_state_var_mappings(in, out, in, out, in, out, di, uo) is det.
+
+substitute_state_var_mappings([], [],
+ VarSet, VarSet, SInfo, SInfo) --> [].
+
+substitute_state_var_mappings([Arg0 | Args0], [Arg | Args],
+ VarSet0, VarSet, SInfo0, SInfo) -->
+ substitute_state_var_mapping(Arg0, Arg,
+ VarSet0, VarSet1, SInfo0, SInfo1),
+ substitute_state_var_mappings(Args0, Args,
+ VarSet1, VarSet, SInfo1, SInfo ).
+
+
+:- pred substitute_state_var_mapping(prog_term, prog_term,
+ prog_varset, prog_varset, svar_info, svar_info, io, io).
+:- mode substitute_state_var_mapping(in, out, in, out, in, out, di, uo) is det.
+
+substitute_state_var_mapping(Arg0, Arg, VarSet0, VarSet, SInfo0, SInfo) -->
+ ( if
+ { Arg0 = functor(atom("!."), [variable(StateVar)], Context) }
+ then
+ dot(Context, StateVar, Var, VarSet0, VarSet, SInfo0, SInfo),
+ { Arg = variable(Var) }
+ else if
+ { Arg0 = functor(atom("!:"), [variable(StateVar)], Context) }
+ then
+ colon(Context, StateVar, Var, VarSet0, VarSet, SInfo0, SInfo),
+ { Arg = variable(Var) }
+ else
+ { VarSet = VarSet0 },
+ { SInfo = SInfo0 },
+ { Arg = Arg0 }
+ ).
+
+%------------------------------------------------------------------------------%
+
+:- pred illegal_state_var_func_result(pred_or_func, list(prog_term), svar).
+:- mode illegal_state_var_func_result(in, in, out) is semidet.
+
+illegal_state_var_func_result(function, Args, StateVar) :-
+ list__last(Args, functor(atom("!"), [variable(StateVar)], _Ctxt)).
+
+%------------------------------------------------------------------------------%
+
+ % We do not allow !X to appear as a lambda head argument.
+ % XXX We could extend the syntax still further to accommodate
+ % this as an option, e.g. !IO::(di, uo).
+ %
+:- pred lambda_args_contain_bang_state_var(list(prog_term), prog_var).
+:- mode lambda_args_contain_bang_state_var(in, out) is semidet.
+
+lambda_args_contain_bang_state_var([Arg | Args], StateVar) :-
+ ( if Arg = functor(atom("!"), [variable(StateVar0)], _)
+ then StateVar = StateVar0
+ else lambda_args_contain_bang_state_var(Args, StateVar)
+ ).
+
+%------------------------------------------------------------------------------%
+
+:- pred report_illegal_state_var_update(prog_context, prog_varset, svar,
+ io, io).
+:- mode report_illegal_state_var_update(in, in, in, di, uo) is det.
+
+report_illegal_state_var_update(Context, VarSet, StateVar) -->
+ { Name = varset__lookup_name(VarSet, StateVar) },
+ prog_out__write_context(Context),
+ report_error(string__format("\
+cannot use !:%s in this context;\n", [s(Name)])),
+ prog_out__write_context(Context),
+ io__format("\
+ however !.%s may be used here.\n", [s(Name)]).
+
+%------------------------------------------------------------------------------%
+
+:- pred report_non_visible_state_var(prog_context, prog_varset, svar, io, io).
+:- mode report_non_visible_state_var(in, in, in, di, uo) is det.
+
+report_non_visible_state_var(Context, VarSet, StateVar) -->
+ { Name = varset__lookup_name(VarSet, StateVar) },
+ prog_out__write_context(Context),
+ report_error(string__format("\
+state variable !:%s is not visible in this context.\n", [s(Name)])).
+
+%------------------------------------------------------------------------------%
+
+:- pred report_unitialized_state_var(prog_context, prog_varset, svar, io, io).
+:- mode report_unitialized_state_var(in, in, in, di, uo) is det.
+
+report_unitialized_state_var(Context, VarSet, StateVar) -->
+ { Name = varset__lookup_name(VarSet, StateVar) },
+ prog_out__write_context(Context),
+ report_warning(string__format("\
+Warning: reference to unitialized state variable !.%s.\n", [s(Name)])).
+
+%------------------------------------------------------------------------------%
+
+:- pred report_illegal_func_svar_result(prog_context, prog_varset, svar,
+ io, io).
+:- mode report_illegal_func_svar_result(in, in, in, di, uo) is det.
+
+report_illegal_func_svar_result(Context, VarSet, StateVar) -->
+ { Name = varset__lookup_name(VarSet, StateVar) },
+ prog_out__write_context(Context),
+ report_error(string__format("\
+!%s cannot be a function result.\n", [s(Name)])),
+ prog_out__write_context(Context),
+ io__format("\
+ You probably meant !.%s or !:%s.\n", [s(Name), s(Name)]).
+
+%------------------------------------------------------------------------------%
+
+:- pred report_illegal_bang_svar_lambda_arg(prog_context, prog_varset, svar,
+ io, io).
+:- mode report_illegal_bang_svar_lambda_arg(in, in, in, di, uo) is det.
+
+report_illegal_bang_svar_lambda_arg(Context, VarSet, StateVar) -->
+ { Name = varset__lookup_name(VarSet, StateVar) },
+ prog_out__write_context(Context),
+ report_error(string__format("\
+!%s cannot be a lambda argument.\n", [s(Name)])),
+ prog_out__write_context(Context),
+ io__format("\
+ Perhaps you meant !.%s or !:%s.\n", [s(Name), s(Name)]).
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list