From d609181cb96e37567e6f020e1c6898206ebf33d3 Mon Sep 17 00:00:00 2001 From: Zoltan Somogyi Date: Wed, 5 Oct 2005 06:34:27 +0000 Subject: [PATCH] Consider types of the form Estimated hours taken: 30 Branches: main Consider types of the form :- type x ---> f. to be dummy types, since they contain no information. Optimize them the same way we currently optimize io.state and store.store. runtime/mercury_type_info.h: Add a new type_ctor_rep for dummy types. runtime/mercury_tabling.h: Add a representation for "tabled" dummy types, which don't actually have a level in the trie, so that the runtime system can handle that fact. runtime/mercury_ml_expand_body.h: When deconstructing a value of a dummy type, ignore the actual value (since it will contain garbage) and instead return the only possible value of the type. runtime/mercury_construct.c: runtime/mercury_deconstruct.c: runtime/mercury_deep_copy_body.c: runtime/mercury_tabling.c: runtime/mercury_unify_compare_body.h: library/rtti_implementation.m: Handle the type_ctor_rep of dummy types. runtime/mercury_builtin_types.c: Provide a place to record profiling information about unifications and comparisons for dummy types. runtime/mercury_mcpp.h: java/runtime/TypeCtorRep.java: library/private_builtin.m: Add a new type_ctor_rep for dummy types, and fix some previous discrepancies in type_ctor_reps. mdbcomp/prim_data.m: Move a bunch of predicates for manipulating special_pred_ids here from the browser and compiler directories. Rename the function symbols of the special_pred_id type to avoid the need to parenthesize the old `initialise' function symbol. Convert to four-space indentation. mdbcomp/rtti_access.m: Don't hardcode the names of special preds: use the predicates in prim_data.m. Convert to four-space indentation. browser/declarative_execution.m: Delete some predicates whose functionality is now in mdbcomp/prim_data.m. compiler/hlds_data.m: Replace the part of du type that says whether a type an enum, which used to be a bool, with something that also says whether the type is a dummy type. Convert to four-space indentation. compiler/make_tags.m: Compute the value for the new field of du type definitions. compiler/hlds_out.m: Write out the new field of du type definitions. compiler/rtti.m: Modify the data structures we use to create type_ctor_infos to allow for dummy types. Convert to four-space indentation. compiler/type_ctor_info.m: Modify the code that generates type_ctor_infos to handle dummy types. compiler/type_util.m: Provide predicates for recognizing dummy types. Convert to four-space indentation. compiler/unify_proc.m: Generate the unify and compare predicates of dummy types using a new code scheme that avoids referencing arguments that contain garbage. When generating code for unifying or comparing other types, ignore any arguments of function symbols that are dummy types. Don't use DCG style access predicates. compiler/higher_order.m: Specialize the unification and comparison of values of dummy types. Break up an excessively large predicate, and factor out common code from the conditions of a chain of if-then-elses. compiler/llds.m: For each input and output of a foreign_proc, include a field saying whether the value is of a dummy type. compiler/pragma_c_gen.m: Fill in the new fields in foreign_proc arguments. compiler/hlds_goal.m: Rename some predicates for constructing unifications to avoid unnecessary ad-hoc overloading. Clarify their documentation. Rename a predicate to make clear the restriction on its use, and document the restriction. Add a predicate for creating simple tests. Add a utility predicate for setting the context of a goal directly. compiler/modules.m: Include dummy types interface files, even if they are private to the module. This is necessary because with the MLDS backend, the generated code inside the module and outside the module must agree whether a function returning a value of the type returns a real value or a void value, and this requires them to agree on whether the type is dummy or not. The impact on interface files is minimal, since very few types are dummy types, and changing a type from a dummy type to a non-dummy type or vice versa is an ever rarer change. compiler/hlds_pred.m: Provide a representation in the compiler of the trie step for dummy types. compiler/layout_out.m: Print the trie step for dummy types. compiler/table_gen.m: Don't table values of dummy types, and record the fact that we don't by including a dummy trie step in the list of trie steps. compiler/add_pragma.m: compiler/add_special_pred.m: compiler/add_type.m: compiler/aditi_builtin_ops.m: compiler/bytecode.m: compiler/bytecode_gen.m: compiler/code_gen.m: compiler/code_info.m: compiler/continuation_info.m: compiler/cse_detection.m: compiler/det_report.m: compiler/exception_analysis.m: compiler/inst_match.m: compiler/livemap.m: compiler/llds_out.m: compiler/llds_out.m: compiler/middle_rec.m: compiler/ml_call_gen.m: compiler/ml_closure_gen.m: compiler/ml_code_gen.m: compiler/ml_code_util.m: compiler/ml_type_gen.m: compiler/ml_unify_gen.m: compiler/mlds_to_c.m: compiler/mlds_to_gcc.m: compiler/mlds_to_il.m: compiler/mlds_to_il.m: compiler/modecheck_unify.m: compiler/modes.m: compiler/opt_util.m: compiler/post_term_analysis.m: compiler/post_typecheck.m: compiler/qual_info.m: compiler/rl.m: compiler/rl_exprn.m: compiler/rl_key.m: compiler/rtti_out.m: compiler/simplify.m: compiler/size_prof.m: compiler/term_constr_initial.m: compiler/term_constr_util.m: compiler/term_norm.m: compiler/termination.m: compiler/trace.m: compiler/typecheck.m: compiler/unify_gen.m: Conform to the changes above. compiler/export.m: compiler/exprn_aux.m: compiler/foreign.m: compiler/polymorphism.m: compiler/proc_label.m: compiler/rtti_to_mlds.m: compiler/special_pred.m: compiler/stack_alloc.m: compiler/stack_layout.m: compiler/state_var.m: compiler/switch_util.m: compiler/trace_params.m: Conform to the changes above. Convert to four-space indentation. compiler/mlds_to_java.m: compiler/var_locn.m: Conform to the changes above, which requires threading the module_info through the module. Convert to four-space indentation. compiler/mercury_compile.m: Pass the module_info to mlds_to_java.m. compiler/ml_util.m: compiler/polymorphism.m: compiler/type_ctor_info.m: compiler/type_util.m: Delete some previously missed references to the temporary types used to bootstrap the change to the type_info type's arity. compiler/polymorphism.m: Turn back on an optimization that avoids passing parameters (such as type_infos) to foreign_procs if they are not actually referred to. compiler/prog_data.m: Convert to four-space indentation. library/svvarset.m: Add a missing predicate. trace/mercury_trace.c: Delete the unused function that used to check for dummy types. tests/debugger/field_names.{m,inp,exp}: Add to this test case a test of the handling of dummy types. Check that their values can be printed out during normal execution, and that the debugger doesn't consider them live nondummy variables, just as it doesn't consider I/O states live nondummy variables. --- browser/declarative_execution.m | 16 +- compiler/add_pragma.m | 6 +- compiler/add_special_pred.m | 39 +- compiler/add_type.m | 9 +- compiler/aditi_builtin_ops.m | 8 +- compiler/bytecode.m | 5 +- compiler/bytecode_gen.m | 3 + compiler/code_gen.m | 2 +- compiler/code_info.m | 55 +- compiler/continuation_info.m | 2 +- compiler/cse_detection.m | 15 +- compiler/det_report.m | 2 +- compiler/exception_analysis.m | 11 +- compiler/export.m | 1209 +++--- compiler/exprn_aux.m | 1787 ++++----- compiler/foreign.m | 911 +++-- compiler/higher_order.m | 377 +- compiler/hlds_data.m | 1707 ++++---- compiler/hlds_goal.m | 149 +- compiler/hlds_out.m | 10 +- compiler/hlds_pred.m | 22 +- compiler/inst_match.m | 1 + compiler/intermod.m | 7 +- compiler/layout_out.m | 4 + compiler/livemap.m | 2 +- compiler/llds.m | 6 + compiler/llds_out.m | 22 +- compiler/make_tags.m | 32 +- compiler/mercury_compile.m | 8 +- compiler/middle_rec.m | 4 +- compiler/ml_call_gen.m | 12 +- compiler/ml_closure_gen.m | 4 +- compiler/ml_code_gen.m | 20 +- compiler/ml_code_util.m | 34 +- compiler/ml_type_gen.m | 13 +- compiler/ml_unify_gen.m | 14 +- compiler/ml_util.m | 4 - compiler/mlds_to_c.m | 3 + compiler/mlds_to_gcc.m | 8 +- compiler/mlds_to_il.m | 1 + compiler/mlds_to_java.m | 4788 +++++++++++----------- compiler/modecheck_unify.m | 2 +- compiler/modes.m | 3 +- compiler/modules.m | 66 +- compiler/opt_util.m | 4 +- compiler/polymorphism.m | 5535 ++++++++++++-------------- compiler/post_term_analysis.m | 16 +- compiler/post_typecheck.m | 4 +- compiler/pragma_c_gen.m | 36 +- compiler/proc_label.m | 181 +- compiler/prog_data.m | 3161 +++++++-------- compiler/qual_info.m | 8 +- compiler/rl.m | 8 + compiler/rl_exprn.m | 4 +- compiler/rl_key.m | 4 +- compiler/rtti.m | 2704 ++++++------- compiler/rtti_out.m | 3 +- compiler/rtti_to_mlds.m | 2303 ++++++----- compiler/simplify.m | 2 +- compiler/size_prof.m | 10 +- compiler/special_pred.m | 393 +- compiler/stack_alloc.m | 304 +- compiler/stack_layout.m | 3 +- compiler/state_var.m | 2 +- compiler/switch_util.m | 3 + compiler/table_gen.m | 45 +- compiler/term_constr_initial.m | 26 +- compiler/term_constr_util.m | 7 +- compiler/term_norm.m | 1 + compiler/termination.m | 54 +- compiler/trace.m | 5 +- compiler/trace_params.m | 406 +- compiler/type_ctor_info.m | 71 +- compiler/type_util.m | 2521 ++++++------ compiler/typecheck.m | 2 +- compiler/unify_gen.m | 3 +- compiler/unify_proc.m | 1056 ++--- compiler/var_locn.m | 239 +- java/runtime/TypeCtorRep.java | 6 +- library/private_builtin.m | 12 +- library/rtti_implementation.m | 18 +- library/svvarset.m | 91 +- mdbcomp/prim_data.m | 390 +- mdbcomp/rtti_access.m | 317 +- mdbcomp/slice_and_dice.m | 2 +- runtime/mercury_builtin_types.c | 30 + runtime/mercury_construct.c | 4 +- runtime/mercury_deconstruct.c | 1 + runtime/mercury_deep_copy_body.h | 7 + runtime/mercury_mcpp.h | 6 +- runtime/mercury_ml_expand_body.h | 14 +- runtime/mercury_stack_layout.h | 1 + runtime/mercury_tabling.c | 14 + runtime/mercury_type_info.h | 35 +- runtime/mercury_unify_compare_body.h | 11 + tests/debugger/field_names.exp | 12 +- tests/debugger/field_names.inp | 5 + tests/debugger/field_names.m | 10 +- trace/mercury_trace.c | 30 - 99 files changed, 15663 insertions(+), 15880 deletions(-) diff --git a/browser/declarative_execution.m b/browser/declarative_execution.m index 72223b4be..9e7c8d2a5 100644 --- a/browser/declarative_execution.m +++ b/browser/declarative_execution.m @@ -430,20 +430,6 @@ %-----------------------------------------------------------------------------% -:- func get_special_pred_id_name(special_pred_id) = string. - -get_special_pred_id_name(unify) = "__Unify__". -get_special_pred_id_name(index) = "__Index__". -get_special_pred_id_name(compare) = "__Compare__". -get_special_pred_id_name(initialise) = "__Initialise__". - -:- func get_special_pred_id_arity(special_pred_id) = int. - -get_special_pred_id_arity(unify) = 2. -get_special_pred_id_arity(index) = 2. -get_special_pred_id_arity(compare) = 3. -get_special_pred_id_arity(initialise) = 1. - get_pred_attributes(ProcId, Module, Name, Arity, PredOrFunc) :- ( ProcId = proc(Module, PredOrFunc, _, Name, Arity, _) @@ -451,7 +437,7 @@ get_pred_attributes(ProcId, Module, Name, Arity, PredOrFunc) :- ProcId = special_proc(Module, SpecialId, _, _, _, _), PredOrFunc = predicate, Arity = get_special_pred_id_arity(SpecialId), - Name = get_special_pred_id_name(SpecialId) + Name = get_special_pred_id_target_name(SpecialId) ). %-----------------------------------------------------------------------------% diff --git a/compiler/add_pragma.m b/compiler/add_pragma.m index a47d14505..8aeaffaf1 100644 --- a/compiler/add_pragma.m +++ b/compiler/add_pragma.m @@ -486,9 +486,9 @@ add_pragma_reserve_tag(TypeName, TypeArity, PragmaStatus, Context, !ModuleInfo, % ReservedTag = yes, module_info_get_globals(!.ModuleInfo, Globals), - assign_constructor_tags(Body, TypeCtor, ReservedTag, Globals, - CtorTags, IsEnum), - TypeBody = du_type(Body, CtorTags, IsEnum, MaybeUserEqComp, + assign_constructor_tags(Body, MaybeUserEqComp, TypeCtor, + ReservedTag, Globals, CtorTags, EnumDummy), + TypeBody = du_type(Body, CtorTags, EnumDummy, MaybeUserEqComp, ReservedTag, IsForeign), hlds_data__set_type_defn_body(TypeBody, TypeDefn0, TypeDefn), map__set(Types0, TypeCtor, TypeDefn, Types), diff --git a/compiler/add_special_pred.m b/compiler/add_special_pred.m index 092399e15..31724ec1a 100644 --- a/compiler/add_special_pred.m +++ b/compiler/add_special_pred.m @@ -114,14 +114,14 @@ add_special_preds(TVarSet, Type, TypeCtor, Body, Context, Status, can_generate_special_pred_clauses_for_type(!.ModuleInfo, TypeCtor, Body) -> - add_special_pred(unify, TVarSet, Type, TypeCtor, Body, Context, - Status, !ModuleInfo), + add_special_pred(spec_pred_unify, TVarSet, Type, TypeCtor, Body, + Context, Status, !ModuleInfo), status_defined_in_this_module(Status, ThisModule), ( ThisModule = yes, ( Ctors = Body ^ du_type_ctors, - Body ^ du_type_is_enum = no, + Body ^ du_type_is_enum = not_enum_or_dummy, Body ^ du_type_usereq = no, module_info_get_globals(!.ModuleInfo, Globals), globals__lookup_int_option(Globals, compare_specialization, @@ -129,9 +129,9 @@ add_special_preds(TVarSet, Type, TypeCtor, Body, Context, Status, list__length(Ctors, CtorCount), CtorCount > CompareSpec -> - SpecialPredIds = [index, compare] + SpecialPredIds = [spec_pred_index, spec_pred_compare] ; - SpecialPredIds = [compare] + SpecialPredIds = [spec_pred_compare] ), add_special_pred_list(SpecialPredIds, TVarSet, Type, TypeCtor, Body, Context, Status, !ModuleInfo) @@ -140,26 +140,27 @@ add_special_preds(TVarSet, Type, TypeCtor, Body, Context, Status, % Never add clauses for comparison predicates % for imported types -- they will never be used. module_info_get_special_pred_map(!.ModuleInfo, SpecialPreds), - ( map__contains(SpecialPreds, compare - TypeCtor) -> + ( map__contains(SpecialPreds, spec_pred_compare - TypeCtor) -> true ; - add_special_pred_decl(compare, TVarSet, Type, TypeCtor, Body, - Context, Status, !ModuleInfo) + add_special_pred_decl(spec_pred_compare, TVarSet, Type, + TypeCtor, Body, Context, Status, !ModuleInfo) ) ), ( type_util__type_body_is_solver_type(!.ModuleInfo, Body) -> - add_special_pred(initialise, TVarSet, Type, TypeCtor, Body, + add_special_pred(spec_pred_init, TVarSet, Type, TypeCtor, Body, Context, Status, !ModuleInfo) ; true ) ; ( type_util__type_body_is_solver_type(!.ModuleInfo, Body) -> - SpecialPredIds = [unify, compare, initialise] + SpecialPredIds = [spec_pred_unify, spec_pred_compare, + spec_pred_init] ; - SpecialPredIds = [unify, compare] + SpecialPredIds = [spec_pred_unify, spec_pred_compare] ), add_special_pred_decl_list(SpecialPredIds, TVarSet, Type, TypeCtor, Body, Context, Status, !ModuleInfo) @@ -192,14 +193,14 @@ add_special_pred(SpecialPredId, TVarSet, Type, TypeCtor, TypeBody, Context, ; GenSpecialPreds = no, ( - SpecialPredId = unify, + SpecialPredId = spec_pred_unify, add_special_pred_unify_status(TypeBody, Status0, Status), do_add_special_pred_for_real(SpecialPredId, TVarSet, Type, TypeCtor, TypeBody, Context, Status, !ModuleInfo) ; - SpecialPredId = index + SpecialPredId = spec_pred_index ; - SpecialPredId = compare, + SpecialPredId = spec_pred_compare, ( TypeBody ^ du_type_usereq = yes(_) -> % The compiler generated comparison % procedure prints an error message, @@ -217,7 +218,7 @@ add_special_pred(SpecialPredId, TVarSet, Type, TypeCtor, TypeBody, Context, true ) ; - SpecialPredId = (initialise), + SpecialPredId = spec_pred_init, ( type_is_solver_type(!.ModuleInfo, Type) -> do_add_special_pred_for_real(SpecialPredId, TVarSet, Type, TypeCtor, TypeBody, Context, Status0, !ModuleInfo) @@ -320,7 +321,7 @@ add_special_pred_decl(SpecialPredId, TVarSet, Type, TypeCtor, TypeBody, ( GenSpecialPreds = yes -> do_add_special_pred_decl_for_real(SpecialPredId, TVarSet, Type, TypeCtor, Context, Status0, !ModuleInfo) - ; SpecialPredId = unify -> + ; SpecialPredId = spec_pred_unify -> add_special_pred_unify_status(TypeBody, Status0, Status), do_add_special_pred_decl_for_real(SpecialPredId, TVarSet, Type, TypeCtor, Context, Status, !ModuleInfo) @@ -333,14 +334,14 @@ do_add_special_pred_decl_for_real(SpecialPredId, TVarSet, Type, TypeCtor, module_info_get_name(!.ModuleInfo, ModuleName), special_pred_interface(SpecialPredId, Type, ArgTypes, ArgModes, Det), Name = special_pred_name(SpecialPredId, TypeCtor), - ( SpecialPredId = (initialise) -> + ( SpecialPredId = spec_pred_init -> TypeCtor = TypeSymName - _TypeArity, sym_name_get_module_name(TypeSymName, ModuleName, TypeModuleName), PredName = qualified(TypeModuleName, Name) ; PredName = unqualified(Name) ), - special_pred_name_arity(SpecialPredId, _, Arity), + Arity = get_special_pred_id_arity(SpecialPredId), clauses_info_init(Arity, ClausesInfo0), Origin = special_pred(SpecialPredId - TypeCtor), adjust_special_pred_status(SpecialPredId, Status0, Status), @@ -410,7 +411,7 @@ adjust_special_pred_status(SpecialPredId, !Status) :- % Unification predicates are special - they are % "pseudo"-imported/exported (only mode 0 is imported/exported). - ( SpecialPredId = unify -> + ( SpecialPredId = spec_pred_unify -> ( !.Status = imported(_) -> !:Status = pseudo_imported ; !.Status = exported -> diff --git a/compiler/add_type.m b/compiler/add_type.m index c7ec56913..1e9d1eee2 100644 --- a/compiler/add_type.m +++ b/compiler/add_type.m @@ -333,6 +333,7 @@ process_type_defn(TypeCtor, TypeDefn, !FoundError, !ModuleInfo, !IO) :- hlds_data__get_type_defn_need_qualifier(TypeDefn, NeedQual), ( ConsList = Body ^ du_type_ctors, + UserEqCmp = Body ^ du_type_usereq, ReservedTag = Body ^ du_type_reserved_tag, module_info_get_cons_table(!.ModuleInfo, Ctors0), module_info_get_partial_qualifier_info(!.ModuleInfo, PQInfo), @@ -348,8 +349,8 @@ process_type_defn(TypeCtor, TypeDefn, !FoundError, !ModuleInfo, !IO) :- globals__io_get_globals(Globals, !IO), ( - type_constructors_should_be_no_tag(ConsList, ReservedTag, Globals, - Name, CtorArgType, _) + type_with_constructors_should_be_no_tag(Globals, TypeCtor, + ReservedTag, ConsList, UserEqCmp, Name, CtorArgType, _) -> NoTagType = no_tag_type(Args, Name, CtorArgType), module_info_get_no_tag_types(!.ModuleInfo, NoTagTypes0), @@ -612,8 +613,8 @@ convert_type_defn(du_type(Body, MaybeUserEqComp), TypeCtor, Globals, % constructor tags by calling assign_constructor_tags again, % with ReservedTagPragma = yes, when processing the pragma.) ReservedTagPragma = no, - assign_constructor_tags(Body, TypeCtor, ReservedTagPragma, Globals, - CtorTags, IsEnum), + assign_constructor_tags(Body, MaybeUserEqComp, TypeCtor, ReservedTagPragma, + Globals, CtorTags, IsEnum), IsForeign = no, HLDSBody = du_type(Body, CtorTags, IsEnum, MaybeUserEqComp, ReservedTagPragma, IsForeign). diff --git a/compiler/aditi_builtin_ops.m b/compiler/aditi_builtin_ops.m index e7d679b14..1229a8dc2 100644 --- a/compiler/aditi_builtin_ops.m +++ b/compiler/aditi_builtin_ops.m @@ -626,12 +626,12 @@ generate_const_args([ConstArg | ConstArgs], [ConstArgVar | ConstArgVars], ProcInfo0 =^ proc_info, { ConstArg = int(Int), - make_int_const_construction(Int, no, ConstGoal, ConstArgVar, - ProcInfo0, ProcInfo) + make_int_const_construction_alloc_in_proc(Int, no, + ConstGoal, ConstArgVar, ProcInfo0, ProcInfo) ; ConstArg = string(String), - make_string_const_construction(String, no, ConstGoal, - ConstArgVar, ProcInfo0, ProcInfo) + make_string_const_construction_alloc_in_proc(String, no, + ConstGoal, ConstArgVar, ProcInfo0, ProcInfo) }, ^ proc_info := ProcInfo, generate_const_args(ConstArgs, ConstArgVars, ConstGoals). diff --git a/compiler/bytecode.m b/compiler/bytecode.m index 3dd01f6d4..a039201ae 100644 --- a/compiler/bytecode.m +++ b/compiler/bytecode.m @@ -119,7 +119,8 @@ ; char_test ; string_test ; float_test - ; enum_test. + ; enum_test + ; dummy_test. :- type byte_module_id == module_name. :- type byte_pred_id == string. @@ -671,6 +672,7 @@ output_test_id(char_test) --> output_byte(1). output_test_id(string_test) --> output_byte(2). output_test_id(float_test) --> output_byte(3). output_test_id(enum_test) --> output_byte(4). +output_test_id(dummy_test) --> output_byte(5). :- pred debug_test_id(byte_test_id::in, io::di, io::uo) is det. @@ -679,6 +681,7 @@ debug_test_id(char_test) --> debug_string("char"). debug_test_id(string_test) --> debug_string("string"). debug_test_id(float_test) --> debug_string("float"). debug_test_id(enum_test) --> debug_string("enum"). +debug_test_id(dummy_test) --> debug_string("dummy"). %---------------------------------------------------------------------------% diff --git a/compiler/bytecode_gen.m b/compiler/bytecode_gen.m index 007998d6d..f6666c42f 100644 --- a/compiler/bytecode_gen.m +++ b/compiler/bytecode_gen.m @@ -551,6 +551,9 @@ bytecode_gen__unify(simple_test(Var1, Var2), _, _, ByteInfo, Code) :- ; TypeCategory = float_type, TestId = float_test + ; + TypeCategory = dummy_type, + TestId = dummy_test ; TypeCategory = enum_type, TestId = enum_test diff --git a/compiler/code_gen.m b/compiler/code_gen.m index 2a32d4855..b0612e740 100644 --- a/compiler/code_gen.m +++ b/compiler/code_gen.m @@ -1354,7 +1354,7 @@ code_gen__push_msg(ModuleInfo, PredId, ProcId) = PushMsg :- pred_info_get_origin(PredInfo, Origin), ( Origin = special_pred(SpecialId - TypeCtor) -> code_gen__find_arg_type_ctor_name(TypeCtor, TypeName), - special_pred_name_arity(SpecialId, SpecialPredName, _), + SpecialPredName = get_special_pred_id_generic_name(SpecialId), FullPredName = SpecialPredName ++ "_for_" ++ TypeName ; FullPredName = PredName diff --git a/compiler/code_info.m b/compiler/code_info.m index ec540713a..df644f4e5 100644 --- a/compiler/code_info.m +++ b/compiler/code_info.m @@ -3226,7 +3226,8 @@ code_info__assign_var_to_var(Var, AssignedVar, !CI) :- code_info__assign_lval_to_var(Var, Lval, Code, !CI) :- code_info__get_var_locn_info(!.CI, VarLocnInfo0), code_info__get_static_cell_info(!.CI, StaticCellInfo), - var_locn__assign_lval_to_var(Var, Lval, StaticCellInfo, Code, + code_info__get_module_info(!.CI, ModuleInfo), + var_locn__assign_lval_to_var(ModuleInfo, Var, Lval, StaticCellInfo, Code, VarLocnInfo0, VarLocnInfo), code_info__set_var_locn_info(VarLocnInfo, !CI). @@ -3252,15 +3253,18 @@ code_info__assign_cell_to_var(Var, ReserveWordAtStart, Ptag, Vector, MaybeSize, TypeMsg, Code, !CI) :- code_info__get_var_locn_info(!.CI, VarLocnInfo0), code_info__get_static_cell_info(!.CI, StaticCellInfo0), - var_locn__assign_cell_to_var(Var, ReserveWordAtStart, Ptag, Vector, - MaybeSize, TypeMsg, Code, StaticCellInfo0, StaticCellInfo, + code_info__get_module_info(!.CI, ModuleInfo), + var_locn__assign_cell_to_var(ModuleInfo, Var, ReserveWordAtStart, Ptag, + Vector, MaybeSize, TypeMsg, Code, StaticCellInfo0, StaticCellInfo, VarLocnInfo0, VarLocnInfo), code_info__set_static_cell_info(StaticCellInfo, !CI), code_info__set_var_locn_info(VarLocnInfo, !CI). code_info__place_var(Var, Lval, Code, !CI) :- code_info__get_var_locn_info(!.CI, VarLocnInfo0), - var_locn__place_var(Var, Lval, Code, VarLocnInfo0, VarLocnInfo), + code_info__get_module_info(!.CI, ModuleInfo), + var_locn__place_var(ModuleInfo, Var, Lval, Code, + VarLocnInfo0, VarLocnInfo), code_info__set_var_locn_info(VarLocnInfo, !CI). :- pred code_info__pick_and_place_vars(assoc_list(prog_var, set(lval))::in, @@ -3292,28 +3296,35 @@ code_info__pick_var_places([Var - LvalSet | VarLvalSets], VarLvals) :- code_info__place_vars(VarLocs, Code, !CI) :- code_info__get_var_locn_info(!.CI, VarLocnInfo0), - var_locn__place_vars(VarLocs, Code, VarLocnInfo0, VarLocnInfo), + code_info__get_module_info(!.CI, ModuleInfo), + var_locn__place_vars(ModuleInfo, VarLocs, Code, VarLocnInfo0, VarLocnInfo), code_info__set_var_locn_info(VarLocnInfo, !CI). code_info__produce_variable(Var, Code, Rval, !CI) :- code_info__get_var_locn_info(!.CI, VarLocnInfo0), - var_locn__produce_var(Var, Rval, Code, VarLocnInfo0, VarLocnInfo), + code_info__get_module_info(!.CI, ModuleInfo), + var_locn__produce_var(ModuleInfo, Var, Rval, Code, + VarLocnInfo0, VarLocnInfo), code_info__set_var_locn_info(VarLocnInfo, !CI). code_info__produce_variable_in_reg(Var, Code, Lval, !CI) :- code_info__get_var_locn_info(!.CI, VarLocnInfo0), - var_locn__produce_var_in_reg(Var, Lval, Code, VarLocnInfo0, VarLocnInfo), + code_info__get_module_info(!.CI, ModuleInfo), + var_locn__produce_var_in_reg(ModuleInfo, Var, Lval, Code, + VarLocnInfo0, VarLocnInfo), code_info__set_var_locn_info(VarLocnInfo, !CI). code_info__produce_variable_in_reg_or_stack(Var, Code, Lval, !CI) :- code_info__get_var_locn_info(!.CI, VarLocnInfo0), - var_locn__produce_var_in_reg_or_stack(Var, Lval, Code, + code_info__get_module_info(!.CI, ModuleInfo), + var_locn__produce_var_in_reg_or_stack(ModuleInfo, Var, Lval, Code, VarLocnInfo0, VarLocnInfo), code_info__set_var_locn_info(VarLocnInfo, !CI). code_info__materialize_vars_in_lval(Lval0, Lval, Code, !CI) :- code_info__get_var_locn_info(!.CI, VarLocnInfo0), - var_locn__materialize_vars_in_lval(Lval0, Lval, Code, + code_info__get_module_info(!.CI, ModuleInfo), + var_locn__materialize_vars_in_lval(ModuleInfo, Lval0, Lval, Code, VarLocnInfo0, VarLocnInfo), code_info__set_var_locn_info(VarLocnInfo, !CI). @@ -3350,7 +3361,8 @@ code_info__release_reg(Lval, !CI) :- code_info__reserve_r1(Code, !CI) :- code_info__get_var_locn_info(!.CI, VarLocnInfo0), - var_locn__clear_r1(Code, VarLocnInfo0, VarLocnInfo1), + code_info__get_module_info(!.CI, ModuleInfo), + var_locn__clear_r1(ModuleInfo, Code, VarLocnInfo0, VarLocnInfo1), var_locn__acquire_reg_require_given(reg(r, 1), VarLocnInfo1, VarLocnInfo), code_info__set_var_locn_info(VarLocnInfo, !CI). @@ -3370,6 +3382,7 @@ code_info__setup_call(GoalInfo, ArgInfos, LiveLocs, Code, !CI) :- set__list_to_set(OutVars, OutVarSet), goal_info_get_determinism(GoalInfo, Detism), code_info__get_opt_no_return_calls(!.CI, OptNoReturnCalls), + code_info__get_module_info(!.CI, ModuleInfo), ( Detism = erroneous, OptNoReturnCalls = yes @@ -3397,23 +3410,24 @@ code_info__setup_call(GoalInfo, ArgInfos, LiveLocs, Code, !CI) :- StackVarLocs = ForwardVarLocs ), VarTypes = code_info__get_var_types(!.CI), - list__filter(valid_stack_slot(VarTypes), StackVarLocs, + list__filter(valid_stack_slot(ModuleInfo, VarTypes), StackVarLocs, RealStackVarLocs, DummyStackVarLocs) ), code_info__get_var_locn_info(!.CI, VarLocnInfo0), code_info__var_arg_info_to_lval(InArgInfos, InArgLocs), list__append(RealStackVarLocs, InArgLocs, AllRealLocs), - var_locn__place_vars(DummyStackVarLocs ++ AllRealLocs, Code, + var_locn__place_vars(ModuleInfo, DummyStackVarLocs ++ AllRealLocs, Code, VarLocnInfo0, VarLocnInfo), code_info__set_var_locn_info(VarLocnInfo, !CI), assoc_list__values(AllRealLocs, LiveLocList), set__list_to_set(LiveLocList, LiveLocs). -:- pred valid_stack_slot(vartypes::in, pair(prog_var, lval)::in) is semidet. +:- pred valid_stack_slot(module_info::in, vartypes::in, + pair(prog_var, lval)::in) is semidet. -valid_stack_slot(VarTypes, Var - Lval) :- +valid_stack_slot(ModuleInfo, VarTypes, Var - Lval) :- map__lookup(VarTypes, Var, Type), - ( is_dummy_argument_type(Type) -> + ( is_dummy_argument_type(ModuleInfo, Type) -> fail ; ( @@ -3436,8 +3450,10 @@ code_info__setup_call_args(AllArgsInfos, Direction, LiveLocs, Code, !CI) :- list__filter(code_info__call_arg_in_selected_dir(Direction), AllArgsInfos, ArgsInfos), code_info__var_arg_info_to_lval(ArgsInfos, ArgsLocns), + code_info__get_module_info(!.CI, ModuleInfo), code_info__get_var_locn_info(!.CI, VarLocnInfo0), - var_locn__place_vars(ArgsLocns, Code, VarLocnInfo0, VarLocnInfo1), + var_locn__place_vars(ModuleInfo, ArgsLocns, Code, + VarLocnInfo0, VarLocnInfo1), code_info__set_var_locn_info(VarLocnInfo1, !CI), assoc_list__values(ArgsLocns, LiveLocList), set__list_to_set(LiveLocList, LiveLocs), @@ -3568,8 +3584,9 @@ code_info__generate_call_vn_livevals(CI, InputArgLocs, OutputArgs, LiveVals) :- code_info__generate_call_stack_vn_livevals(CI, OutputArgs, LiveVals) :- code_info__get_known_variables(CI, KnownVarList0), + code_info__get_module_info(CI, ModuleInfo), VarTypes = code_info__get_var_types(CI), - list__filter(var_is_of_dummy_type(VarTypes), KnownVarList0, + list__filter(var_is_of_dummy_type(ModuleInfo, VarTypes), KnownVarList0, _, KnownVarList), set__list_to_set(KnownVarList, KnownVars), set__difference(KnownVars, OutputArgs, LiveVars), @@ -3610,12 +3627,12 @@ code_info__generate_return_live_lvalues(CI, OutputArgLocs, ReturnInstMap, OkToDeleteAny, LiveLvalues) :- code_info__variable_locations(CI, VarLocs), code_info__get_known_variables(CI, Vars0), + code_info__get_module_info(CI, ModuleInfo), VarTypes = code_info__get_var_types(CI), - list__filter(var_is_of_dummy_type(VarTypes), Vars0, _, Vars), + list__filter(var_is_of_dummy_type(ModuleInfo, VarTypes), Vars0, _, Vars), code_info__get_active_temps_data(CI, Temps), code_info__get_proc_info(CI, ProcInfo), code_info__get_globals(CI, Globals), - code_info__get_module_info(CI, ModuleInfo), continuation_info__generate_return_live_lvalues(OutputArgLocs, ReturnInstMap, Vars, VarLocs, Temps, ProcInfo, ModuleInfo, Globals, OkToDeleteAny, LiveLvalues). diff --git a/compiler/continuation_info.m b/compiler/continuation_info.m index 4a5400e8c..476e9addc 100644 --- a/compiler/continuation_info.m +++ b/compiler/continuation_info.m @@ -668,7 +668,7 @@ continuation_info__generate_resume_layout_for_vars([Var - LvalSet | VarLvals], InstMap, VarTypes, ProcInfo, ModuleInfo, !VarInfos, !TVars) :- ( map__lookup(VarTypes, Var, Type), - is_dummy_argument_type(Type) + is_dummy_argument_type(ModuleInfo, Type) -> true ; diff --git a/compiler/cse_detection.m b/compiler/cse_detection.m index 877d2fe3b..ade8ab1a7 100644 --- a/compiler/cse_detection.m +++ b/compiler/cse_detection.m @@ -621,9 +621,14 @@ create_parallel_subterm(OFV, Context, UnifyContext, !CseInfo, !OldNewVar, map__det_insert(VarTypes0, NFV, Type, VarTypes), !:OldNewVar = [OFV - NFV | !.OldNewVar], UnifyContext = unify_context(MainCtxt, SubCtxt), - create_atomic_unification(OFV, var(NFV), + % It is ok to create complicated unifications here, because we rerun + % mode analysis on the resulting goal. It would be nicer to generate + % the right assignment unification directly, but that would require keeping + % track of the inst of OFV. + create_atomic_complicated_unification(OFV, var(NFV), Context, MainCtxt, SubCtxt, Goal), - !:CseInfo = (!.CseInfo ^ varset := VarSet) ^ vartypes := VarTypes. + !:CseInfo = !.CseInfo ^ varset := VarSet, + !:CseInfo = !.CseInfo ^ vartypes := VarTypes. %-----------------------------------------------------------------------------% @@ -663,7 +668,11 @@ pair_subterms([OldVar - HoistedVar | OldHoistedVars], Context, UnifyContext, Replacements = Replacements1 ; UnifyContext = unify_context(MainCtxt, SubCtxt), - create_atomic_unification(HoistedVar, var(OldVar), + % It is ok to create complicated unifications here, because we rerun + % mode analysis on the resulting goal. It would be nicer to generate + % the right assignment unification directly, but that would require + % keeping track of the inst of OldVar. + create_atomic_complicated_unification(HoistedVar, var(OldVar), Context, MainCtxt, SubCtxt, Goal), Replacements = [Goal | Replacements1] ). diff --git a/compiler/det_report.m b/compiler/det_report.m index 8b3eaf105..b09617ee2 100644 --- a/compiler/det_report.m +++ b/compiler/det_report.m @@ -861,7 +861,7 @@ det_report_call_context(Context, CallUnifyContext, DetInfo, PredId, ProcId, % both out. (The latter can happen if there is a determinism error % in a function call inside some unification.) % - ( Origin = special_pred(unify - _) -> + ( Origin = special_pred(spec_pred_unify - _) -> ( CallUnifyContext = yes(call_unify_context(LHS, RHS, UC)), First = yes, Last = yes, diff --git a/compiler/exception_analysis.m b/compiler/exception_analysis.m index 11db464a5..ef1431732 100644 --- a/compiler/exception_analysis.m +++ b/compiler/exception_analysis.m @@ -309,12 +309,16 @@ check_goal_for_exceptions_2(SCC, ModuleInfo, VarTypes, Goal, _, !Result) :- any_mercury_builtin_module(ModuleName), Name = pred_info_name(CallPredInfo), Arity = pred_info_orig_arity(CallPredInfo), - ( SpecialPredId = compare ; SpecialPredId = unify ), - special_pred_name_arity(SpecialPredId, Name, Arity) + ( SpecialPredId = spec_pred_compare + ; SpecialPredId = spec_pred_unify + ), + special_pred_name_arity(SpecialPredId, Name, _, Arity) ; pred_info_get_origin(CallPredInfo, Origin), Origin = special_pred(SpecialPredId - _), - ( SpecialPredId = compare ; SpecialPredId = unify ) + ( SpecialPredId = spec_pred_compare + ; SpecialPredId = spec_pred_unify + ) ) -> % For unification/comparison the exception status depends @@ -676,6 +680,7 @@ check_type_2(_, _, type_ctor_info_type) = type_will_not_throw. check_type_2(_, _, typeclass_info_type) = type_will_not_throw. check_type_2(_, _, base_typeclass_info_type) = type_will_not_throw. check_type_2(_, _, void_type) = type_will_not_throw. +check_type_2(_, _, dummy_type) = type_will_not_throw. check_type_2(_, _, variable_type) = type_conditional. diff --git a/compiler/export.m b/compiler/export.m index 906b7b6da..0a23b23aa 100644 --- a/compiler/export.m +++ b/compiler/export.m @@ -1,4 +1,6 @@ %-----------------------------------------------------------------------------%) +% vim: ft=mercury ts=4 sw=4 et +%-----------------------------------------------------------------------------%) % Copyright (C) 1996-2005 The University of Melbourne. % This file may only be copied under the terms of the GNU General % Public License - see the file COPYING in the Mercury distribution. @@ -25,48 +27,48 @@ :- import_module io. - % From the module_info, get a list of foreign_export_decls, - % each of which holds information about the declaration - % of a foreign function named in a `pragma export' declaration, - % which is used to allow a call to be made to a Mercury - % procedure from the foreign language. - % -:- pred export__get_foreign_export_decls(module_info::in, - foreign_export_decls::out) is det. + % From the module_info, get a list of foreign_export_decls, + % each of which holds information about the declaration + % of a foreign function named in a `pragma export' declaration, + % which is used to allow a call to be made to a Mercury + % procedure from the foreign language. + % +:- pred get_foreign_export_decls(module_info::in, foreign_export_decls::out) + is det. - % From the module_info, get a list of foreign_export_defns, - % each of which is a string containing the foreign code - % for defining a foreign function named in a `pragma export' decl. - % -:- pred export__get_foreign_export_defns(module_info::in, - foreign_export_defns::out) is det. + % From the module_info, get a list of foreign_export_defns, + % each of which is a string containing the foreign code + % for defining a foreign function named in a `pragma export' decl. + % +:- pred get_foreign_export_defns(module_info::in, foreign_export_defns::out) + is det. - % Produce an interface file containing declarations for the - % exported foreign functions (if required in this foreign language). - % -:- pred export__produce_header_file(foreign_export_decls::in, module_name::in, - io::di, io::uo) is det. + % Produce an interface file containing declarations for the + % exported foreign functions (if required in this foreign language). + % +:- pred produce_header_file(foreign_export_decls::in, module_name::in, + io::di, io::uo) is det. %-----------------------------------------------------------------------------% % Utilities for generating C code which interfaces with Mercury. % The {MLDS,LLDS}->C backends and fact tables use this code. - % Generate C code to convert an rval (represented as a string), from - % a C type to a mercury C type (ie. convert strings and floats to - % words) and return the resulting C code as a string. - % + % Generate C code to convert an rval (represented as a string), from + % a C type to a mercury C type (ie. convert strings and floats to + % words) and return the resulting C code as a string. + % :- pred convert_type_to_mercury(string::in, (type)::in, string::out) is det. - % Generate C code to convert an rval (represented as a string), from - % a mercury C type to a C type. (ie. convert words to strings and - % floats if required) and return the resulting C code as a string. - % + % Generate C code to convert an rval (represented as a string), from + % a mercury C type to a C type. (ie. convert words to strings and + % floats if required) and return the resulting C code as a string. + % :- pred convert_type_from_mercury(string::in, (type)::in, string::out) is det. - % Succeeds iff the given C type is known by the compiler to be - % an integer or pointer type the same size as MR_Word. - % + % Succeeds iff the given C type is known by the compiler to be + % an integer or pointer type the same size as MR_Word. + % :- pred c_type_is_word_sized_int_or_ptr(string::in) is semidet. %-----------------------------------------------------------------------------% @@ -103,659 +105,625 @@ %-----------------------------------------------------------------------------% -export__get_foreign_export_decls(HLDS, ForeignExportDecls) :- - module_info_get_predicate_table(HLDS, PredicateTable), - predicate_table_get_preds(PredicateTable, Preds), +get_foreign_export_decls(HLDS, ForeignExportDecls) :- + module_info_get_predicate_table(HLDS, PredicateTable), + predicate_table_get_preds(PredicateTable, Preds), - module_info_get_foreign_decl(HLDS, RevForeignDecls), - ForeignDecls = list__reverse(RevForeignDecls), + module_info_get_foreign_decl(HLDS, RevForeignDecls), + ForeignDecls = list__reverse(RevForeignDecls), - module_info_get_pragma_exported_procs(HLDS, ExportedProcs), - module_info_get_globals(HLDS, Globals), - export__get_foreign_export_decls_2(Preds, ExportedProcs, Globals, - HLDS, C_ExportDecls), + module_info_get_pragma_exported_procs(HLDS, ExportedProcs), + module_info_get_globals(HLDS, Globals), + get_foreign_export_decls_2(Preds, ExportedProcs, Globals, HLDS, + C_ExportDecls), - ForeignExportDecls = foreign_export_decls(ForeignDecls, C_ExportDecls). + ForeignExportDecls = foreign_export_decls(ForeignDecls, C_ExportDecls). -:- pred export__get_foreign_export_decls_2(pred_table::in, - list(pragma_exported_proc)::in, globals::in, module_info::in, - list(foreign_export_decl)::out) is det. +:- pred get_foreign_export_decls_2(pred_table::in, + list(pragma_exported_proc)::in, globals::in, module_info::in, + list(foreign_export_decl)::out) is det. -export__get_foreign_export_decls_2(_Preds, [], _, _, []). -export__get_foreign_export_decls_2(Preds, [E | ExportedProcs], Globals, Module, - C_ExportDecls) :- - E = pragma_exported_proc(PredId, ProcId, C_Function, _Ctxt), - get_export_info(Preds, PredId, ProcId, Globals, Module, _HowToDeclare, - C_RetType, _DeclareReturnVal, _FailureAction, _SuccessAction, - HeadArgInfoTypes), - get_argument_declarations(HeadArgInfoTypes, no, Module, ArgDecls), - C_ExportDecl = foreign_export_decl(c, C_RetType, C_Function, ArgDecls), - export__get_foreign_export_decls_2(Preds, ExportedProcs, Globals, - Module, C_ExportDecls0), - C_ExportDecls = [C_ExportDecl | C_ExportDecls0]. +get_foreign_export_decls_2(_Preds, [], _, _, []). +get_foreign_export_decls_2(Preds, [E | ExportedProcs], Globals, + ModuleInfo, C_ExportDecls) :- + E = pragma_exported_proc(PredId, ProcId, C_Function, _Ctxt), + get_export_info(Preds, PredId, ProcId, Globals, ModuleInfo, _HowToDeclare, + C_RetType, _DeclareReturnVal, _FailureAction, _SuccessAction, + HeadArgInfoTypes), + get_argument_declarations(HeadArgInfoTypes, no, ModuleInfo, ArgDecls), + C_ExportDecl = foreign_export_decl(c, C_RetType, C_Function, ArgDecls), + get_foreign_export_decls_2(Preds, ExportedProcs, Globals, + ModuleInfo, C_ExportDecls0), + C_ExportDecls = [C_ExportDecl | C_ExportDecls0]. %-----------------------------------------------------------------------------% -export__get_foreign_export_defns(Module, ExportedProcsCode) :- - module_info_get_pragma_exported_procs(Module, ExportedProcs), - module_info_get_predicate_table(Module, PredicateTable), - predicate_table_get_preds(PredicateTable, Preds), - export__to_c(Preds, ExportedProcs, Module, ExportedProcsCode). +get_foreign_export_defns(ModuleInfo, ExportedProcsCode) :- + module_info_get_pragma_exported_procs(ModuleInfo, ExportedProcs), + module_info_get_predicate_table(ModuleInfo, PredicateTable), + predicate_table_get_preds(PredicateTable, Preds), + to_c(Preds, ExportedProcs, ModuleInfo, ExportedProcsCode). - % For each exported procedure, produce a C function. - % The code we generate is in the form - % - % MR_declare_entry(