[m-rev.] for review: use a separate type to describe integer tags
Julien Fischer
jfischer at opturion.com
Sat Jul 22 21:32:14 AEST 2017
For review by anyone.
Use a separate type to describe integer tags.
compiler/hlds_data.m
Use a separate type to describe integer tags and parameterise
the int_tag functor of the cons_tag/0 type by that new type.
compiler/bytecode.m:
compiler/dense_switch.m:
compiler/du_type_layout.m:
compiler/export.m:
compiler/hlds_code_util.m:
compiler/make_tags.m:
compiler/ml_type_gen.m:
compiler/ml_switch_gen.m:
compiler/ml_unify_gen.m:
compiler/switch_gen.m:
compiler/type_ctor_info.m:
compiler/unify_gen.m:
Conform to the above change.
compiler/ml_code_util.m:
Add a utility function for use by the above.
Julien.
diff --git a/compiler/bytecode_gen.m b/compiler/bytecode_gen.m
index 1a172370f..3107ee9c1 100644
--- a/compiler/bytecode_gen.m
+++ b/compiler/bytecode_gen.m
@@ -866,21 +866,21 @@ map_cons_tag(shared_local_tag(Primary, Secondary),
map_cons_tag(string_tag(_), _) :-
unexpected($module, $pred, "string_tag cons tag " ++
"for non-string_constant cons id").
-map_cons_tag(int_tag(IntVal), byte_enum_tag(IntVal)).
-map_cons_tag(uint_tag(_), _) :-
- sorry($module, $pred, "bytecode with uints").
-map_cons_tag(int8_tag(_), _) :-
- sorry($module, $pred, "bytecode with int8s").
-map_cons_tag(uint8_tag(_), _) :-
- sorry($module, $pred, "bytecode with uint8s").
-map_cons_tag(int16_tag(_), _) :-
- sorry($module, $pred, "bytecode with int16s").
-map_cons_tag(uint16_tag(_), _) :-
- sorry($module, $pred, "bytecode with uint16s").
-map_cons_tag(int32_tag(_), _) :-
- sorry($module, $pred, "bytecode with int32s").
-map_cons_tag(uint32_tag(_), _) :-
- sorry($module, $pred, "bytecode with uint32s").
+map_cons_tag(int_tag(IntTagType), ByteConsTag) :-
+ (
+ IntTagType = int_tag_int(IntVal),
+ ByteConsTag = byte_enum_tag(IntVal)
+ ;
+ ( IntTagType = int_tag_uint(_)
+ ; IntTagType = int_tag_int8(_)
+ ; IntTagType = int_tag_uint8(_)
+ ; IntTagType = int_tag_int16(_)
+ ; IntTagType = int_tag_uint16(_)
+ ; IntTagType = int_tag_int32(_)
+ ; IntTagType = int_tag_uint32(_)
+ ),
+ sorry($module, $pred, "bytecode with uint or fixed size int")
+ ).
map_cons_tag(foreign_tag(_, _), _) :-
sorry($module, $pred, "bytecode with foreign tags").
map_cons_tag(float_tag(_), _) :-
diff --git a/compiler/dense_switch.m b/compiler/dense_switch.m
index 4dd2a7d95..1d37bec53 100644
--- a/compiler/dense_switch.m
+++ b/compiler/dense_switch.m
@@ -228,7 +228,7 @@ generate_dense_case(BranchStart, VarName, CodeModel, SwitchGoalInfo, EndLabel,
map(int, label)::in, map(int, label)::out) is det.
record_dense_label_for_cons_tag(Label, ConsTag, !IndexMap) :-
- ( if ConsTag = int_tag(Index) then
+ ( if ConsTag = int_tag(int_tag_int(Index)) then
map.det_insert(Index, Label, !IndexMap)
else
unexpected($module, $pred, "not int_tag")
diff --git a/compiler/du_type_layout.m b/compiler/du_type_layout.m
index a608b5a31..2100bdd86 100644
--- a/compiler/du_type_layout.m
+++ b/compiler/du_type_layout.m
@@ -197,7 +197,7 @@ cons_tags_bits(ConsTagValues) = NumBits :-
:- pred max_int_tag(cons_tag::in, int::in, int::out) is det.
max_int_tag(ConsTag, !Max) :-
- ( if ConsTag = int_tag(Int) then
+ ( if ConsTag = int_tag(int_tag_int(Int)) then
int.max(Int, !Max)
else
unexpected($module, $pred, "non-integer value for enumeration")
diff --git a/compiler/export.m b/compiler/export.m
index 88a4f10dc..df5d3835f 100644
--- a/compiler/export.m
+++ b/compiler/export.m
@@ -949,20 +949,26 @@ foreign_const_name_and_tag(TypeCtor, Mapping, TagValues, Ctor,
ConsId = cons(QualifiedCtorName, Arity, TypeCtor),
map.lookup(TagValues, ConsId, TagVal),
(
- TagVal = int_tag(IntTag),
- Tag = ee_tag_rep_int(IntTag)
+ TagVal = int_tag(IntTagType),
+ (
+ IntTagType = int_tag_int(IntTag),
+ Tag = ee_tag_rep_int(IntTag)
+ ;
+ ( IntTagType = int_tag_uint(_)
+ ; IntTagType = int_tag_int8(_)
+ ; IntTagType = int_tag_uint8(_)
+ ; IntTagType = int_tag_int16(_)
+ ; IntTagType = int_tag_uint16(_)
+ ; IntTagType = int_tag_int32(_)
+ ; IntTagType = int_tag_uint32(_)
+ ),
+ unexpected($module, $pred, "enum constant requires an int tag")
+ )
;
TagVal = foreign_tag(_ForeignLang, ForeignTag),
Tag = ee_tag_rep_string(ForeignTag)
;
( TagVal = string_tag(_)
- ; TagVal = uint_tag(_)
- ; TagVal = int8_tag(_)
- ; TagVal = uint8_tag(_)
- ; TagVal = int16_tag(_)
- ; TagVal = uint16_tag(_)
- ; TagVal = int32_tag(_)
- ; TagVal = uint32_tag(_)
; TagVal = float_tag(_)
; TagVal = closure_tag(_, _, _)
; TagVal = type_ctor_info_tag(_, _, _)
diff --git a/compiler/hlds_code_util.m b/compiler/hlds_code_util.m
index 501830255..ba37e1c21 100644
--- a/compiler/hlds_code_util.m
+++ b/compiler/hlds_code_util.m
@@ -88,35 +88,35 @@
cons_id_to_tag(ModuleInfo, ConsId) = Tag:-
(
ConsId = int_const(Int),
- Tag = int_tag(Int)
+ Tag = int_tag(int_tag_int(Int))
;
ConsId = uint_const(UInt),
- Tag = uint_tag(UInt)
+ Tag = int_tag(int_tag_uint(UInt))
;
ConsId = int8_const(Int8),
- Tag = int8_tag(Int8)
+ Tag = int_tag(int_tag_int8(Int8))
;
ConsId = uint8_const(UInt8),
- Tag = uint8_tag(UInt8)
+ Tag = int_tag(int_tag_uint8(UInt8))
;
ConsId = int16_const(Int16),
- Tag = int16_tag(Int16)
+ Tag = int_tag(int_tag_int16(Int16))
;
ConsId = uint16_const(UInt16),
- Tag = uint16_tag(UInt16)
+ Tag = int_tag(int_tag_uint16(UInt16))
;
ConsId = int32_const(Int32),
- Tag = int32_tag(Int32)
+ Tag = int_tag(int_tag_int32(Int32))
;
ConsId = uint32_const(UInt32),
- Tag = uint32_tag(UInt32)
+ Tag = int_tag(int_tag_uint32(UInt32))
;
ConsId = float_const(Float),
Tag = float_tag(Float)
;
ConsId = char_const(Char),
char.to_int(Char, CharCode),
- Tag = int_tag(CharCode)
+ Tag = int_tag(int_tag_int(CharCode))
;
ConsId = string_const(String),
Tag = string_tag(String)
@@ -173,7 +173,7 @@ cons_id_to_tag(ModuleInfo, ConsId) = Tag:-
; TargetLang = target_erlang
),
( if Arity = 0 then
- Tag = int_tag(0)
+ Tag = int_tag(int_tag_int(0))
else
Tag = single_functor_tag
)
diff --git a/compiler/hlds_data.m b/compiler/hlds_data.m
index c54d0dbe8..8d56dba91 100644
--- a/compiler/hlds_data.m
+++ b/compiler/hlds_data.m
@@ -589,23 +589,9 @@ cons_table_optimize(!ConsTable) :-
% MR_word_to_float(), and MR_float_const() macros. The default
% implementation of these is to use boxed double-precision floats.
- ; int_tag(int)
- % This means the constant is represented just as a word containing
- % the specified integer value. This is used for enumerations and
- % character constants as well as for int constants.
+ ; int_tag(int_tag)
- ; uint_tag(uint)
- % This means the constant is represented just as a word containing
- % the specified unsigned integer value. This is used for uint
- % constants.
- % XXX FIXED SIZE INT
- ; int8_tag(int)
- ; uint8_tag(int)
- ; int16_tag(int)
- ; uint16_tag(int)
- ; int32_tag(int)
- ; uint32_tag(int)
; foreign_tag(foreign_language, string)
% This means the constant is represented by the string which is
@@ -708,6 +694,25 @@ cons_table_optimize(!ConsTable) :-
% the value isn't any of the reserved addresses before testing
% for the constructor's own cons_tag.
+:- type int_tag
+ ---> int_tag_int(int)
+ % This means the constant is represented just as a word containing
+ % the specified integer value. This is used for enumerations and
+ % character constants as well as for int constants.
+
+ ; int_tag_uint(uint)
+ % This means the constant is represented just as a word containing
+ % the specified unsigned integer value. This is used for uint
+ % constants.
+
+ % XXX FIXED SIZE INT
+ ; int_tag_int8(int)
+ ; int_tag_uint8(int)
+ ; int_tag_int16(int)
+ ; int_tag_uint16(int)
+ ; int_tag_int32(int)
+ ; int_tag_uint32(int).
+
:- type reserved_address
---> null_pointer
% This is for constants which are represented as a null pointer.
@@ -789,13 +794,6 @@ get_primary_tag(Tag) = MaybePrimaryTag :-
% it would probably be OK to return `yes(0)'.
% But it's safe to be conservative...
( Tag = int_tag(_)
- ; Tag = uint_tag(_)
- ; Tag = int8_tag(_)
- ; Tag = uint8_tag(_)
- ; Tag = int16_tag(_)
- ; Tag = uint16_tag(_)
- ; Tag = int32_tag(_)
- ; Tag = uint32_tag(_)
; Tag = float_tag(_)
; Tag = string_tag(_)
; Tag = foreign_tag(_, _)
@@ -832,13 +830,6 @@ get_primary_tag(Tag) = MaybePrimaryTag :-
get_secondary_tag(Tag) = MaybeSecondaryTag :-
(
( Tag = int_tag(_)
- ; Tag = uint_tag(_)
- ; Tag = int8_tag(_)
- ; Tag = uint8_tag(_)
- ; Tag = int16_tag(_)
- ; Tag = uint16_tag(_)
- ; Tag = int32_tag(_)
- ; Tag = uint32_tag(_)
; Tag = float_tag(_)
; Tag = string_tag(_)
; Tag = foreign_tag(_, _)
diff --git a/compiler/make_tags.m b/compiler/make_tags.m
index 87ea76d0c..6e2634479 100644
--- a/compiler/make_tags.m
+++ b/compiler/make_tags.m
@@ -226,7 +226,7 @@ assign_enum_constants(_, [], _, !CtorTags).
assign_enum_constants(TypeCtor, [Ctor | Ctors], Val, !CtorTags) :-
Ctor = ctor(_ExistQVars, _Constraints, Name, _Args, Arity, _Ctxt),
ConsId = cons(Name, Arity, TypeCtor),
- Tag = int_tag(Val),
+ Tag = int_tag(int_tag_int(Val)),
% We call set instead of det_insert because we don't want types
% that erroneously contain more than one copy of a cons_id to crash
% the compiler.
diff --git a/compiler/ml_code_util.m b/compiler/ml_code_util.m
index eba30920a..21c6271f4 100644
--- a/compiler/ml_code_util.m
+++ b/compiler/ml_code_util.m
@@ -21,6 +21,7 @@
:- import_module backend_libs.builtin_ops.
:- 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 hlds.hlds_pred.
@@ -113,6 +114,8 @@
% negation: ml_gen_not(X) = unop(std_unop(not), X),
:- func ml_gen_not(mlds_rval) = mlds_rval.
+:- func ml_int_tag_to_rval_const(int_tag, mer_type, mlds_type) = mlds_rval.
+
%-----------------------------------------------------------------------------%
%
% Routines for generating types.
@@ -756,6 +759,39 @@ ml_gen_and(X, Y) =
ml_gen_not(X) = ml_unop(std_unop(logical_not), X).
+ml_int_tag_to_rval_const(IntTag, MerType, MLDS_Type) = Rval :-
+ (
+ IntTag = int_tag_int(Int),
+ ( if MerType = int_type then
+ Rval = ml_const(mlconst_int(Int))
+ else if MerType = char_type then
+ Rval = ml_const(mlconst_char(Int))
+ else
+ Rval = ml_const(mlconst_enum(Int, MLDS_Type))
+ )
+ ;
+ IntTag = int_tag_uint(UInt),
+ Rval = ml_const(mlconst_uint(UInt))
+ ;
+ IntTag = int_tag_int8(Int8),
+ Rval = ml_const(mlconst_int8(Int8))
+ ;
+ IntTag = int_tag_uint8(UInt8),
+ Rval = ml_const(mlconst_uint8(UInt8))
+ ;
+ IntTag = int_tag_int16(Int16),
+ Rval = ml_const(mlconst_int16(Int16))
+ ;
+ IntTag = int_tag_uint16(UInt16),
+ Rval = ml_const(mlconst_uint16(UInt16))
+ ;
+ IntTag = int_tag_int32(Int32),
+ Rval = ml_const(mlconst_int32(Int32))
+ ;
+ IntTag = int_tag_uint32(UInt32),
+ Rval = ml_const(mlconst_uint32(UInt32))
+ ).
+
%-----------------------------------------------------------------------------%
%
% Code for generating types.
diff --git a/compiler/ml_switch_gen.m b/compiler/ml_switch_gen.m
index 48ea926ae..282caf5f5 100644
--- a/compiler/ml_switch_gen.m
+++ b/compiler/ml_switch_gen.m
@@ -535,8 +535,8 @@ ml_switch_generate_mlds_switch(Cases, Var, CodeModel, CanFail, Context, Stmts,
ml_gen_var(!.Info, Var, Lval),
Rval = ml_lval(Lval),
ml_switch_gen_range(!.Info, MLDS_Type, Range),
- ml_switch_generate_mlds_cases(MLDS_Type, Cases, CodeModel, MLDS_Cases,
- !Info),
+ ml_switch_generate_mlds_cases(Type, MLDS_Type, Cases, CodeModel,
+ MLDS_Cases, !Info),
ml_switch_generate_default(CanFail, CodeModel, Context, Default, !Info),
SwitchStmt0 = ml_stmt_switch(MLDS_Type, Rval, Range, MLDS_Cases, Default,
Context),
@@ -559,66 +559,40 @@ ml_switch_gen_range(Info, MLDS_Type, Range) :-
Range = mlds_switch_range_unknown
).
-:- pred ml_switch_generate_mlds_cases(mlds_type::in, list(tagged_case)::in,
- code_model::in, list(mlds_switch_case)::out,
+:- pred ml_switch_generate_mlds_cases(mer_type::in, mlds_type::in,
+ list(tagged_case)::in, code_model::in, list(mlds_switch_case)::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_switch_generate_mlds_cases(_, [], _, [], !Info).
-ml_switch_generate_mlds_cases(MLDS_Type, [TaggedCase | TaggedCases], CodeModel,
- [MLDS_Case | MLDS_Cases], !Info) :-
- ml_switch_generate_mlds_case(MLDS_Type, TaggedCase, CodeModel,
+ml_switch_generate_mlds_cases(_, _, [], _, [], !Info).
+ml_switch_generate_mlds_cases(MerType, MLDS_Type, [TaggedCase | TaggedCases],
+ CodeModel, [MLDS_Case | MLDS_Cases], !Info) :-
+ ml_switch_generate_mlds_case(MerType, MLDS_Type, TaggedCase, CodeModel,
MLDS_Case, !Info),
- ml_switch_generate_mlds_cases(MLDS_Type, TaggedCases, CodeModel,
+ ml_switch_generate_mlds_cases(MerType, MLDS_Type, TaggedCases, CodeModel,
MLDS_Cases, !Info).
-:- pred ml_switch_generate_mlds_case(mlds_type::in, tagged_case::in,
- code_model::in, mlds_switch_case::out,
+:- pred ml_switch_generate_mlds_case(mer_type::in, mlds_type::in,
+ tagged_case::in, code_model::in, mlds_switch_case::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_switch_generate_mlds_case(MLDS_Type, TaggedCase, CodeModel, MLDS_Case,
- !Info) :-
+ml_switch_generate_mlds_case(MerType, MLDS_Type, TaggedCase, CodeModel,
+ MLDS_Case, !Info) :-
TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, _, Goal),
- ml_tagged_cons_id_to_match_cond(MLDS_Type, TaggedMainConsId, MainCond),
- list.map(ml_tagged_cons_id_to_match_cond(MLDS_Type), TaggedOtherConsIds,
- OtherConds),
+ ml_tagged_cons_id_to_match_cond(MerType, MLDS_Type, TaggedMainConsId,
+ MainCond),
+ list.map(ml_tagged_cons_id_to_match_cond(MerType, MLDS_Type),
+ TaggedOtherConsIds, OtherConds),
ml_gen_goal_as_branch_block(CodeModel, Goal, Stmt, !Info),
MLDS_Case = mlds_switch_case(MainCond, OtherConds, Stmt).
-:- pred ml_tagged_cons_id_to_match_cond(mlds_type::in, tagged_cons_id::in,
- mlds_case_match_cond::out) is det.
+:- pred ml_tagged_cons_id_to_match_cond(mer_type::in, mlds_type::in,
+ tagged_cons_id::in, mlds_case_match_cond::out) is det.
-ml_tagged_cons_id_to_match_cond(MLDS_Type, TaggedConsId, MatchCond) :-
- TaggedConsId = tagged_cons_id(ConsId, Tag),
+ml_tagged_cons_id_to_match_cond(MerType, MLDS_Type, TaggedConsId, MatchCond) :-
+ TaggedConsId = tagged_cons_id(_ConsId, Tag),
(
- Tag = int_tag(Int),
- ( if ConsId = int_const(_) then
- Rval = ml_const(mlconst_int(Int))
- else if ConsId = char_const(_) then
- Rval = ml_const(mlconst_char(Int))
- else
- Rval = ml_const(mlconst_enum(Int, MLDS_Type))
- )
- ;
- Tag = uint_tag(UInt),
- Rval = ml_const(mlconst_uint(UInt))
- ;
- Tag = int8_tag(Int8),
- Rval = ml_const(mlconst_int8(Int8))
- ;
- Tag = uint8_tag(UInt8),
- Rval = ml_const(mlconst_uint8(UInt8))
- ;
- Tag = int16_tag(Int16),
- Rval = ml_const(mlconst_int16(Int16))
- ;
- Tag = uint16_tag(UInt16),
- Rval = ml_const(mlconst_uint16(UInt16))
- ;
- Tag = int32_tag(Int32),
- Rval = ml_const(mlconst_int32(Int32))
- ;
- Tag = uint32_tag(UInt32),
- Rval = ml_const(mlconst_uint32(UInt32))
+ Tag = int_tag(IntTag),
+ Rval = ml_int_tag_to_rval_const(IntTag, MerType, MLDS_Type)
;
Tag = string_tag(String),
Rval = ml_const(mlconst_string(String))
diff --git a/compiler/ml_type_gen.m b/compiler/ml_type_gen.m
index 4edc583e3..88db00a4c 100644
--- a/compiler/ml_type_gen.m
+++ b/compiler/ml_type_gen.m
@@ -338,21 +338,27 @@ ml_gen_hld_enum_constant(Context, TypeCtor, ConsTagValues, MLDS_Type, Ctor)
Ctor = ctor(_ExistQTVars, _Constraints, Name, _Args, Arity, _Ctxt),
map.lookup(ConsTagValues, cons(Name, Arity, TypeCtor), TagVal),
(
- TagVal = int_tag(Int),
- ConstValue = ml_const(mlconst_enum(Int, MLDS_Type))
+ TagVal = int_tag(IntTag),
+ (
+ IntTag = int_tag_int(Int),
+ ConstValue = ml_const(mlconst_enum(Int, MLDS_Type))
+ ;
+ ( IntTag = int_tag_uint(_)
+ ; IntTag = int_tag_int8(_)
+ ; IntTag = int_tag_uint8(_)
+ ; IntTag = int_tag_int16(_)
+ ; IntTag = int_tag_uint16(_)
+ ; IntTag = int_tag_int32(_)
+ ; IntTag = int_tag_uint32(_)
+ ),
+ unexpected($pred, "enum constant needs int tag")
+ )
;
TagVal = foreign_tag(ForeignLang, ForeignTagValue),
ConstValue = ml_const(
mlconst_foreign(ForeignLang, ForeignTagValue, MLDS_Type))
;
- ( TagVal = uint_tag(_)
- ; TagVal = int8_tag(_)
- ; TagVal = uint8_tag(_)
- ; TagVal = int16_tag(_)
- ; TagVal = uint16_tag(_)
- ; TagVal = int32_tag(_)
- ; TagVal = uint32_tag(_)
- ; TagVal = string_tag(_)
+ ( TagVal = string_tag(_)
; TagVal = float_tag(_)
; TagVal = closure_tag(_, _, _)
; TagVal = type_ctor_info_tag(_, _, _)
@@ -1182,13 +1188,6 @@ ml_tag_uses_base_class(Tag) = UsesBaseClass :-
( Tag = string_tag(_)
; Tag = float_tag(_)
; Tag = int_tag(_)
- ; Tag = uint_tag(_)
- ; Tag = int8_tag(_)
- ; Tag = uint8_tag(_)
- ; Tag = int16_tag(_)
- ; Tag = uint16_tag(_)
- ; Tag = int32_tag(_)
- ; Tag = uint32_tag(_)
; Tag = foreign_tag(_, _)
; Tag = closure_tag(_, _, _)
; Tag = type_ctor_info_tag(_, _, _)
@@ -1247,21 +1246,28 @@ generate_foreign_enum_constant(TypeCtor, Mapping, TagValues, MLDS_Type, Ctor,
Ctor = ctor(_, _, QualName, _Args, Arity, _),
map.lookup(TagValues, cons(QualName, Arity, TypeCtor), TagVal),
(
- TagVal = int_tag(Int),
- ConstValue = ml_const(mlconst_enum(Int, MLDS_Type))
+ TagVal = int_tag(IntTag),
+ (
+ IntTag = int_tag_int(Int),
+ ConstValue = ml_const(mlconst_enum(Int, MLDS_Type))
+ ;
+ ( IntTag = int_tag_uint(_)
+ ; IntTag = int_tag_int8(_)
+ ; IntTag = int_tag_uint8(_)
+ ; IntTag = int_tag_int16(_)
+ ; IntTag = int_tag_uint16(_)
+ ; IntTag = int_tag_int32(_)
+ ; IntTag = int_tag_uint32(_)
+ ),
+ unexpected($pred,
+ "enum constant requires an int or foreign tag")
+ )
;
TagVal = foreign_tag(Lang, String),
ConstValue = ml_const(mlconst_foreign(Lang, String, MLDS_Type))
;
( TagVal = string_tag(_)
; TagVal = float_tag(_)
- ; TagVal = uint_tag(_)
- ; TagVal = int8_tag(_)
- ; TagVal = uint8_tag(_)
- ; TagVal = int16_tag(_)
- ; TagVal = uint16_tag(_)
- ; TagVal = int32_tag(_)
- ; TagVal = uint32_tag(_)
; TagVal = closure_tag(_, _, _)
; TagVal = type_ctor_info_tag(_, _, _)
; TagVal = base_typeclass_info_tag(_, _, _)
diff --git a/compiler/ml_unify_gen.m b/compiler/ml_unify_gen.m
index 45b51f148..bd588c302 100644
--- a/compiler/ml_unify_gen.m
+++ b/compiler/ml_unify_gen.m
@@ -401,13 +401,6 @@ ml_gen_construct_tag(Tag, Type, Var, ConsId, Args, ArgModes, TakeAddr,
;
% Constants.
( Tag = int_tag(_)
- ; Tag = uint_tag(_)
- ; Tag = int8_tag(_)
- ; Tag = uint8_tag(_)
- ; Tag = int16_tag(_)
- ; Tag = uint16_tag(_)
- ; Tag = int32_tag(_)
- ; Tag = uint32_tag(_)
; Tag = foreign_tag(_, _)
; Tag = float_tag(_)
; Tag = string_tag(_)
@@ -449,35 +442,8 @@ ml_gen_info_lookup_const_var_rval(Info, Var, Rval) :-
ml_gen_constant(Tag, VarType, MLDS_VarType, Rval, !Info) :-
(
- Tag = int_tag(Int),
- ( if VarType = int_type then
- Rval = ml_const(mlconst_int(Int))
- else if VarType = char_type then
- Rval = ml_const(mlconst_char(Int))
- else
- Rval = ml_const(mlconst_enum(Int, MLDS_VarType))
- )
- ;
- Tag = uint_tag(UInt),
- Rval = ml_const(mlconst_uint(UInt))
- ;
- Tag = int8_tag(Int8),
- Rval = ml_const(mlconst_int8(Int8))
- ;
- Tag = uint8_tag(UInt8),
- Rval = ml_const(mlconst_uint8(UInt8))
- ;
- Tag = int16_tag(Int16),
- Rval = ml_const(mlconst_int16(Int16))
- ;
- Tag = uint16_tag(UInt16),
- Rval = ml_const(mlconst_uint16(UInt16))
- ;
- Tag = int32_tag(Int32),
- Rval = ml_const(mlconst_int32(Int32))
- ;
- Tag = uint32_tag(UInt32),
- Rval = ml_const(mlconst_uint32(UInt32))
+ Tag = int_tag(IntTag),
+ Rval = ml_int_tag_to_rval_const(IntTag, VarType, MLDS_VarType)
;
Tag = float_tag(Float),
Rval = ml_const(mlconst_float(Float))
@@ -1497,14 +1463,7 @@ ml_gen_det_deconstruct_tag(Tag, Type, Var, ConsId, Args, Modes, Context,
% the value of the constant, so Stmts = [].
(
( Tag = string_tag(_String)
- ; Tag = int_tag(_Int)
- ; Tag = uint_tag(_UInt)
- ; Tag = int8_tag(_)
- ; Tag = uint8_tag(_)
- ; Tag = int16_tag(_)
- ; Tag = uint16_tag(_)
- ; Tag = int32_tag(_)
- ; Tag = uint32_tag(_)
+ ; Tag = int_tag(_IntTag)
; Tag = foreign_tag(_, _)
; Tag = float_tag(_Float)
; Tag = shared_local_tag(_Bits1, _Num1)
@@ -1608,14 +1567,7 @@ ml_tag_offset_and_argnum(Tag, TagBits, Offset, ArgNum) :-
ml_tag_offset_and_argnum(SubTag, TagBits, Offset, ArgNum)
;
( Tag = string_tag(_String)
- ; Tag = int_tag(_Int)
- ; Tag = uint_tag(_)
- ; Tag = int8_tag(_)
- ; Tag = uint8_tag(_)
- ; Tag = int16_tag(_)
- ; Tag = uint16_tag(_)
- ; Tag = int32_tag(_)
- ; Tag = uint32_tag(_)
+ ; Tag = int_tag(_)
; Tag = foreign_tag(_, _)
; Tag = float_tag(_Float)
; Tag = closure_tag(_, _, _)
@@ -2227,44 +2179,8 @@ ml_gen_tag_test_rval(Tag, Type, ModuleInfo, Rval) = TagTestRval :-
Tag = float_tag(Float),
TagTestRval = ml_binop(float_eq, Rval, ml_const(mlconst_float(Float)))
;
- Tag = int_tag(Int),
- ( if Type = int_type then
- ConstRval = ml_const(mlconst_int(Int))
- else if Type = char_type then
- ConstRval = ml_const(mlconst_char(Int))
- else
- MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type),
- ConstRval = ml_const(mlconst_enum(Int, MLDS_Type))
- ),
- TagTestRval = ml_binop(eq(int_type_int), Rval, ConstRval)
- ;
- Tag = uint_tag(UInt),
- TagTestRval = ml_binop(eq(int_type_uint), Rval,
- ml_const(mlconst_uint(UInt)))
- ;
- Tag = int8_tag(Int8),
- TagTestRval = ml_binop(eq(int_type_int8), Rval,
- ml_const(mlconst_int8(Int8)))
- ;
- Tag = uint8_tag(UInt8),
- TagTestRval = ml_binop(eq(int_type_uint8), Rval,
- ml_const(mlconst_uint8(UInt8)))
- ;
- Tag = int16_tag(Int16),
- TagTestRval = ml_binop(eq(int_type_int16), Rval,
- ml_const(mlconst_int16(Int16)))
- ;
- Tag = uint16_tag(UInt16),
- TagTestRval = ml_binop(eq(int_type_uint16), Rval,
- ml_const(mlconst_uint16(UInt16)))
- ;
- Tag = int32_tag(Int32),
- TagTestRval = ml_binop(eq(int_type_int32), Rval,
- ml_const(mlconst_int32(Int32)))
- ;
- Tag = uint32_tag(UInt32),
- TagTestRval = ml_binop(eq(int_type_uint32), Rval,
- ml_const(mlconst_uint32(UInt32)))
+ Tag = int_tag(IntTag),
+ TagTestRval = ml_gen_int_tag_test_rval(IntTag, Type, ModuleInfo, Rval)
;
Tag = foreign_tag(ForeignLang, ForeignVal),
MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type),
@@ -2343,6 +2259,51 @@ ml_gen_tag_test_rval(Tag, Type, ModuleInfo, Rval) = TagTestRval :-
MatchesThisTag)
).
+:- func ml_gen_int_tag_test_rval(int_tag, mer_type, module_info, mlds_rval) =
+ mlds_rval.
+
+ml_gen_int_tag_test_rval(IntTag, Type, ModuleInfo, Rval) = TagTestRval :-
+ (
+ IntTag = int_tag_int(Int),
+ ( if Type = int_type then
+ ConstRval = ml_const(mlconst_int(Int))
+ else if Type = char_type then
+ ConstRval = ml_const(mlconst_char(Int))
+ else
+ MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type),
+ ConstRval = ml_const(mlconst_enum(Int, MLDS_Type))
+ ),
+ TagTestRval = ml_binop(eq(int_type_int), Rval, ConstRval)
+ ;
+ IntTag = int_tag_uint(UInt),
+ TagTestRval = ml_binop(eq(int_type_uint), Rval,
+ ml_const(mlconst_uint(UInt)))
+ ;
+ IntTag = int_tag_int8(Int8),
+ TagTestRval = ml_binop(eq(int_type_int8), Rval,
+ ml_const(mlconst_int8(Int8)))
+ ;
+ IntTag = int_tag_uint8(UInt8),
+ TagTestRval = ml_binop(eq(int_type_uint8), Rval,
+ ml_const(mlconst_uint8(UInt8)))
+ ;
+ IntTag = int_tag_int16(Int16),
+ TagTestRval = ml_binop(eq(int_type_int16), Rval,
+ ml_const(mlconst_int16(Int16)))
+ ;
+ IntTag = int_tag_uint16(UInt16),
+ TagTestRval = ml_binop(eq(int_type_uint16), Rval,
+ ml_const(mlconst_uint16(UInt16)))
+ ;
+ IntTag = int_tag_int32(Int32),
+ TagTestRval = ml_binop(eq(int_type_int32), Rval,
+ ml_const(mlconst_int32(Int32)))
+ ;
+ IntTag = int_tag_uint32(UInt32),
+ TagTestRval = ml_binop(eq(int_type_uint32), Rval,
+ ml_const(mlconst_uint32(UInt32)))
+ ).
+
ml_gen_secondary_tag_rval(ModuleInfo, PrimaryTagVal, VarType, Rval) =
SecondaryTagField :-
MLDS_VarType = mercury_type_to_mlds_type(ModuleInfo, VarType),
@@ -2556,35 +2517,9 @@ ml_gen_ground_term_conjunct_tag(ModuleInfo, Target, HighLevelData, VarTypes,
(
% Constants.
(
- ConsTag = int_tag(Int),
- ( if VarType = int_type then
- ConstRval = ml_const(mlconst_int(Int))
- else if VarType = char_type then
- ConstRval = ml_const(mlconst_char(Int))
- else
- ConstRval = ml_const(mlconst_enum(Int, MLDS_Type))
- )
- ;
- ConsTag = uint_tag(UInt),
- ConstRval = ml_const(mlconst_uint(UInt))
- ;
- ConsTag = int8_tag(Int8),
- ConstRval = ml_const(mlconst_int8(Int8))
- ;
- ConsTag = uint8_tag(UInt8),
- ConstRval = ml_const(mlconst_uint8(UInt8))
- ;
- ConsTag = int16_tag(Int16),
- ConstRval = ml_const(mlconst_int16(Int16))
- ;
- ConsTag = uint16_tag(UInt16),
- ConstRval = ml_const(mlconst_uint16(UInt16))
- ;
- ConsTag = int32_tag(Int32),
- ConstRval = ml_const(mlconst_int32(Int32))
- ;
- ConsTag = uint32_tag(UInt32),
- ConstRval = ml_const(mlconst_uint32(UInt32))
+ ConsTag = int_tag(IntTag),
+ IntConst = int_tag_to_mlds_rval_const(VarType, MLDS_Type, IntTag),
+ ConstRval = ml_const(IntConst)
;
ConsTag = float_tag(Float),
ConstRval = ml_const(mlconst_float(Float))
@@ -2979,13 +2914,6 @@ ml_gen_const_struct_tag(Info, ConstNum, Type, MLDS_Type, ConsId, ConsTag,
;
% These tags don't build heap cells.
( ConsTag = int_tag(_)
- ; ConsTag = uint_tag(_)
- ; ConsTag = int8_tag(_)
- ; ConsTag = uint8_tag(_)
- ; ConsTag = int16_tag(_)
- ; ConsTag = uint16_tag(_)
- ; ConsTag = int32_tag(_)
- ; ConsTag = uint32_tag(_)
; ConsTag = float_tag(_)
; ConsTag = string_tag(_)
; ConsTag = reserved_address_tag(_)
@@ -3154,35 +3082,9 @@ ml_gen_const_struct_arg(Info, ConstStructMap, ConstArg, DoubleWidth,
ml_gen_const_struct_arg_tag(ModuleInfo, ConsId, ConsTag, Type, MLDS_Type,
Rval) :-
(
- ConsTag = int_tag(Int),
- ( if Type = int_type then
- Rval = ml_const(mlconst_int(Int))
- else if Type = char_type then
- Rval = ml_const(mlconst_char(Int))
- else
- Rval = ml_const(mlconst_enum(Int, MLDS_Type))
- )
- ;
- ConsTag = uint_tag(UInt),
- Rval = ml_const(mlconst_uint(UInt))
- ;
- ConsTag = int8_tag(Int8),
- Rval = ml_const(mlconst_int8(Int8))
- ;
- ConsTag = uint8_tag(UInt8),
- Rval = ml_const(mlconst_uint8(UInt8))
- ;
- ConsTag = int16_tag(Int16),
- Rval = ml_const(mlconst_int16(Int16))
- ;
- ConsTag = uint16_tag(UInt16),
- Rval = ml_const(mlconst_uint16(UInt16))
- ;
- ConsTag = int32_tag(Int32),
- Rval = ml_const(mlconst_int32(Int32))
- ;
- ConsTag = uint32_tag(UInt32),
- Rval = ml_const(mlconst_uint32(UInt32))
+ ConsTag = int_tag(IntTag),
+ RvalConst = int_tag_to_mlds_rval_const(Type, MLDS_Type, IntTag),
+ Rval = ml_const(RvalConst)
;
ConsTag = float_tag(Float),
Rval = ml_const(mlconst_float(Float))
@@ -3244,6 +3146,41 @@ ml_gen_const_struct_arg_tag(ModuleInfo, ConsId, ConsTag, Type, MLDS_Type,
unexpected($pred, "unexpected tag")
).
+:- func int_tag_to_mlds_rval_const(mer_type, mlds_type, int_tag) = mlds_rval_const.
+
+int_tag_to_mlds_rval_const(Type, MLDS_Type, IntTag) = Const :-
+ (
+ IntTag = int_tag_int(Int),
+ ( if Type = int_type then
+ Const = mlconst_int(Int)
+ else if Type = char_type then
+ Const = mlconst_char(Int)
+ else
+ Const = mlconst_enum(Int, MLDS_Type)
+ )
+ ;
+ IntTag = int_tag_uint(UInt),
+ Const = mlconst_uint(UInt)
+ ;
+ IntTag = int_tag_int8(Int8),
+ Const = mlconst_int8(Int8)
+ ;
+ IntTag = int_tag_uint8(UInt8),
+ Const = mlconst_uint8(UInt8)
+ ;
+ IntTag = int_tag_int16(Int16),
+ Const = mlconst_int16(Int16)
+ ;
+ IntTag = int_tag_uint16(UInt16),
+ Const = mlconst_uint16(UInt16)
+ ;
+ IntTag = int_tag_int32(Int32),
+ Const = mlconst_int32(Int32)
+ ;
+ IntTag = int_tag_uint32(UInt32),
+ Const = mlconst_uint32(UInt32)
+ ).
+
%-----------------------------------------------------------------------------%
:- pred arg_width_is_double(arg_width::in, bool::out) is det.
diff --git a/compiler/switch_gen.m b/compiler/switch_gen.m
index 52c8e58be..6f3dddb11 100644
--- a/compiler/switch_gen.m
+++ b/compiler/switch_gen.m
@@ -456,13 +456,6 @@ is_reserved_addr_tag(ConsTag) = IsReservedAddr :-
IsReservedAddr = is_reserved_addr_tag(SubConsTag)
;
( ConsTag = int_tag(_)
- ; ConsTag = uint_tag(_)
- ; ConsTag = int8_tag(_)
- ; ConsTag = uint8_tag(_)
- ; ConsTag = int16_tag(_)
- ; ConsTag = uint16_tag(_)
- ; ConsTag = int32_tag(_)
- ; ConsTag = uint32_tag(_)
; ConsTag = float_tag(_)
; ConsTag = string_tag(_)
; ConsTag = foreign_tag(_, _)
diff --git a/compiler/switch_util.m b/compiler/switch_util.m
index 79423e4bc..0978d0dfb 100644
--- a/compiler/switch_util.m
+++ b/compiler/switch_util.m
@@ -396,7 +396,7 @@ tag_cases(ModuleInfo, SwitchVarType, [Case | Cases],
Case = case(MainConsId, OtherConsIds, Goal),
MainConsTag = cons_id_to_tag(ModuleInfo, MainConsId),
TaggedMainConsId = tagged_cons_id(MainConsId, MainConsTag),
- ( if MainConsTag = int_tag(IntTag) then
+ ( if MainConsTag = int_tag(int_tag_int(IntTag)) then
list.map_foldl4(tag_cons_id_in_int_switch(ModuleInfo),
OtherConsIds, TaggedOtherConsIds,
IntTag, LowerLimit1, IntTag, UpperLimit1,
@@ -473,7 +473,7 @@ tag_cons_id_in_int_switch(ModuleInfo, ConsId, TaggedConsId,
!LowerLimit, !UpperLimit, !NumValues, !IsIntSwitch) :-
ConsTag = cons_id_to_tag(ModuleInfo, ConsId),
TaggedConsId = tagged_cons_id(ConsId, ConsTag),
- ( if ConsTag = int_tag(IntTag) then
+ ( if ConsTag = int_tag(int_tag_int(IntTag)) then
int.min(IntTag, !LowerLimit),
int.max(IntTag, !UpperLimit),
!:NumValues = !.NumValues + 1
@@ -537,13 +537,6 @@ type_ctor_cat_to_switch_cat(CtorCat) = SwitchCat :-
estimate_switch_tag_test_cost(Tag) = Cost :-
(
( Tag = int_tag(_)
- ; Tag = uint_tag(_)
- ; Tag = int8_tag(_)
- ; Tag = uint8_tag(_)
- ; Tag = int16_tag(_)
- ; Tag = uint16_tag(_)
- ; Tag = int32_tag(_)
- ; Tag = uint32_tag(_)
; Tag = foreign_tag(_, _)
; Tag = reserved_address_tag(_)
; Tag = shared_local_tag(_, _)
@@ -1242,13 +1235,6 @@ get_ptag_counts_loop([Tag | Tags], !MaxPrimary, !PtagCountMap) :-
; Tag = string_tag(_)
; Tag = float_tag(_)
; Tag = int_tag(_)
- ; Tag = uint_tag(_)
- ; Tag = int8_tag(_)
- ; Tag = uint8_tag(_)
- ; Tag = int16_tag(_)
- ; Tag = uint16_tag(_)
- ; Tag = int32_tag(_)
- ; Tag = uint32_tag(_)
; Tag = foreign_tag(_, _)
; Tag = closure_tag(_, _, _)
; Tag = type_ctor_info_tag(_, _, _)
@@ -1353,13 +1339,6 @@ group_case_by_ptag(CaseId, CaseRep, TaggedConsId,
; Tag = string_tag(_)
; Tag = float_tag(_)
; Tag = int_tag(_)
- ; Tag = uint_tag(_)
- ; Tag = int8_tag(_)
- ; Tag = uint8_tag(_)
- ; Tag = int16_tag(_)
- ; Tag = uint16_tag(_)
- ; Tag = int32_tag(_)
- ; Tag = uint32_tag(_)
; Tag = foreign_tag(_, _)
; Tag = closure_tag(_, _, _)
; Tag = type_ctor_info_tag(_, _, _)
@@ -1491,7 +1470,7 @@ order_ptags_by_value(Ptag, MaxPtag, PtagCaseMap0, PtagCaseList) :-
%-----------------------------------------------------------------------------%
get_int_tag(ConsTag, Int) :-
- ( if ConsTag = int_tag(IntPrime) then
+ ( if ConsTag = int_tag(int_tag_int(IntPrime)) then
Int = IntPrime
else
unexpected($module, $pred, "not int_tag")
diff --git a/compiler/type_ctor_info.m b/compiler/type_ctor_info.m
index cc6569b8e..6743e82d5 100644
--- a/compiler/type_ctor_info.m
+++ b/compiler/type_ctor_info.m
@@ -585,7 +585,7 @@ make_enum_functors(TypeCtor, [Functor | Functors], NextOrdinal, ConsTagMap,
"functor in enum has nonzero arity"),
ConsId = cons(SymName, list.length(FunctorArgs), TypeCtor),
map.lookup(ConsTagMap, ConsId, ConsTag),
- expect(unify(ConsTag, int_tag(NextOrdinal)), $module, $pred,
+ expect(unify(ConsTag, int_tag(int_tag_int(NextOrdinal))), $module, $pred,
"mismatch on constant assigned to functor in enum"),
FunctorName = unqualify_name(SymName),
EnumFunctor = enum_functor(FunctorName, NextOrdinal),
@@ -661,13 +661,6 @@ make_foreign_enum_functors(TypeCtor, Lang, [Functor | Functors], NextOrdinal,
( ConsTag = string_tag(_)
; ConsTag = float_tag(_)
; ConsTag = int_tag(_)
- ; ConsTag = uint_tag(_)
- ; ConsTag = int8_tag(_)
- ; ConsTag = uint8_tag(_)
- ; ConsTag = int16_tag(_)
- ; ConsTag = uint16_tag(_)
- ; ConsTag = int32_tag(_)
- ; ConsTag = uint32_tag(_)
; ConsTag = closure_tag(_, _, _)
; ConsTag = type_ctor_info_tag(_, _, _)
; ConsTag = base_typeclass_info_tag(_, _, _)
@@ -849,13 +842,6 @@ get_maybe_reserved_rep(ConsTag, ConsRep) :-
( ConsTag = no_tag
; ConsTag = string_tag(_)
; ConsTag = int_tag(_)
- ; ConsTag = uint_tag(_)
- ; ConsTag = int8_tag(_)
- ; ConsTag = uint8_tag(_)
- ; ConsTag = int16_tag(_)
- ; ConsTag = uint16_tag(_)
- ; ConsTag = int32_tag(_)
- ; ConsTag = uint32_tag(_)
; ConsTag = foreign_tag(_, _)
; ConsTag = float_tag(_)
; ConsTag = closure_tag(_, _, _)
diff --git a/compiler/unify_gen.m b/compiler/unify_gen.m
index 36de1c09a..5d2ec62e2 100644
--- a/compiler/unify_gen.m
+++ b/compiler/unify_gen.m
@@ -418,29 +418,9 @@ raw_tag_test(Rval, ConsTag, TestRval) :-
ConsTag = float_tag(Float),
TestRval = binop(float_eq, Rval, const(llconst_float(Float)))
;
- ConsTag = int_tag(Int),
- TestRval = binop(eq(int_type_int), Rval, const(llconst_int(Int)))
- ;
- ConsTag = uint_tag(UInt),
- TestRval = binop(eq(int_type_uint), Rval, const(llconst_uint(UInt)))
- ;
- ConsTag = int8_tag(Int8),
- TestRval = binop(eq(int_type_int8), Rval, const(llconst_int8(Int8)))
- ;
- ConsTag = uint8_tag(UInt8),
- TestRval = binop(eq(int_type_uint8), Rval, const(llconst_uint8(UInt8)))
- ;
- ConsTag = int16_tag(Int16),
- TestRval = binop(eq(int_type_int16), Rval, const(llconst_int16(Int16)))
- ;
- ConsTag = uint16_tag(UInt16),
- TestRval = binop(eq(int_type_uint16), Rval, const(llconst_uint16(UInt16)))
- ;
- ConsTag = int32_tag(Int32),
- TestRval = binop(eq(int_type_int32), Rval, const(llconst_int32(Int32)))
- ;
- ConsTag = uint32_tag(UInt32),
- TestRval = binop(eq(int_type_uint32), Rval, const(llconst_uint32(UInt32)))
+ ConsTag = int_tag(IntTag),
+ int_tag_to_const_and_int_type(IntTag, Const, IntType),
+ TestRval = binop(eq(IntType), Rval, const(Const))
;
ConsTag = foreign_tag(ForeignLang, ForeignVal),
expect(unify(ForeignLang, lang_c), $module, $pred,
@@ -569,36 +549,9 @@ generate_construction_2(ConsTag, LHSVar, RHSVars, ArgModes, ArgWidths,
assign_const_to_var(LHSVar, const(llconst_string(String)), !.CI, !CLD),
Code = empty
;
- ConsTag = int_tag(Int),
- assign_const_to_var(LHSVar, const(llconst_int(Int)), !.CI, !CLD),
- Code = empty
- ;
- ConsTag = uint_tag(UInt),
- assign_const_to_var(LHSVar, const(llconst_uint(UInt)), !.CI, !CLD),
- Code = empty
- ;
- ConsTag = int8_tag(Int8),
- assign_const_to_var(LHSVar, const(llconst_int8(Int8)), !.CI, !CLD),
- Code = empty
- ;
- ConsTag = uint8_tag(UInt8),
- assign_const_to_var(LHSVar, const(llconst_uint8(UInt8)), !.CI, !CLD),
- Code = empty
- ;
- ConsTag = int16_tag(Int16),
- assign_const_to_var(LHSVar, const(llconst_int16(Int16)), !.CI, !CLD),
- Code = empty
- ;
- ConsTag = uint16_tag(UInt16),
- assign_const_to_var(LHSVar, const(llconst_uint16(UInt16)), !.CI, !CLD),
- Code = empty
- ;
- ConsTag = int32_tag(Int32),
- assign_const_to_var(LHSVar, const(llconst_int32(Int32)), !.CI, !CLD),
- Code = empty
- ;
- ConsTag = uint32_tag(UInt32),
- assign_const_to_var(LHSVar, const(llconst_uint32(UInt32)), !.CI, !CLD),
+ ConsTag = int_tag(IntTag),
+ int_tag_to_const_and_int_type(IntTag, Const, _),
+ assign_const_to_var(LHSVar, const(Const), !.CI, !CLD),
Code = empty
;
ConsTag = foreign_tag(Lang, Val),
@@ -1349,14 +1302,7 @@ generate_det_deconstruction_2(Var, Cons, Args, Modes, ArgWidths, Tag,
% the value of the constant, so Code = empty.
(
( Tag = string_tag(_String)
- ; Tag = int_tag(_Int)
- ; Tag = uint_tag(_UInt)
- ; Tag = int8_tag(_Int8)
- ; Tag = uint8_tag(_UInt8)
- ; Tag = int16_tag(_Int16)
- ; Tag = uint16_tag(_UInt16)
- ; Tag = int32_tag(_Int32)
- ; Tag = uint32_tag(_UInt32)
+ ; Tag = int_tag(_)
; Tag = foreign_tag(_, _)
; Tag = float_tag(_Float)
; Tag = closure_tag(_, _, _)
@@ -1862,13 +1808,6 @@ generate_const_struct_rval(ModuleInfo, UnboxedFloats, ConstStructMap,
;
( ConsTag = string_tag(_)
; ConsTag = int_tag(_)
- ; ConsTag = uint_tag(_)
- ; ConsTag = int8_tag(_)
- ; ConsTag = uint8_tag(_)
- ; ConsTag = int16_tag(_)
- ; ConsTag = uint16_tag(_)
- ; ConsTag = int32_tag(_)
- ; ConsTag = uint32_tag(_)
; ConsTag = foreign_tag(_, _)
; ConsTag = float_tag(_)
; ConsTag = shared_local_tag(_, _)
@@ -1923,37 +1862,9 @@ generate_const_struct_arg_tag(ModuleInfo, UnboxedFloats, ConstStructMap,
Const = llconst_string(String),
Type = lt_string
;
- ConsTag = int_tag(Int),
- Const = llconst_int(Int),
- Type = lt_int(int_type_int)
- ;
- ConsTag = uint_tag(UInt),
- Const = llconst_uint(UInt),
- Type = lt_int(int_type_uint)
- ;
- ConsTag = int8_tag(Int8),
- Const = llconst_int8(Int8),
- Type = lt_int(int_type_int8)
- ;
- ConsTag = uint8_tag(UInt8),
- Const = llconst_uint8(UInt8),
- Type = lt_int(int_type_uint8)
- ;
- ConsTag = int16_tag(Int16),
- Const = llconst_int16(Int16),
- Type = lt_int(int_type_int16)
- ;
- ConsTag = uint16_tag(UInt16),
- Const = llconst_uint16(UInt16),
- Type = lt_int(int_type_uint16)
- ;
- ConsTag = int32_tag(Int32),
- Const = llconst_int32(Int32),
- Type = lt_int(int_type_int32)
- ;
- ConsTag = uint32_tag(UInt32),
- Const = llconst_uint32(UInt32),
- Type = lt_int(int_type_uint32)
+ ConsTag = int_tag(IntTag),
+ int_tag_to_const_and_int_type(IntTag, Const, IntType),
+ Type = lt_int(IntType)
;
ConsTag = foreign_tag(Lang, Val),
expect(unify(Lang, lang_c), $module, $pred,
@@ -2128,37 +2039,9 @@ generate_ground_term_conjunct_tag(Var, ConsTag, Args, ConsArgWidths,
Const = llconst_string(String),
Type = lt_string
;
- ConsTag = int_tag(Int),
- Const = llconst_int(Int),
- Type = lt_int(int_type_int)
- ;
- ConsTag = uint_tag(UInt),
- Const = llconst_uint(UInt),
- Type = lt_int(int_type_uint)
- ;
- ConsTag = int8_tag(Int8),
- Const = llconst_int8(Int8),
- Type = lt_int(int_type_int8)
- ;
- ConsTag = uint8_tag(UInt8),
- Const = llconst_uint8(UInt8),
- Type = lt_int(int_type_uint8)
- ;
- ConsTag = int16_tag(Int16),
- Const = llconst_int16(Int16),
- Type = lt_int(int_type_int16)
- ;
- ConsTag = uint16_tag(UInt16),
- Const = llconst_uint16(UInt16),
- Type = lt_int(int_type_uint16)
- ;
- ConsTag = int32_tag(Int32),
- Const = llconst_int32(Int32),
- Type = lt_int(int_type_int32)
- ;
- ConsTag = uint32_tag(UInt32),
- Const = llconst_uint32(UInt32),
- Type = lt_int(int_type_uint32)
+ ConsTag = int_tag(IntTag),
+ int_tag_to_const_and_int_type(IntTag, Const, IntType),
+ Type = lt_int(IntType)
;
ConsTag = foreign_tag(Lang, Val),
expect(unify(Lang, lang_c), $module, $pred,
@@ -2264,6 +2147,44 @@ generate_ground_term_conjunct_tag(Var, ConsTag, Args, ConsArgWidths,
unexpected($module, $pred, "unexpected tag")
).
+:- pred int_tag_to_const_and_int_type(int_tag::in, rval_const::out,
+ int_type::out) is det.
+
+int_tag_to_const_and_int_type(IntTag, Const, Type) :-
+ (
+ IntTag = int_tag_int(Int),
+ Const = llconst_int(Int),
+ Type = int_type_int
+ ;
+ IntTag = int_tag_uint(UInt),
+ Const = llconst_uint(UInt),
+ Type = int_type_uint
+ ;
+ IntTag = int_tag_int8(Int8),
+ Const = llconst_int8(Int8),
+ Type = int_type_int8
+ ;
+ IntTag = int_tag_uint8(UInt8),
+ Const = llconst_uint8(UInt8),
+ Type = int_type_uint8
+ ;
+ IntTag = int_tag_int16(Int16),
+ Const = llconst_int16(Int16),
+ Type = int_type_int16
+ ;
+ IntTag = int_tag_uint16(UInt16),
+ Const = llconst_uint16(UInt16),
+ Type = int_type_uint16
+ ;
+ IntTag = int_tag_int32(Int32),
+ Const = llconst_int32(Int32),
+ Type = int_type_int32
+ ;
+ IntTag = int_tag_uint32(UInt32),
+ Const = llconst_uint32(UInt32),
+ Type = int_type_uint32
+ ).
+
:- pred generate_ground_term_args(list(prog_var)::in, list(arg_width)::in,
list(typed_rval)::out,
active_ground_term_map::in, active_ground_term_map::out) is det.
More information about the reviews
mailing list