Files
mercury/compiler/convert_interface.m
Zoltan Somogyi ab8c2771f7 Move towards generating .opt/.trans_opt files via items.
compiler/prog_item.m:
    Add types for representing .opt and .trans_opt files that specify
    exactly what kinds of items may appear in them.

    Provide a mechanism for representing just the kinds of pragmas
    that we may want to put into .opt files to represent a predicate marker.

    To make the above possible, generalize the item_pragma_info type.

    Do not store the "maybe attributes" field in all pragmas; store it
    in just the one pragma for which it had pragma-specific code (which code
    is dubious anyway). Its only use is to suppress error messages about
    incorrect pragmas if that pragma was created by the compiler, on the
    theory that the user cannot do anything about any such error messages.
    However, if such errors are never reported to anyone, then they won't
    be fixed. I think it is better to allow such problems to be discovered,
    even if they cause a bit of annoyance to the discoverer. The default
    content of the field as set by the parser, item_origin_user, can be
    misleading anway; it is correct when the pragma is read in from a .m file
    or from a .int* file, but it is wrong when read in from a .*opt file,
    since the contents of those are decided by the compiler.

    Store a varset and tvarset in structure sharing and reuse pragmas,
    since without this, one cannot print them out properly.

compiler/intermod.m:
    Change the predicates that write out .opt and .trans_opt files
    to return as large a fraction of the parse trees of those files
    as possible, as a step towards generating those files not directly,
    but by building and then writing out those parse trees. For now,
    we cannot do this fully for .opt files, because for a few item kinds,
    it is far from obvious how to represent as a item what we write out.

    Leave the opening and closing of the file streams for writing out
    .opt and .trans_opt files to our caller, because for .opt files,
    this allows us to avoid having to open the file *twice*.

    Put the output of result-of-analysis pragmas into a standard order.

    Factor out as common code the process for deciding what should go into
    .opt files.

    Give a field of the intermod_info structure a more precise name.

compiler/mercury_compile_front_end.m:
    Hold the stream of the .opt file open between the two different pieces
    of code that write out the two different parts of .opt files.

    If --experiment5 is set, write out the parse tree of the .opt file
    to the .optx file, to enable comparison with the .opt file.

compiler/mercury_compile_middle_passes.m:
    If --experiment5 is set, write out the parse tree of the .trans_opt file
    to the .trans_optx file, to enable comparison with the .trans_opt file.

    Reset a memo table for structure_{sharing,reuse}.analysis.

compiler/structure_reuse.analysis.m:
compiler/structure_sharing.analysis.m:
    Don't take an I/O state pair as arguments, since we needed them *only*
    for that reset, and for progress messages.

    Give the main predicates more descriptive names.

compiler/trailing_analysis.m:
    Give the main predicate a more descriptive names.

compiler/closure_analysis.m:
    Don't take an I/O state pair as arguments, since we needed them *only*
    for progress messages.

compiler/add_pragma.m:
    Don't ignore an error, since one of the other changes in this diff
    could have fixed its cause.

compiler/convert_interface.m:
    Export utility functions needed by code added by this diff.

ompiler/lp_rational.m:
    Tighten the inst of an output argument for use by intermod.m.

    Bring programming style up to date.

compiler/parse_pragma.m:
    Don't put a maybe attributes field into item_pragma_infos.

    Include the varset in structure sharing and reuse pragmas.

    Use simplest_spec where possible.

compiler/parse_tree_out.m:
    Add predicates for writing out the new parse trees of .opt and
    .trans_opt files.

compiler/parse_tree_out_pragma.m:
    Add predicates needed by the new code in parse_tree_out.m.

compiler/add_mutable_aux_preds.m:
compiler/canonicalize_interface.m:
compiler/comp_unit_interface.m:
compiler/equiv_type.m:
compiler/get_dependencies.m:
compiler/grab_modules.m:
compiler/item_util.m:
compiler/make_hlds_error.m:
compiler/make_hlds_passes.m:
compiler/make_hlds_separate_items.m:
compiler/module_qual.qualify_items.m:
compiler/prog_item_stats.m:
compiler/recompilation.version.m:
    Conform to the changes above.
2019-10-30 10:43:39 +11:00

1357 lines
57 KiB
Mathematica

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2019 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% File: convert_interface.m.
% Main author: zs.
%
% This module provides ways to convert between parse_tree_int on the one hand
% and parse_tree_int0, parse_tree_int1, parse_tree_int2 and parse_tree_int3
% on the other hand. The former is a generic data structure for representing
% interface files, while the latter are specialized versions of it that
% encode the different structural invariants on each kind of interface file
% in the type.
%
%---------------------------------------------------------------------------%
:- module parse_tree.convert_interface.
:- interface.
:- import_module mdbcomp.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_item.
:- import_module list.
%---------------------------------------------------------------------------%
% Convert from the interface-file-kind specific parse trees
% to the generic interface file parse tree. These conversions go
% from more restrictive to less restrictive, so they always
% succeed without any problems.
%
:- func convert_parse_tree_int0_to_parse_tree_int(parse_tree_int0)
= parse_tree_int.
:- func convert_parse_tree_int1_to_parse_tree_int(parse_tree_int1)
= parse_tree_int.
:- func convert_parse_tree_int2_to_parse_tree_int(parse_tree_int2)
= parse_tree_int.
:- func convert_parse_tree_int3_to_parse_tree_int(parse_tree_int3)
= parse_tree_int.
% Convert from the generic interface file parse tree to the
% interface-file-kind specific parse trees. These conversions go
% from less restrictive to more restrictive, so they can discover
% problems, which they report as error messages.
%
:- pred convert_parse_tree_int_parse_tree_int0(
parse_tree_int::in, parse_tree_int0::out,
list(error_spec)::in, list(error_spec)::out) is det.
:- pred convert_parse_tree_int_parse_tree_int1(
parse_tree_int::in, parse_tree_int1::out,
list(error_spec)::in, list(error_spec)::out) is det.
:- pred convert_parse_tree_int_parse_tree_int2(
parse_tree_int::in, parse_tree_int2::out,
list(error_spec)::in, list(error_spec)::out) is det.
:- pred convert_parse_tree_int_parse_tree_int3(
parse_tree_int::in, parse_tree_int3::out,
list(error_spec)::in, list(error_spec)::out) is det.
% Functions for gathering up lists of particular kinds of items
% and gathering all items for a given type_ctor (or its inst
% or mode equivalent) together. These are a key component
% of the less to more restrictive conversions above, but they are
% also useful in their own right.
%
:- func type_ctor_defn_items_to_map(list(item_type_defn_info))
= type_ctor_defn_map.
:- func inst_ctor_defn_items_to_map(list(item_inst_defn_info))
= inst_ctor_defn_map.
:- func mode_ctor_defn_items_to_map(list(item_mode_defn_info))
= mode_ctor_defn_map.
:- func type_ctor_repn_items_to_map(list(item_type_repn_info))
= type_ctor_repn_map.
:- func type_ctor_foreign_enum_items_to_map(list(item_foreign_enum_info))
= type_ctor_foreign_enum_map.
%---------------------------------------------------------------------------%
:- func wrap_include(module_name) = item_include.
:- func wrap_import_avail(module_name) = item_avail.
:- func wrap_use_avail(module_name) = item_avail.
:- func wrap_import(module_name) = avail_import_info.
:- func wrap_use(module_name) = avail_use_info.
:- func wrap_type_defn_item(item_type_defn_info) = item.
:- func wrap_inst_defn_item(item_inst_defn_info) = item.
:- func wrap_mode_defn_item(item_mode_defn_info) = item.
:- func wrap_typeclass_item(item_typeclass_info) = item.
:- func wrap_instance_item(item_instance_info) = item.
:- func wrap_pred_decl_item(item_pred_decl_info) = item.
:- func wrap_mode_decl_item(item_mode_decl_info) = item.
:- func wrap_foreign_enum_item(item_foreign_enum_info) = item.
:- func wrap_pragma_item(item_pragma_info) = item.
:- func wrap_promise_item(item_promise_info) = item.
:- func wrap_type_repn_item(item_type_repn_info) = item.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module libs.
:- import_module libs.globals.
:- import_module recompilation.
:- import_module parse_tree.file_kind.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_data_foreign.
:- import_module parse_tree.check_parse_tree_type_defns.
:- import_module cord.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module set.
:- import_module require.
:- import_module term.
:- import_module varset.
%---------------------------------------------------------------------------%
convert_parse_tree_int0_to_parse_tree_int(ParseTreeInt0) = ParseTreeInt :-
ParseTreeInt0 = parse_tree_int0(ModuleName, ModuleNameContext,
MaybeVersionNumbers, IntInclModuleNames, ImpInclModuleNames,
IntImportedModuleNames, IntUsedModuleNames,
ImpImportedModuleNames, ImpUsedModuleNames,
IntFIMSpecs, ImpFIMSpecs,
IntTypeDefnMap, IntInstDefnMap, IntModeDefnMap,
IntTypeClasses, IntInstances, IntPredDecls, IntModeDecls,
IntForeignEnumMap, IntPragmas, IntPromises,
ImpTypeDefnMap, ImpInstDefnMap, ImpModeDefnMap,
ImpTypeClasses, ImpInstances, ImpPredDecls, ImpModeDecls,
ImpForeignEnumMap, ImpPragmas, ImpPromises),
IntIncls = list.map(wrap_include, set.to_sorted_list(IntInclModuleNames)),
ImpIncls = list.map(wrap_include, set.to_sorted_list(ImpInclModuleNames)),
IntImportAvails = list.map(wrap_import_avail,
set.to_sorted_list(IntImportedModuleNames)),
IntUseAvails = list.map(wrap_use_avail,
set.to_sorted_list(IntUsedModuleNames)),
ImpImportAvails = list.map(wrap_import_avail,
set.to_sorted_list(ImpImportedModuleNames)),
ImpUseAvails = list.map(wrap_use_avail,
set.to_sorted_list(ImpUsedModuleNames)),
IntAvails = IntImportAvails ++ IntUseAvails,
ImpAvails = ImpImportAvails ++ ImpUseAvails,
set.to_sorted_list(set.map(fim_spec_to_item, IntFIMSpecs), IntFIMs),
set.to_sorted_list(set.map(fim_spec_to_item, ImpFIMSpecs), ImpFIMs),
IntItems =
type_ctor_defn_map_to_items(IntTypeDefnMap) ++
inst_ctor_defn_map_to_items(IntInstDefnMap) ++
mode_ctor_defn_map_to_items(IntModeDefnMap) ++
list.map(wrap_typeclass_item, IntTypeClasses) ++
list.map(wrap_instance_item, IntInstances) ++
list.map(wrap_pred_decl_item, IntPredDecls) ++
list.map(wrap_mode_decl_item, IntModeDecls) ++
type_ctor_foreign_enum_map_to_items(IntForeignEnumMap) ++
list.map(wrap_pragma_item, IntPragmas) ++
list.map(wrap_promise_item, IntPromises),
ImpItems =
type_ctor_defn_map_to_items(ImpTypeDefnMap) ++
inst_ctor_defn_map_to_items(ImpInstDefnMap) ++
mode_ctor_defn_map_to_items(ImpModeDefnMap) ++
list.map(wrap_typeclass_item, ImpTypeClasses) ++
list.map(wrap_instance_item, ImpInstances) ++
list.map(wrap_pred_decl_item, ImpPredDecls) ++
list.map(wrap_mode_decl_item, ImpModeDecls) ++
type_ctor_foreign_enum_map_to_items(ImpForeignEnumMap) ++
list.map(wrap_pragma_item, ImpPragmas) ++
list.map(wrap_promise_item, ImpPromises),
ParseTreeInt = parse_tree_int(ModuleName, ifk_int0, ModuleNameContext,
MaybeVersionNumbers, IntIncls, ImpIncls, IntAvails, ImpAvails,
IntFIMs, ImpFIMs, IntItems, ImpItems).
convert_parse_tree_int1_to_parse_tree_int(ParseTreeInt1) = ParseTreeInt :-
ParseTreeInt1 = parse_tree_int1(ModuleName, ModuleNameContext,
MaybeVersionNumbers, IntInclModuleNames, ImpInclModuleNames,
IntUsedModuleNames, ImpUsedModuleNames, IntFIMSpecs, ImpFIMSpecs,
IntTypeDefnMap, IntInstDefnMap, IntModeDefnMap,
IntTypeClasses, IntInstances, IntPredDecls, IntModeDecls,
IntForeignEnumMap, IntPragmas, IntPromises, IntTypeRepnMap,
ImpTypeDefnMap, ImpForeignEnumMap, ImpTypeClasses),
IntIncls = list.map(wrap_include,
set.to_sorted_list(IntInclModuleNames)),
ImpIncls = list.map(wrap_include,
set.to_sorted_list(ImpInclModuleNames)),
IntAvails = list.map(wrap_use_avail,
set.to_sorted_list(IntUsedModuleNames)),
ImpAvails = list.map(wrap_use_avail,
set.to_sorted_list(ImpUsedModuleNames)),
set.to_sorted_list(set.map(fim_spec_to_item, IntFIMSpecs), IntFIMs),
set.to_sorted_list(set.map(fim_spec_to_item, ImpFIMSpecs), ImpFIMs),
IntItems =
type_ctor_defn_map_to_items(IntTypeDefnMap) ++
inst_ctor_defn_map_to_items(IntInstDefnMap) ++
mode_ctor_defn_map_to_items(IntModeDefnMap) ++
list.map(wrap_typeclass_item, IntTypeClasses) ++
list.map(wrap_instance_item, IntInstances) ++
list.map(wrap_pred_decl_item, IntPredDecls) ++
list.map(wrap_mode_decl_item, IntModeDecls) ++
type_ctor_foreign_enum_map_to_items(IntForeignEnumMap) ++
list.map(wrap_pragma_item, IntPragmas) ++
list.map(wrap_promise_item, IntPromises) ++
type_ctor_repn_map_to_items(IntTypeRepnMap),
ImpItems =
type_ctor_defn_map_to_items(ImpTypeDefnMap) ++
type_ctor_foreign_enum_map_to_items(ImpForeignEnumMap) ++
list.map(wrap_typeclass_item, ImpTypeClasses),
ParseTreeInt = parse_tree_int(ModuleName, ifk_int1, ModuleNameContext,
MaybeVersionNumbers, IntIncls, ImpIncls, IntAvails, ImpAvails,
IntFIMs, ImpFIMs, IntItems, ImpItems).
convert_parse_tree_int2_to_parse_tree_int(ParseTreeInt2) = ParseTreeInt :-
ParseTreeInt2 = parse_tree_int2(ModuleName, ModuleNameContext,
MaybeVersionNumbers,
IntInclModuleNames, IntUsedModuleNames, IntFIMSpecs, ImpFIMSpecs,
IntTypeDefnMap, IntInstDefnMap, IntModeDefnMap,
IntTypeClasses, IntInstances, IntTypeRepnMap,
ImpTypeDefnMap),
IntIncls = list.map(wrap_include,
set.to_sorted_list(IntInclModuleNames)),
IntAvails = list.map(wrap_use_avail,
set.to_sorted_list(IntUsedModuleNames)),
set.to_sorted_list(set.map(fim_spec_to_item, IntFIMSpecs), IntFIMs),
set.to_sorted_list(set.map(fim_spec_to_item, ImpFIMSpecs), ImpFIMs),
IntItems =
type_ctor_defn_map_to_items(IntTypeDefnMap) ++
inst_ctor_defn_map_to_items(IntInstDefnMap) ++
mode_ctor_defn_map_to_items(IntModeDefnMap) ++
list.map(wrap_typeclass_item, IntTypeClasses) ++
list.map(wrap_instance_item, IntInstances) ++
type_ctor_repn_map_to_items(IntTypeRepnMap),
ImpItems =
type_ctor_defn_map_to_items(ImpTypeDefnMap),
ParseTreeInt = parse_tree_int(ModuleName, ifk_int2, ModuleNameContext,
MaybeVersionNumbers, IntIncls, [], IntAvails, [],
IntFIMs, ImpFIMs, IntItems, ImpItems).
convert_parse_tree_int3_to_parse_tree_int(ParseTreeInt3) = ParseTreeInt :-
ParseTreeInt3 = parse_tree_int3(ModuleName, ModuleNameContext,
IntInclModuleNames, IntImportModuleNames,
IntTypeDefnMap, IntInstDefnMap, IntModeDefnMap,
IntTypeClasses, IntInstances, IntTypeRepnMap),
MaybeVersionNumbers = no_version_numbers,
IntIncls = list.map(wrap_include,
set.to_sorted_list(IntInclModuleNames)),
IntAvails = list.map(wrap_import_avail,
set.to_sorted_list(IntImportModuleNames)),
IntItems =
type_ctor_defn_map_to_items(IntTypeDefnMap) ++
inst_ctor_defn_map_to_items(IntInstDefnMap) ++
mode_ctor_defn_map_to_items(IntModeDefnMap) ++
list.map(wrap_typeclass_item, IntTypeClasses) ++
list.map(wrap_instance_item, IntInstances) ++
type_ctor_repn_map_to_items(IntTypeRepnMap),
ParseTreeInt = parse_tree_int(ModuleName, ifk_int3, ModuleNameContext,
MaybeVersionNumbers, IntIncls, [], IntAvails, [],
[], [], IntItems, []).
%---------------------------------------------------------------------------%
convert_parse_tree_int_parse_tree_int0(ParseTreeInt, ParseTreeInt0, !Specs) :-
ParseTreeInt = parse_tree_int(ModuleName, IntFileKind, ModuleNameContext,
MaybeVersionNumbers, IntIncls, ImpIncls, IntAvails, ImpAvails,
IntFIMs, ImpFIMs, IntItems, ImpItems),
expect(unify(IntFileKind, ifk_int0), $pred,
"trying to convert non-ifk_int0 parse_tree_int to parse_tree_int0"),
list.foldl(add_included_module_name, IntIncls,
set.init, IntInclModuleNames),
list.foldl(add_included_module_name, ImpIncls,
set.init, ImpInclModuleNames),
avail_imports_uses(IntAvails, IntImports, IntUses),
avail_imports_uses(ImpAvails, ImpImports, ImpUses),
IntImportedModules = list.map(get_import_module_name, IntImports),
ImpImportedModules = list.map(get_import_module_name, ImpImports),
IntUsedModules = list.map(get_use_module_name, IntUses),
ImpUsedModules = list.map(get_use_module_name, ImpUses),
set.list_to_set(IntImportedModules, IntImportedModuleNames),
set.list_to_set(ImpImportedModules, ImpImportedModuleNames),
set.list_to_set(IntUsedModules, IntUsedModuleNames),
set.list_to_set(ImpUsedModules, ImpUsedModuleNames),
set.list_to_set(list.map(fim_item_to_spec, IntFIMs), IntFIMSpecs),
set.list_to_set(list.map(fim_item_to_spec, ImpFIMs), ImpFIMSpecs),
classify_int0_items_int_or_imp(IntItems, [], IntTypeDefns,
[], IntInstDefns, [], IntModeDefns,
[], IntTypeClasses0, [], IntInstances0,
[], IntPredDecls0, [], RevIntModeDecls,
[], IntForeignEnums, [], IntPragmas0, [], IntPromises0, !Specs),
IntTypeDefnMap = type_ctor_defn_items_to_map(IntTypeDefns),
IntInstDefnMap = inst_ctor_defn_items_to_map(IntInstDefns),
IntModeDefnMap = mode_ctor_defn_items_to_map(IntModeDefns),
list.sort(IntTypeClasses0, IntTypeClasses),
list.sort(IntInstances0, IntInstances),
list.sort(IntPredDecls0, IntPredDecls),
list.reverse(RevIntModeDecls, IntModeDecls),
IntForeignEnumMap = type_ctor_foreign_enum_items_to_map(IntForeignEnums),
list.sort(IntPragmas0, IntPragmas),
list.sort(IntPromises0, IntPromises),
classify_int0_items_int_or_imp(ImpItems, [], ImpTypeDefns,
[], ImpInstDefns, [], ImpModeDefns,
[], ImpTypeClasses0, [], ImpInstances0,
[], ImpPredDecls0, [], RevImpModeDecls,
[], ImpForeignEnums, [], ImpPragmas0, [], ImpPromises0, !Specs),
ImpTypeDefnMap = type_ctor_defn_items_to_map(ImpTypeDefns),
ImpInstDefnMap = inst_ctor_defn_items_to_map(ImpInstDefns),
ImpModeDefnMap = mode_ctor_defn_items_to_map(ImpModeDefns),
list.sort(ImpTypeClasses0, ImpTypeClasses),
list.sort(ImpInstances0, ImpInstances),
list.sort(ImpPredDecls0, ImpPredDecls),
list.reverse(RevImpModeDecls, ImpModeDecls),
ImpForeignEnumMap = type_ctor_foreign_enum_items_to_map(ImpForeignEnums),
list.sort(ImpPragmas0, ImpPragmas),
list.sort(ImpPromises0, ImpPromises),
% We want only the error messages.
create_type_ctor_checked_map(do_not_insist_on_defn, ModuleName,
IntTypeDefnMap, ImpTypeDefnMap, IntForeignEnumMap, ImpForeignEnumMap,
_TypeDefnCheckedMap, !Specs),
ParseTreeInt0 = parse_tree_int0(ModuleName, ModuleNameContext,
MaybeVersionNumbers, IntInclModuleNames, ImpInclModuleNames,
IntImportedModuleNames, IntUsedModuleNames,
ImpImportedModuleNames, ImpUsedModuleNames,
IntFIMSpecs, ImpFIMSpecs,
IntTypeDefnMap, IntInstDefnMap, IntModeDefnMap,
IntTypeClasses, IntInstances, IntPredDecls, IntModeDecls,
IntForeignEnumMap, IntPragmas, IntPromises,
ImpTypeDefnMap, ImpInstDefnMap, ImpModeDefnMap,
ImpTypeClasses, ImpInstances, ImpPredDecls, ImpModeDecls,
ImpForeignEnumMap, ImpPragmas, ImpPromises).
:- pred classify_int0_items_int_or_imp(list(item)::in,
list(item_type_defn_info)::in, list(item_type_defn_info)::out,
list(item_inst_defn_info)::in, list(item_inst_defn_info)::out,
list(item_mode_defn_info)::in, list(item_mode_defn_info)::out,
list(item_typeclass_info)::in, list(item_typeclass_info)::out,
list(item_instance_info)::in, list(item_instance_info)::out,
list(item_pred_decl_info)::in, list(item_pred_decl_info)::out,
list(item_mode_decl_info)::in, list(item_mode_decl_info)::out,
list(item_foreign_enum_info)::in, list(item_foreign_enum_info)::out,
list(item_pragma_info)::in, list(item_pragma_info)::out,
list(item_promise_info)::in, list(item_promise_info)::out,
list(error_spec)::in, list(error_spec)::out) is det.
classify_int0_items_int_or_imp([], !TypeDefns, !InstDefns, !ModeDefns,
!TypeClasses, !Instances, !PredDecls, !RevModeDecls,
!ForeignEnums, !Pragmas, !Promises, !Specs).
classify_int0_items_int_or_imp([Item | Items], !TypeDefns,
!InstDefns, !ModeDefns,
!TypeClasses, !Instances, !PredDecls, !RevModeDecls,
!ForeignEnums, !Pragmas, !Promises, !Specs) :-
(
Item = item_type_defn(ItemTypeDefn),
!:TypeDefns = [ItemTypeDefn | !.TypeDefns]
;
Item = item_inst_defn(ItemInstDefn),
!:InstDefns = [ItemInstDefn | !.InstDefns]
;
Item = item_mode_defn(ItemModeDefn),
!:ModeDefns = [ItemModeDefn | !.ModeDefns]
;
Item = item_typeclass(ItemTypeClass),
!:TypeClasses = [ItemTypeClass | !.TypeClasses]
;
Item = item_instance(ItemInstance),
!:Instances = [ItemInstance | !.Instances]
;
Item = item_pred_decl(ItemPredDecl),
!:PredDecls = [ItemPredDecl | !.PredDecls]
;
Item = item_mode_decl(ItemModeDecl),
!:RevModeDecls = [ItemModeDecl | !.RevModeDecls]
;
Item = item_foreign_enum(ItemForeignEnum),
!:ForeignEnums = [ItemForeignEnum | !.ForeignEnums]
;
Item = item_pragma(ItemPragma),
!:Pragmas = [ItemPragma | !.Pragmas]
;
Item = item_promise(ItemPromise),
!:Promises = [ItemPromise | !.Promises]
;
( Item = item_clause(_)
; Item = item_foreign_export_enum(_)
; Item = item_initialise(_)
; Item = item_finalise(_)
; Item = item_mutable(_)
; Item = item_type_repn(_)
),
Pieces = [words("A .int0 file may not contain")] ++
item_desc_pieces(Item) ++ [suffix("."), nl],
Spec = error_spec(severity_error, phase_term_to_parse_tree,
[simple_msg(get_item_context(Item), [always(Pieces)])]),
!:Specs = [Spec | !.Specs]
),
classify_int0_items_int_or_imp(Items, !TypeDefns, !InstDefns, !ModeDefns,
!TypeClasses, !Instances, !PredDecls, !RevModeDecls,
!ForeignEnums, !Pragmas, !Promises, !Specs).
%---------------------------------------------------------------------------%
convert_parse_tree_int_parse_tree_int1(ParseTreeInt, ParseTreeInt1, !Specs) :-
ParseTreeInt = parse_tree_int(ModuleName, IntFileKind, ModuleNameContext,
MaybeVersionNumbers, IntIncls, ImpIncls, IntAvails, ImpAvails,
IntFIMs, ImpFIMs, IntItems, ImpItems),
expect(unify(IntFileKind, ifk_int1), $pred,
"trying to convert non-ifk_int1 parse_tree_int to parse_tree_int1"),
list.foldl(add_included_module_name, IntIncls,
set.init, IntInclModuleNames),
list.foldl(add_included_module_name, ImpIncls,
set.init, ImpInclModuleNames),
avail_imports_uses(IntAvails, IntImports, IntUses),
avail_imports_uses(ImpAvails, ImpImports, ImpUses),
IntIntImportContexts = list.map(get_import_context,
IntImports ++ ImpImports),
(
IntIntImportContexts = []
;
IntIntImportContexts = [FirstImportContext | _],
IntImportPieces = [words("A .int2 file may not contain any"),
decl("import_module"), words("declarations."), nl],
IntImportSpec = error_spec(severity_error, phase_term_to_parse_tree,
[simple_msg(FirstImportContext, [always(IntImportPieces)])]),
!:Specs = [IntImportSpec | !.Specs]
),
IntUsedModules = list.map(get_use_module_name, IntUses),
ImpUsedModules = list.map(get_use_module_name, ImpUses),
set.list_to_set(IntUsedModules, IntUsedModuleNames),
set.list_to_set(ImpUsedModules, ImpUsedModuleNames),
set.list_to_set(list.map(fim_item_to_spec, IntFIMs), IntFIMSpecs),
set.list_to_set(list.map(fim_item_to_spec, ImpFIMs), ImpFIMSpecs),
classify_int1_items_int(IntItems, [], IntTypeDefns,
[], IntInstDefns, [], IntModeDefns,
[], IntTypeClasses0, [], IntInstances0,
[], IntPredDecls0, [], RevIntModeDecls,
[], IntForeignEnums, [], IntPragmas0, [], IntPromises0,
[], IntTypeRepns, !Specs),
IntTypeDefnMap = type_ctor_defn_items_to_map(IntTypeDefns),
IntInstDefnMap = inst_ctor_defn_items_to_map(IntInstDefns),
IntModeDefnMap = mode_ctor_defn_items_to_map(IntModeDefns),
list.sort(IntTypeClasses0, IntTypeClasses),
list.sort(IntInstances0, IntInstances),
list.sort(IntPredDecls0, IntPredDecls),
list.reverse(RevIntModeDecls, IntModeDecls),
IntForeignEnumMap = type_ctor_foreign_enum_items_to_map(IntForeignEnums),
list.sort(IntPragmas0, IntPragmas),
list.sort(IntPromises0, IntPromises),
IntTypeRepnMap = type_ctor_repn_items_to_map(IntTypeRepns),
classify_int1_items_imp(ImpItems, [], ImpTypeDefns0,
[], ImpForeignEnums0, [], ImpTypeClasses0, !Specs),
ImpTypeDefnMap = type_ctor_defn_items_to_map(ImpTypeDefns0),
ImpForeignEnumMap = type_ctor_foreign_enum_items_to_map(ImpForeignEnums0),
list.sort(ImpTypeClasses0, ImpTypeClasses),
% We want only the error messages.
create_type_ctor_checked_map(do_not_insist_on_defn, ModuleName,
IntTypeDefnMap, ImpTypeDefnMap, IntForeignEnumMap, ImpForeignEnumMap,
_TypeDefnCheckedMap, !Specs),
ParseTreeInt1 = parse_tree_int1(ModuleName, ModuleNameContext,
MaybeVersionNumbers, IntInclModuleNames, ImpInclModuleNames,
IntUsedModuleNames, ImpUsedModuleNames, IntFIMSpecs, ImpFIMSpecs,
IntTypeDefnMap, IntInstDefnMap, IntModeDefnMap,
IntTypeClasses, IntInstances, IntPredDecls, IntModeDecls,
IntForeignEnumMap, IntPragmas, IntPromises, IntTypeRepnMap,
ImpTypeDefnMap, ImpForeignEnumMap, ImpTypeClasses).
:- pred classify_int1_items_int(list(item)::in,
list(item_type_defn_info)::in, list(item_type_defn_info)::out,
list(item_inst_defn_info)::in, list(item_inst_defn_info)::out,
list(item_mode_defn_info)::in, list(item_mode_defn_info)::out,
list(item_typeclass_info)::in, list(item_typeclass_info)::out,
list(item_instance_info)::in, list(item_instance_info)::out,
list(item_pred_decl_info)::in, list(item_pred_decl_info)::out,
list(item_mode_decl_info)::in, list(item_mode_decl_info)::out,
list(item_foreign_enum_info)::in, list(item_foreign_enum_info)::out,
list(item_pragma_info)::in, list(item_pragma_info)::out,
list(item_promise_info)::in, list(item_promise_info)::out,
list(item_type_repn_info)::in, list(item_type_repn_info)::out,
list(error_spec)::in, list(error_spec)::out) is det.
classify_int1_items_int([], !TypeDefns, !InstDefns, !ModeDefns,
!TypeClasses, !Instances, !PredDecls, !ModeDecls,
!ForeignEnums, !Pragmas, !Promises, !TypeRepns, !Specs).
classify_int1_items_int([Item | Items], !TypeDefns, !InstDefns, !ModeDefns,
!TypeClasses, !Instances, !PredDecls, !ModeDecls,
!ForeignEnums, !Pragmas, !Promises, !TypeRepns, !Specs) :-
(
Item = item_type_defn(ItemTypeDefn),
!:TypeDefns = [ItemTypeDefn | !.TypeDefns]
;
Item = item_inst_defn(ItemInstDefn),
!:InstDefns = [ItemInstDefn | !.InstDefns]
;
Item = item_mode_defn(ItemModeDefn),
!:ModeDefns = [ItemModeDefn | !.ModeDefns]
;
Item = item_typeclass(ItemTypeClass),
!:TypeClasses = [ItemTypeClass | !.TypeClasses]
;
Item = item_instance(ItemInstance),
!:Instances = [ItemInstance | !.Instances]
;
Item = item_type_repn(ItemTypeRepn),
!:TypeRepns = [ItemTypeRepn | !.TypeRepns]
;
Item = item_pred_decl(ItemPredDecl),
!:PredDecls = [ItemPredDecl | !.PredDecls]
;
Item = item_mode_decl(ItemModeDecl),
!:ModeDecls = [ItemModeDecl | !.ModeDecls]
;
Item = item_foreign_enum(ItemForeignEnum),
!:ForeignEnums = [ItemForeignEnum | !.ForeignEnums]
;
Item = item_pragma(ItemPragma),
!:Pragmas = [ItemPragma | !.Pragmas]
;
Item = item_promise(ItemPromise),
ItemPromise = item_promise_info(PromiseType, _, _, _, Context, _),
(
( PromiseType = promise_type_exclusive
; PromiseType = promise_type_exhaustive
; PromiseType = promise_type_exclusive_exhaustive
),
!:Promises = [ItemPromise | !.Promises]
;
PromiseType = promise_type_true,
Pieces = [words("A .int1 file may not contain")] ++
item_desc_pieces(Item) ++
[words("in its interface section."), nl],
Spec = error_spec(severity_error, phase_term_to_parse_tree,
[simple_msg(Context, [always(Pieces)])]),
!:Specs = [Spec | !.Specs]
)
;
( Item = item_clause(_)
; Item = item_foreign_export_enum(_)
; Item = item_initialise(_)
; Item = item_finalise(_)
; Item = item_mutable(_)
),
Pieces = [words("A .int1 file may not contain")] ++
item_desc_pieces(Item) ++
[words("in its interface section."), nl],
Spec = error_spec(severity_error, phase_term_to_parse_tree,
[simple_msg(get_item_context(Item), [always(Pieces)])]),
!:Specs = [Spec | !.Specs]
),
classify_int1_items_int(Items, !TypeDefns, !InstDefns, !ModeDefns,
!TypeClasses, !Instances, !PredDecls, !ModeDecls,
!ForeignEnums, !Pragmas, !Promises, !TypeRepns, !Specs).
:- pred classify_int1_items_imp(list(item)::in,
list(item_type_defn_info)::in, list(item_type_defn_info)::out,
list(item_foreign_enum_info)::in, list(item_foreign_enum_info)::out,
list(item_typeclass_info)::in, list(item_typeclass_info)::out,
list(error_spec)::in, list(error_spec)::out) is det.
classify_int1_items_imp([], !TypeDefns, !ForeignEnums, !TypeClasses, !Specs).
classify_int1_items_imp([Item | Items], !TypeDefns, !ForeignEnums,
!TypeClasses, !Specs) :-
(
Item = item_type_defn(ItemTypeDefn),
!:TypeDefns = [ItemTypeDefn | !.TypeDefns]
;
Item = item_typeclass(ItemTypeClass),
!:TypeClasses = [ItemTypeClass | !.TypeClasses]
;
Item = item_foreign_enum(ItemForeignEnum),
!:ForeignEnums = [ItemForeignEnum | !.ForeignEnums]
;
( Item = item_inst_defn(_)
; Item = item_mode_defn(_)
; Item = item_instance(_)
; Item = item_pred_decl(_)
; Item = item_clause(_)
; Item = item_mode_decl(_)
; Item = item_foreign_export_enum(_)
; Item = item_pragma(_)
; Item = item_promise(_)
; Item = item_initialise(_)
; Item = item_finalise(_)
; Item = item_mutable(_)
; Item = item_type_repn(_)
),
Pieces = [words("A .int file may not contain")] ++
item_desc_pieces(Item) ++
[words("in its implementation section."), nl],
Spec = error_spec(severity_error, phase_term_to_parse_tree,
[simple_msg(get_item_context(Item), [always(Pieces)])]),
!:Specs = [Spec | !.Specs]
),
classify_int1_items_imp(Items, !TypeDefns, !ForeignEnums,
!TypeClasses, !Specs).
%---------------------------------------------------------------------------%
convert_parse_tree_int_parse_tree_int2(ParseTreeInt, ParseTreeInt2, !Specs) :-
ParseTreeInt = parse_tree_int(ModuleName, IntFileKind, ModuleNameContext,
MaybeVersionNumbers, IntIncls, ImpIncls, IntAvails, ImpAvails,
IntFIMs, ImpFIMs, IntItems, ImpItems),
expect(unify(IntFileKind, ifk_int2), $pred,
"trying to convert non-ifk_int2 parse_tree_int to parse_tree_int2"),
list.foldl(add_included_module_name, IntIncls,
set.init, IntInclModuleNames),
(
ImpIncls = []
;
ImpIncls = [FirstImpIncl | _],
ImpInclPieces = [words("A .int2 file may not contain any"),
decl("include_module"), words("declarations"),
words("in its implementation section."), nl],
ImpInclSpec = error_spec(severity_error, phase_term_to_parse_tree,
[simple_msg(FirstImpIncl ^ incl_context,
[always(ImpInclPieces)])]),
!:Specs = [ImpInclSpec | !.Specs]
),
avail_imports_uses(IntAvails, IntImports, IntUses),
(
IntImports = []
;
IntImports = [FirstIntImport | _],
IntImportPieces = [words("A .int2 file may not contain any"),
decl("import_module"), words("declarations."), nl],
IntImportSpec = error_spec(severity_error, phase_term_to_parse_tree,
[simple_msg(FirstIntImport ^ aii_context,
[always(IntImportPieces)])]),
!:Specs = [IntImportSpec | !.Specs]
),
IntUsedModules = list.map(get_use_module_name, IntUses),
set.list_to_set(IntUsedModules, IntUsedModuleNames),
(
ImpAvails = []
;
ImpAvails = [FirstImpAvail | _],
ImpAvailPieces = [words("A .int2 file may not contain any"),
decl("import_module"), words("or"), decl("use_module"),
words("declarations in its implementation section."), nl],
ImpAvailSpec = error_spec(severity_error, phase_term_to_parse_tree,
[simple_msg(get_avail_context(FirstImpAvail),
[always(ImpAvailPieces)])]),
!:Specs = [ImpAvailSpec | !.Specs]
),
set.list_to_set(list.map(fim_item_to_spec, IntFIMs), IntFIMSpecs),
set.list_to_set(list.map(fim_item_to_spec, ImpFIMs), ImpFIMSpecs),
classify_int2_items_int(IntItems, [], IntTypeDefns0,
[], IntInstDefns0, [], IntModeDefns0,
[], IntTypeClasses0, [], IntInstances0, [], IntTypeRepns0, !Specs),
IntTypeDefnMap = type_ctor_defn_items_to_map(IntTypeDefns0),
IntInstDefnMap = inst_ctor_defn_items_to_map(IntInstDefns0),
IntModeDefnMap = mode_ctor_defn_items_to_map(IntModeDefns0),
list.sort(IntTypeClasses0, IntTypeClasses),
list.sort(IntInstances0, IntInstances),
IntTypeRepnMap = type_ctor_repn_items_to_map(IntTypeRepns0),
classify_int2_items_imp(ImpItems, [], ImpTypeDefns0, !Specs),
ImpTypeDefnMap = type_ctor_defn_items_to_map(ImpTypeDefns0),
map.init(IntForeignEnumMap),
map.init(ImpForeignEnumMap),
% We want only the error messages.
create_type_ctor_checked_map(do_not_insist_on_defn, ModuleName,
IntTypeDefnMap, ImpTypeDefnMap, IntForeignEnumMap, ImpForeignEnumMap,
_TypeDefnCheckedMap, !Specs),
ParseTreeInt2 = parse_tree_int2(ModuleName, ModuleNameContext,
MaybeVersionNumbers,
IntInclModuleNames, IntUsedModuleNames, IntFIMSpecs, ImpFIMSpecs,
IntTypeDefnMap, IntInstDefnMap, IntModeDefnMap,
IntTypeClasses, IntInstances, IntTypeRepnMap,
ImpTypeDefnMap).
:- pred classify_int2_items_int(list(item)::in,
list(item_type_defn_info)::in, list(item_type_defn_info)::out,
list(item_inst_defn_info)::in, list(item_inst_defn_info)::out,
list(item_mode_defn_info)::in, list(item_mode_defn_info)::out,
list(item_typeclass_info)::in, list(item_typeclass_info)::out,
list(item_instance_info)::in, list(item_instance_info)::out,
list(item_type_repn_info)::in, list(item_type_repn_info)::out,
list(error_spec)::in, list(error_spec)::out) is det.
classify_int2_items_int([], !TypeDefns, !InstDefns, !ModeDefns,
!TypeClasses, !Instances, !TypeRepns, !Specs).
classify_int2_items_int([Item | Items], !TypeDefns, !InstDefns, !ModeDefns,
!TypeClasses, !Instances, !TypeRepns, !Specs) :-
(
Item = item_type_defn(ItemTypeDefn),
!:TypeDefns = [ItemTypeDefn | !.TypeDefns]
;
Item = item_inst_defn(ItemInstDefn),
!:InstDefns = [ItemInstDefn | !.InstDefns]
;
Item = item_mode_defn(ItemModeDefn),
!:ModeDefns = [ItemModeDefn | !.ModeDefns]
;
Item = item_typeclass(ItemTypeClass),
!:TypeClasses = [ItemTypeClass | !.TypeClasses]
;
Item = item_instance(ItemInstance),
!:Instances = [ItemInstance | !.Instances]
;
Item = item_type_repn(ItemTypeRepn),
!:TypeRepns = [ItemTypeRepn | !.TypeRepns]
;
( Item = item_pred_decl(_)
; Item = item_mode_decl(_)
; Item = item_clause(_)
; Item = item_foreign_enum(_)
; Item = item_foreign_export_enum(_)
; Item = item_pragma(_)
; Item = item_promise(_)
; Item = item_initialise(_)
; Item = item_finalise(_)
; Item = item_mutable(_)
),
Pieces = [words("A .int2 file may not contain")] ++
item_desc_pieces(Item) ++
[words("in its interface section."), nl],
Spec = error_spec(severity_error, phase_term_to_parse_tree,
[simple_msg(get_item_context(Item), [always(Pieces)])]),
!:Specs = [Spec | !.Specs]
),
classify_int2_items_int(Items, !TypeDefns, !InstDefns, !ModeDefns,
!TypeClasses, !Instances, !TypeRepns, !Specs).
:- pred classify_int2_items_imp(list(item)::in,
list(item_type_defn_info)::in, list(item_type_defn_info)::out,
list(error_spec)::in, list(error_spec)::out) is det.
classify_int2_items_imp([], !TypeDefns, !Specs).
classify_int2_items_imp([Item | Items], !TypeDefns, !Specs) :-
(
Item = item_type_defn(ItemTypeDefn),
!:TypeDefns = [ItemTypeDefn | !.TypeDefns]
;
( Item = item_inst_defn(_)
; Item = item_mode_defn(_)
; Item = item_typeclass(_)
; Item = item_instance(_)
; Item = item_pred_decl(_)
; Item = item_clause(_)
; Item = item_mode_decl(_)
; Item = item_foreign_enum(_)
; Item = item_foreign_export_enum(_)
; Item = item_pragma(_)
; Item = item_promise(_)
; Item = item_initialise(_)
; Item = item_finalise(_)
; Item = item_mutable(_)
; Item = item_type_repn(_)
),
Pieces = [words("A .int2 file may not contain")] ++
item_desc_pieces(Item) ++
[words("in its implementation section."), nl],
Spec = error_spec(severity_error, phase_term_to_parse_tree,
[simple_msg(get_item_context(Item), [always(Pieces)])]),
!:Specs = [Spec | !.Specs]
),
classify_int2_items_imp(Items, !TypeDefns, !Specs).
%---------------------------------------------------------------------------%
convert_parse_tree_int_parse_tree_int3(ParseTreeInt, ParseTreeInt3, !Specs) :-
ParseTreeInt = parse_tree_int(ModuleName, IntFileKind, ModuleNameContext,
MaybeVersionNumbers, IntIncls, ImpIncls, IntAvails, ImpAvails,
IntFIMs, ImpFIMs, IntItems, ImpItems),
expect(unify(IntFileKind, ifk_int3), $pred,
"trying to convert non-ifk_int3 parse_tree_int to parse_tree_int3"),
(
MaybeVersionNumbers = no_version_numbers
;
MaybeVersionNumbers = version_numbers(_),
VNPieces = [words("A .int3 file may not contain"),
words("version number information."), nl],
% MaybeVersionNumbers itself contains no context information.
VNSpec = error_spec(severity_error, phase_term_to_parse_tree,
[simple_msg(ModuleNameContext, [always(VNPieces)])]),
!:Specs = [VNSpec | !.Specs]
),
list.foldl(add_included_module_name, IntIncls,
set.init, IntInclModuleNames),
avail_imports_uses(IntAvails, IntImports, IntUses),
IntImportModules = list.map(get_import_module_name, IntImports),
set.list_to_set(IntImportModules, IntImportModuleNames),
(
IntUses = []
;
IntUses = [FirstIntUse | _],
IntUsePieces = [words("A .int3 file may not contain any"),
decl("use_module"), words("declarations."), nl],
IntUseSpec = error_spec(severity_error, phase_term_to_parse_tree,
[simple_msg(FirstIntUse ^ aui_context, [always(IntUsePieces)])]),
!:Specs = [IntUseSpec | !.Specs]
),
(
IntFIMs = []
;
IntFIMs = [FirstIntFIM | _],
IntFIMPieces = [words("A .int3 file may not contain any"),
pragma_decl("foreign_import_module"), words("declarations."), nl],
IntFIMSpec = error_spec(severity_error, phase_term_to_parse_tree,
[simple_msg(FirstIntFIM ^ fim_context, [always(IntFIMPieces)])]),
!:Specs = [IntFIMSpec | !.Specs]
),
classify_int3_items_int(IntItems, [], IntTypeDefns0,
[], IntInstDefns0, [], IntModeDefns0,
[], IntTypeClasses0, [], IntInstances0, [], IntTypeRepns0, !Specs),
IntTypeDefnMap = type_ctor_defn_items_to_map(IntTypeDefns0),
IntInstDefnMap = inst_ctor_defn_items_to_map(IntInstDefns0),
IntModeDefnMap = mode_ctor_defn_items_to_map(IntModeDefns0),
list.sort(IntTypeClasses0, IntTypeClasses),
list.sort(IntInstances0, IntInstances),
IntTypeRepnMap = type_ctor_repn_items_to_map(IntTypeRepns0),
map.init(ImpTypeDefnMap),
map.init(IntForeignEnumMap),
map.init(ImpForeignEnumMap),
% We want only the error messages.
create_type_ctor_checked_map(do_not_insist_on_defn, ModuleName,
IntTypeDefnMap, ImpTypeDefnMap, IntForeignEnumMap, ImpForeignEnumMap,
_TypeDefnCheckedMap, !Specs),
some [!ImpContexts]
(
!:ImpContexts = [],
(
ImpIncls = []
;
ImpIncls = [HeadIncl | _],
!:ImpContexts = [HeadIncl ^ incl_context | !.ImpContexts]
),
(
ImpAvails = []
;
ImpAvails = [HeadAvail | _],
!:ImpContexts = [get_avail_context(HeadAvail) | !.ImpContexts]
),
(
ImpFIMs = []
;
ImpFIMs = [HeadFIM | _],
!:ImpContexts = [HeadFIM ^ fim_context | !.ImpContexts]
),
(
ImpItems = []
;
ImpItems = [HeadImpItem | _],
!:ImpContexts = [get_item_context(HeadImpItem) | !.ImpContexts]
),
list.sort(!ImpContexts),
(
!.ImpContexts = []
;
!.ImpContexts = [FirstImpContext | _],
ImpItemPieces = [words("A .int3 file must not have"),
words("an implementation section."), nl],
ImpItemSpec = error_spec(severity_error, phase_term_to_parse_tree,
[simple_msg(FirstImpContext, [always(ImpItemPieces)])]),
!:Specs = [ImpItemSpec | !.Specs]
)
),
ParseTreeInt3 = parse_tree_int3(ModuleName, ModuleNameContext,
IntInclModuleNames, IntImportModuleNames,
IntTypeDefnMap, IntInstDefnMap, IntModeDefnMap,
IntTypeClasses, IntInstances, IntTypeRepnMap).
:- pred classify_int3_items_int(list(item)::in,
list(item_type_defn_info)::in, list(item_type_defn_info)::out,
list(item_inst_defn_info)::in, list(item_inst_defn_info)::out,
list(item_mode_defn_info)::in, list(item_mode_defn_info)::out,
list(item_typeclass_info)::in, list(item_typeclass_info)::out,
list(item_instance_info)::in, list(item_instance_info)::out,
list(item_type_repn_info)::in, list(item_type_repn_info)::out,
list(error_spec)::in, list(error_spec)::out) is det.
classify_int3_items_int([], !TypeDefns, !InstDefns, !ModeDefns,
!TypeClasses, !Instances, !TypeRepns, !Specs).
classify_int3_items_int([Item | Items], !TypeDefns, !InstDefns, !ModeDefns,
!TypeClasses, !Instances, !TypeRepns, !Specs) :-
(
Item = item_type_defn(ItemTypeDefn),
!:TypeDefns = [ItemTypeDefn | !.TypeDefns]
;
Item = item_inst_defn(ItemInstDefn),
!:InstDefns = [ItemInstDefn | !.InstDefns]
;
Item = item_mode_defn(ItemModeDefn),
!:ModeDefns = [ItemModeDefn | !.ModeDefns]
;
Item = item_typeclass(ItemTypeClass),
!:TypeClasses = [ItemTypeClass | !.TypeClasses]
;
Item = item_instance(ItemInstance),
!:Instances = [ItemInstance | !.Instances]
;
Item = item_type_repn(ItemTypeRepn),
!:TypeRepns = [ItemTypeRepn | !.TypeRepns]
;
( Item = item_pred_decl(_)
; Item = item_clause(_)
; Item = item_mode_decl(_)
; Item = item_foreign_enum(_)
; Item = item_foreign_export_enum(_)
; Item = item_pragma(_)
; Item = item_promise(_)
; Item = item_initialise(_)
; Item = item_finalise(_)
; Item = item_mutable(_)
),
Pieces = [words("A .int3 file may not contain")] ++
item_desc_pieces(Item) ++
[words("in its interface section."), nl],
Spec = error_spec(severity_error, phase_term_to_parse_tree,
[simple_msg(get_item_context(Item), [always(Pieces)])]),
!:Specs = [Spec | !.Specs]
),
classify_int3_items_int(Items, !TypeDefns, !InstDefns, !ModeDefns,
!TypeClasses, !Instances, !TypeRepns, !Specs).
%---------------------------------------------------------------------------%
type_ctor_defn_items_to_map(TypeDefnInfos) = TypeDefnMap :-
list.foldl(add_type_defn_to_map, TypeDefnInfos, map.init, TypeDefnMap).
:- pred add_type_defn_to_map(item_type_defn_info::in,
type_ctor_defn_map::in, type_ctor_defn_map::out) is det.
add_type_defn_to_map(TypeDefnInfo, !TypeDefnMap) :-
TypeDefnInfo = item_type_defn_info(SymName, Params, TypeDefn,
_TypeVarSet, _Context, _SeqNum),
list.length(Params, Arity),
TypeCtor = type_ctor(SymName, Arity),
some [!AbstractSolverDefns, !SolverDefns,
!AbstractStdDefns, !EqvDefns, !DuDefns,
!ForeignDefnsC, !ForeignDefnsJava,
!ForeignDefnsCsharp, !ForeignDefnsErlang]
(
( if map.search(!.TypeDefnMap, TypeCtor, AllDefns0) then
AllDefns0 = type_ctor_all_defns(
!:AbstractSolverDefns, !:SolverDefns,
!:AbstractStdDefns, !:EqvDefns, !:DuDefns,
c_java_csharp_erlang(!:ForeignDefnsC, !:ForeignDefnsJava,
!:ForeignDefnsCsharp, !:ForeignDefnsErlang))
else
!:AbstractSolverDefns = [],
!:SolverDefns = [],
!:AbstractStdDefns = [],
!:EqvDefns = [],
!:DuDefns = [],
!:ForeignDefnsC = [],
!:ForeignDefnsJava = [],
!:ForeignDefnsCsharp = [],
!:ForeignDefnsErlang = []
),
(
TypeDefn = parse_tree_abstract_type(DetailsAbstract),
AbstractDefnInfo = TypeDefnInfo ^ td_ctor_defn := DetailsAbstract,
(
DetailsAbstract = abstract_solver_type,
!:AbstractSolverDefns = !.AbstractSolverDefns ++
[AbstractDefnInfo]
;
( DetailsAbstract = abstract_type_general
; DetailsAbstract = abstract_type_fits_in_n_bits(_)
; DetailsAbstract = abstract_dummy_type
; DetailsAbstract = abstract_notag_type
),
!:AbstractStdDefns = !.AbstractStdDefns ++ [AbstractDefnInfo]
)
;
TypeDefn = parse_tree_solver_type(DetailsSolver),
SolverDefnInfo = TypeDefnInfo ^ td_ctor_defn := DetailsSolver,
!:SolverDefns = !.SolverDefns ++ [SolverDefnInfo]
;
TypeDefn = parse_tree_eqv_type(DetailsEqv),
EqvDefnInfo = TypeDefnInfo ^ td_ctor_defn := DetailsEqv,
!:EqvDefns = !.EqvDefns ++ [EqvDefnInfo]
;
TypeDefn = parse_tree_du_type(DetailsDu),
DuDefnInfo = TypeDefnInfo ^ td_ctor_defn := DetailsDu,
!:DuDefns = !.DuDefns ++ [DuDefnInfo]
;
TypeDefn = parse_tree_foreign_type(DetailsForeign),
ForeignDefnInfo = TypeDefnInfo ^ td_ctor_defn := DetailsForeign,
DetailsForeign = type_details_foreign(LangType, _, _),
(
LangType = c(_),
!:ForeignDefnsC = !.ForeignDefnsC ++ [ForeignDefnInfo]
;
LangType = java(_),
!:ForeignDefnsJava = !.ForeignDefnsJava ++ [ForeignDefnInfo]
;
LangType = csharp(_),
!:ForeignDefnsCsharp = !.ForeignDefnsCsharp ++
[ForeignDefnInfo]
;
LangType = erlang(_),
!:ForeignDefnsErlang = !.ForeignDefnsErlang ++
[ForeignDefnInfo]
)
),
AllDefns = type_ctor_all_defns(!.AbstractSolverDefns, !.SolverDefns,
!.AbstractStdDefns, !.EqvDefns, !.DuDefns,
c_java_csharp_erlang(!.ForeignDefnsC, !.ForeignDefnsJava,
!.ForeignDefnsCsharp, !.ForeignDefnsErlang))
),
map.set(TypeCtor, AllDefns, !TypeDefnMap).
inst_ctor_defn_items_to_map(InstDefnInfos) = InstDefnMap :-
list.foldl(add_inst_defn_to_map, InstDefnInfos, map.init, InstDefnMap).
:- pred add_inst_defn_to_map(item_inst_defn_info::in,
inst_ctor_defn_map::in, inst_ctor_defn_map::out) is det.
add_inst_defn_to_map(InstDefnInfo, !InstDefnMap) :-
InstDefnInfo = item_inst_defn_info(SymName, Params, _MaybeForTypeCtor,
MaybeAbstractInstDefn, _InstVarSet, _Context, _SeqNum),
list.length(Params, Arity),
SNA = sym_name_arity(SymName, Arity),
( if map.search(!.InstDefnMap, SNA, AllDefns0) then
AllDefns0 = inst_ctor_all_defns(AbstractDefns0, NonAbstractDefns0),
(
MaybeAbstractInstDefn = abstract_inst_defn,
AbstractDefns = [InstDefnInfo | AbstractDefns0],
AllDefns = inst_ctor_all_defns(AbstractDefns, NonAbstractDefns0)
;
MaybeAbstractInstDefn = nonabstract_inst_defn(_),
NonAbstractDefns = [InstDefnInfo | NonAbstractDefns0],
AllDefns = inst_ctor_all_defns(AbstractDefns0, NonAbstractDefns)
),
map.det_update(SNA, AllDefns, !InstDefnMap)
else
(
MaybeAbstractInstDefn = abstract_inst_defn,
AllDefns = inst_ctor_all_defns([InstDefnInfo], [])
;
MaybeAbstractInstDefn = nonabstract_inst_defn(_),
AllDefns = inst_ctor_all_defns([], [InstDefnInfo])
),
map.det_insert(SNA, AllDefns, !InstDefnMap)
).
mode_ctor_defn_items_to_map(ModeDefnInfos) = ModeDefnMap :-
list.foldl(add_mode_defn_to_map, ModeDefnInfos, map.init, ModeDefnMap).
:- pred add_mode_defn_to_map(item_mode_defn_info::in,
mode_ctor_defn_map::in, mode_ctor_defn_map::out) is det.
add_mode_defn_to_map(ModeDefnInfo, !ModeDefnMap) :-
ModeDefnInfo = item_mode_defn_info(SymName, Params, MaybeAbstractModeDefn,
_InstVarSet, _Context, _SeqNum),
list.length(Params, Arity),
SNA = sym_name_arity(SymName, Arity),
( if map.search(!.ModeDefnMap, SNA, AllDefns0) then
AllDefns0 = mode_ctor_all_defns(AbstractDefns0, NonAbstractDefns0),
(
MaybeAbstractModeDefn = abstract_mode_defn,
AbstractDefns = [ModeDefnInfo | AbstractDefns0],
AllDefns = mode_ctor_all_defns(AbstractDefns, NonAbstractDefns0)
;
MaybeAbstractModeDefn = nonabstract_mode_defn(_),
NonAbstractDefns = [ModeDefnInfo | NonAbstractDefns0],
AllDefns = mode_ctor_all_defns(AbstractDefns0, NonAbstractDefns)
),
map.det_update(SNA, AllDefns, !ModeDefnMap)
else
(
MaybeAbstractModeDefn = abstract_mode_defn,
AllDefns = mode_ctor_all_defns([ModeDefnInfo], [])
;
MaybeAbstractModeDefn = nonabstract_mode_defn(_),
AllDefns = mode_ctor_all_defns([], [ModeDefnInfo])
),
map.det_insert(SNA, AllDefns, !ModeDefnMap)
).
type_ctor_repn_items_to_map(TypeRepnInfos) = TypeRepnMap :-
list.foldl(add_type_repn_to_map, TypeRepnInfos, map.init, TypeRepnMap).
:- pred add_type_repn_to_map(item_type_repn_info::in,
type_ctor_repn_map::in, type_ctor_repn_map::out) is det.
add_type_repn_to_map(TypeRepnInfo, !TypeRepnMap) :-
TypeRepnInfo = item_type_repn_info(SymName, Params, _TypeRepn,
_TypeVarSet, _Context, _SeqNum),
list.length(Params, Arity),
TypeCtor = type_ctor(SymName, Arity),
% This could be a map.det_insert, because
%
% - we ensure the invariant that an interface file contains at most one
% type_repn item for a given type_ctor, and
%
% - source files should not contain any type_ctor items, because they are
% not a publicly documented part of the language.
%
% However, until we have code to filter out all type_repn items from
% source files, they may contain duplicates, so we keep this as map.set
% for now.
map.set(TypeCtor, TypeRepnInfo, !TypeRepnMap).
type_ctor_foreign_enum_items_to_map(ForeignEnums) = ForeignEnumMap :-
list.foldl(add_foreign_enum_item_to_map, ForeignEnums,
map.init, ForeignEnumMap).
:- pred add_foreign_enum_item_to_map(item_foreign_enum_info::in,
type_ctor_foreign_enum_map::in, type_ctor_foreign_enum_map::out) is det.
add_foreign_enum_item_to_map(ForeignEnumInfo, !ForeignEnumMap) :-
ForeignEnumInfo = item_foreign_enum_info(Lang, TypeCtor, _Values, _, _),
some [!ForeignEnumsC, !ForeignEnumsJava,
!ForeignEnumsCsharp, !ForeignEnumsErlang]
(
( if map.search(!.ForeignEnumMap, TypeCtor, AllEnums0) then
AllEnums0 = c_java_csharp_erlang(!:ForeignEnumsC,
!:ForeignEnumsJava, !:ForeignEnumsCsharp, !:ForeignEnumsErlang)
else
!:ForeignEnumsC = [],
!:ForeignEnumsJava = [],
!:ForeignEnumsCsharp = [],
!:ForeignEnumsErlang = []
),
(
Lang = lang_c,
!:ForeignEnumsC = !.ForeignEnumsC ++ [ForeignEnumInfo]
;
Lang = lang_java,
!:ForeignEnumsJava = !.ForeignEnumsJava ++ [ForeignEnumInfo]
;
Lang = lang_csharp,
!:ForeignEnumsCsharp = !.ForeignEnumsCsharp ++ [ForeignEnumInfo]
;
Lang = lang_erlang,
!:ForeignEnumsErlang = !.ForeignEnumsErlang ++ [ForeignEnumInfo]
),
AllEnums = c_java_csharp_erlang(!.ForeignEnumsC,
!.ForeignEnumsJava, !.ForeignEnumsCsharp, !.ForeignEnumsErlang),
map.set(TypeCtor, AllEnums, !ForeignEnumMap)
).
%---------------------------------------------------------------------------%
:- func type_ctor_defn_map_to_items(type_ctor_defn_map) = list(item).
type_ctor_defn_map_to_items(TypeCtorDefnMap) = Items :-
map.foldl_values(accumulate_type_ctor_defns, TypeCtorDefnMap,
cord.init, TypeDefnsCord),
TypeDefns = cord.list(TypeDefnsCord),
Items = list.map(wrap_type_defn_item, TypeDefns).
:- pred accumulate_type_ctor_defns(type_ctor_all_defns::in,
cord(item_type_defn_info)::in, cord(item_type_defn_info)::out) is det.
accumulate_type_ctor_defns(CtorAllDefns, !TypeDefns) :-
CtorAllDefns = type_ctor_all_defns(AbstractSolverDefns, SolverDefns,
AbstractStdDefns, EqvDefns, DuDefns, CJCsEDefns),
CJCsEDefns = c_java_csharp_erlang(ForeignDefnsC, ForeignDefnsJava,
ForeignDefnsCsharp, ForeignDefnsErlang),
!:TypeDefns = !.TypeDefns ++ cord.from_list(
list.map(wrap_abstract_type_defn, at_most_one(AbstractSolverDefns)) ++
list.map(wrap_solver_type_defn, SolverDefns) ++
list.map(wrap_abstract_type_defn, at_most_one(AbstractStdDefns)) ++
list.map(wrap_eqv_type_defn, EqvDefns) ++
list.map(wrap_du_type_defn, DuDefns) ++
list.map(wrap_foreign_type_defn, ForeignDefnsC) ++
list.map(wrap_foreign_type_defn, ForeignDefnsJava) ++
list.map(wrap_foreign_type_defn, ForeignDefnsCsharp) ++
list.map(wrap_foreign_type_defn, ForeignDefnsErlang)).
:- func at_most_one(list(T)) = list(T).
at_most_one([]) = [].
at_most_one([X | _Xs]) = [X].
:- func wrap_abstract_type_defn(item_type_defn_info_abstract)
= item_type_defn_info.
wrap_abstract_type_defn(AbstractDefnInfo) = TypeDefnInfo :-
AbstractDefn = AbstractDefnInfo ^ td_ctor_defn,
TypeDefnInfo = AbstractDefnInfo ^ td_ctor_defn
:= parse_tree_abstract_type(AbstractDefn).
:- func wrap_solver_type_defn(item_type_defn_info_solver)
= item_type_defn_info.
wrap_solver_type_defn(SolverDefnInfo) = TypeDefnInfo :-
SolverDefn = SolverDefnInfo ^ td_ctor_defn,
TypeDefnInfo = SolverDefnInfo ^ td_ctor_defn
:= parse_tree_solver_type(SolverDefn).
:- func wrap_eqv_type_defn(item_type_defn_info_eqv)
= item_type_defn_info.
wrap_eqv_type_defn(EqvDefnInfo) = TypeDefnInfo :-
EqvDefn = EqvDefnInfo ^ td_ctor_defn,
TypeDefnInfo = EqvDefnInfo ^ td_ctor_defn
:= parse_tree_eqv_type(EqvDefn).
:- func wrap_du_type_defn(item_type_defn_info_du)
= item_type_defn_info.
wrap_du_type_defn(DuDefnInfo) = TypeDefnInfo :-
DuDefn = DuDefnInfo ^ td_ctor_defn,
TypeDefnInfo = DuDefnInfo ^ td_ctor_defn
:= parse_tree_du_type(DuDefn).
:- func wrap_foreign_type_defn(item_type_defn_info_foreign)
= item_type_defn_info.
wrap_foreign_type_defn(ForeignDefnInfo) = TypeDefnInfo :-
ForeignDefn = ForeignDefnInfo ^ td_ctor_defn,
TypeDefnInfo = ForeignDefnInfo ^ td_ctor_defn
:= parse_tree_foreign_type(ForeignDefn).
%---------------------%
:- func inst_ctor_defn_map_to_items(inst_ctor_defn_map) = list(item).
inst_ctor_defn_map_to_items(InstCtorDefnMap) = Items :-
map.foldl_values(accumulate_inst_ctor_defns, InstCtorDefnMap,
cord.init, InstDefnsCord),
InstDefns = cord.list(InstDefnsCord),
Items = list.map(wrap_inst_defn_item, InstDefns).
:- pred accumulate_inst_ctor_defns(inst_ctor_all_defns::in,
cord(item_inst_defn_info)::in, cord(item_inst_defn_info)::out) is det.
accumulate_inst_ctor_defns(CtorAllDefns, !InstDefns) :-
CtorAllDefns = inst_ctor_all_defns(AbstractDefns, EqvDefns),
!:InstDefns = !.InstDefns ++
cord.from_list(AbstractDefns) ++
cord.from_list(EqvDefns).
:- func mode_ctor_defn_map_to_items(mode_ctor_defn_map) = list(item).
mode_ctor_defn_map_to_items(ModeCtorDefnMap) = Items :-
map.foldl_values(accumulate_mode_ctor_defns, ModeCtorDefnMap,
cord.init, ModeDefnsCord),
ModeDefns = cord.list(ModeDefnsCord),
Items = list.map(wrap_mode_defn_item, ModeDefns).
:- pred accumulate_mode_ctor_defns(mode_ctor_all_defns::in,
cord(item_mode_defn_info)::in, cord(item_mode_defn_info)::out) is det.
accumulate_mode_ctor_defns(CtorAllDefns, !ModeDefns) :-
CtorAllDefns = mode_ctor_all_defns(AbstractDefns, EqvDefns),
!:ModeDefns = !.ModeDefns ++
cord.from_list(AbstractDefns) ++
cord.from_list(EqvDefns).
:- func type_ctor_repn_map_to_items(type_ctor_repn_map) = list(item).
type_ctor_repn_map_to_items(TypeCtorRepnMap) = Items :-
map.foldl_values(accumulate_type_ctor_repns, TypeCtorRepnMap,
cord.init, TypeRepnsCord),
TypeRepns = cord.list(TypeRepnsCord),
Items = list.map(wrap_type_repn_item, TypeRepns).
:- pred accumulate_type_ctor_repns(item_type_repn_info::in,
cord(item_type_repn_info)::in, cord(item_type_repn_info)::out) is det.
accumulate_type_ctor_repns(TypeRepn, !TypeRepns) :-
!:TypeRepns = cord.snoc(!.TypeRepns, TypeRepn).
:- func type_ctor_foreign_enum_map_to_items(type_ctor_foreign_enum_map)
= list(item).
type_ctor_foreign_enum_map_to_items(ForeignEnumMap) = Items :-
map.foldl_values(accumulate_foreign_enum_items, ForeignEnumMap,
cord.init, ForeignEnumItemsCord),
ForeignEnumItems = cord.list(ForeignEnumItemsCord),
Items = list.map(wrap_foreign_enum_item, ForeignEnumItems).
:- pred accumulate_foreign_enum_items(c_j_cs_e_enums::in,
cord(item_foreign_enum_info)::in, cord(item_foreign_enum_info)::out)
is det.
accumulate_foreign_enum_items(AllEnums, !ForeignEnums) :-
AllEnums = c_java_csharp_erlang(ForeignEnumsC, ForeignEnumsJava,
ForeignEnumsCsharp, ForeignEnumsErlang),
!:ForeignEnums = !.ForeignEnums ++
cord.from_list(ForeignEnumsC) ++
cord.from_list(ForeignEnumsJava) ++
cord.from_list(ForeignEnumsCsharp) ++
cord.from_list(ForeignEnumsErlang).
%---------------------------------------------------------------------------%
wrap_include(ModuleName) = Include :-
Include = item_include(ModuleName, term.context_init, -1).
wrap_import_avail(ModuleName) = Avail :-
ImportInfo = avail_import_info(ModuleName, term.context_init, -1),
Avail = avail_import(ImportInfo).
wrap_use_avail(ModuleName) = Avail :-
UseInfo = avail_use_info(ModuleName, term.context_init, -1),
Avail = avail_use(UseInfo).
wrap_import(ModuleName) = ImportInfo :-
ImportInfo = avail_import_info(ModuleName, term.context_init, -1).
wrap_use(ModuleName) = UseInfo :-
UseInfo = avail_use_info(ModuleName, term.context_init, -1).
wrap_type_defn_item(X) = item_type_defn(X).
wrap_inst_defn_item(X) = item_inst_defn(X).
wrap_mode_defn_item(X) = item_mode_defn(X).
wrap_typeclass_item(X) = item_typeclass(X).
wrap_instance_item(X) = item_instance(X).
wrap_pred_decl_item(X) = item_pred_decl(X).
wrap_mode_decl_item(X) = item_mode_decl(X).
wrap_foreign_enum_item(X) = item_foreign_enum(X).
wrap_pragma_item(X) = item_pragma(X).
wrap_promise_item(X) = item_promise(X).
wrap_type_repn_item(X) = item_type_repn(X).
%---------------------------------------------------------------------------%
:- end_module parse_tree.convert_interface.
%---------------------------------------------------------------------------%