%---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %---------------------------------------------------------------------------% % Copyright (C) 1993-2012,2014 The University of Melbourne. % Copyright (C) 2015 The Mercury team. % This file may only be copied under the terms of the GNU General % Public License - see the file COPYING in the Mercury distribution. %---------------------------------------------------------------------------% % % File: add_pred.m. % % This submodule of make_hlds handles the type and mode declarations % for predicates. % %---------------------------------------------------------------------------% :- module hlds.add_pred. :- interface. :- import_module hlds.hlds_clauses. :- import_module hlds.hlds_module. :- import_module hlds.hlds_pred. :- import_module hlds.make_hlds. :- import_module hlds.make_hlds.make_hlds_types. :- import_module hlds.pred_name. :- import_module hlds.status. :- import_module mdbcomp. :- import_module mdbcomp.prim_data. :- import_module mdbcomp.sym_name. :- import_module parse_tree. :- import_module parse_tree.error_spec. :- import_module parse_tree.prog_data. :- import_module parse_tree.prog_item. :- import_module list. :- import_module maybe. :- import_module pair. %---------------------------------------------------------------------------% % Add a pred or predmode declaration for a predicate. % % We return MaybePredMaybeProcId = yes(PredId - MaybeProcId) if we % successfully added the predicate to the HLDS. The MaybeProcId part % will be yes(ProcId) if the declaration is a predmode declaration, % and we successfully added its implied mode declaration to the HLDS. % :- pred module_add_pred_decl(item_mercury_status::in, pred_status::in, need_qualifier::in, item_pred_decl_info::in, maybe(pair(pred_id, maybe(proc_id)))::out, module_info::in, module_info::out, list(error_spec)::in, list(error_spec)::out) is det. :- pred add_new_proc(module_info::in, prog_context::in, item_seq_num::in, inst_varset::in, list(mer_mode)::in, maybe(list(mer_mode))::in, maybe(list(is_live))::in, detism_decl::in, maybe(determinism)::in, is_address_taken::in, has_parallel_conj::in, pred_info::in, pred_info::out, proc_id::out) is det. % Is the mode declaration we are adding to the HLDS derived from % a combined predmode declaration? :- type part_of_predmode ---> not_part_of_predmode ; part_of_predmode. % Add a mode declaration for a predicate. % :- pred module_add_mode_decl(part_of_predmode::in, maybe_class_method::in, item_mercury_status::in, pred_status::in, item_mode_decl_info::in, pred_proc_id::out, module_info::in, module_info::out, list(error_spec)::in, list(error_spec)::out) is det. % report_mode_decl_after_predmode(PFNameArity, Context): % % Return a diagnostic reporting that PredPFNameArity has a % mode declaration at Context which is disallowed by the fact that % its predicate or function declaration was a predmode declaration. % % We export this to add_class.m. Class definitions consist of pred, func % and mode declarations, and we want diagnostics for mode declarations % that follow pred or func declarations with embedded mode information % to be the same inside class definitions as they are outside. % :- func report_mode_decl_after_predmode(pred_pf_name_arity, prog_context) = error_spec. % Whenever there is a clause or mode declaration for an undeclared % predicate, we add an implicit declaration % :- pred p(T1, T2, ..., Tn). % for that predicate; the real types will be inferred by type inference. % :- pred add_implicit_pred_decl_report_error(pred_or_func::in, module_name::in, string::in, pred_form_arity::in, pred_status::in, maybe_class_method::in, prog_context::in, pred_origin::in, list(format_piece)::in, pred_id::out, module_info::in, module_info::out, list(error_spec)::in, list(error_spec)::out) is det. :- pred add_implicit_pred_decl(pred_or_func::in, module_name::in, string::in, pred_form_arity::in, pred_status::in, prog_context::in, pred_origin::in, goal_type::in, clauses_info::in, pred_id::out, module_info::in, module_info::out) is det. :- pred check_preds_if_field_access_function(module_info::in, sec_list(item_pred_decl_info)::in, list(error_spec)::in, list(error_spec)::out) is det. %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- implementation. :- import_module hlds.hlds_args. :- import_module hlds.hlds_cons. :- import_module hlds.hlds_goal. :- import_module hlds.hlds_rtti. :- import_module hlds.make_hlds_error. :- import_module hlds.pred_table. :- import_module libs. :- import_module libs.globals. :- import_module libs.options. :- import_module mdbcomp.builtin_modules. :- import_module parse_tree.builtin_lib_types. :- import_module parse_tree.parse_tree_out_misc. :- import_module parse_tree.prog_mode. :- import_module parse_tree.prog_type. :- import_module parse_tree.prog_util. :- import_module parse_tree.set_of_var. :- import_module parse_tree.var_table. :- import_module parse_tree.vartypes. :- import_module bool. :- import_module map. :- import_module require. :- import_module string. :- import_module term_context. :- import_module varset. %---------------------------------------------------------------------------% module_add_pred_decl(ItemMercuryStatus, PredStatus, NeedQual, ItemPredDecl, MaybePredMaybeProcId, !ModuleInfo, !Specs) :- ItemPredDecl = item_pred_decl_info(PredSymName, PredOrFunc, ArgTypesAndModes, WithType, WithInst, MaybeDetism, Origin, TypeVarSet, InstVarSet, ExistQVars, Purity, Constraints, Context, SeqNum), ( PredSymName = unqualified(_PredName), unexpected($pred, "unqualified PredSymName") ; PredSymName = qualified(PredModuleName, PredName) ), % Any WithType and WithInst annotations should have been expanded % and the type and/or inst put into TypesAndModes by equiv_type.m. expect(unify(WithType, no), $pred, "WithType != no"), expect(unify(WithInst, no), $pred, "WithInst != no"), ( if PredName = "" then % The term parser, when given input strings such as "A(B, C)", % in which a variable acts as a function symbol, returns a term % such as functor("", [variable(A), variable(B), variable(C)]). % The only way PredName could be "" is if this happened in the % predicate or function declaration. PredOrFuncStr = pred_or_func_to_full_str(PredOrFunc), Pieces = [words("Error: you cannot declare a"), words(PredOrFuncStr), words("whose name is a variable."), nl], Spec = simplest_spec($pred, severity_error, phase_parse_tree_to_hlds, Context, Pieces), !:Specs = [Spec | !.Specs], MaybePredMaybeProcId = no else split_types_and_modes(ArgTypesAndModes, ArgTypes, MaybeArgModes0), list.length(ArgTypes, PredFormArityInt), ( if PredOrFunc = pf_predicate, MaybeArgModes0 = yes(ArgModes0), % If a predicate declaration has no arguments and no determinism, % then it has none of the components of a mode declaration. ArgModes0 = [], MaybeDetism = no then MaybeArgModes = no else if % A function declaration that contains no argument modes but does % specify a determinism is implicitly specifying the default mode. PredOrFunc = pf_function, MaybeArgModes0 = no, MaybeDetism = yes(_) then adjust_func_arity(pf_function, FuncArityInt, PredFormArityInt), in_mode(InMode), list.duplicate(FuncArityInt, InMode, InModes), out_mode(OutMode), MaybeArgModes = yes(InModes ++ [OutMode]) else MaybeArgModes = MaybeArgModes0 ), ( MaybeArgModes = no, PredmodeDecl = no_predmode_decl ; MaybeArgModes = yes(_), PredmodeDecl = predmode_decl ), user_arity_pred_form_arity(PredOrFunc, UserArity, pred_form_arity(PredFormArityInt)), record_pred_origin(PredOrFunc, PredSymName, UserArity, Origin, Context, PredOrigin, Markers), add_new_pred(PredOrigin, Context, SeqNum, PredStatus, NeedQual, PredOrFunc, PredModuleName, PredName, TypeVarSet, ExistQVars, ArgTypes, Constraints, PredmodeDecl, Purity, Markers, MaybeNewPredId, !ModuleInfo, !Specs), ( MaybeArgModes = yes(ArgModes), ( MaybeNewPredId = no, % Do not try to add the mode declaration part of the predmode % declaration to the HLDS if adding the pred declaration part % has failed. MaybePredMaybeProcId = no ; MaybeNewPredId = yes(NewPredId), ( if check_marker(Markers, marker_class_method) then IsClassMethod = is_a_class_method else IsClassMethod = is_not_a_class_method ), ItemModeDecl = item_mode_decl_info(PredSymName, yes(PredOrFunc), ArgModes, WithInst, MaybeDetism, InstVarSet, Context, SeqNum), module_add_mode_decl(part_of_predmode, IsClassMethod, ItemMercuryStatus, PredStatus, ItemModeDecl, ModePredProcId, !ModuleInfo, !Specs), ModePredProcId = proc(ModePredId, ModeProcId), expect(unify(NewPredId, ModePredId), $pred, "NewPredId != ModePredId"), MaybePredMaybeProcId = yes(NewPredId - yes(ModeProcId)) ) ; MaybeArgModes = no, ( MaybeNewPredId = no, MaybePredMaybeProcId = no ; MaybeNewPredId = yes(NewPredId), MaybePredMaybeProcId = yes(NewPredId - no) ), % There is no valid mode declaration part we can add to the HLDS. % Check for an invalid mode declaration part anyway. check_for_modeless_predmode_decl(PredStatus, PredOrFunc, PredSymName, ArgTypes, MaybeDetism, Context, !Specs) ) ). :- pred record_pred_origin(pred_or_func::in, sym_name::in, user_arity::in, item_maybe_attrs::in, prog_context::in, pred_origin::out, pred_markers::out) is det. record_pred_origin(PredOrFunc, PredSymName, UserArity, Origin, Context, PredOrigin, Markers) :- % If this predicate was added as a result of the mutable % transformation, then mark this predicate as a mutable access pred. % We do this so that we can tell optimizations, like inlining, % to treat it specially. init_markers(Markers0), ( Origin = item_origin_user, PredOrigin = origin_user( user_made_pred(PredOrFunc, PredSymName, UserArity)), Markers = Markers0 ; Origin = item_origin_compiler(CompilerAttrs), CompilerAttrs = item_compiler_attributes(CompilerOrigin), ( CompilerOrigin = compiler_origin_class_method(ClassId, MethodId), PredOrigin = origin_user(user_made_class_method(ClassId, MethodId)), add_marker(marker_class_method, Markers0, Markers) ; CompilerOrigin = compiler_origin_solver_repn(TypeCtor, SolverPredKind), PredOrigin = origin_compiler( made_for_solver_repn(TypeCtor, SolverPredKind)), Markers = Markers0 ; CompilerOrigin = compiler_origin_tabling(PFSymNameArity, TablingPredKind), PredOrigin = origin_compiler(made_for_tabling(PFSymNameArity, TablingPredKind)), Markers = Markers0 ; CompilerOrigin = compiler_origin_mutable(ModuleName, MutableName, MutablePredKind), PredOrigin = origin_compiler( made_for_mutable(ModuleName, MutableName, MutablePredKind)), add_marker(marker_mutable_access_pred, Markers0, Markers) ; CompilerOrigin = compiler_origin_initialise, Context = context(File, Line), PredOrigin = origin_compiler(made_for_initialise(File, Line)), Markers = Markers0 ; CompilerOrigin = compiler_origin_finalise, Context = context(File, Line), PredOrigin = origin_compiler(made_for_finalise(File, Line)), Markers = Markers0 ) ). :- pred check_for_modeless_predmode_decl(pred_status::in, pred_or_func::in, sym_name::in, list(mer_type)::in, maybe(determinism)::in, prog_context::in, list(error_spec)::in, list(error_spec)::out) is det. check_for_modeless_predmode_decl(PredStatus, PredOrFunc, PredSymName, ArgTypes, MaybeDetism, Context, !Specs) :- ( if MaybeDetism = yes(_), % Functions are allowed to declare a determinism without declaring % argument modes; the determinism will apply to the default mode. % Predicates do not have a default mode, so they may NOT declare % a determinism without declaring the argument modes, UNLESS % there are no arguments whose mode needs to be declared. PredOrFunc = pf_predicate, ArgTypes = [_ | _], % Do not generate an error message unless the predicate % is defined in this module. pred_status_defined_in_this_module(PredStatus) = yes then % The declaration of "is" looks like this: % :- pred is(T, T) is det. % We can't just delete "is det" part, because if we do, % the compiler will think that the predicate name "is" % is introducing a determinism, which yields a syntax error. % We also cannot add the argument modes, since "is" has both % unique and non-unique modes. ( if PredSymName = qualified(PredModuleName, "is"), PredModuleName = mercury_std_lib_module_name(unqualified("prolog")) then true else list.length(ArgTypes, PredFormArity), SNA = sym_name_arity(PredSymName, PredFormArity), DetPieces = [words("Error: predicate"), unqual_sym_name_arity(SNA), words("declares a determinism without declaring"), words("the modes of its arguments."), nl], DetSpec = simplest_spec($pred, severity_error, phase_parse_tree_to_hlds, Context, DetPieces), !:Specs = [DetSpec | !.Specs] ) else true ). :- pred add_new_pred(pred_origin::in, prog_context::in, item_seq_num::in, pred_status::in, need_qualifier::in, pred_or_func::in, module_name::in, string::in, tvarset::in, existq_tvars::in, list(mer_type)::in, prog_constraints::in, maybe_predmode_decl::in, purity::in, pred_markers::in, maybe(pred_id)::out, module_info::in, module_info::out, list(error_spec)::in, list(error_spec)::out) is det. add_new_pred(PredOrigin, Context, SeqNum, PredStatus0, NeedQual, PredOrFunc, PredModuleName, PredName, TVarSet, ExistQVars, Types, Constraints, PredmodeDecl, Purity, Markers0, MaybeNewPredId, !ModuleInfo, !Specs) :- % NB. Predicates are also added in lambda.m, which converts % lambda expressions into separate predicates, so any changes may need % to be reflected there too. % Only preds with opt_imported clauses are tagged as opt_imported, so that % the compiler doesn't look for clauses for other preds read in from % optimization interfaces. ( if PredStatus0 = pred_status(status_opt_imported) then PredStatus = pred_status(status_imported(import_locn_interface)) else PredStatus = PredStatus0 ), PredFormArity = arg_list_arity(Types), PredSymName = qualified(PredModuleName, PredName), ( if % NOTE This code is duplicating the effect of % % MaybeItemMercuryStatus = yes(ItemMercuryStatus), % ItemMercuryStatus = item_defined_in_this_module(ItemExport) % % without requiring our caller to pass ItemMercuryStatus here. % The reason why this is important is that for compiler-generated % predicate declarations, there is no natural ItemMercuryStatus. PredStatus = pred_status(OldItemStatus), ( OldItemStatus = status_local, ItemExport = item_export_nowhere ; OldItemStatus = status_exported_to_submodules, ItemExport = item_export_only_submodules ; OldItemStatus = status_exported, ItemExport = item_export_anywhere ) then DeclSection = item_decl_section(ItemExport), MaybeCurUserDecl = yes(cur_user_decl_info(DeclSection, PredmodeDecl, SeqNum)) else MaybeCurUserDecl = no ), GoalType = goal_not_for_promise(np_goal_type_none), module_info_get_predicate_table(!.ModuleInfo, PredTable0), % XXX CIT_TYPES should be cit_types(Types), clauses_info_init(PredOrFunc, cit_no_types(PredFormArity), init_clause_item_numbers_user, ClausesInfo), map.init(Proofs), map.init(ConstraintMap), purity_to_markers(Purity, PurityMarkers), add_markers(PurityMarkers, Markers0, Markers), map.init(VarNameRemap), pred_info_init(PredOrFunc, PredModuleName, PredName, PredFormArity, Context, PredOrigin, PredStatus, MaybeCurUserDecl, GoalType, Markers, Types, TVarSet, ExistQVars, Constraints, Proofs, ConstraintMap, ClausesInfo, VarNameRemap, PredInfo0), predicate_table_lookup_pf_m_n_a(PredTable0, is_fully_qualified, PredOrFunc, PredModuleName, PredName, PredFormArity, PredIds), ( PredIds = [OrigPred | _], MaybeNewPredId = no, module_info_pred_info(!.ModuleInfo, OrigPred, OrigPredInfo), pred_info_get_context(OrigPredInfo, OrigContext), ( if PredStatus0 = pred_status(status_opt_imported) then true else PredOrFuncStr = pred_or_func_to_str(PredOrFunc), user_arity_pred_form_arity(PredOrFunc, UserArity, PredFormArity), report_multiply_defined(PredOrFuncStr, PredSymName, UserArity, Context, OrigContext, [], !Specs) ) ; PredIds = [], module_info_get_partial_qualifier_info(!.ModuleInfo, PQInfo), predicate_table_insert_qual(PredInfo0, NeedQual, PQInfo, PredId, PredTable0, PredTable1), MaybeNewPredId = yes(PredId), ( if pred_info_is_builtin(PredInfo0) then module_info_get_globals(!.ModuleInfo, Globals), globals.get_target(Globals, CompilationTarget), add_builtin(!.ModuleInfo, CompilationTarget, PredId, Types, PredInfo0, PredInfo), predicate_table_get_pred_id_table(PredTable1, PredIdTable1), map.det_update(PredId, PredInfo, PredIdTable1, PredIdTable), predicate_table_set_pred_id_table(PredIdTable, PredTable1, PredTable) else PredTable = PredTable1 ), module_info_set_predicate_table(PredTable, !ModuleInfo) ), DefnThisModule = pred_status_defined_in_this_module(PredStatus0), ( DefnThisModule = yes ; DefnThisModule = no, % All predicate and function declarations read in from % automatically generated interface files should be fully qualified, % *provided* that the source files they are derived from % import all the modules needed to module qualify them. % % For now, we look for and report any unqualified types read in % from .int files. Once we can guarantee that such things cannot occur, % by making --print-errors-warnings-when-generating-interface % not just the default but not even an option that can be switched off, % this code should not be needed anymore. report_any_unqualified_types(PredSymName, Context, Types, !Specs) ). %---------------------% :- func item_decl_section(item_export) = decl_section. item_decl_section(ItemExport) = DeclSection :- ( ItemExport = item_export_anywhere, DeclSection = decl_interface ; ( ItemExport = item_export_nowhere ; ItemExport = item_export_only_submodules ), DeclSection = decl_implementation ). %---------------------% :- pred report_any_unqualified_types(sym_name::in, prog_context::in, list(mer_type)::in, list(error_spec)::in, list(error_spec)::out) is det. report_any_unqualified_types(_PredSymName, _Context, [], !Specs). report_any_unqualified_types(PredSymName, Context, [Type | Types], !Specs) :- report_any_unqualified_type(PredSymName, Context, Type, !Specs), report_any_unqualified_types(PredSymName, Context, Types, !Specs). :- pred report_any_unqualified_type(sym_name::in, prog_context::in, mer_type::in, list(error_spec)::in, list(error_spec)::out) is det. report_any_unqualified_type(PredSymName, Context, Type, !Specs) :- ( Type = defined_type(TypeCtorSymName, ArgTypes, _Kind), ( TypeCtorSymName = qualified(_, _) ; TypeCtorSymName = unqualified(TypeCtorName), ( PredSymName = qualified(PredModuleName, _), Pieces = [words("Error: unqualified type"), quote(TypeCtorName), words("in automatically generated interface file."), words("The problem is that the definition of this type"), words("is not visible in the source file of the"), qual_sym_name(PredModuleName), words("module."), words("The cause is probably"), words("either a typo in the type name,"), words("or a missing"), decl("import_module"), words("declaration."), nl], Spec = simplest_spec($pred, severity_error, phase_parse_tree_to_hlds, Context, Pieces), !:Specs = [Spec | !.Specs] ; PredSymName = unqualified(_) % While a module qualification may be missing from a type name % in a predicate declaration, it *should not* be missing % from the name of the predicate (or function) itself, % since the parser implicitly module qualifies such names. ) ), report_any_unqualified_types(PredSymName, Context, ArgTypes, !Specs) ; Type = tuple_type(ArgTypes, _Kind), report_any_unqualified_types(PredSymName, Context, ArgTypes, !Specs) ; Type = higher_order_type(_PorF, ArgTypes, _HOInstInfo, _Purity, _LambdaEvalMethod), report_any_unqualified_types(PredSymName, Context, ArgTypes, !Specs) ; Type = apply_n_type(_TVar, ArgTypes, _Kind), report_any_unqualified_types(PredSymName, Context, ArgTypes, !Specs) ; Type = kinded_type(SubType, _Kind), report_any_unqualified_type(PredSymName, Context, SubType, !Specs) ; ( Type = type_variable(_, _) ; Type = builtin_type(_) ) ). %---------------------------------------------------------------------------% % For most builtin predicates, say foo/2, we add a clause % % foo(H1, H2) :- foo(H1, H2). % % This does not generate an infinite loop! Instead, the compiler will % generate the usual builtin inline code for foo/2 in the body. The reason % for generating this forwarding code stub is so that things work correctly % if you take the address of the predicate. % % A few builtins are treated specially. % :- pred add_builtin(module_info::in, compilation_target::in, pred_id::in, list(mer_type)::in, pred_info::in, pred_info::out) is det. add_builtin(ModuleInfo, CompilationTarget, PredId, HeadTypes0, !PredInfo) :- ModuleName = pred_info_module(!.PredInfo), Name = pred_info_name(!.PredInfo), pred_info_get_context(!.PredInfo, Context), pred_info_get_clauses_info(!.PredInfo, ClausesInfo0), clauses_info_get_varset(ClausesInfo0, VarSet0), clauses_info_get_headvars(ClausesInfo0, ProcArgVector), % XXX ARGVEC - clean this up after the pred_info is converted to use % the arg_vector structure. HeadVars0 = proc_arg_vector_to_list(ProcArgVector), goal_info_init(Context, GoalInfo0), NonLocals = set_of_var.list_to_set(HeadVars0), goal_info_set_nonlocals(NonLocals, GoalInfo0, GoalInfo1), ( if ModuleName = mercury_private_builtin_module, ( ( Name = "builtin_compound_eq" ; Name = "builtin_compound_lt" ) ; % This predicate is incompatible with some backends. Name = "store_at_ref_impure", require_complete_switch [CompilationTarget] ( ( CompilationTarget = target_java ; CompilationTarget = target_csharp ), SupportsStore = no ; CompilationTarget = target_c, SupportsStore = yes ), SupportsStore = no ) then GoalExpr = conj(plain_conj, []), GoalInfo = GoalInfo1, HeadVars = HeadVars0, HeadTypes = HeadTypes0, VarSet = VarSet0, Stub = yes else if ( ModuleName = mercury_private_builtin_module, Name = "trace_get_io_state" ; ModuleName = mercury_io_module, Name = "unsafe_get_io_state" ) then varset.new_var(ZeroVar, VarSet0, VarSet), HeadVars = [ZeroVar | HeadVars0], HeadTypes = [int_type | HeadTypes0], ConsId = some_int_const(int_const(0)), LHS = ZeroVar, RHS = rhs_functor(ConsId, is_not_exist_constr, []), UnifyMode = unify_modes_li_lf_ri_rf(free, ground_inst, ground_inst, ground_inst), Unification = construct(ZeroVar, ConsId, [], [UnifyMode], construct_dynamically, cell_is_shared, no_construct_sub_info), UnifyContext = unify_context(umc_explicit, []), AssignExpr = unify(LHS, RHS, UnifyMode, Unification, UnifyContext), goal_info_set_nonlocals(set_of_var.make_singleton(ZeroVar), GoalInfo0, GoalInfoWithZero), AssignGoal = hlds_goal(AssignExpr, GoalInfoWithZero), CastExpr = generic_call(cast(unsafe_type_inst_cast), HeadVars, [in_mode, uo_mode], arg_reg_types_unset, detism_det), goal_info_set_nonlocals(set_of_var.list_to_set(HeadVars), GoalInfo0, GoalInfoWithZeroHeadVars), CastGoal = hlds_goal(CastExpr, GoalInfoWithZeroHeadVars), ConjExpr = conj(plain_conj, [AssignGoal, CastGoal]), ConjGoal = hlds_goal(ConjExpr, GoalInfoWithZeroHeadVars), Reason = promise_purity(purity_semipure), GoalExpr = scope(Reason, ConjGoal), GoalInfo = GoalInfo1, Stub = no else if ( ModuleName = mercury_private_builtin_module, Name = "trace_set_io_state" ; ModuleName = mercury_io_module, Name = "unsafe_set_io_state" ) then ConjExpr = conj(plain_conj, []), ConjGoal = hlds_goal(ConjExpr, GoalInfo), Reason = promise_purity(purity_impure), GoalExpr = scope(Reason, ConjGoal), GoalInfo = GoalInfo1, HeadVars = HeadVars0, HeadTypes = HeadTypes0, VarSet = VarSet0, Stub = no else % Construct the pseudo-recursive call to ModuleName.Name(HeadVars). SymName = qualified(ModuleName, Name), % Mode checking will figure out the mode. ModeId = invalid_proc_id, MaybeUnifyContext = no, % XXX ARGVEC GoalExpr = plain_call(PredId, ModeId, HeadVars0, inline_builtin, MaybeUnifyContext, SymName), pred_info_get_purity(!.PredInfo, Purity), goal_info_set_purity(Purity, GoalInfo1, GoalInfo), HeadVars = HeadVars0, HeadTypes = HeadTypes0, VarSet = VarSet0, Stub = no ), ( Stub = no, % Construct a clause containing that pseudo-recursive call. Goal = hlds_goal(GoalExpr, GoalInfo), Clause = clause(all_modes, Goal, impl_lang_mercury, Context, []), set_clause_list([Clause], ClausesRep) ; Stub = yes, set_clause_list([], ClausesRep) ), % Put the clause we just built (if any) into the pred_info, % annotated with the appropriate types. vartypes_from_corresponding_lists(HeadVars, HeadTypes, ExplicitVarTypes), corresponding_vars_types_to_var_table(ModuleInfo, VarSet, HeadVars, HeadTypes, VarTable), rtti_varmaps_init(RttiVarMaps), map.init(TVarNameMap), ClausesInfo = clauses_info(VarSet, ExplicitVarTypes, VarTable, RttiVarMaps, TVarNameMap, ProcArgVector, ClausesRep, init_clause_item_numbers_comp_gen, no_foreign_lang_clauses, no_clause_syntax_errors), pred_info_set_clauses_info(ClausesInfo, !PredInfo), % It is pointless but harmless to inline these clauses. The main purpose % of the `no_inline' marker is to stop constraint propagation creating % real infinite loops in the generated code when processing calls to these % predicates. The code generator will still generate inline code for calls % to these predicates. pred_info_get_markers(!.PredInfo, Markers0), add_marker(marker_user_marked_no_inline, Markers0, Markers1), ( Stub = yes, add_marker(marker_stub, Markers1, Markers2), add_marker(marker_builtin_stub, Markers2, Markers) ; Stub = no, Markers = Markers1 ), pred_info_set_markers(Markers, !PredInfo). %---------------------------------------------------------------------------% add_new_proc(ModuleInfo, Context, SeqNum, InstVarSet, ArgModes, MaybeDeclaredArgModes, MaybeArgLives, DetismDecl, MaybeDetism, IsAddressTaken, HasParallelConj, !PredInfo, ProcId) :- pred_info_get_arg_types(!.PredInfo, ArgTypes), pred_info_get_var_name_remap(!.PredInfo, VarNameRemap), proc_info_init(ModuleInfo, Context, SeqNum, ArgTypes, MaybeDeclaredArgModes, ArgModes, MaybeArgLives, DetismDecl, MaybeDetism, IsAddressTaken, HasParallelConj, VarNameRemap, ProcInfo0), proc_info_set_inst_varset(InstVarSet, ProcInfo0, ProcInfo), pred_info_get_proc_table(!.PredInfo, ProcTable0), % XXX ARITY rename to next_proc_id next_proc_id(ProcTable0, ProcId), map.det_insert(ProcId, ProcInfo, ProcTable0, ProcTable), pred_info_set_proc_table(ProcTable, !PredInfo). %---------------------------------------------------------------------------% module_add_mode_decl(PartOfPredmode, IsClassMethod, ItemMercuryStatus, PredStatus, ItemModeDecl, PredProcId, !ModuleInfo, !Specs) :- ItemModeDecl = item_mode_decl_info(PredSymName, MaybePredOrFunc, Modes, WithInst, _MaybeDetism, _InstVarSet, Context, _SeqNum), ( PredSymName = unqualified(_PredName), unexpected($pred, "unqualified PredSymName") ; PredSymName = qualified(PredModuleName, PredName) ), % The equiv_type pass should have also either set the pred_or_func, % or removed the item from the parse tree. ( MaybePredOrFunc = yes(PredOrFunc) ; MaybePredOrFunc = no, unexpected($pred, "no pred_or_func on mode declaration") ), % Any WithInst annotations should have been expanded % and the inst put into Modes by equiv_type.m. expect(unify(WithInst, no), $pred, "WithInst != no"), ( if PredName = "" then % This dummy PredProcId won't be used due to the error. PredProcId = proc(invalid_pred_id, invalid_proc_id), Pieces = [words("Error: you cannot declare a mode"), words("for a predicate whose name is a variable."), nl], Spec = simplest_spec($pred, severity_error, phase_parse_tree_to_hlds, Context, Pieces), !:Specs = [Spec | !.Specs] else % Lookup the pred or func declaration in the predicate table. % If it is not there (or if it is ambiguous), optionally print % a warning message and insert an implicit definition % for the predicate; it is presumed to be local, and its type % will be inferred automatically. PredFormArity = arg_list_arity(Modes), module_info_get_predicate_table(!.ModuleInfo, PredicateTable0), predicate_table_lookup_pf_m_n_a(PredicateTable0, is_fully_qualified, PredOrFunc, PredModuleName, PredName, PredFormArity, PredIds), ( if PredIds = [PredIdPrime] then PredId = PredIdPrime else user_arity_pred_form_arity(PredOrFunc, UserArity, PredFormArity), Origin = origin_user( user_made_pred(PredOrFunc, PredSymName, UserArity)), add_implicit_pred_decl_report_error(PredOrFunc, PredModuleName, PredName, PredFormArity, PredStatus, IsClassMethod, Context, Origin, [decl("mode"), words("declaration")], PredId, !ModuleInfo, !Specs) ), module_info_get_predicate_table(!.ModuleInfo, PredicateTable1), predicate_table_get_pred_id_table(PredicateTable1, PredIdTable0), map.lookup(PredIdTable0, PredId, PredInfo0), module_do_add_mode(!.ModuleInfo, PartOfPredmode, IsClassMethod, ItemMercuryStatus, ItemModeDecl, PredInfo0, PredInfo, ProcId, !Specs), map.det_update(PredId, PredInfo, PredIdTable0, PredIdTable), predicate_table_set_pred_id_table(PredIdTable, PredicateTable1, PredicateTable), module_info_set_predicate_table(PredicateTable, !ModuleInfo), PredProcId = proc(PredId, ProcId) ). :- pred module_do_add_mode(module_info::in, part_of_predmode::in, maybe_class_method::in, item_mercury_status::in, item_mode_decl_info::in, pred_info::in, pred_info::out, proc_id::out, list(error_spec)::in, list(error_spec)::out) is det. module_do_add_mode(ModuleInfo, PartOfPredmode, IsClassMethod, ItemMercuryStatus, ItemModeDecl, !PredInfo, ProcId, !Specs) :- PredName = pred_info_name(!.PredInfo), PredOrFunc = pred_info_is_pred_or_func(!.PredInfo), ItemModeDecl = item_mode_decl_info(_PredSymName, _MaybePredOrFunc, Modes, _WithInst, MaybeDetism, InstVarSet, Context, SeqNum), PredFormArity = arg_list_arity(Modes), % Check that the determinism was specified. ( MaybeDetism = no, DetismDecl = detism_decl_none, pred_info_get_status(!.PredInfo, PredStatus), PredModule = pred_info_module(!.PredInfo), PredSymName = qualified(PredModule, PredName), PFSymNameArity = pf_sym_name_arity(PredOrFunc, PredSymName, PredFormArity), ( IsClassMethod = is_a_class_method, unspecified_det_for_method(PFSymNameArity, Context, !Specs) ; IsClassMethod = is_not_a_class_method, IsExported = pred_status_is_exported(PredStatus), ( IsExported = yes, unspecified_det_for_exported(PFSymNameArity, Context, !Specs) ; IsExported = no, unspecified_det_for_local(PFSymNameArity, Context, !Specs) ) ) ; MaybeDetism = yes(_), DetismDecl = detism_decl_explicit ), pred_info_get_cur_user_decl_info(!.PredInfo, MaybeCurUserDecl), ( MaybeCurUserDecl = yes(CurUserDecl), CurUserDecl = cur_user_decl_info(PredDeclSection, PredIsPredMode, _PredDeclSeqNum), ( if PartOfPredmode = not_part_of_predmode, ItemMercuryStatus = item_defined_in_this_module(ItemExport) then ModeDeclSection = item_decl_section(ItemExport), ( if PredDeclSection = ModeDeclSection then true else ModeSectionStr = decl_section_to_string(ModeDeclSection), PredSectionStr = decl_section_to_string(PredDeclSection), PFSNA1 = pf_sym_name_arity(PredOrFunc, unqualified(PredName), PredFormArity), SectionPieces = [words("Error: mode declaration in the"), fixed(ModeSectionStr), words("section for"), unqual_pf_sym_name_pred_form_arity(PFSNA1), suffix(","), words("whose"), p_or_f(PredOrFunc), words("declaration"), words("is in the"), fixed(PredSectionStr), suffix("."), nl], SectionSpec = simplest_spec($pred, severity_error, phase_parse_tree_to_hlds, Context, SectionPieces), !:Specs = [SectionSpec | !.Specs] ), ( PredIsPredMode = no_predmode_decl ; PredIsPredMode = predmode_decl, user_arity_pred_form_arity(PredOrFunc, UserArity, PredFormArity), PFNameArity = pred_pf_name_arity(PredOrFunc, unqualified(PredName), UserArity), PredModeSpec = report_mode_decl_after_predmode(PFNameArity, Context), !:Specs = [PredModeSpec | !.Specs] ) else true ) ; MaybeCurUserDecl = no % We allow mode declarations for predicates (and functions) that have % no item_pred_decl. If the right options are given, the argument types % will be inferred. ), % Add the mode declaration to the pred_info for this procedure. ArgLives = no, % Before the simplification pass, HasParallelConj is not meaningful. HasParallelConj = has_no_parallel_conj, add_new_proc(ModuleInfo, Context, SeqNum, InstVarSet, Modes, yes(Modes), ArgLives, DetismDecl, MaybeDetism, address_is_not_taken, HasParallelConj, !PredInfo, ProcId). :- func decl_section_to_string(decl_section) = string. decl_section_to_string(decl_interface) = "interface". decl_section_to_string(decl_implementation) = "implementation". report_mode_decl_after_predmode(PFNameArity, Context) = Spec :- PFNameArity = pred_pf_name_arity(PredOrFunc, _SymName, _UserArity), Pieces = [words("Error:"), unqual_pf_sym_name_user_arity(PFNameArity), words("has its"), p_or_f(PredOrFunc), words("declaration"), words("combined with a mode declaration,"), words("so it may not have a separate mode declaration."), nl], Spec = simplest_spec($pred, severity_error, phase_parse_tree_to_hlds, Context, Pieces). %---------------------------------------------------------------------------% :- pred unspecified_det_for_method(pf_sym_name_arity::in, prog_context::in, list(error_spec)::in, list(error_spec)::out) is det. unspecified_det_for_method(PFSymNameArity, Context, !Specs) :- Pieces = [words("Error: no determinism declaration"), words("for type class method"), qual_pf_sym_name_pred_form_arity(PFSymNameArity), suffix("."), nl], Spec = simplest_spec($pred, severity_error, phase_parse_tree_to_hlds, Context, Pieces), !:Specs = [Spec | !.Specs]. :- pred unspecified_det_for_exported(pf_sym_name_arity::in, prog_context::in, list(error_spec)::in, list(error_spec)::out) is det. unspecified_det_for_exported(PFSymNameArity, Context, !Specs) :- Pieces = [words("Error: no determinism declaration for exported"), unqual_pf_sym_name_pred_form_arity(PFSymNameArity), suffix("."), nl], Spec = simplest_spec($pred, severity_error, phase_parse_tree_to_hlds, Context, Pieces), !:Specs = [Spec | !.Specs]. :- pred unspecified_det_for_local(pf_sym_name_arity::in, prog_context::in, list(error_spec)::in, list(error_spec)::out) is det. unspecified_det_for_local(PFSymNameArity, Context, !Specs) :- MainPieces = [words("Error: no determinism declaration for local"), unqual_pf_sym_name_pred_form_arity(PFSymNameArity), suffix("."), nl], VerbosePieces = [words("(This is an error because"), words("you specified the"), quote("--no-infer-det"), words("option."), words("Use the"), quote("--infer-det"), words("option if you want the compiler"), words("to automatically infer the determinism"), words("of local predicates.)"), nl], Msg = simple_msg(Context, [always(MainPieces), verbose_only(verbose_once, VerbosePieces)]), Spec = conditional_spec($pred, infer_det, no, severity_error, phase_parse_tree_to_hlds, [Msg]), !:Specs = [Spec | !.Specs]. %---------------------------------------------------------------------------% add_implicit_pred_decl_report_error(PredOrFunc, PredModuleName, PredName, PredFormArity, Status, IsClassMethod, Context, PredOrigin, DescPieces, PredId, !ModuleInfo, !Specs) :- PredSymName = qualified(PredModuleName, PredName), maybe_report_undefined_pred_error(!.ModuleInfo, PredOrFunc, PredSymName, PredFormArity, Status, IsClassMethod, Context, DescPieces, !Specs), ( PredOrFunc = pf_function, user_arity_pred_form_arity(pf_function, UserArity, PredFormArity), maybe_check_field_access_function(!.ModuleInfo, PredSymName, UserArity, Status, Context, !Specs) ; PredOrFunc = pf_predicate ), clauses_info_init(PredOrFunc, cit_no_types(PredFormArity), init_clause_item_numbers_user, ClausesInfo), GoalType = goal_not_for_promise(np_goal_type_none), add_implicit_pred_decl(PredOrFunc, PredModuleName, PredName, PredFormArity, Status, Context, PredOrigin, GoalType, ClausesInfo, PredId, !ModuleInfo). add_implicit_pred_decl(PredOrFunc, PredModuleName, PredName, PredFormArity, PredStatus, Context, PredOrigin, GoalType, ClausesInfo, PredId, !ModuleInfo) :- MaybeCurUserDecl = maybe.no, init_markers(Markers0), varset.init(TVarSet0), PredFormArity = pred_form_arity(PredFormArityInt), make_n_fresh_vars("T", PredFormArityInt, TypeVars, TVarSet0, TVarSet), prog_type.var_list_to_type_list(map.init, TypeVars, Types), % We assume none of the arguments are existentially typed. % Existential types must be declared, they won't be inferred. ExistQVars = [], % The class context is empty since this is an implicit definition. % Inference will fill it in. Constraints = constraints([], []), map.init(Proofs), map.init(ConstraintMap), map.init(VarNameRemap), pred_info_init(PredOrFunc, PredModuleName, PredName, PredFormArity, Context, PredOrigin, PredStatus, MaybeCurUserDecl, GoalType, Markers0, Types, TVarSet, ExistQVars, Constraints, Proofs, ConstraintMap, ClausesInfo, VarNameRemap, PredInfo0), add_marker(marker_infer_type, Markers0, Markers1), add_marker(marker_no_pred_decl, Markers1, Markers), pred_info_set_markers(Markers, PredInfo0, PredInfo), module_info_get_predicate_table(!.ModuleInfo, PredicateTable0), predicate_table_lookup_pf_m_n_a(PredicateTable0, is_fully_qualified, PredOrFunc, PredModuleName, PredName, PredFormArity, PredIds), ( PredIds = [], module_info_get_partial_qualifier_info(!.ModuleInfo, MQInfo), predicate_table_insert_qual(PredInfo, may_be_unqualified, MQInfo, PredId, PredicateTable0, PredicateTable), module_info_set_predicate_table(PredicateTable, !ModuleInfo) ; PredIds = [_ | _], ( if PredOrigin = origin_user(user_made_assertion(_, _, _)) then % We add promises to the HLDS *after* we add all user predicate % declarations. PredSymName = qualified(PredModuleName, PredName), NameString = sym_name_to_string(PredSymName), string.format("%s %s %s (%s).\n", [s("Attempted to introduce a predicate for a promise"), s("with a name that is identical to the name of"), s("an existing predicate"), s(NameString)], UnexpectedMsg), unexpected($pred, UnexpectedMsg) else unexpected($pred, "search succeeded") ) ). %---------------------------------------------------------------------------% check_preds_if_field_access_function(_ModuleInfo, [], !Specs). check_preds_if_field_access_function(ModuleInfo, [SecList | SecLists], !Specs) :- SecList = sec_sub_list(SectionInfo, ItemPredSecls), SectionInfo = sec_info(ItemMercuryStatus, _NeedQual), item_mercury_status_to_pred_status(ItemMercuryStatus, PredStatus), list.foldl(check_pred_if_field_access_function(ModuleInfo, PredStatus), ItemPredSecls, !Specs), check_preds_if_field_access_function(ModuleInfo, SecLists, !Specs). :- pred check_pred_if_field_access_function(module_info::in, pred_status::in, item_pred_decl_info::in, list(error_spec)::in, list(error_spec)::out) is det. check_pred_if_field_access_function(ModuleInfo, PredStatus, ItemPredDecl, !Specs) :- ItemPredDecl = item_pred_decl_info(SymName, PredOrFunc, TypesAndModes, _, _, _, _, _, _, _, _, _, Context, _SeqNum), ( PredOrFunc = pf_predicate ; PredOrFunc = pf_function, PredFormArity = arg_list_arity(TypesAndModes), user_arity_pred_form_arity(pf_function, UserArity, PredFormArity), maybe_check_field_access_function(ModuleInfo, SymName, UserArity, PredStatus, Context, !Specs) ). :- pred maybe_check_field_access_function(module_info::in, sym_name::in, user_arity::in, pred_status::in, prog_context::in, list(error_spec)::in, list(error_spec)::out) is det. maybe_check_field_access_function(ModuleInfo, FuncSymName, UserArity, FuncStatus, Context, !Specs) :- UserArity = user_arity(UserArityInt), ( if % XXX ARITY Make this take UserArity, not UserArityInt. is_field_access_function_name(ModuleInfo, FuncSymName, UserArityInt, AccessType, FieldName) then check_field_access_function(ModuleInfo, AccessType, FieldName, FuncSymName, UserArity, FuncStatus, Context, !Specs) else true ). :- pred check_field_access_function(module_info::in, field_access_type::in, sym_name::in, sym_name::in, user_arity::in, pred_status::in, prog_context::in, list(error_spec)::in, list(error_spec)::out) is det. check_field_access_function(ModuleInfo, _AccessType, FieldName, FuncSymName, UserArity, FuncStatus, Context, !Specs) :- % Check that a function applied to an exported type is also exported. module_info_get_ctor_field_table(ModuleInfo, CtorFieldTable), ( if % Abstract types have status `abstract_exported', so errors won't be % reported for local field access functions for them. map.search(CtorFieldTable, FieldName, [FieldDefn]), FieldDefn = hlds_ctor_field_defn(_, DefnStatus, _, _, _), DefnStatus = type_status(status_exported), FuncStatus \= pred_status(status_exported) then % XXX Our caller adjusted the arity one way; we now adjust it back. % It should be possible to do without the double adjustment. user_arity_pred_form_arity(pf_function, UserArity, PredFormArity), PFSymNameArity = pf_sym_name_arity(pf_function, FuncSymName, PredFormArity), report_field_status_mismatch(Context, PFSymNameArity, !Specs) else true ). :- pred report_field_status_mismatch(prog_context::in, pf_sym_name_arity::in, list(error_spec)::in, list(error_spec)::out) is det. report_field_status_mismatch(Context, PFSymNameArity, !Specs) :- Pieces = [words("In declaration of"), unqual_pf_sym_name_pred_form_arity(PFSymNameArity), suffix(":"), nl, words("error: a field access function for an exported field"), words("must also be exported."), nl], Spec = simplest_spec($pred, severity_error, phase_parse_tree_to_hlds, Context, Pieces), !:Specs = [Spec | !.Specs]. %---------------------------------------------------------------------------% :- end_module hlds.add_pred. %---------------------------------------------------------------------------%