mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-17 18:33:58 +00:00
Code Issues Projects Releases Wiki Activity
Files
083d376e6598628362ee91c2da170febd83590f4
mercury/compiler/add_solver.m
Zoltan Somogyi af196031ea Move pred_origin towards a structured pred_name. 
compiler/hlds_pred.m:
    Add a long comment about using pred_origin as a structured pred name.

    Delete the origin_created pred_origin with origin_deforestation,
    which was one of two ways that the compiler could create new predicates
    that weren't derived from one existing predicate, procedure, or other
    single Mercury construct. (Deforestation picks a conjunction of two
    or more goals, and created a new predicate out of *them*.)
    Replace the other, created_by_io_tabling, with a pred_transformation,
    since in that case, the new predicate *is* derived from a single
    existing predicate.

    Add a mechanism for recording the predicates created by the distance
    granularity transformation, which previously was recorded in the predicate
    name, but not in the pred_origin.

    Deleted the dnf predicate transform, since it hasn't been used
    since the Aditi backend was deleted in 2006.

    Include the pred_or_func distinction, and the original user arity,
    in the pred_origin of user defined predicates and functions.

    Include in most other pred transformations the parameters that are
    now recorded in the corresponding transform_name used in pred_name.m,
    with the exception of the pred_or_func distinction, since it is now
    available by following the chain of transforms to the base pred_origin,
    which should include that info.

    Use a type_ctor, not its components, in a pred origin.

    Shorten the too-long names of some function symbols.

compiler/distance_granularity.m:
    Record the transform done by this module.

    Use state variables where appropriate.

    Use more consistent variable names.

    Eliminate excessive indentation in the example transformation
    in the module introduction comment.

compiler/loop_inv.m:
    Fix a bug. The sequence number field of the transform_name
    was being filled with something other than a sequence number,
    which could be the same for two transformations. (Or at least,
    I have seen no convincing argument for why they couldn't be.
    If such an argument existed, the sequence number field would
    not be needed, so the old code would still have been wrong,
    just for a different reason :-)

    Rename a predicate to avoid ambiguity.

compiler/hlds_module.m:
    Add the per-context counter needed by the new code in loop_inv.m.

compiler/pd_info.m:
    The predicate that defines a new predicate always specifies
    the transform_name as tn_deforestation, so don't leave it up
    to the caller to specify the pred_origin of the new predicate;
    instead, construct it here as a deforestation transform of the
    base predicate. That is the origin argument that our one caller
    always specified anyway.

compiler/purity.m:
    Use a full switch over pred_origins, not a partial one,
    to make a decision.

compiler/accumulator.m:
compiler/add_clause.m:
compiler/add_foreign_proc.m:
compiler/add_pragma_tabling.m:
compiler/add_pragma_type_spec.m:
compiler/add_pred.m:
compiler/add_solver.m:
compiler/deforest.m:
compiler/dep_par_conj.m:
compiler/higher_order.m:
compiler/hlds_defns.m:
compiler/hlds_out_pred.m:
compiler/hlds_out_util.m:
compiler/inlining.m:
compiler/layout_out.m:
compiler/lco.m:
compiler/mode_errors.m:
compiler/par_loop_control.m:
compiler/polymorphism.m:
compiler/prog_item.m:
compiler/ssdebug.m:
compiler/table_gen.m:
compiler/trace_params.m:
compiler/tupling.m:
compiler/untupling.m:
compiler/unused_args.m:
compiler/xml_documentation.m:
    Conform to the changes above.
2022-07-20 01:05:34 +10:00

343 lines
12 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1993-2009, 2011 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.
%-----------------------------------------------------------------------------%
:- module hlds.make_hlds.add_solver.
:- interface.
:- import_module libs.
:- import_module libs.globals.
:- import_module mdbcomp.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_item.
:- import_module list.
%-----------------------------------------------------------------------------%
:- type solver_aux_pred_info
---> solver_aux_pred_info(
sym_name,
list(type_param),
tvarset,
solver_type_details,
prog_context
).
% A solver type t defined with
%
% :- solver type st
% where representation is rt, % type
% ground is gi, % inst
% any is ai, ... % inst
%
% requires the following auxiliary predicates:
%
% :- impure func 'representation of ground st'(st::in) =
% (rt::out(gi)) is det.
% :- impure func 'representation of any st'(st::in(any)) =
% (rt::out(ai)) is det.
%
% :- impure func 'representation to ground st'(rt::in(gi)) =
% (st::out) is det.
% :- impure func 'representation to any st'(rt::in(ai)) =
% (st::out(any)) is det.
%
% Declare these auxiliary predicates. We need the declarations available
% whether the solver type is defined in this module or not.
%
:- pred get_solver_type_aux_pred_decls(solver_aux_pred_info::in,
list(item_pred_decl_info)::out) is det.
% Define the auxiliary predicates declared above. It is the caller's
% resposibility to call this predicate only if the solver type is defined
% in this module, since we don't want them to be doubly defined
% both in this module and in the module that defines the solver type.
%
:- pred get_solver_type_aux_pred_defns(compilation_target::in,
solver_aux_pred_info::in, list(item_foreign_proc)::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.prog_data_foreign.
:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_type.
:- import_module map.
:- import_module maybe.
:- import_module string.
:- import_module varset.
%-----------------------------------------------------------------------------%
get_solver_type_aux_pred_decls(SolverAuxPredInfo, PredDecls) :-
SolverAuxPredInfo = solver_aux_pred_info(TypeSymName, TypeParams,
TVarSet, SolverTypeDetails, Context),
% XXX kind inference:
% We set the kinds to `star'. This will be different when we have
% a kind system.
prog_type.var_list_to_type_list(map.init, TypeParams, Args),
SolverType = defined_type(TypeSymName, Args, kind_star),
list.length(TypeParams, TypeArity),
TypeCtor = type_ctor(TypeSymName, TypeArity),
RepnType = SolverTypeDetails ^ std_representation_type,
AnyInst = SolverTypeDetails ^ std_any_inst,
GndInst = SolverTypeDetails ^ std_ground_inst,
InAnyMode = in_mode(AnyInst),
InGndMode = in_mode(GndInst),
OutAnyMode = out_mode(AnyInst),
OutGndMode = out_mode(GndInst),
NoWithType = maybe.no,
NoWithInst = maybe.no,
DetismDet = yes(detism_det),
InstVarSet = varset.init,
ExistQTVars = [],
NoConstraints = constraints([], []),
% The `:- impure
% func 'representation of ground st'(st::in(gi)) =
% (rt::out) is det' declaration.
%
ToGndRepnSymName = solver_to_ground_repn_symname(TypeCtor),
ToGndRepnArgTypesModes =
[type_and_mode(SolverType, in_mode),
type_and_mode(RepnType, OutGndMode)],
ToGndAttrs = item_compiler_attributes(
compiler_origin_solver_repn(TypeCtor, solver_type_to_ground_pred)),
ToGndMaybeAttrs = item_origin_compiler(ToGndAttrs),
ToGndPredDecl = item_pred_decl_info(ToGndRepnSymName, pf_function,
ToGndRepnArgTypesModes, NoWithType, NoWithInst, DetismDet,
ToGndMaybeAttrs, TVarSet, InstVarSet, ExistQTVars, purity_impure,
NoConstraints, Context, item_no_seq_num),
% The `:- impure
% func 'representation of any st'(st::in(ai)) =
% (rt::out(any)) is det' declaration.
%
ToAnyRepnSymName = solver_to_any_repn_symname(TypeCtor),
ToAnyRepnArgTypesModes =
[type_and_mode(SolverType, in_any_mode),
type_and_mode(RepnType, OutAnyMode)],
ToAnyAttrs = item_compiler_attributes(
compiler_origin_solver_repn(TypeCtor, solver_type_to_any_pred)),
ToAnyMaybeAttrs = item_origin_compiler(ToAnyAttrs),
ToAnyPredDecl = item_pred_decl_info(ToAnyRepnSymName, pf_function,
ToAnyRepnArgTypesModes, NoWithType, NoWithInst, DetismDet,
ToAnyMaybeAttrs, TVarSet, InstVarSet, ExistQTVars, purity_impure,
NoConstraints, Context, item_no_seq_num),
% The `:- impure
% func 'representation to ground st'(rt::in(gi)) =
% (st::out) is det' declaration.
%
FromGndRepnSymName = repn_to_ground_solver_symname(TypeCtor),
FromGndRepnArgTypesModes =
[type_and_mode(RepnType, InGndMode),
type_and_mode(SolverType, out_mode)],
FromGndAttrs = item_compiler_attributes(
compiler_origin_solver_repn(TypeCtor, solver_type_from_ground_pred)),
FromGndMaybeAttrs = item_origin_compiler(FromGndAttrs),
FromGndPredDecl = item_pred_decl_info(FromGndRepnSymName, pf_function,
FromGndRepnArgTypesModes, NoWithType, NoWithInst, DetismDet,
FromGndMaybeAttrs, TVarSet, InstVarSet, ExistQTVars, purity_impure,
NoConstraints, Context, item_no_seq_num),
% The `:- impure
% func 'representation to any st'(rt::in(ai)) =
% (st::out(any)) is det' declaration.
%
FromAnyRepnSymName = repn_to_any_solver_symname(TypeCtor),
FromAnyRepnArgTypesModes =
[type_and_mode(RepnType, InAnyMode),
type_and_mode(SolverType, out_any_mode)],
FromAnyAttrs = item_compiler_attributes(
compiler_origin_solver_repn(TypeCtor, solver_type_from_any_pred)),
FromAnyOrigin = item_origin_compiler(FromAnyAttrs),
FromAnyPredDecl = item_pred_decl_info(FromAnyRepnSymName, pf_function,
FromAnyRepnArgTypesModes, NoWithType, NoWithInst, DetismDet,
FromAnyOrigin, TVarSet, InstVarSet, ExistQTVars, purity_impure,
NoConstraints, Context, item_no_seq_num),
PredDecls =
[ToGndPredDecl, ToAnyPredDecl, FromGndPredDecl, FromAnyPredDecl].
%-----------------------------------------------------------------------------%
get_solver_type_aux_pred_defns(Target, SolverAuxPredInfo,
PragmaForeignProcs) :-
SolverAuxPredInfo = solver_aux_pred_info(TypeSymName, TypeParams,
_TVarSet, SolverTypeDetails, Context),
list.length(TypeParams, TypeArity),
TypeCtor = type_ctor(TypeSymName, TypeArity),
AnyInst = SolverTypeDetails ^ std_any_inst,
GroundInst = SolverTypeDetails ^ std_ground_inst,
InAnyMode = in_mode(AnyInst),
InGroundMode = in_mode(GroundInst),
OutAnyMode = out_mode(AnyInst),
OutGroundMode = out_mode(GroundInst),
ProgVarSet0 = varset.init,
varset.new_var(X, ProgVarSet0, ProgVarSet1),
varset.new_var(Y, ProgVarSet1, ProgVarSet),
InstVarSet = varset.init,
(
Target = target_c,
Lang = lang_c
;
Target = target_csharp,
Lang = lang_csharp
;
Target = target_java,
Lang = lang_java
),
Attrs0 = default_attributes(Lang),
some [!Attrs] (
!:Attrs = Attrs0,
set_may_call_mercury(proc_will_not_call_mercury, !Attrs),
set_thread_safe(proc_thread_safe, !Attrs),
set_terminates(proc_terminates, !Attrs),
set_may_modify_trail(proc_will_not_modify_trail, !Attrs),
Attrs = !.Attrs
),
Impl = fp_impl_ordinary("Y = X;", yes(Context)),
% The `func(in) = out(<i_ground>) is det' mode.
%
ToGroundRepnSymName = solver_to_ground_repn_symname(TypeCtor),
XTGPragmaVar = pragma_var(X, "X", in_mode, bp_native_if_possible),
YTGPragmaVar = pragma_var(Y, "Y", OutGroundMode, bp_native_if_possible),
ToGroundRepnArgs = [XTGPragmaVar, YTGPragmaVar],
ToGroundRepnFPInfo = pragma_info_foreign_proc(
Attrs,
ToGroundRepnSymName,
pf_function,
ToGroundRepnArgs,
ProgVarSet,
InstVarSet,
Impl
),
PragmaToGroundRepnFPInfo =
item_pragma_info(ToGroundRepnFPInfo, Context, item_no_seq_num),
% The `func(in(any)) = out(<i_any>) is det' mode.
%
ToAnyRepnSymName = solver_to_any_repn_symname(TypeCtor),
XTAPragmaVar = pragma_var(X, "X", in_any_mode, bp_native_if_possible),
YTAPragmaVar = pragma_var(Y, "Y", OutAnyMode, bp_native_if_possible),
ToAnyRepnArgs = [XTAPragmaVar, YTAPragmaVar],
ToAnyRepnFPInfo = pragma_info_foreign_proc(
Attrs,
ToAnyRepnSymName,
pf_function,
ToAnyRepnArgs,
ProgVarSet,
InstVarSet,
Impl
),
PragmaToAnyRepnFPInfo =
item_pragma_info(ToAnyRepnFPInfo, Context, item_no_seq_num),
% The `func(in(<i_ground>)) = out is det' mode.
%
FromGroundRepnSymName = repn_to_ground_solver_symname(TypeCtor),
XFGPragmaVar = pragma_var(X, "X", InGroundMode, bp_native_if_possible),
YFGPragmaVar = pragma_var(Y, "Y", out_mode, bp_native_if_possible),
FromGroundRepnArgs = [XFGPragmaVar, YFGPragmaVar],
FromGroundRepnFPInfo = pragma_info_foreign_proc(
Attrs,
FromGroundRepnSymName,
pf_function,
FromGroundRepnArgs,
ProgVarSet,
InstVarSet,
Impl
),
PragmaFromGroundRepnFPInfo =
item_pragma_info(FromGroundRepnFPInfo, Context, item_no_seq_num),
% The `func(in(<i_any>)) = out(any) is det' mode.
%
FromAnyRepnSymName = repn_to_any_solver_symname(TypeCtor),
XFAPragmaVar = pragma_var(X, "X", InAnyMode, bp_native_if_possible),
YFAPragmaVar = pragma_var(Y, "Y", out_any_mode, bp_native_if_possible),
FromAnyRepnArgs = [XFAPragmaVar, YFAPragmaVar],
FromAnyRepnFPInfo = pragma_info_foreign_proc(
Attrs,
FromAnyRepnSymName,
pf_function,
FromAnyRepnArgs,
ProgVarSet,
InstVarSet,
Impl
),
PragmaFromAnyRepnFPInfo =
item_pragma_info(FromAnyRepnFPInfo, Context, item_no_seq_num),
PragmaForeignProcs =
[PragmaToGroundRepnFPInfo,
PragmaToAnyRepnFPInfo,
PragmaFromGroundRepnFPInfo,
PragmaFromAnyRepnFPInfo].
%-----------------------------------------------------------------------------%
% Obtain the solver type conversion function sym_names from
% the solver type sym_name.
%
:- func solver_to_ground_repn_symname(type_ctor) = sym_name.
solver_to_ground_repn_symname(TypeCtor) =
solver_conversion_fn_symname("representation of ground ", TypeCtor).
:- func solver_to_any_repn_symname(type_ctor) = sym_name.
solver_to_any_repn_symname(TypeCtor) =
solver_conversion_fn_symname("representation of any ", TypeCtor).
:- func repn_to_ground_solver_symname(type_ctor) = sym_name.
repn_to_ground_solver_symname(TypeCtor) =
solver_conversion_fn_symname("representation to ground ", TypeCtor).
:- func repn_to_any_solver_symname(type_ctor) = sym_name.
repn_to_any_solver_symname(TypeCtor) =
solver_conversion_fn_symname("representation to any ", TypeCtor).
:- func solver_conversion_fn_symname(string, type_ctor) = sym_name.
solver_conversion_fn_symname(Prefix, TypeCtor) = SymName :-
TypeCtor = type_ctor(TypeCtorSymName, TypeCtorArity),
(
TypeCtorSymName = unqualified(TypeCtorName),
Name = Prefix ++ TypeCtorName ++ "/" ++ int_to_string(TypeCtorArity),
SymName = unqualified(Name)
;
TypeCtorSymName = qualified(ModuleName, TypeCtorName),
Name = Prefix ++ TypeCtorName ++ "/" ++ int_to_string(TypeCtorArity),
SymName = qualified(ModuleName, Name)
).
%-----------------------------------------------------------------------------%
:- end_module hlds.make_hlds.add_solver.
%-----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink