Files
mercury/compiler/unify_proc.m
Zoltan Somogyi bc97676d98 Change the definition of is_builtin to use less space.
Estimated hours taken: 2

hlds_goal:
	Change the definition of is_builtin to use less space.

bytecode_gen, code_aux, code_gen, code_util, dependency_graph, follow_code,
higher_order, inlining, live_vars, make_hlds, modecheck_unify, modes,
polymorphism, stratify, unused_args:
	Fixes to accommodate the change to is_builtin.
1996-12-24 02:42:21 +00:00

1394 lines
45 KiB
Mathematica

%-----------------------------------------------------------------------------%
% Copyright (C) 1995 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.
%-----------------------------------------------------------------------------%
%
% unify_proc.m:
%
% This module encapsulates access to the unify_requests table,
% and constructs the clauses for out-of-line complicated
% unification procedures.
% It also generates the code for other compiler-generated type-specific
% predicates such as compare/3.
%
% During mode analysis, we notice each different complicated unification
% that occurs. For each one we add a new mode to the out-of-line
% unification predicate for that type, and we record in the `unify_requests'
% table that we need to eventually modecheck that mode of the unification
% procedure.
%
% After we've done mode analysis for all the ordinary predicates, we then
% do mode analysis for the out-of-line unification procedures. Note that
% unification procedures may call other unification procedures which have
% not yet been encountered, causing new entries to be added to the
% unify_requests table. We store the entries in a queue and continue the
% process until the queue is empty.
%
% Currently if the same complicated unification procedure is called by
% different modules, each module will end up with a copy of the code for
% that procedure. In the long run it would be desireable to either delay
% generation of complicated unification procedures until link time (like
% Cfront does with C++ templates) or to have a smart linker which could
% merge duplicate definitions (like Borland C++). However the amount of
% code duplication involved is probably very small, so it's definitely not
% worth worrying about right now.
% XXX What about complicated unification of an abstract type in a partially
% instantiated mode? Currently we don't implement it correctly. Probably
% it should be disallowed, but we should issue a proper error message.
%-----------------------------------------------------------------------------%
:- module unify_proc.
:- interface.
:- import_module hlds_module, hlds_pred, hlds_goal, hlds_data.
:- import_module llds, modes, prog_data, special_pred.
:- import_module bool, std_util, io, list.
:- type unify_requests.
:- type unify_proc_id == pair(type_id, uni_mode).
% Initialize the unify_requests table.
:- pred unify_proc__init_requests(unify_requests).
:- mode unify_proc__init_requests(out) is det.
% Add a new request to the unify_requests table.
:- pred unify_proc__request_unify(unify_proc_id, determinism,
module_info, module_info).
:- mode unify_proc__request_unify(in, in, in, out) is det.
% Modecheck the unification procedures which have been
% requested. If the first argument is `unique_mode_check',
% then also go on and do full determinism analysis and unique mode
% checking on them as well.
:- pred modecheck_unify_procs(how_to_check_goal, module_info, module_info,
io__state, io__state).
:- mode modecheck_unify_procs(in, in, out, di, uo) is det.
% Given the type and mode of a unification, look up the
% mode number for the unification proc.
:- pred unify_proc__lookup_mode_num(module_info, type_id, uni_mode,
determinism, proc_id).
:- mode unify_proc__lookup_mode_num(in, in, in, in, out) is det.
% Generate the clauses for one of the compiler-generated
% special predicates (compare/3, index/3, unify, etc.)
:- pred unify_proc__generate_clause_info(special_pred_id, type,
hlds__type_body, module_info, clauses_info).
:- mode unify_proc__generate_clause_info(in, in, in, in, out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module tree, map, queue, int, string, require.
:- import_module code_util, code_info, type_util, varset.
:- import_module mercury_to_mercury, hlds_out.
:- import_module make_hlds, term, prog_util.
:- import_module quantification, clause_to_proc.
:- import_module globals, options, mode_util.
:- import_module switch_detection, cse_detection, det_analysis, unique_modes.
% We keep track of all the complicated unification procs we need
% by storing them in the unify_requests structure.
% For each unify_proc_id (i.e. type & mode), we store the proc_id
% (mode number) of the unification procedure which corresponds to
% that mode.
:- type req_map == map(unify_proc_id, proc_id).
:- type req_queue == queue(unify_proc_id).
:- type unify_requests --->
unify_requests(
req_map, % the assignment of numbers
% to unify_proc_ids
req_queue % queue of procs we still need
% to generate code for
).
%-----------------------------------------------------------------------------%
unify_proc__init_requests(Requests) :-
map__init(ReqMap),
queue__init(ReqQueue),
Requests = unify_requests(ReqMap, ReqQueue).
%-----------------------------------------------------------------------------%
% Boring access predicates
:- pred unify_proc__get_req_map(unify_requests, req_map).
:- mode unify_proc__get_req_map(in, out) is det.
:- pred unify_proc__get_req_queue(unify_requests, req_queue).
:- mode unify_proc__get_req_queue(in, out) is det.
:- pred unify_proc__set_req_map(unify_requests, req_map, unify_requests).
:- mode unify_proc__set_req_map(in, in, out) is det.
:- pred unify_proc__set_req_queue(unify_requests, req_queue, unify_requests).
:- mode unify_proc__set_req_queue(in, in, out) is det.
unify_proc__get_req_map(unify_requests(ReqMap, _), ReqMap).
unify_proc__get_req_queue(unify_requests(_, ReqQueue), ReqQueue).
unify_proc__set_req_map(unify_requests(_, B), ReqMap,
unify_requests(ReqMap, B)).
unify_proc__set_req_queue(unify_requests(A, _), ReqQueue,
unify_requests(A, ReqQueue)).
%-----------------------------------------------------------------------------%
unify_proc__lookup_mode_num(ModuleInfo, TypeId, UniMode, Det, Num) :-
( unify_proc__search_mode_num(ModuleInfo, TypeId, UniMode, Det, Num1) ->
Num = Num1
;
error("unify_proc.m: unify_proc__search_num failed")
).
:- pred unify_proc__search_mode_num(module_info, type_id, uni_mode, determinism,
proc_id).
:- mode unify_proc__search_mode_num(in, in, in, in, out) is semidet.
% Given the type, mode, and determinism of a unification, look up the
% mode number for the unification proc.
% We handle semidet unifications with mode (in, in) specially - they
% are always mode zero. For unreachable unifications,
% we also use mode zero.
unify_proc__search_mode_num(ModuleInfo, TypeId, UniMode, Determinism, ProcId) :-
UniMode = (XInitial - YInitial -> _Final),
(
Determinism = semidet,
inst_is_ground(ModuleInfo, XInitial),
inst_is_ground(ModuleInfo, YInitial)
->
ProcId = 0
;
XInitial = not_reached
->
ProcId = 0
;
YInitial = not_reached
->
ProcId = 0
;
module_info_get_unify_requests(ModuleInfo, Requests),
unify_proc__get_req_map(Requests, ReqMap),
map__search(ReqMap, TypeId - UniMode, ProcId)
).
%-----------------------------------------------------------------------------%
unify_proc__request_unify(UnifyId, Determinism, ModuleInfo0, ModuleInfo) :-
%
% check if this unification has already been requested
%
UnifyId = TypeId - UnifyMode,
(
unify_proc__search_mode_num(ModuleInfo0, TypeId, UnifyMode,
Determinism, _)
->
ModuleInfo = ModuleInfo0
;
%
% lookup the pred_id for the unification procedure
% that we are going to generate
%
module_info_get_special_pred_map(ModuleInfo0, SpecialPredMap),
map__lookup(SpecialPredMap, unify - TypeId, PredId),
%
% create a new proc_info for this procedure
%
module_info_preds(ModuleInfo0, Preds0),
map__lookup(Preds0, PredId, PredInfo0),
Arity = 2,
% convert from `uni_mode' to `list(mode)'
UnifyMode = ((X_Initial - Y_Initial) -> (X_Final - Y_Final)),
ArgModes = [(X_Initial -> X_Final), (Y_Initial -> Y_Final)],
MaybeDet = yes(Determinism),
term__context_init(Context),
ArgLives = no, % XXX ArgLives should be part of the UnifyId
add_new_proc(PredInfo0, Arity, ArgModes, ArgLives, MaybeDet,
Context, PredInfo1, ProcId),
%
% copy the clauses for the procedure from the pred_info to the
% proc_info, and mark the procedure as one that cannot
% be processed yet
%
pred_info_procedures(PredInfo1, Procs1),
pred_info_clauses_info(PredInfo1, ClausesInfo),
map__lookup(Procs1, ProcId, ProcInfo0),
proc_info_set_can_process(ProcInfo0, no, ProcInfo1),
copy_clauses_to_proc(ProcId, ClausesInfo, ProcInfo1, ProcInfo2),
map__set(Procs1, ProcId, ProcInfo2, Procs2),
pred_info_set_procedures(PredInfo1, Procs2, PredInfo2),
map__set(Preds0, PredId, PredInfo2, Preds2),
module_info_set_preds(ModuleInfo0, Preds2, ModuleInfo2),
%
% save the proc_id for this unify_proc_id,
% and insert the unify_proc_id into the request queue
%
module_info_get_unify_requests(ModuleInfo2, Requests0),
unify_proc__get_req_map(Requests0, ReqMap0),
map__set(ReqMap0, UnifyId, ProcId, ReqMap),
unify_proc__set_req_map(Requests0, ReqMap, Requests1),
unify_proc__get_req_queue(Requests1, ReqQueue1),
queue__put(ReqQueue1, UnifyId, ReqQueue),
unify_proc__set_req_queue(Requests1, ReqQueue, Requests),
module_info_set_unify_requests(ModuleInfo2, Requests,
ModuleInfo)
).
%-----------------------------------------------------------------------------%
% XXX these belong in modes.m
modecheck_unify_procs(HowToCheckGoal, ModuleInfo0, ModuleInfo) -->
{ module_info_get_unify_requests(ModuleInfo0, Requests0) },
{ unify_proc__get_req_queue(Requests0, RequestQueue0) },
(
{ queue__get(RequestQueue0, UnifyProcId, RequestQueue1) }
->
{ unify_proc__set_req_queue(Requests0, RequestQueue1,
Requests1) },
{ module_info_set_unify_requests(ModuleInfo0, Requests1,
ModuleInfo1) },
globals__io_lookup_bool_option(very_verbose, VeryVerbose),
( { VeryVerbose = yes } ->
{ UnifyProcId = TypeId - UniMode },
( { HowToCheckGoal = check_unique_modes } ->
io__write_string(
"% Mode-checking, determinism-checking, and unique-mode-checking\n% ")
;
io__write_string("% Mode-checking ")
),
io__write_string("unification proc for type `"),
hlds_out__write_type_id(TypeId),
io__write_string("'\n"),
io__write_string("% with insts `"),
{ UniMode = ((InstA - InstB) -> _FinalInst) },
{ varset__init(InstVarSet) },
mercury_output_inst(InstA, InstVarSet),
io__write_string("', `"),
mercury_output_inst(InstB, InstVarSet),
io__write_string("'\n")
;
[]
),
modecheck_unification_proc(HowToCheckGoal, UnifyProcId,
ModuleInfo1, ModuleInfo2),
modecheck_unify_procs(HowToCheckGoal, ModuleInfo2, ModuleInfo)
;
{ ModuleInfo = ModuleInfo0 }
).
:- pred modecheck_unification_proc(how_to_check_goal, unify_proc_id,
module_info, module_info, io__state, io__state).
:- mode modecheck_unification_proc(in, in, in, out, di, uo) is det.
modecheck_unification_proc(HowToCheckGoal, UnifyProcId,
ModuleInfo0, ModuleInfo) -->
{
%
% lookup the pred_id for the unification procedure
% that we are going to generate
%
UnifyProcId = TypeId - _UnifyMode,
module_info_get_special_pred_map(ModuleInfo0, SpecialPredMap),
map__lookup(SpecialPredMap, unify - TypeId, PredId),
%
% lookup the proc_id
%
module_info_get_unify_requests(ModuleInfo0, Requests0),
unify_proc__get_req_map(Requests0, ReqMap),
map__lookup(ReqMap, UnifyProcId, ProcId),
%
% mark the procedure as ready to be processed
%
module_info_preds(ModuleInfo0, Preds0),
map__lookup(Preds0, PredId, PredInfo0),
pred_info_procedures(PredInfo0, Procs0),
map__lookup(Procs0, ProcId, ProcInfo0),
proc_info_set_can_process(ProcInfo0, yes, ProcInfo1),
map__set(Procs0, ProcId, ProcInfo1, Procs1),
pred_info_set_procedures(PredInfo0, Procs1, PredInfo1),
map__set(Preds0, PredId, PredInfo1, Preds1),
module_info_set_preds(ModuleInfo0, Preds1, ModuleInfo1)
},
%
% modecheck the procedure
%
modecheck_proc(ProcId, PredId, ModuleInfo1, ModuleInfo2, NumErrors),
{ NumErrors \= 0 ->
error("mode error in compiler-generated unification predicate")
;
true
},
( { HowToCheckGoal = check_unique_modes } ->
{ detect_switches_in_proc(ProcId, PredId,
ModuleInfo2, ModuleInfo3) },
detect_cse_in_proc(ProcId, PredId,
ModuleInfo3, ModuleInfo4),
determinism_check_proc(ProcId, PredId,
ModuleInfo4, ModuleInfo5),
unique_modes__check_proc(ProcId, PredId,
ModuleInfo5, ModuleInfo)
;
{ ModuleInfo = ModuleInfo2 }
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
unify_proc__generate_clause_info(SpecialPredId, Type, TypeBody, ModuleInfo,
ClauseInfo) :-
unify_proc__info_init(ModuleInfo, VarTypeInfo0),
( TypeBody = eqv_type(EqvType) ->
HeadVarType = EqvType
;
HeadVarType = Type
),
special_pred_info(SpecialPredId, HeadVarType,
_PredName, ArgTypes, _Modes, _Det),
unify_proc__make_fresh_vars_from_types(ArgTypes, Args,
VarTypeInfo0, VarTypeInfo1),
( SpecialPredId = unify, Args = [H1, H2] ->
unify_proc__generate_unify_clauses(TypeBody, H1, H2,
Clauses, VarTypeInfo1, VarTypeInfo)
; SpecialPredId = index, Args = [X, Index] ->
unify_proc__generate_index_clauses(TypeBody, X, Index,
Clauses, VarTypeInfo1, VarTypeInfo)
; SpecialPredId = compare, Args = [Res, X, Y] ->
unify_proc__generate_compare_clauses(TypeBody, Res, X, Y,
Clauses, VarTypeInfo1, VarTypeInfo)
; SpecialPredId = term_to_type, Args = [Term, X] ->
unify_proc__generate_term_to_type_clauses(TypeBody, Term, X,
Clauses, VarTypeInfo1, VarTypeInfo)
; SpecialPredId = type_to_term, Args = [X, Term] ->
unify_proc__generate_type_to_term_clauses(TypeBody, X, Term,
Clauses, VarTypeInfo1, VarTypeInfo)
;
error("unknown special pred")
),
unify_proc__info_extract(VarTypeInfo, VarSet, Types),
ClauseInfo = clauses_info(VarSet, Types, Types, Args, Clauses).
:- pred unify_proc__generate_unify_clauses(hlds__type_body, var, var,
list(clause), unify_proc_info, unify_proc_info).
:- mode unify_proc__generate_unify_clauses(in, in, in, out, in, out) is det.
unify_proc__generate_unify_clauses(TypeBody, H1, H2, Clauses) -->
( { TypeBody = du_type(Ctors, _, IsEnum), IsEnum = no } ->
unify_proc__generate_du_unify_clauses(Ctors, H1, H2, Clauses)
;
{ term__context_init(Context) },
{ create_atomic_unification(H1, var(H2), Context, explicit, [],
Goal) },
unify_proc__info_get_varset(Varset0),
unify_proc__info_get_types(Types0),
{ implicitly_quantify_clause_body([H1, H2], Goal,
Varset0, Types0, Body, Varset, Types, _Warnings) },
unify_proc__info_set_varset(Varset),
unify_proc__info_set_types(Types),
{ Clauses = [clause([], Body, Context)] }
).
:- pred unify_proc__generate_index_clauses(hlds__type_body, var, var,
list(clause), unify_proc_info, unify_proc_info).
:- mode unify_proc__generate_index_clauses(in, in, in, out, in, out) is det.
unify_proc__generate_index_clauses(TypeBody, X, Index, Clauses) -->
( { TypeBody = du_type(Ctors, _, IsEnum), IsEnum = no } ->
unify_proc__generate_du_index_clauses(Ctors, X, Index, 0,
Clauses)
;
{ ArgVars = [X, Index] },
unify_proc__build_call("index", ArgVars, Goal),
unify_proc__info_get_varset(Varset0),
unify_proc__info_get_types(Types0),
{ implicitly_quantify_clause_body(ArgVars, Goal,
Varset0, Types0, Body, Varset, Types, _Warnings) },
unify_proc__info_set_varset(Varset),
unify_proc__info_set_types(Types),
{ term__context_init(Context) },
{ Clauses = [clause([], Body, Context)] }
).
:- pred unify_proc__generate_compare_clauses(hlds__type_body, var, var, var,
list(clause), unify_proc_info, unify_proc_info).
:- mode unify_proc__generate_compare_clauses(in, in, in, in, out, in, out)
is det.
unify_proc__generate_compare_clauses(TypeBody, Res, H1, H2, Clauses) -->
( { TypeBody = du_type(Ctors, _, IsEnum), IsEnum = no } ->
unify_proc__generate_du_compare_clauses(Ctors, Res, H1, H2,
Clauses)
;
{ ArgVars = [Res, H1, H2] },
unify_proc__build_call("compare", ArgVars, Goal),
unify_proc__info_get_varset(Varset0),
unify_proc__info_get_types(Types0),
{ implicitly_quantify_clause_body(ArgVars, Goal,
Varset0, Types0, Body, Varset, Types, _Warnings) },
unify_proc__info_set_varset(Varset),
unify_proc__info_set_types(Types),
{ term__context_init(Context) },
{ Clauses = [clause([], Body, Context)] }
).
:- pred unify_proc__generate_term_to_type_clauses(hlds__type_body, var, var,
list(clause), unify_proc_info, unify_proc_info).
:- mode unify_proc__generate_term_to_type_clauses(in, in, in, out, in, out)
is det.
unify_proc__generate_term_to_type_clauses(TypeBody, Term, X, Clauses) -->
( {TypeBody = du_type(Ctors, _, IsEnum), IsEnum = no } ->
unify_proc__generate_du_term_to_type_clauses(Ctors, Term, X,
Clauses)
;
{ ArgVars = [Term, X] },
unify_proc__build_call("term_to_type", ArgVars, Goal),
unify_proc__info_get_varset(Varset0),
unify_proc__info_get_types(Types0),
{ implicitly_quantify_clause_body(ArgVars, Goal,
Varset0, Types0, Body, Varset, Types, _Warnings) },
unify_proc__info_set_varset(Varset),
unify_proc__info_set_types(Types),
{ term__context_init(Context) },
{ Clauses = [clause([], Body, Context)] }
).
:- pred unify_proc__generate_type_to_term_clauses(hlds__type_body, var, var,
list(clause), unify_proc_info, unify_proc_info).
:- mode unify_proc__generate_type_to_term_clauses(in, in, in, out, in, out)
is det.
unify_proc__generate_type_to_term_clauses(TypeBody, X, Term, Clauses) -->
( { TypeBody = du_type(Ctors, _, IsEnum), IsEnum = no } ->
unify_proc__generate_du_type_to_term_clauses(Ctors, X, Term,
Clauses)
;
{ ArgVars = [X, Term] },
unify_proc__build_call("type_to_term", ArgVars, Goal),
unify_proc__info_get_varset(Varset0),
unify_proc__info_get_types(Types0),
{ implicitly_quantify_clause_body(ArgVars, Goal,
Varset0, Types0, Body, Varset, Types, _Warnings) },
unify_proc__info_set_varset(Varset),
unify_proc__info_set_types(Types),
{ term__context_init(Context) },
{ Clauses = [clause([], Body, Context)] }
).
%-----------------------------------------------------------------------------%
/*
For a type such as
type t(X) ---> a ; b(int) ; c(X); d(int, X, t)
we want to generate code
eq(H1, H2) :-
(
H1 = a,
H2 = a
;
H1 = b(X1),
H2 = b(X2),
X1 = X2,
;
H1 = c(Y1),
H2 = c(Y2),
Y1 = Y2,
;
H1 = d(A1, B1, C1),
H2 = c(A2, B2, C2),
A1 = A2,
B1 = B2,
C1 = C2
).
*/
:- pred unify_proc__generate_du_unify_clauses(list(constructor), var, var,
list(clause), unify_proc_info, unify_proc_info).
:- mode unify_proc__generate_du_unify_clauses(in, in, in, out, in, out) is det.
unify_proc__generate_du_unify_clauses([], _H1, _H2, []) --> [].
unify_proc__generate_du_unify_clauses([Ctor | Ctors], H1, H2,
[Clause | Clauses]) -->
{ Ctor = FunctorName - ArgTypes },
{ list__length(ArgTypes, FunctorArity) },
{ FunctorConsId = cons(FunctorName, FunctorArity) },
{ term__context_init(Context) },
unify_proc__make_fresh_vars(ArgTypes, Vars1),
unify_proc__make_fresh_vars(ArgTypes, Vars2),
{ create_atomic_unification(
H1, functor(FunctorConsId, Vars1), Context, explicit, [],
UnifyH1_Goal) },
{ create_atomic_unification(
H2, functor(FunctorConsId, Vars2), Context, explicit, [],
UnifyH2_Goal) },
{ unify_proc__unify_var_lists(Vars1, Vars2, UnifyArgs_Goal) },
{ GoalList = [UnifyH1_Goal, UnifyH2_Goal | UnifyArgs_Goal] },
{ goal_info_init(GoalInfo) },
{ conj_list_to_goal(GoalList, GoalInfo, Goal) },
unify_proc__info_get_varset(Varset0),
unify_proc__info_get_types(Types0),
{ implicitly_quantify_clause_body([H1, H2], Goal,
Varset0, Types0, Body, Varset, Types, _Warnings) },
unify_proc__info_set_varset(Varset),
unify_proc__info_set_types(Types),
{ Clause = clause([], Body, Context) },
unify_proc__generate_du_unify_clauses(Ctors, H1, H2, Clauses).
%-----------------------------------------------------------------------------%
/*
For a type such as
:- type foo ---> f ; g(a, b, c) ; h(foo).
we want to generate code
index(X, Index) :-
(
X = f,
Index = 0
;
X = g(_, _, _),
Index = 1
;
X = h(_),
Index = 2
).
*/
:- pred unify_proc__generate_du_index_clauses(list(constructor), var, var, int,
list(clause), unify_proc_info, unify_proc_info).
:- mode unify_proc__generate_du_index_clauses(in, in, in, in, out, in, out)
is det.
unify_proc__generate_du_index_clauses([], _X, _Index, _N, []) --> [].
unify_proc__generate_du_index_clauses([Ctor | Ctors], X, Index, N,
[Clause | Clauses]) -->
{ Ctor = FunctorName - ArgTypes },
{ list__length(ArgTypes, FunctorArity) },
{ FunctorConsId = cons(FunctorName, FunctorArity) },
{ term__context_init(Context) },
unify_proc__make_fresh_vars(ArgTypes, ArgVars),
{ create_atomic_unification(
X, functor(FunctorConsId, ArgVars), Context, explicit, [],
UnifyX_Goal) },
{ create_atomic_unification(
Index, functor(int_const(N), []), Context, explicit, [],
UnifyIndex_Goal) },
{ GoalList = [UnifyX_Goal, UnifyIndex_Goal] },
{ goal_info_init(GoalInfo) },
{ conj_list_to_goal(GoalList, GoalInfo, Goal) },
unify_proc__info_get_varset(Varset0),
unify_proc__info_get_types(Types0),
{ implicitly_quantify_clause_body([X, Index], Goal,
Varset0, Types0, Body, Varset, Types, _Warnings) },
unify_proc__info_set_varset(Varset),
unify_proc__info_set_types(Types),
{ Clause = clause([], Body, Context) },
{ N1 is N + 1 },
unify_proc__generate_du_index_clauses(Ctors, X, Index, N1, Clauses).
%-----------------------------------------------------------------------------%
/* For a type such as
:- type foo ---> f ; g(a) ; h(b, foo).
we want to generate code
compare(Res, X, Y) :-
index(X, X_Index), % Call_X_Index
index(Y, Y_Index), % Call_Y_Index
( X_Index < Y_Index -> % Call_Less_Than
Res = (<) % Return_Less_Than
; X_Index > Y_Index -> % Call_Greater_Than
Res = (>) % Return_Greater_Than
;
% This disjunction is generated by
% unify_proc__generate_compare_cases, below.
(
X = f, Y = f,
R = (=)
;
X = g(X1), Y = g(Y1),
compare(R, X1, Y1)
;
X = h(X1, X2), Y = h(Y1, Y2),
( compare(R1, X1, Y1), R1 \= (=) ->
R = R1
;
compare(R, X2, Y2)
)
)
->
Res = R % Return_R
;
compare_error % Abort
).
*/
:- pred unify_proc__generate_du_compare_clauses(
list(constructor), var, var, var,
list(clause), unify_proc_info, unify_proc_info).
:- mode unify_proc__generate_du_compare_clauses(in, in, in, in, out, in, out)
is det.
unify_proc__generate_du_compare_clauses(Ctors, Res, X, Y, [Clause]) -->
( { Ctors = [SingleCtor] } ->
unify_proc__generate_compare_case(SingleCtor, Res, X, Y, Goal)
;
unify_proc__generate_du_compare_clauses_2(Ctors, Res, X, Y,
Goal)
),
{ ArgVars = [Res, X, Y] },
unify_proc__info_get_varset(Varset0),
unify_proc__info_get_types(Types0),
{ implicitly_quantify_clause_body(ArgVars, Goal,
Varset0, Types0, Body, Varset, Types, _Warnings) },
unify_proc__info_set_varset(Varset),
unify_proc__info_set_types(Types),
{ term__context_init(Context) },
{ Clause = clause([], Body, Context) }.
:- pred unify_proc__generate_du_compare_clauses_2(
list(constructor), var, var, var,
hlds__goal, unify_proc_info, unify_proc_info).
:- mode unify_proc__generate_du_compare_clauses_2(in, in, in, in, out, in, out)
is det.
unify_proc__generate_du_compare_clauses_2(Ctors, Res, X, Y, Goal) -->
{ term__context_init(Context) },
{ construct_type(unqualified("int") - 0, [], IntType) },
{ construct_type(qualified("mercury_builtin", "comparison_result") - 0,
[], ResType) },
unify_proc__info_new_var(IntType, X_Index),
unify_proc__info_new_var(IntType, Y_Index),
unify_proc__info_new_var(ResType, R),
{ goal_info_init(GoalInfo) },
unify_proc__build_call("index", [X, X_Index], Call_X_Index),
unify_proc__build_call("index", [Y, Y_Index], Call_Y_Index),
unify_proc__build_call("builtin_int_lt", [X_Index, Y_Index],
Call_Less_Than),
unify_proc__build_call("builtin_int_gt", [X_Index, Y_Index],
Call_Greater_Than),
{ create_atomic_unification(
Res, functor(cons(unqualified("<"), 0), []),
Context, explicit, [],
Return_Less_Than) },
{ create_atomic_unification(
Res, functor(cons(unqualified(">"), 0), []),
Context, explicit, [],
Return_Greater_Than) },
{ create_atomic_unification(Res, var(R), Context, explicit, [],
Return_R) },
unify_proc__generate_compare_cases(Ctors, R, X, Y, Cases),
{ map__init(Empty) },
{ CasesGoal = disj(Cases, Empty) - GoalInfo },
unify_proc__build_call("compare_error", [], Abort),
{ Goal = conj([
Call_X_Index,
Call_Y_Index,
if_then_else([], Call_Less_Than, Return_Less_Than,
if_then_else([], Call_Greater_Than, Return_Greater_Than,
if_then_else([], CasesGoal, Return_R, Abort, Empty
) - GoalInfo, Empty
) - GoalInfo, Empty
) - GoalInfo
]) - GoalInfo }.
/*
unify_proc__generate_compare_cases: for a type such as
:- type foo ---> f ; g(a) ; h(b, foo).
we want to generate code
(
X = f, % UnifyX_Goal
Y = f, % UnifyY_Goal
R = (=) % CompareArgs_Goal
;
X = g(X1),
Y = g(Y1),
compare(R, X1, Y1)
;
X = h(X1, X2),
Y = h(Y1, Y2),
( compare(R1, X1, Y1), R1 \= (=) ->
R = R1
;
compare(R, X2, Y2)
)
)
*/
:- pred unify_proc__generate_compare_cases(list(constructor), var, var, var,
list(hlds__goal), unify_proc_info, unify_proc_info).
:- mode unify_proc__generate_compare_cases(in, in, in, in, out, in, out) is det.
unify_proc__generate_compare_cases([], _R, _X, _Y, []) --> [].
unify_proc__generate_compare_cases([Ctor | Ctors], R, X, Y, [Case | Cases]) -->
unify_proc__generate_compare_case(Ctor, R, X, Y, Case),
unify_proc__generate_compare_cases(Ctors, R, X, Y, Cases).
:- pred unify_proc__generate_compare_case(constructor, var, var, var,
hlds__goal, unify_proc_info, unify_proc_info).
:- mode unify_proc__generate_compare_case(in, in, in, in, out, in, out) is det.
unify_proc__generate_compare_case(Ctor, R, X, Y, Case) -->
{ Ctor = FunctorName - ArgTypes },
{ list__length(ArgTypes, FunctorArity) },
{ FunctorConsId = cons(FunctorName, FunctorArity) },
{ term__context_init(Context) },
unify_proc__make_fresh_vars(ArgTypes, Vars1),
unify_proc__make_fresh_vars(ArgTypes, Vars2),
{ create_atomic_unification(
X, functor(FunctorConsId, Vars1), Context, explicit, [],
UnifyX_Goal) },
{ create_atomic_unification(
Y, functor(FunctorConsId, Vars2), Context, explicit, [],
UnifyY_Goal) },
unify_proc__compare_args(Vars1, Vars2, R, CompareArgs_Goal),
{ GoalList = [UnifyX_Goal, UnifyY_Goal, CompareArgs_Goal] },
{ goal_info_init(GoalInfo) },
{ conj_list_to_goal(GoalList, GoalInfo, Case) }.
/* unify_proc__compare_args: for a constructor such as
h(list(int), foo, string)
we want to generate code
(
compare(R1, X1, Y1), % Do_Comparison
R1 \= (=) % Check_Not_Equal
->
R = R1 % Return_R1
;
compare(R2, X2, Y2),
R2 \= (=)
->
R = R2
;
compare(R, X3, Y3) % Return_Comparison
)
For a constructor with no arguments, we want to generate code
R = (=) % Return_Equal
*/
:- pred unify_proc__compare_args(list(var), list(var), var, hlds__goal,
unify_proc_info, unify_proc_info).
:- mode unify_proc__compare_args(in, in, in, out, in, out) is det.
unify_proc__compare_args([], [], R, Return_Equal) -->
{ term__context_init(Context) },
{ create_atomic_unification(
R, functor(cons(unqualified("="), 0), []),
Context, explicit, [],
Return_Equal) }.
unify_proc__compare_args([X|Xs], [Y|Ys], R, Goal) -->
{ goal_info_init(GoalInfo) },
( { Xs = [], Ys = [] } ->
unify_proc__build_call("compare", [R, X, Y], Goal)
;
{ term__context_init(Context) },
{ construct_type(
qualified("mercury_builtin", "comparison_result") - 0,
[], ResType) },
unify_proc__info_new_var(ResType, R1),
unify_proc__build_call("compare", [R1, X, Y], Do_Comparison),
{ create_atomic_unification(
R1, functor(cons(unqualified("="), 0), []),
Context, explicit, [],
Check_Equal) },
{ Check_Not_Equal = not(Check_Equal) - GoalInfo },
{ create_atomic_unification(
R, var(R1), Context, explicit, [], Return_R1) },
{ Condition = conj([Do_Comparison, Check_Not_Equal])
- GoalInfo },
{ map__init(Empty) },
{ Goal = if_then_else([], Condition, Return_R1, ElseCase, Empty)
- GoalInfo},
unify_proc__compare_args(Xs, Ys, R, ElseCase)
).
unify_proc__compare_args([], [_|_], _, _) -->
{ error("unify_proc__compare_args: length mismatch") }.
unify_proc__compare_args([_|_], [], _, _) -->
{ error("unify_proc__compare_args: length mismatch") }.
/*
For a type such as
type tree(T1, T2) --->
empty
; tree(T1, T2, tree(T1, T2), tree(T1, T2))
we want to generate code
term_to_type(Term, X) :-
(
Term = term__functor(term__atom("empty"), [], _),
X = empty.
;
Term = term__functor(term__atom("tree"),
[KeyTerm, ValTerm, LTreeTerm, RTreeTerm], _),
term_to_type(KeyTerm, Key),
term_to_type(ValTerm, Val),
term_to_type(LTreeTerm, L),
term_to_type(RTreeTerm, R),
X = tree(Key, Val, L, R)
).
The complex unification of Term to term__functor is achieved
by atomic unifications. The code that achieves this is a
specialized inline version of unravel_unification from
make_hlds.m. The actual code generated for the above type is:
term_to_type(Term, X) :-
Term = term__functor(V1, V2, V3),
V1 = term__atom(V4),
(
V4 = "empty",
V2 = [],
X = empty
;
V4 = "tree",
V2 = [KeyTerm | V5],
V5 = [ValTerm | V6],
V6 = [LTreeTerm | V7],
V7 = [RTreeTerm | V8],
V8 = [],
term_to_type(KeyTerm, Key),
term_to_type(ValTerm, Val),
term_to_type(LTreeTerm, L),
term_to_type(RTreeTerm, R),
X = tree(Key, Val, L, R)
).
*/
:- pred unify_proc__generate_du_term_to_type_clauses(list(constructor),
var, var, list(clause), unify_proc_info, unify_proc_info).
:- mode unify_proc__generate_du_term_to_type_clauses(in, in, in, out, in, out)
is det.
unify_proc__generate_du_term_to_type_clauses([], _Term, _X, []) --> [].
unify_proc__generate_du_term_to_type_clauses([Ctor | Ctors], Term, X,
[Clause]) -->
{ term__context_init(Context) },
% Make V1, V2, V3, V4
unify_proc__info_new_var(ConstType, V1),
unify_proc__info_new_var(TermListType, V2),
unify_proc__info_new_var(ContextType, V3),
unify_proc__info_new_var(StringType, V4),
% Make Term = term__functor(V1, V2, V3)
{ create_atomic_unification(
Term,
functor(cons(unqualified("term__functor"), 3), [ V1, V2, V3 ]),
Context, explicit, [],
TermGoal) },
% Make V1 = term__atom(V4),
{ create_atomic_unification(
V1,
functor(cons(unqualified("term__atom"), 1), [ V4 ]),
Context, explicit, [],
AtomGoal) },
{ construct_type(qualified("mercury_builtin", "const") - 0,
[], ConstType) },
{ construct_type(qualified("mercury_builtin", "term") - 0,
[], TermType) },
{ construct_type(qualified("mercury_builtin", "list") - 1,
[TermType], TermListType) },
{ construct_type(qualified("mercury_builtin", "term__context") - 0,
[], ContextType) },
{ construct_type(unqualified("string") - 0, [], StringType) },
% Make disjunctions for the difference functors of the type
unify_proc__generate_du_term_to_type_disjunctions([Ctor | Ctors],
V2, V4, X,
ConstType, TermType, TermListType, ContextType, StringType,
ListDisjunctiveGoals),
% Combine goals into a clause
{ goal_info_init(GoalInfo) },
{ disj_list_to_goal(ListDisjunctiveGoals, GoalInfo, DisjunctiveGoal) },
{ conj_list_to_goal([TermGoal, AtomGoal, DisjunctiveGoal], GoalInfo,
Goal) },
unify_proc__info_get_varset(Varset0),
unify_proc__info_get_types(Types0),
{ implicitly_quantify_clause_body([Term, X], Goal,
Varset0, Types0, Body, Varset, Types, _Warnings) },
unify_proc__info_set_varset(Varset),
unify_proc__info_set_types(Types),
{ Clause = clause([], Body, Context) }.
:- pred unify_proc__generate_du_term_to_type_disjunctions(
list(constructor), var, var, var, term, term, term, term, term,
list(hlds__goal),
unify_proc_info, unify_proc_info).
:- mode unify_proc__generate_du_term_to_type_disjunctions(
in, in, in, in, in, in, in, in, in, out, in, out) is det.
unify_proc__generate_du_term_to_type_disjunctions([],_,_,_,_,_,_,_,_,[]) --> [].
unify_proc__generate_du_term_to_type_disjunctions([Ctor | Ctors], V2, V4, X,
ConstType, TermType, TermListType, ContextType, StringType,
[Goal | Goals]) -->
{ Ctor = FunctorName - ArgTypes },
{ list__length(ArgTypes, FunctorArity) },
{ unqualify_name(FunctorName, UnqualifiedFunctorName) },
{ FunctorAtom = cons(FunctorName, FunctorArity) },
{ FunctorString = string_const(UnqualifiedFunctorName) },
{ term__context_init(Context) },
% Make V4 = ...
{ create_atomic_unification(
V4,
functor(FunctorString, []),
Context, explicit, [],
FunctorGoal) },
% Make Key, Val, L, R
unify_proc__make_fresh_vars(ArgTypes, ArgVars),
% Make Vx = [...] and term_to_type(..., ...) recursive goals
unify_proc__generate_du_term_to_type_recursive(
ArgVars, V2, Context, TermType, TermListType,
TermGoals, Term_To_TypeGoals),
% Make X = ....
{ create_atomic_unification(
X,
functor(FunctorAtom, ArgVars),
Context, explicit, [],
XGoal) },
{ list__append(TermGoals, Term_To_TypeGoals, RecursiveGoals) },
{ goal_info_init(GoalInfo) },
{conj_list_to_goal([FunctorGoal,XGoal|RecursiveGoals], GoalInfo, Goal)},
unify_proc__generate_du_term_to_type_disjunctions(Ctors, V2, V4, X,
ConstType, TermType, TermListType, ContextType, StringType,
Goals).
:- pred unify_proc__generate_du_term_to_type_recursive(
list(var), var, term__context, type, type,
list(hlds__goal), list(hlds__goal), unify_proc_info, unify_proc_info).
:- mode unify_proc__generate_du_term_to_type_recursive(
in, in, in, in, in,
out, out, in, out) is det.
unify_proc__generate_du_term_to_type_recursive(
[], Var, Context, _TermType, _TermListType,
[ Goal ], []) -->
{ create_atomic_unification(
Var,
functor(cons(unqualified("[]"), 0), []),
Context, explicit, [],
Goal) }.
unify_proc__generate_du_term_to_type_recursive(
[ ArgVar | ArgVars ], Var, Context, TermType, TermListType,
[ TermGoal | TermGoals], [TermToTypeGoal | Term_To_TypeGoals ]) -->
unify_proc__info_new_var(TermType, TermVar),
unify_proc__info_new_var(TermListType, TermListVar),
{ create_atomic_unification(
Var,
functor(cons(unqualified("."), 2), [ TermVar, TermListVar ]),
Context, explicit, [],
TermGoal) },
unify_proc__build_call("term_to_type",[TermVar, ArgVar],TermToTypeGoal),
unify_proc__generate_du_term_to_type_recursive(
ArgVars, TermListVar, Context, TermType, TermListType,
TermGoals, Term_To_TypeGoals).
/*
For a type such as
type tree(T1, T2) --->
empty
; tree(T1, T2, tree(T1, T2), tree(T1, T2))
we want to generate code
type_to_term(X, Term) :-
(
X = empty,
term__context_init(Context),
Term = term__functor(term__atom("empty"), [], Context)
;
X = tree(Key, Val, L, R),
type_to_term(Key, KeyTerm),
type_to_term(Val, VeyTerm),
type_to_term(L, LTreeTerm),
type_to_term(R, RTreeTerm),
term__context_init(Context),
Term = term__functor(term__atom("tree"),
[KeyTerm, ValTerm, LTreeTerm, RTreeTerm], Context)
).
The complex unification of Term to term__functor is achieved
by atomic unifications. The code that achieves this is a
specialized inline version of unravel_unification from
make_hlds.m. The actual code generated for the above type is:
type_to_term(X, Term) :-
(
X = empty,
V1 = term__atom(V4),
V4 = "empty",
V2 = [],
term__context_init(V3),
Term = term__functor(V1, V2, V3)
;
X = tree(Key, Val, L, R),
type_to_term(Key, KeyTerm),
type_to_term(Val, ValTerm),
type_to_term(L, LTreeTerm),
type_to_term(R, RTreeTerm),
V2 = [KeyTerm | V5],
V5 = [ValTerm | V6],
V6 = [LTreeTerm | V7],
V7 = [RTreeTerm | V8],
V8 = [],
V1 = term__atom(V4),
V4 = "tree",
term__context_init(V3),
Term = term__functor(V1, V2, V3).
).
*/
:- pred unify_proc__generate_du_type_to_term_clauses(list(constructor),
var, var, list(clause), unify_proc_info, unify_proc_info).
:- mode unify_proc__generate_du_type_to_term_clauses(in, in, in, out, in, out)
is det.
unify_proc__generate_du_type_to_term_clauses([], _X, _Term, []) --> [].
unify_proc__generate_du_type_to_term_clauses([Ctor | Ctors], X, Term,
[Clause | Clauses]) -->
{ Ctor = FunctorName - ArgTypes },
{ unqualify_name(FunctorName, UnqualifiedFunctorName) },
{ list__length(ArgTypes, FunctorArity) },
{ FunctorAtom = cons(FunctorName, FunctorArity) },
{ FunctorString = string_const(UnqualifiedFunctorName) },
{ term__context_init(Context) },
{ construct_type(qualified("mercury_builtin", "const") - 0,
[], ConstType) },
{ construct_type(qualified("mercury_builtin", "term") - 0,
[], TermType) },
{ construct_type(qualified("mercury_builtin", "list") - 0,
[TermType], TermListType) },
{ construct_type(qualified("mercury_builtin", "term__context") - 0,
[], ContextType) },
{ construct_type(unqualified("string") - 0, [], StringType) },
% Make Key, Val, L, R
unify_proc__make_fresh_vars(ArgTypes, ArgVars),
% Make X = ....
{ create_atomic_unification(
X,
functor(FunctorAtom, ArgVars),
Context, explicit, [],
XGoal) },
% Make V2
unify_proc__info_new_var(TermListType, V2),
% Make type_to_term(..., ...) and Vx = [...] recursive goals
unify_proc__generate_du_type_to_term_recursive_clauses(
ArgVars, V2, Context, TermType, TermListType,
RecursiveGoals),
% Make V1, V4
unify_proc__info_new_var(ConstType, V1),
unify_proc__info_new_var(StringType, V4),
% Make V1 = term__atom(V4),
{ create_atomic_unification(
V1,
functor(cons(unqualified("term__atom"), 1), [ V4 ]),
Context, explicit, [],
AtomGoal) },
% Make V4 = ...
{ create_atomic_unification(
V4,
functor(FunctorString, []),
Context, explicit, [],
FunctorGoal) },
% Make V3
unify_proc__info_new_var(ContextType, V3),
% Make term__context(V3)
% unify_proc__build_call("term__context_init", [V3], ContextGoal),
% --- From here ---
unify_proc__info_new_var(StringType, ContextString),
{ construct_type(unqualified("int") - 0, [], IntType) },
unify_proc__info_new_var(IntType, ContextInt),
{ create_atomic_unification(
V3,
functor(cons(unqualified("term__context"), 2),
[ContextString,ContextInt]),
Context, explicit, [],
ContextGoal) },
{ create_atomic_unification(
ContextString,
functor(string_const(""), []),
Context, explicit, [],
ContextGoalString) },
{ create_atomic_unification(
ContextInt,
functor(int_const(0), []),
Context, explicit, [],
ContextGoalInt) },
% --- To here ---
% Make Term = term__functor(V1, V2, V3)
{ create_atomic_unification(
Term,
functor(cons(unqualified("term__functor"), 3), [ V1, V2, V3 ]),
Context, explicit, [],
TermGoal) },
% Combine goals into a clause
{ goal_info_init(GoalInfo) },
{ conj_list_to_goal(
[ XGoal, AtomGoal, FunctorGoal, ContextGoal, TermGoal,
ContextGoalString, ContextGoalInt
|RecursiveGoals],
GoalInfo,
Goal) },
unify_proc__info_get_varset(VarSet0),
unify_proc__info_get_types(Types0),
{ implicitly_quantify_clause_body([Term, X], Goal, VarSet0, Types0,
Body, VarSet, Types, _Warnings) },
unify_proc__info_set_varset(VarSet),
unify_proc__info_set_types(Types),
{ Clause = clause([], Body, Context) },
% Make clauses for other functors of type
unify_proc__generate_du_type_to_term_clauses(Ctors, X, Term, Clauses).
:- pred unify_proc__generate_du_type_to_term_recursive_clauses(
list(var), var, term__context, type, type,
list(hlds__goal), unify_proc_info, unify_proc_info).
:- mode unify_proc__generate_du_type_to_term_recursive_clauses(
in, in, in, in, in,
out, in, out) is det.
unify_proc__generate_du_type_to_term_recursive_clauses(
[], Var, Context, _TermType, _TermListType,
[ Goal ]) -->
{ create_atomic_unification(
Var,
functor(cons(unqualified("[]"), 0), []),
Context, explicit, [],
Goal) }.
unify_proc__generate_du_type_to_term_recursive_clauses(
[ ArgVar | ArgVars ], Var, Context, TermType, TermListType,
[ TypeToTermGoal, TermGoal | Goals ]) -->
unify_proc__info_new_var(TermType, TermVar),
unify_proc__info_new_var(TermListType, TermListVar),
unify_proc__build_call("type_to_term",[ArgVar, TermVar],TypeToTermGoal),
{ create_atomic_unification(
Var,
functor(cons(unqualified("."), 2), [ TermVar, TermListVar ]),
Context, explicit, [],
TermGoal) },
unify_proc__generate_du_type_to_term_recursive_clauses(
ArgVars, TermListVar, Context, TermType, TermListType, Goals).
%-----------------------------------------------------------------------------%
:- pred unify_proc__build_call(string, list(var), hlds__goal,
unify_proc_info, unify_proc_info).
:- mode unify_proc__build_call(in, in, out, in, out) is det.
unify_proc__build_call(Name, ArgVars, Goal) -->
unify_proc__info_get_module_info(ModuleInfo),
{ module_info_get_predicate_table(ModuleInfo, PredicateTable) },
{ list__length(ArgVars, Arity) },
{
predicate_table_search_pred_m_n_a(PredicateTable,
"mercury_builtin", Name, Arity, [PredId])
->
IndexPredId = PredId
;
string__append_list(["unify_proc__build_call: ",
"invalid/ambiguous pred `mercury_builtin:", Name, "'"],
ErrorMessage),
error(ErrorMessage)
},
{ ModeId = 0 },
% We cheat by not providing a context for the call.
% Since automatically generated procedures should not have errors,
% the absence of a context should not be a problem.
{ Call = call(IndexPredId, ModeId, ArgVars, not_builtin,
no, unqualified(Name)) },
{ goal_info_init(GoalInfo) },
{ Goal = Call - GoalInfo }.
%-----------------------------------------------------------------------------%
:- pred unify_proc__make_fresh_vars_from_types(list(type), list(var),
unify_proc_info, unify_proc_info).
:- mode unify_proc__make_fresh_vars_from_types(in, out, in, out) is det.
unify_proc__make_fresh_vars_from_types([], []) --> [].
unify_proc__make_fresh_vars_from_types([Type | Types], [Var | Vars]) -->
unify_proc__info_new_var(Type, Var),
unify_proc__make_fresh_vars_from_types(Types, Vars).
:- pred unify_proc__make_fresh_vars(list(constructor_arg), list(var),
unify_proc_info, unify_proc_info).
:- mode unify_proc__make_fresh_vars(in, out, in, out) is det.
unify_proc__make_fresh_vars([], []) --> [].
unify_proc__make_fresh_vars([_Name - Type | Args], [Var | Vars]) -->
unify_proc__info_new_var(Type, Var),
unify_proc__make_fresh_vars(Args, Vars).
:- pred unify_proc__unify_var_lists(list(var), list(var), list(hlds__goal)).
:- mode unify_proc__unify_var_lists(in, in, out) is det.
unify_proc__unify_var_lists([], [_|_], _) :-
error("unify_proc__unify_var_lists: length mismatch").
unify_proc__unify_var_lists([_|_], [], _) :-
error("unify_proc__unify_var_lists: length mismatch").
unify_proc__unify_var_lists([], [], []).
unify_proc__unify_var_lists([Var1 | Vars1], [Var2 | Vars2], [Goal | Goals]) :-
term__context_init(Context),
create_atomic_unification(Var1, var(Var2), Context, explicit, [],
Goal),
unify_proc__unify_var_lists(Vars1, Vars2, Goals).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% It's a pity that we don't have nested modules.
% :- begin_module unify_proc_info.
% :- interface.
:- type unify_proc_info.
:- pred unify_proc__info_init(module_info, unify_proc_info).
:- mode unify_proc__info_init(in, out) is det.
:- pred unify_proc__info_new_var(type, var, unify_proc_info, unify_proc_info).
:- mode unify_proc__info_new_var(in, out, in, out) is det.
:- pred unify_proc__info_extract(unify_proc_info, varset, map(var, type)).
:- mode unify_proc__info_extract(in, out, out) is det.
:- pred unify_proc__info_get_varset(varset, unify_proc_info, unify_proc_info).
:- mode unify_proc__info_get_varset(out, in, out) is det.
:- pred unify_proc__info_set_varset(varset, unify_proc_info, unify_proc_info).
:- mode unify_proc__info_set_varset(in, in, out) is det.
:- pred unify_proc__info_get_types(map(var, type), unify_proc_info, unify_proc_info).
:- mode unify_proc__info_get_types(out, in, out) is det.
:- pred unify_proc__info_set_types(map(var, type), unify_proc_info, unify_proc_info).
:- mode unify_proc__info_set_types(in, in, out) is det.
:- pred unify_proc__info_get_module_info(module_info,
unify_proc_info, unify_proc_info).
:- mode unify_proc__info_get_module_info(out, in, out) is det.
%-----------------------------------------------------------------------------%
% :- implementation
:- type unify_proc_info
---> unify_proc_info(
varset,
map(var, type),
module_info
).
unify_proc__info_init(ModuleInfo, VarTypeInfo) :-
varset__init(VarSet),
map__init(Types),
VarTypeInfo = unify_proc_info(VarSet, Types, ModuleInfo).
unify_proc__info_new_var(Type, Var,
unify_proc_info(VarSet0, Types0, ModuleInfo),
unify_proc_info(VarSet, Types, ModuleInfo)) :-
varset__new_var(VarSet0, Var, VarSet),
map__set(Types0, Var, Type, Types).
unify_proc__info_extract(unify_proc_info(VarSet, Types, _ModuleInfo),
VarSet, Types).
unify_proc__info_get_varset(VarSet, ProcInfo, ProcInfo) :-
ProcInfo = unify_proc_info(VarSet, _Types, _ModuleInfo).
unify_proc__info_set_varset(VarSet, unify_proc_info(_VarSet, Types, ModuleInfo),
unify_proc_info(VarSet, Types, ModuleInfo)).
unify_proc__info_get_types(Types, ProcInfo, ProcInfo) :-
ProcInfo = unify_proc_info(_VarSet, Types, _ModuleInfo).
unify_proc__info_set_types(Types, unify_proc_info(VarSet, _Types, ModuleInfo),
unify_proc_info(VarSet, Types, ModuleInfo)).
unify_proc__info_get_module_info(ModuleInfo, VarTypeInfo, VarTypeInfo) :-
VarTypeInfo = unify_proc_info(_VarSet, _Types, ModuleInfo).
% :- end_module unify_proc_info.
%-----------------------------------------------------------------------------%