From 3dd02876a5dc325263a022b3be38932d2accc980 Mon Sep 17 00:00:00 2001 From: Julien Fischer Date: Mon, 21 Sep 2015 11:34:08 +1000 Subject: [PATCH] Delete the MLDS->IL backend. compiler/mlds_to_il.m: compiler/mlds_to_ilasm.m: compiler/mlds_to_managed.m: compiler/il_peephole.m: compiler/ilasm.m: compiler/ilds.m: Delete the modules making up the MLDS->IL code generator. compiler/globals.m: compiler/prog_data.m: Delete IL as a target and foreign language. compiler/prog_io_pragma.m: Delete the max_stack_size/1 foreign proc attribute. This was only ever required by the IL backend. compiler/options.m Delete options used for the IL backend. compiler/write_deps_file.m: Don't generate mmake targets for .il files etc. compiler/*.m: Conform to the above changes. compiler/notes/compiler_design.html compiler/notes/work_in_progress.html Conform to the above changes. library/*.m: Delete IL foreign_proc and foreign_export pragmas. README.DotNet: Delete this file. browser/Mmakefile: compiler/Mmakefile: deep_profiler/Mmakefile: mdbcomp/Mmakefile: mfilterjavac/Mmakefile: profiler/Mmakefile: runtime/Mmakefile: slice/Mmakefile: Conform the above changes. configure.ac: Don't check that IL is a supported foreign language when performing the up-to-date check. Delete the '--enable-dotnet-grades' option. scripts/Mmake.vars.in: Delete variables used for the IL backend (and in on case by the Aditi backend). scripts/Mercury.config.bootstrap.in: scripts/Mercury.config.in: scripts/Mmake.rules: scripts/canonical_grade.sh-subr: tools/bootcheck: Delete stuff related to the 'il' and 'ilc' grades. doc/reference_manual.texi: Delete the documentation of the 'max_stack_size' option. doc/user_guide.texi: Delete stuff related to the IL backend. tests/hard_coded/csharp_test.{m,exp}: tests/invalid/foreign_type_missing.{m,err_exp}: tests/valid/csharp_hello.m: Delete these tests: they are no longer relevant. tests/hard_coded/equality_pred_which_requires_boxing.m: tests/hard_coded/foreign_import_module.m: tests/hard_coded/foreign_import_module_2.m: tests/hard_coded/foreign_type.m: tests/hard_coded/foreign_type2.m: tests/hard_coded/foreign_type3.m: tests/hard_coded/intermod_foreign_type2.m: tests/hard_coded/lp.m: tests/hard_coded/user_compare.m: tests/invalid/foreign_type_2.m: tests/invalid/foreign_type_missing.{m,err_exp}: tests/invalid/foreign_type_visibility.m: tests/invalid/illtyped_compare.{m,err_exp}: tests/submodules/external_unification_pred.m tests/valid/big_foreign_type.m tests/valid/solver_type_bug.m tests/valid_seq/foreign_type_spec.m tests/valid_seq/intermod_impure2.m Delete IL foreign_procs where necessary. tests/hard_coded/Mmakefile tests/invalid/Mercury.options tests/invalid/Mmakefile tests/submodules/Mmakefile tests/valid/Mercury.options tests/valid/Mmake.valid.common tests/valid/Mmakefile tests/valid_seq/Mmakefile tests/valid_seq/Mercury.options Conform to the above changes. --- README.DotNet | 268 - browser/Mmakefile | 8 +- compiler/Mmakefile | 12 +- compiler/add_foreign_enum.m | 6 +- compiler/add_foreign_proc.m | 3 +- compiler/add_mutable_aux_preds.m | 13 - compiler/add_solver.m | 4 - compiler/add_type.m | 23 +- compiler/code_gen.m | 1 - compiler/compile_target_code.m | 85 +- compiler/const_struct.m | 3 +- compiler/export.m | 2 - compiler/foreign.m | 35 +- compiler/globals.m | 35 +- compiler/granularity.m | 3 +- compiler/handle_options.m | 185 +- compiler/hlds_code_util.m | 3 +- compiler/hlds_data.m | 1 - compiler/il_peephole.m | 815 --- compiler/ilasm.m | 2170 -------- compiler/ilds.m | 641 --- compiler/int_emu.m | 3 +- compiler/intermod.m | 64 +- compiler/lambda.m | 1 - compiler/llds_out_file.m | 2 - compiler/make.dependencies.m | 18 - compiler/make.m | 7 +- compiler/make.module_target.m | 83 +- compiler/make.program_target.m | 39 +- compiler/make.util.m | 55 +- compiler/make_hlds_warn.m | 26 - compiler/make_tags.m | 3 +- compiler/mercury_compile.m | 26 +- compiler/mercury_compile_llds_back_end.m | 4 - compiler/mercury_compile_middle_passes.m | 6 +- compiler/mercury_compile_mlds_back_end.m | 16 +- compiler/ml_backend.m | 8 - compiler/ml_closure_gen.m | 14 +- compiler/ml_code_util.m | 15 +- compiler/ml_disj_gen.m | 1 - compiler/ml_elim_nested.m | 15 +- compiler/ml_foreign_proc_gen.m | 316 +- compiler/ml_global_data.m | 4 +- compiler/ml_optimize.m | 4 +- compiler/ml_proc_gen.m | 31 +- compiler/ml_target_util.m | 6 - compiler/ml_type_gen.m | 13 +- compiler/ml_unify_gen.m | 15 +- compiler/ml_util.m | 58 +- compiler/mlds.m | 41 +- compiler/mlds_to_c.m | 21 +- compiler/mlds_to_cs.m | 14 +- compiler/mlds_to_il.m | 4696 ----------------- compiler/mlds_to_ilasm.m | 145 - compiler/mlds_to_java.m | 16 +- compiler/mlds_to_managed.m | 777 --- compiler/notes/compiler_design.html | 20 - compiler/notes/work_in_progress.html | 6 - compiler/options.m | 164 +- compiler/options_file.m | 6 +- compiler/parse_tree_out.m | 16 - compiler/parse_tree_out_pragma.m | 2 - compiler/polymorphism.m | 1 - compiler/pragma_c_gen.m | 3 +- compiler/prog_data.m | 43 +- compiler/prog_foreign.m | 30 - compiler/prog_io_pragma.m | 126 +- compiler/prog_item.m | 3 +- compiler/simplify_goal_scope.m | 12 - compiler/special_pred.m | 3 +- compiler/string_encoding.m | 3 +- compiler/write_deps_file.m | 228 +- configure.ac | 18 - deep_profiler/Mmakefile | 4 +- doc/reference_manual.texi | 10 - doc/user_guide.texi | 27 - library/array.m | 6 - library/bitmap.m | 3 - library/bool.m | 2 - library/dir.m | 21 - library/exception.m | 10 - library/float.m | 16 - library/gc.m | 1 - library/io.m | 63 - library/list.m | 2 - library/par_builtin.m | 2 - library/private_builtin.m | 10 +- library/profiling_builtin.m | 6 - library/store.m | 2 - library/string.m | 2 - library/table_builtin.m | 8 - library/table_statistics.m | 6 - library/thread.semaphore.m | 2 - library/time.m | 6 - library/type_desc.m | 9 +- library/univ.m | 10 +- mdbcomp/Mmakefile | 12 +- mfilterjavac/Mmakefile | 4 +- profiler/Mmakefile | 5 +- runtime/Mmakefile | 16 - scripts/Mercury.config.bootstrap.in | 1 - scripts/Mercury.config.in | 1 - scripts/Mmake.rules | 72 +- scripts/Mmake.vars.in | 44 +- scripts/canonical_grade.sh-subr | 2 - slice/Mmakefile | 7 +- tests/hard_coded/Mmakefile | 34 +- tests/hard_coded/csharp_test.exp | 1 - tests/hard_coded/csharp_test.m | 34 - .../equality_pred_which_requires_boxing.m | 5 - tests/hard_coded/foreign_import_module.m | 1 - tests/hard_coded/foreign_import_module_2.m | 1 - tests/hard_coded/foreign_type.m | 4 - tests/hard_coded/foreign_type2.m | 4 - tests/hard_coded/foreign_type3.m | 5 - tests/hard_coded/intermod_foreign_type2.m | 4 - tests/hard_coded/lp.m | 6 - tests/hard_coded/user_compare.m | 2 - tests/invalid/Mercury.options | 1 - tests/invalid/Mmakefile | 2 +- tests/invalid/foreign_type_2.m | 2 +- tests/invalid/foreign_type_missing.err_exp | 3 - tests/invalid/foreign_type_missing.m | 14 - tests/invalid/foreign_type_visibility.m | 4 +- tests/invalid/illtyped_compare.err_exp | 68 +- tests/invalid/illtyped_compare.m | 2 - tests/submodules/Mmakefile | 2 +- tests/submodules/external_unification_pred.m | 2 - tests/valid/Mercury.options | 1 - tests/valid/Mmake.valid.common | 24 +- tests/valid/Mmakefile | 3 - tests/valid/big_foreign_type.m | 4 - tests/valid/csharp_hello.m | 18 - tests/valid/solver_type_bug.m | 1 - tests/valid_seq/Mercury.options | 6 - tests/valid_seq/Mmakefile | 11 +- tests/valid_seq/foreign_type_spec.m | 21 - tests/valid_seq/intermod_impure2.m | 8 - tools/bootcheck | 13 - 139 files changed, 297 insertions(+), 11969 deletions(-) delete mode 100644 README.DotNet delete mode 100644 compiler/il_peephole.m delete mode 100644 compiler/ilasm.m delete mode 100644 compiler/ilds.m delete mode 100644 compiler/mlds_to_il.m delete mode 100644 compiler/mlds_to_ilasm.m delete mode 100644 compiler/mlds_to_managed.m delete mode 100644 tests/hard_coded/csharp_test.exp delete mode 100644 tests/hard_coded/csharp_test.m delete mode 100644 tests/invalid/foreign_type_missing.err_exp delete mode 100644 tests/invalid/foreign_type_missing.m delete mode 100644 tests/valid/csharp_hello.m delete mode 100644 tests/valid_seq/foreign_type_spec.m diff --git a/README.DotNet b/README.DotNet deleted file mode 100644 index 0037dc8bb..000000000 --- a/README.DotNet +++ /dev/null @@ -1,268 +0,0 @@ ------------------------------------------------------------------------------ - -WARNING - -The .NET backend described herein is out-of-date and may be removed in -the future. See README.CSharp for details of a newer backend that targets .NET. - -INTRODUCTION - -This release of Mercury contains a port to the Microsoft.NET Common -Language Runtime (CLR). The Mercury compiler will generate code -in Microsoft's Intermediate Language (IL) that can be assembled into -bytecode suitable for running in the .NET runtime system. - -The port is mostly complete, but some parts of the Mercury standard -library are not yet implemented (for a full list see the FAQ below). -However, enough is implemented correctly to bootstrap the Mercury -compiler, and to pass more than 90% of the applicable tests in the Mercury -test suite. - -The port is currently targeted at the Microsoft .NET Framework SDK versions -1 and 1.1. We recommend version 1.1. - -PREREQUISITES - -In order to try this system you will need - - - The Microsoft .NET Framework SDK version 1 or 1.1, which can be - downloaded for free from: - - - - If you are an MSDN Universal subscriber you can also order - CDs as part of your subscription. - - It might also work with later versions, but we haven't tested - with those. - - - A windows system suitable for development with Microsoft .NET. - According to Microsoft, the .NET Framework SDK runs on: - - Microsoft Windows NT 4.0 (SP 6a required) - Microsoft Windows 2000 (SP 2 recommended) - Microsoft Windows XP Professional - - We have tested only on Windows 2000 (with SP 2) and - Windows XP Home. - - - Cygwin (see README.MS-Windows for how to install). - The Mercury compiler still runs as a native compiler, built - with gcc by default -- although see README.MS-VisualC for how - to build with VC++ if you wish. - Mercury still relies upon the Cygwin environment for - development environment tools such as `mmake'. - - You need the following Cygwin packages: - - gcc - - binutils - - make - - - If you have installed the .NET SDK as part of Visual - Studio .NET, you will need to put the Visual Studio - binaries in your path, and set appropriate environment - variables. The easiest way to do this is to put the line - -call "C:\Program Files\Microsoft Visual Studio.NET\Common7\Tools\vsvars32.bat" - - into your cygwin.bat file (installed on the desktop by Cygwin), - after the line that says @echo off. - Substitute your Visual Studio installation path for the default path - given here. - - - The Mercury distribution -- installed as usual. You invoke the - configure with the option `--enable-dotnet-grades' in order to - enable .NET support. Make sure the installation is run after the - Microsoft .NET SDK is installed (run it again if necessary) so that - the configuration scripts detect the installation path of the SDK. - If `configure' finds `ilasm' and `cl' then this has been successful. - You can install from either the source or binary distribution. - - If you're reading this file from somewhere other than the Mercury - distribution, try the Mercury homepage at: - - - ------------------------------------------------------------------------------ - -THE IL GRADE - -The Mercury compiler currently supports the grade `il' to target the -Microsoft.NET CLR. This grade is enabled by any of the options -`--grade il', `--target il', or just `--il'. - -Support for building and installation of this grade is still somewhat -rudimentary. - -To run a Mercury program using the il grade, you need to build the -library and runtime in the il grade, using the Mercury source distribution. -If configure finds the .NET SDK installed on your machine, the il grade -will be added to the list of default grades to be installed, so simply -running - mmake install -from the Mercury source distribution will install the il grade. - -You can now build programs such as hello.m or calculator.m in the samples -directory. - - cd samples - mmc --make --il hello - -Now you can run hello - - ./hello.exe - -Alternatively, if you prefer, you can use mmake rather than `mmc --make': - - mmake hello.depend GRADE=il - mmake hello GRADE=il - ./hello.exe - -You can also set the grade in an Mmakefile, by adding the line - - GRADE=il - -to the Mmakefile; then you can leave the "GRADE=il" part off the mmake -commands. - ------------------------------------------------------------------------------ - -USING DOTNET - -The Mercury standard library has not been fully ported to .NET yet. -The use of unimplemented procedures will result in a run-time error, -with a message such as "Sorry, not implemented: foreign code for this -function", and a stack trace. - -If you find missing functionality, you can interface to the .NET -Frameworks using C# and Mercury's foreign language interface. - -For example: - - :- pred to_string(T::in, string::out) is det. - :- pragma foreign_proc("C#", - to_string(T::in, Str::out), - [promise_pure, will_not_call_mercury], - " - Str = T.ToString(); - "). - -For more information about the foreign language interface, refer to the Mercury -Language Reference Manual, which you can find at: - - - -The implementation will put this C# in a separate file, which will be -compiled with Microsoft's C# compiler. Mmake will automatically -generate dependencies for this file and invoke the C# compiler with the -appropriate options. - -You can also use the C# interface to interface with any .NET language -(Implementations have been announced or are under development for -C++, C#, Visual Basic, Cobol, Eiffel, SmallTalk, ML, Haskell, Scheme, -Python, Perl, Component Pascal and others). - -Add a - CSCFLAGS-_csharp_code=/reference:.dll -or - CSCFLAGS-_csharp_code=/addmodule:.dll - -to your Mmakefile to pass the appropriate flag to the C# compiler so -that you can reference another DLL from the C# code. - is the name of your Mercury module, and is -the name of the dll you want to use from Mercury via C#. - -We are working on a tool that automatically generates a Mercury interface -for any .NET component, but it is not yet ready for public use. - -Currently each top level Mercury module is placed into its own assembly. -For example, module.m will be placed into the assembly `module', while -module.sub.m will also be placed into the assembly `module'. - -To create a strongly named assemblies in Mercury you need to pass the ---sign-assembly flag to the Mercury compiler. Note that this flag needs -to be also passed when generating the dependencies for the module being -compiled. Currently we use the same strong name as used by the mercury -standard library to sign all the Mercury modules, at a later date we -hope to lift this restriction. - ------------------------------------------------------------------------------ - -RESOURCES - -You might find the following pages useful: - - - - - - - ------------------------------------------------------------------------------ - -FREQUENTLY ASKED QUESTIONS (FAQS) - -Q. What are the advantages of using the .NET back-end? - -A. The main advantage is easy access to the wide range of libraries for the - .NET platform. - - -Q. Does it work with other .NET Common Language Runtime implementations, - such as Mono, Portable.Net, or Rotor? - -A. In theory, it should be possible to build Mercury programs in the - `il' grade using any ECMA-compliant IL assembler that provides the same - command-line interface as the Microsoft ilasm.exe program, and to execute - them using any ECMA-complaint .NET CLR implementation. However, we have - not yet tried using other .NET CLR implementations. - - -Q. Does it work with versions of the Microsoft .NET Framework SDK greater - than 2.0? - -A. We don't know, because we've only tried it with version 1.0 and 1.1. - If you have a later version, try it out yourself and let us know - whether it works! - - -Q. How does it compare in efficiency with the usual Mercury implementation? - -A. Our paper "Compiling Mercury to the .NET Common Language Runtime", - which is available from the Mercury web site, has some benchmark - results. As usual, your mileage may vary. - - -Q. What features are not yet implemented? - -A. The following standard library modules are completely unimplemented: - - benchmarking - store - - The standard library modules that provide RTTI are only partly implemented - (basically just enough to make io.print work): - - construct - deconstruct - - In addition, the following individual procedures from other modules - are still not yet implemented: - - io.binary_stream_offset/4 - io.seek_binary/5 - type_desc.make_type/2 - type_desc.type_ctor/1 - time.clock/3 - time.times/4 - - The following procedures are implemented, but not completely: - - time.local_time/3 - time.mktime/3 - During times close to the transition to/from daylight savings time, - local_time/3 may return incorrect values for the tm_dst field, - and mktime/3 may incorrectly ignore the value of the tm_dst field - in its input. The problem is due to flaws in the .NET time APIs. - ------------------------------------------------------------------------------ diff --git a/browser/Mmakefile b/browser/Mmakefile index 5d9c569ae..abe9ec3ad 100644 --- a/browser/Mmakefile +++ b/browser/Mmakefile @@ -103,7 +103,7 @@ LN = ln # complete, so we need to pass `--allow-stubs' to get them to compile. # Since the standard library is compiled with `--halt-at-warn', # we also need `--no-warn-stubs'. -ifneq ("$(filter il% csharp% java% erlang%,$(GRADE))","") +ifneq ("$(filter csharp% java% erlang%,$(GRADE))","") MCFLAGS += --allow-stubs --no-warn-stubs endif @@ -218,15 +218,13 @@ dates: #-----------------------------------------------------------------------------# -.PHONY: os cs ils +.PHONY: os cs ifneq ($(MMAKE_USE_MMC_MAKE),yes) os: $($(BROWSER_LIB_NAME).os) cs: $($(BROWSER_LIB_NAME).cs) -ils: $($(BROWSER_LIB_NAME).ils) else os: $(BROWSER_LIB_NAME).os cs: $(BROWSER_LIB_NAME).cs -ils: $(BROWSER_LIB_NAME).ils endif #-----------------------------------------------------------------------------# @@ -248,7 +246,7 @@ realclean_local: .PHONY: install install: install_library -ifneq ("$(filter il% erlang%,$(GRADE))","") +ifneq ("$(filter erlang%,$(GRADE))","") # there is no browser in the .NET or Erlang backends diff --git a/compiler/Mmakefile b/compiler/Mmakefile index 842f294bd..f4d0cae45 100644 --- a/compiler/Mmakefile +++ b/compiler/Mmakefile @@ -45,7 +45,7 @@ VPATH = \ MCFLAGS += --flags COMP_FLAGS $(CONFIG_OVERRIDE) -ifeq ("$(filter il% csharp% java% erlang%,$(GRADE))","") +ifeq ("$(filter csharp% java% erlang%,$(GRADE))","") MLOBJS := ../trace/lib$(EVENTSPEC_LIB_NAME).$A \ $(MLOBJS) MLLIBS += $(THREAD_LIBS) @@ -152,13 +152,6 @@ endif # Add some additional dependencies, so that Mmake knows to remake the # compiler if one of the libraries changes. -ifeq ($(findstring il,$(GRADE)),il) -CSCFLAGS=/lib - -# This line works around an Mmake bug: mmake doesn't record -# dependencies properly with --transitive-intermodule-optimization -%.il: opts -else ifeq ("$(filter csharp% java% erlang%,$(GRADE))","") $(MC_PROG): $(RUNTIME_DIR)/lib$(RT_LIB_NAME).$A $(MC_PROG): $(LIBRARY_DIR)/lib$(STD_LIB_NAME).$A @@ -170,7 +163,6 @@ $(MC_PROG): $(TRACE_DIR)/lib$(EVENTSPEC_LIB_NAME).$A # XXX should also depend on $(BOEHM_GC_DIR)/libgc(_prof).$A, but only # if in .gc(.prof) grade endif -endif #-----------------------------------------------------------------------------# @@ -224,12 +216,10 @@ dates: ifneq ($(MMAKE_USE_MMC_MAKE),yes) os: $($(MC_PROG).os) cs: $($(MC_PROG).cs) -ils: $($(MC_PROG).ils) opts: $($(MC_PROG).opts) else os: $(MC_PROG).os cs: $(MC_PROG).cs -ils: $(MC_PROG).ils opts: $(MC_PROG).opts endif diff --git a/compiler/add_foreign_enum.m b/compiler/add_foreign_enum.m index 69af1edaa..8059a2329 100644 --- a/compiler/add_foreign_enum.m +++ b/compiler/add_foreign_enum.m @@ -234,7 +234,6 @@ build_export_enum_name_map(ContextPieces, Lang, TypeName, TypeArity, Context, What = "Java identifiers." ; ( Lang = lang_csharp - ; Lang = lang_il ; Lang = lang_erlang ), sorry($module, $pred, @@ -350,9 +349,7 @@ add_ctor_to_name_map(Lang, Prefix, MakeUpperCase, _TypeModQual, Ctor, ), IsValidForeignName = pred_to_bool(is_valid_c_identifier(ForeignName)) ; - ( Lang = lang_il - ; Lang = lang_erlang - ), + Lang = lang_erlang, sorry($module, $pred, "foreign_export_enum for target language") ), ( @@ -579,7 +576,6 @@ fixup_foreign_tag_val_qualification(TypeModuleName, !NamesAndTags, = foreign_language. target_lang_to_foreign_enum_lang(target_c) = lang_c. -target_lang_to_foreign_enum_lang(target_il) = lang_il. target_lang_to_foreign_enum_lang(target_csharp) = lang_csharp. target_lang_to_foreign_enum_lang(target_java) = lang_java. target_lang_to_foreign_enum_lang(target_erlang) = lang_erlang. diff --git a/compiler/add_foreign_proc.m b/compiler/add_foreign_proc.m index fe70e236a..deeefc6c7 100644 --- a/compiler/add_foreign_proc.m +++ b/compiler/add_foreign_proc.m @@ -388,8 +388,7 @@ add_pragma_foreign_proc(FPInfo, PredStatus, Context, MaybeItemNumber, is_applicable_for_current_backend(_CurrentBackend, []) = yes. is_applicable_for_current_backend(CurrentBackend, [Attr | Attrs]) = Result :- ( - ( Attr = max_stack_size(_) - ; Attr = refers_to_llds_stack + ( Attr = refers_to_llds_stack ; Attr = needs_call_standard_output_registers ), Result = is_applicable_for_current_backend(CurrentBackend, Attrs) diff --git a/compiler/add_mutable_aux_preds.m b/compiler/add_mutable_aux_preds.m index c89826a07..771509b3b 100644 --- a/compiler/add_mutable_aux_preds.m +++ b/compiler/add_mutable_aux_preds.m @@ -347,15 +347,6 @@ do_mutable_checks(ItemMutable, !ModuleInfo, !Specs) :- ModuleName, Name, ForeignLanguage, ForeignNames, _TargetMutableName, !Specs) ) - ; - CompilationTarget = target_il, - Pieces = [words("Error: foreign_name mutable attribute"), - words("is not yet implemented for the"), - fixed(compilation_target_string(CompilationTarget)), - words("backend."), nl], - Msg = simple_msg(Context, [always(Pieces)]), - Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]), - !:Specs = [Spec | !.Specs] ), % If the mutable is to be trailed, then we need to be in a trailing grade. @@ -1438,10 +1429,6 @@ get_mutable_target_params(ModuleInfo, MutAttrs, MaybeTargetParams) :- TargetParams = mutable_target_params(ImplLang, Lang, BoxPolicy, PreInit, LockUnlock, UnsafeAccess), MaybeTargetParams = yes(TargetParams) - ; - CompilationTarget = target_il, - % Mutables are not supported on the IL backend. - MaybeTargetParams = no ). %---------------------------------------------------------------------------% diff --git a/compiler/add_solver.m b/compiler/add_solver.m index fab3d6dfd..10350237e 100644 --- a/compiler/add_solver.m +++ b/compiler/add_solver.m @@ -189,10 +189,6 @@ add_solver_type_aux_pred_defns(TypeSymName, TypeParams, SolverTypeDetails, ; Target = target_erlang, Lang = lang_erlang - ; - Target = target_il, - WhatMsg = "solver type conversion functions for this backend", - sorry($module, WhatMsg) ), Attrs0 = default_attributes(Lang), diff --git a/compiler/add_type.m b/compiler/add_type.m index 7b7ef66c8..3fe91aaaf 100644 --- a/compiler/add_type.m +++ b/compiler/add_type.m @@ -472,7 +472,6 @@ check_foreign_type(TypeCtor, ForeignTypeBody, PrevErrors, Context, FoundInvalidType = found_invalid_type else ( Target = target_c, LangStr = "C" - ; Target = target_il, LangStr = "IL" ; Target = target_csharp, LangStr = "C#" ; Target = target_java, LangStr = "Java" ; Target = target_erlang, LangStr = "Erlang" @@ -507,7 +506,7 @@ merge_foreign_type_bodies(Target, MakeOptInterface, MaybeForeignTypeBody1 = yes(ForeignTypeBody1) ; MaybeForeignTypeBody1 = no, - ForeignTypeBody1 = foreign_type_body(no, no, no, no, no) + ForeignTypeBody1 = foreign_type_body(no, no, no, no) ), merge_foreign_type_bodies_2(ForeignTypeBody0, ForeignTypeBody1, ForeignTypeBody), @@ -531,16 +530,15 @@ merge_foreign_type_bodies(_, _, hlds_foreign_type(Body0), foreign_type_body::in, foreign_type_body::out) is semidet. merge_foreign_type_bodies_2(TypeBodyA, TypeBodyB, TypeBody) :- - TypeBodyA = foreign_type_body(MaybeILA, MaybeCA, MaybeJavaA, MaybeCSharpA, + TypeBodyA = foreign_type_body(MaybeCA, MaybeJavaA, MaybeCSharpA, MaybeErlangA), - TypeBodyB = foreign_type_body(MaybeILB, MaybeCB, MaybeJavaB, MaybeCSharpB, + TypeBodyB = foreign_type_body(MaybeCB, MaybeJavaB, MaybeCSharpB, MaybeErlangB), - merge_maybe(MaybeILA, MaybeILB, MaybeIL), merge_maybe(MaybeCA, MaybeCB, MaybeC), merge_maybe(MaybeJavaA, MaybeJavaB, MaybeJava), merge_maybe(MaybeCSharpA, MaybeCSharpB, MaybeCSharp), merge_maybe(MaybeErlangA, MaybeErlangB, MaybeErlang), - TypeBody = foreign_type_body(MaybeIL, MaybeC, MaybeJava, MaybeCSharp, + TypeBody = foreign_type_body(MaybeC, MaybeJava, MaybeCSharp, MaybeErlang). :- pred merge_maybe(maybe(T)::in, maybe(T)::in, maybe(T)::out) is semidet. @@ -580,30 +578,25 @@ convert_type_defn(parse_tree_abstract_type(Details), _, _, convert_type_defn(parse_tree_foreign_type(ForeignType, MaybeUserEqComp, Assertions), _, _, hlds_foreign_type(Body)) :- ( - ForeignType = il(ILForeignType), - Data = foreign_type_lang_data(ILForeignType, MaybeUserEqComp, - Assertions), - Body = foreign_type_body(yes(Data), no, no, no, no) - ; ForeignType = c(CForeignType), Data = foreign_type_lang_data(CForeignType, MaybeUserEqComp, Assertions), - Body = foreign_type_body(no, yes(Data), no, no, no) + Body = foreign_type_body(yes(Data), no, no, no) ; ForeignType = java(JavaForeignType), Data = foreign_type_lang_data(JavaForeignType, MaybeUserEqComp, Assertions), - Body = foreign_type_body(no, no, yes(Data), no, no) + Body = foreign_type_body(no, yes(Data), no, no) ; ForeignType = csharp(CSharpForeignType), Data = foreign_type_lang_data(CSharpForeignType, MaybeUserEqComp, Assertions), - Body = foreign_type_body(no, no, no, yes(Data), no) + Body = foreign_type_body(no, no, yes(Data), no) ; ForeignType = erlang(ErlangForeignType), Data = foreign_type_lang_data(ErlangForeignType, MaybeUserEqComp, Assertions), - Body = foreign_type_body(no, no, no, no, yes(Data)) + Body = foreign_type_body(no, no, no, yes(Data)) ). :- pred add_type_defn_ctors(list(constructor)::in, type_ctor::in, diff --git a/compiler/code_gen.m b/compiler/code_gen.m index d692d32c9..5c007faac 100644 --- a/compiler/code_gen.m +++ b/compiler/code_gen.m @@ -306,7 +306,6 @@ generate_goal_expr(GoalExpr, GoalInfo, CodeModel, ForwardLiveVarsBeforeGoal, ; ( Lang = lang_java ; Lang = lang_csharp - ; Lang = lang_il ; Lang = lang_erlang ), unexpected($module, $pred, "foreign code other than C") diff --git a/compiler/compile_target_code.m b/compiler/compile_target_code.m index 561958a6e..3571bc5e8 100644 --- a/compiler/compile_target_code.m +++ b/compiler/compile_target_code.m @@ -21,7 +21,6 @@ :- import_module libs.file_util. :- import_module parse_tree. :- import_module parse_tree.module_imports. -:- import_module parse_tree.prog_data. :- import_module mdbcomp. :- import_module mdbcomp.sym_name. @@ -57,18 +56,6 @@ :- pred compile_java_files(globals::in, io.output_stream::in, list(string)::in, bool::out, io::di, io::uo) is det. - % il_assemble(Globals, ErrorStream, ModuleName, HasMain, Succeeded, !IO) - % -:- pred il_assemble(globals::in, io.output_stream::in, module_name::in, - has_main::in, bool::out, io::di, io::uo) is det. - - % do_il_assemble(Globals, ErrorStream, ILFile, DLLFile, HasMain, Succeeded, - % !IO) - % -:- pred do_il_assemble(globals::in, io.output_stream::in, - file_name::in, file_name::in, has_main::in, bool::out, - io::di, io::uo) is det. - % compile_csharp_file(Globals, ErrorStream, C#File, DLLFile, Succeeded, % !IO) % @@ -252,6 +239,7 @@ :- import_module parse_tree.file_names. :- import_module parse_tree.module_cmds. :- import_module parse_tree.write_deps_file. +:- import_module parse_tree.prog_data. :- import_module parse_tree.prog_foreign. :- import_module dir. @@ -262,74 +250,6 @@ %-----------------------------------------------------------------------------% -il_assemble(Globals, ErrorStream, ModuleName, HasMain, Succeeded, !IO) :- - module_name_to_file_name(Globals, ModuleName, ".il", - do_not_create_dirs, IL_File, !IO), - module_name_to_file_name(Globals, ModuleName, ".dll", - do_create_dirs, DllFile, !IO), - - % If the module contains main/2 then we it should be built as an - % executable. Unfortunately C# code may refer to the dll - % so we always need to build the dll. - - do_il_assemble(Globals, ErrorStream, IL_File, DllFile, no_main, - DllSucceeded, !IO), - ( - HasMain = has_main, - module_name_to_file_name(Globals, ModuleName, ".exe", - do_create_dirs, ExeFile, !IO), - do_il_assemble(Globals, ErrorStream, IL_File, ExeFile, HasMain, - ExeSucceeded, !IO), - Succeeded = DllSucceeded `and` ExeSucceeded - ; - HasMain = no_main, - Succeeded = DllSucceeded - ). - -do_il_assemble(Globals, ErrorStream, IL_File, TargetFile, HasMain, Succeeded, - !IO) :- - globals.lookup_bool_option(Globals, verbose, Verbose), - globals.lookup_bool_option(Globals, sign_assembly, SignAssembly), - maybe_write_string(Verbose, "% Assembling `", !IO), - maybe_write_string(Verbose, IL_File, !IO), - maybe_write_string(Verbose, "':\n", !IO), - globals.lookup_string_option(Globals, il_assembler, ILASM), - globals.lookup_accumulating_option(Globals, ilasm_flags, ILASMFlagsList), - join_string_list(ILASMFlagsList, "", "", " ", ILASMFlags), - ( - SignAssembly = yes, - SignOpt = "/keyf=mercury.sn " - ; - SignAssembly = no, - SignOpt = "" - ), - ( - Verbose = yes, - VerboseOpt = "" - ; - Verbose = no, - VerboseOpt = "/quiet " - ), - globals.lookup_bool_option(Globals, target_debug, Debug), - ( - Debug = yes, - DebugOpt = "/debug " - ; - Debug = no, - DebugOpt = "" - ), - ( - HasMain = has_main, - TargetOpt = "" - ; - HasMain = no_main, - TargetOpt = "/dll " - ), - string.append_list([ILASM, " ", SignOpt, VerboseOpt, DebugOpt, - TargetOpt, ILASMFlags, " /out=", TargetFile, " ", IL_File], Command), - invoke_system_command(Globals, ErrorStream, cmd_verbose_commands, Command, - Succeeded, !IO). - compile_csharp_file(Globals, ErrorStream, ModuleAndImports, CSharpFileName0, DLLFileName, Succeeded, !IO) :- globals.lookup_bool_option(Globals, verbose, Verbose), @@ -2796,9 +2716,6 @@ process_link_library(Globals, MercuryLibDirs, LibName, LinkerOpt, !Succeeded, MercuryLinkage = "shared", LinkOpt = "-r:", LibSuffix = ".dll" - ; - Target = target_il, - unexpected($module, $pred, "target_java") ; Target = target_java, unexpected($module, $pred, "target_java") diff --git a/compiler/const_struct.m b/compiler/const_struct.m index a381606df..3a14f98eb 100644 --- a/compiler/const_struct.m +++ b/compiler/const_struct.m @@ -156,8 +156,7 @@ const_struct_db_init(Globals, Db) :- can_enable_const_struct(Globals, PolyEnabled, _GroundTermEnabled), GroundTermEnabled = no ; - ( Target = target_il - ; Target = target_csharp + ( Target = target_csharp ; Target = target_erlang ), PolyEnabled = no, diff --git a/compiler/export.m b/compiler/export.m index 2e0176301..eaf34cda2 100644 --- a/compiler/export.m +++ b/compiler/export.m @@ -150,7 +150,6 @@ get_foreign_export_decls_loop(ModuleInfo, Preds, ; ( Lang = lang_csharp ; Lang = lang_java - ; Lang = lang_il ; Lang = lang_erlang ), sorry($module, $pred, ":- pragma foreign_export for non-C backends.") @@ -828,7 +827,6 @@ write_export_decls([ExportDecl | ExportDecls], !IO) :- ; ( Lang = lang_csharp ; Lang = lang_java - ; Lang = lang_il ; Lang = lang_erlang ), sorry($module, $pred, "foreign languages other than C unimplemented") diff --git a/compiler/foreign.m b/compiler/foreign.m index 31eab4c78..401475ee2 100644 --- a/compiler/foreign.m +++ b/compiler/foreign.m @@ -203,7 +203,6 @@ extrude_pragma_implementation_2(TargetLanguage, ForeignLanguage, ForeignLanguage = lang_c ; ( ForeignLanguage = lang_csharp - ; ForeignLanguage = lang_il ; ForeignLanguage = lang_java ; ForeignLanguage = lang_erlang ), @@ -215,19 +214,6 @@ extrude_pragma_implementation_2(TargetLanguage, ForeignLanguage, ForeignLanguage = lang_csharp ; ( ForeignLanguage = lang_c - ; ForeignLanguage = lang_il - ; ForeignLanguage = lang_java - ; ForeignLanguage = lang_erlang - ), - unimplemented_combination(TargetLanguage, ForeignLanguage) - ) - ; - TargetLanguage = lang_il, - ( - ForeignLanguage = lang_il - ; - ( ForeignLanguage = lang_c - ; ForeignLanguage = lang_csharp ; ForeignLanguage = lang_java ; ForeignLanguage = lang_erlang ), @@ -240,7 +226,6 @@ extrude_pragma_implementation_2(TargetLanguage, ForeignLanguage, ; ( ForeignLanguage = lang_c ; ForeignLanguage = lang_csharp - ; ForeignLanguage = lang_il ; ForeignLanguage = lang_erlang ), unimplemented_combination(TargetLanguage, ForeignLanguage) @@ -252,7 +237,6 @@ extrude_pragma_implementation_2(TargetLanguage, ForeignLanguage, ; ( ForeignLanguage = lang_c ; ForeignLanguage = lang_csharp - ; ForeignLanguage = lang_il ; ForeignLanguage = lang_java ), unimplemented_combination(TargetLanguage, ForeignLanguage) @@ -273,9 +257,6 @@ have_foreign_type_for_backend(Target, ForeignTypeBody, Have) :- ( Target = target_c, Have = ( if ForeignTypeBody ^ c = yes(_) then yes else no ) - ; - Target = target_il, - Have = ( if ForeignTypeBody ^ il = yes(_) then yes else no ) ; Target = target_java, Have = ( if ForeignTypeBody ^ java = yes(_) then yes else no ) @@ -333,7 +314,7 @@ foreign_type_body_to_exported_type(ModuleInfo, ForeignTypeBody, Name, % foreign_type_to_mlds_type in mlds.m. % Any changes here may require changes there as well. - ForeignTypeBody = foreign_type_body(MaybeIL, MaybeC, MaybeJava, + ForeignTypeBody = foreign_type_body(MaybeC, MaybeJava, MaybeCSharp, MaybeErlang), module_info_get_globals(ModuleInfo, Globals), globals.get_target(Globals, Target), @@ -348,16 +329,6 @@ foreign_type_body_to_exported_type(ModuleInfo, ForeignTypeBody, Name, MaybeC = no, unexpected($module, $pred, "no C type") ) - ; - Target = target_il, - ( - MaybeIL = yes(Data), - Data = foreign_type_lang_data(il_type(_, _, Name), MaybeUserEqComp, - Assertions) - ; - MaybeIL = no, - unexpected($module, $pred, "no IL type") - ) ; Target = target_csharp, ( @@ -413,7 +384,6 @@ exported_type_to_string(Lang, ExportedType) = Result :- ) ; ( Lang = lang_csharp - ; Lang = lang_il ; Lang = lang_java ; Lang = lang_erlang ), @@ -522,9 +492,6 @@ exported_type_to_string(Lang, ExportedType) = Result :- % backends. This is not the correct type to use in general. Result = "java.lang.Object" ) - ; - Lang = lang_il, - sorry($module, $pred, "il") ; Lang = lang_erlang, sorry($module, $pred, "erlang") diff --git a/compiler/globals.m b/compiler/globals.m index 7a7dab2a2..2af7acdb6 100644 --- a/compiler/globals.m +++ b/compiler/globals.m @@ -39,8 +39,6 @@ :- type compilation_target ---> target_c % Generate C code (including GNU C). - ; target_il % Generate IL assembler code. - % IL is the Microsoft .NET Intermediate Language. ; target_csharp % Generate C#. ; target_java % Generate Java. ; target_erlang. % Generate Erlang. @@ -52,7 +50,6 @@ % ; lang_cplusplus ; lang_csharp ; lang_java - ; lang_il ; lang_erlang. :- func target_lang_to_foreign_export_lang(compilation_target) @@ -249,20 +246,11 @@ % Access predicates for the `globals' structure. % -:- type il_version_number - ---> il_version_number( - ivn_major :: int, - ivn_minor :: int, - ivn_build :: int, - ivn_revision :: int - ). - :- pred globals_init(option_table::in, compilation_target::in, gc_method::in, tags_method::in, termination_norm::in, termination_norm::in, trace_level::in, trace_suppress_items::in, ssdb_trace_level::in, may_be_thread_safe::in, c_compiler_type::in, csharp_compiler_type::in, - reuse_strategy::in, - maybe(il_version_number)::in, maybe(feedback_info)::in, env_type::in, + reuse_strategy::in, maybe(feedback_info)::in, env_type::in, env_type::in, env_type::in, file_install_cmd::in, limit_error_contexts_map::in, globals::out) is det. @@ -282,8 +270,6 @@ :- pred get_csharp_compiler_type(globals::in, csharp_compiler_type::out) is det. :- pred get_reuse_strategy(globals::in, reuse_strategy::out) is det. -:- pred get_maybe_il_version_number(globals::in, maybe(il_version_number)::out) - is det. :- pred get_maybe_feedback_info(globals::in, maybe(feedback_info)::out) is det. :- pred get_host_env_type(globals::in, env_type::out) is det. :- pred get_system_env_type(globals::in, env_type::out) is det. @@ -405,7 +391,6 @@ convert_target(String, Target) :- convert_target_2("csharp", target_csharp). convert_target_2("java", target_java). -convert_target_2("il", target_il). convert_target_2("c", target_c). convert_target_2("erlang", target_erlang). @@ -419,7 +404,6 @@ convert_foreign_language_2("c", lang_c). convert_foreign_language_2("c#", lang_csharp). convert_foreign_language_2("csharp", lang_csharp). convert_foreign_language_2("c sharp", lang_csharp). -convert_foreign_language_2("il", lang_il). convert_foreign_language_2("java", lang_java). convert_foreign_language_2("erlang", lang_erlang). @@ -647,25 +631,21 @@ convert_reuse_strategy("within_n_cells_difference", NCells, target_lang_to_foreign_export_lang(target_c) = lang_c. target_lang_to_foreign_export_lang(target_erlang) = lang_erlang. -target_lang_to_foreign_export_lang(target_il) = lang_il. target_lang_to_foreign_export_lang(target_csharp) = lang_csharp. target_lang_to_foreign_export_lang(target_java) = lang_java. compilation_target_string(target_c) = "C". compilation_target_string(target_csharp) = "C#". -compilation_target_string(target_il) = "IL". compilation_target_string(target_java) = "Java". compilation_target_string(target_erlang) = "Erlang". foreign_language_string(lang_c) = "C". foreign_language_string(lang_csharp) = "C#". -foreign_language_string(lang_il) = "IL". foreign_language_string(lang_java) = "Java". foreign_language_string(lang_erlang) = "Erlang". simple_foreign_language_string(lang_c) = "c". simple_foreign_language_string(lang_csharp) = "csharp". -simple_foreign_language_string(lang_il) = "il". simple_foreign_language_string(lang_java) = "java". simple_foreign_language_string(lang_erlang) = "erlang". @@ -693,7 +673,6 @@ gc_is_conservative(gc_automatic) = no. g_c_compiler_type :: c_compiler_type, g_csharp_compiler_type :: csharp_compiler_type, g_reuse_strategy :: reuse_strategy, - g_maybe_il_version_number :: maybe(il_version_number), g_maybe_feedback :: maybe(feedback_info), g_host_env_type :: env_type, g_system_env_type :: env_type, @@ -705,15 +684,13 @@ gc_is_conservative(gc_automatic) = no. globals_init(Options, Target, GC_Method, TagsMethod, TerminationNorm, Termination2Norm, TraceLevel, TraceSuppress, SSTraceLevel, MaybeThreadSafe, C_CompilerType, CSharp_CompilerType, - ReuseStrategy, MaybeILVersion, - MaybeFeedback, HostEnvType, SystemEnvType, TargetEnvType, - FileInstallCmd, LimitErrorContextsMap, Globals) :- + ReuseStrategy, MaybeFeedback, HostEnvType, SystemEnvType, + TargetEnvType, FileInstallCmd, LimitErrorContextsMap, Globals) :- Globals = globals(Options, Target, GC_Method, TagsMethod, TerminationNorm, Termination2Norm, TraceLevel, TraceSuppress, SSTraceLevel, MaybeThreadSafe, C_CompilerType, CSharp_CompilerType, - ReuseStrategy, MaybeILVersion, - MaybeFeedback, HostEnvType, SystemEnvType, TargetEnvType, - FileInstallCmd, LimitErrorContextsMap). + ReuseStrategy, MaybeFeedback, HostEnvType, SystemEnvType, + TargetEnvType, FileInstallCmd, LimitErrorContextsMap). get_options(Globals, Globals ^ g_options). get_target(Globals, Globals ^ g_target). @@ -728,7 +705,6 @@ get_maybe_thread_safe(Globals, Globals ^ g_may_be_thread_safe). get_c_compiler_type(Globals, Globals ^ g_c_compiler_type). get_csharp_compiler_type(Globals, Globals ^ g_csharp_compiler_type). get_reuse_strategy(Globals, Globals ^ g_reuse_strategy). -get_maybe_il_version_number(Globals, Globals ^ g_maybe_il_version_number). get_maybe_feedback_info(Globals, Globals ^ g_maybe_feedback). get_host_env_type(Globals, Globals ^ g_host_env_type). get_system_env_type(Globals, Globals ^ g_system_env_type). @@ -896,7 +872,6 @@ current_grade_supports_concurrency(Globals, ThreadsSupported) :- ) ; ( Target = target_erlang - ; Target = target_il ; Target = target_java ; Target = target_csharp ), diff --git a/compiler/granularity.m b/compiler/granularity.m index 420fb9c21..295a62278 100644 --- a/compiler/granularity.m +++ b/compiler/granularity.m @@ -151,8 +151,7 @@ runtime_granularity_test_in_goal(Goal0, Goal, !Changed, SCC, ModuleInfo) :- !:Changed = yes ) ; - ( Target = target_il - ; Target = target_csharp + ( Target = target_csharp ; Target = target_java ; Target = target_erlang ), diff --git a/compiler/handle_options.m b/compiler/handle_options.m index b8b1118bf..abecaedfc 100644 --- a/compiler/handle_options.m +++ b/compiler/handle_options.m @@ -148,14 +148,12 @@ handle_given_options(Args0, OptionArgs, Args, Link, Errors, !:Globals, !IO) :- globals.lookup_bool_option(!.Globals, errorcheck_only, ErrorcheckOnly), globals.lookup_bool_option(!.Globals, target_code_only, TargetCodeOnly), - globals.get_target(!.Globals, Target), - GenerateIL = (if Target = target_il then yes else no), globals.lookup_bool_option(!.Globals, compile_only, CompileOnly), bool.or_list([GenerateDependencies, GenerateDependencyFile, MakeInterface, MakePrivateInterface, MakeShortInterface, MakeOptimizationInt, MakeTransOptInt, MakeAnalysisRegistry, MakeXmlDocumentation, ConvertToMercury, TypecheckOnly, - ErrorcheckOnly, TargetCodeOnly, GenerateIL, CompileOnly], + ErrorcheckOnly, TargetCodeOnly, CompileOnly], NotLink), bool.not(NotLink, Link), globals.lookup_bool_option(!.Globals, smart_recompilation, Smart), @@ -219,7 +217,7 @@ convert_option_table_result_to_globals(ok(OptionTable0), Errors, check_option_values(OptionTable0, OptionTable, Target, GC_Method, TagsMethod, TermNorm, Term2Norm, TraceLevel, TraceSuppress, SSTraceLevel, MaybeThreadSafe, C_CompilerType, CSharp_CompilerType, - ReuseStrategy, MaybeILVersion, + ReuseStrategy, MaybeFeedbackInfo, HostEnvType, SystemEnvType, TargetEnvType, LimitErrorContextsMap, cord.init, CheckErrorsCord, !IO), ( if cord.is_empty(CheckErrorsCord) then @@ -227,7 +225,7 @@ convert_option_table_result_to_globals(ok(OptionTable0), Errors, TagsMethod, TermNorm, Term2Norm, TraceLevel, TraceSuppress, SSTraceLevel, MaybeThreadSafe, C_CompilerType, CSharp_CompilerType, ReuseStrategy, - MaybeILVersion, MaybeFeedbackInfo, + MaybeFeedbackInfo, HostEnvType, SystemEnvType, TargetEnvType, LimitErrorContextsMap, CheckErrorsCord, ErrorsCord, Globals, !IO) else @@ -241,7 +239,7 @@ convert_option_table_result_to_globals(ok(OptionTable0), Errors, termination_norm::out, termination_norm::out, trace_level::out, trace_suppress_items::out, ssdb_trace_level::out, may_be_thread_safe::out, c_compiler_type::out, csharp_compiler_type::out, - reuse_strategy::out, maybe(il_version_number)::out, + reuse_strategy::out, maybe(feedback_info)::out, env_type::out, env_type::out, env_type::out, limit_error_contexts_map::out, cord(string)::in, cord(string)::out, io::di, io::uo) is det. @@ -249,7 +247,7 @@ convert_option_table_result_to_globals(ok(OptionTable0), Errors, check_option_values(!OptionTable, Target, GC_Method, TagsMethod, TermNorm, Term2Norm, TraceLevel, TraceSuppress, SSTraceLevel, MaybeThreadSafe, C_CompilerType, CSharp_CompilerType, - ReuseStrategy, MaybeILVersion, MaybeFeedbackInfo, + ReuseStrategy, MaybeFeedbackInfo, HostEnvType, SystemEnvType, TargetEnvType, LimitErrorContextsMap, !Errors, !IO) :- map.lookup(!.OptionTable, target, Target0), @@ -261,7 +259,7 @@ check_option_values(!OptionTable, Target, GC_Method, TagsMethod, ; Target = target_c, % dummy add_error("Invalid target option " ++ - "(must be `c', `il', `java', 'csharp', or `erlang')", + "(must be `c', `java', 'csharp', or `erlang')", !Errors) ), @@ -524,29 +522,6 @@ check_option_values(!OptionTable, Target, GC_Method, TagsMethod, !Errors) ), - map.lookup(!.OptionTable, dotnet_library_version, DotNetLibVersionOpt), - ( - DotNetLibVersionOpt = string(DotNetLibVersionStr), - IsSep = (pred(('.')::in) is semidet), - string.words_separator(IsSep, DotNetLibVersionStr) = [Mj, Mn, Bu, Rv], - string.to_int(Mj, Major), - string.to_int(Mn, Minor), - string.to_int(Bu, Build), - string.to_int(Rv, Revision) - -> - ILVersion = il_version_number(Major, Minor, Build, Revision), - MaybeILVersion = yes(ILVersion) - ; - MaybeILVersion = no, - add_error("Invalid argument to " ++ - "option `--dotnet-library-version'\n" ++ - "\t(must be of the form " ++ - "`MajorNum.MinorNum.BuildNum.RevisionNum').", - !Errors), - % The IL code generator cannot handle the IL version being unknown. - map.det_update(errorcheck_only, bool(yes), !OptionTable) - ), - map.lookup(!.OptionTable, feedback_file, FeedbackFile0), ( FeedbackFile0 = string(FeedbackFile), @@ -663,7 +638,7 @@ add_error(Error, !Errors) :- termination_norm::in, termination_norm::in, trace_level::in, trace_suppress_items::in, ssdb_trace_level::in, may_be_thread_safe::in, c_compiler_type::in, csharp_compiler_type::in, - reuse_strategy::in, maybe(il_version_number)::in, maybe(feedback_info)::in, + reuse_strategy::in, maybe(feedback_info)::in, env_type::in, env_type::in, env_type::in, limit_error_contexts_map::in, cord(string)::in, cord(string)::out, globals::out, io::di, io::uo) is det. @@ -671,7 +646,7 @@ add_error(Error, !Errors) :- convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0, TermNorm, Term2Norm, TraceLevel, TraceSuppress, SSTraceLevel, MaybeThreadSafe, C_CompilerType, CSharp_CompilerType, - ReuseStrategy, MaybeILVersion, MaybeFeedbackInfo, + ReuseStrategy, MaybeFeedbackInfo, HostEnvType, SystemEnvType, TargetEnvType, LimitErrorContextsMap, !Errors, !:Globals, !IO) :- @@ -688,7 +663,7 @@ convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0, globals_init(OptionTable0, Target, GC_Method, TagsMethod0, TermNorm, Term2Norm, TraceLevel, TraceSuppress, SSTraceLevel, MaybeThreadSafe, C_CompilerType, CSharp_CompilerType, - ReuseStrategy, MaybeILVersion, MaybeFeedbackInfo, + ReuseStrategy, MaybeFeedbackInfo, HostEnvType, SystemEnvType, TargetEnvType, FileInstallCmd, LimitErrorContextsMap, !:Globals), @@ -851,98 +826,6 @@ convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0, globals.set_option(par_loop_control, bool(no), !Globals) ), - % Generating IL implies: - % - gc_method `automatic' and no heap reclamation on failure - % Because GC is handled automatically by the .NET CLR - % implementation. - % - high-level code - % Because only the MLDS back-end supports - % compiling to IL, not the LLDS back-end. - % - high-level data - % Because it is more efficient, - % and better for interoperability. - % (In theory --low-level-data should work too, - % but there's no reason to bother supporting it.) - % - turning off nested functions - % Because IL doesn't support nested functions. - % - using copy-out for nondet output arguments - % For reasons explained in the paper "Compiling Mercury - % to the .NET Common Language Runtime" - % - using no tags - % Because IL doesn't provide any mechanism for tagging - % pointers. - % - boxing enums and disabling no_tag_types - % These are both required to ensure that we have a uniform - % representation (`object[]') for all data types, - % which is required to avoid type errors for code using - % abstract data types. - % XXX It should not be needed now that we have a general - % solution to the abstract equivalence type problem - % (intermodule optimization). - % But currently it is still needed, otherwise - % RTTI (e.g. construct, deconstruct) doesn't work - % for these types. - % - XXX it should also imply num_reserved_addresses = 1 - % (we can use null pointers), but currently it doesn't, - % again because this causes problems with RTTI - % - no static ground terms - % XXX Previously static ground terms used to not work with - % --high-level-data. But this has been (mostly?) fixed now. - % So we should investigate re-enabling static ground terms. - % Currently mlds_to_il.m doesn't support them yet? - % - no library grade installation check with `mmc --make'. - - ( - Target = target_il, - globals.set_gc_method(gc_automatic, !Globals), - globals.set_option(gc, string("automatic"), !Globals), - globals.set_option(reclaim_heap_on_nondet_failure, bool(no), - !Globals), - globals.set_option(reclaim_heap_on_semidet_failure, bool(no), - !Globals), - globals.set_option(highlevel_code, bool(yes), !Globals), - globals.set_option(highlevel_data, bool(yes), !Globals), - globals.set_option(gcc_nested_functions, bool(no), !Globals), - globals.set_option(nondet_copy_out, bool(yes), !Globals), - globals.set_option(num_tag_bits, int(0), !Globals), - globals.set_option(unboxed_enums, bool(no), !Globals), - globals.set_option(unboxed_no_tag_types, bool(no), !Globals), - % globals.set_option(num_reserved_addresses, int(1), !Globals) - globals.set_option(static_ground_cells, bool(no), !Globals), - globals.set_option(libgrade_install_check, bool(no), !Globals), - - % On the .NET backend we will be using a language independent - % debugger not mdb. Thus --debug has to imply --target-debug. - ( given_trace_level_is_none(TraceLevel) = no -> - globals.set_option(target_debug, bool(yes), !Globals) - ; - true - ) - ; - ( Target = target_c - ; Target = target_csharp - ; Target = target_java - ; Target = target_erlang - ) - ), - - % Set --put-nondet-env-on-heap if --verifiable-code is specified, - % unless both --il-funcptr-types and --il-refany-fields - % are specified. - globals.lookup_bool_option(!.Globals, il_funcptr_types, - ILFuncPtrTypes), - globals.lookup_bool_option(!.Globals, il_refany_fields, - ILRefAnyFields), - ( - ILFuncPtrTypes = yes, - ILRefAnyFields = yes - -> - true - ; - option_implies(verifiable_code, put_nondet_env_on_heap, bool(yes), - !Globals) - ), - % Generating Java implies % - gc_method `automatic' and no heap reclamation on failure % Because GC is handled automatically by the Java @@ -1007,7 +890,6 @@ convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0, ) ; ( Target = target_c - ; Target = target_il ; Target = target_erlang ) ), @@ -1053,7 +935,6 @@ convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0, globals.set_option(highlevel_data, bool(no), !Globals) ; ( Target = target_c - ; Target = target_il ; Target = target_java ; Target = target_csharp ) @@ -1466,7 +1347,6 @@ convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0, ; ( Target = target_csharp ; Target = target_java - ; Target = target_il ; Target = target_erlang ), globals.set_option(arg_pack_bits, int(0), !Globals), @@ -1491,9 +1371,7 @@ convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0, ; Target = target_java ) ; - ( Target = target_il - ; Target = target_erlang - ), + Target = target_erlang, globals.set_option(allow_multi_arm_switches, bool(no), !Globals) ), @@ -1619,21 +1497,7 @@ convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0, bool(no), !Globals), globals.set_option(loop_invariants, bool(no), !Globals), globals.set_option(untuple, bool(no), !Globals), - globals.set_option(tuple, bool(no), !Globals), - - % For the IL backend we turn off optimize_peep - % so that we don't optimize away references to the - % local variables of a procedure. - ( - Target = target_il, - globals.set_option(optimize_peep, bool(no), !Globals) - ; - ( Target = target_c - ; Target = target_csharp - ; Target = target_java - ; Target = target_erlang - ) - ) + globals.set_option(tuple, bool(no), !Globals) ; TraceOptimized = yes ), @@ -1758,7 +1622,6 @@ convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0, ( ( given_trace_level_is_none(TraceLevel) = yes ; HighLevelCode = no, Target = target_c - ; Target = target_il ) -> true @@ -2301,10 +2164,6 @@ convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0, ( Target = target_c, BackendForeignLanguages = ["c"] - ; - Target = target_il, - BackendForeignLanguages = ["il", "csharp"], - set_option(optimize_constructor_last_call, bool(no), !Globals) ; Target = target_csharp, BackendForeignLanguages = ["csharp"] @@ -2586,7 +2445,6 @@ check_grade_component_compatibility(Globals, Target, GC_Method, !Errors) :- ; ( Target = target_csharp ; Target = target_erlang - ; Target = target_il ; Target = target_java ), ( @@ -2625,7 +2483,6 @@ check_grade_component_compatibility(Globals, Target, GC_Method, !Errors) :- ProfileTime = yes, ( ( Target = target_java - ; Target = target_il ; Target = target_csharp ; Target = target_erlang ), @@ -2645,7 +2502,6 @@ check_grade_component_compatibility(Globals, Target, GC_Method, !Errors) :- ProfileMemory = yes, ( ( Target = target_java - ; Target = target_il ; Target = target_csharp ; Target = target_erlang ), @@ -2675,7 +2531,6 @@ check_grade_component_compatibility(Globals, Target, GC_Method, !Errors) :- -> ( ( Target = target_java - ; Target = target_il ; Target = target_csharp ; Target = target_erlang ), @@ -2706,7 +2561,6 @@ check_grade_component_compatibility(Globals, Target, GC_Method, !Errors) :- ) ; ( Target = target_java - ; Target = target_il ; Target = target_csharp ; Target = target_erlang ), @@ -2724,7 +2578,6 @@ check_grade_component_compatibility(Globals, Target, GC_Method, !Errors) :- SinglePrecFloat = yes, ( ( Target = target_java - ; Target = target_il ; Target = target_csharp ; Target = target_erlang ), @@ -3177,22 +3030,6 @@ grade_component_table("hlc_nest", comp_gcc_ext, [ gcc_nested_functions - bool(yes), highlevel_data - bool(no)], yes([string("c")]), yes). -grade_component_table("il", comp_gcc_ext, [ - asm_labels - bool(no), - gcc_non_local_gotos - bool(no), - gcc_global_registers - bool(no), - highlevel_code - bool(yes), - gcc_nested_functions - bool(no), - highlevel_data - bool(yes)], - yes([string("il")]), yes). -grade_component_table("ilc", comp_gcc_ext, [ - asm_labels - bool(no), - gcc_non_local_gotos - bool(no), - gcc_global_registers - bool(no), - highlevel_code - bool(yes), - gcc_nested_functions - bool(no), - highlevel_data - bool(no)], - yes([string("il")]), yes). grade_component_table("java", comp_gcc_ext, [ asm_labels - bool(no), gcc_non_local_gotos - bool(no), diff --git a/compiler/hlds_code_util.m b/compiler/hlds_code_util.m index 5cb4a99bb..57a31c038 100644 --- a/compiler/hlds_code_util.m +++ b/compiler/hlds_code_util.m @@ -159,8 +159,7 @@ cons_id_to_tag(ModuleInfo, ConsId) = Tag:- ; % For these target languages, converting arity-zero tuples into % dummy integer tags results in invalid code being generated. - ( TargetLang = target_il - ; TargetLang = target_csharp + ( TargetLang = target_csharp ; TargetLang = target_java ), Tag = single_functor_tag diff --git a/compiler/hlds_data.m b/compiler/hlds_data.m index 26e725311..cccbae643 100644 --- a/compiler/hlds_data.m +++ b/compiler/hlds_data.m @@ -534,7 +534,6 @@ cons_table_optimize(!ConsTable) :- :- type foreign_type_body ---> foreign_type_body( - il :: foreign_type_lang_body(il_foreign_type), c :: foreign_type_lang_body(c_foreign_type), java :: foreign_type_lang_body(java_foreign_type), csharp :: foreign_type_lang_body(csharp_foreign_type), diff --git a/compiler/il_peephole.m b/compiler/il_peephole.m deleted file mode 100644 index c2bc1e401..000000000 --- a/compiler/il_peephole.m +++ /dev/null @@ -1,815 +0,0 @@ -%-----------------------------------------------------------------------------% -% vim: ft=mercury ts=4 sw=4 et -%-----------------------------------------------------------------------------% -% Copyright (C) 2000-2001, 2003-2006, 2009, 2011 The University of Melbourne. -% This file may only be copied under the terms of the GNU General -% Public License - see the file COPYING in the Mercury distribution. -%-----------------------------------------------------------------------------% -% -% File: il_peephole.m. -% Authors: trd (based on peephole.m by fjh and zs). -% -% Local ILDS to ILDS optimizations based on pattern-matching. -% -% Please note that some of the optimizations in this module are required -% for verifiability of IL. -% -% Also, some of these optimizations would be more appropriate at the -% MLDS level. -% -% Patterns to add: -% -% [ ] starg, ldarg patterns (rare, but they are introduced by tailcall) -% -% [ ] loop hoisting (tailcall again) -% looptop: -% ldarg X -% ...instrs... -% starg X -% br looptop (no other branches to looptop). -% -% This isn't really a peephole optimization, might be better done -% elsewhere. -% -%-----------------------------------------------------------------------------% - -:- module ml_backend.il_peephole. -:- interface. - -:- import_module ml_backend.ilasm. - -:- import_module bool. -:- import_module list. - -%-----------------------------------------------------------------------------% - - % il_peephole_optimize(VerifyOnly, !IL): - % - % Peephole optimize a list of instructions, possibly only doing - % those optimizations which are necessary for verifiable code. - % -:- pred il_peephole_optimize(bool::in, - list(il_decl)::in, list(il_decl)::out) is det. - -%-----------------------------------------------------------------------------% -%-----------------------------------------------------------------------------% - -:- implementation. - -:- import_module ml_backend.ilds. - -:- import_module assoc_list. -:- import_module int. -:- import_module pair. -:- import_module string. - -%-----------------------------------------------------------------------------% - -:- type instrs == list(instr). - -il_peephole_optimize(VerifyOnly, Decls0, Decls) :- - % We zip down to the end of the instruction list, and start attempting - % to optimize instruction sequences. As long as we can continue - % optimizing the instruction sequence, we keep doing so; - % when we find a sequence we can't optimize, we back up and try - % to optimize the sequence starting with the previous instruction. - list.map_foldl(optimize_decl(VerifyOnly), Decls0, Decls, no, _Mod). - - % Mod is a bool that says whether the code was modified as a - % result of the optimization (that is, whether Decl \= Decl0). - % This can be used to decide whether to keep repeat the optimizations. - % -:- pred optimize_decl(bool::in, il_decl::in, il_decl::out, bool::in, bool::out) - is det. - -optimize_decl(VerifyOnly, Decl0, Decl, !Mod) :- - ( - Decl0 = ildecl_class(ClassAttrs, ClassId, ParentClass, Implements, - ClassMembers0), - list.map_foldl(optimize_class_member(VerifyOnly), - ClassMembers0, ClassMembers, !Mod), - Decl = ildecl_class(ClassAttrs, ClassId, ParentClass, Implements, - ClassMembers) - ; - Decl0 = ildecl_namespace(NameSpaceName, NamespaceDecls0), - list.map_foldl(optimize_decl(VerifyOnly), NamespaceDecls0, - NamespaceDecls, !Mod), - Decl = ildecl_namespace(NameSpaceName, NamespaceDecls) - ; - Decl0 = ildecl_method(MethodHead, MethodDecls0), - list.map_foldl(optimize_method_decl(VerifyOnly), MethodDecls0, - MethodDecls, !Mod), - Decl = ildecl_method(MethodHead, MethodDecls) - ; - ( Decl0 = ildecl_data(_, _, _) - ; Decl0 = ildecl_file(_) - ; Decl0 = ildecl_extern_module(_) - ; Decl0 = ildecl_extern_assembly(_, _) - ; Decl0 = ildecl_assembly(_) - ; Decl0 = ildecl_custom(_) - ; Decl0 = ildecl_comment_term(_) - ; Decl0 = ildecl_comment_thing(_) - ; Decl0 = ildecl_comment(_) - ), - Decl0 = Decl - ). - -:- pred optimize_class_member(bool::in, class_member::in, class_member::out, - bool::in, bool::out) is det. - -optimize_class_member(VerifyOnly, Member0, Member, !Mod) :- - ( - Member0 = member_method(MethodHead, MethodDecls0), - list.map_foldl(optimize_method_decl(VerifyOnly), MethodDecls0, - MethodDecls1, !Mod), - ( - !.Mod = yes, - % Find the new maxstack. - MaxStacks = list.map((func(X) = - ( if X = instrs(I) - then calculate_max_stack(I) - else 0 - )), MethodDecls1), - NewMaxStack = list.foldl((func(X, Y) = X + Y), MaxStacks, 0), - % Set the maxstack. - MethodDecls = list.map((func(X) = - ( if X = maxstack(_) - then maxstack(int32(NewMaxStack)) - else X - )), MethodDecls1), - Member = member_method(MethodHead, MethodDecls) - ; - !.Mod = no, - Member = member_method(MethodHead, MethodDecls1) - ) - ; - ( Member0 = member_field(_, _, _, _, _) - ; Member0 = member_property(_, _, _, _) - ; Member0 = member_nested_class(_, _, _, _, _) - ; Member0 = member_custom(_) - ; Member0 = member_comment_term(_) - ; Member0 = member_comment_thing(_) - ; Member0 = member_comment(_) - ), - !:Mod = no, - Member0 = Member - ). - -:- pred optimize_method_decl(bool::in, - method_body_decl::in, method_body_decl::out, - bool::in, bool::out) is det. - -optimize_method_decl(VerifyOnly, Decl0, Decl, !Mod) :- - ( Decl0 = instrs(Instrs0) -> - optimize_instrs(VerifyOnly, Instrs0, Instrs, InstrsMod), - bool.or(InstrsMod, !Mod), - Decl = instrs(Instrs) - ; - Decl0 = Decl - ). - -:- pred optimize_instrs(bool::in, instrs::in, instrs::out, bool::out) is det. - -optimize_instrs(VerifyOnly, Instrs0, Instrs, Mod) :- - optimize_2(VerifyOnly, Instrs0, Instrs, Mod). - -:- pred optimize_2(bool::in, instrs::in, instrs::out, bool::out) is det. - -optimize_2(_, [], [], no). -optimize_2(VerifyOnly, [Instr0 | Instrs0], Instrs, Mod) :- - optimize_2(VerifyOnly, Instrs0, Instrs1, Mod0), - opt_instr(VerifyOnly, Instr0, Instrs1, Instrs, Mod1), - bool.or(Mod0, Mod1, Mod). - - % Try to optimize the beginning of the given instruction sequence. - % If successful, try it again. - % -:- pred opt_instr(bool::in, instr::in, instrs::in, instrs::out, bool::out) - is det. - -opt_instr(VerifyOnly, Instr0, Instrs0, Instrs, Mod) :- - ( match(Instr0, VerifyOnly, Instrs0, Instrs2) -> - ( - Instrs2 = [Instr2 | Instrs3], - opt_instr(VerifyOnly, Instr2, Instrs3, Instrs, _) - ; - Instrs2 = [], - Instrs = Instrs2 - ), - Mod = yes - ; - Instrs = [Instr0 | Instrs0], - Mod = no - ). - -%-----------------------------------------------------------------------------% - - % Look for code patterns that can be optimized, and optimize them. - % The second argument says whether or not to only do the optimizations - % which are needed for verifiability. - % -:- pred match(instr::in, bool::in, instrs::in, instrs::out) is semidet. - - % If a ret is followed by anything other than a label, then we can delete - % the instruction that follows, since it is unreachable. This is needed - % for verifiability, since otherwise we sometimes generate some redundant - % instructions that the verifier can't handle, even though they are - % unreachable. - % - % Push ret past nops so we can find instructions on the other side of them - % (but don't eliminate them because they may be useful). - -match(ret, _, Instrs0, Replacement) :- - list.takewhile((pred(X::in) is semidet :- - X \= label(_) - ), Instrs0, PreLabel, NextInstrs0), - PreLabel = [_ | _], - - list.filter((pred(X::in) is semidet :- equivalent_to_nop(X) = yes), - PreLabel, KeepInstrs), - Replacement = KeepInstrs ++ - [comment("peephole -- eliminated instrs after ret"), ret] ++ - NextInstrs0. - - % A branch to a label that is followed by a return can be reduced - % to just the return. - % NOTE: We only look for forwards branches. - -match(br(label_target(Label)), VerifyOnly, Instrs0, Instrs) :- - VerifyOnly = no, - list.takewhile((pred(X::in) is semidet :- - X \= label(Label) - ), Instrs0, _, [label(Label) | NextInstrs0]), - skip_nops(NextInstrs0, NextInstrs, _), - NextInstrs = [ret | _], - Instrs = [comment("peephole -- eliminated branch to ret"), ret | Instrs0]. - - % stloc(X) - % ldloc(X) - % - % is turned into - % - % dup - % stloc(X) - % - % This might be slightly denser, and is easier to detect and - % remove if it turns out the local is not used. - -match(stloc(Var), VerifyOnly, Instrs0, Instrs) :- - VerifyOnly = no, - % The pattern. - skip_nops(Instrs0, Instrs1, Nops), - Instrs1 = [ldloc(Var) | Rest], - % Comment and replacement. - Comment = "peephole: stloc(X), ldloc(X) --> dup, stloc(X)", - Replacement = list.append([dup | Nops], [stloc(Var)]), - Instrs = [comment(Comment) | list.append(Replacement, Rest)]. - - % ldc(C) - % stloc(X) - % ... other instrs ... (no branching, labels, stores to X or calls) - % ldloc(X) - % - % is turned into - % - % ... other instrs ... (no branching or labels) - % ldc(C) - % dup - % stloc(X) - -match(ldc(Type, Const), VerifyOnly, [stloc(Var)| Instrs0], Instrs) :- - VerifyOnly = no, - % The pattern. - list.takewhile((pred(X::in) is semidet :- - X \= ldloc(Var), - X \= label(_), - X \= stloc(Var), - X \= stind(_), - can_call(X) = no, - can_branch(X) = no - ), Instrs0, PreLdInstrs, [ldloc(Var) | Rest]), - - % Comment and replacement. - Comment = comment( - "peephole: ldc(X), stloc(X), ldloc(X) --> ldc(X), dup, stloc(X)"), - Replacement = PreLdInstrs ++ [Comment, ldc(Type, Const), dup, stloc(Var)], - Instrs = list.append(Replacement, Rest). - - % Two patterns begin with start_scope. - -match(start_block(bt_scope(Locals), Id), VerifyOnly, !Instrs) :- - VerifyOnly = no, - ( match_start_scope_1(start_block(bt_scope(Locals), Id), !Instrs) -> - true - ; - match_start_scope_2(start_block(bt_scope(Locals), Id), !Instrs) - ). - - % If this is a scope with a local variable that is stored to but not - % loaded anywhere, we can eliminate the stores. - % - % scope([...X...]) ... dup, stloc(X) - % becomes - % scope([...X...]) ... - % This relies on other peephole optimizations to create dup, stloc(X) - % patterns. This could be more efficient if it stopped looking outside the - % enclosing scope. - % -:- pred match_start_scope_1(instr::in, instrs::in, instrs::out) is semidet. - -match_start_scope_1(start_block(bt_scope(Locals), Id), Instrs0, Instrs) :- - % Is this variable a local that is unused? - IsUnusedLocal = (pred(V::in) is semidet :- - % Var is in the locals - V = name(VN), - assoc_list.search(Locals, VN, _), - - % No ldloc(Var) or ldloca(Var) anywhere in the scope - % (should only really look until the end of this scope) - list.takewhile((pred(X::in) is semidet :- - X \= ldloc(V), - X \= ldloca(V) - ), Instrs0, _, []) - - ), - - % A producer, which finds "dup" and returns the rest of the input, - % and a result. The result is the preceeding input so far and the remainder - % of the input. Note that the preceeding input is a reversed list of - % instructions (we reverse and flatten it later). - FindDup = (pred(InstrIn::in, NextInput::out, R0::in, R::out) is semidet :- - R0 = Pre0 - _NextInput0, - list.takewhile((pred(X::in) is semidet :- X \= dup), - InstrIn, Pre, Post0), - Post0 = [dup | NextInput], - ( - Pre0 = [], - InsertDup = [] - ; - Pre0 = [_ | _], - InsertDup = [dup] - ), - R = [Pre, InsertDup | Pre0] - NextInput - ), - - % A condition, that checks the result of FindDup to see whether there is - % a trailing stloc(V), which is an unused local variable. Our result - % is just the parts of the instruction list that we are going to put - %% together later. - FindStloc = (pred(R0::in, R::out) is semidet :- - R0 = Pre0 - Post0, - Post0 = InstrIn0, - list.takewhile((pred(X::in) is semidet :- equivalent_to_nop(X) = yes), - InstrIn0, Pre, MaybePost), - MaybePost = [stloc(V) | Post], - IsUnusedLocal(V), - R = V - Pre0 - Pre - Post - ), - - no_handwritten_code(Instrs0, Id), - - % Keep looking for "dups" until it is followed by a suitable stloc. - keep_looking(FindDup, FindStloc, Instrs0, [] - [], Result, _Left), - Result = Var - PreStlocInstrsList - Nops - PostStlocInstrs, - Var = name(VarName), - - PreStlocInstrs = condense(reverse(PreStlocInstrsList)), - % Comment and replacement. - Comment = string.format( - "peephole: dup, stloc(%s) --> nothing (%s unused in scope)", - [s(VarName), s(VarName)]), - Instrs = list.condense([[start_block(bt_scope(Locals), Id)], - PreStlocInstrs, - Nops, - [comment(Comment)], - PostStlocInstrs]). - - % Any scope with a local variable that is unused may eliminate it. - % This could be more efficient if it stopped looking outside the - % enclosing scope. - % -:- pred match_start_scope_2(instr::in, instrs::in, instrs::out) is semidet. - -match_start_scope_2(start_block(bt_scope(Locals), Id), Instrs0, Instrs) :- - no_handwritten_code(Instrs0, Id), - - % The pattern. - list.filter((pred(VarName - _Type::in) is semidet :- - Var = name(VarName), - % No stloc(Var) or ldloc(Var) or ldloca(Var) anywhere in the scope - % (should only really look until the end of this scope) - list.takewhile((pred(X::in) is semidet :- - X \= ldloc(Var), - X \= ldloca(Var), - X \= stloc(Var) - ), Instrs0, _, [])), - Locals, UnusedLocals, UsedLocals), - UnusedLocals = [_ | _], - - % Comment and replacement. - list.map((pred(VarName - _Type::in, Comment::out) is det :- - string.format("peephole: unused local var %s eliminated", - [s(VarName)], CommentStr), - Comment = comment(CommentStr) - ), UnusedLocals, Comments), - Replacement = [start_block(bt_scope(UsedLocals), Id)], - - Instrs = list.condense([Comments, Replacement, Instrs0]). - - % Any scope without local variables may be eliminated. - % XXX We don't do this yet because it would requirer finding the matching - % end_block and removing it too. Now that block IDs are available we could - % actually do this, but currently we don't, because the code below - % is incomplete. This procedure is not yet called from anywhere. -:- pred match4(instr::in, instrs::in, instrs::out) is semidet. - -match4(start_block(bt_scope([]), _), Instrs0, Instrs) :- - Replacement = [], - Rest = Instrs0, - Instrs = list.append(Replacement, Rest). - -%-----------------------------------------------------------------------------% - - % Succeeds if there is no handwritten code within the current block - % (excluding sub-blocks). - % -:- pred no_handwritten_code(instrs::in, int::in) is semidet. - -no_handwritten_code([], _). -no_handwritten_code([Instr | Instrs], Id) :- - ( Instr = il_asm_code(_, _) -> - fail - ; Instr = end_block(_, Id) -> - true - ; Instr = start_block(_, SkipId) -> - InstrsAfterBlock = skip_over_block(Instrs, SkipId), - no_handwritten_code(InstrsAfterBlock, Id) - ; - no_handwritten_code(Instrs, Id) - ). - - % Skips over a block until the end of the block (with Id matching - % the given Id) is found. - % -:- func skip_over_block(instrs, int) = instrs. - -skip_over_block([], _) = []. -skip_over_block([Instr | Instrs], Id) = - ( Instr = end_block(_, Id) -> - Instrs - ; - skip_over_block(Instrs, Id) - ). - - % Skip over all the comments. - % -:- pred skip_comments(instrs::in, instrs::out, instrs::out) is det. - -skip_comments(Instrs0, Instrs, Comments) :- - list.takewhile(pred(ilds.comment(_)::in) is semidet, - Instrs0, Comments, Instrs). - - % Skip over all the nop equivalents. - % -:- pred skip_nops(instrs::in, instrs::out, instrs::out) is det. - -skip_nops(Instrs0, Instrs, Nops) :- - list.takewhile((pred(X::in) is semidet :- equivalent_to_nop(X) = yes), - Instrs0, Nops, Instrs). - - % keep_looking(Producer, Condition, Input, IntermediateResult0, - % FinalResult, Leftovers): - % - % Producer consumes Input and produces an intermediate result and the - % leftover input. Condition checks the intermediate result and produces - % a final result. If Condition fails, we use the leftover input as the next - % input for Producer. If Producer ever fails, keep_looking fails. - % - % It is best to use Producer to find the start of a pattern, and Condition - % to check that the rest of the pattern is what we want. Keep_looking - % doesn't keep track of the part of the Input that you threw away while - % looking for a match. However it is easy to put this part of the input - % in the intermediate and final results. - % -:- pred keep_looking(pred(A, A, B, B)::in(pred(in, out, in, out) is semidet), - pred(B, C)::in(pred(in, out) is semidet), A::in, B::in, C::out, A::out) - is semidet. - -keep_looking(Producer, Condition, Input, IntermediateResult0, - FinalResult, Leftovers) :- - Producer(Input, NextInput, IntermediateResult0, IntermediateResult), - ( Condition(IntermediateResult, FinalResult0) -> - Leftovers = NextInput, - FinalResult = FinalResult0 - ; - keep_looking(Producer, Condition, NextInput, IntermediateResult, - FinalResult, Leftovers) - ). - -%-----------------------------------------------------------------------------% - - % These instructions can make a call. - % -:- func can_call(instr) = bool. - -can_call(call(_)) = yes. -can_call(calli(_)) = yes. -can_call(callvirt(_)) = yes. -can_call(jmp(_)) = yes. -can_call(newobj(_)) = yes. -can_call(il_asm_code(_, _)) = yes. - -can_call(comment(_Comment)) = no. -can_call(label(_Label)) = no. -can_call(start_block(_, _Id)) = no. -can_call(end_block(_, _Id)) = no. -can_call(context(_, _)) = no. -can_call(ret) = no. -can_call(bitwise_and) = no. -can_call(arglist) = no. -can_call(break) = no. -can_call(ceq) = no. -can_call(ckfinite) = no. -can_call(cpblk) = no. -can_call(dup) = no. -can_call(endfilter) = no. -can_call(endfinally) = no. -can_call(initblk) = no. -can_call(ldnull) = no. -can_call(localloc) = no. -can_call(neg) = no. -can_call(nop) = no. -can_call(bitwise_not) = no. -can_call(bitwise_or) = no. -can_call(pop) = no. -can_call(shl) = no. -can_call(tailcall) = no. -can_call(volatile) = no. -can_call(bitwise_xor) = no. -can_call(ldlen) = no. -can_call(throw) = no. -can_call(ldarg(_)) = no. -can_call(ldc(_Type, _Const)) = no. -can_call(ldstr(_String)) = no. -can_call(add(_Overflow, _Signed)) = no. -can_call(beq(_Target)) = no. -can_call(bge(_Signed, _Target)) = no. -can_call(bgt(_Signed, _Target)) = no. -can_call(ble(_Signed, _Target)) = no. -can_call(blt(_Signed, _Target)) = no. -can_call(bne(_Signed, _Target)) = no. -can_call(br(_Target)) = no. -can_call(brfalse(_Target)) = no. -can_call(brtrue(_Target)) = no. -can_call(cgt(_Signed)) = no. -can_call(clt(_Signed)) = no. -can_call(conv(_SimpleType)) = no. -can_call(div(_Signed)) = no. -can_call(ldarga(_Variable)) = no. -can_call(ldftn(_MethodRef)) = no. -can_call(ldind(_SimpleType)) = no. -can_call(ldloc(_Variable)) = no. -can_call(ldloca(_Variable)) = no. -can_call(leave(_Target)) = no. -can_call(mul(_Overflow, _Signed)) = no. -can_call(rem(_Signed)) = no. -can_call(shr(_Signed)) = no. -can_call(starg(_Variable)) = no. -can_call(stind(_SimpleType)) = no. -can_call(stloc(_Variable)) = no. -can_call(sub(_OverFlow, _Signed)) = no. -can_call(switch(_)) = no. -can_call(unaligned(_)) = no. -can_call(box(_Type)) = no. -can_call(castclass(_Type)) = no. -can_call(cpobj(_Type)) = no. -can_call(initobj(_Type)) = no. -can_call(isinst(_Type)) = no. -can_call(ldelem(_SimpleType)) = no. -can_call(ldelema(_Type)) = no. -can_call(ldfld(_FieldRef)) = no. -can_call(ldflda(_FieldRef)) = no. -can_call(ldobj(_Type)) = no. -can_call(ldsfld(_FieldRef)) = no. -can_call(ldsflda(_FieldRef)) = no. -can_call(ldtoken(_)) = no. -can_call(ldvirtftn(_MethodRef)) = no. -can_call(mkrefany(_Type)) = no. -can_call(newarr(_Type)) = no. -can_call(refanytype) = no. -can_call(refanyval(_)) = no. -can_call(rethrow) = no. -can_call(sizeof(_Type)) = no. -can_call(stobj(_Type)) = no. -can_call(stelem(_SimpleType)) = no. -can_call(stfld(_FieldRef)) = no. -can_call(stsfld(_FieldRef)) = no. -can_call(unbox(_Type)) = no. - - % These instructions generate no actual code and do not affect control - % flow, they are simply part of instr for convenience. - % -:- func equivalent_to_nop(instr) = bool. - -equivalent_to_nop(comment(_)) = yes. -equivalent_to_nop(start_block(bt_scope(_), _)) = yes. -equivalent_to_nop(end_block(bt_scope(_), _)) = yes. -equivalent_to_nop(nop) = yes. -equivalent_to_nop(context(_, _)) = yes. - -equivalent_to_nop(il_asm_code(_, _)) = no. -equivalent_to_nop(start_block(bt_try, _)) = no. -equivalent_to_nop(end_block(bt_try, _)) = no. -equivalent_to_nop(start_block(bt_catch(_), _)) = no. -equivalent_to_nop(end_block(bt_catch(_), _)) = no. -equivalent_to_nop(label(_Label)) = no. -equivalent_to_nop(call(_MethodRef)) = no. -equivalent_to_nop(calli(_Signature)) = no. -equivalent_to_nop(callvirt(_MethodRef)) = no. -equivalent_to_nop(ret) = no. -equivalent_to_nop(bitwise_and) = no. -equivalent_to_nop(arglist) = no. -equivalent_to_nop(break) = no. -equivalent_to_nop(ceq) = no. -equivalent_to_nop(ckfinite) = no. -equivalent_to_nop(cpblk) = no. -equivalent_to_nop(dup) = no. -equivalent_to_nop(endfilter) = no. -equivalent_to_nop(endfinally) = no. -equivalent_to_nop(initblk) = no. -equivalent_to_nop(ldnull) = no. -equivalent_to_nop(localloc) = no. -equivalent_to_nop(neg) = no. -equivalent_to_nop(bitwise_not) = no. -equivalent_to_nop(bitwise_or) = no. -equivalent_to_nop(pop) = no. -equivalent_to_nop(shl) = no. -equivalent_to_nop(tailcall) = no. -equivalent_to_nop(volatile) = no. -equivalent_to_nop(bitwise_xor) = no. -equivalent_to_nop(ldlen) = no. -equivalent_to_nop(throw) = no. -equivalent_to_nop(ldarg(_)) = no. -equivalent_to_nop(ldc(_Type, _Const)) = no. -equivalent_to_nop(ldstr(_String)) = no. -equivalent_to_nop(add(_Overflow, _Signed)) = no. -equivalent_to_nop(beq(_Target)) = no. -equivalent_to_nop(bge(_Signed, _Target)) = no. -equivalent_to_nop(bgt(_Signed, _Target)) = no. -equivalent_to_nop(ble(_Signed, _Target)) = no. -equivalent_to_nop(blt(_Signed, _Target)) = no. -equivalent_to_nop(bne(_Signed, _Target)) = no. -equivalent_to_nop(br(_Target)) = no. -equivalent_to_nop(brfalse(_Target)) = no. -equivalent_to_nop(brtrue(_Target)) = no. -equivalent_to_nop(cgt(_Signed)) = no. -equivalent_to_nop(clt(_Signed)) = no. -equivalent_to_nop(conv(_SimpleType)) = no. -equivalent_to_nop(div(_Signed)) = no. -equivalent_to_nop(jmp(_MethodRef)) = no. -equivalent_to_nop(ldarga(_Variable)) = no. -equivalent_to_nop(ldftn(_MethodRef)) = no. -equivalent_to_nop(ldind(_SimpleType)) = no. -equivalent_to_nop(ldloc(_Variable)) = no. -equivalent_to_nop(ldloca(_Variable)) = no. -equivalent_to_nop(leave(_Target)) = no. -equivalent_to_nop(mul(_Overflow, _Signed)) = no. -equivalent_to_nop(rem(_Signed)) = no. -equivalent_to_nop(shr(_Signed)) = no. -equivalent_to_nop(starg(_Variable)) = no. -equivalent_to_nop(stind(_SimpleType)) = no. -equivalent_to_nop(stloc(_Variable)) = no. -equivalent_to_nop(sub(_OverFlow, _Signed)) = no. -equivalent_to_nop(switch(_)) = no. -equivalent_to_nop(unaligned(_)) = no. -equivalent_to_nop(box(_Type)) = no. -equivalent_to_nop(castclass(_Type)) = no. -equivalent_to_nop(cpobj(_Type)) = no. -equivalent_to_nop(initobj(_Type)) = no. -equivalent_to_nop(isinst(_Type)) = no. -equivalent_to_nop(ldelem(_SimpleType)) = no. -equivalent_to_nop(ldelema(_Type)) = no. -equivalent_to_nop(ldfld(_FieldRef)) = no. -equivalent_to_nop(ldflda(_FieldRef)) = no. -equivalent_to_nop(ldobj(_Type)) = no. -equivalent_to_nop(ldsfld(_FieldRef)) = no. -equivalent_to_nop(ldsflda(_FieldRef)) = no. -equivalent_to_nop(ldtoken(_)) = no. -equivalent_to_nop(ldvirtftn(_MethodRef)) = no. -equivalent_to_nop(mkrefany(_Type)) = no. -equivalent_to_nop(newarr(_Type)) = no. -equivalent_to_nop(newobj(_MethodRef)) = no. -equivalent_to_nop(refanytype) = no. -equivalent_to_nop(refanyval(_)) = no. -equivalent_to_nop(rethrow) = no. -equivalent_to_nop(stelem(_SimpleType)) = no. -equivalent_to_nop(stfld(_FieldRef)) = no. -equivalent_to_nop(sizeof(_Type)) = no. -equivalent_to_nop(stobj(_)) = no. -equivalent_to_nop(stsfld(_FieldRef)) = no. -equivalent_to_nop(unbox(_Type)) = no. - - % These instructions can branch control flow. - % -:- func can_branch(instr) = bool. - - % XXX we should refine what we mean by can_branch -- it seems to only - % mean local branching to local labels (which il_asm_code shouldn't do) - % but we will be conservative for now. -can_branch(il_asm_code(_, _)) = yes. -can_branch(br(_)) = yes. -can_branch(brtrue(_)) = yes. -can_branch(brfalse(_)) = yes. -can_branch(beq(_)) = yes. -can_branch(bge(_, _)) = yes. -can_branch(bgt(_, _)) = yes. -can_branch(ble(_, _)) = yes. -can_branch(blt(_, _)) = yes. -can_branch(bne(_, _)) = yes. -can_branch(switch(_)) = yes. - -can_branch(end_block(_, _)) = no. -can_branch(comment(_)) = no. -can_branch(start_block(_, _)) = no. -can_branch(context(_, _)) = no. -can_branch(nop) = no. -can_branch(label(_Label)) = no. -can_branch(call(_MethodRef)) = no. -can_branch(calli(_Signature)) = no. -can_branch(callvirt(_MethodRef)) = no. -can_branch(ret) = no. -can_branch(bitwise_and) = no. -can_branch(arglist) = no. -can_branch(break) = no. -can_branch(ceq) = no. -can_branch(ckfinite) = no. -can_branch(cpblk) = no. -can_branch(dup) = no. -can_branch(endfilter) = no. -can_branch(endfinally) = no. -can_branch(initblk) = no. -can_branch(ldnull) = no. -can_branch(localloc) = no. -can_branch(neg) = no. -can_branch(bitwise_not) = no. -can_branch(bitwise_or) = no. -can_branch(pop) = no. -can_branch(shl) = no. -can_branch(tailcall) = no. -can_branch(volatile) = no. -can_branch(bitwise_xor) = no. -can_branch(ldlen) = no. -can_branch(throw) = no. -can_branch(ldarg(_)) = no. -can_branch(ldc(_Type, _Const)) = no. -can_branch(ldstr(_String)) = no. -can_branch(add(_Overflow, _Signed)) = no. -can_branch(cgt(_Signed)) = no. -can_branch(clt(_Signed)) = no. -can_branch(conv(_SimpleType)) = no. -can_branch(div(_Signed)) = no. -can_branch(jmp(_MethodRef)) = no. -can_branch(ldarga(_Variable)) = no. -can_branch(ldftn(_MethodRef)) = no. -can_branch(ldind(_SimpleType)) = no. -can_branch(ldloc(_Variable)) = no. -can_branch(ldloca(_Variable)) = no. -can_branch(leave(_Target)) = no. -can_branch(mul(_Overflow, _Signed)) = no. -can_branch(rem(_Signed)) = no. -can_branch(shr(_Signed)) = no. -can_branch(starg(_Variable)) = no. -can_branch(stind(_SimpleType)) = no. -can_branch(stloc(_Variable)) = no. -can_branch(sub(_OverFlow, _Signed)) = no. -can_branch(unaligned(_)) = no. -can_branch(box(_Type)) = no. -can_branch(castclass(_Type)) = no. -can_branch(cpobj(_Type)) = no. -can_branch(initobj(_Type)) = no. -can_branch(isinst(_Type)) = no. -can_branch(ldelem(_SimpleType)) = no. -can_branch(ldelema(_Type)) = no. -can_branch(ldfld(_FieldRef)) = no. -can_branch(ldflda(_FieldRef)) = no. -can_branch(ldobj(_Type)) = no. -can_branch(ldsfld(_FieldRef)) = no. -can_branch(ldsflda(_FieldRef)) = no. -can_branch(ldtoken(_)) = no. -can_branch(ldvirtftn(_MethodRef)) = no. -can_branch(mkrefany(_Type)) = no. -can_branch(newarr(_Type)) = no. -can_branch(newobj(_MethodRef)) = no. -can_branch(rethrow) = no. -can_branch(refanytype) = no. -can_branch(refanyval(_)) = no. -can_branch(stelem(_SimpleType)) = no. -can_branch(stfld(_FieldRef)) = no. -can_branch(stobj(_)) = no. -can_branch(sizeof(_Type)) = no. -can_branch(stsfld(_FieldRef)) = no. -can_branch(unbox(_Type)) = no. - -%----------------------------------------------------------------------------% -:- end_module ml_backend.il_peephole. -%----------------------------------------------------------------------------% diff --git a/compiler/ilasm.m b/compiler/ilasm.m deleted file mode 100644 index c2115837c..000000000 --- a/compiler/ilasm.m +++ /dev/null @@ -1,2170 +0,0 @@ -%-----------------------------------------------------------------------------% -% vim: ft=mercury ts=4 sw=4 et -%-----------------------------------------------------------------------------% -% Copyright (C) 1999-2007, 2009-2011 The University of Melbourne. -% This file may only be copied under the terms of the GNU General -% Public License - see the file COPYING in the Mercury distribution. -%-----------------------------------------------------------------------------% -% -% File: ilasm.m. -% Main author: trd. -% -% Generate IL for the ilasm assembler. -% -% IL assembler syntax is documented in the Microsoft .NET Framework SDK. -% See ilds.m for links to the documentation. -% -% This code is a little messy. Some of the code here is a hangover from -% earlier versions of the assembler grammar. -% -% To do: -% [ ] Implement missing instructions. -% [ ] Add any missing functionality from the assembler grammar -% (events, properties, etc). -% [ ] Fix up all the XXXs. -% [ ] Replace all reference to io.write with predicates that do not depend -% on the compiler's internal data representations. -% -%-----------------------------------------------------------------------------% - -:- module ml_backend.ilasm. -:- interface. - -:- import_module libs.globals. -:- import_module ml_backend.ilds. - -:- import_module bool. -:- import_module integer. -:- import_module io. -:- import_module list. -:- import_module maybe. -:- import_module term. - -%-----------------------------------------------------------------------------% - -:- pred ilasm_output(globals::in, list(il_decl)::in, io::di, io::uo) is det. - -:- type int64 ---> int64(integer). -:- type int32 ---> int32(int). -:- type int16 ---> int16(int). -:- type int8 ---> int8(int). -:- type byte == int8. -:- type float64 ---> float64(float). -:- type float32 ---> float32(float). - - % A top level declaration in IL assembler. - % -:- type il_decl - % .class declaration - ---> ildecl_class( - list(classattr), % Attributes for the class. - ilds.id, % Name of the class. - extends, % What is the parent class? - implements, % What interfaces are implemented? - list(class_member) % Methods and fields. - ) - - % .namespace declaration - ; ildecl_namespace( - namespace_qual_name, % Namespace name. - list(il_decl) % Contents. - ) - - % .method (a global function) - % There are lots of restrictions on global functions so - % don't get too excited about using them for anything. - % In particular, you can't reference a namespace - % qualified global function from outside the module. - ; ildecl_method( - methodhead, - method_defn - ) - - % .data (module local data) - ; ildecl_data( - bool, % Is data in thread local storage? - maybe(ilds.id), % id to name this data. - data_body % Body of data. - ) - - % .file - % Declares a file associated with the current assembly. - ; ildecl_file(ilds.id) - - % .module extern - % Declares a module name. - ; ildecl_extern_module(ilds.id) - - % .assembly extern - % Declares an assembly name, and possibly its strong - % name/version number. - ; ildecl_extern_assembly(ilds.id, list(assembly_decl)) - - % .assembly - % Defines an assembly. - ; ildecl_assembly(ilds.id) - - % .custom - % A custom attribute. - ; ildecl_custom(custom_decl) - - ; ildecl_comment_term(term) - - % Print almost anything using pprint.to_doc - % (see library/pprint.m for limitations). - ; some [T] ildecl_comment_thing(T) - ; ildecl_comment(string). - -:- type assembly_decl - ---> version(int, int, int, int) % Version number. - ; hash(list(int8)) % Hash. - ; public_key_token(list(int8)) % Public key token. - ; custom(custom_decl). % A custom attribute. - - % A method definition is just a list of body decls. - % -:- type method_defn == list(method_body_decl). - -:- type methodhead - ---> methodhead( - list(methattr), % Method attributes. - member_name, % Method name. - signature, % Method signature. - list(implattr) % Implementation attributes. - ). - -:- type class_member - % .method (a class method) - ---> member_method( - methodhead, % Name, signature, attributes. - method_defn % Definition of method. - ) - - % .field (a class field) - ; member_field( - list(fieldattr), % Attributes. - il_type, % Field type. - ilds.id, % Field name. - maybe(int32), % Offset for explicit layout. - field_initializer % Initializer. - ) - - % .property (a class property) - ; member_property( - il_type, % Property type. - ilds.id, % Property name. - maybe(methodhead), % Get property. - maybe(methodhead) % Set property. - ) - - % .class (a nested class) - ; member_nested_class( - list(classattr), % Attributes for the class. - ilds.id, % Name of the class. - extends, % What is the parent class? - implements, % What interfaces are implemented? - list(class_member) % Methods and fields. - ) - - ; member_custom(custom_decl) % custom attribute - - ; member_comment_term(term) - ; member_comment(string) - - % print almost anything using pprint.to_doc - % (see library/pprint.m for limitations). - ; some [T] member_comment_thing(T). - -:- type field_initializer - ---> none % No initializer. - ; at(ilds.id) % Initialize with .data at given location. - ; equals(field_init). % Initialize with constant. - - % Note that for some reason the syntax for field_init is almost, - % but not quite the same as data items. - % -:- type field_init - ---> data_item(data_item) % Most data_items are valid. - % XXX unicode is not yet implemented, don't use - % wchar_ptr unless you intend to implement it - ; wchar_ptr(string) % A string to convert to unicode. - ; binary_float32(int32) % Binary rep. of float. - ; binary_float64(int64). % Binary rep. of double. - - % A parent class to extend. - % -:- type extends - ---> extends(ilds.class_name) - ; extends_nothing. - - % A list of interfaces that we implement. - % -:- type implements - ---> implements(list(ilds.class_name)). - - % Declarations that can form the body of a method. - % -:- type method_body_decl - ---> emitbyte(int32) - % raw byte output (danger! danger!) - % "emits an int32 to the code section of the method" according - % to the IL Assembly Language Programmers' Reference. - % This probably means it can output IL bytecodes. - - ; maxstack(int32) - % "Defines the maximum size of the stack, specified by the int32" - % But does it measure in bits, nibbles, bytes, words or - % something else? - - ; entrypoint % Is this "main"? - ; zeroinit % Initialize locals to zero. - ; custom(custom_decl) % Custom attribute. - ; instrs(list(instr)) % Instructions. - ; label(string). % A label. - - % Attributes that a class can have. - % See SDK documentation for what they all mean. - % -:- type classattr - ---> abstract - ; ansi - ; auto - ; autochar - ; beforefieldinit - ; explicit - ; interface - ; nestedassembly - ; nestedfamandassem - ; nestedfamily - ; nestedfamorassem - ; nestedprivate - ; nestedpublic - ; private - ; public - ; rtspecialname - ; sealed - ; sequential - ; serializable - ; specialname - ; unicode. - - % Attributes that a method can have. - % See SDK documentation for what they all mean. - % -:- type methattr - ---> abstract - ; assembly - ; famandassem - ; family - ; famorassem - ; final - ; hidebysig - ; newslot - ; private - ; privatescope - ; public - ; rtspecialname - ; specialname - ; static - ; synchronized - ; virtual - ; pinvokeimpl. - - % Attributes that a field can have. - % See SDK documentation for what they all mean. - % -:- type fieldattr - ---> assembly - ; famandassem - ; family - ; famorassem - ; initonly - ; literal - ; notserialized - ; pinvokeimpl - ; private - ; privatescope - ; public - ; static - ; volatile. - - % Attributes that a method implementation can have. - % See SDK documentation for what they all mean. - % -:- type implattr - ---> il - ; implemented - ; internalcall - ; managed - ; native - ; ole - ; optil - ; runtime - ; unmanaged. - - % The body of a .data declaration - % -:- type data_body - ---> itemlist(list(data_item)) - ; item(data_item). - - % Various constants that can be used in .data declarations. - % -:- type data_item - ---> float32(float32) - ; float64(float64) - ; int64(int64) - ; int32(int32) - ; int16(int16) - ; int8(int8) - ; char_ptr(string) - ; '&'(ilds.id) - ; bytearray(list(byte)). % Output as two digit hex, e.g. 01 F7 0A. - -:- type custom_decl - ---> custom_decl( - custom_type, - maybe(custom_type), - qstring_or_bytes - ). - -:- type qstring_or_bytes - ---> qstring(string) - ; bytes(list(int8)) - ; no_initalizer. - -:- type custom_type - ---> type(il_type) - ; methodref(ilds.methodref). - -%-----------------------------------------------------------------------------% -%-----------------------------------------------------------------------------% - -:- implementation. - -:- import_module backend_libs.c_util. % for output_float_literal -:- import_module libs.options. - -:- import_module char. -:- import_module int. -:- import_module pair. -:- import_module pprint. -:- import_module require. -:- import_module string. -:- import_module term_io. -:- import_module varset. - -%-----------------------------------------------------------------------------% - - % Some versions of the IL assembler enforce a rule that if you output - % .assembly foo { } - % you are not allowed to use the assembly reference in the rest of - % the file, e.g. - % [foo]blah.bletch - % Instead you have to output just - % blah.bletch - % - % So we need to duplicate this checking in the output phase and - % make sure we don't output [foo]. - % - % It's a good idea to do this anyway, as there is apparently a - % performance hit if you use assembly references to a symbol that is - % in the local assembly. - -:- type ilasm_info - ---> ilasm_info( - current_assembly :: ilds.id - ). - -:- pred ilasm_write_list(list(T)::in, string::in, - pred(T, ilasm_info, ilasm_info, io, io) - ::in(pred(in, in, out, di, uo) is det), - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - -ilasm_write_list([], _Separator, _OutputPred, !Info, !IO). -ilasm_write_list([E | Es], Separator, OutputPred, !Info, !IO) :- - OutputPred(E, !Info, !IO), - ( - Es = [] - ; - Es = [_ | _], - io.write_string(Separator, !IO) - ), - ilasm_write_list(Es, Separator, OutputPred, !Info, !IO). - -ilasm_output(Globals, Blocks, !IO) :- - OutInfo = init_ilasm_out_info(Globals), - Info0 = ilasm_info(""), - ilasm_output(OutInfo, Blocks, Info0, _Info, !IO). - -:- pred ilasm_output(ilasm_out_info::in, list(il_decl)::in, - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - -ilasm_output(OutInfo, Blocks, !Info, !IO) :- - ilasm_write_list(Blocks, "\n\n", output_decl(OutInfo), !Info, !IO), - io.write_string("\n\n", !IO). - -:- pred output_decl(ilasm_out_info::in, il_decl::in, - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - -output_decl(OutInfo, Decl, !Info, !IO) :- - ( - Decl = ildecl_custom(CustomDecl), - output_custom_decl(OutInfo, CustomDecl, !Info, !IO) - ; - Decl = ildecl_class(Attrs, Id, Extends, Implements, Contents), - io.write_string(".class ", !IO), - io.write_list(Attrs, " ", output_classattr, !IO), - ( - Attrs = [_ | _], - io.write_string(" ", !IO) - ; - Attrs = [] - ), - output_id(Id, !IO), - ( - Extends = extends(ExtendsModule), - io.write_string(" extends ", !IO), - output_class_name(OutInfo, ExtendsModule, !Info, !IO) - ; - Extends = extends_nothing - ), - Implements = implements(ImplementsList), - ( - ImplementsList = [_ | _], - io.write_string(" implements ", !IO), - ilasm_write_list(ImplementsList, ", ", output_class_name(OutInfo), - !Info, !IO) - ; - ImplementsList = [] - ), - io.write_string(" {\n", !IO), - ilasm_write_list(Contents, "\n", output_class_member(OutInfo), - !Info, !IO), - io.write_string("\n}", !IO) - ; - Decl = ildecl_namespace(DottedName, Contents), - ( - DottedName = [_ | _], - io.write_string(".namespace ", !IO), - output_dotted_name(DottedName, !IO), - io.write_string(" {\n", !IO), - ilasm_output(OutInfo, Contents, !Info, !IO), - io.write_string("}\n", !IO) - ; - DottedName = [], - ilasm_output(OutInfo, Contents, !Info, !IO) - ) - ; - Decl = ildecl_method(MethodHead, MethodDecls), - io.write_string(".method ", !IO), - output_methodhead(OutInfo, MethodHead, !Info, !IO), - io.write_string("\n{\n", !IO), - ilasm_write_list(MethodDecls, "\n", output_method_body_decl(OutInfo), - !Info, !IO), - io.write_string("}\n", !IO) - ; - Decl = ildecl_data(TLS, MaybeId, Body), - io.write_string(".data ", !IO), - ( - TLS = yes, - io.write_string("tls ", !IO) - ; - TLS = no - ), - ( - MaybeId = yes(Id), - output_id(Id, !IO), - io.write_string(" = ", !IO) - ; - MaybeId = no - ), - output_data_body(Body, !IO) - ; - Decl = ildecl_comment_term(CommentTerm), - AutoComments = OutInfo ^ ilaoi_auto_comments, - ( - AutoComments = yes, - io.write_string("// ", !IO), - varset.init(VarSet), - term_io.write_term(VarSet, CommentTerm, !IO), - io.nl(!IO) - ; - AutoComments = no - ) - ; - Decl = ildecl_comment_thing(Thing), - AutoComments = OutInfo ^ ilaoi_auto_comments, - ( - AutoComments = yes, - Doc = label("// ", to_doc(Thing)), - write(70, Doc, !IO), - io.nl(!IO) - ; - AutoComments = no - ) - ; - Decl = ildecl_comment(CommentStr), - AutoComments = OutInfo ^ ilaoi_auto_comments, - ( - AutoComments = yes, - output_comment_string(CommentStr, !IO) - ; - AutoComments = no - ) - ; - Decl = ildecl_extern_assembly(AsmName, AssemblyDecls), - io.write_string(".assembly extern ", !IO), - output_id(AsmName, !IO), - io.write_string("{\n", !IO), - list.foldl2( - (pred(A::in, I0::in, I::out, IO0::di, IO::uo) is det :- - output_assembly_decl(OutInfo, A, I0, I, IO0, IO1), - io.write_string("\n\t", IO1, IO) - ), AssemblyDecls, !Info, !IO), - io.write_string("\n}\n", !IO) - ; - Decl = ildecl_assembly(AsmName), - io.write_string(".assembly ", !IO), - output_id(AsmName, !IO), - !Info ^ current_assembly := AsmName, - io.write_string(" { }", !IO) - ; - Decl = ildecl_file(FileName), - io.write_string(".file ", !IO), - output_id(FileName, !IO) - ; - Decl = ildecl_extern_module(ModName), - io.write_string(".module extern ", !IO), - output_id(ModName, !IO) - ). - -:- pred output_class_member(ilasm_out_info::in, class_member::in, - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - -output_class_member(OutInfo, ClassMember, !Info, !IO) :- - ( - ClassMember = member_method(MethodHead, MethodDecls), - MethodDecl = ildecl_method(MethodHead, MethodDecls), - ( MethodHead = methodhead(_, cctor, _, _) -> - % Don't do debug output on class constructors, since - % they are automatically generated and take forever to run. - NoDebugOutInfo = OutInfo ^ ilaoi_debug_il_asm := no, - output_decl(NoDebugOutInfo, MethodDecl, !Info, !IO) - ; - output_decl(OutInfo, MethodDecl, !Info, !IO) - ) - ; - ClassMember = member_custom(CustomDecl), - output_custom_decl(OutInfo, CustomDecl, !Info, !IO) - ; - ClassMember = member_field(FieldAttrs, Type, IlId, MaybeOffset, - Initializer), - io.write_string(".field ", !IO), - ( - MaybeOffset = yes(Offset), - output_int32(Offset, !IO), - io.write_string(" ", !IO) - ; - MaybeOffset = no - ), - io.write_list(FieldAttrs, " ", io.write, !IO), - io.write_string("\n\t", !IO), - output_type(OutInfo, Type, !Info, !IO), - io.write_string("\n\t", !IO), - output_id(IlId, !IO), - output_field_initializer(Initializer, !IO) - ; - ClassMember = member_property(Type, Name, MaybeGet, MaybeSet), - io.write_string(".property instance ", !IO), - output_type(OutInfo, Type, !Info, !IO), - io.write_string(" ", !IO), - output_id(Name, !IO), - io.write_string("() {", !IO), - ( - MaybeGet = yes(methodhead(_, GetMethodName, GetSignature, _)), - io.nl(!IO), - io.write_string("\t.get instance ", !IO), - output_name_signature_and_call_conv(OutInfo, GetSignature, - yes(GetMethodName), "\t\t", !Info, !IO) - ; - MaybeGet = no - ), - ( - MaybeSet = yes(methodhead(_, SetMethodName, SetSignature, _)), - io.nl(!IO), - io.write_string("\t.set instance ", !IO), - output_name_signature_and_call_conv(OutInfo, SetSignature, - yes(SetMethodName), "\t\t", !Info, !IO) - ; - MaybeSet = no - ), - io.write_string("\n}\n", !IO) - ; - ClassMember = member_nested_class(Attrs, Id, Extends, Implements, - Contents), - ClassDecl = ildecl_class(Attrs, Id, Extends, Implements, Contents), - output_decl(OutInfo, ClassDecl, !Info, !IO) - ; - ClassMember = member_comment(CommentStr), - AutoComments = OutInfo ^ ilaoi_auto_comments, - ( - AutoComments = yes, - output_comment_string(CommentStr, !IO) - ; - AutoComments = no - ) - ; - ClassMember = member_comment_term(CommentTerm), - AutoComments = OutInfo ^ ilaoi_auto_comments, - ( - AutoComments = yes, - io.write_string("// ", !IO), - varset.init(VarSet), - term_io.write_term(VarSet, CommentTerm, !IO), - io.nl(!IO) - ; - AutoComments = no - ) - ; - ClassMember = member_comment_thing(Thing), - AutoComments = OutInfo ^ ilaoi_auto_comments, - ( - AutoComments = yes, - Doc = label("// ", to_doc(Thing)), - write(70, Doc, !IO), - io.nl(!IO) - ; - AutoComments = no - ) - ). - -:- pred output_methodhead(ilasm_out_info::in, methodhead::in, - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - -output_methodhead(OutInfo, MethodHead, !Info, !IO) :- - MethodHead = methodhead(Attrs, MethodName, Signature, ImplAttrs), - io.write_list(Attrs, " ", io.write, !IO), - ( - Attrs = [_ | _], - io.write_string(" ", !IO) - ; - Attrs = [] - ), - output_name_signature_and_call_conv(OutInfo, Signature, yes(MethodName), - "\t", !Info, !IO), - io.write_list(ImplAttrs, " ", io.write, !IO). - -:- pred output_method_body_decl(ilasm_out_info::in, method_body_decl::in, - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - -output_method_body_decl(OutInfo, MethodBodyDecl, !Info, !IO) :- - ( - MethodBodyDecl = emitbyte(Int32), - io.write_string(".emitbyte ", !IO), - output_int32(Int32, !IO) - ; - MethodBodyDecl = custom(CustomDecl), - output_custom_decl(OutInfo, CustomDecl, !Info, !IO) - ; - MethodBodyDecl = maxstack(Int32), - io.write_string(".maxstack ", !IO), - output_int32(Int32, !IO) - ; - MethodBodyDecl = entrypoint, - io.write_string(".entrypoint ", !IO) - ; - MethodBodyDecl = zeroinit, - io.write_string(".zeroinit ", !IO) - ; - MethodBodyDecl = instrs(Instrs), - output_instructions(OutInfo, Instrs, !Info, !IO) - ; - MethodBodyDecl = label(Label), - output_label(Label, !IO), - io.write_string(":", !IO) - ). - - :- pred output_label(label::in, io::di, io::uo) is det. - - output_label(Label, !IO) :- - io.write_string(Label, !IO). - - :- pred output_class_name(ilasm_out_info::in, ilds.class_name::in, - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - - output_class_name(OutInfo, ClassName, !Info, !IO) :- - output_structured_name(OutInfo, !.Info, ClassName, !IO). - - :- pred output_call_conv(call_conv::in, io::di, io::uo) is det. - - output_call_conv(call_conv(IsInstance, IlCallConv), !IO) :- - ( - IsInstance = yes, - io.write_string("instance ", !IO) - ; - IsInstance = no, - io.write(IlCallConv, !IO), - io.write_string(" ", !IO) - ). - -:- pred output_name_signature_and_call_conv(ilasm_out_info::in, signature::in, - maybe(member_name)::in, string::in, ilasm_info::in, ilasm_info::out, - io::di, io::uo) is det. - -output_name_signature_and_call_conv(OutInfo, Signature, MaybeMethodName, - Indent, !Info, !IO) :- - Signature = signature(CallConv, ReturnType, ArgTypes), - output_call_conv(CallConv, !IO), - io.write_string("\n", !IO), - io.write_string(Indent, !IO), - output_ret_type(OutInfo, ReturnType, !Info, !IO), - ( - MaybeMethodName = yes(MethodName), - io.write_string("\n", !IO), - io.write_string(Indent, !IO), - output_member_name(MethodName, !IO) - ; - MaybeMethodName = no, - io.write_string(" ", !IO) - ), - ( - ArgTypes = [], - io.write_string("()", !IO) - ; - ArgTypes = [_ | _], - io.write_string("(\n\t\t", !IO), - ilasm_write_list(ArgTypes, ",\n\t\t", output_method_param(OutInfo), - !Info, !IO), - io.write_string("\n\t)", !IO) - ). - -:- pred output_member_name(member_name::in, io::di, io::uo) is det. - -output_member_name(MethodName, !IO) :- - ( - MethodName = ctor, - io.write_string(".ctor", !IO) - ; - MethodName = cctor, - io.write_string(".cctor", !IO) - ; - MethodName = id(IlId), - output_id(IlId, !IO) - ). - -:- pred output_ret_type(ilasm_out_info::in, ret_type::in, - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - -output_ret_type(OutInfo, RetType, !Info, !IO) :- - ( - RetType = void, - io.write_string("void", !IO) - ; - RetType = simple_type(Type), - output_simple_type(OutInfo, Type, !Info, !IO) - ). - -:- pred output_local(ilasm_out_info::in, pair(ilds.id, il_type)::in, - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - -output_local(OutInfo, Id - Type, !Info, !IO) :- - output_type(OutInfo, Type, !Info, !IO), - io.write_string(" ", !IO), - output_id(Id, !IO). - -:- pred output_method_param(ilasm_out_info::in, il_method_param::in, - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - -output_method_param(OutInfo, MethodParam, !Info, !IO) :- - MethodParam = il_method_param(Type, MaybeId), - output_type(OutInfo, Type, !Info, !IO), - ( - MaybeId = no - ; - MaybeId = yes(Id), - io.write_string(" ", !IO), - output_id(Id, !IO) - ). - -:- pred output_type(ilasm_out_info::in, il_type::in, - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - -output_type(OutInfo, IlType, !Info, !IO) :- - IlType = il_type(Modifiers, SimpleType), - io.write_list(Modifiers, " ", output_modifier, !IO), - output_simple_type(OutInfo, SimpleType, !Info, !IO). - -:- pred output_simple_type(ilasm_out_info::in, simple_type::in, - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - -output_simple_type(OutInfo, SimpleType, !Info, !IO) :- - ( - SimpleType = int8, - io.write_string("int8", !IO) - ; - SimpleType = int16, - io.write_string("int16", !IO) - ; - SimpleType = int32, - io.write_string("int32", !IO) - ; - SimpleType = int64, - io.write_string("int64", !IO) - ; - SimpleType = uint8, - io.write_string("unsigned int8", !IO) - ; - SimpleType = uint16, - io.write_string("unsigned int16", !IO) - ; - SimpleType = uint32, - io.write_string("unsigned int32", !IO) - ; - SimpleType = uint64, - io.write_string("unsigned int64", !IO) - ; - SimpleType = native_int, - io.write_string("native int", !IO) - ; - SimpleType = native_uint, - io.write_string("native unsigned int", !IO) - ; - SimpleType = float32, - io.write_string("float32", !IO) - ; - SimpleType = float64, - io.write_string("float64", !IO) - ; - SimpleType = native_float, - io.write_string("native float", !IO) - ; - SimpleType = bool, - io.write_string("bool", !IO) - ; - SimpleType = char, - io.write_string("char", !IO) - ; - SimpleType = object, - io.write_string("object", !IO) - ; - SimpleType = string, - io.write_string("string", !IO) - ; - SimpleType = refany, - io.write_string("refany", !IO) - ; - SimpleType = class(ClassName), - ( name_to_simple_type(ClassName, ClassType) -> - ( - ClassType = reference(ClassSimpleType), - output_simple_type(OutInfo, ClassSimpleType, !Info, !IO) - ; - ClassType = value(_), - % If it is a value type then we are refering - % to the boxed version of the value type. - io.write_string("class ", !IO), - output_structured_name(OutInfo, !.Info, ClassName, !IO) - ) - ; - io.write_string("class ", !IO), - output_structured_name(OutInfo, !.Info, ClassName, !IO) - ) - ; - SimpleType = valuetype(ValueName), - ( name_to_simple_type(ValueName, ValueType) -> - ( - ValueType = value(ValueSimpleType), - output_simple_type(OutInfo, ValueSimpleType, !Info, !IO) - ; - ValueType = reference(_), - unexpected($module, $pred, "builtin reference type") - ) - ; - io.write_string("valuetype ", !IO), - output_structured_name(OutInfo, !.Info, ValueName, !IO) - ) - ; - SimpleType = interface(Name), - io.write_string("interface ", !IO), - output_structured_name(OutInfo, !.Info, Name, !IO) - ; - SimpleType = '[]'(Type, Bounds), - output_type(OutInfo, Type, !Info, !IO), - output_bounds(Bounds, !IO) - ; - SimpleType = '*'(Type), - output_type(OutInfo, Type, !Info, !IO), - io.write_string("*", !IO) - ; - SimpleType = '&'(Type), - output_type(OutInfo, Type, !Info, !IO), - io.write_string("&", !IO) - ). - -:- type ref_or_value - ---> reference(simple_type) - ; value(simple_type). - - % If possible converts a class name to a simple type and an - % indicator of whether or not that simple type is a reference or - % value class. - % -:- pred name_to_simple_type(class_name::in, ref_or_value::out) is semidet. - -name_to_simple_type(Name, Type) :- - % Parition II section 'Built-in Types' (Section 7.2) states - % that all builtin types *must* be referenced by their - % special encoding in signatures. - % See Parition I 'Built-In Types' % (Section 8.2.2) for the - % list of all builtin types. - Name = structured_name(AssemblyName, QualifiedName, _), - AssemblyName = assembly("mscorlib"), - QualifiedName = ["System", TypeName], - ( - TypeName = "Boolean", - Type = value(bool) - ; - TypeName = "Char", - Type = value(char) - ; - TypeName = "Object", - Type = reference(object) - ; - TypeName = "String", - Type = reference(string) - ; - TypeName = "Single", - Type = value(float32) - ; - TypeName = "Double", - Type = value(float64) - ; - TypeName = "SByte", - Type = value(int8) - ; - TypeName = "Int16", - Type = value(int16) - ; - TypeName = "Int32", - Type = value(int32) - ; - TypeName = "Int64", - Type = value(int64) - ; - TypeName = "IntPtr", - Type = value(native_int) - ; - TypeName = "UIntPtr", - Type = value(native_uint) - ; - TypeName = "TypedReference", - Type = value(refany) - ; - TypeName = "Byte", - Type = value(uint8) - ; - TypeName = "UInt16", - Type = value(uint16) - ; - TypeName = "UInt32", - Type = value(uint32) - ; - TypeName = "UInt64", - Type = value(uint64) - ). - - % The names are all different if it is an opcode. - % There's probably a very implementation dependent reason for this. - % -:- pred output_simple_type_opcode(simple_type::in, io::di, io::uo) is det. - -output_simple_type_opcode(int8, !IO) :- - io.write_string("i1", !IO). -output_simple_type_opcode(int16, !IO) :- - io.write_string("i2", !IO). -output_simple_type_opcode(int32, !IO) :- - io.write_string("i4", !IO). -output_simple_type_opcode(int64, !IO) :- - io.write_string("i8", !IO). -output_simple_type_opcode(uint8, !IO) :- - io.write_string("u1", !IO). -output_simple_type_opcode(uint16, !IO) :- - io.write_string("u2", !IO). -output_simple_type_opcode(uint32, !IO) :- - io.write_string("u4", !IO). -output_simple_type_opcode(uint64, !IO) :- - io.write_string("u8", !IO). -output_simple_type_opcode(native_int, !IO) :- - io.write_string("i", !IO). -output_simple_type_opcode(native_uint, !IO) :- - io.write_string("u", !IO). -output_simple_type_opcode(float32, !IO) :- - io.write_string("r4", !IO). -output_simple_type_opcode(float64, !IO) :- - io.write_string("r8", !IO). -output_simple_type_opcode(native_float, !IO) :- - unexpected($module, $pred, "unable to create opcode for native_float"). -output_simple_type_opcode(bool, !IO) :- - % XXX should i4 be used for bool? - io.write_string("i4", !IO). -output_simple_type_opcode(char, !IO) :- - io.write_string("i2", !IO). -output_simple_type_opcode(object, !IO) :- - % All reference types use "ref" as their opcode. - % XXX is "ref" here correct for value classes? - io.write_string("ref", !IO). -output_simple_type_opcode(string, !IO) :- - io.write_string("ref", !IO). -output_simple_type_opcode(refany, !IO) :- - io.write_string("ref", !IO). -output_simple_type_opcode(class(_Name), !IO) :- - io.write_string("ref", !IO). -output_simple_type_opcode(valuetype(_Name), !IO) :- - io.write_string("ref", !IO). -output_simple_type_opcode(interface(_Name), !IO) :- - io.write_string("ref", !IO). -output_simple_type_opcode('[]'(_Type, _Bounds), !IO) :- - io.write_string("ref", !IO). -output_simple_type_opcode('*'(_Type), !IO) :- - io.write_string("ref", !IO). -output_simple_type_opcode('&'(_Type), !IO) :- - io.write_string("ref", !IO). - -:- pred output_bounds(bounds::in, io::di, io::uo) is det. - -output_bounds(Bounds, !IO) :- - io.write_string("[", !IO), - io.write_list(Bounds, ", ", output_bound, !IO), - io.write_string("]", !IO). - -:- pred output_bound(bound::in, io::di, io::uo) is det. - -output_bound(upper(X), !IO) :- - io.write_int(X, !IO). -output_bound(lower(X), !IO) :- - io.write_int(X, !IO), - io.write_string("...", !IO). -output_bound(between(X, Y), !IO) :- - io.write_int(X, !IO), - io.write_string("...", !IO), - io.write_int(Y, !IO). - -:- pred output_modifier(ilds.type_modifier::in, io::di, io::uo) is det. - -output_modifier(const, !IO) :- - io.write_string("const", !IO). -output_modifier(volatile, !IO) :- - io.write_string("volatile", !IO). -output_modifier(readonly, !IO) :- - io.write_string("readonly", !IO). - -:- pred output_instructions(ilasm_out_info::in, list(instr)::in, - ilasm_info::in, ilasm_info::out, - io::di, io::uo) is det. - -output_instructions(OutInfo, Instructions, !Info, !IO) :- - DebugIlAsm = OutInfo ^ ilaoi_debug_il_asm, - ( - DebugIlAsm = yes, - list.foldl2(output_debug_instruction(OutInfo), Instructions, - !Info, !IO) - ; - DebugIlAsm = no, - list.foldl2(output_instruction(OutInfo), Instructions, !Info, !IO) - ). - - % We write each instruction before we execute it. - % This is a nice way of debugging IL as it executes, although as - % the IL debugger improves we might not need this any more. - % -:- pred output_debug_instruction(ilasm_out_info::in, instr::in, - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - -output_debug_instruction(OutInfo, Instr, !Info, !IO) :- - % We can't handle tailcalls easily -- you need to put it out as - % trace the tail instruction - % trace the call instruction - % output the tail instruction - % output the call instruction - % For the moment we'll just ignore tailcalls. - - ( Instr = tailcall -> - true - ; Instr = context(_, _) -> - % Contexts are messy, let's ignore them for now. - true - ; Instr = start_block(bt_catch(ClassName), Id) -> - output_instr(OutInfo, start_block(bt_catch(ClassName), Id), - !Info, !IO), - io.write_string("\n", !IO), - io.write_string("\t", !IO), - output_trace_instr(OutInfo, Instr, !Info, !IO), - io.write_string("\n", !IO) - ; Instr = start_block(bt_scope(Locals), Id) -> - string.format("{\t// #%d", [i(Id)], S), - io.write_string(S, !IO), - io.nl(!IO), - output_trace(S, !IO), - ( - Locals = [] - ; - Locals = [_ | _], - % output the .locals decl - io.write_string("\t.locals (\n\t\t", !IO), - ilasm_write_list(Locals, ",\n\t\t", output_local(OutInfo), - !Info, !IO), - io.write_string("\n\t)", !IO), - io.write_string("\n", !IO), - - % trace the .locals decl - io.write_string("\t\tldstr """, !IO), - io.write_string(".locals (\\n\\t\\t", !IO), - ilasm_write_list(Locals, ",\\n\\t\\t", output_local(OutInfo), - !Info, !IO), - io.write_string(")", !IO), - io.write_string("\\n""", !IO), - io.write_string("\n", !IO), - io.write_string("\t\tcall void " ++ - "['mscorlib']System.Console::" ++ - "Write(class ['mscorlib']System.String)\n", - !IO) - ) - ; - output_trace_instr(OutInfo, Instr, !Info, !IO), - io.write_string("\t", !IO), - output_instr(OutInfo, Instr, !Info, !IO), - io.write_string("\n", !IO) - ). - -:- pred output_trace_instr(ilasm_out_info::in, instr::in, - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - -output_trace_instr(OutInfo, Instr, !Info, !IO) :- - io.write_string("\t\tldstr """, !IO), - % We have to quote loadstrings. - ( Instr = ldstr(LoadString) -> - io.write_string("ldstr \\""", !IO), - output_escaped_string(LoadString, '\"', !IO), - io.write_string("\\""", !IO) - % XXX there could be issues with - % comments containing embedded newlines - ; Instr = comment(Comment) -> - io.write_string("comment: ", !IO), - io.write_string(Comment, !IO) - ; - output_instr(OutInfo, Instr, !Info, !IO) - ), - io.write_string("\\n", !IO), - io.write_string("""\n", !IO), - io.write_string("\t\tcall void ['mscorlib']System.Console::" ++ - "Write(class ['mscorlib']System.String)\n", !IO). - -:- pred output_trace(string::in, io::di, io::uo) is det. - -output_trace(S, !IO) :- - io.write_string("\t\tldstr """, !IO), - io.write_string(S, !IO), - io.write_string("\\n""\n", !IO), - io.write_string("\t\tcall void " ++ - "['mscorlib']System.Console::Write(class System.String)\n", - !IO). - -:- pred output_instruction(ilasm_out_info::in, instr::in, - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - -output_instruction(OutInfo, Instr, !Info, !IO) :- - ( - Instr = comment(_), - OutInfo ^ ilaoi_auto_comments = no - -> - true - ; - io.write_string("\t", !IO), - output_instr(OutInfo, Instr, !Info, !IO), - io.write_string("\n", !IO) - ). - -:- pred output_instr(ilasm_out_info::in, instr::in, - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - -output_instr(OutInfo, Instr, !Info, !IO) :- - ( - Instr = il_asm_code(Code, _MaxStack), - io.write_string(Code, !IO) - ; - Instr = comment(Comment), - output_comment_string(Comment, !IO) - ; - Instr = label(Label), - output_label(Label, !IO), - io.write_string(":", !IO) - ; - Instr = start_block(BlockType, Id), - ( - BlockType = bt_scope(Locals), - io.write_string("{", !IO), - io.write_string("\t// #", !IO), - io.write_int(Id, !IO), - ( - Locals = [] - ; - Locals = [_ | _], - io.write_string("\n\t.locals (\n\t\t", !IO), - ilasm_write_list(Locals, ",\n\t\t", output_local(OutInfo), - !Info, !IO), - io.write_string("\n\t)\n", !IO) - ) - ; - BlockType = bt_try, - io.write_string(".try {", !IO), - io.write_string("\t// #", !IO), - io.write_int(Id, !IO) - ; - BlockType = bt_catch(ClassName), - io.write_string("catch ", !IO), - output_class_name(OutInfo, ClassName, !Info, !IO), - io.write_string(" {", !IO), - io.write_string("\t// #", !IO), - io.write_int(Id, !IO) - ) - ; - Instr = end_block(BlockType, Id), - ( - BlockType = bt_scope(_), - io.write_string("}", !IO), - io.write_string("\t// #", !IO), - io.write_int(Id, !IO) - ; - BlockType = bt_catch(_), - io.write_string("}", !IO), - io.write_string("\t// #", !IO), - io.write_int(Id, !IO), - io.write_string(" (catch block)", !IO) - ; - BlockType = bt_try, - io.write_string("}", !IO), - io.write_string("\t// #", !IO), - io.write_int(Id, !IO), - io.write_string(" (try block)", !IO) - ) - ; - Instr = context(File, Line), - LineNumbers = OutInfo ^ ilaoi_line_numbers, - ( - LineNumbers = yes, - io.write_string("\n\t.line ", !IO), - io.write_int(Line, !IO), - io.write_string(" '", !IO), - io.write_string(File, !IO), - io.write_string("'", !IO) - ; - LineNumbers = no - ) - ; - Instr = call(MethodRef), - io.write_string("call\t", !IO), - output_methodref(OutInfo, MethodRef, !Info, !IO) - ; - Instr = callvirt(MethodRef), - io.write_string("callvirt\t", !IO), - output_methodref(OutInfo, MethodRef, !Info, !IO) - ; - Instr = calli(Signature), - io.write_string("calli\t", !IO), - output_name_signature_and_call_conv(OutInfo, Signature, no, "\t\t", - !Info, !IO) - ; - Instr = ret, - io.write_string("ret", !IO) - ; - Instr = bitwise_and, - io.write_string("and", !IO) - ; - Instr = arglist, - io.write_string("arglist", !IO) - ; - Instr = break, - io.write_string("break", !IO) - ; - Instr = ceq, - io.write_string("ceq", !IO) - ; - Instr = ckfinite, - io.write_string("ckfinite", !IO) - ; - Instr = cpblk, - io.write_string("cpblk", !IO) - ; - Instr = dup, - io.write_string("dup", !IO) - ; - Instr = endfilter, - io.write_string("endfilter", !IO) - ; - Instr = endfinally, - io.write_string("endfinally", !IO) - ; - Instr = initblk, - io.write_string("initblk", !IO) - ; - Instr = ldnull, - io.write_string("ldnull", !IO) - ; - Instr = localloc, - io.write_string("localloc", !IO) - ; - Instr = neg, - io.write_string("neg", !IO) - ; - Instr = nop, - io.write_string("nop", !IO) - ; - Instr = bitwise_not, - io.write_string("not", !IO) - ; - Instr = bitwise_or, - io.write_string("or", !IO) - ; - Instr = pop, - io.write_string("pop", !IO) - ; - Instr = shl, - io.write_string("shl", !IO) - ; - Instr = tailcall, - io.write_string("tail.", !IO) - ; - Instr = volatile, - io.write_string("volatile", !IO) - ; - Instr = bitwise_xor, - io.write_string("xor", !IO) - ; - Instr = ldlen, - io.write_string("ldlen", !IO) - ; - Instr = throw, - io.write_string("throw", !IO) - ; - % There are short forms of various instructions. - % The assembler can't generate them for you. - Instr = ldarg(index(Index)), - ( Index < 4 -> - io.write_string("ldarg.", !IO), - io.write_int(Index, !IO) - ; Index < 256 -> - io.write_string("ldarg.s\t", !IO), - output_index(Index, !IO) - ; - io.write_string("ldarg\t", !IO), - output_index(Index, !IO) - ) - ; - Instr = ldarg(name(Id)), - io.write_string("ldarg\t", !IO), - output_id(Id, !IO) - ; - Instr = ldc(Type, Const), - % Lots of short forms for loading integer. - % XXX Should probably put the magic numbers in functions. - ( ( Type = int32 ; Type = bool ), Const = i(IntConst) -> - ( IntConst < 8, IntConst >= 0 -> - io.write_string("ldc.i4.", !IO), - io.write_int(IntConst, !IO) - ; IntConst = -1 -> - io.write_string("ldc.i4.m1", !IO) - ; IntConst < 128, IntConst > -128 -> - io.write_string("ldc.i4.s\t", !IO), - io.write_int(IntConst, !IO) - ; - io.write_string("ldc.i4\t", !IO), - io.write_int(IntConst, !IO) - ) - ; Type = int64, Const = i(IntConst) -> - io.write_string("ldc.i8\t", !IO), - io.write_int(IntConst, !IO) - ; Type = float32, Const = f(FloatConst) -> - io.write_string("ldc.r4\t", !IO), - c_util.output_float_literal(FloatConst, !IO) - ; Type = float64, Const = f(FloatConst) -> - io.write_string("ldc.r8\t", !IO), - c_util.output_float_literal(FloatConst, !IO) - ; - unexpected($module, $pred, - "Inconsistent arguments in ldc instruction") - ) - ; - Instr = ldstr(String), - io.write_string("ldstr\t", !IO), - output_string_constant(String, !IO) - ; - Instr = add(Overflow, Signed), - io.write_string("add", !IO), - output_overflow(Overflow, !IO), - output_signed(Signed, !IO) - ; - Instr = beq(Target), - io.write_string("beq ", !IO), - output_target(Target, !IO) - ; - Instr = bge(Signed, Target), - io.write_string("bge", !IO), - output_signed(Signed, !IO), - io.write_string("\t", !IO), - output_target(Target, !IO) - ; - Instr = bgt(Signed, Target), - io.write_string("bgt", !IO), - output_signed(Signed, !IO), - io.write_string("\t", !IO), - output_target(Target, !IO) - ; - Instr = ble(Signed, Target), - io.write_string("ble", !IO), - output_signed(Signed, !IO), - io.write_string("\t", !IO), - output_target(Target, !IO) - ; - Instr = blt(Signed, Target), - io.write_string("blt", !IO), - output_signed(Signed, !IO), - io.write_string("\t", !IO), - output_target(Target, !IO) - ; - Instr = bne(Signed, Target), - io.write_string("bne", !IO), - output_signed(Signed, !IO), - io.write_string("\t", !IO), - output_target(Target, !IO) - ; - Instr = br(Target), - io.write_string("br\t", !IO), - output_target(Target, !IO) - ; - Instr = brfalse(Target), - io.write_string("brfalse\t", !IO), - output_target(Target, !IO) - ; - Instr = brtrue(Target), - io.write_string("brtrue\t", !IO), - output_target(Target, !IO) - ; - Instr = cgt(Signed), - io.write_string("cgt", !IO), - output_signed(Signed, !IO) - ; - Instr = clt(Signed), - io.write_string("clt", !IO), - output_signed(Signed, !IO) - ; - Instr = conv(SimpleType), - io.write_string("conv.", !IO), - output_simple_type_opcode(SimpleType, !IO) - ; - Instr = div(Signed), - io.write_string("div", !IO), - output_signed(Signed, !IO) - ; - Instr = jmp(MethodRef), - io.write_string("jmp\t", !IO), - output_methodref(OutInfo, MethodRef, !Info, !IO) - ; - % XXX can use short encoding for indexes - Instr = ldarga(Variable), - io.write_string("ldarga\t", !IO), - ( - Variable = index(Index), - output_index(Index, !IO) - ; - Variable = name(Name), - output_id(Name, !IO) - ) - ; - Instr = ldftn(MethodRef), - io.write_string("ldftn\t", !IO), - output_methodref(OutInfo, MethodRef, !Info, !IO) - ; - Instr = ldind(SimpleType), - io.write_string("ldind.", !IO), - output_simple_type_opcode(SimpleType, !IO) - ; - % XXX can use short encoding for indexes - Instr = ldloc(Variable), - io.write_string("ldloc\t", !IO), - ( - Variable = index(Index), - output_index(Index, !IO) - ; - Variable = name(Name), - output_id(Name, !IO) - ) - ; - % XXX can use short encoding for indexes - Instr = ldloca(Variable), - io.write_string("ldloca\t", !IO), - ( - Variable = index(Index), - output_index(Index, !IO) - ; - Variable = name(Name), - output_id(Name, !IO) - ) - ; - Instr = leave(Target), - io.write_string("leave\t", !IO), - output_target(Target, !IO) - ; - Instr = mul(Overflow, Signed), - io.write_string("mul", !IO), - output_overflow(Overflow, !IO), - output_signed(Signed, !IO) - ; - Instr = rem(Signed), - io.write_string("rem", !IO), - output_signed(Signed, !IO) - ; - Instr = shr(Signed), - io.write_string("shr", !IO), - output_signed(Signed, !IO) - ; - % XXX can use short encoding for indexes - Instr = starg(Variable), - io.write_string("starg\t", !IO), - ( - Variable = index(Index), - output_index(Index, !IO) - ; - Variable = name(Name), - output_id(Name, !IO) - ) - ; - % XXX can use short encoding for indexes - Instr = stind(SimpleType), - io.write_string("stind.", !IO), - output_simple_type_opcode(SimpleType, !IO) - ; - Instr = stloc(Variable), - io.write_string("stloc\t", !IO), - ( - Variable = index(Index), - output_index(Index, !IO) - ; - Variable = name(Name), - output_id(Name, !IO) - ) - ; - Instr = sub(OverFlow, Signed), - io.write_string("sub", !IO), - output_overflow(OverFlow, !IO), - output_signed(Signed, !IO) - ; - Instr = switch(Targets), - io.write_string("switch (", !IO), - io.write_list(Targets, ", ", output_target, !IO), - io.write_string(")", !IO) - ; - Instr = unaligned(_), - io.write_string("unaligned.", !IO) - ; - Instr = box(Type), - io.write_string("box\t", !IO), - output_type(OutInfo, Type, !Info, !IO) - ; - Instr = castclass(Type), - ( - Type = il_type(_, '[]'(ElementType, _)), - ElementType = il_type(_, class(Name)), - Name = structured_name(assembly("mscorlib"), - ["System", "Type"], _) - -> - % XXX There is bug where castclass to System.Type[] - % sometimes erroneously fails, so we comment out these - % castclass's. - io.write_string("// ", !IO) - ; - true - ), - io.write_string("castclass\t", !IO), - output_type(OutInfo, Type, !Info, !IO) - ; - Instr = cpobj(Type), - io.write_string("cpobj\t", !IO), - output_type(OutInfo, Type, !Info, !IO) - ; - Instr = initobj(Type), - io.write_string("initobj\t", !IO), - output_type(OutInfo, Type, !Info, !IO) - ; - Instr = isinst(Type), - io.write_string("isinst\t", !IO), - output_type(OutInfo, Type, !Info, !IO) - ; - Instr = ldelem(SimpleType), - io.write_string("ldelem.", !IO), - output_simple_type_opcode(SimpleType, !IO) - ; - Instr = ldelema(Type), - io.write_string("ldelema\t", !IO), - output_type(OutInfo, Type, !Info, !IO) - ; - Instr = ldfld(FieldRef), - io.write_string("ldfld\t", !IO), - output_fieldref(OutInfo, FieldRef, !Info, !IO) - ; - Instr = ldflda(FieldRef), - io.write_string("ldflda\t", !IO), - output_fieldref(OutInfo, FieldRef, !Info, !IO) - ; - Instr = ldobj(Type), - io.write_string("ldobj\t", !IO), - output_type(OutInfo, Type, !Info, !IO) - ; - Instr = ldsfld(FieldRef), - io.write_string("ldsfld\t", !IO), - output_fieldref(OutInfo, FieldRef, !Info, !IO) - ; - Instr = ldsflda(FieldRef), - io.write_string("ldsflda\t", !IO), - output_fieldref(OutInfo, FieldRef, !Info, !IO) - ; - % XXX should be implemented - Instr = ldtoken(_), - sorry($module, $pred, "ldtoken not implemented") - ; - Instr = ldvirtftn(MethodRef), - io.write_string("ldvirtftn\t", !IO), - output_methodref(OutInfo, MethodRef, !Info, !IO) - ; - Instr = mkrefany(Type), - io.write_string("mkrefany\t", !IO), - output_type(OutInfo, Type, !Info, !IO) - ; - Instr = newarr(Type), - io.write_string("newarr\t", !IO), - output_type(OutInfo, Type, !Info, !IO) - ; - Instr = newobj(MethodRef), - io.write_string("newobj\t", !IO), - output_methodref(OutInfo, MethodRef, !Info, !IO) - ; - Instr = refanytype, - io.write_string("refanytype", !IO) - ; - Instr = refanyval(Type), - io.write_string("refanyval\t", !IO), - output_type(OutInfo, Type, !Info, !IO) - ; - Instr = rethrow, - io.write_string("rethrow", !IO) - ; - Instr = stelem(SimpleType), - io.write_string("stelem.", !IO), - output_simple_type_opcode(SimpleType, !IO) - ; - Instr = stfld(FieldRef), - io.write_string("stfld\t", !IO), - output_fieldref(OutInfo, FieldRef, !Info, !IO) - ; - Instr = stobj(Type), - io.write_string("stobj\t", !IO), - output_type(OutInfo, Type, !Info, !IO) - ; - Instr = sizeof(Type), - io.write_string("sizeof\t", !IO), - output_type(OutInfo, Type, !Info, !IO) - ; - Instr = stsfld(FieldRef), - io.write_string("stsfld\t", !IO), - output_fieldref(OutInfo, FieldRef, !Info, !IO) - ; - Instr = unbox(Type), - io.write_string("unbox\t", !IO), - output_type(OutInfo, Type, !Info, !IO) - ). - - % XXX might use this later. -:- func max_efficient_encoding_short = int. - -max_efficient_encoding_short = 256. - -:- pred output_overflow(overflow::in, io::di, io::uo) is det. - -output_overflow(OverFlow, !IO) :- - ( - OverFlow = checkoverflow, - io.write_string(".ovf", !IO) - ; - OverFlow = nocheckoverflow - ). - -:- pred output_signed(signed::in, io::di, io::uo) is det. - -output_signed(Signed, !IO) :- - ( - Signed = signed - ; - Signed = unsigned, - io.write_string(".un", !IO) - ). - -:- pred output_target(target::in, io::di, io::uo) is det. - -output_target(offset_target(Target), !IO) :- - io.write_int(Target, !IO). -output_target(label_target(Label), !IO) :- - output_label(Label, !IO). - -:- pred output_fieldref(ilasm_out_info::in, fieldref::in, - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - -output_fieldref(OutInfo, fieldref(Type, ClassMemberName), !Info, !IO) :- - output_type(OutInfo, Type, !Info, !IO), - io.write_string("\n\t\t", !IO), - output_class_member_name(OutInfo, !.Info, ClassMemberName, !IO). - -:- pred output_methodref(ilasm_out_info::in, methodref::in, - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - -output_methodref(OutInfo, MethodRef, !Info, !IO) :- - ( - MethodRef = methoddef(call_conv(IsInstance, _), ReturnType, - ClassMemberName, ArgTypes), - ( - IsInstance = yes, - io.write_string("instance ", !IO) - ; - IsInstance = no - ), - output_ret_type(OutInfo, ReturnType, !Info, !IO), - io.write_string("\n\t\t", !IO), - output_class_member_name(OutInfo, !.Info, ClassMemberName, !IO), - ( - ArgTypes = [], - io.write_string("()\n", !IO) - ; - ArgTypes = [_ | _], - io.write_string("(\n\t\t\t", !IO), - ilasm_write_list(ArgTypes, ",\n\t\t\t", output_type(OutInfo), - !Info, !IO), - io.write_string("\n\t\t)", !IO) - ) - ; - MethodRef = local_method(call_conv(IsInstance, _), ReturnType, - MethodName, ArgTypes), - ( - IsInstance = yes, - io.write_string("instance ", !IO) - ; - IsInstance = no - ), - output_ret_type(OutInfo, ReturnType, !Info, !IO), - io.write_string("\n\t\t", !IO), - output_member_name(MethodName, !IO), - ( - ArgTypes = [], - io.write_string("()\n", !IO) - ; - ArgTypes = [_ | _], - io.write_string("(\n\t\t\t", !IO), - ilasm_write_list(ArgTypes, ",\n\t\t\t", output_type(OutInfo), - !Info, !IO), - io.write_string("\n\t\t)", !IO) - ) - ). - -:- pred output_classattr(classattr::in, io::di, io::uo) is det. - -output_classattr(abstract, !IO) :- - io.write_string("abstract", !IO). -output_classattr(ansi, !IO) :- - io.write_string("ansi", !IO). -output_classattr(auto, !IO) :- - io.write_string("auto", !IO). -output_classattr(autochar, !IO) :- - io.write_string("autochar", !IO). -output_classattr(beforefieldinit, !IO) :- - io.write_string("beforefieldinit", !IO). -output_classattr(explicit, !IO) :- - io.write_string("explicit", !IO). -output_classattr(interface, !IO) :- - io.write_string("interface", !IO). -output_classattr(nestedassembly, !IO) :- - io.write_string("nested assembly", !IO). -output_classattr(nestedfamandassem, !IO) :- - io.write_string("nested famandassem", !IO). -output_classattr(nestedfamily, !IO) :- - io.write_string("nested family", !IO). -output_classattr(nestedfamorassem, !IO) :- - io.write_string("nested famorassem", !IO). -output_classattr(nestedprivate, !IO) :- - io.write_string("nested private", !IO). -output_classattr(nestedpublic, !IO) :- - io.write_string("nested public", !IO). -output_classattr(private, !IO) :- - io.write_string("private", !IO). -output_classattr(public, !IO) :- - io.write_string("public", !IO). -output_classattr(rtspecialname, !IO) :- - io.write_string("rtspecialname", !IO). -output_classattr(sealed, !IO) :- - io.write_string("sealed", !IO). -output_classattr(sequential, !IO) :- - io.write_string("sequential", !IO). -output_classattr(serializable, !IO) :- - io.write_string("serializable", !IO). -output_classattr(specialname, !IO) :- - io.write_string("specialname", !IO). -output_classattr(unicode, !IO) :- - io.write_string("unicode", !IO). - -:- pred output_assembly_decl(ilasm_out_info::in, assembly_decl::in, - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - -output_assembly_decl(OutInfo, AssemblyDecl, !Info, !IO) :- - ( - AssemblyDecl = version(A, B, C, D), - io.format(".ver %d:%d:%d:%d", [i(A), i(B), i(C), i(D)], !IO) - ; - AssemblyDecl = public_key_token(Token), - io.write_string(".publickeytoken = ( ", !IO), - io.write_list(Token, " ", output_hexbyte, !IO), - io.write_string(" ) ", !IO) - ; - AssemblyDecl = hash(Hash), - io.write_string(".hash = ( ", !IO), - io.write_list(Hash, " ", output_hexbyte, !IO), - io.write_string(" ) ", !IO) - ; - AssemblyDecl = custom(CustomDecl), - output_custom_decl(OutInfo, CustomDecl, !Info, !IO) - ). - -:- pred output_custom_decl(ilasm_out_info::in, custom_decl::in, - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - -output_custom_decl(OutInfo, CustomDecl, !Info, !IO) :- - CustomDecl = custom_decl(Type, MaybeOwner, StringOrBytes), - io.write_string(".custom ", !IO), - ( - MaybeOwner = yes(Owner), - io.write_string(" (", !IO), - output_custom_type(OutInfo, Owner, !Info, !IO), - io.write_string(") ", !IO) - ; - MaybeOwner = no - ), - output_custom_type(OutInfo, Type, !Info, !IO), - ( - StringOrBytes = bytes(Bytes), - io.write_string(" = (", !IO), - io.write_list(Bytes, " ", output_hexbyte, !IO), - io.write_string(")", !IO) - ; - ( StringOrBytes = qstring(_) - ; StringOrBytes = no_initalizer - ), - sorry($module, $pred, "unexpected custom_decl") - ), - io.write_string("\n", !IO). - -:- pred output_custom_type(ilasm_out_info::in, custom_type::in, - ilasm_info::in, ilasm_info::out, io::di, io::uo) is det. - -output_custom_type(OutInfo, CustomType, !Info, !IO) :- - ( - CustomType = type(Type), - output_type(OutInfo, Type, !Info, !IO) - ; - CustomType = methodref(MethodRef), - output_methodref(OutInfo, MethodRef, !Info, !IO) - ). - -:- pred output_index(index::in, io::di, io::uo) is det. - -output_index(Index, !IO) :- - io.write_int(Index, !IO). - -:- pred output_string_constant(string::in, io::di, io::uo) is det. - -output_string_constant(String, !IO) :- - io.write_string("""", !IO), - output_escaped_string(String, '\"', !IO), - io.write_string("""", !IO). - -:- pred output_class_member_name(ilasm_out_info::in, ilasm_info::in, - class_member_name::in, io::di, io::uo) is det. - -output_class_member_name(OutInfo, Info, ClassMemberName, !IO) :- - ClassMemberName = class_member_name(StructuredName, MemberName), - output_structured_name(OutInfo, Info, StructuredName, !IO), - io.write_string("::", !IO), - output_member_name(MemberName, !IO). - -:- pred output_structured_name(ilasm_out_info::in, ilasm_info::in, - structured_name::in, io::di, io::uo) is det. - -output_structured_name(OutInfo, Info, StructuredName, !IO) :- - StructuredName = structured_name(Asm, DottedName, NestedClasses), - SeparateAssemblies = OutInfo ^ ilaoi_separate_assemblies, - ( - Asm = assembly(Assembly), - maybe_output_quoted_assembly_name(Assembly, Info, !IO) - ; - Asm = module(Module, Assembly), - ( - SeparateAssemblies = yes, - maybe_output_quoted_assembly_name(Module, Info, !IO) - ; - SeparateAssemblies = no, - ( - Info ^ current_assembly \= "", - string.prefix(Module, Info ^ current_assembly) - -> - quote_id(Module ++ ".dll", QuotedModuleName), - io.format("[.module %s]", [s(QuotedModuleName)], !IO) - ; - maybe_output_quoted_assembly_name(Assembly, Info, !IO) - ) - ) - ), - output_dotted_name(DottedName, !IO), - output_nested_class_quals(NestedClasses, !IO). - -:- pred maybe_output_quoted_assembly_name(ilds.id::in, ilasm_info::in, - io::di, io::uo) is det. - -maybe_output_quoted_assembly_name(Assembly, Info, !IO) :- - ( - Assembly \= "", - Assembly \= Info ^ current_assembly - -> - quote_id(Assembly, QuotedAssemblyName), - io.format("[%s]", [s(QuotedAssemblyName)], !IO) - ; - true - ). - -:- pred output_dotted_name(namespace_qual_name::in, io::di, io::uo) is det. - -output_dotted_name(Name, !IO) :- - io.write_list(Name, ".", output_id, !IO). - -:- pred output_nested_class_quals(nested_class_name::in, - io::di, io::uo) is det. - -output_nested_class_quals(Name, !IO) :- - list.foldl( - (pred(Id::in, IO0::di, IO::uo) is det :- - io.write_char('/', IO0, IO1), - output_id(Id, IO1, IO) - ), - Name, !IO). - -:- pred output_id(ilds.id::in, io::di, io::uo) is det. - -output_id(Id, !IO) :- - quote_id(Id, QuotedId), - io.write_string(QuotedId, !IO). - -:- pred output_field_initializer(field_initializer::in, io::di, io::uo) is det. - -output_field_initializer(none, !IO). -output_field_initializer(at(Id), !IO) :- - io.write_string(" at ", !IO), - output_id(Id, !IO). -output_field_initializer(equals(FieldInit), !IO) :- - io.write_string(" = ", !IO), - output_field_init(FieldInit, !IO). - -:- pred output_field_init(field_init::in, io::di, io::uo) is det. - -output_field_init(binary_float64(Int64), !IO) :- - io.write_string("float64(", !IO), - output_int64(Int64, !IO), - io.write_string(")", !IO). -output_field_init(binary_float32(Int32), !IO) :- - io.write_string("float32(", !IO), - output_int32(Int32, !IO), - io.write_string(")", !IO). -output_field_init(wchar_ptr(String), !IO) :- - io.write_string("wchar *(", !IO), - io.write(String, !IO), - io.write_string(")", !IO). - % XXX should check for invalid data_items -output_field_init(data_item(DataItem), !IO) :- - ( DataItem = char_ptr(String) -> - io.write(String, !IO) - ; - output_data_item(DataItem, !IO) - ). - -:- pred output_data_body(data_body::in, io::di, io::uo) is det. - -output_data_body(itemlist(DataItemList), !IO) :- - io.write_string("{", !IO), - io.write_list(DataItemList, ", ", output_data_item, !IO), - io.write_string("}", !IO). -output_data_body(item(DataItem), !IO) :- - output_data_item(DataItem, !IO). - -:- pred output_data_item(data_item::in, io::di, io::uo) is det. - -output_data_item(float64(Float), !IO) :- - io.write_string("float64(", !IO), - output_float64(Float, !IO), - io.write_string(")", !IO). -output_data_item(float32(Float32), !IO) :- - io.write_string("float32(", !IO), - output_float32(Float32, !IO), - io.write_string(")", !IO). -output_data_item(int64(Int64), !IO) :- - io.write_string("int64(", !IO), - output_int64(Int64, !IO), - io.write_string(")", !IO). -output_data_item(int32(Int32), !IO) :- - io.write_string("int32(", !IO), - output_int32(Int32, !IO), - io.write_string(")", !IO). -output_data_item(int16(Int16), !IO) :- - io.write_string("int16(", !IO), - output_int16(Int16, !IO), - io.write_string(")", !IO). -output_data_item(int8(Int8), !IO) :- - io.write_string("int8(", !IO), - output_int8(Int8, !IO), - io.write_string(")", !IO). -output_data_item(char_ptr(String), !IO) :- - io.write_string("char *(", !IO), - io.write(String, !IO), - io.write_string(")", !IO). -output_data_item('&'(Id), !IO) :- - io.write_string("&(", !IO), - output_id(Id, !IO), - io.write_string(")", !IO). -output_data_item(bytearray(Bytes), !IO) :- - io.write_string("bytearray(", !IO), - io.write_list(Bytes, " ", output_hexbyte, !IO), - io.write_string(")", !IO). - -:- pred output_float64(float64::in, io::di, io::uo) is det. - -output_float64(float64(Float), !IO) :- - io.write_float(Float, !IO). - -:- pred output_float32(float32::in, io::di, io::uo) is det. - -output_float32(float32(Float), !IO) :- - io.write_float(Float, !IO). - -:- pred output_int64(int64::in, io::di, io::uo) is det. - -output_int64(int64(Integer), !IO) :- - io.write_string(integer.to_string(Integer), !IO). - -:- pred output_int32(int32::in, io::di, io::uo) is det. - -output_int32(int32(Int), !IO) :- - io.write_int(Int, !IO). - -:- pred output_int16(int16::in, io::di, io::uo) is det. - -output_int16(int16(Int), !IO) :- - io.write_int(Int, !IO). - -:- pred output_int8(int8::in, io::di, io::uo) is det. - -output_int8(int8(Int), !IO) :- - io.write_int(Int, !IO). - -:- pred output_byte(byte::in, io::di, io::uo) is det. - -output_byte(Byte, !IO) :- - output_int8(Byte, !IO). - -:- pred output_hexbyte(byte::in, io::di, io::uo) is det. - -output_hexbyte(int8(Int), !IO) :- - string.int_to_base_string(Int, 16, Tmp), - io.write_string(Tmp, !IO). - -:- pred output_comment_string(string::in, io::di, io::uo) is det. - -output_comment_string(Comment, !IO) :- - io.write_string("// ", !IO), - CommentDoc = separated(text, line, - string.words_separator((pred('\n'::in) is semidet :- true), Comment)), - Doc = label("\t// ", CommentDoc), - write(70, Doc, !IO). - - % We need to quote all the IDs we output to avoid bumping into - % keywords that assembler uses (there are a lot of them, and - % there is no list available). -:- pred quote_id(ilds.id::in, string::out) is det. - -quote_id(Id, QuotedId) :- - escape_string(Id, '\'', EscapedId), - string.append_list(["'", EscapedId, "'"], QuotedId). - -:- pred output_escaped_string(string::in, char::in, io::di, io::uo) is det. - -output_escaped_string(String, EscapeChar, !IO) :- - escape_string(String, EscapeChar, EscapedString), - io.write_string(EscapedString, !IO). - - % Replace all Rep0 with backslash quoted Rep0 in Str0, - % giving the escaped string Str. - % We also escape embedded newlines and other characters. - % We already do some name mangling during code generation that - % means we avoid most weird characters here. - % -:- pred escape_string(string::in, char::in, string::out) is det. - -escape_string(Str0, ReplaceChar, Str) :- - string.to_char_list(Str0, CharList0), - list.foldl( - (pred(Char::in, E0::in, E::out) is det :- - ( escape_special_char(Char, QuoteChar) -> - E = [QuoteChar, '\\' | E0] - ; Char = ReplaceChar -> - E = [ReplaceChar, '\\' | E0] - ; - E = [Char | E0] - ) - ), CharList0, [], CharList), - string.from_rev_char_list(CharList, Str). - - % Characters that should be escaped in strings, and the - % character to escape with. - % -:- pred escape_special_char(char::in, char::out) is semidet. - -escape_special_char('\\', '\\'). -escape_special_char('\n', 'n'). -escape_special_char('\t', 't'). -escape_special_char('\b', 'b'). - -%-----------------------------------------------------------------------------% - -:- type ilasm_out_info - ---> ilasm_out_info( - ilaoi_auto_comments :: bool, - ilaoi_line_numbers :: bool, - ilaoi_debug_il_asm :: bool, - ilaoi_separate_assemblies :: bool - ). - -:- func init_ilasm_out_info(globals) = ilasm_out_info. - -init_ilasm_out_info(Globals) = Info :- - globals.lookup_bool_option(Globals, auto_comments, AutoComments), - globals.lookup_bool_option(Globals, line_numbers, LineNumbers), - globals.lookup_bool_option(Globals, debug_il_asm, DebugIlAsm), - globals.lookup_bool_option(Globals, separate_assemblies, - SeparateAssemblies), - Info = ilasm_out_info(AutoComments, LineNumbers, DebugIlAsm, - SeparateAssemblies). - -%-----------------------------------------------------------------------------% -:- end_module ml_backend.ilasm. -%-----------------------------------------------------------------------------% diff --git a/compiler/ilds.m b/compiler/ilds.m deleted file mode 100644 index e10a5156e..000000000 --- a/compiler/ilds.m +++ /dev/null @@ -1,641 +0,0 @@ -%-----------------------------------------------------------------------------% -% vim: ft=mercury ts=4 sw=4 et -%-----------------------------------------------------------------------------% -% Copyright (C) 1999-2006, 2010-2011 The University of Melbourne. -% This file may only be copied under the terms of the GNU General -% Public License - see the file COPYING in the Mercury distribution. -%-----------------------------------------------------------------------------% -% -% File: ilds.m. -% Main author: trd. -% -% ilds - The IL instruction set. -% -% The IL instruction set is documented in the Microsoft .NET Framework SDK. -% -% See -% -% for more info, including a downloadable (Windows only) version of the -% SDK available here: -% -% -%-----------------------------------------------------------------------------% - -:- module ml_backend.ilds. -:- interface. - -:- import_module assoc_list. -:- import_module bool. -:- import_module list. -:- import_module maybe. - -%-----------------------------------------------------------------------------% - - % Returns the maximum stack usage of a list of IL instructions. - % -:- func calculate_max_stack(list(ilds.instr)) = int. - - % A method parameter. - % -:- type il_method_param - ---> il_method_param( - ilmp_type :: il_type, - % The type of the parameter. - ilmp_maybe_id :: maybe(ilds.id) - % The name of the parameter (if any). - ). - - % A method signature. - % -:- type signature - ---> signature( - call_conv, % calling convention - ret_type, % return type - list(il_method_param) % parameters - ). - - % A method reference. - % -:- type methodref - ---> methoddef( - call_conv, - ret_type, - class_member_name, - list(il_type) - ) -% ; methodref( -% call_conv, -% ret_type, -% class_name, -% list(il_type) -% ) - ; local_method( - call_conv, - ret_type, - member_name, - list(il_type) - ). - - % A field reference. - % -:- type fieldref - ---> fieldref(il_type, class_member_name). - -%-----------------------------------------------------------------------------% - - % If an assembly name is empty it is a reference to a local type - % in the same assembly. - % -:- type structured_name - ---> structured_name( - assembly_name, % The name of the assembly. - - namespace_qual_name, % The name of the top-level class - % (i.e. the namespace name - % and the outermost class name), - % or just the namespace name, - % if this structured_name is - % a namespace. - - nested_class_name % The name of the nested class - % within the top-level class, - % or the empty list if it is - % not a nested class. - ). - - % If we are referencing a sub-module, then we need to record two names. - % One is the sub-module name, which is used for references from the parent - % module, and the other is the assembly name for when the name is - % referenced from anywhere else. - % -:- type assembly_name - ---> module( - il_module_name :: ilds.id, - containing_assembly_name :: ilds.id - - ) - ; assembly( - ilds.id - ). - -:- type namespace_qual_name == list(ilds.id). -:- type nested_class_name == list(ilds.id). - - % An assembly- and namespace-qualified class name is a structured name. - % E.g. the ILASM name [Foo]Bar1.Bar2.Baz1/Baz2/Quux is - % structured_name("Foo", ["Bar1", "Bar2", "Baz1"], ["Baz2", "Quux"]). - % "[Foo]" is the assembly qualifier, - % "Bar1.Bar2." is the namespace qualiifer, - % "Baz1/Baz2/" is a class qualifier, - % and "Quux" is the name of the nested class. - % -:- type class_name == structured_name. - - % A assembly-qualified namespace name is a structured name. - % e.g. the ILASM name [Foo]Bar1.Bar2 is - % structured_name("Foo", ["Bar1", "Bar2"], []). - % -:- type namespace_name == structured_name. - - % A member of a class. - % -:- type class_member_name - ---> class_member_name( - class_name, - member_name - ). - - % The name of a member (method, field, event or property). - % -:- type member_name - ---> ctor % Constructor (initializes instances - % of this class). - - ; cctor % Class constructor (initializes - % non-instance fields). - - ; id(ilds.id). % Ordinary method or field name. - - % Calling conventions. - % -:- type call_conv - ---> call_conv( - bool, % Is this an instance method call? - il_call_kind % What kind of call is it? - ). - -:- type il_call_kind - ---> default - ; vararg - ; unmanaged_cdecl - ; unmanaged_stdcall - ; unmanaged_thiscall - ; unmanaged_fastcall. - - % XXX types have changed significantly in the spec since this - % was written, we should update this section (indeed, we should - % update all of ilds.m and ilasm.m). - - % Return types. - % -:- type ret_type - ---> void - ; simple_type(simple_type). - -:- type il_type - ---> il_type(list(ilds.type_modifier), simple_type). - -:- type ilds.type_modifier - ---> const - ; readonly - ; volatile. - -:- type simple_type - ---> int8 - ; int16 - ; int32 - ; int64 - ; uint8 - ; uint16 - ; uint32 - ; uint64 - ; native_int - ; native_uint % Also used for unmanaged pointers. - ; float32 - ; float64 - ; native_float - ; bool - ; char % A unicode character. - ; object - ; string - ; refany % A reference to value with an attached type. - ; class(class_name) - ; valuetype(class_name) - ; interface(class_name) - ; '[]'(il_type, bounds) % An array. - ; '&'(il_type) % A managed pointer. - ; '*'(il_type). % A transient pointer (could become - % managed or unmanaged depending on - % usage). - -:- type bounds == list(bound). - -:- type bound - ---> upper(int) % 0 <= index <= int - ; lower(int) % int <= index <= maxint - ; between(int, int). % int <= index <= int2 - - % An ID must start with "<", "_" or an alphabetic character. - % This initial character can be followed by any number of alphabetic - % characters, decimal digits, ">", "<", or "_". - % -:- type ilds.id == string. - - % XXX Should really limit this, but we don't really support - % the alignment instruction just yet. -:- type alignment == int. - -:- type constant - ---> i(int) - ; f(float). - -:- type overflow - ---> checkoverflow - ; nocheckoverflow. - -:- type signed - ---> signed - ; unsigned. % or unordered for comparisons - - % A variable (local or argument) can be referred to by name or index - % -:- type variable - ---> name(ilds.id) - ; index(index). - -:- type index == int. - -:- type target - ---> offset_target(int) - ; label_target(label). - - % Local variables, they all have names. - % This should probably be the same as params. - % -:- type locals == assoc_list(ilds.id, il_type). - - % Blocks can be just scope for locals, can surround a block of - % handwritten code, or can introduce try or catch code. - % -:- type blocktype - ---> bt_scope(locals) - % scope just introduces a scope for local variables - ; bt_try - ; bt_catch(class_name). - - % Each block has a unique identifier (mainly so you can tell which - % ones match up without counting them). - % XXX Should probably use counter type instead. -:- type blockid == int. - -:- type instr - % NOT INSTRUCTIONS AT ALL - % These are just added to the IL instructions to make it easy to - % generate instructions and include debugging information. - - ---> comment(string) - ; label(label) % a label - ; start_block(blocktype, blockid) % new block - ; end_block(blocktype, blockid) % end block - ; context(string, int) % context of following code - % (filename, line) - - ; il_asm_code(string, int) % a slab of handwritten - % IL assembler (with - % max stack size) - - % BASE INSTRUCTIONS - - ; add(overflow, signed) % add numeric values - ; bitwise_and % bitwise and - ; arglist % return arglist handle for current meth - ; beq(target) % branch to target if equal - ; bge(signed, target) % branch to target if >= - ; bgt(signed, target) % branch to target if > - ; ble(signed, target) % branch to target if <= - ; blt(signed, target) % branch to target if < - ; bne(signed, target) % branch to target if != - ; br(target) % branch to target - ; break % inform debugger breakpoint reached - ; brfalse(target) % branch to target if value is zero - ; brtrue(target) % branch to target if value is non-zero - ; call(methodref) % call method described by methodref - ; calli(signature) % call method indicated on stack using - % args described by the signature - ; ceq % compare equal: push 1 if value1 - % equals value2 - ; cgt(signed) % compare >: push 1 if value1 > value2 - ; ckfinite % throw ArithmeticException if value - % not finite - ; clt(signed) % compare <: push 1 if value1 < value2 - ; conv(simple_type) % convert value to data type - ; cpblk % copy data from memory to memory - ; div(signed) % divide values - ; dup % duplicate the value on the top - % of the stack - ; endfilter % end filter clause of SEH exception - % handling - ; endfinally % end finally clause of an exception block - ; initblk % initialize a block - ; jmp(methodref) % jump to a specified method - ; ldarg(variable) % load argument onto the stack - ; ldarga(variable) % fetch address of argument - ; ldc(simple_type, constant) - % load a numeric constant - ; ldftn(methodref) % push a pointer to a method - ; ldind(simple_type) % indirect load a value onto the stack - ; ldloc(variable) % load a local variable onto the stack - ; ldloca(variable) % load a local variable address - ; ldnull % push a null GC reference onto stack - ; leave(target) % exit a protected region of code - ; localloc % allocate space from local pool - ; mul(overflow, signed) % multiply values - ; neg % negate value - ; nop % no operation - ; bitwise_not % bitwise negation - ; bitwise_or % bitwise or - ; pop % pop a value from the stack - ; rem(signed) % compute remainder - ; ret % return from method - ; shl % shift integer left - ; shr(signed) % shift integer right - ; starg(variable) % store a value in argument slot - ; stind(simple_type) % store indirect at address from stack - ; stloc(variable) % pop value from stack to local var - ; sub(overflow, signed) % subtract value2 from value1 - ; switch(list(target)) % table switch on value - ; tailcall % remove frame before following call - ; unaligned(alignment) % subsequent pointer not aligned - ; volatile % subsequent pointer ref is volatile - ; bitwise_xor % bitwise XOR of integer values - - % OBJECT MODEL INSTRUCTIONS - - ; box(il_type) % convert pointer to reference - ; callvirt(methodref) % call a method associated with obj - ; castclass(il_type) % cast obj to class - ; cpobj(ilds.il_type) % copy a value type - ; initobj(il_type) % initialize a value type - ; isinst(il_type) % test if obj is an instance - ; ldelem(simple_type) % load an element of an array - ; ldelema(ilds.il_type) % load address of element of array - ; ldfld(fieldref) % load value of field of obj - ; ldflda(fieldref) % load field address of obj - ; ldlen % load length of array - ; ldobj(ilds.il_type) % copy value type to stack - ; ldsfld(fieldref) % load static field of a class - ; ldsflda(fieldref) % load static field address - ; ldstr(string) % load a literal string - ; ldtoken(signature) % load runtime rep of metadata token - ; ldvirtftn(methodref) % push a pointer to a virtual method - ; mkrefany(ilds.il_type) % push a refany pointer of type class - ; newarr(ilds.il_type) % create a zero based 1D array - ; newobj(methodref) % create new obj and call constructor - ; refanytype % extract type info from refany nth arg - ; refanyval(ilds.il_type) % extract type info from refany nth arg - ; rethrow % rethrow an exception - ; sizeof(ilds.il_type) % push the sizeof a value type - ; stelem(simple_type) % store an element of an array - ; stfld(fieldref) % store into a field of an object - ; stobj(ilds.il_type) - ; stsfld(fieldref) % replace the value of field with val - ; throw % throw an exception - ; unbox(ilds.il_type). % convert boxed value type to raw form - - % Locations marked as dead by ann_dead -- positive numbers are stack slots, - % negative numbers are locals. - % -:- type location == int. - - % Static single assignment nodes are generated, numbered from 0, - % by ann_def and ann_phi. - % -:- type node_number == int. - -:- type label == string. - -%----------------------------------------------------------------------------% -% -% Utility functions and predicates -% - - % Get the namespace portion of a class name. - % -:- func get_class_namespace(ilds.class_name) = ilds.namespace_qual_name. - - % Get the non-namespace portion of a class name. - % -:- func get_class_suffix(ilds.class_name) = list(ilds.id). - - % Add an extra identifier to the end of an IL namespace name, e.g. - % append Foo to [mercury]mercury.runtime to make - % [mercury]mercury.runtime.Foo - % -:- func append_toplevel_class_name(ilds.namespace_name, ilds.id) = - ilds.class_name. - - % Add an extra identifier to the end of an IL class name, e.g. - % append Bar to [mercury]mercury.runtime.Foo to make - % [mercury]mercury.runtime.Foo/Bar - % -:- func append_nested_class_name(ilds.class_name, ilds.nested_class_name) = - ilds.class_name. - -%-----------------------------------------------------------------------------% -%-----------------------------------------------------------------------------% - -:- implementation. - -:- import_module int. -:- import_module require. - -%-----------------------------------------------------------------------------% - -get_class_suffix(structured_name(_, OuterClassFullName, NestedClass)) - = SuffixName :- - ( - list.last(OuterClassFullName, Last) - -> - SuffixName = [Last | NestedClass] - ; - % This class has no name whatsoever. - unexpected($module, $pred, "class has no name") - ). - -get_class_namespace(structured_name(_, FullName, _)) = NamespaceName :- - ( - list.last(FullName, Last), - list.remove_suffix(FullName, [Last], NamespaceName0) - -> - NamespaceName0 = NamespaceName - ; - % This class has no name whatsoever. - unexpected($module, $pred, "class has no name") - ). - -append_toplevel_class_name(structured_name(Assembly, Namespace, NestedClass), - Class) = structured_name(Assembly, ClassName, []) :- - expect(unify(NestedClass, []), $module, $pred, - "namespace name has nested class?"), - list.append(Namespace, [Class], ClassName). - -append_nested_class_name(StructuredName0, ExtraNestedClasses) - = StructuredName :- - StructuredName0 = structured_name(Assembly, Class, NestedClasses), - StructuredName = structured_name(Assembly, Class, - NestedClasses ++ ExtraNestedClasses). - -calculate_max_stack(Instrs) = - calculate_max_stack_2(Instrs, 0, 0). - -:- func calculate_max_stack_2(list(ilds.instr), int, int) = int. - -calculate_max_stack_2([], _, Max) = Max. -calculate_max_stack_2([I | Instrs], Current, Max) = - calculate_max_stack_2(Instrs, NewCurrent, NewMax) :- - - % If there is handwritten code, it might increase the current stack height - % by its maximum, but it will then pop the stack leaving nothing on the - % stack (so Current remains the same). - ( I = il_asm_code(_, HandwrittenMax) -> - NewCurrent = Current, - NewMax = max(Current + HandwrittenMax, Max) - ; - NewCurrent = Current + get_stack_difference(I), - NewMax = max(NewCurrent, Max) - ), - % This is a sanity check, the stack should never have a negative size. - ( NewCurrent < 0 -> - unexpected($module, $pred, "stack underflow") - ; - true - ). - - % Return the difference in stack height after an instruction is executed. - % Stack height is measured in stack items (each item can be a different - % size in bits). - % -:- func get_stack_difference(ilds.instr) = int. - -get_stack_difference(end_block(_, _)) = 0. -get_stack_difference(comment(_)) = 0. -get_stack_difference(start_block(bt_scope(_), _)) = 0. -get_stack_difference(start_block(bt_try, _)) = 0. -get_stack_difference(start_block(bt_catch(_), _)) = 1. -get_stack_difference(context(_, _)) = 0. -get_stack_difference(label(_Label)) = 0. -get_stack_difference(il_asm_code(_, _)) = 0. - -get_stack_difference(add(_Overflow, _Signed)) = -1. -get_stack_difference(bitwise_and) = -1. -get_stack_difference(arglist) = 1. -get_stack_difference(beq(_)) = -2. -get_stack_difference(bge(_, _)) = -2. -get_stack_difference(bgt(_, _)) = -2. -get_stack_difference(ble(_, _)) = -2. -get_stack_difference(blt(_, _)) = -2. -get_stack_difference(bne(_, _)) = -2. -get_stack_difference(br(_)) = 0. -get_stack_difference(break) = 0. -get_stack_difference(brtrue(_)) = -1. -get_stack_difference(brfalse(_)) = -1. -get_stack_difference(call(MethodRef)) = get_call_stack_difference(MethodRef). -get_stack_difference(calli(Signature)) = get_calli_stack_difference(Signature). -get_stack_difference(callvirt(MethodRef)) = - get_call_stack_difference(MethodRef). -get_stack_difference(ceq) = -1. -get_stack_difference(cgt(_Signed)) = -1. -get_stack_difference(ckfinite) = 0. -get_stack_difference(clt(_Signed)) = -1. -get_stack_difference(conv(_SimpleType)) = 0. -get_stack_difference(cpblk) = -3. -get_stack_difference(div(_Signed)) = -1. -get_stack_difference(dup) = 1. -get_stack_difference(endfilter) = -1. -get_stack_difference(endfinally) = -1. -get_stack_difference(initblk) = -3. -get_stack_difference(jmp(_MethodRef)) = 0. -get_stack_difference(ldarg(_)) = 1. -get_stack_difference(ldarga(_Variable)) = 1. -get_stack_difference(ldc(_Type, _Const)) = 1. -get_stack_difference(ldftn(_MethodRef)) = 1. -get_stack_difference(ldind(_SimpleType)) = 0. -get_stack_difference(ldloc(_Variable)) = 1. -get_stack_difference(ldloca(_Variable)) = 1. -get_stack_difference(ldnull) = 1. -get_stack_difference(leave(_Target)) = 0. -get_stack_difference(localloc) = 0. -get_stack_difference(mul(_Overflow, _Signed)) = -1. -get_stack_difference(neg) = 0. -get_stack_difference(nop) = 0. -get_stack_difference(bitwise_not) = 0. -get_stack_difference(bitwise_or) = -1. -get_stack_difference(pop) = -1. -get_stack_difference(rem(_Signed)) = -1. -get_stack_difference(ret) = 0. -get_stack_difference(shl) = -1. -get_stack_difference(shr(_Signed)) = -1. -get_stack_difference(starg(_Variable)) = -1. -get_stack_difference(stind(_SimpleType)) = -2. -get_stack_difference(stloc(_Variable)) = -1. -get_stack_difference(sub(_OverFlow, _Signed)) = -1. -get_stack_difference(switch(_)) = -1. -get_stack_difference(tailcall) = 0. -get_stack_difference(unaligned(_)) = 0. -get_stack_difference(volatile) = 0. -get_stack_difference(bitwise_xor) = -1. - -get_stack_difference(box(_Type)) = 0. -get_stack_difference(castclass(_Type)) = 0. -get_stack_difference(cpobj(_Type)) = -2. -get_stack_difference(initobj(_Type)) = -1. -get_stack_difference(isinst(_Type)) = 0. -get_stack_difference(ldelem(_SimpleType)) = -1. -get_stack_difference(ldelema(_Type)) = -1. -get_stack_difference(ldfld(_FieldRef)) = 0. -get_stack_difference(ldflda(_FieldRef)) = 0. -get_stack_difference(ldlen) = 0. -get_stack_difference(ldobj(_Type)) = 0. -get_stack_difference(ldsfld(_FieldRef)) = 1. -get_stack_difference(ldsflda(_FieldRef)) = 1. -get_stack_difference(ldstr(_String)) = 1. -get_stack_difference(ldtoken(_)) = 1. -get_stack_difference(ldvirtftn(_MethodRef)) = 0. -get_stack_difference(mkrefany(_Type)) = 0. -get_stack_difference(newarr(_Type)) = 0. -get_stack_difference(newobj(methoddef(_, _, _, Params))) = Diff :- - Diff = -(length(Params)) + 1. -get_stack_difference(newobj(local_method(_, _, _, Params))) = Diff :- - Diff = -(length(Params)) + 1. -get_stack_difference(refanytype) = 0. -get_stack_difference(refanyval(_Type)) = 0. -get_stack_difference(rethrow) = 0. -get_stack_difference(sizeof(_Type)) = 1. -get_stack_difference(stelem(_SimpleType)) = -3. -get_stack_difference(stfld(_FieldRef)) = -2. -get_stack_difference(stobj(_ClassName)) = -2. -get_stack_difference(stsfld(_FieldRef)) = -1. -get_stack_difference(throw) = -1. -get_stack_difference(unbox(_Type)) = 0. - - % Count the stack size difference for a call. A call will remove the - % params, and remove "this" if it is an instance method, but will put - % the return type (if there is one) on the stack. - % -:- func get_call_stack_difference(methodref) = int. - -get_call_stack_difference(MethodRef) = Diff :- - ( - MethodRef = methoddef(CallConv, RetType, _, Params) - ; - MethodRef = local_method(CallConv, RetType, _, Params) - ), - InstanceDiff = ( CallConv = call_conv(yes, _) -> -1 ; 0 ), - RetDiff = ( RetType = void -> 0 ; 1), - Diff = -(length(Params)) + InstanceDiff + RetDiff. - - % A calli will remove the function pointer, the params, and remove "this" - % if it is an instance method, but puts the return type (if there is one) - % on the stack. - % -:- func get_calli_stack_difference(signature) = int. - -get_calli_stack_difference(signature(CallConv, RetType, Params)) = Diff :- - InstanceDiff = ( CallConv = call_conv(yes, _) -> -1 ; 0 ), - RetDiff = ( RetType = void -> 0 ; 1), - Diff = -(length(Params)) + InstanceDiff + RetDiff - 1. - -%-----------------------------------------------------------------------------% -:- end_module ml_backend.ilds. -%-----------------------------------------------------------------------------% diff --git a/compiler/int_emu.m b/compiler/int_emu.m index 5ddec5f69..855b6a39b 100644 --- a/compiler/int_emu.m +++ b/compiler/int_emu.m @@ -86,8 +86,7 @@ target_bits_per_int(Globals, bits_per_int(BitsPerInt)) :- Target = target_c, globals.lookup_int_option(Globals, bits_per_word, BitsPerInt) ; - ( Target = target_il - ; Target = target_csharp + ( Target = target_csharp ; Target = target_java ; Target = target_erlang ), diff --git a/compiler/intermod.m b/compiler/intermod.m index cfd335a99..1a73cb3f8 100644 --- a/compiler/intermod.m +++ b/compiler/intermod.m @@ -446,11 +446,6 @@ should_be_processed(ProcessLocalPreds, PredId, PredInfo, TypeSpecForcePreds, % Don't export non-inlinable predicates. not check_marker(Markers, marker_user_marked_no_inline), - % No point exporting code which isn't very inlinable. - module_info_get_globals(ModuleInfo, Globals), - globals.get_target(Globals, Target), - not clauses_contain_noninlinable_foreign_code(Target, Clauses), - % Don't export tabled predicates since they are not inlinable. proc_info_get_eval_method(ProcInfo, eval_normal), @@ -481,24 +476,6 @@ should_be_processed(ProcessLocalPreds, PredId, PredInfo, TypeSpecForcePreds, pred_info_is_promise(PredInfo, _) ). - % If the clauses contains foreign code which requires an external - % definition, there is not much point in exporting it. - % -:- pred clauses_contain_noninlinable_foreign_code(compilation_target::in, - list(clause)::in) is semidet. - -clauses_contain_noninlinable_foreign_code(Target, [Clause | Clauses]) :- - ( if - Target = target_il, - Lang = Clause ^ clause_lang, - Lang = impl_lang_foreign(ForeignLang), - ForeignLang = lang_csharp - then - true - else - clauses_contain_noninlinable_foreign_code(Target, Clauses) - ). - :- pred intermod_traverse_clauses(list(clause)::in, list(clause)::out, bool::out, intermod_info::in, intermod_info::out) is det. @@ -1220,8 +1197,8 @@ gather_types_acc(TypeCtor, TypeDefn0, !Info) :- resolve_foreign_type_body_overloading(ModuleInfo, TypeCtor, ForeignTypeBody0, ForeignTypeBody, !Info) :- - ForeignTypeBody0 = foreign_type_body(MaybeIL0, MaybeC0, MaybeJava0, - MaybeCSharp0, MaybeErlang0), + ForeignTypeBody0 = foreign_type_body(MaybeC0, MaybeJava0, MaybeCSharp0, + MaybeErlang0), module_info_get_globals(ModuleInfo, Globals), globals.get_target(Globals, Target), @@ -1239,31 +1216,17 @@ resolve_foreign_type_body_overloading(ModuleInfo, TypeCtor, resolve_foreign_type_body_overloading_2(ModuleInfo, TypeCtor, MaybeC0, MaybeC, !Info) ; - ( Target = target_il - ; Target = target_csharp + ( Target = target_csharp ; Target = target_java ), MaybeC = MaybeC0 ), - ( - Target = target_il, - resolve_foreign_type_body_overloading_2(ModuleInfo, TypeCtor, - MaybeIL0, MaybeIL, !Info) - ; - ( Target = target_c - ; Target = target_csharp - ; Target = target_java - ; Target = target_erlang - ), - MaybeIL = MaybeIL0 - ), ( Target = target_csharp, resolve_foreign_type_body_overloading_2(ModuleInfo, TypeCtor, MaybeCSharp0, MaybeCSharp, !Info) ; ( Target = target_c - ; Target = target_il ; Target = target_java ; Target = target_erlang ), @@ -1275,7 +1238,6 @@ resolve_foreign_type_body_overloading(ModuleInfo, TypeCtor, MaybeJava0, MaybeJava, !Info) ; ( Target = target_c - ; Target = target_il ; Target = target_csharp ; Target = target_erlang ), @@ -1287,14 +1249,13 @@ resolve_foreign_type_body_overloading(ModuleInfo, TypeCtor, MaybeErlang0, MaybeErlang, !Info) ; ( Target = target_c - ; Target = target_il ; Target = target_csharp ; Target = target_java ), MaybeErlang = MaybeErlang0 ), - ForeignTypeBody = foreign_type_body(MaybeIL, MaybeC, MaybeJava, - MaybeCSharp, MaybeErlang). + ForeignTypeBody = foreign_type_body(MaybeC, MaybeJava, MaybeCSharp, + MaybeErlang). :- pred resolve_foreign_type_body_overloading_2(module_info::in, type_ctor::in, foreign_type_lang_body(T)::in, foreign_type_lang_body(T)::out, @@ -1539,22 +1500,9 @@ intermod_write_type(OutInfo, TypeCtor - TypeDefn, !IO) :- ( Body = hlds_foreign_type(ForeignTypeBody) ; Body ^ du_type_is_foreign_type = yes(ForeignTypeBody) ), - ForeignTypeBody = foreign_type_body(MaybeIL, MaybeC, MaybeJava, + ForeignTypeBody = foreign_type_body(MaybeC, MaybeJava, MaybeCSharp, MaybeErlang) then - ( - MaybeIL = yes(DataIL), - DataIL = foreign_type_lang_data(ILForeignType, ILMaybeUserEqComp, - AssertionsIL), - ILItemTypeDefn = item_type_defn_info(Name, Args, - parse_tree_foreign_type(il(ILForeignType), - ILMaybeUserEqComp, AssertionsIL), - VarSet, Context, -1), - ILItem = item_type_defn(ILItemTypeDefn), - mercury_output_item(MercInfo, ILItem, !IO) - ; - MaybeIL = no - ), ( MaybeC = yes(DataC), DataC = foreign_type_lang_data(CForeignType, diff --git a/compiler/lambda.m b/compiler/lambda.m index b939cd4d4..dfc607c01 100644 --- a/compiler/lambda.m +++ b/compiler/lambda.m @@ -523,7 +523,6 @@ expand_lambda(Purity, _Groundness, PredOrFunc, EvalMethod, RegWrapperProc, globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode), ( ( Target = target_c - ; Target = target_il ; Target = target_csharp ; Target = target_java ), diff --git a/compiler/llds_out_file.m b/compiler/llds_out_file.m index 5ff970174..6210f45c3 100644 --- a/compiler/llds_out_file.m +++ b/compiler/llds_out_file.m @@ -882,7 +882,6 @@ output_foreign_body_code(Info, ForeignBodyCode, !IO) :- ; ( Lang = lang_java ; Lang = lang_csharp - ; Lang = lang_il ; Lang = lang_erlang ), unexpected($module, $pred, @@ -915,7 +914,6 @@ output_foreign_header_include_line(Info, Decl, !AlreadyDone, !IO) :- ; ( Lang = lang_java ; Lang = lang_csharp - ; Lang = lang_il ; Lang = lang_erlang ), unexpected($module, $pred, diff --git a/compiler/make.dependencies.m b/compiler/make.dependencies.m index 11292adab..e99ced625 100644 --- a/compiler/make.dependencies.m +++ b/compiler/make.dependencies.m @@ -418,12 +418,6 @@ target_dependencies(Globals, module_target_c_header(_)) = target_dependencies(Globals, module_target_c_code). target_dependencies(Globals, module_target_c_code) = compiled_code_dependencies(Globals). -target_dependencies(Globals, module_target_il_code) = - compiled_code_dependencies(Globals). -target_dependencies(_, module_target_il_asm) = - combine_deps_list([ - module_target_il_code `of` self - ]). target_dependencies(Globals, module_target_csharp_code) = compiled_code_dependencies(Globals). target_dependencies(Globals, module_target_java_code) = @@ -484,18 +478,6 @@ target_dependencies(_, module_target_analysis_registry) = module_target_intermodule_interface `of` indirect_imports, module_target_intermodule_interface `of` intermod_imports ]). -target_dependencies(_, module_target_foreign_il_asm(_)) = - combine_deps_list([ - module_target_il_asm `of` self, - module_target_il_asm `of` - filter_module_names(maybe_keep_std_lib_module, direct_imports), - module_target_il_asm `of` - filter_module_names(maybe_keep_std_lib_module, - foreign_imports_lang(lang_il)), - module_target_foreign_il_asm(lang_csharp) `of` - filter_module_names(maybe_keep_std_lib_module, - foreign_imports_lang(lang_csharp)) - ]). target_dependencies(Globals, module_target_foreign_object(PIC, _)) = get_foreign_deps(Globals, PIC). target_dependencies(Globals, module_target_fact_table_object(PIC, _)) = diff --git a/compiler/make.m b/compiler/make.m index e1baa8d50..965034b38 100644 --- a/compiler/make.m +++ b/compiler/make.m @@ -226,8 +226,6 @@ ; module_target_track_flags ; module_target_c_header(c_header_type) ; module_target_c_code - ; module_target_il_code - ; module_target_il_asm ; module_target_csharp_code ; module_target_java_code ; module_target_java_class_code @@ -235,7 +233,6 @@ ; module_target_erlang_code ; module_target_erlang_beam_code ; module_target_object_code(pic) - ; module_target_foreign_il_asm(foreign_language) ; module_target_foreign_object(pic, foreign_language) ; module_target_fact_table_object(pic, file_name) ; module_target_xml_doc. @@ -577,9 +574,7 @@ search_backwards_for_dot(String, Index, DotIndex) :- get_executable_type(Globals) = ExecutableType :- globals.get_target(Globals, CompilationTarget), ( - ( CompilationTarget = target_c - ; CompilationTarget = target_il - ), + CompilationTarget = target_c, ExecutableType = executable ; CompilationTarget = target_csharp, diff --git a/compiler/make.module_target.m b/compiler/make.module_target.m index c07627a1d..3aa020834 100644 --- a/compiler/make.module_target.m +++ b/compiler/make.module_target.m @@ -258,23 +258,8 @@ make_module_target_file_extra_options(ExtraOptions, Globals, TargetFile, Succeeded = yes ; Status = deps_status_being_built, - ( - TargetFile = target_file(_FileName, FileType), - FileType = module_target_foreign_il_asm(_Lang) - -> - io.write_string("Error: circular dependency detected " ++ - "while building\n", !IO), - io.write_string(" `", !IO), - make_write_dependency_file(Globals, Dep, !IO), - io.write_string("'.\n", !IO), - io.write_string(" This is due to a forbidden " ++ - "foreign_import_module cycle.\n", !IO), - io.set_exit_status(1, !IO) - ; - unexpected($module, $pred, - "target being built, circular dependencies?") - ), - Succeeded = no + unexpected($module, $pred, + "target being built, circular dependencies?") ; Status = deps_status_error, Succeeded = no @@ -530,7 +515,7 @@ build_target_2(ModuleName, Task, ArgFileName, Imports, Globals, AllOptionArgs, pic::in, io.output_stream::in, module_and_imports::in, bool::out, io::di, io::uo) is det. -build_object_code(Globals, ModuleName, Target, PIC, ErrorStream, Imports, +build_object_code(Globals, ModuleName, Target, PIC, ErrorStream, _Imports, Succeeded, !IO) :- ( Target = target_c, @@ -546,10 +531,6 @@ build_object_code(Globals, ModuleName, Target, PIC, ErrorStream, Imports, CsharpFile, !IO), compile_target_code.link(Globals, ErrorStream, csharp_library, ModuleName, [CsharpFile], Succeeded, !IO) - ; - Target = target_il, - il_assemble(Globals, ErrorStream, ModuleName, Imports ^ mai_has_main, - Succeeded, !IO) ; Target = target_erlang, module_name_to_file_name(Globals, ModuleName, ".erl", do_create_dirs, @@ -567,10 +548,6 @@ compile_foreign_code_file(Globals, ErrorStream, PIC, Imports, ForeignCodeFile, ForeignCodeFile = foreign_code_file(lang_c, CFile, ObjFile), do_compile_c_file(Globals, ErrorStream, PIC, CFile, ObjFile, Succeeded, !IO) - ; - ForeignCodeFile = foreign_code_file(lang_il, ILFile, DLLFile), - do_il_assemble(Globals, ErrorStream, ILFile, DLLFile, no_main, - Succeeded, !IO) ; ForeignCodeFile = foreign_code_file(lang_java, JavaFile, _ClassFile), compile_java_files(Globals, ErrorStream, [JavaFile], Succeeded, !IO) @@ -636,9 +613,6 @@ get_object_extension(Globals, PIC) = Ext :- ( CompilationTarget = target_c, maybe_pic_object_file_extension(Globals, PIC, Ext) - ; - CompilationTarget = target_il, - Ext = ".dll" ; CompilationTarget = target_csharp, sorry($module, $pred, "object extension for csharp") @@ -855,10 +829,6 @@ compilation_task(Globals, module_target_c_header(_)) = compilation_task(Globals, module_target_c_code). compilation_task(_, module_target_c_code) = process_module(task_compile_to_target_code) - ["--compile-to-c"]. -compilation_task(_, module_target_il_code) = - process_module(task_compile_to_target_code) - ["--il-only"]. -compilation_task(_, module_target_il_asm) = - target_code_to_object_code(non_pic) - []. compilation_task(_, module_target_csharp_code) = process_module(task_compile_to_target_code) - ["--csharp-only"]. compilation_task(_, module_target_java_code) = @@ -873,8 +843,6 @@ compilation_task(_, module_target_erlang_beam_code) = target_code_to_object_code(non_pic) - []. compilation_task(_, module_target_object_code(PIC)) = target_code_to_object_code(PIC) - get_pic_flags(PIC). -compilation_task(_, module_target_foreign_il_asm(Lang)) = - foreign_code_to_object_code(non_pic, Lang) - []. compilation_task(_, module_target_foreign_object(PIC, Lang)) = foreign_code_to_object_code(PIC, Lang) - get_pic_flags(PIC). compilation_task(_, module_target_fact_table_object(PIC, FactTable)) = @@ -990,8 +958,7 @@ touched_files_process_module(Globals, TargetFile, Task, TouchedTargetFiles, HeaderTargets0 = [] ) ; - ( CompilationTarget = target_il - ; CompilationTarget = target_csharp + ( CompilationTarget = target_csharp ; CompilationTarget = target_java ), HeaderTargets0 = [] @@ -1010,8 +977,7 @@ touched_files_process_module(Globals, TargetFile, Task, TouchedTargetFiles, make_target_file_list(Names, module_target_c_header(header_mh)) ++ HeaderTargets0 ; - ( CompilationTarget = target_il - ; CompilationTarget = target_csharp + ( CompilationTarget = target_csharp ; CompilationTarget = target_java ; CompilationTarget = target_erlang ), @@ -1065,16 +1031,10 @@ external_foreign_code_files(Globals, PIC, Imports, ForeignFiles, !IO) :- maybe_pic_object_file_extension(Globals, PIC, ObjExt), globals.get_target(Globals, CompilationTarget), ModuleName = Imports ^ mai_module_name, - ( - CompilationTarget = target_il, - Imports ^ mai_has_foreign_code = contains_foreign_code(Langs) - -> - list.map_foldl(external_foreign_code_files_for_il(Globals, ModuleName), - set.to_sorted_list(Langs), ForeignFilesList, !IO), - list.condense(ForeignFilesList, ForeignFiles0) - ; - ForeignFiles0 = [] - ), + + % None of the current backends require estnerally compiled foreign + % code. + ForeignFiles0 = [], % Find externally compiled foreign code files for fact tables. ( @@ -1093,33 +1053,11 @@ external_foreign_code_files(Globals, PIC, Imports, ForeignFiles, !IO) :- ; ( CompilationTarget = target_java ; CompilationTarget = target_csharp - ; CompilationTarget = target_il ; CompilationTarget = target_erlang ), ForeignFiles = ForeignFiles0 ). -:- pred external_foreign_code_files_for_il(globals::in, module_name::in, - foreign_language::in, list(foreign_code_file)::out, - io::di, io::uo) is det. - -external_foreign_code_files_for_il(Globals, ModuleName, Language, ForeignFiles, - !IO) :- - ( - ForeignModuleName = foreign_language_module_name(ModuleName, Language), - ForeignExt = foreign_language_file_extension(Language) - -> - module_name_to_file_name(Globals, ForeignModuleName, ForeignExt, - do_create_dirs, ForeignFileName, !IO), - module_name_to_file_name(Globals, ForeignModuleName, ".dll", - do_create_dirs, ForeignDLLFileName, !IO), - ForeignFiles = [foreign_code_file(Language, ForeignFileName, - ForeignDLLFileName)] - ; - % No external file is generated for this foreign language. - ForeignFiles = [] - ). - :- func target_type_to_pic(module_target_type) = pic. target_type_to_pic(TargetType) = Result :- @@ -1138,15 +1076,12 @@ target_type_to_pic(TargetType) = Result :- ; TargetType = module_target_track_flags ; TargetType = module_target_c_header(_) ; TargetType = module_target_c_code - ; TargetType = module_target_il_code - ; TargetType = module_target_il_asm ; TargetType = module_target_csharp_code ; TargetType = module_target_java_code ; TargetType = module_target_java_class_code ; TargetType = module_target_erlang_header ; TargetType = module_target_erlang_code ; TargetType = module_target_erlang_beam_code - ; TargetType = module_target_foreign_il_asm(_) ; TargetType = module_target_foreign_object(_, _) ; TargetType = module_target_fact_table_object(_, _) ; TargetType = module_target_xml_doc diff --git a/compiler/make.program_target.m b/compiler/make.program_target.m index 905e7fe41..0d95a40d3 100644 --- a/compiler/make.program_target.m +++ b/compiler/make.program_target.m @@ -164,10 +164,6 @@ make_linked_target_2(LinkedTargetFile, Globals, _, Succeeded, !Info, !IO) :- CompilationTarget = target_c, IntermediateTargetType = module_target_c_code, ObjectTargetType = module_target_object_code(PIC) - ; - CompilationTarget = target_il, - IntermediateTargetType = module_target_il_code, - ObjectTargetType = module_target_il_asm ; CompilationTarget = target_csharp, IntermediateTargetType = module_target_csharp_code, @@ -368,17 +364,9 @@ get_foreign_object_targets(Globals, PIC, ModuleName, ObjectTargets, MaybeImports = no, unexpected($module, $pred, "unknown imports") ), - ( - CompilationTarget = target_il, - Imports ^ mai_has_foreign_code = contains_foreign_code(Langs) - -> - ForeignObjectTargets = list.map( - (func(L) = dep_target(target_file(ModuleName, - module_target_foreign_il_asm(L))) - ), set.to_sorted_list(Langs)) - ; - ForeignObjectTargets = [] - ), + + % XXX only used by the IL backend. + ForeignObjectTargets = [], % Find out if any externally compiled foreign code files for fact tables % exist. @@ -394,7 +382,6 @@ get_foreign_object_targets(Globals, PIC, ModuleName, ObjectTargets, ; ( CompilationTarget = target_java ; CompilationTarget = target_csharp - ; CompilationTarget = target_il ; CompilationTarget = target_erlang ), ObjectTargets = ForeignObjectTargets @@ -582,9 +569,6 @@ build_linked_target_2(Globals, MainModuleName, FileType, OutputFileName, CompilationTarget = target_c, maybe_pic_object_file_extension(NoLinkObjsGlobals, PIC, ObjExtToUse) - ; - CompilationTarget = target_il, - ObjExtToUse = ".dll" ; CompilationTarget = target_csharp, % There is no separate object code step. @@ -619,9 +603,6 @@ build_linked_target_2(Globals, MainModuleName, FileType, OutputFileName, compile_target_code.link(NoLinkObjsGlobals, ErrorStream, FileType, MainModuleName, AllObjects), Succeeded, !IO) - ; - CompilationTarget = target_il, - Succeeded = yes ), !Info ^ command_line_targets := set.delete(!.Info ^ command_line_targets, @@ -1229,9 +1210,6 @@ build_library(MainModuleName, AllModules, Globals, Succeeded, !Info, !IO) :- Target = target_c, build_c_library(Globals, MainModuleName, AllModules, Succeeded, !Info, !IO) - ; - Target = target_il, - sorry($module, $pred, "target IL not supported yet") ; Target = target_csharp, build_csharp_library(Globals, MainModuleName, Succeeded, !Info, !IO) @@ -1418,7 +1396,6 @@ install_ints_and_headers(Globals, SubdirLinkSucceeded, ModuleName, Succeeded, ; ( Target = target_java ; Target = target_csharp - ; Target = target_il ), HeaderSucceeded = yes ), @@ -2002,7 +1979,6 @@ make_module_clean(Globals, ModuleName, !Info, !IO) :- [module_target_errors, module_target_c_code, module_target_c_header(header_mih), - module_target_il_code, module_target_csharp_code, module_target_java_code, module_target_java_class_code, @@ -2051,14 +2027,7 @@ make_module_clean(Globals, ModuleName, !Info, !IO) :- !Info, !IO) ), FactTableFiles, !Info, !IO) ), - [pic, link_with_pic, non_pic], !Info, !IO), - - % Remove IL foreign code files. - CSharpModule = foreign_language_module_name(ModuleName, lang_csharp), - make_remove_module_file(Globals, very_verbose, CSharpModule, - foreign_language_file_extension(lang_csharp), !Info, !IO), - make_remove_target_file_by_name(Globals, very_verbose, CSharpModule, - module_target_foreign_il_asm(lang_csharp), !Info, !IO). + [pic, link_with_pic, non_pic], !Info, !IO). :- pred make_module_realclean(globals::in, module_name::in, make_info::in, make_info::out, io::di, io::uo) is det. diff --git a/compiler/make.util.m b/compiler/make.util.m index b78f6db44..94bf0a451 100644 --- a/compiler/make.util.m +++ b/compiler/make.util.m @@ -1468,10 +1468,8 @@ target_extension(_, module_target_track_flags) = yes(".track_flags"). target_extension(_, module_target_c_header(header_mih)) = yes(".mih"). target_extension(_, module_target_c_header(header_mh)) = yes(".mh"). target_extension(_, module_target_c_code) = yes(".c"). -target_extension(_, module_target_il_code) = yes(".il"). % XXX ".exe" if the module contains main. -target_extension(_, module_target_il_asm) = yes(".dll"). target_extension(_, module_target_csharp_code) = yes(".cs"). target_extension(_, module_target_java_code) = yes(".java"). target_extension(_, module_target_java_class_code) = yes(".class"). @@ -1484,7 +1482,6 @@ target_extension(_, module_target_xml_doc) = yes(".xml"). % These all need to be handled as special cases. target_extension(_, module_target_foreign_object(_, _)) = no. -target_extension(_, module_target_foreign_il_asm(_)) = no. target_extension(_, module_target_fact_table_object(_, _)) = no. % Currently the .cs extension is still treated as the build-all target for @@ -1583,18 +1580,6 @@ module_target_to_file_name_maybe_search(Globals, ModuleName, TargetType, ; unexpected($module, $pred, "object test failed") ) - ; - TargetType = module_target_foreign_il_asm(Lang), - ( - ForeignModuleName = - foreign_language_module_name(ModuleName, Lang) - -> - module_target_to_file_name_maybe_search(Globals, - ForeignModuleName, module_target_il_asm, MkDir, - Search, FileName, !IO) - ; - unexpected($module, $pred, "ilasm test failed") - ) ; TargetType = module_target_fact_table_object(PIC, FactFile), maybe_pic_object_file_extension(Globals, PIC, Ext), @@ -1608,8 +1593,6 @@ module_target_to_file_name_maybe_search(Globals, ModuleName, TargetType, ; TargetType = module_target_erlang_code ; TargetType = module_target_erlang_header ; TargetType = module_target_errors - ; TargetType = make.module_target_il_asm - ; TargetType = module_target_il_code ; TargetType = module_target_intermodule_interface ; TargetType = module_target_csharp_code ; TargetType = module_target_java_code @@ -1649,7 +1632,6 @@ timestamp_extension(_, module_target_analysis_registry) = ".analysis_date". timestamp_extension(_, module_target_c_code) = ".c_date". timestamp_extension(Globals, module_target_c_header(_)) = Ext :- Ext = timestamp_extension(Globals, module_target_c_code). -timestamp_extension(_, module_target_il_code) = ".il_date". timestamp_extension(_, module_target_csharp_code) = ".cs_date". timestamp_extension(_, module_target_java_code) = ".java_date". timestamp_extension(_, module_target_erlang_code) = ".erl_date". @@ -1674,8 +1656,6 @@ search_for_file_type(module_target_analysis_registry) = search_for_file_type(module_target_track_flags) = no. search_for_file_type(module_target_c_header(_)) = yes(c_include_directory). search_for_file_type(module_target_c_code) = no. -search_for_file_type(module_target_il_code) = no. -search_for_file_type(module_target_il_asm) = no. search_for_file_type(module_target_csharp_code) = no. search_for_file_type(module_target_java_code) = no. search_for_file_type(module_target_java_class_code) = no. @@ -1685,7 +1665,6 @@ search_for_file_type(module_target_erlang_code) = no. search_for_file_type(module_target_erlang_beam_code) = no. search_for_file_type(module_target_object_code(_)) = no. search_for_file_type(module_target_foreign_object(_, _)) = no. -search_for_file_type(module_target_foreign_il_asm(_)) = no. search_for_file_type(module_target_fact_table_object(_, _)) = no. search_for_file_type(module_target_xml_doc) = no. @@ -1712,8 +1691,6 @@ is_target_grade_or_arch_dependent(Target) = IsDependent :- ; Target = module_target_track_flags ; Target = module_target_c_header(header_mih) ; Target = module_target_c_code - ; Target = module_target_il_code - ; Target = module_target_il_asm ; Target = module_target_csharp_code ; Target = module_target_java_code ; Target = module_target_java_class_code @@ -1722,7 +1699,6 @@ is_target_grade_or_arch_dependent(Target) = IsDependent :- ; Target = module_target_erlang_header ; Target = module_target_object_code(_) ; Target = module_target_foreign_object(_, _) - ; Target = module_target_foreign_il_asm(_) ; Target = module_target_fact_table_object(_, _) ), IsDependent = yes @@ -1966,47 +1942,38 @@ module_target_type_to_nonce(Type) = X :- Type = module_target_c_code, X = 11 ; - Type = module_target_il_code, + Type = module_target_java_code, X = 12 ; - Type = module_target_il_asm, + Type = module_target_erlang_header, X = 13 ; - Type = module_target_java_code, + Type = module_target_erlang_code, X = 14 ; - Type = module_target_erlang_header, + Type = module_target_erlang_beam_code, X = 15 - ; - Type = module_target_erlang_code, - X = 16 - ; - Type = module_target_erlang_beam_code, - X = 17 ; Type = module_target_object_code(PIC), - X = 18 `mix` pic_to_nonce(PIC) - ; - Type = module_target_foreign_il_asm(_ForeignLang), - X = 19 + X = 16 `mix` pic_to_nonce(PIC) ; Type = module_target_foreign_object(_PIC, _ForeignLang), - X = 20 + X = 17 ; Type = module_target_fact_table_object(_PIC, _FileName), - X = 21 + X = 18 ; Type = module_target_xml_doc, - X = 22 + X = 19 ; Type = module_target_track_flags, - X = 23 + X = 20 ; Type = module_target_java_class_code, - X = 24 + X = 21 ; Type = module_target_csharp_code, - X = 25 + X = 22 ). :- func pic_to_nonce(pic) = int. diff --git a/compiler/make_hlds_warn.m b/compiler/make_hlds_warn.m index 92be788e9..73acceb11 100644 --- a/compiler/make_hlds_warn.m +++ b/compiler/make_hlds_warn.m @@ -715,8 +715,6 @@ check_fp_body_for_success_indicator(ModuleInfo, Lang, Context, SimpleCallId, ; Detism = detism_failure ) ) - ; - Lang = lang_il ) ; MaybeDeclDetism = no @@ -754,30 +752,6 @@ check_fp_body_for_return(Lang, Context, SimpleCallId, BodyPieces, !Specs) :- ; true ) - ; - Lang = lang_il, - ( - ( list.member("ret", BodyPieces) - ; list.member("jmp", BodyPieces) - ) - -> - Pieces = [ - words("Warning: the IL code for"), simple_call(SimpleCallId), - words("may contain a"), quote("ret"), - words("or"), quote("jmp"), - words("instruction."), nl - ], - Msg = simple_msg(Context, - [option_is_set(warn_suspicious_foreign_procs, yes, - [always(Pieces)])] - ), - Severity = severity_conditional( - warn_suspicious_foreign_procs, yes, severity_warning, no), - Spec = error_spec(Severity, phase_parse_tree_to_hlds, [Msg]), - !:Specs = [Spec | !.Specs] - ; - true - ) ; Lang = lang_erlang ). diff --git a/compiler/make_tags.m b/compiler/make_tags.m index ab73d9c27..cfefb589b 100644 --- a/compiler/make_tags.m +++ b/compiler/make_tags.m @@ -452,8 +452,7 @@ post_process_type_defns(!HLDS, Specs) :- Specs = [] ) ; - ( Target = target_il - ; Target = target_csharp + ( Target = target_csharp ; Target = target_java ; Target = target_erlang ), diff --git a/compiler/mercury_compile.m b/compiler/mercury_compile.m index 96573717d..863c9d647 100644 --- a/compiler/mercury_compile.m +++ b/compiler/mercury_compile.m @@ -602,8 +602,7 @@ do_mode_of_operation_standalone_interface(Globals, StandaloneIntBasename, !IO) :- globals.get_target(Globals, Target), ( - ( Target = target_il - ; Target = target_csharp + ( Target = target_csharp ; Target = target_java ), NotRequiredMsg = [ @@ -674,7 +673,6 @@ do_default_mode_of_operation(DetectedGradeFlags, OptionVariables, OptionArgs, ; ( Target = target_c ; Target = target_csharp - ; Target = target_il ; Target = target_erlang ), compile_with_module_options(Globals, MainModuleName, @@ -1559,7 +1557,6 @@ compile_with_module_options(Globals, ModuleName, DetectedGradeFlags, find_smart_recompilation_target_files(Globals, FindTargetFiles) :- globals.get_target(Globals, CompilationTarget), ( CompilationTarget = target_c, TargetSuffix = ".c" - ; CompilationTarget = target_il, TargetSuffix = ".il" ; CompilationTarget = target_csharp, TargetSuffix = ".cs" ; CompilationTarget = target_java, TargetSuffix = ".java" ; CompilationTarget = target_erlang, TargetSuffix = ".erl" @@ -1585,9 +1582,6 @@ find_timestamp_files(Globals, FindTimestampFiles) :- ( CompilationTarget = target_c, TimestampSuffix = ".c_date" - ; - CompilationTarget = target_il, - TimestampSuffix = ".il_date" ; CompilationTarget = target_csharp, TimestampSuffix = ".cs_date" @@ -1824,28 +1818,10 @@ mercury_compile_after_front_end(NestedSubModules, FindTimestampFiles, ; ( Target = target_java ; Target = target_csharp - ; Target = target_il ; Target = target_erlang ) ), ( - Target = target_il, - mlds_backend(!.HLDS, _, MLDS, !DumpInfo, !IO), - mlds_to_il_assembler(Globals, MLDS, TargetCodeSucceeded, !IO), - ( if - TargetCodeSucceeded = yes, - TargetCodeOnly = no - then - HasMain = mlds_has_main(MLDS), - io.output_stream(OutputStream, !IO), - il_assemble(Globals, OutputStream, ModuleName, HasMain, - Succeeded, !IO), - maybe_set_exit_status(Succeeded, !IO) - else - Succeeded = TargetCodeSucceeded - ), - ExtraObjFiles = [] - ; Target = target_csharp, mlds_backend(!.HLDS, _, MLDS, !DumpInfo, !IO), mlds_to_csharp(!.HLDS, MLDS, Succeeded, !IO), diff --git a/compiler/mercury_compile_llds_back_end.m b/compiler/mercury_compile_llds_back_end.m index a4d4fb898..bf52e0071 100644 --- a/compiler/mercury_compile_llds_back_end.m +++ b/compiler/mercury_compile_llds_back_end.m @@ -860,10 +860,6 @@ make_foreign_import_header_code(Globals, ForeignImportModule, Include, !IO) :- Lang = lang_csharp, sorry($module, $pred, ":- import_module not yet implemented: " ++ "`:- pragma foreign_import_module' for C#") - ; - Lang = lang_il, - sorry($module, $pred, ":- import_module not yet implemented: " ++ - "`:- pragma foreign_import_module' for IL") ; Lang = lang_java, sorry($module, $pred, ":- import_module not yet implemented: " ++ diff --git a/compiler/mercury_compile_middle_passes.m b/compiler/mercury_compile_middle_passes.m index 03a540a52..051adc4a5 100644 --- a/compiler/mercury_compile_middle_passes.m +++ b/compiler/mercury_compile_middle_passes.m @@ -1219,8 +1219,7 @@ maybe_control_granularity(Verbose, Stats, !HLDS, !IO) :- maybe_write_string(Verbose, "% done.\n", !IO), maybe_report_stats(Stats, !IO) ; - ( Target = target_il - ; Target = target_csharp + ( Target = target_csharp ; Target = target_java ; Target = target_erlang ) @@ -1265,8 +1264,7 @@ maybe_control_distance_granularity(Verbose, Stats, !HLDS, !IO) :- maybe_write_string(Verbose, "% done.\n", !IO), maybe_report_stats(Stats, !IO) ; - ( Target = target_il - ; Target = target_csharp + ( Target = target_csharp ; Target = target_java ; Target = target_erlang ) diff --git a/compiler/mercury_compile_mlds_back_end.m b/compiler/mercury_compile_mlds_back_end.m index b6d05f016..e569aa7ef 100644 --- a/compiler/mercury_compile_mlds_back_end.m +++ b/compiler/mercury_compile_mlds_back_end.m @@ -47,9 +47,6 @@ :- pred mlds_to_csharp(module_info::in, mlds::in, bool::out, io::di, io::uo) is det. -:- pred mlds_to_il_assembler(globals::in, mlds::in, bool::out, - io::di, io::uo) is det. - %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% @@ -71,7 +68,6 @@ :- import_module ml_backend.mlds_to_c. % MLDS -> C :- import_module ml_backend.mlds_to_java. % MLDS -> Java :- import_module ml_backend.mlds_to_cs. % MLDS -> C# -:- import_module ml_backend.mlds_to_ilasm. % MLDS -> IL assembler :- import_module ml_backend.ml_util. % MLDS utility predicates :- import_module parse_tree.error_util. :- import_module parse_tree.file_names. @@ -297,8 +293,7 @@ maybe_add_trail_ops(Verbose, Stats, !HLDS, !IO) :- % XXX Currently, we can only generate trail ops inline for % the C backends. % - ( Target = target_il - ; Target = target_csharp + ( Target = target_csharp ; Target = target_java ; Target = target_erlang ), @@ -404,15 +399,6 @@ mlds_to_csharp(HLDS, MLDS, Succeeded, !IO) :- maybe_write_string(Verbose, "% Finished converting MLDS to C#.\n", !IO), maybe_report_stats(Stats, !IO). -mlds_to_il_assembler(Globals, MLDS, Succeeded, !IO) :- - globals.lookup_bool_option(Globals, verbose, Verbose), - globals.lookup_bool_option(Globals, statistics, Stats), - - maybe_write_string(Verbose, "% Converting MLDS to IL...\n", !IO), - output_mlds_via_ilasm(Globals, MLDS, Succeeded, !IO), - maybe_write_string(Verbose, "% Finished converting MLDS to IL.\n", !IO), - maybe_report_stats(Stats, !IO). - %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% diff --git a/compiler/ml_backend.m b/compiler/ml_backend.m index 2c83d78e4..78d027bbc 100644 --- a/compiler/ml_backend.m +++ b/compiler/ml_backend.m @@ -72,14 +72,6 @@ % MLDS->C# back-end. :- include_module mlds_to_cs. -% MLDS->.NET CLR back-end -:- include_module il_peephole. -:- include_module ilasm. -:- include_module ilds. -:- include_module mlds_to_il. -:- include_module mlds_to_ilasm. -:- include_module mlds_to_managed. - :- implementation. :- import_module backend_libs. diff --git a/compiler/ml_closure_gen.m b/compiler/ml_closure_gen.m index 986d8757d..140176f5b 100644 --- a/compiler/ml_closure_gen.m +++ b/compiler/ml_closure_gen.m @@ -1123,9 +1123,9 @@ ml_gen_closure_wrapper_gc_decls(ClosureKind, ClosureArgName, ClosureArgType, ClosureKind = higher_order_proc_closure, ClosureLayoutPtrGCInitFragments = [ target_code_output(ClosureLayoutPtrLval), - raw_target_code(" = (MR_Box) ((MR_Closure *)\n", []), + raw_target_code(" = (MR_Box) ((MR_Closure *)\n"), target_code_input(ml_lval(ClosureArgLval)), - raw_target_code(")->MR_closure_layout;\n", []) + raw_target_code(")->MR_closure_layout;\n") ], ClosureLayoutPtrGCInit = statement(ml_stmt_atomic( inline_target_code(ml_target_c, @@ -1133,9 +1133,9 @@ ml_gen_closure_wrapper_gc_decls(ClosureKind, ClosureArgName, ClosureArgType, TypeParamsGCInitFragments = [ target_code_output(TypeParamsLval), raw_target_code(" = (MR_Box) " ++ - "MR_materialize_closure_type_params(\n", []), + "MR_materialize_closure_type_params(\n"), target_code_input(ml_lval(ClosureArgLval)), - raw_target_code(");\n", []) + raw_target_code(");\n") ] ; ClosureKind = typeclass_info_closure, @@ -1150,11 +1150,11 @@ ml_gen_closure_wrapper_gc_decls(ClosureKind, ClosureArgName, ClosureArgType, target_code_output(TypeParamsLval), raw_target_code(" = (MR_Box) " ++ "MR_materialize_typeclass_info_type_params(\n" - ++ "(MR_Word) ", []), + ++ "(MR_Word) "), target_code_input(ml_lval(ClosureArgLval)), - raw_target_code(", (MR_Closure_Layout *) ", []), + raw_target_code(", (MR_Closure_Layout *) "), target_code_input(ml_lval(ClosureLayoutPtrLval)), - raw_target_code(");\n", []) + raw_target_code(");\n") ] ; ClosureKind = special_pred_closure, diff --git a/compiler/ml_code_util.m b/compiler/ml_code_util.m index 08d71f4e5..7c3bb4b6d 100644 --- a/compiler/ml_code_util.m +++ b/compiler/ml_code_util.m @@ -1381,7 +1381,6 @@ ml_must_box_field_type(ModuleInfo, Type, Width) :- ( ( Target = target_c ; Target = target_csharp - ; Target = target_il ; Target = target_erlang ), classify_type(ModuleInfo, Type) = Category, @@ -1698,22 +1697,22 @@ ml_gen_local_for_output_arg(VarName, Type, ArgNum, Context, LocalVarDefn, GCStatement0 = gc_initialiser(CallTraceFuncCode) ), MakeTypeInfoCode = ml_stmt_atomic(inline_target_code(ml_target_c, [ - raw_target_code("{\n", []), - raw_target_code("MR_MemoryList allocated_mem = NULL;\n", []), + raw_target_code("{\n"), + raw_target_code("MR_MemoryList allocated_mem = NULL;\n"), target_code_output(TypeInfoLval), raw_target_code(" = (MR_C_Pointer) " ++ - "MR_make_type_info_maybe_existq(\n\t", []), + "MR_make_type_info_maybe_existq(\n\t"), target_code_input(ml_lval(TypeParamsLval)), - raw_target_code(", ((MR_Closure_Layout *)\n\t", []), + raw_target_code(", ((MR_Closure_Layout *)\n\t"), target_code_input(ml_lval(ClosureLayoutPtrLval)), raw_target_code(string.format(")->" ++ "MR_closure_arg_pseudo_type_info[%d - 1],\n\t" ++ "NULL, NULL, &allocated_mem);\n", - [i(ArgNum)]), []) + [i(ArgNum)])) ])), DeallocateCode = ml_stmt_atomic(inline_target_code(ml_target_c, [ - raw_target_code("MR_deallocate(allocated_mem);\n", []), - raw_target_code("}\n", []) + raw_target_code("MR_deallocate(allocated_mem);\n"), + raw_target_code("}\n") ])), GCTraceCode = ml_stmt_block([TypeInfoDecl], [ statement(MakeTypeInfoCode, MLDS_Context), diff --git a/compiler/ml_disj_gen.m b/compiler/ml_disj_gen.m index 8be3ec5a6..ac9ec789f 100644 --- a/compiler/ml_disj_gen.m +++ b/compiler/ml_disj_gen.m @@ -198,7 +198,6 @@ ml_gen_disj(Disjuncts, GoalInfo, CodeModel, Context, Statements, !Info) :- :- func allow_lookup_disj(compilation_target) = bool. allow_lookup_disj(target_c) = yes. -allow_lookup_disj(target_il) = no. allow_lookup_disj(target_csharp) = yes. allow_lookup_disj(target_java) = yes. allow_lookup_disj(target_erlang) = no. diff --git a/compiler/ml_elim_nested.m b/compiler/ml_elim_nested.m index 7cb7f4fb2..000a1b0af 100644 --- a/compiler/ml_elim_nested.m +++ b/compiler/ml_elim_nested.m @@ -1167,15 +1167,8 @@ ml_insert_init_env(Action, TypeName, ModuleName, Globals, Defn0, Defn, :- func ml_make_env_ptr_type(globals, mlds_type) = mlds_type. -ml_make_env_ptr_type(Globals, EnvType) = EnvPtrType :- - globals.lookup_bool_option(Globals, put_nondet_env_on_heap, OnHeap), - globals.get_target(Globals, Target), - ( if Target = target_il, OnHeap = yes then - % For IL, a class type is already a pointer (object reference). - EnvPtrType = EnvType - else - EnvPtrType = mlds_ptr_type(EnvType) - ). +ml_make_env_ptr_type(_Globals, EnvType) = EnvPtrType :- + EnvPtrType = mlds_ptr_type(EnvType). % Create the environment pointer and initialize it: % @@ -1919,8 +1912,8 @@ fixup_target_code_components(Action, Info, fixup_target_code_component(Action, Info, Component0, Component) :- ( - ( Component0 = raw_target_code(_Code, _Attrs) - ; Component0 = user_target_code(_Code, _Context, _Attrs) + ( Component0 = raw_target_code(_Code) + ; Component0 = user_target_code(_Code, _Context) ; Component0 = target_code_type(_Type) ; Component0 = target_code_name(_Name) ; Component0 = target_code_alloc_id(_AllocId) diff --git a/compiler/ml_foreign_proc_gen.m b/compiler/ml_foreign_proc_gen.m index 92dfd95d0..7dac25a79 100644 --- a/compiler/ml_foreign_proc_gen.m +++ b/compiler/ml_foreign_proc_gen.m @@ -144,11 +144,6 @@ ml_gen_ordinary_pragma_foreign_proc(CodeModel, Attributes, PredId, ProcId, ml_gen_ordinary_pragma_csharp_java_proc(ml_target_csharp, OrdinaryKind, Attributes, PredId, ProcId, Args, ExtraArgs, Foreign_Code, Context, Decls, Statements, !Info) - ; - Target = target_il, - ml_gen_ordinary_pragma_managed_proc(OrdinaryKind, Attributes, - PredId, ProcId, Args, ExtraArgs, - Foreign_Code, Context, Decls, Statements, !Info) ; ( Target = target_c ; Target = target_java @@ -157,12 +152,6 @@ ml_gen_ordinary_pragma_foreign_proc(CodeModel, Attributes, PredId, ProcId, unexpected($module, $pred, "C# foreign code not supported for compilation target") ) - ; - Lang = lang_il, - % XXX should pass OrdinaryKind - ml_gen_ordinary_pragma_il_proc(CodeModel, Attributes, - PredId, ProcId, Args, ExtraArgs, - Foreign_Code, Context, Decls, Statements, !Info) ; Lang = lang_java, ml_gen_ordinary_pragma_csharp_java_proc(ml_target_java, OrdinaryKind, @@ -227,29 +216,29 @@ ml_gen_ordinary_pragma_csharp_java_proc(TargetLang, OrdinaryKind, Attributes, BoolType = "bool" ), SucceededDecl = [ - raw_target_code("\t" ++ BoolType ++ " SUCCESS_INDICATOR;\n", [])], + raw_target_code("\t" ++ BoolType ++ " SUCCESS_INDICATOR;\n")], AssignSucceeded = [ - raw_target_code("\t", []), + raw_target_code("\t"), target_code_output(SucceededLval), - raw_target_code(" = SUCCESS_INDICATOR;\n", []) + raw_target_code(" = SUCCESS_INDICATOR;\n") ] ; OrdinaryKind = kind_failure, ml_success_lval(!.Info, SucceededLval), SucceededDecl = [], AssignSucceeded = [ - raw_target_code("\t", []), + raw_target_code("\t"), target_code_output(SucceededLval), - raw_target_code(" = false;\n", []) + raw_target_code(" = false;\n") ] ), Starting_Code = list.condense([ - [raw_target_code("{\n", [])], + [raw_target_code("{\n")], ArgDeclsList, SucceededDecl, AssignInputsList, - [user_target_code(JavaCode, yes(Context), [])] + [user_target_code(JavaCode, yes(Context))] ]), Starting_Code_Stmt = inline_target_code(TargetLang, Starting_Code), Starting_Code_Statement = statement(ml_stmt_atomic(Starting_Code_Stmt), @@ -257,7 +246,7 @@ ml_gen_ordinary_pragma_csharp_java_proc(TargetLang, OrdinaryKind, Attributes, Ending_Code = list.condense([ AssignSucceeded, - [raw_target_code("\t}\n", [])] + [raw_target_code("\t}\n")] ]), Ending_Code_Stmt = inline_target_code(TargetLang, Ending_Code), Ending_Code_Statement = statement(ml_stmt_atomic(Ending_Code_Stmt), @@ -367,170 +356,6 @@ ml_gen_outline_args([Arg | Args], [OutlineArg | OutlineArgs], !Info) :- OutlineArg = ola_unused ). -:- pred ml_gen_ordinary_pragma_il_proc(code_model::in, - pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in, - list(foreign_arg)::in, list(foreign_arg)::in, string::in, - prog_context::in, list(mlds_defn)::out, list(statement)::out, - ml_gen_info::in, ml_gen_info::out) is det. - -ml_gen_ordinary_pragma_il_proc(_CodeModel, Attributes, PredId, ProcId, - Args, ExtraArgs, ForeignCode, Context, Decls, Statements, !Info) :- - expect(unify(ExtraArgs, []), $module, $pred, "extra args"), - - % XXX FIXME need to handle model_semi code here, - % i.e. provide some equivalent to SUCCESS_INDICATOR. - - % XXX FIXME do we handle top_unused mode correctly? - - MLDSContext = mlds_make_context(Context), - - ml_gen_info_get_module_info(!.Info, ModuleInfo), - module_info_pred_proc_info(ModuleInfo, PredId, ProcId, - _PredInfo, ProcInfo), - proc_info_get_varset(ProcInfo, VarSet), -% proc_info_get_vartypes(ProcInfo, VarTypes), - % note that for headvars we must use the types from - % the procedure interface, not from the procedure body - ml_gen_info_get_byref_output_vars(!.Info, ByRefOutputVars), - ml_gen_info_get_value_output_vars(!.Info, CopiedOutputVars), - module_info_get_name(ModuleInfo, ModuleName), - MLDSModuleName = mercury_module_name_to_mlds(ModuleName), - - % XXX in the code to marshall parameters, fjh says: - % We need to handle the case where the types in the procedure interface - % are polymorphic, but the types of the vars in the `foreign_proc' HLDS - % goal are concrete instances of those types, which can happen when the - % procedure is inlined or specialized. The assignment that you - % generate here with ml_gen_assign won't be type-correct. In general - % you may need to box/unbox the arguments. - - build_arg_map(Args, map.init, ArgMap), - - % Generate statements to assign by-ref output arguments. - list.filter_map(ml_gen_pragma_il_proc_assign_output(ModuleInfo, - MLDSModuleName, ArgMap, VarSet, Context, yes), - ByRefOutputVars, ByRefAssignStatements), - - % Generate statements to assign copied output arguments. - list.filter_map(ml_gen_pragma_il_proc_assign_output(ModuleInfo, - MLDSModuleName, ArgMap, VarSet, Context, no), - CopiedOutputVars, CopiedOutputStatements), - - ArgVars = list.map(foreign_arg_var, Args), - % Generate declarations for all the variables, and initializers for - % input variables. - list.map( - ml_gen_pragma_il_proc_var_decl_defn(ModuleInfo, MLDSModuleName, - ArgMap, VarSet, MLDSContext, ByRefOutputVars, CopiedOutputVars), - ArgVars, VarLocals), - - OutlineStmt = inline_target_code(ml_target_il, [ - user_target_code(ForeignCode, yes(Context), - get_target_code_attributes(lang_il, - get_extra_attributes(Attributes))) - ]), - - ILCodeFragment = statement(ml_stmt_atomic(OutlineStmt), MLDSContext), - BlockStatements = [ILCodeFragment | ByRefAssignStatements] ++ - CopiedOutputStatements, - BlockStatement = statement(ml_stmt_block(VarLocals, BlockStatements), - mlds_make_context(Context)), - Statements = [BlockStatement], - Decls = []. - -:- pred build_arg_map(list(foreign_arg)::in, map(prog_var, foreign_arg)::in, - map(prog_var, foreign_arg)::out) is det. - -build_arg_map([], !ArgMap). -build_arg_map([ForeignArg | ForeignArgs], !ArgMap) :- - ForeignArg = foreign_arg(Var, _, _, _), - map.det_insert(Var, ForeignArg, !ArgMap), - build_arg_map(ForeignArgs, !ArgMap). - -:- pred ml_gen_pragma_il_proc_assign_output(module_info::in, - mlds_module_name::in, map(prog_var, foreign_arg)::in, prog_varset::in, - prog_context::in, bool::in, prog_var::in, statement::out) - is semidet. - -ml_gen_pragma_il_proc_assign_output(ModuleInfo, MLDSModuleName, ArgMap, - VarSet, Context, IsByRef, Var, Statement) :- - map.lookup(ArgMap, Var, ForeignArg), - ForeignArg = foreign_arg(_, MaybeNameMode, Type, BoxPolicy), - check_dummy_type(ModuleInfo, Type) = is_not_dummy_type, - ( - BoxPolicy = always_boxed, - MLDSType = mlds_generic_type - ; - BoxPolicy = native_if_possible, - MLDSType = mercury_type_to_mlds_type(ModuleInfo, Type) - ), - - VarName = ml_gen_var_name(VarSet, Var), - QualVarName = qual(MLDSModuleName, module_qual, VarName), - ( - IsByRef = yes, - OutputVarLval = ml_mem_ref(ml_lval(ml_var(QualVarName, MLDSType)), - MLDSType) - ; - IsByRef = no, - OutputVarLval = ml_var(QualVarName, MLDSType) - ), - - MaybeNameMode = yes(UserVarNameString - _), - NonMangledVarName = mlds_var_name(UserVarNameString, no), - QualLocalVarName= qual(MLDSModuleName, module_qual, NonMangledVarName), - LocalVarLval = ml_var(QualLocalVarName, MLDSType), - - Statement = ml_gen_assign(OutputVarLval, ml_lval(LocalVarLval), Context). - -:- pred ml_gen_pragma_il_proc_var_decl_defn(module_info::in, - mlds_module_name::in, map(prog_var, foreign_arg)::in, prog_varset::in, - mlds_context::in, list(prog_var)::in, list(prog_var)::in, - prog_var::in, mlds_defn::out) is det. - -ml_gen_pragma_il_proc_var_decl_defn(ModuleInfo, MLDSModuleName, ArgMap, VarSet, - MLDSContext, ByRefOutputVars, CopiedOutputVars, Var, Defn) :- - map.lookup(ArgMap, Var, ForeignArg), - ForeignArg = foreign_arg(_, MaybeNameMode, Type, BoxPolicy), - VarName = ml_gen_var_name(VarSet, Var), - ( - MaybeNameMode = yes(UserVarNameString - _), - NonMangledVarName = mlds_var_name(UserVarNameString, no) - ; - MaybeNameMode = no, - sorry($module, $pred, "no variable name for var") - ), - ( - BoxPolicy = always_boxed, - MLDSType0 = mlds_generic_type - ; - BoxPolicy = native_if_possible, - MLDSType0 = mercury_type_to_mlds_type(ModuleInfo, Type) - ), - - % Dummy arguments are just mapped to integers, since they shouldn't be - % used in any way that requires them to have a real value. - ( if check_dummy_type(ModuleInfo, Type) = is_dummy_type then - Initializer = no_initializer, - MLDSType = mlds_native_int_type - else if list.member(Var, ByRefOutputVars) then - Initializer = no_initializer, - MLDSType = MLDSType0 - else if list.member(Var, CopiedOutputVars) then - Initializer = no_initializer, - MLDSType = MLDSType0 - else - MLDSType = MLDSType0, - QualVarName = qual(MLDSModuleName, module_qual, VarName), - Initializer = init_obj(ml_lval(ml_var(QualVarName, MLDSType))) - ), - % XXX Accurate GC is not supported for IL foreign code; - % this would only be useful if interfacing to - % IL when compiling to C, which is not yet supported. - GCStatement = gc_no_stmt, - Defn = ml_gen_mlds_var_decl_init(mlds_data_var(NonMangledVarName), - MLDSType, Initializer, GCStatement, MLDSContext). - % For ordinary (not model_non) pragma c_proc, % we generate code of the following form: % @@ -626,22 +451,22 @@ ml_gen_ordinary_pragma_c_proc(OrdinaryKind, Attributes, PredId, _ProcId, ( OrdinaryKind = kind_det, Starting_C_Code = list.condense([ - [raw_target_code("{\n", [])], + [raw_target_code("{\n")], HashDefineAllocId, HashDefineProcLabel, ArgDeclsList, - [raw_target_code("\n", [])], + [raw_target_code("\n")], AssignInputsList, - [raw_target_code(ObtainLock, []), - raw_target_code("\t\t{\n", []), - user_target_code(C_Code, yes(Context), []), - raw_target_code("\n\t\t;}\n", [])], + [raw_target_code(ObtainLock), + raw_target_code("\t\t{\n"), + user_target_code(C_Code, yes(Context)), + raw_target_code("\n\t\t;}\n")], HashUndefAllocId, - [raw_target_code("#undef MR_PROC_LABEL\n", []), - raw_target_code(ReleaseLock, [])], + [raw_target_code("#undef MR_PROC_LABEL\n"), + raw_target_code(ReleaseLock)], AssignOutputsList ]), - Ending_C_Code = [raw_target_code("}\n", [])] + Ending_C_Code = [raw_target_code("}\n")] ; OrdinaryKind = kind_failure, % We need to treat this case separately, because for these @@ -650,51 +475,51 @@ ml_gen_ordinary_pragma_c_proc(OrdinaryKind, Attributes, PredId, _ProcId, % would test an undefined value. ml_success_lval(!.Info, SucceededLval), Starting_C_Code = list.condense([ - [raw_target_code("{\n", [])], + [raw_target_code("{\n")], HashDefineAllocId, HashDefineProcLabel, ArgDeclsList, - [raw_target_code("\n", [])], + [raw_target_code("\n")], AssignInputsList, - [raw_target_code(ObtainLock, []), - raw_target_code("\t\t{\n", []), - user_target_code(C_Code, yes(Context), []), - raw_target_code("\n\t\t;}\n", [])], + [raw_target_code(ObtainLock), + raw_target_code("\t\t{\n"), + user_target_code(C_Code, yes(Context)), + raw_target_code("\n\t\t;}\n")], HashUndefAllocId, - [raw_target_code("#undef MR_PROC_LABEL\n", []), - raw_target_code(ReleaseLock, [])] + [raw_target_code("#undef MR_PROC_LABEL\n"), + raw_target_code(ReleaseLock)] ]), Ending_C_Code = [ target_code_output(SucceededLval), - raw_target_code(" = MR_FALSE;\n", []), - raw_target_code("}\n", []) + raw_target_code(" = MR_FALSE;\n"), + raw_target_code("}\n") ] ; OrdinaryKind = kind_semi, ml_success_lval(!.Info, SucceededLval), Starting_C_Code = list.condense([ - [raw_target_code("{\n", [])], + [raw_target_code("{\n")], HashDefineAllocId, HashDefineProcLabel, ArgDeclsList, - [raw_target_code("\tMR_bool SUCCESS_INDICATOR;\n", []), - raw_target_code("\n", [])], + [raw_target_code("\tMR_bool SUCCESS_INDICATOR;\n"), + raw_target_code("\n")], AssignInputsList, - [raw_target_code(ObtainLock, []), - raw_target_code("\t\t{\n", []), - user_target_code(C_Code, yes(Context), []), - raw_target_code("\n\t\t;}\n", [])], + [raw_target_code(ObtainLock), + raw_target_code("\t\t{\n"), + user_target_code(C_Code, yes(Context)), + raw_target_code("\n\t\t;}\n")], HashUndefAllocId, - [raw_target_code("#undef MR_PROC_LABEL\n", []), - raw_target_code(ReleaseLock, []), - raw_target_code("\tif (SUCCESS_INDICATOR) {\n", [])], + [raw_target_code("#undef MR_PROC_LABEL\n"), + raw_target_code(ReleaseLock), + raw_target_code("\tif (SUCCESS_INDICATOR) {\n")], AssignOutputsList ]), Ending_C_Code = [ - raw_target_code("\t}\n", []), + raw_target_code("\t}\n"), target_code_output(SucceededLval), - raw_target_code(" = SUCCESS_INDICATOR;\n", []), - raw_target_code("}\n", []) + raw_target_code(" = SUCCESS_INDICATOR;\n"), + raw_target_code("}\n") ] ), Starting_C_Code_Stmt = inline_target_code(ml_target_c, Starting_C_Code), @@ -756,10 +581,10 @@ ml_gen_hash_define_mr_alloc_id(C_Codes, Context, HashDefine, HashUndef, GlobalData0, GlobalData), ml_gen_info_set_global_data(GlobalData, !Info), HashDefine = [ - raw_target_code("#define MR_ALLOC_ID ", []), + raw_target_code("#define MR_ALLOC_ID "), target_code_alloc_id(AllocId), - raw_target_code("\n", [])], - HashUndef = [raw_target_code("#undef MR_ALLOC_ID\n", [])] + raw_target_code("\n")], + HashUndef = [raw_target_code("#undef MR_ALLOC_ID\n")] else HashDefine = [], HashUndef = [] @@ -777,36 +602,9 @@ ml_gen_hash_define_mr_proc_label(Info, HashDefine) :- ml_gen_info_get_pred_id(Info, PredId), ml_gen_info_get_proc_id(Info, ProcId), ml_gen_proc_label(ModuleInfo, PredId, ProcId, Name, Module), - HashDefine = [raw_target_code("#define MR_PROC_LABEL ", []), + HashDefine = [raw_target_code("#define MR_PROC_LABEL "), target_code_name(qual(Module, module_qual, Name)), - raw_target_code("\n", [])]. - -:- func get_target_code_attributes(foreign_language, - pragma_foreign_proc_extra_attributes) = target_code_attributes. - -get_target_code_attributes(_Lang, []) = []. -get_target_code_attributes(Lang, [ProcAttr | ProcAttrs]) = TargetAttrs :- - TargetAttrs1 = get_target_code_attributes(Lang, ProcAttrs), - ( - ProcAttr = max_stack_size(N), - ( - Lang = lang_il, - TargetAttrs = [max_stack_size(N) | TargetAttrs1] - ; - ( Lang = lang_c - ; Lang = lang_csharp - ; Lang = lang_java - ; Lang = lang_erlang - ), - TargetAttrs = TargetAttrs1 - ) - ; - ( ProcAttr = refers_to_llds_stack - ; ProcAttr = backend(_) - ; ProcAttr = needs_call_standard_output_registers - ), - TargetAttrs = TargetAttrs1 - ). + raw_target_code("\n")]. %---------------------------------------------------------------------------% @@ -848,7 +646,7 @@ ml_gen_pragma_c_decl(Info, Lang, Arg, Decl) :- % it can't be used, so we just ignore it. DeclString = "" ), - Decl = raw_target_code(DeclString, []). + Decl = raw_target_code(DeclString). %-----------------------------------------------------------------------------% @@ -900,7 +698,7 @@ ml_gen_pragma_csharp_java_decl(Info, MutableSpecial, Arg, Decl) :- ), TypeDecl = target_code_type(MLDS_Type), string.format(" %s;\n", [s(ArgName)], VarDeclString), - VarDecl = raw_target_code(VarDeclString, []), + VarDecl = raw_target_code(VarDeclString), Decl = [TypeDecl, VarDecl] else % If the variable doesn't occur in the ArgNames list, @@ -996,18 +794,18 @@ ml_gen_pragma_ccsj_gen_input_arg(Lang, Var, ArgName, OrigType, BoxPolicy, % In the usual case, we can just use an assignment and perhaps a cast. string.format("\t%s = %s ", [s(ArgName), s(Cast)], AssignToArgName), AssignInput = [ - raw_target_code(AssignToArgName, []), + raw_target_code(AssignToArgName), target_code_input(ArgRval), - raw_target_code(";\n", []) + raw_target_code(";\n") ] else % For foreign types (without the `can_pass_as_mercury_type' assertion) % we need to call MR_MAYBE_UNBOX_FOREIGN_TYPE. AssignInput = [ raw_target_code("\tMR_MAYBE_UNBOX_FOREIGN_TYPE(" - ++ TypeString ++ ", ", []), + ++ TypeString ++ ", "), target_code_input(ArgRval), - raw_target_code(", " ++ ArgName ++ ");\n", []) + raw_target_code(", " ++ ArgName ++ ");\n") ] ). @@ -1069,9 +867,7 @@ input_arg_assignable_with_cast(Lang, HighLevelData, OrigType, ExportedType, Lang = lang_csharp, Cast = "" ; - ( Lang = lang_il - ; Lang = lang_erlang - ), + Lang = lang_erlang, unexpected($module, $pred, "unexpected language") ). @@ -1253,17 +1049,17 @@ ml_gen_pragma_c_gen_output_arg(Var, ArgName, OrigType, BoxPolicy, AssignFromArgName), string.format("\t%s ", [s(LHS_Cast)], AssignTo), AssignOutput = [ - raw_target_code(AssignTo, []), + raw_target_code(AssignTo), target_code_output(ArgLval), - raw_target_code(AssignFromArgName, []) + raw_target_code(AssignFromArgName) ] else % For foreign types, we need to call MR_MAYBE_BOX_FOREIGN_TYPE. AssignOutput = [ raw_target_code("\tMR_MAYBE_BOX_FOREIGN_TYPE(" - ++ TypeString ++ ", " ++ ArgName ++ ", ", []), + ++ TypeString ++ ", " ++ ArgName ++ ", "), target_code_output(ArgLval), - raw_target_code(");\n", []) + raw_target_code(");\n") ] ). diff --git a/compiler/ml_global_data.m b/compiler/ml_global_data.m index cb7dcb76e..caa4ebe77 100644 --- a/compiler/ml_global_data.m +++ b/compiler/ml_global_data.m @@ -655,9 +655,7 @@ ml_gen_static_vector_type(MLDS_ModuleName, MLDS_Context, Target, ArgTypes, MLDS_Context), CtorDefns = [CtorDefn] ; - ( Target = target_il - ; Target = target_erlang - ), + Target = target_erlang, unexpected($module, $pred, "unsupported target language") ), diff --git a/compiler/ml_optimize.m b/compiler/ml_optimize.m index 493371044..d69b7f1e6 100644 --- a/compiler/ml_optimize.m +++ b/compiler/ml_optimize.m @@ -1525,8 +1525,8 @@ eliminate_var_in_case_cond(Cond0, Cond, !VarElimInfo) :- eliminate_var_in_target_code_component(Component0, Component, !VarElimInfo) :- ( - ( Component0 = raw_target_code(_Code, _Attrs) - ; Component0 = user_target_code(_Code, _Context, _Attrs) + ( Component0 = raw_target_code(_Code) + ; Component0 = user_target_code(_Code, _Context) ; Component0 = target_code_type(_Type) ; Component0 = target_code_name(_Name) ; Component0 = target_code_alloc_id(_AllocId) diff --git a/compiler/ml_proc_gen.m b/compiler/ml_proc_gen.m index 5a1bddae2..bc0ce1cd8 100644 --- a/compiler/ml_proc_gen.m +++ b/compiler/ml_proc_gen.m @@ -152,38 +152,13 @@ ml_gen_imports(ModuleInfo, MLDS_ImportList) :- :- func foreign_type_required_imports(compilation_target, pair(type_ctor, hlds_type_defn)) = list(mlds_import). -foreign_type_required_imports(Target, _TypeCtor - TypeDefn) = Imports :- +foreign_type_required_imports(Target, _TypeCtor - _TypeDefn) = Imports :- ( ( Target = target_c ; Target = target_java ; Target = target_csharp ), Imports = [] - ; - Target = target_il, - hlds_data.get_type_defn_body(TypeDefn, TypeBody), - ( - TypeBody = hlds_foreign_type(ForeignTypeBody), - ForeignTypeBody = foreign_type_body(MaybeIL, - _MaybeC, _MaybeJava, _MaybeCSharp, _MaybeErlang), - ( if - MaybeIL = yes(Data), - Data = foreign_type_lang_data(il_type(_, Location, _), _, _) - then - Name = il_assembly_name(mercury_module_name_to_mlds( - unqualified(Location))), - Imports = [foreign_import(Name)] - else - unexpected($module, $pred, "no IL type") - ) - ; - ( TypeBody = hlds_du_type(_, _, _,_, _, _, _, _, _) - ; TypeBody = hlds_eqv_type(_) - ; TypeBody = hlds_solver_type(_, _) - ; TypeBody = hlds_abstract_type(_) - ), - Imports = [] - ) ; Target = target_erlang, unexpected($module, $pred, "target erlang") @@ -212,9 +187,7 @@ ml_gen_init_common_data(ModuleInfo, GlobalData) :- ), UseCommonCells = use_common_cells ; - ( Target = target_il - ; Target = target_erlang - ), + Target = target_erlang, UseCommonCells = do_not_use_common_cells ), globals.lookup_bool_option(Globals, unboxed_float, UnboxedFloats), diff --git a/compiler/ml_target_util.m b/compiler/ml_target_util.m index 97be3d65f..0e41da69e 100644 --- a/compiler/ml_target_util.m +++ b/compiler/ml_target_util.m @@ -68,14 +68,12 @@ globals_target_supports_break_and_continue(Globals) = SupportsBreakContinue :- %-----------------------------------------------------------------------------% target_supports_int_switch(target_c) = yes. -target_supports_int_switch(target_il) = no. target_supports_int_switch(target_csharp) = yes. target_supports_int_switch(target_java) = yes. target_supports_int_switch(target_erlang) = unexpected($module, $pred, "target erlang"). target_supports_string_switch(target_c) = no. -target_supports_string_switch(target_il) = no. target_supports_string_switch(target_csharp) = yes. target_supports_string_switch(target_java) = no. % String switches were added in Java 7. @@ -83,7 +81,6 @@ target_supports_string_switch(target_erlang) = unexpected($module, $pred, "target erlang"). target_supports_computed_goto(target_c) = yes. -target_supports_computed_goto(target_il) = yes. target_supports_computed_goto(target_csharp) = yes. target_supports_computed_goto(target_java) = no. % target_supports_computed_goto(c_sharp) = no. @@ -91,14 +88,12 @@ target_supports_computed_goto(target_erlang) = unexpected($module, $pred, "target erlang"). target_supports_goto(target_c) = yes. -target_supports_goto(target_il) = yes. target_supports_goto(target_csharp) = yes. target_supports_goto(target_java) = no. target_supports_goto(target_erlang) = unexpected($module, $pred, "target erlang"). target_supports_break_and_continue(target_c) = yes. -target_supports_break_and_continue(target_il) = no. target_supports_break_and_continue(target_csharp) = yes. target_supports_break_and_continue(target_java) = yes. % target_supports_break_and_continue(target_c_sharp) = yes. @@ -106,7 +101,6 @@ target_supports_break_and_continue(target_erlang) = _ :- unexpected($module, $pred, "target erlang"). target_supports_inheritence(target_c) = no. -target_supports_inheritence(target_il) = yes. target_supports_inheritence(target_csharp) = yes. target_supports_inheritence(target_java) = yes. target_supports_inheritence(target_erlang) = diff --git a/compiler/ml_type_gen.m b/compiler/ml_type_gen.m index 1b7f01b6d..21b30cc0a 100644 --- a/compiler/ml_type_gen.m +++ b/compiler/ml_type_gen.m @@ -136,16 +136,10 @@ ml_gen_types(ModuleInfo, Defns) :- module_info_get_globals(ModuleInfo, Globals), globals.lookup_bool_option(Globals, highlevel_data, HighLevelData), - globals.get_target(Globals, Target), ( HighLevelData = yes, module_info_get_type_table(ModuleInfo, TypeTable), - get_all_type_ctor_defns(TypeTable, TypeCtorsDefns0), - list.filter( - ( pred(TypeCtorDefn::in) is semidet :- - TypeCtorDefn = TypeCtor - _TypeDefn, - not type_ctor_needs_lowlevel_rep(Target, TypeCtor) - ), TypeCtorsDefns0, TypeCtorDefns), + get_all_type_ctor_defns(TypeTable, TypeCtorDefns), list.foldl(ml_gen_type_defn(ModuleInfo), TypeCtorDefns, [], Defns) ; HighLevelData = no, @@ -267,7 +261,6 @@ ml_gen_enum_type(Target, TypeCtor, TypeDefn, Ctors, TagValues, Inherits = [ml_java_mercury_enum_class] ; ( Target = target_c - ; Target = target_il ; Target = target_csharp ; Target = target_erlang ), @@ -511,7 +504,6 @@ ml_gen_du_parent_type(ModuleInfo, TypeCtor, TypeDefn, Ctors, TagValues, Implements = [ml_java_mercury_type_interface] ; ( Target = target_c - ; Target = target_il ; Target = target_csharp ; Target = target_erlang ), @@ -885,7 +877,6 @@ ml_tag_uses_base_class(Tag) = UsesBaseClass :- ). ml_target_uses_constructors(target_c) = no. -ml_target_uses_constructors(target_il) = yes. ml_target_uses_constructors(target_csharp) = yes. ml_target_uses_constructors(target_java) = yes. ml_target_uses_constructors(target_erlang) = @@ -894,7 +885,6 @@ ml_target_uses_constructors(target_erlang) = :- func target_uses_empty_base_classes(compilation_target) = bool. target_uses_empty_base_classes(target_c) = no. -target_uses_empty_base_classes(target_il) = yes. target_uses_empty_base_classes(target_csharp) = no. target_uses_empty_base_classes(target_java) = yes. target_uses_empty_base_classes(target_erlang) = @@ -911,7 +901,6 @@ target_uses_empty_base_classes(target_erlang) = :- func target_requires_module_qualified_params(compilation_target) = bool. target_requires_module_qualified_params(target_c) = no. -target_requires_module_qualified_params(target_il) = no. target_requires_module_qualified_params(target_csharp) = yes. target_requires_module_qualified_params(target_java) = yes. target_requires_module_qualified_params(target_erlang) = diff --git a/compiler/ml_unify_gen.m b/compiler/ml_unify_gen.m index 80a509140..d26ed239e 100644 --- a/compiler/ml_unify_gen.m +++ b/compiler/ml_unify_gen.m @@ -1815,9 +1815,7 @@ ml_gen_unify_arg(ConsId, Arg, Mode, ArgType, Field, VarType, VarLval, HighLevelData = yes, ml_gen_info_get_target(!.Info, Target), ( if - ( type_is_tuple(VarType, _) - ; type_needs_lowlevel_rep(Target, VarType) - ) + type_is_tuple(VarType, _) then Offset = offset(OffsetInt), FieldId = ml_field_offset(ml_const(mlconst_int(OffsetInt))) @@ -2281,13 +2279,9 @@ ml_gen_secondary_tag_rval(ModuleInfo, PrimaryTagVal, VarType, Rval) = SecondaryTagField :- MLDS_VarType = mercury_type_to_mlds_type(ModuleInfo, VarType), module_info_get_globals(ModuleInfo, Globals), - globals.get_target(Globals, Target), globals.lookup_bool_option(Globals, highlevel_data, HighLevelData), - ( if - ( HighLevelData = no - ; type_needs_lowlevel_rep(Target, VarType) - ) - then + ( + HighLevelData = no, % Note: with the low-level data representation, all fields -- even % the secondary tag -- are boxed, and so we need to unbox (i.e. cast) % it back to the right type here. @@ -2296,7 +2290,8 @@ ml_gen_secondary_tag_rval(ModuleInfo, PrimaryTagVal, VarType, Rval) = ml_lval(ml_field(yes(PrimaryTagVal), Rval, ml_field_offset(ml_const(mlconst_int(0))), mlds_generic_type, MLDS_VarType))) - else + ; + HighLevelData = yes, FieldId = ml_gen_hl_tag_field_id(ModuleInfo, VarType), SecondaryTagField = ml_lval(ml_field(yes(PrimaryTagVal), Rval, FieldId, mlds_native_int_type, MLDS_VarType)) diff --git a/compiler/ml_util.m b/compiler/ml_util.m index db9f8c879..b3548d2e3 100644 --- a/compiler/ml_util.m +++ b/compiler/ml_util.m @@ -20,7 +20,7 @@ :- import_module hlds.hlds_data. :- import_module hlds.hlds_module. :- import_module ml_backend.mlds. -:- import_module parse_tree.prog_data. +%:- import_module parse_tree.prog_data. :- import_module bool. :- import_module list. @@ -146,17 +146,6 @@ :- func lval_contains_var(mlds_lval, mlds_data) = bool. -%-----------------------------------------------------------------------------% - - % Does the type require the lowlevel representation on the indicated - % backend? - % -:- pred type_needs_lowlevel_rep(compilation_target::in, mer_type::in) - is semidet. - -:- pred type_ctor_needs_lowlevel_rep(compilation_target::in, - type_ctor::in) is semidet. - %-----------------------------------------------------------------------------% % % Functions for generating initializers. @@ -605,8 +594,8 @@ target_code_components_contains_var([TargetCode | TargetCodes], DataName) target_code_component_contains_var(TargetCode, DataName) = ContainsVar :- ( - ( TargetCode = user_target_code(_, _, _) - ; TargetCode = raw_target_code(_, _) + ( TargetCode = user_target_code(_, _) + ; TargetCode = raw_target_code(_) ; TargetCode = target_code_type(_) ; TargetCode = target_code_alloc_id(_) ), @@ -931,47 +920,6 @@ lval_contains_var(Lval, DataName) = ContainsVar :- %-----------------------------------------------------------------------------% -type_needs_lowlevel_rep(Target, Type) :- - type_to_ctor(Type, TypeCtor), - type_ctor_needs_lowlevel_rep(Target, TypeCtor). - - % XXX Do we need to do the same for the Java back-end? -type_ctor_needs_lowlevel_rep(target_il, type_ctor(TypeName, _Arity)) :- - Builtin = mercury_public_builtin_module, - PrivateBuiltin = mercury_private_builtin_module, - RttiImplementation = unqualified("rtti_implementation"), - Univ = unqualified("univ"), - MutVar = unqualified("mutvar"), - TypeDesc = unqualified("type_desc"), - ( TypeName = qualified(PrivateBuiltin, "base_typeclass_info") - ; TypeName = qualified(PrivateBuiltin, "type_ctor_info") - ; TypeName = qualified(PrivateBuiltin, "typeclass_info") - ; TypeName = qualified(PrivateBuiltin, "type_info") - - % Use lowlevel types for all types in rtti_implementation - % as this allows as to add new types needed to manipulate - % the RTTI type safely easily. - ; TypeName = qualified(RttiImplementation, _) - - ; TypeName = qualified(TypeDesc, "type_desc") - ; TypeName = qualified(TypeDesc, "pseudo_type_desc") - ; TypeName = qualified(TypeDesc, "type_ctor_desc") - - % Types which don't have a Mercury representation. - ; TypeName = qualified(PrivateBuiltin, "ref") - ; TypeName = qualified(PrivateBuiltin, "heap_pointer") - ; TypeName = qualified(Builtin, "c_pointer") - - % XXX These types are referenced in IL and C# code, - % so it is easier to just keep their low level representation - % for the moment. - ; TypeName = qualified(Builtin, "comparison_result") - ; TypeName = qualified(Univ, "univ") - ; TypeName = qualified(MutVar, "mutvar") - ). - -%-----------------------------------------------------------------------------% - gen_init_builtin_const(Name) = init_obj(Rval) :- PrivateBuiltin = mercury_private_builtin_module, MLDS_Module = mercury_module_name_to_mlds(PrivateBuiltin), diff --git a/compiler/mlds.m b/compiler/mlds.m index 820540817..f09b7b31a 100644 --- a/compiler/mlds.m +++ b/compiler/mlds.m @@ -478,7 +478,7 @@ % :- func mlds_append_name(mlds_module_name, string) = mlds_module_name. - % When targetting languages such as IL, C#, and Java, which don't support + % When targetting languages such as C#, and Java, which don't support % global methods or global variables, we need to wrap all the generated % global functions and global data inside a wrapper class. This function % returns the name to use for the wrapper class. @@ -1425,7 +1425,6 @@ ---> ml_target_c ; ml_target_gnu_c % ; ml_target_c_minus_minus - ; ml_target_il ; ml_target_csharp ; ml_target_java. % ; ml_target_java_asm @@ -1437,8 +1436,7 @@ % `pragma foreign_proc' declaration. string, - maybe(prog_context), - target_code_attributes + maybe(prog_context) ) ; raw_target_code( % Raw_target_code holds C code that the compiler has generated. @@ -1448,8 +1446,7 @@ % target_code_component must be a `name(Name)' component, % for which we do not output #line directives. - string, - target_code_attributes + string ) ; target_code_input(mlds_rval) @@ -1458,18 +1455,6 @@ ; target_code_name(mlds_qualified_entity_name) ; target_code_alloc_id(mlds_alloc_id). -:- type target_code_attributes == list(target_code_attribute). - -:- type target_code_attribute - ---> max_stack_size(int). - % max_stack_size(Size): - % This attribute declares the maximum stack usage of a - % particular piece of code. The unit that `Size' is measured - % in depends upon foreign language being used. Currently this - % attribute is only used (and is in fact required) by the - % `IL' foreign language interface, and is measured in units - % of stack items. - :- type mlds_alloc_id ---> mlds_alloc_id(int). @@ -1909,7 +1894,6 @@ mercury_type_to_mlds_type(ModuleInfo, Type) = MLDSType :- MLDSType = MLDSRefType ; ( Target = target_c - ; Target = target_il ; Target = target_java ; Target = target_erlang ), @@ -1950,7 +1934,7 @@ foreign_type_to_mlds_type(ModuleInfo, ForeignTypeBody) = MLDSType :- % foreign_type_body_to_exported_type in foreign.m. % Any changes here may require changes there as well. - ForeignTypeBody = foreign_type_body(MaybeIL, MaybeC, MaybeJava, + ForeignTypeBody = foreign_type_body(MaybeC, MaybeJava, MaybeCSharp, _MaybeErlang), module_info_get_globals(ModuleInfo, Globals), globals.get_target(Globals, Target), @@ -1965,17 +1949,6 @@ foreign_type_to_mlds_type(ModuleInfo, ForeignTypeBody) = MLDSType :- % This is checked by check_foreign_type in make_hlds. unexpected($module, $pred, "no C foreign type") ) - ; - Target = target_il, - ( - MaybeIL = yes(Data), - Data = foreign_type_lang_data(ILForeignType, _, _), - ForeignType = il(ILForeignType) - ; - MaybeIL = no, - % This is checked by check_foreign_type in make_hlds. - unexpected($module, $pred, "no IL foreign type") - ) ; Target = target_csharp, ( @@ -2021,12 +1994,6 @@ mlds_get_arg_types(Parameters) = ArgTypes :- %-----------------------------------------------------------------------------% -% For IL: -% An MLDS module name consists of two parts. One part is the package -% which the module name is defined in, and the other part is the actual -% module name. For example the module name System.XML could be defined -% in the package XML. -% % For Java: % The "package_name" is really the name of the Mercury module, and the % "module_name" is the "package_name" plus additional qualifiers (if any). diff --git a/compiler/mlds_to_c.m b/compiler/mlds_to_c.m index 46a8525d2..b4c18acff 100644 --- a/compiler/mlds_to_c.m +++ b/compiler/mlds_to_c.m @@ -312,7 +312,6 @@ mlds_output_src_imports(Opts, Indent, Imports, !IO) :- ; ( Target = target_java ; Target = target_csharp - ; Target = target_il ; Target = target_erlang ), unexpected($module, $pred, "expected target c") @@ -506,8 +505,7 @@ mlds_output_hdr_start(Opts, Indent, ModuleName, !IO) :- io.write_string("#endif\n", !IO), io.nl(!IO) ; - ( Target = target_il - ; Target = target_java + ( Target = target_java ; Target = target_csharp ; Target = target_erlang ) @@ -620,8 +618,7 @@ mlds_output_hdr_end(Opts, Indent, ModuleName, !IO) :- io.write_string("#endif\n", !IO), io.nl(!IO) ; - ( Target = target_il - ; Target = target_csharp + ( Target = target_csharp ; Target = target_java ; Target = target_erlang ) @@ -947,7 +944,6 @@ mlds_output_c_hdr_decl(Opts, _Indent, MaybeDesiredIsLocal, DeclCode, !IO) :- ; ( Lang = lang_java ; Lang = lang_csharp - ; Lang = lang_il ; Lang = lang_erlang ), sorry($module, $pred, "foreign code other than C") @@ -986,8 +982,7 @@ mlds_output_c_foreign_import_module(Opts, Indent, ForeignImport, !IO) :- mercury_import(user_visible_interface, mercury_module_name_to_mlds(Import)), !IO) ; - ( Lang = lang_il - ; Lang = lang_csharp + ( Lang = lang_csharp ; Lang = lang_java ; Lang = lang_erlang ), @@ -1005,7 +1000,6 @@ mlds_output_c_defn(Opts, _Indent, ForeignBodyCode, !IO) :- !IO) ; ( Lang = lang_csharp - ; Lang = lang_il ; Lang = lang_java ; Lang = lang_erlang ), @@ -1132,9 +1126,6 @@ mlds_output_pragma_export_type(PrefixSuffix, MLDS_Type, !IO) :- ( ForeignType = c(c_type(Name)), io.write_string(Name, !IO) - ; - ForeignType = il(_), - unexpected($module, $pred, "il foreign_type") ; ForeignType = java(_), unexpected($module, $pred, "java foreign_type") @@ -1419,7 +1410,6 @@ mlds_output_export_enum(Opts, _Indent, ExportedEnum, !IO) :- ; ( Lang = lang_csharp ; Lang = lang_java - ; Lang = lang_il ; Lang = lang_erlang ) ). @@ -3918,7 +3908,6 @@ mlds_output_atomic_stmt(Opts, Indent, _FuncInfo, Statement, Context, !IO) :- Components, !IO) ; ( TargetLang = ml_target_gnu_c - ; TargetLang = ml_target_il ; TargetLang = ml_target_csharp ; TargetLang = ml_target_java ), @@ -3948,7 +3937,7 @@ mlds_output_maybe_alloc_id(MaybeAllocId, !IO) :- mlds_output_target_code_component(Opts, Context, TargetCode, !IO) :- ( - TargetCode = user_target_code(CodeString, MaybeUserContext, _Attrs), + TargetCode = user_target_code(CodeString, MaybeUserContext), ( MaybeUserContext = yes(UserContext), output_context_opts(Opts, mlds_make_context(UserContext), !IO) @@ -3960,7 +3949,7 @@ mlds_output_target_code_component(Opts, Context, TargetCode, !IO) :- io.write_string("\n", !IO), reset_context_opts(Opts, !IO) ; - TargetCode = raw_target_code(CodeString, _Attrs), + TargetCode = raw_target_code(CodeString), io.write_string(CodeString, !IO) ; TargetCode = target_code_input(Rval), diff --git a/compiler/mlds_to_cs.m b/compiler/mlds_to_cs.m index 02d174cc0..a73af01dc 100644 --- a/compiler/mlds_to_cs.m +++ b/compiler/mlds_to_cs.m @@ -234,7 +234,6 @@ output_csharp_decl(Info, Indent, DeclCode, !IO) :- ; ( Lang = lang_c ; Lang = lang_java - ; Lang = lang_il ; Lang = lang_erlang ), sorry($module, $pred, "foreign decl other than C#") @@ -253,7 +252,6 @@ output_csharp_body_code(Info, Indent, ForeignBodyCode, !IO) :- ; ( Lang = lang_c ; Lang = lang_java - ; Lang = lang_il ; Lang = lang_erlang ), sorry($module, $pred, "foreign code other than C#") @@ -418,7 +416,6 @@ output_exported_enum(Info, Indent, ExportedEnum, !IO) :- ; ( Lang = lang_c ; Lang = lang_java - ; Lang = lang_il ; Lang = lang_erlang ) ). @@ -1544,8 +1541,7 @@ get_type_initializer(Info, Type) = Initializer :- ForeignType = csharp(csharp_type(CsharpType)), Initializer = "default(" ++ CsharpType ++ ")" ; - ( ForeignType = il(_) - ; ForeignType = c(_) + ( ForeignType = c(_) ; ForeignType = java(_) ; ForeignType = erlang(_) ), @@ -2268,9 +2264,6 @@ type_to_string(Info, MLDS_Type, String, ArrayDims) :- ; ForeignType = c(_), unexpected($module, $pred, "c foreign_type") - ; - ForeignType = il(_), - unexpected($module, $pred, "il foreign_type") ; ForeignType = java(_), unexpected($module, $pred, "java foreign_type") @@ -3178,7 +3171,6 @@ output_atomic_stmt(Info, Indent, AtomicStmt, Context, !IO) :- ; ( TargetLang = ml_target_c ; TargetLang = ml_target_gnu_c - ; TargetLang = ml_target_il ; TargetLang = ml_target_java ), unexpected($module, $pred, @@ -3197,7 +3189,7 @@ output_atomic_stmt(Info, Indent, AtomicStmt, Context, !IO) :- output_target_code_component(Info, TargetCode, !IO) :- ( - TargetCode = user_target_code(CodeString, MaybeUserContext, _Attrs), + TargetCode = user_target_code(CodeString, MaybeUserContext), io.write_string("{\n", !IO), ( MaybeUserContext = yes(ProgContext), @@ -3209,7 +3201,7 @@ output_target_code_component(Info, TargetCode, !IO) :- io.write_string("}\n", !IO), output_default_context(Info, !IO) ; - TargetCode = raw_target_code(CodeString, _Attrs), + TargetCode = raw_target_code(CodeString), io.write_string(CodeString, !IO) ; TargetCode = target_code_input(Rval), diff --git a/compiler/mlds_to_il.m b/compiler/mlds_to_il.m deleted file mode 100644 index d2b963aa1..000000000 --- a/compiler/mlds_to_il.m +++ /dev/null @@ -1,4696 +0,0 @@ -%-----------------------------------------------------------------------------% -% vim: ft=mercury ts=4 sw=4 et -%-----------------------------------------------------------------------------% -% Copyright (C) 2000-2012 The University of Melbourne. -% This file may only be copied under the terms of the GNU General -% Public License - see the file COPYING in the Mercury distribution. -%-----------------------------------------------------------------------------% -% -% File: mlds_to_il.m - Convert MLDS to IL. -% Main author: trd, petdr. -% -% This module generates IL from MLDS. Currently it's pretty tuned -% towards generating assembler -- to generate code using -% Reflection::Emit it is likely some changes will need to be made. -% -% Currently non-det environments are represented using a high-level data -% representation (classes with typed fields), while all other data structures -% are represented using a low-level data representation (arrays of -% System.Object). This is for historical reasons -- the MLDS high-level-data -% support wasn't available when it was needed. Eventually we should -% move to a completely high-level data representation as the current -% representation is pretty inefficient. -% -% The IL backend TO-DO list: -% -% [ ] advanced name mangling: -% - optionally only mangle names when it is absolutely necessary -% (Partly done; we now mangle names less often than we used to. -% The only way to mangle less would be to use a context-sensitive -% name mangling algorithm, which may not be a good idea.) -% [ ] Type classes -% - now work, but... -% - type class hierarchies don't work due to unimplemented pragma -% foreign code. -% - should be implemented as interfaces -% [ ] RTTI (io.write -- about half the work required for this is done) -% [ ] High-level RTTI data -% [ ] Test unused mode (we seem to create a byref for it) -% [ ] auto dependency generation for IL and assembler -% [ ] build environment improvements -% (support libraries/packages/namespaces better) -% [ ] verifiable code -% [ ] verifiable function pointers -% [ ] omit empty cctors -% [ ] Computed gotos need testing. -% [ ] nested modules need testing -% [ ] Fix issues with abstract types so that we can implement C -% pointers as MR_Box rather than MR_Word. -% [ ] When generating target_code, sometimes we output more calls than -% we should (this can occur in nondet C code). -% [ ] ml_gen_call_current_success_cont_indirectly should be merged with -% similar code for doing copy-in/copy-out. -% [ ] Add an option to do overflow checking. -% [ ] Should replace hard-coded of int32 with a more abstract name such -% as `mercury_int_il_type'. -% [ ] Implement `pragma foreign_export' for C#. -% -% XXX We should rename this module to mlds_to_ilds, since that is what -% it actually does. -% -%-----------------------------------------------------------------------------% - -:- module ml_backend.mlds_to_il. -:- interface. - -:- import_module hlds.hlds_pred. % for `pred_proc_id'. -:- import_module libs.globals. % for `foreign_language'. -:- import_module ml_backend.ilasm. -:- import_module ml_backend.ilds. -:- import_module ml_backend.mlds. - -:- import_module bool. -:- import_module list. -:- import_module maybe. -:- import_module set. - -%-----------------------------------------------------------------------------% - - % Generate IL assembly from MLDS. - % - % This is where all the action is for the IL backend. - % -:- pred generate_il(globals::in, mlds::in, list(il_decl)::out, - set(foreign_language)::out) is det. - -%-----------------------------------------------------------------------------% - - % The following predicates are exported so that we can get type - % conversions and name mangling consistent between the C# output - % (currently in mlds_to_managed.m) and IL output (in this file). - % - % XXX we should reduce the dependencies here to a bare minimum. - % -:- func params_to_il_signature(il_data_rep, mlds_module_name, - mlds_func_params) = signature. - - % Generate an identifier for a pred label, to be used in C#. - % -:- pred predlabel_to_csharp_id(mlds_pred_label::in, proc_id::in, - maybe(mlds_func_sequence_num)::in, ilds.id::out) is det. - - % Generate an IL identifier for a MLDS var. - % -:- pred mangle_mlds_var(mlds_var::in, ilds.id::out) is det. - - % This type stores information affecting our IL data representation. - % -:- type il_data_rep - ---> il_data_rep( - highlevel_data :: bool, % Do we use high-level data? - il_envptr_type :: il_type % What IL type do we use for - % mlds_generic_env_ptr_type? - ). - -:- pred get_il_data_rep(globals::in, il_data_rep::out) is det. - - % Get the corresponding ILDS type for an MLDS type - % (this depends on which representation you happen to be using). - % -:- func mlds_type_to_ilds_type(il_data_rep, mlds_type) = il_type. - - % Get the corresponding ILDS class name for an MLDS type - % (this depends on which representation you happen to be using). - % -:- func mlds_type_to_ilds_class_name(il_data_rep, mlds_type) = - ilds.class_name. - - % Turn a proc name into an IL class_name and a method name. - % -:- pred mangle_mlds_proc_label(mlds_qualified_proc_label::in, - maybe(mlds_func_sequence_num)::in, ilds.class_name::out, ilds.id::out) - is det. - - % class_name(Module, Name) returns a class name representing - % Name in the module Module. - % -:- func class_name(mlds_module_name, string) = ilds.class_name. - - % Return the class_name for the generic class. - % -:- func il_generic_class_name = ilds.class_name. - -%-----------------------------------------------------------------------------% -%-----------------------------------------------------------------------------% - -:- implementation. - -:- import_module backend_libs.builtin_ops. -:- import_module backend_libs.foreign. -:- import_module backend_libs.rtti. -:- import_module hlds.code_model. -:- import_module libs.options. -:- import_module mdbcomp.builtin_modules. -:- import_module mdbcomp.prim_data. -:- import_module mdbcomp.sym_name. -:- import_module ml_backend.ml_code_util. -:- import_module ml_backend.ml_global_data. -:- import_module ml_backend.ml_type_gen. -:- import_module ml_backend.ml_util. -:- import_module parse_tree.prog_data. -:- import_module parse_tree.prog_foreign. -:- import_module parse_tree.prog_type. - -:- import_module assoc_list. -:- import_module cord. -:- import_module counter. -:- import_module deconstruct. -:- import_module int. -:- import_module map. -:- import_module pair. -:- import_module require. -:- import_module string. -:- import_module term. - -%-----------------------------------------------------------------------------% - - % We build up lists of instructions using a tree to make - % insertion easy. - % -:- type instr_tree == cord(instr). - - % The state of the il code generator. - % -:- type il_info - ---> il_info( - % file-wide attributes (all static) - module_name :: mlds_module_name, - assembly_name :: ilds.id, - imports :: mlds_imports, - file_foreign_langs :: set(foreign_language), - % file foreign code - - il_data_rep :: il_data_rep, - debug_il_asm :: bool, % --debug-il-asm - verifiable_code :: bool, % --verifiable-code - il_byref_tailcalls :: bool, % --il-byref-tailcalls - support_ms_clr :: bool, % --support-ms-clr - support_rotor_clr :: bool, % --support-rotor-clr - - % class-wide attributes (all accumulate) - alloc_instrs :: instr_tree, - % .cctor allocation instructions - init_instrs :: instr_tree, - % .cctor init instructions - class_members :: list(class_member), - % class methods and fields - has_main :: has_main, - % class contains main - class_foreign_langs :: set(foreign_language), - % class foreign code - field_names :: field_names_set, - - % method-wide attributes (accumulating) - locals :: locals_map, - % The current locals - instr_tree :: instr_tree, - % The instruction tree (unused) - label_counter :: counter, % the label counter - block_counter :: counter, % the block counter - method_foreign_lang :: maybe(foreign_language), - % method contains foreign code - - % method-wide attributes (static) - arguments :: arguments_map, % The arguments - method_name :: member_name, % current method name - csharp_method_name :: member_name, - % current C# method name - signature :: signature % current return type - ). - -:- type locals_map == map(ilds.id, mlds_type). -:- type arguments_map == assoc_list(ilds.id, mlds_type). -:- type mlds_vartypes == map(ilds.id, mlds_type). -:- type field_names_set == set(string). - -%-----------------------------------------------------------------------------% -%-----------------------------------------------------------------------------% - -generate_il(Globals, MLDS, ILAsm, ForeignLangs) :- - globals.get_maybe_il_version_number(Globals, MaybeVersionNumber), - ( - MaybeVersionNumber = yes(VersionNumber), - VersionNumber = il_version_number(Major, Minor, Build, Revision), - Version = version(Major, Minor, Build, Revision), - generate_il(Globals, MLDS, Version, ILAsm, ForeignLangs) - ; - MaybeVersionNumber = no, - ILAsm = [], - ForeignLangs = set.init - ). - -%-----------------------------------------------------------------------------% - -:- pred generate_il(globals::in, mlds::in, assembly_decl::in, - list(il_decl)::out, set(foreign_language)::out) is det. - -generate_il(Globals, MLDS0, Version, ILAsm, ForeignLangs) :- - % XXX initialise declarations NYI for IL backend - il_transform_mlds(MLDS0, MLDS), - MLDS = mlds(MercuryModuleName, ForeignCode, Imports, GlobalData, Defns0, - _, _, _), - ml_global_data_get_all_global_defns(GlobalData, - ScalarCellGroupMap, VectorCellGroupMap, _AllocIdMap, GlobalDefns), - expect(map.is_empty(ScalarCellGroupMap), $module, $pred, - "nonempty ScalarCellGroupMap"), - expect(map.is_empty(VectorCellGroupMap), $module, $pred, - "nonempty VectorCellGroupMap"), - Defns = GlobalDefns ++ Defns0, - - ModuleName = mercury_module_name_to_mlds(MercuryModuleName), - AssemblyName = - sym_name_to_string(mlds_module_name_to_sym_name(ModuleName)), - get_il_data_rep(Globals, ILDataRep), - globals.lookup_bool_option(Globals, debug_il_asm, DebugIlAsm), - globals.lookup_bool_option(Globals, verifiable_code, VerifiableCode), - globals.lookup_bool_option(Globals, il_byref_tailcalls, ByRefTailCalls), - globals.lookup_bool_option(Globals, il_sign_assembly, SignAssembly), - globals.lookup_bool_option(Globals, separate_assemblies, - SeparateAssemblies), - globals.lookup_bool_option(Globals, support_ms_clr, MsCLR), - globals.lookup_bool_option(Globals, support_rotor_clr, RotorCLR), - - IlInfo0 = il_info_init(ModuleName, AssemblyName, Imports, ILDataRep, - DebugIlAsm, VerifiableCode, ByRefTailCalls, MsCLR, RotorCLR), - - % Generate code for all the methods. - list.map_foldl(mlds_defn_to_ilasm_decl, Defns, ILDecls, IlInfo0, IlInfo), - - list.filter(has_foreign_code_defined(ForeignCode), - [lang_csharp], ForeignCodeLangs), - - ForeignLangs = IlInfo ^ file_foreign_langs `union` - set.list_to_set(ForeignCodeLangs), - - ClassName = mlds_module_name_to_class_name(ModuleName), - ClassName = structured_name(_, NamespaceName, _), - - % Make this module an assembly unless it is in the standard library. - % Standard library modules all go in the one assembly in a separate step - % during the build (using AL.EXE). - PackageName = mlds_module_name_to_package_name(ModuleName), - ( sym_name_prefix(PackageName) = "mercury" -> - ThisAssembly = [], - AssemblerRefs = Imports - ; - % If the package name is qualified then the we have a sub-module - % which shouldn't be placed in its own assembly provided we have - % --no-separate-assemblies. - ( - PackageName = qualified(_, _), - SeparateAssemblies = no - -> - ThisAssembly = [] - ; - ThisAssembly = [ildecl_assembly(AssemblyName)] - ), - - % XXX At a later date we should make foreign code behave like - % a submodule. - % - % If not in the library, but we have foreign code, declare the foreign - % module as an assembly we reference. - list.map( - (pred(F::in, I::out) is det :- - mangle_foreign_code_module(F, ModuleName, N), - I = mercury_import(compiler_visible_interface, N) - ), - set.to_sorted_list(ForeignLangs), - ForeignCodeAssemblerRefs), - AssemblerRefs = list.append(ForeignCodeAssemblerRefs, Imports) - ), - generate_extern_assembly(AssemblyName, Version, SignAssembly, - SeparateAssemblies, AssemblerRefs, ExternAssemblies), - Namespace = ildecl_namespace(NamespaceName, ILDecls), - ILAsm = ThisAssembly ++ ExternAssemblies ++ [Namespace]. - -get_il_data_rep(Globals, ILDataRep) :- - globals.lookup_bool_option(Globals, highlevel_data, HighLevelData), - ILEnvPtrType = choose_il_envptr_type(Globals), - ILDataRep = il_data_rep(HighLevelData, ILEnvPtrType). - -:- pred has_foreign_code_defined(map(foreign_language, mlds_foreign_code)::in, - foreign_language::in) is semidet. - -has_foreign_code_defined(ForeignCodeMap, Lang) :- - ForeignCode = map.search(ForeignCodeMap, Lang), - ForeignCode = mlds_foreign_code(DeclCodes, BodyCodes, Imports, Exports), - ( DeclCodes = [_ | _] - ; BodyCodes = [_ | _] - ; Imports = [_ | _] - ; Exports = [_ | _] - ). - -%-----------------------------------------------------------------------------% -%-----------------------------------------------------------------------------% - - % Move all the top level methods and data definitions into the wrapper - % class, and then fix all the references so that they refer to their new - % names. - % -:- pred il_transform_mlds(mlds::in, mlds::out) is det. - -il_transform_mlds(MLDS0, MLDS) :- - MLDS0 = mlds(ModuleName, ForeignCodeMap, TopLevelImports, - GlobalData0, Defns0, InitPreds, FinalPreds, ExportedEnums), - - map.values(ForeignCodeMap, ForeignCodes), - ForeignCodeExportLists = - list.map(project_foreign_code_export, ForeignCodes), - ForeignCodeExports = list.condense(ForeignCodeExportLists), - - % Generate the exports for this file, they will be placed into - % class methods inside the wrapper class. - list.map(mlds_export_to_mlds_defn, ForeignCodeExports, ExportDefns), - - % We take all the definitions out of the global data field of the MLDS. - ml_global_data_get_all_global_defns(GlobalData0, - ScalarCellGroupMap, VectorCellGroupMap, _AllocIdMap, GlobalDefns), - expect(map.is_empty(ScalarCellGroupMap), $module, $pred, - "nonempty ScalarCellGroupMap"), - expect(map.is_empty(VectorCellGroupMap), $module, $pred, - "nonempty VectorCellGroupMap"), - Defns1 = GlobalDefns ++ Defns0 ++ ExportDefns, - GlobalData = ml_global_data_init(do_not_use_common_cells, - do_not_have_unboxed_floats), - - IsFunctionOrData = - (pred(D::in) is semidet :- - ( D = mlds_defn(_, _, _, mlds_function(_, _, _, _, _)) - ; D = mlds_defn(_, _, _, mlds_data(_, _, _)) - ) - ), - list.filter(IsFunctionOrData, Defns1, MercuryCodeDefns, OtherDefns), - - WrapperClass = wrapper_class(list.map(rename_defn, MercuryCodeDefns)), - % XXX We are we renaming OtherDefns? Its definitions are not being wrapped - % in a class. - WrappedOtherDefns = list.map(rename_defn, OtherDefns), - % Note that ILASM requires that the type definitions in WrappedOtherDefns - % must precede the references to those types in WrapperClass. - Defns = WrappedOtherDefns ++ [WrapperClass], - - MLDS = mlds(ModuleName, ForeignCodeMap, TopLevelImports, - GlobalData, Defns, InitPreds, FinalPreds, ExportedEnums). - -:- func project_foreign_code_export(mlds_foreign_code) = - list(mlds_pragma_export). - -project_foreign_code_export(mlds_foreign_code(_, _, _, Exports)) = Exports. - -:- func wrapper_class(list(mlds_defn)) = mlds_defn. - -wrapper_class(Members) = - mlds_defn( - entity_export(wrapper_class_name), - mlds_make_context(term.context_init), - ml_gen_type_decl_flags, - mlds_class(mlds_class_defn(mlds_package, [], [], [], [], [], Members)) - ). - -%-----------------------------------------------------------------------------% -% -% Rename the relevant components of the definition (such as qualified var -% names) to reflect the wrapper class we are adding around the definition. -% - -:- func rename_defn(mlds_defn) = mlds_defn. - -rename_defn(Defn0) = Defn :- - Defn0 = mlds_defn(Name, Context, Flags, Entity0), - ( - Entity0 = mlds_data(Type, Initializer, GCStatement), - Entity = mlds_data(Type, - rename_initializer(Initializer), - rename_gc_statement(GCStatement)) - ; - Entity0 = mlds_function(MaybePredProcId, Params, FunctionBody0, - Attributes, EnvVarNames), - ( - FunctionBody0 = body_defined_here(Stmt), - FunctionBody = body_defined_here(rename_statement(Stmt)) - ; - FunctionBody0 = body_external, - FunctionBody = body_external - ), - Entity = mlds_function(MaybePredProcId, Params, FunctionBody, - Attributes, EnvVarNames) - ; - Entity0 = mlds_class(ClassDefn0), - ClassDefn0 = mlds_class_defn(Kind, Imports, Inherits, Implements, - TypeParams, Ctors0, Members0), - Ctors = list.map(rename_defn, Ctors0), - Members = list.map(rename_defn, Members0), - ClassDefn = mlds_class_defn(Kind, Imports, Inherits, Implements, - TypeParams, Ctors, Members), - Entity = mlds_class(ClassDefn) - ), - Defn = mlds_defn(Name, Context, Flags, Entity). - -:- func rename_maybe_statement(maybe(statement)) = maybe(statement). - -rename_maybe_statement(no) = no. -rename_maybe_statement(yes(Stmt)) = yes(rename_statement(Stmt)). - -:- func rename_gc_statement(mlds_gc_statement) = mlds_gc_statement. - -rename_gc_statement(gc_no_stmt) = gc_no_stmt. -rename_gc_statement(gc_trace_code(Stmt)) - = gc_trace_code(rename_statement(Stmt)). -rename_gc_statement(gc_initialiser(Stmt)) - = gc_initialiser(rename_statement(Stmt)). - -:- func rename_statement(statement) = statement. - -rename_statement(statement(ml_stmt_block(Defns, Stmts), Context)) - = statement(ml_stmt_block(list.map(rename_defn, Defns), - list.map(rename_statement, Stmts)), Context). -rename_statement(statement(ml_stmt_while(Kind, Rval, Loop), Context)) - = statement(ml_stmt_while(Kind, rename_rval(Rval), rename_statement(Loop)), - Context). -rename_statement(statement(ml_stmt_if_then_else(Rval, Then, MaybeElse), - Context)) = - statement(ml_stmt_if_then_else(rename_rval(Rval), - rename_statement(Then), - rename_maybe_statement(MaybeElse)), Context). -rename_statement(statement(ml_stmt_switch(Type, Rval, Range, Cases, Default0), - Context)) - = statement(ml_stmt_switch(Type, rename_rval(Rval), Range, - list.map(rename_switch_case, Cases), Default), Context) :- - ( - Default0 = default_is_unreachable, - Default = default_is_unreachable - ; - Default0 = default_do_nothing, - Default = default_do_nothing - ; - Default0 = default_case(Stmt), - Default = default_case(rename_statement(Stmt)) - ). -rename_statement(statement(ml_stmt_label(Label), Context)) - = statement(ml_stmt_label(Label), Context). -rename_statement(statement(ml_stmt_goto(Label), Context)) - = statement(ml_stmt_goto(Label), Context). -rename_statement(statement(ml_stmt_computed_goto(Rval, Labels), Context)) - = statement(ml_stmt_computed_goto(rename_rval(Rval), Labels), Context). - -rename_statement(statement( - ml_stmt_call(Signature, Rval, MaybeThis0, Args, Results, TailCall), - Context)) - = statement(ml_stmt_call(Signature, rename_rval(Rval), - MaybeThis, list.map(rename_rval, Args), - list.map(rename_lval, Results), TailCall), Context) :- - ( - MaybeThis0 = yes(Self), - MaybeThis = yes(rename_rval(Self)) - ; - MaybeThis0 = no, - MaybeThis = no - ). - -rename_statement(statement(ml_stmt_return(Vals), Context)) - = statement(ml_stmt_return(Vals), Context). -rename_statement(statement(ml_stmt_try_commit(Lval, Try, Handler), Context)) - = statement(ml_stmt_try_commit(rename_lval(Lval), rename_statement(Try), - rename_statement(Handler)), Context). -rename_statement(statement(ml_stmt_do_commit(Rval), Context)) - = statement(ml_stmt_do_commit(rename_rval(Rval)), Context). -rename_statement(statement(ml_stmt_atomic(Stmt), Context)) - = statement(ml_stmt_atomic(rename_atomic(Stmt)), Context). - -:- func rename_switch_case(mlds_switch_case) = mlds_switch_case. - -rename_switch_case(Case0) = Case :- - Case0 = mlds_switch_case(FirstCond0, LaterConds0, Stmt0), - FirstCond = rename_cond(FirstCond0), - LaterConds = list.map(rename_cond, LaterConds0), - Stmt = rename_statement(Stmt0), - Case = mlds_switch_case(FirstCond, LaterConds, Stmt). - -:- func rename_cond(mlds_case_match_cond) = mlds_case_match_cond. - -rename_cond(match_value(Rval)) = match_value(rename_rval(Rval)). -rename_cond(match_range(RvalA, RvalB)) - = match_range(rename_rval(RvalA), rename_rval(RvalB)). - -:- func rename_atomic(mlds_atomic_statement) = mlds_atomic_statement. - -rename_atomic(comment(S)) = comment(S). -rename_atomic(assign(L, R)) = assign(rename_lval(L), rename_rval(R)). -rename_atomic(assign_if_in_heap(L, R)) = - assign(rename_lval(L), rename_rval(R)). -rename_atomic(delete_object(O)) = delete_object(rename_rval(O)). -rename_atomic(new_object(L, Tag, ExplicitSecTag, Type, MaybeSize, Ctxt, Args, - Types, MayUseAtomic, AllocId)) - = new_object(rename_lval(L), Tag, ExplicitSecTag, Type, MaybeSize, - Ctxt, list.map(rename_rval, Args), Types, MayUseAtomic, AllocId). -rename_atomic(gc_check) = gc_check. -rename_atomic(mark_hp(L)) = mark_hp(rename_lval(L)). -rename_atomic(restore_hp(R)) = restore_hp(rename_rval(R)). -rename_atomic(trail_op(T)) = trail_op(T). -rename_atomic(inline_target_code(L, Cs)) = inline_target_code(L, Cs). -rename_atomic(outline_foreign_proc(F, Vs, Ls, S)) - = outline_foreign_proc(F, Vs, Ls, S). - -:- func rename_rval(mlds_rval) = mlds_rval. - -rename_rval(ml_lval(Lval)) = ml_lval(rename_lval(Lval)). -rename_rval(ml_mkword(Tag, Rval)) = ml_mkword(Tag, rename_rval(Rval)). -rename_rval(ml_const(Const)) = ml_const(rename_const(Const)). -rename_rval(ml_unop(Op, Rval)) = ml_unop(Op, rename_rval(Rval)). -rename_rval(ml_binop(Op, RvalA, RvalB)) = - ml_binop(Op, rename_rval(RvalA), rename_rval(RvalB)). -rename_rval(ml_mem_addr(Lval)) = ml_mem_addr(rename_lval(Lval)). -rename_rval(ml_scalar_common(ScalarCommon)) = ml_scalar_common(ScalarCommon). -rename_rval(ml_vector_common_row(VectorCommon, RowRval)) = - ml_vector_common_row(VectorCommon, rename_rval(RowRval)). -rename_rval(ml_self(Type)) = ml_self(Type). - -:- func rename_const(mlds_rval_const) = mlds_rval_const. - -rename_const(mlconst_true) = mlconst_true. -rename_const(mlconst_false) = mlconst_false. -rename_const(mlconst_int(I)) = mlconst_int(I). -rename_const(mlconst_enum(I, T)) = mlconst_enum(I, T). -rename_const(mlconst_char(C)) = mlconst_char(C). -rename_const(mlconst_foreign(L, F, T)) = mlconst_foreign(L, F, T). -rename_const(mlconst_float(F)) = mlconst_float(F). -rename_const(mlconst_string(S)) = mlconst_string(S). -rename_const(mlconst_multi_string(S)) = mlconst_multi_string(S). -rename_const(mlconst_named_const(NC)) = mlconst_named_const(NC). -rename_const(mlconst_code_addr(C)) = mlconst_code_addr(rename_code_addr(C)). -rename_const(mlconst_data_addr(A)) = mlconst_data_addr(rename_data_addr(A)). -rename_const(mlconst_null(T)) = mlconst_null(T). - -:- func rename_code_addr(mlds_code_addr) = mlds_code_addr. - -rename_code_addr(code_addr_proc(Label, Signature)) - = code_addr_proc(rename_proc_label(Label), Signature). -rename_code_addr(code_addr_internal(Label, Seq, Signature)) - = code_addr_internal(rename_proc_label(Label), Seq, Signature). - -rename_proc_label(qual(Module, _QualKind, Name)) - = qual(mlds_append_wrapper_class(Module), type_qual, Name). - -:- func rename_lval(mlds_lval) = mlds_lval. - -rename_lval(ml_field(Tag, Address, FieldName, FieldType, PtrType)) - = ml_field(Tag, rename_rval(Address), - rename_field_id(FieldName), FieldType, PtrType). -rename_lval(ml_mem_ref(Rval, Type)) = ml_mem_ref(rename_rval(Rval), Type). -rename_lval(ml_global_var_ref(Ref)) = ml_global_var_ref(Ref). -rename_lval(ml_var(Var, Type)) = ml_var(rename_mlds_var(Var, Type), Type). - -:- func rename_field_id(mlds_field_id) = mlds_field_id. - -rename_field_id(ml_field_offset(Rval)) = ml_field_offset(rename_rval(Rval)). -rename_field_id(ml_field_named(Name, Type)) = ml_field_named(Name, Type). - -:- func rename_initializer(mlds_initializer) = mlds_initializer. - -rename_initializer(init_obj(Rval)) = init_obj(rename_rval(Rval)). -rename_initializer(init_struct(Type, Inits)) - = init_struct(Type, list.map(rename_initializer, Inits)). -rename_initializer(init_array(Inits)) - = init_array(list.map(rename_initializer, Inits)). -rename_initializer(no_initializer) = no_initializer. - - % We need to append a wrapper class qualifier so that we access - % the RTTI fields correctly. - % -:- func rename_data_addr(mlds_data_addr) = mlds_data_addr. - -rename_data_addr(data_addr(ModuleName, Name)) - = data_addr(mlds_append_wrapper_class(ModuleName), Name). - - % We need to append a wrapper class qualifier so that we refer to the - % methods of the wrapper class. - % -:- func rename_proc_label(mlds_qualified_proc_label) - = mlds_qualified_proc_label. - - % Again append a wrapper class qualifier to the var name. - % -:- func rename_mlds_var(mlds_var, mlds_type) = mlds_var. - -rename_mlds_var(qual(ModuleName, _QualKind, Name), _Type) - = qual(mlds_append_wrapper_class(ModuleName), type_qual, Name). - -%-----------------------------------------------------------------------------% -%-----------------------------------------------------------------------------% - -:- pred mlds_defn_to_ilasm_decl(mlds_defn::in, il_decl::out, - il_info::in, il_info::out) is det. - -mlds_defn_to_ilasm_decl(mlds_defn(Name, Context, Flags0, Data), Decl, !Info) :- - % IL supports top-level (i.e. "global") function definitions and - % data definitions, but they're not part of the CLS. - % Since they are not part of the CLS, we don't generate them, - % and so there's no need to handle them here. - ( - Data = mlds_data(_Type, _Init, _GC), - sorry($module, $pred, "top level data definition!") - ; - Data = mlds_function(_MaybePredProcId, _Params, _MaybeStmts, _Attrs, - _EnvVarNames), - sorry($module, $pred, "top level function definition!") - ; - Data = mlds_class(ClassDefn), - il_info_new_class(ClassDefn, !Info), - - generate_class_body(Name, Context, ClassDefn, ClassName, EntityName, - Extends, Interfaces, MethodsAndFieldsAndCtors, !Info), - - % Only the wrapper class needs to have the initialization instructions - % executed by the class constructor. - ( EntityName = wrapper_class_name -> - Imports = !.Info ^ imports, - InitInstrs = cord.list(!.Info ^ init_instrs), - AllocInstrs = cord.list(!.Info ^ alloc_instrs), - - % Generate a field that records whether we have finished - % RTTI initialization. - generate_rtti_initialization_field(ClassName, - AllocDoneFieldRef, AllocDoneField), - - % Generate a class constructor. - make_class_constructor_class_member(AllocDoneFieldRef, - Imports, AllocInstrs, InitInstrs, CCtor, !Info), - - % The declarations in this class. - MethodDecls = [AllocDoneField, CCtor | MethodsAndFieldsAndCtors] - ; - MethodDecls = MethodsAndFieldsAndCtors - ), - % XXX Needed to work around a bug where private classes aren't - % accessible from classes in the same assembly when that assembly - % is created by al.exe. This occurs for nondet environment classes - % in the mercury std library. - ( ClassName = structured_name(assembly("mercury"), _, _) -> - Flags = set_access(Flags0, acc_public) - ; - Flags = Flags0 - ), - Decl = ildecl_class(decl_flags_to_classattrs(Flags), EntityName, - Extends, Interfaces, MethodDecls) - ). - -:- pred generate_class_body(mlds_entity_name::in, mlds_context::in, - mlds_class_defn::in, ilds.class_name::out, ilds.id::out, - extends::out, implements::out, list(class_member)::out, - il_info::in, il_info::out) is det. - -generate_class_body(Name, Context, ClassDefn, ClassName, EntityName, Extends, - Interfaces, ClassMembers, !Info) :- - EntityName = entity_name_to_ilds_id(Name), - ClassDefn = mlds_class_defn(Kind, _Imports, Inherits, Implements, - _TypeParams, Ctors0, Members), - Parent - Extends = generate_parent_and_extends(!.Info ^ il_data_rep, - Kind, Inherits), - Interfaces = implements( - list.map(interface_id_to_class_name, Implements)), - ClassName = class_name(!.Info ^ module_name, EntityName), - list.map_foldl(generate_method(ClassName, no), Members, - MethodsAndFields, !Info), - Ctors = maybe_add_empty_ctor(Ctors0, Kind, Context), - list.map_foldl(generate_method(ClassName, yes(Parent)), Ctors, - IlCtors, !Info), - ClassMembers = IlCtors ++ MethodsAndFields. - - % For IL, every class needs a constructor, otherwise you can't use the - % newobj instruction to allocate instances of the class. So if a class - % doesn't already have one, we add an empty one. - % -:- func maybe_add_empty_ctor(list(mlds_defn), mlds_class_kind, mlds_context) = - list(mlds_defn). - -maybe_add_empty_ctor(Ctors0, Kind, Context) = Ctors :- - ( - Kind = mlds_class, - Ctors0 = [] - -> - % Generate an empty block for the body of the constructor. - Stmt = statement(ml_stmt_block([], []), Context), - - Attributes = [], - EnvVarNames = set.init, - Ctor = mlds_function(no, mlds_func_params([], []), - body_defined_here(Stmt), Attributes, EnvVarNames), - CtorFlags = init_decl_flags(acc_public, per_instance, non_virtual, - overridable, modifiable, concrete), - - CtorDefn = mlds_defn(entity_export(".ctor"), Context, CtorFlags, Ctor), - Ctors = [CtorDefn] - ; - Ctors = Ctors0 - ). - -:- func generate_parent_and_extends(il_data_rep, mlds_class_kind, - list(mlds_class_id)) = pair(ilds.class_name, extends). - -generate_parent_and_extends(DataRep, Kind, Inherits) = Parent - Extends :- - ( - Inherits = [], - ( - Kind = mlds_struct, - Parent = il_generic_valuetype_name, - Extends = extends(Parent) - ; - Kind = mlds_enum, - Parent = il_generic_enum_name, - Extends = extends(Parent) - ; - ( Kind = mlds_class - ; Kind = mlds_package - ; Kind = mlds_interface - ), - Parent = il_generic_class_name, - Extends = extends_nothing - ) - ; - Inherits = [Parent0 | Rest], - ( - Rest = [], - Parent = mlds_type_to_ilds_class_name(DataRep, Parent0), - Extends = extends(Parent) - ; - Rest = [_ | _], - unexpected($module, $pred, "multiple inheritance not supported") - ) - ). - -class_name(Module, Name) - = append_toplevel_class_name(mlds_module_name_to_class_name(Module), Name). - -:- func decl_flags_to_classattrs(mlds_decl_flags) = list(ilasm.classattr). - -decl_flags_to_classattrs(Flags) = - list.condense([Access, decl_flags_to_classattrs_2(Flags)]) :- - AccessFlag = access(Flags), - ( - AccessFlag = acc_public, - Access = [public] - ; - AccessFlag = acc_protected, - unexpected($module, $pred, "protected access flag") - ; - AccessFlag = acc_private, - Access = [private] - ; - AccessFlag = acc_default, - % To make members of the private class accessible to other types - % in the assembly, set their access to be default or public. - Access = [private] - ; - AccessFlag = acc_local, - unexpected($module, $pred, "local access flag") - ). - -:- func decl_flags_to_nestedclassattrs(mlds_decl_flags) = - list(ilasm.classattr). - -decl_flags_to_nestedclassattrs(Flags) - = list.condense([Access, decl_flags_to_classattrs_2(Flags)]) :- - AccessFlag = access(Flags), - ( - AccessFlag = acc_public, - Access = [nestedpublic] - ; - AccessFlag = acc_protected, - Access = [nestedfamily] - ; - AccessFlag = acc_private, - Access = [nestedprivate] - ; - AccessFlag = acc_default, - Access = [nestedassembly] - ; - AccessFlag = acc_local, - unexpected($module, $pred, "local access flag") - ). - -:- func decl_flags_to_classattrs_2(mlds_decl_flags) = list(ilasm.classattr). - -decl_flags_to_classattrs_2(Flags) = ClassAttrs :- - OverridabilityFlag = overridability(Flags), - ( - OverridabilityFlag = overridable, - Overridability = [] - ; - OverridabilityFlag = sealed, - Overridability = [sealed] - ), - AbstractnessFlag = abstractness(Flags), - ( - AbstractnessFlag = concrete, - Abstractness = [] - ; - AbstractnessFlag = abstract, - Abstractness = [abstract] - ), - ClassAttrs = list.condense([Overridability, Abstractness]). - -:- func decl_flags_to_methattrs(mlds_decl_flags) = list(ilasm.methattr). - -decl_flags_to_methattrs(Flags) - = list.condense([Access, PerInstance, Virtuality, - Overridability, Abstractness]) :- - AccessFlag = access(Flags), - ( - AccessFlag = acc_public, - Access = [public] - ; - AccessFlag = acc_protected, - Access = [family] - ; - AccessFlag = acc_private, - Access = [private] - ; - AccessFlag = acc_default, - Access = [assembly] - ; - AccessFlag = acc_local, - unexpected($module, $pred, "local access flag") - ), - PerInstanceFlag = per_instance(Flags), - ( - PerInstanceFlag = one_copy, - PerInstance = [static] - ; - PerInstanceFlag = per_instance, - PerInstance = [] - ), - VirtualityFlag = virtuality(Flags), - ( - VirtualityFlag = non_virtual, - Virtuality = [] - ; - VirtualityFlag = virtual, - Virtuality = [virtual] - ), - OverridabilityFlag = overridability(Flags), - ( - OverridabilityFlag = overridable, - Overridability = [] - ; - OverridabilityFlag = sealed, - Overridability = [final] - ), - AbstractnessFlag = abstractness(Flags), - ( - AbstractnessFlag = concrete, - Abstractness = [] - ; - AbstractnessFlag = abstract, - Abstractness = [abstract] - ). - -:- func decl_flags_to_fieldattrs(mlds_decl_flags) = list(ilasm.fieldattr). - -decl_flags_to_fieldattrs(Flags) - = list.condense([Access, PerInstance, Constness]) :- - AccessFlag = access(Flags), - ( - AccessFlag = acc_public, - Access = [public] - ; - AccessFlag = acc_protected, - Access = [family] - ; - AccessFlag = acc_private, - Access = [private] - ; - AccessFlag = acc_default, - Access = [assembly] - ; - AccessFlag = acc_local, - % Access = [private] - unexpected($module, $pred, "local access flag") - ), - PerInstanceFlag = per_instance(Flags), - ( - PerInstanceFlag = one_copy, - PerInstance = [static] - ; - PerInstanceFlag = per_instance, - PerInstance = [] - ), - ConstnessFlag = constness(Flags), - ( - ConstnessFlag = modifiable, - Constness = [] - ; - ConstnessFlag = const, - Constness = [initonly] - ). - -:- func entity_name_to_ilds_id(mlds_entity_name) = ilds.id. - -entity_name_to_ilds_id(entity_export(Name)) = Name. -entity_name_to_ilds_id(entity_function(PredLabel, ProcId, MaybeSeqNum, _)) - = Name :- - predlabel_to_ilds_id(PredLabel, ProcId, MaybeSeqNum, Name). -entity_name_to_ilds_id(entity_type(Name, Arity)) - = string.format("%s_%d", [s(Name), i(Arity)]). -entity_name_to_ilds_id(entity_data(DataName)) = Name :- - mangle_dataname(DataName, Name). - -:- func interface_id_to_class_name(mlds_interface_id) = ilds.class_name. - -interface_id_to_class_name(_) = Result :- - % XXX - ( semidet_succeed -> - sorry($module, $pred, "NYI") - ; - Result = structured_name(assembly("XXX"), [], []) - ). - -%-----------------------------------------------------------------------------% - -:- pred generate_method(ilds.class_name::in, maybe(ilds.class_name)::in, - mlds_defn::in, class_member::out, il_info::in, il_info::out) is det. - -generate_method(ClassName, _, mlds_defn(Name, Context, Flags, Entity), - ClassMember, !Info) :- - Entity = mlds_data(Type, DataInitializer, _GCStatement), - - FieldName = entity_name_to_ilds_id(Name), - - Attrs = decl_flags_to_fieldattrs(Flags), - - % Generate instructions to initialize this data. There are two sorts of - % instructions, instructions to allocate the data structure, and - % instructions to initialize it. See the comments about class constructors - % to find out why we do this. - data_initializer_to_instrs(DataInitializer, Type, AllocInstrsTree, - InitInstrTree, !Info), - - % Make a field reference for the field. - DataRep = !.Info ^ il_data_rep, - ILType = mlds_type_to_ilds_type(DataRep, Type), - FieldRef = make_fieldref(ILType, ClassName, FieldName), - - % If we had to allocate memory, the code we generate looks like this: - % - % // allocation for foo - % ... allocation instructions ... - % stsfld thisclass::foo - % - % - % // initializer for foo - % ldsfld thisclass::foo - % ... initialization code ... - % pop - % - % The final pop is necessary because the init code will leave the field - % on the stack, but we don't need it anymore (and we already set the field - % when we allocated it). - % - % If no memory had to be allocated, the code is a bit simpler. - % - % // allocation for foo - % nothing here! - % - % // initializer for foo - % ... initialization code ... - % stsfld thisclass::foo - % - % Note that here we have to set the field. - - ( cord.is_empty(AllocInstrsTree) -> - StoreAllocTree = empty, - StoreInitTree = singleton(stsfld(FieldRef)), - LoadTree = empty - ; - StoreAllocTree = singleton(stsfld(FieldRef)), - StoreInitTree = singleton(pop), - LoadTree = singleton(ldsfld(FieldRef)) - ), - - % Add a store after the alloc instrs (if necessary) - AllocInstrs = cord.list( - context_node(Context) ++ - comment_node(string.append("allocation for ", FieldName)) ++ - AllocInstrsTree ++ - StoreAllocTree), - - % Add a load before the init instrs (if necessary) - InitInstrs = cord.list( - context_node(Context) ++ - comment_node(string.append("initializer for ", FieldName)) ++ - LoadTree ++ - InitInstrTree ++ - StoreInitTree), - - % Add these instructions to the lists of allocation/initialization - % instructions. They will be put into the class constructor later. - il_info_add_alloc_instructions(AllocInstrs, !Info), - il_info_add_init_instructions(InitInstrs, !Info), - - MaybeOffset = no, - Initializer = none, - - ClassMember = member_field(Attrs, ILType, FieldName, MaybeOffset, - Initializer). - -generate_method(_, IsCons, mlds_defn(Name, Context, Flags, Entity), - ClassMember, !Info) :- - Entity = mlds_function(_MaybePredProcId, Params, MaybeStatement, - Attributes, EnvVarNames), - - expect(set.is_empty(EnvVarNames), $module, $pred, "EnvVarNames"), - - il_info_get_module_name(!.Info, ModuleName), - -% XXX We formerly returned a list of definitions, so we could put -% this term in a comment term, so we cannot currently do this. -% -% % Generate a term (we use it to emit the complete method definition -% % as a comment, which is nice for debugging). -% term.type_to_term(defn(Name, Context, Flags, Entity), _MLDSDefnTerm), - - % Generate the signature - Params = mlds_func_params(Args, Returns), - ILArgs = list.map(mlds_arg_to_il_arg, Args), - DataRep = !.Info ^ il_data_rep, - ILSignature = params_to_il_signature(DataRep, ModuleName, Params), - - % Generate the name - ( - IsCons = yes(ParentClass), - MemberName = ctor, - CSharpMemberName = ctor, - CtorInstrs = [load_this, - call(methoddef(call_conv(yes, default), void, - class_member_name(ParentClass, ctor), []))] - ; - IsCons = no, - ( - Name = entity_function(PredLabel, ProcId, MaybeSeqNum, _PredId), - predlabel_to_ilds_id(PredLabel, ProcId, MaybeSeqNum, MemberName0), - predlabel_to_csharp_id(PredLabel, ProcId, MaybeSeqNum, - CSharpMemberName0), - MemberName = id(MemberName0), - CSharpMemberName = id(CSharpMemberName0) - ; - Name = entity_export(ExportName), - MemberName = id(ExportName), - CSharpMemberName = id(ExportName) - ; - ( Name = entity_type(_, _) - ; Name = entity_data(_) - ), - unexpected($module, $pred, "IL procedure is not a function") - ), - CtorInstrs = [] - ), - - Attrs = decl_flags_to_methattrs(Flags), - - % Initialize the IL info with this method info. - il_info_new_method(ILArgs, ILSignature, MemberName, CSharpMemberName, - !Info), - - % Start a new block, which we will use to wrap up the entire method. - il_info_get_next_block_id(BlockId, !Info), - - % Generate the code of the statement. - ( - MaybeStatement = body_defined_here(Statement), - statement_to_il(Statement, InstrsTree1, !Info), - % Need to insert a ret for functions returning void (MLDS doesn't). - ( - Returns = [], - MaybeRet = singleton(ret) - ; - Returns = [_ | _], - MaybeRet = empty - ) - ; - MaybeStatement = body_external, - - % XXX The external reference must currently reside in the - % C# file associated with this file. This is very hackish. - ForeignLangs = !.Info ^ file_foreign_langs, - !Info ^ file_foreign_langs := - set.insert(ForeignLangs, lang_csharp), - - mangle_dataname_module(no, ModuleName, NewModuleName), - ClassName = mlds_module_name_to_class_name(NewModuleName), - - ILSignature = signature(_, ILRetType, ILParams), - TypeParams = il_method_params_to_il_types(ILParams), - - list.map_foldl( - (pred(_::in, Instr::out, Num::in, Num+1::out) is det :- - Instr = ldarg(index(Num)) - ), TypeParams, LoadInstrs, 0, _), - InstrsTree1 = - comment_node("external -- call handwritten version") ++ - from_list(LoadInstrs) ++ - singleton(call(get_static_methodref(ClassName, - CSharpMemberName, ILRetType, TypeParams))), - MaybeRet = singleton(ret) - ), - - % Retrieve the locals, put them in the enclosing scope. - il_info_get_locals_list(!.Info, Locals), - InstrsTree2 = - context_node(Context) ++ - from_list(CtorInstrs) ++ - context_node(Context) ++ - singleton(start_block(bt_scope(Locals), BlockId)) ++ - InstrsTree1 ++ - MaybeRet ++ - singleton(end_block(bt_scope(Locals), BlockId)), - - % If this is main, add the entrypoint, set a flag, wrap the code - % in an exception handler and call the initialization instructions - % in the cctor of this module. - ( - Name = entity_function(MainPredLabel, _ProcId, no, _), - MainPredLabel = mlds_user_pred_label(pf_predicate, no, "main", 2, - model_det, no) - -> - EntryPoint = [entrypoint], - !Info ^ has_main := has_main, - - il_info_get_next_block_id(InnerTryBlockId, !Info), - il_info_get_next_block_id(OuterTryBlockId, !Info), - il_info_get_next_block_id(InnerCatchBlockId, !Info), - il_info_get_next_block_id(OuterCatchBlockId, !Info), - il_info_make_next_label(DoneLabel, !Info), - - % Replace all the returns with leave instructions; as a side effect, - % this means that we can no longer have any tail calls, so replace them - % with nops. - RenameRets = (func(I) = - (if (I = ret) then - leave(label_target(DoneLabel)) - else if (I = tailcall) then - nop - else - I - ) - ), - - UnivSymName = qualified(unqualified("univ"), "univ"), - UnivMercuryType = defined_type(UnivSymName, [], kind_star), - UnivMLDSType = mercury_type(UnivMercuryType, - ctor_cat_user(cat_user_general), - non_foreign_type(UnivMercuryType)), - UnivType = mlds_type_to_ilds_type(DataRep, UnivMLDSType), - - MercuryExceptionClassName = mercury_runtime_name(["Exception"]), - - ExceptionClassName = structured_name(il_system_assembly_name, - ["System", "Exception"], []), - - FieldRef = make_fieldref(UnivType, MercuryExceptionClassName, - "mercury_exception"), - - ConsoleWriteName = class_member_name( - structured_name(il_system_assembly_name, - ["System", "Console"], []), - id("Write")), - - UncaughtExceptionName = class_member_name( - mercury_library_wrapper_class_name(["exception"]), - id("ML_report_uncaught_exception")), - - WriteString = methoddef(call_conv(no, default), - void, ConsoleWriteName, [il_string_type]), - WriteUncaughtException = methoddef(call_conv(no, default), - void, UncaughtExceptionName, [UnivType]), - WriteObject = methoddef(call_conv(no, default), - void, ConsoleWriteName, [il_generic_type]), - - % A code block to catch any exception at all. - - CatchAnyException = - from_list([ - start_block(bt_catch(ExceptionClassName), OuterCatchBlockId), - ldstr("\nUncaught system exception: \n"), - call(WriteString), - call(WriteObject), - ldc(int32, i(1)), - call(il_set_exit_code), - leave(label_target(DoneLabel)), - end_block(bt_catch(ExceptionClassName), OuterCatchBlockId) - ]), - - % Code to catch Mercury exceptions. - CatchUserException = - from_list([ - start_block(bt_catch(MercuryExceptionClassName), - InnerCatchBlockId), - ldfld(FieldRef), - call(WriteUncaughtException), - - ldc(int32, i(1)), - call(il_set_exit_code), - - leave(label_target(DoneLabel)), - end_block(bt_catch(MercuryExceptionClassName), - InnerCatchBlockId) - ]), - - % Wrap an exception handler around the main code. This allows us - % to debug programs remotely without a window popping up asking - % how you wish to debug. Pressing the cancel button on this window - % is a bit difficult remotely. - % - % Inside this exception handler, we catch any exceptions and - % print them. - % - % We nest the Mercury exception handler so that any exceptions thrown - % in ML_report_uncaught_exception will be caught by the outer - % (more general) exception handler. - % - % try { - % try { - % ... main instructions ... - % } - % catch (mercury.runtime.Exception me) { - % ML_report_uncaught_exception(me); - % System.Environment.ExitCode = 1; - % } - % } - % catch (System.Exception e) { - % System.Console.Write(e); - % System.Environment.ExitCode = 1; - % } - - InstrsTree = - from_list([ - % outer try block - start_block(bt_try, OuterTryBlockId), - - % inner try block - start_block(bt_try, InnerTryBlockId) - ]) ++ - cord.map(RenameRets, InstrsTree2) ++ - from_list([ - leave(label_target(DoneLabel)), - end_block(bt_try, InnerTryBlockId) - ]) ++ - % inner catch block - CatchUserException ++ - from_list([ - leave(label_target(DoneLabel)), - end_block(bt_try, OuterTryBlockId) - ]) ++ - % outer catch block - CatchAnyException ++ - from_list([ - label(DoneLabel), - ret - ]) - ; - EntryPoint = [], - InstrsTree = InstrsTree2 - ), - - % Generate the entire method contents. - DebugIlAsm = !.Info ^ debug_il_asm, - VerifiableCode = !.Info ^ verifiable_code, - MethodBody = make_method_defn(DebugIlAsm, VerifiableCode, - InstrsTree), - CustomAttributes = attributes_to_custom_attributes(DataRep, - Attributes), - list.condense([EntryPoint, CustomAttributes, MethodBody], - MethodContents), - - ClassMember = member_method(methodhead(Attrs, MemberName, - ILSignature, []), MethodContents). - -generate_method(_, _, mlds_defn(Name, Context, Flags, Entity), ClassMember, - !Info) :- - Entity = mlds_class(ClassDefn), - generate_class_body(Name, Context, ClassDefn, _ClassName, EntityName, - Extends, Interfaces, ClassMembers, !Info), - ClassMember = member_nested_class(decl_flags_to_nestedclassattrs(Flags), - EntityName, Extends, Interfaces, ClassMembers). - -%-----------------------------------------------------------------------------% - -:- func attributes_to_custom_attributes(il_data_rep, list(mlds_attribute)) - = list(method_body_decl). - -attributes_to_custom_attributes(DataRep, Attrs) = - list.map(attribute_to_custom_attribute(DataRep), Attrs). - -:- func attribute_to_custom_attribute(il_data_rep, mlds_attribute) - = method_body_decl. - -attribute_to_custom_attribute(DataRep, custom(MLDSType)) - = custom(CustomDecl) :- - ClassName = mlds_type_to_ilds_class_name(DataRep, MLDSType), - MethodRef = get_constructor_methoddef(ClassName, []), - CustomDecl = custom_decl(methodref(MethodRef), no, no_initalizer). - -%-----------------------------------------------------------------------------% -%-----------------------------------------------------------------------------% - - % MLDS exports are converted into forwarding functions, which are - % marked as public, are given the specified name, and simply call to - % the "exported" function. - % - % They will be placed inside the "mercury_code" wrapper class with - % all the other procedures. - % - % XXX Much of this code should be generalized and turned into a - % more general routine for generating MLDS forwarding functions. - % We could use almost the same approach for outline_foreign_code - % to generate the forwarding function. - % -:- pred mlds_export_to_mlds_defn(mlds_pragma_export::in, mlds_defn::out) - is det. - -mlds_export_to_mlds_defn(ExportDefn, Defn) :- - ExportDefn = ml_pragma_export(Lang, ExportName, EntityName, Params, - _UnivQTVars, Context), - EntityName = qual(ModuleName, _QualKind, UnqualName), - expect(unify(Lang, lang_il), $module, $pred, - "export for language other than IL."), - Params = mlds_func_params(Inputs, RetTypes), - list.map_foldl( - (pred(RT::in, RV - Lval::out, N0::in, N0 + 1::out) is det :- - VN = mlds_var_name("returnval" ++ int_to_string(N0), no), - % We don't need to worry about tracing variables for - % accurate GC in the IL back-end -- the .NET runtime - % system itself provides accurate GC. - GCStatement = gc_no_stmt, - RV = ml_gen_mlds_var_decl_init(mlds_data_var(VN), RT, - no_initializer, GCStatement, Context), - Lval = ml_var(qual(ModuleName, module_qual, VN), RT) - ), RetTypes, ReturnVars, 0, _), - - EntNameToVarName = (func(EntName) = VarName :- - ( EntName = entity_data(mlds_data_var(VarName0)) -> - VarName = qual(ModuleName, module_qual, VarName0) - ; - unexpected($module, $pred, - "exported method has argument without var name") - ) - ), - ArgTypes = mlds_get_arg_types(Inputs), - ArgRvals = list.map( - (func(mlds_argument(EntName, Type, _GCStatement)) = - ml_lval(ml_var(VarName, Type)) :- - VarName = EntNameToVarName(EntName) - ), Inputs), - ReturnVarDecls = assoc_list.keys(ReturnVars), - ReturnLvals = assoc_list.values(ReturnVars), - ReturnRvals = list.map((func(X) = ml_lval(X)), ReturnLvals), - - Signature = mlds_func_signature(ArgTypes, RetTypes), - ( - UnqualName = entity_function(PredLabel, ProcId, _MaybeSeq, _PredId), - CodeRval = ml_const(mlconst_code_addr(code_addr_proc( - qual(ModuleName, module_qual, mlds_proc_label(PredLabel, ProcId)), - Signature))) - ; - ( UnqualName = entity_type(_, _) - ; UnqualName = entity_data(_) - ; UnqualName = entity_export(_) - ), - unexpected($module, $pred, "exported entity is not a function") - ), - - % XXX Should we look for tail calls? - CallStatement = statement( - ml_stmt_call(Signature, CodeRval, no, ArgRvals, ReturnLvals, - ordinary_call), Context), - ReturnStatement = statement(ml_stmt_return(ReturnRvals), Context), - - Statement = statement(ml_stmt_block(ReturnVarDecls, - ( ReturnRvals = [] -> - [CallStatement] - ; - [CallStatement, ReturnStatement] - ) - ), Context), - - Attributes = [], - EnvVarNames = set.init, - DefnEntity = mlds_function(no, Params, body_defined_here(Statement), - Attributes, EnvVarNames), - - Flags = init_decl_flags(acc_public, one_copy, non_virtual, overridable, - const, concrete), - Defn = mlds_defn(entity_export(ExportName), Context, Flags, DefnEntity). - -%-----------------------------------------------------------------------------% -%-----------------------------------------------------------------------------% -% -% Code for generating initializers. -% - - % Generate initializer code from an MLDS defn. We are only expecting - % data defns at this point (local vars), not functions or classes. - % -:- pred generate_defn_initializer(mlds_defn::in, - instr_tree::in, instr_tree::out, il_info::in, il_info::out) is det. - -generate_defn_initializer(mlds_defn(Name, Context, _DeclFlags, Entity), - !Tree, !Info) :- - ( - Name = entity_data(DataName), - Entity = mlds_data(MLDSType, Initializer, _GCStatement) - -> - ( Initializer = no_initializer -> - true - ; - ( DataName = mlds_data_var(VarName) -> - il_info_get_module_name(!.Info, ModuleName), - Lval = ml_var(qual(ModuleName, module_qual, VarName), - MLDSType), - get_load_store_lval_instrs(Lval, - LoadMemRefInstrs, StoreLvalInstrs, !Info), - NameString = mangle_mlds_var_name(VarName) - ; - LoadMemRefInstrs = throw_unimplemented( - "initializer_for_non_var_data_name"), - StoreLvalInstrs = empty, - NameString = "unknown" - ), - data_initializer_to_instrs(Initializer, MLDSType, - AllocInstrs, InitInstrs, !Info), - Comment = "initializer for " ++ NameString, - !:Tree = - !.Tree ++ - context_node(Context) ++ - comment_node(Comment) ++ - LoadMemRefInstrs ++ - AllocInstrs ++ - InitInstrs ++ - StoreLvalInstrs - ) - ; - unexpected($module, $pred, "defn not data(...) in block") - ). - - % Initialize this value, leave it on the stack. - % XXX the code generator doesn't box these values - % we need to look ahead at them and box them appropriately. - % -:- pred data_initializer_to_instrs(mlds_initializer::in, mlds_type::in, - instr_tree::out, instr_tree::out, il_info::in, il_info::out) is det. - -data_initializer_to_instrs(init_obj(Rval), _Type, empty, InitInstrs, - !Info) :- - load(Rval, InitInstrs, !Info). - - % MLDS structures initializers are assumed to be initialized like - % structures in C, which means nested elements are actually laid out - % flat in the structure. - % - % So we flatten structures, and then process them as arrays - % (this may have to be re-visited if used to initialise high-level data). - % -data_initializer_to_instrs(init_struct(_StructType, InitList0), Type, - AllocInstrs, InitInstrs, !Info) :- - InitList = flatten_inits(InitList0), - data_initializer_to_instrs(init_array(InitList), Type, - AllocInstrs, InitInstrs, !Info). - - % Put the array allocation in AllocInstrs. - % For sub-initializations, we don't worry about keeping AllocInstrs - % and InitInstrs apart, since we are only interested in top level - % allocations. -data_initializer_to_instrs(init_array(InitList), Type, - AllocInstrs, InitInstrs, !Info) :- - % Figure out the array element type. - DataRep = !.Info ^ il_data_rep, - ( Type = mlds_array_type(ElemType0) -> - ElemType = ElemType0, - ILElemType = mlds_type_to_ilds_type(DataRep, ElemType) - ; - % XXX We assume struct fields have type mlds_generic_type - % This is probably wrong for --high-level-data. - ElemType = mlds_generic_type, - ILElemType = il_generic_type - ), - ILElemType = il_type(_, ILElemSimpleType), - - % To initialize an array, we generate the following code: - % ldc - % newarr - % - % Then, for each element in the array: - % dup - % ldc - % ... allocation instructions ... - % ... initialization instructions ... - % box the value (if necessary) - % stelem - % - % The initialization will leave the array on the stack. - % - AllocInstrs = from_list([ - ldc(int32, i(list.length(InitList))), - newarr(ILElemType) - ]), - AddInitializer = - (pred(Init0::in, X0 - Tree0::in, (X0 + 1) - Tree::out, - Info0::in, Info::out) is det :- - % we may need to box the arguments - % XXX is this right? - ( ElemType = mlds_generic_type -> - maybe_box_initializer(Init0, Init) - ; - Init = Init0 - ), - data_initializer_to_instrs(Init, ElemType, - ATree1, ITree1, Info0, Info), - Tree = Tree0 ++ from_list([dup, ldc(int32, i(X0))]) ++ - ATree1 ++ ITree1 ++ singleton(stelem(ILElemSimpleType)) - ), - list.foldl2(AddInitializer, InitList, 0 - empty, _ - InitInstrs, !Info). -data_initializer_to_instrs(no_initializer, _, empty, empty, !Info). - - % If we are initializing an array or struct, we need to box - % all the things inside it. - % -:- pred maybe_box_initializer(mlds_initializer::in, mlds_initializer::out) - is det. - - % nothing to do -maybe_box_initializer(no_initializer, no_initializer). - % array already boxed -maybe_box_initializer(init_array(X), init_array(X)). - % struct already boxed -maybe_box_initializer(init_struct(Type, X), init_struct(Type, X)). - % single items need to be boxed -maybe_box_initializer(init_obj(Rval), init_obj(NewRval)) :- - rval_to_type(Rval, BoxType), - NewRval = ml_unop(box(BoxType), Rval). - - % Code to flatten nested intializers. - % -:- func flatten_inits(list(mlds_initializer)) = list(mlds_initializer). - -flatten_inits(Inits) = list.condense(list.map(flatten_init, Inits)). - -:- func flatten_init(mlds_initializer) = list(mlds_initializer). - -flatten_init(I) = Inits :- - ( I = init_struct(_Type, Inits0) -> - Inits = flatten_inits(Inits0) - ; I = init_array(Inits0) -> - Inits = flatten_inits(Inits0) - ; - Inits = [I] - ). - -%-----------------------------------------------------------------------------% -% -% Convert basic MLDS statements into IL. -% - -:- pred statements_to_il(list(statement)::in, instr_tree::out, - il_info::in, il_info::out) is det. - -statements_to_il([], empty, !Info). -statements_to_il([HeadStmt | TailStmts], HeadCode ++ TailCode, !Info) :- - statement_to_il(HeadStmt, HeadCode, !Info), - statements_to_il(TailStmts, TailCode, !Info). - -:- pred statement_to_il(statement::in, instr_tree::out, - il_info::in, il_info::out) is det. - -statement_to_il(statement(BlockStmt, Context), Instrs, !Info) :- - BlockStmt = ml_stmt_block(Defns, Statements), - il_info_get_module_name(!.Info, ModuleName), - il_info_get_next_block_id(BlockId, !Info), - list.map(defn_to_local(ModuleName), Defns, Locals), - il_info_add_locals(Locals, !Info), - list.foldl2(generate_defn_initializer, Defns, empty, - InitInstrsTree, !Info), - statements_to_il(Statements, BlockInstrs, !Info), - DataRep = !.Info ^ il_data_rep, - list.map((pred((K - V)::in, (K - W)::out) is det :- - W = mlds_type_to_ilds_type(DataRep, V)), Locals, ILLocals), - Scope = bt_scope(ILLocals), - Instrs = - context_node(Context) ++ - singleton(start_block(Scope, BlockId)) ++ - InitInstrsTree ++ - comment_node("block body") ++ - BlockInstrs ++ - singleton(end_block(Scope, BlockId)), - il_info_remove_locals(Locals, !Info). - -statement_to_il(statement(ml_stmt_atomic(Atomic), Context), Instrs, !Info) :- - atomic_statement_to_il(Atomic, AtomicInstrs, !Info), - Instrs = context_node(Context) ++ AtomicInstrs. - -statement_to_il(statement(CallStmt, Context), Instrs, !Info) :- - CallStmt = ml_stmt_call(Sig, Function, _This, Args, Returns, CallKind), - VerifiableCode = !.Info ^ verifiable_code, - ByRefTailCalls = !.Info ^ il_byref_tailcalls, - MsCLR = !.Info ^ support_ms_clr, - RotorCLR = !.Info ^ support_rotor_clr, - DataRep = !.Info ^ il_data_rep, - TypeParams = mlds_signature_to_ilds_type_params(DataRep, Sig), - ReturnParam = mlds_signature_to_il_return_param(DataRep, Sig), - CallerSig = !.Info ^ signature, - CallerSig = signature(_, CallerReturnParam, _), - ( - ( CallKind = tail_call ; CallKind = no_return_call ), - % If --verifiable-code is enabled, and the arguments contain one - % or more byrefs, then don't emit the "tail." prefix, unless - % --il-byref-tailcalls is set. - \+ ( - VerifiableCode = yes, - some [Ref] ( - list.member(Ref, TypeParams), - ( Ref = il_type(_, '&'(_)) - ; Ref = il_type(_, '*'(_)) - ; Ref = il_type(_, refany) - ) - ), - ByRefTailCalls = no - ), - % If --verifiable-code is enabled, then we must not output the "tail." - % prefix unless the callee return type is compatible with the caller - % return type. - \+ ( - VerifiableCode = yes, - ReturnParam \= CallerReturnParam - ), - % In the MS CLR implementation the callee and caller return type - % of a tail call must be compatible even when we are using - % unverifiable code. - \+ ( - MsCLR = yes, - ReturnParam \= CallerReturnParam - ), - % The ROTOR implementation only allows "tail." annotations on direct - % calls (tail.call), not indirect calls (calli). - \+ ( - RotorCLR = yes, - Function \= ml_const(_) - ) - -> - TailCallInstrs = [tailcall], - % For calls marked with "tail.", we need a `ret' instruction - % immediately after the call (this is in fact needed for correct IL, - % not just for verifiability). - RetInstrs = [ret], - ReturnsStoredInstrs = empty, - LoadMemRefInstrs = empty - ; - % For non-tail calls, we might have to load a memory reference - % before the call so we can store the result into the memory reference - % after the call. - TailCallInstrs = [], - RetInstrs = [], - get_all_load_store_lval_instrs(Returns, - LoadMemRefInstrs, ReturnsStoredInstrs, !Info) - ), - list.map_foldl(load, Args, ArgsLoadInstrsTrees, !Info), - ArgsLoadInstrs = cord_list_to_cord(ArgsLoadInstrsTrees), - ( Function = ml_const(Const) -> - FunctionLoadInstrs = empty, - const_rval_to_function(Const, MemberName), - Instrs0 = [call(methoddef(call_conv(no, default), - ReturnParam, MemberName, TypeParams))] - ; - load(Function, FunctionLoadInstrs, !Info), - MakeMethodParam = (func(MethodType) = MethodParam :- - MethodParam = il_method_param(MethodType, no) - ), - ParamsList = list.map(MakeMethodParam, TypeParams), - Instrs0 = [calli(signature(call_conv(no, default), - ReturnParam, ParamsList))] - ), - Instrs = - context_node(Context) ++ - comment_node("call") ++ - LoadMemRefInstrs ++ - ArgsLoadInstrs ++ - FunctionLoadInstrs ++ - from_list(TailCallInstrs) ++ - from_list(Instrs0) ++ - from_list(RetInstrs) ++ - ReturnsStoredInstrs. - -statement_to_il(statement(IfThenElseStmt, Context), Instrs, !Info) :- - IfThenElseStmt = ml_stmt_if_then_else(Condition, ThenCase, ElseCase), - generate_condition(Condition, ConditionInstrs, ElseLabel, !Info), - il_info_make_next_label(DoneLabel, !Info), - statement_to_il(ThenCase, ThenInstrs, !Info), - maybe_map_fold(statement_to_il, ElseCase, empty, ElseInstrs, !Info), - Instrs = - context_node(Context) ++ - comment_node("if then else") ++ - ConditionInstrs ++ - comment_node("then case") ++ - ThenInstrs ++ - singleton(br(label_target(DoneLabel))) ++ - singleton(label(ElseLabel)) ++ - comment_node("else case") ++ - ElseInstrs ++ - comment_node("end if then else") ++ - singleton(label(DoneLabel)). - -statement_to_il(statement(SwitchStmt, _Context), _Instrs, !Info) :- - SwitchStmt = ml_stmt_switch(_Type, _Val, _Range, _Cases, _Default), - % The IL back-end only supports computed_gotos and if-then-else chains; - % the MLDS code generator should either avoid generating MLDS switches, - % or should transform them into computed_gotos or if-then-else chains. - unexpected($module, $pred, "`switch' not supported"). - -statement_to_il(statement(WhileStmt, Context), Instrs, !Info) :- - WhileStmt = ml_stmt_while(Kind, Condition, Body), - generate_condition(Condition, ConditionInstrs, EndLabel, !Info), - il_info_make_next_label(StartLabel, !Info), - statement_to_il(Body, BodyInstrs, !Info), - ( - Kind = may_loop_zero_times, - Instrs = - context_node(Context) ++ - comment_node("while") ++ - singleton(label(StartLabel)) ++ - ConditionInstrs ++ - BodyInstrs ++ - singleton(br(label_target(StartLabel))) ++ - singleton(label(EndLabel)) - ; - Kind = loop_at_least_once, - % XXX This generates a branch over branch which is suboptimal. - Instrs = - context_node(Context) ++ - comment_node("while (actually do ... while)") ++ - singleton(label(StartLabel)) ++ - BodyInstrs ++ - ConditionInstrs ++ - singleton(br(label_target(StartLabel))) ++ - singleton(label(EndLabel)) - ). - -statement_to_il(statement(ml_stmt_return(Rvals), Context), Instrs, !Info) :- - ( - Rvals = [], - unexpected($module, $pred, "empty list of return values") - ; - Rvals = [Rval], - load(Rval, LoadInstrs, !Info), - Instrs = - context_node(Context) ++ - LoadInstrs ++ - singleton(ret) - ; - Rvals = [_, _ | _], - % MS IL doesn't support multiple return values - sorry($module, $pred, "multiple return values") - ). - -statement_to_il(statement(ml_stmt_label(Label), Context), Instrs, !Info) :- - string.format("label %s", [s(Label)], Comment), - Instrs = from_list([ - comment(Comment), - context_instr(Context), - label(Label) - ]). - -statement_to_il(statement(GotoLabelStmt, Context), Instrs, !Info) :- - GotoLabelStmt = ml_stmt_goto(goto_label(Label)), - string.format("goto %s", [s(Label)], Comment), - Instrs = from_list([ - comment(Comment), - context_instr(Context), - br(label_target(Label)) - ]). - -statement_to_il(statement(ml_stmt_goto(goto_break), _Context), _Instrs, - !Info) :- - sorry($module, $pred, "break"). - -statement_to_il(statement(ml_stmt_goto(goto_continue), _Context), _Instrs, - !Info) :- - sorry($module, $pred, "continue"). - -statement_to_il(statement(DoCommitStmt, Context), Instrs, !Info) :- - DoCommitStmt = ml_stmt_do_commit(_Ref), - - % For commits, we use exception handling. - % - % For a do_commit instruction, we generate code equivalent - % to the following C#/Java code: - % - % throw new mercury.runtime.Commit(); - % - % In IL the code looks like this: - % - % newobj instance void - % ['mercury']'mercury'.'runtime'.'Commit'::.ctor() - % throw - % - NewObjInstr = newobj_constructor(il_commit_class_name, []), - Instrs = - context_node(Context) ++ - comment_node("do_commit/1") ++ - singleton(NewObjInstr) ++ - singleton(throw). - -statement_to_il(statement(TryCommitStmt, Context), Instrs, !Info) :- - TryCommitStmt = ml_stmt_try_commit(_Ref, GoalToTry, CommitHandlerGoal), - - % For commits, we use exception handling. - % - % For try_commit instructions, we generate IL code - % of the following form: - % - % .try { - % - % leave label1 - % } catch commit_type { - % pop // discard the exception object - % - % leave label1 - % } - % label1: - % - il_info_get_next_block_id(TryBlockId, !Info), - statement_to_il(GoalToTry, GoalInstrsTree, !Info), - il_info_get_next_block_id(CatchBlockId, !Info), - statement_to_il(CommitHandlerGoal, HandlerInstrsTree, !Info), - il_info_make_next_label(DoneLabel, !Info), - - ClassName = il_commit_class_name, - Instrs = - context_node(Context) ++ - comment_node("try_commit/3") ++ - - singleton(start_block(bt_try, TryBlockId)) ++ - GoalInstrsTree ++ - singleton(leave(label_target(DoneLabel))) ++ - singleton(end_block(bt_try, TryBlockId)) ++ - - singleton(start_block(bt_catch(ClassName), CatchBlockId)) ++ - comment_node("discard the exception object") ++ - singleton(pop) ++ - HandlerInstrsTree ++ - singleton(leave(label_target(DoneLabel))) ++ - singleton(end_block(bt_catch(ClassName), CatchBlockId)) ++ - singleton(label(DoneLabel)). - -statement_to_il(statement(ComputedGotoStmt, Context), Instrs, !Info) :- - ComputedGotoStmt = ml_stmt_computed_goto(Rval, MLDSLabels), - load(Rval, RvalLoadInstrs, !Info), - Targets = list.map(func(L) = label_target(L), MLDSLabels), - Instrs = - context_node(Context) ++ - comment_node("computed goto") ++ - RvalLoadInstrs ++ - singleton(switch(Targets)). - -:- pred atomic_statement_to_il(mlds_atomic_statement::in, instr_tree::out, - il_info::in, il_info::out) is det. - -atomic_statement_to_il(gc_check, singleton(Instr), !Info) :- - Instr = comment("gc check -- not relevant for this backend"). -atomic_statement_to_il(mark_hp(_), singleton(Instr), !Info) :- - Instr = comment("mark hp -- not relevant for this backend"). -atomic_statement_to_il(restore_hp(_), singleton(Instr), !Info) :- - Instr = comment("restore hp -- not relevant for this backend"). - -atomic_statement_to_il(outline_foreign_proc(Lang, _, ReturnLvals, _Code), - Instrs, !Info) :- - il_info_get_module_name(!.Info, ModuleName), - ( - !.Info ^ method_foreign_lang = no, - Info0 = !.Info, - !Info ^ method_foreign_lang := yes(Lang), - !Info ^ file_foreign_langs := - set.insert(Info0 ^ file_foreign_langs, Lang), - mangle_foreign_code_module(Lang, ModuleName, OutlineLangModuleName), - ClassName = mlds_module_name_to_class_name(OutlineLangModuleName), - signature(_, RetType, Params) = !.Info ^ signature, - - ( - ReturnLvals = [], - % If there is a return type, but no return value, it must be - % a semidet predicate so put it in SUCCESS_INDICATOR. - % XXX It would be better to get the code generator - % to tell us this is the case directly. - LoadInstrs = empty, - ( RetType = void -> - StoreInstrs = empty - ; - StoreInstrs = singleton(stloc(name("SUCCESS_INDICATOR"))) - ) - ; - ReturnLvals = [ReturnLval], - get_load_store_lval_instrs(ReturnLval, LoadInstrs, StoreInstrs, - !Info) - ; - ReturnLvals = [_, _ | _], - sorry($module, $pred, "multiple return values") - ), - MethodName = !.Info ^ csharp_method_name, - TypeParams = il_method_params_to_il_types(Params), - list.map_foldl((pred(_::in, Instr::out, - Num::in, Num + 1::out) is det :- - Instr = ldarg(index(Num))), - TypeParams, LoadArgInstrs, 0, _), - Instrs = - comment_node("outline foreign proc -- call handwritten version") ++ - LoadInstrs ++ - from_list(LoadArgInstrs) ++ - singleton(call(get_static_methodref(ClassName, MethodName, RetType, - TypeParams))) ++ - StoreInstrs - ; - !.Info ^ method_foreign_lang = yes(_), - Instrs = comment_node("outline foreign proc -- already called") - ). - -atomic_statement_to_il(inline_target_code(ml_target_il, Code), Instrs, - !Info) :- - Instrs = inline_code_to_il_asm(Code). -atomic_statement_to_il(inline_target_code(ml_target_c, _Code), _Instrs, - !Info) :- - unexpected($module, $pred, "ml_target_c"). -atomic_statement_to_il(inline_target_code(ml_target_csharp, _Code), _Instrs, - !Info) :- - unexpected($module, $pred, "ml_target_csharp"). -atomic_statement_to_il(inline_target_code(ml_target_java, _Code), _Instrs, - !Info) :- - unexpected($module, $pred, "ml_target_java"). -atomic_statement_to_il(inline_target_code(ml_target_gnu_c, _), _, !Info) :- - unexpected($module, $pred, "ml_target_gnu_c"). - - % NOTE: for the MLDS backends trail ops are currently implemented by - % the HLDS->HLDS transformation in add_trail_ops.m. If we encounter - % an MLDS trail op it's an error. - % -atomic_statement_to_il(trail_op(_), _, _, _) :- - unexpected($module, $pred, "trail ops"). - -atomic_statement_to_il(assign(Lval, Rval), Instrs, !Info) :- - % Do assignments by loading the rval and storing to the lval. - load(Rval, LoadRvalInstrs, !Info), - get_load_store_lval_instrs(Lval, LoadMemRefInstrs, StoreLvalInstrs, - !Info), - Instrs = - comment_node("assign") ++ - LoadMemRefInstrs ++ - LoadRvalInstrs ++ - StoreLvalInstrs. - -atomic_statement_to_il(assign_if_in_heap(_, _), _, !Info) :- - sorry($module, $pred, "assign_if_in_heap"). - -atomic_statement_to_il(comment(Comment), Instrs, !Info) :- - Instrs = singleton(comment(Comment)). - -atomic_statement_to_il(delete_object(_Target), Instrs, !Info) :- - % XXX We assume the code generator knows what it is doing and is only - % going to delete real objects (e.g. reference types). It would perhaps - % be prudent to check the type of delete_object (if it had one) to - % make sure. - - % We implement delete_object by storing null in the lval, which hopefully - % gives the garbage collector a good solid hint that this storage is - % no longer required. - % - % XXX commented out because `delete_object' was changed to take an rval - % instead of an lval - % - % get_load_store_lval_instrs(Target, LoadInstrs, StoreInstrs, !Info), - % Instrs = LoadInstrs ++ singleton(ldnull) ++ StoreInstrs. - Instrs = empty. - -atomic_statement_to_il(NewObject, Instrs, !Info) :- - NewObject = new_object(Target0, _MaybeTag, ExplicitSecTag, Type, - Size, MaybeCtorName, Args, ArgTypes, _MayUseAtomic, _AllocId), - ( - ExplicitSecTag = yes, - unexpected($module, $pred, "new_object has explicit secondary tag") - ; - ExplicitSecTag = no - ), - DataRep = !.Info ^ il_data_rep, - ( - ( - Type = mlds_generic_env_ptr_type - ; - Type = mlds_class_type(_, _, mlds_class) - ; - DataRep ^ highlevel_data = yes, - Type = mercury_type(MercuryType, ctor_cat_user(_), _), - \+ type_needs_lowlevel_rep(target_il, MercuryType) - ) - -> - % If this is a class, we should call the constructor. (This is needed - % for nondet environment classes, and also for high-level data.) - % We generate code of the form: - % - % ... load memory reference ... - % // new object (call constructor) - % ... load each argument ... - % call ClassName::.ctor - % ... store to memory reference ... - - ClassName0 = mlds_type_to_ilds_class_name(DataRep, Type), - ( - MaybeCtorName = yes(QualifiedCtorName), - QualifiedCtorName = qual(_, _, ctor_id(CtorName, CtorArity)), - CtorType = - entity_name_to_ilds_id(entity_type(CtorName, CtorArity)), - ClassName = append_nested_class_name(ClassName0, [CtorType]) - ; - MaybeCtorName = no, - ClassName = ClassName0 - ), - ILArgTypes = list.map(mlds_type_to_ilds_type(DataRep), ArgTypes), - list.map_foldl(load, Args, ArgsLoadInstrsTrees, !Info), - ArgsLoadInstrs = cord_list_to_cord(ArgsLoadInstrsTrees), - - % If the new object is being assigned to private_builtin.dummy_var - % then we need to cast it to il_generic_type. - ( - Target0 = ml_var(qual(MLDS_Module, QualKind, VarName), _), - VarName = mlds_var_name("dummy_var", _), - PrivateBuiltin = mercury_private_builtin_module, - MLDS_PrivateBuiltin = mercury_module_name_to_mlds(PrivateBuiltin), - mlds_append_wrapper_class(MLDS_PrivateBuiltin) = MLDS_Module - -> - MaybeCastInstrs = singleton(castclass(il_generic_type)), - Target = ml_var(qual(MLDS_Module, QualKind, VarName), - mlds_generic_type) - ; - MaybeCastInstrs = empty, - Target = Target0 - ), - get_load_store_lval_instrs(Target, LoadMemRefInstrs, - StoreLvalInstrs, !Info), - CallCtor = newobj_constructor(ClassName, ILArgTypes), - Instrs = - LoadMemRefInstrs ++ - comment_node("new object (call constructor)") ++ - ArgsLoadInstrs ++ - singleton(CallCtor) ++ - MaybeCastInstrs ++ - StoreLvalInstrs - ; - % Otherwise this is a generic mercury object -- we use an array - % of System::Object to represent it. - % - % ... load memory reference ... - % // new object - % ldc - % newarr - % - % And then for each array element: - % - % dup - % ldc - % ... load rval ... - % stelem System::Object - % - % Finally, after all the array elements have been set: - % - % ... store to memory reference ... - % - % Note that the MLDS code generator is responsible for boxing/unboxing - % the arguments if needed. - - % Load each rval. - % XXX We do almost exactly the same code when initializing array - % data structures -- we should reuse that code. - LoadInArray = - (pred(Rval::in, I::out, Arg0::in, Arg::out) is det :- - Arg0 = Index - S0, - I0 = singleton(dup), - load(ml_const(mlconst_int(Index)), I1, S0, S1), - - % XXX the MLDS code generator is meant to be responsible for - % boxing the args, but when compiled with the highlevel_data - % where we have overridden the type to use a lowlevel - % representation it doesn't get this right. - rval_to_type(Rval, RvalType), - ILRvalType = mlds_type_to_ilds_type(DataRep, RvalType), - ( already_boxed(ILRvalType) -> - NewRval = Rval - ; - NewRval = ml_unop(box(RvalType), Rval) - ), - - load(NewRval, I2, S1, S), - I3 = singleton(stelem(il_generic_simple_type)), - I = I0 ++ I1 ++ I2 ++ I3, - Arg = (Index + 1) - S - ), - list.map_foldl(LoadInArray, Args, ArgsLoadInstrsTrees, - 0 - !.Info, _ - !:Info), - ArgsLoadInstrs = cord_list_to_cord(ArgsLoadInstrsTrees), - - % Get the instructions to load and store the target. - get_load_store_lval_instrs(Target0, LoadMemRefInstrs, StoreLvalInstrs, - !Info), - ( - Size = yes(SizeInWordsRval0), - SizeInWordsRval = SizeInWordsRval0 - ; - Size = no, - % XXX Do we need to handle this case? - % I think it's needed for --high-level-data. - unexpected($module, $pred, "unknown size in MLDS new_object") - ), - load(SizeInWordsRval, LoadSizeInstrs, !Info), - - Instrs = - LoadMemRefInstrs ++ - comment_node("new object") ++ - LoadSizeInstrs ++ - singleton(newarr(il_generic_type)) ++ - ArgsLoadInstrs ++ - StoreLvalInstrs - ). - -:- func inline_code_to_il_asm(list(target_code_component)) = instr_tree. - -inline_code_to_il_asm([]) = empty. -inline_code_to_il_asm([T | Ts]) = Instrs ++ Rest :- - ( - T = user_target_code(Code, MaybeContext, Attrs), - ( yes(max_stack_size(N)) = get_max_stack_attribute(Attrs) -> - ( - MaybeContext = yes(Context), - Instrs0 = context_node(mlds_make_context(Context)) - ; - MaybeContext = no, - Instrs0 = empty - ), - Instrs = Instrs0 ++ singleton(il_asm_code(Code, N)) - ; - unexpected($module, $pred, "max_stack_size not set") - ) - ; - T = raw_target_code(Code, Attrs), - MaybeMaxStack = get_max_stack_attribute(Attrs), - ( - MaybeMaxStack = yes(max_stack_size(N)), - Instrs = singleton(il_asm_code(Code, N)) - ; - MaybeMaxStack = no, - unexpected($module, $pred, "max_stack_size not set") - ) - ; - T = target_code_input(_), - Instrs = empty - ; - T = target_code_output(_), - Instrs = empty - ; - T = target_code_type(_), - Instrs = empty - ; - T = target_code_name(_), - Instrs = empty - ; - T = target_code_alloc_id(_), - unexpected($module, $pred, "target_code_alloc_id not implemented") - ), - Rest = inline_code_to_il_asm(Ts). - -:- func get_max_stack_attribute(target_code_attributes) = - maybe(target_code_attribute). - -get_max_stack_attribute([]) = no. -get_max_stack_attribute([X | _Xs]) = yes(X) :- X = max_stack_size(_). - -:- pred get_all_load_store_lval_instrs(list(mlds_lval)::in, - instr_tree::out, instr_tree::out, il_info::in, il_info::out) is det. - -get_all_load_store_lval_instrs([], empty, empty, !Info). -get_all_load_store_lval_instrs([Lval | Lvals], - LoadMemRefNode ++ LoadMemRefTree, - StoreLvalNode ++ StoreLvalTree, !Info) :- - get_load_store_lval_instrs(Lval, LoadMemRefNode, StoreLvalNode, !Info), - get_all_load_store_lval_instrs(Lvals, LoadMemRefTree, StoreLvalTree, - !Info). - - % Some lvals need to be loaded before you load the rval. - % XXX It would be much better if this took the lval and the rval and - % just gave you a single tree. Instead it gives you the "before" tree - % and the "after" tree and asks you to sandwich the rval in between. - % The predicate `store' should probably take the lval and the rval - % and do all of this at once. - % -:- pred get_load_store_lval_instrs(mlds_lval::in, - instr_tree::out, instr_tree::out, - il_info::in, il_info::out) is det. - -get_load_store_lval_instrs(Lval, LoadMemRefInstrs, StoreLvalInstrs, !Info) :- - DataRep = !.Info ^ il_data_rep, - ( Lval = ml_mem_ref(Rval0, MLDS_Type) -> - load(Rval0, LoadMemRefInstrs, !Info), - SimpleType = mlds_type_to_ilds_simple_type(DataRep, MLDS_Type), - StoreLvalInstrs = singleton(stind(SimpleType)) - ; Lval = ml_field(_MaybeTag, FieldRval, FieldNum, FieldType, ClassType) -> - ClassILType = mlds_type_to_ilds_type(DataRep, ClassType), - ( ClassILType = il_type(_, '[]'(_, _)) -> - ( - FieldNum = ml_field_offset(OffsetRval), - FieldILType = mlds_type_to_ilds_simple_type(DataRep, - FieldType), - load(FieldRval, LoadArrayRval, !Info), - load(OffsetRval, LoadIndexRval, !Info), - LoadMemRefInstrs = LoadArrayRval ++ LoadIndexRval, - StoreLvalInstrs = singleton(stelem(FieldILType)) - ; - FieldNum = ml_field_named(_, _), - unexpected($module, $pred, - "ml_field_named for a type with an array representation.") - ) - ; - get_fieldref(DataRep, FieldNum, FieldType, ClassType, FieldRef, - CastClassInstrs), - load(FieldRval, LoadMemRefInstrs0, !Info), - LoadMemRefInstrs = LoadMemRefInstrs0 ++ CastClassInstrs, - StoreLvalInstrs = singleton(stfld(FieldRef)) - ) - ; - LoadMemRefInstrs = empty, - store(Lval, StoreLvalInstrs, !Info) - ). - -%-----------------------------------------------------------------------------% -% -% Load and store. -% -% NOTE: Be very careful calling store directly. You probably want to call -% get_load_store_lval_instrs to generate the prelude part (which will load -% any memory reference that need to be loaded) and the store part (while will -% store the rval into the pre-loaded lval), and then sandwich the calculation -% of the rval in between the two. - -:- pred load(mlds_rval::in, instr_tree::out, il_info::in, il_info::out) is det. - -load(Rval, Instrs, !Info) :- - ( - Rval = ml_lval(Lval), - DataRep = !.Info ^ il_data_rep, - ( - Lval = ml_var(Var, VarType), - mangle_mlds_var(Var, MangledVarStr), - ( is_local(MangledVarStr, !.Info) -> - Instrs = singleton(ldloc(name(MangledVarStr))) - ; is_argument(MangledVarStr, !.Info) -> - Instrs = singleton(ldarg(name(MangledVarStr))) - ; is_local_field(Var, VarType, !.Info, FieldRef) -> - Instrs = singleton(ldsfld(FieldRef)) - ; - FieldRef = make_static_fieldref(DataRep, Var, VarType), - Instrs = singleton(ldsfld(FieldRef)) - ) - ; - Lval = ml_field(_MaybeTag, BaseRval, FieldNum, FieldType, - ClassType), - load(BaseRval, BaseRvalLoadInstrs, !Info), - ( FieldNum = ml_field_offset(OffSet) -> - SimpleFieldType = mlds_type_to_ilds_simple_type(DataRep, - FieldType), - load(OffSet, OffSetLoadInstrs, !Info), - CastClassInstrs = empty, - LoadInstruction = ldelem(SimpleFieldType) - ; - get_fieldref(DataRep, FieldNum, FieldType, ClassType, FieldRef, - CastClassInstrs), - LoadInstruction = ldfld(FieldRef), - OffSetLoadInstrs = empty - ), - Instrs = - BaseRvalLoadInstrs ++ - CastClassInstrs ++ - OffSetLoadInstrs ++ - singleton(LoadInstruction) - ; - Lval = ml_mem_ref(BaseRval, MLDS_Type), - SimpleType = mlds_type_to_ilds_simple_type(DataRep, MLDS_Type), - load(BaseRval, BaseRvalLoadInstrs, !Info), - Instrs = BaseRvalLoadInstrs ++ singleton(ldind(SimpleType)) - ; - Lval = ml_global_var_ref(_), - Instrs = throw_unimplemented("load lval mem_ref") - ) - ; - Rval = ml_mkword(_Tag, _Rval), - Instrs = comment_node("unimplemented load rval mkword") - ; - Rval = ml_const(Const), - % XXX check these, what should we do about multi strings, - % characters, etc. - DataRep = !.Info ^ il_data_rep, - % True and false are just the integers 1 and 0. - ( - Const = mlconst_true, - Instrs = singleton(ldc(bool, i(1))) - ; - Const = mlconst_false, - Instrs = singleton(ldc(bool, i(0))) - ; - Const = mlconst_string(Str), - Instrs = singleton(ldstr(Str)) - ; - ( Const = mlconst_int(Int) - ; Const = mlconst_enum(Int, _) - ; Const = mlconst_char(Int) - ), - Instrs = singleton(ldc(int32, i(Int))) - ; - Const = mlconst_foreign(_Lang, _F, _T), - sorry($module, $pred, "NYI IL backend and foreign tags.") - ; - Const = mlconst_float(Float), - Instrs = singleton(ldc(float64, f(Float))) - ; - Const = mlconst_multi_string(_MultiString), - Instrs = throw_unimplemented("load multi_string_const") - ; - Const = mlconst_named_const(_NamedConst), - Instrs = throw_unimplemented("load named_const") - ; - Const = mlconst_code_addr(CodeAddr), - MethodRef = code_addr_constant_to_methodref(DataRep, CodeAddr), - Instrs = singleton(ldftn(MethodRef)) - ; - Const = mlconst_data_addr(DataAddr), - data_addr_constant_to_fieldref(DataAddr, FieldRef), - Instrs = singleton(ldsfld(FieldRef)) - ; - Const = mlconst_null(_MLDSType), - % We might consider loading an integer for null function types. - Instrs = singleton(ldnull) - ) - ; - Rval = ml_unop(Unop, RvalA), - load(RvalA, RvalALoadInstrs, !Info), - unaryop_to_il(Unop, RvalA, UnOpInstrs, !Info), - Instrs = RvalALoadInstrs ++ UnOpInstrs - ; - Rval = ml_binop(BinOp, RvalA, RvalB), - load(RvalA, RvalALoadInstrs, !Info), - load(RvalB, RvalBLoadInstrs, !Info), - binaryop_to_il(BinOp, BinaryOpInstrs, !Info), - Instrs = RvalALoadInstrs ++ RvalBLoadInstrs ++ BinaryOpInstrs - ; - Rval = ml_mem_addr(Lval), - DataRep = !.Info ^ il_data_rep, - ( - Lval = ml_var(Var, VarType), - mangle_mlds_var(Var, MangledVarStr), - ( is_local(MangledVarStr, !.Info) -> - Instrs = singleton(ldloca(name(MangledVarStr))) - ; is_argument(MangledVarStr, !.Info) -> - Instrs = singleton(ldarga(name(MangledVarStr))) - ; is_local_field(Var, VarType, !.Info, FieldRef) -> - Instrs = singleton(ldsfld(FieldRef)) - ; - FieldRef = make_static_fieldref(DataRep, Var, VarType), - Instrs = singleton(ldsfld(FieldRef)) - ) - ; - Lval = ml_field(_MaybeTag, BaseRval, FieldNum, FieldType, - ClassType), - get_fieldref(DataRep, FieldNum, FieldType, ClassType, - FieldRef, CastClassInstrs), - load(BaseRval, BaseRvalLoadInstrs, !Info), - Instrs = - BaseRvalLoadInstrs ++ - CastClassInstrs ++ - singleton(ldflda(FieldRef)) - ; - Lval = ml_mem_ref(_, _), - % XXX Implement this. - Instrs = throw_unimplemented("load mem_addr lval mem_ref") - ; - Lval = ml_global_var_ref(_), - Instrs = throw_unimplemented("load mem_addr lval global_var_ref") - ) - ; - Rval = ml_scalar_common(_), - Instrs = throw_unimplemented("load scalar_common") - ; - Rval = ml_vector_common_row(_, _), - Instrs = throw_unimplemented("load vector_common_row") - ; - Rval = ml_self(_), - Instrs = singleton(ldarg(index(0))) - ). - -:- pred store(mlds_lval::in, instr_tree::out, il_info::in, il_info::out) - is det. - -store(Lval, Instrs, !Info) :- - ( - Lval = ml_field(_MaybeTag, Rval, FieldNum, FieldType, ClassType), - DataRep = !.Info ^ il_data_rep, - get_fieldref(DataRep, FieldNum, FieldType, ClassType, - FieldRef, CastClassInstrs), - load(Rval, RvalLoadInstrs, !Info), - Instrs = - CastClassInstrs ++ - RvalLoadInstrs ++ - singleton(stfld(FieldRef)) - ; - Lval = ml_mem_ref(_Rval, _Type), - % You always need load the reference first, then the value, - % then stind it. There's no swap instruction. Annoying, eh? - unexpected($module, $pred, "store into mem_ref") - ; - Lval = ml_global_var_ref(_), - unexpected($module, $pred, "store into global_var_ref") - ; - Lval = ml_var(Var, VarType), - DataRep = !.Info ^ il_data_rep, - mangle_mlds_var(Var, MangledVarStr), - ( is_local(MangledVarStr, !.Info) -> - Instrs = singleton(stloc(name(MangledVarStr))) - ; is_argument(MangledVarStr, !.Info) -> - Instrs = singleton(starg(name(MangledVarStr))) - ; - FieldRef = make_static_fieldref(DataRep, Var, VarType), - Instrs = singleton(stsfld(FieldRef)) - ) - ). - -%-----------------------------------------------------------------------------% -% -% Convert binary and unary operations to IL. -% - -:- pred unaryop_to_il(mlds_unary_op::in, mlds_rval::in, instr_tree::out, - il_info::in, il_info::out) is det. - - % Once upon a time the MLDS code generator generated primary tag tests - % (but we don't use primary tags). - % If we make mktag return its operand (since it will always be - % called with 0 as its operand), and we make tag return 0, it will - % always succeed in the tag test (which is good, with tagbits = 0 - % we want to always succeed all primary tag tests). - -unaryop_to_il(std_unop(mktag), _, comment_node("mktag (a no-op)"), !Info). -unaryop_to_il(std_unop(tag), _, Instrs, !Info) :- - load(ml_const(mlconst_int(0)), Instrs, !Info). -unaryop_to_il(std_unop(unmktag), _, comment_node("unmktag (a no-op)"), !Info). -unaryop_to_il(std_unop(strip_tag),_,comment_node("strip_tag (a no-op)"), - !Info). -unaryop_to_il(std_unop(mkbody), _, comment_node("mkbody (a no-op)"), !Info). -unaryop_to_il(std_unop(unmkbody), _, comment_node("unmkbody (a no-op)"), - !Info). -unaryop_to_il(std_unop(bitwise_complement), _, singleton(bitwise_not), !Info). - - % Might want to revisit this and define not to be only valid on 1 or 0, - % then we can use ldc.i4.1 and xor, which might be more efficient. -unaryop_to_il(std_unop(logical_not), _, - from_list([ldc(int32, i(1)), clt(unsigned)]), !Info). -unaryop_to_il(std_unop(hash_string), _, - singleton(call(il_mercury_string_hash)), !Info). -unaryop_to_il(std_unop(hash_string2), _, _, !Info) :- - unexpected($module, $pred, "hash_string2"). -unaryop_to_il(std_unop(hash_string3), _, _, !Info) :- - unexpected($module, $pred, "hash_string3"). -unaryop_to_il(std_unop(hash_string4), _, _, !Info) :- - unexpected($module, $pred, "hash_string4"). -unaryop_to_il(std_unop(hash_string5), _, _, !Info) :- - unexpected($module, $pred, "hash_string5"). -unaryop_to_il(std_unop(hash_string6), _, _, !Info) :- - unexpected($module, $pred, "hash_string6"). - - % XXX Should detect casts to System.Array from array types - % and ignore them, as they are not necessary. -unaryop_to_il(cast(DestType), SrcRval, Instrs, !Info) :- - DataRep = !.Info ^ il_data_rep, - DestILType = mlds_type_to_ilds_type(DataRep, DestType), - rval_to_type(SrcRval, SrcType), - SrcILType = mlds_type_to_ilds_type(DataRep, SrcType), - - % We need to handle casts to/from "refany" specially -- - % IL has special instructions for those - ( - % Is it a cast to refany? - DestILType = il_type(_, refany) - -> - ( - % Is it from refany? - SrcILType = il_type(_, refany) - -> - % Cast from refany to refany is a NOP. - Instrs = empty - ; - % Cast to refany: use "mkrefany" instruction. - ( SrcILType = il_type(_Qual, '&'(ReferencedType)) -> - Instrs = singleton(mkrefany(ReferencedType)) - ; - unexpected($module, $pred, "cast from non-ref type to refany") - ) - ) - ; - % Is it a cast from refany? - SrcRval = ml_lval(_), - rval_to_type(SrcRval, SrcType), - SrcILType = mlds_type_to_ilds_type(DataRep, SrcType), - SrcILType = il_type(_, refany) - -> - % Cast from refany: use "refanyval" instruction. - ( DestILType = il_type(_Qual, '&'(ReferencedType)) -> - Instrs = singleton(refanyval(ReferencedType)) - ; - unexpected($module, $pred, "cast from non-ref type to refany") - ) - ; - % We need to handle casts to/from unmanaged pointers specially -- - % .castclass doesn't work for those. These casts are generated - % by ml_elim_nested.m for the environment pointers. If we're - % using unmanaged pointers, then this must be unverifiable code. - % We don't need to use any explicit conversion in the IL - % - % XXX Currently ilds uses `native_uint' for unmanaged pointers, - % because that's what IL does, but we should probably define a - % separate ilds type for this. - - ( DestILType = il_type(_, native_uint) - ; SrcILType = il_type(_, native_uint) - ) - -> - Instrs = empty - ; - % If we are casting from an unboxed type to a boxed type, - % we should box it first, and then cast. - - already_boxed(DestILType) - -> - ( already_boxed(SrcILType) -> - ( SrcType = DestType -> - Instrs = empty - ; - % Cast one boxed type to another boxed type. - Instrs = singleton(castclass(DestILType)) - ) - ; - % Convert an unboxed type to a boxed type: box it first, then cast. - Instrs = - convert_to_object(SrcILType) ++ - singleton(castclass(DestILType)) - ) - ; - ( already_boxed(SrcILType) -> - ( - SrcType = mercury_type(_, TypeCtorCategory, _), - % XXX Consider whether this is the right way to handle - % type_infos, type_ctor_infos, typeclass_infos and - % base_typeclass_infos. - ( TypeCtorCategory = ctor_cat_user(_) - ; is_introduced_type_info_type_category(TypeCtorCategory) = yes - ) - -> - % XXX We should look into a nicer way to generate MLDS - % so we don't need to do this. - % XXX This looks wrong for --high-level-data. - % -fjh. - Instrs = - comment_node("loading out of an MR_Word") ++ - singleton(ldc(int32, i(0))) ++ - singleton(ldelem(il_generic_simple_type)) ++ - comment_node("turning a cast into an unbox") ++ - convert_from_object(DestILType) - ; - % XXX It would be nicer if the MLDS used an unbox to do this. - Instrs = - comment_node("turning a cast into an unbox") ++ - convert_from_object(DestILType) - ) - ; - DestILType = il_type(_, DestSimpleType), - Instrs = - comment_node("cast between value types") ++ - singleton(conv(DestSimpleType)) - ) - ). - -unaryop_to_il(box(UnboxedType), _, Instrs, !Info) :- - DataRep = !.Info ^ il_data_rep, - UnboxedILType = mlds_type_to_ilds_type(DataRep, UnboxedType), - ( already_boxed(UnboxedILType) -> - % It is already boxed, so we don't need to do anything. - Instrs = empty - ; - Instrs = convert_to_object(UnboxedILType) - ). - -unaryop_to_il(unbox(UnboxedType), Rval, Instrs, !Info) :- - DataRep = !.Info^ il_data_rep, - rval_to_type(Rval, RvalType), - UnboxedILType = mlds_type_to_ilds_type(DataRep, UnboxedType), - ( already_boxed(UnboxedILType) -> - ( RvalType = UnboxedType -> - % We already have the correct type. - Instrs = empty - ; - % We have a different boxed type. - Instrs = singleton(castclass(UnboxedILType)) - ) - ; - Instrs = convert_from_object(UnboxedILType) - ). - -:- pred already_boxed(il_type::in) is semidet. - -already_boxed(il_type(_, object)). -already_boxed(il_type(_, string)). -already_boxed(il_type(_, refany)). -already_boxed(il_type(_, class(_))). -already_boxed(il_type(_, interface(_))). -already_boxed(il_type(_, '[]'(_, _))). -already_boxed(il_type(_, '&'(_))). -already_boxed(il_type(_, '*'(_))). - -:- pred binaryop_to_il(binary_op::in, instr_tree::out, - il_info::in, il_info::out) is det. - -binaryop_to_il(int_add, singleton(I), !Info) :- - I = add(nocheckoverflow, signed). - -binaryop_to_il(int_sub, singleton(I), !Info) :- - I = sub(nocheckoverflow, signed). - -binaryop_to_il(int_mul, singleton(I), !Info) :- - I = mul(nocheckoverflow, signed). - -binaryop_to_il(int_div, singleton(I), !Info) :- - I = div(signed). - -binaryop_to_il(int_mod, singleton(I), !Info) :- - I = rem(signed). - -binaryop_to_il(unchecked_left_shift, singleton(I), !Info) :- - I = shl. - -binaryop_to_il(unchecked_right_shift, singleton(I), !Info) :- - I = shr(signed). - -binaryop_to_il(bitwise_and, singleton(I), !Info) :- - I = bitwise_and. - -binaryop_to_il(bitwise_or, singleton(I), !Info) :- - I = bitwise_or. - -binaryop_to_il(bitwise_xor, singleton(I), !Info) :- - I = bitwise_xor. - -binaryop_to_il(logical_and, singleton(I), !Info) :- - % XXX - I = bitwise_and. - -binaryop_to_il(logical_or, singleton(I), !Info) :- - % XXX - I = bitwise_or. - -binaryop_to_il(eq, singleton(I), !Info) :- - I = ceq. - -binaryop_to_il(ne, from_list(Instrs), !Info) :- - Instrs = [ - ceq, - ldc(int32, i(0)), - ceq - ]. - -binaryop_to_il(body, _, !Info) :- - unexpected($module, $pred, "body"). - -binaryop_to_il(float_word_bits, _, !Info) :- - unexpected($module, $pred, "float_word_bits"). - -binaryop_to_il(float_from_dword, _, !Info) :- - unexpected($module, $pred, "float_from_dword"). - -binaryop_to_il(array_index(ElemType), singleton(I), !Info) :- - DataRep = !.Info ^ il_data_rep, - MLDS_Type = ml_gen_array_elem_type(ElemType), - ILSimpleType = mlds_type_to_ilds_simple_type(DataRep, MLDS_Type), - I = ldelem(ILSimpleType). - -binaryop_to_il(string_unsafe_index_code_unit, _, !Info) :- - unexpected($module, $pred, "string_unsafe_index_code_unit"). - - % String operations. -binaryop_to_il(str_eq, from_list([ - call(il_string_equals) - ]), !Info). -binaryop_to_il(offset_str_eq(_), from_list([ - call(il_string_equals) - ]), !Info). -binaryop_to_il(str_ne, from_list([ - call(il_string_equals), - ldc(int32, i(0)), - ceq - ]), !Info). -binaryop_to_il(str_lt, from_list([ - call(il_string_compare), - ldc(int32, i(0)), - clt(signed) - ]), !Info). -binaryop_to_il(str_gt, from_list([ - call(il_string_compare), - ldc(int32, i(0)), - cgt(signed) - ]), !Info). -binaryop_to_il(str_le, from_list([ - call(il_string_compare), - ldc(int32, i(1)), clt(signed) - ]), !Info). -binaryop_to_il(str_ge, from_list([ - call(il_string_compare), - ldc(int32, i(-1)), - cgt(signed) - ]), !Info). -binaryop_to_il(str_cmp, _, !Info) :- - unexpected($module, $pred, "str_cmp"). - - % Integer comparison -binaryop_to_il(int_lt, singleton(clt(signed)), !Info). -binaryop_to_il(int_gt, singleton(cgt(signed)), !Info). -binaryop_to_il(int_le, from_list([cgt(signed), ldc(int32, i(0)), ceq]), !Info). -binaryop_to_il(int_ge, from_list([clt(signed), ldc(int32, i(0)), ceq]), !Info). -binaryop_to_il(unsigned_le, from_list([cgt(unsigned), ldc(int32, i(0)), ceq]), - !Info). - - % Floating pointer operations. -binaryop_to_il(float_plus, singleton(I), !Info) :- - I = add(nocheckoverflow, signed). -binaryop_to_il(float_minus, singleton(I), !Info) :- - I = sub(nocheckoverflow, signed). -binaryop_to_il(float_times, singleton(I), !Info) :- - I = mul(nocheckoverflow, signed). -binaryop_to_il(float_divide, singleton(I), !Info) :- - I = div(signed). -binaryop_to_il(float_eq, singleton(I), !Info) :- - I = ceq. -binaryop_to_il(float_ne, from_list(Instrs), !Info) :- - Instrs = [ - ceq, - ldc(int32, i(0)), - ceq - ]. -binaryop_to_il(float_lt, singleton(clt(signed)), !Info). -binaryop_to_il(float_gt, singleton(cgt(signed)), !Info). -binaryop_to_il(float_le, from_list([cgt(signed), ldc(int32, i(0)), ceq]), - !Info). -binaryop_to_il(float_ge, from_list([clt(signed), ldc(int32, i(0)), ceq]), - !Info). - -binaryop_to_il(pointer_equal_conservative, _, !Info) :- - unexpected($module, $pred, "pointer_equal_conservative"). -binaryop_to_il(compound_eq, _, !Info) :- - unexpected($module, $pred, "compound_eq"). -binaryop_to_il(compound_lt, _, !Info) :- - unexpected($module, $pred, "compound_lt"). - -%-----------------------------------------------------------------------------% -% -% Generate code for conditional statements -% -% For most conditionals, we simply load the rval and branch to the else -% case if it is false. -% -% load rval -% brfalse elselabel -% -% For eq and ne binops, this will generate something a bit wasteful, e.g. -% -% load operand1 -% load operand2 -% ceq -% brfalse elselabel -% -% We try to avoid generating a comparison result on the stack and then -% comparing it to false. Instead we load the operands and -% branch/compare all at once. E.g. -% -% load operand1 -% load operand2 -% bne.unsigned elselabel -% -% Perhaps it would be better to just generate the default code and let -% the peephole optimizer pick this one up. Since it's pretty easy -% to detect I've left it here for now. - -:- pred generate_condition(mlds_rval::in, instr_tree::out, string::out, - il_info::in, il_info::out) is det. - -generate_condition(Rval, Instrs, ElseLabel, !Info) :- - il_info_make_next_label(ElseLabel, !Info), - ( - Rval = ml_binop(eq, Operand1, Operand2) - -> - load(Operand1, Op1Instr, !Info), - load(Operand2, Op2Instr, !Info), - OpInstr = singleton(bne(unsigned, label_target(ElseLabel))), - Instrs = Op1Instr ++ Op2Instr ++ OpInstr - ; - Rval = ml_binop(ne, Operand1, Operand2) - -> - load(Operand1, Op1Instr, !Info), - load(Operand2, Op2Instr, !Info), - OpInstr = singleton(beq(label_target(ElseLabel))), - Instrs = Op1Instr ++ Op2Instr ++ OpInstr - ; - load(Rval, RvalLoadInstrs, !Info), - ExtraInstrs = singleton(brfalse(label_target(ElseLabel))), - Instrs = RvalLoadInstrs ++ ExtraInstrs - ). - -%-----------------------------------------------------------------------------% -% -% Get a function name for a code_addr_const rval. -% -% XXX This predicate should be narrowed down to the cases that actually -% make sense. - - % Convert an rval into a function we can call. - % -:- pred const_rval_to_function(mlds_rval_const::in, class_member_name::out) - is det. - -const_rval_to_function(Const, MemberName) :- - ( Const = mlconst_code_addr(CodeConst) -> - ( - CodeConst = code_addr_proc(ProcLabel, _Sig), - mangle_mlds_proc_label(ProcLabel, no, ClassName, ProcLabelStr) - ; - CodeConst = code_addr_internal(ProcLabel, SeqNum, _Sig), - mangle_mlds_proc_label(ProcLabel, yes(SeqNum), ClassName, - ProcLabelStr) - ), - MemberName = class_member_name(ClassName, id(ProcLabelStr)) - ; - unexpected($module, $pred, "const is not a code address") - ). - -%----------------------------------------------------------------------------- -% -% Class constructors (.cctors) are used to initialise the runtime. -% This currently consists of initialising the RTTI and calling -% mercury.runtime.init_runtime. -% -% The RTTI is stored in static fields of the class. - - % .cctors can be called at practically any time by the runtime - % system, but must be called before a static field is loaded - % (the runtime will ensure this happens). - % Since all the static fields in RTTI reference other RTTI static - % fields, we could run into problems if we load a field from another - % class before we initialize it. Often the RTTI in one module will - % refer to another, creating exactly this cross-referencing problem. - % To avoid problems, we initialize them in 3 passes (passes 2 to 4 - % below). - % - % Here is the structure of the .cctor that we generate. - % - % 1. We call mercury.runtime.responsible_for_initialising_runtime - % to determine whether this is the first mercury .cctor called. - % - % 2. We allocate all the RTTI data structures but leave them blank. - % When this is complete we set a flag to say we have completed this - % pass. After this pass is complete, it is safe for any other - % module to reference our data structures. - % - % 3. We call all the .cctors for RTTI data structures that we - % import. We do this because we can't load fields from them until we - % know they have been allocated. - % - % 4. We fill in the RTTI info in the already allocated structures. - % - % 5. If responsible_for_initialising_runtime returned true, then we - % call the initialise runtime function now all the RTTI is - % initialised. - % - % To ensure that pass 3 doesn't cause looping, the first thing done - % in all .cctors is a check to see if the flag is set. If it is, we - % return immediately (we have already been called and our - % initialization is either complete or at pass 3). - % - % Here is a skeleton of the il that we will generate. - % - % // Are we responsible for initialising the runtime. - % call bool [mercury]mercury.runtime:: - % responsible_for_initialising_runtime() - % - % // if (rtti_initialized) return; - % ldsfld rtti_initialized - % brfalse done_label - % pop // pop the responsible_for_initialising_runtime bool - % ret - % done_label: - % - % // rtti_initialized = true - % ldc.i4.1 - % stsfld rtti_initialized - % - % // allocate RTTI data structures. - % - % - % // call .cctors - % call someclass::.cctor - % call someotherclass::.cctor - % ... etc ... - % - % // fill in fields of RTTI data structures - % - % - % // Maybe initialise the runtime - % call void [mercury]mercury.runtime::init_runtime(bool) - % -:- pred make_class_constructor_class_member(fieldref::in, mlds_imports::in, - list(instr)::in, list(instr)::in, class_member::out, - il_info::in, il_info::out) is det. - -make_class_constructor_class_member(DoneFieldRef, Imports, AllocInstrs, - InitInstrs, Method, !Info) :- - Method = member_method(methodhead([public, static], cctor, - signature(call_conv(no, default), void, []), []), MethodDecls), - ResponsibleInitRuntimeInstrs = responsible_for_init_runtime_instrs, - RuntimeInitInstrs = runtime_initialization_instrs, - test_rtti_initialization_field(DoneFieldRef, TestInstrs, !Info), - set_rtti_initialization_field(DoneFieldRef, SetInstrs, !Info), - CCtorCalls = list.filter_map( - (func(I::in) = (C::out) is semidet :- - I = mercury_import(compiler_visible_interface, ImportName), - C = call_class_constructor( - class_name(ImportName, wrapper_class_name)) - ), Imports), - AllInstrs = list.condense([ResponsibleInitRuntimeInstrs, TestInstrs, - AllocInstrs, SetInstrs, CCtorCalls, InitInstrs, RuntimeInitInstrs, - [ret]]), - MethodDecls = [instrs(AllInstrs)]. - -:- pred test_rtti_initialization_field(fieldref::in, list(instr)::out, - il_info::in, il_info::out) is det. - -test_rtti_initialization_field(FieldRef, Instrs, !Info) :- - il_info_make_next_label(DoneLabel, !Info), - Instrs = [ldsfld(FieldRef), brfalse(label_target(DoneLabel)), - pop, ret, label(DoneLabel)]. - -:- pred set_rtti_initialization_field(fieldref::in, list(instr)::out, - il_info::in, il_info::out) is det. - -set_rtti_initialization_field(FieldRef, Instrs, !Info) :- - Instrs = [ldc(int32, i(1)), stsfld(FieldRef)]. - -:- pred generate_rtti_initialization_field(ilds.class_name::in, - fieldref::out, class_member::out) is det. - -generate_rtti_initialization_field(ClassName, AllocDoneFieldRef, - AllocDoneField) :- - AllocDoneFieldName = "rtti_initialized", - AllocDoneField = member_field([public, static], il_type([], bool), - AllocDoneFieldName, no, none), - AllocDoneFieldRef = make_fieldref(il_type([], bool), - ClassName, AllocDoneFieldName). - -%----------------------------------------------------------------------------- -% -% Conversion of MLDS types to IL types. - -:- func mlds_inherits_to_ilds_inherits(il_data_rep, list(mlds_type)) - = ilasm.extends. - -mlds_inherits_to_ilds_inherits(DataRep, Inherits) = Extends :- - ( - Inherits = [], - Extends = extends_nothing - ; - Inherits = [InheritType], - Extends = extends(mlds_type_to_ilds_class_name(DataRep, InheritType)) - ; - Inherits = [_, _ | _], - unexpected($module, $pred, "multiple inheritance not supported") - ). - -:- pred mlds_signature_to_ilds_type_params(il_data_rep::in, - mlds_func_signature::in, list(il_type)::out) is det. - -mlds_signature_to_ilds_type_params(DataRep, - mlds_func_signature(Args, _Returns), Params) :- - Params = list.map(mlds_type_to_ilds_type(DataRep), Args). - -:- func mlds_arg_to_il_arg(mlds_argument) = pair(ilds.id, mlds_type). - -mlds_arg_to_il_arg(mlds_argument(EntityName, Type, _GCStatement)) = - Id - Type :- - mangle_entity_name(EntityName, Id). - -:- func mlds_signature_to_ilds_type_params(il_data_rep, mlds_func_signature) - = list(il_type). - -mlds_signature_to_ilds_type_params(DataRep, - mlds_func_signature(Args, _Returns)) = - list.map(mlds_type_to_ilds_type(DataRep), Args). - -:- func mlds_signature_to_il_return_param(il_data_rep, mlds_func_signature) - = ret_type. - -mlds_signature_to_il_return_param(DataRep, mlds_func_signature(_, Returns)) - = Param :- - ( - Returns = [], - Param = void - ; - Returns = [ReturnType], - SimpleType = mlds_type_to_ilds_simple_type(DataRep, ReturnType), - Param = simple_type(SimpleType) - ; - Returns = [_, _ | _], - % IL doesn't support multiple return values - sorry($module, $pred, "multiple return values") - ). - -params_to_il_signature(DataRep, ModuleName, FuncParams) = ILSignature :- - ILInputTypes = list.map(input_param_to_ilds_type(DataRep, ModuleName), - Inputs), - FuncParams = mlds_func_params(Inputs, Outputs), - ( - Outputs = [], - Param = void - ; - Outputs = [ReturnType], - SimpleType = mlds_type_to_ilds_simple_type(DataRep, ReturnType), - Param = simple_type(SimpleType) - ; - Outputs = [_, _ | _], - % IL doesn't support multiple return values. - sorry($module, $pred, "multiple return values") - ), - ILSignature = signature(call_conv(no, default), Param, ILInputTypes). - -:- func input_param_to_ilds_type(il_data_rep, mlds_module_name, mlds_argument) - = il_method_param. - -input_param_to_ilds_type(DataRep, _ModuleName, Arg) = MethodParam :- - Arg = mlds_argument(EntityName, MldsType, _GCStatement), - mangle_entity_name(EntityName, Id), - ILType = mlds_type_to_ilds_type(DataRep, MldsType), - MethodParam = il_method_param(ILType, yes(Id)). - -:- func mlds_type_to_ilds_simple_type(il_data_rep, mlds_type) - = ilds.simple_type. - -mlds_type_to_ilds_simple_type(DataRep, MLDSType) = SimpleType :- - il_type(_, SimpleType) = mlds_type_to_ilds_type(DataRep, MLDSType). - - % XXX Make sure all the types are converted correctly. - -mlds_type_to_ilds_type(_, mlds_rtti_type(_RttiName)) = il_object_array_type. - - % This is a placeholder only. -mlds_type_to_ilds_type(_, mlds_tabling_type(_Id)) = il_object_array_type. - -mlds_type_to_ilds_type(DataRep, mlds_mercury_array_type(ElementType)) = - ( ElementType = mercury_type(_, ctor_cat_variable, _) -> - il_generic_array_type - ; - il_type([], '[]'(mlds_type_to_ilds_type(DataRep, ElementType), [])) - ). - -mlds_type_to_ilds_type(DataRep, mlds_array_type(ElementType)) = - il_type([], '[]'(mlds_type_to_ilds_type(DataRep, ElementType), [])). - -mlds_type_to_ilds_type(_, mlds_mostly_generic_array_type(_)) = _ :- - sorry($module, $pred, "mlds_mostly_generic_array_type"). - - % XXX Should be checked. -mlds_type_to_ilds_type(_, mlds_type_info_type) = il_generic_type. - - % This is tricky. It could be an integer, or it could be a System.Array. -mlds_type_to_ilds_type(_, mlds_pseudo_type_info_type) = il_generic_type. - - % IL has a pretty fuzzy idea about function types. We treat them - % as integers for now - % XXX This means the code is not verifiable. -mlds_type_to_ilds_type(_, mlds_func_type(_)) = il_type([], int32). - -mlds_type_to_ilds_type(_, mlds_generic_type) = il_generic_type. - - % XXX Using int32 here means the code is not verifiable - % see comments about function types above. -mlds_type_to_ilds_type(_, mlds_cont_type(_ArgTypes)) = il_type([], int32). - -mlds_type_to_ilds_type(_, mlds_class_type(Class, Arity, Kind)) = - il_type([], SimpleType) :- - ClassName = mlds_class_name_to_ilds_class_name(Class, Arity), - SimpleType = mlds_class_to_ilds_simple_type(Kind, ClassName). - -mlds_type_to_ilds_type(_, mlds_commit_type) = il_commit_type. - -mlds_type_to_ilds_type(ILDataRep, mlds_generic_env_ptr_type) = - ILDataRep^il_envptr_type. - -mlds_type_to_ilds_type(_, mlds_native_bool_type) = il_type([], bool). - -mlds_type_to_ilds_type(_, mlds_native_char_type) = il_type([], char). - - % These two following choices are arbitrary -- IL has native integer - % and float types too. It's not clear whether there is any benefit - % in mapping to them instead -- it all depends what the indended use - % of mlds_native_int_type and mlds_native_float_type is. - % Any mapping other than int32 would have to be examined to see - % whether it is going to be compatible with int32. -mlds_type_to_ilds_type(_, mlds_native_int_type) = il_type([], int32). - -mlds_type_to_ilds_type(_, mlds_native_float_type) = il_type([], float64). - -mlds_type_to_ilds_type(_, mlds_foreign_type(ForeignType)) - = il_type([], Class) :- - ( - ForeignType = il(il_type(RefOrVal, Assembly, Type)), - sym_name_to_class_name(Type, ForeignClassName), - ( - RefOrVal = reference, - Class = class(structured_name(assembly(Assembly), - ForeignClassName, [])) - ; - RefOrVal = value, - Class = valuetype(structured_name(assembly(Assembly), - ForeignClassName, [])) - ) - ; - ForeignType = c(_), - unexpected($module, $pred, "c foreign type") - ; - ForeignType = java(_), - unexpected($module, $pred, "java foreign type") - ; - ForeignType = csharp(_), - unexpected($module, $pred, "csharp foreign type") - ; - ForeignType = erlang(_), - unexpected($module, $pred, "erlang foreign type") - ). - -mlds_type_to_ilds_type(ILDataRep, mlds_ptr_type(MLDSType)) = - il_type([], '&'(mlds_type_to_ilds_type(ILDataRep, MLDSType))). - -mlds_type_to_ilds_type(ILDataRep, mercury_type(MercuryType, TypeCategory, _)) = - mlds_mercury_type_to_ilds_type(ILDataRep, MercuryType, TypeCategory). - -mlds_type_to_ilds_type(_, mlds_unknown_type) = _ :- - unexpected($module, $pred, "unknown_type"). - - % Get the corresponding ILDS type for an MLDS mercury type - % (this depends on which representation you happen to be using). - % The entry for the void type is a dummy; there shouldn't be values - % of type void, so the type is moot. - % -:- func mlds_mercury_type_to_ilds_type(il_data_rep, mer_type, - type_ctor_category) = il_type. - -mlds_mercury_type_to_ilds_type(DataRep, MercuryType, CtorCat) = ILType :- - ( - ( CtorCat = ctor_cat_builtin(cat_builtin_int) - ; CtorCat = ctor_cat_void - ), - ILType = il_type([], int32) - ; - CtorCat = ctor_cat_builtin(cat_builtin_char), - ILType = il_type([], char) - ; - CtorCat = ctor_cat_builtin(cat_builtin_float), - ILType = il_type([], float64) - ; - CtorCat = ctor_cat_builtin(cat_builtin_string), - ILType = il_string_type - ; - ( CtorCat = ctor_cat_higher_order - ; CtorCat = ctor_cat_tuple - ; CtorCat = ctor_cat_enum(_) - ), - ILType = il_object_array_type - ; - ( CtorCat = ctor_cat_builtin_dummy - ; CtorCat = ctor_cat_variable - ), - ILType = il_generic_type - ; - % We should handle ctor_cat_user(cat_user_direct_dummy) specially. - ( CtorCat = ctor_cat_system(_) - ; CtorCat = ctor_cat_user(_) - ), - ( - DataRep ^ highlevel_data = yes, - \+ type_needs_lowlevel_rep(target_il, MercuryType) - -> - ILType = mercury_type_to_highlevel_class_type(MercuryType) - ; - ILType = il_object_array_type - ) - ). - -:- func mlds_class_to_ilds_simple_type(mlds_class_kind, ilds.class_name) = - ilds.simple_type. - -mlds_class_to_ilds_simple_type(Kind, ClassName) = SimpleType :- - ( Kind = mlds_package, SimpleType = class(ClassName) - ; Kind = mlds_class, SimpleType = class(ClassName) - ; Kind = mlds_interface, SimpleType = class(ClassName) - ; Kind = mlds_struct, SimpleType = valuetype(ClassName) - ; Kind = mlds_enum, SimpleType = valuetype(ClassName) - ). - -:- func mercury_type_to_highlevel_class_type(mer_type) = il_type. - -mercury_type_to_highlevel_class_type(MercuryType) = ILType :- - type_to_ctor_det(MercuryType, TypeCtor), - ml_gen_type_name(TypeCtor, ClassName, Arity), - ILType = il_type([], class( - mlds_class_name_to_ilds_class_name(ClassName, Arity))). - -:- func mlds_class_name_to_ilds_class_name(mlds_class, arity) = - ilds.class_name. - -mlds_class_name_to_ilds_class_name(QualClassName, Arity) = IldsClassName :- - QualClassName = qual(MldsModuleName, _QualKind, MldsClassName0), - MldsClassName = string.format("%s_%d", [s(MldsClassName0), i(Arity)]), - IldsClassName = append_toplevel_class_name( - mlds_module_name_to_class_name(MldsModuleName), MldsClassName). - -mlds_type_to_ilds_class_name(DataRep, MldsType) = - get_ilds_type_class_name(mlds_type_to_ilds_type(DataRep, MldsType)). - -:- func get_ilds_type_class_name(il_type) = ilds.class_name. - -get_ilds_type_class_name(ILType) = ClassName :- - ( - ( ILType = il_type(_, class(ClassName0)) - ; ILType = il_type(_, valuetype(ClassName0)) - ) - -> - ClassName = ClassName0 - ; - unexpected($module, $pred, "type not a class") - ). - -%----------------------------------------------------------------------------- -% -% Name mangling. - -:- type il_mangle_name - ---> mangle_for_il - % Names that are to be used only in IL are able to include - % spaces, punctuation and other special characters, because they - % are in quotes. - - ; mangle_for_csharp. - % Names that are to be used in C# (typically because they are - % foreign procedures) must be mangled in the same way as for C. - - % Create a mangled predicate identifier, suitable for use in IL. - % -:- pred predlabel_to_ilds_id(mlds_pred_label::in, proc_id::in, - maybe(mlds_func_sequence_num)::in, ilds.id::out) is det. - -predlabel_to_ilds_id(PredLabel, ProcId, MaybeSeqNum, Id) :- - predlabel_to_id(PredLabel, ProcId, MaybeSeqNum, mangle_for_il, Id). - -predlabel_to_csharp_id(PredLabel, ProcId, MaybeSeqNum, Id) :- - predlabel_to_id(PredLabel, ProcId, MaybeSeqNum, mangle_for_csharp, Id). - - % XXX We may need to do different name mangling for CLS compliance - % than we would otherwise need. - % - % We mangle as follows: - % - Problem: - % Two preds or funcs with different arities in Mercury - % end up having the same types and arities in IL, e.g. - % because one of them takes io.state arguments which - % get omitted in IL. - % - % To avoid this we append _ to every procedure - % name. - % - % - Problem: - % A semidet pred returns its success value, and so has - % the same return type (bool) as a function. - % - % To avoid this, we mangle all semidet predicates - % to indicate that they are a pred by appending _p. - % - % - Problem: - % A function with modes other than the default (in, in, - % in = out) may clash with a predicate which has the - % same types and modes. - % - % In addition, a function may clash with a predicate which - % has the same types and modes and has been introduced - % by inlining.These will then differ only in return type, - % which is forbidden. - % - % To avoid this, we mangle all functions by adding _f - % to the procedure name. - % - % - Problem: - % A predicate or function with more than one mode. - % - % To avoid this, we mangle all modes > 0 by adding - % _m to the procedure name. - % - % - We append the sequence number (if there is one) as - % _i. - % - % - We prepend the module name (if there is one) as - % _. - % - % So the mangled name is: - % (_)_(_f|_p)(_m)(_i) - % - % Where parentheses indicate optional components. - % - % Since each optional component (except the modulename) is after - % the mandatory arity, and the components have unique prefixes, - % it isn't possible to generate names that conflict with user - % names. - % - % XXX I think that it may be possible to have conflicts with - % user names in the case where there is a . - fjh - % -:- pred predlabel_to_id(mlds_pred_label::in, proc_id::in, - maybe(mlds_func_sequence_num)::in, il_mangle_name::in, - ilds.id::out) is det. - -predlabel_to_id(mlds_user_pred_label(PredOrFunc, MaybeModuleName, Name, Arity, - CodeModel, _NonOutputFunc), ProcId, MaybeSeqNum, MangleType, Id) :- - ( - MaybeModuleName = yes(ModuleName), - mlds_to_il.sym_name_to_string(ModuleName, MStr), - string.format("%s_", [s(MStr)], MaybeModuleStr) - ; - MaybeModuleName = no, - MaybeModuleStr = "" - ), - ( - PredOrFunc = pf_predicate, - ( CodeModel = model_semi -> - PredOrFuncStr = "_p" - ; - PredOrFuncStr = "" - ) - ; - PredOrFunc = pf_function, - PredOrFuncStr = "_f" - ), - proc_id_to_int(ProcId, ProcIdInt), - ( ProcIdInt = 0 -> - MaybeProcIdInt = "" - ; - string.format("_m%d", [i(ProcIdInt)], MaybeProcIdInt) - ), - ( - MaybeSeqNum = yes(SeqNum), - string.format("_i%d", [i(SeqNum)], MaybeSeqNumStr) - ; - MaybeSeqNum = no, - MaybeSeqNumStr = "" - ), - MangledName = mangle_pred_name(Name, MangleType), - string.format("%s%s_%d%s%s%s", [ - s(MaybeModuleStr), s(MangledName), - i(Arity), s(PredOrFuncStr), s(MaybeProcIdInt), - s(MaybeSeqNumStr)], Id). - -predlabel_to_id(mlds_special_pred_label(PredName, MaybeModuleName, TypeName, - Arity), ProcId, MaybeSeqNum, MangleType, Id) :- - proc_id_to_int(ProcId, ProcIdInt), - ( - MaybeModuleName = yes(ModuleName), - mlds_to_il.sym_name_to_string(ModuleName, MStr), - string.format("%s_", [s(MStr)], MaybeModuleStr) - ; - MaybeModuleName = no, - MaybeModuleStr = "" - ), - ( - MaybeSeqNum = yes(SeqNum), - string.format("_%d", [i(SeqNum)], MaybeSeqNumStr) - ; - MaybeSeqNum = no, - MaybeSeqNumStr = "" - ), - MangledName = mangle_pred_name(PredName, MangleType), - string.format("special_%s%s_%s_%d_%d%s", - [s(MaybeModuleStr), s(MangledName), s(TypeName), i(Arity), - i(ProcIdInt), s(MaybeSeqNumStr)], Id). - -:- func mangle_pred_name(string, il_mangle_name) = string. - -mangle_pred_name(PredName, mangle_for_il) = PredName. -mangle_pred_name(PredName, mangle_for_csharp) = MangledName :- - ( string.is_all_alnum_or_underscore(PredName) -> - MangledName = PredName - ; - MangledName = convert_to_valid_c_identifier(PredName) - ). - - % If an mlds_var is not an argument or a local, what is it? - % We assume the given variable is a static field; - % either a compiler-generated static, - % or possibly a handwritten RTTI reference or a - % reference to some hand-written code in the - % modulename__csharp_code.mercury_code class. - % -:- func make_static_fieldref(il_data_rep, mlds_var, mlds_type) = fieldref. - -make_static_fieldref(DataRep, Var, VarType) = FieldRef :- - Var = qual(ModuleName, _QualKind, VarName), - mangle_mlds_var(Var, MangledVarStr), - mangle_dataname_module(yes(mlds_data_var(VarName)), - ModuleName, NewModuleName), - ClassName = mlds_module_name_to_class_name(NewModuleName), - FieldRef = make_fieldref(mlds_type_to_ilds_type(DataRep, VarType), - ClassName, MangledVarStr). - -:- pred mangle_foreign_code_module(foreign_language::in, - mlds_module_name::in, mlds_module_name::out) is det. - -mangle_foreign_code_module(Lang, ModuleName0, ModuleName) :- - LangStr = simple_foreign_language_string(Lang), - PackageName0 = mlds_module_name_to_package_name(ModuleName0), - ( - PackageName0 = qualified(Q, M0), - M = string.format("%s__%s_code", [s(M0), s(LangStr)]), - PackageName = qualified(Q, M) - ; - PackageName0 = unqualified(M0), - M = string.format("%s__%s_code", [s(M0), s(LangStr)]), - PackageName = unqualified(M) - ), - SymName0 = mlds_module_name_to_sym_name(ModuleName0), - % Check to see whether or not the name has already been qualified - % with the wrapper class. If not, qualify it. - ( SymName0 = qualified(SymName1, wrapper_class_name) -> - ( - SymName1 = qualified(SQ, SM0), - SM = string.format("%s__%s_code", [s(SM0), s(LangStr)]), - SymName2 = qualified(SQ, SM) - ; - SymName1 = unqualified(SM0), - SM = string.format("%s__%s_code", [s(SM0), s(LangStr)]), - SymName2 = unqualified(SM) - ), - SymName = qualified(SymName2, wrapper_class_name) - ; - ( - SymName0 = qualified(SQ, SM0), - SM = string.format("%s__%s_code", [s(SM0), s(LangStr)]), - SymName = qualified(qualified(SQ, SM), wrapper_class_name) - ; - SymName0 = unqualified(SM0), - SM = string.format("%s__%s_code", [s(SM0), s(LangStr)]), - SymName = qualified(unqualified(SM), wrapper_class_name) - ) - ), - ModuleName = mercury_module_and_package_name_to_mlds(PackageName, SymName). - - % When generating references to RTTI, we need to mangle the module name - % if the RTTI is defined in C code by hand. If no data_name is provided, - % always do the mangling. - % -:- pred mangle_dataname_module(maybe(mlds_data_name)::in, - mlds_module_name::in, mlds_module_name::out) is det. - -mangle_dataname_module(no, !ModuleName) :- - mangle_foreign_code_module(lang_csharp, !ModuleName). - -mangle_dataname_module(yes(DataName), !ModuleName) :- - ( - SymName = mlds_module_name_to_sym_name(!.ModuleName), - SymName = qualified(qualified(unqualified("mercury"), - LibModuleName0), wrapper_class_name), - DataName = mlds_data_var(_), - LibModuleName0 = "private_builtin", - CodeString = "__csharp_code" - -> - string.append(LibModuleName0, CodeString, LibModuleName), - !:ModuleName = mercury_module_name_to_mlds( - qualified(qualified(unqualified("mercury"), - LibModuleName), wrapper_class_name)) - ; - true - ). - -:- pred mangle_dataname(mlds_data_name::in, string::out) is det. - -mangle_dataname(DataName, Name) :- - ( - DataName = mlds_data_var(MLDSVarName), - Name = mangle_mlds_var_name(MLDSVarName) - ; - DataName = mlds_scalar_common_ref(_), - sorry($module, $pred, "unimplemented: mangling mlds_scalar_common_ref") - ; - DataName = mlds_rtti(RttiId), - rtti.id_to_c_identifier(RttiId, Name) - ; - DataName = mlds_module_layout, - sorry($module, $pred, "unimplemented: mangling mlds_module_layout") - ; - DataName = mlds_proc_layout(_), - sorry($module, $pred, "unimplemented: mangling mlds_proc_layout") - ; - DataName = mlds_internal_layout(_, _), - sorry($module, $pred, "unimplemented: mangling mlds_internal_layout") - ; - DataName = mlds_tabling_ref(_, _), - sorry($module, $pred, "unimplemented: mangling mlds_tabling_ref") - ). - - % We turn procedures into methods of classes. -mangle_mlds_proc_label(qual(ModuleName, _, mlds_proc_label(PredLabel, ProcId)), - MaybeSeqNum, ClassName, PredStr) :- - ClassName = mlds_module_name_to_class_name(ModuleName), - predlabel_to_ilds_id(PredLabel, ProcId, MaybeSeqNum, PredStr). - -:- pred mangle_entity_name(mlds_entity_name::in, string::out) is det. - -mangle_entity_name(entity_type(_TypeName, _), _MangledName) :- - unexpected($module, $pred, "can't mangle type names"). -mangle_entity_name(entity_data(DataName), MangledName) :- - mangle_dataname(DataName, MangledName). -mangle_entity_name(entity_function(_, _, _, _), _MangledName) :- - unexpected($module, $pred, "can't mangle function names"). -mangle_entity_name(entity_export(_), _MangledName) :- - unexpected($module, $pred, "can't mangle export names"). - - % Any valid Mercury identifier will be fine here too. - % We quote all identifiers before we output them, so - % even funny characters should be fine. -mangle_mlds_var(qual(_ModuleName, _, VarName), Str) :- - Str = mangle_mlds_var_name(VarName). - -:- func mangle_mlds_var_name(mlds_var_name) = string. - -mangle_mlds_var_name(mlds_var_name(Name, yes(Num))) = - string.format("%s_%d", [s(Name), i(Num)]). -mangle_mlds_var_name(mlds_var_name(Name, no)) = Name. - -:- pred mlds_to_il.sym_name_to_string(sym_name::in, string::out) is det. - -mlds_to_il.sym_name_to_string(SymName, String) :- - mlds_to_il.sym_name_to_string(SymName, ".", String). - -:- pred mlds_to_il.sym_name_to_string(sym_name::in, string::in, string::out) - is det. - -mlds_to_il.sym_name_to_string(SymName, Separator, String) :- - mlds_to_il.sym_name_to_string_2(SymName, Separator, [], Parts), - string.append_list(Parts, String). - -:- pred mlds_to_il.sym_name_to_string_2(sym_name::in, string::in, - list(string)::in, list(string)::out) is det. - -mlds_to_il.sym_name_to_string_2(qualified(ModuleSpec,Name), Separator, - !Strs) :- - mlds_to_il.sym_name_to_string_2(ModuleSpec, Separator, !Strs), - !:Strs = [Separator, Name | !.Strs]. -mlds_to_il.sym_name_to_string_2(unqualified(Name), _, !Strs) :- - !:Strs = [Name | !.Strs]. - - % Turn an MLDS module name into a class_name name. - % -:- func mlds_module_name_to_class_name(mlds_module_name) = ilds.class_name. - -mlds_module_name_to_class_name(MldsModuleName) = - structured_name(AssemblyName, ClassName, []) :- - SymName = mlds_module_name_to_sym_name(MldsModuleName), - sym_name_to_class_name(SymName, ClassName), - AssemblyName = mlds_module_name_to_assembly_name(MldsModuleName). - -:- func mlds_module_name_to_assembly_name(mlds_module_name) = assembly_name. - -mlds_module_name_to_assembly_name(MldsModuleName) = AssemblyName :- - SymName = mlds_module_name_to_sym_name(MldsModuleName), - PackageSymName = mlds_module_name_to_package_name(MldsModuleName), - sym_name_to_class_name(SymName, ClassName), - ( - ClassName = ["mercury" | _] - -> - AssemblyName = assembly("mercury") - ; - % Foreign code currently resides in it's own assembly even if it is - % in a sub-module. - PackageSymName = qualified(_, Name), - ( string.remove_suffix(Name, "__csharp_code", _) - ; string.remove_suffix(Name, "__cpp_code", _) - ) - -> - mlds_to_il.sym_name_to_string(PackageSymName, PackageString), - AssemblyName = assembly(PackageString) - ; - mlds_to_il.sym_name_to_string(PackageSymName, PackageString), - ( - PackageSymName = unqualified(_), - AssemblyName = assembly(PackageString) - ; - PackageSymName = qualified(_, _), - AssemblyName = module(PackageString, - outermost_qualifier(PackageSymName)) - ) - ). - -:- pred sym_name_to_class_name(sym_name::in, list(ilds.id)::out) is det. - -sym_name_to_class_name(SymName, Ids) :- - sym_name_to_class_name_2(SymName, Ids0), - list.reverse(Ids0, Ids). - -:- pred sym_name_to_class_name_2(sym_name::in, list(ilds.id)::out) is det. - -sym_name_to_class_name_2(qualified(ModuleSpec, Name), [Name | Modules]) :- - sym_name_to_class_name_2(ModuleSpec, Modules). -sym_name_to_class_name_2(unqualified(Name), [Name]). - -:- func sym_name_prefix(sym_name) = string. -sym_name_prefix(qualified(ModuleSpec, _)) = sym_name_prefix(ModuleSpec). -sym_name_prefix(unqualified(Name)) = Name. - -%-----------------------------------------------------------------------------% -% -% Predicates for checking various attributes of variables -% - -:- pred is_argument(ilds.id::in, il_info::in) is semidet. - -is_argument(VarName, Info) :- - list.member(VarName - _, Info ^ arguments). - -:- pred is_local(ilds.id::in, il_info::in) is semidet. - -is_local(VarName, Info) :- - map.contains(Info ^ locals, VarName). - -:- pred is_local_field(mlds_var::in, mlds_type::in, il_info::in, - fieldref::out) is semidet. - -is_local_field(Var, VarType, Info, FieldRef) :- - mangle_mlds_var(Var, VarName), - set.member(VarName, Info ^ field_names), - Var = qual(ModuleName, _, _), - ClassName = mlds_module_name_to_class_name(ModuleName), - FieldRef = make_fieldref( - mlds_type_to_ilds_type(Info ^ il_data_rep, VarType), - ClassName, VarName). - -%-----------------------------------------------------------------------------% -% -% Preds and funcs to find the types of rvals -% - - % This gives us the type of an rval. This type is an MLDS type, - % but is with respect to the IL representation (that is, we map code - % address and data address constants to the MLDS version of their IL - % representation). This is so you can generate appropriate box rvals for - % rval_consts. - % -:- pred rval_to_type(mlds_rval::in, mlds_type::out) is det. - -rval_to_type(ml_lval(ml_var(_, Type)), Type). -rval_to_type(ml_lval(ml_field(_, _, _, Type, _)), Type). -rval_to_type(ml_lval(ml_mem_ref(_, Type)), Type). -rval_to_type(ml_lval(ml_global_var_ref(_)), _) :- - sorry($module, $pred, "global_var_ref"). -rval_to_type(ml_mkword(_, _), _) :- - unexpected($module, $pred, "mkword"). -rval_to_type(ml_unop(Unop, _), Type) :- - ( - Unop = box(_), - Type = mlds_generic_type - ; - Unop = unbox(UnboxType), - Type = UnboxType - ; - Unop = cast(CastType), - Type = CastType - ; - Unop = std_unop(StdUnop), - functor(StdUnop, canonicalize, StdUnopStr, _Arity), - sorry($module, $pred, "unop: " ++ StdUnopStr) - ). -rval_to_type(ml_binop(_, _, _), _) :- - sorry($module, $pred, "binop"). -rval_to_type(ml_mem_addr(_), _) :- - sorry($module, $pred, "mem_addr"). -rval_to_type(ml_scalar_common(ScalarCommon), Type) :- - ScalarCommon = ml_scalar_common(_, Type, _, _). -rval_to_type(ml_vector_common_row(VectorCommon, _), Type) :- - VectorCommon = ml_vector_common(_, Type, _, _, _). -rval_to_type(ml_self(Type), Type). -rval_to_type(ml_const(Const), Type) :- - Type = rval_const_to_type(Const). - -:- func rval_const_to_type(mlds_rval_const) = mlds_type. - -rval_const_to_type(mlconst_data_addr(_)) = mlds_array_type(mlds_generic_type). -rval_const_to_type(mlconst_code_addr(_)) - = mlds_func_type(mlds_func_params([], [])). -rval_const_to_type(mlconst_int(_)) = ml_int_type. -rval_const_to_type(mlconst_enum(_, MLDS_Type)) = MLDS_Type. -rval_const_to_type(mlconst_char(_)) = ml_char_type. -rval_const_to_type(mlconst_foreign(_, _, _)) - = sorry($module, $pred, "IL backend and foreign tag"). -rval_const_to_type(mlconst_float(_)) = MLDSType :- - FloatType = builtin_type(builtin_type_float), - MLDSType = mercury_type(FloatType, ctor_cat_builtin(cat_builtin_float), - non_foreign_type(FloatType)). -rval_const_to_type(mlconst_false) = mlds_native_bool_type. -rval_const_to_type(mlconst_true) = mlds_native_bool_type. -rval_const_to_type(mlconst_string(_)) = ml_string_type. -rval_const_to_type(mlconst_multi_string(_)) = ml_string_type. -rval_const_to_type(mlconst_named_const(_)) - = sorry($module, $pred, "IL backend and named const"). -rval_const_to_type(mlconst_null(MldsType)) = MldsType. - -%-----------------------------------------------------------------------------% - -:- func code_addr_constant_to_methodref(il_data_rep, mlds_code_addr) = - methodref. - -code_addr_constant_to_methodref(DataRep, code_addr_proc(ProcLabel, Sig)) - = MethodRef :- - mangle_mlds_proc_label(ProcLabel, no, ClassName, ProcLabelStr), - ReturnParam = mlds_signature_to_il_return_param(DataRep, Sig), - TypeParams = mlds_signature_to_ilds_type_params(DataRep, Sig), - MemberName = class_member_name(ClassName, id(ProcLabelStr)), - MethodRef = methoddef(call_conv(no, default), ReturnParam, - MemberName, TypeParams). - -code_addr_constant_to_methodref(DataRep, - code_addr_internal(ProcLabel, SeqNum, Sig)) = MethodRef :- - mangle_mlds_proc_label(ProcLabel, yes(SeqNum), ClassName, ProcLabelStr), - TypeParams = mlds_signature_to_ilds_type_params(DataRep, Sig), - ReturnParam = mlds_signature_to_il_return_param(DataRep, Sig), - MemberName = class_member_name(ClassName, id(ProcLabelStr)), - MethodRef = methoddef(call_conv(no, default), ReturnParam, - MemberName, TypeParams). - - % Assumed to be a field of a class. - % -:- pred data_addr_constant_to_fieldref(mlds_data_addr::in, fieldref::out) - is det. - -data_addr_constant_to_fieldref(data_addr(ModuleName, DataName), FieldRef) :- - mangle_dataname(DataName, FieldName), - mangle_dataname_module(yes(DataName), ModuleName, NewModuleName), - ClassName = mlds_module_name_to_class_name(NewModuleName), - FieldRef = make_fieldref(il_object_array_type, ClassName, FieldName). - -%-----------------------------------------------------------------------------% - - % When we generate mercury terms using classes, we should use this - % to reference the fields of the class. Note this pred will handle - % named or offsets. It assumes that an offset is transformed into "f". - % XXX Should move towards using this code for *all* field name - % creation and referencing. - % XXX We remove byrefs from fields here. Perhaps we ought to do this - % in a separate pass. See defn_to_class_decl which does the same thing - % when creating the fields. - % -:- pred get_fieldref(il_data_rep::in, mlds_field_id::in, mlds_type::in, - mlds_type::in, fieldref::out, instr_tree::out) is det. - -get_fieldref(DataRep, FieldNum, FieldType, ClassType0, FieldRef, - CastClassInstrs) :- - ( ClassType0 = mlds_ptr_type(ClassType1) -> - ClassType = ClassType1 - ; - ClassType = ClassType0 - ), - FieldILType0 = mlds_type_to_ilds_type(DataRep, FieldType), - ( FieldILType0 = il_type(_, '&'(FieldILType1)) -> - FieldILType = FieldILType1 - ; - FieldILType = FieldILType0 - ), - ( - FieldNum = ml_field_offset(OffsetRval), - ClassName = mlds_type_to_ilds_class_name(DataRep, ClassType), - ( OffsetRval = ml_const(mlconst_int(Num)) -> - string.format("f%d", [i(Num)], FieldId) - ; - sorry($module, $pred, "offsets for non-mlconst_int rvals") - ), - CastClassInstrs = empty - ; - FieldNum = ml_field_named(qual(ModuleName, _, FieldId), _CtorType), - % The MLDS doesn't record which qualifiers are class qualifiers - % and which are namespace qualifiers... we first generate - % a name for the CtorClass as if it wasn't nested, and then - % we call fixup_class_qualifiers to make it correct. - % XXX This is a bit of a hack. It would be nicer for the - % MLDS to keep the information around. - CtorClassName = mlds_module_name_to_class_name(ModuleName), - PtrClassName = mlds_type_to_ilds_class_name(DataRep, ClassType), - ClassName = fixup_class_qualifiers(CtorClassName, PtrClassName), - ( PtrClassName = CtorClassName -> - CastClassInstrs = empty - ; - CastClassInstrs = singleton( - castclass(il_type([], class(ClassName)))) - ) - ), - FieldRef = make_fieldref(FieldILType, ClassName, FieldId). - - % The CtorClass will be nested inside the base class. - % But when we initially generate the name, we don't - % know that it is nested. This routine fixes up the - % CtorClassName by moving the nested parts into the - % third field of the structured_name. - % -:- func fixup_class_qualifiers(ilds.class_name, ilds.class_name) = - ilds.class_name. - -fixup_class_qualifiers(CtorClassName0, PtrClassName) = CtorClassName :- - PtrClassName = structured_name(PtrAssembly, PtrClass, PtrNested), - CtorClassName0 = structured_name(CtorAssembly, CtorClass, CtorNested), - ( - % Some sanity checks. - PtrAssembly = CtorAssembly, - PtrNested = [], - CtorNested = [] - -> - % The part of the prefix which CtorClass shares with PtrClass - % will be the outermost class name; the remainder of CtorClass, - % if any, will be a nested class within. - % (XXX This relies on the way that ml_type_gen.m generates - % the nested MLDS classes for discriminated unions.) - common_prefix(CtorClass, PtrClass, OuterClass, NestedClasses, _), - CtorClassName = structured_name(CtorAssembly, OuterClass, - NestedClasses) - ; - unexpected($module, $pred, "condition failed") - ). - - % common_prefix(List1, List2, Prefix, Tail1, Tail2): - % List1 = Prefix ++ Tail1, - % List2 = Prefix ++ Tail2. -:- pred common_prefix(list(T)::in, list(T)::in, list(T)::out, list(T)::out, - list(T)::out) is det. - -common_prefix([], Ys, [], [], Ys). -common_prefix([X | Xs], [], [], [X | Xs], []). -common_prefix([X | Xs], [Y | Ys], Prefix, TailXs, TailYs) :- - ( X = Y -> - common_prefix(Xs, Ys, Prefix1, TailXs, TailYs), - Prefix = [X | Prefix1] - ; - TailXs = [X | Xs], - TailYs = [Y | Ys], - Prefix = [] - ). - -%-----------------------------------------------------------------------------% - -:- pred defn_to_local(mlds_module_name::in, mlds_defn::in, - pair(ilds.id, mlds_type)::out) is det. - -defn_to_local(ModuleName, Defn, Id - MLDSType) :- - Defn = mlds_defn(Name, _Context, _DeclFlags, Entity), - ( - Name = entity_data(DataName), - Entity = mlds_data(MLDSType0, _Initializer, _GCStatement) - -> - mangle_dataname(DataName, MangledDataName), - mangle_mlds_var(qual(ModuleName, module_qual, - mlds_var_name(MangledDataName, no)), Id), - MLDSType0 = MLDSType - ; - unexpected($module, $pred, "definition name was not data/1") - ). - -%-----------------------------------------------------------------------------% -% -% These functions are for converting to/from generic objects. -% - -:- func convert_to_object(il_type) = instr_tree. - -convert_to_object(Type) = singleton(box(ValueType)) :- - Type = il_type(_, SimpleType), - ValueType = simple_type_to_valuetype(SimpleType). - -:- func convert_from_object(il_type) = instr_tree. - -convert_from_object(Type) = from_list([unbox(Type), ldobj(Type)]). - -:- func simple_type_to_valuetype(simple_type) = il_type. -simple_type_to_valuetype(int8) = - il_type([], valuetype(il_system_name(["SByte"]))). -simple_type_to_valuetype(int16) = - il_type([], valuetype(il_system_name(["Int16"]))). -simple_type_to_valuetype(int32) = - il_type([], valuetype(il_system_name(["Int32"]))). -simple_type_to_valuetype(int64) = - il_type([], valuetype(il_system_name(["Int64"]))). -simple_type_to_valuetype(uint8) = - il_type([], valuetype(il_system_name(["Byte"]))). -simple_type_to_valuetype(uint16) = - il_type([], valuetype(il_system_name(["UInt16"]))). -simple_type_to_valuetype(uint32) = - il_type([], valuetype(il_system_name(["UInt32"]))). -simple_type_to_valuetype(uint64) = - il_type([], valuetype(il_system_name(["UInt64"]))). -simple_type_to_valuetype(float32) = - il_type([], valuetype(il_system_name(["Single"]))). -simple_type_to_valuetype(float64) = - il_type([], valuetype(il_system_name(["Double"]))). -simple_type_to_valuetype(bool) = - il_type([], valuetype(il_system_name(["Boolean"]))). -simple_type_to_valuetype(char) = - il_type([], valuetype(il_system_name(["Char"]))). -simple_type_to_valuetype(object) = _ :- - % il_type([], valuetype(il_system_name(["Object"]))). - unexpected($module, $pred, "no value class for System.Object"). -simple_type_to_valuetype(string) = _ :- - % il_type([], valuetype(il_system_name(["String"]))). - unexpected($module, $pred, "no value class for System.String"). -simple_type_to_valuetype(refany) = _ :- - unexpected($module, $pred, "no value class for refany"). -simple_type_to_valuetype(class(_)) = _ :- - unexpected($module, $pred, "no value class for class"). -simple_type_to_valuetype(valuetype(Name)) = - il_type([], valuetype(Name)). -simple_type_to_valuetype(interface(_)) = _ :- - unexpected($module, $pred, "no value class for interface"). -simple_type_to_valuetype('[]'(_, _)) = _ :- - unexpected($module, $pred, "no value class for array"). -simple_type_to_valuetype('&'( _)) = _ :- - unexpected($module, $pred, "no value class for '&'"). -simple_type_to_valuetype('*'(_)) = _ :- - unexpected($module, $pred, "no value class for '*'"). -simple_type_to_valuetype(native_float) = _ :- - unexpected($module, $pred, "no value class for native float"). -simple_type_to_valuetype(native_int) = _ :- - unexpected($module, $pred, "no value class for native int"). -simple_type_to_valuetype(native_uint) = _ :- - unexpected($module, $pred, "no value class for native uint"). - -%-----------------------------------------------------------------------------% - -:- func il_bool_type = il_type. - -il_bool_type = simple_type_to_valuetype(bool). - -%-----------------------------------------------------------------------------% -% -% The mapping of the string type. -% - -:- func il_string_equals = methodref. - -il_string_equals = get_static_methodref(il_string_class_name, id("Equals"), - simple_type(bool), [il_string_type, il_string_type]). - -:- func il_string_compare = methodref. - -il_string_compare = get_static_methodref(il_string_class_name, id("Compare"), - simple_type(int32), [il_string_type, il_string_type]). - - % Note that we need to use the hash function from the Mercury standard - % library, rather than the one from the .NET BCL (Base Class Library), - % because it must match the one used by the Mercury compiler when - % computing the hash tables for string switches. - % -:- func il_mercury_string_hash = methodref. - -il_mercury_string_hash = get_static_methodref(mercury_string_class_name, - id("hash_2"), simple_type(int32), [il_string_type]). - -:- func il_string_class_name = ilds.class_name. - -il_string_class_name = il_system_name(["String"]). - -:- func il_string_simple_type = simple_type. - -il_string_simple_type = class(il_string_class_name). - -:- func il_string_type = il_type. - -il_string_type = il_type([], il_string_simple_type). - -:- func mercury_string_class_name = ilds.class_name. - -mercury_string_class_name = mercury_library_name(StringClass) :- - sym_name_to_class_name(qualified(unqualified("string"), - wrapper_class_name), StringClass). - -%-----------------------------------------------------------------------------% -% -% The mapping of the generic type (used like MR_Box) -% - -:- func il_generic_type = il_type. - -il_generic_type = il_type([], il_generic_simple_type). - -:- func il_generic_simple_type = simple_type. - -il_generic_simple_type = class(il_generic_class_name). - -il_generic_class_name = il_system_name(["Object"]). - - % Return the class name for System.ValueType. - % -:- func il_generic_valuetype_name = ilds.class_name. - -il_generic_valuetype_name = il_system_name(["ValueType"]). - - % Return the class name for System.Enum - % -:- func il_generic_enum_name = ilds.class_name. - -il_generic_enum_name = il_system_name(["Enum"]). - -%-----------------------------------------------------------------------------% -% -% The mapping of the object array type (used like MR_Word). -% - % il_object_array_type means array of System.Object. - % -:- func il_object_array_type = il_type. - -il_object_array_type = il_type([], '[]'(il_generic_type, [])). - -%-----------------------------------------------------------------------------% -% -% The mapping of the library array type (array(T)) -% - - % il_generic_array_type means array of System.Object. - % -:- func il_generic_array_type = il_type. - -il_generic_array_type = il_type([], class(il_system_name(["Array"]))). - -%-----------------------------------------------------------------------------% -% -% The class that performs conversion operations -% - -:- func il_conversion_class_name = ilds.class_name. - -il_conversion_class_name = mercury_runtime_name(["Convert"]). - -%-----------------------------------------------------------------------------% -% -% The mapping of the exception type. -% - -:- func il_exception_type = il_type. - -il_exception_type = il_type([], il_exception_simple_type). - -:- func il_exception_simple_type = simple_type. - -il_exception_simple_type = class(il_exception_class_name). - -:- func il_exception_class_name = ilds.class_name. - -il_exception_class_name = mercury_runtime_name(["Exception"]). - -%-----------------------------------------------------------------------------% - - % The System.Environment.set_ExitCode method (the "setter" for the - % System.Environment.ExitCode property). We use this to set a non-zero - % exit status when the main method exits due to an uncaught exception. - % -:- func il_set_exit_code = methodref. - -il_set_exit_code = get_static_methodref(system_environment_class_name, - id("set_ExitCode"), void, [il_type([], int32)]). - -:- func system_environment_class_name = ilds.class_name. - -system_environment_class_name = il_system_name(["Environment"]). - -%-----------------------------------------------------------------------------% -% -% The mapping of the generic environment pointer type. -% - -% Unfortunately the .NET CLR doesn't have any verifiable way of creating a -% generic pointer to an environment, unless you allocate them on the heap. -% Using "refany" (a.k.a. "typedref") *almost* works, except that we need -% to be able to put these pointers in environment structs, and the CLR -% doesn't allow that (see ECMA CLI Partition 1, 8.6.1.3 "Local Signatures"). -% So we only do that if the --il-refany-fields option is set. -% If it is not set, then handle_options.m will ensure that we allocate -% the environments on the heap if verifiable code is requested. - -% For unverifiable code we allocate environments on the stack and use -% unmanaged pointers. - -:- func choose_il_envptr_type(globals) = il_type. - -choose_il_envptr_type(Globals) = ILType :- - globals.lookup_bool_option(Globals, put_nondet_env_on_heap, OnHeap), - globals.lookup_bool_option(Globals, verifiable_code, Verifiable), - ( OnHeap = yes -> - % Use an object reference type. - ILType = il_heap_envptr_type - ; Verifiable = yes -> - % Use "refany", the generic managed pointer type - ILType = il_type([], refany) - ; - % Use unmanaged pointers - ILType = il_type([], native_uint) - % XXX We should introduce an ILDS type for unmanaged pointers, - % rather than using native_uint; that's what IL does, but it sucks - % -- we should delay the loss of type information to the last possible - % moment, i.e. when writing out IL. - ). - -:- func il_heap_envptr_type = il_type. - -il_heap_envptr_type = il_type([], il_heap_envptr_simple_type). - -:- func il_heap_envptr_simple_type = simple_type. - -il_heap_envptr_simple_type = class(il_heap_envptr_class_name). - -:- func il_heap_envptr_class_name = ilds.class_name. - -il_heap_envptr_class_name = mercury_runtime_name(["Environment"]). - -%-----------------------------------------------------------------------------% -% -% The mapping of the commit type -% - -:- func il_commit_type = il_type. - -il_commit_type = il_type([], il_commit_simple_type). - -:- func il_commit_simple_type = simple_type. - -il_commit_simple_type = class(il_commit_class_name). - -:- func il_commit_class_name = ilds.class_name. - -il_commit_class_name = mercury_runtime_name(["Commit"]). - -%----------------------------------------------------------------------------- - - % Qualify a name with "[mercury]mercury.". - % -:- func mercury_library_name(ilds.namespace_qual_name) = ilds.class_name. - -mercury_library_name(Name) = - structured_name(assembly("mercury"), ["mercury" | Name], []). - - % Qualify a name with "[mercury]mercury." and add the wrapper class - % name on the end. - % -:- func mercury_library_wrapper_class_name(ilds.namespace_qual_name) = - ilds.class_name. - -mercury_library_wrapper_class_name(Name) = - structured_name(assembly("mercury"), - ["mercury" | Name] ++ [wrapper_class_name], []). - -%----------------------------------------------------------------------------- - - % Qualifiy a name with "[mercury]mercury.runtime.". - % -:- func mercury_runtime_name(ilds.namespace_qual_name) = ilds.class_name. - -mercury_runtime_name(Name) = - structured_name(assembly("mercury"), ["mercury", "runtime" | Name], []). - -%----------------------------------------------------------------------------- - - % Qualifiy a name with "[mscorlib]System.". - % -:- func il_system_name(ilds.namespace_qual_name) = ilds.class_name. - -il_system_name(Name) = - structured_name(il_system_assembly_name, - [il_system_namespace_name | Name], []). - -:- func il_system_assembly_name = assembly_name. - -il_system_assembly_name = assembly("mscorlib"). - -:- func il_system_namespace_name = string. - -il_system_namespace_name = "System". - -%----------------------------------------------------------------------------- - - % Generate extern decls for any assembly we reference. - % -:- pred generate_extern_assembly(string::in, assembly_decl::in, - bool::in, bool::in, mlds_imports::in, list(il_decl)::out) is det. - -generate_extern_assembly(CurrentAssembly, Version, SignAssembly, - SeparateAssemblies, Imports, AllDecls) :- - Gen = (pred(Import::in, GenDecls::out) is semidet :- - ( - Import = mercury_import(compiler_visible_interface, ImportName), - ( - SignAssembly = yes, - AsmDecls = mercury_strong_name_assembly_decls - ; - SignAssembly = no, - AsmDecls = [] - ) - ; - Import = foreign_import(ForeignImportName), - ForeignImportName = il_assembly_name(ImportName), - PackageName = mlds_module_name_to_package_name( ImportName), - ForeignPackageStr = sym_name_to_string(PackageName), - ( string.prefix(ForeignPackageStr, "System") -> - AsmDecls = dotnet_system_assembly_decls(Version) - ; - AsmDecls = [] - ) - ), - AsmName = mlds_module_name_to_assembly_name(ImportName), - ( - AsmName = assembly(Assembly), - Assembly \= "mercury", - GenDecls = [ildecl_extern_assembly(Assembly, AsmDecls)] - ; - AsmName = module(ModuleName, Assembly), - ( - SeparateAssemblies = no, - ( Assembly = CurrentAssembly -> - ModuleStr = ModuleName ++ ".dll", - GenDecls = [ildecl_file(ModuleStr), - ildecl_extern_module(ModuleStr)] - ; - Assembly \= "mercury", - GenDecls = [ildecl_extern_assembly(Assembly, AsmDecls)] - ) - ; - SeparateAssemblies = yes, - GenDecls = [ildecl_extern_assembly(ModuleName, AsmDecls)] - ) - ) - ), - list.filter_map(Gen, Imports, Decls0), - list.sort_and_remove_dups(list.condense(Decls0), Decls), - AllDecls = [ - ildecl_extern_assembly("mercury", [ - version(0, 0, 0, 0), - public_key_token([ - int8(0x22), int8(0x8C), int8(0x16), int8(0x7D), - int8(0x12), int8(0xAA), int8(0x0B), int8(0x0B) - ]) - ]), - ildecl_extern_assembly("mscorlib", - dotnet_system_assembly_decls(Version)) | Decls]. - -:- func dotnet_system_assembly_decls(assembly_decl) = list(assembly_decl). - -dotnet_system_assembly_decls(Version) - = [ - Version, - public_key_token([ - int8(0xb7), int8(0x7a), int8(0x5c), int8(0x56), - int8(0x19), int8(0x34), int8(0xE0), int8(0x89) - ]) - ]. - -:- func mercury_strong_name_assembly_decls = list(assembly_decl). - -mercury_strong_name_assembly_decls - = [ - version(0, 0, 0, 0), - public_key_token([ - int8(0x22), int8(0x8C), int8(0x16), int8(0x7D), - int8(0x12), int8(0xAA), int8(0x0B), int8(0x0B) - ]) - ]. - -%----------------------------------------------------------------------------- - -:- func make_method_defn(bool, bool, instr_tree) = method_defn. - -make_method_defn(DebugIlAsm, VerifiableCode, InstrTree) = MethodDecls :- - ( - DebugIlAsm = yes, - Add = 1 - ; - DebugIlAsm = no, - Add = 0 - ), - Instrs = cord.list(InstrTree), - MaxStack = maxstack(int32(calculate_max_stack(Instrs) + Add)), - % .zeroinit (which initializes all variables to zero) is required for - % verifiable code. But if we're generating non-verifiable code, then - % we can skip it. The code that the Mercury compiler generates doesn't - % require it, and omitting it may lead to slightly faster code. - ( - VerifiableCode = yes, - MethodDecls = [MaxStack, zeroinit, instrs(Instrs)] - ; - VerifiableCode = no, - MethodDecls = [MaxStack, instrs(Instrs)] - ). - -%----------------------------------------------------------------------------- -% -% Some useful functions for generating IL fragments -% - -:- func load_this = instr. - -load_this = ldarg(index(0)). - -:- func call_class_constructor(ilds.class_name) = instr. - -call_class_constructor(CtorMemberName) = - call(get_static_methodref(CtorMemberName, cctor, void, [])). - -:- func call_constructor(ilds.class_name) = instr. - -call_constructor(CtorMemberName) = - call(get_constructor_methoddef(CtorMemberName, [])). - -:- func throw_unimplemented(string) = instr_tree. - -throw_unimplemented(String) = - from_list([ - ldstr(String), - newobj(get_instance_methodref(il_exception_class_name, - ctor, void, [il_string_type])), - throw] - ). - -:- func newobj_constructor(ilds.class_name, list(il_type)) = instr. - -newobj_constructor(CtorMemberName, ArgTypes) = - newobj(get_constructor_methoddef(CtorMemberName, ArgTypes)). - -:- func get_constructor_methoddef(ilds.class_name, list(il_type)) - = methodref. - -get_constructor_methoddef(CtorMemberName, ArgTypes) = - get_instance_methodref(CtorMemberName, ctor, void, ArgTypes). - -:- func get_instance_methodref(ilds.class_name, member_name, ret_type, - list(il_type)) = methodref. - -get_instance_methodref(ClassName, MethodName, RetType, TypeParams) = - methoddef(call_conv(yes, default), RetType, - class_member_name(ClassName, MethodName), TypeParams). - -:- func get_static_methodref(ilds.class_name, member_name, ret_type, - list(il_type)) = methodref. - -get_static_methodref(ClassName, MethodName, RetType, TypeParams) = - methoddef(call_conv(no, default), RetType, - class_member_name(ClassName, MethodName), TypeParams). - -:- func make_constructor_class_member(method_defn) = class_member. - -make_constructor_class_member(MethodDecls) = Member :- - MethodHead = methodhead([], ctor, signature(call_conv(no, default), - void, []), []), - Member = member_method(MethodHead, MethodDecls). - -:- func make_fieldref(il_type, ilds.class_name, ilds.id) = fieldref. - -make_fieldref(ILType, ClassName, Id) = - fieldref(ILType, class_member_name(ClassName, id(Id))). - -:- func responsible_for_init_runtime_instrs = list(instr). - -responsible_for_init_runtime_instrs = [ - call(get_static_methodref(runtime_init_module_name, - responsible_for_init_runtime_name, simple_type(bool), [])) - ]. - -:- func runtime_initialization_instrs = list(instr). - -runtime_initialization_instrs = [ - call(get_static_methodref(runtime_init_module_name, - runtime_init_method_name, void, [il_bool_type])) - ]. - -:- func runtime_init_module_name = ilds.class_name. - -runtime_init_module_name = - structured_name(assembly("mercury"), - ["mercury", "runtime", "Init"], []). - -:- func runtime_init_method_name = ilds.member_name. - -runtime_init_method_name = id("init_runtime"). - -:- func responsible_for_init_runtime_name = ilds.member_name. - -responsible_for_init_runtime_name = id("responsible_for_initialising_runtime"). - -%-----------------------------------------------------------------------------% -% -% Predicates for manipulating il_info -% - -:- func il_info_init(mlds_module_name, ilds.id, mlds_imports, - il_data_rep, bool, bool, bool, bool, bool) = il_info. - -il_info_init(ModuleName, AssemblyName, Imports, ILDataRep, - DebugIlAsm, VerifiableCode, ByRefTailCalls, MsCLR, RotorCLR) = - il_info(ModuleName, AssemblyName, Imports, set.init, ILDataRep, - DebugIlAsm, VerifiableCode, ByRefTailCalls, MsCLR, RotorCLR, - empty, empty, [], no_main, set.init, set.init, - map.init, empty, counter.init(1), counter.init(1), no, - Args, MethodName, CSharpMethodName, DefaultSignature) :- - Args = [], - DefaultSignature = signature(call_conv(no, default), void, []), - MethodName = id(""), - CSharpMethodName = id(""). - -:- pred il_info_new_class(mlds_class_defn::in, il_info::in, il_info::out) - is det. - -il_info_new_class(ClassDefn, !Info) :- - ClassDefn = mlds_class_defn(_, _, _, _, _, _, Members), - list.filter_map( - (pred(M::in, S::out) is semidet :- - M = mlds_defn(Name, _, _, mlds_data(_, _, _)), - S = entity_name_to_ilds_id(Name) - ), Members, FieldNames), - !Info ^ alloc_instrs := empty, - !Info ^ init_instrs := empty, - !Info ^ class_members := [], - !Info ^ has_main := no_main, - !Info ^ class_foreign_langs := set.init, - !Info ^ field_names := set.list_to_set(FieldNames). - - % Reset the il_info for processing a new method. - % -:- pred il_info_new_method(arguments_map::in, signature::in, member_name::in, - member_name::in, il_info::in, il_info::out) is det. - -il_info_new_method(ILArgs, ILSignature, MethodName, CSharpMethodName, - !Info) :- - Info0 = !.Info, - ( - !.Info ^ method_foreign_lang = yes(SomeLang), - !Info ^ file_foreign_langs := - set.insert(Info0 ^ file_foreign_langs, SomeLang), - !Info ^ class_foreign_langs := - set.insert(Info0 ^ class_foreign_langs, SomeLang) - ; - !.Info ^ method_foreign_lang = no - ), - !Info ^ locals := map.init, - !Info ^ instr_tree := empty, - !Info ^ label_counter := counter.init(1), - !Info ^ block_counter := counter.init(1), - !Info ^ method_foreign_lang := no, - !Info ^ arguments := ILArgs, - !Info ^ method_name := MethodName, - !Info ^ csharp_method_name := CSharpMethodName, - !Info ^ signature := ILSignature. - -:- pred il_info_set_arguments(assoc_list(ilds.id, mlds_type)::in, - il_info::in, il_info::out) is det. - -il_info_set_arguments(Arguments, !Info) :- - !Info ^ arguments := Arguments. - -:- pred il_info_get_arguments(il_info::in, arguments_map::out) is det. - -il_info_get_arguments(Info, Arguments) :- - Arguments = Info ^ arguments. - -:- pred il_info_get_mlds_type(ilds.id::in, mlds_type::out, - il_info::in, il_info::out) is det. - -il_info_get_mlds_type(Id, Type, !Info) :- - ( map.search(!.Info ^ locals, Id, Type0) -> - Type = Type0 - ; assoc_list.search(!.Info ^ arguments, Id, Type0) -> - Type = Type0 - ; - % XXX If it isn't a local or an argument, it can only be a - % "global variable" -- used by RTTI. - Type = mlds_type_for_rtti_global - ). - - % RTTI creates global variables -- these all happen to be of - % type mlds_native_int_type. - % -:- func mlds_type_for_rtti_global = mlds_type. - -mlds_type_for_rtti_global = mlds_native_int_type. - -:- pred il_info_set_modulename(mlds_module_name::in, - il_info::in, il_info::out) is det. - -il_info_set_modulename(ModuleName, !Info) :- - !Info ^ module_name := ModuleName. - -:- pred il_info_add_locals(assoc_list(ilds.id, mlds_type)::in, - il_info::in, il_info::out) is det. - -il_info_add_locals(NewLocals, !Info) :- - !Info ^ locals := - map.det_insert_from_assoc_list(!.Info ^ locals, NewLocals). - -:- pred il_info_remove_locals(assoc_list(ilds.id, mlds_type)::in, - il_info::in, il_info::out) is det. - -il_info_remove_locals(RemoveLocals, !Info) :- - assoc_list.keys(RemoveLocals, Keys), - map.delete_list(Keys, !.Info ^ locals, NewLocals), - !Info ^ locals := NewLocals. - -:- pred il_info_add_class_member(list(class_member)::in, - il_info::in, il_info::out) is det. - -il_info_add_class_member(ClassMembers, !Info) :- - !Info ^ class_members := - list.append(ClassMembers, !.Info ^ class_members). - -:- pred il_info_add_instructions(list(instr)::in, - il_info::in, il_info::out) is det. - -il_info_add_instructions(NewInstrs, !Info) :- - !Info ^ instr_tree := - !.Info ^ instr_tree ++ from_list(NewInstrs). - -:- pred il_info_add_init_instructions(list(instr)::in, - il_info::in, il_info::out) is det. - -il_info_add_init_instructions(NewInstrs, !Info) :- - !Info ^ init_instrs := - !.Info ^ init_instrs ++ from_list(NewInstrs). - -:- pred il_info_add_alloc_instructions(list(instr)::in, - il_info::in, il_info::out) is det. - -il_info_add_alloc_instructions(NewInstrs, !Info) :- - !Info ^ alloc_instrs := - !.Info ^ alloc_instrs ++ from_list(NewInstrs). - -:- pred il_info_get_instructions(il_info::in, cord(instr)::out) is det. - -il_info_get_instructions(Info, Instrs) :- - Instrs = Info ^ instr_tree. - -:- pred il_info_get_locals_list(il_info::in, - assoc_list(ilds.id, il_type)::out) is det. - -il_info_get_locals_list(Info, Locals) :- - DataRep = Info ^ il_data_rep, - map.map_values_only((pred(V::in, W::out) is det :- - W = mlds_type_to_ilds_type(DataRep, V)), - Info ^ locals, LocalsMap), - map.to_assoc_list(LocalsMap, Locals). - -:- pred il_info_get_module_name(il_info::in, mlds_module_name::out) is det. - -il_info_get_module_name(Info, ModuleName) :- - ModuleName = Info ^ module_name. - -:- pred il_info_get_next_block_id(blockid::out, il_info::in, il_info::out) - is det. - -il_info_get_next_block_id(N, !Info) :- - counter.allocate(N, !.Info ^ block_counter, NewCounter), - !Info ^ block_counter := NewCounter. - -:- pred il_info_get_next_label_num(int::out, il_info::in, il_info::out) is det. - -il_info_get_next_label_num(N, !Info) :- - counter.allocate(N, !.Info ^ label_counter, NewCounter), - !Info ^ label_counter := NewCounter. - -:- pred il_info_make_next_label(ilds.label::out, il_info::in, il_info::out) - is det. - -il_info_make_next_label(Label, !Info) :- - il_info_get_next_label_num(LabelNnum, !Info), - string.format("l%d", [i(LabelNnum)], Label). - -%-----------------------------------------------------------------------------% - - % Use this to make comments into trees easily. - % -:- func comment_node(string) = instr_tree. - -comment_node(S) = singleton(comment(S)). - - % Use this to make contexts into trees easily. - % -:- func context_node(mlds_context) = instr_tree. - -context_node(Context) = singleton(context_instr(Context)). - -:- func context_instr(mlds_context) = instr. - -context_instr(Context) = context(FileName, LineNumber) :- - ProgContext = mlds_get_prog_context(Context), - term.context_file(ProgContext, FileName), - term.context_line(ProgContext, LineNumber). - - % Maybe fold T into U, and map it to V. - % U remains untouched if T is `no'. - % -:- pred maybe_map_fold(pred(T, V, U, U)::in(pred(in, out, in, out) is det), - maybe(T)::in, V::in, V::out, U::in, U::out) is det. - -maybe_map_fold(_, no, !V, !U). -maybe_map_fold(P, yes(T), _, !:V, !U) :- - P(T, !:V, !U). - -:- func il_method_params_to_il_types(list(il_method_param)) = list(il_type). - -il_method_params_to_il_types([]) = []. -il_method_params_to_il_types([ il_method_param(Type, _) | Params]) = - [ Type | Types ] :- - Types = il_method_params_to_il_types(Params). - -%-----------------------------------------------------------------------------% -:- end_module ml_backend.mlds_to_il. -%-----------------------------------------------------------------------------% diff --git a/compiler/mlds_to_ilasm.m b/compiler/mlds_to_ilasm.m deleted file mode 100644 index a6bcec04a..000000000 --- a/compiler/mlds_to_ilasm.m +++ /dev/null @@ -1,145 +0,0 @@ -%-----------------------------------------------------------------------------% -% vim: ft=mercury ts=4 sw=4 et -%-----------------------------------------------------------------------------% -% Copyright (C) 1999-2011 The University of Melbourne. -% This file may only be copied under the terms of the GNU General -% Public License - see the file COPYING in the Mercury distribution. -%-----------------------------------------------------------------------------% -% -% File: mlds_to_ilasm.m. -% Main author: trd. -% -% This code converts the MLDS representation into IL assembler. This module -% takes care of creating the appropriate files and generating output, while -% mlds_to_il takes care of generated IL from MLDS. -% -%-----------------------------------------------------------------------------% - -:- module ml_backend.mlds_to_ilasm. -:- interface. - -:- import_module libs.globals. -:- import_module ml_backend.mlds. - -:- import_module bool. -:- import_module io. - -%-----------------------------------------------------------------------------% - - % Convert the MLDS to IL and write it to a file. - % -:- pred output_mlds_via_ilasm(globals::in, mlds::in, bool::out, - io::di, io::uo) is det. - -%-----------------------------------------------------------------------------% -%-----------------------------------------------------------------------------% - -:- implementation. - -:- import_module libs.file_util. -:- import_module libs.options. -:- import_module ml_backend.ilasm. -:- import_module ml_backend.il_peephole. -:- import_module ml_backend.mlds_to_il. -:- import_module ml_backend.mlds_to_managed. -:- import_module parse_tree.file_names. -:- import_module parse_tree.prog_foreign. - -:- import_module list. -:- import_module maybe. -:- import_module require. -:- import_module set. - -%-----------------------------------------------------------------------------% - -output_mlds_via_ilasm(Globals, MLDS, Succeeded, !IO) :- - ModuleName = mlds_get_module_name(MLDS), - module_name_to_file_name(Globals, ModuleName, ".il", - do_create_dirs, ILAsmFile, !IO), - output_to_file_return_result(Globals, ILAsmFile, - output_assembler(Globals, MLDS), Result, !IO), - - ( - Result = yes(ForeignLangs), - % Output any outline foreign_code to the appropriate foreign - % language file. - list.foldl2(output_foreign_file(Globals, MLDS), - set.to_sorted_list(ForeignLangs), yes, Succeeded, !IO) - ; - % An I/O error occurred; output_to_file has already reported - % an error message, so we don't need to do anything here. - Result = no, - Succeeded = no - ). - -:- pred output_foreign_file(globals::in, mlds::in, foreign_language::in, - bool::in, bool::out, io::di, io::uo) is det. - -output_foreign_file(Globals, MLDS, ForeignLang, !Succeeded, !IO) :- - ModuleName = mlds_get_module_name(MLDS), - ( - ForeignModuleName = foreign_language_module_name(ModuleName, - ForeignLang), - Extension = foreign_language_file_extension(ForeignLang) - -> - ( - ForeignLang = lang_csharp, - module_name_to_file_name(Globals, ForeignModuleName, Extension, - do_create_dirs, File, !IO), - output_to_file(Globals, File, output_csharp_code(Globals, MLDS), - TargetCodeSucceeded, !IO), - bool.and(TargetCodeSucceeded, !Succeeded) - ; - ForeignLang = lang_c, - sorry($module, $pred, "language C foreign code not supported") - ; - ForeignLang = lang_il, - sorry($module, $pred, "language IL foreign code not supported") - ; - ForeignLang = lang_java, - sorry($module, $pred, "language Java foreign code not supported") - ; - ForeignLang = lang_erlang, - sorry($module, $pred, "language Erlang foreign code not supported") - ) - ; - unexpected($module, $pred, "output_foreign_file: unexpected language") - ). - - % Generate the `.il' file. - % Returns the set of foreign language - % -:- pred output_assembler(globals::in, mlds::in, set(foreign_language)::out, - io::di, io::uo) is det. - -output_assembler(Globals, MLDS, ForeignLangs, !IO) :- - MLDS = mlds(ModuleName, _ForeignCode, _Imports, _GlobalData, _Defns, - _InitPreds, _FinalPreds, _ExportedEnums), - output_src_start(ModuleName, !IO), - io.nl(!IO), - - generate_il(Globals, MLDS, ILAsm0, ForeignLangs), - - % Perform peephole optimization if requested. If peephole optimization - % was not requested, we may still need to invoke the peephole optimization - % pass, because some of the peephole optimizations are actually needed - % for verifiability of the generated IL. - globals.lookup_bool_option(Globals, optimize_peep, Peephole), - globals.lookup_bool_option(Globals, verifiable_code, Verifiable), - ( Peephole = yes -> - VerifyOnly = no, - il_peephole_optimize(VerifyOnly, ILAsm0, ILAsm) - ; Verifiable = yes -> - VerifyOnly = yes, - il_peephole_optimize(VerifyOnly, ILAsm0, ILAsm) - ; - ILAsm0 = ILAsm - ), - - % Output the assembly. - ilasm_output(Globals, ILAsm, !IO), - output_src_end(ModuleName, !IO). - -%-----------------------------------------------------------------------------% -:- end_module ml_backend.mlds_to_ilasm. -%-----------------------------------------------------------------------------% diff --git a/compiler/mlds_to_java.m b/compiler/mlds_to_java.m index 4df731061..7de20cdb4 100644 --- a/compiler/mlds_to_java.m +++ b/compiler/mlds_to_java.m @@ -451,7 +451,6 @@ output_java_decl(Info, Indent, DeclCode, !IO) :- ; ( Lang = lang_c ; Lang = lang_csharp - ; Lang = lang_il ; Lang = lang_erlang ), sorry($module, $pred, "foreign decl other than Java") @@ -470,7 +469,6 @@ output_java_body_code(Info, Indent, ForeignBodyCode, !IO) :- ; ( Lang = lang_c ; Lang = lang_csharp - ; Lang = lang_il ; Lang = lang_erlang ), sorry($module, $pred, "foreign code other than Java") @@ -730,7 +728,6 @@ output_exported_enum(Info, Indent, ExportedEnum, !IO) :- ; ( Lang = lang_c ; Lang = lang_csharp - ; Lang = lang_il ; Lang = lang_erlang ) ). @@ -1720,7 +1717,6 @@ rename_class_names_atomic(Renaming, !Statement) :- ; ( Lang = ml_target_c ; Lang = ml_target_gnu_c - ; Lang = ml_target_il ; Lang = ml_target_csharp ) ) @@ -1866,9 +1862,9 @@ rename_class_names_unary_op(Renaming, !Op) :- rename_class_names_target_code_component(Renaming, !Component) :- ( - !.Component = user_target_code(_, _, _) + !.Component = user_target_code(_, _) ; - !.Component = raw_target_code(_, _) + !.Component = raw_target_code(_) ; !.Component = target_code_alloc_id(_) ; @@ -3481,9 +3477,6 @@ type_to_string(Info, MLDS_Type, String, ArrayDims) :- ; ForeignType = c(_), unexpected($module, $pred, "c foreign_type") - ; - ForeignType = il(_), - unexpected($module, $pred, "il foreign_type") ; ForeignType = csharp(_), unexpected($module, $pred, "csharp foreign_type") @@ -4553,7 +4546,6 @@ output_atomic_stmt(Info, Indent, AtomicStmt, Context, !IO) :- ; ( TargetLang = ml_target_c ; TargetLang = ml_target_gnu_c - ; TargetLang = ml_target_il ; TargetLang = ml_target_csharp ), unexpected($module, $pred, @@ -4572,7 +4564,7 @@ output_atomic_stmt(Info, Indent, AtomicStmt, Context, !IO) :- output_target_code_component(Info, TargetCode, !IO) :- ( - TargetCode = user_target_code(CodeString, MaybeUserContext, _Attrs), + TargetCode = user_target_code(CodeString, MaybeUserContext), ( MaybeUserContext = yes(ProgContext), write_string_with_context_block(Info, 0, CodeString, @@ -4582,7 +4574,7 @@ output_target_code_component(Info, TargetCode, !IO) :- io.write_string(CodeString, !IO) ) ; - TargetCode = raw_target_code(CodeString, _Attrs), + TargetCode = raw_target_code(CodeString), io.write_string(CodeString, !IO) ; TargetCode = target_code_input(Rval), diff --git a/compiler/mlds_to_managed.m b/compiler/mlds_to_managed.m deleted file mode 100644 index d52c24ceb..000000000 --- a/compiler/mlds_to_managed.m +++ /dev/null @@ -1,777 +0,0 @@ -%-----------------------------------------------------------------------------% -% vim: ft=mercury ts=4 sw=4 et -%-----------------------------------------------------------------------------% -% Copyright (C) 2002-2007, 2009-2011 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. -%-----------------------------------------------------------------------------% -% -% Module: mlds_to_managed.m. -% Main author: trd, petdr. -% -% Generate code for the foreign language interface to C#. -% -%-----------------------------------------------------------------------------% - -:- module ml_backend.mlds_to_managed. -:- interface. - -:- import_module libs.globals. -:- import_module ml_backend.mlds. - -:- import_module io. - -%-----------------------------------------------------------------------------% - - % Convert the MLDS to C# and write it to a file. - % -:- pred output_csharp_code(globals::in, mlds::in, io::di, io::uo) is det. - - % Print the header comments of the output module. - % -:- pred output_src_start(mercury_module_name::in, io::di, io::uo) is det. - - % Print the footer commments of the output module. - % -:- pred output_src_end(mercury_module_name::in, io::di, io::uo) is det. - -%-----------------------------------------------------------------------------% -%-----------------------------------------------------------------------------% - -:- implementation. - -:- import_module backend_libs.c_util. -:- import_module libs.file_util. -:- import_module libs.options. -:- import_module mdbcomp.sym_name. -:- import_module ml_backend.ilds. -:- import_module ml_backend.ml_global_data. -:- import_module ml_backend.ml_util. -:- import_module ml_backend.mlds_to_il. -:- import_module parse_tree.file_names. -:- import_module parse_tree.prog_data. -:- import_module parse_tree.prog_foreign. -:- import_module parse_tree.prog_out. - -:- import_module bool. -:- import_module deconstruct. -:- import_module library. -:- import_module list. -:- import_module map. -:- import_module maybe. -:- import_module require. -:- import_module set. -:- import_module string. -:- import_module term. - -%-----------------------------------------------------------------------------% - -output_csharp_code(Globals, MLDS, !IO) :- - MLDS = mlds(ModuleName, AllForeignCode, _Imports, GlobalData, Defns0, - _InitPreds, _FinalPreds, _ExportedEnums), - ml_global_data_get_all_global_defns(GlobalData, - ScalarCellGroupMap, VectorCellGroupMap, _AllocIdMap, GlobalDefns), - expect(map.is_empty(ScalarCellGroupMap), $module, $pred, - "nonempty ScalarCellGroupMap"), - expect(map.is_empty(VectorCellGroupMap), $module, $pred, - "nonempty VectorCellGroupMap"), - Defns = GlobalDefns ++ Defns0, - - output_src_start(ModuleName, !IO), - - ClassName = class_name(mercury_module_name_to_mlds(ModuleName), - wrapper_class_name), - - output_csharp_header_code(Globals, !IO), - - % Get the foreign code for the required language. - module_source_filename(Globals, ModuleName, SourceFileName, !IO), - ForeignCode = map.lookup(AllForeignCode, lang_csharp), - generate_foreign_header_code(Globals, SourceFileName, ForeignCode, !IO), - - % Output the namespace. - generate_namespace_details(ClassName, NameSpaceFmtStr, Namespace), - io.write_list(Namespace, "\n", - (pred(N::in, !.IO::di, !:IO::uo) is det :- - io.format(NameSpaceFmtStr, [s(N)], !IO) - ), !IO), - - io.write_strings(["\npublic class " ++ wrapper_class_name, "{\n"], !IO), - - % Output the contents of pragma foreign_code declarations. - generate_foreign_code(Globals, SourceFileName, ForeignCode, !IO), - - io.nl(!IO), - - % Output the contents of foreign_proc declarations. - % Put each one inside a method. - get_il_data_rep(Globals, DataRep), - list.foldl(generate_method_code(Globals, DataRep), Defns, !IO), - - io.write_string("};\n", !IO), - - % Close the namespace braces. - io.write_list(Namespace, "\n", - (pred(_N::in, !.IO::di, !:IO::uo) is det :- - io.write_string("}", !IO) - ), !IO), - io.nl(!IO), - - output_src_end(ModuleName, !IO). - -%-----------------------------------------------------------------------------% - -output_src_start(ModuleName, !IO) :- - library.version(Version, Fullarch), - io.write_strings( - ["//\n// Automatically generated from `", - sym_name_to_string(ModuleName), - ".m' by the\n", - "// Mercury compiler, version ", Version, ",\n", - "// configured for ", Fullarch, ".\n", - "// Do not edit.\n", - "\n\n"], !IO). - -output_src_end(ModuleName, !IO) :- - io.write_string("// End of module: ", !IO), - prog_out.write_sym_name(ModuleName, !IO), - io.write_string(". \n", !IO). - -%-----------------------------------------------------------------------------% - -:- pred output_csharp_header_code(globals::in, io::di, io::uo) is det. - -output_csharp_header_code(Globals, !IO) :- - get_il_data_rep(Globals, DataRep), - ( DataRep = il_data_rep(yes, _) -> - io.write_string("#define MR_HIGHLEVEL_DATA\n", !IO) - ; - true - ), - - % XXX We may be able to drop the mercury namespace soon, - % as there doesn't appear to be any llds generated code - % in the C# code anymore. - io.write_string("using mercury;\n\n", !IO), - - globals.lookup_bool_option(Globals, il_sign_assembly, SignAssembly), - ( - SignAssembly = yes, - io.write_string("[assembly:System.Reflection." ++ - "AssemblyKeyFileAttribute(\"mercury.sn\")]\n", !IO) - ; - SignAssembly = no - ). - -:- pred generate_foreign_header_code(globals::in, string::in, - mlds_foreign_code::in, io::di, io::uo) is det. - -generate_foreign_header_code(Globals, SourceFileName, ForeignCode, !IO) :- - ForeignCode = mlds_foreign_code(DeclCodes, _BodyCodes, _Imports, - _ExportDefns), - - io.write_list(DeclCodes, "\n", - % XXX Ignoring _IsLocal may not be the right thing to do. - (pred(ForeignDeclCode::in, !.IO::di, !:IO::uo) is det :- - ForeignDeclCode = foreign_decl_code(CodeLang, _IsLocal, - LiteralOrInclude, Context), - ( CodeLang = lang_csharp -> - output_foreign_literal_or_include(Globals, SourceFileName, - LiteralOrInclude, Context, !IO) - ; - sorry($module, $pred, "wrong foreign code") - ), - output_reset_context(Globals, !IO) - ), !IO). - -:- pred generate_namespace_details(ilds.class_name::in, string::out, - list(string)::out) is det. - -generate_namespace_details(ClassName, NameSpaceFmtStr, Namespace) :- - % XXX We should consider what happens if we need to mangle - % the namespace name. - % - % XXX Generating the left brace here and the right brace somewhere else - % seems bad design. -zs - NameSpaceFmtStr = "namespace @%s {", - - Namespace0 = get_class_namespace(ClassName), - ( list.reverse(Namespace0) = [Head | Tail] -> - Namespace = list.reverse([Head ++ "__csharp_code" | Tail]) - ; - Namespace = Namespace0 - ). - -:- pred generate_foreign_code(globals::in, string::in, mlds_foreign_code::in, - io::di, io::uo) is det. - -generate_foreign_code(Globals, SourceFileName, ForeignCode, !IO) :- - ForeignCode = mlds_foreign_code(_DeclCodes, BodyCodes, - _Imports, _ExportDefns), - io.write_list(BodyCodes, "\n", - (pred(foreign_body_code(CodeLang, LiteralOrInclude, Context)::in, - !.IO::di, !:IO::uo) is det :- - ( CodeLang = lang_csharp -> - output_foreign_literal_or_include(Globals, SourceFileName, - LiteralOrInclude, Context, !IO) - ; - sorry($module, $pred, "wrong foreign language") - ), - output_reset_context(Globals, !IO) - ), !IO). - -:- pred output_foreign_literal_or_include(globals::in, string::in, - foreign_literal_or_include::in, prog_context::in, io::di, io::uo) is det. - -output_foreign_literal_or_include(Globals, SourceFileName, - LiteralOrInclude, Context, !IO) :- - ( - LiteralOrInclude = literal(Code), - output_context(Globals, Context, !IO), - io.write_string(Code, !IO) - ; - LiteralOrInclude = include_file(IncludeFileName), - make_include_file_path(SourceFileName, IncludeFileName, IncludePath), - output_context(Globals, context(IncludePath, 1), !IO), - write_include_file_contents(IncludePath, !IO) - ), - io.nl(!IO). - -:- pred generate_method_code(globals::in, il_data_rep::in, mlds_defn::in, - io::di, io::uo) is det. - -generate_method_code(Globals, DataRep, Defn, !IO) :- - Defn = mlds_defn(EntityName, _Context, _DeclFlags, Entity), - ( - ( EntityName = entity_export(_) - ; EntityName = entity_data(_) - ; EntityName = entity_type(_, _) - ) - ; - EntityName = entity_function(PredLabel, ProcId, MaybeSeqNum, _PredId), - ( - % XXX we ignore the attributes - Entity = mlds_function(_, Params, body_defined_here(Statement), - _Attributes, EnvVarNames), - has_foreign_languages(Statement, Langs), - list.member(lang_csharp, Langs) - -> - expect(set.is_empty(EnvVarNames), $module, $pred, "EnvVarNames"), - Params = mlds_func_params(Inputs, Outputs), - ( - Outputs = [], - ReturnType = void - ; - Outputs = [MLDSReturnType], - mlds_type_to_ilds_type(DataRep, MLDSReturnType) = - il_type(_, SimpleType), - ReturnType = simple_type(SimpleType) - ; - Outputs = [_, _ | _], - % C# doesn't support multiple return values - sorry($module, $pred, "multiple return values") - ), - - predlabel_to_csharp_id(PredLabel, ProcId, MaybeSeqNum, Id), - io.write_string("public static ", !IO), - write_il_ret_type_as_foreign_type(ReturnType, !IO), - - io.write_string(" ", !IO), - - io.write_string(Id, !IO), - io.write_string("(", !IO), - io.write_list(Inputs, ", ", - write_input_arg_as_foreign_type(DataRep), !IO), - io.write_string(")", !IO), - io.nl(!IO), - - io.write_string("{\n", !IO), - write_statement(Globals, DataRep, Inputs, Statement, !IO), - io.write_string("}\n", !IO) - ; - true - ) - ). - -:- pred write_statement(globals::in, il_data_rep::in, mlds_arguments::in, - statement::in, io::di, io::uo) is det. - -write_statement(Globals, DataRep, Args, statement(Statement, Context), !IO) :- - ( - % XXX petdr - Statement = ml_stmt_atomic(ForeignProc), - ForeignProc = outline_foreign_proc(lang_csharp, OutlineArgs, _, Code) - -> - list.foldl(write_outline_arg_init(DataRep), OutlineArgs, !IO), - output_context(Globals, mlds_get_prog_context(Context), !IO), - io.write_string(Code, !IO), - io.nl(!IO), - output_reset_context(Globals, !IO), - list.foldl(write_outline_arg_final(DataRep), OutlineArgs, !IO) - ; - Statement = ml_stmt_block(Defns, Statements) - -> - io.write_list(Defns, "", write_defn_decl(DataRep), !IO), - io.write_string("{\n", !IO), - io.write_list(Statements, "", write_statement(Globals, DataRep, Args), - !IO), - io.write_string("\n}\n", !IO) - ; - Statement = ml_stmt_return(Rvals) - -> - ( Rvals = [Rval] -> - io.write_string("return ", !IO), - write_rval(DataRep, Rval, !IO), - io.write_string(";\n", !IO) - ; - sorry($module, $pred, "multiple return values") - ) - ; - Statement = ml_stmt_atomic(assign(LVal, RVal)) - -> - write_lval(DataRep, LVal, !IO), - io.write_string(" = ", !IO), - write_rval(DataRep, RVal, !IO), - io.write_string(";\n", !IO) - ; - functor(Statement, canonicalize, SFunctor, _Arity), - sorry($module, $pred, "foreign code output for " ++ SFunctor) - ). - -:- pred write_outline_arg_init(il_data_rep::in, outline_arg::in, - io::di, io::uo) is det. - -write_outline_arg_init(DataRep, OutlineArg, !IO) :- - ( - OutlineArg = ola_in(Type, VarName, Rval), - write_parameter_type(DataRep, Type, !IO), - io.write_string(" ", !IO), - io.write_string(VarName, !IO), - io.write_string(" = ", !IO), - write_rval(DataRep, Rval, !IO), - io.write_string(";\n", !IO) - ; - OutlineArg = ola_out(Type, VarName, _Lval), - write_parameter_type(DataRep, Type, !IO), - io.write_string(" ", !IO), - io.write_string(VarName, !IO), - % In C# give output variables a default value to avoid warnings. - io.write_string(" = ", !IO), - write_parameter_initializer(DataRep, Type, !IO), - io.write_string(";\n", !IO) - ; - OutlineArg = ola_unused - ). - -:- pred write_outline_arg_final(il_data_rep::in, outline_arg::in, - io::di, io::uo) is det. - -write_outline_arg_final(DataRep, OutlineArg, !IO) :- - ( - OutlineArg = ola_in(_, _, _) - ; - OutlineArg = ola_out(_Type, VarName, Lval), - write_lval(DataRep, Lval, !IO), - io.write_string(" = ", !IO), - io.write_string(VarName, !IO), - io.write_string(";\n", !IO) - ; - OutlineArg = ola_unused - ). - -:- pred write_assign_local_to_output(mlds_argument::in, io::di, io::uo) is det. - -write_assign_local_to_output(mlds_argument(Name, Type, _GcCode), !IO) :- - ( Name = entity_data(mlds_data_var(VarName0)) -> - VarName = VarName0 - ; - unexpected($module, $pred, "not a variable name") - ), - - % A pointer type is an output type. - ( - Type = mlds_ptr_type(_OutputType), - not is_anonymous_variable(VarName) - -> - write_mlds_var_name_for_parameter(VarName, !IO), - io.write_string(" = ", !IO), - write_mlds_var_name_for_local(VarName, !IO), - io.write_string(";\n", !IO) - ; - true - ). - -:- pred is_anonymous_variable(mlds_var_name::in) is semidet. - -is_anonymous_variable(mlds_var_name(Name, _)) :- - string.prefix(Name, "_"). - -%-----------------------------------------------------------------------------% - -:- pred output_context(globals::in, prog_context::in, io::di, io::uo) is det. - -output_context(Globals, Context, !IO) :- - MaybeSetLineNumbers = lookup_line_numbers(Globals, line_numbers), - term.context_file(Context, File), - term.context_line(Context, Line), - c_util.maybe_set_line_num(MaybeSetLineNumbers, File, Line, !IO). - -:- pred output_reset_context(globals::in, io::di, io::uo) is det. - -output_reset_context(Globals, !IO) :- - MaybeSetLineNumbers = lookup_line_numbers(Globals, line_numbers), - c_util.maybe_reset_line_num(MaybeSetLineNumbers, no, !IO). - -:- pred write_rval(il_data_rep::in, mlds_rval::in, io::di, io::uo) is det. - -write_rval(DataRep, Rval, !IO) :- - ( - Rval = ml_lval(Lval), - write_lval(DataRep, Lval, !IO) - ; - Rval = ml_mkword(_Tag, _Rval), - sorry($module, $pred, "mkword rval") - ; - Rval = ml_const(RvalConst), - write_rval_const(RvalConst, !IO) - ; - Rval = ml_unop(UnOp, RvalA), - ( - UnOp = std_unop(StdUnOp), - c_util.unary_prefix_op(StdUnOp, UnOpStr) - -> - io.write_string(UnOpStr, !IO), - io.write_string("(", !IO), - write_rval(DataRep, RvalA, !IO), - io.write_string(")", !IO) - ; - UnOp = cast(Type) - -> - io.write_string("(", !IO), - write_parameter_type(DataRep, Type, !IO), - io.write_string(") ", !IO), - write_rval(DataRep, RvalA, !IO) - ; - sorry($module, $pred, "box or unbox unop") - ) - ; - Rval = ml_binop(BinOp, RvalA, RvalB), - c_util.binop_category_string(BinOp, Category, BinOpStr), - ( Category = int_or_bool_binary_infix_binop -> - io.write_string("(", !IO), - write_rval(DataRep, RvalA, !IO), - io.write_string(") ", !IO), - io.write_string(BinOpStr, !IO), - io.write_string(" (", !IO), - write_rval(DataRep, RvalB, !IO), - io.write_string(")", !IO) - ; - sorry($module, $pred, "binop rval") - ) - ; - Rval = ml_scalar_common(_), - sorry($module, $pred, "scalar_common rval") - ; - Rval = ml_vector_common_row(_, _), - sorry($module, $pred, "vector_common_row rval") - ; - Rval = ml_mem_addr(_), - sorry($module, $pred, "mem_addr rval") - ; - Rval = ml_self(_), - sorry($module, $pred, "self rval") - ). - -:- pred write_rval_const(mlds_rval_const::in, io::di, io::uo) is det. - -write_rval_const(mlconst_true, !IO) :- - io.write_string("1", !IO). -write_rval_const(mlconst_false, !IO) :- - io.write_string("0", !IO). -write_rval_const(Const, !IO) :- - ( Const = mlconst_int(I) - ; Const = mlconst_enum(I, _) - ; Const = mlconst_char(I) - ), - io.write_int(I, !IO). -write_rval_const(mlconst_foreign(_Lang, _Value, _Type), !IO) :- - sorry($module, $pred, "mlconst_foreign for managed languages"). -write_rval_const(mlconst_float(F), !IO) :- - io.write_float(F, !IO). - % XXX We don't quote this correctly. -write_rval_const(mlconst_string(S), !IO) :- - io.write_string("""", !IO), - c_util.output_quoted_string(S, !IO), - io.write_string("""", !IO). -write_rval_const(mlconst_multi_string(S), !IO) :- - io.write_string("""", !IO), - c_util.output_quoted_multi_string(S, !IO), - io.write_string("""", !IO). -write_rval_const(mlconst_named_const(NamedConst), !IO) :- - io.write_string(NamedConst, !IO). -write_rval_const(mlconst_code_addr(CodeAddrConst), !IO) :- - ( - CodeAddrConst = code_addr_proc(ProcLabel, _FuncSignature), - mangle_mlds_proc_label(ProcLabel, no, ClassName, MangledName), - write_class_name(ClassName, !IO), - io.write_string(".", !IO), - io.write_string(MangledName, !IO) - ; - CodeAddrConst = code_addr_internal(ProcLabel, SeqNum, _FuncSignature), - mangle_mlds_proc_label(ProcLabel, yes(SeqNum), ClassName, MangledName), - write_class_name(ClassName, !IO), - io.write_string(".", !IO), - io.write_string(MangledName, !IO) - ). -write_rval_const(mlconst_data_addr(_), !IO) :- - sorry($module, $pred, "data_addr_const rval"). -write_rval_const(mlconst_null(_), !IO) :- - io.write_string("null", !IO). - -:- pred write_lval(il_data_rep::in, mlds_lval::in, io::di, io::uo) is det. - -write_lval(DataRep, Lval, !IO) :- - ( - Lval = ml_field(_, Rval, FieldId, _, _), - ( - FieldId = ml_field_offset(OffSet), - io.write_string("(", !IO), - write_rval(DataRep, Rval, !IO), - io.write_string(")", !IO), - io.write_string("[", !IO), - write_rval(DataRep, OffSet, !IO), - io.write_string("]", !IO) - ; - FieldId = ml_field_named(FQFieldName, _Type), - io.write_string("(", !IO), - write_rval(DataRep, Rval, !IO), - io.write_string(")", !IO), - io.write_string(".", !IO), - FQFieldName = qual(_, _, FieldName), - io.write_string(FieldName, !IO) - ) - ; - Lval = ml_mem_ref(Rval, _), - write_rval(DataRep, Rval, !IO) - ; - Lval = ml_global_var_ref(_), - sorry($module, $pred, "global_var_ref NYI") - ; - Lval = ml_var(Var, _VarType), - Var = qual(_, _, VarName), - write_mlds_var_name_for_parameter(VarName, !IO) - ). - -:- pred write_defn_decl(il_data_rep::in, mlds_defn::in, io::di, io::uo) is det. - -write_defn_decl(DataRep, Defn, !IO) :- - Defn = mlds_defn(Name, _Context, _Flags, DefnBody), - ( - DefnBody = mlds_data(Type, _Initializer, _GCStatement), - Name = entity_data(mlds_data_var(VarName)) - -> - write_parameter_type(DataRep, Type, !IO), - io.write_string(" ", !IO), - write_mlds_var_name_for_parameter(VarName, !IO), - io.write_string(";\n", !IO) - ; - % XXX We should implement others. - sorry($module, $pred, "data_addr_const rval") - ). - -:- pred write_parameter_type(il_data_rep::in, mlds_type::in, io::di, io::uo) - is det. - -write_parameter_type(DataRep, Type, !IO) :- - ILType = mlds_type_to_ilds_type(DataRep, Type), - write_il_type_as_foreign_type(ILType, !IO). - -:- pred write_input_arg_as_foreign_type(il_data_rep::in, mlds_argument::in, - io::di, io::uo) is det. - -write_input_arg_as_foreign_type(DataRep, Arg, !IO) :- - Arg = mlds_argument(EntityName, Type, _GCStatement), - write_il_type_as_foreign_type(mlds_type_to_ilds_type(DataRep, Type), !IO), - io.write_string(" ", !IO), - ( EntityName = entity_data(mlds_data_var(VarName)) -> - write_mlds_var_name_for_parameter(VarName, !IO) - ; - unexpected($module, $pred, "found a variable in a list") - ). - -:- pred write_parameter_initializer(il_data_rep::in, mlds_type::in, - io::di, io::uo) is det. - -write_parameter_initializer(DataRep, Type, !IO) :- - ILType = mlds_type_to_ilds_type(DataRep, Type), - ILType = il_type(_, ILSimpleType), - write_csharp_initializer(ILSimpleType, !IO). - -:- pred write_il_ret_type_as_foreign_type(ret_type::in, io::di, io::uo) is det. - -write_il_ret_type_as_foreign_type(void, !IO) :- - io.write_string("void", !IO). -write_il_ret_type_as_foreign_type(simple_type(T), !IO) :- - write_il_simple_type_as_foreign_type(T, !IO). - -:- pred write_il_type_as_foreign_type(il_type::in, io::di, io::uo) is det. - -write_il_type_as_foreign_type(il_type(Modifiers, SimpleType), !IO) :- - io.write_list(Modifiers, " ", - write_il_type_modifier_as_foreign_type, !IO), - write_il_simple_type_as_foreign_type(SimpleType, !IO). - -:- pred write_il_type_modifier_as_foreign_type(ilds.type_modifier::in, - io::di, io::uo) is det. - -write_il_type_modifier_as_foreign_type(const, !IO) :- - io.write_string("const", !IO). -write_il_type_modifier_as_foreign_type(readonly, !IO) :- - io.write_string("readonly", !IO). -write_il_type_modifier_as_foreign_type(volatile, !IO) :- - io.write_string("volatile", !IO). - - % XXX Need to revisit this and choose types appropriately. - % -:- pred write_il_simple_type_as_foreign_type(simple_type::in, - io::di, io::uo) is det. - -write_il_simple_type_as_foreign_type(int8, !IO) :- - io.write_string("sbyte", !IO). -write_il_simple_type_as_foreign_type(int16, !IO) :- - io.write_string("short", !IO). -write_il_simple_type_as_foreign_type(int32, !IO) :- - io.write_string("int", !IO). -write_il_simple_type_as_foreign_type(int64, !IO) :- - io.write_string("long", !IO). -write_il_simple_type_as_foreign_type(uint8, !IO) :- - io.write_string("byte", !IO). -write_il_simple_type_as_foreign_type(uint16, !IO) :- - io.write_string("ushort", !IO). -write_il_simple_type_as_foreign_type(uint32, !IO) :- - io.write_string("uint", !IO). -write_il_simple_type_as_foreign_type(uint64, !IO) :- - io.write_string("ulong", !IO). -write_il_simple_type_as_foreign_type(native_int, !IO) :- - io.write_string("int", !IO). -write_il_simple_type_as_foreign_type(native_uint, !IO) :- - io.write_string("uint", !IO). -write_il_simple_type_as_foreign_type(float32, !IO) :- - io.write_string("float", !IO). -write_il_simple_type_as_foreign_type(float64, !IO) :- - io.write_string("double", !IO). -write_il_simple_type_as_foreign_type(native_float, !IO) :- - io.write_string("float", !IO). -write_il_simple_type_as_foreign_type(bool, !IO) :- - io.write_string("bool", !IO). -write_il_simple_type_as_foreign_type(char, !IO) :- - io.write_string("char", !IO). -write_il_simple_type_as_foreign_type(string, !IO) :- - io.write_string("string", !IO). -write_il_simple_type_as_foreign_type(object, !IO) :- - io.write_string("object", !IO). -write_il_simple_type_as_foreign_type(refany, !IO) :- - io.write_string("mercury.MR_RefAny", !IO). -write_il_simple_type_as_foreign_type(class(ClassName), !IO) :- - write_class_name(ClassName, !IO). -write_il_simple_type_as_foreign_type(valuetype(ClassName), !IO) :- - write_class_name(ClassName, !IO). -write_il_simple_type_as_foreign_type(interface(_ClassName), !IO) :- - sorry($module, $pred, "interfaces"). -write_il_simple_type_as_foreign_type('[]'(Type, Bounds), !IO) :- - write_il_type_as_foreign_type(Type, !IO), - io.write_string("[]", !IO), - ( - Bounds = [] - ; - Bounds = [_ | _], - sorry($module, $pred, "arrays with bounds") - ). -write_il_simple_type_as_foreign_type('&'(Type), !IO) :- - % XXX Is this always right? - io.write_string("ref ", !IO), - write_il_type_as_foreign_type(Type, !IO). -write_il_simple_type_as_foreign_type('*'(Type), !IO) :- - write_il_type_as_foreign_type(Type, !IO), - io.write_string(" *", !IO). - -:- pred write_csharp_initializer(simple_type::in, io::di, io::uo) is det. - -write_csharp_initializer(int8, !IO) :- - io.write_string("0", !IO). -write_csharp_initializer(int16, !IO) :- - io.write_string("0", !IO). -write_csharp_initializer(int32, !IO) :- - io.write_string("0", !IO). -write_csharp_initializer(int64, !IO) :- - io.write_string("0", !IO). -write_csharp_initializer(uint8, !IO) :- - io.write_string("0", !IO). -write_csharp_initializer(uint16, !IO) :- - io.write_string("0", !IO). -write_csharp_initializer(uint32, !IO) :- - io.write_string("0", !IO). -write_csharp_initializer(uint64, !IO) :- - io.write_string("0", !IO). -write_csharp_initializer(native_int, !IO) :- - io.write_string("0", !IO). -write_csharp_initializer(native_uint, !IO) :- - io.write_string("0", !IO). -write_csharp_initializer(float32, !IO) :- - io.write_string("0.0", !IO). -write_csharp_initializer(float64, !IO) :- - io.write_string("0.0", !IO). -write_csharp_initializer(native_float, !IO) :- - io.write_string("0.0", !IO). -write_csharp_initializer(bool, !IO) :- - io.write_string("false", !IO). -write_csharp_initializer(char, !IO) :- - io.write_string("'\\0'", !IO). -write_csharp_initializer(string, !IO) :- - io.write_string("null", !IO). -write_csharp_initializer(object, !IO) :- - io.write_string("null", !IO). -write_csharp_initializer(refany, !IO) :- - io.write_string("null", !IO). -write_csharp_initializer(class(_ClassName), !IO) :- - io.write_string("null", !IO). -write_csharp_initializer(interface(_ClassName), !IO) :- - io.write_string("null", !IO). -write_csharp_initializer('[]'(_Type, _Bounds), !IO) :- - io.write_string("null", !IO). -write_csharp_initializer('&'(_Type), !IO) :- - io.write_string("null", !IO). -write_csharp_initializer('*'(_Type), !IO) :- - io.write_string("null", !IO). -write_csharp_initializer(valuetype(ClassName), !IO) :- - io.write_string("new ", !IO), - write_class_name(ClassName, !IO), - io.write_string("()", !IO). - -:- pred write_class_name(structured_name::in, io::di, io::uo) is det. - -write_class_name(structured_name(_Asm, DottedName, NestedClasses), !IO) :- - io.write_list(DottedName ++ NestedClasses, ".", io.write_string, !IO). - -:- pred write_mlds_var_name_for_local(mlds_var_name::in, - io::di, io::uo) is det. - -write_mlds_var_name_for_local(mlds_var_name(Name, _MaybeNum), !IO) :- - io.write_string(Name, !IO). - -:- pred write_mlds_var_name_for_parameter(mlds_var_name::in, - io::di, io::uo) is det. - -write_mlds_var_name_for_parameter(mlds_var_name(Name, MaybeNum), !IO) :- - io.write_string(Name, !IO), - ( - MaybeNum = yes(Num), - io.write_string("_", !IO), - io.write_int(Num, !IO) - ; - MaybeNum = no - ). - -%-----------------------------------------------------------------------------% -:- end_module ml_backend.mlds_to_managed. -%-----------------------------------------------------------------------------% diff --git a/compiler/notes/compiler_design.html b/compiler/notes/compiler_design.html index 6cd423b15..94da628ad 100644 --- a/compiler/notes/compiler_design.html +++ b/compiler/notes/compiler_design.html @@ -2038,26 +2038,6 @@ and one generates C#.

-The MLDS->IL backend is broken into several submodules. - -

    -
  • - mlds_to_ilasm.m converts MLDS to IL assembler and writes it to a .il file. -
  • - mlds_to_il.m converts MLDS to IL -
  • - ilds.m contains representations of IL -
  • - ilasm.m contains output routines for writing IL to assembler. -
  • - il_peephole.m performs peephole optimization on IL instructions. -
- -After IL assembler has been emitted, ILASM in invoked to turn the .il file -into a .dll or .exe. - -

- The MLDS->Java backend is broken into two submodules.

  • diff --git a/compiler/notes/work_in_progress.html b/compiler/notes/work_in_progress.html index 18cfe01bf..e6fd8c2ee 100644 --- a/compiler/notes/work_in_progress.html +++ b/compiler/notes/work_in_progress.html @@ -16,12 +16,6 @@ at some time in the future:

      -
    • There is a - `--target il' - option, which generates MSIL code for Microsoft's - .NET Common Language Runtime. - We're still working on this. -
    • Thread-safe engine (the `.par' grades).
    • Independent AND-parallelism (the `&' parallel conjunction operator). diff --git a/compiler/options.m b/compiler/options.m index 999e7f33b..56ff1bfc8 100644 --- a/compiler/options.m +++ b/compiler/options.m @@ -172,7 +172,6 @@ ; debug_opt_pred_id ; debug_opt_pred_name ; debug_pd % pd = partial deduction/deforestation - ; debug_il_asm % il_asm = IL generation via asm ; debug_liveness ; debug_stack_opt ; debug_make @@ -287,8 +286,6 @@ ; prop_mode_constraints ; benchmark_modes ; benchmark_modes_repeat - ; il_sign_assembly - ; separate_assemblies % Language semantics options ; reorder_conj @@ -309,8 +306,6 @@ % Target selection options ; target - ; il % target il - ; il_only % target il + target_code_only ; compile_to_c % target c + target_code_only ; java % target java ; java_only % target java + target_code_only @@ -450,17 +445,6 @@ ; put_commit_in_own_func ; put_nondet_env_on_heap - % IL back-end compilation model options - ; verifiable_code - ; il_refany_fields - ; il_funcptr_types - ; il_byref_tailcalls - % Currently this is not really a compilation model option, i.e. - % it doesn't affect the ABI. In future it might become one, though - % -- we should return multiple values in value types, rather than - % using byrefs. Also it's nicer to keep it with the other IL - % back-end options here. - % Options for internal use only (the values of these options are implied % by the settings of other options) @@ -862,14 +846,6 @@ ; java_classpath ; java_object_file_extension - % IL - ; il_assembler - ; ilasm_flags - ; quoted_ilasm_flag - ; dotnet_library_version - ; support_ms_clr - ; support_rotor_clr - % C# ; csharp_compiler ; csharp_flags @@ -1182,7 +1158,6 @@ option_defaults_2(verbosity_option, [ debug_opt_pred_id - accumulating([]), debug_opt_pred_name - accumulating([]), debug_pd - bool(no), - debug_il_asm - bool(no), debug_liveness - int(-1), debug_stack_opt - int(-1), debug_make - bool(no), @@ -1277,10 +1252,7 @@ option_defaults_2(aux_output_option, [ simple_mode_constraints - bool(no), prop_mode_constraints - bool(no), benchmark_modes - bool(no), - benchmark_modes_repeat - int(1), - il_sign_assembly - bool(no), - % XXX should default to no but currently broken - separate_assemblies - bool(yes) + benchmark_modes_repeat - int(1) ]). option_defaults_2(language_semantics_option, [ strict_sequential - special, @@ -1304,8 +1276,6 @@ option_defaults_2(compilation_model_option, [ % Target selection compilation model options target - string("c"), - il - special, - il_only - special, compile_to_c - special, csharp - special, csharp_only - special, @@ -1413,13 +1383,7 @@ option_defaults_2(compilation_model_option, [ det_copy_out - bool(no), nondet_copy_out - bool(no), put_commit_in_own_func - bool(no), - put_nondet_env_on_heap - bool(no), - - % IL back-end compilation model options - verifiable_code - bool(no), - il_funcptr_types - bool(no), - il_refany_fields - bool(no), - il_byref_tailcalls - bool(no) + put_nondet_env_on_heap - bool(no) ]). option_defaults_2(internal_use_option, [ % Options for internal use only @@ -1764,16 +1728,6 @@ option_defaults_2(target_code_compilation_option, [ java_classpath - accumulating([]), java_object_file_extension - string(".class"), - % IL - il_assembler - string("ilasm"), - ilasm_flags - accumulating([]), - quoted_ilasm_flag - string_special, - dotnet_library_version - string("1.0.3300.0"), - % We default to the version of the - % library that came with Beta2. - support_ms_clr - bool(yes), - support_rotor_clr - bool(no), - % C# csharp_compiler - string("csc"), csharp_flags - accumulating([]), @@ -2079,11 +2033,6 @@ long_option("debug-opt", debug_opt). long_option("debug-opt-pred-id", debug_opt_pred_id). long_option("debug-opt-pred-name", debug_opt_pred_name). long_option("debug-pd", debug_pd). - % debug-il-asm does very low-level printf style debugging of - % IL assembler. Each instruction is written on stdout before it - % is executed. It is a temporary measure until the IL debugging - % system built into .NET improves. -long_option("debug-il-asm", debug_il_asm). long_option("debug-liveness", debug_liveness). long_option("debug-stack-opt", debug_stack_opt). long_option("debug-make", debug_make). @@ -2198,8 +2147,6 @@ long_option("dump-mlds", dump_mlds). long_option("mlds-dump", dump_mlds). long_option("verbose-dump-mlds", verbose_dump_mlds). long_option("verbose-mlds-dump", verbose_dump_mlds). -long_option("il-sign-assembly", il_sign_assembly). -long_option("separate-assemblies", separate_assemblies). long_option("mode-constraints", mode_constraints). long_option("simple-mode-constraints", simple_mode_constraints). long_option("prop-mode-constraints", prop_mode_constraints). @@ -2226,9 +2173,6 @@ long_option("event-set-file-name", event_set_file_name). long_option("grade", grade). % target selection options long_option("target", target). -long_option("il", il). -long_option("il-only", il_only). -long_option("IL-only", il_only). long_option("compile-to-c", compile_to_c). long_option("compile-to-C", compile_to_c). long_option("java", java). @@ -2349,15 +2293,6 @@ long_option("det-copy-out", det_copy_out). long_option("nondet-copy-out", nondet_copy_out). long_option("put-commit-in-own-func", put_commit_in_own_func). long_option("put-nondet-env-on-heap", put_nondet_env_on_heap). -% IL back-end compilation model options -long_option("verifiable-code", verifiable_code). -long_option("verifiable", verifiable_code). -long_option("il-funcptr-types", il_funcptr_types). -long_option("IL-funcptr-types", il_funcptr_types). -long_option("il-refany-fields", il_refany_fields). -long_option("IL-refany-fields", il_refany_fields). -long_option("il-byref-tailcalls", il_byref_tailcalls). -long_option("IL-byref-tailcalls", il_byref_tailcalls). % internal use options long_option("backend-foreign-languages", backend_foreign_languages). @@ -2757,13 +2692,6 @@ long_option("java-debug", target_debug). long_option("java-classpath", java_classpath). long_option("java-object-file-extension", java_object_file_extension). -long_option("il-assembler", il_assembler). -long_option("ilasm-flags", ilasm_flags). -long_option("ilasm-flag", quoted_ilasm_flag). -long_option("dotnet-library-version", dotnet_library_version). -long_option("support-ms-clr", support_ms_clr). -long_option("support-rotor-clr", support_rotor_clr). - long_option("csharp-compiler", csharp_compiler). long_option("csharp-flags", csharp_flags). long_option("csharp-flag", quoted_csharp_flag). @@ -2979,11 +2907,6 @@ special_handler(grade, string(Grade), OptionTable0, Result) :- ; Result = error("invalid grade `" ++ Grade ++ "'") ). -special_handler(il, none, !.OptionTable, ok(!:OptionTable)) :- - map.set(target, string("il"), !OptionTable). -special_handler(il_only, none, !.OptionTable, ok(!:OptionTable)) :- - map.set(target, string("il"), !OptionTable), - map.set(target_code_only, bool(yes), !OptionTable). special_handler(compile_to_c, none, !.OptionTable, ok(!:OptionTable)) :- map.set(target, string("c"), !OptionTable), map.set(target_code_only, bool(yes), !OptionTable). @@ -3138,9 +3061,6 @@ special_handler(quoted_msvc_flag, string(Flag), special_handler(quoted_java_flag, string(Flag), OptionTable0, ok(OptionTable)) :- handle_quoted_flag(java_flags, Flag, OptionTable0, OptionTable). -special_handler(quoted_ilasm_flag, string(Flag), - OptionTable0, ok(OptionTable)) :- - handle_quoted_flag(ilasm_flags, Flag, OptionTable0, OptionTable). special_handler(quoted_csharp_flag, string(Flag), OptionTable0, ok(OptionTable)) :- handle_quoted_flag(csharp_flags, Flag, OptionTable0, OptionTable). @@ -4132,19 +4052,6 @@ options_help_aux_output --> % "--prop-mode-constraints", % "\tUse the new propagation solver for constraints based", % "\tmode analysis.", -% IL options are commented out to reduce confusion. -% "--il-sign-assembly", -% "\tSign the current assembly with the Mercury strong name.", -% "\tTo use assemblies created with this command all the Mercury", -% "\tmodules must be compiled with this option enabled.", -% "\tThis option is specific to the IL backend, and is likely", -% "\tto be deprecated at a later date." - - /* XXX currently broken. - "--separate-assemblies", - "\tPlace sub-modules in separate assemblies.", - "\tThis option is specific to the IL backend." - */ ]). :- pred options_help_semantics(io::di, io::uo) is det. @@ -4349,7 +4256,6 @@ options_help_compilation_model --> write_tabbed_lines([ %"--target c\t\t\t(grades: none, reg, jump, fast,", %"\t\t\t\t\tasm_jump, asm_fast, hl, hlc)", - %"--target il\t\t\t(grades: il)", "--target c\t\t\t(grades: none, reg, asm_fast, hlc)", "--target csharp\t\t\t(grades: csharp)", "--target java\t\t\t(grades: java)", @@ -4358,25 +4264,6 @@ options_help_compilation_model --> "\tThe default is C.", "\tTargets other than C imply `--high-level-code' (see below).", -% IL options are commented out to reduce confusion. -% "--il", -% "\tAn abbreviation for `--target il'.", -% "--il-only", -% "\tAn abbreviation for `--target il --target-code-only'.", -% "\tGenerate IL code in `.il', but do not generate", -% "\tobject code.", -% -% "--dotnet-library-version ", -% "\tThe version number for the mscorlib assembly distributed", -% "\twith the Microsoft .NET SDK.", -% -% "--no-support-ms-clr", -% "\tDon't use MS CLR specific workarounds in the generated code.", -% -% "--support-rotor-clr", -% "\tUse specific workarounds for the ROTOR CLR in the generated", -% "\tcode.", - "--csharp", "\tAn abbreviation for `--target csharp'.", "--csharp-only", @@ -4499,7 +4386,7 @@ options_help_compilation_model --> % "--no-profile-deep-coverage-branch-disj", % "\tDisable coverage points at the beginning of disjunction branches.", -% I beleive these options are broken - pbone. +% I believe these options are broken - pbone. % "Switches to tune the coverage profiling pass, useful for ", % "debugging.", % @@ -4537,7 +4424,7 @@ options_help_compilation_model --> write_tabbed_lines([ "--gc {none, boehm, hgc, accurate, automatic}", "--garbage-collection {none, boehm, hgc, accurate, automatic}", - "\t\t\t\t(`java', `csharp', `il' and `erlang'", + "\t\t\t\t(`java', `csharp', and `erlang'", "\t\t\t\t\tgrades use `--gc automatic',", "\t\t\t\t`.gc' grades use `--gc boehm',", "\t\t\t\t`.hgc' grades use `--gc hgc',", @@ -4671,7 +4558,7 @@ options_help_compilation_model --> % "\tprocedures using return-by-value rather than pass-by-reference.", % "\tThis option is ignored if the `--high-level-code' option is not enabled.", % The --nondet-copy-out option is not yet documented, -% because it is probably not very useful except for IL and Java, +% because it is probably not very useful except for Java, % where it is the default. % "--nondet-copy-out\t\t(grades: il, ilc)", % "\tSpecify whether to handle output arguments for nondet", @@ -4697,36 +4584,6 @@ options_help_compilation_model --> % ]), % io.write_string("\n IL back-end compilation model options:\n"), % write_tabbed_lines([ -% -% The --verifiable-code option is not yet documented because it is not yet fully -% implemented. -% "--verifiable, --verifiable-code\t\t\t", -% "\tEnsure that the generated IL code is verifiable.", -% -% The --il-refany-fields option is not documented because currently there -% are no IL implementations for which it is useful. -% "--il-refany-fields", -% "\tGenerate IL code that assumes that the CLI implementation", -% "\tsupports value types with fields of type `refany'.", -% "\tUsing this option could in theory allow more efficient", -% "\tverifiable IL code for nondeterministic Mercury procedures,", -% "\tif the CLI implementation supported it." -% "\tHowever, the current Microsoft CLR does not support it." -% -% The --il-byref-tailcalls option is not documented because currently there -% are no IL implementations for which it is useful. -% "--il-byref-tailcalls", -% "\tGenerate IL code that assumes that the CLI verifier", -% "\tsupports tail calls with byref arguments." -% -% The --il-funcptr-types option is not documented because it is not yet -% implemented. -% "--il-funcptr-types", -% "\tGenerate IL code that assumes that the IL assembler", -% "\tsupports function pointer types." -% "\tThe ECMA CLI specification allows function pointer types," -% "\tbut some CLR implementations, e.g. the old Beta 2 version of" -% "\tthe Microsoft CLR implementation, do not support them." ]), io.write_string("\n Developer compilation model options:\n"), @@ -4996,8 +4853,7 @@ options_help_code_generation --> % "\tThis makes the generated code less readable, but potentially", % "\tslightly more efficient.", % "\tThis option has no effect unless the `--high-level-code' option", -% "\tis enabled. It also has no effect if the `--target' option is", -% "\tset to `il'.", +% "\tis enabled.", % This optimization is for implementors only. Turning this option on provides % the fairest possible test of --optimize-saved-vars-cell. % "--no-opt-no-return-calls", @@ -5605,14 +5461,6 @@ options_help_target_code_compilation --> "\tSpecify an extension for Java object (bytecode) files", "\tBy default this is `.class'.", -% IL options are commented out to reduce confusion. -% "--il-assembler ", -% "\tSpecify the name of the .NET IL Assembler command.", -% "--ilasm-flags , --ilasm-flag ", -% "\tSpecify options to be passed to the IL assembler.", -% "\t`--ilasm-flag' should be used for single words which need", -% "\tto be quoted when passed to the shell.", - "--csharp-compiler ", "\tSpecify the name of the C# Compiler. The default is `csc'.", "--csharp-flags , --csharp-flag