[m-rev.] for post-commit review: scalar and vector global data for MLDS
Zoltan Somogyi
zs at csse.unimelb.edu.au
Mon Sep 21 14:08:09 AEST 2009
Implement scalar and vector global data for the MLDS backend, modelled on
the implementation of global data for the LLDS backend. Use scalar global
data to eliminate redundant copies of static memory cells. Use vector global
data to implement lookup switches, and to implement string switches more
efficiently.
The diff reduces the compiler executable's size by 3.3% by eliminating
duplicate copies of static cells. The diff can reduce the sizes of object files
not only through this reduction in the size of read-only data, but also through
reductions in the size of the needed relocation info: even in the absence of
duplicated cells, using one global variable that holds an array of all the
cells of the same type requires less relocation info than a whole bunch of
separate global variables each holding one cell. If C debugging is enabled,
we can also expect a significant reduction in the size of the debug information
stored in object files AND in executables, for the same reason. (This was the
original motivation for scalar static data on the LLDS backend; the large
amount of relocation information in object files, especially if Mercury
debugging was enabled, led to long link times.)
compiler/ml_global_data.m:
Make the changes described above.
compiler/ml_lookup_switch.m:
This new module implements lookup switches for the MLDS backend.
For now, it implements only model_det and model_semi switches.
compiler/ml_switch_gen.m:
Call the new module when appropriate.
Do not require the switch generation methods that never generate
definitions to return an empty list of definitions.
compiler/ml_backend.m:
Add the new module.
compiler/notes/compiler_design.html:
Mention the new module, and fix some documentation rot.
compiler/mlds.m:
Extend the relevant types to allow the generated MLDS code to refer
to both scalar and vector global data.
Move a predicate that belongs here from ml_code_util.m.
Rename a predicate to avoid ambiguity with its own return type.
Give the functors of some types distinguishing prefixes.
compiler/ml_util.m:
Replace some semidet predicates with functions returning bool,
since the semidet predicates silently did the wrong thing on the new
additions to the MLDS.
compiler/ml_code_gen.m:
Ensure that we do not generate references to scalar and vector common
cells on platforms which do not (yet) support them. At the moment,
they are supported only when generating C.
Put some code into a predicate of its own.
compiler/builtin_ops.m:
Extend the type that represents array elements to allow them to be
structures, which they are for vector globals.
compiler/ml_code_util.m:
Add some new utility predicates and functions.
Move some predicates that are now needed in more than one module here.
Remove the predicates moved to mlds.m.
Conform to the changes above.
compiler/ml_string_switch.m:
compiler/string_switch.m:
Instead of two separate arrays, use one array of structures (a static
vector), since they way, the string and the next slot indicator,
which are accesses together, are next to each other and thus
in the same cache block.
compiler/lookup_switch.m:
compiler/switch_util.m:
Move several predicates from lookup_switch.m to switch_util.m,
since now ml_lookup_switch.m needs them too. Parameterize the moved
predicates as needed.
Conform to the changes above.
compiler/llds.m:
Add prefixes to some functor names to avoid ambiguities.
compiler/llds_out.m:
compiler/lookup_util.m:
compiler/mercury_compile.m:
Minor style improvements.
compiler/global_data.m:
Minor cleanups. Give names to some data types, and add prefixes to some
field names.
Conform to the changes above.
compiler/jumpopt.m:
Minor style improvements.
Conform to the changes above.
compiler/opt_debug.m:
Fix some misleading variable names.
compiler/reassign.m:
Factor out some duplicated code.
compiler/ll_pseudo_type_info.m:
compiler/ml_closure_gen.m:
compiler/ml_elim_nested.m:
compiler/ml_optimize.m:
compiler/ml_tag_switch.m:
compiler/ml_tailcall.m:
compiler/ml_unify_gen.m:
compiler/mlds_to_c.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_il.m:
compiler/mlds_to_java.m:
compiler/mlds_to_managed.m:
compiler/rtti_to_mlds.m:
compiler/stack_layout.m:
compiler/unify_gen.m:
Conform to the changes above.
tests/hard_coded/lookup_switch_simple.{m,exp}:
tests/hard_coded/lookup_switch_simple_bitvec.{m,exp}:
tests/hard_coded/lookup_switch_simple_non.{m,exp}:
tests/hard_coded/lookup_switch_simple_opt.{m,exp}:
New test cases to exercise the new functionality.
tests/hard_coded/Mmakefile:
tests/hard_coded/Mercury.options:
Enable the new tests.
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/builtin_ops.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/builtin_ops.m,v
retrieving revision 1.30
diff -u -b -r1.30 builtin_ops.m
--- compiler/builtin_ops.m 11 Jun 2009 07:00:06 -0000 1.30
+++ compiler/builtin_ops.m 20 Sep 2009 06:38:44 -0000
@@ -98,9 +98,13 @@
% rather than just putting the MLDS type here, avoids the need
% for this module to depend on back-end specific stuff like MLDS types.
:- type array_elem_type
- ---> elem_type_string % ml_string_type
- ; elem_type_int % mlds_native_int_type
- ; elem_type_generic. % mlds_generic_type
+ ---> array_elem_scalar(scalar_array_elem_type)
+ ; array_elem_struct(list(scalar_array_elem_type)).
+
+:- type scalar_array_elem_type
+ ---> scalar_elem_string % ml_string_type
+ ; scalar_elem_int % mlds_native_int_type
+ ; scalar_elem_generic. % mlds_generic_type
% translate_builtin:
%
Index: compiler/global_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/global_data.m,v
retrieving revision 1.40
diff -u -b -r1.40 global_data.m
--- compiler/global_data.m 3 Sep 2009 23:07:26 -0000 1.40
+++ compiler/global_data.m 20 Sep 2009 06:38:44 -0000
@@ -155,21 +155,21 @@
---> global_data(
% Information about the global variables defined by
% each procedure.
- proc_var_map :: proc_var_map,
+ gd_proc_var_map :: proc_var_map,
% Information about the layout structures defined by
% each procedure.
- proc_layout_map :: proc_layout_map,
+ gd_proc_layout_map :: proc_layout_map,
% The list of all closure layouts generated in this module.
% While all closure layouts are different from all other
% layout_data, it is possible, although unlikely, for
% two closures to have the same layout.
- closure_layouts :: list(layout_data),
+ gd_closure_layouts :: list(layout_data),
% Information about all the statically allocated cells
% created so far.
- static_cell_info :: static_cell_info
+ gd_static_cell_info :: static_cell_info
).
global_data_init(StaticCellInfo, GlobalData) :-
@@ -178,49 +178,49 @@
GlobalData = global_data(EmptyDataMap, EmptyLayoutMap, [], StaticCellInfo).
global_data_add_new_proc_var(PredProcId, ProcVar, !GlobalData) :-
- ProcVarMap0 = !.GlobalData ^ proc_var_map,
+ ProcVarMap0 = !.GlobalData ^ gd_proc_var_map,
map.det_insert(ProcVarMap0, PredProcId, ProcVar, ProcVarMap),
- !GlobalData ^ proc_var_map := ProcVarMap.
+ !GlobalData ^ gd_proc_var_map := ProcVarMap.
global_data_add_new_proc_layout(PredProcId, ProcLayout, !GlobalData) :-
- ProcLayoutMap0 = !.GlobalData ^ proc_layout_map,
+ ProcLayoutMap0 = !.GlobalData ^ gd_proc_layout_map,
map.det_insert(ProcLayoutMap0, PredProcId, ProcLayout, ProcLayoutMap),
- !GlobalData ^ proc_layout_map := ProcLayoutMap.
+ !GlobalData ^ gd_proc_layout_map := ProcLayoutMap.
global_data_update_proc_layout(PredProcId, ProcLayout, !GlobalData) :-
- ProcLayoutMap0 = !.GlobalData ^ proc_layout_map,
+ ProcLayoutMap0 = !.GlobalData ^ gd_proc_layout_map,
map.det_update(ProcLayoutMap0, PredProcId, ProcLayout, ProcLayoutMap),
- !GlobalData ^ proc_layout_map := ProcLayoutMap.
+ !GlobalData ^ gd_proc_layout_map := ProcLayoutMap.
global_data_add_new_closure_layouts(NewClosureLayouts, !GlobalData) :-
- ClosureLayouts0 = !.GlobalData ^ closure_layouts,
+ ClosureLayouts0 = !.GlobalData ^ gd_closure_layouts,
list.append(NewClosureLayouts, ClosureLayouts0, ClosureLayouts),
- !GlobalData ^ closure_layouts := ClosureLayouts.
+ !GlobalData ^ gd_closure_layouts := ClosureLayouts.
global_data_maybe_get_proc_layout(GlobalData, PredProcId, ProcLayout) :-
- ProcLayoutMap = GlobalData ^ proc_layout_map,
+ ProcLayoutMap = GlobalData ^ gd_proc_layout_map,
map.search(ProcLayoutMap, PredProcId, ProcLayout).
global_data_get_proc_layout(GlobalData, PredProcId, ProcLayout) :-
- ProcLayoutMap = GlobalData ^ proc_layout_map,
+ ProcLayoutMap = GlobalData ^ gd_proc_layout_map,
map.lookup(ProcLayoutMap, PredProcId, ProcLayout).
global_data_get_all_proc_vars(GlobalData, ProcVars) :-
- ProcVarMap = GlobalData ^ proc_var_map,
+ ProcVarMap = GlobalData ^ gd_proc_var_map,
map.values(ProcVarMap, ProcVars).
global_data_get_all_proc_layouts(GlobalData, ProcLayouts) :-
- ProcLayoutMap = GlobalData ^ proc_layout_map,
+ ProcLayoutMap = GlobalData ^ gd_proc_layout_map,
map.values(ProcLayoutMap, ProcLayouts).
global_data_get_all_closure_layouts(GlobalData, ClosureLayouts) :-
- ClosureLayouts = GlobalData ^ closure_layouts.
+ ClosureLayouts = GlobalData ^ gd_closure_layouts.
global_data_get_static_cell_info(GlobalData, StaticCellInfo) :-
- StaticCellInfo = GlobalData ^ static_cell_info.
+ StaticCellInfo = GlobalData ^ gd_static_cell_info.
global_data_set_static_cell_info(StaticCellInfo, !GlobalData) :-
- !GlobalData ^ static_cell_info := StaticCellInfo.
+ !GlobalData ^ gd_static_cell_info := StaticCellInfo.
%-----------------------------------------------------------------------------%
@@ -263,24 +263,30 @@
:- type static_cell_sub_info
---> static_cell_sub_info(
- module_name :: module_name, % base file name
- unbox_float :: have_unboxed_floats,
- common_data :: bool
+ scsi_module_name :: module_name, % base file name
+ scsi_unbox_float :: have_unboxed_floats,
+ scsi_common_data :: bool
).
+:- type cell_type_bimap == bimap(common_cell_type, type_num).
+:- type scalar_type_cell_map == map(type_num, scalar_cell_group).
+:- type vector_type_cell_map == map(type_num, vector_cell_group).
+
:- type static_cell_info
---> static_cell_info(
- sub_info :: static_cell_sub_info,
- type_counter :: counter, % next type number
+ sci_sub_info :: static_cell_sub_info,
+ sci_type_counter :: counter, % next type number
% Maps types to type numbers and vice versa.
- cell_type_num_map :: bimap(common_cell_type, type_num),
+ sci_cell_type_num_map :: cell_type_bimap,
% Maps the cell type number to the information we have
% for all scalar cells of that type.
- scalar_cell_group_map :: map(type_num, scalar_cell_group),
+ sci_scalar_cell_group_map :: scalar_type_cell_map,
- vector_cell_group_map :: map(type_num, vector_cell_group)
+ % Maps the cell type number to the information we have
+ % for all vector cells of that type.
+ sci_vector_cell_group_map :: vector_type_cell_map
).
init_static_cell_info(BaseName, UnboxFloat, CommonData) = Info0 :-
@@ -291,7 +297,7 @@
%-----------------------------------------------------------------------------%
add_scalar_static_cell_natural_types(Args, DataAddr, !Info) :-
- list.map(associate_natural_type(!.Info ^ sub_info ^ unbox_float),
+ list.map(associate_natural_type(!.Info ^ sci_sub_info ^ scsi_unbox_float),
Args, ArgsTypes),
add_scalar_static_cell(ArgsTypes, DataAddr, !Info).
@@ -300,7 +306,7 @@
% so that the generated C structure isn't empty.
(
ArgsTypes0 = [],
- ArgsTypes = [const(llconst_int(-1)) - integer]
+ ArgsTypes = [const(llconst_int(-1)) - lt_integer]
;
ArgsTypes0 = [_ | _],
ArgsTypes = ArgsTypes0
@@ -316,23 +322,23 @@
do_add_scalar_static_cell(ArgsTypes, CellType, CellValue, DataAddr, !Info) :-
assoc_list.keys(ArgsTypes, Args),
some [!CellGroup] (
- TypeNumMap0 = !.Info ^ cell_type_num_map,
- CellGroupMap0 = !.Info ^ scalar_cell_group_map,
- ( bimap.search(TypeNumMap0, CellType, TypeNumPrime) ->
- TypeNum = TypeNumPrime,
+ TypeNumMap0 = !.Info ^ sci_cell_type_num_map,
+ CellGroupMap0 = !.Info ^ sci_scalar_cell_group_map,
+ ( bimap.search(TypeNumMap0, CellType, OldTypeNum) ->
+ TypeNum = OldTypeNum,
( map.search(CellGroupMap0, TypeNum, !:CellGroup) ->
true
;
!:CellGroup = init_scalar_cell_group
)
;
- TypeNumCounter0 = !.Info ^ type_counter,
- counter.allocate(TypeNum0, TypeNumCounter0, TypeNumCounter),
- TypeNum = type_num(TypeNum0),
- !Info ^ type_counter := TypeNumCounter,
+ TypeNumCounter0 = !.Info ^ sci_type_counter,
+ counter.allocate(TypeRawNum, TypeNumCounter0, TypeNumCounter),
+ TypeNum = type_num(TypeRawNum),
+ !Info ^ sci_type_counter := TypeNumCounter,
bimap.det_insert(TypeNumMap0, CellType, TypeNum, TypeNumMap),
- !Info ^ cell_type_num_map := TypeNumMap,
+ !Info ^ sci_cell_type_num_map := TypeNumMap,
!:CellGroup = init_scalar_cell_group
),
@@ -347,7 +353,7 @@
RevArray0 = !.CellGroup ^ scalar_cell_rev_array,
RevArray = [CellValue | RevArray0],
!CellGroup ^ scalar_cell_rev_array := RevArray,
- InsertCommonData = !.Info ^ sub_info ^ common_data,
+ InsertCommonData = !.Info ^ sci_sub_info ^ scsi_common_data,
(
InsertCommonData = yes,
bimap.det_insert(MembersMap0, Args, DataName, MembersMap),
@@ -359,10 +365,10 @@
% be useful when comparing the LLDS and MLDS backends.
),
map.set(CellGroupMap0, TypeNum, !.CellGroup, CellGroupMap),
- !Info ^ scalar_cell_group_map := CellGroupMap
+ !Info ^ sci_scalar_cell_group_map := CellGroupMap
)
),
- ModuleName = !.Info ^ sub_info ^ module_name,
+ ModuleName = !.Info ^ sci_sub_info ^ scsi_module_name,
DataAddr = data_addr(ModuleName, DataName).
:- func init_scalar_cell_group = scalar_cell_group.
@@ -370,9 +376,9 @@
init_scalar_cell_group = scalar_cell_group(counter.init(0), bimap.init, []).
search_scalar_static_cell_offset(Info, DataAddr, Offset, Rval) :-
- DataAddr = data_addr(Info ^ sub_info ^ module_name, DataName),
+ DataAddr = data_addr(Info ^ sci_sub_info ^ scsi_module_name, DataName),
DataName = scalar_common_ref(TypeNum, _CellNum),
- CellGroupMap = Info ^ scalar_cell_group_map,
+ CellGroupMap = Info ^ sci_scalar_cell_group_map,
map.lookup(CellGroupMap, TypeNum, CellGroup),
CellGroupMembers = CellGroup ^ scalar_cell_group_members,
bimap.reverse_lookup(CellGroupMembers, Rvals, DataName),
@@ -417,15 +423,15 @@
->
LLDSType = LLDSType0
;
- NaturalType = integer,
- LLDSType0 = data_ptr
+ NaturalType = lt_integer,
+ LLDSType0 = lt_data_ptr
->
- LLDSType = data_ptr
+ LLDSType = lt_data_ptr
;
- NaturalType = data_ptr,
- LLDSType0 = integer
+ NaturalType = lt_data_ptr,
+ LLDSType0 = lt_integer
->
- LLDSType = data_ptr
+ LLDSType = lt_data_ptr
;
fail
),
@@ -446,8 +452,8 @@
CellType = plain_type(LLDSTypes),
VectorCells = list.map(pair_vector_element(LLDSTypes), VectorData),
some [!CellGroup] (
- TypeNumMap0 = !.Info ^ cell_type_num_map,
- CellGroupMap0 = !.Info ^ vector_cell_group_map,
+ TypeNumMap0 = !.Info ^ sci_cell_type_num_map,
+ CellGroupMap0 = !.Info ^ sci_vector_cell_group_map,
( bimap.search(TypeNumMap0, CellType, TypeNumPrime) ->
TypeNum = TypeNumPrime,
( map.search(CellGroupMap0, TypeNum, !:CellGroup) ->
@@ -456,13 +462,13 @@
!:CellGroup = init_vector_cell_group
)
;
- TypeNumCounter0 = !.Info ^ type_counter,
+ TypeNumCounter0 = !.Info ^ sci_type_counter,
counter.allocate(TypeNum0, TypeNumCounter0, TypeNumCounter),
TypeNum = type_num(TypeNum0),
- !Info ^ type_counter := TypeNumCounter,
+ !Info ^ sci_type_counter := TypeNumCounter,
bimap.det_insert(TypeNumMap0, CellType, TypeNum, TypeNumMap),
- !Info ^ cell_type_num_map := TypeNumMap,
+ !Info ^ sci_cell_type_num_map := TypeNumMap,
!:CellGroup = init_vector_cell_group
),
@@ -475,9 +481,9 @@
map.det_insert(CellMap0, CellNum, VectorContents, CellMap),
!CellGroup ^ vector_cell_map := CellMap,
map.set(CellGroupMap0, TypeNum, !.CellGroup, CellGroupMap),
- !Info ^ vector_cell_group_map := CellGroupMap
+ !Info ^ sci_vector_cell_group_map := CellGroupMap
),
- ModuleName = !.Info ^ sub_info ^ module_name,
+ ModuleName = !.Info ^ sci_sub_info ^ scsi_module_name,
DataAddr = data_addr(ModuleName, DataName).
:- func init_vector_cell_group = vector_cell_group.
@@ -492,17 +498,17 @@
%-----------------------------------------------------------------------------%
get_static_cells(Info, ScalarDatas, VectorDatas) :-
- ModuleName = Info ^ sub_info ^ module_name,
- TypeNumMap = Info ^ cell_type_num_map,
+ ModuleName = Info ^ sci_sub_info ^ scsi_module_name,
+ TypeNumMap = Info ^ sci_cell_type_num_map,
map.foldl(add_scalar_static_cell_for_type(ModuleName, TypeNumMap),
- Info ^ scalar_cell_group_map, [], RevScalarDatas),
+ Info ^ sci_scalar_cell_group_map, [], RevScalarDatas),
list.reverse(RevScalarDatas, ScalarDatas),
map.foldl(add_all_vector_static_cells_for_type(ModuleName, TypeNumMap),
- Info ^ vector_cell_group_map, [], RevVectorDatas),
+ Info ^ sci_vector_cell_group_map, [], RevVectorDatas),
list.reverse(RevVectorDatas, VectorDatas).
:- pred add_scalar_static_cell_for_type(module_name::in,
- bimap(common_cell_type, type_num)::in, type_num::in, scalar_cell_group::in,
+ cell_type_bimap::in, type_num::in, scalar_cell_group::in,
list(scalar_common_data_array)::in, list(scalar_common_data_array)::out)
is det.
@@ -515,7 +521,7 @@
!:Arrays = [Array | !.Arrays].
:- pred add_all_vector_static_cells_for_type(module_name::in,
- bimap(common_cell_type, type_num)::in, type_num::in, vector_cell_group::in,
+ cell_type_bimap::in, type_num::in, vector_cell_group::in,
list(vector_common_data_array)::in, list(vector_common_data_array)::out)
is det.
@@ -606,10 +612,10 @@
natural_type(UnboxFloat, Rval, Type) :-
llds.rval_type(Rval, Type0),
(
- Type0 = float,
+ Type0 = lt_float,
UnboxFloat = do_not_have_unboxed_floats
->
- Type = data_ptr
+ Type = lt_data_ptr
;
Type = Type0
).
@@ -638,10 +644,10 @@
% Mapping of old to new data_names.
bump_type_num_counter(Increment, !GlobalData) :-
- Counter0 = !.GlobalData ^ static_cell_info ^ type_counter,
+ Counter0 = !.GlobalData ^ gd_static_cell_info ^ sci_type_counter,
counter.allocate(N, Counter0, _),
Counter = counter.init(N + Increment),
- !GlobalData ^ static_cell_info ^ type_counter := Counter.
+ !GlobalData ^ gd_static_cell_info ^ sci_type_counter := Counter.
merge_global_datas(GlobalDataA, GlobalDataB, GlobalData, Remap) :-
GlobalDataA = global_data(ProcVarMapA, ProcLayoutMapA, ClosureLayoutsA,
@@ -687,8 +693,7 @@
remap_static_cell_info(Remap, SCI0, SCI).
:- pred merge_cell_type_num_maps(common_cell_type::in, type_num::in,
- counter::in, counter::out, bimap(common_cell_type, type_num)::in,
- bimap(common_cell_type, type_num)::out,
+ counter::in, counter::out, cell_type_bimap::in, cell_type_bimap::out,
cell_type_num_remap::in, cell_type_num_remap::out) is det.
merge_cell_type_num_maps(CellType, BTypeNum,
@@ -705,8 +710,8 @@
).
:- pred merge_scalar_cell_group_maps(cell_type_num_remap::in,
- map(type_num, scalar_cell_group)::in, map(type_num, scalar_cell_group)::in,
- map(type_num, scalar_cell_group)::out,
+ scalar_type_cell_map::in, scalar_type_cell_map::in,
+ scalar_type_cell_map::out,
map(type_num, scalar_cell_group_remap)::out) is det.
merge_scalar_cell_group_maps(TypeNumRemap,
@@ -719,8 +724,8 @@
:- pred merge_scalar_cell_group_maps_2(cell_type_num_remap::in,
type_num::in, scalar_cell_group::in,
- map(type_num, scalar_cell_group)::in,
- map(type_num, scalar_cell_group)::out,
+ scalar_type_cell_map::in,
+ scalar_type_cell_map::out,
map(type_num, scalar_cell_group_remap)::in,
map(type_num, scalar_cell_group_remap)::out) is det.
@@ -790,8 +795,8 @@
).
:- pred merge_vector_cell_group_maps(cell_type_num_remap::in,
- map(type_num, vector_cell_group)::in, map(type_num, vector_cell_group)::in,
- map(type_num, vector_cell_group)::out) is det.
+ vector_type_cell_map::in, vector_type_cell_map::in,
+ vector_type_cell_map::out) is det.
merge_vector_cell_group_maps(TypeNumRemap, VectorCellGroupMapA,
VectorCellGroupMapB, VectorCellGroupMap) :-
@@ -800,12 +805,12 @@
VectorCellGroupMapA, VectorCellGroupMap).
:- pred merge_vector_cell_group_maps_2(cell_type_num_remap::in,
- type_num::in, vector_cell_group::in, map(type_num, vector_cell_group)::in,
- map(type_num, vector_cell_group)::out) is det.
+ type_num::in, vector_cell_group::in,
+ vector_type_cell_map::in, vector_type_cell_map::out) is det.
merge_vector_cell_group_maps_2(TypeNumRemap, OldTypeNum, VectorCellGroup,
!VectorCellGroupMap) :-
- NewTypeNum = TypeNumRemap ^ det_elem(OldTypeNum),
+ map.lookup(TypeNumRemap, OldTypeNum, NewTypeNum),
svmap.det_insert(NewTypeNum, VectorCellGroup, !VectorCellGroupMap).
:- func nth_member_lookup0(list(T), T) = int.
@@ -822,12 +827,12 @@
static_cell_info::in, static_cell_info::out) is det.
remap_static_cell_info(Remap, !SCI) :-
- ScalarMap0 = !.SCI ^ scalar_cell_group_map,
- VectorMap0 = !.SCI ^ vector_cell_group_map,
+ ScalarMap0 = !.SCI ^ sci_scalar_cell_group_map,
+ VectorMap0 = !.SCI ^ sci_vector_cell_group_map,
map.map_values_only(remap_scalar_cell_group(Remap), ScalarMap0, ScalarMap),
map.map_values_only(remap_vector_cell_group(Remap), VectorMap0, VectorMap),
- !SCI ^ scalar_cell_group_map := ScalarMap,
- !SCI ^ vector_cell_group_map := VectorMap.
+ !SCI ^ sci_scalar_cell_group_map := ScalarMap,
+ !SCI ^ sci_vector_cell_group_map := VectorMap.
:- pred remap_scalar_cell_group(static_cell_remap_info::in,
scalar_cell_group::in, scalar_cell_group::out) is det.
@@ -926,9 +931,9 @@
list.map(remap_foreign_proc_component(Remap), Comps0, Comps),
Instr = foreign_proc_code(A, Comps, B, C, D, E, F, G, H)
;
- Instr0 = computed_goto(Rval0, CodeAddrs),
+ Instr0 = computed_goto(Rval0, MaybeLabels),
remap_rval(Remap, Rval0, Rval),
- Instr = computed_goto(Rval, CodeAddrs)
+ Instr = computed_goto(Rval, MaybeLabels)
;
Instr0 = save_maxfr(Lval0),
remap_lval(Remap, Lval0, Lval),
Index: compiler/jumpopt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/jumpopt.m,v
retrieving revision 1.110
diff -u -b -r1.110 jumpopt.m
--- compiler/jumpopt.m 11 Feb 2008 03:56:08 -0000 1.110
+++ compiler/jumpopt.m 20 Sep 2009 06:38:44 -0000
@@ -105,7 +105,8 @@
Recjump, PessimizeTailCalls, CheckedNondetTailCall, !C, !Instrs,
Mod) :-
some [!Instrmap, !Blockmap, !Lvalmap, !Procmap, !Sdprocmap, !Succmap,
- !Forkmap] (
+ !Forkmap]
+ (
Instrs0 = !.Instrs,
map.init(!:Instrmap),
map.init(!:Blockmap),
@@ -512,14 +513,15 @@
NewRemain = usual_case
)
;
- Uinstr0 = computed_goto(Index, Targets0),
+ Uinstr0 = computed_goto(Index, MaybeTargets0),
% Short-circuit all the destination labels.
- short_maybe_labels(Instrmap, Targets0, Targets),
- ( Targets = Targets0 ->
+ short_maybe_labels(Instrmap, MaybeTargets0, MaybeTargets),
+ ( MaybeTargets = MaybeTargets0 ->
NewRemain = usual_case
;
Shorted = Comment0 ++ " (some shortcircuits)",
- NewInstrs = [llds_instr(computed_goto(Index, Targets), Shorted)],
+ NewInstrs =
+ [llds_instr(computed_goto(Index, MaybeTargets), Shorted)],
NewRemain = specified(NewInstrs, Instrs0)
)
;
Index: compiler/ll_pseudo_type_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ll_pseudo_type_info.m,v
retrieving revision 1.22
diff -u -b -r1.22 ll_pseudo_type_info.m
--- compiler/ll_pseudo_type_info.m 1 Dec 2006 15:04:03 -0000 1.22
+++ compiler/ll_pseudo_type_info.m 10 Sep 2009 00:22:21 -0000
@@ -87,13 +87,13 @@
(
Pseudo = type_var(Int),
Rval = const(llconst_int(Int)),
- LldsType = integer
+ LldsType = lt_integer
;
Pseudo = plain_arity_zero_pseudo_type_info(RttiTypeCtor),
DataAddr = rtti_addr(
ctor_rtti_id(RttiTypeCtor, type_ctor_pseudo_type_info(Pseudo))),
Rval = const(llconst_data_addr(DataAddr, no)),
- LldsType = data_ptr
+ LldsType = lt_data_ptr
;
Pseudo = plain_pseudo_type_info(RttiTypeCtor, Args),
convert_compound_pseudo_type_info(RttiTypeCtor, [], Args,
@@ -117,7 +117,7 @@
DataAddr = rtti_addr(ctor_rtti_id(RttiTypeCtor,
type_ctor_type_info(TypeInfo))),
Rval = const(llconst_data_addr(DataAddr, no)),
- LldsType = data_ptr
+ LldsType = lt_data_ptr
;
TypeInfo = plain_type_info(RttiTypeCtor, Args),
convert_compound_type_info(RttiTypeCtor, [], Args,
@@ -141,7 +141,7 @@
TypeCtorInfoDataAddr = rtti_addr(
ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info)),
TypeCtorInfoRval = const(llconst_data_addr(TypeCtorInfoDataAddr, no)),
- LldsType = data_ptr,
+ LldsType = lt_data_ptr,
list.map_foldl((pred(A::in, AR::out, SCI0::in, SCI::out) is det :-
(
A = pseudo(PTI),
@@ -167,7 +167,7 @@
TypeCtorInfoDataAddr = rtti_addr(
ctor_rtti_id(RttiTypeCtor, TypeCtorInfoData)),
TypeCtorInfoRval = const(llconst_data_addr(TypeCtorInfoDataAddr, no)),
- LldsType = data_ptr,
+ LldsType = lt_data_ptr,
list.map_foldl((pred(A::in, AR::out, SCI0::in, SCI::out) is det :-
convert_plain_type_info(A, SCI0, SCI, AR, _LldsType)
), Args, ArgRvals1, !StaticCellInfo),
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.362
diff -u -b -r1.362 llds.m
--- compiler/llds.m 6 Jan 2009 03:56:25 -0000 1.362
+++ compiler/llds.m 20 Sep 2009 06:38:44 -0000
@@ -1163,42 +1163,45 @@
; entry_label(entry_label_type, proc_label).
:- type code_addr
- ---> code_label(label) % A label defined in this Mercury module.
+ ---> code_label(label)
+ % A label defined in this Mercury module.
+
; code_imported_proc(proc_label)
- % A label for a procedure from another
- % Mercury module.
- ; code_succip % The address in the `succip' register.
- ; do_succeed(bool) % The bool is `yes' if there are any
- % alternatives left. If the bool is `no',
- % we do a succeed_discard() rather than
+ % A label for a procedure from another Mercury module.
+
+ ; code_succip
+ % The address in the `succip' register.
+
+ ; do_succeed(bool)
+ % The bool is `yes' if there are any alternatives left.
+ % If the bool is `no', we do a succeed_discard() rather than
% a succeed().
+
; do_redo
; do_fail
; do_trace_redo_fail_shallow
; do_trace_redo_fail_deep
- % Labels in the runtime, the code at which
- % calls MR_trace with a REDO event and
- % then fails. The shallow variety only does
- % this if the from_full flag was set on
- % entry to the given procedure.
+ % Labels in the runtime, the code at which calls MR_trace with
+ % a REDO event and then fails. The shallow variety only does this
+ % if the from_full flag was set on entry to the given procedure.
+
; do_call_closure(ho_call_variant)
; do_call_class_method(ho_call_variant)
- ; do_not_reached. % We should never jump to this address.
+ ; do_not_reached.
+ % We should never jump to this address.
:- type ho_call_variant
- ---> generic % This calls for the use of one of
- % do_call_closure_compact and
- % do_call_class_method_compact,
- % which work for any number of visible
- % input arguments.
-
- ; specialized_known(int). % If the integer is N, this calls for
- % the use of do_call_closure_N or
- % do_call_class_method_N. These are
- % specialized to assume N visible
- % input arguments.
+ ---> generic
+ % This calls for the use of one of do_call_closure_compact and
+ % do_call_class_method_compact, which work for any number of
+ % visible input arguments.
+
+ ; specialized_known(int).
+ % If the integer is N, this calls for the use of do_call_closure_N
+ % or do_call_class_method_N. These are specialized to assume N
+ % visible input arguments.
% A tag (used in mkword, create and field expressions and in incr_hp
% instructions) is a small integer.
@@ -1210,65 +1213,65 @@
% for a given value to avoid unnecessary boxing/unboxing of floats.
%
:- type llds_type
- ---> bool
+ ---> lt_bool
% A boolean value represented using the C type `MR_Integer'.
- ; int_least8
+ ; lt_int_least8
% A signed value that fits that contains at least eight bits,
% represented using the C type MR_int_least8_t. Intended for use
% in static data declarations, not for data that gets stored in
% registers, stack slots etc.
- ; uint_least8
+ ; lt_uint_least8
% An unsigned version of int_least8, represented using the C type
% MR_uint_least8_t.
- ; int_least16
+ ; lt_int_least16
% A signed value that fits that contains at least sixteen bits,
% represented using the C type MR_int_least16_t. Intended for use
% in static data declarations, not for data that gets stored in
% registers, stack slots etc.
- ; uint_least16
+ ; lt_uint_least16
% An unsigned version of int_least16, represented using the C type
% MR_uint_least16_t.
- ; int_least32
+ ; lt_int_least32
% A signed value that fits that contains at least 32 bits,
% represented using the C type MR_int_least32_t. Intended for use
% in static data declarations, not for data that gets stored in
% registers, stack slots etc.
- ; uint_least32
+ ; lt_uint_least32
% An unsigned version of intleast_32, represented using the C type
% uint_least32_t.
- ; integer
+ ; lt_integer
% A Mercury `int', represented in C as a value of type `MR_Integer'
% (which is a signed integral type of the same size as a pointer).
- ; unsigned
+ ; lt_unsigned
% Something whose C type is `MR_Unsigned' (the unsigned equivalent
% of `MR_Integer').
- ; float
+ ; lt_float
% A Mercury `float', represented in C as a value of type `MR_Float'
% (which may be either `float' or `double', but is usually
% `double').
- ; string
+ ; lt_string
% A Mercury string; represented in C as a value of type
% `MR_String'.
- ; data_ptr
+ ; lt_data_ptr
% A pointer to data; represented in C as a value of C type
% `MR_Word *'.
- ; code_ptr
+ ; lt_code_ptr
% A pointer to code; represented in C as a value of C type
% `MR_Code *'.
- ; word.
+ ; lt_word.
% Something that can be assigned to a value of C type `MR_Word',
% i.e., something whose size is a word but which may be either
% signed or unsigned (used for registers, stack slots, etc).
@@ -1420,27 +1423,27 @@
lval_type(reg(RegType, _), Type) :-
register_type(RegType, Type).
-lval_type(succip, code_ptr).
-lval_type(maxfr, data_ptr).
-lval_type(curfr, data_ptr).
-lval_type(hp, data_ptr).
-lval_type(sp, data_ptr).
-lval_type(parent_sp, data_ptr).
+lval_type(succip, lt_code_ptr).
+lval_type(maxfr, lt_data_ptr).
+lval_type(curfr, lt_data_ptr).
+lval_type(hp, lt_data_ptr).
+lval_type(sp, lt_data_ptr).
+lval_type(parent_sp, lt_data_ptr).
lval_type(temp(RegType, _), Type) :-
register_type(RegType, Type).
-lval_type(stackvar(_), word).
-lval_type(parent_stackvar(_), word).
-lval_type(framevar(_), word).
-lval_type(succip_slot(_), code_ptr).
-lval_type(redoip_slot(_), code_ptr).
-lval_type(redofr_slot(_), data_ptr).
-lval_type(succfr_slot(_), data_ptr).
-lval_type(prevfr_slot(_), data_ptr).
-lval_type(field(_, _, _), word).
+lval_type(stackvar(_), lt_word).
+lval_type(parent_stackvar(_), lt_word).
+lval_type(framevar(_), lt_word).
+lval_type(succip_slot(_), lt_code_ptr).
+lval_type(redoip_slot(_), lt_code_ptr).
+lval_type(redofr_slot(_), lt_data_ptr).
+lval_type(succfr_slot(_), lt_data_ptr).
+lval_type(prevfr_slot(_), lt_data_ptr).
+lval_type(field(_, _, _), lt_word).
lval_type(lvar(_), _) :-
unexpected(this_file, "lvar unexpected in llds.lval_type").
-lval_type(mem_ref(_), word).
-lval_type(global_var_ref(_), word).
+lval_type(mem_ref(_), lt_word).
+lval_type(global_var_ref(_), lt_word).
rval_type(lval(Lval), Type) :-
lval_type(Lval, Type).
@@ -1458,87 +1461,87 @@
% to a pointer, but casts from integer to pointer are OK, it's
% only the reverse direction we need to avoid.
%
-rval_type(mkword(_, _), data_ptr).
+rval_type(mkword(_, _), lt_data_ptr).
rval_type(const(Const), Type) :-
const_type(Const, Type).
rval_type(unop(UnOp, _), Type) :-
unop_return_type(UnOp, Type).
rval_type(binop(BinOp, _, _), Type) :-
binop_return_type(BinOp, Type).
-rval_type(mem_addr(_), data_ptr).
+rval_type(mem_addr(_), lt_data_ptr).
-const_type(llconst_true, bool).
-const_type(llconst_false, bool).
-const_type(llconst_int(_), integer).
+const_type(llconst_true, lt_bool).
+const_type(llconst_false, lt_bool).
+const_type(llconst_int(_), lt_integer).
const_type(llconst_foreign(_, Type), Type).
-const_type(llconst_float(_), float).
-const_type(llconst_string(_), string).
-const_type(llconst_multi_string(_), string).
-const_type(llconst_code_addr(_), code_ptr).
-const_type(llconst_data_addr(_, _), data_ptr).
-
-unop_return_type(mktag, word).
-unop_return_type(tag, word).
-unop_return_type(unmktag, word).
-unop_return_type(strip_tag, word).
-unop_return_type(mkbody, word).
-unop_return_type(unmkbody, word).
-unop_return_type(hash_string, integer).
-unop_return_type(bitwise_complement, integer).
-unop_return_type(logical_not, bool).
-
-unop_arg_type(mktag, word).
-unop_arg_type(tag, word).
-unop_arg_type(unmktag, word).
-unop_arg_type(strip_tag, word).
-unop_arg_type(mkbody, word).
-unop_arg_type(unmkbody, word).
-unop_arg_type(hash_string, string).
-unop_arg_type(bitwise_complement, integer).
-unop_arg_type(logical_not, bool).
-
-binop_return_type(int_add, integer).
-binop_return_type(int_sub, integer).
-binop_return_type(int_mul, integer).
-binop_return_type(int_div, integer).
-binop_return_type(int_mod, integer).
-binop_return_type(unchecked_left_shift, integer).
-binop_return_type(unchecked_right_shift, integer).
-binop_return_type(bitwise_and, integer).
-binop_return_type(bitwise_or, integer).
-binop_return_type(bitwise_xor, integer).
-binop_return_type(logical_and, bool).
-binop_return_type(logical_or, bool).
-binop_return_type(eq, bool).
-binop_return_type(ne, bool).
-binop_return_type(array_index(_Type), word).
-binop_return_type(str_eq, bool).
-binop_return_type(str_ne, bool).
-binop_return_type(str_lt, bool).
-binop_return_type(str_gt, bool).
-binop_return_type(str_le, bool).
-binop_return_type(str_ge, bool).
-binop_return_type(int_lt, bool).
-binop_return_type(int_gt, bool).
-binop_return_type(int_le, bool).
-binop_return_type(int_ge, bool).
-binop_return_type(unsigned_le, bool).
-binop_return_type(float_plus, float).
-binop_return_type(float_minus, float).
-binop_return_type(float_times, float).
-binop_return_type(float_divide, float).
-binop_return_type(float_eq, bool).
-binop_return_type(float_ne, bool).
-binop_return_type(float_lt, bool).
-binop_return_type(float_gt, bool).
-binop_return_type(float_le, bool).
-binop_return_type(float_ge, bool).
-binop_return_type(body, word).
-binop_return_type(compound_eq, bool).
-binop_return_type(compound_lt, bool).
+const_type(llconst_float(_), lt_float).
+const_type(llconst_string(_), lt_string).
+const_type(llconst_multi_string(_), lt_string).
+const_type(llconst_code_addr(_), lt_code_ptr).
+const_type(llconst_data_addr(_, _), lt_data_ptr).
+
+unop_return_type(mktag, lt_word).
+unop_return_type(tag, lt_word).
+unop_return_type(unmktag, lt_word).
+unop_return_type(strip_tag, lt_word).
+unop_return_type(mkbody, lt_word).
+unop_return_type(unmkbody, lt_word).
+unop_return_type(hash_string, lt_integer).
+unop_return_type(bitwise_complement, lt_integer).
+unop_return_type(logical_not, lt_bool).
+
+unop_arg_type(mktag, lt_word).
+unop_arg_type(tag, lt_word).
+unop_arg_type(unmktag, lt_word).
+unop_arg_type(strip_tag, lt_word).
+unop_arg_type(mkbody, lt_word).
+unop_arg_type(unmkbody, lt_word).
+unop_arg_type(hash_string, lt_string).
+unop_arg_type(bitwise_complement, lt_integer).
+unop_arg_type(logical_not, lt_bool).
+
+binop_return_type(int_add, lt_integer).
+binop_return_type(int_sub, lt_integer).
+binop_return_type(int_mul, lt_integer).
+binop_return_type(int_div, lt_integer).
+binop_return_type(int_mod, lt_integer).
+binop_return_type(unchecked_left_shift, lt_integer).
+binop_return_type(unchecked_right_shift, lt_integer).
+binop_return_type(bitwise_and, lt_integer).
+binop_return_type(bitwise_or, lt_integer).
+binop_return_type(bitwise_xor, lt_integer).
+binop_return_type(logical_and, lt_bool).
+binop_return_type(logical_or, lt_bool).
+binop_return_type(eq, lt_bool).
+binop_return_type(ne, lt_bool).
+binop_return_type(array_index(_Type), lt_word).
+binop_return_type(str_eq, lt_bool).
+binop_return_type(str_ne, lt_bool).
+binop_return_type(str_lt, lt_bool).
+binop_return_type(str_gt, lt_bool).
+binop_return_type(str_le, lt_bool).
+binop_return_type(str_ge, lt_bool).
+binop_return_type(int_lt, lt_bool).
+binop_return_type(int_gt, lt_bool).
+binop_return_type(int_le, lt_bool).
+binop_return_type(int_ge, lt_bool).
+binop_return_type(unsigned_le, lt_bool).
+binop_return_type(float_plus, lt_float).
+binop_return_type(float_minus, lt_float).
+binop_return_type(float_times, lt_float).
+binop_return_type(float_divide, lt_float).
+binop_return_type(float_eq, lt_bool).
+binop_return_type(float_ne, lt_bool).
+binop_return_type(float_lt, lt_bool).
+binop_return_type(float_gt, lt_bool).
+binop_return_type(float_le, lt_bool).
+binop_return_type(float_ge, lt_bool).
+binop_return_type(body, lt_word).
+binop_return_type(compound_eq, lt_bool).
+binop_return_type(compound_lt, lt_bool).
-register_type(reg_r, word).
-register_type(reg_f, float).
+register_type(reg_r, lt_word).
+register_type(reg_f, lt_float).
get_proc_label(entry_label(_, ProcLabel)) = ProcLabel.
get_proc_label(internal_label(_, ProcLabel)) = ProcLabel.
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.330
diff -u -b -r1.330 llds_out.m
--- compiler/llds_out.m 16 Jul 2009 02:48:52 -0000 1.330
+++ compiler/llds_out.m 20 Sep 2009 06:38:44 -0000
@@ -1889,24 +1889,38 @@
:- pred output_instr_decls(map(label, data_addr)::in, instr::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
-output_instr_decls(_, comment(_), !DeclSet, !IO).
-output_instr_decls(_, livevals(_), !DeclSet, !IO).
-output_instr_decls( StackLayoutLabels, block(_TempR, _TempF, Instrs),
- !DeclSet, !IO) :-
+output_instr_decls(StackLayoutLabels, Instr, !DeclSet, !IO) :-
+ (
+ ( Instr = comment(_)
+ ; Instr = livevals(_)
+ ; Instr = arbitrary_c_code(_, _, _)
+ ; Instr = label(_)
+ ; Instr = push_region_frame(_, _)
+ ; Instr = use_and_maybe_pop_region_frame(_, _)
+ ; Instr = discard_ticket
+ ; Instr = prune_ticket
+ ; Instr = incr_sp(_, _, _)
+ ; Instr = decr_sp(_)
+ ; Instr = decr_sp_and_return(_)
+ )
+ ;
+ Instr = block(_TempR, _TempF, Instrs),
list.foldl2(output_instruction_decls(StackLayoutLabels), Instrs,
- !DeclSet, !IO).
-output_instr_decls(_, assign(Lval, Rval), !DeclSet, !IO) :-
+ !DeclSet, !IO)
+ ;
+ Instr = assign(Lval, Rval),
output_lval_decls(Lval, !DeclSet, !IO),
- output_rval_decls(Rval, !DeclSet, !IO).
-output_instr_decls(_, keep_assign(Lval, Rval), !DeclSet, !IO) :-
+ output_rval_decls(Rval, !DeclSet, !IO)
+ ;
+ Instr = keep_assign(Lval, Rval),
output_lval_decls(Lval, !DeclSet, !IO),
- output_rval_decls(Rval, !DeclSet, !IO).
-output_instr_decls(_, llcall(Target, ContLabel, _, _, _, _), !DeclSet, !IO) :-
+ output_rval_decls(Rval, !DeclSet, !IO)
+ ;
+ Instr = llcall(Target, ContLabel, _, _, _, _),
output_code_addr_decls(Target, !DeclSet, !IO),
- output_code_addr_decls(ContLabel, !DeclSet, !IO).
-output_instr_decls(_, arbitrary_c_code(_, _, _), !DeclSet, !IO).
-output_instr_decls(_, mkframe(FrameInfo, MaybeFailureContinuation),
- !DeclSet, !IO) :-
+ output_code_addr_decls(ContLabel, !DeclSet, !IO)
+ ;
+ Instr = mkframe(FrameInfo, MaybeFailureContinuation),
(
FrameInfo = ordinary_frame(_, _, yes(Struct)),
Struct = foreign_proc_struct(StructName, StructFields,
@@ -1941,21 +1955,26 @@
output_code_addr_decls(FailureContinuation, !DeclSet, !IO)
;
MaybeFailureContinuation = no
- ).
-output_instr_decls(_, label(_), !DeclSet, !IO).
-output_instr_decls(_, goto(CodeAddr), !DeclSet, !IO) :-
- output_code_addr_decls(CodeAddr, !DeclSet, !IO).
-output_instr_decls(_, computed_goto(Rval, _Labels), !DeclSet, !IO) :-
- output_rval_decls(Rval, !DeclSet, !IO).
-output_instr_decls(_, if_val(Rval, Target), !DeclSet, !IO) :-
+ )
+ ;
+ Instr = goto(CodeAddr),
+ output_code_addr_decls(CodeAddr, !DeclSet, !IO)
+ ;
+ Instr = computed_goto(Rval, _MaybeLabels),
+ output_rval_decls(Rval, !DeclSet, !IO)
+ ;
+ Instr = if_val(Rval, Target),
output_rval_decls(Rval, !DeclSet, !IO),
- output_code_addr_decls(Target, !DeclSet, !IO).
-output_instr_decls(_, save_maxfr(Lval), !DeclSet, !IO) :-
- output_lval_decls(Lval, !DeclSet, !IO).
-output_instr_decls(_, restore_maxfr(Lval), !DeclSet, !IO) :-
- output_lval_decls(Lval, !DeclSet, !IO).
-output_instr_decls(_, incr_hp(Lval, _Tag, _, Rval, _, _, MaybeRegionRval,
- MaybeReuse), !DeclSet, !IO) :-
+ output_code_addr_decls(Target, !DeclSet, !IO)
+ ;
+ Instr = save_maxfr(Lval),
+ output_lval_decls(Lval, !DeclSet, !IO)
+ ;
+ Instr = restore_maxfr(Lval),
+ output_lval_decls(Lval, !DeclSet, !IO)
+ ;
+ Instr = incr_hp(Lval, _Tag, _, Rval, _, _, MaybeRegionRval,
+ MaybeReuse),
output_lval_decls(Lval, !DeclSet, !IO),
output_rval_decls(Rval, !DeclSet, !IO),
(
@@ -1975,40 +1994,40 @@
)
;
MaybeReuse = no_llds_reuse
- ).
-output_instr_decls(_, mark_hp(Lval), !DeclSet, !IO) :-
- output_lval_decls(Lval, !DeclSet, !IO).
-output_instr_decls(_, restore_hp(Rval), !DeclSet, !IO) :-
- output_rval_decls(Rval, !DeclSet, !IO).
-output_instr_decls(_, free_heap(Rval), !DeclSet, !IO) :-
- output_rval_decls(Rval, !DeclSet, !IO).
-output_instr_decls(_, push_region_frame(_StackId, _EmbeddedFrame),
- !DeclSet, !IO).
-output_instr_decls(_, region_fill_frame(_FillOp, _EmbeddedFrame, IdRval,
- NumLval, AddrLval), !DeclSet, !IO) :-
+ )
+ ;
+ Instr = mark_hp(Lval),
+ output_lval_decls(Lval, !DeclSet, !IO)
+ ;
+ Instr = restore_hp(Rval),
+ output_rval_decls(Rval, !DeclSet, !IO)
+ ;
+ Instr = free_heap(Rval),
+ output_rval_decls(Rval, !DeclSet, !IO)
+ ;
+ Instr = region_fill_frame(_FillOp, _EmbeddedFrame, IdRval,
+ NumLval, AddrLval),
output_rval_decls(IdRval, !DeclSet, !IO),
output_lval_decls(NumLval, !DeclSet, !IO),
- output_lval_decls(AddrLval, !DeclSet, !IO).
-output_instr_decls(_, region_set_fixed_slot(_SetOp, _EmbeddedFrame, ValueRval),
- !DeclSet, !IO) :-
- output_rval_decls(ValueRval, !DeclSet, !IO).
-output_instr_decls(_, use_and_maybe_pop_region_frame(_UseOp, _EmbeddedFrame),
- !DeclSet, !IO).
-output_instr_decls(_, store_ticket(Lval), !DeclSet, !IO) :-
- output_lval_decls(Lval, !DeclSet, !IO).
-output_instr_decls(_, reset_ticket(Rval, _Reason), !DeclSet, !IO) :-
- output_rval_decls(Rval, !DeclSet, !IO).
-output_instr_decls(_, discard_ticket, !DeclSet, !IO).
-output_instr_decls(_, prune_ticket, !DeclSet, !IO).
-output_instr_decls(_, mark_ticket_stack(Lval), !DeclSet, !IO) :-
- output_lval_decls(Lval, !DeclSet, !IO).
-output_instr_decls(_, prune_tickets_to(Rval), !DeclSet, !IO) :-
- output_rval_decls(Rval, !DeclSet, !IO).
-output_instr_decls(_, incr_sp(_, _, _), !DeclSet, !IO).
-output_instr_decls(_, decr_sp(_), !DeclSet, !IO).
-output_instr_decls(_, decr_sp_and_return(_), !DeclSet, !IO).
-output_instr_decls(StackLayoutLabels, foreign_proc_code(_, Comps, _, _,
- MaybeLayoutLabel, MaybeOnlyLayoutLabel, _, _, _), !DeclSet, !IO) :-
+ output_lval_decls(AddrLval, !DeclSet, !IO)
+ ;
+ Instr = region_set_fixed_slot(_SetOp, _EmbeddedFrame, ValueRval),
+ output_rval_decls(ValueRval, !DeclSet, !IO)
+ ;
+ Instr = store_ticket(Lval),
+ output_lval_decls(Lval, !DeclSet, !IO)
+ ;
+ Instr = reset_ticket(Rval, _Reason),
+ output_rval_decls(Rval, !DeclSet, !IO)
+ ;
+ Instr = mark_ticket_stack(Lval),
+ output_lval_decls(Lval, !DeclSet, !IO)
+ ;
+ Instr = prune_tickets_to(Rval),
+ output_rval_decls(Rval, !DeclSet, !IO)
+ ;
+ Instr = foreign_proc_code(_, Comps, _, _,
+ MaybeLayoutLabel, MaybeOnlyLayoutLabel, _, _, _),
(
MaybeLayoutLabel = yes(Label),
map.lookup(StackLayoutLabels, Label, DataAddr),
@@ -2023,15 +2042,19 @@
;
MaybeOnlyLayoutLabel = no
),
- list.foldl2(output_foreign_proc_component_decls, Comps, !DeclSet, !IO).
-output_instr_decls(_, init_sync_term(Lval, _), !DeclSet, !IO) :-
- output_lval_decls(Lval, !DeclSet, !IO).
-output_instr_decls(_, fork_new_child(Lval, Child), !DeclSet, !IO) :-
- output_code_addr_decls(code_label(Child), !DeclSet, !IO),
- output_lval_decls(Lval, !DeclSet, !IO).
-output_instr_decls(_, join_and_continue(Lval, Label), !DeclSet, !IO) :-
+ list.foldl2(output_foreign_proc_component_decls, Comps, !DeclSet, !IO)
+ ;
+ Instr = init_sync_term(Lval, _),
+ output_lval_decls(Lval, !DeclSet, !IO)
+ ;
+ Instr = fork_new_child(Lval, Child),
+ output_lval_decls(Lval, !DeclSet, !IO),
+ output_code_addr_decls(code_label(Child), !DeclSet, !IO)
+ ;
+ Instr = join_and_continue(Lval, Label),
output_lval_decls(Lval, !DeclSet, !IO),
- output_code_addr_decls(code_label(Label), !DeclSet, !IO).
+ output_code_addr_decls(code_label(Label), !DeclSet, !IO)
+ ).
:- pred output_foreign_proc_component_decls(foreign_proc_component::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
@@ -2261,55 +2284,56 @@
:- pred output_instruction(instr::in, pair(label, set_tree234(label))::in,
io::di, io::uo) is det.
-output_instruction(comment(Comment), _, !IO) :-
+output_instruction(Instr, ProfInfo, !IO) :-
+ (
+ Instr = comment(Comment),
% Ensure that any comments embedded inside Comment are made safe, i.e.
- % prevent the closing of embedded comments from closing the outer comment.
- % The fact that the code here is not very efficient doesn't matter since
- % we write out comments only with --auto-comments, which we enable only
- % when we want to debug the generated C code.
+ % prevent the closing of embedded comments from closing the outer
+ % comment. The fact that the code here is not very efficient doesn't
+ % matter since we write out comments only with --auto-comments,
+ % which we enable only when we want to debug the generated C code.
io.write_string("/*", !IO),
string.to_char_list(Comment, CommentChars),
output_comment_chars('*', CommentChars, !IO),
- io.write_string("*/\n", !IO).
-
-output_instruction(livevals(LiveVals), _, !IO) :-
+ io.write_string("*/\n", !IO)
+ ;
+ Instr = livevals(LiveVals),
io.write_string("/*\n* Live lvalues:\n", !IO),
set.to_sorted_list(LiveVals, LiveValsList),
output_livevals(LiveValsList, !IO),
- io.write_string("*/\n", !IO).
-
-output_instruction(block(TempR, TempF, Instrs), ProfInfo, !IO) :-
+ io.write_string("*/\n", !IO)
+ ;
+ Instr = block(TempR, TempF, Instrs),
output_block_start(TempR, TempF, !IO),
globals.io_lookup_bool_option(auto_comments, PrintComments, !IO),
output_instruction_list(Instrs, PrintComments, ProfInfo,
set_tree234.init, !IO),
- output_block_end(!IO).
-
-output_instruction(assign(Lval, Rval), _, !IO) :-
+ output_block_end(!IO)
+ ;
+ Instr = assign(Lval, Rval),
io.write_string("\t", !IO),
output_lval_for_assign(Lval, Type, !IO),
io.write_string(" = ", !IO),
output_rval_as_type(Rval, Type, !IO),
- io.write_string(";\n", !IO).
-
-output_instruction(keep_assign(Lval, Rval), _, !IO) :-
+ io.write_string(";\n", !IO)
+ ;
+ Instr = keep_assign(Lval, Rval),
io.write_string("\t", !IO),
output_lval_for_assign(Lval, Type, !IO),
io.write_string(" = ", !IO),
output_rval_as_type(Rval, Type, !IO),
- io.write_string(";\n", !IO).
-
-output_instruction(llcall(Target, ContLabel, LiveVals, _, _, _), ProfInfo,
- !IO) :-
+ io.write_string(";\n", !IO)
+ ;
+ Instr = llcall(Target, ContLabel, LiveVals, _, _, _),
ProfInfo = CallerLabel - _,
output_call(Target, ContLabel, CallerLabel, !IO),
- output_gc_livevals(LiveVals, !IO).
-
-output_instruction(arbitrary_c_code(_, _, C_Code), _, !IO) :-
+ output_gc_livevals(LiveVals, !IO)
+ ;
+ Instr = arbitrary_c_code(_, _, C_Code),
io.write_string("\t", !IO),
- io.write_string(C_Code, !IO).
-
-output_instruction(mkframe(FrameInfo, MaybeFailCont), _, !IO) :-
+ io.write_string(C_Code, !IO)
+ ;
+ Instr = mkframe(FrameInfo, MaybeFailCont),
(
FrameInfo = ordinary_frame(Msg, Num, MaybeStruct),
(
@@ -2381,9 +2405,9 @@
),
io.write_string(");\n", !IO)
)
- ).
-
-output_instruction(label(Label), ProfInfo, !IO) :-
+ )
+ ;
+ Instr = label(Label),
output_label_defn(Label, !IO),
globals.io_lookup_bool_option(local_thread_engine_base,
LocalThreadEngineBase, !IO),
@@ -2393,40 +2417,40 @@
;
LocalThreadEngineBase = no
),
- maybe_output_update_prof_counter(Label, ProfInfo, !IO).
-
-output_instruction(goto(CodeAddr), ProfInfo, !IO) :-
+ maybe_output_update_prof_counter(Label, ProfInfo, !IO)
+ ;
+ Instr = goto(CodeAddr),
ProfInfo = CallerLabel - _,
io.write_string("\t", !IO),
- output_goto(CodeAddr, CallerLabel, !IO).
-
-output_instruction(computed_goto(Rval, Labels), _, !IO) :-
+ output_goto(CodeAddr, CallerLabel, !IO)
+ ;
+ Instr = computed_goto(Rval, MaybeLabels),
io.write_string("\tMR_COMPUTED_GOTO(", !IO),
- output_rval_as_type(Rval, unsigned, !IO),
+ output_rval_as_type(Rval, lt_unsigned, !IO),
io.write_string(",\n\t\t", !IO),
- output_label_list_or_not_reached(Labels, !IO),
- io.write_string(");\n", !IO).
-
-output_instruction(if_val(Rval, Target), ProfInfo, !IO) :-
+ output_label_list_or_not_reached(MaybeLabels, !IO),
+ io.write_string(");\n", !IO)
+ ;
+ Instr = if_val(Rval, Target),
ProfInfo = CallerLabel - _,
io.write_string("\tif (", !IO),
output_test_rval(Rval, !IO),
io.write_string(") {\n\t\t", !IO),
output_goto(Target, CallerLabel, !IO),
- io.write_string("\t}\n", !IO).
-
-output_instruction(save_maxfr(Lval), _, !IO) :-
+ io.write_string("\t}\n", !IO)
+ ;
+ Instr = save_maxfr(Lval),
io.write_string("\tMR_save_maxfr(", !IO),
output_lval(Lval, !IO),
- io.write_string(");\n", !IO).
-
-output_instruction(restore_maxfr(Lval), _, !IO) :-
+ io.write_string(");\n", !IO)
+ ;
+ Instr = restore_maxfr(Lval),
io.write_string("\tMR_restore_maxfr(", !IO),
output_lval(Lval, !IO),
- io.write_string(");\n", !IO).
-
-output_instruction(incr_hp(Lval, MaybeTag, MaybeOffset, SizeRval, TypeMsg,
- MayUseAtomicAlloc, MaybeRegionRval, MaybeReuse), ProfInfo, !IO) :-
+ io.write_string(");\n", !IO)
+ ;
+ Instr = incr_hp(Lval, MaybeTag, MaybeOffset, SizeRval, TypeMsg,
+ MayUseAtomicAlloc, MaybeRegionRval, MaybeReuse),
io.write_string("\t", !IO),
(
MaybeReuse = no_llds_reuse,
@@ -2472,24 +2496,24 @@
TypeMsg, MayUseAtomicAlloc, MaybeRegionRval, ProfInfo, !IO),
io.write_string(")", !IO)
),
- io.write_string(";\n", !IO).
-
-output_instruction(mark_hp(Lval), _, !IO) :-
+ io.write_string(";\n", !IO)
+ ;
+ Instr = mark_hp(Lval),
io.write_string("\tMR_mark_hp(", !IO),
output_lval_as_word(Lval, !IO),
- io.write_string(");\n", !IO).
-
-output_instruction(restore_hp(Rval), _, !IO) :-
+ io.write_string(");\n", !IO)
+ ;
+ Instr = restore_hp(Rval),
io.write_string("\tMR_restore_hp(", !IO),
- output_rval_as_type(Rval, word, !IO),
- io.write_string(");\n", !IO).
-
-output_instruction(free_heap(Rval), _, !IO) :-
+ output_rval_as_type(Rval, lt_word, !IO),
+ io.write_string(");\n", !IO)
+ ;
+ Instr = free_heap(Rval),
io.write_string("\tMR_free_heap(", !IO),
- output_rval_as_type(Rval, data_ptr, !IO),
- io.write_string(");\n", !IO).
-
-output_instruction(push_region_frame(StackId, EmbeddedFrame), _, !IO) :-
+ output_rval_as_type(Rval, lt_data_ptr, !IO),
+ io.write_string(");\n", !IO)
+ ;
+ Instr = push_region_frame(StackId, EmbeddedFrame),
(
StackId = region_stack_ite,
io.write_string("\tMR_push_region_ite_frame", !IO)
@@ -2511,10 +2535,10 @@
int_to_string(LastSlot) ++ " */",
io.write_string(Comment, !IO),
- io.write_string("\n", !IO).
-
-output_instruction(region_fill_frame(FillOp, EmbeddedFrame, IdRval,
- NumLval, AddrLval), _, !IO) :-
+ io.write_string("\n", !IO)
+ ;
+ Instr = region_fill_frame(FillOp, EmbeddedFrame, IdRval,
+ NumLval, AddrLval),
(
FillOp = region_fill_ite_protect,
io.write_string("\tMR_region_fill_ite_protect", !IO)
@@ -2542,10 +2566,9 @@
output_lval(NumLval, !IO),
io.write_string(", ", !IO),
output_lval(AddrLval, !IO),
- io.write_string(");\n", !IO).
-
-output_instruction(region_set_fixed_slot(SetOp, EmbeddedFrame, ValueRval),
- _, !IO) :-
+ io.write_string(");\n", !IO)
+ ;
+ Instr = region_set_fixed_slot(SetOp, EmbeddedFrame, ValueRval),
(
SetOp = region_set_ite_num_protects,
io.write_string("\tMR_region_set_ite_num_protects", !IO)
@@ -2566,10 +2589,9 @@
output_embedded_frame_addr(EmbeddedFrame, !IO),
io.write_string(", ", !IO),
output_rval(ValueRval, !IO),
- io.write_string(");\n", !IO).
-
-output_instruction(use_and_maybe_pop_region_frame(UseOp, EmbeddedFrame),
- _, !IO) :-
+ io.write_string(");\n", !IO)
+ ;
+ Instr = use_and_maybe_pop_region_frame(UseOp, EmbeddedFrame),
(
UseOp = region_ite_then(region_ite_semidet_cond),
io.write_string("\tMR_use_region_ite_then_semidet", !IO)
@@ -2603,37 +2625,37 @@
),
io.write_string("(", !IO),
output_embedded_frame_addr(EmbeddedFrame, !IO),
- io.write_string(");\n", !IO).
-
-output_instruction(store_ticket(Lval), _, !IO) :-
+ io.write_string(");\n", !IO)
+ ;
+ Instr = store_ticket(Lval),
io.write_string("\tMR_store_ticket(", !IO),
output_lval_as_word(Lval, !IO),
- io.write_string(");\n", !IO).
-
-output_instruction(reset_ticket(Rval, Reason), _, !IO) :-
+ io.write_string(");\n", !IO)
+ ;
+ Instr = reset_ticket(Rval, Reason),
io.write_string("\tMR_reset_ticket(", !IO),
- output_rval_as_type(Rval, word, !IO),
+ output_rval_as_type(Rval, lt_word, !IO),
io.write_string(", ", !IO),
output_reset_trail_reason(Reason, !IO),
- io.write_string(");\n", !IO).
-
-output_instruction(discard_ticket, _, !IO) :-
- io.write_string("\tMR_discard_ticket();\n", !IO).
-
-output_instruction(prune_ticket, _, !IO) :-
- io.write_string("\tMR_prune_ticket();\n", !IO).
-
-output_instruction(mark_ticket_stack(Lval), _, !IO) :-
+ io.write_string(");\n", !IO)
+ ;
+ Instr = discard_ticket,
+ io.write_string("\tMR_discard_ticket();\n", !IO)
+ ;
+ Instr = prune_ticket,
+ io.write_string("\tMR_prune_ticket();\n", !IO)
+ ;
+ Instr = mark_ticket_stack(Lval),
io.write_string("\tMR_mark_ticket_stack(", !IO),
output_lval_as_word(Lval, !IO),
- io.write_string(");\n", !IO).
-
-output_instruction(prune_tickets_to(Rval), _, !IO) :-
+ io.write_string(");\n", !IO)
+ ;
+ Instr = prune_tickets_to(Rval),
io.write_string("\tMR_prune_tickets_to(", !IO),
- output_rval_as_type(Rval, word, !IO),
- io.write_string(");\n", !IO).
-
-output_instruction(incr_sp(N, _Msg, Kind), _, !IO) :-
+ output_rval_as_type(Rval, lt_word, !IO),
+ io.write_string(");\n", !IO)
+ ;
+ Instr = incr_sp(N, _Msg, Kind),
(
Kind = stack_incr_leaf,
( N < max_leaf_stack_frame_size ->
@@ -2646,52 +2668,52 @@
io.write_string("\tMR_incr_sp(", !IO)
),
io.write_int(N, !IO),
- io.write_string(");\n", !IO).
+ io.write_string(");\n", !IO)
% Use the code below instead of the code above if you want to run
% tools/framesize on the output of the compiler.
% io.write_string("\tMR_incr_sp_push_msg(", !IO),
% io.write_int(N, !IO),
% io.write_string(", """, !IO),
% c_util.output_quoted_string(Msg, !IO),
- % io.write_string(""");\n", !IO).
-
-output_instruction(decr_sp(N), _, !IO) :-
+ % io.write_string(""");\n", !IO)
+ ;
+ Instr = decr_sp(N),
io.write_string("\tMR_decr_sp(", !IO),
io.write_int(N, !IO),
- io.write_string(");\n", !IO).
-
-output_instruction(decr_sp_and_return(N), _, !IO) :-
+ io.write_string(");\n", !IO)
+ ;
+ Instr = decr_sp_and_return(N),
io.write_string("\tMR_decr_sp_and_return(", !IO),
io.write_int(N, !IO),
- io.write_string(");\n", !IO).
-
-output_instruction(foreign_proc_code(Decls, Components, _, _, _, _, _, _, _),
- _, !IO) :-
+ io.write_string(");\n", !IO)
+ ;
+ Instr = foreign_proc_code(Decls, Components, _, _, _, _, _, _, _),
io.write_string("\t{\n", !IO),
output_foreign_proc_decls(Decls, !IO),
list.foldl(output_foreign_proc_component, Components, !IO),
- io.write_string("\t}\n", !IO).
-
-output_instruction(init_sync_term(Lval, N), _, !IO) :-
+ io.write_string("\t}\n", !IO)
+ ;
+ Instr = init_sync_term(Lval, N),
io.write_string("\tMR_init_sync_term(", !IO),
output_lval_as_word(Lval, !IO),
io.write_string(", ", !IO),
io.write_int(N, !IO),
- io.write_string(");\n", !IO).
-
-output_instruction(fork_new_child(Lval, Child), _, !IO) :-
+ io.write_string(");\n", !IO)
+ ;
+ Instr = fork_new_child(Lval, Child),
io.write_string("\tMR_fork_new_child(", !IO),
output_lval_as_word(Lval, !IO),
io.write_string(", ", !IO),
output_label_as_code_addr(Child, !IO),
- io.write_string(");\n", !IO).
-
-output_instruction(join_and_continue(Lval, Label), _, !IO) :-
+ io.write_string(");\n", !IO)
+ ;
+ Instr = join_and_continue(Lval, Label),
io.write_string("\tMR_join_and_continue(", !IO),
output_lval(Lval, !IO),
io.write_string(", ", !IO),
output_label_as_code_addr(Label, !IO),
- io.write_string(");\n", !IO).
+ io.write_string(");\n", !IO)
+ ).
:- pred output_incr_hp_no_reuse(lval::in, maybe(tag)::in, maybe(int)::in,
rval::in, string::in, may_use_atomic_alloc::in, maybe(rval)::in,
@@ -2715,7 +2737,7 @@
io.write_string(", ", !IO),
output_rval(RegionRval, !IO),
io.write_string(", ", !IO),
- output_rval_as_type(Rval, word, !IO),
+ output_rval_as_type(Rval, lt_word, !IO),
io.write_string(")", !IO)
;
MaybeRegionRval = no,
@@ -2755,7 +2777,7 @@
io.write_int(Offset, !IO),
io.write_string(", ", !IO)
),
- output_rval_as_type(Rval, word, !IO),
+ output_rval_as_type(Rval, lt_word, !IO),
io.write_string(", ", !IO),
ProfInfo = CallerLabel - _,
output_label(CallerLabel, !IO),
@@ -2823,7 +2845,7 @@
;
MaybeOffset = no
),
- output_rval_as_type(Rval, word, !IO),
+ output_rval_as_type(Rval, lt_word, !IO),
io.write_string(")", !IO)
)
).
@@ -2843,7 +2865,7 @@
output_embedded_frame_addr(EmbeddedFrame, !IO) :-
EmbeddedFrame = embedded_stack_frame_id(MainStackId, _FirstSlot, LastSlot),
FrameStartRval = stack_slot_num_to_lval_ref(MainStackId, LastSlot),
- output_rval_as_type(FrameStartRval, data_ptr, !IO).
+ output_rval_as_type(FrameStartRval, lt_data_ptr, !IO).
:- func max_leaf_stack_frame_size = int.
@@ -2969,7 +2991,7 @@
BoxPolicy = always_boxed,
io.write_string(VarName, !IO),
io.write_string(" = ", !IO),
- output_rval_as_type(Rval, word, !IO)
+ output_rval_as_type(Rval, lt_word, !IO)
;
BoxPolicy = native_if_possible,
(
@@ -2993,12 +3015,12 @@
io.write_string(VarName, !IO),
io.write_string(" = ", !IO),
io.write_string("(" ++ ForeignType ++ ") ", !IO),
- output_rval_as_type(Rval, word, !IO)
+ output_rval_as_type(Rval, lt_word, !IO)
;
io.write_string("MR_MAYBE_UNBOX_FOREIGN_TYPE(", !IO),
io.write_string(ForeignType, !IO),
io.write_string(", ", !IO),
- output_rval_as_type(Rval, word, !IO),
+ output_rval_as_type(Rval, lt_word, !IO),
io.write_string(", ", !IO),
io.write_string(VarName, !IO),
io.write_string(")", !IO)
@@ -3008,12 +3030,12 @@
io.write_string(VarName, !IO),
io.write_string(" = ", !IO),
( OrigType = builtin_type(builtin_type_string) ->
- output_llds_type_cast(string, !IO),
- output_rval_as_type(Rval, word, !IO)
+ output_llds_type_cast(lt_string, !IO),
+ output_rval_as_type(Rval, lt_word, !IO)
; OrigType = builtin_type(builtin_type_float) ->
- output_rval_as_type(Rval, float, !IO)
+ output_rval_as_type(Rval, lt_float, !IO)
;
- output_rval_as_type(Rval, word, !IO)
+ output_rval_as_type(Rval, lt_word, !IO)
)
)
),
@@ -3072,7 +3094,7 @@
( list.member(foreign_type_can_pass_as_mercury_type, Assertions) ->
output_lval_as_word(Lval, !IO),
io.write_string(" = ", !IO),
- output_llds_type_cast(word, !IO),
+ output_llds_type_cast(lt_word, !IO),
io.write_string(VarName, !IO)
;
io.write_string("MR_MAYBE_BOX_FOREIGN_TYPE(", !IO),
@@ -3090,7 +3112,7 @@
(
OrigType = builtin_type(builtin_type_string)
->
- output_llds_type_cast(word, !IO),
+ output_llds_type_cast(lt_word, !IO),
io.write_string(VarName, !IO)
;
OrigType = builtin_type(builtin_type_float)
@@ -3370,7 +3392,7 @@
output_indent(FirstIndent, LaterIndent, !.N, !IO),
!:N = !.N + 1,
io.write_string("static const ", !IO),
- output_llds_type(float, !IO),
+ output_llds_type(lt_float, !IO),
io.write_string(" mercury_float_const_", !IO),
io.write_string(FloatName, !IO),
io.write_string(" = ", !IO),
@@ -3378,11 +3400,11 @@
% compiler evaluate it, rather than evaluating it ourselves.
% This avoids having to deal with some nasty issues regarding
% floating point accuracy when doing cross-compilation.
- output_rval_as_type(Rval1, float, !IO),
+ output_rval_as_type(Rval1, lt_float, !IO),
io.write_string(" ", !IO),
io.write_string(OpStr, !IO),
io.write_string(" ", !IO),
- output_rval_as_type(Rval2, float, !IO),
+ output_rval_as_type(Rval2, lt_float, !IO),
io.write_string(";\n", !IO)
)
;
@@ -3584,33 +3606,33 @@
:- pred output_llds_type(llds_type::in, io::di, io::uo) is det.
-output_llds_type(int_least8, !IO) :-
+output_llds_type(lt_int_least8, !IO) :-
io.write_string("MR_int_least8_t", !IO).
-output_llds_type(uint_least8, !IO) :-
+output_llds_type(lt_uint_least8, !IO) :-
io.write_string("MR_uint_least8_t", !IO).
-output_llds_type(int_least16, !IO) :-
+output_llds_type(lt_int_least16, !IO) :-
io.write_string("MR_int_least16_t", !IO).
-output_llds_type(uint_least16, !IO) :-
+output_llds_type(lt_uint_least16, !IO) :-
io.write_string("MR_uint_least16_t", !IO).
-output_llds_type(int_least32, !IO) :-
+output_llds_type(lt_int_least32, !IO) :-
io.write_string("MR_int_least32_t", !IO).
-output_llds_type(uint_least32, !IO) :-
+output_llds_type(lt_uint_least32, !IO) :-
io.write_string("MR_uint_least32_t", !IO).
-output_llds_type(bool, !IO) :-
+output_llds_type(lt_bool, !IO) :-
io.write_string("MR_Integer", !IO).
-output_llds_type(integer, !IO) :-
+output_llds_type(lt_integer, !IO) :-
io.write_string("MR_Integer", !IO).
-output_llds_type(unsigned, !IO) :-
+output_llds_type(lt_unsigned, !IO) :-
io.write_string("MR_Unsigned", !IO).
-output_llds_type(float, !IO) :-
+output_llds_type(lt_float, !IO) :-
io.write_string("MR_Float", !IO).
-output_llds_type(word, !IO) :-
+output_llds_type(lt_word, !IO) :-
io.write_string("MR_Word", !IO).
-output_llds_type(string, !IO) :-
+output_llds_type(lt_string, !IO) :-
io.write_string("MR_String", !IO).
-output_llds_type(data_ptr, !IO) :-
+output_llds_type(lt_data_ptr, !IO) :-
io.write_string("MR_Word *", !IO).
-output_llds_type(code_ptr, !IO) :-
+output_llds_type(lt_code_ptr, !IO) :-
io.write_string("MR_Code *", !IO).
:- pred output_common_cell_value(common_cell_value::in, io::di, io::uo) is det.
@@ -3772,29 +3794,29 @@
:- pred ok_int_const(int::in, llds_type::in) is semidet.
:- pragma inline(ok_int_const/2).
-ok_int_const(N, int_least8) :-
+ok_int_const(N, lt_int_least8) :-
-128 =< N, N < 128.
-ok_int_const(N, uint_least8) :-
+ok_int_const(N, lt_uint_least8) :-
0 =< N, N < 256.
-ok_int_const(N, int_least16) :-
+ok_int_const(N, lt_int_least16) :-
-32768 =< N, N < 32768.
-ok_int_const(N, uint_least16) :-
+ok_int_const(N, lt_uint_least16) :-
0 =< N, N < 65536.
-ok_int_const(_N, int_least32).
-ok_int_const(_N, uint_least32).
-ok_int_const(_N, bool) :-
+ok_int_const(_N, lt_int_least32).
+ok_int_const(_N, lt_uint_least32).
+ok_int_const(_N, lt_bool) :-
unexpected(this_file, "ok_int_const: not integer constant").
-ok_int_const(_N, integer).
-ok_int_const(_N, unsigned).
-ok_int_const(_, float) :-
+ok_int_const(_N, lt_integer).
+ok_int_const(_N, lt_unsigned).
+ok_int_const(_, lt_float) :-
unexpected(this_file, "ok_int_const: not integer constant").
-ok_int_const(_, word) :-
+ok_int_const(_, lt_word) :-
unexpected(this_file, "ok_int_const: not integer constant").
-ok_int_const(_, string) :-
+ok_int_const(_, lt_string) :-
unexpected(this_file, "ok_int_const: not integer constant").
-ok_int_const(_, data_ptr) :-
+ok_int_const(_, lt_data_ptr) :-
unexpected(this_file, "ok_int_const: not integer constant").
-ok_int_const(_, code_ptr) :-
+ok_int_const(_, lt_code_ptr) :-
unexpected(this_file, "ok_int_const: not integer constant").
%-----------------------------------------------------------------------------%
@@ -4743,14 +4765,14 @@
% We need to convert to the right type first.
% Convertions to/from float must be treated specially;
% for the others, we can just use a cast.
- ( DesiredType = float ->
+ ( DesiredType = lt_float ->
io.write_string("MR_word_to_float(", !IO),
output_rval(Rval, !IO),
io.write_string(")", !IO)
- ; ActualType = float ->
- ( DesiredType = word ->
+ ; ActualType = lt_float ->
+ ( DesiredType = lt_word ->
output_float_rval_as_word(Rval, !IO)
- ; DesiredType = data_ptr ->
+ ; DesiredType = lt_data_ptr ->
output_float_rval_as_data_ptr(Rval, !IO)
;
unexpected(this_file, "output_rval_as_type: type error")
@@ -4783,13 +4805,13 @@
:- pred types_match(llds_type::in, llds_type::in) is semidet.
types_match(Type, Type).
-types_match(word, unsigned).
-types_match(word, integer).
-types_match(word, bool).
-types_match(bool, integer).
-types_match(bool, unsigned).
-types_match(bool, word).
-types_match(integer, bool).
+types_match(lt_word, lt_unsigned).
+types_match(lt_word, lt_integer).
+types_match(lt_word, lt_bool).
+types_match(lt_bool, lt_integer).
+types_match(lt_bool, lt_unsigned).
+types_match(lt_bool, lt_word).
+types_match(lt_integer, lt_bool).
% Return true iff an integer constant can be used directly as a value
% in a structure field of the given type, instead of being cast to
@@ -4801,20 +4823,20 @@
%
:- func direct_field_int_constant(llds_type) = bool.
-direct_field_int_constant(bool) = no.
-direct_field_int_constant(int_least8) = yes.
-direct_field_int_constant(uint_least8) = yes.
-direct_field_int_constant(int_least16) = yes.
-direct_field_int_constant(uint_least16) = yes.
-direct_field_int_constant(int_least32) = yes.
-direct_field_int_constant(uint_least32) = yes.
-direct_field_int_constant(integer) = yes.
-direct_field_int_constant(unsigned) = yes.
-direct_field_int_constant(float) = no.
-direct_field_int_constant(string) = no.
-direct_field_int_constant(data_ptr) = no.
-direct_field_int_constant(code_ptr) = no.
-direct_field_int_constant(word) = no.
+direct_field_int_constant(lt_bool) = no.
+direct_field_int_constant(lt_int_least8) = yes.
+direct_field_int_constant(lt_uint_least8) = yes.
+direct_field_int_constant(lt_int_least16) = yes.
+direct_field_int_constant(lt_uint_least16) = yes.
+direct_field_int_constant(lt_int_least32) = yes.
+direct_field_int_constant(lt_uint_least32) = yes.
+direct_field_int_constant(lt_integer) = yes.
+direct_field_int_constant(lt_unsigned) = yes.
+direct_field_int_constant(lt_float) = no.
+direct_field_int_constant(lt_string) = no.
+direct_field_int_constant(lt_data_ptr) = no.
+direct_field_int_constant(lt_code_ptr) = no.
+direct_field_int_constant(lt_word) = no.
% Output a float rval, converted to type `MR_Word *'
%
@@ -4848,10 +4870,10 @@
->
(
IsPtr = yes,
- Cast = data_ptr
+ Cast = lt_data_ptr
;
IsPtr = no,
- Cast = word
+ Cast = lt_word
),
output_llds_type_cast(Cast, !IO),
io.write_string("&mercury_float_const_", !IO),
@@ -4859,7 +4881,7 @@
;
(
IsPtr = yes,
- output_llds_type_cast(data_ptr, !IO)
+ output_llds_type_cast(lt_data_ptr, !IO)
;
IsPtr = no
),
@@ -4978,7 +5000,7 @@
io.write_int(Stag, !IO),
io.write_string(")", !IO)
;
- output_rval_as_type(Test, bool, !IO)
+ output_rval_as_type(Test, lt_bool, !IO)
).
:- pred is_int_cmp(rval::in, rval::out, int::out, string::out, string::out)
@@ -5063,9 +5085,9 @@
(
Category = array_index_binop,
io.write_string("(", !IO),
- output_rval_as_type(X, data_ptr, !IO),
+ output_rval_as_type(X, lt_data_ptr, !IO),
io.write_string(")[", !IO),
- output_rval_as_type(Y, integer, !IO),
+ output_rval_as_type(Y, lt_integer, !IO),
io.write_string("]", !IO)
;
Category = compound_compare_binop,
@@ -5079,14 +5101,14 @@
output_rval_const(llconst_string(XConst), !IO)
;
io.write_string("(char *) ", !IO),
- output_rval_as_type(X, data_ptr, !IO)
+ output_rval_as_type(X, lt_data_ptr, !IO)
),
io.write_string(", ", !IO),
( Y = const(llconst_string(YConst)) ->
output_rval_const(llconst_string(YConst), !IO)
;
io.write_string("(char *) ", !IO),
- output_rval_as_type(Y, data_ptr, !IO)
+ output_rval_as_type(Y, lt_data_ptr, !IO)
),
io.write_string(")", !IO),
io.write_string(" ", !IO),
@@ -5098,20 +5120,20 @@
; Category = float_arith_binop
),
io.write_string("(", !IO),
- output_rval_as_type(X, float, !IO),
+ output_rval_as_type(X, lt_float, !IO),
io.write_string(" ", !IO),
io.write_string(OpStr, !IO),
io.write_string(" ", !IO),
- output_rval_as_type(Y, float, !IO),
+ output_rval_as_type(Y, lt_float, !IO),
io.write_string(")", !IO)
;
Category = unsigned_compare_binop,
io.write_string("(", !IO),
- output_rval_as_type(X, unsigned, !IO),
+ output_rval_as_type(X, lt_unsigned, !IO),
io.write_string(" ", !IO),
io.write_string(OpStr, !IO),
io.write_string(" ", !IO),
- output_rval_as_type(Y, unsigned, !IO),
+ output_rval_as_type(Y, lt_unsigned, !IO),
io.write_string(")", !IO)
;
Category = int_or_bool_binary_infix_binop,
@@ -5122,9 +5144,9 @@
% MR_Integer.
( Op = eq ; Op = ne ),
llds.rval_type(X, XType),
- ( XType = word ; XType = unsigned ),
+ ( XType = lt_word ; XType = lt_unsigned ),
llds.rval_type(Y, YType),
- ( YType = word ; YType = unsigned )
+ ( YType = lt_word ; YType = lt_unsigned )
->
io.write_string("(", !IO),
output_rval(X, !IO),
@@ -5152,20 +5174,20 @@
% io.write_string(")")
;
io.write_string("(", !IO),
- output_rval_as_type(X, integer, !IO),
+ output_rval_as_type(X, lt_integer, !IO),
io.write_string(" ", !IO),
io.write_string(OpStr, !IO),
io.write_string(" ", !IO),
- output_rval_as_type(Y, integer, !IO),
+ output_rval_as_type(Y, lt_integer, !IO),
io.write_string(")", !IO)
)
;
Category = macro_binop,
io.write_string(OpStr, !IO),
io.write_string("(", !IO),
- output_rval_as_type(X, integer, !IO),
+ output_rval_as_type(X, lt_integer, !IO),
io.write_string(", ", !IO),
- output_rval_as_type(Y, integer, !IO),
+ output_rval_as_type(Y, lt_integer, !IO),
io.write_string(")", !IO)
).
output_rval(mkword(Tag, Exprn), !IO) :-
@@ -5193,7 +5215,7 @@
io.write_string("MR_tmkword(", !IO),
io.write_int(Tag, !IO),
io.write_string(", ", !IO),
- output_rval_as_type(Exprn, data_ptr, !IO),
+ output_rval_as_type(Exprn, lt_data_ptr, !IO),
io.write_string(")", !IO)
).
output_rval(lval(Lval), !IO) :-
@@ -5232,7 +5254,7 @@
( Rval = const(llconst_int(SlotNum)) ->
io.write_int(SlotNum, !IO)
;
- output_rval_as_type(Rval, integer, !IO)
+ output_rval_as_type(Rval, lt_integer, !IO)
),
io.write_string(")", !IO)
;
@@ -5242,7 +5264,7 @@
( Rval = const(llconst_int(SlotNum)) ->
io.write_int(SlotNum, !IO)
;
- output_rval_as_type(Rval, integer, !IO)
+ output_rval_as_type(Rval, lt_integer, !IO)
),
io.write_string(")", !IO)
;
@@ -5256,7 +5278,7 @@
( FieldNumRval = const(llconst_int(FieldNum)) ->
io.write_int(FieldNum, !IO)
;
- output_rval_as_type(FieldNumRval, integer, !IO)
+ output_rval_as_type(FieldNumRval, lt_integer, !IO)
),
io.write_string(")", !IO)
).
@@ -5270,7 +5292,7 @@
output_rval_const(llconst_int(N), !IO) :-
% We need to cast to (MR_Integer) to ensure things like 1 << 32 work
% when `MR_Integer' is 64 bits but `int' is 32 bits.
- output_llds_type_cast(integer, !IO),
+ output_llds_type_cast(lt_integer, !IO),
io.write_int(N, !IO).
output_rval_const(llconst_foreign(Value, Type), !IO) :-
io.write_char('(', !IO),
@@ -5280,7 +5302,7 @@
output_rval_const(llconst_float(FloatVal), !IO) :-
% The cast to (MR_Float) here lets the C compiler do arithmetic in `float'
% rather than `double' if `MR_Float' is `float' not `double'.
- output_llds_type_cast(float, !IO),
+ output_llds_type_cast(lt_float, !IO),
c_util.output_float_literal(FloatVal, !IO).
output_rval_const(llconst_string(String), !IO) :-
io.write_string("MR_string_const(""", !IO),
@@ -5328,14 +5350,14 @@
->
output_type_ctor_addr(Module, Name, Arity, !IO)
;
- output_llds_type_cast(data_ptr, !IO),
+ output_llds_type_cast(lt_data_ptr, !IO),
io.write_string("&", !IO),
output_data_addr(DataAddr, !IO)
)
;
MaybeOffset = yes(Offset),
io.write_string("((", !IO),
- output_llds_type_cast(data_ptr, !IO),
+ output_llds_type_cast(lt_data_ptr, !IO),
output_data_addr(DataAddr, !IO),
io.write_string(") + ", !IO),
io.write_int(Offset, !IO),
@@ -5408,9 +5430,9 @@
output_lval_as_word(Lval, !IO) :-
llds.lval_type(Lval, ActualType),
- ( types_match(word, ActualType) ->
+ ( types_match(lt_word, ActualType) ->
output_lval(Lval, !IO)
- ; ActualType = float ->
+ ; ActualType = lt_float ->
% Sanity check -- if this happens, the LLDS is ill-typed.
unexpected(this_file, "output_lval_as_word: got float")
;
@@ -5523,11 +5545,11 @@
:- pred output_lval_for_assign(lval::in, llds_type::out, io::di, io::uo)
is det.
-output_lval_for_assign(reg(RegType, Num), word, !IO) :-
+output_lval_for_assign(reg(RegType, Num), lt_word, !IO) :-
expect(unify(RegType, reg_r), this_file,
"output_lval_for_assign: float reg"),
output_reg(RegType, Num, !IO).
-output_lval_for_assign(stackvar(N), word, !IO) :-
+output_lval_for_assign(stackvar(N), lt_word, !IO) :-
( N < 0 ->
unexpected(this_file, "stack var out of range")
;
@@ -5536,7 +5558,7 @@
io.write_string("MR_sv(", !IO),
io.write_int(N, !IO),
io.write_string(")", !IO).
-output_lval_for_assign(parent_stackvar(N), word, !IO) :-
+output_lval_for_assign(parent_stackvar(N), lt_word, !IO) :-
( N < 0 ->
unexpected(this_file, "parent stack var out of range")
;
@@ -5545,7 +5567,7 @@
io.write_string("MR_parent_sv(", !IO),
io.write_int(N, !IO),
io.write_string(")", !IO).
-output_lval_for_assign(framevar(N), word, !IO) :-
+output_lval_for_assign(framevar(N), lt_word, !IO) :-
( N =< 0 ->
unexpected(this_file, "frame var out of range")
;
@@ -5554,39 +5576,39 @@
io.write_string("MR_fv(", !IO),
io.write_int(N, !IO),
io.write_string(")", !IO).
-output_lval_for_assign(succip, word, !IO) :-
+output_lval_for_assign(succip, lt_word, !IO) :-
io.write_string("MR_succip_word", !IO).
-output_lval_for_assign(sp, word, !IO) :-
+output_lval_for_assign(sp, lt_word, !IO) :-
io.write_string("MR_sp_word", !IO).
-output_lval_for_assign(parent_sp, data_ptr, !IO) :-
+output_lval_for_assign(parent_sp, lt_data_ptr, !IO) :-
io.write_string("MR_parent_sp", !IO).
-output_lval_for_assign(hp, word, !IO) :-
+output_lval_for_assign(hp, lt_word, !IO) :-
io.write_string("MR_hp_word", !IO).
-output_lval_for_assign(maxfr, word, !IO) :-
+output_lval_for_assign(maxfr, lt_word, !IO) :-
io.write_string("MR_maxfr_word", !IO).
-output_lval_for_assign(curfr, word, !IO) :-
+output_lval_for_assign(curfr, lt_word, !IO) :-
io.write_string("MR_curfr_word", !IO).
-output_lval_for_assign(succfr_slot(Rval), word, !IO) :-
+output_lval_for_assign(succfr_slot(Rval), lt_word, !IO) :-
io.write_string("MR_succfr_slot_word(", !IO),
output_rval(Rval, !IO),
io.write_string(")", !IO).
-output_lval_for_assign(prevfr_slot(Rval), word, !IO) :-
+output_lval_for_assign(prevfr_slot(Rval), lt_word, !IO) :-
io.write_string("MR_prevfr_slot_word(", !IO),
output_rval(Rval, !IO),
io.write_string(")", !IO).
-output_lval_for_assign(redofr_slot(Rval), word, !IO) :-
+output_lval_for_assign(redofr_slot(Rval), lt_word, !IO) :-
io.write_string("MR_redofr_slot_word(", !IO),
output_rval(Rval, !IO),
io.write_string(")", !IO).
-output_lval_for_assign(redoip_slot(Rval), word, !IO) :-
+output_lval_for_assign(redoip_slot(Rval), lt_word, !IO) :-
io.write_string("MR_redoip_slot_word(", !IO),
output_rval(Rval, !IO),
io.write_string(")", !IO).
-output_lval_for_assign(succip_slot(Rval), word, !IO) :-
+output_lval_for_assign(succip_slot(Rval), lt_word, !IO) :-
io.write_string("MR_succip_slot_word(", !IO),
output_rval(Rval, !IO),
io.write_string(")", !IO).
-output_lval_for_assign(field(MaybeTag, Rval, FieldNumRval), word, !IO) :-
+output_lval_for_assign(field(MaybeTag, Rval, FieldNumRval), lt_word, !IO) :-
(
MaybeTag = yes(Tag),
io.write_string("MR_tfield(", !IO),
@@ -5610,18 +5632,18 @@
output_lval_for_assign(temp(RegType, Num), Type, !IO) :-
(
RegType = reg_r,
- Type = word,
+ Type = lt_word,
io.write_string("MR_tempr", !IO),
io.write_int(Num, !IO)
;
RegType = reg_f,
- Type = float,
+ Type = lt_float,
io.write_string("MR_tempf", !IO),
io.write_int(Num, !IO)
).
-output_lval_for_assign(mem_ref(MemRef), word, !IO) :-
+output_lval_for_assign(mem_ref(MemRef), lt_word, !IO) :-
output_lval(mem_ref(MemRef), !IO).
-output_lval_for_assign(global_var_ref(GlobalVar), word, !IO) :-
+output_lval_for_assign(global_var_ref(GlobalVar), lt_word, !IO) :-
io.write_string(c_global_var_name(GlobalVar), !IO).
:- func c_global_var_name(c_global_var_ref) = string.
Index: compiler/lookup_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lookup_switch.m,v
retrieving revision 1.83
diff -u -b -r1.83 lookup_switch.m
--- compiler/lookup_switch.m 25 Aug 2009 23:46:47 -0000 1.83
+++ compiler/lookup_switch.m 20 Sep 2009 08:23:24 -0000
@@ -42,12 +42,11 @@
:- module ll_backend.lookup_switch.
:- interface.
-:- import_module hlds.code_model.
+:- import_module backend_libs.switch_util.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_llds.
:- import_module ll_backend.code_info.
:- import_module ll_backend.llds.
-:- import_module parse_tree.prog_data.
:- import_module list.
@@ -57,16 +56,16 @@
% Decide whether we can generate code for this switch using a lookup table.
%
-:- pred is_lookup_switch(mer_type::in, list(tagged_case)::in,
- int::in, int::in, int::in, hlds_goal_info::in, can_fail::in, int::in,
- abs_store_map::in, branch_end::in, branch_end::out, code_model::in,
+:- pred is_lookup_switch(list(tagged_case)::in, hlds_goal_info::in,
+ abs_store_map::in, branch_end::in, branch_end::out,
lookup_switch_info::out, code_info::in, code_info::out) is semidet.
% Generate code for the switch that the lookup_switch_info came from.
%
:- pred generate_lookup_switch(rval::in, abs_store_map::in, branch_end::in,
- lookup_switch_info::in, llds_code::out, code_info::in, code_info::out)
- is det.
+ lookup_switch_info::in, int::in, int::in,
+ need_bit_vec_check::in, need_range_check::in, llds_code::out,
+ code_info::in, code_info::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -74,8 +73,8 @@
:- implementation.
:- import_module backend_libs.builtin_ops.
-:- import_module backend_libs.switch_util.
:- import_module check_hlds.type_util.
+:- import_module hlds.code_model.
:- import_module hlds.goal_form.
:- import_module hlds.hlds_data.
:- import_module libs.compiler_util.
@@ -100,52 +99,19 @@
%-----------------------------------------------------------------------------%
-:- type case_consts
- ---> all_one_soln(
- assoc_list(int, list(rval))
- )
- ; some_several_solns(
- assoc_list(int, soln_consts),
- set(prog_var), % The resume vars.
- bool % The Boolean "or" of the result
- % of invoking goal_may_modify_trail
- % on the goal_infos of the switch arms
- % that are disjunctions.
- ).
-
-:- type soln_consts
- ---> one_soln(list(rval))
- ; several_solns(list(list(rval))).
-
-:- type need_range_check
- ---> need_range_check
- ; dont_need_range_check.
-
-:- type need_bit_vec_check
- ---> need_bit_vec_check
- ; dont_need_bit_vec_check.
-
:- type lookup_switch_info
---> lookup_switch_info(
- lsi_first :: int,
- lsi_last :: int,
- % The first and last values of the
- % switched-on rval covered by the
- % switch.
- lsi_cases :: case_consts,
- % The map from the switched-on value
- % to the values of the variables
- % in each solution.
- lsi_variables :: list(prog_var),
+ % The map from the switched-on value to the values of the
+ % variables in each solution.
+ lsi_cases :: case_consts(rval),
+
% The output variables.
+ lsi_variables :: list(prog_var),
+
+ % The types of the fields in the C structure we generate
+ % for each case.
lsi_field_types :: list(llds_type),
- % The types of the fields in the C
- % structure we generate for each case.
- lsi_need_range_check :: need_range_check,
- lsi_need_bit_vec_check :: need_bit_vec_check,
- % Do we need a range check and/or a
- % bit vector check on the switched-on
- % variable?
+
lsi_liveness :: set(prog_var)
).
@@ -153,88 +119,12 @@
% Most of this predicate is taken from dense_switch.m.
%
-is_lookup_switch(Type, TaggedCases0, LowerLimit, UpperLimit, NumValues,
- GoalInfo, SwitchCanFail0, ReqDensity, StoreMap, !MaybeEnd, CodeModel,
- LookupSwitchInfo, !CI) :-
+is_lookup_switch(TaggedCases, GoalInfo, StoreMap, !MaybeEnd, LookupSwitchInfo,
+ !CI) :-
% We need the code_info structure to generate code for the cases to
% get the constants (if they exist). We can't throw it away at the
% end because we may have allocated some new static ground terms.
- % Since lookup switches rely on static ground terms to work efficiently,
- % there is no point in using a lookup switch if static ground terms are
- % not enabled. Well, actually, it is possible that they might be a win in
- % some circumstances, but it would take a pretty complex heuristic to get
- % it right, so, lets just use a simple one - no static ground terms,
- % no lookup switch.
- get_globals(!.CI, Globals),
- globals.lookup_bool_option(Globals, static_ground_cells, yes),
-
- CodeModel = goal_info_get_code_model(GoalInfo),
- (
- ( CodeModel = model_non
- ; CodeModel = model_semi
- ),
- % We build up the list in reverse because that is linear and uses
- % constant stack space, whereas building it up in the right order
- % would either use linear stack space or require a quadratic algorithm.
- % This doesn't matter if TaggedCases0 is short, but does matter if it
- % contains thousands of elements.
- filter_out_failing_cases(TaggedCases0, [], RevTaggedCases,
- SwitchCanFail0, SwitchCanFail),
- list.reverse(RevTaggedCases, TaggedCases)
- ;
- CodeModel = model_det,
- TaggedCases = TaggedCases0,
- SwitchCanFail = SwitchCanFail0
- ),
-
- % We want to generate a lookup switch for any switch that is dense enough
- % - we don't care how many cases it has. A memory lookup tends to be
- % cheaper than a branch.
-
- Span = UpperLimit - LowerLimit,
- Range = Span + 1,
- Density = switch_density(NumValues, Range),
- Density > ReqDensity,
-
- % If there are going to be no gaps in the lookup table then we won't need
- % a bitvector test to see if this switch has a value for this case.
- ( NumValues = Range ->
- NeedBitVecCheck0 = dont_need_bit_vec_check
- ;
- NeedBitVecCheck0 = need_bit_vec_check
- ),
- (
- SwitchCanFail = can_fail,
- % For can_fail switches, we normally need to check that the variable
- % is in range before we index into the jump table. However, if the
- % range of the type is sufficiently small, we can make the jump table
- % large enough to hold all of the values for the type, but then we
- % will need to do the bitvector test.
- get_module_info(!.CI, ModuleInfo),
- classify_type(ModuleInfo, Type) = TypeCategory,
- (
- type_range(ModuleInfo, TypeCategory, Type, _, _, TypeRange),
- DetDensity = switch_density(NumValues, TypeRange),
- DetDensity > ReqDensity
- ->
- NeedRangeCheck = dont_need_range_check,
- NeedBitVecCheck = need_bit_vec_check,
- FirstVal = 0,
- LastVal = TypeRange - 1
- ;
- NeedRangeCheck = need_range_check,
- NeedBitVecCheck = NeedBitVecCheck0,
- FirstVal = LowerLimit,
- LastVal = UpperLimit
- )
- ;
- SwitchCanFail = cannot_fail,
- NeedRangeCheck = dont_need_range_check,
- NeedBitVecCheck = NeedBitVecCheck0,
- FirstVal = LowerLimit,
- LastVal = UpperLimit
- ),
figure_out_output_vars(!.CI, GoalInfo, OutVars),
remember_position(!.CI, CurPos),
generate_constants_for_lookup_switch(TaggedCases, OutVars, StoreMap,
@@ -264,61 +154,19 @@
get_exprn_opts(!.CI, ExprnOpts),
UnboxFloats = get_unboxed_floats(ExprnOpts),
find_general_llds_types(UnboxFloats, OutTypes, CaseValues, LLDSTypes),
- LookupSwitchInfo = lookup_switch_info(FirstVal, LastVal, CaseConsts,
- OutVars, LLDSTypes, NeedRangeCheck, NeedBitVecCheck, Liveness).
-
-:- pred project_all_to_one_solution(assoc_list(int, soln_consts)::in,
- assoc_list(int, list(rval))::in, assoc_list(int, list(rval))::out)
- is semidet.
-
-project_all_to_one_solution([], !RevCaseValuePairs).
-project_all_to_one_solution([Case - Solns | CaseSolns], !RevCaseValuePairs) :-
- Solns = one_soln(Values),
- !:RevCaseValuePairs = [Case - Values | !.RevCaseValuePairs],
- project_all_to_one_solution(CaseSolns, !RevCaseValuePairs).
-
-:- pred project_solns_to_rval_lists(assoc_list(int, soln_consts)::in,
- list(list(rval))::in, list(list(rval))::out) is det.
-
-project_solns_to_rval_lists([], !RvalsList).
-project_solns_to_rval_lists([Case | Cases], !RvalsList) :-
- Case = _Index - Soln,
- (
- Soln = one_soln(Rvals),
- !:RvalsList = [Rvals | !.RvalsList]
- ;
- Soln = several_solns(SolnRvalsList),
- !:RvalsList = SolnRvalsList ++ !.RvalsList
- ),
- project_solns_to_rval_lists(Cases, !RvalsList).
-
-%---------------------------------------------------------------------------%
-
-:- pred filter_out_failing_cases(list(tagged_case)::in,
- list(tagged_case)::in, list(tagged_case)::out,
- can_fail::in, can_fail::out) is det.
-
-filter_out_failing_cases([], !RevTaggedCases, !SwitchCanFail).
-filter_out_failing_cases([Case | Cases], !RevTaggedCases, !SwitchCanFail) :-
- Case = tagged_case(_, _, _, Goal),
- Goal = hlds_goal(GoalExpr, _),
- ( GoalExpr = disj([]) ->
- !:SwitchCanFail = can_fail
- ;
- !:RevTaggedCases = [Case | !.RevTaggedCases]
- ),
- filter_out_failing_cases(Cases, !RevTaggedCases, !SwitchCanFail).
+ LookupSwitchInfo = lookup_switch_info(CaseConsts, OutVars, LLDSTypes,
+ Liveness).
%---------------------------------------------------------------------------%
:- pred generate_constants_for_lookup_switch(list(tagged_case)::in,
list(prog_var)::in, abs_store_map::in, maybe(set(prog_var))::out,
- map(int, soln_consts)::in, map(int, soln_consts)::out,
+ map(int, soln_consts(rval))::in, map(int, soln_consts(rval))::out,
branch_end::in, branch_end::out, set(prog_var)::in, set(prog_var)::out,
bool::in, bool::out, code_info::in, code_info::out) is semidet.
generate_constants_for_lookup_switch([], _Vars, _StoreMap, no, !IndexMap,
- !MaybeEnd, !ResumeVars, !GoalTrailOps, !CI).
+ !MaybeEnd, !ResumeVars, !GoalsMayModifyTrail, !CI).
generate_constants_for_lookup_switch([TaggedCase | TaggedCases], Vars,
StoreMap, MaybeLiveness, !IndexMap, !MaybeEnd, !ResumeVars,
!GoalsMayModifyTrail, !CI) :-
@@ -335,7 +183,7 @@
(
Disjuncts = [],
% Cases like this should have been filtered out by
- % filter_out_failing_cases above.
+ % filter_out_failing_cases.
unexpected(this_file, "generate_constants: disj([])")
;
Disjuncts = [FirstDisjunct | _],
@@ -378,8 +226,9 @@
StoreMap, _MaybeLivenessRest, !IndexMap, !MaybeEnd, !ResumeVars,
!GoalsMayModifyTrail, !CI).
-:- pred record_lookup_for_tagged_cons_id(soln_consts::in, tagged_cons_id::in,
- map(int, soln_consts)::in, map(int, soln_consts)::out) is det.
+:- pred record_lookup_for_tagged_cons_id(soln_consts(rval)::in,
+ tagged_cons_id::in,
+ map(int, soln_consts(rval))::in, map(int, soln_consts(rval))::out) is det.
record_lookup_for_tagged_cons_id(SolnConsts, TaggedConsId, !IndexMap) :-
TaggedConsId = tagged_cons_id(_ConsId, ConsTag),
@@ -391,10 +240,10 @@
%---------------------------------------------------------------------------%
-generate_lookup_switch(VarRval, StoreMap, MaybeEnd0, LookupSwitchInfo, Code,
- !CI) :-
- LookupSwitchInfo = lookup_switch_info(StartVal, EndVal, CaseConsts,
- OutVars, LLDSTypes, NeedRangeCheck, NeedBitVecCheck, Liveness),
+generate_lookup_switch(VarRval, StoreMap, MaybeEnd0, LookupSwitchInfo,
+ StartVal, EndVal, NeedBitVecCheck, NeedRangeCheck, Code, !CI) :-
+ LookupSwitchInfo = lookup_switch_info(CaseConsts, OutVars, LLDSTypes,
+ Liveness),
% If the case values start at some number other than 0,
% then subtract that number to give us a zero-based index.
@@ -497,7 +346,7 @@
% Add an expression to the expression cache in the code_info structure
% for each of the output variables of the lookup switch. This is done by
- % creating a `create' term for the array, and caching an expression
+ % creating a static term for the array, and generating an expression
% for the variable to get the IndexRval'th field of that term.
%
:- pred generate_simple_terms(rval::in, list(prog_var)::in,
@@ -544,7 +393,7 @@
%-----------------------------------------------------------------------------%
:- pred generate_several_soln_lookup_switch(rval::in, abs_store_map::in,
- branch_end::in, int::in, int::in, assoc_list(int, soln_consts)::in,
+ branch_end::in, int::in, int::in, assoc_list(int, soln_consts(rval))::in,
set(prog_var)::in, add_trail_ops::in, list(prog_var)::in,
list(llds_type)::in, need_bit_vec_check::in, set(prog_var)::in,
llds_code::out, code_info::in, code_info::out) is det.
@@ -587,7 +436,7 @@
),
list.reverse(RevLaterSolnArray, LaterSolnArray),
- MainRowTypes = [integer, integer | LLDSTypes],
+ MainRowTypes = [lt_integer, lt_integer | LLDSTypes],
list.length(MainRowTypes, MainRowWidth),
add_vector_static_cell(MainRowTypes, MainRows, MainVectorAddr, !CI),
MainVectorAddrRval = const(llconst_data_addr(MainVectorAddr, no)),
@@ -827,7 +676,7 @@
% in order to make this predicate tail recursive.
%
:- pred construct_several_soln_vector(int::in, int::in, int::in,
- list(llds_type)::in, int::in, assoc_list(int, soln_consts)::in,
+ list(llds_type)::in, int::in, assoc_list(int, soln_consts(rval))::in,
list(list(rval))::out,
list(list(rval))::in, list(list(rval))::out,
int::in, int::out, int::in, int::out, int::in, int::out) is det.
@@ -908,7 +757,8 @@
int::in, int::in, llds_code::out, code_info::in, code_info::out) is det.
generate_bitvec_test(IndexRval, CaseVals, Start, _End, CheckCode, !CI) :-
- get_word_bits(!.CI, WordBits, Log2WordBits),
+ get_globals(!.CI, Globals),
+ get_word_bits(Globals, WordBits, Log2WordBits),
generate_bit_vec(CaseVals, Start, WordBits, BitVecArgs, BitVecRval, !CI),
% Optimize the single-word case: if all the cases fit into a single word,
@@ -937,39 +787,16 @@
binop(unchecked_left_shift, const(llconst_int(1)), BitNum), Word),
fail_if_rval_is_false(HasBit, CheckCode, !CI).
- % Prevent cross-compilation errors by making sure that the bitvector
- % uses a number of bits that will fit both on this machine (so that
- % we can correctly generate it), and on the target machine (so that
- % it can be executed correctly). Also make sure that the number of bits
- % that we use is a power of 2, so that we implement division as
- % right-shift (see above).
- %
-:- pred get_word_bits(code_info::in, int::out, int::out) is det.
-
-get_word_bits(CI, WordBits, Log2WordBits) :-
- int.bits_per_int(HostWordBits),
- get_globals(CI, Globals),
- globals.lookup_int_option(Globals, bits_per_word, TargetWordBits),
- int.min(HostWordBits, TargetWordBits, WordBits0),
- % round down to the nearest power of 2
- Log2WordBits = log2_rounded_down(WordBits0),
- int.pow(2, Log2WordBits, WordBits).
-
-:- func log2_rounded_down(int) = int.
-
-log2_rounded_down(X) = Log :-
- int.log2(X + 1, Log + 1). % int.log2 rounds up
-
% We generate the bitvector by iterating through the cases marking the bit
- % for each case. (We represent the bitvector here as a map from the word
+ % for each case. We represent the bitvector here as a map from the word
% number in the vector to the bits for that word.
%
:- pred generate_bit_vec(assoc_list(int, T)::in, int::in, int::in,
list(rval)::out, rval::out, code_info::in, code_info::out) is det.
generate_bit_vec(CaseVals, Start, WordBits, Args, BitVec, !CI) :-
- map.init(Empty),
- generate_bit_vec_2(CaseVals, Start, WordBits, Empty, BitMap),
+ map.init(BitMap0),
+ generate_bit_vec_2(CaseVals, Start, WordBits, BitMap0, BitMap),
map.to_assoc_list(BitMap, WordVals),
generate_bit_vec_args(WordVals, 0, Args),
add_scalar_static_cell_natural_types(Args, DataAddr, !CI),
@@ -978,18 +805,18 @@
:- pred generate_bit_vec_2(assoc_list(int, T)::in, int::in, int::in,
map(int, int)::in, map(int, int)::out) is det.
-generate_bit_vec_2([], _, _, Bits, Bits).
-generate_bit_vec_2([Tag - _ | Rest], Start, WordBits, Bits0, Bits) :-
+generate_bit_vec_2([], _, _, !BitMap).
+generate_bit_vec_2([Tag - _ | Rest], Start, WordBits, !BitMap) :-
Val = Tag - Start,
Word = Val // WordBits,
Offset = Val mod WordBits,
- ( map.search(Bits0, Word, X0) ->
+ ( map.search(!.BitMap, Word, X0) ->
X1 = X0 \/ (1 << Offset)
;
X1 = (1 << Offset)
),
- map.set(Bits0, Word, X1, Bits1),
- generate_bit_vec_2(Rest, Start, WordBits, Bits1, Bits).
+ svmap.set(Word, X1, !BitMap),
+ generate_bit_vec_2(Rest, Start, WordBits, !BitMap).
:- pred generate_bit_vec_args(list(pair(int))::in, int::in,
list(rval)::out) is det.
@@ -1011,20 +838,20 @@
:- func default_value_for_type(llds_type) = rval.
-default_value_for_type(bool) = const(llconst_int(0)).
-default_value_for_type(int_least8) = const(llconst_int(0)).
-default_value_for_type(uint_least8) = const(llconst_int(0)).
-default_value_for_type(int_least16) = const(llconst_int(0)).
-default_value_for_type(uint_least16) = const(llconst_int(0)).
-default_value_for_type(int_least32) = const(llconst_int(0)).
-default_value_for_type(uint_least32) = const(llconst_int(0)).
-default_value_for_type(integer) = const(llconst_int(0)).
-default_value_for_type(unsigned) = const(llconst_int(0)).
-default_value_for_type(float) = const(llconst_float(0.0)).
-default_value_for_type(string) = const(llconst_string("")).
-default_value_for_type(data_ptr) = const(llconst_int(0)).
-default_value_for_type(code_ptr) = const(llconst_int(0)).
-default_value_for_type(word) = const(llconst_int(0)).
+default_value_for_type(lt_bool) = const(llconst_int(0)).
+default_value_for_type(lt_int_least8) = const(llconst_int(0)).
+default_value_for_type(lt_uint_least8) = const(llconst_int(0)).
+default_value_for_type(lt_int_least16) = const(llconst_int(0)).
+default_value_for_type(lt_uint_least16) = const(llconst_int(0)).
+default_value_for_type(lt_int_least32) = const(llconst_int(0)).
+default_value_for_type(lt_uint_least32) = const(llconst_int(0)).
+default_value_for_type(lt_integer) = const(llconst_int(0)).
+default_value_for_type(lt_unsigned) = const(llconst_int(0)).
+default_value_for_type(lt_float) = const(llconst_float(0.0)).
+default_value_for_type(lt_string) = const(llconst_string("")).
+default_value_for_type(lt_data_ptr) = const(llconst_int(0)).
+default_value_for_type(lt_code_ptr) = const(llconst_int(0)).
+default_value_for_type(lt_word) = const(llconst_int(0)).
%-----------------------------------------------------------------------------%
Index: compiler/lookup_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lookup_util.m,v
retrieving revision 1.10
diff -u -b -r1.10 lookup_util.m
--- compiler/lookup_util.m 13 Jan 2009 05:03:20 -0000 1.10
+++ compiler/lookup_util.m 20 Sep 2009 10:42:58 -0000
@@ -79,6 +79,7 @@
:- import_module check_hlds.mode_util.
:- import_module hlds.code_model.
+:- import_module hlds.hlds_module.
:- import_module hlds.instmap.
:- import_module libs.compiler_util.
:- import_module libs.globals.
@@ -89,7 +90,6 @@
:- import_module cord.
:- import_module int.
:- import_module pair.
-:- import_module solutions.
figure_out_output_vars(CI, GoalInfo, OutVars) :-
InstMapDelta = goal_info_get_instmap_delta(GoalInfo),
@@ -101,16 +101,19 @@
instmap_delta_changed_vars(InstMapDelta, ChangedVars),
instmap.apply_instmap_delta(CurrentInstMap, InstMapDelta,
InstMapAfter),
- Lambda = (pred(Var::out) is nondet :-
+ list.filter(is_output_var(ModuleInfo, CurrentInstMap, InstMapAfter),
+ set.to_sorted_list(ChangedVars), OutVars)
+ ).
+
+:- pred is_output_var(module_info::in, instmap::in, instmap::in, prog_var::in)
+ is semidet.
+
+is_output_var(ModuleInfo, CurrentInstMap, InstMapAfter, Var) :-
% If a variable has a final inst, then it changed
% instantiatedness during the switch.
- set.member(Var, ChangedVars),
instmap_lookup_var(CurrentInstMap, Var, Initial),
instmap_lookup_var(InstMapAfter, Var, Final),
- mode_is_output(ModuleInfo, (Initial -> Final))
- ),
- solutions.solutions(Lambda, OutVars)
- ).
+ mode_is_output(ModuleInfo, (Initial -> Final)).
goal_is_conj_of_unify(Goal) :-
Goal = hlds_goal(_GoalExpr, GoalInfo),
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.503
diff -u -b -r1.503 mercury_compile.m
--- compiler/mercury_compile.m 16 Sep 2009 02:32:52 -0000 1.503
+++ compiler/mercury_compile.m 20 Sep 2009 03:43:28 -0000
@@ -1088,7 +1088,7 @@
),
globals.lookup_bool_option(!.Globals, detailed_statistics, Stats),
maybe_report_stats(Stats, !IO),
- string.append(FileName, ".m", SourceFileName)
+ SourceFileName = FileName ++ ".m"
).
:- func version_numbers_return_timestamp(bool) = maybe_return_timestamp.
@@ -5007,7 +5007,7 @@
C_InterfaceInfo = foreign_interface_info(ModuleSymName, C_HeaderCode0,
C_Includes, C_BodyCode0, _C_ExportDecls, C_ExportDefns),
MangledModuleName = sym_name_mangle(ModuleSymName),
- string.append(MangledModuleName, "_module", ModuleName),
+ ModuleName = MangledModuleName ++ "_module",
module_info_get_globals(ModuleInfo, Globals),
globals.lookup_int_option(Globals, procs_per_c_function, ProcsPerFunc),
get_c_body_code(C_BodyCode0, C_BodyCode),
@@ -5109,7 +5109,7 @@
combine_chunks_2([], _ModName, _N, []).
combine_chunks_2([Chunk | Chunks], ModuleName, Num, [Module | Modules]) :-
string.int_to_string(Num, NumString),
- string.append(ModuleName, NumString, ThisModuleName),
+ ThisModuleName = ModuleName ++ NumString,
Module = comp_gen_c_module(ThisModuleName, Chunk),
Num1 = Num + 1,
combine_chunks_2(Chunks, ModuleName, Num1, Modules).
@@ -5151,8 +5151,8 @@
get_linked_target_type(LinkedTargetType, !IO),
get_object_code_type(LinkedTargetType, PIC, !IO),
maybe_pic_object_file_extension(PIC, Obj, !IO),
- string.append(BaseName, ".c", C_File),
- string.append(BaseName, Obj, O_File),
+ C_File = BaseName ++ ".c",
+ O_File = BaseName ++ Obj,
compile_target_code.compile_c_file(ErrorStream, PIC, C_File, O_File,
Succeeded, !IO).
@@ -5565,8 +5565,7 @@
ModuleName = mlds_get_module_name(MLDS),
module_name_to_file_name(ModuleName, ".mlds_dump", do_create_dirs,
BaseFileName, !IO),
- string.append_list([BaseFileName, ".", StageNumStr, "-", StageName],
- DumpFile),
+ DumpFile = BaseFileName ++ "." ++ StageNumStr ++ "-" ++ StageName,
dump_mlds(Globals, DumpFile, MLDS, !IO),
maybe_write_string(Verbose, "% done.\n", !IO)
;
Index: compiler/ml_backend.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_backend.m,v
retrieving revision 1.13
diff -u -b -r1.13 ml_backend.m
--- compiler/ml_backend.m 2 Sep 2009 00:30:17 -0000 1.13
+++ compiler/ml_backend.m 10 Sep 2009 05:19:00 -0000
@@ -45,6 +45,7 @@
:- include_module ml_simplify_switch.
:- include_module ml_string_switch.
:- include_module ml_tag_switch.
+ :- include_module ml_lookup_switch.
:- include_module ml_type_gen.
:- include_module ml_unify_gen.
:- include_module ml_code_util.
Index: compiler/ml_closure_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_closure_gen.m,v
retrieving revision 1.62
diff -u -b -r1.62 ml_closure_gen.m
--- compiler/ml_closure_gen.m 2 Sep 2009 00:30:17 -0000 1.62
+++ compiler/ml_closure_gen.m 9 Sep 2009 15:29:31 -0000
@@ -181,7 +181,7 @@
mlds_rval::out, mlds_type::out, ml_gen_info::in, ml_gen_info::out) is det.
ml_gen_closure_layout(PredId, ProcId, Context,
- ClosureLayoutRval, ClosureLayoutType, !Info) :-
+ ClosureLayoutAddrRval, ClosureLayoutType, !Info) :-
ml_gen_info_get_module_info(!.Info, ModuleInfo),
continuation_info.generate_closure_layout(ModuleInfo, PredId, ProcId,
ClosureLayoutInfo),
@@ -207,19 +207,14 @@
% XXX There's no way in C to properly represent this type,
% since it is a struct that ends with a variable-length array.
% For now we just treat the whole struct as an array.
- ClosureLayoutType = mlds_array_type(mlds_generic_type),
- ml_gen_static_const_defn("closure_layout", ClosureLayoutType,
- acc_private, init_array(Inits), Context, ClosureLayoutVarName,
- !GlobalData),
-
- ml_gen_info_set_global_data(!.GlobalData, !Info)
- ),
-
module_info_get_name(ModuleInfo, ModuleName),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
- ClosureLayoutVar =
- qual(MLDS_ModuleName, module_qual, ClosureLayoutVarName),
- ClosureLayoutRval = ml_lval(ml_var(ClosureLayoutVar, ClosureLayoutType)).
+ ClosureLayoutType = mlds_array_type(mlds_generic_type),
+ ml_gen_static_scalar_const_addr(MLDS_ModuleName, "closure_layout",
+ ClosureLayoutType, init_array(Inits), Context,
+ ClosureLayoutAddrRval, !GlobalData),
+ ml_gen_info_set_global_data(!.GlobalData, !Info)
+ ).
:- pred ml_gen_closure_proc_id(module_info::in, prog_context::in,
mlds_initializer::out, mlds_type::out,
@@ -449,22 +444,19 @@
mlds_rval::out, mlds_type::out,
ml_global_data::in, ml_global_data::out) is det.
-ml_stack_layout_construct_tvar_vector(ModuleInfo, TvarVectorNameStr, Context,
- TVarLocnMap, MLDS_Rval, ArrayType, !GlobalData) :-
+ml_stack_layout_construct_tvar_vector(ModuleInfo, TVarVectorNameStr, Context,
+ TVarLocnMap, TVarVectorAddrRval, ArrayType, !GlobalData) :-
ArrayType = mlds_array_type(mlds_native_int_type),
( map.is_empty(TVarLocnMap) ->
- MLDS_Rval = ml_const(mlconst_null(ArrayType))
+ TVarVectorAddrRval = ml_const(mlconst_null(ArrayType))
;
ml_stack_layout_construct_tvar_rvals(TVarLocnMap, Vector,
_VectorTypes),
Initializer = init_array(Vector),
- ml_gen_static_const_defn(TvarVectorNameStr, ArrayType, acc_private,
- Initializer, Context, TvarVectorName, !GlobalData),
module_info_get_name(ModuleInfo, ModuleName),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
- QualTvarVectorName =
- qual(MLDS_ModuleName, module_qual, TvarVectorName),
- MLDS_Rval = ml_lval(ml_var(QualTvarVectorName, ArrayType))
+ ml_gen_static_scalar_const_addr(MLDS_ModuleName, TVarVectorNameStr,
+ ArrayType, Initializer, Context, TVarVectorAddrRval, !GlobalData)
).
:- pred ml_stack_layout_construct_tvar_rvals(map(tvar, set(layout_locn))::in,
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.223
diff -u -b -r1.223 ml_code_gen.m
--- compiler/ml_code_gen.m 8 Sep 2009 02:43:34 -0000 1.223
+++ compiler/ml_code_gen.m 20 Sep 2009 10:15:06 -0000
@@ -695,7 +695,6 @@
% - apply the reverse tag test optimization
% for types with two functors (see unify_gen.m)
% - binary search switches
-% - lookup switches
% - generate local declarations for the `succeeded' variable;
% this would help in nondet code, because it would avoid
% the need to access the outermost function's `succeeded'
@@ -978,8 +977,23 @@
ml_gen_preds(!ModuleInfo, PredDefns, GlobalData) :-
module_info_preds(!.ModuleInfo, PredTable),
map.keys(PredTable, PredIds),
+ module_info_get_globals(!.ModuleInfo, Globals),
+ globals.get_target(Globals, Target),
+ (
+ Target = target_c,
+ UseCommonCells = use_common_cells
+ ;
+ ( Target = target_asm
+ ; Target = target_java
+ ; Target = target_il
+ ; Target = target_erlang
+ ; Target = target_x86_64
+ ),
+ UseCommonCells = do_not_use_common_cells
+ ),
+ GlobalData0 = ml_global_data_init(UseCommonCells),
ml_gen_preds_2(!ModuleInfo, PredIds, [], PredDefns,
- ml_global_data_init, GlobalData).
+ GlobalData0, GlobalData).
:- pred ml_gen_preds_2(module_info::in, module_info::out, list(pred_id)::in,
list(mlds_defn)::in, list(mlds_defn)::out,
@@ -1732,10 +1746,31 @@
Goal = hlds_goal(GoalExpr, GoalInfo),
Context = goal_info_get_context(GoalInfo),
- % Generate the local variables for this goal. We need to declare any
- % variables which are local to this goal (including its subgoals),
- % but which are not local to a subgoal. (If they're local to a subgoal,
- % they'll be declared when we generate code for that subgoal.)
+ % Generate the local variables for this goal.
+ ml_gen_info_get_var_types(!.Info, VarTypes),
+ find_vars_to_declare(VarTypes, GoalExpr, GoalInfo, VarsToDeclare),
+
+ ml_gen_info_get_varset(!.Info, VarSet),
+ ml_gen_local_var_decls(VarSet, VarTypes, Context, VarsToDeclare, VarDecls,
+ !Info),
+
+ % Generate code for the goal in its own code model.
+ GoalCodeModel = goal_info_get_code_model(GoalInfo),
+ ml_gen_goal_expr(GoalExpr, GoalCodeModel, Context, GoalInfo,
+ GoalDecls, GoalStatements0, !Info),
+
+ % Add whatever wrapper is needed to convert the goal's code model
+ % to the desired code model.
+ ml_gen_maybe_convert_goal_code_model(CodeModel, GoalCodeModel, Context,
+ GoalStatements0, GoalStatements, !Info),
+
+ Decls = VarDecls ++ GoalDecls,
+ Statements = GoalStatements.
+
+ % For any given goal, we need to declare any variables which are local
+ % to this goal (including its subgoals), but which are not local to
+ % a subgoal. If they're local to a subgoal, they will be declared when
+ % we generate code for that subgoal.
%
% We need to make sure that we declare any type_info or type_classinfo
% variables *before* any other variables, since the GC tracing code
@@ -1745,13 +1780,15 @@
% However, in the common case that the number of variables to declare is
% zero or one, such reordering is guaranteed to be a no-op, so avoid the
% expense.
+ %
+:- pred find_vars_to_declare(vartypes::in,
+ hlds_goal_expr::in, hlds_goal_info::in, list(prog_var)::out) is det.
+find_vars_to_declare(VarTypes, GoalExpr, GoalInfo, VarsToDeclare) :-
goal_expr_find_subgoal_nonlocals(GoalExpr, SubGoalNonLocals),
NonLocals = goal_info_get_nonlocals(GoalInfo),
set.difference(SubGoalNonLocals, NonLocals, VarsToDeclareSet),
set.to_sorted_list(VarsToDeclareSet, VarsToDeclare0),
-
- ml_gen_info_get_var_types(!.Info, VarTypes),
(
( VarsToDeclare0 = []
; VarsToDeclare0 = [_]
@@ -1760,24 +1797,7 @@
;
VarsToDeclare0 = [_, _ | _],
VarsToDeclare = put_typeinfo_vars_first(VarsToDeclare0, VarTypes)
- ),
-
- ml_gen_info_get_varset(!.Info, VarSet),
- ml_gen_local_var_decls(VarSet, VarTypes, Context, VarsToDeclare, VarDecls,
- !Info),
-
- % Generate code for the goal in its own code model.
- GoalCodeModel = goal_info_get_code_model(GoalInfo),
- ml_gen_goal_expr(GoalExpr, GoalCodeModel, Context,
- GoalDecls, GoalStatements0, !Info),
-
- % Add whatever wrapper is needed to convert the goal's code model
- % to the desired code model.
- ml_gen_maybe_convert_goal_code_model(CodeModel, GoalCodeModel, Context,
- GoalStatements0, GoalStatements, !Info),
-
- Decls = VarDecls ++ GoalDecls,
- Statements = GoalStatements.
+ ).
% The task of this predicate is to help compute the set of MLDS variables
% that should be declared at the scope of GoalExpr. This should be the
@@ -2324,10 +2344,11 @@
% Generate MLDS code for the different kinds of HLDS goals.
%
:- pred ml_gen_goal_expr(hlds_goal_expr::in, code_model::in, prog_context::in,
- list(mlds_defn)::out, list(statement)::out,
+ hlds_goal_info::in, list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_goal_expr(GoalExpr, CodeModel, Context, Decls, Statements, !Info) :-
+ml_gen_goal_expr(GoalExpr, CodeModel, Context, GoalInfo,
+ Decls, Statements, !Info) :-
(
GoalExpr = unify(_LHS, _RHS, _Mode, Unification, _UnifyContext),
ml_gen_unification(Unification, CodeModel, Context, Decls, Statements,
@@ -2412,7 +2433,7 @@
ml_gen_disj(Goals, CodeModel, Context, Decls, Statements, !Info)
;
GoalExpr = switch(Var, CanFail, CasesList),
- ml_gen_switch(Var, CanFail, CasesList, CodeModel, Context,
+ ml_gen_switch(Var, CanFail, CasesList, CodeModel, Context, GoalInfo,
Decls, Statements, !Info)
;
GoalExpr = if_then_else(_Vars, Cond, Then, Else),
@@ -2875,16 +2896,16 @@
mode_to_arg_mode(ModuleInfo, Mode, OrigType, ArgMode),
(
ArgMode = top_in,
- OutlineArg = in(MldsType, ArgName, ml_lval(VarLval))
+ OutlineArg = ola_in(MldsType, ArgName, ml_lval(VarLval))
;
ArgMode = top_out,
- OutlineArg = out(MldsType, ArgName, VarLval)
+ OutlineArg = ola_out(MldsType, ArgName, VarLval)
;
ArgMode = top_unused,
- OutlineArg = unused
+ OutlineArg = ola_unused
)
;
- OutlineArg = unused
+ OutlineArg = ola_unused
).
:- pred ml_gen_ordinary_pragma_il_proc(code_model::in,
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.142
diff -u -b -r1.142 ml_code_util.m
--- compiler/ml_code_util.m 8 Sep 2009 02:49:06 -0000 1.142
+++ compiler/ml_code_util.m 20 Sep 2009 10:10:58 -0000
@@ -119,12 +119,16 @@
% Convert the element type for an array_index operator to an MLDS type.
%
-:- func ml_gen_array_elem_type(builtin_ops.array_elem_type) = mlds_type.
+:- func ml_gen_array_elem_type(array_elem_type) = mlds_type.
% Return the MLDS type corresponding to a Mercury string type.
%
:- func ml_string_type = mlds_type.
+ % Return the MLDS type corresponding to a Mercury int type.
+ %
+:- func ml_int_type = mlds_type.
+
% Allocate some fresh type variables, with kind `star', to use as
% the Mercury types of boxed objects (e.g. to get the argument types
% for tuple constructors or closure constructors). Note that this
@@ -297,18 +301,6 @@
%
:- func ml_format_reserved_object_name(string, arity) = mlds_var_name.
- % Generate a definition of a static constant, given the constant's name,
- % type, accessibility, and initializer.
- %
-:- pred ml_gen_static_const_defn(string::in, mlds_type::in, access::in,
- mlds_initializer::in, prog_context::in, mlds_var_name::out,
- ml_global_data::in, ml_global_data::out) is det.
-
- % Return the declaration flags appropriate for an initialized
- % local static constant.
- %
-:- func ml_static_const_decl_flags = mlds_decl_flags.
-
% Succeed iff the specified mlds_defn defines a local static constant.
%
:- pred ml_decl_is_static_const(mlds_defn::in) is semidet.
@@ -528,6 +520,14 @@
%
:- func fixup_builtin_module(module_name) = module_name.
+:- pred ml_gen_box_const_rvals(module_info::in, prog_context::in,
+ list(mlds_type)::in, list(mlds_rval)::in, list(mlds_rval)::out,
+ ml_global_data::in, ml_global_data::out) is det.
+
+:- pred ml_gen_box_const_rval(module_info::in, prog_context::in,
+ mlds_type::in, mlds_rval::in, mlds_rval::out,
+ ml_global_data::in, ml_global_data::out) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
@@ -1010,14 +1010,29 @@
ml_gen_info_get_module_info(Info, ModuleInfo),
MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type).
-ml_gen_array_elem_type(elem_type_string) = ml_string_type.
-ml_gen_array_elem_type(elem_type_int) = mlds_native_int_type.
-ml_gen_array_elem_type(elem_type_generic) = mlds_generic_type.
+ml_gen_array_elem_type(ElemType) = MLDS_Type :-
+ (
+ ElemType = array_elem_scalar(ScalarElem),
+ MLDS_Type = ml_gen_scalar_array_elem_type(ScalarElem)
+ ;
+ ElemType = array_elem_struct(_ScalarElems),
+ unexpected(this_file, "ml_gen_array_elem_type: struct")
+ ).
+
+:- func ml_gen_scalar_array_elem_type(scalar_array_elem_type) = mlds_type.
+
+ml_gen_scalar_array_elem_type(scalar_elem_string) = ml_string_type.
+ml_gen_scalar_array_elem_type(scalar_elem_int) = mlds_native_int_type.
+ml_gen_scalar_array_elem_type(scalar_elem_generic) = mlds_generic_type.
ml_string_type =
mercury_type(string_type, ctor_cat_builtin(cat_builtin_string),
non_foreign_type(string_type)).
+ml_int_type =
+ mercury_type(int_type, ctor_cat_builtin(cat_builtin_int),
+ non_foreign_type(int_type)).
+
ml_make_boxed_types(Arity) = BoxedTypes :-
varset.init(TypeVarSet0),
varset.new_vars(TypeVarSet0, Arity, BoxedTypeVars, _TypeVarSet),
@@ -1503,8 +1518,8 @@
ml_gen_var_lval(Info, VarName, VarType, QualifiedVarLval) :-
ml_gen_info_get_module_name(Info, ModuleName),
- MLDS_Module = mercury_module_name_to_mlds(ModuleName),
- MLDS_Var = qual(MLDS_Module, module_qual, VarName),
+ MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
+ MLDS_Var = qual(MLDS_ModuleName, module_qual, VarName),
QualifiedVarLval = ml_var(MLDS_Var, VarType).
ml_gen_var_decl(VarName, Type, Context, Defn, !Info) :-
@@ -1525,20 +1540,6 @@
DeclFlags = ml_gen_local_var_decl_flags,
Defn = mlds_defn(Name, Context, DeclFlags, EntityDefn).
-ml_gen_static_const_defn(ConstName, ConstType, Access, Initializer, Context,
- VarName, !GlobalData) :-
- ml_global_data_get_unique_const_num(ConstNum, !GlobalData),
- VarName = mlds_var_name(ConstName, yes(ConstNum)),
- EntityName = entity_data(mlds_data_var(VarName)),
- % The GC never needs to trace static constants, because they can never
- % point into the heap; they can point only to other static constants.
- GCStatement = gc_no_stmt,
- EntityDefn = mlds_data(ConstType, Initializer, GCStatement),
- DeclFlags = mlds.set_access(ml_static_const_decl_flags, Access),
- MLDS_Context = mlds_make_context(Context),
- Defn = mlds_defn(EntityName, MLDS_Context, DeclFlags, EntityDefn),
- ml_global_data_add_flat_cell_defn(Defn, !GlobalData).
-
ml_gen_public_field_decl_flags = DeclFlags :-
Access = acc_public,
PerInstance = per_instance,
@@ -1559,18 +1560,6 @@
DeclFlags = init_decl_flags(Access, PerInstance,
Virtuality, Finality, Constness, Abstractness).
-ml_static_const_decl_flags = DeclFlags :-
- % Note that rtti_decl_flags, in rtti_to_mlds.m,
- % must be the same as this apart from the access.
- Access = acc_local,
- PerInstance = one_copy,
- Virtuality = non_virtual,
- Finality = final,
- Constness = const,
- Abstractness = concrete,
- DeclFlags = init_decl_flags(Access, PerInstance,
- Virtuality, Finality, Constness, Abstractness).
-
ml_var_name_to_string(mlds_var_name(Var, yes(Num))) =
Var ++ "_" ++ string.int_to_string(Num).
ml_var_name_to_string(mlds_var_name(Var, no)) = Var.
@@ -2835,6 +2824,54 @@
ModuleName = ModuleName0
).
+ml_gen_box_const_rvals(_, _, [], [], [], !GlobalData).
+ml_gen_box_const_rvals(_, _, [], [_ | _], _, !GlobalData) :-
+ unexpected(this_file, "ml_gen_box_const_rvals: list length mismatch").
+ml_gen_box_const_rvals(_, _, [_ | _], [], _, !GlobalData) :-
+ unexpected(this_file, "ml_gen_box_const_rvals: list length mismatch").
+ml_gen_box_const_rvals(ModuleInfo, Context, [Type | Types], [Rval | Rvals],
+ [BoxedRval | BoxedRvals], !GlobalData) :-
+ ml_gen_box_const_rval(ModuleInfo, Context, Type, Rval, BoxedRval,
+ !GlobalData),
+ ml_gen_box_const_rvals(ModuleInfo, Context, Types, Rvals, BoxedRvals,
+ !GlobalData).
+
+ml_gen_box_const_rval(ModuleInfo, Context, Type, Rval, BoxedRval,
+ !GlobalData) :-
+ (
+ ( Type = mercury_type(type_variable(_, _), _, _)
+ ; Type = mlds_generic_type
+ )
+ ->
+ BoxedRval = Rval
+ ;
+ % For the MLDS->C and MLDS->asm back-ends, we need to handle floats
+ % specially, since boxed floats normally get heap allocated, whereas
+ % for other types boxing is just a cast (casts are OK in static
+ % initializers, but calls to malloc() are not).
+ %
+ % [For the .NET and Java back-ends, this code currently never gets
+ % called, since currently we don't support static ground term
+ % optimization for those back-ends.]
+
+ ( Type = mercury_type(builtin_type(builtin_type_float), _, _)
+ ; Type = mlds_native_float_type
+ )
+ ->
+ % Generate a local static constant for this float.
+ module_info_get_name(ModuleInfo, ModuleName),
+ MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
+ Initializer = init_obj(Rval),
+ ml_gen_static_scalar_const_addr(MLDS_ModuleName, "float", Type,
+ Initializer, Context, ConstAddrRval, !GlobalData),
+
+ % Return as the boxed rval the address of that constant,
+ % cast to mlds_generic_type.
+ BoxedRval = ml_unop(cast(mlds_generic_type), ConstAddrRval)
+ ;
+ BoxedRval = ml_unop(box(Type), Rval)
+ ).
+
%-----------------------------------------------------------------------------%
:- func this_file = string.
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.108
diff -u -b -r1.108 ml_elim_nested.m
--- compiler/ml_elim_nested.m 16 Sep 2009 02:32:53 -0000 1.108
+++ compiler/ml_elim_nested.m 20 Sep 2009 04:56:52 -0000
@@ -473,6 +473,7 @@
% Flat global data structures do not need to be processed here; that is
% what makes them "flat".
ml_global_data_get_global_defns(GlobalData0,
+ _ScalarCellGroupMap, _VectorCellGroupMap,
_RevFlatCellDefns, _RevFlatRttiDefns, RevNonFlatDefns0),
list.reverse(RevNonFlatDefns0, NonFlatDefns0),
ml_elim_nested_defns_list(Action, MLDS_ModuleName, Globals, OuterVars,
@@ -1151,7 +1152,7 @@
DefnBody0 = mlds_function(PredProcId, Params,
body_defined_here(FuncBody0), Attributes, EnvVarNames),
statement_contains_var(FuncBody0, qual(ModuleName, module_qual,
- mlds_data_var(mlds_var_name("env_ptr", no))))
+ mlds_data_var(mlds_var_name("env_ptr", no)))) = yes
->
EnvPtrVal = ml_lval(ml_var(qual(ModuleName, module_qual,
mlds_var_name("env_ptr_arg", no)),
@@ -1773,7 +1774,7 @@
ml_need_to_hoist_defn(QualDataName, FollowingDefn) :-
FollowingDefn = mlds_defn(_, _, _, mlds_function(_, _, _, _, _)),
- defn_contains_var(FollowingDefn, QualDataName).
+ defn_contains_var(FollowingDefn, QualDataName) = yes.
%-----------------------------------------------------------------------------%
@@ -2016,7 +2017,12 @@
fixup_rval(Action, Info, YRval0, YRval),
Rval = ml_binop(BinOp, XRval, YRval)
;
+ Rval0 = ml_vector_common_row(VectorCommon, RowRval0),
+ fixup_rval(Action, Info, RowRval0, RowRval),
+ Rval = ml_vector_common_row(VectorCommon, RowRval)
+ ;
( Rval0 = ml_const(_)
+ ; Rval0 = ml_scalar_common(_)
; Rval0 = ml_self(_)
),
Rval = Rval0
Index: compiler/ml_global_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_global_data.m,v
retrieving revision 1.1
diff -u -b -r1.1 ml_global_data.m
--- compiler/ml_global_data.m 2 Sep 2009 00:30:19 -0000 1.1
+++ compiler/ml_global_data.m 20 Sep 2009 08:13:07 -0000
@@ -19,8 +19,13 @@
:- interface.
:- import_module backend_libs.rtti.
+:- import_module libs.globals.
:- import_module ml_backend.mlds.
+:- import_module parse_tree.prog_data.
+:- import_module bimap.
+:- import_module cord.
+:- import_module counter.
:- import_module list.
:- import_module map.
@@ -30,29 +35,63 @@
%
:- type ml_global_data.
+:- type use_common_cells
+ ---> do_not_use_common_cells
+ ; use_common_cells.
+
+:- type ml_scalar_cell_map ==
+ map(ml_scalar_common_type_num, ml_scalar_cell_group).
+
+:- type ml_scalar_cell_group
+ ---> ml_scalar_cell_group(
+ mscg_type :: mlds_type,
+ mscg_array_size :: initializer_array_size,
+
+ mscg_counter :: counter, % next cell number
+ mscg_members :: bimap(mlds_initializer,
+ mlds_scalar_common),
+ mscg_rows :: cord(mlds_initializer)
+ ).
+
+:- type ml_vector_cell_map ==
+ map(ml_vector_common_type_num, ml_vector_cell_group).
+
+:- type ml_vector_cell_group
+ ---> ml_vector_cell_group(
+ mvcg_type :: mlds_type,
+ mvcg_type_defn :: mlds_defn,
+ mvcg_field_ids :: list(mlds_field_id),
+
+ mvcg_next_row :: int,
+ mvcg_rows :: cord(mlds_initializer)
+ ).
+
% Initialize the ml_global_data structure to a value that represents
% no global data structures known yet.
%
-:- func ml_global_data_init = ml_global_data.
+:- func ml_global_data_init(use_common_cells) = ml_global_data.
- % ml_global_data_get_global_defns(GlobalData, RevFlatCellDefns,
- % RevFlatRttiDefns, RevMaybeNonFlatDefns):
+ % ml_global_data_get_global_defns(GlobalData, ScalarCellTypeMap,
+ % RevFlatCellDefns, RevFlatRttiDefns, RevMaybeNonFlatDefns):
%
% Get all the global definitions implicit in the argument. Each group
% of global definitions with shared characteristics are returned in a
% separate argument.
%
:- pred ml_global_data_get_global_defns(ml_global_data::in,
+ ml_scalar_cell_map::out, ml_vector_cell_map::out,
list(mlds_defn)::out, list(mlds_defn)::out, list(mlds_defn)::out) is det.
- % ml_global_data_get_all_global_defns(GlobalData, Defns):
+ % ml_global_data_get_all_global_defns(GlobalData, ScalarCellTypeMap,
+ % Defns):
%
- % Get all the global definitions implicit in the argument, in an order
- % which is likely to be reasonably good. Note that this order may still
- % require forward declarations.
+ % Get all the global definitions implicit in the argument, grouped together
+ % as much as possible, in an order which is likely to be reasonably good.
+ % Note that this order may still require forward declarations.
%
:- pred ml_global_data_get_all_global_defns(ml_global_data::in,
- list(mlds_defn)::out) is det.
+ ml_scalar_cell_map::out, ml_vector_cell_map::out, list(mlds_defn)::out)
+ is det.
% This type maps the names of rtti data structures that have already been
% generated to the rval that refers to that data structure, and its type.
@@ -82,9 +121,6 @@
:- pred ml_global_data_get_pdup_rval_type_map(ml_global_data::in,
ml_rtti_rval_type_map::out) is det.
-:- pred ml_global_data_get_unique_const_num(int::out,
- ml_global_data::in, ml_global_data::out) is det.
-
% Set the list of unique maybe-nonflat definitions to the given list.
% Intended for use by code that transforms the previously current list
% of unique maybe-nonflat definitions.
@@ -103,8 +139,6 @@
% definitions (definitions for which ml_elim_nested is an identity
% operation), while some have no such guarantee.
%
-:- pred ml_global_data_add_flat_cell_defn(mlds_defn::in,
- ml_global_data::in, ml_global_data::out) is det.
:- pred ml_global_data_add_flat_rtti_defn(mlds_defn::in,
ml_global_data::in, ml_global_data::out) is det.
:- pred ml_global_data_add_flat_rtti_defns(list(mlds_defn)::in,
@@ -112,35 +146,102 @@
:- pred ml_global_data_add_maybe_nonflat_defns(list(mlds_defn)::in,
ml_global_data::in, ml_global_data::out) is det.
+ % Generate a definition for a static scalar constant, given the constant's
+ % name prefix, type, and initializer (access is always acc_private),
+ % and return a reference to the constant itself (not its address).
+ %
+:- pred ml_gen_static_scalar_const_value(mlds_module_name::in, string::in,
+ mlds_type::in, mlds_initializer::in, prog_context::in, mlds_rval::out,
+ ml_global_data::in, ml_global_data::out) is det.
+
+ % Generate a definition for a static scalar constant, given the constant's
+ % name prefix, type, and initializer (access is always acc_private),
+ % and return a reference to the constant's address.
+ %
+:- pred ml_gen_static_scalar_const_addr(mlds_module_name::in, string::in,
+ mlds_type::in, mlds_initializer::in, prog_context::in, mlds_rval::out,
+ ml_global_data::in, ml_global_data::out) is det.
+
+ % Look up (and if necessary, create) the type of the structure needed
+ % to hold a vector of values of the given types. Return the number of the
+ % type, so that it can be given to ml_gen_static_vector_defn later,
+ % and both the type itself and the names of its fields, so that they
+ % can be used in code that builds and/or uses the vector.
+ %
+:- pred ml_gen_static_vector_type(mlds_module_name::in, mlds_context::in,
+ compilation_target::in, list(mlds_type)::in,
+ ml_vector_common_type_num::out, mlds_type::out, list(mlds_field_id)::out,
+ ml_global_data::in, ml_global_data::out) is det.
+
+ % Generate a definition for a static vector constant, given the constant's
+ % type and an initializer for each row.
+ %
+:- pred ml_gen_static_vector_defn(mlds_module_name::in,
+ ml_vector_common_type_num::in, list(mlds_initializer)::in,
+ mlds_vector_common::out, ml_global_data::in, ml_global_data::out) is det.
+
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module counter.
+:- import_module libs.compiler_util.
+
+:- import_module int.
+:- import_module maybe.
+:- import_module string.
:- import_module svmap.
+:- type ml_scalar_cell_type
+ ---> ml_scalar_cell_type(mlds_type, initializer_array_size).
+:- type ml_scalar_cell_type_map
+ == map(ml_scalar_cell_type, ml_scalar_common_type_num).
+
+:- type ml_vector_cell_type_map
+ == map(list(mlds_type), ml_vector_common_type_num).
+
:- type ml_global_data
---> ml_global_data(
- mdg_pdup_rval_type_map :: ml_rtti_rval_type_map,
- mdg_const_counter :: counter,
- mdg_rev_flat_cell_defns :: list(mlds_defn),
- mdg_rev_flat_rtti_defns :: list(mlds_defn),
- mdg_rev_maybe_nonflat_defns :: list(mlds_defn)
- ).
+ mgd_pdup_rval_type_map :: ml_rtti_rval_type_map,
+ mgd_use_common_cells :: use_common_cells,
+ mgd_const_counter :: counter,
+ mgd_rev_flat_cell_defns :: list(mlds_defn),
+ mgd_rev_flat_rtti_defns :: list(mlds_defn),
+ mgd_rev_maybe_nonflat_defns :: list(mlds_defn),
-%-----------------------------------------------------------------------------%
+ mgd_cell_type_counter :: counter,
+
+ mgd_scalar_type_num_map :: ml_scalar_cell_type_map,
+ mgd_scalar_cell_group_map :: ml_scalar_cell_map,
-ml_global_data_init = GlobalData :-
- GlobalData = ml_global_data(map.init, counter.init(1), [], [], []).
+ mgd_vector_type_num_map :: ml_vector_cell_type_map,
+ mgd_vector_cell_group_map :: ml_vector_cell_map
+ ).
-ml_global_data_get_global_defns(GlobalData, RevFlatCellDefns, RevFlatRttiDefns,
- RevMaybeNonFlatDefns) :-
- GlobalData = ml_global_data(_PDupRvalTypeMap, _ConstCounter,
- RevFlatCellDefns, RevFlatRttiDefns, RevMaybeNonFlatDefns).
+%-----------------------------------------------------------------------------%
-ml_global_data_get_all_global_defns(GlobalData, Defns) :-
- GlobalData = ml_global_data(_PDupRvalTypeMap, _ConstCounter,
- RevFlatCellDefns, RevFlatRttiDefns, RevMaybeNonFlatDefns),
+ml_global_data_init(UseCommonCells) = GlobalData :-
+ GlobalData = ml_global_data(map.init, UseCommonCells,
+ counter.init(1), [], [], [],
+ counter.init(1), map.init, map.init, map.init, map.init).
+
+ml_global_data_get_global_defns(GlobalData,
+ ScalarCellGroupMap, VectorCellGroupMap,
+ RevFlatCellDefns, RevFlatRttiDefns, RevMaybeNonFlatDefns) :-
+ GlobalData = ml_global_data(_PDupRvalTypeMap, _UseCommonCells,
+ _ConstCounter,
+ RevFlatCellDefns, RevFlatRttiDefns, RevMaybeNonFlatDefns,
+ _TypeNumCounter,
+ _ScalarTypeNumMap, ScalarCellGroupMap,
+ _VectorTypeNumMap, VectorCellGroupMap).
+
+ml_global_data_get_all_global_defns(GlobalData,
+ ScalarCellGroupMap, VectorCellGroupMap, Defns) :-
+ GlobalData = ml_global_data(_PDupRvalTypeMap, _UseCommonCells,
+ _ConstCounter,
+ RevFlatCellDefns, RevFlatRttiDefns, RevMaybeNonFlatDefns,
+ _TypeNumCounter,
+ _ScalarTypeNumMap, ScalarCellGroupMap,
+ _VectorTypeNumMap, VectorCellGroupMap),
% RevFlatRttiDefns are type_ctor_infos and the like, while
% RevNonFlatDefns are type_infos and pseudo_type_infos.
% They refer to each other, so neither order is obviously better.
@@ -176,26 +277,26 @@
ml_global_data::in, ml_global_data::out) is det.
ml_global_data_get_pdup_rval_type_map(GlobalData,
- GlobalData ^ mdg_pdup_rval_type_map).
+ GlobalData ^ mgd_pdup_rval_type_map).
ml_global_data_get_const_counter(GlobalData,
- GlobalData ^ mdg_const_counter).
+ GlobalData ^ mgd_const_counter).
ml_global_data_get_rev_flat_cell_defns(GlobalData,
- GlobalData ^ mdg_rev_flat_cell_defns).
+ GlobalData ^ mgd_rev_flat_cell_defns).
ml_global_data_get_rev_flat_rtti_defns(GlobalData,
- GlobalData ^ mdg_rev_flat_rtti_defns).
+ GlobalData ^ mgd_rev_flat_rtti_defns).
ml_global_data_get_rev_maybe_nonflat_defns(GlobalData,
- GlobalData ^ mdg_rev_maybe_nonflat_defns).
+ GlobalData ^ mgd_rev_maybe_nonflat_defns).
ml_global_data_set_pdup_rval_type_map(PDupRvalTypeMap, !GlobalData) :-
- !GlobalData ^ mdg_pdup_rval_type_map := PDupRvalTypeMap.
+ !GlobalData ^ mgd_pdup_rval_type_map := PDupRvalTypeMap.
ml_global_data_set_const_counter(ConstCounter, !GlobalData) :-
- !GlobalData ^ mdg_const_counter := ConstCounter.
+ !GlobalData ^ mgd_const_counter := ConstCounter.
ml_global_data_set_rev_flat_cell_defns(Defns, !GlobalData) :-
- !GlobalData ^ mdg_rev_flat_cell_defns := Defns.
+ !GlobalData ^ mgd_rev_flat_cell_defns := Defns.
ml_global_data_set_rev_flat_rtti_defns(Defns, !GlobalData) :-
- !GlobalData ^ mdg_rev_flat_rtti_defns := Defns.
+ !GlobalData ^ mgd_rev_flat_rtti_defns := Defns.
ml_global_data_set_rev_maybe_nonflat_defns(Defns, !GlobalData) :-
- !GlobalData ^ mdg_rev_maybe_nonflat_defns := Defns.
+ !GlobalData ^ mgd_rev_maybe_nonflat_defns := Defns.
%-----------------------------------------------------------------------------%
@@ -204,16 +305,6 @@
svmap.det_insert(RttiId, RvalType, PDupRvalTypeMap0, PDupRvalTypeMap),
ml_global_data_set_pdup_rval_type_map(PDupRvalTypeMap, !GlobalData).
-ml_global_data_get_unique_const_num(ConstNum, !GlobalData) :-
- ml_global_data_get_const_counter(!.GlobalData, ConstCounter0),
- counter.allocate(ConstNum, ConstCounter0, ConstCounter),
- ml_global_data_set_const_counter(ConstCounter, !GlobalData).
-
-ml_global_data_add_flat_cell_defn(Defn, !GlobalData) :-
- ml_global_data_get_rev_flat_cell_defns(!.GlobalData, RevDefns0),
- RevDefns = [Defn | RevDefns0],
- ml_global_data_set_rev_flat_cell_defns(RevDefns, !GlobalData).
-
ml_global_data_add_flat_rtti_defn(Defn, !GlobalData) :-
ml_global_data_get_rev_flat_rtti_defns(!.GlobalData, RevDefns0),
RevDefns = [Defn | RevDefns0],
@@ -230,5 +321,230 @@
ml_global_data_set_rev_maybe_nonflat_defns(RevDefns, !GlobalData).
%-----------------------------------------------------------------------------%
+
+ml_gen_static_scalar_const_value(MLDS_ModuleName, ConstBaseName, ConstType,
+ Initializer, Context, DataRval, !GlobalData) :-
+ UseCommonCells = !.GlobalData ^ mgd_use_common_cells,
+ (
+ UseCommonCells = use_common_cells,
+ ml_gen_scalar_static_defn(MLDS_ModuleName, ConstType, Initializer,
+ Common, !GlobalData),
+ DataRval = ml_scalar_common(Common)
+ ;
+ UseCommonCells = do_not_use_common_cells,
+ ml_gen_plain_static_defn(ConstBaseName, ConstType, Initializer,
+ Context, VarName, !GlobalData),
+ QualVarName = qual(MLDS_ModuleName, module_qual, VarName),
+ DataVar = ml_var(QualVarName, ConstType),
+ DataRval = ml_lval(DataVar)
+ ).
+
+ml_gen_static_scalar_const_addr(MLDS_ModuleName, ConstBaseName, ConstType,
+ Initializer, Context, DataAddrRval, !GlobalData) :-
+ UseCommonCells = !.GlobalData ^ mgd_use_common_cells,
+ (
+ UseCommonCells = use_common_cells,
+ ml_gen_scalar_static_defn(MLDS_ModuleName, ConstType, Initializer,
+ Common, !GlobalData),
+ CommonDataName = mlds_scalar_common_ref(Common),
+ DataAddr = data_addr(MLDS_ModuleName, CommonDataName),
+ DataAddrRval = ml_const(mlconst_data_addr(DataAddr))
+ ;
+ UseCommonCells = do_not_use_common_cells,
+ ml_gen_plain_static_defn(ConstBaseName, ConstType, Initializer,
+ Context, VarName, !GlobalData),
+ DataName = mlds_data_var(VarName),
+ DataAddr = data_addr(MLDS_ModuleName, DataName),
+ DataAddrRval = ml_const(mlconst_data_addr(DataAddr))
+ ).
+
+:- pred ml_gen_scalar_static_defn(mlds_module_name::in, mlds_type::in,
+ mlds_initializer::in, mlds_scalar_common::out,
+ ml_global_data::in, ml_global_data::out) is det.
+
+ml_gen_scalar_static_defn(MLDS_ModuleName, ConstType, Initializer, Common,
+ !GlobalData) :-
+ InitArraySize = get_initializer_array_size(Initializer),
+ CellType = ml_scalar_cell_type(ConstType, InitArraySize),
+ some [!CellGroup] (
+ TypeNumMap0 = !.GlobalData ^ mgd_scalar_type_num_map,
+ CellGroupMap0 = !.GlobalData ^ mgd_scalar_cell_group_map,
+ ( map.search(TypeNumMap0, CellType, OldTypeNum) ->
+ TypeNum = OldTypeNum,
+ ( map.search(CellGroupMap0, TypeNum, !:CellGroup) ->
+ true
+ ;
+ !:CellGroup = ml_scalar_cell_group(ConstType,
+ InitArraySize, counter.init(0), bimap.init, cord.empty)
+ )
+ ;
+ TypeNumCounter0 = !.GlobalData ^ mgd_cell_type_counter,
+ counter.allocate(TypeRawNum, TypeNumCounter0, TypeNumCounter),
+ TypeNum = ml_scalar_common_type_num(TypeRawNum),
+ !GlobalData ^ mgd_cell_type_counter := TypeNumCounter,
+
+ map.det_insert(TypeNumMap0, CellType, TypeNum, TypeNumMap),
+ !GlobalData ^ mgd_scalar_type_num_map := TypeNumMap,
+
+ !:CellGroup = ml_scalar_cell_group(ConstType,
+ InitArraySize, counter.init(0), bimap.init, cord.empty)
+ ),
+
+ MembersMap0 = !.CellGroup ^ mscg_members,
+ ( bimap.search(MembersMap0, Initializer, OldCommon) ->
+ Common = OldCommon
+ ;
+ RowCounter0 = !.CellGroup ^ mscg_counter,
+ counter.allocate(RowNum, RowCounter0, RowCounter),
+ !CellGroup ^ mscg_counter := RowCounter,
+
+ Common = ml_scalar_common(MLDS_ModuleName, ConstType, TypeNum,
+ RowNum),
+
+ Rows0 = !.CellGroup ^ mscg_rows,
+ Rows = cord.snoc(Rows0, Initializer),
+ !CellGroup ^ mscg_rows := Rows,
+
+ bimap.det_insert(MembersMap0, Initializer, Common, MembersMap),
+ !CellGroup ^ mscg_members := MembersMap
+ ),
+ map.set(CellGroupMap0, TypeNum, !.CellGroup, CellGroupMap),
+ !GlobalData ^ mgd_scalar_cell_group_map := CellGroupMap
+ ).
+
+:- pred ml_gen_plain_static_defn(string::in, mlds_type::in,
+ mlds_initializer::in, prog_context::in, mlds_var_name::out,
+ ml_global_data::in, ml_global_data::out) is det.
+
+ml_gen_plain_static_defn(ConstBaseName, ConstType,
+ Initializer, Context, VarName, !GlobalData) :-
+ ml_global_data_get_const_counter(!.GlobalData, ConstCounter0),
+ counter.allocate(ConstNum, ConstCounter0, ConstCounter),
+ ml_global_data_set_const_counter(ConstCounter, !GlobalData),
+
+ VarName = mlds_var_name(ConstBaseName, yes(ConstNum)),
+ EntityName = entity_data(mlds_data_var(VarName)),
+ % The GC never needs to trace static constants, because they can never
+ % point into the heap; they can point only to other static constants.
+ GCStatement = gc_no_stmt,
+ EntityDefn = mlds_data(ConstType, Initializer, GCStatement),
+ DeclFlags = mlds.set_access(ml_static_const_decl_flags, acc_private),
+ MLDS_Context = mlds_make_context(Context),
+ Defn = mlds_defn(EntityName, MLDS_Context, DeclFlags, EntityDefn),
+
+ ml_global_data_get_rev_flat_cell_defns(!.GlobalData, RevDefns0),
+ RevDefns = [Defn | RevDefns0],
+ ml_global_data_set_rev_flat_cell_defns(RevDefns, !GlobalData).
+
+%-----------------------------------------------------------------------------%
+
+ml_gen_static_vector_type(MLDS_ModuleName, MLDS_Context, Target, ArgTypes,
+ TypeNum, StructType, FieldIds, !GlobalData) :-
+ TypeNumMap0 = !.GlobalData ^ mgd_vector_type_num_map,
+ ( map.search(TypeNumMap0, ArgTypes, OldTypeNum) ->
+ TypeNum = OldTypeNum,
+ CellGroupMap = !.GlobalData ^ mgd_vector_cell_group_map,
+ map.lookup(CellGroupMap, TypeNum, CellGroup),
+ CellGroup = ml_vector_cell_group(StructType, _TypeDefn, FieldIds,
+ _, _)
+ ;
+ TypeNumCounter0 = !.GlobalData ^ mgd_cell_type_counter,
+ counter.allocate(TypeRawNum, TypeNumCounter0, TypeNumCounter),
+ TypeRawNumStr = string.int_to_string(TypeRawNum),
+ TypeNum = ml_vector_common_type_num(TypeRawNum),
+ !GlobalData ^ mgd_cell_type_counter := TypeNumCounter,
+
+ map.det_insert(TypeNumMap0, ArgTypes, TypeNum, TypeNumMap),
+ !GlobalData ^ mgd_vector_type_num_map := TypeNumMap,
+
+ FieldFlags = init_decl_flags(acc_local, per_instance, non_virtual,
+ final, const, concrete),
+ FieldNamePrefix = "vct_" ++ TypeRawNumStr,
+ ml_gen_vector_cell_field_types(MLDS_Context, FieldFlags,
+ FieldNamePrefix, 0, ArgTypes, FieldNames, FieldDefns),
+
+ ClassDefn = mlds_class_defn(mlds_struct, [], [], [], [], FieldDefns),
+ StructTypeName = "vector_common_type_" ++ TypeRawNumStr,
+ StructTypeEntityName = entity_type(StructTypeName, 0),
+ StructTypeEntityDefn = mlds_class(ClassDefn),
+ % The "modifiable" is only to shut up a gcc warning about constant
+ % fields.
+ StructTypeFlags = init_decl_flags(acc_private, one_copy,
+ non_virtual, final, modifiable, concrete),
+ StructTypeDefn = mlds_defn(StructTypeEntityName, MLDS_Context,
+ StructTypeFlags, StructTypeEntityDefn),
+ QualStructTypeName =
+ qual(MLDS_ModuleName, module_qual, StructTypeName),
+ StructType = mlds_class_type(QualStructTypeName, 0, mlds_struct),
+
+ MLDS_ClassModuleName = mlds_append_class_qualifier(Target,
+ MLDS_ModuleName, module_qual, StructTypeName, 0),
+ make_named_fields(MLDS_ClassModuleName, StructType, FieldNames,
+ FieldIds),
+
+ CellGroup = ml_vector_cell_group(StructType, StructTypeDefn, FieldIds,
+ 0, cord.empty),
+
+ CellGroupMap0 = !.GlobalData ^ mgd_vector_cell_group_map,
+ map.det_insert(CellGroupMap0, TypeNum, CellGroup, CellGroupMap),
+ !GlobalData ^ mgd_vector_cell_group_map := CellGroupMap
+ ).
+
+:- pred ml_gen_vector_cell_field_types(mlds_context::in, mlds_decl_flags::in,
+ string::in, int::in, list(mlds_type)::in,
+ list(string)::out, list(mlds_defn)::out) is det.
+
+ml_gen_vector_cell_field_types(_, _, _, _, [], [], []).
+ml_gen_vector_cell_field_types(MLDS_Context, Flags, FieldNamePrefix, FieldNum,
+ [Type | Types], [RawFieldName | RawFieldNames],
+ [FieldDefn | FieldDefns]) :-
+ RawFieldName = FieldNamePrefix ++ "_f_" ++ string.int_to_string(FieldNum),
+ FieldName = entity_data(mlds_data_var(mlds_var_name(RawFieldName, no))),
+ FieldEntityDefn = mlds_data(Type, no_initializer, gc_no_stmt),
+ FieldDefn = mlds_defn(FieldName, MLDS_Context, Flags, FieldEntityDefn),
+ ml_gen_vector_cell_field_types(MLDS_Context, Flags, FieldNamePrefix,
+ FieldNum + 1, Types, RawFieldNames, FieldDefns).
+
+:- pred make_named_fields(mlds_module_name::in, mlds_type::in,
+ list(string)::in, list(mlds_field_id)::out) is det.
+
+make_named_fields(_, _, [], []).
+make_named_fields(MLDS_ModuleName, StructType, [RawFieldName | RawFieldNames],
+ [FieldName | FieldNames]) :-
+ QualName = qual(MLDS_ModuleName, module_qual, RawFieldName),
+ FieldName = ml_field_named(QualName, StructType),
+ make_named_fields(MLDS_ModuleName, StructType, RawFieldNames, FieldNames).
+
+ml_gen_static_vector_defn(MLDS_ModuleName, TypeNum, RowInitializers, Common,
+ !GlobalData) :-
+ some [!CellGroup] (
+ list.length(RowInitializers, NumRows),
+ CellGroupMap0 = !.GlobalData ^ mgd_vector_cell_group_map,
+ map.lookup(CellGroupMap0, TypeNum, !:CellGroup),
+
+ NextRow0 = !.CellGroup ^ mvcg_next_row,
+ StartRowNum = NextRow0,
+ NextRow = NextRow0 + NumRows,
+ !CellGroup ^ mvcg_next_row := NextRow,
+
+ StructType = !.CellGroup ^ mvcg_type,
+ Common = ml_vector_common(MLDS_ModuleName, StructType, TypeNum,
+ StartRowNum, NumRows),
+
+ Rows0 = !.CellGroup ^ mvcg_rows,
+ Rows = Rows0 ++ cord.from_list(RowInitializers),
+ !CellGroup ^ mvcg_rows := Rows,
+
+ map.det_update(CellGroupMap0, TypeNum, !.CellGroup, CellGroupMap),
+ !GlobalData ^ mgd_vector_cell_group_map := CellGroupMap
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "ml_global_data.m".
+
+%-----------------------------------------------------------------------------%
:- end_module ml_backend.ml_global_data.
%-----------------------------------------------------------------------------%
Index: compiler/ml_lookup_switch.m
===================================================================
RCS file: compiler/ml_lookup_switch.m
diff -N compiler/ml_lookup_switch.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/ml_lookup_switch.m 20 Sep 2009 10:50:44 -0000
@@ -0,0 +1,538 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2009 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.
+%-----------------------------------------------------------------------------%
+%
+% File: ml_lookup_switch.m
+% Author: zs.
+%
+%-----------------------------------------------------------------------------%
+
+:- module ml_backend.ml_lookup_switch.
+:- interface.
+
+:- import_module backend_libs.switch_util.
+:- import_module hlds.code_model.
+:- import_module hlds.hlds_goal.
+:- import_module ml_backend.ml_code_util.
+:- import_module ml_backend.mlds.
+:- import_module parse_tree.prog_data.
+
+:- import_module list.
+:- import_module set.
+
+%-----------------------------------------------------------------------------%
+
+ % Generate MLDS code for a lookup switch, if possible.
+ %
+:- pred ml_gen_lookup_switch(prog_var::in, list(tagged_case)::in,
+ set(prog_var)::in, code_model::in, prog_context::in,
+ int::in, int::in, need_bit_vec_check::in, need_range_check::in,
+ list(statement)::out, ml_gen_info::in, ml_gen_info::out) is semidet.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module backend_libs.builtin_ops.
+:- import_module hlds.goal_form.
+:- import_module hlds.hlds_data.
+:- import_module hlds.hlds_module.
+:- import_module libs.compiler_util.
+:- import_module libs.globals.
+:- import_module ml_backend.ml_code_gen.
+:- import_module ml_backend.ml_global_data.
+
+:- import_module assoc_list.
+:- import_module bool.
+:- import_module int.
+:- import_module map.
+:- import_module maybe.
+:- import_module pair.
+:- import_module svmap.
+
+%-----------------------------------------------------------------------------%
+
+ml_gen_lookup_switch(SwitchVar, TaggedCases, NonLocals, CodeModel, Context,
+ StartVal, EndVal, NeedBitVecCheck, NeedRangeCheck, Statements,
+ !Info) :-
+ set.remove(NonLocals, SwitchVar, OtherNonLocals),
+ set.to_sorted_list(OtherNonLocals, OutVars),
+ ml_generate_constants_for_lookup_switch(CodeModel, OtherNonLocals, OutVars,
+ TaggedCases, map.init, CaseSolnMap, no, GoalsMayModifyTrail, !Info),
+
+ % XXX We should implement the case GoalsMayModifyTrail = yes.
+ GoalsMayModifyTrail = no,
+
+ ml_gen_var(!.Info, SwitchVar, SwitchVarLval),
+ SwitchVarRval = ml_lval(SwitchVarLval),
+ ( StartVal = 0 ->
+ IndexRval = SwitchVarRval
+ ;
+ StartRval = ml_const(mlconst_int(StartVal)),
+ IndexRval = ml_binop(int_sub, SwitchVarRval, StartRval)
+ ),
+
+ map.to_assoc_list(CaseSolnMap, CaseSolns),
+ ( project_all_to_one_solution(CaseSolns, [], RevCaseValuePairs) ->
+ list.reverse(RevCaseValuePairs, CaseValuePairs),
+ ml_gen_simple_lookup_switch(IndexRval, OutVars, CaseValuePairs,
+ CodeModel, Context, StartVal, EndVal,
+ NeedBitVecCheck, NeedRangeCheck, Statement, !Info),
+ Statements = [Statement]
+ ;
+ % XXX We should implement this case.
+ fail
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred ml_gen_simple_lookup_switch(mlds_rval::in, list(prog_var)::in,
+ assoc_list(int, list(mlds_rval))::in, code_model::in, prog_context::in,
+ int::in, int::in, need_bit_vec_check::in, need_range_check::in,
+ statement::out, ml_gen_info::in, ml_gen_info::out) is det.
+
+ml_gen_simple_lookup_switch(IndexRval, OutVars, CaseValues, CodeModel, Context,
+ StartVal, EndVal, NeedBitVecCheck, NeedRangeCheck, Statement, !Info) :-
+ ml_gen_info_get_module_info(!.Info, ModuleInfo),
+ module_info_get_name(ModuleInfo, ModuleName),
+ MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
+ MLDS_Context = mlds_make_context(Context),
+ ml_gen_info_get_target(!.Info, Target),
+
+ ml_gen_info_get_var_types(!.Info, VarTypes),
+ list.map(map.lookup(VarTypes), OutVars, FieldTypes),
+ MLDS_FieldTypes =
+ list.map(mercury_type_to_mlds_type(ModuleInfo), FieldTypes),
+
+ ml_gen_info_get_global_data(!.Info, GlobalData0),
+ ml_gen_static_vector_type(MLDS_ModuleName, MLDS_Context, Target,
+ MLDS_FieldTypes, StructTypeNum, StructType, FieldIds,
+ GlobalData0, GlobalData1),
+
+ ml_construct_simple_vector(ModuleInfo, Context, StructType,
+ MLDS_FieldTypes, StartVal, CaseValues, RowInitializers),
+
+ ml_gen_static_vector_defn(MLDS_ModuleName, StructTypeNum, RowInitializers,
+ VectorCommon, GlobalData1, GlobalData),
+ ml_gen_info_set_global_data(GlobalData, !Info),
+
+ ml_generate_offset_assigns(OutVars, MLDS_FieldTypes, FieldIds,
+ VectorCommon, StructType, IndexRval, MLDS_Context, LookupStatements,
+ !Info),
+
+ (
+ CodeModel = model_det,
+ expect(unify(NeedRangeCheck, dont_need_range_check), this_file,
+ "ml_gen_simple_lookup_switch: model_det need_range_check"),
+ expect(unify(NeedBitVecCheck, dont_need_bit_vec_check), this_file,
+ "ml_gen_simple_lookup_switch: model_det need_bit_vec_check"),
+ Stmt = ml_stmt_block([], LookupStatements),
+ Statement = statement(Stmt, MLDS_Context)
+ ;
+ CodeModel = model_semi,
+ ml_gen_set_success(!.Info, ml_const(mlconst_true), Context,
+ SetSuccessTrueStatement),
+ LookupStmt = ml_stmt_block([],
+ LookupStatements ++ [SetSuccessTrueStatement]),
+ LookupStatement = statement(LookupStmt, MLDS_Context),
+ (
+ NeedRangeCheck = need_range_check,
+ Difference = EndVal - StartVal,
+ RangeCheckRval = ml_binop(unsigned_le, IndexRval,
+ ml_const(mlconst_int(Difference))),
+ ml_gen_set_success(!.Info, ml_const(mlconst_false), Context,
+ SetSuccessFalseStatement),
+ (
+ NeedBitVecCheck = dont_need_bit_vec_check,
+ RangeCheckSuccessStatement = LookupStatement
+ ;
+ NeedBitVecCheck = need_bit_vec_check,
+ ml_generate_bitvec_test(MLDS_ModuleName, Context, IndexRval,
+ CaseValues, StartVal, EndVal, BitVecCheckRval, !Info),
+
+ RangeCheckSuccessStmt = ml_stmt_if_then_else(BitVecCheckRval,
+ LookupStatement, yes(SetSuccessFalseStatement)),
+ RangeCheckSuccessStatement =
+ statement(RangeCheckSuccessStmt, MLDS_Context)
+ ),
+
+ % We want to execute the bit vector test only if the range check
+ % succeeded, since otherwise the bit vector test will probably
+ % access the bit vector outside its bounds.
+ Stmt = ml_stmt_if_then_else(RangeCheckRval,
+ RangeCheckSuccessStatement, yes(SetSuccessFalseStatement)),
+ Statement = statement(Stmt, MLDS_Context)
+ ;
+ NeedRangeCheck = dont_need_range_check,
+ (
+ NeedBitVecCheck = dont_need_bit_vec_check,
+ Statement = LookupStatement
+ ;
+ NeedBitVecCheck = need_bit_vec_check,
+ ml_generate_bitvec_test(MLDS_ModuleName, Context, IndexRval,
+ CaseValues, StartVal, EndVal, BitVecCheckRval, !Info),
+
+ ml_gen_set_success(!.Info, ml_const(mlconst_false), Context,
+ SetSuccessFalseStatement),
+
+ Stmt = ml_stmt_if_then_else(BitVecCheckRval,
+ LookupStatement, yes(SetSuccessFalseStatement)),
+ Statement = statement(Stmt, MLDS_Context)
+ )
+ )
+ ;
+ CodeModel = model_non,
+ % If all the switch arms have exactly one solution, then the switch
+ % as a whole cannot be model_non.
+ unexpected(this_file, "ml_gen_simple_lookup_switch: model_non")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % The bitvector is an array of words (where we use the first 32 bits
+ % of each word). Each bit represents a tag value for the (range checked)
+ % input to the lookup switch. The bit is `1' iff we have a case for that
+ % tag value.
+ %
+:- pred ml_generate_bitvec_test(mlds_module_name::in, prog_context::in,
+ mlds_rval::in, assoc_list(int, T)::in, int::in, int::in,
+ mlds_rval::out, ml_gen_info::in, ml_gen_info::out) is det.
+
+ml_generate_bitvec_test(MLDS_ModuleName, Context, IndexRval, CaseVals,
+ Start, _End, CheckRval, !Info) :-
+ ml_gen_info_get_globals(!.Info, Globals),
+ get_word_bits(Globals, WordBits, Log2WordBits),
+ ml_gen_info_get_global_data(!.Info, GlobalData0),
+ ml_generate_bit_vec(MLDS_ModuleName, Context, CaseVals, Start, WordBits,
+ BitVecArgRvals, BitVecRval, GlobalData0, GlobalData),
+
+ % Optimize the single-word case: if all the cases fit into a single word,
+ % then the word to use is always that word, and the index specifies which
+ % bit; we don't need the array.
+ ( BitVecArgRvals = [SingleWordRval] ->
+ % Do not save GlobalData back into !Info.
+ WordRval = SingleWordRval,
+ BitNumRval = IndexRval
+ ;
+ % Otherwise, the high bits of the index specify which word in the array
+ % to use and the low bits specify which bit in that word.
+ ml_gen_info_set_global_data(GlobalData, !Info),
+
+ % This is the same as
+ % WordNumRval = ml_binop(int_div, IndexRval,
+ % ml_const(mlconst_int(WordBits)))
+ % except that it can generate more efficient code.
+ WordNumRval = ml_binop(unchecked_right_shift, IndexRval,
+ ml_const(mlconst_int(Log2WordBits))),
+
+ ArrayElemType = array_elem_scalar(scalar_elem_int),
+ WordRval = ml_binop(array_index(ArrayElemType),
+ BitVecRval, WordNumRval),
+
+ % This is the same as
+ % BitNumRval = ml_binop(int_mod, IndexRval,
+ % ml_const(mlconst_int(WordBits)))
+ % except that it can generate more efficient code.
+ BitNumRval = ml_binop(bitwise_and, IndexRval,
+ ml_const(mlconst_int(WordBits - 1)))
+ ),
+ CheckRval = ml_binop(bitwise_and, WordRval,
+ ml_binop(unchecked_left_shift, ml_const(mlconst_int(1)), BitNumRval)).
+
+ % We generate the bitvector by iterating through the cases marking the bit
+ % for each case. We represent the bitvector here as a map from the word
+ % number in the vector to the bits for that word.
+ %
+:- pred ml_generate_bit_vec(mlds_module_name::in, prog_context::in,
+ assoc_list(int, T)::in, int::in, int::in,
+ list(mlds_rval)::out, mlds_rval::out,
+ ml_global_data::in, ml_global_data::out) is det.
+
+ml_generate_bit_vec(MLDS_ModuleName, Context, CaseVals, Start, WordBits,
+ WordRvals, BitVecRval, !GlobalData) :-
+ map.init(BitMap0),
+ ml_generate_bit_vec_2(CaseVals, Start, WordBits, BitMap0, BitMap),
+ map.to_assoc_list(BitMap, WordVals),
+ ml_generate_bit_vec_initializers(WordVals, 0, WordRvals, WordInitializers),
+ Initializer = init_array(WordInitializers),
+
+ ConstType = mlds_array_type(mlds_native_int_type),
+ ml_gen_static_scalar_const_value(MLDS_ModuleName, "bit_vector", ConstType,
+ Initializer, Context, BitVecRval, !GlobalData).
+
+:- pred ml_generate_bit_vec_2(assoc_list(int, T)::in, int::in, int::in,
+ map(int, int)::in, map(int, int)::out) is det.
+
+ml_generate_bit_vec_2([], _, _, !BitMap).
+ml_generate_bit_vec_2([Tag - _ | Rest], Start, WordBits, !BitMap) :-
+ Val = Tag - Start,
+ Word = Val // WordBits,
+ Offset = Val mod WordBits,
+ ( map.search(!.BitMap, Word, X0) ->
+ X1 = X0 \/ (1 << Offset)
+ ;
+ X1 = (1 << Offset)
+ ),
+ svmap.set(Word, X1, !BitMap),
+ ml_generate_bit_vec_2(Rest, Start, WordBits, !BitMap).
+
+:- pred ml_generate_bit_vec_initializers(list(pair(int))::in, int::in,
+ list(mlds_rval)::out, list(mlds_initializer)::out) is det.
+
+ml_generate_bit_vec_initializers([], _, [], []).
+ml_generate_bit_vec_initializers([Word - Bits | Rest], Count,
+ [Rval | Rvals], [Initializer | Initializers]) :-
+ ( Count < Word ->
+ WordVal = 0,
+ Remainder = [Word - Bits | Rest]
+ ;
+ WordVal = Bits,
+ Remainder = Rest
+ ),
+ Rval = ml_const(mlconst_int(WordVal)),
+ Initializer = init_obj(Rval),
+ Count1 = Count + 1,
+ ml_generate_bit_vec_initializers(Remainder, Count1, Rvals, Initializers).
+
+%-----------------------------------------------------------------------------%
+
+:- pred ml_construct_simple_vector(module_info::in, prog_context::in,
+ mlds_type::in, list(mlds_type)::in, int::in,
+ assoc_list(int, list(mlds_rval))::in, list(mlds_initializer)::out) is det.
+
+ml_construct_simple_vector(_, _, _, _, _, [], []).
+ml_construct_simple_vector(ModuleInfo, Context, StructType, FieldTypes,
+ CurIndex, [Pair | Pairs], [RowInitializer | RowInitializers]) :-
+ Pair = Index - Rvals,
+ ( CurIndex < Index ->
+ FieldRvals = list.map(ml_default_value_for_type, FieldTypes),
+ RemainingPairs = [Pair | Pairs]
+ ;
+ FieldRvals = Rvals,
+ RemainingPairs = Pairs
+ ),
+ FieldInitializers = list.map(wrap_init_obj, FieldRvals),
+ RowInitializer = init_struct(StructType, FieldInitializers),
+ ml_construct_simple_vector(ModuleInfo, Context, StructType, FieldTypes,
+ CurIndex + 1, RemainingPairs, RowInitializers).
+
+:- func wrap_init_obj(mlds_rval) = mlds_initializer.
+
+wrap_init_obj(Rval) = init_obj(Rval).
+
+:- func ml_default_value_for_type(mlds_type) = mlds_rval.
+
+ml_default_value_for_type(MLDS_Type) = DefaultRval :-
+ (
+ MLDS_Type = mlds_native_int_type,
+ DefaultRval = ml_const(mlconst_int(0))
+ ;
+ MLDS_Type = mlds_native_bool_type,
+ DefaultRval = ml_const(mlconst_false)
+ ;
+ MLDS_Type = mlds_native_float_type,
+ DefaultRval = ml_const(mlconst_float(0.0))
+ ;
+ ( MLDS_Type = mlds_native_char_type
+ ; MLDS_Type = mercury_type(_, _, _)
+ ; MLDS_Type = mlds_mercury_array_type(_)
+ ; MLDS_Type = mlds_foreign_type(_)
+ ; MLDS_Type = mlds_class_type(_, _, _)
+ ; MLDS_Type = mlds_array_type(_)
+ ; MLDS_Type = mlds_func_type(_)
+ ; MLDS_Type = mlds_generic_type
+ ; MLDS_Type = mlds_type_info_type
+ ; MLDS_Type = mlds_pseudo_type_info_type
+ ),
+ DefaultRval = ml_unop(cast(MLDS_Type), ml_const(mlconst_int(0)))
+ ;
+ ( MLDS_Type = mlds_cont_type(_)
+ ; MLDS_Type = mlds_commit_type
+ ; MLDS_Type = mlds_ptr_type(_)
+ ; MLDS_Type = mlds_generic_env_ptr_type
+ ; MLDS_Type = mlds_rtti_type(_)
+ ; MLDS_Type = mlds_tabling_type(_)
+ ; MLDS_Type = mlds_unknown_type
+ ),
+ unexpected(this_file,
+ "ml_default_value_for_type: unexpected MLDS_Type")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred ml_generate_offset_assigns(list(prog_var)::in, list(mlds_type)::in,
+ list(mlds_field_id)::in, mlds_vector_common::in, mlds_type::in,
+ mlds_rval::in, mlds_context::in, list(statement)::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
+
+ml_generate_offset_assigns(OutVars, FieldTypes, FieldIds, VectorCommon,
+ StructType, IndexRval, Context, Statements, !Info) :-
+ (
+ OutVars = [],
+ FieldTypes = [],
+ FieldIds = []
+ ->
+ Statements = []
+ ;
+ OutVars = [HeadOutVar | TailOutVars],
+ FieldTypes = [HeadFieldType | TailFieldTypes],
+ FieldIds = [HeadFieldId | TailFieldIds]
+ ->
+ ml_generate_offset_assigns(TailOutVars, TailFieldTypes, TailFieldIds,
+ VectorCommon, StructType, IndexRval, Context, TailStatements,
+ !Info),
+
+ ml_gen_var(!.Info, HeadOutVar, HeadOutVarLval),
+ BaseRval = ml_vector_common_row(VectorCommon, IndexRval),
+ HeadFieldLval = ml_field(yes(0), BaseRval, HeadFieldId,
+ HeadFieldType, StructType),
+ HeadAtomicStmt = assign(HeadOutVarLval, ml_lval(HeadFieldLval)),
+ HeadStmt = ml_stmt_atomic(HeadAtomicStmt),
+ HeadStatement = statement(HeadStmt, Context),
+
+ Statements = [HeadStatement | TailStatements]
+ ;
+ unexpected(this_file, "ml_generate_offset_assigns: mismatched lists")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred ml_generate_constants_for_lookup_switch(code_model::in,
+ set(prog_var)::in, list(prog_var)::in, list(tagged_case)::in,
+ map(int, soln_consts(mlds_rval))::in,
+ map(int, soln_consts(mlds_rval))::out,
+ bool::in, bool::out, ml_gen_info::in, ml_gen_info::out) is semidet.
+
+ml_generate_constants_for_lookup_switch(_CodeModel, _NonLocals, _OutVars,
+ [], !IndexMap, !GoalsMayModifyTrail, !Info).
+ml_generate_constants_for_lookup_switch(CodeModel, NonLocals, OutVars,
+ [TaggedCase | TaggedCases], !IndexMap, !GoalsMayModifyTrail, !Info) :-
+ TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, _, Goal),
+ Goal = hlds_goal(GoalExpr, GoalInfo),
+ ( GoalExpr = disj(Disjuncts) ->
+ bool.or(goal_may_modify_trail(GoalInfo), !GoalsMayModifyTrail),
+ ml_all_disjuncts_are_conj_of_unify(NonLocals, Disjuncts),
+ ml_generate_constants_for_disjuncts(CodeModel, OutVars, Disjuncts,
+ Solns, !Info),
+ SolnConsts = several_solns(Solns)
+ ;
+ ml_goal_is_conj_of_unify(NonLocals, Goal),
+ ml_generate_constants_for_arm(CodeModel, OutVars, Goal, Soln, !Info),
+ SolnConsts = one_soln(Soln)
+ ),
+ ml_record_lookup_for_tagged_cons_id(SolnConsts,
+ TaggedMainConsId, !IndexMap),
+ list.foldl(ml_record_lookup_for_tagged_cons_id(SolnConsts),
+ TaggedOtherConsIds, !IndexMap),
+ ml_generate_constants_for_lookup_switch(CodeModel, NonLocals, OutVars,
+ TaggedCases, !IndexMap, !GoalsMayModifyTrail, !Info).
+
+:- pred ml_record_lookup_for_tagged_cons_id(soln_consts(mlds_rval)::in,
+ tagged_cons_id::in,
+ map(int, soln_consts(mlds_rval))::in,
+ map(int, soln_consts(mlds_rval))::out) is det.
+
+ml_record_lookup_for_tagged_cons_id(SolnConsts, TaggedConsId, !IndexMap) :-
+ TaggedConsId = tagged_cons_id(_ConsId, ConsTag),
+ ( ConsTag = int_tag(Index) ->
+ svmap.det_insert(Index, SolnConsts, !IndexMap)
+ ;
+ unexpected(this_file,
+ "ml_record_lookup_for_tagged_cons_id: not int_tag")
+ ).
+
+:- pred ml_generate_constants_for_disjuncts(code_model::in, list(prog_var)::in,
+ list(hlds_goal)::in, list(list(mlds_rval))::out,
+ ml_gen_info::in, ml_gen_info::out) is semidet.
+
+ml_generate_constants_for_disjuncts(_CodeModel, _Vars, [], [], !Info).
+ml_generate_constants_for_disjuncts(CodeModel, Vars,
+ [Goal | Goals], [Soln | Solns], !Info) :-
+ ml_generate_constants_for_arm(CodeModel, Vars, Goal, Soln, !Info),
+ ml_generate_constants_for_disjuncts(CodeModel, Vars, Goals, Solns, !Info).
+
+:- pred ml_generate_constants_for_arm(code_model::in, list(prog_var)::in,
+ hlds_goal::in, list(mlds_rval)::out,
+ ml_gen_info::in, ml_gen_info::out) is semidet.
+
+ml_generate_constants_for_arm(CodeModel, Vars, Goal, Soln, !Info) :-
+ ml_gen_info_get_const_var_map(!.Info, InitConstVarMap),
+ ml_gen_goal(CodeModel, Goal, _Decls, _Statements, !Info),
+ ml_gen_info_get_const_var_map(!.Info, FinalConstVarMap),
+ ml_gen_info_set_const_var_map(InitConstVarMap, !Info),
+ list.map(search_ground_rval(FinalConstVarMap), Vars, Soln).
+
+:- pred search_ground_rval(ml_ground_term_map::in, prog_var::in,
+ mlds_rval::out) is semidet.
+
+search_ground_rval(FinalConstVarMap, Var, Rval) :-
+ map.search(FinalConstVarMap, Var, GroundTerm),
+ GroundTerm = ml_ground_term(Rval, _, _).
+
+%-----------------------------------------------------------------------------%
+
+ % Is the input goal a conjunction of unifications? A
+ % from_ground_term_construct scope counts as a unification.
+ %
+ % Unlike goal_is_conj_of_unify in lookup_util, we also insist that
+ % (a) the unification be a static construction, and (b) the only nonlocal
+ % variables being constructed be in the provided set.
+ %
+:- pred ml_goal_is_conj_of_unify(set(prog_var)::in, hlds_goal::in) is semidet.
+
+ml_goal_is_conj_of_unify(AllowedVars, Goal) :-
+ Goal = hlds_goal(_GoalExpr, GoalInfo),
+ CodeModel = goal_info_get_code_model(GoalInfo),
+ CodeModel = model_det,
+ NonLocals = goal_info_get_nonlocals(GoalInfo),
+ goal_to_conj_list(Goal, Conj),
+ ml_only_constant_goals(NonLocals, AllowedVars, Conj).
+
+ % Run ml_goal_is_conj_of_unify on each goal in the list.
+ %
+:- pred ml_all_disjuncts_are_conj_of_unify(set(prog_var)::in,
+ list(hlds_goal)::in) is semidet.
+
+ml_all_disjuncts_are_conj_of_unify(_AllowedVars, []).
+ml_all_disjuncts_are_conj_of_unify(AllowedVars, [Disjunct | Disjuncts]) :-
+ ml_goal_is_conj_of_unify(AllowedVars, Disjunct),
+ ml_all_disjuncts_are_conj_of_unify(AllowedVars, Disjuncts).
+
+:- pred ml_only_constant_goals(set(prog_var)::in, set(prog_var)::in,
+ list(hlds_goal)::in) is semidet.
+
+ml_only_constant_goals(_NonLocals, AllowedVars0, []) :-
+ set.empty(AllowedVars0).
+ml_only_constant_goals(NonLocals, AllowedVars0, [Goal | Goals]) :-
+ Goal = hlds_goal(GoalExpr, _),
+ % We could allow calls as well. Some procedures have an output inst
+ % that fixes the value of the output variable, which is thus a constant.
+ % However, calls to such procedures should have been inlined by now.
+ (
+ GoalExpr = unify(_, _, _, Unify, _),
+ Unify = construct(Var, _, _, _, construct_statically, _, _)
+ ;
+ GoalExpr = scope(Reason, _),
+ Reason = from_ground_term(Var, from_ground_term_construct)
+ ),
+ ( set.member(Var, NonLocals) ->
+ set.remove(AllowedVars0, Var, AllowedVars)
+ ;
+ % The conjunction is allowed to bind local variables, since these
+ % may later be used to construct variables in AllowedVars0.
+ AllowedVars = AllowedVars0
+ ),
+ ml_only_constant_goals(NonLocals, AllowedVars, Goals).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "ml_lookup_switch.m".
+
+%-----------------------------------------------------------------------------%
Index: compiler/ml_optimize.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_optimize.m,v
retrieving revision 1.60
diff -u -b -r1.60 ml_optimize.m
--- compiler/ml_optimize.m 16 Sep 2009 02:32:53 -0000 1.60
+++ compiler/ml_optimize.m 20 Sep 2009 04:57:08 -0000
@@ -623,7 +623,7 @@
% We must check that the value being assigned doesn't refer to the
% variable itself.
- \+ rval_contains_var(RHS, ThisData),
+ rval_contains_var(RHS, ThisData) = no,
% We must check that the value being assign doesn't refer to any
% of the variables which are declared after this one. We must also
@@ -636,9 +636,10 @@
OtherDefn = mlds_defn(entity_data(OtherVarName),
_, _, mlds_data(_Type, OtherInitializer, _GC)),
(
- rval_contains_var(RHS, qual(Qualifier, QualKind, OtherVarName))
+ QualOtherVar = qual(Qualifier, QualKind, OtherVarName),
+ rval_contains_var(RHS, QualOtherVar) = yes
;
- initializer_contains_var(OtherInitializer, ThisData)
+ initializer_contains_var(OtherInitializer, ThisData) = yes
)
),
\+ list.find_first_match(Filter, FollowingDefns, _)
@@ -869,7 +870,7 @@
% on and look for the initial value in Statements0.
VarName = qual(Mod, QualKind, UnqualVarName),
DataName = qual(Mod, QualKind, mlds_data_var(UnqualVarName)),
- \+ statement_contains_var(Statement0, DataName),
+ statement_contains_var(Statement0, DataName) = no,
\+ (
statement_contains_statement(Statement0, Label),
Label = statement(ml_stmt_label(_), _)
@@ -892,7 +893,7 @@
; Stmt0 = ml_stmt_block(Defns0, SubStatements0) ->
Var = qual(Mod, QualKind, UnqualVarName),
Data = qual(Mod, QualKind, mlds_data_var(UnqualVarName)),
- \+ defns_contains_var(Defns0, Data),
+ defns_contains_var(Defns0, Data) = no,
find_initial_val_in_statements(Var, Rval,
SubStatements0, SubStatements),
Stmt = ml_stmt_block(Defns0, SubStatements)
@@ -1024,9 +1025,6 @@
eliminate_var_in_rval(ArgRval0, ArgRval, !VarElimInfo),
Rval = ml_mkword(Tag, ArgRval)
;
- Rval0 = ml_const(_),
- Rval = Rval0
- ;
Rval0 = ml_unop(Op, ArgRval0),
eliminate_var_in_rval(ArgRval0, ArgRval, !VarElimInfo),
Rval = ml_unop(Op, ArgRval)
@@ -1040,7 +1038,14 @@
eliminate_var_in_lval(Lval0, Lval, !VarElimInfo),
Rval = ml_mem_addr(Lval)
;
- Rval0 = ml_self(_Type),
+ Rval0 = ml_vector_common_row(VectorCommon, RowRval0),
+ eliminate_var_in_rval(RowRval0, RowRval, !VarElimInfo),
+ Rval = ml_vector_common_row(VectorCommon, RowRval)
+ ;
+ ( Rval0 = ml_const(_)
+ ; Rval0 = ml_scalar_common(_)
+ ; Rval0 = ml_self(_)
+ ),
Rval = Rval0
).
Index: compiler/ml_string_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_string_switch.m,v
retrieving revision 1.41
diff -u -b -r1.41 ml_string_switch.m
--- compiler/ml_string_switch.m 2 Sep 2009 00:30:19 -0000 1.41
+++ compiler/ml_string_switch.m 20 Sep 2009 08:13:28 -0000
@@ -41,9 +41,12 @@
:- import_module backend_libs.builtin_ops.
:- import_module backend_libs.switch_util.
:- import_module hlds.hlds_data.
+:- import_module hlds.hlds_module.
:- import_module libs.compiler_util.
:- import_module ml_backend.ml_code_gen.
+:- import_module ml_backend.ml_global_data.
:- import_module ml_backend.ml_simplify_switch.
+:- import_module parse_tree.builtin_lib_types.
:- import_module assoc_list.
:- import_module bool.
@@ -60,8 +63,6 @@
ml_generate_string_switch(Cases, Var, CodeModel, _CanFail, Context,
Decls, Statements, !Info) :-
MLDS_Context = mlds_make_context(Context),
- % Compute the value we're going to switch on.
-
ml_gen_var(!.Info, Var, VarLval),
VarRval = ml_lval(VarLval),
@@ -69,23 +70,24 @@
% int slot_N;
% MR_String str_M;
- ml_gen_info_new_aux_var_name("slot", SlotVarName, !Info),
+ ml_gen_info_new_aux_var_name("slot", SlotVar, !Info),
SlotVarType = mlds_native_int_type,
% We never need to trace ints.
SlotVarGCStatement = gc_no_stmt,
- SlotVarDefn = ml_gen_mlds_var_decl(mlds_data_var(SlotVarName), SlotVarType,
+ SlotVarDefn = ml_gen_mlds_var_decl(mlds_data_var(SlotVar), SlotVarType,
SlotVarGCStatement, MLDS_Context),
- ml_gen_var_lval(!.Info, SlotVarName, SlotVarType, SlotVarLval),
+ ml_gen_var_lval(!.Info, SlotVar, SlotVarType, SlotVarLval),
+ SlotVarRval = ml_lval(SlotVarLval),
- ml_gen_info_new_aux_var_name("str", StringVarName, !Info),
+ ml_gen_info_new_aux_var_name("str", StringVar, !Info),
StringVarType = ml_string_type,
% This variable always points to an element of the string_table array,
% which are all static constants; it can never point into the heap.
% So the GC never needs to trace it
StringVarGCStatement = gc_no_stmt,
- StringVarDefn = ml_gen_mlds_var_decl(mlds_data_var(StringVarName),
+ StringVarDefn = ml_gen_mlds_var_decl(mlds_data_var(StringVar),
StringVarType, StringVarGCStatement, MLDS_Context),
- ml_gen_var_lval(!.Info, StringVarName, StringVarType, StringVarLval),
+ ml_gen_var_lval(!.Info, StringVar, StringVarType, StringVarLval),
% Generate new labels.
ml_gen_new_label(EndLabel, !Info),
@@ -127,37 +129,42 @@
ml_gen_failure(CodeModel, Context, FailStatements, !Info)
),
- % Generate the code etc. for the hash table.
- ml_gen_string_hash_slots(0, TableSize, HashSlotsMap,
- Strings, NextSlots, map.init, RevMap),
- map.to_assoc_list(RevMap, RevList),
- generate_string_switch_arms(CodeMap, RevList, [], SlotsCases0),
- list.sort(SlotsCases0, SlotsCases),
-
- % Generate the following local constant declarations:
- % static const int next_slots_table_N = { <NextSlots> };
- % static const MR_String string_table_M[] = { <Strings> };
-
- some [!GlobalData] (
- ml_gen_info_get_global_data(!.Info, !:GlobalData),
-
- NextSlotsType = mlds_array_type(SlotVarType),
- ml_gen_static_const_defn("next_slots_table", NextSlotsType,
- acc_private, init_array(NextSlots), Context, NextSlotsName,
- !GlobalData),
- ml_gen_var_lval(!.Info, NextSlotsName, NextSlotsType, NextSlotsLval),
-
- StringTableType = mlds_array_type(StringVarType),
- ml_gen_static_const_defn("string_table", StringTableType,
- acc_private, init_array(Strings), Context, StringTableName,
- !GlobalData),
- ml_gen_var_lval(!.Info, StringTableName, StringTableType,
- StringTableLval),
-
- ml_gen_info_set_global_data(!.GlobalData, !Info)
+ ml_gen_info_get_module_info(!.Info, ModuleInfo),
+ module_info_get_name(ModuleInfo, ModuleName),
+ MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
+ ml_gen_info_get_target(!.Info, Target),
+
+ MLDS_StringType = mercury_type_to_mlds_type(ModuleInfo, string_type),
+ MLDS_NextSlotType = mlds_native_int_type,
+ MLDS_ArgTypes = [MLDS_StringType, MLDS_NextSlotType],
+
+ ml_gen_info_get_global_data(!.Info, GlobalData0),
+ ml_gen_static_vector_type(MLDS_ModuleName, MLDS_Context, Target,
+ MLDS_ArgTypes, StructTypeNum, StructType, FieldIds,
+ GlobalData0, GlobalData1),
+
+ ( FieldIds = [StringFieldIdPrime, NextSlotFieldIdPrime] ->
+ StringFieldId = StringFieldIdPrime,
+ NextSlotFieldId = NextSlotFieldIdPrime
+ ;
+ unexpected(this_file, "ml_generate_string_switch: bad FieldIds")
),
+ % Generate the rows of the hash table.
+ ml_gen_string_hash_slots(0, TableSize, StructType, HashSlotsMap,
+ RowInitializers, map.init, RevMap),
+
+ % Generate the hash table. The hash table is indexed by slot number,
+ % and each element has two fields: the matched string, and the next slot
+ % indication.
+ ml_gen_static_vector_defn(MLDS_ModuleName, StructTypeNum, RowInitializers,
+ VectorCommon, GlobalData1, GlobalData),
+ ml_gen_info_set_global_data(GlobalData, !Info),
+
% Generate code which does the hash table lookup.
+ map.to_assoc_list(RevMap, RevList),
+ generate_string_switch_arms(CodeMap, RevList, [], SlotsCases0),
+ list.sort(SlotsCases0, SlotsCases),
SwitchStmt0 = ml_stmt_switch(SlotVarType, ml_lval(SlotVarLval),
mlds_switch_range(0, TableSize - 1), SlotsCases,
default_is_unreachable),
@@ -188,9 +195,9 @@
"lookup the string for this hash slot")), MLDS_Context),
statement(
ml_stmt_atomic(assign(StringVarLval,
- ml_binop(array_index(elem_type_string),
- ml_lval(StringTableLval),
- ml_lval(SlotVarLval)))),
+ ml_lval(ml_field(yes(0),
+ ml_vector_common_row(VectorCommon, SlotVarRval),
+ StringFieldId, MLDS_StringType, StructType)))),
MLDS_Context),
statement(ml_stmt_atomic(comment("did we find a match?")),
MLDS_Context),
@@ -200,9 +207,9 @@
"no match yet, so get next slot in hash chain")), MLDS_Context),
statement(
ml_stmt_atomic(assign(SlotVarLval,
- ml_binop(array_index(elem_type_int),
- ml_lval(NextSlotsLval),
- ml_lval(SlotVarLval)))),
+ ml_lval(ml_field(yes(0),
+ ml_vector_common_row(VectorCommon, SlotVarRval),
+ NextSlotFieldId, MLDS_NextSlotType, StructType)))),
MLDS_Context)
],
Context),
@@ -296,31 +303,27 @@
%
:- type hash_slot_rev_map == map(int, hash_slots).
-:- pred ml_gen_string_hash_slots(int::in, int::in,
- map(int, string_hash_slot(int))::in,
- list(mlds_initializer)::out, list(mlds_initializer)::out,
+:- pred ml_gen_string_hash_slots(int::in, int::in, mlds_type::in,
+ map(int, string_hash_slot(int))::in, list(mlds_initializer)::out,
hash_slot_rev_map::in, hash_slot_rev_map::out) is det.
-ml_gen_string_hash_slots(Slot, TableSize, HashSlotMap,
- StringInits, NextSlotInits, !RevMap) :-
+ml_gen_string_hash_slots(Slot, TableSize, RowType, HashSlotMap,
+ RowInitializers, !RevMap) :-
( Slot = TableSize ->
- StringInits = [],
- NextSlotInits = []
+ RowInitializers = []
;
- ml_gen_string_hash_slot(Slot, HashSlotMap,
- StringInit, NextSlotInit, !RevMap),
- ml_gen_string_hash_slots(Slot + 1, TableSize, HashSlotMap,
- LaterStringInits, LaterNextSlotInits, !RevMap),
- StringInits = [StringInit | LaterStringInits],
- NextSlotInits = [NextSlotInit | LaterNextSlotInits]
+ ml_gen_string_hash_slot(Slot, RowType, HashSlotMap, HeadRowInitializer,
+ !RevMap),
+ ml_gen_string_hash_slots(Slot + 1, TableSize, RowType, HashSlotMap,
+ TailRowInitializers, !RevMap),
+ RowInitializers = [HeadRowInitializer | TailRowInitializers]
).
-:- pred ml_gen_string_hash_slot(int::in,
- map(int, string_hash_slot(int))::in,
- mlds_initializer::out, mlds_initializer::out,
+:- pred ml_gen_string_hash_slot(int::in, mlds_type::in,
+ map(int, string_hash_slot(int))::in, mlds_initializer::out,
hash_slot_rev_map::in, hash_slot_rev_map::out) is det.
-ml_gen_string_hash_slot(Slot, HashSlotMap, StringInit, NextSlotInit,
+ml_gen_string_hash_slot(Slot, StructType, HashSlotMap, RowInitializer,
!RevMap) :-
( map.search(HashSlotMap, Slot, string_hash_slot(Next, String, CaseNum)) ->
StringRval = ml_const(mlconst_string(String)),
@@ -337,8 +340,8 @@
StringRval = ml_const(mlconst_null(ml_string_type)),
NextSlotRval = ml_const(mlconst_int(-2))
),
- StringInit = init_obj(StringRval),
- NextSlotInit = init_obj(NextSlotRval).
+ RowInitializer = init_struct(StructType,
+ [init_obj(StringRval), init_obj(NextSlotRval)]).
:- pred generate_string_switch_arms(map(int, statement)::in,
assoc_list(int, hash_slots)::in,
Index: compiler/ml_switch_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_switch_gen.m,v
retrieving revision 1.43
diff -u -b -r1.43 ml_switch_gen.m
--- compiler/ml_switch_gen.m 4 Sep 2009 02:27:52 -0000 1.43
+++ compiler/ml_switch_gen.m 20 Sep 2009 10:50:49 -0000
@@ -24,11 +24,9 @@
% several possibilities.
%
% a) If all the alternative goals for a switch on an atomic data type
-% contain only construction unifications of constants, then we
-% should generate a dense lookup table (an array) for each output
-% variable of the switch, rather than computed goto, so that
-% executing the switch becomes a matter of doing an array index for
-% each output variable. (NYI)
+% contain only construction unifications of constants, then we should
+% generate a dense lookup table (an array) in which we can look up
+% the values of the output variables.
% b) If the cases are not sparse, and the target supports computed
% gotos, we should use a computed_goto, unless the target supports
% switch statements and the `--prefer-switch' option is set. (NYI)
@@ -79,7 +77,7 @@
% Generate MLDS code for a switch.
%
:- pred ml_gen_switch(prog_var::in, can_fail::in, list(case)::in,
- code_model::in, prog_context::in,
+ code_model::in, prog_context::in, hlds_goal_info::in,
list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
@@ -111,6 +109,7 @@
:- import_module libs.options.
:- import_module ml_backend.ml_code_gen.
:- import_module ml_backend.ml_code_util.
+:- import_module ml_backend.ml_lookup_switch.
:- import_module ml_backend.ml_simplify_switch.
:- import_module ml_backend.ml_string_switch.
:- import_module ml_backend.ml_tag_switch.
@@ -126,8 +125,8 @@
%-----------------------------------------------------------------------------%
-ml_gen_switch(SwitchVar, CanFail, Cases, CodeModel, Context, Decls, Statements,
- !Info) :-
+ml_gen_switch(SwitchVar, CanFail, Cases, CodeModel, Context, GoalInfo,
+ Decls, Statements, !Info) :-
% Lookup the representation of the constructors for the tag tests.
% Note that you cannot have a switch on a variable whose type's main
% type constructor is not known.
@@ -135,12 +134,11 @@
ml_variable_type(!.Info, SwitchVar, SwitchVarType),
type_to_ctor_det(SwitchVarType, SwitchVarTypeCtor),
tag_cases(ModuleInfo, SwitchVarType, Cases, TaggedCases,
- _MaybeIntSwitchInfo),
- % We will need MaybeIntSwitchInfo when we implement lookup switches.
+ MaybeIntSwitchInfo),
% Figure out what kind of switch this is.
- type_util.classify_type(ModuleInfo, SwitchVarType) = TypeCtorCategory,
- SwitchCategory = switch_util.type_ctor_cat_to_switch_cat(TypeCtorCategory),
+ TypeCtorCategory = classify_type(ModuleInfo, SwitchVarType),
+ SwitchCategory = type_ctor_cat_to_switch_cat(TypeCtorCategory),
ml_gen_info_get_globals(!.Info, Globals),
globals.lookup_bool_option(Globals, smart_indexing, Indexing),
(
@@ -161,7 +159,8 @@
% for and handled the reserved addresses, and then used one of the
% smart indexing schemes for the other cases.
ml_switch_generate_if_then_else_chain(TaggedCases, SwitchVar,
- CodeModel, CanFail, Context, Decls, Statements, !Info)
+ CodeModel, CanFail, Context, Statements, !Info),
+ Decls = []
;
(
SwitchCategory = string_switch,
@@ -193,8 +192,8 @@
CodeModel, CanFail, Context, Decls, Statements, !Info)
;
ml_switch_generate_if_then_else_chain(TaggedCases,
- SwitchVar, CodeModel, CanFail, Context, Decls, Statements,
- !Info)
+ SwitchVar, CodeModel, CanFail, Context, Statements, !Info),
+ Decls = []
)
;
SwitchCategory = tag_switch,
@@ -206,38 +205,62 @@
target_supports_int_switch(Globals)
->
ml_generate_tag_switch(TaggedCases, SwitchVar, CodeModel,
- CanFail, Context, Decls, Statements, !Info)
+ CanFail, Context, Statements, !Info)
;
ml_switch_generate_if_then_else_chain(TaggedCases,
- SwitchVar, CodeModel, CanFail, Context, Decls, Statements,
- !Info)
- )
+ SwitchVar, CodeModel, CanFail, Context, Statements, !Info)
+ ),
+ Decls = []
+ ;
+ SwitchCategory = atomic_switch,
+ num_cons_ids_in_tagged_cases(TaggedCases, NumConsIds, NumArms),
+ (
+ ml_gen_info_get_high_level_data(!.Info, no),
+ MaybeIntSwitchInfo = int_switch(LowerLimit, UpperLimit,
+ NumValues),
+ globals.lookup_bool_option(Globals, static_ground_cells, yes),
+ globals.lookup_int_option(Globals, lookup_switch_size,
+ LookupSize),
+ NumConsIds >= LookupSize,
+ NumArms > 1,
+ globals.lookup_int_option(Globals, lookup_switch_req_density,
+ ReqDensity),
+ find_lookup_switch_params(ModuleInfo, SwitchVarType, CodeModel,
+ CanFail, TaggedCases, FilteredTaggedCases,
+ LowerLimit, UpperLimit, NumValues, ReqDensity,
+ NeedBitVecCheck, NeedRangeCheck, FirstVal, LastVal),
+ NonLocals = goal_info_get_nonlocals(GoalInfo),
+ ml_gen_lookup_switch(SwitchVar, FilteredTaggedCases,
+ NonLocals, CodeModel, Context, FirstVal, LastVal,
+ NeedBitVecCheck, NeedRangeCheck, StatementsPrime, !Info)
+ ->
+ Statements = StatementsPrime
;
- % For atomic switches that are suitable for lookup switches or
- % sense switches, we could do better than the code we generate
- % below.
- ( SwitchCategory = atomic_switch
- ; SwitchCategory = other_switch
+ target_supports_computed_goto(Globals)
+ ->
+ ml_switch_generate_mlds_switch(TaggedCases, SwitchVar,
+ CodeModel, CanFail, Context, Statements, !Info)
+ ;
+ ml_switch_generate_if_then_else_chain(TaggedCases,
+ SwitchVar, CodeModel, CanFail, Context, Statements, !Info)
),
+ Decls = []
+ ;
+ SwitchCategory = other_switch,
(
% Try using a "direct-mapped" switch. This also handles dense
% (computed goto) switches -- for those, we first generate a
% direct-mapped switch, and then convert it into a computed
% goto switch in ml_simplify_switch.
- (
target_supports_switch(SwitchCategory, Globals)
- ;
- SwitchCategory = atomic_switch,
- target_supports_computed_goto(Globals)
- )
->
ml_switch_generate_mlds_switch(TaggedCases, SwitchVar,
- CodeModel, CanFail, Context, Decls, Statements, !Info)
+ CodeModel, CanFail, Context, Statements, !Info)
;
ml_switch_generate_if_then_else_chain(TaggedCases,
- SwitchVar, CodeModel, CanFail, Context, Decls, Statements,
- !Info)
- )
+ SwitchVar, CodeModel, CanFail, Context, Statements, !Info)
+ ),
+ Decls = []
)
).
@@ -346,11 +369,10 @@
%
:- pred ml_switch_generate_if_then_else_chain(list(tagged_case)::in,
prog_var::in, code_model::in, can_fail::in, prog_context::in,
- list(mlds_defn)::out, list(statement)::out,
- ml_gen_info::in, ml_gen_info::out) is det.
+ list(statement)::out, ml_gen_info::in, ml_gen_info::out) is det.
ml_switch_generate_if_then_else_chain(TaggedCases0, Var,
- CodeModel, CanFail, Context, Decls, Statements, !Info) :-
+ CodeModel, CanFail, Context, Statements, !Info) :-
% Associate each tagged case with the estimated cost of its tag tests.
list.map(mark_tag_test_cost, TaggedCases0, CostTaggedCases0),
@@ -366,8 +388,7 @@
TaggedCases = [FirstTaggedCase | LaterTaggedCases],
ml_switch_generate_if_then_else_chain_ites(FirstTaggedCase,
LaterTaggedCases, Var, CodeModel, CanFail, Context, Statements,
- !Info),
- Decls = []
+ !Info)
).
:- pred ml_switch_generate_if_then_else_chain_ites(tagged_case::in,
@@ -464,11 +485,10 @@
%
:- pred ml_switch_generate_mlds_switch(list(tagged_case)::in,
prog_var::in, code_model::in, can_fail::in, prog_context::in,
- list(mlds_defn)::out, list(statement)::out,
- ml_gen_info::in, ml_gen_info::out) is det.
+ list(statement)::out, ml_gen_info::in, ml_gen_info::out) is det.
ml_switch_generate_mlds_switch(Cases, Var, CodeModel, CanFail, Context,
- Decls, Statements, !Info) :-
+ Statements, !Info) :-
ml_variable_type(!.Info, Var, Type),
ml_gen_type(!.Info, Type, MLDS_Type),
ml_gen_var(!.Info, Var, Lval),
@@ -479,7 +499,6 @@
SwitchStmt0 = ml_stmt_switch(MLDS_Type, Rval, Range, MLDS_Cases, Default),
MLDS_Context = mlds_make_context(Context),
ml_simplify_switch(SwitchStmt0, MLDS_Context, SwitchStatement, !Info),
- Decls = [],
Statements = [SwitchStatement].
:- pred ml_switch_gen_range(ml_gen_info::in, mlds_type::in,
Index: compiler/ml_tag_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_tag_switch.m,v
retrieving revision 1.31
diff -u -b -r1.31 ml_tag_switch.m
--- compiler/ml_tag_switch.m 2 Sep 2009 00:30:19 -0000 1.31
+++ compiler/ml_tag_switch.m 10 Sep 2009 05:57:43 -0000
@@ -30,8 +30,7 @@
% Generate efficient indexing code for tag based switches.
%
:- pred ml_generate_tag_switch(list(tagged_case)::in, prog_var::in,
- code_model::in, can_fail::in, prog_context::in,
- list(mlds_defn)::out, list(statement)::out,
+ code_model::in, can_fail::in, prog_context::in, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
%-----------------------------------------------------------------------------%
@@ -60,7 +59,7 @@
%-----------------------------------------------------------------------------%
ml_generate_tag_switch(TaggedCases, Var, CodeModel, CanFail, Context,
- Decls, Statements, !Info) :-
+ Statements, !Info) :-
% Generate the rval for the primary tag.
ml_gen_var(!.Info, Var, VarLval),
VarRval = ml_lval(VarLval),
@@ -106,7 +105,6 @@
PtagCases, Default),
MLDS_Context = mlds_make_context(Context),
ml_simplify_switch(SwitchStmt0, MLDS_Context, SwitchStatement, !Info),
- Decls = [],
Statements = [SwitchStatement].
:- pred gen_tagged_case_code(code_model::in, tagged_case::in, int::out,
Index: compiler/ml_tailcall.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_tailcall.m,v
retrieving revision 1.52
diff -u -b -r1.52 ml_tailcall.m
--- compiler/ml_tailcall.m 2 Sep 2009 00:30:19 -0000 1.52
+++ compiler/ml_tailcall.m 19 Sep 2009 16:35:19 -0000
@@ -456,7 +456,12 @@
% if that lval names a local variable.
MayYieldDanglingStackRef = check_lval(Lval, Locals)
;
- Rval = ml_self(_),
+ Rval = ml_vector_common_row(_VectorCommon, RowRval),
+ MayYieldDanglingStackRef = check_rval(RowRval, Locals)
+ ;
+ ( Rval = ml_scalar_common(_)
+ ; Rval = ml_self(_)
+ ),
MayYieldDanglingStackRef = may_yield_dangling_stack_ref
).
@@ -497,13 +502,15 @@
:- func check_const(mlds_rval_const, locals) = may_yield_dangling_stack_ref.
check_const(Const, Locals) = MayYieldDanglingStackRef :-
- ( Const = mlconst_code_addr(CodeAddr) ->
+ (
+ Const = mlconst_code_addr(CodeAddr),
( function_is_local(CodeAddr, Locals) ->
MayYieldDanglingStackRef = may_yield_dangling_stack_ref
;
MayYieldDanglingStackRef = will_not_yield_dangling_stack_ref
)
- ; Const = mlconst_data_addr(DataAddr) ->
+ ;
+ Const = mlconst_data_addr(DataAddr),
DataAddr = data_addr(ModuleName, DataName),
( DataName = mlds_data_var(VarName) ->
( var_is_local(qual(ModuleName, module_qual, VarName), Locals) ->
@@ -515,6 +522,16 @@
MayYieldDanglingStackRef = will_not_yield_dangling_stack_ref
)
;
+ ( Const = mlconst_true
+ ; Const = mlconst_false
+ ; Const = mlconst_int(_)
+ ; Const = mlconst_foreign(_, _, _)
+ ; Const = mlconst_float(_)
+ ; Const = mlconst_string(_)
+ ; Const = mlconst_multi_string(_)
+ ; Const = mlconst_named_const(_)
+ ; Const = mlconst_null(_)
+ ),
MayYieldDanglingStackRef = will_not_yield_dangling_stack_ref
).
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.138
diff -u -b -r1.138 ml_unify_gen.m
--- compiler/ml_unify_gen.m 8 Sep 2009 02:49:06 -0000 1.138
+++ compiler/ml_unify_gen.m 13 Sep 2009 01:25:16 -0000
@@ -297,8 +297,8 @@
ArgGroundTerm = ml_ground_term(ArgRval, _ArgType,
MLDS_ArgType),
ml_gen_info_get_global_data(!.Info, GlobalData0),
- ml_gen_box_const_rval(ModuleInfo, MLDS_ArgType,
- ArgRval, Context, Rval0, GlobalData0, GlobalData),
+ ml_gen_box_const_rval(ModuleInfo, Context, MLDS_ArgType,
+ ArgRval, Rval0, GlobalData0, GlobalData),
ml_gen_info_set_global_data(GlobalData, !Info),
MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type),
Rval = ml_unop(cast(MLDS_Type), Rval0),
@@ -722,10 +722,10 @@
% Box *all* the arguments, including the ExtraRvals.
list.map(ml_gen_info_lookup_const_var(!.Info), ArgVars,
ArgGroundTerms),
- ml_gen_box_extra_const_rval_list(ModuleInfo,
- ExtraTypes, ExtraRvals, Context, ExtraArgRvals, !GlobalData),
- ml_gen_box_const_rval_list(ModuleInfo, ArgGroundTerms,
- Context, ArgRvals1, !GlobalData),
+ ml_gen_box_extra_const_rval_list(ModuleInfo, Context, ExtraTypes,
+ ExtraRvals, ExtraArgRvals, !GlobalData),
+ ml_gen_box_const_rval_list(ModuleInfo, Context, ArgGroundTerms,
+ ArgRvals1, !GlobalData),
ArgRvals = ExtraArgRvals ++ ArgRvals1
;
HighLevelData = yes,
@@ -762,8 +762,10 @@
;
Initializer = init_struct(ConstType, ArgInits)
),
- ml_gen_static_const_defn("const_var", ConstType, acc_private,
- Initializer, Context, ConstVarName, !GlobalData),
+ module_info_get_name(ModuleInfo, ModuleName),
+ MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
+ ml_gen_static_scalar_const_addr(MLDS_ModuleName, "const_var",
+ ConstType, Initializer, Context, ConstAddrRval, !GlobalData),
ml_gen_info_set_global_data(!.GlobalData, !Info)
),
@@ -771,15 +773,11 @@
%
% Any later references to Var in later code on the right hand side of
% another construct_statically construction unification will refer to
- % ConstDefn, not to VarLval. If the only later references to Var
+ % ConstAddrRval, not to VarLval. If the only later references to Var
% are in such places, then the definition of VarLval and AssignStatement
% are both useless, and can be deleted without harm. Unfortunately,
% at this point in the code generation process, we do not know if
% there are any other kinds of references to Var later on.
- % ZZZ above comment needs updating
-
- ml_gen_var_lval(!.Info, ConstVarName, ConstType, ConstLval),
- ConstAddrRval = ml_mem_addr(ConstLval),
(
MaybeTag = no,
TaggedRval = ConstAddrRval
@@ -1127,7 +1125,7 @@
% -- in that case, we can just box the argument type.
FieldType = type_variable(_, _),
MLDS_ArgType = mercury_type_to_mlds_type(ModuleInfo, ArgType),
- ml_gen_box_const_rval(ModuleInfo, MLDS_ArgType, ArgRval, Context,
+ ml_gen_box_const_rval(ModuleInfo, Context, MLDS_ArgType, ArgRval,
FieldRval, !GlobalData)
;
( FieldType = defined_type(_, _, _)
@@ -1144,79 +1142,35 @@
native_if_possible, ArgRval, FieldRval)
).
-:- pred ml_gen_box_const_rval_list(module_info::in, list(ml_ground_term)::in,
- prog_context::in, list(mlds_rval)::out,
+:- pred ml_gen_box_const_rval_list(module_info::in, prog_context::in,
+ list(ml_ground_term)::in, list(mlds_rval)::out,
ml_global_data::in, ml_global_data::out) is det.
-ml_gen_box_const_rval_list(_, [], _, [], !GlobalData).
-ml_gen_box_const_rval_list(ModuleInfo, [GroundTerm | GroundTerms],
- Context, [BoxedRval | BoxedRvals], !GlobalData) :-
+ml_gen_box_const_rval_list(_, _, [], [], !GlobalData).
+ml_gen_box_const_rval_list(ModuleInfo, Context, [GroundTerm | GroundTerms],
+ [BoxedRval | BoxedRvals], !GlobalData) :-
GroundTerm = ml_ground_term(Rval, _MercuryType, Type),
- ml_gen_box_const_rval(ModuleInfo, Type, Rval,
- Context, BoxedRval, !GlobalData),
- ml_gen_box_const_rval_list(ModuleInfo, GroundTerms,
- Context, BoxedRvals, !GlobalData).
+ ml_gen_box_const_rval(ModuleInfo, Context, Type, Rval,
+ BoxedRval, !GlobalData),
+ ml_gen_box_const_rval_list(ModuleInfo, Context, GroundTerms,
+ BoxedRvals, !GlobalData).
-:- pred ml_gen_box_extra_const_rval_list(module_info::in, list(mlds_type)::in,
- list(mlds_rval)::in, prog_context::in, list(mlds_rval)::out,
+:- pred ml_gen_box_extra_const_rval_list(module_info::in, prog_context::in,
+ list(mlds_type)::in, list(mlds_rval)::in, list(mlds_rval)::out,
ml_global_data::in, ml_global_data::out) is det.
-ml_gen_box_extra_const_rval_list(_, [], [], _, [], !GlobalData).
-ml_gen_box_extra_const_rval_list(ModuleInfo, [Type | Types], [Rval | Rvals],
- Context, [BoxedRval | BoxedRvals], !GlobalData) :-
- ml_gen_box_const_rval(ModuleInfo, Type, Rval,
- Context, BoxedRval, !GlobalData),
- ml_gen_box_extra_const_rval_list(ModuleInfo, Types, Rvals,
- Context, BoxedRvals, !GlobalData).
-ml_gen_box_extra_const_rval_list(_, [], [_ | _], _, _, !GlobalData) :-
+ml_gen_box_extra_const_rval_list(_, _, [], [], [], !GlobalData).
+ml_gen_box_extra_const_rval_list(ModuleInfo, Context, [Type | Types],
+ [Rval | Rvals], [BoxedRval | BoxedRvals], !GlobalData) :-
+ ml_gen_box_const_rval(ModuleInfo, Context, Type, Rval,
+ BoxedRval, !GlobalData),
+ ml_gen_box_extra_const_rval_list(ModuleInfo, Context, Types, Rvals,
+ BoxedRvals, !GlobalData).
+ml_gen_box_extra_const_rval_list(_, _, [], [_ | _], _, !GlobalData) :-
unexpected(this_file, "ml_gen_box_extra_const_rval_list: length mismatch").
-ml_gen_box_extra_const_rval_list(_, [_ | _], [], _, _, !GlobalData) :-
+ml_gen_box_extra_const_rval_list(_, _, [_ | _], [], _, !GlobalData) :-
unexpected(this_file, "ml_gen_box_extra_const_rval_list: length mismatch").
-:- pred ml_gen_box_const_rval(module_info::in, mlds_type::in, mlds_rval::in,
- prog_context::in, mlds_rval::out,
- ml_global_data::in, ml_global_data::out) is det.
-
-ml_gen_box_const_rval(ModuleInfo, Type, Rval, Context, BoxedRval,
- !GlobalData) :-
- (
- ( Type = mercury_type(type_variable(_, _), _, _)
- ; Type = mlds_generic_type
- )
- ->
- BoxedRval = Rval
- ;
- % For the MLDS->C and MLDS->asm back-ends, we need to handle floats
- % specially, since boxed floats normally get heap allocated, whereas
- % for other types boxing is just a cast (casts are OK in static
- % initializers, but calls to malloc() are not).
- %
- % [For the .NET and Java back-ends, this code currently never gets
- % called, since currently we don't support static ground term
- % optimization for those back-ends.]
-
- ( Type = mercury_type(builtin_type(builtin_type_float), _, _)
- ; Type = mlds_native_float_type
- )
- ->
- % Generate a local static constant for this float.
- Initializer = init_obj(Rval),
- ml_gen_static_const_defn("float", Type, acc_private, Initializer,
- Context, ConstName, !GlobalData),
-
- % Return as the boxed rval the address of that constant,
- % cast to mlds_generic_type.
- module_info_get_name(ModuleInfo, ModuleName),
- MLDS_Module = mercury_module_name_to_mlds(ModuleName),
- MLDS_ConstVar = qual(MLDS_Module, module_qual, ConstName),
- ConstLval = ml_var(MLDS_ConstVar, Type),
-
- ConstAddrRval = ml_mem_addr(ConstLval),
- BoxedRval = ml_unop(cast(mlds_generic_type), ConstAddrRval)
- ;
- BoxedRval = ml_unop(box(Type), Rval)
- ).
-
:- pred ml_cons_name(compilation_target::in, cons_id::in, ctor_name::out)
is det.
@@ -2147,8 +2101,8 @@
Args = [Arg],
svmap.det_remove(Arg, ArgGroundTerm, !GroundTermMap),
ArgGroundTerm = ml_ground_term(ArgRval, _ArgType, MLDS_ArgType),
- ml_gen_box_const_rval(ModuleInfo, MLDS_ArgType,
- ArgRval, Context, Rval0, !GlobalData),
+ ml_gen_box_const_rval(ModuleInfo, Context, MLDS_ArgType,
+ ArgRval, Rval0, !GlobalData),
Rval = ml_unop(cast(MLDS_Type), Rval0),
GroundTerm = ml_ground_term(Rval, VarType, MLDS_Type),
svmap.det_insert(Var, GroundTerm, !GroundTermMap)
@@ -2272,21 +2226,17 @@
;
Initializer = init_struct(ConstType, SubInitializers)
),
- ml_gen_static_const_defn("const_var", ConstType, acc_private, Initializer,
- Context, ConstVarName, !GlobalData),
+ module_info_get_name(ModuleInfo, ModuleName),
+ MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
+ ml_gen_static_scalar_const_addr(MLDS_ModuleName, "const_var", ConstType,
+ Initializer, Context, ConstDataAddrRval, !GlobalData),
% Assign the (possibly tagged) address of the local static constant
% to the variable.
- module_info_get_name(ModuleInfo, ModuleName),
- MLDS_Module = mercury_module_name_to_mlds(ModuleName),
- MLDS_ConstVar = qual(MLDS_Module, module_qual, ConstVarName),
- ConstVarLval = ml_var(MLDS_ConstVar, MLDS_Type),
-
- ConstAddrRval = ml_mem_addr(ConstVarLval),
( Ptag = 0 ->
- TaggedRval = ConstAddrRval
+ TaggedRval = ConstDataAddrRval
;
- TaggedRval = ml_mkword(Ptag, ConstAddrRval)
+ TaggedRval = ml_mkword(Ptag, ConstDataAddrRval)
),
Rval = ml_unop(cast(MLDS_Type), TaggedRval),
GroundTerm = ml_ground_term(Rval, VarType, MLDS_Type),
@@ -2351,8 +2301,8 @@
Arg - _ConsArgType, ArgInitializer, !GlobalData, !GroundTermMap) :-
svmap.det_remove(Arg, ArgGroundTerm, !GroundTermMap),
ArgGroundTerm = ml_ground_term(ArgRval0, _ArgType, MLDS_ArgType),
- ml_gen_box_const_rval(ModuleInfo, MLDS_ArgType,
- ArgRval0, Context, ArgRval, !GlobalData),
+ ml_gen_box_const_rval(ModuleInfo, Context, MLDS_ArgType,
+ ArgRval0, ArgRval, !GlobalData),
ArgInitializer = init_obj(ArgRval).
%-----------------------------------------------------------------------------%
Index: compiler/ml_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_util.m,v
retrieving revision 1.67
diff -u -b -r1.67 ml_util.m
--- compiler/ml_util.m 2 Sep 2009 05:48:00 -0000 1.67
+++ compiler/ml_util.m 20 Sep 2009 05:28:00 -0000
@@ -48,16 +48,14 @@
% Nondeterministically generates sub-statements from statements.
%
-:- pred statement_contains_statement(statement::in, statement::out)
- is multi.
+:- pred statement_contains_statement(statement::in, statement::out) is multi.
-:- pred stmt_contains_statement(mlds_stmt::in, statement::out)
- is nondet.
+:- pred stmt_contains_statement(mlds_stmt::in, statement::out) is nondet.
% Succeeds iff this statement contains a reference to the
% specified variable.
%
-:- pred statement_contains_var(statement::in, mlds_data::in) is semidet.
+:- func statement_contains_var(statement, mlds_data) = bool.
:- pred has_foreign_languages(statement::in, list(foreign_language)::out)
is det.
@@ -111,15 +109,15 @@
%
:- pred defn_is_public(mlds_defn::in) is semidet.
- % Succeeds iff these definitions contains a reference to
+ % Says whether these definitions contains a reference to
% the specified variable.
%
-:- pred defns_contains_var(list(mlds_defn)::in, mlds_data::in) is semidet.
+:- func defns_contains_var(list(mlds_defn), mlds_data) = bool.
- % Succeeds iff this definition contains a reference to
+ % Says whether this definition contains a reference to
% the specified variable.
%
-:- pred defn_contains_var(mlds_defn::in, mlds_data::in) is semidet.
+:- func defn_contains_var(mlds_defn, mlds_data) = bool.
%-----------------------------------------------------------------------------%
%
@@ -136,19 +134,17 @@
% Succeed iff the specified construct contains a reference to
% the specified variable.
-:- pred initializer_contains_var(mlds_initializer::in, mlds_data::in)
- is semidet.
+:- func initializer_contains_var(mlds_initializer, mlds_data) = bool.
-:- pred rvals_contains_var(list(mlds_rval)::in, mlds_data::in) is semidet.
+:- func rvals_contains_var(list(mlds_rval), mlds_data) = bool.
-:- pred maybe_rval_contains_var(maybe(mlds_rval)::in, mlds_data::in)
- is semidet.
+:- func maybe_rval_contains_var(maybe(mlds_rval), mlds_data) = bool.
-:- pred rval_contains_var(mlds_rval::in, mlds_data::in) is semidet.
+:- func rval_contains_var(mlds_rval, mlds_data) = bool.
-:- pred lvals_contains_var(list(mlds_lval)::in, mlds_data::in) is semidet.
+:- func lvals_contains_var(list(mlds_lval), mlds_data) = bool.
-:- pred lval_contains_var(mlds_lval::in, mlds_data::in) is semidet.
+:- func lval_contains_var(mlds_lval, mlds_data) = bool.
%-----------------------------------------------------------------------------%
@@ -321,6 +317,8 @@
default_contains_statement(default_case(Statement), SubStatement) :-
statement_contains_statement(Statement, SubStatement).
+%-----------------------------------------------------------------------------%
+%
% statements_contains_var:
% maybe_statement_contains_var:
% statement_contains_var:
@@ -330,133 +328,209 @@
% Succeed iff the specified construct contains a reference to
% the specified variable.
-:- pred statements_contains_var(list(statement)::in, mlds_data::in)
- is semidet.
+:- func statements_contains_var(list(statement), mlds_data) = bool.
-statements_contains_var(Statements, Name) :-
- list.member(Statement, Statements),
- statement_contains_var(Statement, Name).
+statements_contains_var([], _DataName) = no.
+statements_contains_var([Statement | Statements], DataName) = ContainsVar :-
+ ( statement_contains_var(Statement, DataName) = yes ->
+ ContainsVar = yes
+ ;
+ ContainsVar = statements_contains_var(Statements, DataName)
+ ).
-:- pred maybe_statement_contains_var(maybe(statement)::in,
- mlds_data::in) is semidet.
+:- func maybe_statement_contains_var(maybe(statement), mlds_data) = bool.
-% maybe_statement_contains_var(no, _) :- fail.
-maybe_statement_contains_var(yes(Statement), Name) :-
- statement_contains_var(Statement, Name).
+maybe_statement_contains_var(no, _) = no.
+maybe_statement_contains_var(yes(Statement), DataName) = ContainsVar :-
+ ContainsVar = statement_contains_var(Statement, DataName).
-statement_contains_var(Statement, Name) :-
+statement_contains_var(Statement, DataName) = ContainsVar :-
Statement = statement(Stmt, _Context),
- stmt_contains_var(Stmt, Name).
+ ContainsVar = stmt_contains_var(Stmt, DataName).
-:- pred stmt_contains_var(mlds_stmt::in, mlds_data::in) is semidet.
+:- func stmt_contains_var(mlds_stmt, mlds_data) = bool.
-stmt_contains_var(Stmt, Name) :-
+stmt_contains_var(Stmt, DataName) = ContainsVar :-
(
Stmt = ml_stmt_block(Defns, Statements),
- ( defns_contains_var(Defns, Name)
- ; statements_contains_var(Statements, Name)
+ ( defns_contains_var(Defns, DataName) = yes ->
+ ContainsVar = yes
+ ;
+ ContainsVar = statements_contains_var(Statements, DataName)
)
;
Stmt = ml_stmt_while(Rval, Statement, _Once),
- ( rval_contains_var(Rval, Name)
- ; statement_contains_var(Statement, Name)
+ ( rval_contains_var(Rval, DataName) = yes ->
+ ContainsVar = yes
+ ;
+ ContainsVar = statement_contains_var(Statement, DataName)
)
;
Stmt = ml_stmt_if_then_else(Cond, Then, MaybeElse),
- ( rval_contains_var(Cond, Name)
- ; statement_contains_var(Then, Name)
- ; maybe_statement_contains_var(MaybeElse, Name)
+ ( rval_contains_var(Cond, DataName) = yes ->
+ ContainsVar = yes
+ ; statement_contains_var(Then, DataName) = yes ->
+ ContainsVar = yes
+ ;
+ ContainsVar = maybe_statement_contains_var(MaybeElse, DataName)
)
;
Stmt = ml_stmt_switch(_Type, Val, _Range, Cases, Default),
- ( rval_contains_var(Val, Name)
- ; cases_contains_var(Cases, Name)
- ; default_contains_var(Default, Name)
+ ( rval_contains_var(Val, DataName) = yes ->
+ ContainsVar = yes
+ ; cases_contains_var(Cases, DataName) = yes ->
+ ContainsVar = yes
+ ;
+ ContainsVar = default_contains_var(Default, DataName)
)
;
( Stmt = ml_stmt_label(_Label)
; Stmt = ml_stmt_goto(_)
),
- fail
+ ContainsVar = no
;
Stmt = ml_stmt_computed_goto(Rval, _Labels),
- rval_contains_var(Rval, Name)
+ ContainsVar = rval_contains_var(Rval, DataName)
;
Stmt = ml_stmt_call(_Sig, Func, Obj, Args, RetLvals, _TailCall),
- ( rval_contains_var(Func, Name)
- ; maybe_rval_contains_var(Obj, Name)
- ; rvals_contains_var(Args, Name)
- ; lvals_contains_var(RetLvals, Name)
+ ( rval_contains_var(Func, DataName) = yes ->
+ ContainsVar = yes
+ ; maybe_rval_contains_var(Obj, DataName) = yes ->
+ ContainsVar = yes
+ ; rvals_contains_var(Args, DataName) = yes ->
+ ContainsVar = yes
+ ;
+ ContainsVar = lvals_contains_var(RetLvals, DataName)
)
;
Stmt = ml_stmt_return(Rvals),
- rvals_contains_var(Rvals, Name)
+ ContainsVar = rvals_contains_var(Rvals, DataName)
;
Stmt = ml_stmt_do_commit(Ref),
- rval_contains_var(Ref, Name)
+ ContainsVar = rval_contains_var(Ref, DataName)
;
Stmt = ml_stmt_try_commit(Ref, Statement, Handler),
- ( lval_contains_var(Ref, Name)
- ; statement_contains_var(Statement, Name)
- ; statement_contains_var(Handler, Name)
+ ( lval_contains_var(Ref, DataName) = yes ->
+ ContainsVar = yes
+ ; statement_contains_var(Statement, DataName) = yes ->
+ ContainsVar = yes
+ ;
+ ContainsVar = statement_contains_var(Handler, DataName)
)
;
Stmt = ml_stmt_atomic(AtomicStmt),
- atomic_stmt_contains_var(AtomicStmt, Name)
+ ContainsVar = atomic_stmt_contains_var(AtomicStmt, DataName)
).
-:- pred cases_contains_var(list(mlds_switch_case)::in, mlds_data::in)
- is semidet.
+:- func cases_contains_var(list(mlds_switch_case), mlds_data) = bool.
-cases_contains_var(Cases, Name) :-
- list.member(Case, Cases),
+cases_contains_var([], _DataName) = no.
+cases_contains_var([Case | Cases], DataName) = ContainsVar :-
Case = mlds_switch_case(_FirstCond, _LaterConds, Statement),
- statement_contains_var(Statement, Name).
+ ( statement_contains_var(Statement, DataName) = yes ->
+ ContainsVar = yes
+ ;
+ ContainsVar = cases_contains_var(Cases, DataName)
+ ).
-:- pred default_contains_var(mlds_switch_default::in, mlds_data::in)
- is semidet.
+:- func default_contains_var(mlds_switch_default, mlds_data) = bool.
-% default_contains_var(default_do_nothing, _) :- fail.
-% default_contains_var(default_is_unreachable, _) :- fail.
-default_contains_var(default_case(Statement), Name) :-
- statement_contains_var(Statement, Name).
+default_contains_var(Default, DataName) = ContainsVar :-
+ (
+ ( Default = default_do_nothing
+ ; Default = default_is_unreachable
+ ),
+ ContainsVar = no
+ ;
+ Default = default_case(Statement),
+ ContainsVar = statement_contains_var(Statement, DataName)
+ ).
-:- pred atomic_stmt_contains_var(mlds_atomic_statement::in, mlds_data::in)
- is semidet.
+:- func atomic_stmt_contains_var(mlds_atomic_statement, mlds_data) = bool.
-% atomic_stmt_contains_var(comment(_), _Name) :- fail.
-atomic_stmt_contains_var(assign(Lval, Rval), Name) :-
- ( lval_contains_var(Lval, Name)
- ; rval_contains_var(Rval, Name)
- ).
-atomic_stmt_contains_var(new_object(Target, _MaybeTag, _HasSecTag, _Type,
- _MaybeSize, _MaybeCtorName, Args, _ArgTypes, _MayUseAtomic), Name) :-
- ( lval_contains_var(Target, Name)
- ; rvals_contains_var(Args, Name)
- ).
-% atomic_stmt_contains_var(gc_check, _) :- fail.
-atomic_stmt_contains_var(mark_hp(Lval), Name) :-
- lval_contains_var(Lval, Name).
-atomic_stmt_contains_var(restore_hp(Rval), Name) :-
- rval_contains_var(Rval, Name).
-atomic_stmt_contains_var(trail_op(TrailOp), Name) :-
- trail_op_contains_var(TrailOp, Name).
-atomic_stmt_contains_var(inline_target_code(_Lang, Components), Name) :-
- list.member(Component, Components),
- target_code_component_contains_var(Component, Name) = yes.
-
-:- pred trail_op_contains_var(trail_op::in, mlds_data::in) is semidet.
-
-trail_op_contains_var(store_ticket(Lval), Name) :-
- lval_contains_var(Lval, Name).
-trail_op_contains_var(reset_ticket(Rval, _Reason), Name) :-
- rval_contains_var(Rval, Name).
-% trail_op_contains_var(discard_ticket, _Name) :- fail.
-% trail_op_contains_var(prune_ticket, _Name) :- fail.
-trail_op_contains_var(mark_ticket_stack(Lval), Name) :-
- lval_contains_var(Lval, Name).
-trail_op_contains_var(prune_tickets_to(Rval), Name) :-
- rval_contains_var(Rval, Name).
+atomic_stmt_contains_var(AtomicStmt, DataName) = ContainsVar :-
+ (
+ AtomicStmt = comment(_),
+ ContainsVar = no
+ ;
+ ( AtomicStmt = assign(Lval, Rval)
+ ; AtomicStmt = assign_if_in_heap(Lval, Rval)
+ ),
+ ( lval_contains_var(Lval, DataName) = yes ->
+ ContainsVar = yes
+ ;
+ ContainsVar = rval_contains_var(Rval, DataName)
+ )
+ ;
+ AtomicStmt = delete_object(Rval),
+ ContainsVar = rval_contains_var(Rval, DataName)
+ ;
+ AtomicStmt = new_object(Target, _MaybeTag, _HasSecTag, _Type,
+ _MaybeSize, _MaybeCtorName, Args, _ArgTypes, _MayUseAtomic),
+ ( lval_contains_var(Target, DataName) = yes ->
+ ContainsVar = yes
+ ;
+ ContainsVar = rvals_contains_var(Args, DataName)
+ )
+ ;
+ AtomicStmt = gc_check,
+ ContainsVar = no
+ ;
+ AtomicStmt = mark_hp(Lval),
+ ContainsVar = lval_contains_var(Lval, DataName)
+ ;
+ AtomicStmt = restore_hp(Rval),
+ ContainsVar = rval_contains_var(Rval, DataName)
+ ;
+ AtomicStmt = trail_op(TrailOp),
+ ContainsVar = trail_op_contains_var(TrailOp, DataName)
+ ;
+ AtomicStmt = inline_target_code(_Lang, Components),
+ ContainsVar = target_code_components_contains_var(Components, DataName)
+ ;
+ AtomicStmt = outline_foreign_proc(_Lang, OutlineArgs, ReturnLvals,
+ _Code),
+ ( outline_args_contains_var(OutlineArgs, DataName) = yes ->
+ ContainsVar = yes
+ ;
+ ContainsVar = lvals_contains_var(ReturnLvals, DataName)
+ )
+ ).
+
+:- func trail_op_contains_var(trail_op, mlds_data) = bool.
+
+trail_op_contains_var(TrailOp, DataName) = ContainsVar :-
+ (
+ TrailOp = store_ticket(Lval),
+ ContainsVar = lval_contains_var(Lval, DataName)
+ ;
+ TrailOp = reset_ticket(Rval, _Reason),
+ ContainsVar = rval_contains_var(Rval, DataName)
+ ;
+ ( TrailOp = discard_ticket
+ ; TrailOp = prune_ticket
+ ),
+ ContainsVar = no
+ ;
+ TrailOp = mark_ticket_stack(Lval),
+ ContainsVar = lval_contains_var(Lval, DataName)
+ ;
+ TrailOp = prune_tickets_to(Rval),
+ ContainsVar = rval_contains_var(Rval, DataName)
+ ).
+
+:- func target_code_components_contains_var(list(target_code_component),
+ mlds_data) = bool.
+
+target_code_components_contains_var([], _DataName) = no.
+target_code_components_contains_var([TargetCode | TargetCodes], DataName)
+ = ContainsVar :-
+ ( target_code_component_contains_var(TargetCode, DataName) = yes ->
+ ContainsVar = yes
+ ;
+ ContainsVar =
+ target_code_components_contains_var(TargetCodes, DataName)
+ ).
:- func target_code_component_contains_var(target_code_component, mlds_data)
= bool.
@@ -470,10 +544,10 @@
ContainsVar = no
;
TargetCode = target_code_input(Rval),
- ContainsVar = pred_to_bool(rval_contains_var(Rval, DataName))
+ ContainsVar = rval_contains_var(Rval, DataName)
;
TargetCode = target_code_output(Lval),
- ContainsVar = pred_to_bool(lval_contains_var(Lval, DataName))
+ ContainsVar = lval_contains_var(Lval, DataName)
;
TargetCode = target_code_name(EntityName),
(
@@ -487,6 +561,33 @@
)
).
+:- func outline_args_contains_var(list(outline_arg), mlds_data) = bool.
+
+outline_args_contains_var([], _DataName) = no.
+outline_args_contains_var([OutlineArg | OutlineArgs], DataName) =
+ ContainsVar :-
+ ( outline_arg_contains_var(OutlineArg, DataName) = yes ->
+ ContainsVar = yes
+ ;
+ ContainsVar = outline_args_contains_var(OutlineArgs, DataName)
+ ).
+
+:- func outline_arg_contains_var(outline_arg, mlds_data) = bool.
+
+outline_arg_contains_var(OutlineArg, DataName) = ContainsVar :-
+ (
+ OutlineArg = ola_in(_Type, _Str, Rval),
+ ContainsVar = rval_contains_var(Rval, DataName)
+ ;
+ OutlineArg = ola_out(_Type, _Str, Lval),
+ ContainsVar = lval_contains_var(Lval, DataName)
+ ;
+ OutlineArg = ola_unused,
+ ContainsVar = no
+ ).
+
+%-----------------------------------------------------------------------------%
+
has_foreign_languages(Statement, Langs) :-
GetTargetCode = (pred(Lang::out) is nondet :-
statement_contains_statement(Statement, SubStatement),
@@ -543,6 +644,8 @@
Defn = mlds_defn(_Name, _Context, Flags, _Body),
access(Flags) = acc_public.
+%-----------------------------------------------------------------------------%
+%
% defns_contains_var:
% defn_contains_var:
% defn_body_contains_var:
@@ -551,35 +654,50 @@
% Succeed iff the specified construct contains a reference to
% the specified variable.
-defns_contains_var(Defns, Name) :-
- list.member(Defn, Defns),
- defn_contains_var(Defn, Name).
+defns_contains_var([], _DataName) = no.
+defns_contains_var([Defn | Defns], DataName) = ContainsVar :-
+ ( defn_contains_var(Defn, DataName) = yes ->
+ ContainsVar = yes
+ ;
+ ContainsVar = defns_contains_var(Defns, DataName)
+ ).
-defn_contains_var(mlds_defn(_Name, _Context, _Flags, DefnBody), Name) :-
- defn_body_contains_var(DefnBody, Name).
+defn_contains_var(Defn, DataName) = ContainsVar :-
+ Defn = mlds_defn(_Name, _Context, _Flags, DefnBody),
+ ContainsVar = defn_body_contains_var(DefnBody, DataName).
-:- pred defn_body_contains_var(mlds_entity_defn::in, mlds_data::in)
- is semidet.
+:- func defn_body_contains_var(mlds_entity_defn, mlds_data) = bool.
+defn_body_contains_var(DefnBody, DataName) = ContainsVar :-
+ (
+ DefnBody = mlds_data(_Type, Initializer, _GCStatement),
% XXX Should we include variables in the GCStatement field here?
-defn_body_contains_var(mlds_data(_Type, Initializer, _GCStatement), Name) :-
- initializer_contains_var(Initializer, Name).
-defn_body_contains_var(mlds_function(_PredProcId, _Params, FunctionBody,
- _Attrs, _EnvVarNames), Name) :-
- function_body_contains_var(FunctionBody, Name).
-defn_body_contains_var(mlds_class(ClassDefn), Name) :-
+ ContainsVar = initializer_contains_var(Initializer, DataName)
+ ;
+ DefnBody = mlds_function(_PredProcId, _Params, FunctionBody,
+ _Attrs, _EnvVarNames),
+ ContainsVar = function_body_contains_var(FunctionBody, DataName)
+ ;
+ DefnBody = mlds_class(ClassDefn),
ClassDefn = mlds_class_defn(_Kind, _Imports, _Inherits, _Implements,
CtorDefns, FieldDefns),
- ( defns_contains_var(FieldDefns, Name)
- ; defns_contains_var(CtorDefns, Name)
+ ( defns_contains_var(FieldDefns, DataName) = yes ->
+ ContainsVar = yes
+ ;
+ ContainsVar = defns_contains_var(CtorDefns, DataName)
+ )
).
-:- pred function_body_contains_var(mlds_function_body::in, mlds_data::in)
- is semidet.
+:- func function_body_contains_var(mlds_function_body, mlds_data) = bool.
-% function_body_contains_var(body_external, _) :- fail.
-function_body_contains_var(body_defined_here(Statement), Name) :-
- statement_contains_var(Statement, Name).
+function_body_contains_var(Body, DataName) = ContainsVar :-
+ (
+ Body = body_external,
+ ContainsVar = no
+ ;
+ Body = body_defined_here(Statement),
+ ContainsVar = statement_contains_var(Statement, DataName)
+ ).
%-----------------------------------------------------------------------------%
%
@@ -587,64 +705,137 @@
%
% initializer_contains_var:
+% initializers_contains_var:
% rvals_contains_var:
% maybe_rval_contains_var:
% rval_contains_var:
% lvals_contains_var:
% lval_contains_var:
%
-% Succeed iff the specified construct contains a reference to
+% Say whether the specified construct contains a reference to
% the specified variable.
-% initializer_contains_var(no_initializer, _) :- fail.
-initializer_contains_var(init_obj(Rval), Name) :-
- rval_contains_var(Rval, Name).
-initializer_contains_var(init_struct(_Type, Inits), Name) :-
- list.member(Init, Inits),
- initializer_contains_var(Init, Name).
-initializer_contains_var(init_array(Inits), Name) :-
- list.member(Init, Inits),
- initializer_contains_var(Init, Name).
-
-rvals_contains_var(Rvals, Name) :-
- list.member(Rval, Rvals),
- rval_contains_var(Rval, Name).
-
-% maybe_rval_contains_var(no, _Name) :- fail.
-maybe_rval_contains_var(yes(Rval), Name) :-
- rval_contains_var(Rval, Name).
-
-rval_contains_var(ml_lval(Lval), Name) :-
- lval_contains_var(Lval, Name).
-rval_contains_var(ml_mkword(_Tag, Rval), Name) :-
- rval_contains_var(Rval, Name).
-rval_contains_var(ml_const(Const), QualDataName) :-
+initializer_contains_var(Initializer, DataName) = ContainsVar :-
+ (
+ Initializer = no_initializer,
+ ContainsVar = no
+ ;
+ Initializer = init_obj(Rval),
+ ContainsVar = rval_contains_var(Rval, DataName)
+ ;
+ Initializer = init_struct(_Type, FieldInitializers),
+ ContainsVar = initializers_contains_var(FieldInitializers, DataName)
+ ;
+ Initializer = init_array(ElementInitializers),
+ ContainsVar = initializers_contains_var(ElementInitializers, DataName)
+ ).
+
+:- func initializers_contains_var(list(mlds_initializer), mlds_data) = bool.
+
+initializers_contains_var([], _DataName) = no.
+initializers_contains_var([Initializer | Initializers], DataName) =
+ ContainsVar :-
+ ( initializer_contains_var(Initializer, DataName) = yes ->
+ ContainsVar = yes
+ ;
+ ContainsVar = initializers_contains_var(Initializers, DataName)
+ ).
+
+rvals_contains_var([], _DataName) = no.
+rvals_contains_var([Rval | Rvals], DataName) = ContainsVar :-
+ ( rval_contains_var(Rval, DataName) = yes ->
+ ContainsVar = yes
+ ;
+ ContainsVar = rvals_contains_var(Rvals, DataName)
+ ).
+
+maybe_rval_contains_var(no, _DataName) = no.
+maybe_rval_contains_var(yes(Rval), DataName) =
+ rval_contains_var(Rval, DataName).
+
+rval_contains_var(Rval, DataName) = ContainsVar :-
+ (
+ Rval = ml_lval(Lval),
+ ContainsVar = lval_contains_var(Lval, DataName)
+ ;
+ Rval = ml_mkword(_Tag, SubRval),
+ ContainsVar = rval_contains_var(SubRval, DataName)
+ ;
+ Rval = ml_const(Const),
+ (
Const = mlconst_data_addr(DataAddr),
- DataAddr = data_addr(ModuleName, DataName),
- QualDataName = qual(ModuleName, _QualKind, DataName),
- % this is a place where we can succeed
- true.
-rval_contains_var(ml_unop(_Op, Rval), Name) :-
- rval_contains_var(Rval, Name).
-rval_contains_var(ml_binop(_Op, X, Y), Name) :-
- ( rval_contains_var(X, Name)
- ; rval_contains_var(Y, Name)
- ).
-rval_contains_var(ml_mem_addr(Lval), Name) :-
- lval_contains_var(Lval, Name).
-
-lvals_contains_var(Lvals, Name) :-
- list.member(Lval, Lvals),
- lval_contains_var(Lval, Name).
-
-lval_contains_var(ml_field(_MaybeTag, Rval, _FieldId, _, _), Name) :-
- rval_contains_var(Rval, Name).
-lval_contains_var(ml_mem_ref(Rval, _Type), Name) :-
- rval_contains_var(Rval, Name).
-lval_contains_var(ml_var(qual(ModuleName, QualKind, Name), _Type),
- qual(ModuleName, QualKind, mlds_data_var(Name))) :-
+ DataAddr = data_addr(ModuleName, RawDataName),
+ ( DataName = qual(ModuleName, _QualKind, RawDataName) ->
+ % This is a place where we can succeed.
+ ContainsVar = yes
+ ;
+ ContainsVar = no
+ )
+ ;
+ ( Const = mlconst_true
+ ; Const = mlconst_false
+ ; Const = mlconst_int(_)
+ ; Const = mlconst_float(_)
+ ; Const = mlconst_string(_)
+ ; Const = mlconst_multi_string(_)
+ ; Const = mlconst_foreign(_, _, _)
+ ; Const = mlconst_named_const(_)
+ ; Const = mlconst_code_addr(_)
+ ; Const = mlconst_null(_)
+ ),
+ ContainsVar = no
+ )
+ ;
+ Rval = ml_unop(_Op, RvalA),
+ ContainsVar = rval_contains_var(RvalA, DataName)
+ ;
+ Rval = ml_binop(_Op, RvalA, RvalB),
+ ( rval_contains_var(RvalA, DataName) = yes ->
+ ContainsVar = yes
+ ;
+ ContainsVar = rval_contains_var(RvalB, DataName)
+ )
+ ;
+ Rval = ml_mem_addr(Lval),
+ ContainsVar = lval_contains_var(Lval, DataName)
+ ;
+ Rval = ml_scalar_common(_ScalarCommon),
+ ContainsVar = no
+ ;
+ Rval = ml_vector_common_row(_VectorCommon, IndexRval),
+ ContainsVar = rval_contains_var(IndexRval, DataName)
+ ;
+ Rval = ml_self(_),
+ ContainsVar = no
+ ).
+
+lvals_contains_var([], _DataName) = no.
+lvals_contains_var([Lval | Lvals], DataName) = ContainsVar :-
+ ( lval_contains_var(Lval, DataName) = yes ->
+ ContainsVar = yes
+ ;
+ ContainsVar = lvals_contains_var(Lvals, DataName)
+ ).
+
+lval_contains_var(Lval, DataName) = ContainsVar :-
+ (
+ Lval = ml_field(_MaybeTag, Rval, _FieldId, _, _),
+ ContainsVar = rval_contains_var(Rval, DataName)
+ ;
+ Lval = ml_mem_ref(Rval, _Type),
+ ContainsVar = rval_contains_var(Rval, DataName)
+ ;
+ Lval = ml_global_var_ref(_),
+ ContainsVar = no
+ ;
+ Lval = ml_var(qual(ModuleName, QualKind, Name), _Type),
% This is another place where we can succeed.
- true.
+ ( DataName = qual(ModuleName, QualKind, mlds_data_var(Name)) ->
+ ContainsVar = yes
+ ;
+ ContainsVar =no
+ )
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.178
diff -u -b -r1.178 mlds.m
--- compiler/mlds.m 10 Sep 2009 05:11:05 -0000 1.178
+++ compiler/mlds.m 20 Sep 2009 10:36:05 -0000
@@ -630,6 +630,13 @@
; init_array(list(mlds_initializer))
; no_initializer.
+:- type initializer_array_size
+ ---> array_size(int)
+ ; no_size. % Either the size is unknown,
+ % or the data is not an array.
+
+:- func get_initializer_array_size(mlds_initializer) = initializer_array_size.
+
:- type mlds_func_params
---> mlds_func_params(
mlds_arguments, % names and types of arguments (inputs)
@@ -683,7 +690,7 @@
:- type mlds_class_name == string.
:- type mlds_class == mlds_fully_qualified_name(mlds_class_name).
- % Note that standard C doesn't support empty structs, so when targetting C,
+ % Note that standard C doesn't support empty structs, so when targeting C,
% it is the MLDS code generator's responsibility to ensure that each
% generated MLDS class has at least one base class or non-static
% data member.
@@ -918,6 +925,11 @@
:- func init_decl_flags(access, per_instance, virtuality, finality,
constness, abstractness) = mlds_decl_flags.
+ % Return the declaration flags appropriate for an initialized
+ % local static constant.
+ %
+:- func ml_static_const_decl_flags = mlds_decl_flags.
+
%-----------------------------------------------------------------------------%
%
% Foreign code interfacing
@@ -1372,19 +1384,19 @@
% Stores information about each argument to an outline_foreign_proc.
%
:- type outline_arg
- ---> in(
+ ---> ola_in(
mlds_type, % The type of the argument.
string, % The name of the argument in the foreign code.
mlds_rval % The rval which holds the value of this
% argument.
)
- ; out(
+ ; ola_out(
mlds_type, % The type of the argument.
string, % The name of the argument in the foreign code.
mlds_lval % The lval where we are to place the result
% calculated by the foreign code into.
)
- ; unused.
+ ; ola_unused.
% This is just a random selection of possible languages
% that we might want to target...
@@ -1462,17 +1474,22 @@
---> ml_field_offset(mlds_rval)
% offset(N) represents the field at offset N Words.
- ; ml_field_named(mlds_fully_qualified_name(mlds_field_name),
- mlds_type).
- % named_field(Name, CtorType) represents the field with the
- % specified name. The CtorType gives the MLDS type for this
- % particular constructor. The type of the object is given by
- % the PtrType in the field(..) lval; CtorType may either be
- % the same as PtrType, or it may be a pointer to a derived class.
- % In the latter case, the MLDS->target code back-end is responsible
- % for inserting a downcast from PtrType to CtorType before
+ ; ml_field_named(
+ % ml_field_named(Name, MaybeCtorType) represents the field with
+ % the specified name.
+ %
+ % CtorType gives the MLDS type for this particular constructor.
+ % The type of the object is given by the PtrType in the
+ % field(..) lval. CtorType may either be the same as PtrType,
+ % or it may be a pointer to a derived class. In the latter
+ % case, the MLDS->target code back-end is responsible for
+ % inserting a downcast from PtrType to CtorType before
% accessing the field.
+ mlds_fully_qualified_name(mlds_field_name),
+ mlds_type
+ ).
+
:- type mlds_field_name == string.
% An mlds_var represents a variable or constant.
@@ -1559,6 +1576,22 @@
% Expressions
%
+:- type ml_scalar_common_type_num
+ ---> ml_scalar_common_type_num(int).
+:- type ml_vector_common_type_num
+ ---> ml_vector_common_type_num(int).
+
+:- type mlds_scalar_common
+ ---> ml_scalar_common(mlds_module_name, mlds_type,
+ ml_scalar_common_type_num, int).
+ % module name, type, type number, row number
+
+:- type mlds_vector_common
+ ---> ml_vector_common(mlds_module_name, mlds_type,
+ ml_vector_common_type_num, int, int).
+ % module name, type, type number,
+ % starting row number, number of rows
+
% An rval is an expression that represents a value.
%
:- type mlds_rval
@@ -1582,6 +1615,26 @@
; ml_mem_addr(mlds_lval)
% The address of a variable, etc.
+ ; ml_scalar_common(mlds_scalar_common)
+ % A reference to the given common structure. The reference is NOT
+ % the address; that can be represented using a mlds_data_addr
+ % const. This rval is intended to be used as the name of an
+ % array to be indexed into. This is possible because the elements
+ % of a scalar common cell are all boxed and thus of the same size.
+
+ ; ml_vector_common_row(mlds_vector_common, mlds_rval)
+ % ml_vector_common_row(VectorCommon, Index),
+ % A reference to a selected row (selected by the second argument)
+ % of the given common structure. If VectorCommon is equal e.g.
+ % to ml_vector_common(ModuleName, Type, TypeNum, StartRow, NumRows)
+ % then Index must be between 0 and NumRows-1 (both inclusive),
+ % and the reference will be row StartRow + Index in the 2D table
+ % represented by the 2D table holding all the vector static data of
+ % this type.
+ %
+ % The selected row should be a struct holding unboxed values,
+ % which can be retrieved using field names (not field offsets).
+
; ml_self(mlds_type).
% The equivalent of the `this' pointer in C++ with the type of the
% object. Note that this rval is valid iff we are targeting an
@@ -1608,13 +1661,14 @@
---> mlconst_true
; mlconst_false
; mlconst_int(int)
- ; mlconst_foreign(foreign_language, string, mlds_type)
; mlconst_float(float)
; mlconst_string(string)
; mlconst_multi_string(list(string))
% A multi_string_const is a string containing embedded NULs
% between each substring in the list.
+ ; mlconst_foreign(foreign_language, string, mlds_type)
+
; mlconst_named_const(string)
% A constant with the given name, such as a value of an enum type
% in C.
@@ -1657,10 +1711,8 @@
---> mlds_data_var(mlds_var_name)
% Ordinary variables.
- ; mlds_common(int)
- % Compiler-introduced constants representing global constants.
- % These are called "common" because they may be common
- % subexpressions.
+ ; mlds_scalar_common_ref(mlds_scalar_common)
+ % The address of the given scalar common cell.
% Stuff for handling polymorphism/RTTI and type classes.
@@ -1926,13 +1978,17 @@
unexpected(this_file, "target x86_64 with --high-level-code")
;
Target = target_erlang,
- unexpected(this_file,
- "mercury_type_to_mlds_type: target erlang")
+ unexpected(this_file, "mercury_type_to_mlds_type: target erlang")
),
MLDSType = mlds_foreign_type(ForeignType).
%-----------------------------------------------------------------------------%
+get_initializer_array_size(no_initializer) = no_size.
+get_initializer_array_size(init_obj(_)) = no_size.
+get_initializer_array_size(init_struct(_, _)) = no_size.
+get_initializer_array_size(init_array(Elems)) = array_size(list.length(Elems)).
+
mlds_get_func_signature(mlds_func_params(Parameters, RetTypes)) =
mlds_func_signature(ParamTypes, RetTypes) :-
ParamTypes = mlds_get_arg_types(Parameters).
@@ -2188,6 +2244,18 @@
constness_bits(Constness) \/
abstractness_bits(Abstractness).
+ml_static_const_decl_flags = DeclFlags :-
+ % Note that rtti_decl_flags, in rtti_to_mlds.m,
+ % must be the same as this apart from the access.
+ Access = acc_local,
+ PerInstance = one_copy,
+ Virtuality = non_virtual,
+ Finality = final,
+ Constness = const,
+ Abstractness = concrete,
+ DeclFlags = init_decl_flags(Access, PerInstance,
+ Virtuality, Finality, Constness, Abstractness).
+
%-----------------------------------------------------------------------------%
:- func this_file = string.
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.241
diff -u -b -r1.241 mlds_to_c.m
--- compiler/mlds_to_c.m 8 Sep 2009 02:56:55 -0000 1.241
+++ compiler/mlds_to_c.m 20 Sep 2009 10:51:06 -0000
@@ -104,7 +104,9 @@
:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_util.
+:- import_module assoc_list.
:- import_module bool.
+:- import_module cord.
:- import_module int.
:- import_module library.
:- import_module list.
@@ -229,10 +231,11 @@
io::di, io::uo) is det.
mlds_output_hdr_file(Opts, Indent, MLDS, !IO) :-
- MLDS = mlds(ModuleName, AllForeignCode, Imports, GlobalData, Defns0,
+ MLDS = mlds(ModuleName, AllForeignCode, Imports, GlobalData, PlainDefns,
InitPreds, FinalPreds, ExportEnums),
- ml_global_data_get_all_global_defns(GlobalData, GlobalDefns),
- Defns = GlobalDefns ++ Defns0,
+ ml_global_data_get_all_global_defns(GlobalData,
+ _ScalarCellGroupMap, _VectorCellGroupMap, GlobalDefns),
+ Defns = GlobalDefns ++ PlainDefns,
mlds_output_hdr_start(Indent, ModuleName, !IO),
io.nl(!IO),
@@ -341,13 +344,16 @@
io::di, io::uo) is det.
mlds_output_src_file(Opts, Indent, MLDS, !IO) :-
- MLDS = mlds(ModuleName, AllForeignCode, Imports, GlobalData, Defns0,
+ MLDS = mlds(ModuleName, AllForeignCode, Imports, GlobalData, PlainDefns,
InitPreds, FinalPreds, _ExportEnums),
- ml_global_data_get_all_global_defns(GlobalData, GlobalDefns),
- Defns = GlobalDefns ++ Defns0,
+ ml_global_data_get_all_global_defns(GlobalData,
+ ScalarCellGroupMap, VectorCellGroupMap, GlobalDefns),
+ Defns = GlobalDefns ++ PlainDefns,
+ map.to_assoc_list(ScalarCellGroupMap, ScalarCellGroups),
+ map.to_assoc_list(VectorCellGroupMap, VectorCellGroups),
ForeignCode = mlds_get_c_foreign_code(AllForeignCode),
- EnvVarNameSet = mlds_get_env_var_names(Defns),
+ EnvVarNameSet = mlds_get_env_var_names(PlainDefns),
set.to_sorted_list(EnvVarNameSet, EnvVarNames),
mlds_output_src_start(Indent, ModuleName, ForeignCode,
InitPreds, FinalPreds, EnvVarNames, !IO),
@@ -377,13 +383,13 @@
% are generated by mlds_output_type_forward_decls. See the comment in
% mlds_output_decl.
- % ZZZ could do the following better
+ % XXX could do the following better
list.filter(defn_is_public, Defns, _PublicDefns, PrivateDefns),
list.filter(defn_is_type, PrivateDefns, PrivateTypeDefns,
PrivateNonTypeDefns),
list.filter(defn_is_type, Defns, _TypeDefns, NonTypeDefns),
list.filter(defn_is_function, NonTypeDefns, FuncDefns),
- list.filter(defn_is_type_ctor_info, NonTypeDefns, TypeCtorInfoDefns),
+ list.filter(defn_is_type_ctor_info, GlobalDefns, TypeCtorInfoDefns),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
mlds_output_defns(Opts, Indent, yes, MLDS_ModuleName, PrivateTypeDefns,
@@ -392,6 +398,23 @@
mlds_output_decls(Opts, Indent, MLDS_ModuleName, PrivateNonTypeDefns, !IO),
io.nl(!IO),
+ ModuleSymName = mlds_module_name_to_sym_name(MLDS_ModuleName),
+ MangledModuleName = sym_name_mangle(ModuleSymName),
+
+ mlds_output_scalar_cell_group_decls(Opts, Indent, MangledModuleName,
+ ScalarCellGroups, !IO),
+ io.nl(!IO),
+ mlds_output_vector_cell_group_decls(Opts, Indent, MLDS_ModuleName,
+ MangledModuleName, VectorCellGroups, !IO),
+ io.nl(!IO),
+
+ mlds_output_scalar_cell_group_defns(Opts, Indent, MangledModuleName,
+ ScalarCellGroups, !IO),
+ io.nl(!IO),
+ mlds_output_vector_cell_group_defns(Opts, Indent, MangledModuleName,
+ VectorCellGroups, !IO),
+ io.nl(!IO),
+
mlds_output_c_defns(Opts, MLDS_ModuleName, Indent, ForeignCode, !IO),
io.nl(!IO),
mlds_output_defns(Opts, Indent, yes, MLDS_ModuleName, NonTypeDefns, !IO),
@@ -1210,7 +1233,7 @@
Arg = mlds_argument(Name, Type, _GCStatement),
io.write_string("\t", !IO),
mlds_output_data_decl_ho(Opts,
- mlds_output_type_prefix, mlds_output_type_suffix,
+ mlds_output_type_prefix, mlds_output_type_suffix_no_size,
qual(ModuleName, module_qual, boxed_name(Name)), Type, !IO),
io.write_string(";\n", !IO).
@@ -1221,7 +1244,7 @@
Arg = mlds_argument(Name, Type, _GCStatement),
io.write_string("\t", !IO),
mlds_output_data_decl_ho(Opts,
- mlds_output_type_prefix, mlds_output_type_suffix,
+ mlds_output_type_prefix, mlds_output_type_suffix_no_size,
qual(ModuleName, module_qual, boxed_name(Name)), pointed_to_type(Type),
!IO),
io.write_string(";\n", !IO).
@@ -1360,7 +1383,7 @@
%-----------------------------------------------------------------------------%
%
-% Code to output declarations and definitions
+% Code to output declarations and definitions.
%
:- pred mlds_output_defns(mlds_to_c_opts::in, indent::in, bool::in,
@@ -1398,15 +1421,9 @@
mlds_output_decls(_Opts, _Indent, _ModuleName, [], !IO).
mlds_output_decls(Opts, Indent, ModuleName, [Defn | Defns], !IO) :-
- mlds_output_decl_blank_line(Opts, Indent, ModuleName, Defn, !IO),
- mlds_output_decls(Opts, Indent, ModuleName, Defns, !IO).
-
-:- pred mlds_output_decl_blank_line(mlds_to_c_opts::in, indent::in,
- mlds_module_name::in, mlds_defn::in, io::di, io::uo) is det.
-
-mlds_output_decl_blank_line(Opts, Indent, ModuleName, Defn, !IO) :-
io.nl(!IO),
- mlds_output_decl(Opts, Indent, ModuleName, Defn, !IO).
+ mlds_output_decl(Opts, Indent, ModuleName, Defn, !IO),
+ mlds_output_decls(Opts, Indent, ModuleName, Defns, !IO).
:- pred mlds_output_decl(mlds_to_c_opts::in, indent::in,
mlds_module_name::in, mlds_defn::in, io::di, io::uo) is det.
@@ -1452,10 +1469,162 @@
% Now output the declaration for this mlds_defn.
mlds_output_context_and_indent(Context, Indent, !IO),
mlds_output_decl_flags(Opts, Flags, forward_decl, Name, DefnBody, !IO),
- mlds_output_decl_body(Opts, Indent,
- qual(ModuleName, module_qual, Name), Context, DefnBody, !IO)
+ QualName = qual(ModuleName, module_qual, Name),
+ mlds_output_decl_body(Opts, Indent, QualName, Context, DefnBody, !IO)
).
+:- pred mlds_output_scalar_cell_group_decls(mlds_to_c_opts::in, indent::in,
+ string::in,
+ assoc_list(ml_scalar_common_type_num, ml_scalar_cell_group)::in,
+ io::di, io::uo) is det.
+
+mlds_output_scalar_cell_group_decls(_Opts, _Indent, _MangledModuleName,
+ [], !IO).
+mlds_output_scalar_cell_group_decls(Opts, Indent, MangledModuleName,
+ [CellGroup | CellGroups], !IO) :-
+ mlds_output_scalar_cell_group_decl(Opts, Indent, MangledModuleName,
+ CellGroup, !IO),
+ mlds_output_scalar_cell_group_decls(Opts, Indent, MangledModuleName,
+ CellGroups, !IO).
+
+:- pred mlds_output_scalar_cell_group_decl(mlds_to_c_opts::in, indent::in,
+ string::in, pair(ml_scalar_common_type_num, ml_scalar_cell_group)::in,
+ io::di, io::uo) is det.
+
+mlds_output_scalar_cell_group_decl(Opts, Indent, MangledModuleName,
+ TypeNum - CellGroup, !IO) :-
+ TypeNum = ml_scalar_common_type_num(TypeRawNum),
+ CellGroup = ml_scalar_cell_group(Type, InitArraySize,
+ _Counter, _Members, _RevRows),
+ mlds_indent(Indent, !IO),
+ io.write_string("\nstatic /* final */ const ", !IO),
+ mlds_output_type_prefix(Opts, Type, !IO),
+ io.write_string(" ", !IO),
+ io.write_string(MangledModuleName, !IO),
+ io.write_string("_scalar_common_", !IO),
+ io.write_int(TypeRawNum, !IO),
+ io.write_string("[]", !IO),
+ mlds_output_type_suffix(Opts, Type, InitArraySize, !IO),
+ io.write_string(";\n", !IO).
+
+:- pred mlds_output_vector_cell_group_decls(mlds_to_c_opts::in, indent::in,
+ mlds_module_name::in, string::in,
+ assoc_list(ml_vector_common_type_num, ml_vector_cell_group)::in,
+ io::di, io::uo) is det.
+
+mlds_output_vector_cell_group_decls(_Opts, _Indent,
+ _ModuleName, _MangledModuleName, [], !IO).
+mlds_output_vector_cell_group_decls(Opts, Indent,
+ ModuleName, MangledModuleName, [CellGroup | CellGroups], !IO) :-
+ mlds_output_vector_cell_group_decl(Opts, Indent,
+ ModuleName, MangledModuleName, CellGroup, !IO),
+ mlds_output_vector_cell_group_decls(Opts, Indent,
+ ModuleName, MangledModuleName, CellGroups, !IO).
+
+:- pred mlds_output_vector_cell_group_decl(mlds_to_c_opts::in, indent::in,
+ mlds_module_name::in, string::in,
+ pair(ml_vector_common_type_num, ml_vector_cell_group)::in,
+ io::di, io::uo) is det.
+
+mlds_output_vector_cell_group_decl(Opts, Indent, ModuleName, MangledModuleName,
+ TypeNum - CellGroup, !IO) :-
+ TypeNum = ml_vector_common_type_num(TypeRawNum),
+ CellGroup = ml_vector_cell_group(Type, ClassDefn, _FieldNames,
+ _NextRow, _RevRows),
+ mlds_output_defn(Opts, Indent, yes, ModuleName, ClassDefn, !IO),
+
+ mlds_indent(Indent, !IO),
+ io.write_string("\nstatic /* final */ const ", !IO),
+ mlds_output_type_prefix(Opts, Type, !IO),
+ io.write_string(" ", !IO),
+ io.write_string(MangledModuleName, !IO),
+ io.write_string("_vector_common_", !IO),
+ io.write_int(TypeRawNum, !IO),
+ io.write_string("[]", !IO),
+ mlds_output_type_suffix(Opts, Type, no_size, !IO),
+ io.write_string(";\n", !IO).
+
+:- pred mlds_output_scalar_cell_group_defns(mlds_to_c_opts::in, indent::in,
+ string::in,
+ assoc_list(ml_scalar_common_type_num, ml_scalar_cell_group)::in,
+ io::di, io::uo) is det.
+
+mlds_output_scalar_cell_group_defns(_Opts, _Indent, _MangledModuleName,
+ [], !IO).
+mlds_output_scalar_cell_group_defns(Opts, Indent, MangledModuleName,
+ [CellGroup | CellGroups], !IO) :-
+ mlds_output_scalar_cell_group_defn(Opts, Indent, MangledModuleName,
+ CellGroup, !IO),
+ mlds_output_scalar_cell_group_defns(Opts, Indent, MangledModuleName,
+ CellGroups, !IO).
+
+:- pred mlds_output_scalar_cell_group_defn(mlds_to_c_opts::in, indent::in,
+ string::in, pair(ml_scalar_common_type_num, ml_scalar_cell_group)::in,
+ io::di, io::uo) is det.
+
+mlds_output_scalar_cell_group_defn(Opts, Indent, MangledModuleName,
+ TypeNum - CellGroup, !IO) :-
+ TypeNum = ml_scalar_common_type_num(TypeRawNum),
+ CellGroup = ml_scalar_cell_group(Type, InitArraySize,
+ _Counter, _Members, RowCords),
+ Rows = cord.list(RowCords),
+ mlds_indent(Indent, !IO),
+ io.write_string("\nstatic /* final */ const ", !IO),
+ mlds_output_type_prefix(Opts, Type, !IO),
+ io.write_string(" ", !IO),
+ io.write_string(MangledModuleName, !IO),
+ io.write_string("_scalar_common_", !IO),
+ io.write_int(TypeRawNum, !IO),
+ io.write_string("[]", !IO),
+ mlds_output_type_suffix(Opts, Type, InitArraySize, !IO),
+ io.write_string(" = {\n", !IO),
+ list.foldl(mlds_output_cell(Opts, Indent + 1), Rows, !IO),
+ io.write_string("};\n", !IO).
+
+:- pred mlds_output_vector_cell_group_defns(mlds_to_c_opts::in, indent::in,
+ string::in,
+ assoc_list(ml_vector_common_type_num, ml_vector_cell_group)::in,
+ io::di, io::uo) is det.
+
+mlds_output_vector_cell_group_defns(_Opts, _Indent, _MangledModuleName,
+ [], !IO).
+mlds_output_vector_cell_group_defns(Opts, Indent, MangledModuleName,
+ [CellGroup | CellGroups], !IO) :-
+ mlds_output_vector_cell_group_defn(Opts, Indent, MangledModuleName,
+ CellGroup, !IO),
+ mlds_output_vector_cell_group_defns(Opts, Indent, MangledModuleName,
+ CellGroups, !IO).
+
+:- pred mlds_output_vector_cell_group_defn(mlds_to_c_opts::in, indent::in,
+ string::in, pair(ml_vector_common_type_num, ml_vector_cell_group)::in,
+ io::di, io::uo) is det.
+
+mlds_output_vector_cell_group_defn(Opts, Indent, MangledModuleName,
+ TypeNum - CellGroup, !IO) :-
+ TypeNum = ml_vector_common_type_num(TypeRawNum),
+ CellGroup = ml_vector_cell_group(Type, _ClassDefn, _FieldNames,
+ _NextRow, RowCords),
+ Rows = cord.list(RowCords),
+ mlds_indent(Indent, !IO),
+ io.write_string("\nstatic /* final */ const ", !IO),
+ mlds_output_type_prefix(Opts, Type, !IO),
+ io.write_string(" ", !IO),
+ io.write_string(MangledModuleName, !IO),
+ io.write_string("_vector_common_", !IO),
+ io.write_int(TypeRawNum, !IO),
+ io.write_string("[]", !IO),
+ mlds_output_type_suffix(Opts, Type, no_size, !IO),
+ io.write_string(" = {\n", !IO),
+ list.foldl(mlds_output_cell(Opts, Indent + 1), Rows, !IO),
+ io.write_string("};\n", !IO).
+
+:- pred mlds_output_cell(mlds_to_c_opts::in, indent::in,
+ mlds_initializer::in, io::di, io::uo) is det.
+
+mlds_output_cell(Opts, Indent, Initializer, !IO) :-
+ mlds_output_initializer_body(Opts, Indent, Initializer, !IO),
+ io.write_string(",\n", !IO).
+
:- pred mlds_output_type_forward_decls(mlds_to_c_opts::in, indent::in,
list(mlds_type)::in, io::di, io::uo) is det.
@@ -1549,7 +1718,7 @@
(
DefnBody = mlds_data(Type, Initializer, _GCStatement),
mlds_output_data_decl(Opts, Name, Type,
- initializer_array_size(Initializer), !IO)
+ get_initializer_array_size(Initializer), !IO)
;
DefnBody = mlds_function(MaybePredProcId, Signature,
_MaybeBody, _Attrs, _EnvVarNames),
@@ -1653,7 +1822,7 @@
; UnqualName = entity_function(_, _, _, _)
; UnqualName = entity_export(_)
),
- unexpected(this_file, "mlds_output_enum_constants")
+ unexpected(this_file, "mlds_output_class")
),
% Hoist out static members, since plain old C doesn't support
@@ -1690,7 +1859,7 @@
list.map_foldl(mlds_make_base_class(Context), BaseClasses, BaseDefns,
1, _),
- list.append(BaseDefns, StructMembers, BasesAndMembers),
+ BasesAndMembers = BaseDefns ++ StructMembers,
% Output the class declaration and the class members.
% We treat enumerations specially.
@@ -1828,7 +1997,7 @@
mlds_output_data_defn(Opts, Name, Type, Initializer, !IO) :-
mlds_output_data_decl(Opts, Name, Type,
- initializer_array_size(Initializer), !IO),
+ get_initializer_array_size(Initializer), !IO),
mlds_output_initializer(Opts, Type, Initializer, !IO),
io.write_string(";\n", !IO).
@@ -1867,27 +2036,27 @@
:- pred mlds_output_initializer_body(mlds_to_c_opts::in, int::in,
mlds_initializer::in, io::di, io::uo) is det.
-mlds_output_initializer_body(Opts, Indent, Init, !IO) :-
+mlds_output_initializer_body(Opts, Indent, Initializer, !IO) :-
(
- Init = no_initializer
+ Initializer = no_initializer
;
- Init = init_obj(Rval),
+ Initializer = init_obj(Rval),
mlds_indent(Indent, !IO),
mlds_output_rval(Opts, Rval, !IO)
;
- Init = init_struct(_Type, FieldInits),
+ Initializer = init_struct(_Type, FieldInitializers),
% Note that standard ANSI/ISO C does not allow empty structs. But it is
% the responsibility of the MLDS code generator to not generate any.
% So we don't need to handle empty initializers specially here.
mlds_indent(Indent, !IO),
io.write_string("{\n", !IO),
- io.write_list(FieldInits, ",\n",
+ io.write_list(FieldInitializers, ",\n",
mlds_output_initializer_body(Opts, Indent + 1), !IO),
io.write_string("\n", !IO),
mlds_indent(Indent, !IO),
io.write_string("}", !IO)
;
- Init = init_array(ElementInits),
+ Initializer = init_array(ElementInitializers),
% Standard ANSI/ISO C does not allow empty arrays. But the MLDS does.
% To keep the C compiler happy, we therefore convert zero-element MLDS
% arrays into one-element C arrays. (The extra element is a minor waste
@@ -1896,14 +2065,14 @@
% We can initialize the extra element with any value. We use "0",
% since that is a valid initializer for any type.
(
- ElementInits = [],
+ ElementInitializers = [],
mlds_indent(Indent, !IO),
io.write_string("{ 0 }\n", !IO)
;
- ElementInits = [_ | _],
+ ElementInitializers = [_ | _],
mlds_indent(Indent, !IO),
io.write_string("{\n", !IO),
- io.write_list(ElementInits, ",\n",
+ io.write_list(ElementInitializers, ",\n",
mlds_output_initializer_body(Opts, Indent + 1), !IO),
io.write_string("\n", !IO),
mlds_indent(Indent, !IO),
@@ -1969,7 +2138,7 @@
CallingConvention = "MR_CALL ",
mlds_output_func_decl_ho(Opts, Indent, QualifiedName, Context,
CallingConvention, Signature,
- mlds_output_type_prefix, mlds_output_type_suffix, !IO).
+ mlds_output_type_prefix, mlds_output_type_suffix_no_size, !IO).
:- pred mlds_output_func_decl_ho(mlds_to_c_opts::in, indent::in,
mlds_qualified_entity_name::in, mlds_context::in, string::in,
@@ -2289,22 +2458,39 @@
:- pred mlds_output_data_name(mlds_data_name::in, io::di, io::uo) is det.
-mlds_output_data_name(mlds_data_var(Name), !IO) :-
- mlds_output_mangled_name(ml_var_name_to_string(Name), !IO).
-mlds_output_data_name(mlds_common(Num), !IO) :-
- io.write_string("common_", !IO),
- io.write_int(Num, !IO).
-mlds_output_data_name(mlds_rtti(RttiId), !IO) :-
+mlds_output_data_name(DataName, !IO) :-
+ (
+ DataName = mlds_data_var(Name),
+ mlds_output_mangled_name(ml_var_name_to_string(Name), !IO)
+ ;
+ DataName = mlds_scalar_common_ref(Common),
+ Common = ml_scalar_common(ModuleName, _Type,
+ ml_scalar_common_type_num(TypeNum), RowNum),
+ ModuleSymName = mlds_module_name_to_sym_name(ModuleName),
+ MangledModuleName = sym_name_mangle(ModuleSymName),
+ io.write_string(MangledModuleName, !IO),
+ io.write_string("_scalar_common_", !IO),
+ io.write_int(TypeNum, !IO),
+ io.write_string("[", !IO),
+ io.write_int(RowNum, !IO),
+ io.write_string("]", !IO)
+ ;
+ DataName = mlds_rtti(RttiId),
rtti.id_to_c_identifier(RttiId, RttiAddrName),
- io.write_string(RttiAddrName, !IO).
-mlds_output_data_name(mlds_module_layout, !IO) :-
- sorry(this_file, "NYI: module_layout").
-mlds_output_data_name(mlds_proc_layout(_ProcLabel), !IO) :-
- sorry(this_file, "NYI: proc_layout").
-mlds_output_data_name(mlds_internal_layout(_ProcLabel, _FuncSeqNum), !IO) :-
- sorry(this_file, "NYI: internal_layout").
-mlds_output_data_name(mlds_tabling_ref(ProcLabel, Id), !IO) :-
- io.write_string(mlds_tabling_data_name(ProcLabel, Id), !IO).
+ io.write_string(RttiAddrName, !IO)
+ ;
+ DataName = mlds_module_layout,
+ sorry(this_file, "NYI: module_layout")
+ ;
+ DataName = mlds_proc_layout(_ProcLabel),
+ sorry(this_file, "NYI: proc_layout")
+ ;
+ DataName = mlds_internal_layout(_ProcLabel, _FuncSeqNum),
+ sorry(this_file, "NYI: internal_layout")
+ ;
+ DataName = mlds_tabling_ref(ProcLabel, Id),
+ io.write_string(mlds_tabling_data_name(ProcLabel, Id), !IO)
+ ).
mlds_tabling_data_name(ProcLabel, Id) =
tabling_info_id_str(Id) ++ "_for_" ++
@@ -2330,7 +2516,7 @@
% the suffix.
mlds_output_type_prefix(Opts, Type, !IO),
- mlds_output_type_suffix(Opts, Type, !IO).
+ mlds_output_type_suffix(Opts, Type, no_size, !IO).
:- pred mlds_output_type_prefix(mlds_to_c_opts::in, mlds_type::in,
io::di, io::uo) is det.
@@ -2547,24 +2733,12 @@
),
mlds_output_type_prefix(Opts, MLDS_Type, !IO).
-:- pred mlds_output_type_suffix(mlds_to_c_opts::in, mlds_type::in,
+:- pred mlds_output_type_suffix_no_size(mlds_to_c_opts::in, mlds_type::in,
io::di, io::uo) is det.
-mlds_output_type_suffix(Opts, Type, !IO) :-
+mlds_output_type_suffix_no_size(Opts, Type, !IO) :-
mlds_output_type_suffix(Opts, Type, no_size, !IO).
-:- type initializer_array_size
- ---> array_size(int)
- ; no_size. % Either the size is unknown,
- % or the data is not an array.
-
-:- func initializer_array_size(mlds_initializer) = initializer_array_size.
-
-initializer_array_size(no_initializer) = no_size.
-initializer_array_size(init_obj(_)) = no_size.
-initializer_array_size(init_struct(_, _)) = no_size.
-initializer_array_size(init_array(Elems)) = array_size(list.length(Elems)).
-
:- pred mlds_output_type_suffix(mlds_to_c_opts::in, mlds_type::in,
initializer_array_size::in, io::di, io::uo) is det.
@@ -3373,7 +3547,7 @@
mlds_output_type_prefix(Opts, Type, !IO),
io.write_string(" ", !IO),
io.write_string(BaseVarName, !IO),
- mlds_output_type_suffix(Opts, Type, !IO),
+ mlds_output_type_suffix(Opts, Type, no_size, !IO),
io.write_string(";\n", !IO)
),
@@ -3664,8 +3838,14 @@
(
FieldId = ml_field_offset(OffsetRval),
(
- ( FieldType = mlds_generic_type
- ; FieldType = mercury_type(type_variable(_, _), _, _)
+ (
+ FieldType = mlds_generic_type
+ ;
+ FieldType = mercury_type(MercuryType, _, _),
+ MercuryType = type_variable(_, _)
+ % We could also accept other types that are the same size
+ % as MR_Box, such as builtin_type(builtin_type_int) and
+ % builtin_type(builtin_type_string).
)
->
io.write_string("(", !IO),
@@ -3697,8 +3877,8 @@
;
true
),
- ( PtrRval = ml_mem_addr(Lval) ->
- mlds_output_lval(Opts, Lval, !IO),
+ ( PtrRval = ml_mem_addr(PtrAddrLval) ->
+ mlds_output_lval(Opts, PtrAddrLval, !IO),
io.write_string(").", !IO)
;
mlds_output_bracketed_rval(Opts, PtrRval, !IO),
@@ -3800,12 +3980,28 @@
% Even though C doesn't support multiple return types, this case needs
% to be handled for e.g. MLDS dumps when compiling to Java. We generate
% an "#error" directive to make the error message clearer, but then we go
- % ahead and generate C-like psuedo-code for the purposes of MLDS dumps.
+ % ahead and generate C-like pseudo-code for the purposes of MLDS dumps.
io.write_string("\n#error multiple return values\n", !IO),
io.write_string("\t{", !IO),
io.write_list(List, ", ", OutputPred, !IO),
io.write_string("}", !IO).
+:- pred mlds_output_rval_as_op_arg(mlds_to_c_opts::in, mlds_rval::in,
+ io::di, io::uo) is det.
+
+mlds_output_rval_as_op_arg(Opts, Rval, !IO) :-
+ (
+ ( Rval = ml_unop(_, _)
+ ; Rval = ml_binop(_, _, _)
+ )
+ ->
+ io.write_string("(", !IO),
+ mlds_output_rval(Opts, Rval, !IO),
+ io.write_string(")", !IO)
+ ;
+ mlds_output_rval(Opts, Rval, !IO)
+ ).
+
:- pred mlds_output_rval(mlds_to_c_opts::in, mlds_rval::in, io::di, io::uo)
is det.
@@ -3846,17 +4042,44 @@
Rval = ml_const(Const),
mlds_output_rval_const(Opts, Const, !IO)
;
- Rval = ml_unop(Op, RvalA),
- mlds_output_unop(Opts, Op, RvalA, !IO)
+ Rval = ml_unop(UnOp, RvalA),
+ mlds_output_unop(Opts, UnOp, RvalA, !IO)
;
- Rval = ml_binop(Op, RvalA, RvalB),
- mlds_output_binop(Opts, Op, RvalA, RvalB, !IO)
+ Rval = ml_binop(BinOp, RvalA, RvalB),
+ mlds_output_binop(Opts, BinOp, RvalA, RvalB, !IO)
;
Rval = ml_mem_addr(Lval),
% XXX Are parentheses needed?
io.write_string("&", !IO),
mlds_output_lval(Opts, Lval, !IO)
;
+ Rval = ml_scalar_common(ScalarCommon),
+ ScalarCommon = ml_scalar_common(ModuleName, _Type,
+ ml_scalar_common_type_num(TypeNum), RowNum),
+ ModuleSymName = mlds_module_name_to_sym_name(ModuleName),
+ MangledModuleName = sym_name_mangle(ModuleSymName),
+ io.write_string(MangledModuleName, !IO),
+ io.write_string("_scalar_common_", !IO),
+ io.write_int(TypeNum, !IO),
+ io.write_string("[", !IO),
+ io.write_int(RowNum, !IO),
+ io.write_string("]", !IO)
+ ;
+ Rval = ml_vector_common_row(VectorCommon, RowRval),
+ VectorCommon = ml_vector_common(ModuleName, _Type,
+ ml_vector_common_type_num(TypeNum), StartRowNum, _NumRows),
+ ModuleSymName = mlds_module_name_to_sym_name(ModuleName),
+ MangledModuleName = sym_name_mangle(ModuleSymName),
+ io.write_string("&", !IO),
+ io.write_string(MangledModuleName, !IO),
+ io.write_string("_vector_common_", !IO),
+ io.write_int(TypeNum, !IO),
+ io.write_string("[", !IO),
+ io.write_int(StartRowNum, !IO),
+ io.write_string(" + ", !IO),
+ mlds_output_rval(Opts, RowRval, !IO),
+ io.write_string("]", !IO)
+ ;
Rval = ml_self(_),
io.write_string("this", !IO)
).
@@ -4047,31 +4270,31 @@
io.write_string(")", !IO)
;
Category = unsigned_compare_binop,
- io.write_string("( (MR_Unsigned) ", !IO),
+ io.write_string("(((MR_Unsigned) ", !IO),
mlds_output_rval(Opts, X, !IO),
- io.write_string(" ", !IO),
+ io.write_string(") ", !IO),
io.write_string(OpStr, !IO),
- io.write_string(" (MR_Unsigned) ", !IO),
+ io.write_string(" ((MR_Unsigned) ", !IO),
mlds_output_rval(Opts, Y, !IO),
- io.write_string(")", !IO)
+ io.write_string("))", !IO)
;
Category = int_or_bool_binary_infix_binop,
% We could treat X + (-const) specially, but we don't.
% The reason is documented in the equivalent code in llds_out.m.
io.write_string("(", !IO),
- mlds_output_rval(Opts, X, !IO),
+ mlds_output_rval_as_op_arg(Opts, X, !IO),
io.write_string(" ", !IO),
io.write_string(OpStr, !IO),
io.write_string(" ", !IO),
- mlds_output_rval(Opts, Y, !IO),
+ mlds_output_rval_as_op_arg(Opts, Y, !IO),
io.write_string(")", !IO)
;
Category = macro_binop,
io.write_string(OpStr, !IO),
io.write_string("(", !IO),
- mlds_output_rval(Opts, X, !IO),
+ mlds_output_rval_as_op_arg(Opts, X, !IO),
io.write_string(", ", !IO),
- mlds_output_rval(Opts, Y, !IO),
+ mlds_output_rval_as_op_arg(Opts, Y, !IO),
io.write_string(")", !IO)
).
@@ -4170,22 +4393,21 @@
:- pred mlds_output_data_addr(mlds_data_addr::in, io::di, io::uo) is det.
mlds_output_data_addr(data_addr(ModuleName, DataName), !IO) :-
- % If its an array type, then we just use the name, otherwise we must
+ % If it is an array type, then we just use the name, otherwise we must
% prefix the name with `&'.
(
+ (
DataName = mlds_rtti(RttiId),
rtti_id_has_array_type(RttiId) = is_array
- ->
- mlds_output_data_var_name(ModuleName, DataName, !IO)
;
DataName = mlds_tabling_ref(_, TablingId),
tabling_id_has_array_type(TablingId) = is_array
+ )
->
mlds_output_data_var_name(ModuleName, DataName, !IO)
;
- io.write_string("(&", !IO),
- mlds_output_data_var_name(ModuleName, DataName, !IO),
- io.write_string(")", !IO)
+ io.write_string("&", !IO),
+ mlds_output_data_var_name(ModuleName, DataName, !IO)
).
:- pred mlds_output_data_var_name(mlds_module_name::in, mlds_data_name::in,
@@ -4198,6 +4420,10 @@
->
true
;
+ DataName = mlds_scalar_common_ref(_)
+ ->
+ true
+ ;
mlds_output_module_name(mlds_module_name_to_sym_name(ModuleName), !IO),
io.write_string("__", !IO)
),
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.145
diff -u -b -r1.145 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 2 Sep 2009 00:30:20 -0000 1.145
+++ compiler/mlds_to_gcc.m 19 Sep 2009 16:47:18 -0000
@@ -297,7 +297,8 @@
% them from the asm file!) and pass that to mlds_to_c.m
% to create the .mih file, and if necessary the .c file.
{ ForeignMLDS = mlds(ModuleName, AllForeignCode, Imports,
- ml_global_data_init, list__map(make_public, ForeignDefns),
+ ml_global_data_init(do_not_use_common_cells),
+ list__map(make_public, ForeignDefns),
InitPreds, FinalPreds, ExportedEnums) },
mlds_to_c__output_c_file(ForeignMLDS, Globals, "")
),
@@ -814,7 +815,7 @@
{ DefnInfo = defn_info(GlobalInfo0, Name, LocalVars,
LabelTable) },
{ GCC_Name = build_qualified_name(Name) },
- build_type(Type, initializer_array_size(Initializer),
+ build_type(Type, get_initializer_array_size(Initializer),
GlobalInfo0, GCC_Type),
build_initializer(Initializer, GCC_Type, DefnInfo,
GCC_Initializer),
@@ -1152,7 +1153,7 @@
:- mode build_local_data_defn(in, in, in, in, in, out, di, uo) is det.
build_local_data_defn(Name, Flags, Type, Initializer, DefnInfo, GCC_Defn) -->
- build_type(Type, initializer_array_size(Initializer),
+ build_type(Type, get_initializer_array_size(Initializer),
DefnInfo ^ global_info, GCC_Type),
{ Name = qual(_ModuleName, _QualKind, UnqualName) },
( { UnqualName = entity_data(mlds_data_var(VarName0)) } ->
@@ -1200,7 +1201,7 @@
:- mode build_field_data_defn(in, in, in, in, out, di, uo) is det.
build_field_data_defn(Name, Type, Initializer, GlobalInfo, GCC_Defn) -->
- build_type(Type, initializer_array_size(Initializer),
+ build_type(Type, get_initializer_array_size(Initializer),
GlobalInfo, GCC_Type),
{ Name = qual(_ModuleName, _QualKind, UnqualName) },
( { UnqualName = entity_data(mlds_data_var(VarName)) } ->
@@ -1958,19 +1959,6 @@
gcc__build_array_type(GCC_Type, Size, GCC_ArrayType).
%-----------------------------------------------------------------------------%
-
-:- type initializer_array_size
- ---> array_size(int)
- ; no_size. % either the size is unknown,
- % or the data is not an array
-
-:- func initializer_array_size(mlds_initializer) = initializer_array_size.
-initializer_array_size(no_initializer) = no_size.
-initializer_array_size(init_obj(_)) = no_size.
-initializer_array_size(init_struct(_, _)) = no_size.
-initializer_array_size(init_array(Elems)) = array_size(list__length(Elems)).
-
-%-----------------------------------------------------------------------------%
%
% Code to build RTTI types
%
@@ -2609,8 +2597,8 @@
build_data_name(mlds_data_var(Name)) =
name_mangle(ml_var_name_to_string(Name)).
-build_data_name(mlds_common(Num)) =
- string__format("common_%d", [i(Num)]).
+build_data_name(mlds_scalar_common_ref(_)) =
+ sorry(this_file, "mlds_scalar_common_ref").
build_data_name(mlds_rtti(RttiId0)) = RttiAddrName :-
RttiId = fixup_rtti_id(RttiId0),
rtti__id_to_c_identifier(RttiId, RttiAddrName).
@@ -2625,8 +2613,7 @@
% so we can use get_func_name below
ProcLabel = mlds_proc_label(PredLabel, ProcId),
MaybeSeqNum = no,
- Name = entity_function(PredLabel, ProcId, MaybeSeqNum,
- invalid_pred_id),
+ Name = entity_function(PredLabel, ProcId, MaybeSeqNum, invalid_pred_id),
get_func_name(Name, _FuncName, AsmFuncName),
TablingPointerName = tabling_info_id_str(Id) ++ "_" ++ AsmFuncName.
@@ -3393,26 +3380,24 @@
build_rval(ml_lval(Lval), DefnInfo, Expr) -->
build_lval(Lval, DefnInfo, Expr).
-
build_rval(ml_mkword(Tag, Arg), DefnInfo, Expr) -->
gcc__build_int(Tag, GCC_Tag),
build_rval(Arg, DefnInfo, GCC_Arg),
gcc__build_binop(gcc__plus_expr, gcc__ptr_type_node,
GCC_Arg, GCC_Tag, Expr).
-
build_rval(ml_const(Const), DefnInfo, Expr) -->
build_rval_const(Const, DefnInfo ^ global_info, Expr).
-
build_rval(ml_unop(Op, Rval), DefnInfo, Expr) -->
build_unop(Op, Rval, DefnInfo, Expr).
-
build_rval(ml_binop(Op, Rval1, Rval2), DefnInfo, Expr) -->
build_std_binop(Op, Rval1, Rval2, DefnInfo, Expr).
-
build_rval(ml_mem_addr(Lval), DefnInfo, AddrExpr) -->
build_lval(Lval, DefnInfo, Expr),
gcc__build_addr_expr(Expr, AddrExpr).
-
+build_rval(ml_scalar_common(_), _DefnInfo, _Expr) -->
+ { unexpected(this_file, "scalar_common rval") }.
+build_rval(ml_vector_common_row(_, _), _DefnInfo, _Expr) -->
+ { unexpected(this_file, "vector_common rval") }.
build_rval(ml_self(_), _DefnInfo, _Expr) -->
{ unexpected(this_file, "self rval") }.
@@ -3423,14 +3408,10 @@
build_unop(cast(Type), Rval, DefnInfo, GCC_Expr) -->
build_cast_rval(Type, Rval, DefnInfo, GCC_Expr).
build_unop(box(Type), Rval, DefnInfo, GCC_Expr) -->
- (
- { type_is_float(Type) }
- ->
+ ( { type_is_float(Type) } ->
build_call(gcc__box_float_func_decl, [Rval], DefnInfo,
GCC_Expr)
- ;
- { Type = mlds_array_type(_) }
- ->
+ ; { Type = mlds_array_type(_) } ->
% When boxing arrays, we need to take the address of the array.
% This implies that the array must be an lval.
% But we also allow null arrays as a special case;
@@ -3450,9 +3431,7 @@
build_cast_rval(mlds_generic_type, Rval, DefnInfo, GCC_Expr)
).
build_unop(unbox(Type), Rval, DefnInfo, GCC_Expr) -->
- (
- { type_is_float(Type) }
- ->
+ ( { type_is_float(Type) } ->
% Generate `*(MR_Float *)<Rval>'
build_rval(Rval, DefnInfo, GCC_Pointer),
gcc__build_pointer_type('MR_Float', FloatPointerType),
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.208
diff -u -b -r1.208 mlds_to_il.m
--- compiler/mlds_to_il.m 3 Sep 2009 23:07:27 -0000 1.208
+++ compiler/mlds_to_il.m 20 Sep 2009 10:38:11 -0000
@@ -259,7 +259,12 @@
il_transform_mlds(MLDS0, MLDS),
MLDS = mlds(MercuryModuleName, ForeignCode, Imports, GlobalData, Defns0,
_, _, _),
- ml_global_data_get_all_global_defns(GlobalData, GlobalDefns),
+ ml_global_data_get_all_global_defns(GlobalData,
+ ScalarCellGroupMap, VectorCellGroupMap, GlobalDefns),
+ expect(map.is_empty(ScalarCellGroupMap), this_file,
+ "generate_il: nonempty ScalarCellGroupMap"),
+ expect(map.is_empty(VectorCellGroupMap), this_file,
+ "generate_il: nonempty VectorCellGroupMap"),
Defns = GlobalDefns ++ Defns0,
ModuleName = mercury_module_name_to_mlds(MercuryModuleName),
@@ -369,9 +374,14 @@
list.map(mlds_export_to_mlds_defn, ForeignCodeExports, ExportDefns),
% We take all the definitions out of the global data field of the MLDS.
- ml_global_data_get_all_global_defns(GlobalData0, GlobalDefns),
+ ml_global_data_get_all_global_defns(GlobalData0,
+ ScalarCellGroupMap, VectorCellGroupMap, GlobalDefns),
+ expect(map.is_empty(ScalarCellGroupMap), this_file,
+ "il_transform_mlds: nonempty ScalarCellGroupMap"),
+ expect(map.is_empty(VectorCellGroupMap), this_file,
+ "il_transform_mlds: nonempty VectorCellGroupMap"),
Defns1 = GlobalDefns ++ Defns0 ++ ExportDefns,
- GlobalData = ml_global_data_init,
+ GlobalData = ml_global_data_init(do_not_use_common_cells),
IsFunctionOrData =
(pred(D::in) is semidet :-
@@ -554,9 +564,12 @@
rename_rval(ml_mkword(Tag, Rval)) = ml_mkword(Tag, rename_rval(Rval)).
rename_rval(ml_const(Const)) = ml_const(rename_const(Const)).
rename_rval(ml_unop(Op, Rval)) = ml_unop(Op, rename_rval(Rval)).
-rename_rval(ml_binop(Op, RvalA, RvalB))
- = ml_binop(Op, rename_rval(RvalA), rename_rval(RvalB)).
+rename_rval(ml_binop(Op, RvalA, RvalB)) =
+ ml_binop(Op, rename_rval(RvalA), rename_rval(RvalB)).
rename_rval(ml_mem_addr(Lval)) = ml_mem_addr(rename_lval(Lval)).
+rename_rval(ml_scalar_common(ScalarCommon)) = ml_scalar_common(ScalarCommon).
+rename_rval(ml_vector_common_row(VectorCommon, RowRval)) =
+ ml_vector_common_row(VectorCommon, rename_rval(RowRval)).
rename_rval(ml_self(Type)) = ml_self(Type).
:- func rename_const(mlds_rval_const) = mlds_rval_const.
@@ -947,8 +960,8 @@
predlabel_to_ilds_id(PredLabel, ProcId, MaybeSeqNum, Name).
entity_name_to_ilds_id(entity_type(Name, Arity))
= string.format("%s_%d", [s(Name), i(Arity)]).
-entity_name_to_ilds_id(entity_data(DataName))
- = mangle_dataname(DataName).
+entity_name_to_ilds_id(entity_data(DataName)) = Name :-
+ mangle_dataname(DataName, Name).
:- func interface_id_to_class_name(mlds_interface_id) = ilds.class_name.
@@ -1345,25 +1358,6 @@
CustomDecl = custom_decl(methodref(MethodRef), no, no_initalizer).
%-----------------------------------------------------------------------------%
-
-:- func mangle_dataname(mlds_data_name) = string.
-
-mangle_dataname(mlds_data_var(MLDSVarName))
- = mangle_mlds_var_name(MLDSVarName).
-mangle_dataname(mlds_common(Int))
- = string.format("common_%d", [i(Int)]).
-mangle_dataname(mlds_rtti(RttiId)) = MangledName :-
- rtti.id_to_c_identifier(RttiId, MangledName).
-mangle_dataname(mlds_module_layout) = _MangledName :-
- unexpected(this_file, "unimplemented: mangling mlds_module_layout").
-mangle_dataname(mlds_proc_layout(_)) = _MangledName :-
- unexpected(this_file, "unimplemented: mangling mlds_proc_layout").
-mangle_dataname(mlds_internal_layout(_, _)) = _MangledName :-
- unexpected(this_file, "unimplemented: mangling mlds_internal_layout").
-mangle_dataname(mlds_tabling_ref(_, _)) = _MangledName :-
- unexpected(this_file, "unimplemented: mangling mlds_tabling_ref").
-
-%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% MLDS exports are converted into forwarding functions, which are
@@ -2313,7 +2307,9 @@
:- pred load(mlds_rval::in, instr_tree::out, il_info::in, il_info::out) is det.
-load(ml_lval(Lval), Instrs, !Info) :-
+load(Rval, Instrs, !Info) :-
+ (
+ Rval = ml_lval(Lval),
DataRep = !.Info ^ il_data_rep,
(
Lval = ml_var(Var, VarType),
@@ -2329,8 +2325,9 @@
Instrs = singleton(ldsfld(FieldRef))
)
;
- Lval = ml_field(_MaybeTag, Rval, FieldNum, FieldType, ClassType),
- load(Rval, RvalLoadInstrs, !Info),
+ Lval = ml_field(_MaybeTag, BaseRval, FieldNum, FieldType,
+ ClassType),
+ load(BaseRval, BaseRvalLoadInstrs, !Info),
( FieldNum = ml_field_offset(OffSet) ->
SimpleFieldType = mlds_type_to_ilds_simple_type(DataRep,
FieldType),
@@ -2344,26 +2341,26 @@
OffSetLoadInstrs = empty
),
Instrs =
- RvalLoadInstrs ++
+ BaseRvalLoadInstrs ++
CastClassInstrs ++
OffSetLoadInstrs ++
singleton(LoadInstruction)
;
- Lval = ml_mem_ref(Rval, MLDS_Type),
+ Lval = ml_mem_ref(BaseRval, MLDS_Type),
SimpleType = mlds_type_to_ilds_simple_type(DataRep, MLDS_Type),
- load(Rval, RvalLoadInstrs, !Info),
- Instrs = RvalLoadInstrs ++ singleton(ldind(SimpleType))
+ load(BaseRval, BaseRvalLoadInstrs, !Info),
+ Instrs = BaseRvalLoadInstrs ++ singleton(ldind(SimpleType))
;
Lval = ml_global_var_ref(_),
Instrs = throw_unimplemented("load lval mem_ref")
- ).
-
-load(ml_mkword(_Tag, _Rval), Instrs, !Info) :-
- Instrs = comment_node("unimplemented load rval mkword").
-
+ )
+ ;
+ Rval = ml_mkword(_Tag, _Rval),
+ Instrs = comment_node("unimplemented load rval mkword")
+ ;
+ Rval = ml_const(Const),
% XXX check these, what should we do about multi strings,
% characters, etc.
-load(ml_const(Const), Instrs, !Info) :-
DataRep = !.Info ^ il_data_rep,
% True and false are just the integers 1 and 0.
(
@@ -2402,20 +2399,20 @@
Const = mlconst_null(_MLDSType),
% We might consider loading an integer for null function types.
Instrs = singleton(ldnull)
- ).
-
-load(ml_unop(Unop, Rval), Instrs, !Info) :-
- load(Rval, RvalLoadInstrs, !Info),
- unaryop_to_il(Unop, Rval, UnOpInstrs, !Info),
- Instrs = RvalLoadInstrs ++ UnOpInstrs.
-
-load(ml_binop(BinOp, R1, R2), Instrs, !Info) :-
- load(R1, R1LoadInstrs, !Info),
- load(R2, R2LoadInstrs, !Info),
+ )
+ ;
+ Rval = ml_unop(Unop, RvalA),
+ load(RvalA, RvalALoadInstrs, !Info),
+ unaryop_to_il(Unop, RvalA, UnOpInstrs, !Info),
+ Instrs = RvalALoadInstrs ++ UnOpInstrs
+ ;
+ Rval = ml_binop(BinOp, RvalA, RvalB),
+ load(RvalA, RvalALoadInstrs, !Info),
+ load(RvalB, RvalBLoadInstrs, !Info),
binaryop_to_il(BinOp, BinaryOpInstrs, !Info),
- Instrs = R1LoadInstrs ++ R2LoadInstrs ++ BinaryOpInstrs.
-
-load(ml_mem_addr(Lval), Instrs, !Info) :-
+ Instrs = RvalALoadInstrs ++ RvalBLoadInstrs ++ BinaryOpInstrs
+ ;
+ Rval = ml_mem_addr(Lval),
DataRep = !.Info ^ il_data_rep,
(
Lval = ml_var(Var, VarType),
@@ -2431,12 +2428,13 @@
Instrs = singleton(ldsfld(FieldRef))
)
;
- Lval = ml_field(_MaybeTag, Rval, FieldNum, FieldType, ClassType),
+ Lval = ml_field(_MaybeTag, BaseRval, FieldNum, FieldType,
+ ClassType),
get_fieldref(DataRep, FieldNum, FieldType, ClassType,
FieldRef, CastClassInstrs),
- load(Rval, RvalLoadInstrs, !Info),
+ load(BaseRval, BaseRvalLoadInstrs, !Info),
Instrs =
- RvalLoadInstrs ++
+ BaseRvalLoadInstrs ++
CastClassInstrs ++
singleton(ldflda(FieldRef))
;
@@ -2446,15 +2444,24 @@
;
Lval = ml_global_var_ref(_),
Instrs = throw_unimplemented("load mem_addr lval global_var_ref")
+ )
+ ;
+ Rval = ml_scalar_common(_),
+ Instrs = throw_unimplemented("load scalar_common")
+ ;
+ Rval = ml_vector_common_row(_, _),
+ Instrs = throw_unimplemented("load vector_common_row")
+ ;
+ Rval = ml_self(_),
+ Instrs = singleton(ldarg(index(0)))
).
-load(ml_self(_), singleton(ldarg(index(0))), !Info).
-
:- pred store(mlds_lval::in, instr_tree::out, il_info::in, il_info::out)
is det.
-store(ml_field(_MaybeTag, Rval, FieldNum, FieldType, ClassType), Instrs,
- !Info) :-
+store(Lval, Instrs, !Info) :-
+ (
+ Lval = ml_field(_MaybeTag, Rval, FieldNum, FieldType, ClassType),
DataRep = !.Info ^ il_data_rep,
get_fieldref(DataRep, FieldNum, FieldType, ClassType,
FieldRef, CastClassInstrs),
@@ -2462,17 +2469,17 @@
Instrs =
CastClassInstrs ++
RvalLoadInstrs ++
- singleton(stfld(FieldRef)).
-
-store(ml_mem_ref(_Rval, _Type), _Instrs, !Info) :-
- % You always need load the reference first, then the value, then stind it.
- % There's no swap instruction. Annoying, eh?
- unexpected(this_file, "store into mem_ref").
-
-store(ml_global_var_ref(_), _Instrs, !Info) :-
- unexpected(this_file, "store into global_var_ref").
-
-store(ml_var(Var, VarType), Instrs, !Info) :-
+ singleton(stfld(FieldRef))
+ ;
+ Lval = ml_mem_ref(_Rval, _Type),
+ % You always need load the reference first, then the value,
+ % then stind it. There's no swap instruction. Annoying, eh?
+ unexpected(this_file, "store into mem_ref")
+ ;
+ Lval = ml_global_var_ref(_),
+ unexpected(this_file, "store into global_var_ref")
+ ;
+ Lval = ml_var(Var, VarType),
DataRep = !.Info ^ il_data_rep,
mangle_mlds_var(Var, MangledVarStr),
( is_local(MangledVarStr, !.Info) ->
@@ -2482,11 +2489,12 @@
;
FieldRef = make_static_fieldref(DataRep, Var, VarType),
Instrs = singleton(stsfld(FieldRef))
+ )
).
%-----------------------------------------------------------------------------%
%
-% Convert binary and unary operations to IL
+% Convert binary and unary operations to IL.
%
:- pred unaryop_to_il(mlds_unary_op::in, mlds_rval::in, instr_tree::out,
@@ -3521,20 +3529,29 @@
:- pred mangle_dataname(mlds_data_name::in, string::out) is det.
-mangle_dataname(mlds_data_var(MLDSVarName), Name) :-
- Name = mangle_mlds_var_name(MLDSVarName).
-mangle_dataname(mlds_common(Int), MangledName) :-
- string.format("common_%d", [i(Int)], MangledName).
-mangle_dataname(mlds_rtti(RttiId), MangledName) :-
- rtti.id_to_c_identifier(RttiId, MangledName).
-mangle_dataname(mlds_module_layout, _MangledName) :-
- sorry(this_file, "unimplemented: mangling mlds_module_layout").
-mangle_dataname(mlds_proc_layout(_), _MangledName) :-
- sorry(this_file, "unimplemented: mangling mlds_proc_layout").
-mangle_dataname(mlds_internal_layout(_, _), _MangledName) :-
- sorry(this_file, "unimplemented: mangling mlds_internal_layout").
-mangle_dataname(mlds_tabling_ref(_, _), _MangledName) :-
- sorry(this_file, "unimplemented: mangling mlds_tabling_ref").
+mangle_dataname(DataName, Name) :-
+ (
+ DataName = mlds_data_var(MLDSVarName),
+ Name = mangle_mlds_var_name(MLDSVarName)
+ ;
+ DataName = mlds_scalar_common_ref(_),
+ sorry(this_file, "unimplemented: mangling mlds_scalar_common_ref")
+ ;
+ DataName = mlds_rtti(RttiId),
+ rtti.id_to_c_identifier(RttiId, Name)
+ ;
+ DataName = mlds_module_layout,
+ sorry(this_file, "unimplemented: mangling mlds_module_layout")
+ ;
+ DataName = mlds_proc_layout(_),
+ sorry(this_file, "unimplemented: mangling mlds_proc_layout")
+ ;
+ DataName = mlds_internal_layout(_, _),
+ sorry(this_file, "unimplemented: mangling mlds_internal_layout")
+ ;
+ DataName = mlds_tabling_ref(_, _),
+ sorry(this_file, "unimplemented: mangling mlds_tabling_ref")
+ ).
% We turn procedures into methods of classes.
mangle_mlds_proc_label(qual(ModuleName, _, mlds_proc_label(PredLabel, ProcId)),
@@ -3711,6 +3728,10 @@
sorry(this_file, "rval_to_type: binop").
rval_to_type(ml_mem_addr(_), _) :-
sorry(this_file, "rval_to_type: mem_addr").
+rval_to_type(ml_scalar_common(ScalarCommon), Type) :-
+ ScalarCommon = ml_scalar_common(_, Type, _, _).
+rval_to_type(ml_vector_common_row(VectorCommon, _), Type) :-
+ VectorCommon = ml_vector_common(_, Type, _, _, _).
rval_to_type(ml_self(Type), Type).
rval_to_type(ml_const(Const), Type) :-
Type = rval_const_to_type(Const).
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.140
diff -u -b -r1.140 mlds_to_java.m
--- compiler/mlds_to_java.m 14 Sep 2009 07:10:55 -0000 1.140
+++ compiler/mlds_to_java.m 19 Sep 2009 16:52:35 -0000
@@ -337,7 +337,12 @@
% Run further transformations on the MLDS.
MLDS = mlds(ModuleName, AllForeignCode, Imports, GlobalData, Defns0,
InitPreds, FinalPreds, ExportedEnums),
- ml_global_data_get_all_global_defns(GlobalData, GlobalDefns),
+ ml_global_data_get_all_global_defns(GlobalData,
+ ScalarCellGroupMap, VectorCellGroupMap, GlobalDefns),
+ expect(map.is_empty(ScalarCellGroupMap), this_file,
+ "output_java_src_file: nonempty ScalarCellGroupMap"),
+ expect(map.is_empty(VectorCellGroupMap), this_file,
+ "output_java_src_file: nonempty VectorCellGroupMap"),
% Do NOT enforce the outermost "mercury" qualifier here. This module
% name is compared with other module names in the MLDS, to avoid
@@ -770,9 +775,12 @@
).
method_ptrs_in_rval(ml_unop(_UnaryOp, Rval), !CodeAddrs) :-
method_ptrs_in_rval(Rval, !CodeAddrs).
-method_ptrs_in_rval(ml_binop(_BinaryOp, Rval1, Rval2), !CodeAddrs) :-
- method_ptrs_in_rval(Rval1, !CodeAddrs),
- method_ptrs_in_rval(Rval2, !CodeAddrs).
+method_ptrs_in_rval(ml_binop(_BinaryOp, RvalA, RvalB), !CodeAddrs) :-
+ method_ptrs_in_rval(RvalA, !CodeAddrs),
+ method_ptrs_in_rval(RvalB, !CodeAddrs).
+method_ptrs_in_rval(ml_scalar_common(_), !CodeAddrs).
+method_ptrs_in_rval(ml_vector_common_row(_, RowRval), !CodeAddrs) :-
+ method_ptrs_in_rval(RowRval, !CodeAddrs).
method_ptrs_in_rval(ml_mem_addr(_Address), !CodeAddrs).
method_ptrs_in_rval(ml_self(_Type), !CodeAddrs).
@@ -1007,7 +1015,8 @@
Args0, Args) :-
ArrayRval = ml_lval(ml_var(ArrayVar, mlds_native_int_type)),
IndexRval = ml_const(mlconst_int(Counter)),
- Rval = ml_binop(array_index(elem_type_generic), ArrayRval, IndexRval),
+ ElemType = array_elem_scalar(scalar_elem_generic),
+ Rval = ml_binop(array_index(ElemType), ArrayRval, IndexRval),
UnBoxedRval = ml_unop(unbox(Type), Rval),
Args1 = Args0 ++ [UnBoxedRval],
generate_call_method_array_args(Types, ArrayVar, Counter + 1, Args1, Args).
@@ -1511,6 +1520,12 @@
rename_class_names_lval(Renaming, Lval0, Lval),
!:Rval = ml_mem_addr(Lval)
;
+ !.Rval = ml_scalar_common(_)
+ ;
+ !.Rval = ml_vector_common_row(VectorCommon, RowRval0),
+ rename_class_names_rval(Renaming, RowRval0, RowRval),
+ !:Rval = ml_vector_common_row(VectorCommon, RowRval)
+ ;
!.Rval = ml_self(Type0),
rename_class_names_type(Renaming, Type0, Type),
!:Rval = ml_self(Type)
@@ -2674,9 +2689,8 @@
output_data_name(mlds_data_var(VarName), !IO) :-
output_mlds_var_name(VarName, !IO).
-output_data_name(mlds_common(Num), !IO) :-
- io.write_string("common_", !IO),
- io.write_int(Num, !IO).
+output_data_name(mlds_scalar_common_ref(_), !IO) :-
+ unexpected(this_file, "NYI: mlds_scalar_common_ref").
output_data_name(mlds_rtti(RttiId), !IO) :-
rtti.id_to_c_identifier(RttiId, RttiAddrName),
io.write_string(RttiAddrName, !IO).
@@ -3981,6 +3995,12 @@
Rval = ml_lval(Lval),
output_lval(ModuleInfo, Lval, ModuleName, !IO)
;
+ Rval = ml_scalar_common(_),
+ unexpected(this_file, "output_rval: ml_scalar_common")
+ ;
+ Rval = ml_vector_common_row(_, _),
+ unexpected(this_file, "output_rval: ml_vector_common_row")
+ ;
Rval = ml_mkword(_, _),
unexpected(this_file, "output_rval: tags not supported in Java")
;
Index: compiler/mlds_to_managed.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_managed.m,v
retrieving revision 1.51
diff -u -b -r1.51 mlds_to_managed.m
--- compiler/mlds_to_managed.m 2 Sep 2009 00:30:21 -0000 1.51
+++ compiler/mlds_to_managed.m 20 Sep 2009 05:05:06 -0000
@@ -68,7 +68,12 @@
output_csharp_code(Globals, MLDS, !IO) :-
MLDS = mlds(ModuleName, AllForeignCode, _Imports, GlobalData, Defns0,
_InitPreds, _FinalPreds, _ExportedEnums),
- ml_global_data_get_all_global_defns(GlobalData, GlobalDefns),
+ ml_global_data_get_all_global_defns(GlobalData,
+ ScalarCellGroupMap, VectorCellGroupMap, GlobalDefns),
+ expect(map.is_empty(ScalarCellGroupMap), this_file,
+ "output_csharp_code: nonempty ScalarCellGroupMap"),
+ expect(map.is_empty(VectorCellGroupMap), this_file,
+ "output_csharp_code: nonempty VectorCellGroupMap"),
Defns = GlobalDefns ++ Defns0,
output_src_start(ModuleName, !IO),
@@ -322,7 +327,7 @@
write_outline_arg_init(DataRep, OutlineArg, !IO) :-
(
- OutlineArg = in(Type, VarName, Rval),
+ OutlineArg = ola_in(Type, VarName, Rval),
write_parameter_type(DataRep, Type, !IO),
io.write_string(" ", !IO),
io.write_string(VarName, !IO),
@@ -330,7 +335,7 @@
write_rval(DataRep, Rval, !IO),
io.write_string(";\n", !IO)
;
- OutlineArg = out(Type, VarName, _Lval),
+ OutlineArg = ola_out(Type, VarName, _Lval),
write_parameter_type(DataRep, Type, !IO),
io.write_string(" ", !IO),
io.write_string(VarName, !IO),
@@ -339,7 +344,7 @@
write_parameter_initializer(DataRep, Type, !IO),
io.write_string(";\n", !IO)
;
- OutlineArg = unused
+ OutlineArg = ola_unused
).
:- pred write_outline_arg_final(il_data_rep::in, outline_arg::in,
@@ -347,15 +352,15 @@
write_outline_arg_final(DataRep, OutlineArg, !IO) :-
(
- OutlineArg = in(_, _, _)
+ OutlineArg = ola_in(_, _, _)
;
- OutlineArg = out(_Type, VarName, Lval),
+ OutlineArg = ola_out(_Type, VarName, Lval),
write_lval(DataRep, Lval, !IO),
io.write_string(" = ", !IO),
io.write_string(VarName, !IO),
io.write_string(";\n", !IO)
;
- OutlineArg = unused
+ OutlineArg = ola_unused
).
:- pred write_assign_local_to_output(mlds_argument::in, io::di, io::uo) is det.
@@ -446,6 +451,12 @@
sorry(this_file, "binop rval")
)
;
+ Rval = ml_scalar_common(_),
+ sorry(this_file, "scalar_common rval")
+ ;
+ Rval = ml_vector_common_row(_, _),
+ sorry(this_file, "vector_common_row rval")
+ ;
Rval = ml_mem_addr(_),
sorry(this_file, "mem_addr rval")
;
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.209
diff -u -b -r1.209 opt_debug.m
--- compiler/opt_debug.m 5 Jan 2009 01:28:49 -0000 1.209
+++ compiler/opt_debug.m 20 Sep 2009 06:38:44 -0000
@@ -792,9 +792,9 @@
Instr = goto(CodeAddr),
Str = "goto " ++ dump_code_addr(MaybeProcLabel, CodeAddr)
;
- Instr = computed_goto(Rval, Labels),
+ Instr = computed_goto(Rval, MaybeLabels),
Str = "computed_goto " ++ dump_rval(MaybeProcLabel, Rval) ++ ":"
- ++ dump_labels_or_not_reached(MaybeProcLabel, Labels)
+ ++ dump_labels_or_not_reached(MaybeProcLabel, MaybeLabels)
;
Instr = arbitrary_c_code(AL, _, Code),
Str = "arbitrary_c_code(" ++ dump_affects_liveness(AL) ++ "\n" ++
Index: compiler/reassign.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/reassign.m,v
retrieving revision 1.28
diff -u -b -r1.28 reassign.m
--- compiler/reassign.m 3 Sep 2008 03:32:18 -0000 1.28
+++ compiler/reassign.m 20 Sep 2009 06:38:44 -0000
@@ -193,14 +193,9 @@
!:KnownContentsMap = map.init,
!:DepLvalMap = map.init
;
- Uinstr0 = goto(_),
- !:RevInstrs = [Instr0 | !.RevInstrs],
- % The value of !:KnownContentsMap doesn't really matter since the next
- % instruction (which must be a label) will reset it to empty anyway.
- !:KnownContentsMap = map.init,
- !:DepLvalMap = map.init
- ;
- Uinstr0 = computed_goto(_, _),
+ ( Uinstr0 = goto(_)
+ ; Uinstr0 = computed_goto(_, _)
+ ),
!:RevInstrs = [Instr0 | !.RevInstrs],
% The value of !:KnownContentsMap doesn't really matter since the next
% instruction (which must be a label) will reset it to empty anyway.
Index: compiler/rtti_to_mlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.90
diff -u -b -r1.90 rtti_to_mlds.m
--- compiler/rtti_to_mlds.m 2 Sep 2009 00:30:23 -0000 1.90
+++ compiler/rtti_to_mlds.m 20 Sep 2009 06:38:44 -0000
@@ -1721,6 +1721,11 @@
Rval = ml_mem_addr(Lval),
add_rtti_defn_arcs_lval(DefnDataName, Lval, !Graph)
;
+ Rval = ml_scalar_common(_)
+ ;
+ Rval = ml_vector_common_row(_, RowRval),
+ add_rtti_defn_arcs_rval(DefnDataName, RowRval, !Graph)
+ ;
Rval = ml_self(_)
).
@@ -1751,7 +1756,7 @@
digraph.add_vertices_and_edge(DefnDataName, DataName, !Graph)
;
( DataName = mlds_data_var(_)
- ; DataName = mlds_common(_)
+ ; DataName = mlds_scalar_common_ref(_)
; DataName = mlds_module_layout
; DataName = mlds_proc_layout(_)
; DataName = mlds_internal_layout(_, _)
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.146
diff -u -b -r1.146 stack_layout.m
--- compiler/stack_layout.m 3 Sep 2009 23:07:30 -0000 1.146
+++ compiler/stack_layout.m 10 Sep 2009 00:36:42 -0000
@@ -1087,7 +1087,7 @@
MaybeVarNum = yes(VarNum)
;
MaybeAttr = no,
- LocnRvalAndType = const(llconst_int(0)) - unsigned,
+ LocnRvalAndType = const(llconst_int(0)) - lt_unsigned,
MaybeVarNum = no
),
construct_user_data_array(VarNumMap, MaybeAttrs, LocnRvalAndTypes,
@@ -1131,7 +1131,7 @@
construct_type_param_locn_vector(TVarLocns, 1, TypeParamLocs),
list.length(TypeParamLocs, TypeParamsLength),
LengthRval = const(llconst_int(TypeParamsLength)),
- Vector = [LengthRval - unsigned | TypeParamLocs].
+ Vector = [LengthRval - lt_unsigned | TypeParamLocs].
%---------------------------------------------------------------------------%
@@ -1229,12 +1229,12 @@
),
represent_locn_as_int_rval(Locn, Rval),
construct_type_param_locn_vector(TVarLocns, NextSlot, VectorTail),
- Vector = [Rval - unsigned | VectorTail]
+ Vector = [Rval - lt_unsigned | VectorTail]
; TVarNum > CurSlot ->
construct_type_param_locn_vector([TVar - Locns | TVarLocns], NextSlot,
VectorTail),
% This slot will never be referred to.
- Vector = [const(llconst_int(0)) - unsigned | VectorTail]
+ Vector = [const(llconst_int(0)) - lt_unsigned | VectorTail]
;
unexpected(this_file,
"unsorted tvars in construct_type_param_locn_vector")
@@ -1290,9 +1290,9 @@
list.map(SelectTypes, AllArrayInfo, AllTypeRvalsTypes),
list.map(SelectLocns, IntArrayInfo, IntLocns),
- list.map(associate_type(unsigned), IntLocns, IntLocnsTypes),
+ list.map(associate_type(lt_unsigned), IntLocns, IntLocnsTypes),
list.map(SelectLocns, ByteArrayInfo, ByteLocns),
- list.map(associate_type(uint_least8), ByteLocns, ByteLocnsTypes),
+ list.map(associate_type(lt_uint_least8), ByteLocns, ByteLocnsTypes),
list.append(IntLocnsTypes, ByteLocnsTypes, AllLocnsTypes),
list.append(AllTypeRvalsTypes, AllLocnsTypes, TypeLocnVectorRvalsTypes),
get_layout_static_cell_info(!.Info, StaticCellInfo0),
@@ -1306,7 +1306,8 @@
TraceStackLayout = yes,
list.foldl(AddRevNums, AllArrayInfo, [], RevVarNumRvals),
list.reverse(RevVarNumRvals, VarNumRvals),
- list.map(associate_type(uint_least16), VarNumRvals, VarNumRvalsTypes),
+ list.map(associate_type(lt_uint_least16), VarNumRvals,
+ VarNumRvalsTypes),
get_layout_static_cell_info(!.Info, StaticCellInfo2),
add_scalar_static_cell(VarNumRvalsTypes, NumVectorAddr,
StaticCellInfo2, StaticCellInfo),
@@ -1400,12 +1401,12 @@
closure_proc_id(CallerProcLabel, SeqNo, ClosureProcLabel)),
Data = closure_proc_id_data(CallerProcLabel, SeqNo, ClosureProcLabel,
ModuleName, FileName, LineNumber, Origin, GoalPath),
- ProcIdRvalType = const(llconst_data_addr(DataAddr, no)) - data_ptr,
+ ProcIdRvalType = const(llconst_data_addr(DataAddr, no)) - lt_data_ptr,
ClosureLayoutInfo = closure_layout_info(ClosureArgs, TVarLocnMap),
construct_closure_arg_rvals(ClosureArgs,
ClosureArgRvalsTypes, !StaticCellInfo),
construct_tvar_vector(TVarLocnMap, TVarVectorRval, !StaticCellInfo),
- RvalsTypes = [ProcIdRvalType, TVarVectorRval - data_ptr |
+ RvalsTypes = [ProcIdRvalType, TVarVectorRval - lt_data_ptr |
ClosureArgRvalsTypes].
:- pred construct_closure_arg_rvals(list(closure_arg_info)::in,
@@ -1418,7 +1419,7 @@
!StaticCellInfo),
list.length(ArgRvalsTypes, Length),
ClosureArgRvalsTypes =
- [const(llconst_int(Length)) - integer | ArgRvalsTypes].
+ [const(llconst_int(Length)) - lt_integer | ArgRvalsTypes].
:- pred construct_closure_arg_rval(closure_arg_info::in,
pair(rval, llds_type)::out,
@@ -1508,23 +1509,23 @@
:- pred represent_live_value_type(live_value_type::in, rval::out,
llds_type::out, stack_layout_info::in, stack_layout_info::out) is det.
-represent_live_value_type(live_value_succip, Rval, data_ptr, !Info) :-
+represent_live_value_type(live_value_succip, Rval, lt_data_ptr, !Info) :-
represent_special_live_value_type("succip", Rval).
-represent_live_value_type(live_value_hp, Rval, data_ptr, !Info) :-
+represent_live_value_type(live_value_hp, Rval, lt_data_ptr, !Info) :-
represent_special_live_value_type("hp", Rval).
-represent_live_value_type(live_value_curfr, Rval, data_ptr, !Info) :-
+represent_live_value_type(live_value_curfr, Rval, lt_data_ptr, !Info) :-
represent_special_live_value_type("curfr", Rval).
-represent_live_value_type(live_value_maxfr, Rval, data_ptr, !Info) :-
+represent_live_value_type(live_value_maxfr, Rval, lt_data_ptr, !Info) :-
represent_special_live_value_type("maxfr", Rval).
-represent_live_value_type(live_value_redofr, Rval, data_ptr, !Info) :-
+represent_live_value_type(live_value_redofr, Rval, lt_data_ptr, !Info) :-
represent_special_live_value_type("redofr", Rval).
-represent_live_value_type(live_value_redoip, Rval, data_ptr, !Info) :-
+represent_live_value_type(live_value_redoip, Rval, lt_data_ptr, !Info) :-
represent_special_live_value_type("redoip", Rval).
-represent_live_value_type(live_value_trail_ptr, Rval, data_ptr, !Info) :-
+represent_live_value_type(live_value_trail_ptr, Rval, lt_data_ptr, !Info) :-
represent_special_live_value_type("trail_ptr", Rval).
-represent_live_value_type(live_value_ticket, Rval, data_ptr, !Info) :-
+represent_live_value_type(live_value_ticket, Rval, lt_data_ptr, !Info) :-
represent_special_live_value_type("ticket", Rval).
-represent_live_value_type(RegionType, Rval, data_ptr, !Info) :-
+represent_live_value_type(RegionType, Rval, lt_data_ptr, !Info) :-
( RegionType = live_value_region_ite
; RegionType = live_value_region_disj
; RegionType = live_value_region_commit
@@ -1532,7 +1533,7 @@
% Neither the garbage collector nor the debugger need info about
% regions.
represent_special_live_value_type("unwanted", Rval).
-represent_live_value_type(live_value_unwanted, Rval, data_ptr, !Info) :-
+represent_live_value_type(live_value_unwanted, Rval, lt_data_ptr, !Info) :-
represent_special_live_value_type("unwanted", Rval).
represent_live_value_type(live_value_var(_, _, Type, _), Rval, LldsType,
!Info) :-
@@ -1564,7 +1565,7 @@
(
LvalOrConst = lval(Lval),
represent_locn_as_int_rval(locn_direct(Lval), Rval),
- Type = unsigned
+ Type = lt_unsigned
;
LvalOrConst = const(_Const),
get_unboxed_floats(!.Info, UnboxedFloats),
@@ -1575,7 +1576,7 @@
StaticCellInfo0, StaticCellInfo),
set_layout_static_cell_info(StaticCellInfo, !Info),
Rval = const(llconst_data_addr(DataAddr, no)),
- Type = data_ptr
+ Type = lt_data_ptr
;
LvalOrConst = mkword(Tag, LvalOrConstBase),
represent_locn_or_const_as_int_rval(LvalOrConstBase, BaseRval, Type,
Index: compiler/string_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/string_switch.m,v
retrieving revision 1.65
diff -u -b -r1.65 string_switch.m
--- compiler/string_switch.m 6 Jan 2009 03:56:27 -0000 1.65
+++ compiler/string_switch.m 20 Sep 2009 07:14:07 -0000
@@ -66,8 +66,10 @@
% allows the code of the cases to make use of them.
acquire_reg(reg_r, SlotReg, !CI),
+ acquire_reg(reg_r, RowReg, !CI),
acquire_reg(reg_r, StringReg, !CI),
release_reg(SlotReg, !CI),
+ release_reg(RowReg, !CI),
release_reg(StringReg, !CI),
get_next_label(LoopLabel, !CI),
@@ -104,7 +106,7 @@
% Generate the data structures for the hash table.
gen_string_hash_slots(0, TableSize, HashSlotsMap, FailLabel,
- Strings, NextSlots, Targets),
+ TableRows, Targets),
% Generate the code for the cases.
map.foldl(add_remaining_case, CaseLabelMap, empty, CasesCode),
@@ -113,11 +115,11 @@
),
% Generate the code for the hash table lookup.
- % XXX We should be using one vector cell, not two scalar cells.
- add_scalar_static_cell_natural_types(NextSlots, NextSlotsTableAddr, !CI),
- add_scalar_static_cell_natural_types(Strings, StringTableAddr, !CI),
- NextSlotsTable = const(llconst_data_addr(NextSlotsTableAddr, no)),
- StringTable = const(llconst_data_addr(StringTableAddr, no)),
+ RowElemTypes = [lt_string, lt_integer],
+ add_vector_static_cell(RowElemTypes, TableRows, TableAddr, !CI),
+ ArrayElemTypes = [scalar_elem_string, scalar_elem_int],
+ ArrayElemType = array_elem_struct(ArrayElemTypes),
+ TableAddrRval = const(llconst_data_addr(TableAddr, no)),
HashLookupCode = from_list([
llds_instr(comment("hashed string switch"), ""),
llds_instr(assign(SlotReg,
@@ -125,17 +127,21 @@
const(llconst_int(HashMask)))),
"compute the hash value of the input string"),
llds_instr(label(LoopLabel), "begin hash chain loop"),
+ llds_instr(assign(RowReg,
+ binop(int_mul, lval(SlotReg), const(llconst_int(2)))),
+ "find the start of the row"),
llds_instr(assign(StringReg,
- binop(array_index(elem_type_string),
- StringTable, lval(SlotReg))),
+ binop(array_index(ArrayElemType),
+ TableAddrRval, lval(RowReg))),
"lookup the string for this hash slot"),
llds_instr(if_val(binop(logical_and, lval(StringReg),
binop(str_eq, lval(StringReg), VarRval)),
code_label(JumpLabel)),
"did we find a match?"),
llds_instr(assign(SlotReg,
- binop(array_index(elem_type_int),
- NextSlotsTable, lval(SlotReg))),
+ binop(array_index(ArrayElemType),
+ TableAddrRval,
+ binop(int_add, lval(RowReg), const(llconst_int(1))))),
"not yet, so get next slot in hash chain"),
llds_instr(
if_val(binop(int_ge, lval(SlotReg), const(llconst_int(0))),
@@ -144,6 +150,19 @@
llds_instr(label(FailLabel), "no match, so fail")
]),
+ % XXX The generated code would be faster (due to better locality)
+ % if we included the target addresses in the main table. Unfortunately,
+ % that would require two extensions to the LLDS. The first and relatively
+ % easy change would be a new LLDS instruction that represents a goto
+ % to an arbitrary rval (in this case, the rval taken from the selected
+ % table row). The second and substantially harder change would be making
+ % the internal labels of the switch arms actually storable in static data.
+ % We do not currently have any way to refer to internal labels from data,
+ % and optimizations that manipulate labels (such as frameopt, which can
+ % duplicate them, and dupelim, which can replace them with other labels)
+ % would have to be taught to reflect any changes they make in the global
+ % data. It is the last step that is the killer in the terms of difficulty
+ % of implementation.
JumpCode = from_list([
llds_instr(label(JumpLabel), "we found a match"),
llds_instr(computed_goto(lval(SlotReg), Targets),
@@ -154,26 +173,25 @@
:- pred gen_string_hash_slots(int::in, int::in,
map(int, string_hash_slot(label))::in, label::in,
- list(rval)::out, list(rval)::out, list(maybe(label))::out) is det.
+ list(list(rval))::out, list(maybe(label))::out) is det.
gen_string_hash_slots(Slot, TableSize, HashSlotMap, FailLabel,
- Strings, NextSlots, Targets) :-
+ TableRows, MaybeTargets) :-
( Slot = TableSize ->
- Strings = [],
- NextSlots = [],
- Targets = []
+ TableRows = [],
+ MaybeTargets = []
;
gen_string_hash_slot(Slot, HashSlotMap, FailLabel,
- String, NextSlot, Target),
+ StringRval, NextSlotRval, Target),
gen_string_hash_slots(Slot + 1, TableSize, HashSlotMap, FailLabel,
- TailStrings, TailNextSlots, TailTargets),
- Strings = [String | TailStrings],
- NextSlots = [NextSlot | TailNextSlots],
- Targets = [Target | TailTargets]
+ TailTableRows, TailMaybeTargets),
+ HeadTableRow = [StringRval, NextSlotRval],
+ TableRows = [HeadTableRow | TailTableRows],
+ MaybeTargets = [yes(Target) | TailMaybeTargets]
).
:- pred gen_string_hash_slot(int::in, map(int, string_hash_slot(label))::in,
- label::in, rval::out, rval::out, maybe(label)::out) is det.
+ label::in, rval::out, rval::out, label::out) is det.
gen_string_hash_slot(Slot, HashSlotMap, FailLabel,
StringRval, NextSlotRval, Target) :-
@@ -181,11 +199,11 @@
SlotInfo = string_hash_slot(Next, String, CaseLabel),
NextSlotRval = const(llconst_int(Next)),
StringRval = const(llconst_string(String)),
- Target = yes(CaseLabel)
+ Target = CaseLabel
;
StringRval = const(llconst_int(0)),
NextSlotRval = const(llconst_int(-2)),
- Target = yes(FailLabel)
+ Target = FailLabel
).
:- pred this_is_last_case(int::in, int::in,
Index: compiler/switch_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_gen.m,v
retrieving revision 1.112
diff -u -b -r1.112 switch_gen.m
--- compiler/switch_gen.m 4 Sep 2009 02:27:55 -0000 1.112
+++ compiler/switch_gen.m 10 Sep 2009 08:41:11 -0000
@@ -133,20 +133,35 @@
(
MaybeIntSwitchInfo =
int_switch(LowerLimit, UpperLimit, NumValues),
+ % Since lookup switches rely on static ground terms to work
+ % efficiently, there is no point in using a lookup switch
+ % if static ground terms are not enabled. Well, actually,
+ % it is possible that they might be a win in some
+ % circumstances, but it would take a pretty complex heuristic
+ % to get it right, so, lets just use a simple one - no static
+ % ground terms, no lookup switch.
+ globals.lookup_bool_option(Globals, static_ground_cells, yes),
+
+ % Lookup switches do not generate trace events.
get_maybe_trace_info(!.CI, MaybeTraceInfo),
MaybeTraceInfo = no,
+
globals.lookup_int_option(Globals, lookup_switch_size,
LookupSize),
NumConsIds >= LookupSize,
NumArms > 1,
globals.lookup_int_option(Globals, lookup_switch_req_density,
ReqDensity),
- is_lookup_switch(VarType, TaggedCases, LowerLimit, UpperLimit,
- NumValues, GoalInfo, CanFail, ReqDensity, StoreMap,
- no, MaybeEndPrime, CodeModel, LookupSwitchInfo, !CI)
+ find_lookup_switch_params(ModuleInfo, VarType, CodeModel,
+ CanFail, TaggedCases, FilteredTaggedCases,
+ LowerLimit, UpperLimit, NumValues, ReqDensity,
+ NeedBitVecCheck, NeedRangeCheck, FirstVal, LastVal),
+ is_lookup_switch(FilteredTaggedCases, GoalInfo, StoreMap,
+ no, MaybeEndPrime, LookupSwitchInfo, !CI)
->
MaybeEnd = MaybeEndPrime,
generate_lookup_switch(VarRval, StoreMap, no, LookupSwitchInfo,
+ FirstVal, LastVal, NeedBitVecCheck, NeedRangeCheck,
SwitchCode, !CI)
;
MaybeIntSwitchInfo =
Index: compiler/switch_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_util.m,v
retrieving revision 1.44
diff -u -b -r1.44 switch_util.m
--- compiler/switch_util.m 4 Sep 2009 02:27:55 -0000 1.44
+++ compiler/switch_util.m 20 Sep 2009 07:25:22 -0000
@@ -19,14 +19,18 @@
:- import_module backend_libs.rtti. % for sectag_locn
:- import_module hlds.
+:- import_module hlds.code_model.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
+:- import_module libs.
+:- import_module libs.globals.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_type.
:- import_module assoc_list.
+:- import_module bool.
:- import_module list.
:- import_module map.
:- import_module pair.
@@ -106,6 +110,68 @@
%-----------------------------------------------------------------------------%
%
+% Stuff for lookup switches.
+%
+
+:- type case_consts(Rval)
+ ---> all_one_soln(
+ assoc_list(int, list(Rval))
+ )
+ ; some_several_solns(
+ assoc_list(int, soln_consts(Rval)),
+ set(prog_var), % The resume vars.
+ bool % The Boolean "or" of the result
+ % of invoking goal_may_modify_trail
+ % on the goal_infos of the switch arms
+ % that are disjunctions.
+ ).
+
+:- type soln_consts(Rval)
+ ---> one_soln(list(Rval))
+ ; several_solns(list(list(Rval))).
+
+:- type need_range_check
+ ---> need_range_check
+ ; dont_need_range_check.
+
+:- type need_bit_vec_check
+ ---> need_bit_vec_check
+ ; dont_need_bit_vec_check.
+
+:- pred find_lookup_switch_params(module_info::in, mer_type::in,
+ code_model::in, can_fail::in,
+ list(tagged_case)::in, list(tagged_case)::out,
+ int::in, int::in, int::in, int::in,
+ need_bit_vec_check::out, need_range_check::out, int::out, int::out)
+ is semidet.
+
+:- pred project_all_to_one_solution(assoc_list(int, soln_consts(Rval))::in,
+ assoc_list(int, list(Rval))::in, assoc_list(int, list(Rval))::out)
+ is semidet.
+
+:- pred project_solns_to_rval_lists(assoc_list(int, soln_consts(Rval))::in,
+ list(list(Rval))::in, list(list(Rval))::out) is det.
+
+ % get_word_bits(Globals, WordBits, Log2WordBits):
+ %
+ % Return in WordBits the largest number of bits that
+ % - fits into a word on the host machine
+ % - fits into a word on the target machine
+ % - is a power of 2.
+ %
+ % WordBits will be 2^Log2WordBits.
+ %
+ % We use this predicate to prevent cross-compilation errors when generating
+ % bit vector tests for lookup switches by making sure that the bitvector
+ % uses a number of bits that will fit both on this machine (so that
+ % we can correctly generate it), and on the target machine (so that
+ % it can be executed correctly). We require the number of bits to be
+ % a power of 2, so that we implement division as right-shift.
+ %
+:- pred get_word_bits(globals::in, int::out, int::out) is det.
+
+%-----------------------------------------------------------------------------%
+%
% Stuff for string hash switches.
%
@@ -262,11 +328,13 @@
:- implementation.
+:- import_module check_hlds.
+:- import_module check_hlds.type_util.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_code_util.
:- import_module hlds.hlds_out.
-:- import_module libs.
:- import_module libs.compiler_util.
+:- import_module libs.options.
:- import_module parse_tree.prog_type.
:- import_module char.
@@ -524,6 +592,125 @@
%-----------------------------------------------------------------------------%
%
+% Stuff for lookup switches.
+%
+
+find_lookup_switch_params(ModuleInfo, SwitchVarType, CodeModel,
+ !.SwitchCanFail, !TaggedCases, LowerLimit, UpperLimit, NumValues,
+ ReqDensity, NeedBitVecCheck, NeedRangeCheck, FirstVal, LastVal) :-
+ (
+ ( CodeModel = model_non
+ ; CodeModel = model_semi
+ ),
+ filter_out_failing_cases(!TaggedCases, !SwitchCanFail)
+ ;
+ CodeModel = model_det
+ ),
+
+ % We want to generate a lookup switch for any switch that is dense enough
+ % - we don't care how many cases it has. A memory lookup tends to be
+ % cheaper than a branch.
+ Span = UpperLimit - LowerLimit,
+ Range = Span + 1,
+ Density = switch_density(NumValues, Range),
+ Density > ReqDensity,
+
+ % If there are going to be no gaps in the lookup table then we won't need
+ % a bitvector test to see if this switch has a value for this case.
+ ( NumValues = Range ->
+ NeedBitVecCheck0 = dont_need_bit_vec_check
+ ;
+ NeedBitVecCheck0 = need_bit_vec_check
+ ),
+ (
+ !.SwitchCanFail = can_fail,
+ % For can_fail switches, we normally need to check that the variable
+ % is in range before we index into the jump table. However, if the
+ % range of the type is sufficiently small, we can make the jump table
+ % large enough to hold all of the values for the type, but then we
+ % will need to do the bitvector test.
+ classify_type(ModuleInfo, SwitchVarType) = TypeCategory,
+ (
+ type_range(ModuleInfo, TypeCategory, SwitchVarType, _, _,
+ TypeRange),
+ DetDensity = switch_density(NumValues, TypeRange),
+ DetDensity > ReqDensity
+ ->
+ NeedRangeCheck = dont_need_range_check,
+ NeedBitVecCheck = need_bit_vec_check,
+ FirstVal = 0,
+ LastVal = TypeRange - 1
+ ;
+ NeedRangeCheck = need_range_check,
+ NeedBitVecCheck = NeedBitVecCheck0,
+ FirstVal = LowerLimit,
+ LastVal = UpperLimit
+ )
+ ;
+ !.SwitchCanFail = cannot_fail,
+ NeedRangeCheck = dont_need_range_check,
+ NeedBitVecCheck = NeedBitVecCheck0,
+ FirstVal = LowerLimit,
+ LastVal = UpperLimit
+ ).
+
+:- pred filter_out_failing_cases(list(tagged_case)::in, list(tagged_case)::out,
+ can_fail::in, can_fail::out) is det.
+
+filter_out_failing_cases(TaggedCases0, TaggedCases, !SwitchCanFail) :-
+ filter_out_failing_cases_2(TaggedCases0, [], RevTaggedCases,
+ !SwitchCanFail),
+ list.reverse(RevTaggedCases, TaggedCases).
+
+:- pred filter_out_failing_cases_2(list(tagged_case)::in,
+ list(tagged_case)::in, list(tagged_case)::out,
+ can_fail::in, can_fail::out) is det.
+
+filter_out_failing_cases_2([], !RevTaggedCases, !SwitchCanFail).
+filter_out_failing_cases_2([TaggedCase | TaggedCases], !RevTaggedCases,
+ !SwitchCanFail) :-
+ TaggedCase = tagged_case(_, _, _, Goal),
+ Goal = hlds_goal(GoalExpr, _),
+ ( GoalExpr = disj([]) ->
+ !:SwitchCanFail = can_fail
+ ;
+ !:RevTaggedCases = [TaggedCase | !.RevTaggedCases]
+ ),
+ filter_out_failing_cases_2(TaggedCases, !RevTaggedCases, !SwitchCanFail).
+
+project_all_to_one_solution([], !RevCaseValuePairs).
+project_all_to_one_solution([Case - Solns | CaseSolns], !RevCaseValuePairs) :-
+ Solns = one_soln(Values),
+ !:RevCaseValuePairs = [Case - Values | !.RevCaseValuePairs],
+ project_all_to_one_solution(CaseSolns, !RevCaseValuePairs).
+
+project_solns_to_rval_lists([], !RvalsList).
+project_solns_to_rval_lists([Case | Cases], !RvalsList) :-
+ Case = _Index - Soln,
+ (
+ Soln = one_soln(Rvals),
+ !:RvalsList = [Rvals | !.RvalsList]
+ ;
+ Soln = several_solns(SolnRvalsList),
+ !:RvalsList = SolnRvalsList ++ !.RvalsList
+ ),
+ project_solns_to_rval_lists(Cases, !RvalsList).
+
+get_word_bits(Globals, WordBits, Log2WordBits) :-
+ int.bits_per_int(HostWordBits),
+ globals.lookup_int_option(Globals, bits_per_word, TargetWordBits),
+ int.min(HostWordBits, TargetWordBits, WordBits0),
+ % Round down to the nearest power of 2.
+ Log2WordBits = log2_rounded_down(WordBits0),
+ int.pow(2, Log2WordBits, WordBits).
+
+:- func log2_rounded_down(int) = int.
+
+log2_rounded_down(X) = Log :-
+ int.log2(X + 1, Log + 1). % int.log2 rounds up
+
+%-----------------------------------------------------------------------------%
+%
% Stuff for string hash switches.
%
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.193
diff -u -b -r1.193 unify_gen.m
--- compiler/unify_gen.m 20 Jul 2009 00:39:36 -0000 1.193
+++ compiler/unify_gen.m 10 Sep 2009 00:40:45 -0000
@@ -361,7 +361,8 @@
ConsTag = foreign_tag(ForeignLang, ForeignVal),
expect(unify(ForeignLang, lang_c), this_file,
"foreign tag for language other than C"),
- TestRval = binop(eq, Rval, const(llconst_foreign(ForeignVal, integer)))
+ TestRval = binop(eq, Rval,
+ const(llconst_foreign(ForeignVal, lt_integer)))
;
ConsTag = closure_tag(_, _, _),
% This should never happen, since the error will be detected
@@ -474,7 +475,7 @@
ConsTag = foreign_tag(Lang, Val),
expect(unify(Lang, lang_c), this_file,
"foreign_tag for language other than C"),
- ForeignConst = const(llconst_foreign(Val, integer)),
+ ForeignConst = const(llconst_foreign(Val, lt_integer)),
assign_const_to_var(Var, ForeignConst, !CI),
Code = empty
;
@@ -1340,26 +1341,26 @@
(
ConsTag = string_tag(String),
Const = llconst_string(String),
- Type = string
+ Type = lt_string
;
ConsTag = int_tag(Int),
Const = llconst_int(Int),
- Type = integer
+ Type = lt_integer
;
ConsTag = foreign_tag(Lang, Val),
expect(unify(Lang, lang_c), this_file,
"foreign_tag for language other than C"),
- Const = llconst_foreign(Val, integer),
- Type = integer
+ Const = llconst_foreign(Val, lt_integer),
+ Type = lt_integer
;
ConsTag = float_tag(Float),
Const = llconst_float(Float),
(
UnboxedFloats = have_unboxed_floats,
- Type = float
+ Type = lt_float
;
UnboxedFloats = do_not_have_unboxed_floats,
- Type = data_ptr
+ Type = lt_data_ptr
)
),
ActiveGroundTerm = const(Const) - Type,
@@ -1367,7 +1368,7 @@
;
ConsTag = shared_local_tag(Ptag, Stag),
Rval = mkword(Ptag, unop(mkbody, const(llconst_int(Stag)))),
- ActiveGroundTerm = Rval - data_ptr,
+ ActiveGroundTerm = Rval - lt_data_ptr,
svmap.det_insert(Var, ActiveGroundTerm, !ActiveMap)
;
ConsTag = reserved_address_tag(RA),
@@ -1406,18 +1407,18 @@
MaybeOffset = no,
CellPtrConst = const(llconst_data_addr(DataAddr, MaybeOffset)),
Rval = mkword(Ptag, CellPtrConst),
- ActiveGroundTerm = Rval - data_ptr,
+ ActiveGroundTerm = Rval - lt_data_ptr,
svmap.det_insert(Var, ActiveGroundTerm, !ActiveMap)
;
ConsTag = shared_remote_tag(Ptag, Stag),
generate_ground_term_args(Args, ArgRvalsTypes, !ActiveMap),
- StagRvalType = const(llconst_int(Stag)) - integer,
+ StagRvalType = const(llconst_int(Stag)) - lt_integer,
AllRvalsTypes = [StagRvalType | ArgRvalsTypes],
add_scalar_static_cell(AllRvalsTypes, DataAddr, !StaticCellInfo),
MaybeOffset = no,
CellPtrConst = const(llconst_data_addr(DataAddr, MaybeOffset)),
Rval = mkword(Ptag, CellPtrConst),
- ActiveGroundTerm = Rval - data_ptr,
+ ActiveGroundTerm = Rval - lt_data_ptr,
svmap.det_insert(Var, ActiveGroundTerm, !ActiveMap)
;
( ConsTag = closure_tag(_, _, _)
cvs diff: Diffing compiler/notes
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.145
diff -u -b -r1.145 compiler_design.html
--- compiler/notes/compiler_design.html 2 Sep 2009 00:30:31 -0000 1.145
+++ compiler/notes/compiler_design.html 20 Sep 2009 09:52:43 -0000
@@ -1555,11 +1555,12 @@
<li> ml_unify_gen.m
<li> ml_closure_gen.m
<li> ml_call_gen.m
- <li> ml_switch_gen.m, which in turn has sub-modules
+ <li> ml_switch_gen.m, which calls upon:
<ul>
- <li> ml_dense_switch.m
+ <li> ml_lookup_switch.m
<li> ml_string_switch.m
<li> ml_tag_switch.m
+ <li> ml_simplify_switch.m
<li> switch_util.m (in the backend_libs.m package,
since it is also used by LLDS back-end)
</ul>
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
Index: tests/hard_coded/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mercury.options,v
retrieving revision 1.40
diff -u -b -r1.40 Mercury.options
--- tests/hard_coded/Mercury.options 3 Sep 2009 23:57:50 -0000 1.40
+++ tests/hard_coded/Mercury.options 20 Sep 2009 02:52:42 -0000
@@ -40,6 +40,7 @@
MCFLAGS-intermod_multimode = --intermodule-optimization
MCFLAGS-intermod_multimode_main = --intermodule-optimization
MCFLAGS-lco_no_inline = --optimize-constructor-last-call --no-inline-builtins
+MCFLAGS-lookup_switch_simple_non = --no-warn-det-decls-too-lax
MCFLAGS-opt_format = --optimize-format-calls
MCFLAGS-reuse_ho = --ctgc --no-optimise-higher-order
MCFLAGS-sharing_comb = --ctgc --structure-sharing-widening 2
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.380
diff -u -b -r1.380 Mmakefile
--- tests/hard_coded/Mmakefile 3 Sep 2009 23:57:50 -0000 1.380
+++ tests/hard_coded/Mmakefile 20 Sep 2009 06:40:02 -0000
@@ -144,6 +144,10 @@
join_list \
lco_no_inline \
list_series_int \
+ lookup_switch_simple \
+ lookup_switch_simple_bitvec \
+ lookup_switch_simple_non \
+ lookup_switch_simple_opt \
loop_inv_test \
loop_inv_test1 \
map_fold \
Index: tests/hard_coded/lookup_switch_simple.exp
===================================================================
RCS file: tests/hard_coded/lookup_switch_simple.exp
diff -N tests/hard_coded/lookup_switch_simple.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/lookup_switch_simple.exp 20 Sep 2009 02:36:22 -0000
@@ -0,0 +1,4 @@
+N = 1: no solution
+N = 2: 22 2.2 "two" 222 - 223
+N = 3: 33 3.3 "three" 222 - 224
+N = 4: 44 4.4 "four" 222 - 225
Index: tests/hard_coded/lookup_switch_simple.m
===================================================================
RCS file: tests/hard_coded/lookup_switch_simple.m
diff -N tests/hard_coded/lookup_switch_simple.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/lookup_switch_simple.m 11 Sep 2009 03:23:10 -0000
@@ -0,0 +1,46 @@
+% vim: ts=4 sw=4 et ft=mercury
+
+:- module lookup_switch_simple.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+:- import_module pair.
+:- import_module string.
+
+main(!IO) :-
+ test(1, !IO),
+ test(2, !IO),
+ test(3, !IO),
+ test(4, !IO).
+
+:- pred test(int::in, io::di, io::uo) is det.
+
+test(N, !IO) :-
+ ( p(N, A, B, C, D) ->
+ io.format("N = %d: ", [i(N)], !IO),
+ io.write(A, !IO),
+ io.write_string(" ", !IO),
+ io.write(B, !IO),
+ io.write_string(" ", !IO),
+ io.write(C, !IO),
+ io.write_string(" ", !IO),
+ io.write(D, !IO),
+ io.write_string("\n", !IO)
+ ;
+ io.format("N = %d: no solution\n", [i(N)], !IO)
+ ).
+
+:- pred p(int::in, int::out, float::out, string::out, pair(int)::out)
+ is semidet.
+
+p(2, 22, 2.2, "two", 222 - 223).
+p(3, 33, 3.3, "three", 222 - 224).
+p(4, 44, 4.4, "four", 222 - 225).
+p(5, 55, 5.5, "five", 222 - 226).
Index: tests/hard_coded/lookup_switch_simple_bitvec.exp
===================================================================
RCS file: tests/hard_coded/lookup_switch_simple_bitvec.exp
diff -N tests/hard_coded/lookup_switch_simple_bitvec.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/lookup_switch_simple_bitvec.exp 20 Sep 2009 07:23:56 -0000
@@ -0,0 +1,4 @@
+N = 1: no solution
+N = 2: 22 2.2 "two" 222 - 223
+N = 3: 33 3.3 "three" 222 - 224
+N = 4: no solution
Index: tests/hard_coded/lookup_switch_simple_bitvec.m
===================================================================
RCS file: tests/hard_coded/lookup_switch_simple_bitvec.m
diff -N tests/hard_coded/lookup_switch_simple_bitvec.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/lookup_switch_simple_bitvec.m 20 Sep 2009 03:22:38 -0000
@@ -0,0 +1,45 @@
+% vim: ts=4 sw=4 et ft=mercury
+
+:- module lookup_switch_simple_bitvec.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+:- import_module pair.
+:- import_module string.
+
+main(!IO) :-
+ test(1, !IO),
+ test(2, !IO),
+ test(3, !IO),
+ test(4, !IO).
+
+:- pred test(int::in, io::di, io::uo) is det.
+
+test(N, !IO) :-
+ ( p(N, A, B, C, D) ->
+ io.format("N = %d: ", [i(N)], !IO),
+ io.write(A, !IO),
+ io.write_string(" ", !IO),
+ io.write(B, !IO),
+ io.write_string(" ", !IO),
+ io.write(C, !IO),
+ io.write_string(" ", !IO),
+ io.write(D, !IO),
+ io.write_string("\n", !IO)
+ ;
+ io.format("N = %d: no solution\n", [i(N)], !IO)
+ ).
+
+:- pred p(int::in, int::out, float::out, string::out, pair(int)::out)
+ is semidet.
+
+p(2, 22, 2.2, "two", 222 - 223).
+p(3, 33, 3.3, "three", 222 - 224).
+p(5, 55, 5.5, "five", 222 - 226).
Index: tests/hard_coded/lookup_switch_simple_non.exp
===================================================================
RCS file: tests/hard_coded/lookup_switch_simple_non.exp
diff -N tests/hard_coded/lookup_switch_simple_non.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/lookup_switch_simple_non.exp 20 Sep 2009 02:53:06 -0000
@@ -0,0 +1,4 @@
+N = 1: no solution
+N = 2: 22 2.2 "two" 222 - 223
+N = 3: 33 3.3 "three" 222 - 224
+N = 4: 44 4.4 "four" 222 - 225
Index: tests/hard_coded/lookup_switch_simple_non.m
===================================================================
RCS file: tests/hard_coded/lookup_switch_simple_non.m
diff -N tests/hard_coded/lookup_switch_simple_non.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/lookup_switch_simple_non.m 20 Sep 2009 02:51:25 -0000
@@ -0,0 +1,61 @@
+% vim: ts=4 sw=4 et ft=mercury
+
+:- module lookup_switch_simple_non.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+:- import_module pair.
+:- import_module solutions.
+:- import_module string.
+
+main(!IO) :-
+ test(1, !IO),
+ test(2, !IO),
+ test(3, !IO),
+ test(4, !IO).
+
+:- pred test(int::in, io::di, io::uo) is det.
+
+test(N, !IO) :-
+ solutions(test_p(N), Solns),
+ (
+ Solns = [_ | _],
+ list.foldl(write_solution, Solns, !IO)
+ ;
+ Solns = [],
+ io.format("N = %d: no solution\n", [i(N)], !IO)
+ ).
+
+:- pred test_p(int::in, {int, int, float, string, pair(int)}::out) is nondet.
+
+test_p(N, {N, A, B, C, D}) :-
+ p(N, A, B, C, D).
+
+:- pred write_solution({int, int, float, string, pair(int)}::in,
+ io::di, io::uo) is det.
+
+write_solution({N, A, B, C, D}, !IO) :-
+ io.format("N = %d: ", [i(N)], !IO),
+ io.write(A, !IO),
+ io.write_string(" ", !IO),
+ io.write(B, !IO),
+ io.write_string(" ", !IO),
+ io.write(C, !IO),
+ io.write_string(" ", !IO),
+ io.write(D, !IO),
+ io.write_string("\n", !IO).
+
+:- pred p(int::in, int::out, float::out, string::out, pair(int)::out)
+ is nondet.
+
+p(2, 22, 2.2, "two", 222 - 223).
+p(3, 33, 3.3, "three", 222 - 224).
+p(4, 44, 4.4, "four", 222 - 225).
+p(5, 55, 5.5, "five", 222 - 226).
Index: tests/hard_coded/lookup_switch_simple_opt.exp
===================================================================
RCS file: tests/hard_coded/lookup_switch_simple_opt.exp
diff -N tests/hard_coded/lookup_switch_simple_opt.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/lookup_switch_simple_opt.exp 20 Sep 2009 07:13:08 -0000
@@ -0,0 +1,7 @@
+t(e1, 11) => 1
+t(e2, 12) => 2
+t(e3, 13) => 3
+t(e4, 14) => 4
+t(e5, 15) => 5
+t(e6, 16) => 6
+t(e7, 17) => 7
Index: tests/hard_coded/lookup_switch_simple_opt.m
===================================================================
RCS file: tests/hard_coded/lookup_switch_simple_opt.m
diff -N tests/hard_coded/lookup_switch_simple_opt.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/lookup_switch_simple_opt.m 20 Sep 2009 03:57:12 -0000
@@ -0,0 +1,63 @@
+% vim: ts=4 sw=4 et ft=mercury
+
+:- module lookup_switch_simple_opt.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+:- import_module pair.
+:- import_module string.
+
+:- type e ---> e1 ; e2 ; e3 ; e4 ; e5 ; e6 ; e7.
+:- type t ---> t(e, int).
+
+main(!IO) :-
+ test(t(e1, 11), !IO),
+ test(t(e2, 12), !IO),
+ test(t(e3, 13), !IO),
+ test(t(e4, 14), !IO),
+ test(t(e5, 15), !IO),
+ test(t(e6, 16), !IO),
+ test(t(e7, 17), !IO).
+
+:- pred test(t::in, io::di, io::uo) is det.
+
+test(T, !IO) :-
+ p(T, N),
+ io.write(T, !IO),
+ io.write_string(" => ", !IO),
+ io.write_int(N, !IO),
+ io.write_string("\n", !IO).
+
+:- pred p(t::in, int::out) is det.
+
+p(T, N) :-
+ T = t(E, _N),
+ (
+ E = e1,
+ N = 1
+ ;
+ E = e2,
+ N = 2
+ ;
+ E = e3,
+ N = 3
+ ;
+ E = e4,
+ N = 4
+ ;
+ E = e5,
+ N = 5
+ ;
+ E = e6,
+ N = 6
+ ;
+ E = e7,
+ N = 7
+ ).
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list