%---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %---------------------------------------------------------------------------% % Copyright (C) 1997-2012,2014 The University of Melbourne. % This file may only be copied under the terms of the GNU General % Public License - see the file COPYING in the Mercury distribution. %---------------------------------------------------------------------------% % % Author: fjh % % This module does most of the final parts of type analysis: % % - it reports errors for any unsatisfied type class constraints; % - it reports an error or a warning for unbound type variables, % binding them to the type `void'; % - it propagates type information into the argument modes of procedures; % - it reports errors for unbound inst variables in mode declarations; % - it reports an error if a predicate or function has two or more % indistinguishable modes. % % These actions cannot be done until after type inference is complete, % so they need to be done in a pass *after* the typecheck pass. % % A few other related actions that have similar constraints on when they % should be done are handled by resolve_unify_functor.m, by check_promise.m, % or by code in purity.m itself. % %---------------------------------------------------------------------------% :- module check_hlds.post_typecheck. :- interface. :- import_module check_hlds.inst_mode_type_prop. :- import_module hlds. :- import_module hlds.hlds_module. :- import_module hlds.hlds_pred. :- import_module parse_tree. :- import_module parse_tree.error_spec. :- import_module list. %---------------------------------------------------------------------------% % post_typecheck_finish_preds(!ModuleInfo, NumErrors, % AlwaysSpecs, NoTypeErrorSpecs): % % Check that the types of variables in predicates contain no unbound type % variables other than those that occur in the types of the predicate's % head variables, and that there are no unsatisfied type class constraints. % Also bind any unbound type variables to the type `void'. % % Return two lists of error messages. AlwaysSpecs will be the messages % we want to print in all cases, and NoTypeErrorSpecs will be the messages % we want to print only if type checking did not find any errors. The % latter will be the kinds of errors that you can get as "avalanche" % messages from type errors. % % Separately, we return NumBadErrors, the number of errors that prevent us % from proceeding further in compilation. We do this separately since some % errors (e.g. bad type for main) do NOT prevent us from going further. % % Note that when checking assertions we take the conservative approach % of warning about unbound type variables. There may be cases for which % this doesn't make sense. % :- pred post_typecheck_finish_preds(module_info::in, module_info::out, int::out, list(error_spec)::out, list(error_spec)::out) is det. % Make sure the vartypes field in the clauses_info is valid for imported % predicates. (Non-imported predicates should already have it set up.) % :- pred setup_var_table_in_clauses_for_imported_pred(module_info::in, pred_info::in, pred_info::out) is det. % Propagate type information into the argument modes of all % the procedures of the given predicate. % % Return a list of the ids of the procedures in which this process failed, % and a list of errors describing situations in which a named inst % was applied to a type whose type constructor is *not* the type % constructor that this inst was declared to be for. % % This predicate is exported for use by add_special_pred.m, which does % most of the task of this module itself, but delegates this one to us. % :- pred propagate_checked_types_into_pred_modes(module_info::in, list(proc_id)::out, list(error_spec)::out, tprop_cache::in, tprop_cache::out, pred_info::in, pred_info::out) is det. %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- implementation. :- import_module check_hlds.inst_match. :- import_module check_hlds.mode_comparison. :- import_module check_hlds.mode_errors. :- import_module check_hlds.type_util. :- import_module hlds.goal_util. :- import_module hlds.hlds_class. :- import_module hlds.hlds_clauses. :- import_module hlds.hlds_error_util. :- import_module hlds.hlds_goal. :- import_module hlds.pred_name. :- import_module hlds.status. :- import_module libs. :- import_module libs.globals. :- import_module libs.op_mode. :- import_module libs.options. :- import_module mdbcomp. :- import_module mdbcomp.prim_data. :- import_module parse_tree.builtin_lib_types. :- import_module parse_tree.parse_tree_out_info. :- import_module parse_tree.parse_tree_out_term. :- import_module parse_tree.parse_tree_out_type. :- import_module parse_tree.prog_data. :- import_module parse_tree.prog_type. :- import_module parse_tree.var_table. :- import_module assoc_list. :- import_module bool. :- import_module int. :- import_module map. :- import_module maybe. :- import_module pair. :- import_module set. :- import_module set_tree234. :- import_module solutions. :- import_module string. :- import_module varset. %---------------------------------------------------------------------------% post_typecheck_finish_preds(!ModuleInfo, NumBadErrors, AlwaysSpecs, NoTypeErrorSpecs) :- module_info_get_valid_pred_ids(!.ModuleInfo, ValidPredIds), ValidPredIdSet = set_tree234.list_to_set(ValidPredIds), module_info_get_pred_id_table(!.ModuleInfo, PredIdTable0), map.map_foldl4(post_typecheck_do_finish_pred(!.ModuleInfo, ValidPredIdSet), PredIdTable0, PredIdTable, map.init, _Cache, 0, NumBadErrors, [], AlwaysSpecs, [], NoTypeErrorSpecs), module_info_set_pred_id_table(PredIdTable, !ModuleInfo). :- pred post_typecheck_do_finish_pred(module_info::in, set_tree234(pred_id)::in, pred_id::in, pred_info::in, pred_info::out, tprop_cache::in, tprop_cache::out, int::in, int::out, list(error_spec)::in, list(error_spec)::out, list(error_spec)::in, list(error_spec)::out) is det. post_typecheck_do_finish_pred(ModuleInfo, ValidPredIdSet, PredId, !PredInfo, !Cache, !NumBadErrors, !AlwaysSpecs, !NoTypeErrorSpecs) :- ( if set_tree234.contains(ValidPredIdSet, PredId) then % Regardless of the path we take when processing a valid predicate, % we need to ensure that we fill in the vte_is_dummy field in all % the entries in the predicate's var_table with valid information, % to replace the placeholder values put there earlier. % % In the then-part of this if-then-else, that is done by % setup_var_table_in_clauses_for_imported_pred. In the else-part, % it is done by find_unresolved_types_fill_in_is_dummy_in_pred. ( if ( pred_info_is_imported(!.PredInfo) ; pred_info_is_pseudo_imported(!.PredInfo) ) then setup_var_table_in_clauses_for_imported_pred(ModuleInfo, !PredInfo) else % Emptying out the varset tells hlds_out_pred.m that the % clauses_info has been through typechecking, and that % the authoritative source for information about variables' names % is now the var_table field, not the varset field. % This is because all the compiler passes after typechecking % that create new variables add them to the var_table field, % not to the varset field. % % setup_var_table_in_clauses_for_imported_pred does the same % in the then branch of this if-then-else. pred_info_get_clauses_info(!.PredInfo, ClausesInfo0), varset.init(EmptyVarSet), clauses_info_set_varset(EmptyVarSet, ClausesInfo0, ClausesInfo), pred_info_set_clauses_info(ClausesInfo, !PredInfo), find_unproven_body_constraints(ModuleInfo, PredId, !.PredInfo, !NumBadErrors, !NoTypeErrorSpecs), find_unresolved_types_fill_in_is_dummy_in_pred(ModuleInfo, PredId, !PredInfo, !NoTypeErrorSpecs), check_type_of_main(!.PredInfo, !AlwaysSpecs) ), propagate_checked_types_into_pred_modes(ModuleInfo, ErrorProcs, InstForTypeSpecs, !Cache, !PredInfo), !:NoTypeErrorSpecs = InstForTypeSpecs ++ !.NoTypeErrorSpecs, report_unbound_inst_vars(ModuleInfo, PredId, ErrorProcs, !PredInfo, !AlwaysSpecs), check_for_indistinguishable_modes(ModuleInfo, PredId, !PredInfo, !AlwaysSpecs) else true ). %---------------------% :- pred report_unbound_inst_vars(module_info::in, pred_id::in, list(proc_id)::in, pred_info::in, pred_info::out, list(error_spec)::in, list(error_spec)::out) is det. report_unbound_inst_vars(ModuleInfo, PredId, ErrorProcIds, !PredInfo, !Specs) :- ( ErrorProcIds = [] ; ErrorProcIds = [_ | _], pred_info_get_proc_table(!.PredInfo, ProcTable0), list.foldl2(report_unbound_inst_var_error(ModuleInfo, PredId), ErrorProcIds, ProcTable0, ProcTable, !Specs), pred_info_set_proc_table(ProcTable, !PredInfo) ). :- pred report_unbound_inst_var_error(module_info::in, pred_id::in, proc_id::in, proc_table::in, proc_table::out, list(error_spec)::in, list(error_spec)::out) is det. report_unbound_inst_var_error(ModuleInfo, PredId, ProcId, Procs0, Procs, !Specs) :- map.lookup(Procs0, ProcId, ProcInfo), proc_info_get_context(ProcInfo, Context), Pieces = [words("In"), decl("mode"), words("declaration for")] ++ describe_one_pred_name(ModuleInfo, should_not_module_qualify, PredId) ++ [suffix(":"), nl, words("error: unbound inst variable(s)."), nl, words("(Sorry, polymorphic modes are not supported.)"), nl], Spec = simplest_spec($pred, severity_error, phase_type_check, Context, Pieces), !:Specs = [Spec | !.Specs], % Delete this mode, to avoid internal errors. map.det_remove(ProcId, _, Procs0, Procs). %---------------------------------------------------------------------------% % Check that the all of the types which have been inferred for the % variables in the predicate do not contain any unbound type variables % other than those that occur in the types of head variables, and that % there are no unsatisfied type class constraints. % :- pred find_unproven_body_constraints(module_info::in, pred_id::in, pred_info::in, int::in, int::out, list(error_spec)::in, list(error_spec)::out) is det. :- pragma inline(pred(find_unproven_body_constraints/7)). find_unproven_body_constraints(ModuleInfo, PredId, PredInfo, !NumBadErrors, !NoTypeErrorSpecs) :- pred_info_get_unproven_body_constraints(PredInfo, UnprovenConstraints0), ( UnprovenConstraints0 = [_ | _], list.sort_and_remove_dups(UnprovenConstraints0, UnprovenConstraints), report_unsatisfied_constraints(ModuleInfo, PredId, PredInfo, UnprovenConstraints, !NoTypeErrorSpecs), list.length(UnprovenConstraints, NumUnprovenConstraints), !:NumBadErrors = !.NumBadErrors + NumUnprovenConstraints ; UnprovenConstraints0 = [] ). %---------------------% % Report unsatisfied typeclass constraints. % :- pred report_unsatisfied_constraints(module_info::in, pred_id::in, pred_info::in, list(prog_constraint)::in, list(error_spec)::in, list(error_spec)::out) is det. report_unsatisfied_constraints(ModuleInfo, PredId, PredInfo, Constraints, !Specs) :- pred_info_get_typevarset(PredInfo, TVarSet), pred_info_get_context(PredInfo, Context), PredIdPieces = describe_one_pred_name(ModuleInfo, should_not_module_qualify, PredId), MainPieces = [words("In")] ++ PredIdPieces ++ [suffix(":"), nl, fixed("type error: unsatisfied typeclass " ++ choose_number(Constraints, "constraint:", "constraints:")), nl_indent_delta(1)] ++ component_list_to_line_pieces( list.map(constraint_to_error_piece(TVarSet), Constraints), [nl_indent_delta(-1)]), MainMsg = simplest_msg(Context, MainPieces), ConstrainedGoals = find_constrained_goals(PredInfo, Constraints), ( % This can happen because the call to find_constraint_goals/2 will not % necessarily return goal_ids for every unproven constraint. See the % comment in that function for details. % XXX If we performed this check after checking for unresolved % polymorphism we could at least report the problem is due to unbound % type variables occurring in Constraints. ConstrainedGoals = [], ContextMsgs = [] ; ConstrainedGoals = [_ | _], DueToPieces = choose_number(Constraints, [words("The constraint is due to:")], [words("The constraints are due to:")]), ContextMsgsPrefix = simplest_msg(Context, DueToPieces), ContextMsgsList = constrained_goals_to_error_msgs(ModuleInfo, ConstrainedGoals), ContextMsgs = [ContextMsgsPrefix | ContextMsgsList] ), Spec = error_spec($pred, severity_error, phase_type_check, [MainMsg | ContextMsgs]), !:Specs = [Spec | !.Specs]. :- func constraint_to_error_piece(tvarset, prog_constraint) = list(format_piece). constraint_to_error_piece(TVarset, Constraint) = [quote(mercury_constraint_to_string(TVarset, print_name_only, Constraint))]. % A prog_constraint cannot contain context information (see the comment on % the type definition). However, a constraint_id happens to contain a % goal_id, so we can look up a constraint_id for a prog_constraint, then % use the goal_id to reach the goal. % :- func find_constrained_goals(pred_info, list(prog_constraint)) = list(hlds_goal). find_constrained_goals(PredInfo, Constraints) = Goals :- pred_info_get_clauses_info(PredInfo, ClausesInfo), clauses_info_get_clauses_rep(ClausesInfo, ClausesRep, _ItemNumbers), get_clause_list_maybe_repeated(ClausesRep, Clauses), pred_info_get_constraint_map(PredInfo, ConstraintMap), ReverseConstraintMap = map.reverse_map(ConstraintMap), list.foldl(gather_constraint_ids(ReverseConstraintMap), Constraints, [], ConstraintIdSets), ConstraintIds = set.union_list(ConstraintIdSets), % This could be more efficient. FindGoals = ( pred(Goal::out) is nondet :- set.member(ConstraintId, ConstraintIds), ConstraintId = constraint_id(_, ConstraintGoalId, _), promise_equivalent_solutions [Goal] ( list.member(Clause, Clauses), goal_contains_goal(Clause ^ clause_body, Goal), Goal = hlds_goal(_, GoalInfo), GoalId = goal_info_get_goal_id(GoalInfo), GoalId = ConstraintGoalId ) ), solutions(FindGoals, Goals). :- pred gather_constraint_ids(map(prog_constraint, set(constraint_id))::in, prog_constraint::in, list(set(constraint_id))::in, list(set(constraint_id))::out) is det. gather_constraint_ids(ReverseConstraintMap, Constraint, !ConstraintIdSets) :- % Note that not all unproven constraints will appear in the reverse % constraint map (it only stores as many as the type checker requires). % We should store context information for unproven constraints separately % so we can report it in error messages. ( if map.search(ReverseConstraintMap, Constraint, ConstraintIdSet) then !:ConstraintIdSets = [ConstraintIdSet | !.ConstraintIdSets] else true ). :- func constrained_goals_to_error_msgs(module_info, list(hlds_goal)) = list(error_msg). constrained_goals_to_error_msgs(_, []) = []. constrained_goals_to_error_msgs(ModuleInfo, [Goal | Goals]) = [Msg | Msgs] :- ( Goals = [_, _ | _], Words = describe_constrained_goal(ModuleInfo, Goal), Suffix = suffix(",") ; Goals = [_], Words = describe_constrained_goal(ModuleInfo, Goal), Suffix = suffix(", and") ; Goals = [], Words = describe_constrained_goal(ModuleInfo, Goal), Suffix = suffix(".") ), Goal = hlds_goal(_, GoalInfo), Context = goal_info_get_context(GoalInfo), Msg = error_msg(yes(Context), treat_based_on_posn, 1, [always(Words ++ [Suffix])]), Msgs = constrained_goals_to_error_msgs(ModuleInfo, Goals). :- func describe_constrained_goal(module_info, hlds_goal) = list(format_piece). describe_constrained_goal(ModuleInfo, Goal) = Pieces :- Goal = hlds_goal(GoalExpr, _), ( ( GoalExpr = plain_call(PredId, _, _, _, _, _), CallPieces = describe_one_pred_name(ModuleInfo, should_module_qualify, PredId) ; GoalExpr = generic_call(GenericCall, _, _, _, _), GenericCall = class_method(_, _, _, PFSymNameArity), CallPieces = [qual_pf_sym_name_pred_form_arity(PFSymNameArity)] ; GoalExpr = call_foreign_proc(_, PredId, _, _, _, _, _), CallPieces = describe_one_pred_name(ModuleInfo, should_module_qualify, PredId) ), Pieces = [words("the call to") | CallPieces] ; GoalExpr = generic_call(higher_order(_, _, _, _), _, _, _, _), Pieces = [words("a higher-order call here")] ; ( GoalExpr = generic_call(event_call(_), _, _, _, _) ; GoalExpr = generic_call(cast(_), _, _, _, _) ; GoalExpr = unify(_, _, _, _, _) ; GoalExpr = conj(_, _) ; GoalExpr = disj(_) ; GoalExpr = switch(_, _, _) ; GoalExpr = negation(_) ; GoalExpr = scope(_, _) ; GoalExpr = if_then_else(_, _, _, _) ; GoalExpr = shorthand(_) ), Pieces = [words("a goal here")] ). %---------------------------------------------------------------------------% % Check that all of the types which have been inferred for the % variables in the predicate are free of unbound type variables % other than those that occur in the types of head variables, and that % there are no unsatisfied type class constraints. % % Also, fill in the vte_is_dummy field in all the entries in predicate's % var_table. We do this by flattening the old var table to VarsEntries0, % filling in those slots in VarsEntries0 to yield RevVarsEntries, and then % constructing the updated var table from RevVarsEntries. % :- pred find_unresolved_types_fill_in_is_dummy_in_pred(module_info::in, pred_id::in, pred_info::in, pred_info::out, list(error_spec)::in, list(error_spec)::out) is det. :- pragma inline(pred(find_unresolved_types_fill_in_is_dummy_in_pred/6)). find_unresolved_types_fill_in_is_dummy_in_pred(ModuleInfo, PredId, !PredInfo, !NoTypeErrorSpecs) :- pred_info_get_clauses_info(!.PredInfo, ClausesInfo0), pred_info_get_external_type_params(!.PredInfo, ExternalTypeParams), clauses_info_get_var_table(ClausesInfo0, VarTable0), var_table_to_sorted_assoc_list(VarTable0, VarsEntries0), set.init(BindToVoidTVars0), find_unresolved_types_fill_in_is_dummy(ModuleInfo, ExternalTypeParams, VarsEntries0, [], RevVarsEntries, [], UnresolvedVarsEntries, BindToVoidTVars0, BindToVoidTVars), var_table_from_rev_sorted_assoc_list(RevVarsEntries, VarTable1), ( UnresolvedVarsEntries = [], VarTable = VarTable1 ; UnresolvedVarsEntries = [_ | _], report_unresolved_type_warning(ModuleInfo, PredId, !.PredInfo, UnresolvedVarsEntries, !NoTypeErrorSpecs), % Bind all the type variables in `BindToVoidTVars' to `void' ... pred_info_get_constraint_proof_map(!.PredInfo, ProofMap0), pred_info_get_constraint_map(!.PredInfo, ConstraintMap0), bind_type_vars_to_void(BindToVoidTVars, VarTable1, VarTable, ProofMap0, ProofMap, ConstraintMap0, ConstraintMap), pred_info_set_constraint_proof_map(ProofMap, !PredInfo), pred_info_set_constraint_map(ConstraintMap, !PredInfo) ), clauses_info_set_var_table(VarTable, ClausesInfo0, ClausesInfo), pred_info_set_clauses_info(ClausesInfo, !PredInfo). % The number of variables can be huge here (hundred of thousands for % Doug Auclair's training_cars program). The code below prevents stack % overflows in grades that do not permit tail recursion. % :- pred find_unresolved_types_fill_in_is_dummy(module_info::in, list(tvar)::in, assoc_list(prog_var, var_table_entry)::in, assoc_list(prog_var, var_table_entry)::in, assoc_list(prog_var, var_table_entry)::out, assoc_list(prog_var, var_table_entry)::in, assoc_list(prog_var, var_table_entry)::out, set(tvar)::in, set(tvar)::out) is det. find_unresolved_types_fill_in_is_dummy(ModuleInfo, ExternalTypeParams, VarsEntries0, !RevVarsEntries, !UnresolvedVarsEntries, !BindToVoidTVars) :- find_unresolved_types_fill_in_is_dummy_inner(ModuleInfo, ExternalTypeParams, 1000, VarsEntries0, LeftOverVarsEntries0, !RevVarsEntries, !UnresolvedVarsEntries, !BindToVoidTVars), ( LeftOverVarsEntries0 = [] ; LeftOverVarsEntries0 = [_ | _], find_unresolved_types_fill_in_is_dummy(ModuleInfo, ExternalTypeParams, LeftOverVarsEntries0, !RevVarsEntries, !UnresolvedVarsEntries, !BindToVoidTVars) ). :- pred find_unresolved_types_fill_in_is_dummy_inner(module_info::in, list(tvar)::in, int::in, assoc_list(prog_var, var_table_entry)::in, assoc_list(prog_var, var_table_entry)::out, assoc_list(prog_var, var_table_entry)::in, assoc_list(prog_var, var_table_entry)::out, assoc_list(prog_var, var_table_entry)::in, assoc_list(prog_var, var_table_entry)::out, set(tvar)::in, set(tvar)::out) is det. find_unresolved_types_fill_in_is_dummy_inner(_, _, _, [], [], !RevVarsEntries, !UnresolvedVarsEntries, !BindToVoidTVars). find_unresolved_types_fill_in_is_dummy_inner(ModuleInfo, ExternalTypeParams, VarsToDo, [Var - Entry0 | VarsEntries0], LeftOverVarsEntries0, !RevVarsEntries, !UnresolvedVarsEntries, !BindToVoidTVars) :- ( if VarsToDo < 0 then LeftOverVarsEntries0 = [Var - Entry0 | VarsEntries0] else fill_in_is_dummy_slot(ModuleInfo, Entry0, Entry), !:RevVarsEntries = [Var - Entry | !.RevVarsEntries], Type = Entry ^ vte_type, type_vars_in_type(Type, TVars), set.list_to_set(TVars, TVarsSet0), set.delete_list(ExternalTypeParams, TVarsSet0, TVarsSet1), ( if set.is_empty(TVarsSet1) then true else !:UnresolvedVarsEntries = [Var - Entry | !.UnresolvedVarsEntries], set.union(TVarsSet1, !BindToVoidTVars) ), find_unresolved_types_fill_in_is_dummy_inner(ModuleInfo, ExternalTypeParams, VarsToDo - 1, VarsEntries0, LeftOverVarsEntries0, !RevVarsEntries, !UnresolvedVarsEntries, !BindToVoidTVars) ). % Bind all the type variables in `UnboundTypeVarsSet' to the type `void'. % :- pred bind_type_vars_to_void(set(tvar)::in, var_table::in, var_table::out, constraint_proof_map::in, constraint_proof_map::out, constraint_map::in, constraint_map::out) is det. bind_type_vars_to_void(UnboundTypeVarsSet, !VarTable, !ProofMap, !ConstraintMap) :- % Create a substitution that maps all of the unbound type variables % to `void'. MapToVoid = ( pred(TVar::in, Subst0::in, Subst::out) is det :- map.det_insert(TVar, void_type, Subst0, Subst) ), set.fold(MapToVoid, UnboundTypeVarsSet, map.init, VoidSubst), % Then apply the substitution we just created to the various maps. IsDummyFunc = (func(_Type) = is_dummy_type), apply_subst_to_var_table(IsDummyFunc, VoidSubst, !VarTable), apply_subst_to_constraint_proof_map(VoidSubst, !ProofMap), apply_subst_to_constraint_map(VoidSubst, !ConstraintMap). %---------------------% :- pred fill_in_is_dummy_slot(module_info::in, var_table_entry::in, var_table_entry::out) is det. :- pragma inline(pred(fill_in_is_dummy_slot/3)). fill_in_is_dummy_slot(ModuleInfo, !Entry) :- !.Entry = vte(Name, Type, _OldIsDummy), IsDummy = is_type_a_dummy(ModuleInfo, Type), % We always allocate a new entry. We put is_dummy_type in the third slot % of var_table_entries before typecheck, before this authoritative filling % in of that slot, to make any bugs caused by *not* doing this filling-in % more visible. They would be more visible because in most programs, % most types are not dummy types. But this fact also means that if we % tested whether IsDummy = _OldIsDummy, and allocated a new memory cell % for a new entry if that test failed, we would lose more time in doing % the test than we saved by not doing the allocation if the test succeeded. !:Entry = vte(Name, Type, IsDummy). %---------------------% % Report a warning: uninstantiated type parameter. % :- pred report_unresolved_type_warning(module_info::in, pred_id::in, pred_info::in, assoc_list(prog_var, var_table_entry)::in, list(error_spec)::in, list(error_spec)::out) is det. report_unresolved_type_warning(ModuleInfo, PredId, PredInfo, VarsEntries, !Specs) :- pred_info_get_typevarset(PredInfo, TypeVarSet), pred_info_get_context(PredInfo, Context), PredIdPieces = describe_one_pred_name(ModuleInfo, should_not_module_qualify, PredId), VarTypePieceLists = list.map(var_and_type_to_pieces(TypeVarSet), VarsEntries), list.condense(VarTypePieceLists, VarTypePieces), MainPieces = [words("In")] ++ PredIdPieces ++ [suffix(":"), nl, words("warning: unresolved polymorphism."), nl, words(choose_number(VarsEntries, "The variable with an unbound type was:", "The variables with unbound types were:")), nl_indent_delta(1)] ++ VarTypePieces ++ [nl_indent_delta(-1), words("The unbound type"), words(choose_number(VarsEntries, "variable", "variables")), words("will be implicitly bound to the builtin type"), quote("void"), suffix("."), nl], VerbosePieces = [words("The body of the clause contains a call"), words("to a polymorphic predicate,"), words("but I can't determine which version should be called,"), words("because the type variables listed above didn't get bound."), % words("You may need to use an explicit type qualifier."), % XXX improve error message words("(I ought to tell you which call caused the problem,"), words("but I'm afraid you'll have to work it out yourself."), words("My apologies.)"), nl], Msg = simple_msg(Context, [always(MainPieces), verbose_only(verbose_once, VerbosePieces)]), Spec = conditional_spec($pred, warn_unresolved_polymorphism, yes, severity_warning, phase_type_check, [Msg]), !:Specs = [Spec | !.Specs]. :- func var_and_type_to_pieces(tvarset, pair(prog_var, var_table_entry)) = list(format_piece). var_and_type_to_pieces(TVarSet, Var - Entry) = Pieces :- Entry = vte(Name, Type, _IsDummy), VarStr = mercury_var_raw_to_string(print_name_only, Var, Name), TypeStr = mercury_type_to_string(TVarSet, print_name_only, Type), Pieces = [words(VarStr), suffix(":"), words(TypeStr), nl]. %---------------------------------------------------------------------------% :- pred check_type_of_main(pred_info::in, list(error_spec)::in, list(error_spec)::out) is det. check_type_of_main(PredInfo, !Specs) :- ( if % Check if this predicate is the program entry point main/2. pred_info_name(PredInfo) = "main", pred_info_orig_arity(PredInfo) = 2, pred_info_is_exported(PredInfo) then pred_info_get_arg_types(PredInfo, ArgTypes), % Check that both arguments of main/2 have type `io.state'. ( if % This part of the test cannot fail, since we checked the arity. ArgTypes = [ArgType1, ArgType2], % These parts can fail. type_is_io_state(ArgType1), type_is_io_state(ArgType2) then true else pred_info_get_context(PredInfo, Context), Pieces = [words("Error: both arguments of"), quote("main/2"), words("must have type"), quote("io.state"), suffix("."), nl], Spec = simplest_spec($pred, severity_error, phase_type_check, Context, Pieces), !:Specs = [Spec | !.Specs] ) else true ). %---------------------------------------------------------------------------% setup_var_table_in_clauses_for_imported_pred(ModuleInfo, !PredInfo) :- % Make sure the var_table field in the clauses_info is valid for imported % predicates. Unification and comparison procedures have their clauses % generated automatically, and the code that creates the clauses also % fills in the clauses' var_table. % NOTE The code that creates the clauses and fills in the var_table % is executed lazily, on demand. pred_info_get_clauses_info(!.PredInfo, ClausesInfo0), ( if pred_info_is_pseudo_imported(!.PredInfo) then clauses_info_get_var_table(ClausesInfo0, VarTable0), transform_var_table(fill_in_is_dummy_slot(ModuleInfo), VarTable0, VarTable), clauses_info_set_var_table(VarTable, ClausesInfo0, ClausesInfo) else clauses_info_get_varset(ClausesInfo0, VarSet), clauses_info_get_headvar_list(ClausesInfo0, HeadVars), pred_info_get_arg_types(!.PredInfo, ArgTypes), % This call fills in all the vte_is_dummy fields in VarTable. corresponding_vars_types_to_var_table(ModuleInfo, VarSet, HeadVars, ArgTypes, VarTable), clauses_info_set_var_table(VarTable, ClausesInfo0, ClausesInfo1), varset.init(EmptyVarSet), clauses_info_set_varset(EmptyVarSet, ClausesInfo1, ClausesInfo) ), pred_info_set_clauses_info(ClausesInfo, !PredInfo). %---------------------------------------------------------------------------% propagate_checked_types_into_pred_modes(ModuleInfo, ErrorProcIds, !:Specs, !Cache, !PredInfo) :- pred_info_get_proc_table(!.PredInfo, Procs0), ProcIds = pred_info_all_procids(!.PredInfo), !:Specs = [], propagate_checked_types_into_procs_modes(ModuleInfo, !.PredInfo, ProcIds, [], RevErrorProcIds, !Cache, !Specs, Procs0, Procs), list.reverse(RevErrorProcIds, ErrorProcIds), pred_info_set_proc_table(Procs, !PredInfo), pred_info_get_markers(!.PredInfo, Markers), ( if check_marker(Markers, marker_has_rhs_lambda) then % We have not copied goals in clauses to become the bodies % of procedures, so the lambda expressions in whose arguments % we should propagate types into insts exist only in the clauses_info. pred_info_get_clauses_info(!.PredInfo, ClausesInfo0), clauses_info_get_had_syntax_errors(ClausesInfo0, FoundSyntaxError), ( FoundSyntaxError = some_clause_syntax_errors % Any errors we could generate could be spurious. Any that aren't % will be found and reported by the first compiler invocation % after the user fixes the syntax errors. ; FoundSyntaxError = no_clause_syntax_errors, clauses_info_get_clauses_rep(ClausesInfo0, ClausesRep0, ItemNums), get_clause_list_for_replacement(ClausesRep0, Clauses0), VarTable = ClausesInfo0 ^ cli_var_table, propagate_checked_types_into_lambda_modes_in_clauses(ModuleInfo, VarTable, Clauses0, Clauses, !Cache, !Specs), set_clause_list(Clauses, ClausesRep), clauses_info_set_clauses_rep(ClausesRep, ItemNums, ClausesInfo0, ClausesInfo), pred_info_set_clauses_info(ClausesInfo, !PredInfo) ) else true ). %---------------------% :- pred propagate_checked_types_into_procs_modes(module_info::in, pred_info::in, list(proc_id)::in, list(proc_id)::in, list(proc_id)::out, tprop_cache::in, tprop_cache::out, list(error_spec)::in, list(error_spec)::out, proc_table::in, proc_table::out) is det. propagate_checked_types_into_procs_modes(_, _, [], !RevErrorProcIds, !Cache, !Specs, !Procs). propagate_checked_types_into_procs_modes(ModuleInfo, PredInfo, [ProcId | ProcIds], !RevErrorProcIds, !Cache, !Specs, !Procs) :- propagate_checked_types_into_proc_modes(ModuleInfo, PredInfo, ProcId, !RevErrorProcIds, !Cache, !Specs, !Procs), propagate_checked_types_into_procs_modes(ModuleInfo, PredInfo, ProcIds, !RevErrorProcIds, !Cache, !Specs, !Procs). :- pred propagate_checked_types_into_proc_modes(module_info::in, pred_info::in, proc_id::in, list(proc_id)::in, list(proc_id)::out, tprop_cache::in, tprop_cache::out, list(error_spec)::in, list(error_spec)::out, proc_table::in, proc_table::out) is det. propagate_checked_types_into_proc_modes(ModuleInfo, PredInfo, ProcId, !RevErrorProcIds, !Cache, !Specs, !Procs) :- pred_info_get_arg_types(PredInfo, ArgTypes), map.lookup(!.Procs, ProcId, ProcInfo0), proc_info_get_argmodes(ProcInfo0, ArgModes0), propagate_checked_types_into_modes(ModuleInfo, ta_pred(PredInfo), ArgTypes, ArgModes0, ArgModes, !Cache, !Specs), % Check for unbound inst vars. % % This needs to be done after calling propagate_checked_types_into_modes, % because we need the insts to be module qualified. % % It also needs to be done before mode analysis, to avoid internal errors % in mode analysis. ( if mode_list_contains_inst_var(ArgModes, _InstVar) % XXX This should be % some [InstVar] ( % mode_list_contains_inst_var(ArgModes, InstVar) % ) % but that gets a singleton variable warning, because quantification.m % replaces the list of quantified variables with the empty list % BEFORE the singleton variable warning is generated. then !:RevErrorProcIds = [ProcId | !.RevErrorProcIds] else proc_info_set_argmodes(ArgModes, ProcInfo0, ProcInfo), map.det_update(ProcId, ProcInfo, !Procs) ). %---------------------% :- pred propagate_checked_types_into_lambda_modes_in_clauses(module_info::in, var_table::in, list(clause)::in, list(clause)::out, tprop_cache::in, tprop_cache::out, list(error_spec)::in, list(error_spec)::out) is det. propagate_checked_types_into_lambda_modes_in_clauses(_, _, [], [], !Cache, !Specs). propagate_checked_types_into_lambda_modes_in_clauses(ModuleInfo, VarTable, [Clause0 | Clauses0], [Clause | Clauses], !Cache, !Specs) :- propagate_checked_types_into_lambda_modes_in_clause(ModuleInfo, VarTable, Clause0, Clause, !Cache, !Specs), propagate_checked_types_into_lambda_modes_in_clauses(ModuleInfo, VarTable, Clauses0, Clauses, !Cache, !Specs). :- pred propagate_checked_types_into_lambda_modes_in_clause(module_info::in, var_table::in, clause::in, clause::out, tprop_cache::in, tprop_cache::out, list(error_spec)::in, list(error_spec)::out) is det. propagate_checked_types_into_lambda_modes_in_clause(ModuleInfo, VarTable, Clause0, Clause, !Cache, !Specs) :- Lang = Clause0 ^ clause_lang, ( Lang = impl_lang_mercury, Goal0 = Clause0 ^ clause_body, propagate_checked_types_into_lambda_modes_in_goal(ModuleInfo, VarTable, Goal0, Goal, !Cache, !Specs), Clause = Clause0 ^ clause_body := Goal ; Lang = impl_lang_foreign(_), Clause = Clause0 ). :- pred propagate_checked_types_into_lambda_modes_in_goal(module_info::in, var_table::in, hlds_goal::in, hlds_goal::out, tprop_cache::in, tprop_cache::out, list(error_spec)::in, list(error_spec)::out) is det. propagate_checked_types_into_lambda_modes_in_goal(ModuleInfo, VarTable, Goal0, Goal, !Cache, !Specs) :- Goal0 = hlds_goal(GoalExpr0, GoalInfo0), ( GoalExpr0 = unify(LHS0, RHS0, UnifyMode0, Unification0, UniContext0), ( ( RHS0 = rhs_var(_) ; RHS0 = rhs_functor(_, _, _) ), Goal = Goal0 ; RHS0 = rhs_lambda_goal(Purity0, HOGroundness0, PorF0, EvalMethod0, ClosureVars0, ArgVarsModes0, Detism0, LambdaGoal0), list.length(ArgVarsModes0, NumArgs), Context = goal_info_get_context(GoalInfo0), Args = ta_lambda(PorF0, NumArgs, Context), propagate_checked_types_into_var_modes(ModuleInfo, VarTable, Args, 1, ArgVarsModes0, ArgVarsModes, !Cache, !Specs), propagate_checked_types_into_lambda_modes_in_goal(ModuleInfo, VarTable, LambdaGoal0, LambdaGoal, !Cache, !Specs), RHS = rhs_lambda_goal(Purity0, HOGroundness0, PorF0, EvalMethod0, ClosureVars0, ArgVarsModes, Detism0, LambdaGoal), GoalExpr = unify(LHS0, RHS, UnifyMode0, Unification0, UniContext0), Goal = hlds_goal(GoalExpr, GoalInfo0) ) ; ( GoalExpr0 = plain_call(_, _, _, _, _, _) ; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _) ; GoalExpr0 = generic_call(_, _, _, _, _) ), Goal = Goal0 ; GoalExpr0 = conj(ConjType, Conjuncts0), propagate_checked_types_into_lambda_modes_in_goals(ModuleInfo, VarTable, Conjuncts0, Conjuncts, !Cache, !Specs), GoalExpr = conj(ConjType, Conjuncts), Goal = hlds_goal(GoalExpr, GoalInfo0) ; GoalExpr0 = disj(Disjuncts0), propagate_checked_types_into_lambda_modes_in_goals(ModuleInfo, VarTable, Disjuncts0, Disjuncts, !Cache, !Specs), GoalExpr = disj(Disjuncts), Goal = hlds_goal(GoalExpr, GoalInfo0) ; GoalExpr0 = switch(Var0, CanFail0, Cases0), propagate_checked_types_into_lambda_modes_in_cases(ModuleInfo, VarTable, Cases0, Cases, !Cache, !Specs), GoalExpr = switch(Var0, CanFail0, Cases), Goal = hlds_goal(GoalExpr, GoalInfo0) ; GoalExpr0 = if_then_else(Vars0, Cond0, Then0, Else0), propagate_checked_types_into_lambda_modes_in_goal(ModuleInfo, VarTable, Cond0, Cond, !Cache, !Specs), propagate_checked_types_into_lambda_modes_in_goal(ModuleInfo, VarTable, Then0, Then, !Cache, !Specs), propagate_checked_types_into_lambda_modes_in_goal(ModuleInfo, VarTable, Else0, Else, !Cache, !Specs), GoalExpr = if_then_else(Vars0, Cond, Then, Else), Goal = hlds_goal(GoalExpr, GoalInfo0) ; GoalExpr0 = negation(SubGoal0), propagate_checked_types_into_lambda_modes_in_goal(ModuleInfo, VarTable, SubGoal0, SubGoal, !Cache, !Specs), GoalExpr = negation(SubGoal), Goal = hlds_goal(GoalExpr, GoalInfo0) ; GoalExpr0 = scope(Reason0, SubGoal0), propagate_checked_types_into_lambda_modes_in_goal(ModuleInfo, VarTable, SubGoal0, SubGoal, !Cache, !Specs), GoalExpr = scope(Reason0, SubGoal), Goal = hlds_goal(GoalExpr, GoalInfo0) ; GoalExpr0 = shorthand(ShortHand0), ( ShortHand0 = bi_implication(GoalA0, GoalB0), propagate_checked_types_into_lambda_modes_in_goal(ModuleInfo, VarTable, GoalA0, GoalA, !Cache, !Specs), propagate_checked_types_into_lambda_modes_in_goal(ModuleInfo, VarTable, GoalB0, GoalB, !Cache, !Specs), ShortHand = bi_implication(GoalA, GoalB) ; ShortHand0 = atomic_goal(AtomicGoalType0, OuterVars0, InnerVars0, OutputVars0, MainGoal0, OrElseGoals0, OrElseInners0), propagate_checked_types_into_lambda_modes_in_goal(ModuleInfo, VarTable, MainGoal0, MainGoal, !Cache, !Specs), propagate_checked_types_into_lambda_modes_in_goals(ModuleInfo, VarTable, OrElseGoals0, OrElseGoals, !Cache, !Specs), ShortHand = atomic_goal(AtomicGoalType0, OuterVars0, InnerVars0, OutputVars0, MainGoal, OrElseGoals, OrElseInners0) ; ShortHand0 = try_goal(MaybeIOVars0, ResultVars0, SubGoal0), propagate_checked_types_into_lambda_modes_in_goal(ModuleInfo, VarTable, SubGoal0, SubGoal, !Cache, !Specs), ShortHand = try_goal(MaybeIOVars0, ResultVars0, SubGoal) ), GoalExpr = shorthand(ShortHand), Goal = hlds_goal(GoalExpr, GoalInfo0) ). :- pred propagate_checked_types_into_lambda_modes_in_goals(module_info::in, var_table::in, list(hlds_goal)::in, list(hlds_goal)::out, tprop_cache::in, tprop_cache::out, list(error_spec)::in, list(error_spec)::out) is det. propagate_checked_types_into_lambda_modes_in_goals(_, _, [], [], !Cache, !Specs). propagate_checked_types_into_lambda_modes_in_goals(ModuleInfo, VarTable, [Goal0 | Goals0], [Goal | Goals], !Cache, !Specs) :- propagate_checked_types_into_lambda_modes_in_goal(ModuleInfo, VarTable, Goal0, Goal, !Cache, !Specs), propagate_checked_types_into_lambda_modes_in_goals(ModuleInfo, VarTable, Goals0, Goals, !Cache, !Specs). :- pred propagate_checked_types_into_lambda_modes_in_cases(module_info::in, var_table::in, list(case)::in, list(case)::out, tprop_cache::in, tprop_cache::out, list(error_spec)::in, list(error_spec)::out) is det. propagate_checked_types_into_lambda_modes_in_cases(_, _, [], [], !Cache, !Specs). propagate_checked_types_into_lambda_modes_in_cases(ModuleInfo, VarTable, [Case0 | Cases0], [Case | Cases], !Cache, !Specs) :- Case0 = case(MainConsId0, OtherConsIds0, Goal0), propagate_checked_types_into_lambda_modes_in_goal(ModuleInfo, VarTable, Goal0, Goal, !Cache, !Specs), Case = case(MainConsId0, OtherConsIds0, Goal), propagate_checked_types_into_lambda_modes_in_cases(ModuleInfo, VarTable, Cases0, Cases, !Cache, !Specs). %---------------------% :- pred propagate_checked_types_into_var_modes(module_info::in, var_table::in, tprop_args::in, int::in, assoc_list(prog_var, mer_mode)::in, assoc_list(prog_var, mer_mode)::out, tprop_cache::in, tprop_cache::out, list(error_spec)::in, list(error_spec)::out) is det. propagate_checked_types_into_var_modes(_, _, _, _, [], [], !Cache, !Specs). propagate_checked_types_into_var_modes(ModuleInfo, VarTable, Args, ArgNum, [Var - Mode0 | VarsModes0], [Var - Mode | VarsModes], !Cache, !Specs) :- lookup_var_type(VarTable, Var, Type), Context = tprop_arg_list_slot(Args, ArgNum), propagate_checked_type_into_mode(ModuleInfo, Context, Type, Mode0, Mode, !Cache, !Specs), propagate_checked_types_into_var_modes(ModuleInfo, VarTable, Args, ArgNum + 1, VarsModes0, VarsModes, !Cache, !Specs). %---------------------------------------------------------------------------% :- pred check_for_indistinguishable_modes(module_info::in, pred_id::in, pred_info::in, pred_info::out, list(error_spec)::in, list(error_spec)::out) is det. check_for_indistinguishable_modes(ModuleInfo, PredId, !PredInfo, !Specs) :- ( if % Don't check for indistinguishable modes in unification predicates. % The default (in, in) mode must be semidet, but for single-value types % we also want to create a det mode which will be indistinguishable % from the semidet mode. (When the type is known, the det mode is % called, but the polymorphic unify needs to be able to call % the semidet mode.) pred_info_get_origin(!.PredInfo, Origin), Origin = origin_compiler(made_for_uci(spec_pred_unify, _)) then true else ProcIds = pred_info_all_procids(!.PredInfo), check_for_indistinguishable_modes_in_procs(ModuleInfo, PredId, ProcIds, [], !PredInfo, !Specs) ). :- pred check_for_indistinguishable_modes_in_procs(module_info::in, pred_id::in, list(proc_id)::in, list(proc_id)::in, pred_info::in, pred_info::out, list(error_spec)::in, list(error_spec)::out) is det. check_for_indistinguishable_modes_in_procs(_, _, [], _, !PredInfo, !Specs). check_for_indistinguishable_modes_in_procs(ModuleInfo, PredId, [ProcId | ProcIds], PrevProcIds, !PredInfo, !Specs) :- check_for_indistinguishable_mode(ModuleInfo, PredId, ProcId, PrevProcIds, Removed, !PredInfo, !Specs), ( Removed = yes, PrevProcIds1 = PrevProcIds ; Removed = no, PrevProcIds1 = [ProcId | PrevProcIds] ), check_for_indistinguishable_modes_in_procs(ModuleInfo, PredId, ProcIds, PrevProcIds1, !PredInfo, !Specs). :- pred check_for_indistinguishable_mode(module_info::in, pred_id::in, proc_id::in, list(proc_id)::in, bool::out, pred_info::in, pred_info::out, list(error_spec)::in, list(error_spec)::out) is det. check_for_indistinguishable_mode(_, _, _, [], no, !PredInfo, !Specs). check_for_indistinguishable_mode(ModuleInfo, PredId, ProcId1, [ProcId | ProcIds], Removed, !PredInfo, !Specs) :- ( if modes_are_indistinguishable(ModuleInfo, !.PredInfo, ProcId, ProcId1) then pred_info_get_status(!.PredInfo, Status), module_info_get_globals(ModuleInfo, Globals), ( if % XXX I (zs) don't understand the reason behind the logic % we use here to decide whether to report the error. ( pred_status_defined_in_this_module(Status) = yes ; % With intermodule optimization, we can read the declarations % for a predicate from the `.int' and `.int0' files, so ignore % the error in those cases. % % XXX We should ignore the error only if we DID read the % predicate declaration from a place for which we shouldn't % report errors. This tests whether we COULD HAVE, which is % not the same thing. globals.lookup_bool_option(Globals, intermodule_optimization, no), globals.lookup_bool_option(Globals, intermodule_analysis, no) ; globals.get_op_mode(Globals, OpMode), OpMode = opm_top_args(opma_augment(opmau_make_plain_opt), _) ) then % XXX We shouldn't ignore the updated ModuleInfo, which may % differ from the old one in including an updated error count. Spec = report_indistinguishable_modes_error(ModuleInfo, ProcId1, ProcId, PredId, !.PredInfo), !:Specs = [Spec | !.Specs] else true ), % XXX doing this leaves dangling references the deleted proc_id in the % method definitions in the class table if the predicate being % processed is one of those introduced for type class methods. % See also: the comment above expand_class_method_body/5 in % polymorphism.m. pred_info_remove_procid(ProcId1, !PredInfo), Removed = yes else check_for_indistinguishable_mode(ModuleInfo, PredId, ProcId1, ProcIds, Removed, !PredInfo, !Specs) ). % Report an error for the case when two mode declarations % declare indistinguishable modes. % :- func report_indistinguishable_modes_error(module_info, proc_id, proc_id, pred_id, pred_info) = error_spec. report_indistinguishable_modes_error(ModuleInfo, OldProcId, NewProcId, PredId, PredInfo) = Spec :- pred_info_get_proc_table(PredInfo, Procs), map.lookup(Procs, OldProcId, OldProcInfo), map.lookup(Procs, NewProcId, NewProcInfo), proc_info_get_context(OldProcInfo, OldContext), proc_info_get_context(NewProcInfo, NewContext), MainPieces = [words("In mode declarations for ")] ++ describe_one_pred_name(ModuleInfo, should_module_qualify, PredId) ++ [suffix(":"), nl, words("error: duplicate mode declaration."), nl], VerbosePieces = [words("Modes"), words_quote(mode_decl_to_string(output_mercury, OldProcId, PredInfo)), words("and"), words_quote(mode_decl_to_string(output_mercury, NewProcId, PredInfo)), words("are indistinguishable.")], OldPieces = [words("Here is the conflicting mode declaration.")], Spec = error_spec($pred, severity_error, phase_mode_check(report_in_any_mode), [simple_msg(NewContext, [always(MainPieces), verbose_only(verbose_always, VerbosePieces)]), simplest_msg(OldContext, OldPieces)]). %---------------------------------------------------------------------------% :- end_module check_hlds.post_typecheck. %---------------------------------------------------------------------------%