[m-rev.] for review: promise scopes (part 2)
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Mar 21 16:45:27 AEDT 2005
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.295
diff -u -r1.295 modes.m
--- compiler/modes.m 18 Mar 2005 01:18:15 -0000 1.295
+++ compiler/modes.m 18 Mar 2005 03:25:14 -0000
@@ -607,7 +607,15 @@
!ModuleInfo),
module_info_remove_predid(PredId, !ModuleInfo)
),
- !:NumErrors = !.NumErrors + ErrsInThisPred
+ !:NumErrors = !.NumErrors + ErrsInThisPred,
+ globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+ globals__io_lookup_bool_option(statistics, Statistics, !IO),
+ (
+ VeryVerbose = yes,
+ maybe_report_stats(Statistics, !IO)
+ ;
+ VeryVerbose = no
+ )
).
:- pred write_modes_progress_message(pred_id::in, pred_info::in,
@@ -616,18 +624,22 @@
write_modes_progress_message(PredId, PredInfo, ModuleInfo, WhatToCheck, !IO) :-
pred_info_get_markers(PredInfo, Markers),
( check_marker(Markers, infer_modes) ->
- ( WhatToCheck = check_modes,
+ (
+ WhatToCheck = check_modes,
write_pred_progress_message("% Mode-analysing ",
PredId, ModuleInfo, !IO)
- ; WhatToCheck = check_unique_modes,
+ ;
+ WhatToCheck = check_unique_modes,
write_pred_progress_message("% Unique-mode-analysing ",
PredId, ModuleInfo, !IO)
)
;
- ( WhatToCheck = check_modes,
+ (
+ WhatToCheck = check_modes,
write_pred_progress_message("% Mode-checking ",
PredId, ModuleInfo, !IO)
- ; WhatToCheck = check_unique_modes,
+ ;
+ WhatToCheck = check_unique_modes,
write_pred_progress_message("% Unique-mode-checking ",
PredId, ModuleInfo, !IO)
)
@@ -1197,11 +1209,56 @@
mode_info_set_instmap(InstMap0, !ModeInfo),
mode_checkpoint(exit, "not", !ModeInfo, !IO).
-modecheck_goal_expr(some(Vs, CanRemove, SubGoal0), _,
- some(Vs, CanRemove, SubGoal), !ModeInfo, !IO) :-
- mode_checkpoint(enter, "some", !ModeInfo, !IO),
- modecheck_goal(SubGoal0, SubGoal, !ModeInfo, !IO),
- mode_checkpoint(exit, "some", !ModeInfo, !IO).
+modecheck_goal_expr(scope(Reason, SubGoal0), _GoalInfo, GoalExpr,
+ !ModeInfo, !IO) :-
+ ( Reason = from_ground_term(TermVar) ->
+ % The original goal does no quantification, so deleting
+ % the `scope' is OK, and it is necessary for avoiding
+ % bad performance in later compiler phases, such as
+ % simplification. This deletion undoes the insertion
+ % done in the base case of unravel_unification in make_hlds.m.
+ (
+ mode_info_get_instmap(!.ModeInfo, InstMap0),
+ instmap__lookup_var(InstMap0, TermVar, InstOfVar),
+ InstOfVar = free,
+ SubGoal0 = conj([UnifyTermGoal | UnifyArgGoals])
+ - SubGoalInfo,
+ % If TermVar created by an impure unification, which is
+ % possible for solver types, it is possible for
+ % UnifyTermGoal to contain a unification other than
+ % one involving TermVar.
+ UnifyTermGoal = unify(TermVar, _, _, _, _) - _
+ ->
+ % UnifyTerm unifies TermVar with the arguments created
+ % by UnifyArgs. Since TermVar is now free and the
+ % argument variables haven't been encountered yet,
+ % UnifyTerm cannot succeed until *after* the argument
+ % variables become ground.
+ %
+ % Putting UnifyTerm after UnifyArgs here is much more
+ % efficient than letting the usual more ordering
+ % algorithm delay it repeatedly.
+
+ list__reverse([UnifyTermGoal | UnifyArgGoals],
+ RevConj),
+ RevSubGoal0 = conj(RevConj) - SubGoalInfo,
+ mode_checkpoint(enter, "ground scope", !ModeInfo, !IO),
+ modecheck_goal(RevSubGoal0, SubGoal, !ModeInfo, !IO),
+ mode_checkpoint(exit, "ground scope", !ModeInfo, !IO),
+
+ SubGoal = GoalExpr - _
+ ;
+ mode_checkpoint(enter, "scope", !ModeInfo, !IO),
+ modecheck_goal(SubGoal0, SubGoal, !ModeInfo, !IO),
+ mode_checkpoint(exit, "scope", !ModeInfo, !IO),
+ SubGoal = GoalExpr - _
+ )
+ ;
+ mode_checkpoint(enter, "scope", !ModeInfo, !IO),
+ modecheck_goal(SubGoal0, SubGoal, !ModeInfo, !IO),
+ mode_checkpoint(exit, "scope", !ModeInfo, !IO),
+ GoalExpr = scope(Reason, SubGoal)
+ ).
modecheck_goal_expr(call(PredId, ProcId0, Args0, _, Context, PredName),
GoalInfo0, Goal, !ModeInfo, !IO) :-
@@ -1782,7 +1839,8 @@
delay_info__delay_goal(DelayInfo0, FirstErrorInfo,
Goal0, DelayInfo1),
% delaying an impure goal is an impurity error
- ( Impure = yes ->
+ (
+ Impure = yes,
FirstErrorInfo = mode_error_info(Vars, _, _, _),
ImpureError = mode_error_conj(
[delayed_goal(Vars, FirstErrorInfo, Goal0)],
@@ -1793,7 +1851,7 @@
Context, ModeContext),
!:ImpurityErrors = [ImpureErrorInfo | !.ImpurityErrors]
;
- true
+ Impure = no
)
;
Errors = [],
@@ -1804,11 +1862,13 @@
% and then continue scheduling the rest of the goal.
delay_info__wakeup_goals(WokenGoals, DelayInfo1, DelayInfo),
list__append(WokenGoals, Goals0, Goals1),
- ( WokenGoals = [] ->
- true
- ; WokenGoals = [_] ->
+ (
+ WokenGoals = []
+ ;
+ WokenGoals = [_],
mode_checkpoint(wakeup, "goal", !ModeInfo, !IO)
;
+ WokenGoals = [_, _ | _],
mode_checkpoint(wakeup, "goals", !ModeInfo, !IO)
),
mode_info_set_delay_info(DelayInfo, !ModeInfo),
@@ -1824,14 +1884,21 @@
modecheck_conj_list_2(Goals1, Goals2, !ImpurityErrors,
!ModeInfo, !IO)
),
-
- ( Errors = [] ->
- % we successfully scheduled this goal, so insert
- % it in the list of successfully scheduled goals
- Goals = ScheduledSolverGoals ++ [Goal | Goals2]
- ;
- % we delayed this goal -- it will be stored in the delay_info
+ (
+ Errors = [_ | _],
+ % We delayed this goal -- it will be stored in the delay_info.
Goals = ScheduledSolverGoals ++ Goals2
+ ;
+ Errors = [],
+ % We successfully scheduled this goal, so insert it
+ % in the list of successfully scheduled goals.
+ % We flatten out conjunctions if we can. They can arise
+ % when Goal0 was a scope(from_ground_term, _) goal.
+ ( Goal = conj(SubGoals) - _ ->
+ Goals = ScheduledSolverGoals ++ SubGoals ++ Goals2
+ ;
+ Goals = ScheduledSolverGoals ++ [Goal | Goals2]
+ )
).
% We may still have some unscheduled goals. This may be because some
@@ -1853,16 +1920,13 @@
%
modecheck_conj_list_3(DelayedGoals0, DelayedGoals1, Goals0,
!ImpurityErrors, !ModeInfo, !IO),
-
% Try to handle any unscheduled goals by inserting solver
% initialisation calls, aiming for *any* workable schedule.
%
modecheck_conj_list_4(DelayedGoals1, DelayedGoals, Goals1,
!ImpurityErrors, !ModeInfo, !IO),
-
Goals = Goals0 ++ Goals1.
-
% We may still have some unscheduled goals. This may be because some
% initialisation calls are needed to turn some solver type vars
% from inst free to inst any. This pass attempts to identify a
@@ -2107,7 +2171,7 @@
candidate_init_vars_3(ModeInfo, Goal0, !NonFree, !CandidateVars) :-
% An existentially quantified goal.
%
- Goal0 = some(_, _, Goal) - _GoalInfo,
+ Goal0 = scope(_, Goal) - _GoalInfo,
candidate_init_vars_3(ModeInfo, Goal, !NonFree, !CandidateVars).
candidate_init_vars_3(ModeInfo, Goal, !NonFree, !CandidateVars) :-
@@ -2301,7 +2365,6 @@
!:ImpurityErrors = [ImpurityError | !.ImpurityErrors]
).
-
:- pred filter_headvar_unification_goals(list(prog_var)::in,
list(delayed_goal)::in, list(delayed_goal)::out,
list(delayed_goal)::out) is det.
@@ -2311,7 +2374,6 @@
list__filter(is_headvar_unification_goal(HeadVars), DelayedGoals,
HeadVarUnificationGoals, NonHeadVarUnificationGoals).
-
:- pred is_headvar_unification_goal(list(prog_var)::in, delayed_goal::in)
is semidet.
@@ -2340,7 +2402,6 @@
get_all_waiting_vars_2([delayed_goal(Vars1, _, _) | Rest], Vars0, Vars) :-
set__union(Vars0, Vars1, Vars2),
get_all_waiting_vars_2(Rest, Vars2, Vars).
-
:- pred redelay_goals(list(delayed_goal)::in, delay_info::in, delay_info::out)
is det.
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.98
diff -u -r1.98 module_qual.m
--- compiler/module_qual.m 20 Mar 2005 02:24:35 -0000 1.98
+++ compiler/module_qual.m 20 Mar 2005 02:26:35 -0000
@@ -475,6 +475,10 @@
process_assert(G, Symbols, Success).
process_assert(all_state_vars(_, G) - _, Symbols, Success) :-
process_assert(G, Symbols, Success).
+process_assert(promise_purity(_P, G) - _, Symbols, Success) :-
+ process_assert(G, Symbols, Success).
+process_assert(promise_equivalent_solution(_V, G) - _, Symbols, Success) :-
+ process_assert(G, Symbols, Success).
process_assert(implies(GA, GB) - _, Symbols, Success) :-
process_assert(GA, SymbolsA, SuccessA),
process_assert(GB, SymbolsB, SuccessB),
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.451
diff -u -r1.451 options.m
--- compiler/options.m 7 Mar 2005 05:00:26 -0000 1.451
+++ compiler/options.m 16 Mar 2005 14:05:28 -0000
@@ -110,6 +110,8 @@
; statistics
; debug_types
; debug_modes
+ ; debug_modes_statistics
+ ; debug_modes_minimal
; debug_modes_verbose
; debug_modes_pred_id
; debug_det
@@ -793,6 +795,8 @@
statistics - bool(no),
debug_types - bool(no),
debug_modes - bool(no),
+ debug_modes_statistics - bool(no),
+ debug_modes_minimal - bool(no),
debug_modes_verbose - bool(no),
debug_modes_pred_id - int(-1),
debug_det - bool(no),
@@ -1442,6 +1446,8 @@
long_option("statistics", statistics).
long_option("debug-types", debug_types).
long_option("debug-modes", debug_modes).
+long_option("debug-modes-statistics", debug_modes_statistics).
+long_option("debug-modes-minimal", debug_modes_minimal).
long_option("debug-modes-verbose", debug_modes_verbose).
long_option("debug-modes-pred-id", debug_modes_pred_id).
long_option("debug-determinism", debug_det).
@@ -2717,6 +2723,10 @@
"\tOutput detailed debugging traces of the type checking.",
"-N, --debug-modes",
"\tOutput debugging traces of the mode checking.",
+ "--debug-modes-statistics",
+ "\tOutput statistics after each step of mode checking.",
+ "--debug-modes-minimal",
+ "\tOutput only minimal debugging traces of the mode checking.",
"--debug-modes-verbose",
"\tOutput detailed debugging traces of the mode checking.",
"--debug-modes-pred-id <n>",
Index: compiler/passes_aux.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/passes_aux.m,v
retrieving revision 1.66
diff -u -r1.66 passes_aux.m
--- compiler/passes_aux.m 21 Jan 2005 06:20:44 -0000 1.66
+++ compiler/passes_aux.m 24 Feb 2005 10:38:17 -0000
@@ -243,46 +243,40 @@
:- import_module int, string, map, require, varset.
-process_all_nonimported_procs(Task, ModuleInfo0, ModuleInfo) -->
- { True = (pred(_PredInfo::in) is semidet :- true) },
- process_matching_nonimported_procs(Task, True,
- ModuleInfo0, ModuleInfo).
+process_all_nonimported_procs(Task, !ModuleInfo, !IO) :-
+ True = (pred(_PredInfo::in) is semidet :- true),
+ process_matching_nonimported_procs(Task, True, !ModuleInfo, !IO).
-process_all_nonimported_nonaditi_procs(Task, ModuleInfo0, ModuleInfo) -->
- { NotAditi = (pred(PredInfo::in) is semidet :-
+process_all_nonimported_nonaditi_procs(Task, !ModuleInfo, !IO) :-
+ NotAditi = (pred(PredInfo::in) is semidet :-
\+ hlds_pred__pred_info_is_aditi_relation(PredInfo)
- ) },
- process_matching_nonimported_procs(Task, NotAditi,
- ModuleInfo0, ModuleInfo).
-
-process_all_nonimported_nonaditi_procs(Task0, Task,
- ModuleInfo0, ModuleInfo) -->
- { NotAditi = (pred(PredInfo::in) is semidet :-
+ ),
+ process_matching_nonimported_procs(Task, NotAditi, !ModuleInfo, !IO).
+
+process_all_nonimported_nonaditi_procs(!Task, !ModuleInfo, !IO) :-
+ NotAditi = (pred(PredInfo::in) is semidet :-
\+ hlds_pred__pred_info_is_aditi_relation(PredInfo)
- ) },
- process_matching_nonimported_procs(Task0, Task, NotAditi,
- ModuleInfo0, ModuleInfo).
-
-process_all_nonimported_procs(Task0, Task, ModuleInfo0, ModuleInfo) -->
- { True = (pred(_PredInfo::in) is semidet :- true) },
- process_matching_nonimported_procs(Task0, Task, True,
- ModuleInfo0, ModuleInfo).
-
-process_matching_nonimported_procs(Task, Filter, ModuleInfo0, ModuleInfo) -->
- { module_info_predids(ModuleInfo0, PredIds) },
- ( { Task = update_pred_error(Pred) } ->
+ ),
+ process_matching_nonimported_procs(!Task, NotAditi, !ModuleInfo, !IO).
+
+process_all_nonimported_procs(!Task, !ModuleInfo, !IO) :-
+ True = (pred(_PredInfo::in) is semidet :- true),
+ process_matching_nonimported_procs(!Task, True, !ModuleInfo, !IO).
+
+process_matching_nonimported_procs(Task, Filter, !ModuleInfo, !IO) :-
+ module_info_predids(!.ModuleInfo, PredIds),
+ ( Task = update_pred_error(Pred) ->
list__foldl2(process_nonimported_pred(Pred, Filter), PredIds,
- ModuleInfo0, ModuleInfo)
+ !ModuleInfo, !IO)
;
process_nonimported_procs_in_preds(PredIds, Task, _, Filter,
- ModuleInfo0, ModuleInfo)
+ !ModuleInfo, !IO)
).
-process_matching_nonimported_procs(Task0, Task, Filter,
- ModuleInfo0, ModuleInfo) -->
- { module_info_predids(ModuleInfo0, PredIds) },
+process_matching_nonimported_procs(Task0, Task, Filter, !ModuleInfo, !IO) :-
+ module_info_predids(!.ModuleInfo, PredIds),
process_nonimported_procs_in_preds(PredIds, Task0, Task, Filter,
- ModuleInfo0, ModuleInfo).
+ !ModuleInfo, !IO).
:- pred process_nonimported_pred(pred_error_task::in(pred_error_task),
pred(pred_info)::in(pred(in) is semidet), pred_id::in,
@@ -383,33 +377,33 @@
process_nonimported_procs(ProcIds, PredId, !Task, !ModuleInfo, !IO).
-write_pred_progress_message(Message, PredId, ModuleInfo) -->
- globals__io_lookup_bool_option(very_verbose, VeryVerbose),
- ( { VeryVerbose = yes } ->
- io__write_string(Message),
- hlds_out__write_pred_id(ModuleInfo, PredId),
- io__write_string("\n")
+write_pred_progress_message(Message, PredId, ModuleInfo, !IO) :-
+ globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+ (
+ VeryVerbose = yes,
+ io__write_string(Message, !IO),
+ hlds_out__write_pred_id(ModuleInfo, PredId, !IO),
+ io__write_string("\n", !IO)
;
- []
+ VeryVerbose = no
).
-write_proc_progress_message(Message, PredId, ProcId, ModuleInfo) -->
- globals__io_lookup_bool_option(very_verbose, VeryVerbose),
- ( { VeryVerbose = yes } ->
- io__write_string(Message),
- hlds_out__write_pred_proc_id(ModuleInfo, PredId, ProcId),
- io__write_string("\n")
+write_proc_progress_message(Message, PredId, ProcId, ModuleInfo, !IO) :-
+ globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+ (
+ VeryVerbose = yes,
+ io__write_string(Message, !IO),
+ hlds_out__write_pred_proc_id(ModuleInfo, PredId, ProcId, !IO),
+ io__write_string("\n", !IO)
;
- []
+ VeryVerbose = no
).
:- pred passes_aux__handle_errors(int::in, int::in,
module_info::in, module_info::out, io::di, io::uo) is det.
-passes_aux__handle_errors(WarnCnt, ErrCnt, ModuleInfo1, ModuleInfo8,
- State1, State9) :-
- globals__io_lookup_bool_option(halt_at_warn, HaltAtWarn,
- State1, State2),
+passes_aux__handle_errors(WarnCnt, ErrCnt, !ModuleInfo, !IO) :-
+ globals__io_lookup_bool_option(halt_at_warn, HaltAtWarn, !IO),
(
(
ErrCnt > 0
@@ -418,47 +412,50 @@
HaltAtWarn = yes
)
->
- io__set_exit_status(1, State2, State9),
- module_info_incr_errors(ModuleInfo1, ModuleInfo8)
+ io__set_exit_status(1, !IO),
+ module_info_incr_errors(!ModuleInfo)
;
- ModuleInfo8 = ModuleInfo1,
- State9 = State2
+ true
).
-maybe_set_exit_status(yes) --> [].
-maybe_set_exit_status(no) --> io__set_exit_status(1).
+maybe_set_exit_status(yes, !IO).
+maybe_set_exit_status(no, !IO) :- io__set_exit_status(1, !IO).
-invoke_shell_command(ErrorStream, Verbosity, Command0, Succeeded) -->
- invoke_shell_command(ErrorStream, Verbosity, Command0, no, Succeeded).
+invoke_shell_command(ErrorStream, Verbosity, Command0, Succeeded, !IO) :-
+ invoke_shell_command(ErrorStream, Verbosity, Command0, no, Succeeded,
+ !IO).
invoke_shell_command(ErrorStream, Verbosity, Command0,
- ProcessOutput, Succeeded) -->
- { make_command_string(Command0, forward, Command) },
+ ProcessOutput, Succeeded, !IO) :-
+ make_command_string(Command0, forward, Command),
invoke_system_command(ErrorStream, Verbosity, Command,
- ProcessOutput, Succeeded).
+ ProcessOutput, Succeeded, !IO).
-invoke_system_command(ErrorStream, Verbosity, Command, Succeeded) -->
- invoke_system_command(ErrorStream, Verbosity, Command, no, Succeeded).
+invoke_system_command(ErrorStream, Verbosity, Command, Succeeded, !IO) :-
+ invoke_system_command(ErrorStream, Verbosity, Command, no, Succeeded,
+ !IO).
invoke_system_command(ErrorStream, Verbosity, Command,
- MaybeProcessOutput, Succeeded) -->
+ MaybeProcessOutput, Succeeded, !IO) :-
% This predicate shouldn't alter the exit status of mercury_compile.
- io__get_exit_status(OldStatus),
- globals__io_lookup_bool_option(verbose, Verbose),
+ io__get_exit_status(OldStatus, !IO),
+ globals__io_lookup_bool_option(verbose, Verbose, !IO),
(
- { Verbosity = verbose },
- { PrintCommand = Verbose }
+ Verbosity = verbose,
+ PrintCommand = Verbose
;
- { Verbosity = verbose_commands },
- globals__io_lookup_bool_option(verbose_commands, PrintCommand)
+ Verbosity = verbose_commands,
+ globals__io_lookup_bool_option(verbose_commands, PrintCommand,
+ !IO)
),
- ( { PrintCommand = yes } ->
- io__write_string("% Invoking system command `"),
- io__write_string(Command),
- io__write_string("'...\n"),
- io__flush_output
+ (
+ PrintCommand = yes,
+ io__write_string("% Invoking system command `", !IO),
+ io__write_string(Command, !IO),
+ io__write_string("'...\n", !IO),
+ io__flush_output(!IO)
;
- []
+ PrintCommand = no
),
%
@@ -467,108 +464,110 @@
% the output from the command would go to the current C output
% and error streams.
%
- io__make_temp(TmpFile),
- { use_dotnet ->
+ io__make_temp(TmpFile, !IO),
+ ( use_dotnet ->
% XXX can't use Bourne shell syntax to redirect on .NET
% XXX the output will go to the wrong place!
CommandRedirected = Command
;
CommandRedirected =
string__append_list([Command, " > ", TmpFile, " 2>&1"])
- },
- io__call_system_return_signal(CommandRedirected, Result),
+ ),
+ io__call_system_return_signal(CommandRedirected, Result, !IO),
(
- { Result = ok(exited(Status)) },
- maybe_write_string(PrintCommand, "% done.\n"),
- ( { Status = 0 } ->
- { CommandSucceeded = yes }
+ Result = ok(exited(Status)),
+ maybe_write_string(PrintCommand, "% done.\n", !IO),
+ ( Status = 0 ->
+ CommandSucceeded = yes
;
% The command should have produced output
% describing the error.
- { CommandSucceeded = no }
+ CommandSucceeded = no
)
;
- { Result = ok(signalled(Signal)) },
+ Result = ok(signalled(Signal)),
% Make sure the current process gets the signal. Some
% systems (e.g. Linux) ignore SIGINT during a call to
% system().
- raise_signal(Signal),
+ raise_signal(Signal, !IO),
report_error(ErrorStream, "system command received signal "
- ++ int_to_string(Signal) ++ "."),
- { CommandSucceeded = no }
+ ++ int_to_string(Signal) ++ ".", !IO),
+ CommandSucceeded = no
;
- { Result = error(Error) },
- report_error(ErrorStream, io__error_message(Error)),
- { CommandSucceeded = no }
+ Result = error(Error),
+ report_error(ErrorStream, io__error_message(Error), !IO),
+ CommandSucceeded = no
),
(
- { MaybeProcessOutput = yes(ProcessOutput) },
- io__make_temp(ProcessedTmpFile),
+ MaybeProcessOutput = yes(ProcessOutput),
+ io__make_temp(ProcessedTmpFile, !IO),
io__call_system_return_signal(
string__append_list([ProcessOutput, " < ",
TmpFile, " > ", ProcessedTmpFile, " 2>&1"]),
- ProcessOutputResult),
- io__remove_file(TmpFile, _),
+ ProcessOutputResult, !IO),
+ io__remove_file(TmpFile, _, !IO),
(
- { ProcessOutputResult =
- ok(exited(ProcessOutputStatus)) },
- maybe_write_string(PrintCommand, "% done.\n"),
- ( { ProcessOutputStatus = 0 } ->
- { ProcessOutputSucceeded = yes }
+ ProcessOutputResult =
+ ok(exited(ProcessOutputStatus)),
+ maybe_write_string(PrintCommand, "% done.\n", !IO),
+ ( ProcessOutputStatus = 0 ->
+ ProcessOutputSucceeded = yes
;
% The command should have produced output
% describing the error.
- { ProcessOutputSucceeded = no }
+ ProcessOutputSucceeded = no
)
;
- { ProcessOutputResult =
- ok(signalled(ProcessOutputSignal)) },
+ ProcessOutputResult =
+ ok(signalled(ProcessOutputSignal)),
% Make sure the current process gets the signal. Some
% systems (e.g. Linux) ignore SIGINT during a call to
% system().
- raise_signal(ProcessOutputSignal),
+ raise_signal(ProcessOutputSignal, !IO),
report_error(ErrorStream,
"system command received signal "
- ++ int_to_string(ProcessOutputSignal) ++ "."),
- { ProcessOutputSucceeded = no }
+ ++ int_to_string(ProcessOutputSignal) ++ ".",
+ !IO),
+ ProcessOutputSucceeded = no
;
- { ProcessOutputResult = error(ProcessOutputError) },
+ ProcessOutputResult = error(ProcessOutputError),
report_error(ErrorStream,
- io__error_message(ProcessOutputError)),
- { ProcessOutputSucceeded = no }
+ io__error_message(ProcessOutputError), !IO),
+ ProcessOutputSucceeded = no
)
;
- { MaybeProcessOutput = no },
- { ProcessOutputSucceeded = yes },
- { ProcessedTmpFile = TmpFile }
+ MaybeProcessOutput = no,
+ ProcessOutputSucceeded = yes,
+ ProcessedTmpFile = TmpFile
),
- { Succeeded = CommandSucceeded `and` ProcessOutputSucceeded },
+ Succeeded = CommandSucceeded `and` ProcessOutputSucceeded,
%
% Write the output to the error stream.
%
- io__open_input(ProcessedTmpFile, TmpFileRes),
+ io__open_input(ProcessedTmpFile, TmpFileRes, !IO),
(
- { TmpFileRes = ok(TmpFileStream) },
+ TmpFileRes = ok(TmpFileStream),
io__input_stream_foldl_io(TmpFileStream,
- io__write_char(ErrorStream), Res),
+ io__write_char(ErrorStream), Res, !IO),
(
- { Res = ok }
+ Res = ok
;
- { Res = error(TmpFileReadError) },
+ Res = error(TmpFileReadError),
report_error(ErrorStream,
"error reading command output: "
- ++ io__error_message(TmpFileReadError))
+ ++ io__error_message(TmpFileReadError),
+ !IO)
),
- io__close_input(TmpFileStream)
+ io__close_input(TmpFileStream, !IO)
;
- { TmpFileRes = error(TmpFileError) },
+ TmpFileRes = error(TmpFileError),
report_error(ErrorStream, "error opening command output: "
- ++ io__error_message(TmpFileError))
+ ++ io__error_message(TmpFileError), !IO)
),
- io__remove_file(ProcessedTmpFile, _),
- io__set_exit_status(OldStatus).
+ io__remove_file(ProcessedTmpFile, _, !IO),
+ io__set_exit_status(OldStatus, !IO).
make_command_string(String0, QuoteType, String) :-
( use_win32 ->
@@ -627,58 +626,59 @@
:- pred report_sizes(module_info::in, io::di, io::uo) is det.
-report_sizes(ModuleInfo) -->
- { module_info_preds(ModuleInfo, Preds) },
- tree_stats("Pred table", Preds),
- { module_info_types(ModuleInfo, Types) },
- tree_stats("Type table", Types),
- { module_info_ctors(ModuleInfo, Ctors) },
- tree_stats("Constructor table", Ctors).
+report_sizes(ModuleInfo, !IO) :-
+ module_info_preds(ModuleInfo, Preds),
+ tree_stats("Pred table", Preds, !IO),
+ module_info_types(ModuleInfo, Types),
+ tree_stats("Type table", Types, !IO),
+ module_info_ctors(ModuleInfo, Ctors),
+ tree_stats("Constructor table", Ctors, !IO).
:- pred tree_stats(string::in, map(_K, _V)::in, io::di, io::uo) is det.
-tree_stats(Description, Tree) -->
- { map__count(Tree, Count) },
- io__write_string(Description),
- io__write_string(": count = "),
- io__write_int(Count),
- io__write_string("\n").
+tree_stats(Description, Tree, !IO) :-
+ map__count(Tree, Count),
+ io__write_string(Description, !IO),
+ io__write_string(": count = ", !IO),
+ io__write_int(Count, !IO),
+ io__write_string("\n", !IO).
%-----------------------------------------------------------------------------%
-report_pred_proc_id(ModuleInfo, PredId, ProcId, MaybeContext, Context) -->
- { module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
- PredInfo, ProcInfo) },
- { PredName = pred_info_name(PredInfo) },
- { Arity = pred_info_orig_arity(PredInfo) },
- { PredOrFunc = pred_info_is_pred_or_func(PredInfo) },
- { proc_info_context(ProcInfo, Context) },
- { proc_info_argmodes(ProcInfo, ArgModes0) },
+report_pred_proc_id(ModuleInfo, PredId, ProcId, MaybeContext, Context, !IO) :-
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
+ PredInfo, ProcInfo),
+ PredName = pred_info_name(PredInfo),
+ Arity = pred_info_orig_arity(PredInfo),
+ PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ proc_info_context(ProcInfo, Context),
+ proc_info_argmodes(ProcInfo, ArgModes0),
% We need to strip off the extra type_info arguments inserted at the
% front by polymorphism.m - we only want the last `PredArity' of them.
%
- { list__length(ArgModes0, NumArgModes) },
- { NumToDrop = NumArgModes - Arity },
- ( { list__drop(NumToDrop, ArgModes0, ArgModes1) } ->
- { ArgModes = ArgModes1 }
+ list__length(ArgModes0, NumArgModes),
+ NumToDrop = NumArgModes - Arity,
+ ( list__drop(NumToDrop, ArgModes0, ArgModes1) ->
+ ArgModes = ArgModes1
;
- { error("report_pred_proc_id: list__drop failed") }
+ error("report_pred_proc_id: list__drop failed")
),
(
- { MaybeContext = yes(OutContext) }
+ MaybeContext = yes(OutContext)
;
- { MaybeContext = no },
- { OutContext = Context }
+ MaybeContext = no,
+ OutContext = Context
),
- prog_out__write_context(OutContext),
- io__write_string("In `"),
- report_pred_name_mode(PredOrFunc, PredName, ArgModes),
- io__write_string("':\n").
+ prog_out__write_context(OutContext, !IO),
+ io__write_string("In `", !IO),
+ report_pred_name_mode(PredOrFunc, PredName, ArgModes, !IO),
+ io__write_string("':\n", !IO).
report_pred_name_mode(predicate, PredName, ArgModes, !IO) :-
io__write_string(PredName, !IO),
- ( ArgModes \= [] ->
+ (
+ ArgModes = [_ | _],
varset__init(InstVarSet), % XXX inst var names
io__write_string("(", !IO),
strip_builtin_qualifiers_from_mode_list(ArgModes,
@@ -686,7 +686,7 @@
mercury_output_mode_list(StrippedArgModes, InstVarSet, !IO),
io__write_string(")", !IO)
;
- true
+ ArgModes = []
).
report_pred_name_mode(function, FuncName, ArgModes, !IO) :-
@@ -694,44 +694,47 @@
strip_builtin_qualifiers_from_mode_list(ArgModes, StrippedArgModes),
pred_args_to_func_args(StrippedArgModes, FuncArgModes, FuncRetMode),
io__write_string(FuncName, !IO),
- ( FuncArgModes \= [] ->
+ (
+ FuncArgModes = [_ | _],
io__write_string("(", !IO),
mercury_output_mode_list(FuncArgModes, InstVarSet, !IO),
io__write_string(")", !IO)
;
- true
+ FuncArgModes = []
),
io__write_string(" = ", !IO),
mercury_output_mode(FuncRetMode, InstVarSet, !IO).
%-----------------------------------------------------------------------------%
-output_to_file(FileName, Action) -->
- { NewAction = (pred(0::out, di, uo) is det --> Action ) },
- output_to_file(FileName, NewAction, _Result).
-
-output_to_file(FileName, Action, Result) -->
- globals__io_lookup_bool_option(verbose, Verbose),
- globals__io_lookup_bool_option(statistics, Stats),
- maybe_write_string(Verbose, "% Writing to file `"),
- maybe_write_string(Verbose, FileName),
- maybe_write_string(Verbose, "'...\n"),
- maybe_flush_output(Verbose),
- io__open_output(FileName, Res),
- ( { Res = ok(FileStream) } ->
- io__set_output_stream(FileStream, OutputStream),
- Action(ActionResult),
- io__set_output_stream(OutputStream, _),
- io__close_output(FileStream),
- maybe_write_string(Verbose, "% done.\n"),
- maybe_report_stats(Stats),
- { Result = yes(ActionResult) }
- ;
- maybe_write_string(Verbose, "\n"),
- { string__append_list(["can't open file `",
- FileName, "' for output."], ErrorMessage) },
- report_error(ErrorMessage),
- { Result = no }
+output_to_file(FileName, Action, !IO) :-
+ NewAction = (pred(0::out, di, uo) is det --> Action),
+ output_to_file(FileName, NewAction, _Result, !IO).
+
+output_to_file(FileName, Action, Result, !IO) :-
+ globals__io_lookup_bool_option(verbose, Verbose, !IO),
+ globals__io_lookup_bool_option(statistics, Stats, !IO),
+ maybe_write_string(Verbose, "% Writing to file `", !IO),
+ maybe_write_string(Verbose, FileName, !IO),
+ maybe_write_string(Verbose, "'...\n", !IO),
+ maybe_flush_output(Verbose, !IO),
+ io__open_output(FileName, Res, !IO),
+ (
+ Res = ok(FileStream),
+ io__set_output_stream(FileStream, OutputStream, !IO),
+ Action(ActionResult, !IO),
+ io__set_output_stream(OutputStream, _, !IO),
+ io__close_output(FileStream, !IO),
+ maybe_write_string(Verbose, "% done.\n", !IO),
+ maybe_report_stats(Stats, !IO),
+ Result = yes(ActionResult)
+ ;
+ Res = error(_),
+ maybe_write_string(Verbose, "\n", !IO),
+ string__append_list(["can't open file `",
+ FileName, "' for output."], ErrorMessage),
+ report_error(ErrorMessage, !IO),
+ Result = no
).
%-----------------------------------------------------------------------------%
Index: compiler/pd_cost.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pd_cost.m,v
retrieving revision 1.21
diff -u -r1.21 pd_cost.m
--- compiler/pd_cost.m 2 Sep 2004 23:49:32 -0000 1.21
+++ compiler/pd_cost.m 15 Feb 2005 15:15:15 -0000
@@ -80,7 +80,7 @@
pd_cost__goal(not(Goal) - _, Cost) :-
pd_cost__goal(Goal, Cost).
-pd_cost__goal(some(_, _, Goal) - _, Cost) :-
+pd_cost__goal(scope(_, Goal) - _, Cost) :-
pd_cost__goal(Goal, Cost).
pd_cost__goal(generic_call(_, Args, _, _) - _, Cost) :-
Index: compiler/pd_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pd_util.m,v
retrieving revision 1.33
diff -u -r1.33 pd_util.m
--- compiler/pd_util.m 2 Sep 2004 23:49:33 -0000 1.33
+++ compiler/pd_util.m 15 Feb 2005 15:15:29 -0000
@@ -1095,8 +1095,8 @@
OldGoal = not(OldSubGoal) - _,
NewGoal = not(NewSubGoal) - _
;
- OldGoal = some(_, _, OldSubGoal) - _,
- NewGoal = some(_, _, NewSubGoal) - _
+ OldGoal = scope(_, OldSubGoal) - _,
+ NewGoal = scope(_, NewSubGoal) - _
)
->
goal_to_conj_list(OldSubGoal, OldSubGoalList),
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.260
diff -u -r1.260 polymorphism.m
--- compiler/polymorphism.m 1 Feb 2005 07:11:36 -0000 1.260
+++ compiler/polymorphism.m 15 Feb 2005 14:35:17 -0000
@@ -1065,9 +1065,9 @@
polymorphism__process_case_list(Cases0, Cases, !Info),
Goal = switch(Var, CanFail, Cases) - GoalInfo.
polymorphism__process_goal_expr(GoalExpr, GoalInfo, Goal, !Info) :-
- GoalExpr = some(Vars, CanRemove, SubGoal0),
+ GoalExpr = scope(Reason, SubGoal0),
polymorphism__process_goal(SubGoal0, SubGoal, !Info),
- Goal = some(Vars, CanRemove, SubGoal) - GoalInfo.
+ Goal = scope(Reason, SubGoal) - GoalInfo.
polymorphism__process_goal_expr(GoalExpr, GoalInfo, Goal, !Info) :-
GoalExpr = if_then_else(Vars, Cond0, Then0, Else0),
polymorphism__process_goal(Cond0, Cond, !Info),
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.69
diff -u -r1.69 post_typecheck.m
--- compiler/post_typecheck.m 21 Jan 2005 06:20:45 -0000 1.69
+++ compiler/post_typecheck.m 15 Feb 2005 17:22:27 -0000
@@ -1457,9 +1457,11 @@
% If the cons_id is existentially quantified, add a `new' prefix
% so that polymorphism.m adds the appropriate type_infos.
- ( ExistQVars = [] ->
+ (
+ ExistQVars = [],
ConsId = ConsId0
;
+ ExistQVars = [_ | _],
( ConsId0 = cons(ConsName0, ConsArity) ->
remove_new_prefix(ConsName, ConsName0),
ConsId = cons(ConsName, ConsArity)
@@ -1478,7 +1480,7 @@
% Make mode analysis treat the translated access function
% as an atomic goal.
- Goal = some([], can_remove, Conj).
+ Goal = scope(barrier(removable), Conj).
:- pred get_cons_id_arg_types_adding_existq_tvars(module_info::in, cons_id::in,
(type)::in, list(type)::out, list(tvar)::out,
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.120
diff -u -r1.120 prog_data.m
--- compiler/prog_data.m 10 Mar 2005 02:35:59 -0000 1.120
+++ compiler/prog_data.m 16 Mar 2005 06:00:07 -0000
@@ -1061,6 +1061,10 @@
% state variables extracted from
% some/2 and all/2 quantifiers.
+ % other scopes
+ ; promise_purity(purity, goal)
+ ; promise_equivalent_solution(prog_vars, goal)
+
% implications
; implies(goal, goal) % A => B
; equivalent(goal, goal) % A <=> B
Index: compiler/prog_io_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_goal.m,v
retrieving revision 1.30
diff -u -r1.30 prog_io_goal.m
--- compiler/prog_io_goal.m 19 Jan 2005 03:10:52 -0000 1.30
+++ compiler/prog_io_goal.m 16 Mar 2005 12:06:25 -0000
@@ -235,7 +235,6 @@
list__map(term__coerce_var, Vars0, Vars),
parse_goal(A0, A @ (GoalExprA - ContextA), !V),
-
(
Vars = [], StateVars = [],
GoalExpr = GoalExprA
@@ -249,6 +248,24 @@
Vars = [_|_], StateVars = [_|_],
GoalExpr = some(Vars, some_state_vars(StateVars, A) - ContextA)
).
+
+parse_goal_2("promise_equivalent_solution", [OVars, A0], GoalExpr, !V):-
+ parse_goal(A0, A, !V),
+ parse_vars(OVars, Vars0),
+ list__map(term__coerce_var, Vars0, Vars),
+ GoalExpr = promise_equivalent_solution(Vars, A).
+
+parse_goal_2("promise_pure", [A0], GoalExpr, !V):-
+ parse_goal(A0, A, !V),
+ GoalExpr = promise_purity(pure, A).
+
+parse_goal_2("promise_semipure", [A0], GoalExpr, !V):-
+ parse_goal(A0, A, !V),
+ GoalExpr = promise_purity(semipure, A).
+
+parse_goal_2("promise_impure", [A0], GoalExpr, !V):-
+ parse_goal(A0, A, !V),
+ GoalExpr = promise_purity(impure, A).
% The following is a temporary hack to handle `is' in
% the parser - we ought to handle it in the code generation -
Index: compiler/prog_io_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_util.m,v
retrieving revision 1.33
diff -u -r1.33 prog_io_util.m
--- compiler/prog_io_util.m 7 Feb 2005 13:49:32 -0000 1.33
+++ compiler/prog_io_util.m 16 Mar 2005 12:06:25 -0000
@@ -72,6 +72,10 @@
:- pred parse_quantifier_vars(term(T)::in, list(var(T))::out,
list(var(T))::out) is semidet.
+ % Parse a list of quantified variables.
+ %
+:- pred parse_vars(term(T)::in, list(var(T))::out) is semidet.
+
:- pred parse_name_and_arity(module_name::in, term(_T)::in,
sym_name::out, arity::out) is semidet.
@@ -561,16 +565,21 @@
%-----------------------------------------------------------------------------%
parse_quantifier_vars(functor(atom("[]"), [], _), [], []).
-parse_quantifier_vars(functor(atom("[|]"), [H, T], _), SVs, Vs) :-
+parse_quantifier_vars(functor(atom("[|]"), [H, T], _), !:SVs, !:Vs) :-
+ parse_quantifier_vars(T, !:SVs, !:Vs),
(
- H = functor(atom("!"), [variable(SV)], _),
- SVs = [SV | SVs0],
- parse_quantifier_vars(T, SVs0, Vs)
- ;
- H = variable(V),
- Vs = [V | Vs0],
- parse_quantifier_vars(T, SVs, Vs0)
+ H = functor(atom("!"), [variable(SV)], _),
+ !:SVs = [SV | !.SVs]
+ ;
+ H = variable(V),
+ !:Vs = [V | !.Vs]
).
+
+parse_vars(functor(atom("[]"), [], _), []).
+parse_vars(functor(atom("[|]"), [H, T], _), !:Vs) :-
+ parse_vars(T, !:Vs),
+ H = variable(V),
+ !:Vs = [V | !.Vs].
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/prog_rep.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_rep.m,v
retrieving revision 1.31
diff -u -r1.31 prog_rep.m
--- compiler/prog_rep.m 1 Feb 2005 07:11:37 -0000 1.31
+++ compiler/prog_rep.m 16 Mar 2005 11:52:17 -0000
@@ -199,8 +199,7 @@
InstMap0, Info, Rep) :-
prog_rep__represent_cases(Cases, InstMap0, Info, CaseReps),
Rep = switch_rep(CaseReps).
-prog_rep__represent_goal_expr(some(_, _, Goal), GoalInfo, InstMap0, Info, Rep)
- :-
+prog_rep__represent_goal_expr(scope(_, Goal), GoalInfo, InstMap0, Info, Rep) :-
prog_rep__represent_goal(Goal, InstMap0, Info, InnerRep),
Goal = _ - InnerGoalInfo,
goal_info_get_determinism(GoalInfo, OuterDetism),
@@ -210,7 +209,7 @@
;
MaybeCut = cut
),
- Rep = some_rep(InnerRep, MaybeCut).
+ Rep = scope_rep(InnerRep, MaybeCut).
prog_rep__represent_goal_expr(generic_call(GenericCall, Args, _, _),
GoalInfo, InstMap0, Info, Rep) :-
list__map(term__var_to_int, Args, ArgsRep),
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.71
diff -u -r1.71 prog_util.m
--- compiler/prog_util.m 21 Jan 2005 03:27:47 -0000 1.71
+++ compiler/prog_util.m 16 Mar 2005 08:38:55 -0000
@@ -424,6 +424,14 @@
all_state_vars(Vars, Goal)) :-
prog_util__rename_in_vars(OldVar, NewVar, Vars0, Vars),
prog_util__rename_in_goal(OldVar, NewVar, Goal0, Goal).
+prog_util__rename_in_goal_expr(OldVar, NewVar, promise_purity(Purity, Goal0),
+ promise_purity(Purity, Goal)) :-
+ prog_util__rename_in_goal(OldVar, NewVar, Goal0, Goal).
+prog_util__rename_in_goal_expr(OldVar, NewVar,
+ promise_equivalent_solution(Vars0, Goal0),
+ promise_equivalent_solution(Vars, Goal)) :-
+ prog_util__rename_in_vars(OldVar, NewVar, Vars0, Vars),
+ prog_util__rename_in_goal(OldVar, NewVar, Goal0, Goal).
prog_util__rename_in_goal_expr(OldVar, NewVar, implies(GoalA0, GoalB0),
implies(GoalA, GoalB)) :-
prog_util__rename_in_goal(OldVar, NewVar, GoalA0, GoalA),
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.71
diff -u -r1.71 purity.m
--- compiler/purity.m 21 Jan 2005 06:20:45 -0000 1.71
+++ compiler/purity.m 16 Mar 2005 09:57:49 -0000
@@ -27,7 +27,7 @@
%
% We also do elimination of double-negation in this pass.
% It needs to be done somewhere after quantification analysis and
-% before mode analysis, and this is convenient place to do it.
+% before mode analysis, and this is a convenient place to do it.
%
% This pass also converts calls to `private_builtin.unsafe_type_cast'
% into `generic_call(unsafe_cast, ...)' goals.
@@ -205,6 +205,9 @@
check_preds_purity(FoundTypeError, PostTypecheckError, !HLDS, !IO),
maybe_report_stats(Statistics, !IO).
+less_pure(P1, P2) :-
+ \+ ( worst_purity(P1, P2) = P2).
+
% worst_purity/3 could be written more compactly, but this definition
% guarantees us a determinism error if we add to type `purity'. We also
% define less_pure/2 in terms of worst_purity/3 rather than the other way
@@ -220,8 +223,20 @@
worst_purity((impure), (semipure)) = (impure).
worst_purity((impure), (impure)) = (impure).
-less_pure(P1, P2) :-
- \+ ( worst_purity(P1, P2) = P2).
+ % Sort of a "minimum" for impurity. The reason why this is written is
+ % as a switch is the same as for worst_purity.
+ %
+:- func best_purity(purity, purity) = purity.
+
+best_purity(pure, pure) = pure.
+best_purity(pure, (semipure)) = pure.
+best_purity(pure, (impure)) = pure.
+best_purity((semipure), pure) = pure.
+best_purity((semipure), (semipure)) = (semipure).
+best_purity((semipure), (impure)) = (semipure).
+best_purity((impure), pure) = pure.
+best_purity((impure), (semipure)) = (semipure).
+best_purity((impure), (impure)) = (impure).
%-----------------------------------------------------------------------------%
@@ -642,9 +657,28 @@
compute_goal_purity(NotGoal0, NotGoal1, Purity, !Info),
NotGoal1 = NotGoal - _
).
-compute_expr_purity(some(Vars, CanRemove, Goal0), some(Vars, CanRemove, Goal),
+compute_expr_purity(scope(Reason, Goal0), scope(Reason, Goal),
_, Purity, !Info) :-
- compute_goal_purity(Goal0, Goal, Purity, !Info).
+ compute_goal_purity(Goal0, Goal, Purity0, !Info),
+ (
+ Reason = exist_quant(_),
+ Purity = Purity0
+ ;
+ Reason = promise_purity(PromisedPurity),
+ Purity = best_purity(Purity0, PromisedPurity)
+ ;
+ Reason = promise_equivalent_solution(_),
+ Purity = Purity0
+ ;
+ Reason = commit(_),
+ Purity = Purity0
+ ;
+ Reason = barrier(_),
+ Purity = Purity0
+ ;
+ Reason = from_ground_term(_),
+ Purity = Purity0
+ ).
compute_expr_purity(if_then_else(Vars, Cond0, Then0, Else0),
if_then_else(Vars, Cond, Then, Else), _, Purity, !Info) :-
compute_goal_purity(Cond0, Cond, Purity1, !Info),
@@ -1070,7 +1104,8 @@
; aditi_builtin_error(aditi_builtin_error).
:- type post_typecheck_warning
- ---> unnecessary_body_impurity_decl(prog_context, pred_id, purity).
+ ---> unnecessary_body_impurity_decl(prog_context, pred_id, purity)
+ ; redundant_promise_purity(prog_context, purity, purity).
:- pred report_post_typecheck_message(module_info::in,
post_typecheck_message::in, io::di, io::uo) is det.
@@ -1094,18 +1129,19 @@
report_aditi_builtin_error(AditiError, !IO)
).
-report_post_typecheck_message(ModuleInfo, Warning, !IO) :-
- Warning = warning(unnecessary_body_impurity_decl(Context,
- PredId, DeclaredPurity)),
- globals__io_lookup_bool_option(halt_at_warn, HaltAtWarn, !IO),
+report_post_typecheck_message(ModuleInfo, warning(Warning), !IO) :-
+ record_warning(!IO),
(
- HaltAtWarn = yes,
- io__set_exit_status(1, !IO)
- ;
- HaltAtWarn = no
- ),
- warn_unnecessary_body_impurity_decl(ModuleInfo, PredId, Context,
- DeclaredPurity, !IO).
+ Warning = unnecessary_body_impurity_decl(Context,
+ PredId, DeclaredPurity),
+ warn_unnecessary_body_impurity_decl(ModuleInfo, PredId,
+ Context, DeclaredPurity, !IO)
+ ;
+ Warning = redundant_promise_purity(Context, PromisedPurity,
+ InsidePurity),
+ warn_redundant_promise_purity(Context, PromisedPurity,
+ InsidePurity, !IO)
+ ).
:- pred error_missing_body_impurity_decl(module_info::in, pred_id::in,
prog_context::in, io::di, io::uo) is det.
@@ -1157,6 +1193,18 @@
words("is sufficient.")]
),
write_error_pieces(Context, 0, Pieces1 ++ Pieces2, !IO).
+
+:- pred warn_redundant_promise_purity(prog_context::in, purity::in, purity::in,
+ io::di, io::uo) is det.
+
+warn_redundant_promise_purity(Context, PromisedPurity, InsidePurity, !IO) :-
+ purity_name(PromisedPurity, PromisedPurityName),
+ DeclName = "promise_" ++ PromisedPurityName,
+ purity_name(InsidePurity, InsidePurityName),
+ Pieces = [words("Warning: unnecessary"),
+ fixed("`" ++ DeclName ++ "'"), words("goal."), nl,
+ words("The purity inside is"), words(InsidePurityName), nl],
+ write_error_pieces(Context, 0, Pieces, !IO).
:- pred check_closure_purity(hlds_goal_info::in, purity::in, purity::in,
purity_info::in, purity_info::out) is det.
Index: compiler/quantification.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/quantification.m,v
retrieving revision 1.90
diff -u -r1.90 quantification.m
--- compiler/quantification.m 14 Jun 2004 04:16:32 -0000 1.90
+++ compiler/quantification.m 16 Mar 2005 14:08:06 -0000
@@ -118,9 +118,14 @@
:- import_module hlds__goal_util.
:- import_module hlds__instmap.
-:- import_module map, term, varset.
-:- import_module std_util, bool, require.
-:- import_module enum, sparse_bitset.
+:- import_module bool.
+:- import_module enum.
+:- import_module map.
+:- import_module require.
+:- import_module sparse_bitset.
+:- import_module std_util.
+:- import_module term.
+:- import_module varset.
% The `outside vars', `lambda outside vars', and `quant vars'
% fields are inputs; the `nonlocals' field is output; and
@@ -256,8 +261,7 @@
!Info),
(
% If there are any variables that are local to the goal
- % which we have come across before, then we rename them
- % apart.
+ % which we have come across before, then we rename them apart.
quantification__goal_vars_bitset(NonLocalsToRecompute,
Goal0 - GoalInfo0, GoalVars0),
difference(GoalVars0, NonLocalVars, LocalVars),
@@ -292,30 +296,76 @@
% analysis doesn't try to reorder through quantifiers.
% (Actually it would make sense to allow mode analysis
% to do that, but the reference manual says it doesn't,
- % so we don't.) Thus we replace `some(Vars, Goal0)' with
- % an empty quantifier `some([], Goal)'.
+ % so we don't.) Thus we replace `scope(exist_quant(Vars), Goal0)'
+ % with an empty quantifier `scope(exist_quant([]), Goal)'.
implicitly_quantify_goal_2(Expr0, Expr, Context, !Info) :-
- Expr0 = some(Vars0, CanRemove, Goal0),
- Expr = some([], CanRemove, Goal),
+ Expr0 = scope(Reason0, Goal0),
+ (
+ Reason0 = exist_quant(Vars0),
+ Reason1 = exist_quant([])
+ ;
+ Reason0 = promise_purity(_),
+ Reason1 = Reason0,
+ Vars0 = []
+ ;
+ Reason0 = promise_equivalent_solution(_),
+ Reason1 = Reason0,
+ Vars0 = []
+ ;
+ Reason0 = commit(_),
+ Reason1 = Reason0,
+ Vars0 = []
+ ;
+ Reason0 = barrier(_),
+ Reason1 = Reason0,
+ Vars0 = []
+ ;
+ Reason0 = from_ground_term(_),
+ Reason1 = Reason0,
+ Vars0 = []
+ ),
quantification__get_outside(OutsideVars, !Info),
quantification__get_lambda_outside(LambdaOutsideVars, !Info),
quantification__get_quant_vars(QuantVars, !Info),
- % Rename apart all the quantified
- % variables that occur outside this goal.
+ % Rename apart all the quantified variables that
+ % occur outside this goal.
list_to_set(Vars0, QVars),
intersect(OutsideVars, QVars, RenameVars1),
intersect(LambdaOutsideVars, QVars, RenameVars2),
union(RenameVars1, RenameVars2, RenameVars),
( empty(RenameVars) ->
Goal1 = Goal0,
- Vars = Vars0
+ Vars = Vars0,
+ Reason = Reason1
;
quantification__warn_overlapping_scope(RenameVars, Context,
!Info),
quantification__rename_apart(RenameVars, RenameMap,
Goal0, Goal1, !Info),
- goal_util__rename_var_list(Vars0, no, RenameMap, Vars)
+ goal_util__rename_var_list(Vars0, no, RenameMap, Vars),
+ (
+ Reason1 = exist_quant(_),
+ % We have already handled this case.
+ Reason = Reason1
+ ;
+ Reason1 = promise_purity(_),
+ Reason = Reason1
+ ;
+ Reason1 = promise_equivalent_solution(PromiseVars0),
+ goal_util__rename_var_list(PromiseVars0, no, RenameMap,
+ PromiseVars),
+ Reason = promise_equivalent_solution(PromiseVars)
+ ;
+ Reason1 = commit(_),
+ Reason = Reason1
+ ;
+ Reason1 = barrier(_),
+ Reason = Reason1
+ ;
+ Reason1 = from_ground_term(_),
+ Reason = Reason1
+ )
),
quantification__update_seen_vars(QVars, !Info),
insert_list(QuantVars, Vars, QuantVars1),
@@ -324,37 +374,37 @@
quantification__get_nonlocals(NonLocals0, !Info),
delete_list(NonLocals0, Vars, NonLocals),
quantification__set_quant_vars(QuantVars, !Info),
- quantification__set_nonlocals(NonLocals, !Info).
+ quantification__set_nonlocals(NonLocals, !Info),
+ Expr = scope(Reason, Goal).
implicitly_quantify_goal_2(Expr0, Expr, _, !Info) :-
Expr0 = conj(Goals0),
- Expr = conj(Goals),
- implicitly_quantify_conj(Goals0, Goals, !Info).
+ implicitly_quantify_conj(Goals0, Goals, !Info),
+ Expr = conj(Goals).
implicitly_quantify_goal_2(Expr0, Expr, _, !Info) :-
Expr0 = par_conj(Goals0),
- Expr = par_conj(Goals),
- implicitly_quantify_conj(Goals0, Goals, !Info).
+ implicitly_quantify_conj(Goals0, Goals, !Info),
+ Expr = par_conj(Goals).
implicitly_quantify_goal_2(Expr0, Expr, _, !Info) :-
Expr0 = disj(Goals0),
- Expr = disj(Goals),
- implicitly_quantify_disj(Goals0, Goals, !Info).
+ implicitly_quantify_disj(Goals0, Goals, !Info),
+ Expr = disj(Goals).
implicitly_quantify_goal_2(Expr0, Expr, _, !Info) :-
Expr0 = switch(Var, Det, Cases0),
- Expr = switch(Var, Det, Cases),
implicitly_quantify_cases(Cases0, Cases, !Info),
% The switch variable is guaranteed to be non-local to the
% switch, since it has to be bound elsewhere, so we put it
% in the nonlocals here.
quantification__get_nonlocals(NonLocals0, !Info),
insert(NonLocals0, Var, NonLocals),
- quantification__set_nonlocals(NonLocals, !Info).
+ quantification__set_nonlocals(NonLocals, !Info),
+ Expr = switch(Var, Det, Cases).
implicitly_quantify_goal_2(Expr0, Expr, _, !Info) :-
Expr0 = not(Goal0),
- Expr = not(Goal),
% quantified variables cannot be pushed inside a negation,
% so we insert the quantified vars into the outside vars set,
% and initialize the new quantified vars set to be empty
@@ -366,6 +416,7 @@
quantification__set_quant_vars(QuantVars1, !Info),
quantification__set_outside(OutsideVars1, !Info),
implicitly_quantify_goal(Goal0, Goal, !Info),
+ Expr = not(Goal),
quantification__set_outside(OutsideVars, !Info),
quantification__set_quant_vars(QuantVars, !Info).
@@ -376,7 +427,6 @@
% `if_then_else([], ...)'.
implicitly_quantify_goal_2(Expr0, Expr, Context, !Info) :-
Expr0 = if_then_else(Vars0, Cond0, Then0, Else0),
- Expr = if_then_else([], Cond, Then, Else),
quantification__get_quant_vars(QuantVars, !Info),
quantification__get_outside(OutsideVars, !Info),
quantification__get_lambda_outside(LambdaOutsideVars, !Info),
@@ -421,6 +471,8 @@
quantification__set_outside(OutsideVars, !Info),
quantification__set_quant_vars(QuantVars, !Info),
implicitly_quantify_goal(Else0, Else, !Info),
+ Expr = if_then_else([], Cond, Then, Else),
+
quantification__get_nonlocals(NonLocalsElse, !Info),
union(NonLocalsCond, NonLocalsThen, NonLocalsIfThen),
union(NonLocalsIfThen, NonLocalsElse, NonLocalsIfThenElse),
@@ -441,7 +493,6 @@
implicitly_quantify_goal_2(Expr0, Expr, Context, !Info) :-
Expr0 = unify(Var, UnifyRHS0, Mode, Unification0, UnifyContext),
- Expr = unify(Var, UnifyRHS, Mode, Unification, UnifyContext),
quantification__get_outside(OutsideVars, !Info),
quantification__get_lambda_outside(LambdaOutsideVars, !Info),
TypeInfoVars = quantification__get_unify_typeinfos(Unification0),
@@ -465,6 +516,7 @@
),
implicitly_quantify_unify_rhs(MaybeSetArgs, Context,
UnifyRHS0, UnifyRHS, Unification0, Unification, !Info),
+ Expr = unify(Var, UnifyRHS, Mode, Unification, UnifyContext),
quantification__get_nonlocals(VarsUnifyRHS, !Info),
insert(VarsUnifyRHS, Var, GoalVars0),
insert_list(GoalVars0, TypeInfoVars, GoalVars1),
@@ -960,14 +1012,28 @@
insert(!.Set, Var, !:Set),
case_list_vars_2(NonLocalsToRecompute, Cases, !Set, !LambdaSet).
-quantification__goal_vars_2(NonLocalsToRecompute, some(Vars, _, Goal),
- Set0, Set, LambdaSet0, LambdaSet) :-
+quantification__goal_vars_2(NonLocalsToRecompute, scope(Reason, Goal),
+ Set0, !:Set, LambdaSet0, !:LambdaSet) :-
quantification__goal_vars(NonLocalsToRecompute,
- Goal, Set1, LambdaSet1),
- delete_list(Set1, Vars, Set2),
- delete_list(LambdaSet1, Vars, LambdaSet2),
- union(Set0, Set2, Set),
- union(LambdaSet0, LambdaSet2, LambdaSet).
+ Goal, !:Set, !:LambdaSet),
+ (
+ Reason = exist_quant(Vars),
+ delete_list(!.Set, Vars, !:Set),
+ delete_list(!.LambdaSet, Vars, !:LambdaSet)
+ ;
+ Reason = promise_purity(_)
+ ;
+ Reason = promise_equivalent_solution(Vars),
+ insert_list(!.Set, Vars, !:Set)
+ ;
+ Reason = commit(_)
+ ;
+ Reason = barrier(_)
+ ;
+ Reason = from_ground_term(_)
+ ),
+ union(Set0, !Set),
+ union(LambdaSet0, !LambdaSet).
quantification__goal_vars_2(NonLocalsToRecompute, not(Goal - _GoalInfo),
!Set, !LambdaSet) :-
Index: compiler/rl_exprn.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rl_exprn.m,v
retrieving revision 1.48
diff -u -r1.48 rl_exprn.m
--- compiler/rl_exprn.m 1 Feb 2005 07:11:37 -0000 1.48
+++ compiler/rl_exprn.m 15 Feb 2005 14:37:03 -0000
@@ -1464,7 +1464,7 @@
{ error("rl_exprn__goal: higher-order and class-method calls not yet implemented") }.
rl_exprn__goal(foreign_proc(_, _, _, _, _, _) - _, _, _) -->
{ error("rl_exprn__goal: foreign_proc not yet implemented") }.
-rl_exprn__goal(some(_, _, Goal) - _, Fail, Code) -->
+rl_exprn__goal(scope(_, Goal) - _, Fail, Code) -->
rl_exprn__goal(Goal, Fail, Code).
rl_exprn__goal(shorthand(_) - _, _, _) -->
% these should have been expanded out by now
Index: compiler/saved_vars.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/saved_vars.m,v
retrieving revision 1.45
diff -u -r1.45 saved_vars.m
--- compiler/saved_vars.m 6 Mar 2005 05:17:30 -0000 1.45
+++ compiler/saved_vars.m 7 Mar 2005 01:26:37 -0000
@@ -125,9 +125,9 @@
saved_vars_in_goal(Else0, Else, !SlotInfo),
Goal = if_then_else(Vars, Cond, Then, Else) - GoalInfo0
;
- GoalExpr0 = some(Var, CanRemove, SubGoal0),
+ GoalExpr0 = scope(Reason, SubGoal0),
saved_vars_in_goal(SubGoal0, SubGoal, !SlotInfo),
- Goal = some(Var, CanRemove, SubGoal) - GoalInfo0
+ Goal = scope(Reason, SubGoal) - GoalInfo0
;
GoalExpr0 = generic_call(_, _, _, _),
Goal = GoalExpr0 - GoalInfo0
@@ -198,7 +198,6 @@
ok_to_duplicate(stack_opt) = no.
ok_to_duplicate(tuple_opt) = no.
ok_to_duplicate(call_table_gen) = no.
-ok_to_duplicate(keep_this_commit) = no.
ok_to_duplicate(preserve_backtrack_into) = no.
ok_to_duplicate(hide_debug_event) = no.
ok_to_duplicate(tailcall) = no.
@@ -240,7 +239,7 @@
(
FirstExpr = conj(_)
;
- FirstExpr = some(_, _, _)
+ FirstExpr = scope(_, _)
;
FirstExpr = not(_)
;
@@ -332,7 +331,7 @@
IsNonLocal, Goals1, !SlotInfo),
Goals = [Goal0|Goals1]
;
- Goal0Expr = some(SomeVars, CanRemove, SomeGoal0),
+ Goal0Expr = scope(Reason, SomeGoal0),
rename_var(Var, NewVar, Subst, !SlotInfo),
goal_util__rename_vars_in_goal(Construct, Subst,
NewConstruct),
@@ -340,8 +339,7 @@
SomeGoal1),
push_into_goal(SomeGoal1, NewConstruct, NewVar,
SomeGoal, !SlotInfo),
- Goal1 = some(SomeVars, CanRemove, SomeGoal)
- - Goal0Info,
+ Goal1 = scope(Reason, SomeGoal) - Goal0Info,
saved_vars_delay_goal(Goals0, Construct, Var,
IsNonLocal, Goals1, !SlotInfo),
Goals = [Goal1 | Goals1]
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.137
diff -u -r1.137 simplify.m
--- compiler/simplify.m 24 Jan 2005 02:32:44 -0000 1.137
+++ compiler/simplify.m 16 Feb 2005 10:11:14 -0000
@@ -452,9 +452,8 @@
% Remove unnecessary explicit quantifications before working
% out whether the goal can cause a stack flush.
%
- ( Goal1 = some(SomeVars, CanRemove, SomeGoal1) - GoalInfo1 ->
- simplify__nested_somes(CanRemove, SomeVars, SomeGoal1,
- GoalInfo1, Goal2)
+ ( Goal1 = scope(Reason, SomeGoal1) - GoalInfo1 ->
+ simplify__nested_scopes(Reason, SomeGoal1, GoalInfo1, Goal2)
;
Goal2 = Goal1
),
@@ -517,7 +516,7 @@
%
% Conjunctions that cannot produce solutions may nevertheless
% contain nondet and multi goals. If this happens, the
- % conjunction is put inside a `some' to appease the code
+ % conjunction is put inside a `scope' to appease the code
% generator.
%
goal_info_get_determinism(GoalInfo0, Detism),
@@ -531,7 +530,7 @@
goal_info_set_determinism(GoalInfo0,
InnerDetism, InnerInfo),
InnerGoal = conj(Goals) - InnerInfo,
- Goal = some([], can_remove, InnerGoal)
+ Goal = scope(commit(dont_force_pruning), InnerGoal)
;
Goal = conj(Goals)
),
@@ -1006,7 +1005,7 @@
IfThenElseCanFail, at_most_many),
goal_info_set_determinism(GoalInfo1,
InnerDetism, InnerInfo),
- Goal = some([], can_remove,
+ Goal = scope(commit(dont_force_pruning),
IfThenElse - InnerInfo)
;
Goal = IfThenElse
@@ -1059,13 +1058,13 @@
GoalInfo = GoalInfo0
).
-simplify__goal_2(some(Vars1, CanRemove0, Goal1), GoalExpr, SomeInfo, GoalInfo,
+simplify__goal_2(scope(Reason0, Goal1), GoalExpr, SomeInfo, GoalInfo,
!Info) :-
simplify_info_get_common_info(!.Info, Common),
simplify__goal(Goal1, Goal2, !Info),
- simplify__nested_somes(CanRemove0, Vars1, Goal2, SomeInfo, Goal),
+ simplify__nested_scopes(Reason0, Goal2, SomeInfo, Goal),
Goal = GoalExpr - GoalInfo,
- ( Goal = some(_, _, _) - _ ->
+ ( Goal = scope(_, _) - _ ->
% Replacing calls, constructions or deconstructions
% outside a commit with references to variables created
% inside the commit would increase the set of output
@@ -1600,60 +1599,77 @@
%-----------------------------------------------------------------------------%
% replace nested `some's with a single `some',
-:- pred simplify__nested_somes(can_remove::in, list(prog_var)::in,
- hlds_goal::in, hlds_goal_info::in, hlds_goal::out) is det.
+:- pred simplify__nested_scopes(scope_reason::in, hlds_goal::in,
+ hlds_goal_info::in, hlds_goal::out) is det.
-simplify__nested_somes(CanRemove0, Vars1, Goal0, OrigGoalInfo, Goal) :-
- simplify__nested_somes_2(CanRemove0, no, Vars1, Goal0,
- CanRemove, KeepThisCommit, Vars, Goal1),
- Goal1 = GoalExpr1 - GoalInfo1,
+simplify__nested_scopes(Reason0, InnerGoal0, OuterGoalInfo, Goal) :-
+ simplify__nested_scopes_2(Reason0, Reason, InnerGoal0, InnerGoal),
+ InnerGoal = _ - GoalInfo,
(
- goal_info_get_determinism(GoalInfo1, Detism),
- goal_info_get_determinism(OrigGoalInfo, Detism),
- CanRemove = can_remove
+ Reason = exist_quant(_),
+ goal_info_get_determinism(GoalInfo, Detism),
+ goal_info_get_determinism(OuterGoalInfo, Detism)
->
- % If the inner and outer detisms match the `some'
+ % If the inner and outer detisms match the `scope'
% is unnecessary.
- Goal = GoalExpr1 - GoalInfo1
+ Goal = InnerGoal
;
- % The `some' needs to be kept.
- % However, we may still have merged multiple nested somes
- % into a single `some'. This is OK, but we need to be careful
- % to ensure that we don't lose the `keep_this_commit' flag
- % (if any) on the nested somes.
- ( KeepThisCommit = yes ->
- goal_info_add_feature(OrigGoalInfo, keep_this_commit,
- GoalInfo)
- ;
- GoalInfo = OrigGoalInfo
- ),
- Goal = some(Vars, CanRemove, Goal1) - GoalInfo
+ Goal = scope(Reason, InnerGoal) - OuterGoalInfo
).
-:- pred simplify__nested_somes_2(can_remove::in, bool::in, list(prog_var)::in,
- hlds_goal::in, can_remove::out, bool::out, list(prog_var)::out,
- hlds_goal::out) is det.
-
-simplify__nested_somes_2(CanRemove0, KeepThisCommit0, Vars0, Goal0,
- CanRemove, KeepThisCommit, Vars, Goal) :-
- ( Goal0 = some(Vars1, CanRemove1, Goal1) - GoalInfo0 ->
- ( goal_info_has_feature(GoalInfo0, keep_this_commit) ->
- KeepThisCommit2 = yes
+:- pred simplify__nested_scopes_2(scope_reason::in, scope_reason::out,
+ hlds_goal::in, hlds_goal::out) is det.
+
+simplify__nested_scopes_2(Reason0, Reason, Goal0, Goal) :-
+ (
+ Goal0 = scope(Reason1, Goal1) - _GoalInfo0,
+ (
+ Reason0 = exist_quant(Vars0),
+ Reason1 = exist_quant(Vars1)
+ ->
+ list__append(Vars0, Vars1, Vars2),
+ Reason2 = exist_quant(Vars2)
;
- KeepThisCommit2 = KeepThisCommit0
- ),
- ( CanRemove1 = cannot_remove ->
- CanRemove2 = cannot_remove
+ Reason0 = from_ground_term(_)
+ ->
+ Reason2 = Reason1
;
- CanRemove2 = CanRemove0
- ),
- list__append(Vars0, Vars1, Vars2),
- simplify__nested_somes_2(CanRemove2, KeepThisCommit2, Vars2,
- Goal1, CanRemove, KeepThisCommit, Vars, Goal)
- ;
- CanRemove = CanRemove0,
- KeepThisCommit = KeepThisCommit0,
- Vars = Vars0,
+ Reason1 = from_ground_term(_)
+ ->
+ Reason2 = Reason0
+ ;
+ Reason0 = barrier(Removable0),
+ Reason1 = barrier(Removable1)
+ ->
+ (
+ Removable0 = removable,
+ Removable1 = removable
+ ->
+ Removable2 = removable
+ ;
+ Removable2 = not_removable
+ ),
+ Reason2 = barrier(Removable2)
+ ;
+ Reason0 = commit(ForcePruning0),
+ Reason1 = commit(ForcePruning1)
+ ->
+ (
+ ForcePruning0 = dont_force_pruning,
+ ForcePruning1 = dont_force_pruning
+ ->
+ ForcePruning2 = dont_force_pruning
+ ;
+ ForcePruning2 = force_pruning
+ ),
+ Reason2 = commit(ForcePruning2)
+ ;
+ fail
+ )
+ ->
+ simplify__nested_scopes_2(Reason2, Reason, Goal1, Goal)
+ ;
+ Reason = Reason0,
Goal = Goal0
).
@@ -1664,7 +1680,7 @@
% need to rerun determinism analysis on the
% procedure. I think this is a similar situation
% to inlining of erroneous goals. The safe thing
- % to do is to wrap a `some' around the inner goal if
+ % to do is to wrap a `scope' around the inner goal if
% the inner and outer determinisms are not the same.
% It probably won't happen that often.
:- pred simplify__maybe_wrap_goal(hlds_goal_info::in, hlds_goal_info::in,
@@ -1680,7 +1696,8 @@
Goal = Goal1,
GoalInfo = InnerGoalInfo
;
- Goal = some([], can_remove, Goal1 - InnerGoalInfo),
+ Goal = scope(commit(dont_force_pruning),
+ Goal1 - InnerGoalInfo),
GoalInfo = OuterGoalInfo,
simplify_info_set_rerun_det(!Info)
).
Index: compiler/size_prof.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/size_prof.m,v
retrieving revision 1.15
diff -u -r1.15 size_prof.m
--- compiler/size_prof.m 15 Feb 2005 05:22:20 -0000 1.15
+++ compiler/size_prof.m 15 Feb 2005 15:15:45 -0000
@@ -456,9 +456,9 @@
!:Info = !.Info ^ known_size_map := KnownSizeMap0,
GoalExpr = not(NegGoal)
;
- GoalExpr0 = some(Vars, CanRemove, SomeGoal0),
+ GoalExpr0 = scope(Reason, SomeGoal0),
process_goal(SomeGoal0, SomeGoal, !Info),
- GoalExpr = some(Vars, CanRemove, SomeGoal)
+ GoalExpr = scope(Reason, SomeGoal)
;
GoalExpr0 = shorthand(_),
error("size_prof__process_goal: shorthand")
Index: compiler/store_alloc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/store_alloc.m,v
retrieving revision 1.88
diff -u -r1.88 store_alloc.m
--- compiler/store_alloc.m 14 Jun 2004 04:16:37 -0000 1.88
+++ compiler/store_alloc.m 15 Feb 2005 16:27:54 -0000
@@ -210,9 +210,8 @@
LastLocns0, LastLocnsElse, ResumeVars0, StoreAllocInfo),
merge_last_locations([LastLocnsThen, LastLocnsElse], LastLocns).
-store_alloc_in_goal_2(some(Vars, CanRemove, Goal0),
- some(Vars, CanRemove, Goal), !Liveness, !LastLocns,
- ResumeVars0, _, StoreAllocInfo) :-
+store_alloc_in_goal_2(scope(Remove, Goal0), scope(Remove, Goal),
+ !Liveness, !LastLocns, ResumeVars0, _, StoreAllocInfo) :-
store_alloc_in_goal(Goal0, Goal, !Liveness, !LastLocns,
ResumeVars0, StoreAllocInfo).
Index: compiler/stratify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stratify.m,v
retrieving revision 1.36
diff -u -r1.36 stratify.m
--- compiler/stratify.m 21 Jan 2005 03:27:49 -0000 1.36
+++ compiler/stratify.m 15 Feb 2005 14:46:01 -0000
@@ -180,7 +180,7 @@
Error, !ModuleInfo, !IO),
first_order_check_goal(Else, EInfo, Negated, WholeScc, ThisPredProcId,
Error, !ModuleInfo, !IO).
-first_order_check_goal(some(_Vars, _, Goal - GoalInfo), _GoalInfo, Negated,
+first_order_check_goal(scope(_, Goal - GoalInfo), _GoalInfo, Negated,
WholeScc, ThisPredProcId, Error, !ModuleInfo, !IO) :-
first_order_check_goal(Goal, GoalInfo, Negated, WholeScc,
ThisPredProcId, Error, !ModuleInfo, !IO).
@@ -326,7 +326,7 @@
HighOrderLoops, Error, !ModuleInfo, !IO),
higher_order_check_goal(Else, EInfo, Negated, WholeScc, ThisPredProcId,
HighOrderLoops, Error, !ModuleInfo, !IO).
-higher_order_check_goal(some(_Vars, _, Goal - GoalInfo), _GoalInfo, Negated,
+higher_order_check_goal(scope(_, Goal - GoalInfo), _GoalInfo, Negated,
WholeScc, ThisPredProcId, HighOrderLoops,
Error, !ModuleInfo, !IO) :-
higher_order_check_goal(Goal, GoalInfo, Negated, WholeScc,
@@ -752,7 +752,7 @@
check_goal1(Cond, !Calls, !HasAT, !CallsHO),
check_goal1(Then, !Calls, !HasAT, !CallsHO),
check_goal1(Else, !Calls, !HasAT, !CallsHO).
-check_goal1(some(_Vars, _, Goal - _GoalInfo), !Calls, !HasAT, !CallsHO) :-
+check_goal1(scope(_, Goal - _GoalInfo), !Calls, !HasAT, !CallsHO) :-
check_goal1(Goal, !Calls, !HasAT, !CallsHO).
check_goal1(not(Goal - _GoalInfo), !Calls, !HasAT, !CallsHO) :-
check_goal1(Goal, !Calls, !HasAT, !CallsHO).
@@ -834,7 +834,7 @@
get_called_procs(Cond, !Calls),
get_called_procs(Then, !Calls),
get_called_procs(Else, !Calls).
-get_called_procs(some(_Vars, _, Goal - _GoalInfo), !Calls) :-
+get_called_procs(scope(_, Goal - _GoalInfo), !Calls) :-
get_called_procs(Goal, !Calls).
get_called_procs(not(Goal - _GoalInfo), !Calls) :-
get_called_procs(Goal, !Calls).
Index: compiler/switch_detection.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_detection.m,v
retrieving revision 1.108
diff -u -r1.108 switch_detection.m
--- compiler/switch_detection.m 15 Feb 2005 00:04:55 -0000 1.108
+++ compiler/switch_detection.m 15 Feb 2005 14:46:49 -0000
@@ -30,13 +30,13 @@
module_info::in, module_info::out) is det.
% find_bind_var(Var, ProcessUnify, Goal0, Goals, Subst0, Subst,
- % Result0, Result, FoundDeconstruct):
- % Used by both switch_detection and cse_detection.
- % Searches through `Goal0' looking for the first deconstruction
- % unification with `Var' or an alias of `Var'.
- % If a deconstruction unification of the variable is found,
- % `ProcessUnify' is called to handle it and searching is stopped.
- % If not, `Result' is set to `Result0'.
+ % !Result, FoundDeconstruct):
+ % Used by both switch_detection and cse_detection. Searches through
+ % `Goal0' looking for the first deconstruction unification with `Var'
+ % or an alias of `Var'. If a deconstruction unification of the
+ % variable is found, `ProcessUnify' is called to handle it and
+ % searching is stopped. If not, `Result' is set to `Result0'.
+ %
:- pred find_bind_var(prog_var::in,
process_unify(Result, Info)::in(process_unify),
hlds_goal::in, hlds_goal::out, Result::in, Result::out,
@@ -88,11 +88,12 @@
detect_switches_in_pred(PredId, PredInfo0, !ModuleInfo, !IO) :-
ProcIds = pred_info_non_imported_procids(PredInfo0),
- ( ProcIds \= [] ->
+ (
+ ProcIds = [_ | _],
write_pred_progress_message("% Detecting switches in ", PredId,
!.ModuleInfo, !IO)
;
- true
+ ProcIds = []
),
detect_switches_in_procs(ProcIds, PredId, !ModuleInfo).
@@ -144,11 +145,11 @@
:- pred detect_switches_in_goal_1(module_info::in, vartypes::in,
instmap::in, instmap::out, hlds_goal::in, hlds_goal::out) is det.
-detect_switches_in_goal_1(ModuleInfo, VarTypes, InstMap0, InstMap,
+detect_switches_in_goal_1(ModuleInfo, VarTypes, !InstMap,
Goal0 - GoalInfo, Goal - GoalInfo) :-
- detect_switches_in_goal_2(ModuleInfo, VarTypes, InstMap0, GoalInfo,
+ detect_switches_in_goal_2(ModuleInfo, VarTypes, !.InstMap, GoalInfo,
Goal0, Goal),
- update_instmap(Goal0 - GoalInfo, InstMap0, InstMap).
+ update_instmap(Goal0 - GoalInfo, !InstMap).
% Here we process each of the different sorts of goals.
@@ -157,9 +158,11 @@
detect_switches_in_goal_2(ModuleInfo, VarTypes, InstMap0, GoalInfo,
disj(Goals0), Goal) :-
- ( Goals0 = [] ->
+ (
+ Goals0 = [],
Goal = disj([])
;
+ Goals0 = [_ | _],
goal_info_get_nonlocals(GoalInfo, NonLocals),
set__to_sorted_list(NonLocals, NonLocalsList),
detect_switches_in_disj(NonLocalsList, Goals0, GoalInfo,
@@ -189,7 +192,7 @@
detect_switches_in_goal(ModuleInfo, VarTypes, InstMap0, Else0, Else).
detect_switches_in_goal_2(ModuleInfo, VarTypes, InstMap0, _GoalInfo,
- some(Vars, CanRemove, Goal0), some(Vars, CanRemove, Goal)) :-
+ scope(Reason, Goal0), scope(Reason, Goal)) :-
detect_switches_in_goal(ModuleInfo, VarTypes, InstMap0, Goal0, Goal).
detect_switches_in_goal_2(_, _, _, _, Goal @ generic_call(_, _, _, _), Goal).
@@ -270,8 +273,7 @@
->
( CasesList = [_, _ | _] ->
cases_to_switch(CasesList, Var, VarTypes,
- GoalInfo, InstMap, ModuleInfo,
- Goal)
+ GoalInfo, InstMap, ModuleInfo, Goal)
;
detect_sub_switches_in_disj(ModuleInfo,
VarTypes, InstMap, Goals0, Goals),
@@ -446,7 +448,7 @@
find_bind_var(Var, ProcessUnify, !Goal, !Result, !Info, FoundDeconstruct) :-
map__init(Subst),
- find_bind_var(Var, ProcessUnify, !Goal, Subst, _, !Result, !Info,
+ find_bind_var_2(Var, ProcessUnify, !Goal, Subst, _, !Result, !Info,
DeconstructSearch),
(
DeconstructSearch = before_deconstruct,
@@ -464,59 +466,58 @@
; found_deconstruct
; given_up_search.
-:- pred find_bind_var(prog_var::in,
+:- pred find_bind_var_2(prog_var::in,
process_unify(Result, Info)::in(process_unify),
hlds_goal::in, hlds_goal::out,
prog_substitution::in, prog_substitution::out, Result::in, Result::out,
Info::in, Info::out, deconstruct_search::out) is det.
-find_bind_var(Var, ProcessUnify, Goal0 - GoalInfo, Goal,
- Subst0, Subst, Result0, Result, Info0, Info,
- FoundDeconstruct) :-
- ( Goal0 = some(Vars, CanRemove, SubGoal0) ->
- find_bind_var(Var, ProcessUnify, SubGoal0, SubGoal,
- Subst0, Subst, Result0, Result,
- Info0, Info, FoundDeconstruct),
- Goal = some(Vars, CanRemove, SubGoal) - GoalInfo
+find_bind_var_2(Var, ProcessUnify, Goal0 - GoalInfo, Goal, !Subst, !Result,
+ !Info, FoundDeconstruct) :-
+ ( Goal0 = scope(Reason, SubGoal0) ->
+ find_bind_var_2(Var, ProcessUnify, SubGoal0, SubGoal, !Subst,
+ !Result, !Info, FoundDeconstruct),
+ Goal = scope(Reason, SubGoal) - GoalInfo
; Goal0 = conj(SubGoals0) ->
- conj_find_bind_var(Var, ProcessUnify, SubGoals0, SubGoals,
- Subst0, Subst, Result0, Result,
- Info0, Info, FoundDeconstruct),
- Goal = conj(SubGoals) - GoalInfo
- ; Goal0 = unify(A, B, _, UnifyInfo0, _) ->
+ (
+ SubGoals0 = [],
+ Goal = Goal0 - GoalInfo,
+ FoundDeconstruct = before_deconstruct
+ ;
+ SubGoals0 = [_ | _],
+ conj_find_bind_var(Var, ProcessUnify,
+ SubGoals0, SubGoals, !Subst, !Result, !Info,
+ FoundDeconstruct),
+ Goal = conj(SubGoals) - GoalInfo
+ )
+ ; Goal0 = unify(LHS, RHS, _, UnifyInfo0, _) ->
(
% check whether the unification is a deconstruction
% unification on Var or a variable aliased to Var
UnifyInfo0 = deconstruct(UnifyVar, _, _, _, _, _),
term__apply_rec_substitution(term__variable(Var),
- Subst0, term__variable(Var1)),
+ !.Subst, term__variable(Var1)),
term__apply_rec_substitution(term__variable(UnifyVar),
- Subst0, term__variable(UnifyVar1)),
+ !.Subst, term__variable(UnifyVar1)),
Var1 = UnifyVar1
->
call(ProcessUnify, Var, Goal0 - GoalInfo, Goals,
- Result0, Result, Info0, Info),
+ !Result, !Info),
conj_list_to_goal(Goals, GoalInfo, Goal),
- FoundDeconstruct = found_deconstruct,
- Subst = Subst0
+ FoundDeconstruct = found_deconstruct
;
Goal = Goal0 - GoalInfo,
FoundDeconstruct = before_deconstruct,
% otherwise abstractly interpret the unification
- Result = Result0,
- Info = Info0,
- ( interpret_unify(A, B, Subst0, Subst1) ->
- Subst = Subst1
+ ( interpret_unify(LHS, RHS, !.Subst, NewSubst) ->
+ !:Subst = NewSubst
;
% the unification must fail - just ignore it
- Subst = Subst0
+ true
)
)
;
Goal = Goal0 - GoalInfo,
- Subst = Subst0,
- Result = Result0,
- Info = Info0,
( goal_info_has_feature(GoalInfo, from_head) ->
FoundDeconstruct = before_deconstruct
;
@@ -534,7 +535,7 @@
before_deconstruct).
conj_find_bind_var(Var, ProcessUnify, [Goal0 | Goals0], [Goal | Goals],
!Subst, !Result, !Info, FoundDeconstruct) :-
- find_bind_var(Var, ProcessUnify, Goal0, Goal, !Subst,
+ find_bind_var_2(Var, ProcessUnify, Goal0, Goal, !Subst,
!Result, !Info, FoundDeconstruct1),
( FoundDeconstruct1 = before_deconstruct ->
conj_find_bind_var(Var, ProcessUnify, Goals0, Goals,
Index: compiler/term_pass1.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_pass1.m,v
retrieving revision 1.18
diff -u -r1.18 term_pass1.m
--- compiler/term_pass1.m 14 Jun 2004 04:16:39 -0000 1.18
+++ compiler/term_pass1.m 15 Feb 2005 15:15:53 -0000
@@ -342,7 +342,7 @@
!Errors).
check_goal_expr_non_term_calls(Module, PPId, VarTypes, not(Goal), _, !Errors) :-
check_goal_non_term_calls(Module, PPId, VarTypes, Goal, !Errors).
-check_goal_expr_non_term_calls(Module, PPId, VarTypes, some(_, _, Goal), _,
+check_goal_expr_non_term_calls(Module, PPId, VarTypes, scope(_, Goal), _,
!Errors) :-
check_goal_non_term_calls(Module, PPId, VarTypes, Goal, !Errors).
check_goal_expr_non_term_calls(Module, PPId, VarTypes,
Index: compiler/term_traversal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_traversal.m,v
retrieving revision 1.32
diff -u -r1.32 term_traversal.m
--- compiler/term_traversal.m 21 Jan 2005 03:27:49 -0000 1.32
+++ compiler/term_traversal.m 15 Feb 2005 15:15:59 -0000
@@ -188,7 +188,7 @@
% but it shouldn't hurt either.
traverse_goal(Goal, Params, !Info).
-traverse_goal_2(some(_Vars, _, Goal), _GoalInfo, Params, !Info) :-
+traverse_goal_2(scope(_, Goal), _GoalInfo, Params, !Info) :-
traverse_goal(Goal, Params, !Info).
traverse_goal_2(if_then_else(_, Cond, Then, Else), _, Params, !Info) :-
Index: compiler/tupling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/tupling.m,v
retrieving revision 1.3
diff -u -r1.3 tupling.m
--- compiler/tupling.m 21 Mar 2005 02:41:03 -0000 1.3
+++ compiler/tupling.m 21 Mar 2005 02:47:33 -0000
@@ -1087,7 +1087,7 @@
"count_load_stores_in_goal: complicated_unify")
).
-count_load_stores_in_goal(some(_Vars, _CanRemove, Goal) - _GoalInfo, CountInfo,
+count_load_stores_in_goal(scope(_Reason, Goal) - _GoalInfo, CountInfo,
!CountState) :-
count_load_stores_in_goal(Goal, CountInfo, !CountState).
@@ -1731,8 +1731,8 @@
!VarSet, !VarTypes, TransformMap) :-
fix_calls_in_goal(Goal0, Goal, !VarSet, !VarTypes, TransformMap).
-fix_calls_in_goal(some(Vars, CanRemove, Goal0) - GoalInfo,
- some(Vars, CanRemove, Goal) - GoalInfo,
+fix_calls_in_goal(scope(Reason, Goal0) - GoalInfo,
+ scope(Reason, Goal) - GoalInfo,
!VarSet, !VarTypes, TransformMap) :-
fix_calls_in_goal(Goal0, Goal, !VarSet, !VarTypes, TransformMap).
@@ -1986,10 +1986,10 @@
goal_path_step_to_mdbcomp_goal_path_step(
neg, mdbcomp.program_representation.neg).
goal_path_step_to_mdbcomp_goal_path_step(
- exist(cut), mdbcomp.program_representation.exist(
+ scope(cut), mdbcomp.program_representation.scope(
mdbcomp.program_representation.cut)).
goal_path_step_to_mdbcomp_goal_path_step(
- exist(no_cut), mdbcomp.program_representation.exist(
+ scope(no_cut), mdbcomp.program_representation.scope(
mdbcomp.program_representation.no_cut)).
goal_path_step_to_mdbcomp_goal_path_step(
first, mdbcomp.program_representation.first).
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.365
diff -u -r1.365 typecheck.m
--- compiler/typecheck.m 16 Mar 2005 00:37:54 -0000 1.365
+++ compiler/typecheck.m 17 Mar 2005 01:33:20 -0000
@@ -355,14 +355,13 @@
globals__lookup_bool_option(Globals, allow_stubs, yes),
\+ check_marker(Markers0, class_method)
->
+ globals__lookup_bool_option(Globals, warn_stubs, WarnStubs),
(
- globals__lookup_bool_option(Globals,
- warn_stubs, yes)
- ->
+ WarnStubs = yes,
report_no_clauses("Warning", PredId,
!.PredInfo, !.ModuleInfo, !IO)
;
- true
+ WarnStubs = no
),
PredPieces = describe_one_pred_name(!.ModuleInfo,
should_module_qualify, PredId),
@@ -958,19 +957,24 @@
%
list__foldl2(find_headvar_names_in_clause(VarSet0, HeadVars0),
Clauses0, map__init, HeadVarNames, yes, _),
- VarSet = map__foldl(
- (func(HeadVar, MaybeHeadVarName, VarSet1) =
- ( MaybeHeadVarName = yes(HeadVarName) ->
- varset__name_var(VarSet1, HeadVar,
- HeadVarName)
- ;
- VarSet1
- )
- ), HeadVarNames, VarSet0),
+ map__foldl(maybe_update_headvar_name, HeadVarNames,
+ VarSet0, VarSet),
clauses_info_set_varset(VarSet, ClausesInfo0, ClausesInfo),
pred_info_set_clauses_info(ClausesInfo, !PredInfo)
).
+:- pred maybe_update_headvar_name(prog_var::in, maybe(string)::in,
+ prog_varset::in, prog_varset::out) is det.
+
+maybe_update_headvar_name(HeadVar, MaybeHeadVarName, VarSet0, VarSet) :-
+ (
+ MaybeHeadVarName = yes(HeadVarName),
+ varset__name_var(VarSet0, HeadVar, HeadVarName, VarSet)
+ ;
+ MaybeHeadVarName = no,
+ VarSet = VarSet0
+ ).
+
:- pred improve_single_clause_headvars(list(hlds_goal)::in, list(prog_var)::in,
list(prog_var)::in, prog_varset::in, prog_varset::out,
map(prog_var, prog_var)::in, map(prog_var, prog_var)::out,
@@ -1066,9 +1070,11 @@
ClauseHeadVarMap = list__foldl(
find_headvar_names_in_goal(VarSet, HeadVars),
Conj, map__init),
- ( IsFirstClause = yes ->
+ (
+ IsFirstClause = yes,
HeadVarMap = ClauseHeadVarMap
;
+ IsFirstClause = no,
% Check that the variables in this clause match
% the names in previous clauses.
HeadVarMap1 = map__foldl(
@@ -1227,7 +1233,6 @@
error("internal error in typechecker: no type-assignment")
;
TypeAssignSet = [_SingleTypeAssign]
-
;
TypeAssignSet = [TypeAssign1, TypeAssign2 | _],
%
@@ -1335,10 +1340,25 @@
checkpoint("not", !Info, !IO),
typecheck_goal(SubGoal0, SubGoal, !Info, !IO).
-typecheck_goal_2(some(Vars, B, SubGoal0), some(Vars,B, SubGoal), !Info, !IO) :-
- checkpoint("some", !Info, !IO),
+typecheck_goal_2(scope(Reason, SubGoal0), scope(Reason, SubGoal), !Info,
+ !IO) :-
+ checkpoint("scope", !Info, !IO),
typecheck_goal(SubGoal0, SubGoal, !Info, !IO),
- ensure_vars_have_a_type(Vars, !Info, !IO).
+ (
+ Reason = exist_quant(Vars),
+ ensure_vars_have_a_type(Vars, !Info, !IO)
+ ;
+ Reason = promise_purity(_)
+ ;
+ Reason = promise_equivalent_solution(Vars),
+ ensure_vars_have_a_type(Vars, !Info, !IO)
+ ;
+ Reason = commit(_)
+ ;
+ Reason = barrier(_)
+ ;
+ Reason = from_ground_term(_)
+ ).
typecheck_goal_2(call(_, B, Args, D, E, Name),
call(PredId, B, Args, D, E, Name), !Info, !IO) :-
@@ -1607,6 +1627,10 @@
%-----------------------------------------------------------------------------%
+:- pred assign(T::in, T::out) is det.
+
+assign(X, X).
+
:- pred typecheck_call_pred(simple_call_id::in, list(prog_var)::in,
pred_id::out, typecheck_info::in, typecheck_info::out,
io::di, io::uo) is det.
@@ -2064,7 +2088,8 @@
arg_type_assign_var_has_type(TypeAssign0, ArgTypes0, Var, ClassContext,
!ArgTypeAssignSet) :-
type_assign_get_var_types(TypeAssign0, VarTypes0),
- ( ArgTypes0 = [Type | ArgTypes] ->
+ (
+ ArgTypes0 = [Type | ArgTypes],
( map__search(VarTypes0, Var, VarType) ->
(
type_assign_unify_type(TypeAssign0, VarType,
@@ -2087,6 +2112,7 @@
!.ArgTypeAssignSet]
)
;
+ ArgTypes0 = [],
error("arg_type_assign_var_has_type")
).
@@ -2307,10 +2333,11 @@
typecheck_info_get_module_info(!.Info, ModuleInfo),
module_info_globals(ModuleInfo, Globals),
globals__lookup_bool_option(Globals, debug_types, DoCheckPoint),
- ( DoCheckPoint = yes ->
+ (
+ DoCheckPoint = yes,
checkpoint_2(Msg, !.Info, !IO)
;
- true
+ DoCheckPoint = no
).
:- pred checkpoint_2(string::in, typecheck_info::in, io::di, io::uo) is det.
@@ -2400,11 +2427,13 @@
list__length(Args, Arity),
typecheck_info_get_ctor_list(!.Info, Functor, Arity,
ConsDefnList, InvalidConsDefnList),
- ( ConsDefnList = [] ->
+ (
+ ConsDefnList = [],
report_error_undef_cons(!.Info, InvalidConsDefnList,
Functor, Arity, !IO),
typecheck_info_set_found_error(yes, !Info)
;
+ ConsDefnList = [_ | _],
%
% produce the ConsTypeAssignSet, which is essentially the
% cross-product of the TypeAssignSet0 and the ConsDefnList
@@ -3184,7 +3213,8 @@
% Pair = Pair0 ^ snd := 2.
%
term__vars(FieldType, TVarsInField),
- ( TVarsInField = [] ->
+ (
+ TVarsInField = [],
TVarSet = TVarSet0,
RetType = FunctorType,
ArgTypes = [FunctorType, FieldType],
@@ -3200,6 +3230,7 @@
ConsTypeInfo = ok(cons_type_info(TVarSet, ExistQVars,
RetType, ArgTypes, ClassConstraints))
;
+ TVarsInField = [_ | _],
%
% XXX This demonstrates a problem - if a
% type variable occurs in the types of multiple
@@ -3303,11 +3334,12 @@
% implement handling of those, they will need to be renamed
% here as well.
%
- ( UnivConstraints0 = [] ->
- true
+ (
+ UnivConstraints0 = []
;
- error(
- "project_rename_flip_class_constraints: universal constraints")
+ UnivConstraints0 = [_ | _],
+ error("project_rename_flip_class_constraints: " ++
+ "universal constraints")
),
%
@@ -3529,22 +3561,23 @@
%-----------------------------------------------------------------------------%
% typecheck_info_get_final_info(Info, OldHeadTypeParams, OldExistQVars,
-% OldExplicitVarTypes, NewTypeVarSet, New* ..., TypeRenaming,
-% ExistTypeRenaming):
-% extracts the final inferred types from Info.
+% OldExplicitVarTypes, NewTypeVarSet, New* ..., TypeRenaming,
+% ExistTypeRenaming):
+%
+% Extracts the final inferred types from Info.
%
-% OldHeadTypeParams should be the type variables from the head of the
-% predicate.
-% OldExistQVars should be the declared existentially quantified
-% type variables (if any).
-% OldExplicitVarTypes is the vartypes map containing the explicit
-% type qualifications.
-% New* is the newly inferred types, in NewTypeVarSet.
-% TypeRenaming is a map to rename things from the old TypeVarSet
-% to the NewTypeVarSet.
-% ExistTypeRenaming is a map (which should be applied *before*
-% applying TypeRenaming) to rename existential type variables
-% in OldExistQVars.
+% OldHeadTypeParams should be the type variables from the head of the
+% predicate.
+% OldExistQVars should be the declared existentially quantified
+% type variables (if any).
+% OldExplicitVarTypes is the vartypes map containing the explicit
+% type qualifications.
+% New* is the newly inferred types, in NewTypeVarSet.
+% TypeRenaming is a map to rename things from the old TypeVarSet
+% to the NewTypeVarSet.
+% ExistTypeRenaming is a map (which should be applied *before*
+% applying TypeRenaming) to rename existential type variables
+% in OldExistQVars.
:- pred typecheck_info_get_final_info(typecheck_info::in, list(tvar)::in,
existq_tvars::in, vartypes::in, tvarset::out, existq_tvars::out,
@@ -3557,7 +3590,8 @@
NewVarTypes, NewTypeConstraints, NewConstraintProofs, TSubst,
ExistTypeRenaming) :-
typecheck_info_get_type_assign_set(Info, TypeAssignSet),
- ( TypeAssignSet = [TypeAssign | _] ->
+ (
+ TypeAssignSet = [TypeAssign | _],
type_assign_get_head_type_params(TypeAssign, HeadTypeParams),
type_assign_get_typevarset(TypeAssign, OldTypeVarSet),
type_assign_get_var_types(TypeAssign, VarTypes0),
@@ -3646,6 +3680,7 @@
NewProofValuesList, NewConstraintProofs)
)
;
+ TypeAssignSet = [],
error("internal error in typecheck_info_get_vartypes")
).
@@ -3820,7 +3855,6 @@
Arity = 0,
builtin_atomic_type(Functor, BuiltInTypeName)
->
- % ZZZ
construct_type(unqualified(BuiltInTypeName) - 0, [], ConsType),
varset__init(ConsTypeVarSet),
ConsInfo = cons_type_info(ConsTypeVarSet, [], ConsType, [],
@@ -3844,7 +3878,6 @@
TupleArgTVars, TupleConsTypeVarSet),
term__var_list_to_term_list(TupleArgTVars, TupleArgTypes),
- % ZZZ
construct_type(unqualified("{}") - TupleArity, TupleArgTypes,
TupleConsType),
@@ -3960,42 +3993,43 @@
%-----------------------------------------------------------------------------%
% perform_context_reduction(OrigTypeAssignSet, Info0, Info)
-% is true iff either
-% Info is the typecheck_info that results from performing
-% context reduction on the type_assigns in Info0,
-% or, if there is no valid context reduction, then
-% Info is Info0 with the type assign set replaced by
-% OrigTypeAssignSet (see below).
+% is true iff either
+% is the typecheck_info that results from performing
+% context reduction on the type_assigns in Info0,
+% or, if there is no valid context reduction, then
+% Info is Info0 with the type assign set replaced by
+% OrigTypeAssignSet (see below).
+%
+% Context reduction is the process of eliminating redundant constraints
+% from the constraints in the type_assign and adding the proof of the
+% constraint's redundancy to the proofs in the same type_assign. There
+% are three ways in which a constraint may be redundant:
%
-% Context reduction is the process of eliminating redundant constraints
-% from the constraints in the type_assign and adding the proof of the
-% constraint's redundancy to the proofs in the same type_assign. There
-% are three ways in which a constraint may be redundant:
-% - if a constraint occurs in the pred/func declaration for this
-% predicate or function, then it is redundant
-% (in this case, the proof is trivial, so there is no need
-% to record it in the proof map)
-% - if a constraint is present in the set of constraints and all
-% of the "superclass" constraints for the constraints are all
-% present, then all the superclass constraints are eliminated
-% - if there is an instance declaration that may be applied, the
-% constraint is replaced by the constraints from that instance
-% declaration
+% - if a constraint occurs in the pred/func declaration for this
+% predicate or function, then it is redundant
+% (in this case, the proof is trivial, so there is no need
+% to record it in the proof map)
+% - if a constraint is present in the set of constraints and all
+% of the "superclass" constraints for the constraints are all
+% present, then all the superclass constraints are eliminated
+% - if there is an instance declaration that may be applied, the
+% constraint is replaced by the constraints from that instance
+% declaration
%
-% In addition, context reduction removes repeated constraints.
+% In addition, context reduction removes repeated constraints.
%
-% If context reduction fails on a type_assign, that type_assign is
-% removed from the type_assign_set. Context reduction fails if there is
-% a constraint where the type of (at least) one of the arguments to
-% the constraint has its top level functor bound, but there is no
-% instance declaration for that type.
+% If context reduction fails on a type_assign, that type_assign is
+% removed from the type_assign_set. Context reduction fails if there is
+% a constraint where the type of (at least) one of the arguments to
+% the constraint has its top level functor bound, but there is no
+% instance declaration for that type.
%
-% If all type_assigns from the typecheck_info are rejected, than an
-% appropriate error message is given, the type_assign_set is
-% restored to the original one given by OrigTypeAssignSet,
-% but without any typeclass constraints.
-% The reason for this is to avoid reporting the same error at
-% subsequent calls to perform_context_reduction.
+% If all type_assigns from the typecheck_info are rejected, than an
+% appropriate error message is given, the type_assign_set is
+% restored to the original one given by OrigTypeAssignSet,
+% but without any typeclass constraints.
+% The reason for this is to avoid reporting the same error at
+% subsequent calls to perform_context_reduction.
:- pred perform_context_reduction(type_assign_set::in,
typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
@@ -4263,8 +4297,8 @@
% constraint fails then that constraint is eliminated because it
% cannot contribute to proving the constraint we are trying to
% prove.
- list__filter_map(subclass_details_to_constraint(TVarSet,
- SuperClassTypes),
+ list__filter_map(
+ subclass_details_to_constraint(TVarSet, SuperClassTypes),
SubClasses, SubClassConstraints),
(
@@ -6221,12 +6255,6 @@
strip_builtin_qualifiers_from_type_list(Types0, Types) :-
list__map(strip_builtin_qualifiers_from_type, Types0, Types).
-
-%-----------------------------------------------------------------------------%
-
-:- pred assign(T::in, T::out) is det.
-
-assign(X, X).
%-----------------------------------------------------------------------------%
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.86
diff -u -r1.86 unique_modes.m
--- compiler/unique_modes.m 1 Feb 2005 07:11:39 -0000 1.86
+++ compiler/unique_modes.m 15 Feb 2005 14:48:58 -0000
@@ -436,8 +436,8 @@
mode_info_set_instmap(InstMap0, !ModeInfo),
mode_checkpoint(exit, "not", !ModeInfo, !IO).
-unique_modes__check_goal_2(some(Vars, CanRemove, SubGoal0), _,
- some(Vars, CanRemove, SubGoal), !ModeInfo, !IO) :-
+unique_modes__check_goal_2(scope(Reason, SubGoal0), _,
+ scope(Reason, SubGoal), !ModeInfo, !IO) :-
mode_checkpoint(enter, "some", !ModeInfo, !IO),
unique_modes__check_goal(SubGoal0, SubGoal, !ModeInfo, !IO),
mode_checkpoint(exit, "some", !ModeInfo, !IO).
Index: compiler/unneeded_code.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unneeded_code.m,v
retrieving revision 1.20
diff -u -r1.20 unneeded_code.m
--- compiler/unneeded_code.m 14 Jun 2004 04:16:43 -0000 1.20
+++ compiler/unneeded_code.m 15 Feb 2005 15:16:28 -0000
@@ -677,11 +677,11 @@
GoalExpr = not(NegGoal),
Goal = GoalExpr - GoalInfo0
;
- GoalExpr0 = some(Vars, CanRemove, SomeGoal0),
+ GoalExpr0 = scope(Reason, SomeGoal0),
process_goal(SomeGoal0, SomeGoal, InitInstMap, FinalInstMap,
VarTypes, ModuleInfo, Options,
!WhereNeededMap, !RefinedGoals, !Changed),
- GoalExpr = some(Vars, CanRemove, SomeGoal),
+ GoalExpr = scope(Reason, SomeGoal),
Goal = GoalExpr - GoalInfo0
;
GoalExpr0 = shorthand(_),
@@ -959,9 +959,9 @@
GoalExpr = not(NegGoal),
Goal = GoalExpr - GoalInfo0
;
- GoalExpr0 = some(Vars, CanFail, SomeGoal0),
+ GoalExpr0 = scope(Reason, SomeGoal0),
refine_goal(SomeGoal0, SomeGoal, !RefinedGoals),
- GoalExpr = some(Vars, CanFail, SomeGoal),
+ GoalExpr = scope(Reason, SomeGoal),
Goal = GoalExpr - GoalInfo0
;
GoalExpr0 = shorthand(_),
Index: compiler/untupling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/untupling.m,v
retrieving revision 1.3
diff -u -r1.3 untupling.m
--- compiler/untupling.m 6 Mar 2005 05:17:30 -0000 1.3
+++ compiler/untupling.m 7 Mar 2005 01:26:40 -0000
@@ -565,8 +565,8 @@
fix_calls_in_goal(Goal0, Goal, !VarSet, !VarTypes, TransformMap,
ModuleInfo).
-fix_calls_in_goal(some(Vars, CanRemove, Goal0) - GoalInfo,
- some(Vars, CanRemove, Goal) - GoalInfo,
+fix_calls_in_goal(scope(Reason, Goal0) - GoalInfo,
+ scope(Reason, Goal) - GoalInfo,
!VarSet, !VarTypes, TransformMap, ModuleInfo) :-
fix_calls_in_goal(Goal0, Goal, !VarSet, !VarTypes, TransformMap,
ModuleInfo).
Index: compiler/unused_args.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.101
diff -u -r1.101 unused_args.m
--- compiler/unused_args.m 1 Feb 2005 07:11:39 -0000 1.101
+++ compiler/unused_args.m 15 Feb 2005 15:17:01 -0000
@@ -538,7 +538,7 @@
traverse_goal(Info, Goal, !VarDep).
% handle quantification
-traverse_goal(Info, some(_, _, Goal - _), !VarDep) :-
+traverse_goal(Info, scope(_, Goal - _), !VarDep) :-
traverse_goal(Info, Goal, !VarDep).
% we assume that higher-order predicate calls use all variables involved
@@ -1309,8 +1309,8 @@
bool__or_list([Changed1, Changed2, Changed3], Changed).
fixup_goal_expr(ModuleInfo, UnusedVars, ProcCallInfo, Changed,
- some(Vars, CanRemove, SubGoal0) - GoalInfo,
- some(Vars, CanRemove, SubGoal) - GoalInfo) :-
+ scope(Reason, SubGoal0) - GoalInfo,
+ scope(Reason, SubGoal) - GoalInfo) :-
fixup_goal(ModuleInfo, UnusedVars, ProcCallInfo, Changed,
SubGoal0, SubGoal).
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.310
diff -u -r1.310 reference_manual.texi
--- doc/reference_manual.texi 15 Mar 2005 03:38:21 -0000 1.310
+++ doc/reference_manual.texi 19 Mar 2005 13:04:09 -0000
@@ -626,6 +626,41 @@
@var{Goal} must be a valid goal.
This is an abbreviation for @samp{not (some @var{Vars} not @var{Goal})}.
+ at item @code{promise_pure @var{Goal}}
+A purity cast.
+ at var{Goal} must be a valid goal.
+This goal promises that @var{Goal} implements a pure interface,
+even though it may include impure and semipure components.
+
+ at item @code{promise_semipure @var{Goal}}
+A purity cast.
+ at var{Goal} must be a valid goal.
+This goal promises that @var{Goal} implements a semipure interface,
+even though it may include impure components.
+
+ at c @item @code{promise_impure @var{Goal}}
+ at c A purity cast.
+ at c @var{Goal} must be a valid goal.
+ at c This goal promises that @var{Goal} implements an impure interface.
+
+ at item @code{promise_equivalent_solution @var{Vars} @var{Goal}}
+A determinism cast.
+ at var{Vars} must be a list of variables.
+ at var{Goal} must be a valid goal.
+This goal promises that @var{Vars} is the set of variables bound by @var{Goal},
+and that while @var{Goal} may have more than one solution,
+all these solutions aree equivalent with respect to the equality theories
+of the variables in @var{Vars}.
+The compiler checks the first part of that promise.
+In terms of determinism analysis,
+ at var{Goal} is in a single solution context.
+If @var{Goal} has determinism @samp{cc_multi},
+then @code{promise_equivalent_solution @var{Goal} @var{Goal}}
+has determinism @samp{det};
+If @var{Goal} has determinism @samp{cc_nondet},
+then @code{promise_equivalent_solution @var{Goal} @var{Goal}}
+has determinism @samp{semidet}.
+
@item @code{@var{Goal1}, @var{Goal2}}
A conjunction.
@var{Goal1} and @var{Goal2} must be valid goals.
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/ops.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/ops.m,v
retrieving revision 1.48
diff -u -r1.48 ops.m
--- library/ops.m 2 Feb 2005 04:28:48 -0000 1.48
+++ library/ops.m 16 Mar 2005 11:39:05 -0000
@@ -330,6 +330,11 @@
ops__op_table("rule", before, fx, 1199). % NU-Prolog extension
ops__op_table("semipure", before, fy, 800). % Mercury extension
ops__op_table("solver", before, fy, 1181). % Mercury extension
+ops__op_table("promise_pure", before, fx, 950). % Mercury extension
+ops__op_table("promise_impure", before, fx, 950). % Mercury extension
+ops__op_table("promise_semipure", before, fx, 950). % Mercury extension
+ops__op_table("promise_equivalent_solution", before, fxy, 950).
+ % Mercury extension
ops__op_table("some", before, fxy, 950). % Mercury/NU-Prolog extension
ops__op_table("then", after, xfx, 1150). % Mercury/NU-Prolog extension
ops__op_table("type", before, fx, 1180). % Mercury extension
cvs diff: Diffing mdbcomp
Index: mdbcomp/program_representation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/program_representation.m,v
retrieving revision 1.2
diff -u -r1.2 program_representation.m
--- mdbcomp/program_representation.m 10 Feb 2005 04:10:30 -0000 1.2
+++ mdbcomp/program_representation.m 16 Mar 2005 11:41:11 -0000
@@ -70,7 +70,7 @@
; negation_rep(
goal_rep % The negated goal.
)
- ; some_rep(
+ ; scope_rep(
goal_rep, % The quantified goal.
maybe_cut
)
@@ -182,12 +182,12 @@
; ite_then
; ite_else
; neg
- ; exist(maybe_cut)
+ ; scope(maybe_cut)
; first
; later.
- % Does `some G' have a different determinism from plain `G'?
-:- type maybe_cut ---> cut ; no_cut.
+ % Does the scope goal have a different determinism inside than outside?
+:- type maybe_cut ---> cut ; no_cut.
:- pred path_from_string_det(string, goal_path).
:- mode path_from_string_det(in, out) is det.
@@ -283,7 +283,7 @@
goal_generates_internal_event(switch_rep(_)) = yes.
goal_generates_internal_event(ite_rep(_, _, _)) = yes.
goal_generates_internal_event(negation_rep(_)) = yes.
-goal_generates_internal_event(some_rep(_, _)) = no.
+goal_generates_internal_event(scope_rep(_, _)) = no.
% Atomic goals may generate interface events, not internal events.
goal_generates_internal_event(atomic_goal_rep(_, _, _, _, _)) = no.
@@ -325,8 +325,8 @@
string__first_char(String, First, Rest),
path_step_from_string_2(First, Rest, Step).
-:- pred path_step_from_string_2(char, string, goal_path_step).
-:- mode path_step_from_string_2(in, in, out) is semidet.
+:- pred path_step_from_string_2(char::in, string::in, goal_path_step::out)
+ is semidet.
path_step_from_string_2('c', NStr, conj(N)) :-
string__to_int(NStr, N).
@@ -338,8 +338,8 @@
path_step_from_string_2('t', "", ite_then).
path_step_from_string_2('e', "", ite_else).
path_step_from_string_2('~', "", neg).
-path_step_from_string_2('q', "!", exist(cut)).
-path_step_from_string_2('q', "", exist(no_cut)).
+path_step_from_string_2('q', "!", scope(cut)).
+path_step_from_string_2('q', "", scope(no_cut)).
path_step_from_string_2('f', "", first).
path_step_from_string_2('l', "", later).
@@ -358,8 +358,8 @@
string_from_path_step(ite_then, "t").
string_from_path_step(ite_else, "e").
string_from_path_step(neg, "~").
-string_from_path_step(exist(cut), "q!").
-string_from_path_step(exist(no_cut), "q").
+string_from_path_step(scope(cut), "q!").
+string_from_path_step(scope(no_cut), "q").
string_from_path_step(first, "f").
string_from_path_step(later, "l").
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.252
diff -u -r1.252 Mmakefile
--- tests/hard_coded/Mmakefile 18 Mar 2005 01:18:16 -0000 1.252
+++ tests/hard_coded/Mmakefile 18 Mar 2005 03:25:27 -0000
@@ -132,6 +132,7 @@
pragma_import \
pragma_inline \
pretty_printing \
+ promise_equivalent_solution_test \
qual_adv_test \
qual_basic_test \
qual_is_test \
Index: tests/hard_coded/promise_equivalent_solution_test.exp
===================================================================
RCS file: tests/hard_coded/promise_equivalent_solution_test.exp
diff -N tests/hard_coded/promise_equivalent_solution_test.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/promise_equivalent_solution_test.exp 16 Mar 2005 12:51:59 -0000
@@ -0,0 +1,3 @@
+[1, 2]
+[33, 44]
+[2, 5]
Index: tests/hard_coded/promise_equivalent_solution_test.m
===================================================================
RCS file: tests/hard_coded/promise_equivalent_solution_test.m
diff -N tests/hard_coded/promise_equivalent_solution_test.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/promise_equivalent_solution_test.m 16 Mar 2005 04:30:51 -0000
@@ -0,0 +1,45 @@
+% Various checks that promise_equivalent_solution goals are treated properly.
+
+:- module promise_equivalent_solution_test.
+
+:- interface.
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+:- import_module int, list, string.
+
+main(!IO) :-
+ % The equality theory with respect to which all solutions of the goal
+ % inside the promise_equivalent_solution are equivalent is the one that
+ % views the lists as unsorted representations of sets, possibly with
+ % duplicates.
+ promise_equivalent_solution [A, B] (
+ ( A = [1, 2]
+ ; A = [2, 1]
+ ),
+ ( B = [44, 33]
+ ; B = [33, 44]
+ )
+ ),
+ list__sort_and_remove_dups(A, ASorted),
+ list__sort_and_remove_dups(B, BSorted),
+ io__write(ASorted, !IO),
+ io__nl(!IO),
+ io__write(BSorted, !IO),
+ io__nl(!IO),
+ (
+ promise_equivalent_solution [C] (
+ ASorted = [_ | ATail],
+ ( C = [5] ++ ATail
+ ; C = ATail ++ [5]
+ )
+ )
+ ->
+ list__sort_and_remove_dups(C, CSorted),
+ io__write(CSorted, !IO),
+ io__nl(!IO)
+ ;
+ io__write("cannot compute CSorted\n", !IO)
+ ).
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
Index: tests/hard_coded/purity/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/purity/Mmakefile,v
retrieving revision 1.5
diff -u -r1.5 Mmakefile
--- tests/hard_coded/purity/Mmakefile 28 Feb 2003 00:21:42 -0000 1.5
+++ tests/hard_coded/purity/Mmakefile 16 Mar 2005 03:45:29 -0000
@@ -9,6 +9,7 @@
impure_func_t5_fixed2 \
impure_func_t6 \
impure_pred_t1_fixed3 \
+ promise_pure_test \
purity \
purity_opt
Index: tests/hard_coded/purity/promise_pure_test.exp
===================================================================
RCS file: tests/hard_coded/purity/promise_pure_test.exp
diff -N tests/hard_coded/purity/promise_pure_test.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/purity/promise_pure_test.exp 16 Mar 2005 03:44:46 -0000
@@ -0,0 +1,2 @@
+[10, 0, 10]
+[63, 65, 75]
Index: tests/hard_coded/purity/promise_pure_test.m
===================================================================
RCS file: tests/hard_coded/purity/promise_pure_test.m
diff -N tests/hard_coded/purity/promise_pure_test.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/purity/promise_pure_test.m 16 Mar 2005 03:44:36 -0000
@@ -0,0 +1,68 @@
+% Various checks that promise_pure goals are treated properly.
+
+:- module promise_pure_test.
+
+:- interface.
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+:- import_module int, list, string.
+
+main(!IO) :-
+ test1(5, List1),
+ io__write(List1, !IO),
+ io__nl(!IO),
+ test2(21, List2),
+ io__write(List2, !IO),
+ io__nl(!IO).
+
+:- impure pred set_x(int::in) is det.
+:- pragma foreign_proc("C", set_x(X::in), [will_not_call_mercury], "x=X;" ).
+:- pragma foreign_proc("C#", set_x(X::in), [will_not_call_mercury], "x=X;" ).
+:- pragma no_inline(set_x/1).
+
+:- semipure pred get_x(int::out) is det.
+:- pragma promise_semipure(get_x/1).
+:- pragma foreign_proc("C", get_x(X::out), [will_not_call_mercury], "X=x;").
+:- pragma foreign_proc("C#", get_x(X::out), [will_not_call_mercury], "X=x;").
+:- pragma no_inline(get_x/1).
+
+:- impure pred incr_x is det.
+:- pragma foreign_proc("C", incr_x, [will_not_call_mercury], "++x;" ).
+:- pragma foreign_proc("C#", incr_x, [will_not_call_mercury], "++x;" ).
+:- pragma no_inline(incr_x/0).
+
+:- pragma foreign_decl("C", "extern int x;").
+:- pragma foreign_code("C", "int x = 0;").
+:- pragma foreign_code("C#", "static int x = 0;").
+
+:- pred test1(int::in, list(int)::out) is det.
+
+% Tempt compiler to optimize away duplicate semipure goals.
+% The promise_pure is actually a lie, since the value of Y depends
+% on the initial value of the global. This is why we call test1 only once.
+
+test1(A, [X, Y, Z]) :-
+ X = A * 2,
+ promise_pure (
+ semipure get_x(Y),
+ impure set_x(X),
+ semipure get_x(Z)
+ ).
+
+:- pred test2(int::in, list(int)::out) is det.
+
+% Tempt compiler to optimize away duplicate impure goals,
+% or to compile away det goals with no outputs.
+
+test2(A, [X, Y, Z]) :-
+ X = A * 3,
+ promise_pure (
+ impure set_x(X),
+ impure incr_x,
+ impure incr_x,
+ semipure get_x(Y)
+ ),
+ Z = Y + 10.
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
Index: tests/warnings/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/Mmakefile,v
retrieving revision 1.36
diff -u -r1.36 Mmakefile
--- tests/warnings/Mmakefile 22 Jan 2005 06:12:56 -0000 1.36
+++ tests/warnings/Mmakefile 16 Mar 2005 12:58:33 -0000
@@ -18,11 +18,12 @@
double_underscore \
duplicate_call \
duplicate_const \
- inf_recursion_lambda \
- infinite_recursion \
inference_test \
+ infinite_recursion \
+ inf_recursion_lambda \
missing_if \
pragma_source_file \
+ promise_equivalent_solution_test \
purity_warnings \
simple_code \
singleton_test \
Index: tests/warnings/promise_equivalent_solution_test.exp
===================================================================
RCS file: tests/warnings/promise_equivalent_solution_test.exp
diff -N tests/warnings/promise_equivalent_solution_test.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/warnings/promise_equivalent_solution_test.exp 16 Mar 2005 12:50:37 -0000
@@ -0,0 +1,7 @@
+promise_equivalent_solution_test.m:018: Error: the promise_equivalent_solution
+promise_equivalent_solution_test.m:018: goal binds a variable that is not
+promise_equivalent_solution_test.m:018: listed: A.
+promise_equivalent_solution_test.m:033: Error: the promise_equivalent_solution
+promise_equivalent_solution_test.m:033: goal lists an extra variable:
+promise_equivalent_solution_test.m:033: ASorted.
+For more information, try recompiling with `-E'.
Index: tests/warnings/promise_equivalent_solution_test.m
===================================================================
RCS file: tests/warnings/promise_equivalent_solution_test.m
diff -N tests/warnings/promise_equivalent_solution_test.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/warnings/promise_equivalent_solution_test.m 16 Mar 2005 12:37:08 -0000
@@ -0,0 +1,45 @@
+% Various checks that promise_equivalent_solution goals are treated properly.
+
+:- module promise_equivalent_solution_test.
+
+:- interface.
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+:- import_module int, list, string.
+
+main(!IO) :-
+ % The equality theory with respect to which all solutions of the goal
+ % inside the promise_equivalent_solution are equivalent is the one that
+ % views the lists as unsorted representations of sets, possibly with
+ % duplicates.
+ promise_equivalent_solution [B] (
+ ( A = [1, 2]
+ ; A = [2, 1]
+ ),
+ ( B = [44, 33]
+ ; B = [33, 44]
+ )
+ ),
+ list__sort_and_remove_dups(A, ASorted),
+ list__sort_and_remove_dups(B, BSorted),
+ io__write(ASorted, !IO),
+ io__nl(!IO),
+ io__write(BSorted, !IO),
+ io__nl(!IO),
+ (
+ promise_equivalent_solution [C, ASorted] (
+ ASorted = [_ | ATail],
+ ( C = [5] ++ ATail
+ ; C = ATail ++ [5]
+ )
+ )
+ ->
+ list__sort_and_remove_dups(C, CSorted),
+ io__write(CSorted, !IO),
+ io__nl(!IO)
+ ;
+ io__write("cannot compute CSorted\n", !IO)
+ ).
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
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