[m-rev.] for review: promise scopes (part 2)
Ralph Becket
rafe at cs.mu.OZ.AU
Wed Mar 23 15:21:59 AEDT 2005
Zoltan Somogyi, Monday, 21 March 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
> ===================================================================
> +
> + 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}.
If there is a sensible thing that should happen if Vars is a subset
of the non-locals of Goal, you should document that. [I see from the
test cases below that you consider this an error.]
It seems to me that Vars should list all and only the non-locals in
Goal. In which case it seems listing Vars is just make- work for the
programmer.
I think you should explicitly document the scoped-determinisms when
Goal is multi or nondet.
> 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;").
Just out of curiosity, why is x extern?
Other than that, this half of the diff looks fine.
-- Ralph
--------------------------------------------------------------------------
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