[m-dev.] for review: polymorphic ground insts [3/3]
David Overton
dmo at ender.cs.mu.oz.au
Wed Feb 9 13:40:22 AEDT 2000
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.238
diff -u -r1.238 modes.m
--- compiler/modes.m 2000/01/26 02:04:26 1.238
+++ compiler/modes.m 2000/02/07 06:01:06
@@ -226,8 +226,8 @@
% inst.
%
:- pred modecheck_var_has_inst_list(list(prog_var), list(inst), int,
- mode_info, mode_info).
-:- mode modecheck_var_has_inst_list(in, in, in, mode_info_di, mode_info_uo)
+ inst_var_sub, mode_info, mode_info).
+:- mode modecheck_var_has_inst_list(in, in, in, out, mode_info_di, mode_info_uo)
is det.
:- pred modecheck_set_var_inst(prog_var, inst, mode_info, mode_info).
@@ -316,7 +316,7 @@
:- import_module make_hlds, hlds_data, unique_modes, mode_debug.
:- import_module mode_info, delay_info, mode_errors, inst_match, instmap.
-:- import_module type_util, mode_util, code_util, unify_proc.
+:- import_module type_util, mode_util, code_util, unify_proc, special_pred.
:- import_module globals, options, mercury_to_mercury, hlds_out, int, set.
:- import_module passes_aux, typecheck, module_qual, clause_to_proc.
:- import_module modecheck_unify, modecheck_call, inst_util, purity.
@@ -607,11 +607,27 @@
{ pred_info_procedures(PredInfo0, Procs0) },
{ map__keys(Procs0, ProcIds) },
( { WhatToCheck = check_modes } ->
- ( { ProcIds = [] } ->
+ (
+ { ProcIds = [] }
+ ->
maybe_report_error_no_modes(PredId, PredInfo0,
ModuleInfo0),
{ NumErrors0 = 0 }
;
+ { module_info_get_special_pred_map(ModuleInfo0,
+ SpecialPredMap) },
+ { map__member(SpecialPredMap, unify - _, PredId) }
+ ->
+ % Don't check for indistinguishable modes in unification
+ % predicates. The default (in, in) mode must be
+ % semidet, but for single-value types we also want to
+ % create a det mode which will be indistinguishable
+ % from the semidet mode.
+ % (When the type is known, the det mode is called,
+ % but the polymorphic unify needs to be able to call
+ % the semidet mode.)
+ { NumErrors0 = 0 }
+ ;
check_for_indistinguishable_modes(ProcIds, PredId,
PredInfo0, ModuleInfo0, 0, NumErrors0)
)
@@ -887,7 +903,7 @@
maybe_clobber_insts([], [], []).
maybe_clobber_insts([Inst0 | Insts0], [IsLive | IsLives], [Inst | Insts]) :-
( IsLive = dead ->
- Inst = ground(clobbered, no)
+ Inst = ground(clobbered, none)
;
Inst = Inst0
),
@@ -916,11 +932,14 @@
;
% XXX this might need to be reconsidered now
% we have unique modes
+ =(ModeInfo),
+ { mode_info_get_var_types(ModeInfo, VarTypes) },
+ { map__lookup(VarTypes, Var, Type) },
( { inst_matches_initial(VarInst, Inst,
- ModuleInfo) } ->
+ Type, ModuleInfo) } ->
{ Reason = too_instantiated }
; { inst_matches_initial(Inst, VarInst,
- ModuleInfo) } ->
+ Type, ModuleInfo) } ->
{ Reason = not_instantiated_enough }
;
% I don't think this can happen.
@@ -1794,29 +1813,48 @@
% Given a list of variables and a list of initial insts, ensure
% that the inst of each variable matches the corresponding initial
% inst.
+
+modecheck_var_has_inst_list(Vars, Insts, ArgNum, Subst) -->
+ { map__init(Subst0) },
+ modecheck_var_has_inst_list_2(Vars, Insts, ArgNum, Subst0, Subst).
+
+:- pred modecheck_var_has_inst_list_2(list(prog_var), list(inst), int,
+ inst_var_sub, inst_var_sub, mode_info, mode_info).
+:- mode modecheck_var_has_inst_list_2(in, in, in, in, out,
+ mode_info_di, mode_info_uo) is det.
-modecheck_var_has_inst_list([_|_], [], _) -->
+modecheck_var_has_inst_list_2([_|_], [], _, _, _) -->
{ error("modecheck_var_has_inst_list: length mismatch") }.
-modecheck_var_has_inst_list([], [_|_], _) -->
+modecheck_var_has_inst_list_2([], [_|_], _, _, _) -->
{ error("modecheck_var_has_inst_list: length mismatch") }.
-modecheck_var_has_inst_list([], [], _ArgNum) --> [].
-modecheck_var_has_inst_list([Var|Vars], [Inst|Insts], ArgNum0) -->
+modecheck_var_has_inst_list_2([], [], _ArgNum, Subst, Subst) --> [].
+modecheck_var_has_inst_list_2([Var|Vars], [Inst|Insts], ArgNum0, Subst0, Subst)
+ -->
{ ArgNum is ArgNum0 + 1 },
mode_info_set_call_arg_context(ArgNum),
- modecheck_var_has_inst(Var, Inst),
- modecheck_var_has_inst_list(Vars, Insts, ArgNum).
+ modecheck_var_has_inst(Var, Inst, Subst0, Subst1),
+ modecheck_var_has_inst_list_2(Vars, Insts, ArgNum, Subst1, Subst).
-:- pred modecheck_var_has_inst(prog_var, inst, mode_info, mode_info).
-:- mode modecheck_var_has_inst(in, in, mode_info_di, mode_info_uo) is det.
+:- pred modecheck_var_has_inst(prog_var, inst, inst_var_sub, inst_var_sub,
+ mode_info, mode_info).
+:- mode modecheck_var_has_inst(in, in, in, out, mode_info_di, mode_info_uo)
+ is det.
-modecheck_var_has_inst(VarId, Inst, ModeInfo0, ModeInfo) :-
+modecheck_var_has_inst(VarId, Inst, Subst0, Subst, ModeInfo0, ModeInfo) :-
mode_info_get_instmap(ModeInfo0, InstMap),
instmap__lookup_var(InstMap, VarId, VarInst),
+ mode_info_get_var_types(ModeInfo0, VarTypes),
+ map__lookup(VarTypes, VarId, Type),
- mode_info_get_module_info(ModeInfo0, ModuleInfo),
- ( inst_matches_initial(VarInst, Inst, ModuleInfo) ->
- ModeInfo = ModeInfo0
+ mode_info_get_module_info(ModeInfo0, ModuleInfo0),
+ (
+ inst_matches_initial(VarInst, Inst, Type, ModuleInfo0,
+ ModuleInfo, Subst0, Subst1)
+ ->
+ Subst = Subst1,
+ mode_info_set_module_info(ModeInfo0, ModuleInfo, ModeInfo)
;
+ Subst = Subst0,
set__singleton_set(WaitingVars, VarId),
mode_info_error(WaitingVars,
mode_error_var_has_inst(VarId, VarInst, Inst),
@@ -1916,7 +1954,9 @@
% If we haven't added any information and
% we haven't bound any part of the var, then
% the only thing we can have done is lose uniqueness.
- inst_matches_initial(Inst0, Inst, ModuleInfo)
+ mode_info_get_var_types(ModeInfo1, VarTypes),
+ map__lookup(VarTypes, Var0, Type),
+ inst_matches_initial(Inst0, Inst, Type, ModuleInfo)
->
instmap__set(InstMap0, Var0, Inst, InstMap),
mode_info_set_instmap(InstMap, ModeInfo1, ModeInfo3)
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.53
diff -u -r1.53 module_qual.m
--- compiler/module_qual.m 2000/01/13 04:29:40 1.53
+++ compiler/module_qual.m 2000/01/17 23:43:43
@@ -749,15 +749,20 @@
qualify_inst(bound(Uniq, BoundInsts0), bound(Uniq, BoundInsts),
Info0, Info) -->
qualify_bound_inst_list(BoundInsts0, BoundInsts, Info0, Info).
-qualify_inst(ground(Uniq, MaybePredInstInfo0), ground(Uniq, MaybePredInstInfo),
+qualify_inst(ground(Uniq, GroundInstInfo0), ground(Uniq, GroundInstInfo),
Info0, Info) -->
(
- { MaybePredInstInfo0 = yes(pred_inst_info(A, Modes0, Det)) },
+ { GroundInstInfo0 = higher_order(pred_inst_info(A, Modes0,
+ Det)) },
qualify_mode_list(Modes0, Modes, Info0, Info),
- { MaybePredInstInfo = yes(pred_inst_info(A, Modes, Det)) }
+ { GroundInstInfo = higher_order(pred_inst_info(A, Modes, Det)) }
;
- { MaybePredInstInfo0 = no },
- { MaybePredInstInfo = no },
+ { GroundInstInfo0 = constrained_inst_var(Var) },
+ { GroundInstInfo = constrained_inst_var(Var) },
+ { Info = Info0 }
+ ;
+ { GroundInstInfo0 = none },
+ { GroundInstInfo = none },
{ Info = Info0 }
).
qualify_inst(inst_var(Var), inst_var(Var), Info, Info) --> [].
Index: compiler/pd_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_info.m,v
retrieving revision 1.6
diff -u -r1.6 pd_info.m
--- compiler/pd_info.m 1999/10/15 03:45:00 1.6
+++ compiler/pd_info.m 2000/02/03 05:26:34
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 1998-1999 University of Melbourne.
+% Copyright (C) 1998-2000 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.
%-----------------------------------------------------------------------------%
@@ -680,7 +680,7 @@
goal_info_get_nonlocals(OldGoalInfo, OldNonLocals0),
set__to_sorted_list(OldNonLocals0, OldNonLocalsList),
pd_info__check_insts(ModuleInfo, OldNonLocalsList, OldNewRenaming,
- OldInstMap, NewInstMap, exact, Exact),
+ OldInstMap, NewInstMap, NewVarTypes, exact, Exact),
MaybeVersion = version(Exact, PredProcId, Version,
OldNewRenaming, TypeRenaming).
@@ -690,21 +690,25 @@
% Check that all the insts in the old version are at least as
% general as the insts in the new version.
:- pred pd_info__check_insts(module_info::in, list(prog_var)::in,
- map(prog_var, prog_var)::in, instmap::in, instmap::in,
- version_is_exact::in, version_is_exact::out) is semidet.
+ map(prog_var, prog_var)::in, instmap::in, instmap::in, vartypes::in,
+ version_is_exact::in, version_is_exact::out) is semidet.
-pd_info__check_insts(_, [], _, _, _, Exact, Exact).
+pd_info__check_insts(_, [], _, _, _, _, Exact, Exact).
pd_info__check_insts(ModuleInfo, [OldVar | Vars], VarRenaming, OldInstMap,
- NewInstMap, ExactSoFar0, ExactSoFar) :-
+ NewInstMap, VarTypes, ExactSoFar0, ExactSoFar) :-
instmap__lookup_var(OldInstMap, OldVar, OldVarInst),
map__lookup(VarRenaming, OldVar, NewVar),
instmap__lookup_var(NewInstMap, NewVar, NewVarInst),
- inst_matches_initial(NewVarInst, OldVarInst, ModuleInfo),
+ map__lookup(VarTypes, NewVar, Type),
+ inst_matches_initial(NewVarInst, OldVarInst, Type, ModuleInfo),
( ExactSoFar0 = exact ->
% Does inst_matches_initial(Inst1, Inst2, M) and
% inst_matches_initial(Inst2, Inst1, M) imply that Inst1
% and Inst2 are interchangable?
- ( inst_matches_initial(OldVarInst, NewVarInst, ModuleInfo) ->
+ (
+ inst_matches_initial(OldVarInst, NewVarInst, Type,
+ ModuleInfo)
+ ->
ExactSoFar1 = exact
;
ExactSoFar1 = more_general
@@ -713,7 +717,7 @@
ExactSoFar1 = more_general
),
pd_info__check_insts(ModuleInfo, Vars, VarRenaming, OldInstMap,
- NewInstMap, ExactSoFar1, ExactSoFar).
+ NewInstMap, VarTypes, ExactSoFar1, ExactSoFar).
%-----------------------------------------------------------------------------%
@@ -744,11 +748,12 @@
{ proc_info_vartypes(ProcInfo, VarTypes) },
{ proc_info_typeinfo_varmap(ProcInfo, TVarMap) },
{ proc_info_typeclass_info_varmap(ProcInfo, TCVarMap) },
+ { proc_info_inst_varset(ProcInfo, InstVarSet) },
% XXX handle the extra typeinfo arguments for
% --typeinfo-liveness properly.
{ hlds_pred__define_new_pred(Goal, CallGoal, Args, _ExtraArgs, InstMap,
Name, TVarSet, VarTypes, ClassContext, TVarMap, TCVarMap,
- VarSet, Markers, Owner, address_is_not_taken,
+ VarSet, InstVarSet, Markers, Owner, address_is_not_taken,
ModuleInfo0, ModuleInfo, PredProcId) },
pd_info_set_module_info(ModuleInfo).
Index: compiler/pd_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_util.m,v
retrieving revision 1.7
diff -u -r1.7 pd_util.m
--- compiler/pd_util.m 1999/10/15 03:45:01 1.7
+++ compiler/pd_util.m 2000/02/03 05:26:39
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 1998-1999 University of Melbourne.
+% Copyright (C) 1998-2000 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.
%-----------------------------------------------------------------------------%
@@ -157,8 +157,9 @@
pd_info_get_proc_info(ProcInfo0),
{ proc_info_varset(ProcInfo0, VarSet0) },
{ proc_info_vartypes(ProcInfo0, VarTypes0) },
+ { proc_info_inst_varset(ProcInfo0, InstVarSet0) },
{ simplify_info_init(DetInfo0, Simplifications, InstMap0,
- VarSet0, VarTypes0, SimplifyInfo0) },
+ VarSet0, VarTypes0, InstVarSet0, SimplifyInfo0) },
{ simplify__process_goal(Goal0, Goal, SimplifyInfo0, SimplifyInfo) },
@@ -677,8 +678,9 @@
pd_info_get_instmap(InstMap),
pd_info_get_proc_info(ProcInfo),
{ proc_info_vartypes(ProcInfo, VarTypes) },
- { recompute_instmap_delta(yes, Goal0, Goal, VarTypes, InstMap,
- ModuleInfo0, ModuleInfo) },
+ { proc_info_inst_varset(ProcInfo, InstVarSet) },
+ { recompute_instmap_delta(yes, Goal0, Goal, VarTypes, InstVarSet,
+ InstMap, ModuleInfo0, ModuleInfo) },
pd_info_set_module_info(ModuleInfo).
%-----------------------------------------------------------------------------%
@@ -795,7 +797,7 @@
Uniq = unique,
inst_is_unique(ModuleInfo, bound(unique, List))
),
- Inst = ground(Uniq, no)
+ Inst = ground(Uniq, none)
).
%-----------------------------------------------------------------------------%
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.181
diff -u -r1.181 polymorphism.m
--- compiler/polymorphism.m 2000/01/17 03:38:55 1.181
+++ compiler/polymorphism.m 2000/01/17 23:43:48
@@ -2300,8 +2300,8 @@
RLExprnId = no,
BaseUnification = construct(BaseVar, ConsId, [], [],
ReuseVar, cell_is_shared, RLExprnId),
- BaseUnifyMode = (free -> ground(shared, no)) -
- (ground(shared, no) -> ground(shared, no)),
+ BaseUnifyMode = (free -> ground(shared, none)) -
+ (ground(shared, none) -> ground(shared, none)),
BaseUnifyContext = unify_context(explicit, []),
% XXX the UnifyContext is wrong
BaseUnify = unify(BaseVar, BaseTypeClassInfoTerm, BaseUnifyMode,
@@ -2309,7 +2309,7 @@
% create a goal_info for the unification
set__list_to_set([BaseVar], NonLocals),
- instmap_delta_from_assoc_list([BaseVar - ground(shared, no)],
+ instmap_delta_from_assoc_list([BaseVar - ground(shared, none)],
InstmapDelta),
goal_info_init(NonLocals, InstmapDelta, det, BaseGoalInfo),
@@ -2328,14 +2328,14 @@
% create the construction unification to initialize the
% variable
- UniMode = (free - ground(shared, no) ->
- ground(shared, no) - ground(shared, no)),
+ UniMode = (free - ground(shared, none) ->
+ ground(shared, none) - ground(shared, none)),
list__length(NewArgVars, NumArgVars),
list__duplicate(NumArgVars, UniMode, UniModes),
Unification = construct(NewVar, NewConsId, NewArgVars,
UniModes, ReuseVar, cell_is_unique, RLExprnId),
- UnifyMode = (free -> ground(shared, no)) -
- (ground(shared, no) -> ground(shared, no)),
+ UnifyMode = (free -> ground(shared, none)) -
+ (ground(shared, none) -> ground(shared, none)),
UnifyContext = unify_context(explicit, []),
% XXX the UnifyContext is wrong
Unify = unify(NewVar, TypeClassInfoTerm, UnifyMode,
@@ -2345,7 +2345,7 @@
goal_info_init(GoalInfo0),
set__list_to_set([NewVar | NewArgVars], TheNonLocals),
goal_info_set_nonlocals(GoalInfo0, TheNonLocals, GoalInfo1),
- list__duplicate(NumArgVars, ground(shared, no), ArgInsts),
+ list__duplicate(NumArgVars, ground(shared, none), ArgInsts),
% note that we could perhaps be more accurate than
% `ground(shared)', but it shouldn't make any
% difference.
@@ -2735,16 +2735,16 @@
TypeInfoVar, VarSet, VarTypes),
% create the construction unification to initialize the variable
- UniMode = (free - ground(shared, no) ->
- ground(shared, no) - ground(shared, no)),
+ UniMode = (free - ground(shared, none) ->
+ ground(shared, none) - ground(shared, none)),
list__length(ArgVars, NumArgVars),
list__duplicate(NumArgVars, UniMode, UniModes),
ReuseVar = no,
RLExprnId = no,
Unification = construct(TypeInfoVar, ConsId, ArgVars, UniModes,
ReuseVar, cell_is_unique, RLExprnId),
- UnifyMode = (free -> ground(shared, no)) -
- (ground(shared, no) -> ground(shared, no)),
+ UnifyMode = (free -> ground(shared, none)) -
+ (ground(shared, none) -> ground(shared, none)),
UnifyContext = unify_context(explicit, []),
% XXX the UnifyContext is wrong
Unify = unify(TypeInfoVar, TypeInfoTerm, UnifyMode,
@@ -2752,7 +2752,7 @@
% create a goal_info for the unification
set__list_to_set([TypeInfoVar | ArgVars], NonLocals),
- list__duplicate(NumArgVars, ground(shared, no), ArgInsts),
+ list__duplicate(NumArgVars, ground(shared, none), ArgInsts),
% note that we could perhaps be more accurate than
% `ground(shared)', but it shouldn't make any
% difference.
@@ -2799,8 +2799,8 @@
RLExprnId = no,
Unification = construct(TypeCtorInfoVar, ConsId, [], [],
ReuseVar, cell_is_shared, RLExprnId),
- UnifyMode = (free -> ground(shared, no)) -
- (ground(shared, no) -> ground(shared, no)),
+ UnifyMode = (free -> ground(shared, none)) -
+ (ground(shared, none) -> ground(shared, none)),
UnifyContext = unify_context(explicit, []),
% XXX the UnifyContext is wrong
Unify = unify(TypeCtorInfoVar, TypeInfoTerm, UnifyMode,
@@ -2808,7 +2808,7 @@
% create a goal_info for the unification
set__list_to_set([TypeCtorInfoVar], NonLocals),
- instmap_delta_from_assoc_list([TypeCtorInfoVar - ground(shared, no)],
+ instmap_delta_from_assoc_list([TypeCtorInfoVar - ground(shared, none)],
InstmapDelta),
goal_info_init(NonLocals, InstmapDelta, det, GoalInfo),
@@ -2941,7 +2941,7 @@
% type_info argument even though its declaration is
% polymorphic.
set__list_to_set([TypeClassInfoVar, IndexVar, TypeInfoVar], NonLocals),
- instmap_delta_from_assoc_list([TypeInfoVar - ground(shared, no)],
+ instmap_delta_from_assoc_list([TypeInfoVar - ground(shared, none)],
InstmapDelta),
goal_info_init(NonLocals, InstmapDelta, det, GoalInfo),
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.18
diff -u -r1.18 post_typecheck.m
--- compiler/post_typecheck.m 2000/01/13 06:16:45 1.18
+++ compiler/post_typecheck.m 2000/01/17 23:43:49
@@ -417,7 +417,7 @@
in_mode(InMode),
aditi_builtin_modes(InMode, (aditi_top_down),
ArgTypes, DeleteArgModes),
- Inst = ground(shared, yes(pred_inst_info(PredOrFunc,
+ Inst = ground(shared, higher_order(pred_inst_info(PredOrFunc,
DeleteArgModes, semidet))),
Modes = [(Inst -> Inst), aditi_di_mode, aditi_uo_mode].
@@ -438,7 +438,7 @@
pred_info_arg_types(RelationPredInfo, ArgTypes),
out_mode(OutMode),
aditi_builtin_modes(OutMode, (aditi_bottom_up), ArgTypes, OpArgModes),
- Inst = ground(shared, yes(pred_inst_info(PredOrFunc,
+ Inst = ground(shared, higher_order(pred_inst_info(PredOrFunc,
OpArgModes, nondet))),
Modes = [(Inst -> Inst), aditi_di_mode, aditi_uo_mode].
@@ -478,8 +478,8 @@
aditi_builtin_modes(OutMode, (aditi_top_down),
ArgTypes, OutputArgModes),
list__append(InputArgModes, OutputArgModes, ModifyArgModes),
- Inst = ground(shared,
- yes(pred_inst_info(predicate, ModifyArgModes, semidet))),
+ Inst = ground(shared, higher_order(pred_inst_info(predicate,
+ ModifyArgModes, semidet))),
Modes = [(Inst -> Inst), aditi_di_mode, aditi_uo_mode].
% Use the type of the closure passed to an `aditi_delete',
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.52
diff -u -r1.52 prog_data.m
--- compiler/prog_data.m 2000/01/24 17:47:15 1.52
+++ compiler/prog_data.m 2000/02/03 03:44:26
@@ -698,7 +698,7 @@
; abstract_inst(sym_name, list(inst_param)).
% probably inst parameters should be variables not terms
-:- type inst_param == inst_term.
+:- type inst_param == inst_var.
% An `inst_name' is used as a key for the inst_table.
% It is either a user-defined inst `user_inst(Name, Args)',
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.186
diff -u -r1.186 prog_io.m
--- compiler/prog_io.m 2000/01/13 06:16:49 1.186
+++ compiler/prog_io.m 2000/02/03 00:28:17
@@ -1973,8 +1973,9 @@
process_pred_mode(ok(F, As0), PredMode, VarSet0, MaybeDet, Cond, Result) :-
(
- convert_mode_list(As0, As)
+ convert_mode_list(As0, As1)
->
+ list__map(constrain_inst_vars_in_mode, As1, As),
varset__coerce(VarSet0, VarSet),
Result = ok(pred_mode(VarSet, F, As, MaybeDet, Cond))
;
@@ -1990,9 +1991,11 @@
process_func_mode(ok(F, As0), FuncMode, RetMode0, VarSet0, MaybeDet, Cond,
Result) :-
(
- convert_mode_list(As0, As)
+ convert_mode_list(As0, As1)
->
- ( convert_mode(RetMode0, RetMode) ->
+ list__map(constrain_inst_vars_in_mode, As1, As),
+ ( convert_mode(RetMode0, RetMode1) ->
+ constrain_inst_vars_in_mode(RetMode1, RetMode),
varset__coerce(VarSet0, VarSet),
Result = ok(func_mode(VarSet, F, As, RetMode, MaybeDet,
Cond))
@@ -2010,6 +2013,63 @@
%-----------------------------------------------------------------------------%
+% Replace all occurrences of inst_var(I) with
+% ground(shared, constrained_inst_var(I)).
+
+:- pred constrain_inst_vars_in_mode(mode, mode).
+:- mode constrain_inst_vars_in_mode(in, out) is det.
+
+constrain_inst_vars_in_mode(I0 -> F0, I -> F) :-
+ constrain_inst_vars_in_inst(I0, I),
+ constrain_inst_vars_in_inst(F0, F).
+constrain_inst_vars_in_mode(user_defined_mode(Name, Args0),
+ user_defined_mode(Name, Args)) :-
+ list__map(constrain_inst_vars_in_inst, Args0, Args).
+
+:- pred constrain_inst_vars_in_inst(inst, inst).
+:- mode constrain_inst_vars_in_inst(in, out) is det.
+
+constrain_inst_vars_in_inst(any(U), any(U)).
+constrain_inst_vars_in_inst(free, free).
+constrain_inst_vars_in_inst(free(T), free(T)).
+constrain_inst_vars_in_inst(bound(U, BIs0), bound(U, BIs)) :-
+ list__map((pred(functor(C, Is0)::in, functor(C, Is)::out) is det :-
+ list__map(constrain_inst_vars_in_inst, Is0, Is)), BIs0, BIs).
+constrain_inst_vars_in_inst(ground(U, none), ground(U, none)).
+constrain_inst_vars_in_inst(ground(U, higher_order(PredInstInfo0)),
+ ground(U, higher_order(PredInstInfo))) :-
+ constrain_inst_vars_in_pred_inst_info(PredInstInfo0, PredInstInfo).
+constrain_inst_vars_in_inst(ground(U, constrained_inst_var(V)),
+ ground(U, constrained_inst_var(V))).
+constrain_inst_vars_in_inst(not_reached, not_reached).
+constrain_inst_vars_in_inst(inst_var(V),
+ ground(shared, constrained_inst_var(V))).
+constrain_inst_vars_in_inst(defined_inst(Name0), defined_inst(Name)) :-
+ constrain_inst_vars_in_inst_name(Name0, Name).
+constrain_inst_vars_in_inst(abstract_inst(N, Is0), abstract_inst(N, Is)) :-
+ list__map(constrain_inst_vars_in_inst, Is0, Is).
+
+:- pred constrain_inst_vars_in_pred_inst_info(pred_inst_info, pred_inst_info).
+:- mode constrain_inst_vars_in_pred_inst_info(in, out) is det.
+
+constrain_inst_vars_in_pred_inst_info(PII0, PII) :-
+ PII0 = pred_inst_info(PredOrFunc, Modes0, Det),
+ list__map(constrain_inst_vars_in_mode, Modes0, Modes),
+ PII = pred_inst_info(PredOrFunc, Modes, Det).
+
+:- pred constrain_inst_vars_in_inst_name(inst_name, inst_name).
+:- mode constrain_inst_vars_in_inst_name(in, out) is det.
+
+constrain_inst_vars_in_inst_name(Name0, Name) :-
+ ( Name0 = user_inst(SymName, Args0) ->
+ list__map(constrain_inst_vars_in_inst, Args0, Args),
+ Name = user_inst(SymName, Args)
+ ;
+ Name = Name0
+ ).
+
+%-----------------------------------------------------------------------------%
+
% Parse a `:- inst <InstDefn>.' declaration.
%
:- pred parse_inst_decl(module_name, varset, term, maybe1(item)).
@@ -2060,55 +2120,53 @@
:- mode convert_inst_defn_2(in, in, in, out) is det.
convert_inst_defn_2(error(M, T), _, _, error(M, T)).
-convert_inst_defn_2(ok(Name, Args), Head, Body, Result) :-
- % check that all the head args are variables
- ( %%% some [Arg]
- (
- list__member(Arg, Args),
- Arg \= term__variable(_)
- )
+convert_inst_defn_2(ok(Name, ArgTerms), Head, Body, Result) :-
+ (
+ % check that all the head args are variables
+ term__var_list_to_term_list(Args, ArgTerms)
->
- Result = error("inst parameters must be variables", Head)
- ;
- % check that all the head arg variables are distinct
- %%% some [Arg2, OtherArgs]
(
+ % check that all the head arg variables are distinct
list__member(Arg2, Args, [Arg2|OtherArgs]),
list__member(Arg2, OtherArgs)
- )
- ->
- Result = error("repeated inst parameters in LHS of inst defn",
+ ->
+ Result = error(
+ "repeated inst parameters in LHS of inst defn",
Head)
- ;
- % check that all the variables in the body occur in the head
- %%% some [Var2]
- (
+ ;
+ % check that all the variables in the body occur
+ % in the head
term__contains_var(Body, Var2),
- \+ term__contains_var_list(Args, Var2)
- )
- ->
- Result = error("free inst parameter in RHS of inst definition",
+ \+ list__member(Var2, Args)
+ ->
+ Result = error(
+ "free inst parameter in RHS of inst definition",
Body)
- ;
- % check that the inst is a valid user-defined inst, i.e. that
- % it does not have the form of one of the builtin insts
- \+ (
- convert_inst(Head, UserInst),
- UserInst = defined_inst(user_inst(_, _))
- )
- ->
- Result = error("attempt to redefine builtin inst", Head)
- ;
- % should improve the error message here
-
- ( %%% some [ConvertedBody]
- convert_inst(Body, ConvertedBody)
+ ;
+ % check that the inst is a valid user-defined
+ % inst, i.e. that it does not have the form of
+ % one of the builtin insts
+ \+ (
+ convert_inst(Head, UserInst),
+ UserInst = defined_inst(user_inst(_, _))
+ )
->
- list__map(term__coerce, Args, InstArgs),
- Result = ok(eqv_inst(Name, InstArgs, ConvertedBody))
+ Result = error("attempt to redefine builtin inst", Head)
;
- Result = error("syntax error in inst body", Body)
+ % should improve the error message here
+ (
+ convert_inst(Body, ConvertedBody)
+ ->
+ list__map(term__coerce_var, Args, InstArgs),
+ Result = ok(eqv_inst(Name, InstArgs,
+ ConvertedBody))
+ ;
+ Result = error("syntax error in inst body",
+ Body)
+ )
)
+ ;
+ Result = error("inst parameters must be variables", Head)
).
:- pred convert_abstract_inst_defn(module_name, term, maybe1(inst_defn)).
@@ -2121,29 +2179,25 @@
:- pred convert_abstract_inst_defn_2(maybe_functor, term, maybe1(inst_defn)).
:- mode convert_abstract_inst_defn_2(in, in, out) is det.
convert_abstract_inst_defn_2(error(M, T), _, error(M, T)).
-convert_abstract_inst_defn_2(ok(Name, Args), Head, Result) :-
- % check that all the head args are variables
- ( %%% some [Arg]
- (
- list__member(Arg, Args),
- Arg \= term__variable(_)
- )
+convert_abstract_inst_defn_2(ok(Name, ArgTerms), Head, Result) :-
+ (
+ % check that all the head args are variables
+ term__var_list_to_term_list(Args, ArgTerms)
->
- Result = error("inst parameters must be variables", Head)
- ;
- % check that all the head arg variables are distinct
- %%% some [Arg2, OtherArgs]
(
+ % check that all the head arg variables are distinct
list__member(Arg2, Args, [Arg2|OtherArgs]),
list__member(Arg2, OtherArgs)
- )
- ->
- Result = error(
+ ->
+ Result = error(
"repeated inst parameters in abstract inst definition",
Head)
+ ;
+ list__map(term__coerce_var, Args, InstArgs),
+ Result = ok(abstract_inst(Name, InstArgs))
+ )
;
- list__map(term__coerce, Args, InstArgs),
- Result = ok(abstract_inst(Name, InstArgs))
+ Result = error("inst parameters must be variables", Head)
).
:- pred make_inst_defn(varset, condition, inst_defn, item).
@@ -2188,48 +2242,46 @@
:- pred convert_mode_defn_2(maybe_functor, term, term, maybe1(mode_defn)).
:- mode convert_mode_defn_2(in, in, in, out) is det.
convert_mode_defn_2(error(M, T), _, _, error(M, T)).
-convert_mode_defn_2(ok(Name, Args), Head, Body, Result) :-
- % check that all the head args are variables
- ( %%% some [Arg]
- (
- list__member(Arg, Args),
- Arg \= term__variable(_)
- )
+convert_mode_defn_2(ok(Name, ArgTerms), Head, Body, Result) :-
+ (
+ % check that all the head args are variables
+ term__var_list_to_term_list(Args, ArgTerms)
->
- Result = error("mode parameters must be variables", Head)
- ;
- % check that all the head arg variables are distinct
- %%% some [Arg2, OtherArgs]
(
+ % check that all the head arg variables are distinct
list__member(Arg2, Args, [Arg2|OtherArgs]),
list__member(Arg2, OtherArgs)
- )
- ->
- Result = error("repeated parameters in LHS of mode defn",
+ ->
+ Result = error(
+ "repeated parameters in LHS of mode defn",
Head)
- % check that all the variables in the body occur in the head
- ; %%% some [Var2]
- (
+ % check that all the variables in the body occur
+ % in the head
+ ;
term__contains_var(Body, Var2),
- \+ term__contains_var_list(Args, Var2)
- )
- ->
- Result = error("free inst parameter in RHS of mode definition",
- Body)
- ;
- % should improve the error message here
-
- ( %%% some [ConvertedBody]
- convert_mode(Body, ConvertedBody)
+ \+ list__member(Var2, Args)
->
- list__map(term__coerce, Args, InstArgs),
- Result = ok(eqv_mode(Name, InstArgs, ConvertedBody))
+ Result = error(
+ "free inst parameter in RHS of mode definition",
+ Body)
;
- % catch-all error message - we should do
- % better than this
- Result = error("syntax error in mode definition body",
+ % should improve the error message here
+ (
+ convert_mode(Body, ConvertedBody)
+ ->
+ list__map(term__coerce_var, Args, InstArgs),
+ Result = ok(eqv_mode(Name, InstArgs,
+ ConvertedBody))
+ ;
+ % catch-all error message - we should do
+ % better than this
+ Result = error(
+ "syntax error in mode definition body",
Body)
+ )
)
+ ;
+ Result = error("mode parameters must be variables", Head)
).
:- pred convert_type_and_mode_list(list(term), list(type_and_mode)).
@@ -2247,7 +2299,8 @@
_Context)
->
convert_type(TypeTerm, Type),
- convert_mode(ModeTerm, Mode),
+ convert_mode(ModeTerm, Mode0),
+ constrain_inst_vars_in_mode(Mode0, Mode),
Result = type_and_mode(Type, Mode)
;
convert_type(Term, Type),
Index: compiler/prog_io_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_util.m,v
retrieving revision 1.16
diff -u -r1.16 prog_io_util.m
--- compiler/prog_io_util.m 1999/12/27 11:07:29 1.16
+++ compiler/prog_io_util.m 2000/02/03 05:26:45
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 1996-1999 The University of Melbourne.
+% Copyright (C) 1996-2000 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.
%-----------------------------------------------------------------------------%
@@ -244,7 +244,7 @@
standard_det(DetString, Detism),
convert_mode_list(ArgModesTerms, ArgModes),
PredInstInfo = pred_inst_info(predicate, ArgModes, Detism),
- Inst = ground(shared, yes(PredInstInfo)),
+ Inst = ground(shared, higher_order(PredInstInfo)),
Mode = (Inst -> Inst)
;
% Handle higher-order function modes:
@@ -266,7 +266,7 @@
convert_mode(RetModeTerm, RetMode),
list__append(ArgModes0, [RetMode], ArgModes),
FuncInstInfo = pred_inst_info(function, ArgModes, Detism),
- Inst = ground(shared, yes(FuncInstInfo)),
+ Inst = ground(shared, higher_order(FuncInstInfo)),
Mode = (Inst -> Inst)
;
parse_qualified_term(Term, Term, "mode definition", R),
@@ -302,15 +302,15 @@
% `ground' insts
; Name = term__atom("ground"), Args0 = [] ->
- Result = ground(shared, no)
+ Result = ground(shared, none)
; Name = term__atom("unique"), Args0 = [] ->
- Result = ground(unique, no)
+ Result = ground(unique, none)
; Name = term__atom("mostly_unique"), Args0 = [] ->
- Result = ground(mostly_unique, no)
+ Result = ground(mostly_unique, none)
; Name = term__atom("clobbered"), Args0 = [] ->
- Result = ground(clobbered, no)
+ Result = ground(clobbered, none)
; Name = term__atom("mostly_clobbered"), Args0 = [] ->
- Result = ground(mostly_clobbered, no)
+ Result = ground(mostly_clobbered, none)
;
% The syntax for a higher-order pred inst is
%
@@ -326,7 +326,7 @@
standard_det(DetString, Detism),
convert_mode_list(ArgModesTerm, ArgModes),
PredInst = pred_inst_info(predicate, ArgModes, Detism),
- Result = ground(shared, yes(PredInst))
+ Result = ground(shared, higher_order(PredInst))
;
% The syntax for a higher-order func inst is
@@ -347,7 +347,7 @@
convert_mode(RetModeTerm, RetMode),
list__append(ArgModes0, [RetMode], ArgModes),
FuncInst = pred_inst_info(function, ArgModes, Detism),
- Result = ground(shared, yes(FuncInst))
+ Result = ground(shared, higher_order(FuncInst))
% `not_reached' inst
; Name = term__atom("not_reached"), Args0 = [] ->
Index: compiler/saved_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/saved_vars.m,v
retrieving revision 1.22
diff -u -r1.22 saved_vars.m
--- compiler/saved_vars.m 1999/10/25 03:49:38 1.22
+++ compiler/saved_vars.m 2000/02/03 05:26:53
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 1996-1999 The University of Melbourne.
+% Copyright (C) 1996-2000 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.
%-----------------------------------------------------------------------------%
@@ -71,7 +71,8 @@
implicitly_quantify_clause_body(HeadVars, Goal1, Varset1,
VarTypes1, Goal2, Varset, VarTypes, _Warnings),
proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap0),
- recompute_instmap_delta(no, Goal2, Goal, VarTypes, InstMap0,
+ proc_info_inst_varset(ProcInfo0, InstVarSet),
+ recompute_instmap_delta(no, Goal2, Goal, VarTypes, InstVarSet, InstMap0,
ModuleInfo0, ModuleInfo),
% hlds_out__write_goal(Goal, ModuleInfo, Varset, 0, "\n"),
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.75
diff -u -r1.75 simplify.m
--- compiler/simplify.m 2000/02/03 19:39:42 1.75
+++ compiler/simplify.m 2000/02/09 00:19:36
@@ -155,10 +155,11 @@
proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap0),
proc_info_varset(ProcInfo0, VarSet0),
proc_info_vartypes(ProcInfo0, VarTypes0),
+ proc_info_inst_varset(ProcInfo0, InstVarSet0),
proc_info_goal(ProcInfo0, Goal0),
simplify_info_init(DetInfo0, Simplifications, InstMap0,
- VarSet0, VarTypes0, Info0),
+ VarSet0, VarTypes0, InstVarSet0, Info0),
simplify__process_goal(Goal0, Goal, Info0, Info),
simplify_info_get_varset(Info, VarSet),
@@ -223,7 +224,8 @@
simplify_info_get_module_info(Info3, ModuleInfo3),
recompute_instmap_delta(RecomputeAtomic, Goal2, Goal3,
- VarTypes, InstMap0, ModuleInfo3, ModuleInfo4),
+ VarTypes, Info3^inst_varset, InstMap0, ModuleInfo3,
+ ModuleInfo4),
simplify_info_set_module_info(Info3, ModuleInfo4, Info4)
;
Goal3 = Goal1,
@@ -1850,42 +1852,52 @@
:- type simplify_info
---> simplify_info(
- det_info,
- set(det_msg),
- set(simplification),
- common_info, % Info about common subexpressions.
- instmap,
- prog_varset,
- map(prog_var, type),
- bool, % Does the goal need requantification.
- bool, % Do we need to recompute
+ det_info :: det_info,
+ msgs :: set(det_msg),
+ simplifications :: set(simplification),
+ common_info :: common_info,
+ % Info about common subexpressions.
+ instmap :: instmap,
+ varset :: prog_varset,
+ var_types :: map(prog_var, type),
+ inst_varset :: inst_varset,
+ requantify :: bool,
+ % Does the goal need requantification.
+ recompute_atomic :: bool,
+ % Do we need to recompute
% instmap_deltas for atomic goals
- bool, % Does determinism analysis need to
+ rerun_det :: bool,
+ % Does determinism analysis need to
% be rerun.
- int, % Measure of the improvement in
+ cost_delta :: int,
+ % Measure of the improvement in
% the goal from simplification.
- int % Count of the number of lambdas
+ lambdas :: int
+ % Count of the number of lambdas
% which enclose the current goal.
).
simplify_info_init(DetInfo, Simplifications0, InstMap,
- VarSet, VarTypes, Info) :-
+ VarSet, VarTypes, InstVarSet, Info) :-
common_info_init(CommonInfo),
set__init(Msgs),
set__list_to_set(Simplifications0, Simplifications),
Info = simplify_info(DetInfo, Msgs, Simplifications, CommonInfo,
- InstMap, VarSet, VarTypes, no, no, no, 0, 0).
+ InstMap, VarSet, VarTypes, InstVarSet, no, no, no, 0, 0).
% Reinitialise the simplify_info before reprocessing a goal.
:- pred simplify_info_reinit(set(simplification)::in, instmap::in,
simplify_info::in, simplify_info::out) is det.
-simplify_info_reinit(Simplifications, InstMap0, Info0, Info) :-
- Info0 = simplify_info(DetInfo, Msgs, _, _, _,
- VarSet, VarTypes, _, _, _, CostDelta, _),
- common_info_init(Common),
- Info = simplify_info(DetInfo, Msgs, Simplifications, Common, InstMap0,
- VarSet, VarTypes, no, no, no, CostDelta, 0).
+simplify_info_reinit(Simplifications, InstMap0) -->
+ { common_info_init(Common) },
+ ^simplifications := Simplifications,
+ ^common_info := Common,
+ ^instmap := InstMap0,
+ ^requantify := no,
+ ^recompute_atomic := no,
+ ^rerun_det := no,
+ ^lambdas := 0.
% exported for common.m
:- interface.
@@ -1894,8 +1906,8 @@
:- import_module set.
:- pred simplify_info_init(det_info, list(simplification), instmap,
- prog_varset, map(prog_var, type), simplify_info).
-:- mode simplify_info_init(in, in, in, in, in, out) is det.
+ prog_varset, map(prog_var, type), inst_varset, simplify_info).
+:- mode simplify_info_init(in, in, in, in, in, in, out) is det.
:- pred simplify_info_get_det_info(simplify_info::in, det_info::out) is det.
:- pred simplify_info_get_msgs(simplify_info::in, set(det_msg)::out) is det.
@@ -1917,22 +1929,17 @@
:- implementation.
-simplify_info_get_det_info(simplify_info(Det, _,_,_,_,_,_,_,_,_,_,_), Det).
-simplify_info_get_msgs(simplify_info(_, Msgs, _,_,_,_,_,_,_,_,_,_), Msgs).
-simplify_info_get_simplifications(simplify_info(_,_,Simplify,_,_,_,_,_,_,_,_,_),
- Simplify).
-simplify_info_get_common_info(simplify_info(_,_,_,Common, _,_,_,_,_,_,_,_),
- Common).
-simplify_info_get_instmap(simplify_info(_,_,_,_, InstMap,_,_,_,_,_,_,_),
- InstMap).
-simplify_info_get_varset(simplify_info(_,_,_,_,_, VarSet, _,_,_,_,_,_), VarSet).
-simplify_info_get_var_types(simplify_info(_,_,_,_,_,_, VarTypes, _,_,_,_,_),
- VarTypes).
-simplify_info_requantify(simplify_info(_,_,_,_,_,_,_, yes, _,_,_,_)).
-simplify_info_recompute_atomic(simplify_info(_,_,_,_,_,_,_,_, yes,_,_,_)).
-simplify_info_rerun_det(simplify_info(_,_,_,_,_,_,_,_,_, yes,_,_)).
-simplify_info_get_cost_delta(simplify_info(_,_,_,_,_,_,_,_,_,_,CostDelta, _),
- CostDelta).
+simplify_info_get_det_info(Info, Info^det_info).
+simplify_info_get_msgs(Info, Info^msgs).
+simplify_info_get_simplifications(Info, Info^simplifications).
+simplify_info_get_common_info(Info, Info^common_info).
+simplify_info_get_instmap(Info, Info^instmap).
+simplify_info_get_varset(Info, Info^varset).
+simplify_info_get_var_types(Info, Info^var_types).
+simplify_info_requantify(Info) :- Info^requantify = yes.
+simplify_info_recompute_atomic(Info) :- Info^recompute_atomic = yes.
+simplify_info_rerun_det(Info) :- Info^rerun_det = yes.
+simplify_info_get_cost_delta(Info, Info^cost_delta).
simplify_info_get_module_info(Info, ModuleInfo) :-
simplify_info_get_det_info(Info, DetInfo),
@@ -1980,38 +1987,21 @@
:- implementation.
-simplify_info_set_det_info(simplify_info(_, B, C, D, E, F, G, H, I, J, K, L),
- Det, simplify_info(Det, B, C, D, E, F, G, H, I, J, K, L)).
-simplify_info_set_msgs(simplify_info(A, _, C, D, E, F, G, H, I, J, K, L), Msgs,
- simplify_info(A, Msgs, C, D, E, F, G, H, I, J, K, L)).
-simplify_info_set_simplifications(
- simplify_info(A, B, _, D, E, F, G, H, I, J, K, L),
- Simp, simplify_info(A, B, Simp, D, E, F, G, H, I, J, K, L)).
-simplify_info_set_instmap(simplify_info(A, B, C, D, _, F, G, H, I, J, K, L),
- InstMap,
- simplify_info(A, B, C, D, InstMap, F, G, H, I, J, K, L)).
-simplify_info_set_common_info(simplify_info(A, B, C, _, E, F, G, H, I, J, K, L),
- Common,
- simplify_info(A, B, C, Common, E, F, G, H, I, J, K, L)).
-simplify_info_set_varset(simplify_info(A, B, C, D, E, _, G, H, I, J, K, L),
- VarSet,
- simplify_info(A, B, C, D, E, VarSet, G, H, I, J, K, L)).
-simplify_info_set_var_types(simplify_info(A, B, C, D, E, F, _, H, I, J, K, L),
- VarTypes, simplify_info(A, B, C, D, E, F, VarTypes, H,I,J,K,L)).
-simplify_info_set_requantify(simplify_info(A, B, C, D, E, F, G, _, I, J, K, L),
- simplify_info(A, B, C, D, E, F, G, yes, I, J, K, L)).
-simplify_info_set_recompute_atomic(simplify_info(A, B, C, D, E, F, G,H,_,J,K,L),
- simplify_info(A, B, C, D, E, F, G, H, yes, J, K, L)).
-simplify_info_set_rerun_det(simplify_info(A, B, C, D, E, F, G,H,I,_,K,L),
- simplify_info(A, B, C, D, E, F, G, H, I, yes, K, L)).
-simplify_info_set_cost_delta(simplify_info(A, B, C, D, E, F, G, H, I, J, _, L),
- Delta, simplify_info(A, B, C, D, E, F, G, H, I, J, Delta, L)).
-
-simplify_info_incr_cost_delta(
- simplify_info(A, B, C, D, E, F,G,H,I,J, Delta0, L),
- Incr, simplify_info(A, B, C, D, E, F, G, H, I, J, Delta, L)) :-
- Delta is Delta0 + Incr.
+simplify_info_set_det_info(Info, Det, Info^det_info := Det).
+simplify_info_set_msgs(Info, Msgs, Info^msgs := Msgs).
+simplify_info_set_simplifications(Info, Simp, Info^simplifications := Simp).
+simplify_info_set_instmap(Info, InstMap, Info^instmap := InstMap).
+simplify_info_set_common_info(Info, Common, Info^common_info := Common).
+simplify_info_set_varset(Info, VarSet, Info^varset := VarSet).
+simplify_info_set_var_types(Info, VarTypes, Info^var_types := VarTypes).
+simplify_info_set_requantify(Info, Info^requantify := yes).
+simplify_info_set_recompute_atomic(Info, Info^recompute_atomic := yes).
+simplify_info_set_rerun_det(Info, Info^rerun_det := yes).
+simplify_info_set_cost_delta(Info, Delta, Info^cost_delta := Delta).
+simplify_info_incr_cost_delta(Info, Incr,
+ Info^cost_delta := Info^cost_delta + Incr).
+
simplify_info_add_msg(Info0, Msg, Info) :-
( simplify_do_warn(Info0) ->
simplify_info_do_add_msg(Info0, Msg, Info)
@@ -2024,24 +2014,13 @@
set__insert(Msgs0, Msg, Msgs),
simplify_info_set_msgs(Info0, Msgs, Info).
-simplify_info_enter_lambda(
- simplify_info(A, B, C, D, E, F, G, H, I, J, K, LambdaCount0),
- simplify_info(A, B, C, D, E, F, G, H, I, J, K, LambdaCount)) :-
- LambdaCount is LambdaCount0 + 1.
-simplify_info_leave_lambda(
- simplify_info(A, B, C, D, E, F, G, H, I, J, K, LambdaCount0),
- simplify_info(A, B, C, D, E, F, G, H, I, J, K, LambdaCount)) :-
- LambdaCount1 is LambdaCount0 - 1,
- (
- LambdaCount1 >= 0
- ->
- LambdaCount = LambdaCount1
- ;
- error("simplify_info_leave_lambda: Left too many lambdas")
- ).
-simplify_info_inside_lambda(
- simplify_info(_,_,_,_,_,_,_,_,_,_,_,LambdaCount)) :-
- LambdaCount > 0.
+simplify_info_enter_lambda(Info, Info^lambdas := Info^lambdas + 1).
+simplify_info_leave_lambda(Info, Info^lambdas := LambdaCount) :-
+ LambdaCount = Info^lambdas - 1,
+ require(((pred) is semidet :- LambdaCount >= 0),
+ "simplify_info_leave_lambda: Left too many lambdas").
+simplify_info_inside_lambda(Info) :-
+ Info^lambdas > 0.
simplify_info_set_module_info(Info0, ModuleInfo, Info) :-
simplify_info_get_det_info(Info0, DetInfo0),
@@ -2101,10 +2080,8 @@
:- pred simplify_info_update_instmap(simplify_info::in, hlds_goal::in,
simplify_info::out) is det.
-simplify_info_update_instmap(
- simplify_info(A, B, C, D, InstMap0, F, G, H, I, J, K, L), Goal,
- simplify_info(A, B, C, D, InstMap, F, G, H, I, J, K, L)) :-
- update_instmap(Goal, InstMap0, InstMap).
+simplify_info_update_instmap(Info, Goal, Info^instmap := InstMap) :-
+ update_instmap(Goal, Info^instmap, InstMap).
:- type before_after
---> before
Index: compiler/special_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/special_pred.m,v
retrieving revision 1.23
diff -u -r1.23 special_pred.m
--- compiler/special_pred.m 1998/09/10 06:51:38 1.23
+++ compiler/special_pred.m 2000/02/07 04:02:01
@@ -67,6 +67,11 @@
% mode num for special procs is always 0 (the first mode)
special_pred_mode_num(_, 0).
+ % XXX If the type has only one value, the determinism should be `det'.
+ % However, this predicate is called by make_hlds before all the type
+ % information is available, so we can't check that here.
+ % There is a pass over the unify preds at the end of make_hlds to
+ % fix up the determinism.
special_pred_info(unify, Type, "__Unify__", [Type, Type], [In, In], semidet) :-
in_mode(In).
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.16
diff -u -r1.16 table_gen.m
--- compiler/table_gen.m 2000/02/07 00:31:10 1.16
+++ compiler/table_gen.m 2000/02/09 00:19:38
@@ -690,7 +690,7 @@
generate_new_table_var("SubgoalVar", VarTypes2, VarTypes,
VarSet2, VarSet, SubgoalVar),
generate_call("table_nondet_setup", [TableNodeVar, SubgoalVar],
- det, impure, [SubgoalVar - ground(unique, no)],
+ det, impure, [SubgoalVar - ground(unique, none)],
Module, Context, SetupGoal),
list__append([GetTableGoal | LookupGoals], [SetupGoal], Goals),
@@ -759,7 +759,7 @@
generate_call("table_lookup_insert_enum",
[TableVar, RangeVar, ArgVar, NextTableVar],
det, impure,
- [NextTableVar - ground(unique, no)],
+ [NextTableVar - ground(unique, none)],
Module, Context, LookupGoal),
set__init(NonLocals0),
set__insert_list(NonLocals0, [TableVar, ArgVar],
@@ -775,7 +775,7 @@
;
generate_new_table_var("TableNodeVar", VarTypes0, VarTypes1,
VarSet0, VarSet1, NextTableVar),
- InstMapAL = [NextTableVar - ground(unique, no)],
+ InstMapAL = [NextTableVar - ground(unique, none)],
(
( TypeCat = pred_type
; TypeCat = polymorphic_type
@@ -837,7 +837,7 @@
generate_call("table_create_ans_block",
[TableVar, NumAnsVarsVar, AnsTableVar], det, impure,
- [AnsTableVar - ground(unique, no)], Module, Context,
+ [AnsTableVar - ground(unique, none)], Module, Context,
CreateAnsBlockGoal),
generate_save_goals(AnsList, AnsTableVar, 0, Context,
@@ -874,7 +874,7 @@
generate_new_table_var("AnswerTableVar", VarTypes0, VarTypes1,
VarSet0, VarSet1, AnsTableVar0),
generate_call("table_nondet_get_ans_table", [TableVar, AnsTableVar0],
- det, impure, [AnsTableVar0 - ground(unique, no)],
+ det, impure, [AnsTableVar0 - ground(unique, none)],
Module, Context, GetAnsTableGoal),
generate_lookup_goals(AnsList, Context, AnsTableVar0, AnsTableVar1,
VarTypes1, VarTypes2, VarSet1, VarSet2, TableInfo0, TableInfo1,
@@ -885,7 +885,7 @@
generate_new_table_var("AnswerSlotVar", VarTypes2, VarTypes3,
VarSet2, VarSet3, AnsSlotVar),
generate_call("table_nondet_new_ans_slot", [TableVar, AnsSlotVar], det,
- impure, [AnsSlotVar - ground(unique, no)],
+ impure, [AnsSlotVar - ground(unique, none)],
Module, Context, NewAnsSlotGoal),
list__length(AnsList, NumAnsVars),
@@ -895,7 +895,7 @@
VarSet4, VarSet5, AnsBlockVar),
generate_call("table_create_ans_block",
[AnsSlotVar, NumAnsVarsVar, AnsBlockVar], det, impure,
- [AnsBlockVar - ground(unique, no)],
+ [AnsBlockVar - ground(unique, none)],
Module, Context, CreateAnsBlockGoal),
generate_save_goals(AnsList, AnsBlockVar, 0, Context,
@@ -1011,7 +1011,7 @@
generate_new_table_var("AnswerTable", VarTypes0, VarTypes1,
VarSet0, VarSet1, AnsTableVar),
generate_call("table_nondet_return_all_ans", [TableVar, AnsTableVar],
- nondet, semipure, [AnsTableVar - ground(unique, no)],
+ nondet, semipure, [AnsTableVar - ground(unique, none)],
Module, Context, ReturnAnsBlocksGoal),
generate_restore_goals(OutputVars, AnsTableVar, 0, Module, Context,
@@ -1066,7 +1066,7 @@
LookupPredName)
),
generate_call(LookupPredName, [TableVar, OffsetVar, Var], det, impure,
- [Var - ground(shared, no)], Module, Context, Goal).
+ [Var - ground(shared, none)], Module, Context, Goal).
%-----------------------------------------------------------------------------%
@@ -1081,7 +1081,7 @@
generate_new_table_var("AnswerTable", VarTypes0, VarTypes1,
VarSet0, VarSet1, AnsTableVar),
generate_call("table_nondet_suspend", [TableVar, AnsTableVar],
- nondet, semipure, [AnsTableVar - ground(unique, no)],
+ nondet, semipure, [AnsTableVar - ground(unique, none)],
Module, Context, ReturnAnsBlocksGoal),
generate_restore_goals(OutputVars, AnsTableVar, 0, Module, Context,
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.79
diff -u -r1.79 type_util.m
--- compiler/type_util.m 2000/02/08 06:59:28 1.79
+++ compiler/type_util.m 2000/02/09 00:19:41
@@ -171,6 +171,11 @@
:- pred type_util__get_cons_id_arg_types(module_info::in, (type)::in,
cons_id::in, list(type)::out) is det.
+ % The same as type_util__get_cons_id_arg_types except that the
+ % cons_id is output non-deterministically.
+:- pred type_util__cons_id_arg_types(module_info::in, (type)::in,
+ cons_id::out, list(type)::out) is nondet.
+
% Given a type and a cons_id, look up the definitions of that
% type and constructor. Aborts if the cons_id is not user-defined.
:- pred type_util__get_type_and_cons_defn(module_info, (type), cons_id,
@@ -664,20 +669,39 @@
ConsId, TypeDefn, ConsDefn),
ConsDefn = hlds_cons_defn(ExistQVars0, _Constraints0,
ArgTypes0, _, _),
- ArgTypes0 \= []
+ ArgTypes0 \= [],
+
+ % XXX handle ExistQVars
+ ExistQVars0 = []
->
hlds_data__get_type_defn_tparams(TypeDefn, TypeDefnParams),
term__term_list_to_var_list(TypeDefnParams, TypeDefnVars),
- % XXX handle ExistQVars
- require(unify(ExistQVars0, []),
- "type_util__get_cons_id_arg_types: existentially typed cons_id"),
-
map__from_corresponding_lists(TypeDefnVars, TypeArgs, TSubst),
term__apply_substitution_to_list(ArgTypes0, TSubst, ArgTypes)
;
ArgTypes = []
).
+
+type_util__cons_id_arg_types(ModuleInfo, VarType, ConsId, ArgTypes) :-
+ module_info_ctors(ModuleInfo, Ctors),
+
+ map__member(Ctors, ConsId, ConsDefns),
+ list__member(ConsDefn, ConsDefns),
+
+ type_to_type_id(VarType, TypeId, TypeArgs),
+ ConsDefn = hlds_cons_defn(ExistQVars0, _, ArgTypes0, TypeId, _),
+ module_info_types(ModuleInfo, Types),
+ map__lookup(Types, TypeId, TypeDefn),
+ hlds_data__get_type_defn_tparams(TypeDefn, TypeDefnParams),
+ term__term_list_to_var_list(TypeDefnParams, TypeDefnVars),
+
+ % XXX handle ExistQVars
+ ExistQVars0 = [],
+
+ map__from_corresponding_lists(TypeDefnVars, TypeArgs, TSubst),
+ term__apply_substitution_to_list(ArgTypes0, TSubst, ArgTypes).
+
type_util__is_existq_cons(ModuleInfo, VarType, ConsId) :-
type_util__is_existq_cons(ModuleInfo, VarType, ConsId, _).
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.80
diff -u -r1.80 unify_proc.m
--- compiler/unify_proc.m 2000/02/08 06:59:29 1.80
+++ compiler/unify_proc.m 2000/02/09 00:19:43
@@ -62,18 +62,18 @@
% Add a new request for a unification procedure to the
% proc_requests table.
-:- pred unify_proc__request_unify(unify_proc_id, determinism, prog_context,
- module_info, module_info).
-:- mode unify_proc__request_unify(in, in, in, in, out) is det.
+:- pred unify_proc__request_unify(unify_proc_id, inst_varset,
+ determinism, prog_context, module_info, module_info).
+:- mode unify_proc__request_unify(in, in, in, in, in, out) is det.
% Add a new request for a procedure (not necessarily a unification)
% to the request queue. Return the procedure's newly allocated
% proc_id. (This is used by unique_modes.m.)
-:- pred unify_proc__request_proc(pred_id, list(mode), maybe(list(is_live)),
- maybe(determinism), prog_context,
- module_info, proc_id, module_info).
-:- mode unify_proc__request_proc(in, in, in, in, in, in, out, out) is det.
+:- pred unify_proc__request_proc(pred_id, list(mode), inst_varset,
+ maybe(list(is_live)), maybe(determinism), prog_context,
+ module_info, proc_id, module_info).
+:- mode unify_proc__request_proc(in, in, in, in, in, in, in, out, out) is det.
% Do mode analysis of the queued procedures.
% If the first argument is `unique_mode_check',
@@ -213,8 +213,8 @@
%-----------------------------------------------------------------------------%
-unify_proc__request_unify(UnifyId, Determinism, Context, ModuleInfo0,
- ModuleInfo) :-
+unify_proc__request_unify(UnifyId, InstVarSet, Determinism, Context,
+ ModuleInfo0, ModuleInfo) :-
%
% check if this unification has already been requested, or
% if the proc is hand defined.
@@ -258,7 +258,7 @@
ArgLives = no, % XXX ArgLives should be part of the UnifyId
- unify_proc__request_proc(PredId, ArgModes, ArgLives,
+ unify_proc__request_proc(PredId, ArgModes, InstVarSet, ArgLives,
yes(Determinism), Context, ModuleInfo0,
ProcId, ModuleInfo1),
@@ -273,8 +273,8 @@
ModuleInfo)
).
-unify_proc__request_proc(PredId, ArgModes, ArgLives, MaybeDet, Context,
- ModuleInfo0, ProcId, ModuleInfo) :-
+unify_proc__request_proc(PredId, ArgModes, InstVarSet, ArgLives, MaybeDet,
+ Context, ModuleInfo0, ProcId, ModuleInfo) :-
%
% create a new proc_info for this procedure
%
@@ -282,7 +282,7 @@
map__lookup(Preds0, PredId, PredInfo0),
list__length(ArgModes, Arity),
DeclaredArgModes = no,
- add_new_proc(PredInfo0, Arity, ArgModes, DeclaredArgModes,
+ add_new_proc(PredInfo0, InstVarSet, Arity, ArgModes, DeclaredArgModes,
ArgLives, MaybeDet, Context, address_is_not_taken,
PredInfo1, ProcId),
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.60
diff -u -r1.60 unique_modes.m
--- compiler/unique_modes.m 1999/11/19 13:22:14 1.60
+++ compiler/unique_modes.m 2000/02/03 05:25:21
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 1996-1999 The University of Melbourne.
+% Copyright (C) 1996-2000 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.
%-----------------------------------------------------------------------------%
@@ -614,8 +614,9 @@
mode_list_get_initial_insts(ProcArgModes, ModuleInfo,
InitialInsts),
modecheck_var_has_inst_list(ArgVars, InitialInsts, ArgOffset,
- ModeInfo0, ModeInfo1),
- mode_list_get_final_insts(ProcArgModes, ModuleInfo, FinalInsts),
+ InstVarSub, ModeInfo0, ModeInfo1),
+ mode_list_get_final_insts(ProcArgModes, ModuleInfo, FinalInsts0),
+ inst_list_apply_substitution(FinalInsts0, InstVarSub, FinalInsts),
modecheck_set_var_inst_list(ArgVars, InitialInsts, FinalInsts,
ArgOffset, NewArgVars, ExtraGoals, ModeInfo1, ModeInfo2),
( NewArgVars = ArgVars, ExtraGoals = no_extra_goals ->
Index: library/array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/array.m,v
retrieving revision 1.67
diff -u -r1.67 array.m
--- library/array.m 2000/01/19 09:45:16 1.67
+++ library/array.m 2000/02/04 02:15:56
@@ -93,30 +93,30 @@
% Note: in this implementation, the lower bound is always zero.
:- pred array__min(array(_T), int).
:- mode array__min(array_ui, out) is det.
-:- mode array__min(in, out) is det.
+%:- mode array__min(in, out) is det.
% array__max returns the upper bound of the array.
:- pred array__max(array(_T), int).
:- mode array__max(array_ui, out) is det.
-:- mode array__max(in, out) is det.
+%:- mode array__max(in, out) is det.
% array__size returns the length of the array,
% i.e. upper bound - lower bound + 1.
:- pred array__size(array(_T), int).
:- mode array__size(array_ui, out) is det.
-:- mode array__size(in, out) is det.
+%:- mode array__size(in, out) is det.
% array__bounds returns the upper and lower bounds of an array.
% Note: in this implementation, the lower bound is always zero.
:- pred array__bounds(array(_T), int, int).
:- mode array__bounds(array_ui, out, out) is det.
-:- mode array__bounds(in, out, out) is det.
+%:- mode array__bounds(in, out, out) is det.
% array__in_bounds checks whether an index is in the bounds
% of an array.
:- pred array__in_bounds(array(_T), int).
:- mode array__in_bounds(array_ui, in) is semidet.
-:- mode array__in_bounds(in, in) is semidet.
+%:- mode array__in_bounds(in, in) is semidet.
%-----------------------------------------------------------------------------%
@@ -124,13 +124,13 @@
% It is an error if the index is out of bounds.
:- pred array__lookup(array(T), int, T).
:- mode array__lookup(array_ui, in, out) is det.
-:- mode array__lookup(in, in, out) is det.
+%:- mode array__lookup(in, in, out) is det.
% array__semidet_lookup returns the Nth element of an array.
% It fails if the index is out of bounds.
:- pred array__semidet_lookup(array(T), int, T).
:- mode array__semidet_lookup(array_ui, in, out) is semidet.
-:- mode array__semidet_lookup(in, in, out) is semidet.
+%:- mode array__semidet_lookup(in, in, out) is semidet.
% array__set sets the nth element of an array, and returns the
% resulting array (good opportunity for destructive update ;-).
@@ -152,7 +152,7 @@
% It is an error if the index is out of bounds.
:- pred array__slow_set(array(T), int, T, array(T)).
:- mode array__slow_set(array_ui, in, in, array_uo) is det.
-:- mode array__slow_set(in, in, in, array_uo) is det.
+%:- mode array__slow_set(in, in, in, array_uo) is det.
% array__semidet_slow_set sets the nth element of an array,
% and returns the resulting array. The initial array is not
@@ -161,13 +161,13 @@
% It fails if the index is out of bounds.
:- pred array__semidet_slow_set(array(T), int, T, array(T)).
:- mode array__semidet_slow_set(array_ui, in, in, array_uo) is semidet.
-:- mode array__semidet_slow_set(in, in, in, array_uo) is semidet.
+%:- mode array__semidet_slow_set(in, in, in, array_uo) is semidet.
% array__copy(Array0, Array):
% Makes a new unique copy of an array.
:- pred array__copy(array(T), array(T)).
:- mode array__copy(array_ui, array_uo) is det.
-:- mode array__copy(in, array_uo) is det.
+%:- mode array__copy(in, array_uo) is det.
% array__resize(Array0, Size, Init, Array):
% The array is expanded or shrunk to make it fit
@@ -194,7 +194,7 @@
% occurred in the array.
:- pred array__to_list(array(T), list(T)).
:- mode array__to_list(array_ui, out) is det.
-:- mode array__to_list(in, out) is det.
+%:- mode array__to_list(in, out) is det.
% array__fetch_items takes an array and a lower and upper
% index, and places those items in the array between these
@@ -213,7 +213,7 @@
:- pred array__bsearch(array(T), T, pred(T, T, comparison_result),
maybe(int)).
:- mode array__bsearch(array_ui, in, pred(in, in, out) is det, out) is det.
-:- mode array__bsearch(in, in, pred(in, in, out) is det, out) is det.
+%:- mode array__bsearch(in, in, pred(in, in, out) is det, out) is det.
% array__map(Closure, OldArray, NewArray) applys `Closure' to
% each of the elements of `OldArray' to create `NewArray'.
@@ -321,8 +321,8 @@
% unify/2 for arrays
array_equal(Array1, Array2) :-
- array__size(Array1, Size),
- array__size(Array2, Size),
+ array__size(inst_cast(Array1), Size),
+ array__size(inst_cast(Array2), Size),
array__equal_elements(0, Size, Array1, Array2).
:- pred array__equal_elements(int, int, array(T), array(T)).
@@ -332,8 +332,8 @@
( N = Size ->
true
;
- array__lookup(Array1, N, Elem),
- array__lookup(Array2, N, Elem),
+ array__lookup(inst_cast(Array1), N, Elem),
+ array__lookup(inst_cast(Array2), N, Elem),
N1 is N + 1,
array__equal_elements(N1, Size, Array1, Array2)
).
@@ -341,8 +341,8 @@
% compare/3 for arrays
array_compare(Result, Array1, Array2) :-
- array__size(Array1, Size1),
- array__size(Array2, Size2),
+ array__size(inst_cast(Array1), Size1),
+ array__size(inst_cast(Array2), Size2),
compare(SizeResult, Size1, Size2),
( SizeResult = (=) ->
array__compare_elements(0, Size1, Array1, Array2, Result)
@@ -358,8 +358,8 @@
( N = Size ->
Result = (=)
;
- array__lookup(Array1, N, Elem1),
- array__lookup(Array2, N, Elem2),
+ array__lookup(inst_cast(Array1), N, Elem1),
+ array__lookup(inst_cast(Array2), N, Elem2),
compare(ElemResult, Elem1, Elem2),
( ElemResult = (=) ->
N1 is N + 1,
@@ -409,20 +409,23 @@
/* Array not used */
Min = 0;
").
+/*
:- pragma c_code(array__min(Array::in, Min::out),
[will_not_call_mercury, thread_safe], "
- /* Array not used */
Min = 0;
").
+*/
:- pragma c_code(array__max(Array::array_ui, Max::out),
[will_not_call_mercury, thread_safe], "
Max = ((MR_ArrayType *)Array)->size - 1;
").
+/*
:- pragma c_code(array__max(Array::in, Max::out),
[will_not_call_mercury, thread_safe], "
Max = ((MR_ArrayType *)Array)->size - 1;
").
+*/
array__bounds(Array, Min, Max) :-
array__min(Array, Min),
@@ -434,10 +437,12 @@
[will_not_call_mercury, thread_safe], "
Max = ((MR_ArrayType *)Array)->size;
").
+/*
:- pragma c_code(array__size(Array::in, Max::out),
[will_not_call_mercury, thread_safe], "
Max = ((MR_ArrayType *)Array)->size;
").
+*/
%-----------------------------------------------------------------------------%
@@ -473,6 +478,7 @@
#endif
Item = array->elements[Index];
}").
+/*
:- pragma c_code(array__lookup(Array::in, Index::in, Item::out),
[will_not_call_mercury, thread_safe], "{
MR_ArrayType *array = (MR_ArrayType *)Array;
@@ -483,6 +489,7 @@
#endif
Item = array->elements[Index];
}").
+*/
%-----------------------------------------------------------------------------%
@@ -623,10 +630,12 @@
Array = (Word) ML_copy_array((MR_ArrayType *) Array0);
").
+/*
:- pragma c_code(array__copy(Array0::in, Array::array_uo),
[will_not_call_mercury, thread_safe], "
Array = (Word) ML_copy_array((MR_ArrayType *) Array0);
").
+*/
%-----------------------------------------------------------------------------%
@@ -668,7 +677,7 @@
;
Low1 is Low + 1,
array__fetch_items(Array, Low1, High, List0),
- array__lookup(Array, Low, Item),
+ array__lookup(inst_cast(Array), Low, Item),
List = [Item|List0]
).
@@ -692,7 +701,7 @@
% If Width == 0, we may just have found our element.
% Do a Compare to check.
( Width = 0 ->
- array__lookup(Array, Lo, X),
+ array__lookup(inst_cast(Array), Lo, X),
( call(Compare, El, X, (=)) ->
Result = yes(Lo)
;
@@ -702,7 +711,7 @@
% Otherwise find the middle element of the range
% and check against that.
Mid is (Lo + Hi) >> 1, % `>> 1' is hand-optimized `div 2'.
- array__lookup(Array, Mid, XMid),
+ array__lookup(inst_cast(Array), Mid, XMid),
call(Compare, XMid, El, Comp),
( Comp = (<),
Mid1 is Mid + 1,
@@ -737,14 +746,31 @@
( N >= Size ->
NewArray = NewArray0
;
- array__lookup(OldArray, N, OldElem),
+ array__lookup(inst_cast(OldArray), N, OldElem),
Closure(OldElem, NewElem),
- array__set(NewArray0, N, NewElem, NewArray1),
+ array__set(inst_cast(NewArray0), N, NewElem, NewArray1),
array__map_2(N + 1, Size, Closure, OldArray,
NewArray1, NewArray)
).
%-----------------------------------------------------------------------------%
+
+:- interface.
+
+% XXX this function is necessary for bootstrapping. It, and all calls to
+% it, should be removed after the change to allow
+% inst_matches_initial(ground, bound) has bootstrapped.
+
+:- func inst_cast(array(T)) = array(T).
+:- mode inst_cast(in) = array_uo is det.
+
+:- implementation.
+
+:- pragma c_code(inst_cast(A0::in) = (A::array_uo),
+ [will_not_call_mercury, thread_safe],
+ "A = A0;").
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% Ralph Becket <rwab1 at cam.sri.com> 24/04/99
% Function forms added.
@@ -774,7 +800,7 @@
:- func array__slow_set(array(T), int, T) = array(T).
:- mode array__slow_set(array_ui, in, in) = array_uo is det.
-:- mode array__slow_set(in, in, in) = array_uo is det.
+%:- mode array__slow_set(in, in, in) = array_uo is det.
:- func array__copy(array(T)) = array(T).
:- mode array__copy(array_ui) = array_uo is det.
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.194
diff -u -r1.194 io.m
--- library/io.m 2000/02/04 02:12:09 1.194
+++ library/io.m 2000/02/09 00:20:31
@@ -2153,7 +2153,7 @@
io__write_array(Array) -->
io__write_string("array("),
- { array__to_list(Array, List) },
+ { array__to_list(array__inst_cast(Array), List) },
io__write(List),
io__write_string(")").
Index: library/term.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/term.m,v
retrieving revision 1.92
diff -u -r1.92 term.m
--- library/term.m 1999/10/30 04:16:11 1.92
+++ library/term.m 2000/02/04 02:17:12
@@ -632,7 +632,7 @@
has_type(Elem, ElemType),
same_type(List, [Elem]),
det_univ_to_type(Univ, Array),
- array__to_list(Array, List),
+ array__to_list(array__inst_cast(Array), List),
term__type_to_term(List, ArgsTerm).
:- pred same_type(T::unused, T::unused) is det.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list