diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..f0366ca
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,64 @@
+#OS junk files
+[Tt]humbs.db
+*.DS_Store
+
+#Visual Studio files
+*.[Oo]bj
+*.user
+*.aps
+*.pch
+*.vspscc
+*.vssscc
+*_i.c
+*_p.c
+*.ncb
+*.suo
+*.tlb
+*.tlh
+*.bak
+*.[Cc]ache
+*.ilk
+*.log
+*.lib
+*.sbr
+*.sdf
+*.opensdf
+*.unsuccessfulbuild
+ipch/
+obj/
+[Bb]in
+[Dd]ebug*/
+[Rr]elease*/
+Ankh.NoLoad
+
+#MonoDevelop
+*.pidb
+*.userprefs
+
+#Tooling
+_ReSharper*/
+*.resharper
+[Tt]est[Rr]esult*
+*.sass-cache
+
+#Project files
+[Bb]uild/
+
+#Subversion files
+.svn
+
+# Office Temp Files
+~$*
+
+#NuGet
+packages/
+
+#ncrunch
+*ncrunch*
+*crunch*.local.xml
+
+# visual studio database projects
+*.dbmdl
+
+#Test files
+*.testsettings
\ No newline at end of file
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..a42a2b0
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,56 @@
+Apache License
+Version 2.0, January 2004
+http://www.apache.org/licenses/
+
+TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
+
+1. Definitions.
+
+"License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document.
+
+"Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License.
+
+"Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity.
+
+"You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License.
+
+"Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files.
+
+"Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types.
+
+"Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below).
+
+"Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof.
+
+"Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution."
+
+"Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work.
+
+2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form.
+
+3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed.
+
+4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions:
+
+ 1. You must give any other recipients of the Work or Derivative Works a copy of this License; and
+
+ 2. You must cause any modified files to carry prominent notices stating that You changed the files; and
+
+ 3. You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and
+
+ 4. If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License.
+
+You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License.
+
+5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions.
+
+6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file.
+
+7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License.
+
+8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages.
+
+9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability.
+
+See FAQ for answers to frequently asked questions about this license.
+
diff --git a/README-original.md b/README-original.md
new file mode 100644
index 0000000..702bae9
--- /dev/null
+++ b/README-original.md
@@ -0,0 +1,11 @@
+F# 3.0 Compiler + Library Source Code Drop, matching Visual Studio 2012 (R) RTM binary release
+===
+
+
+The original README can be found at http://fsharppowerpack.codeplex.com/SourceControl/changeset/view/70537#1229467
+
+It has been removed to avoid confusion because the build instructions were Windows-specific.
+
+**License:** subject to terms and conditions of the Apache License, Version 2.0. A copy of the license can be found in the License.html file at the root of this distribution. By using this source code in any fashion, you are agreeing to be bound by the terms of the Apache License, Version 2.0. You must not remove this notice, or any other, from this software.
+
+**Questions?** If you have questions about the source code, please ask at the [F# Open Source Google Group](http://groups.google.com/group/fsharp-opensource). Please do not ask the Visual F# team at Microsoft for help with this source code: they like to be friendly, but they are very busy working on improving F# and need to focus on that.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..8a40b2b
--- /dev/null
+++ b/README.md
@@ -0,0 +1,205 @@
+This is the F# compiler, core library and core tools (open source edition). It uses the Apache 2.0 license.
+
+The `master` branch is for the latest version of F# (currently F# 3.0).
+
+To bootstrap the compiler, binaries built from an earlier version of this project are used.
+
+## Requirements
+
+Requires mono 2.9 or higher. Prefer Mono 3.0.
+
+On OSX, requires automake 2.69. To install from [homebrew](http://mxcl.github.com/homebrew):
+```
+brew install automake
+```
+
+
+## Building
+
+### On Linux and other Unix systems:
+The usual:
+```
+./autogen.sh
+make
+sudo make install
+```
+By default that makes optimized binaries. To make debug, use ```make CONFIG=debug```
+
+
+### On MacOS (OSX)
+
+Use a prefix to your version of Mono:
+```
+./autogen.sh --prefix=/Library/Frameworks/Mono.framework/Versions/Current/
+make
+sudo make install
+```
+By default that makes optimized binaries. To make debug, use ```make CONFIG=debug```
+
+### On Windows, using msbuild (e.g.. if .NET is installed)
+If you have only VS2012 installed, and not VS2010, you'll need to install the F# 2.0 Runtime (http://www.microsoft.com/en-us/download/details.aspx?id=13450)
+```
+cd src
+msbuild fsharp-proto-build.proj
+ngen install ..\lib\proto\4.0\fsc-proto.exe (optional)
+msbuild fsharp-library-build.proj /p:Configuration=Release
+msbuild fsharp-compiler-build.proj /p:Configuration=Release
+```
+You can also build the FSharp.Core for .NET 2.0, Mono 2.1, MonoTouch, Silverlight 5.0, Windows Phone 7.1, Portable Profile47 (net45+sl5+win8), Portable Profile88 (net4+sl4+wp71+win8) and XNA 4.0 for Xbox 360 profiles:
+```
+msbuild fsharp-library-build.proj /p:TargetFramework=net20 /p:Configuration=Release
+msbuild fsharp-library-build.proj /p:TargetFramework=mono21 /p:Configuration=Release
+msbuild fsharp-library-build.proj /p:TargetFramework=monotouch /p:Configuration=Release
+msbuild fsharp-library-build.proj /p:TargetFramework=portable-net45+sl5+win8 /p:Configuration=Release
+msbuild fsharp-library-build.proj /p:TargetFramework=portable-net4+sl4+wp71+win8 /p:Configuration=Release
+msbuild fsharp-library-build.proj /p:TargetFramework=sl5 /p:Configuration=Release
+msbuild fsharp-library-build.proj /p:TargetFramework=wp7 /p:Configuration=Release
+msbuild fsharp-library-build.proj /p:TargetFramework=net40-xna40-xbox360 /p:Configuration=Release
+```
+You can also build the FSharp.Core and FSharp.Compiler.Silverlight.dll for Silverlight 5.0:
+```
+msbuild fsharp-library-build.proj /p:TargetFramework=sl5-compiler /p:Configuration=Release
+msbuild fsharp-compiler-build.proj /p:TargetFramework=sl5-compiler /p:Configuration=Release
+```
+Change to ``` /p:Configuration=Debug``` for debug binaries.
+
+### On Windows, using xbuild (e.g. if no .NET is installed and only Mono 3.0 is installed):
+
+```
+cd src
+xbuild fsharp-proto-build.proj
+xbuild fsharp-library-build.proj
+xbuild fsharp-compiler-build.proj
+```
+
+Building using xbuild does not yet lay down a Mono-ready distribution (see src/fsharp/targets.make), so should only
+be used for private development rather than preparing distributions.
+
+
+## Strong Names
+
+The FSharp.Core.dll produced is only delay-signed (Mono does not require strong names).
+If a strong-name signed FSharp.Core.dll is needed then use the one in
+```
+ lib\bootstrap\signed\3.0\v4.0\FSharp.Core.dll
+```
+
+
+## What you get
+
+Once built the main compiler binaries go in
+ lib/release/4.0
+
+There are versions of FSharp.Core for .NET 2.0, MonoAndroid, MonoTouch (Mono profile 2.1) in
+ lib/release/2.0
+ lib/release/2.1
+ lib/release/2.1monotouch
+
+On 'make install' the binaries etc. go in the prefix, e.g.
+
+ /Library/Frameworks/Mono.framework/Versions/Current/lib/mono/2.0/FSharp.Core.dll
+ /Library/Frameworks/Mono.framework/Versions/Current/lib/mono/2.1/FSharp.Core.dll
+ /Library/Frameworks/Mono.framework/Versions/Current/lib/mono/4.0/fsc.exe
+ /Library/Frameworks/Mono.framework/Versions/Current/lib/mono/4.0/FSharp.Compiler.dll
+ ...
+ /Library/Frameworks/Mono.framework/Versions/Current/lib/mono/4.5/fsc.exe
+ /Library/Frameworks/Mono.framework/Versions/Current/lib/mono/4.5/FSharp.Compiler.dll
+ ...
+ /Library/Frameworks/Mono.framework/Versions/Current/lib/mono/gac/.../FSharp.Compiler.dll
+ /Library/Frameworks/Mono.framework/Versions/Current/lib/mono/gac/.../FSharp.Compiler.dll
+ ...
+
+plus some files for xbuild support
+
+ /Library/Frameworks/Mono.framework/Versions/Current/lib/mono/Microsoft\ F#/v4.0/*
+ /Library/Frameworks/Mono.framework/Versions/Current/lib/mono/Microsoft\ SDKs/F#/3.0/Framework/*
+
+(these names are the canonical names for Microsoft.FSharp.Targets used by project files coming from Visual Studio)
+
+plus scripts
+
+ /usr/bin/fsharpc (F# compiler)
+ /usr/bin/fsharpi (F# Interactive)
+
+## Development notes
+
+###Continuous Integration Build
+
+We have a CI build set up with the JetBrains/Teamcity server as part of the F# community projects there:
+
+http://teamcity.codebetter.com/project.html?projectId=project61&tab=projectOverview
+
+@forki controls access. Right now this builds both a Mono 'make' install and a Windows 'cd src; msbuild fsharp-build.proj' build. No binaries are saved from the build, it is just for sanity checking.
+
+
+###Editing the Compiler with Visual Studio or MonoDevelop
+
+Open `all-vs2012.sln`, and edit in modes Debug or Release. The compiler takes a good while to compile and that
+can be a bit invasive to the work flow, so it's normally better to do the actual compilation from
+the command line, see above.
+
+The F# support in MonoDevelop uses an in-process background compiler. On the Mac this causes pausing garbage
+collections to kick in which makes editing the compiler in MonoDevelop awkward.
+
+### Building F# Core Unit Tests for .NET 4.x (optional)
+
+This uses the proto compiler to build the unit tests that check some parts of `FSharp.Core.dll` and `FSharp.Compiler.dll`. There is also another set of tests under `tests\fsharp`.
+
+```
+msbuild fsharp-library-unittests-build.proj /p:TargetFramework=net40
+```
+
+*Note: You must have NUnit installed to build the unit tests.*
+
+
+
+### Validation and Use
+
+Here are some simple tests to validate what you have built by checking `fsi.exe` (F# Interactive) starts up:
+
+```
+lib\debug\4.0\fsi.exe
+1 + 1;;
+\#q;;
+lib\debug\4.0\fsi.exe /help
+lib\debug\4.0\fsc.exe /help
+echo printfn "hello world" > hello.fs
+lib\debug\4.0\fsc.exe hello.fs
+hello.exe
+```
+
+### Running Compiler tests (on Windows)
+
+There are language tests under `tests\fsharp\core`. The test apparatus is primitive and unfortunately uses batch files. You can run these on Windows using:
+
+```
+cd ..\tests\fsharp\core
+..\..\build-and-run-all-installed-ilx-configs.bat results.log
+```
+
+The results file will contain one entry for each test directory, plus any reported errors.
+
+```
+tests\fsharp\core
+tests\fsharp\core\queriesCustomQueryOps
+tests\fsharp\core\queriesLeafExpressionConvert
+tests\fsharp\core\queriesNullableOperators
+tests\fsharp\core\queriesOverIEnumerable
+...
+```
+
+Some tests for LINQ queries require SQL Server be installed. A failing test will look like this:
+
+```
+ERRORLEVEL=1: in tests\fsharp\core\csfromfs\build.bat
+```
+
+You can then go to the relevant directory and run `build.bat` and `run.bat`.
+
+
+## History
+
+F# compiler sources dropped by Microsoft are available from [fsharppowerpack.codeplex.com](http://fsharppowerpack.codeplex.com).
+
+Uses bootstrapping libraries, tools and F# compiler. The `lib/bootstrap/X.0` directories contain mono-built libraries, compiler and tools that can be used to bootstrap a build. You can also supply your own via the `--with-bootstrap` option.
+
diff --git a/samples/crlish/TestApp/App.config b/samples/crlish/TestApp/App.config
new file mode 100644
index 0000000..8e15646
--- /dev/null
+++ b/samples/crlish/TestApp/App.config
@@ -0,0 +1,6 @@
+
+
+
+
+
+
\ No newline at end of file
diff --git a/samples/crlish/TestApp/Program.cs b/samples/crlish/TestApp/Program.cs
new file mode 100644
index 0000000..6517c3b
--- /dev/null
+++ b/samples/crlish/TestApp/Program.cs
@@ -0,0 +1,17 @@
+using System;
+using System.Collections.Generic;
+using System.Linq;
+using System.Text;
+using System.Threading.Tasks;
+
+namespace TestApp
+{
+ class Program
+ {
+ static void Main(string[] args)
+ {
+ int i = 1 + 1;
+ Console.WriteLine(i);
+ }
+ }
+}
diff --git a/samples/crlish/TestApp/Properties/AssemblyInfo.cs b/samples/crlish/TestApp/Properties/AssemblyInfo.cs
new file mode 100644
index 0000000..bc9722e
--- /dev/null
+++ b/samples/crlish/TestApp/Properties/AssemblyInfo.cs
@@ -0,0 +1,36 @@
+using System.Reflection;
+using System.Runtime.CompilerServices;
+using System.Runtime.InteropServices;
+
+// General Information about an assembly is controlled through the following
+// set of attributes. Change these attribute values to modify the information
+// associated with an assembly.
+[assembly: AssemblyTitle("TestApp")]
+[assembly: AssemblyDescription("")]
+[assembly: AssemblyConfiguration("")]
+[assembly: AssemblyCompany("")]
+[assembly: AssemblyProduct("TestApp")]
+[assembly: AssemblyCopyright("Copyright © 2013")]
+[assembly: AssemblyTrademark("")]
+[assembly: AssemblyCulture("")]
+
+// Setting ComVisible to false makes the types in this assembly not visible
+// to COM components. If you need to access a type in this assembly from
+// COM, set the ComVisible attribute to true on that type.
+[assembly: ComVisible(false)]
+
+// The following GUID is for the ID of the typelib if this project is exposed to COM
+[assembly: Guid("9958c0ed-5145-4c38-87ac-97c8a0f2aee6")]
+
+// Version information for an assembly consists of the following four values:
+//
+// Major Version
+// Minor Version
+// Build Number
+// Revision
+//
+// You can specify all the values or you can default the Build and Revision Numbers
+// by using the '*' as shown below:
+// [assembly: AssemblyVersion("1.0.*")]
+[assembly: AssemblyVersion("1.0.0.0")]
+[assembly: AssemblyFileVersion("1.0.0.0")]
diff --git a/samples/crlish/TestApp/TestApp.csproj b/samples/crlish/TestApp/TestApp.csproj
new file mode 100644
index 0000000..ea43450
--- /dev/null
+++ b/samples/crlish/TestApp/TestApp.csproj
@@ -0,0 +1,58 @@
+
+
+
+
+ Debug
+ AnyCPU
+ {E3F21F5E-94A5-485D-9FC0-571D27E87EE8}
+ Exe
+ Properties
+ TestApp
+ TestApp
+ v4.5
+ 512
+
+
+ AnyCPU
+ true
+ full
+ false
+ bin\Debug\
+ DEBUG;TRACE
+ prompt
+ 4
+
+
+ AnyCPU
+ pdbonly
+ true
+ bin\Release\
+ TRACE
+ prompt
+ 4
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
\ No newline at end of file
diff --git a/samples/crlish/clrish/App.config b/samples/crlish/clrish/App.config
new file mode 100644
index 0000000..c9bdc98
--- /dev/null
+++ b/samples/crlish/clrish/App.config
@@ -0,0 +1,17 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
\ No newline at end of file
diff --git a/samples/crlish/clrish/ExecutionEngine.fs b/samples/crlish/clrish/ExecutionEngine.fs
new file mode 100644
index 0000000..8f5c420
--- /dev/null
+++ b/samples/crlish/clrish/ExecutionEngine.fs
@@ -0,0 +1,334 @@
+module ExecutionEngine
+open System
+open System.Collections.Generic
+open Microsoft.FSharp.Compiler.AbstractIL.ILBinaryReader
+open Microsoft.FSharp.Compiler.AbstractIL.IL
+
+type InstructionResult =
+ | NoResult
+ | Return of obj
+ | Branch of ILCodeLabel
+ | ExceptionThrown of Exception
+
+
+let rec exeMethod (currentModule: ILModuleReader) (parameters: obj[]) (typeDef: ILTypeDef) (methodDef: ILMethodDef) =
+ let stack = new Stack()
+ let locals = Array.zeroCreate methodDef.Locals.Length
+
+ let exeTargetMethod (ilMethodSpec: ILMethodSpec) objPtr =
+ let innerExe ilTypeSpec =
+ let targetType, targetModule = TypeManagement.getType currentModule ilTypeSpec
+ let possibleMethods = targetType.Methods.FindByName(ilMethodSpec.Name)
+ let targetMethod = possibleMethods |> Seq.tryFind (fun x -> x.CallingSignature.ArgTypes = ilMethodSpec.FormalArgTypes)
+ match targetMethod with
+ | Some targetMethod ->
+ let parameters =
+ match objPtr with
+ | Some x ->
+ let parameters = Array.zeroCreate (stack.Count + 1)
+ stack.CopyTo(parameters, 0)
+ parameters.[stack.Count] <-x
+ parameters |> Array.rev
+ | None -> stack.ToArray()
+ MemoryManagement.pushThreadParameters parameters targetMethod
+ let result = exeMethod targetModule parameters targetType targetMethod
+ stack.Clear()
+ MemoryManagement.popThreadParameters ()
+ let result' =
+ match result with
+ | Return result ->
+ stack.Push result
+ NoResult
+ | _ -> result
+ result'
+ | None -> failwith "failed to find method %A" ilMethodSpec
+ match ilMethodSpec.EnclosingType with
+ | ILType.Void -> failwith "Unsupported type"
+ | ILType.Array (ilArrayShape, ilType) -> failwith "Unsupported type"
+ | ILType.Value (ilTypeSpec) -> innerExe ilTypeSpec
+ | ILType.Boxed (ilTypeSpec) -> innerExe ilTypeSpec
+ | ILType.Ptr (ilType) -> failwith "Unsupported type"
+ | ILType.Byref (ilType) -> failwith "Unsupported type"
+ | ILType.FunctionPointer (ilCallingSignature) -> failwith "Unsupported type"
+ | ILType.TypeVar i -> failwith "Unsupported type"
+ | ILType.Modified (required, ilTypeRef, ilType) -> failwith "Unsupported type"
+
+ let execILBlock ilBasicBlock =
+ match ilBasicBlock with
+ // Basic
+ | AI_add ->
+ let v1 = stack.Pop()
+ let v2 = stack.Pop()
+ match v1, v2 with
+ | (:? int as v1), (:? int as v2) -> stack.Push(v1 + v2)
+ | _ -> failwith "adding supported combination of types"
+ NoResult
+ | AI_add_ovf -> failwith "Instruction AI_add_ovf unsupported"
+ | AI_add_ovf_un -> failwith "Instruction AI_add_ovf_un unsupported"
+ | AI_and -> failwith "Instruction AI_and unsupported"
+ | AI_div -> failwith "Instruction AI_div unsupported"
+ | AI_div_un -> failwith "Instruction AI_div_un unsupported"
+ | AI_ceq -> failwith "Instruction AI_ceq unsupported"
+ | AI_cgt -> failwith "Instruction AI_cgt unsupported"
+ | AI_cgt_un -> failwith "Instruction AI_cgt_un unsupported"
+ | AI_clt -> failwith "Instruction AI_clt unsupported"
+ | AI_clt_un -> failwith "Instruction AI_clt_un unsupported"
+ | AI_conv (ilBasicType) -> failwith "Instruction AI_conv unsupported"
+ | AI_conv_ovf (ilBasicType) -> failwith "Instruction AI_conv_ovf unsupported"
+ | AI_conv_ovf_un (ilBasicType) -> failwith "Instruction AI_conv_ovf_un unsupported"
+ | AI_mul -> failwith "Instruction AI_mul unsupported"
+ | AI_mul_ovf -> failwith "Instruction AI_mul_ovf unsupported"
+ | AI_mul_ovf_un -> failwith "Instruction AI_mul_ovf_un unsupported"
+ | AI_rem -> failwith "Instruction AI_rem unsupported"
+ | AI_rem_un -> failwith "Instruction AI_rem_un unsupported"
+ | AI_shl -> failwith "Instruction AI_shl unsupported"
+ | AI_shr -> failwith "Instruction AI_shr unsupported"
+ | AI_shr_un -> failwith "Instruction AI_shr unsupported"
+ | AI_sub -> failwith "Instruction AI_sub unsupported"
+ | AI_sub_ovf -> failwith "Instruction AI_sub_ovf unsupported"
+ | AI_sub_ovf_un -> failwith "Instruction AI_sub_ovf_un unsupported"
+ | AI_xor -> failwith "Instruction AI_xor unsupported"
+ | AI_or -> failwith "Instruction AI_xor unsupported"
+ | AI_neg -> failwith "Instruction AI_neg unsupported"
+ | AI_not -> failwith "Instruction AI_not unsupported"
+ | AI_ldnull ->
+ stack.Push null
+ NoResult
+ | AI_dup -> failwith "Instruction AI_dup unsupported"
+ | AI_pop ->
+ stack.Pop() |> ignore
+ NoResult
+ | AI_ckfinite -> failwith "Instruction AI_ckfinite unsupported"
+ | AI_nop -> NoResult
+ | AI_ldc (ilBasicType, ilConst) ->
+ match ilConst with
+ | ILConst.I4 x -> stack.Push x
+ | ILConst.I8 x -> stack.Push x
+ | ILConst.R4 x -> stack.Push x
+ | ILConst.R8 x -> stack.Push x
+ NoResult
+
+ | I_ldarg (i) ->
+ stack.Push(parameters.[int i])
+ NoResult
+ | I_ldarga (i) ->
+ stack.Push (MemoryManagement.getParameterAddress (int i))
+ NoResult
+ | I_ldind (ilAlignment, ilVolatility, ilBasicType) -> failwith "Instruction I_ldind unsupported"
+ | I_ldloc (i) ->
+ stack.Push(locals.[int i])
+ NoResult
+
+ | I_ldloca (i) -> failwith "Instruction I_ldloca unsupported"
+ | I_starg (i) -> failwith "Instruction I_starg unsupported"
+ | I_stind (ilAlignment, ilVolatility, ilBasicType) -> failwith "Instruction I_stind unsupported"
+ | I_stloc (i) ->
+ locals.[int i] <- stack.Pop()
+ NoResult
+
+ // Control transfer
+ | I_br (ilCodeLabel) ->
+ Branch ilCodeLabel
+ | I_jmp (ilMethodSpec) -> failwith "Instruction I_jmp unsupported"
+ | I_brcmp (ilComparisonInstr, ilCodeLabel1, ilCodeLabel2) ->
+ let firstBranch =
+ match ilComparisonInstr with
+ | BI_brfalse | BI_brtrue ->
+ let v1 = stack.Pop()
+ match ilComparisonInstr with
+ | BI_brfalse ->
+ match v1 with
+ | null -> true
+ | :? bool as v1 when v1 = false -> true
+ | :? int as v1 when v1 = 0 -> true
+ | :? int16 as v1 when v1 = 0s -> true
+ | :? int64 as v1 when v1 = 0L -> true
+ | _ -> false
+ | BI_brtrue ->
+ match v1 with
+ | null -> false
+ | :? bool as v1 when v1 = true -> true
+ | :? int as v1 when v1 <> 0 -> true
+ | :? int16 as v1 when v1 <> 0s -> true
+ | :? int64 as v1 when v1 <> 0L -> true
+ | _ -> false
+ | _ -> failwith "can't happen"
+ | _ ->
+ let v1 = stack.Pop()
+ let v2 = stack.Pop()
+ match ilComparisonInstr with
+ | BI_beq -> unbox v1 = unbox v2
+ | BI_bge -> unbox v1 >= unbox v2
+ | BI_bge_un -> unbox v1 >= unbox v2
+ | BI_bgt -> unbox v1 > unbox v2
+ | BI_bgt_un -> unbox v1 > unbox v2
+ | BI_ble -> unbox v1 <= unbox v2
+ | BI_ble_un -> unbox v1 <= unbox v2
+ | BI_blt -> unbox v1 < unbox v2
+ | BI_blt_un -> unbox v1 < unbox v2
+ | BI_bne_un -> unbox v1 <> unbox v2
+ | _ -> failwith "can't happen"
+ if firstBranch then Branch ilCodeLabel1 else Branch ilCodeLabel2
+ | I_switch (ilCodeLabels,ilCodeLabel) -> failwith "Instruction I_switch unsupported" (* last label is fallthrough *)
+ | I_ret ->
+ match stack.Count, methodDef.CallingSignature.ReturnType with
+ | 0, ILType.Void -> Return null
+ | 1, _ -> Return (stack.Pop())
+ | _ -> failwith "Error unblanced stack at return instruction"
+
+ // Method call
+ | I_call (ilTailcall, ilMethodSpec, ilVarArgs) ->
+ exeTargetMethod ilMethodSpec None
+ | I_callvirt (ilTailcall, ilMethodSpec, ilVarArgs) -> failwith "Instruction I_callvirt unsupported"
+ | I_callconstraint (ilTailcall, ilType, ilMethodSpec, ilVarArgs) -> failwith "Instruction I_callconstraint unsupported"
+ | I_calli (ilTailcall, ilCallingSignature, ilVarArgs) -> failwith "Instruction I_calli unsupported"
+ | I_ldftn ilMethodSpec -> failwith "Instruction I_ldftn unsupported"
+ | I_newobj (ilMethodSpec, ilVarArgs) ->
+ let t, _ = TypeManagement.getType currentModule ilMethodSpec.EnclosingType.TypeSpec
+ let newObjRef = MemoryManagement.getBlankObject t
+
+ let result = exeTargetMethod ilMethodSpec (Some (box newObjRef))
+ result
+
+ // Exceptions
+ | I_throw -> failwith "Instruction I_throw unsupported"
+ | I_endfinally -> failwith "Instruction I_endfinally unsupported"
+ | I_endfilter -> failwith "Instruction I_endfilter unsupported"
+ | I_leave ilCodeLabel -> failwith "Instruction I_leave unsupported"
+ | I_rethrow -> failwith "Instruction I_rethrow unsupported"
+
+ // Object instructions
+ | I_ldsfld (ilVolatility, ilFieldSpec) ->
+ let t, tModule = TypeManagement.getType currentModule ilFieldSpec.EnclosingType.TypeSpec
+ let fieldValue = MemoryManagement.getStaticField tModule t ilFieldSpec (exeMethod tModule [||] t)
+ stack.Push fieldValue
+ NoResult
+ | I_ldfld (ilAlignment, ilVolatility, ilFieldSpec) -> failwith "Instruction I_ldfld unsupported"
+ | I_ldsflda (ilFieldSpec) ->
+ let t, tModule = TypeManagement.getType currentModule ilFieldSpec.EnclosingType.TypeSpec
+ let fieldAddress = MemoryManagement.getStaticFieldAddress tModule t ilFieldSpec (exeMethod tModule [||] t)
+ stack.Push fieldAddress
+ NoResult
+ | I_ldflda (ilFieldSpec) -> failwith "Instruction I_ldflda unsupported"
+ | I_stsfld (ilVolatility, ilFieldSpec) -> failwith "Instruction I_stsfld unsupported"
+ | I_stfld (ilAlignment, ilVolatility, ilFieldSpec) ->
+ let value = stack.Pop()
+ let objRef = stack.Pop() :?> int
+ MemoryManagement.storeValueInObjectField objRef value currentModule ilFieldSpec
+ NoResult
+ | I_ldstr (stringToLoad) -> failwith "Instruction I_ldstr unsupported"
+ | I_isinst (ilType) -> failwith "Instruction I_isinst unsupported"
+ | I_castclass (ilType) -> failwith "Instruction I_castclass unsupported"
+ | I_ldtoken (ilToken) -> failwith "Instruction I_ldtoken unsupported"
+ | I_ldvirtftn (ilMethodSpec) -> failwith "Instruction I_ldvirtftn unsupported"
+
+ // Value type instructions
+ | I_cpobj (ilType) -> failwith "Instruction I_cpobj unsupported"
+ | I_initobj (ilType) -> failwith "Instruction I_initobj unsupported"
+ | I_ldobj (ilAlignment, ilVolatility, ilType) -> failwith "Instruction I_ldobj unsupported"
+ | I_stobj (ilAlignment, ilVolatility, ilType) -> failwith "Instruction I_stobj unsupported"
+ | I_box (ilType) ->
+ let value = stack.Pop()
+ let addr = MemoryManagement.storeBoxedValue value
+ stack.Push addr
+ NoResult
+ | I_unbox (ilType) -> failwith "Instruction I_unbox unsupported"
+ | I_unbox_any (ilType) -> failwith "Instruction I_unbox_any unsupported"
+ | I_sizeof (ilType) -> failwith "Instruction I_sizeof unsupported"
+
+ // Generalized array instructions. In AbsIL these instructions include
+ // both the single-dimensional variants (with ILArrayShape == ILArrayShape.SingleDimensional)
+ // and calls to the "special" multi-dimensional "methods" such as
+ // newobj void string[,]::.ctor(int32, int32)
+ // call string string[,]::Get(int32, int32)
+ // call string& string[,]::Address(int32, int32)
+ // call void string[,]::Set(int32, int32,string)
+ // The IL reader transforms calls of this form to the corresponding
+ // generalized instruction with the corresponding ILArrayShape
+ // argument. This is done to simplify the IL and make it more uniform.
+ // The IL writer then reverses this when emitting the binary.
+ | I_ldelem (ilBasicType) -> failwith "Instruction I_ldelem unsupported"
+ | I_stelem (ilBasicType) -> failwith "Instruction I_stelem unsupported"
+ | I_ldelema (ilReadonly, whatDoesThisBoolMean, ilArrayShape, ilType) -> failwith "Instruction I_ldelema unsupported"(* ILArrayShape = ILArrayShape.SingleDimensional for single dimensional arrays *)
+ | I_ldelem_any (ilArrayShap, ilType) -> failwith "Instruction I_ldelem_any unsupported" (* ILArrayShape = ILArrayShape.SingleDimensional for single dimensional arrays *)
+ | I_stelem_any (ilArrayShape, ilType) -> failwith "Instruction I_stelem_any unsupported" (* ILArrayShape = ILArrayShape.SingleDimensional for single dimensional arrays *)
+ | I_newarr (ilArrayShape, ilType) -> failwith "Instruction I_newarr unsupported" (* ILArrayShape = ILArrayShape.SingleDimensional for single dimensional arrays *)
+ | I_ldlen -> failwith "Instruction I_ldlen unsupported"
+
+ // "System.TypedReference" related instructions: almost
+ // no languages produce these, though they do occur in mscorlib.dll
+ // System.TypedReference represents a pair of a type and a byref-pointer
+ // to a value of that type.
+ | I_mkrefany (ilType) ->
+ stack.Push ilType // seems wrong
+ NoResult
+ | I_refanytype -> failwith "Instruction I_refanytype unsupported"
+ | I_refanyval (ilType) -> failwith "Instruction I_refanyval unsupported"
+
+ // Debug-specific
+ // I_seqpoint is a fake instruction to represent a sequence point:
+ // the next instruction starts the execution of the
+ // statement covered by the given range - this is a
+ // dummy instruction and is not emitted
+ | I_break -> failwith "Instruction I_break unsupported"
+ | I_seqpoint ilSourceMarker -> failwith "Instruction I_seqpoint unsupported"
+
+ // Varargs - C++ only
+ | I_arglist -> failwith "Instruction I_arglist unsupported"
+
+ // Local aggregates, i.e. stack allocated data (alloca) : C++ only
+ | I_localloc -> failwith "Instruction I_localloc unsupported"
+ | I_cpblk (ilAlignment, ilVolatility) -> failwith "Instruction I_cpblk unsupported"
+ | I_initblk (ilAlignment, ilVolatility) -> failwith "Instruction I_initblk unsupported"
+
+ // EXTENSIONS, e.g. MS-ILX
+ | EI_ilzero (ilType) -> failwith "Instruction EI_ilzero unsupported"
+ | EI_ldlen_multi (x, y) -> failwith "Instruction EI_ldlen_multi unsupported"
+ | I_other (ilxExtensionInstr) -> failwith "Instruction I_other unsupported"
+ let rec matchLabel label code =
+ match code with
+ | ILBasicBlock ilBasicBlock -> ilBasicBlock.Label = label
+ | GroupBlock (ilDebugMappings, ilCodes) -> ilCodes |> List.exists (fun x -> matchLabel label x)
+ | RestrictBlock (ilCodeLabels, ilCode) -> matchLabel label ilCode || ilCodeLabels |> List.exists (fun x -> x = label)
+ | TryBlock (ilCode, ilExceptionBlock) -> matchLabel label ilCode
+ let rec execCodeBlock code =
+ match code with
+ | ILBasicBlock ilBasicBlock ->
+ let rec loop index =
+ let instr = ilBasicBlock.Instructions.[index]
+ let result = execILBlock instr
+ let nextIndex = index + 1
+ match result with
+ | Return _ -> result
+ | Branch _ -> result
+ | ExceptionThrown _ -> result
+ | NoResult ->
+ if ilBasicBlock.Instructions.Length = nextIndex then
+ result
+ else
+ loop nextIndex
+ loop 0
+ | GroupBlock (ilDebugMappings, ilCodes) ->
+ let firstBlock = List.head ilCodes
+ let result = execCodeBlock firstBlock
+ match result with
+ | Branch targetLabel ->
+ let targetBlock =
+ ilCodes |> List.find (fun code -> matchLabel targetLabel code)
+ execCodeBlock targetBlock
+ | _ -> result
+ | RestrictBlock (ilCodeLabels, ilCode) ->
+ execCodeBlock ilCode
+ | TryBlock (ilCode, ilExceptionBlock) ->
+ // TODO error handling :)
+ execCodeBlock ilCode
+ printfn "%s.%s %A" typeDef.Name methodDef.Name parameters
+ if methodDef.IsUnmanagedExport then
+ printfn "IsUnmanagedExport"
+ NoResult
+ elif methodDef.IsInternalCall then
+ let result = InternalCalls.execInternalCall methodDef parameters
+ stack.Push result
+ NoResult
+ else
+ execCodeBlock methodDef.MethodBody.Code
diff --git a/samples/crlish/clrish/InternalCalls.fs b/samples/crlish/clrish/InternalCalls.fs
new file mode 100644
index 0000000..d92aca9
--- /dev/null
+++ b/samples/crlish/clrish/InternalCalls.fs
@@ -0,0 +1,11 @@
+module InternalCalls
+open System
+open System.Threading
+open Microsoft.FSharp.Compiler.AbstractIL.ILBinaryReader
+open Microsoft.FSharp.Compiler.AbstractIL.IL
+
+let execInternalCall (meth: ILMethodDef) (parameters: obj[]) =
+ match meth.Name with
+ | "_CompareExchange" ->
+ Interlocked.CompareExchange(ref parameters.[0], parameters.[1], parameters.[2])
+ | _ -> failwith "internal call not supported"
diff --git a/samples/crlish/clrish/Loader.fs b/samples/crlish/clrish/Loader.fs
new file mode 100644
index 0000000..b9b542a
--- /dev/null
+++ b/samples/crlish/clrish/Loader.fs
@@ -0,0 +1,30 @@
+module Loader
+
+open System
+open System.Collections.Generic
+open System.IO
+open Microsoft.FSharp.Compiler.AbstractIL.ILBinaryReader
+open Microsoft.FSharp.Compiler.AbstractIL.IL
+
+let assemblyPath = Environment.ExpandEnvironmentVariables(@"%windir%\Microsoft.NET\Framework\v4.0.30319")
+
+let modules = new Dictionary()
+
+let loadModuleFromPath path =
+ let ``module`` = OpenILModuleReader path defaults
+ match ``module``.ILModuleDef.Manifest with
+ | Some manifest ->
+ modules.Add(manifest.Name, ``module``)
+ | None -> failwith "Module has no manifest, only full assemblies are support"
+ ``module``
+
+let getModule (assemblyRef: ILAssemblyRef) =
+ if modules.ContainsKey assemblyRef.Name then
+ modules.[assemblyRef.Name]
+ else
+ // sooner or later we'll need to search more places/file type, but this will get the frawework .dlls
+ loadModuleFromPath (Path.Combine(assemblyPath, assemblyRef.Name + ".dll"))
+
+let closeModules() =
+ for ``module`` in modules.Values do
+ CloseILModuleReader ``module``
diff --git a/samples/crlish/clrish/MemoryManagement.fs b/samples/crlish/clrish/MemoryManagement.fs
new file mode 100644
index 0000000..f267de4
--- /dev/null
+++ b/samples/crlish/clrish/MemoryManagement.fs
@@ -0,0 +1,108 @@
+module MemoryManagement
+open System
+open System.Collections.Generic
+open Microsoft.FSharp.Compiler.AbstractIL.ILBinaryReader
+open Microsoft.FSharp.Compiler.AbstractIL.IL
+
+let memoryChunkSize = 5120
+let memoryArrays: obj[][] = Array.zeroCreate memoryChunkSize
+
+let getSlotIndexes i =
+ let chunkIndex = i / memoryChunkSize
+ let index = i - (chunkIndex * memoryChunkSize)
+ chunkIndex, index
+
+let getSlotValue i =
+ let chunkIndex, index = getSlotIndexes i
+ memoryArrays.[chunkIndex].[index]
+
+let setSlotValue i value =
+ let chunkIndex, index = getSlotIndexes i
+ if memoryArrays.[chunkIndex] = null then
+ memoryArrays.[chunkIndex] <- Array.zeroCreate memoryChunkSize
+ memoryArrays.[chunkIndex].[index] <- value
+
+
+let heapPointer = ref (5 * memoryChunkSize)
+let threadStackPointer = ref 1
+
+let pushThreadParameters (parameters: obj[]) (targetMethod: ILMethodDef) =
+ for parameter in parameters do
+ setSlotValue !threadStackPointer parameter
+ incr threadStackPointer
+ setSlotValue !threadStackPointer (targetMethod, parameters.Length)
+ incr threadStackPointer
+
+let popThreadParameters () =
+ decr threadStackPointer
+ let _, parameterCount = (getSlotValue !threadStackPointer) :?> (ILMethodDef * int)
+ threadStackPointer := !threadStackPointer - parameterCount
+
+let getParameterAddress i =
+ let methodDesLocaction = !threadStackPointer - 1
+ let _, parameterCount = (getSlotValue methodDesLocaction) :?> (ILMethodDef * int)
+ !threadStackPointer - (parameterCount + 1) + i
+
+let staticFieldLocations = new Dictionary()
+
+let rec getDefaultValue (t: ILType) =
+ match t with
+ | ILType.Void -> failwith "Unsupported type"
+ | ILType.Array (_) -> null
+ | ILType.Value (ilTypeSpec) -> Activator.CreateInstance(Type.GetType(ilTypeSpec.TypeRef.QualifiedName))
+ | ILType.Boxed (ilTypeSpec) -> null
+ | ILType.Ptr (ilType) -> IntPtr.Zero :> obj
+ | ILType.Byref (ilType) -> failwith "Unsupported type"
+ | ILType.FunctionPointer (ilCallingSignature) -> failwith "Unsupported type"
+ | ILType.TypeVar i -> failwith "Unsupported type"
+ | ILType.Modified (required, ilTypeRef, ilType) -> getDefaultValue ilType
+
+let getFieldStaticFieldOffset t name =
+ t.Fields.AsList
+ |> List.filter (fun x -> x.IsStatic)
+ |> List.findIndex(fun x -> x.Name = name)
+
+let getStaticFieldAddress (tModule: ILModuleReader) (t: ILTypeDef) (field: ILFieldSpec) (execMethod: (ILMethodDef -> 'a)) =
+ // TODO this is will not provide a key that's unique for each type
+ let typeFullname = sprintf "%s, %s" t.Name tModule.ILModuleDef.Name
+
+ if not (staticFieldLocations.ContainsKey typeFullname) then
+ staticFieldLocations.Add(typeFullname, !heapPointer)
+ for field in t.Fields.AsList |> List.filter (fun x -> x.IsStatic) do
+ setSlotValue !heapPointer (getDefaultValue field.Type)
+ incr heapPointer
+
+ let staticCtor = t.Methods.AsList |> List.find (fun x -> x.IsClassInitializer)
+ execMethod staticCtor |> ignore
+
+ staticFieldLocations.[typeFullname] + (getFieldStaticFieldOffset t field.Name)
+
+let getStaticField (tModule: ILModuleReader) (t: ILTypeDef) (field: ILFieldSpec) (execMethod: (ILMethodDef -> 'a)) =
+ let location = getStaticFieldAddress tModule t field execMethod
+ getSlotValue location
+
+
+let getFieldInstranceFieldOffset t name =
+ t.Fields.AsList
+ |> List.filter (fun x -> not x.IsStatic)
+ |> List.findIndex(fun x -> x.Name = name)
+
+let getBlankObject (t: ILTypeDef) =
+ let objRef = !heapPointer
+ setSlotValue (!heapPointer) t
+ incr heapPointer
+ for field in t.Fields.AsList |> List.filter (fun x -> not x.IsStatic) do
+ setSlotValue !heapPointer (getDefaultValue field.Type)
+ incr heapPointer
+ objRef
+
+let storeValueInObjectField objRef value (currentModule: ILModuleReader) (fieldSpec: ILFieldSpec) =
+ let t, _ = TypeManagement.getType currentModule fieldSpec.EnclosingType.TypeSpec
+ let offset = getFieldInstranceFieldOffset t fieldSpec.Name
+ setSlotValue (objRef + offset) value
+
+let storeBoxedValue (value: obj) =
+ let objRef = !heapPointer
+ setSlotValue !heapPointer value
+ incr heapPointer
+ objRef
diff --git a/samples/crlish/clrish/Program.fs b/samples/crlish/clrish/Program.fs
new file mode 100644
index 0000000..f10a000
--- /dev/null
+++ b/samples/crlish/clrish/Program.fs
@@ -0,0 +1,19 @@
+open System
+open System.Collections.Generic
+open Microsoft.FSharp.Compiler.AbstractIL.ILBinaryReader
+open Microsoft.FSharp.Compiler.AbstractIL.IL
+
+[]
+let main argv =
+ let entryModule = Loader.loadModuleFromPath argv.[0]
+ try
+ let entryPoint =
+ entryModule.ILModuleDef.TypeDefs |> Seq.collect (fun x -> x.Methods |> Seq.map (fun m -> x, m) ) |> Seq.tryFind (fun (t,m) -> m.IsEntryPoint)
+ match entryPoint with
+ | Some (t, entryPoint) ->
+ ExecutionEngine.exeMethod entryModule [||] t entryPoint |> ignore
+ | None -> failwith "No entry point found"
+ finally
+ Loader.closeModules()
+ 0
+
diff --git a/samples/crlish/clrish/TypeManagement.fs b/samples/crlish/clrish/TypeManagement.fs
new file mode 100644
index 0000000..27a935b
--- /dev/null
+++ b/samples/crlish/clrish/TypeManagement.fs
@@ -0,0 +1,21 @@
+module TypeManagement
+open System
+open System.Collections.Generic
+open Microsoft.FSharp.Compiler.AbstractIL.ILBinaryReader
+open Microsoft.FSharp.Compiler.AbstractIL.IL
+
+let getType (currentModule: ILModuleReader) (ilTypeSpec: ILTypeSpec) =
+ let typesModule =
+ if ilTypeSpec.Scope.IsLocalRef then
+ currentModule
+ else
+ Loader.getModule ilTypeSpec.Scope.AssemblyRef
+ let targetType =
+ typesModule.ILModuleDef.TypeDefs
+ |> Seq.append ( typesModule.ILModuleDef.TypeDefs |> Seq.collect(fun x -> x.NestedTypes))
+ |> Seq.tryFind (fun x -> x.Name = ilTypeSpec.Name)
+ match targetType with
+ | Some x -> x, typesModule
+ | None -> failwithf "Failed to load %A" ilTypeSpec
+
+
diff --git a/samples/crlish/clrish/crlish.fsproj b/samples/crlish/clrish/crlish.fsproj
new file mode 100644
index 0000000..d23ed60
--- /dev/null
+++ b/samples/crlish/clrish/crlish.fsproj
@@ -0,0 +1,75 @@
+
+
+
+
+ Debug
+ AnyCPU
+ 2.0
+ 0898e907-dab0-49fe-9f9a-5767d80d2376
+ Exe
+ crlish
+ crlish
+ v4.5
+ crlish
+
+
+ true
+ full
+ false
+ false
+ bin\Debug\
+ DEBUG;TRACE
+ 3
+ AnyCPU
+ bin\Debug\crlish.XML
+ true
+ "C:\code\clrish\src\TestApp\bin\Debug\TestApp.exe"
+
+
+ pdbonly
+ true
+ true
+ bin\Release\
+ TRACE
+ 3
+ AnyCPU
+ bin\Release\crlish.XML
+ true
+
+
+
+
+ True
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ FSharp.AbsIL
+ {2e4d67b4-522d-4cf7-97e4-ba940f0b18f3}
+ True
+
+
+
+ 11
+
+
+
+
\ No newline at end of file
diff --git a/src/absil-vs2012.sln b/src/absil-vs2012.sln
new file mode 100644
index 0000000..87ef28c
--- /dev/null
+++ b/src/absil-vs2012.sln
@@ -0,0 +1,63 @@
+
+Microsoft Visual Studio Solution File, Format Version 12.00
+# Visual Studio 2012
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FSharp.AbsIL", "fsharp\FSharp.AbsIL\FSharp.AbsIL.fsproj", "{2E4D67B4-522D-4CF7-97E4-BA940F0B18F3}"
+EndProject
+Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "TestApp", "..\samples\crlish\TestApp\TestApp.csproj", "{E3F21F5E-94A5-485D-9FC0-571D27E87EE8}"
+EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "crlish", "..\samples\crlish\clrish\crlish.fsproj", "{0898E907-DAB0-49FE-9F9A-5767D80D2376}"
+EndProject
+Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "samples", "samples", "{A3F6BF8D-E804-4804-B39D-CC1704B98A2F}"
+EndProject
+Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "clrish", "clrish", "{E7297A96-1B40-4790-9D27-DEAEE95E7633}"
+EndProject
+Global
+ GlobalSection(SolutionConfigurationPlatforms) = preSolution
+ Debug|Any CPU = Debug|Any CPU
+ Debug|Mixed Platforms = Debug|Mixed Platforms
+ Debug|x86 = Debug|x86
+ Release|Any CPU = Release|Any CPU
+ Release|Mixed Platforms = Release|Mixed Platforms
+ Release|x86 = Release|x86
+ EndGlobalSection
+ GlobalSection(ProjectConfigurationPlatforms) = postSolution
+ {2E4D67B4-522D-4CF7-97E4-BA940F0B18F3}.Debug|Any CPU.ActiveCfg = Debug|x86
+ {2E4D67B4-522D-4CF7-97E4-BA940F0B18F3}.Debug|Mixed Platforms.ActiveCfg = Debug|x86
+ {2E4D67B4-522D-4CF7-97E4-BA940F0B18F3}.Debug|Mixed Platforms.Build.0 = Debug|x86
+ {2E4D67B4-522D-4CF7-97E4-BA940F0B18F3}.Debug|x86.ActiveCfg = Debug|x86
+ {2E4D67B4-522D-4CF7-97E4-BA940F0B18F3}.Debug|x86.Build.0 = Debug|x86
+ {2E4D67B4-522D-4CF7-97E4-BA940F0B18F3}.Release|Any CPU.ActiveCfg = Release|x86
+ {2E4D67B4-522D-4CF7-97E4-BA940F0B18F3}.Release|Mixed Platforms.ActiveCfg = Release|x86
+ {2E4D67B4-522D-4CF7-97E4-BA940F0B18F3}.Release|Mixed Platforms.Build.0 = Release|x86
+ {2E4D67B4-522D-4CF7-97E4-BA940F0B18F3}.Release|x86.ActiveCfg = Release|x86
+ {2E4D67B4-522D-4CF7-97E4-BA940F0B18F3}.Release|x86.Build.0 = Release|x86
+ {E3F21F5E-94A5-485D-9FC0-571D27E87EE8}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+ {E3F21F5E-94A5-485D-9FC0-571D27E87EE8}.Debug|Any CPU.Build.0 = Debug|Any CPU
+ {E3F21F5E-94A5-485D-9FC0-571D27E87EE8}.Debug|Mixed Platforms.ActiveCfg = Debug|Any CPU
+ {E3F21F5E-94A5-485D-9FC0-571D27E87EE8}.Debug|Mixed Platforms.Build.0 = Debug|Any CPU
+ {E3F21F5E-94A5-485D-9FC0-571D27E87EE8}.Debug|x86.ActiveCfg = Debug|Any CPU
+ {E3F21F5E-94A5-485D-9FC0-571D27E87EE8}.Release|Any CPU.ActiveCfg = Release|Any CPU
+ {E3F21F5E-94A5-485D-9FC0-571D27E87EE8}.Release|Any CPU.Build.0 = Release|Any CPU
+ {E3F21F5E-94A5-485D-9FC0-571D27E87EE8}.Release|Mixed Platforms.ActiveCfg = Release|Any CPU
+ {E3F21F5E-94A5-485D-9FC0-571D27E87EE8}.Release|Mixed Platforms.Build.0 = Release|Any CPU
+ {E3F21F5E-94A5-485D-9FC0-571D27E87EE8}.Release|x86.ActiveCfg = Release|Any CPU
+ {0898E907-DAB0-49FE-9F9A-5767D80D2376}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+ {0898E907-DAB0-49FE-9F9A-5767D80D2376}.Debug|Any CPU.Build.0 = Debug|Any CPU
+ {0898E907-DAB0-49FE-9F9A-5767D80D2376}.Debug|Mixed Platforms.ActiveCfg = Debug|Any CPU
+ {0898E907-DAB0-49FE-9F9A-5767D80D2376}.Debug|Mixed Platforms.Build.0 = Debug|Any CPU
+ {0898E907-DAB0-49FE-9F9A-5767D80D2376}.Debug|x86.ActiveCfg = Debug|Any CPU
+ {0898E907-DAB0-49FE-9F9A-5767D80D2376}.Release|Any CPU.ActiveCfg = Release|Any CPU
+ {0898E907-DAB0-49FE-9F9A-5767D80D2376}.Release|Any CPU.Build.0 = Release|Any CPU
+ {0898E907-DAB0-49FE-9F9A-5767D80D2376}.Release|Mixed Platforms.ActiveCfg = Release|Any CPU
+ {0898E907-DAB0-49FE-9F9A-5767D80D2376}.Release|Mixed Platforms.Build.0 = Release|Any CPU
+ {0898E907-DAB0-49FE-9F9A-5767D80D2376}.Release|x86.ActiveCfg = Release|Any CPU
+ EndGlobalSection
+ GlobalSection(SolutionProperties) = preSolution
+ HideSolutionNode = FALSE
+ EndGlobalSection
+ GlobalSection(NestedProjects) = preSolution
+ {E7297A96-1B40-4790-9D27-DEAEE95E7633} = {A3F6BF8D-E804-4804-B39D-CC1704B98A2F}
+ {E3F21F5E-94A5-485D-9FC0-571D27E87EE8} = {E7297A96-1B40-4790-9D27-DEAEE95E7633}
+ {0898E907-DAB0-49FE-9F9A-5767D80D2376} = {E7297A96-1B40-4790-9D27-DEAEE95E7633}
+ EndGlobalSection
+EndGlobal
diff --git a/src/absil/bytes.fs b/src/absil/bytes.fs
new file mode 100644
index 0000000..2447a0d
--- /dev/null
+++ b/src/absil/bytes.fs
@@ -0,0 +1,146 @@
+//----------------------------------------------------------------------------
+//
+// Copyright (c) 2002-2012 Microsoft Corporation.
+//
+// This source code is subject to terms and conditions of the Apache License, Version 2.0. A
+// copy of the license can be found in the License.html file at the root of this distribution.
+// By using this source code in any fashion, you are agreeing to be bound
+// by the terms of the Apache License, Version 2.0.
+//
+// You must not remove this notice, or any other, from this software.
+//----------------------------------------------------------------------------
+
+/// Byte arrays
+namespace Microsoft.FSharp.Compiler.AbstractIL.Internal
+
+open System.IO
+open Internal.Utilities
+
+open Microsoft.FSharp.Compiler.AbstractIL
+open Microsoft.FSharp.Compiler.AbstractIL.Internal
+
+module internal Bytes =
+ let b0 n = (n &&& 0xFF)
+ let b1 n = ((n >>> 8) &&& 0xFF)
+ let b2 n = ((n >>> 16) &&& 0xFF)
+ let b3 n = ((n >>> 24) &&& 0xFF)
+
+ let dWw1 n = int32 ((n >>> 32) &&& 0xFFFFFFFFL)
+ let dWw0 n = int32 (n &&& 0xFFFFFFFFL)
+
+ let get (b:byte[]) n = int32 (Array.get b n)
+ let zeroCreate n : byte[] = Array.zeroCreate n
+
+ let sub ( b:byte[]) s l = Array.sub b s l
+ let blit (a:byte[]) b c d e = Array.blit a b c d e
+
+ let ofInt32Array (arr:int[]) = Array.init arr.Length (fun i -> byte arr.[i])
+
+ let stringAsUtf8NullTerminated (s:string) =
+ Array.append (System.Text.Encoding.UTF8.GetBytes s) (ofInt32Array [| 0x0 |])
+
+ let stringAsUnicodeNullTerminated (s:string) =
+ Array.append (System.Text.Encoding.Unicode.GetBytes s) (ofInt32Array [| 0x0;0x0 |])
+
+type internal ByteStream =
+ { bytes: byte[];
+ mutable pos: int;
+ max: int }
+ member b.ReadByte() =
+ if b.pos >= b.max then failwith "end of stream";
+ let res = b.bytes.[b.pos]
+ b.pos <- b.pos + 1;
+ res
+ member b.ReadUtf8String n =
+ let res = System.Text.Encoding.UTF8.GetString(b.bytes,b.pos,n)
+ b.pos <- b.pos + n; res
+
+ static member FromBytes (b:byte[],n,len) =
+ if n < 0 || (n+len) > b.Length then failwith "FromBytes";
+ { bytes = b; pos = n; max = n+len }
+
+ member b.ReadBytes n =
+ if b.pos + n > b.max then failwith "ReadBytes: end of stream";
+ let res = Bytes.sub b.bytes b.pos n
+ b.pos <- b.pos + n;
+ res
+
+ member b.Position = b.pos
+#if LAZY_UNPICKLE
+ member b.CloneAndSeek = { bytes=b.bytes; pos=pos; max=b.max }
+ member b.Skip = b.pos <- b.pos + n
+#endif
+
+
+type internal ByteBuffer =
+ { mutable bbArray: byte[];
+ mutable bbCurrent: int }
+
+ member buf.Ensure newSize =
+ let oldBufSize = buf.bbArray.Length
+ if newSize > oldBufSize then
+ let old = buf.bbArray
+ buf.bbArray <- Bytes.zeroCreate (max newSize (oldBufSize * 2));
+ Bytes.blit old 0 buf.bbArray 0 buf.bbCurrent;
+
+ member buf.Close () = Bytes.sub buf.bbArray 0 buf.bbCurrent
+
+ member buf.EmitIntAsByte (i:int) =
+ let newSize = buf.bbCurrent + 1
+ buf.Ensure newSize;
+ buf.bbArray.[buf.bbCurrent] <- byte i
+ buf.bbCurrent <- newSize
+
+ member buf.EmitByte (b:byte) = buf.EmitIntAsByte (int b)
+
+ member buf.EmitIntsAsBytes (arr:int[]) =
+ let n = arr.Length
+ let newSize = buf.bbCurrent + n
+ buf.Ensure newSize;
+ let bbarr = buf.bbArray
+ let bbbase = buf.bbCurrent
+ for i = 0 to n - 1 do
+ bbarr.[bbbase + i] <- byte arr.[i]
+ buf.bbCurrent <- newSize
+
+ member bb.FixupInt32 pos n =
+ bb.bbArray.[pos] <- (Bytes.b0 n |> byte);
+ bb.bbArray.[pos + 1] <- (Bytes.b1 n |> byte);
+ bb.bbArray.[pos + 2] <- (Bytes.b2 n |> byte);
+ bb.bbArray.[pos + 3] <- (Bytes.b3 n |> byte);
+
+ member buf.EmitInt32 n =
+ let newSize = buf.bbCurrent + 4
+ buf.Ensure newSize;
+ buf.FixupInt32 buf.bbCurrent n;
+ buf.bbCurrent <- newSize
+
+ member buf.EmitBytes (i:byte[]) =
+ let n = i.Length
+ let newSize = buf.bbCurrent + n
+ buf.Ensure newSize;
+ Bytes.blit i 0 buf.bbArray buf.bbCurrent n;
+ buf.bbCurrent <- newSize
+
+ member buf.EmitInt32AsUInt16 n =
+ let newSize = buf.bbCurrent + 2
+ buf.Ensure newSize;
+ buf.bbArray.[buf.bbCurrent] <- (Bytes.b0 n |> byte);
+ buf.bbArray.[buf.bbCurrent + 1] <- (Bytes.b1 n |> byte);
+ buf.bbCurrent <- newSize
+
+ member buf.EmitBoolAsByte (b:bool) = buf.EmitIntAsByte (if b then 1 else 0)
+
+ member buf.EmitUInt16 (x:uint16) = buf.EmitInt32AsUInt16 (int32 x)
+
+ member buf.EmitInt64 x =
+ buf.EmitInt32 (Bytes.dWw0 x);
+ buf.EmitInt32 (Bytes.dWw1 x)
+
+ member buf.Position = buf.bbCurrent
+
+ static member Create sz =
+ { bbArray=Bytes.zeroCreate sz;
+ bbCurrent = 0; }
+
+
diff --git a/src/absil/bytes.fsi b/src/absil/bytes.fsi
new file mode 100644
index 0000000..113e124
--- /dev/null
+++ b/src/absil/bytes.fsi
@@ -0,0 +1,66 @@
+//----------------------------------------------------------------------------
+//
+// Copyright (c) 2002-2012 Microsoft Corporation.
+//
+// This source code is subject to terms and conditions of the Apache License, Version 2.0. A
+// copy of the license can be found in the License.html file at the root of this distribution.
+// By using this source code in any fashion, you are agreeing to be bound
+// by the terms of the Apache License, Version 2.0.
+//
+// You must not remove this notice, or any other, from this software.
+//----------------------------------------------------------------------------
+
+
+/// Blobs of bytes, cross-compiling
+namespace Microsoft.FSharp.Compiler.AbstractIL.Internal
+
+open Internal.Utilities
+
+open Microsoft.FSharp.Compiler.AbstractIL
+open Microsoft.FSharp.Compiler.AbstractIL.Internal
+
+
+module internal Bytes =
+ /// returned int will be 0 <= x <= 255
+ val get: byte[] -> int -> int
+ val zeroCreate: int -> byte[]
+ /// each int must be 0 <= x <= 255
+ val ofInt32Array: int[] -> byte[]
+ /// each int will be 0 <= x <= 255
+
+ val blit: byte[] -> int -> byte[] -> int -> int -> unit
+
+ val stringAsUnicodeNullTerminated: string -> byte[]
+ val stringAsUtf8NullTerminated: string -> byte[]
+
+
+/// Imperative buffers and streams of byte[]
+[]
+type internal ByteBuffer =
+ member Close : unit -> byte[]
+ member EmitIntAsByte : int -> unit
+ member EmitIntsAsBytes : int[] -> unit
+ member EmitByte : byte -> unit
+ member EmitBytes : byte[] -> unit
+ member EmitInt32 : int32 -> unit
+ member EmitInt64 : int64 -> unit
+ member FixupInt32 : pos: int -> value: int32 -> unit
+ member EmitInt32AsUInt16 : int32 -> unit
+ member EmitBoolAsByte : bool -> unit
+ member EmitUInt16 : uint16 -> unit
+ member Position : int
+ static member Create : int -> ByteBuffer
+
+
+[]
+type internal ByteStream =
+ member ReadByte : unit -> byte
+ member ReadBytes : int -> byte[]
+ member ReadUtf8String : int -> string
+ member Position : int
+ static member FromBytes : byte[] * start:int * length:int -> ByteStream
+
+#if LAZY_UNPICKLE
+ member CloneAndSeek : int -> ByteStream
+ member Skip : int -> unit
+#endif
diff --git a/src/absil/il.fs b/src/absil/il.fs
new file mode 100644
index 0000000..6da501d
--- /dev/null
+++ b/src/absil/il.fs
@@ -0,0 +1,5026 @@
+//----------------------------------------------------------------------------
+//
+// Copyright (c) 2002-2012 Microsoft Corporation.
+//
+// This source code is subject to terms and conditions of the Apache License, Version 2.0. A
+// copy of the license can be found in the License.html file at the root of this distribution.
+// By using this source code in any fashion, you are agreeing to be bound
+// by the terms of the Apache License, Version 2.0.
+//
+// You must not remove this notice, or any other, from this software.
+//----------------------------------------------------------------------------
+
+module Microsoft.FSharp.Compiler.AbstractIL.IL
+
+#nowarn "49"
+#nowarn "343" // The type 'ILAssemblyRef' implements 'System.IComparable' explicitly but provides no corresponding override for 'Object.Equals'.
+#nowarn "346" // The struct, record or union type 'IlxExtensionType' has an explicit implementation of 'Object.Equals'. ...
+
+
+open Internal.Utilities
+open Microsoft.FSharp.Compiler.AbstractIL
+open Microsoft.FSharp.Compiler.AbstractIL.Internal
+open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library
+open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics
+open System.Collections.Generic
+open System.Collections
+
+let logging = false
+
+// Officially supported way to detect if we are running on Mono.
+// See http://www.mono-project.com/FAQ:_Technical
+// "How can I detect if am running in Mono?" section
+let runningOnMono =
+ try
+ System.Type.GetType("Mono.Runtime") <> null
+ with e->
+ // Must be robust in the case that someone else has installed a handler into System.AppDomain.OnTypeResolveEvent
+ // that is not reliable.
+ // This is related to bug 5506--the issue is actually a bug in VSTypeResolutionService.EnsurePopulated which is
+ // called by OnTypeResolveEvent. The function throws a NullReferenceException. I'm working with that team to get
+ // their issue fixed but we need to be robust here anyway.
+ false
+
+let _ = if logging then dprintn "* warning: Il.logging is on"
+
+let isNil x = match x with [] -> true | _ -> false
+let nonNil x = match x with [] -> false | _ -> true
+let int_order = LanguagePrimitives.FastGenericComparer
+
+let notlazy v = Lazy.CreateFromValue v
+
+/// A little ugly, but the idea is that if a data structure does not
+/// contain lazy values then we don't add laziness. So if the thing to map
+/// is already evaluated then immediately apply the function.
+let lazyMap f (x:Lazy<_>) =
+ if x.IsValueCreated then notlazy (f (x.Force())) else lazy (f (x.Force()))
+
+// --------------------------------------------------------------------
+// Utilities: type names
+// --------------------------------------------------------------------
+
+let splitNameAt (nm:string) idx =
+ if idx < 0 then failwith "splitNameAt: idx < 0";
+ let last = nm.Length - 1
+ if idx > last then failwith "splitNameAt: idx > last";
+ (nm.Substring(0,idx)),
+ (if idx < last then nm.Substring (idx+1,last - idx) else "")
+
+let rec splitNamespaceAux (nm:string) =
+ match nm.IndexOf '.' with
+ | -1 -> [nm]
+ | idx ->
+ let s1,s2 = splitNameAt nm idx
+ s1::splitNamespaceAux s2
+
+/// Global State. All namespace splits ever seen
+// ++GLOBAL MUTABLE STATE
+let memoizeNamespaceTable = new Dictionary(10)
+
+// ++GLOBAL MUTABLE STATE
+let memoizeNamespaceRightTable = new Dictionary(100)
+
+
+let splitNamespace nm =
+ let mutable res = Unchecked.defaultof<_>
+ let ok = memoizeNamespaceTable.TryGetValue(nm,&res)
+ if ok then res else
+ let x = splitNamespaceAux nm
+ (memoizeNamespaceTable.[nm] <- x; x)
+
+let splitNamespaceMemoized nm = splitNamespace nm
+
+// ++GLOBAL MUTABLE STATE
+let memoizeNamespaceArrayTable =
+ Dictionary(10)
+
+let splitNamespaceToArray nm =
+ let mutable res = Unchecked.defaultof<_>
+ let ok = memoizeNamespaceArrayTable.TryGetValue(nm,&res)
+ if ok then res else
+ let x = Array.ofList (splitNamespace nm)
+ (memoizeNamespaceArrayTable.[nm] <- x; x)
+
+
+let splitILTypeName (nm:string) =
+ match nm.LastIndexOf '.' with
+ | -1 -> [],nm
+ | idx ->
+ let s1,s2 = splitNameAt nm idx
+ splitNamespace s1,s2
+
+let emptyStringArray = ([| |] : string[])
+
+// Duplciate of comment in import.fs:
+// The type names that flow to the point include the "mangled" type names used for static parameters for provided types.
+// For example,
+// Foo.Bar,"1.0"
+// This is because the ImportSystemType code goes via Abstract IL type references. Ultimately this probably isn't
+// the best way to do things.
+let splitILTypeNameWithPossibleStaticArguments (nm:string) =
+ let nm,suffix =
+ match nm.IndexOf ',' with
+ | -1 -> nm, None
+ | idx -> let s1, s2 = splitNameAt nm idx in s1, Some s2
+
+ let nsp,nm =
+ match nm.LastIndexOf '.' with
+ | -1 -> emptyStringArray,nm
+ | idx ->
+ let s1,s2 = splitNameAt nm idx
+ splitNamespaceToArray s1,s2
+ nsp, (match suffix with None -> nm | Some s -> nm + "," + s)
+
+(*
+splitILTypeNameWithPossibleStaticArguments "Foo" = ([| |], "Foo")
+splitILTypeNameWithPossibleStaticArguments "Foo.Bar" = ([| "Foo" |], "Bar")
+splitILTypeNameWithPossibleStaticArguments "Foo.Bar,3" = ([| "Foo" |], "Bar,3")
+splitILTypeNameWithPossibleStaticArguments "Foo.Bar," = ([| "Foo" |], "Bar,")
+splitILTypeNameWithPossibleStaticArguments "Foo.Bar,\"1.0\"" = ([| "Foo" |], "Bar,\"1.0\"")
+splitILTypeNameWithPossibleStaticArguments "Foo.Bar.Bar,\"1.0\"" = ([| "Foo"; "Bar" |], "Bar,\"1.0\"")
+*)
+
+let unsplitTypeName (ns,n) =
+ match ns with
+ | [] -> String.concat "." ns + "." + n
+ | _ -> n
+
+let splitTypeNameRightAux nm =
+ if String.contains nm '.' then
+ let idx = String.rindex nm '.'
+ let s1,s2 = splitNameAt nm idx
+ Some s1,s2
+ else None, nm
+
+let splitTypeNameRight nm =
+ let mutable res = Unchecked.defaultof<_>
+ let ok = memoizeNamespaceRightTable.TryGetValue(nm,&res)
+ if ok then res else
+ let x = splitTypeNameRightAux nm
+ (memoizeNamespaceRightTable.[nm] <- x; x)
+
+// --------------------------------------------------------------------
+// Ordered lists with a lookup table
+// --------------------------------------------------------------------
+
+/// This is used to store event, property and field maps.
+///
+/// Review: this is not such a great data structure.
+type LazyOrderedMultiMap<'Key,'Data when 'Key : equality>(keyf : 'Data -> 'Key, lazyItems : Lazy<'Data list>) =
+
+ let quickMap=
+ lazyItems |> lazyMap (fun entries ->
+ let t = new Dictionary<_,_>(entries.Length, HashIdentity.Structural)
+ do entries |> List.iter (fun y -> let key = keyf y in t.[key] <- y :: (if t.ContainsKey(key) then t.[key] else []))
+ t)
+
+ member self.Entries() = lazyItems.Force()
+
+ member self.Add(y) = new LazyOrderedMultiMap<'Key,'Data>(keyf, lazyItems |> lazyMap (fun x -> y :: x))
+
+ member self.Filter(f) = new LazyOrderedMultiMap<'Key,'Data>(keyf, lazyItems |> lazyMap (List.filter f))
+
+ member self.Item with get(x) = let t = quickMap.Force() in if t.ContainsKey x then t.[x] else []
+
+
+//---------------------------------------------------------------------
+// SHA1 hash-signing algorithm. Used to get the public key token from
+// the public key.
+//---------------------------------------------------------------------
+
+
+let b0 n = (n &&& 0xFF)
+let b1 n = ((n >>> 8) &&& 0xFF)
+let b2 n = ((n >>> 16) &&& 0xFF)
+let b3 n = ((n >>> 24) &&& 0xFF)
+
+
+module SHA1 =
+ let inline (>>>&) (x:int) (y:int) = int32 (uint32 x >>> y)
+ let f(t,b,c,d) =
+ if t < 20 then (b &&& c) ||| ((~~~b) &&& d) else
+ if t < 40 then b ^^^ c ^^^ d else
+ if t < 60 then (b &&& c) ||| (b &&& d) ||| (c &&& d) else
+ b ^^^ c ^^^ d
+
+ let k0to19 = 0x5A827999
+ let k20to39 = 0x6ED9EBA1
+ let k40to59 = 0x8F1BBCDC
+ let k60to79 = 0xCA62C1D6
+
+ let k t =
+ if t < 20 then k0to19
+ elif t < 40 then k20to39
+ elif t < 60 then k40to59
+ else k60to79
+
+
+ type chan = SHABytes of byte[]
+ type sha_instream =
+ { stream: chan;
+ mutable pos: int;
+ mutable eof: bool; }
+
+ let rot_left32 x n = (x <<< n) ||| (x >>>& (32-n))
+
+ let sha_eof sha = sha.eof
+
+ (* padding and length (in bits!) recorded at end *)
+ let sha_after_eof sha =
+ let n = sha.pos
+ let len =
+ (match sha.stream with
+ | SHABytes s -> s.Length)
+ if n = len then 0x80
+ else
+ let padded_len = (((len + 9 + 63) / 64) * 64) - 8
+ if n < padded_len - 8 then 0x0
+ elif (n &&& 63) = 56 then int32 ((int64 len * int64 8) >>> 56) &&& 0xff
+ elif (n &&& 63) = 57 then int32 ((int64 len * int64 8) >>> 48) &&& 0xff
+ elif (n &&& 63) = 58 then int32 ((int64 len * int64 8) >>> 40) &&& 0xff
+ elif (n &&& 63) = 59 then int32 ((int64 len * int64 8) >>> 32) &&& 0xff
+ elif (n &&& 63) = 60 then int32 ((int64 len * int64 8) >>> 24) &&& 0xff
+ elif (n &&& 63) = 61 then int32 ((int64 len * int64 8) >>> 16) &&& 0xff
+ elif (n &&& 63) = 62 then int32 ((int64 len * int64 8) >>> 8) &&& 0xff
+ elif (n &&& 63) = 63 then (sha.eof <- true; int32 (int64 len * int64 8) &&& 0xff)
+ else 0x0
+
+ let sha_read8 sha =
+ let b =
+ match sha.stream with
+ | SHABytes s -> if sha.pos >= s.Length then sha_after_eof sha else int32 s.[sha.pos]
+ sha.pos <- sha.pos + 1;
+ b
+
+ let sha_read32 sha =
+ let b0 = sha_read8 sha
+ let b1 = sha_read8 sha
+ let b2 = sha_read8 sha
+ let b3 = sha_read8 sha
+ let res = (b0 <<< 24) ||| (b1 <<< 16) ||| (b2 <<< 8) ||| b3
+ res
+
+
+ let sha1_hash sha =
+ let h0 = ref 0x67452301
+ let h1 = ref 0xEFCDAB89
+ let h2 = ref 0x98BADCFE
+ let h3 = ref 0x10325476
+ let h4 = ref 0xC3D2E1F0
+ let a = ref 0
+ let b = ref 0
+ let c = ref 0
+ let d = ref 0
+ let e = ref 0
+ let w = Array.create 80 0x00
+ while (not (sha_eof sha)) do
+ for i = 0 to 15 do
+ w.[i] <- sha_read32 sha
+ for t = 16 to 79 do
+ w.[t] <- rot_left32 (w.[t-3] ^^^ w.[t-8] ^^^ w.[t-14] ^^^ w.[t-16]) 1;
+ a := !h0;
+ b := !h1;
+ c := !h2;
+ d := !h3;
+ e := !h4;
+ for t = 0 to 79 do
+ let temp = (rot_left32 !a 5) + f(t,!b,!c,!d) + !e + w.[t] + k(t)
+ e := !d;
+ d := !c;
+ c := rot_left32 !b 30;
+ b := !a;
+ a := temp;
+ h0 := !h0 + !a;
+ h1 := !h1 + !b;
+ h2 := !h2 + !c;
+ h3 := !h3 + !d;
+ h4 := !h4 + !e
+ done;
+ (!h0,!h1,!h2,!h3,!h4)
+
+ let sha1HashBytes s =
+ let (_h0,_h1,_h2,h3,h4) = sha1_hash { stream = SHABytes s; pos = 0; eof = false } // the result of the SHA algorithm is stored in registers 3 and 4
+ Array.map byte [| b0 h4; b1 h4; b2 h4; b3 h4; b0 h3; b1 h3; b2 h3; b3 h3; |]
+
+
+let sha1HashBytes s = SHA1.sha1HashBytes s
+
+// --------------------------------------------------------------------
+// ILList
+// --------------------------------------------------------------------
+
+/// ILList is the type used to store relatively small lists in the Abstract IL data structures,
+/// i.e. for ILTypes, ILGenericArgs, ILParameters and ILLocals.
+
+// This #if starts isolating the representation for "ILTypes", "ILGenericArgs", "ILParameters" and "ILLocals"
+// with the aim of making it possible to easily switch between using arrays and lists as representations for these.
+// THis is because many allocations of these small lists appear in memory logs.
+//
+// The "obviouos" step is to use arrays instead of lists. However, this is routinely and surprisingly disappointing.
+// As a result, we haven’t enabled the use of arrays: we had expected this change to give a perf gain,
+// but it does not! It even gives a small perf loss. We've tried this approach on several other occasions
+// for other data structures and each time been surprised that there’s no perf gain. It's possible that
+// arrays-of-references are just not as fast as we expect here: either the runtime check on assignment
+// into the array, or some kind of write barrier may be degrading performance.
+//
+// However, There must surely be some better data structure here than allocating endless linked-list containing one item
+// each. One option is to use a linked-list structure that stores multiple elements in each allocation, e.g.
+//
+// type ThreeList<'T> = T of 'T * 'T * 'T * ThreeList<'T>
+//
+// and a similar hack is used as the underlying representation fot List<'T>, where we store a "constant" value to indicate the end
+// of the sequence. Some of the 'T values would be empty to indicate a partially-filled node. Storing an integer would of course
+// make things clearer, and allow values-with-null to be stored in the data structure:
+//
+// type ThreeList<'T> = T of int * 'T * 'T * 'T * ThreeList<'T>
+//
+// Since we haven't quite given up on moving away from lists as yet, the #if below still feels useful
+// as it isolates the representation of these data structures from the rest of the compiler.
+//
+// Note this is similar to the use of "Flat Lists" in the tast.fs data structures where we tried to eliminate
+// the use of lists in the tast.fs nodes of the compiler, but that also didn't give perf gains.
+//
+// If it turns out that we just eventually completely abandon these exercises then we can eliminate this code and
+// universally replace "ILList" and "FlatList" by "List".
+
+#if ABSIL_USES_ARRAY_FOR_ILLIST
+type ILList<'T> = 'T[]
+[]
+module ILList =
+ let inline map f x = Array.map f x
+ let inline mapi f x = Array.mapi f x
+ let inline isEmpty (x:ILList<_>) = x.Length <> 0
+ let inline toArray (x:ILList<_>) = x
+ let inline ofArray (x:'T[]) = x
+ let inline nth n (x:'T[]) = x.[n]
+ let inline toList (x:ILList<_>) = Array.toList x
+ let inline ofList (x:'T list) = Array.ofList x
+ let inline lengthsEqAndForall2 f x1 x2 = Array.lengthsEqAndForall2 f x1 x2
+ let inline init n f = Array.init n f
+ let inline empty<'T> = ([| |] :'T[])
+ let inline iter f (x:'T[]) = Array.iter f x
+ let inline iteri f (x:'T[]) = Array.iteri f x
+ let inline foldBack f (x:'T[]) z = Array.foldBack f x z
+ let inline exists f x = Array.exists f x
+#endif
+
+//#if ABSIL_USES_LIST_FOR_ILLIST
+type ILList<'T> = 'T list
+
+[]
+module ILList =
+ let inline map f x = List.map f x
+ let inline mapi f x = List.mapi f x
+ let inline isEmpty x = match x with [] -> true | _ -> false
+ let inline toArray (x:ILList<_>) = List.toArray x
+ let inline ofArray (x:'T[]) = List.ofArray x
+ let inline iter f (x:'T list) = List.iter f x
+ let inline iteri f (x:'T list) = List.iteri f x
+ let inline nth (x:'T list) n = List.nth x n
+ let inline toList (x:ILList<_>) = x
+ let inline ofList (x:'T list) = x
+ let inline lengthsEqAndForall2 f x1 x2 = List.lengthsEqAndForall2 f x1 x2
+ let inline init n f = List.init n f
+ let inline empty<'T> = ([ ] :'T list)
+ let inline foldBack f x z = List.foldBack f x z
+ let inline exists f x = List.exists f x
+//#endif // ABSIL_USES_LIST_FOR_ILLIST
+
+#if ABSIL_USES_THREELIST_FOR_ILLIST
+type ILList<'T> = ThreeList<'T>
+
+[]
+module ILList =
+ let inline map f x = ThreeList.map f x
+ let inline mapi f x = ThreeList.mapi f x
+ let inline isEmpty x = ThreeList.isEmpty x
+ let inline toArray (x:ILList<_>) = ThreeList.toArray x
+ let inline ofArray (x:'T[]) = ThreeList.ofArray x
+ let inline iter f (x:ILList<'T>) = ThreeList.iter f x
+ let inline iteri f (x:ILList<'T>) = ThreeList.iteri f x
+ let inline toList (x:ILList<_>) = ThreeList.toList x
+ let inline nth (x:ILList<'T>) n = ThreeList.nth x n
+ let inline ofList (x:'T list) = ThreeList.ofList x
+ let inline lengthsEqAndForall2 f x1 x2 = ThreeList.lengthsEqAndForall2 f x1 x2
+ let inline init n f = ThreeList.init n f
+ let inline empty<'T> = ThreeList.empty<'T>
+ let inline foldBack f x z = ThreeList.foldBack f x z
+ let inline exists f x = ThreeList.exists f x
+#endif
+
+// --------------------------------------------------------------------
+//
+// --------------------------------------------------------------------
+
+type ILVersionInfo = uint16 * uint16 * uint16 * uint16
+
+type Locale = string
+
+[]
+type PublicKey =
+ | PublicKey of byte[]
+ | PublicKeyToken of byte[]
+ member x.IsKey=match x with PublicKey _ -> true | _ -> false
+ member x.IsKeyToken=match x with PublicKeyToken _ -> true | _ -> false
+ member x.Key=match x with PublicKey b -> b | _ -> invalidOp "not a key"
+ member x.KeyToken=match x with PublicKeyToken b -> b | _ -> invalidOp"not a key token"
+
+ member x.ToToken() =
+ match x with
+ | PublicKey bytes -> SHA1.sha1HashBytes bytes
+ | PublicKeyToken token -> token
+ static member KeyAsToken(k) = PublicKeyToken(PublicKey(k).ToToken())
+
+[]
+type AssemblyRefData =
+ { assemRefName: string;
+ assemRefHash: byte[] option;
+ assemRefPublicKeyInfo: PublicKey option;
+ assemRefRetargetable: bool;
+ assemRefVersion: ILVersionInfo option;
+ assemRefLocale: Locale option; }
+
+/// Global state: table of all assembly references keyed by AssemblyRefData
+let AssemblyRefUniqueStampGenerator = new UniqueStampGenerator()
+
+[]
+type ILAssemblyRef(data) =
+ let uniqueStamp = AssemblyRefUniqueStampGenerator.Encode(data)
+ member x.Name=data.assemRefName
+ member x.Hash=data.assemRefHash
+ member x.PublicKey=data.assemRefPublicKeyInfo
+ member x.Retargetable=data.assemRefRetargetable
+ member x.Version=data.assemRefVersion
+ member x.Locale=data.assemRefLocale
+ member x.UniqueStamp=uniqueStamp
+ override x.GetHashCode() = uniqueStamp
+ override x.Equals(yobj) = ((yobj :?> ILAssemblyRef).UniqueStamp = uniqueStamp)
+ interface System.IComparable with
+ override x.CompareTo(yobj) = compare (yobj :?> ILAssemblyRef).UniqueStamp uniqueStamp
+ static member Create(name,hash,publicKey,retargetable,version,locale) =
+ ILAssemblyRef
+ { assemRefName=name;
+ assemRefHash=hash;
+ assemRefPublicKeyInfo=publicKey;
+ assemRefRetargetable=retargetable;
+ assemRefVersion=version;
+ assemRefLocale=locale; }
+
+ static member FromAssemblyName (aname:System.Reflection.AssemblyName) =
+ let culture = None
+ let locale = None
+ let version =
+ let v = aname.Version
+ Some(uint16 v.Major,uint16 v.Minor,uint16 v.Build,uint16 v.Revision)
+ let key =
+ match aname.GetPublicKeyToken() with
+ | null | [| |] -> None
+ | bytes -> Some (PublicKeyToken bytes)
+ let retargetable = (aname.Flags = System.Reflection.AssemblyNameFlags.Retargetable)
+ ILAssemblyRef.Create(aname.Name,culture,key,retargetable,version,locale)
+
+
+ member aref.QualifiedName =
+ let b = new System.Text.StringBuilder(100)
+ let add (s:string) = (b.Append(s) |> ignore)
+ let addC (s:char) = (b.Append(s) |> ignore)
+ add(aref.Name);
+ match aref.Version with
+ | None -> ()
+ | Some (a,b,c,d) ->
+ add ", Version=";
+ add (string (int a))
+ add ".";
+ add (string (int b))
+ add ".";
+ add (string (int c))
+ add ".";
+ add (string (int d))
+ add ", Culture="
+ match aref.Locale with
+ | None -> add "neutral"
+ | Some b -> add b
+ add ", PublicKeyToken="
+ match aref.PublicKey with
+ | None -> add "null"
+ | Some pki ->
+ let pkt = pki.ToToken()
+ let convDigit(digit) =
+ let digitc =
+ if digit < 10
+ then System.Convert.ToInt32 '0' + digit
+ else System.Convert.ToInt32 'a' + (digit - 10)
+ System.Convert.ToChar(digitc)
+ for i = 0 to pkt.Length-1 do
+ let v = pkt.[i]
+ addC (convDigit(System.Convert.ToInt32(v)/16))
+ addC (convDigit(System.Convert.ToInt32(v)%16))
+ // retargetable can be true only for system assemblies that definitely have Version
+ if aref.Retargetable then
+ add ", Retargetable=Yes"
+ b.ToString()
+
+
+[]
+type ILModuleRef =
+ { name: string;
+ hasMetadata: bool;
+ hash: byte[] option; }
+ static member Create(name,hasMetadata,hash) =
+ { name=name;
+ hasMetadata= hasMetadata;
+ hash=hash }
+
+ member x.Name=x.name
+ member x.HasMetadata=x.hasMetadata
+ member x.Hash=x.hash
+
+[]
+[]
+type ILScopeRef =
+ | Local
+ | Module of ILModuleRef
+ | Assembly of ILAssemblyRef
+ member x.IsLocalRef = match x with ILScopeRef.Local -> true | _ -> false
+ member x.IsModuleRef = match x with ILScopeRef.Module _ -> true | _ -> false
+ member x.IsAssemblyRef= match x with ILScopeRef.Assembly _ -> true | _ -> false
+ member x.ModuleRef = match x with ILScopeRef.Module x -> x | _ -> failwith "not a module reference"
+ member x.AssemblyRef = match x with ILScopeRef.Assembly x -> x | _ -> failwith "not an assembly reference"
+
+ member scoref.QualifiedName =
+ match scoref with
+ | ILScopeRef.Local -> ""
+ | ILScopeRef.Module mref -> "module "^mref.Name
+ | ILScopeRef.Assembly aref when aref.Name = "mscorlib" -> ""
+ | ILScopeRef.Assembly aref -> aref.QualifiedName
+
+ member scoref.QualifiedNameWithNoShortMscorlib =
+ match scoref with
+ | ILScopeRef.Local -> ""
+ | ILScopeRef.Module mref -> "module "+mref.Name
+ | ILScopeRef.Assembly aref -> aref.QualifiedName
+
+type ILArrayBound = int32 option
+type ILArrayBounds = ILArrayBound * ILArrayBound
+
+[]
+type ILArrayShape =
+ | ILArrayShape of ILArrayBounds list (* lobound/size pairs *)
+ member x.Rank = (let (ILArrayShape l) = x in l.Length)
+ static member SingleDimensional = ILArrayShapeStatics.SingleDimensional
+ static member FromRank n = if n = 1 then ILArrayShape.SingleDimensional else ILArrayShape(List.replicate n (Some 0,None))
+
+
+and ILArrayShapeStatics() =
+ static let singleDimensional = ILArrayShape [(Some 0, None)]
+ static member SingleDimensional = singleDimensional
+
+/// Calling conventions. These are used in method pointer types.
+[]
+type ILArgConvention =
+ | Default
+ | CDecl
+ | StdCall
+ | ThisCall
+ | FastCall
+ | VarArg
+
+[]
+type ILThisConvention =
+ | Instance
+ | InstanceExplicit
+ | Static
+
+[]
+type ILCallingConv =
+ | Callconv of ILThisConvention * ILArgConvention
+ member x.ThisConv = let (Callconv(a,_b)) = x in a
+ member x.BasicConv = let (Callconv(_a,b)) = x in b
+ member x.IsInstance = match x.ThisConv with ILThisConvention.Instance -> true | _ -> false
+ member x.IsInstanceExplicit = match x.ThisConv with ILThisConvention.InstanceExplicit -> true | _ -> false
+ member x.IsStatic = match x.ThisConv with ILThisConvention.Static -> true | _ -> false
+
+ static member Instance = ILCallingConvStatics.Instance
+ static member Static = ILCallingConvStatics.Static
+
+/// Static storage to amortize the allocation of ILCallingConv.Instance and ILCallingConv.Static
+and ILCallingConvStatics() =
+ static let instanceCallConv = Callconv(ILThisConvention.Instance,ILArgConvention.Default)
+ static let staticCallConv = Callconv(ILThisConvention.Static,ILArgConvention.Default)
+ static member Instance = instanceCallConv
+ static member Static = staticCallConv
+
+type ILBoxity =
+ | AsObject
+ | AsValue
+
+
+// IL type references have a pre-computed hash code to enable quick lookup tables during binary generation.
+[]
+type ILTypeRef =
+ { trefScope: ILScopeRef;
+ trefEnclosing: string list;
+ trefName: string;
+ hashCode : int
+ mutable asBoxedType: ILType }
+
+ static member Create(scope,enclosing,name) =
+ let hashCode = hash scope * 17 ^^^ (hash enclosing * 101 <<< 1) ^^^ (hash name * 47 <<< 2)
+ { trefScope=scope;
+ trefEnclosing= enclosing;
+ trefName=name;
+ hashCode=hashCode;
+ asBoxedType = Unchecked.defaultof<_> }
+
+ member x.Scope = x.trefScope
+ member x.Enclosing = x.trefEnclosing
+ member x.Name = x.trefName
+ member x.ApproxId = x.hashCode
+
+ member x.AsBoxedType (tspec:ILTypeSpec) =
+ match tspec.tspecInst.Length with
+ | 0 ->
+ let v = x.asBoxedType
+ match box v with
+ | null ->
+ let r = ILType.Boxed tspec
+ x.asBoxedType <- r
+ r
+ | _ -> v
+ | _ -> ILType.Boxed tspec
+
+ override x.GetHashCode() = x.hashCode
+ override x.Equals(yobj) =
+ let y = (yobj :?> ILTypeRef)
+ (x.ApproxId = y.ApproxId) &&
+ (x.Scope = y.Scope) &&
+ (x.Name = y.Name) &&
+ (x.Enclosing = y.Enclosing)
+ interface System.IComparable with
+ override x.CompareTo(yobj) =
+ let y = (yobj :?> ILTypeRef)
+ let c = compare x.ApproxId y.ApproxId
+ if c <> 0 then c else
+ let c = compare x.Scope y.Scope
+ if c <> 0 then c else
+ let c = compare x.Name y.Name
+ if c <> 0 then c else
+ compare x.Enclosing y.Enclosing
+
+ member tref.FullName = String.concat "." (tref.Enclosing @ [tref.Name])
+
+ member tref.BasicQualifiedName =
+ String.concat "+" (tref.Enclosing @ [ tref.Name ])
+
+ member tref.AddQualifiedNameExtensionWithNoShortMscorlib(basic) =
+ let sco = tref.Scope.QualifiedNameWithNoShortMscorlib
+ if sco = "" then basic else String.concat ", " [basic;sco]
+
+ member tref.QualifiedNameWithNoShortMscorlib =
+ tref.AddQualifiedNameExtensionWithNoShortMscorlib(tref.BasicQualifiedName)
+
+ member tref.QualifiedName =
+ let basic = tref.BasicQualifiedName
+ let sco = tref.Scope.QualifiedName
+ if sco = "" then basic else String.concat ", " [basic;sco]
+
+
+ override x.ToString() = x.FullName
+
+
+and
+ []
+ ILTypeSpec =
+ { tspecTypeRef: ILTypeRef;
+ /// The type instantiation if the type is generic
+ tspecInst: ILGenericArgs }
+ member x.TypeRef=x.tspecTypeRef
+ member x.Scope=x.TypeRef.Scope
+ member x.Enclosing=x.TypeRef.Enclosing
+ member x.Name=x.TypeRef.Name
+ member x.GenericArgs=x.tspecInst
+ static member Create(tref,inst) = { tspecTypeRef =tref; tspecInst=inst }
+ override x.ToString() = x.TypeRef.ToString() + (if ILList.isEmpty x.GenericArgs then "" else "<...>")
+ member x.BasicQualifiedName =
+ let tc = x.TypeRef.BasicQualifiedName
+ if ILList.isEmpty x.GenericArgs then
+ tc
+ else
+ tc + "[" + String.concat "," (x.GenericArgs |> ILList.map (fun arg -> "[" + arg.QualifiedNameWithNoShortMscorlib + "]")) + "]"
+
+ member x.AddQualifiedNameExtensionWithNoShortMscorlib(basic) =
+ x.TypeRef.AddQualifiedNameExtensionWithNoShortMscorlib(basic)
+
+ member x.FullName=x.TypeRef.FullName
+
+and []
+ ILType =
+ | Void
+ | Array of ILArrayShape * ILType
+ | Value of ILTypeSpec
+ | Boxed of ILTypeSpec
+ | Ptr of ILType
+ | Byref of ILType
+ | FunctionPointer of ILCallingSignature
+ | TypeVar of uint16
+ | Modified of bool * ILTypeRef * ILType
+
+ member x.BasicQualifiedName =
+ match x with
+ | ILType.TypeVar n -> "!" + string n
+ | ILType.Modified(_,_ty1,ty2) -> ty2.BasicQualifiedName
+ | ILType.Array (ILArrayShape(s),ty) -> ty.BasicQualifiedName + "[" + System.String(',',s.Length-1) + "]"
+ | ILType.Value tr | ILType.Boxed tr -> tr.BasicQualifiedName
+ | ILType.Void -> "void"
+ | ILType.Ptr _ty -> failwith "unexpected pointer type"
+ | ILType.Byref _ty -> failwith "unexpected byref type"
+ | ILType.FunctionPointer _mref -> failwith "unexpected function pointer type"
+
+ member x.AddQualifiedNameExtensionWithNoShortMscorlib(basic) =
+ match x with
+ | ILType.TypeVar _n -> basic
+ | ILType.Modified(_,_ty1,ty2) -> ty2.AddQualifiedNameExtensionWithNoShortMscorlib(basic)
+ | ILType.Array (ILArrayShape(_s),ty) -> ty.AddQualifiedNameExtensionWithNoShortMscorlib(basic)
+ | ILType.Value tr | ILType.Boxed tr -> tr.AddQualifiedNameExtensionWithNoShortMscorlib(basic)
+ | ILType.Void -> failwith "void"
+ | ILType.Ptr _ty -> failwith "unexpected pointer type"
+ | ILType.Byref _ty -> failwith "unexpected byref type"
+ | ILType.FunctionPointer _mref -> failwith "unexpected function pointer type"
+
+ member x.QualifiedNameWithNoShortMscorlib =
+ x.AddQualifiedNameExtensionWithNoShortMscorlib(x.BasicQualifiedName)
+
+and
+ []
+ IlxExtensionType =
+ | Ext_typ of obj
+ member x.Value = (let (Ext_typ(v)) = x in v)
+ override x.Equals(yobj) = match yobj with :? IlxExtensionType as y -> Unchecked.equals x.Value y.Value | _ -> false
+ interface System.IComparable with
+ override x.CompareTo(yobj) = match yobj with :? IlxExtensionType as y -> Unchecked.compare x.Value y.Value | _ -> invalidOp "bad comparison"
+
+and []
+ ILCallingSignature =
+ { CallingConv: ILCallingConv;
+ ArgTypes: ILTypes;
+ ReturnType: ILType }
+
+and ILGenericArgs = ILList
+and ILTypes = ILList
+
+
+let emptyILTypes = (ILList.empty : ILTypes)
+let emptyILGenericArgs = (ILList.empty: ILGenericArgs)
+
+let mkILTypes xs = (match xs with [] -> emptyILTypes | _ -> ILList.ofList xs)
+let mkILGenericArgs xs = (match xs with [] -> emptyILGenericArgs | _ -> ILList.ofList xs)
+
+let mkILCallSigRaw (cc,args,ret) = { ArgTypes=args; CallingConv=cc; ReturnType=ret}
+let mkILCallSig (cc,args,ret) = mkILCallSigRaw(cc, mkILTypes args, ret)
+let mkILBoxedType (tspec:ILTypeSpec) = tspec.TypeRef.AsBoxedType tspec
+
+type ILMethodRef =
+ { mrefParent: ILTypeRef;
+ mrefCallconv: ILCallingConv;
+ mrefGenericArity: int;
+ mrefName: string;
+ mrefArgs: ILTypes;
+ mrefReturn: ILType }
+ member x.EnclosingTypeRef = x.mrefParent
+ member x.CallingConv = x.mrefCallconv
+ member x.Name = x.mrefName
+ member x.GenericArity = x.mrefGenericArity
+ member x.ArgCount = x.mrefArgs.Length
+ member x.ArgTypes = x.mrefArgs
+ member x.ReturnType = x.mrefReturn
+
+ member x.CallingSignature = mkILCallSigRaw (x.CallingConv,x.ArgTypes,x.ReturnType)
+ static member Create(a,b,c,d,e,f) =
+ { mrefParent= a;mrefCallconv=b;mrefName=c;mrefGenericArity=d; mrefArgs=e;mrefReturn=f }
+ override x.ToString() = x.EnclosingTypeRef.ToString() + "::" + x.Name + "(...)"
+
+
+[]
+type ILFieldRef =
+ { EnclosingTypeRef: ILTypeRef;
+ Name: string;
+ Type: ILType }
+ override x.ToString() = x.EnclosingTypeRef.ToString() + "::" + x.Name
+
+[]
+type ILMethodSpec =
+ { mspecMethodRef: ILMethodRef;
+ mspecEnclosingType: ILType;
+ mspecMethodInst: ILGenericArgs; }
+ static member Create(a,b,c) = { mspecEnclosingType=a; mspecMethodRef =b; mspecMethodInst=c }
+ member x.MethodRef = x.mspecMethodRef
+ member x.EnclosingType=x.mspecEnclosingType
+ member x.GenericArgs=x.mspecMethodInst
+ member x.Name=x.MethodRef.Name
+ member x.CallingConv=x.MethodRef.CallingConv
+ member x.GenericArity = x.MethodRef.GenericArity
+ member x.FormalArgTypes = x.MethodRef.ArgTypes
+ member x.FormalReturnType = x.MethodRef.ReturnType
+ override x.ToString() = x.MethodRef.ToString() + "(...)"
+
+
+type ILFieldSpec =
+ { FieldRef: ILFieldRef;
+ EnclosingType: ILType }
+ member x.FormalType = x.FieldRef.Type
+ member x.Name = x.FieldRef.Name
+ member x.EnclosingTypeRef = x.FieldRef.EnclosingTypeRef
+ override x.ToString() = x.FieldRef.ToString()
+
+
+// --------------------------------------------------------------------
+// Debug info.
+// --------------------------------------------------------------------
+
+type Guid = byte[]
+
+type ILPlatform =
+ | X86
+ | AMD64
+ | IA64
+
+type ILSourceDocument =
+ { sourceLanguage: Guid option;
+ sourceVendor: Guid option;
+ sourceDocType: Guid option;
+ sourceFile: string; }
+ static member Create(language,vendor,docType,file) =
+ { sourceLanguage=language;
+ sourceVendor=vendor;
+ sourceDocType=docType;
+ sourceFile=file; }
+ member x.Language=x.sourceLanguage
+ member x.Vendor=x.sourceVendor
+ member x.DocumentType=x.sourceDocType
+ member x.File=x.sourceFile
+
+type ILSourceMarker =
+ { sourceDocument: ILSourceDocument;
+ sourceLine: int;
+ sourceColumn: int;
+ sourceEndLine: int;
+ sourceEndColumn: int }
+ static member Create(document, line, column, endLine, endColumn) =
+ { sourceDocument=document;
+ sourceLine=line;
+ sourceColumn=column;
+ sourceEndLine=endLine;
+ sourceEndColumn=endColumn }
+ member x.Document=x.sourceDocument
+ member x.Line=x.sourceLine
+ member x.Column=x.sourceColumn
+ member x.EndLine=x.sourceEndLine
+ member x.EndColumn=x.sourceEndColumn
+ override x.ToString() = sprintf "(%d,%d)-(%d,%d)" x.Line x.Column x.EndLine x.EndColumn
+
+// --------------------------------------------------------------------
+// Custom attributes
+// --------------------------------------------------------------------
+
+type ILAttribElem =
+ | String of string option
+ | Bool of bool
+ | Char of char
+ | SByte of int8
+ | Int16 of int16
+ | Int32 of int32
+ | Int64 of int64
+ | Byte of uint8
+ | UInt16 of uint16
+ | UInt32 of uint32
+ | UInt64 of uint64
+ | Single of single
+ | Double of double
+ | Null
+ | Type of ILType option
+ | TypeRef of ILTypeRef option
+ | Array of ILType * ILAttribElem list
+
+type ILAttributeNamedArg = (string * ILType * bool * ILAttribElem)
+type ILAttribute =
+ { Method: ILMethodSpec;
+#if SILVERLIGHT
+ Arguments: ILAttribElem list * ILAttributeNamedArg list
+#endif
+ Data: byte[] }
+
+[]
+type ILAttributes =
+ | CustomAttrsLazy of Lazy
+ | CustomAttrs of ILAttribute list
+ member x.AsList = match x with | CustomAttrsLazy l -> l.Force() | CustomAttrs l -> l
+
+type ILCodeLabel = int
+
+// --------------------------------------------------------------------
+// Instruction set.
+// --------------------------------------------------------------------
+
+type ILBasicType =
+ | DT_R
+ | DT_I1
+ | DT_U1
+ | DT_I2
+ | DT_U2
+ | DT_I4
+ | DT_U4
+ | DT_I8
+ | DT_U8
+ | DT_R4
+ | DT_R8
+ | DT_I
+ | DT_U
+ | DT_REF
+
+[]
+type ILToken =
+ | ILType of ILType
+ | ILMethod of ILMethodSpec
+ | ILField of ILFieldSpec
+
+[]
+type ILConst =
+ | I4 of int32
+ | I8 of int64
+ | R4 of single
+ | R8 of double
+
+type ILTailcall =
+ | Tailcall
+ | Normalcall
+
+type ILAlignment =
+ | Aligned
+ | Unaligned1
+ | Unaligned2
+ | Unaligned4
+
+type ILVolatility =
+ | Volatile
+ | Nonvolatile
+
+type ILReadonly =
+ | ReadonlyAddress
+ | NormalAddress
+
+type ILVarArgs = ILTypes option
+
+[]
+type ILComparisonInstr =
+ | BI_beq
+ | BI_bge
+ | BI_bge_un
+ | BI_bgt
+ | BI_bgt_un
+ | BI_ble
+ | BI_ble_un
+ | BI_blt
+ | BI_blt_un
+ | BI_bne_un
+ | BI_brfalse
+ | BI_brtrue
+
+
+[]
+type ILInstr =
+ | AI_add
+ | AI_add_ovf
+ | AI_add_ovf_un
+ | AI_and
+ | AI_div
+ | AI_div_un
+ | AI_ceq
+ | AI_cgt
+ | AI_cgt_un
+ | AI_clt
+ | AI_clt_un
+ | AI_conv of ILBasicType
+ | AI_conv_ovf of ILBasicType
+ | AI_conv_ovf_un of ILBasicType
+ | AI_mul
+ | AI_mul_ovf
+ | AI_mul_ovf_un
+ | AI_rem
+ | AI_rem_un
+ | AI_shl
+ | AI_shr
+ | AI_shr_un
+ | AI_sub
+ | AI_sub_ovf
+ | AI_sub_ovf_un
+ | AI_xor
+ | AI_or
+ | AI_neg
+ | AI_not
+ | AI_ldnull
+ | AI_dup
+ | AI_pop
+ | AI_ckfinite
+ | AI_nop
+ | AI_ldc of ILBasicType * ILConst
+ | I_ldarg of uint16
+ | I_ldarga of uint16
+ | I_ldind of ILAlignment * ILVolatility * ILBasicType
+ | I_ldloc of uint16
+ | I_ldloca of uint16
+ | I_starg of uint16
+ | I_stind of ILAlignment * ILVolatility * ILBasicType
+ | I_stloc of uint16
+
+ | I_br of ILCodeLabel
+ | I_jmp of ILMethodSpec
+ | I_brcmp of ILComparisonInstr * ILCodeLabel * ILCodeLabel (* second label is fall-through *)
+ | I_switch of (ILCodeLabel list * ILCodeLabel) (* last label is fallthrough *)
+ | I_ret
+
+ | I_call of ILTailcall * ILMethodSpec * ILVarArgs
+ | I_callvirt of ILTailcall * ILMethodSpec * ILVarArgs
+ | I_callconstraint of ILTailcall * ILType * ILMethodSpec * ILVarArgs
+ | I_calli of ILTailcall * ILCallingSignature * ILVarArgs
+ | I_ldftn of ILMethodSpec
+ | I_newobj of ILMethodSpec * ILVarArgs
+
+ | I_throw
+ | I_endfinally
+ | I_endfilter
+ | I_leave of ILCodeLabel
+ | I_rethrow
+
+ | I_ldsfld of ILVolatility * ILFieldSpec
+ | I_ldfld of ILAlignment * ILVolatility * ILFieldSpec
+ | I_ldsflda of ILFieldSpec
+ | I_ldflda of ILFieldSpec
+ | I_stsfld of ILVolatility * ILFieldSpec
+ | I_stfld of ILAlignment * ILVolatility * ILFieldSpec
+ | I_ldstr of string
+ | I_isinst of ILType
+ | I_castclass of ILType
+ | I_ldtoken of ILToken
+ | I_ldvirtftn of ILMethodSpec
+
+ | I_cpobj of ILType
+ | I_initobj of ILType
+ | I_ldobj of ILAlignment * ILVolatility * ILType
+ | I_stobj of ILAlignment * ILVolatility * ILType
+ | I_box of ILType
+ | I_unbox of ILType
+ | I_unbox_any of ILType
+ | I_sizeof of ILType
+
+ | I_ldelem of ILBasicType
+ | I_stelem of ILBasicType
+ | I_ldelema of ILReadonly * bool * ILArrayShape * ILType
+ | I_ldelem_any of ILArrayShape * ILType
+ | I_stelem_any of ILArrayShape * ILType
+ | I_newarr of ILArrayShape * ILType
+ | I_ldlen
+
+ | I_mkrefany of ILType
+ | I_refanytype
+ | I_refanyval of ILType
+
+ | I_break
+ | I_seqpoint of ILSourceMarker
+
+ | I_arglist
+
+ | I_localloc
+ | I_cpblk of ILAlignment * ILVolatility
+ | I_initblk of ILAlignment * ILVolatility
+
+ (* FOR EXTENSIONS, e.g. MS-ILX *)
+ | EI_ilzero of ILType
+ | EI_ldlen_multi of int32 * int32
+ | I_other of IlxExtensionInstr
+
+and IlxExtensionInstr = Ext_instr of obj
+
+
+// --------------------------------------------------------------------
+// Helpers for the ILX extensions
+// --------------------------------------------------------------------
+
+type internal_instr_extension =
+ { internalInstrExtIs: IlxExtensionInstr -> bool;
+ internalInstrExtDests: IlxExtensionInstr -> ILCodeLabel list;
+ internalInstrExtFallthrough: IlxExtensionInstr -> ILCodeLabel option;
+ internalInstrExtIsTailcall: IlxExtensionInstr -> bool;
+ internalInstrExtRelabel: (ILCodeLabel -> ILCodeLabel) -> IlxExtensionInstr -> IlxExtensionInstr; }
+
+type ILInstrSetExtension<'T> =
+ { instrExtDests: 'T -> ILCodeLabel list;
+ instrExtFallthrough: 'T -> ILCodeLabel option;
+ instrExtIsTailcall: 'T -> bool;
+ instrExtRelabel: (ILCodeLabel -> ILCodeLabel) -> 'T -> 'T; }
+
+let instrExtensions = ref []
+
+let RegisterInstructionSetExtension (ext: ILInstrSetExtension<'T>) =
+ if nonNil !instrExtensions then failwith "RegisterInstructionSetExtension: only one extension currently allowed";
+ let mk (x: 'T) = Ext_instr (box x)
+ let test (Ext_instr _x) = true
+ let dest (Ext_instr x) = (unbox x : 'T)
+ instrExtensions :=
+ { internalInstrExtIs=test;
+ internalInstrExtDests=(fun x -> ext.instrExtDests (dest x));
+ internalInstrExtFallthrough=(fun x -> ext.instrExtFallthrough (dest x));
+ internalInstrExtIsTailcall=(fun x -> ext.instrExtIsTailcall (dest x));
+ internalInstrExtRelabel=(fun f x -> mk (ext.instrExtRelabel f (dest x))); }
+ :: !instrExtensions;
+ mk,test,dest
+
+let rec find_extension s f l =
+ let rec look l1 =
+ match l1 with
+ | [] -> failwith ("extension for "+s+" not found")
+ | (h::t) -> match f h with None -> look t | Some res -> res
+ look l
+
+
+type ILDebugMapping =
+ { LocalIndex: int;
+ LocalName: string; }
+
+type ILBasicBlock =
+ { Label: ILCodeLabel;
+ Instructions: ILInstr[] }
+ member bb.LastInstruction =
+ let n = bb.Instructions.Length
+ if n = 0 then failwith "last_of_bblock: empty bblock";
+ bb.Instructions.[n - 1]
+
+ member x.Fallthrough =
+ match x.LastInstruction with
+ | I_br l | I_brcmp (_,_,l) | I_switch (_,l) -> Some l
+ | I_other e -> find_extension "instr" (fun ext -> if ext.internalInstrExtIs e then Some (ext.internalInstrExtFallthrough e) else None) !instrExtensions
+ | _ -> None
+
+
+type ILCode =
+ | ILBasicBlock of ILBasicBlock
+ | GroupBlock of ILDebugMapping list * ILCode list
+ | RestrictBlock of ILCodeLabel list * ILCode
+ | TryBlock of ILCode * ILExceptionBlock
+
+and ILExceptionBlock =
+ | FaultBlock of ILCode
+ | FinallyBlock of ILCode
+ | FilterCatchBlock of (ILFilterBlock * ILCode) list
+
+and ILFilterBlock =
+ | TypeFilter of ILType
+ | CodeFilter of ILCode
+
+[]
+type ILLocal =
+ { Type: ILType;
+ IsPinned: bool }
+
+type ILLocals = ILList
+let emptyILLocals = (ILList.empty : ILLocals)
+let mkILLocals xs = (match xs with [] -> emptyILLocals | _ -> ILList.ofList xs)
+
+[]
+type ILMethodBody =
+ { IsZeroInit: bool;
+ MaxStack: int32;
+ NoInlining: bool;
+ Locals: ILLocals;
+ Code: ILCode;
+ SourceMarker: ILSourceMarker option }
+
+[]
+type ILMemberAccess =
+ | Assembly
+ | CompilerControlled
+ | FamilyAndAssembly
+ | FamilyOrAssembly
+ | Family
+ | Private
+ | Public
+
+[]
+[]
+type ILFieldInit =
+ | String of string
+ | Bool of bool
+ | Char of uint16
+ | Int8 of int8
+ | Int16 of int16
+ | Int32 of int32
+ | Int64 of int64
+ | UInt8 of uint8
+ | UInt16 of uint16
+ | UInt32 of uint32
+ | UInt64 of uint64
+ | Single of single
+ | Double of double
+ | Null
+
+// --------------------------------------------------------------------
+// Native Types, for marshalling to the native C interface.
+// These are taken directly from the ILASM syntax, and don't really
+// correspond yet to the ECMA Spec (Partition II, 7.4).
+// --------------------------------------------------------------------
+
+[]
+[]
+type ILNativeType =
+ | Empty
+ | Custom of Guid * string * string * byte[] (* guid,nativeTypeName,custMarshallerName,cookieString *)
+ | FixedSysString of int32
+ | FixedArray of int32
+ | Currency
+ | LPSTR
+ | LPWSTR
+ | LPTSTR
+ | ByValStr
+ | TBSTR
+ | LPSTRUCT
+ | Struct
+ | Void
+ | Bool
+ | Int8
+ | Int16
+ | Int32
+ | Int64
+ | Single
+ | Double
+ | Byte
+ | UInt16
+ | UInt32
+ | UInt64
+ | Array of ILNativeType option * (int32 * int32 option) option (* optional idx of parameter giving size plus optional additive i.e. num elems *)
+ | Int
+ | UInt
+ | Method
+ | AsAny
+ | BSTR
+ | IUnknown
+ | IDispatch
+ | Interface
+ | Error
+ | SafeArray of ILNativeVariant * string option
+ | ANSIBSTR
+ | VariantBool
+
+
+and ILNativeVariant =
+ | Empty
+ | Null
+ | Variant
+ | Currency
+ | Decimal
+ | Date
+ | BSTR
+ | LPSTR
+ | LPWSTR
+ | IUnknown
+ | IDispatch
+ | SafeArray
+ | Error
+ | HRESULT
+ | CArray
+ | UserDefined
+ | Record
+ | FileTime
+ | Blob
+ | Stream
+ | Storage
+ | StreamedObject
+ | StoredObject
+ | BlobObject
+ | CF
+ | CLSID
+ | Void
+ | Bool
+ | Int8
+ | Int16
+ | Int32
+ | Int64
+ | Single
+ | Double
+ | UInt8
+ | UInt16
+ | UInt32
+ | UInt64
+ | PTR
+ | Array of ILNativeVariant
+ | Vector of ILNativeVariant
+ | Byref of ILNativeVariant
+ | Int
+ | UInt
+
+type ILSecurityAction =
+ | Request
+ | Demand
+ | Assert
+ | Deny
+ | PermitOnly
+ | LinkCheck
+ | InheritCheck
+ | ReqMin
+ | ReqOpt
+ | ReqRefuse
+ | PreJitGrant
+ | PreJitDeny
+ | NonCasDemand
+ | NonCasLinkDemand
+ | NonCasInheritance
+ | LinkDemandChoice
+ | InheritanceDemandChoice
+ | DemandChoice
+
+type ILPermission =
+ | PermissionSet of ILSecurityAction * byte[]
+
+type ILPermissions =
+ | SecurityDecls of ILPermission list
+ | SecurityDeclsLazy of Lazy
+ member x.AsList = match x with SecurityDecls m -> m | SecurityDeclsLazy m -> m.Force()
+
+[]
+type PInvokeCharBestFit =
+ | UseAssembly
+ | Enabled
+ | Disabled
+
+[]
+type PInvokeThrowOnUnmappableChar =
+ | UseAssembly
+ | Enabled
+ | Disabled
+
+[]
+type PInvokeCallingConvention =
+ | None
+ | Cdecl
+ | Stdcall
+ | Thiscall
+ | Fastcall
+ | WinApi
+
+[]
+type PInvokeCharEncoding =
+ | None
+ | Ansi
+ | Unicode
+ | Auto
+
+[]
+type PInvokeMethod =
+ { Where: ILModuleRef;
+ Name: string;
+ CallingConv: PInvokeCallingConvention;
+ CharEncoding: PInvokeCharEncoding;
+ NoMangle: bool;
+ LastError: bool;
+ ThrowOnUnmappableChar: PInvokeThrowOnUnmappableChar;
+ CharBestFit: PInvokeCharBestFit }
+
+type ILParameter =
+ { Name: string option;
+ Type: ILType;
+ Default: ILFieldInit option;
+ Marshal: ILNativeType option;
+ IsIn: bool;
+ IsOut: bool;
+ IsOptional: bool;
+ CustomAttrs: ILAttributes }
+
+type ILParameters = ILList
+let emptyILParameters = (ILList.empty : ILParameters)
+
+let mkILParametersRaw x = (match x with [] -> emptyILParameters | _ -> ILList.ofList x)
+
+type ILReturn =
+ { Marshal: ILNativeType option;
+ Type: ILType;
+ CustomAttrs: ILAttributes }
+
+type ILOverridesSpec =
+ | OverridesSpec of ILMethodRef * ILType
+ member x.MethodRef = let (OverridesSpec(mr,_ty)) = x in mr
+ member x.EnclosingType = let (OverridesSpec(_mr,ty)) = x in ty
+
+type ILMethodVirtualInfo =
+ { IsFinal: bool
+ IsNewSlot: bool
+ IsCheckAccessOnOverride: bool
+ IsAbstract: bool }
+
+type MethodKind =
+ | Static
+ | Cctor
+ | Ctor
+ | NonVirtual
+ | Virtual of ILMethodVirtualInfo
+
+[]
+type MethodBody =
+ | IL of ILMethodBody
+ | PInvoke of PInvokeMethod (* platform invoke to native *)
+ | Abstract
+ | Native
+
+type ILLazyMethodBody =
+ | ILLazyMethodBody of Lazy
+ member x.Contents = let (ILLazyMethodBody mb) = x in mb.Force()
+
+[]
+type MethodCodeKind =
+ | IL
+ | Native
+ | Runtime
+
+let mkMethBodyAux mb = ILLazyMethodBody (Lazy.CreateFromValue mb)
+let mkMethBodyLazyAux mb = ILLazyMethodBody mb
+
+let typesOfILParamsRaw (ps:ILParameters) : ILTypes = ps |> ILList.map (fun p -> p.Type)
+let typesOfILParamsList (ps:ILParameter list) = ps |> List.map (fun p -> p.Type)
+
+[]
+type ILGenericVariance =
+ | NonVariant
+ | CoVariant
+ | ContraVariant
+
+type ILGenericParameterDef =
+ { Name: string;
+ Constraints: ILTypes;
+ Variance: ILGenericVariance;
+ HasReferenceTypeConstraint: bool;
+ CustomAttrs : ILAttributes;
+ HasNotNullableValueTypeConstraint: bool;
+ HasDefaultConstructorConstraint: bool; }
+
+ override x.ToString() = x.Name
+
+type ILGenericParameterDefs = ILGenericParameterDef list
+
+[]
+type ILMethodDef =
+ { Name: string;
+ mdKind: MethodKind;
+ CallingConv: ILCallingConv;
+ Parameters: ILParameters;
+ Return: ILReturn;
+ Access: ILMemberAccess;
+ mdBody: ILLazyMethodBody;
+ mdCodeKind: MethodCodeKind;
+ IsInternalCall: bool;
+ IsManaged: bool;
+ IsForwardRef: bool;
+ SecurityDecls: ILPermissions;
+ HasSecurity: bool;
+ IsEntryPoint:bool;
+ IsReqSecObj: bool;
+ IsHideBySig: bool;
+ IsSpecialName: bool;
+ IsUnmanagedExport: bool;
+ IsSynchronized: bool;
+ IsPreserveSig: bool;
+ IsMustRun: bool;
+ IsNoInline: bool;
+ GenericParams: ILGenericParameterDefs;
+ CustomAttrs: ILAttributes; }
+ member x.ParameterTypes = typesOfILParamsRaw x.Parameters
+ // Whidbey feature: SafeHandle finalizer must be run
+ member md.Code =
+ match md.mdBody.Contents with
+ | MethodBody.IL il-> Some il.Code
+ | _ -> None
+ member x.IsIL = match x.mdBody.Contents with | MethodBody.IL _ -> true | _ -> false
+ member x.Locals = match x.mdBody.Contents with | MethodBody.IL il -> il.Locals | _ -> emptyILLocals
+
+ member x.MethodBody = match x.mdBody.Contents with MethodBody.IL il -> il | _ -> failwith "not IL"
+
+ member x.SourceMarker = x.MethodBody.SourceMarker
+ member x.MaxStack = x.MethodBody.MaxStack
+ member x.IsZeroInit = x.MethodBody.IsZeroInit
+
+ member x.IsClassInitializer = match x.mdKind with | MethodKind.Cctor -> true | _ -> false
+ member x.IsConstructor = match x.mdKind with | MethodKind.Ctor -> true | _ -> false
+ member x.IsStatic = match x.mdKind with | MethodKind.Static -> true | _ -> false
+ member x.IsNonVirtualInstance = match x.mdKind with | MethodKind.NonVirtual -> true | _ -> false
+ member x.IsVirtual = match x.mdKind with | MethodKind.Virtual _ -> true | _ -> false
+
+ member x.IsFinal = match x.mdKind with | MethodKind.Virtual v -> v.IsFinal | _ -> invalidOp "not virtual"
+ member x.IsNewSlot = match x.mdKind with | MethodKind.Virtual v -> v.IsNewSlot | _ -> invalidOp "not virtual"
+ member x.IsCheckAccessOnOverride= match x.mdKind with | MethodKind.Virtual v -> v.IsCheckAccessOnOverride | _ -> invalidOp "not virtual"
+ member x.IsAbstract = match x.mdKind with | MethodKind.Virtual v -> v.IsAbstract | _ -> invalidOp "not virtual"
+
+ member md.CallingSignature = mkILCallSigRaw (md.CallingConv,md.ParameterTypes,md.Return.Type)
+
+
+/// Index table by name and arity.
+type MethodDefMap = Map
+
+[]
+type ILMethodDefs =
+ | Methods of Lazy
+ interface IEnumerable with
+ member x.GetEnumerator() = ((x :> IEnumerable).GetEnumerator() :> IEnumerator)
+ interface IEnumerable with
+ member x.GetEnumerator() =
+ let (Methods(lms)) = x
+ let ms,_ = lms.Force()
+ (ms :> IEnumerable).GetEnumerator()
+ member x.AsList = Seq.toList x
+
+ member x.FindByName nm =
+ let (Methods lpmap) = x
+ let t = snd (Lazy.force lpmap)
+ Map.tryFindMulti nm t
+
+ member x.FindByNameAndArity (nm,arity) =
+ x.FindByName nm |> List.filter (fun x -> x.Parameters.Length = arity)
+
+
+[]
+type ILEventDef =
+ { Type: ILType option;
+ Name: string;
+ IsRTSpecialName: bool;
+ IsSpecialName: bool;
+ AddMethod: ILMethodRef;
+ RemoveMethod: ILMethodRef;
+ FireMethod: ILMethodRef option;
+ OtherMethods: ILMethodRef list;
+ CustomAttrs: ILAttributes; }
+
+(* Index table by name. *)
+[]
+type ILEventDefs =
+ | Events of LazyOrderedMultiMap
+ member x.AsList = let (Events t) = x in t.Entries()
+ member x.LookupByName s = let (Events t) = x in t.[s]
+
+[]
+type ILPropertyDef =
+ { Name: string;
+ IsRTSpecialName: bool;
+ IsSpecialName: bool;
+ SetMethod: ILMethodRef option;
+ GetMethod: ILMethodRef option;
+ CallingConv: ILThisConvention;
+ Type: ILType;
+ Init: ILFieldInit option;
+ Args: ILTypes;
+ CustomAttrs: ILAttributes; }
+
+// Index table by name.
+[]
+type ILPropertyDefs =
+ | Properties of LazyOrderedMultiMap
+ member x.AsList = let (Properties t) = x in t.Entries()
+ member x.LookupByName s = let (Properties t) = x in t.[s]
+
+[]
+type ILFieldDef =
+ { Name: string;
+ Type: ILType;
+ IsStatic: bool;
+ Access: ILMemberAccess;
+ Data: byte[] option;
+ LiteralValue: ILFieldInit option;
+ Offset: int32 option;
+ IsSpecialName: bool;
+ Marshal: ILNativeType option;
+ NotSerialized: bool;
+ IsLiteral: bool ;
+ IsInitOnly: bool;
+ CustomAttrs: ILAttributes; }
+
+
+// Index table by name. Keep a canonical list to make sure field order is not disturbed for binary manipulation.
+type ILFieldDefs =
+ | Fields of LazyOrderedMultiMap
+ member x.AsList = let (Fields t) = x in t.Entries()
+ member x.LookupByName s = let (Fields t) = x in t.[s]
+
+type ILMethodImplDef =
+ { Overrides: ILOverridesSpec;
+ OverrideBy: ILMethodSpec }
+
+// Index table by name and arity.
+type ILMethodImplDefs =
+ | MethodImpls of Lazy
+ member x.AsList = let (MethodImpls ltab) = x in Map.foldBack (fun _x y r -> y@r) (ltab.Force()) []
+
+and MethodImplsMap = Map
+
+[]
+type ILTypeDefLayout =
+ | Auto
+ | Sequential of ILTypeDefLayoutInfo
+ | Explicit of ILTypeDefLayoutInfo (* REVIEW: add field info here *)
+
+and ILTypeDefLayoutInfo =
+ { Size: int32 option;
+ Pack: uint16 option }
+
+[]
+type ILTypeInit =
+ | BeforeField
+ | OnAny
+
+[]
+type ILDefaultPInvokeEncoding =
+ | Ansi
+ | Auto
+ | Unicode
+
+type ILTypeDefAccess =
+ | Public
+ | Private
+ | Nested of ILMemberAccess
+
+[]
+type ILTypeDefKind =
+ | Class
+ | ValueType
+ | Interface
+ | Enum
+ | Delegate
+ | Other of IlxExtensionTypeKind
+
+and IlxExtensionTypeKind = Ext_type_def_kind of obj
+
+type internal_type_def_kind_extension =
+ { internalTypeDefKindExtIs: IlxExtensionTypeKind -> bool; }
+
+
+[]
+type ILTypeDef =
+ { tdKind: ILTypeDefKind;
+ Name: string;
+ GenericParams: ILGenericParameterDefs; (* class is generic *)
+ Access: ILTypeDefAccess;
+ IsAbstract: bool;
+ IsSealed: bool;
+ IsSerializable: bool;
+ IsComInterop: bool; (* Class or interface generated for COM interop *)
+ Layout: ILTypeDefLayout;
+ IsSpecialName: bool;
+ Encoding: ILDefaultPInvokeEncoding;
+ NestedTypes: ILTypeDefs;
+ Implements: ILTypes;
+ Extends: ILType option;
+ Methods: ILMethodDefs;
+ SecurityDecls: ILPermissions;
+ HasSecurity: bool;
+ Fields: ILFieldDefs;
+ MethodImpls: ILMethodImplDefs;
+ InitSemantics: ILTypeInit;
+ Events: ILEventDefs;
+ Properties: ILPropertyDefs;
+ CustomAttrs: ILAttributes; }
+ member x.IsClass = (match x.tdKind with ILTypeDefKind.Class -> true | _ -> false)
+ member x.IsInterface = (match x.tdKind with ILTypeDefKind.Interface -> true | _ -> false)
+ member x.IsEnum = (match x.tdKind with ILTypeDefKind.Enum -> true | _ -> false)
+ member x.IsDelegate = (match x.tdKind with ILTypeDefKind.Delegate -> true | _ -> false)
+
+ member tdef.IsStructOrEnum =
+ match tdef.tdKind with
+ | ILTypeDefKind.ValueType | ILTypeDefKind.Enum -> true
+ | _ -> false
+
+
+and ILTypeDefs =
+ | TypeDefTable of Lazy<(string list * string * ILAttributes * Lazy) array> * Lazy
+ interface IEnumerable with
+ member x.GetEnumerator() = ((x :> IEnumerable).GetEnumerator() :> IEnumerator)
+ interface IEnumerable with
+ member x.GetEnumerator() =
+ let (TypeDefTable (larr,_tab)) = x
+ let tds = seq { for (_,_,_,td) in larr.Force() -> td.Force() }
+ tds.GetEnumerator()
+ member x.AsList = Seq.toList x
+
+ member x.AsListOfLazyTypeDefs = let (TypeDefTable (larr,_tab)) = x in larr.Force() |> Array.toList
+
+ member x.FindByName nm =
+ let (TypeDefTable (_,m)) = x
+ let ns,n = splitILTypeName nm
+ m.Force().[ns].[n].Force()
+
+
+/// keyed first on namespace then on type name. The namespace is often a unique key for a given type map.
+and ILTypeDefsMap =
+ Map>>
+
+type ILNestedExportedType =
+ { Name: string;
+ Access: ILMemberAccess;
+ Nested: ILNestedExportedTypes;
+ CustomAttrs: ILAttributes }
+
+and ILNestedExportedTypes =
+ | ILNestedExportedTypes of Lazy>
+ member x.AsList = let (ILNestedExportedTypes ltab) = x in Map.foldBack (fun _x y r -> y::r) (ltab.Force()) []
+
+and []
+ ILExportedTypeOrForwarder =
+ { ScopeRef: ILScopeRef;
+ Name: string;
+ IsForwarder: bool;
+ Access: ILTypeDefAccess;
+ Nested: ILNestedExportedTypes;
+ CustomAttrs: ILAttributes }
+
+and ILExportedTypesAndForwarders =
+ | ILExportedTypesAndForwarders of Lazy>
+ member x.AsList = let (ILExportedTypesAndForwarders ltab) = x in Map.foldBack (fun _x y r -> y::r) (ltab.Force()) []
+
+[]
+type ILResourceAccess =
+ | Public
+ | Private
+
+[]
+type ILResourceLocation =
+ | Local of (unit -> byte[])
+ | File of ILModuleRef * int32
+ | Assembly of ILAssemblyRef
+
+type ILResource =
+ { Name: string;
+ Location: ILResourceLocation;
+ Access: ILResourceAccess;
+ CustomAttrs: ILAttributes }
+
+type ILResources =
+ | ILResources of Lazy
+ member x.AsList = let (ILResources ltab) = x in (ltab.Force())
+
+// --------------------------------------------------------------------
+// One module in the "current" assembly
+// --------------------------------------------------------------------
+
+[]
+type ILAssemblyLongevity =
+ | Unspecified
+ | Library
+ | PlatformAppDomain
+ | PlatformProcess
+ | PlatformSystem
+
+
+type ILAssemblyManifest =
+ { Name: string;
+ AuxModuleHashAlgorithm: int32;
+ SecurityDecls: ILPermissions;
+ PublicKey: byte[] option;
+ Version: ILVersionInfo option;
+ Locale: Locale option;
+ CustomAttrs: ILAttributes;
+
+ AssemblyLongevity: ILAssemblyLongevity;
+ DisableJitOptimizations: bool;
+ JitTracking: bool;
+ Retargetable: bool;
+
+ /// Records the types impemented by other modules.
+ ExportedTypes: ILExportedTypesAndForwarders;
+ /// Records whether the entrypoint resides in another module.
+ EntrypointElsewhere: ILModuleRef option;
+
+ }
+
+type ILModuleDef =
+ { Manifest: ILAssemblyManifest option;
+ CustomAttrs: ILAttributes;
+ Name: string;
+ TypeDefs: ILTypeDefs;
+ SubsystemVersion : int * int
+ UseHighEntropyVA : bool
+ (* Random bits of relatively uninteresting data *)
+ SubSystemFlags: int32;
+ IsDLL: bool;
+ IsILOnly: bool;
+ Platform: ILPlatform option;
+ StackReserveSize: int32 option;
+ Is32Bit: bool;
+ Is32BitPreferred: bool;
+ Is64Bit: bool;
+ VirtualAlignment: int32;
+ PhysicalAlignment: int32;
+ ImageBase: int32;
+ MetadataVersion: string;
+ Resources: ILResources;
+ NativeResources: list>; (* e.g. win32 resources *)
+ }
+ member x.ManifestOfAssembly =
+ match x.Manifest with
+ | Some m -> m
+ | None -> failwith "no manifest. It is possible you are using an auxiliary module of an assembly in a context where the main module of an assembly is expected. Typically the main module of an assembly must be specified first within a list of the modules in an assembly."
+
+ member m.HasManifest =
+ match m.Manifest with None -> false | _ -> true
+
+
+// --------------------------------------------------------------------
+// Add fields and types to tables, with decent error messages
+// when clashes occur...
+// --------------------------------------------------------------------
+
+
+
+let mkILEmptyGenericParams = ([]: ILGenericParameterDefs)
+let emptyILGenericArgsList = ([ ]: ILType list)
+
+
+type ILType with
+ member x.TypeSpec =
+ match x with
+ | ILType.Boxed tr | ILType.Value tr -> tr
+ | _ -> invalidOp "not a nominal type"
+ member x.Boxity =
+ match x with
+ | ILType.Boxed _ -> AsObject
+ | ILType.Value _ -> AsValue
+ | _ -> invalidOp "not a nominal type"
+ member x.TypeRef =
+ match x with
+ | ILType.Boxed tspec | ILType.Value tspec -> tspec.TypeRef
+ | _ -> invalidOp "not a nominal type"
+ member x.IsNominal =
+ match x with
+ | ILType.Boxed _ | ILType.Value _ -> true
+ | _ -> false
+ member x.GenericArgs =
+ match x with
+ | ILType.Boxed tspec | ILType.Value tspec -> tspec.GenericArgs
+ | _ -> emptyILGenericArgs
+ member x.IsTyvar =
+ match x with
+ | ILType.TypeVar _ -> true | _ -> false
+
+
+
+// --------------------------------------------------------------------
+// Make ILTypeRefs etc.
+// --------------------------------------------------------------------
+
+let mkILNestedTyRef (scope,l,nm) = ILTypeRef.Create(scope,l,nm)
+let mkILTyRef (scope,nm) = mkILNestedTyRef (scope,[],nm)
+
+type ILGenericArgsList = ILType list
+
+let mkILTySpecRaw (tref,inst) = ILTypeSpec.Create(tref, inst)
+let mkILTySpec (tref,inst) = mkILTySpecRaw (tref, mkILGenericArgs inst)
+
+let mkILNonGenericTySpec tref = mkILTySpec (tref,[])
+
+let mkILTyRefInTyRef (tref:ILTypeRef,nm) =
+ mkILNestedTyRef (tref.Scope,tref.Enclosing@[tref.Name],nm)
+
+let mkILTy boxed tspec =
+ match boxed with AsObject -> mkILBoxedType tspec | _ -> ILType.Value tspec
+
+let mkILNamedTy vc tref tinst = mkILTy vc (ILTypeSpec.Create(tref, mkILGenericArgs tinst))
+let mkILNamedTyRaw vc tref tinst = mkILTy vc (ILTypeSpec.Create(tref, tinst))
+
+let mkILValueTy tref tinst = mkILNamedTy AsValue tref tinst
+let mkILBoxedTy tref tinst = mkILNamedTy AsObject tref tinst
+let mkILBoxedTyRaw tref tinst = mkILNamedTyRaw AsObject tref tinst
+
+let mkILNonGenericValueTy tref = mkILNamedTy AsValue tref []
+let mkILNonGenericBoxedTy tref = mkILNamedTy AsObject tref []
+
+
+type ILTypeDefKindExtension<'T> =
+ | TypeDefKindExtension
+
+let type_def_kind_extensions = ref []
+
+let RegisterTypeDefKindExtension (TypeDefKindExtension : ILTypeDefKindExtension<'T>) =
+ if nonNil !type_def_kind_extensions then failwith "define_type_extension: only one extension currently allowed";
+ let mk (x:'T) = Ext_type_def_kind (box x)
+ let test (Ext_type_def_kind _x) = true
+ let dest (Ext_type_def_kind x) = (unbox x: 'T)
+ type_def_kind_extensions :=
+ { internalTypeDefKindExtIs=test;}
+ :: !type_def_kind_extensions;
+ mk,test,dest
+
+// --------------------------------------------------------------------
+// Making assembly, module and file references
+// --------------------------------------------------------------------
+
+let mkSimpleAssRef n =
+ ILAssemblyRef.Create(n, None, None, false, None, None)
+
+let mkSimpleModRef n =
+ ILModuleRef.Create(n, true, None)
+
+let module_name_of_scoref = function
+ | ILScopeRef.Module(mref) -> mref.Name
+ | _ -> failwith "module_name_of_scoref"
+
+// --------------------------------------------------------------------
+// The toplevel class of a module is called ""
+//
+// REVIEW: the following comments from the ECMA Spec (Parition II, Section 9.8)
+//
+// "For an ordinary type, if the metadata merges two definitions
+// of the same type, it simply discards one definition on the
+// assumption they are equivalent and that any anomaly will be
+// discovered when the type is used. For the special class that
+// holds global members, however, members are unioned across all
+// modules at merge time. If the same name appears to be defined
+// for cross-module use in multiple modules then there is an
+// error. In detail:
+// - If no member of the same kind (field or method), name, and
+// signature exists, then add this member to the output class.
+// - If there are duplicates and no more than one has an
+// accessibility other than compilercontrolled, then add them
+// all in the output class.
+// - If there are duplicates and two or more have an accessibility
+// other than compilercontrolled an error has occurred."
+// --------------------------------------------------------------------
+
+let typeNameForGlobalFunctions = ""
+
+let mkILTypeForGlobalFunctions scoref = mkILBoxedType (mkILNonGenericTySpec (ILTypeRef.Create(scoref,[],typeNameForGlobalFunctions)))
+
+let isTypeNameForGlobalFunctions d = (d = typeNameForGlobalFunctions)
+
+
+let mkILMethRefRaw (tref,callconv,nm,gparams,args,rty) =
+ { mrefParent=tref;
+ mrefCallconv=callconv;
+ mrefGenericArity=gparams;
+ mrefName=nm;
+ mrefArgs=args;
+ mrefReturn=rty}
+
+let mkILMethRef (tref,callconv,nm,gparams,args,rty) = mkILMethRefRaw (tref,callconv,nm,gparams,mkILTypes args,rty)
+
+let mkILMethSpecForMethRefInTyRaw (mref,typ,minst) =
+ { mspecMethodRef=mref;
+ mspecEnclosingType=typ;
+ mspecMethodInst=minst }
+
+let mkILMethSpecForMethRefInTy (mref,typ,minst) = mkILMethSpecForMethRefInTyRaw (mref,typ,mkILGenericArgs minst)
+
+let mkILMethSpec (mref, vc, tinst, minst) = mkILMethSpecForMethRefInTy (mref,mkILNamedTy vc mref.EnclosingTypeRef tinst, minst)
+
+let mk_mspec_in_tref (tref,vc,cc,nm,args,rty,tinst,minst) =
+ mkILMethSpec (mkILMethRef ( tref,cc,nm,List.length minst,args,rty),vc,tinst,minst)
+
+let mkILMethSpecInTyRaw (typ:ILType, cc, nm, args, rty, minst:ILGenericArgs) =
+ mkILMethSpecForMethRefInTyRaw (mkILMethRefRaw (typ.TypeRef,cc,nm,minst.Length,args,rty),typ,minst)
+
+let mkILMethSpecInTy (typ:ILType, cc, nm, args, rty, minst) =
+ mkILMethSpecForMethRefInTy (mkILMethRef (typ.TypeRef,cc,nm,List.length minst,args,rty),typ,minst)
+
+let mkILNonGenericMethSpecInTy (typ,cc,nm,args,rty) =
+ mkILMethSpecInTy (typ,cc,nm,args,rty,[])
+
+let mkILInstanceMethSpecInTy (typ:ILType,nm,args,rty,minst) =
+ mkILMethSpecInTy (typ, ILCallingConv.Instance, nm, args, rty, minst)
+
+let mkILNonGenericInstanceMethSpecInTy (typ:ILType,nm,args,rty) =
+ mkILInstanceMethSpecInTy (typ,nm,args,rty,[])
+
+let mkILStaticMethSpecInTy (typ,nm,args,rty,minst) =
+ mkILMethSpecInTy (typ,ILCallingConv.Static,nm,args,rty,minst)
+
+let mkILNonGenericStaticMethSpecInTy (typ,nm,args,rty) =
+ mkILStaticMethSpecInTy (typ,nm,args,rty,[])
+
+let mkILCtorMethSpec (tref,args,cinst) =
+ mk_mspec_in_tref(tref,AsObject,ILCallingConv.Instance,".ctor",args,ILType.Void,cinst, [])
+
+let mkILCtorMethSpecForTy (ty,args) =
+ mkILMethSpecInTy(ty,ILCallingConv.Instance,".ctor",args,ILType.Void, [])
+
+let mkILNonGenericCtorMethSpec (tref,args) =
+ mkILCtorMethSpec (tref,args,[])
+
+// --------------------------------------------------------------------
+// Make references to fields
+// --------------------------------------------------------------------
+
+let mkILFieldRef(tref,nm,ty) = { EnclosingTypeRef=tref; Name=nm; Type=ty}
+
+let mkILFieldSpec (tref,ty) = { FieldRef= tref; EnclosingType=ty }
+
+let mkILFieldSpecInTy (typ:ILType,nm,fty) =
+ mkILFieldSpec (mkILFieldRef (typ.TypeRef,nm,fty), typ)
+
+let emptyILCustomAttrs = CustomAttrs []
+
+let mkILCustomAttrs l = match l with [] -> emptyILCustomAttrs | _ -> CustomAttrs l
+let mkILComputedCustomAttrs l = CustomAttrsLazy (Lazy.Create l)
+
+let andTailness x y =
+ match x with Tailcall when y -> Tailcall | _ -> Normalcall
+
+// --------------------------------------------------------------------
+// ILAttributes on code blocks (esp. debug info)
+// --------------------------------------------------------------------
+
+let formatCodeLabel (x:int) = "L"+string x
+
+module CodeLabels =
+ let insert (e:ILCodeLabel) l = Zset.add e l
+ let remove e l = Zset.remove e l
+ let fold f s acc = Zset.fold f s acc
+ let add s x = Zset.add s x
+ let addList s xs = Zset.addList s xs
+ let diff l1 l2 = Zset.diff l1 l2
+ let union l1 l2 = Zset.union l1 l2
+ let inter (l1:Zset) l2 = Zset.inter l1 l2
+ let subset (l1:Zset) l2 = Zset.subset l1 l2
+ let empty = Zset.empty int_order
+ let isNonEmpty s = not (Zset.isEmpty s)
+ let ofList l = Zset.addList l empty
+ let toList l = Zset.elements l
+
+// --------------------------------------------------------------------
+// Basic operations on code.
+// --------------------------------------------------------------------
+
+let destinationsOfInstr i =
+ match i with
+ | I_leave l | I_br l -> [l]
+ | I_brcmp (_,l1,l2) -> [l1; l2]
+ | I_switch (ls,l) -> CodeLabels.toList (CodeLabels.ofList (l::ls))
+ | I_endfinally | I_endfilter | I_ret | I_throw | I_rethrow
+ | I_call (Tailcall,_,_)| I_callvirt (Tailcall,_,_)| I_callconstraint (Tailcall,_,_,_)
+ | I_calli (Tailcall,_,_) -> []
+ | I_other e -> find_extension "instr" (fun ext -> if ext.internalInstrExtIs e then Some (ext.internalInstrExtDests e) else None) !instrExtensions
+ | _ -> []
+
+let destinationsOfBasicBlock (bblock:ILBasicBlock) = destinationsOfInstr bblock.LastInstruction
+
+let instrIsTailcall i =
+ match i with
+ | I_call (Tailcall,_,_)| I_callvirt (Tailcall,_,_) | I_callconstraint (Tailcall,_,_,_) | I_calli (Tailcall,_,_) -> true
+ | I_other e -> find_extension "instr" (fun ext -> if ext.internalInstrExtIs e then Some (ext.internalInstrExtIsTailcall e) else None) !instrExtensions
+ | _ -> false
+
+let instrIsBasicBlockEnd i =
+ instrIsTailcall i ||
+ match i with
+ | I_leave _ | I_br _ | I_brcmp _ | I_switch _ | I_endfinally
+ | I_endfilter | I_ret | I_throw | I_rethrow -> true
+ | I_other e -> find_extension "instr" (fun ext -> if ext.internalInstrExtIs e then Some (nonNil (ext.internalInstrExtDests e)) else None) !instrExtensions
+ | _ -> false
+
+let checks = false
+let _ = if checks then dprintn "Warning - Il.checks is on"
+
+let rec accEntriesOfCode c acc =
+ match c with
+ | ILBasicBlock bb -> CodeLabels.add bb.Label acc
+ | GroupBlock (_,l) -> List.foldBack accEntriesOfCode l acc
+ | RestrictBlock (ls,c) -> CodeLabels.union acc (CodeLabels.diff (entriesOfCodeAsSet c) (CodeLabels.ofList ls))
+ | TryBlock (l,_r) -> accEntriesOfCode l acc
+
+and entriesOfCodeAsSet c =
+ accEntriesOfCode c CodeLabels.empty
+
+let rec accExitsOfCode c acc =
+ let basicOutsideLabels =
+ match c with
+ | ILBasicBlock bblock -> CodeLabels.addList (destinationsOfBasicBlock bblock) acc
+ | GroupBlock (_,l) -> List.foldBack accExitsOfCode l acc
+ | RestrictBlock (ls,c) -> CodeLabels.union acc (CodeLabels.diff (exitsOfCodeAsSet c) (CodeLabels.ofList ls))
+ | TryBlock (l,_r) -> accExitsOfCode l acc
+ CodeLabels.diff basicOutsideLabels (entriesOfCodeAsSet c)
+
+and exitsOfCodeAsSet c = accExitsOfCode c CodeLabels.empty
+
+let entriesOfCode c = CodeLabels.toList (entriesOfCodeAsSet c)
+let exitsOfCode c = CodeLabels.toList (exitsOfCodeAsSet c)
+
+/// Finds all labels defined within this code block, seeing through restrictions.
+/// This assumes that labels are unique within the code blocks, even if hidden behind restrictions.
+///
+// Note: Repeats in the list indicate this invariant is broken.
+let rec accLabelsOfCode acc c =
+ match c with
+ | ILBasicBlock bb -> bb.Label::acc
+ | GroupBlock (_,l) -> List.fold accLabelsOfCode acc l
+ | RestrictBlock (_ls,c) -> accLabelsOfCode acc c
+ | TryBlock (l,r) -> let acc = accLabelsOfCode acc l
+ let acc = accLabelsOfSEH acc r
+ acc
+and accLabelsOfSEH acc = function
+ | FaultBlock code -> accLabelsOfCode acc code
+ | FinallyBlock code -> accLabelsOfCode acc code
+ | FilterCatchBlock fcodes -> List.fold accLabelsOfFilterCode acc fcodes
+
+and accLabelsOfFilterCode acc = function
+ | TypeFilter _,code -> accLabelsOfCode acc code
+ | CodeFilter test,code -> let accA = accLabelsOfCode acc code
+ let accB = accLabelsOfCode accA test
+ accB
+
+let labelsOfCode code = accLabelsOfCode [] code
+
+(*
+
+From the ECMA spec:
+
+There are only two ways to enter a try block from outside its lexical body:
+ - Branching to or falling into the try block’s first instruction. The branch may be made using a 37
+conditional branch, an unconditional branch, or a leave instruction. 38
+ - Using a leave instruction from that try’s catch block. In this case, correct CIL code may 39
+branch to any instruction within the try block, not just its first instruction, so long as that 40
+branch target is not protected by yet another try, nested withing the first
+*)
+
+
+let checkILCode code =
+ if checks then
+ match code with
+ | RestrictBlock (ls,c') ->
+ (*
+ if not (CodeLabels.subset ls (entriesOfCode c')) then begin
+ dprintn ("* warning: Restricting labels that are not declared in block, e.g. "+ (List.head (CodeLabels.diff ls (entriesOfCode c'))));
+ dprintn ("* warning: Labels in block are: "+ (String.concat "," (entriesOfCode c')));
+ dprintn ("* warning: Labels being restricted are: "+ (String.concat "," ls));
+ end;
+ *)
+ let cls = (CodeLabels.inter (CodeLabels.ofList ls) (exitsOfCodeAsSet c'))
+ if (CodeLabels.isNonEmpty cls) then
+ dprintn ("* warning: restricting unsatisfied exits from a block, e.g. "+ formatCodeLabel (List.head (CodeLabels.toList cls)));
+ | TryBlock (_l,r) ->
+ begin match r with
+ | FaultBlock b | FinallyBlock b ->
+ if (CodeLabels.isNonEmpty (CodeLabels.inter (exitsOfCodeAsSet b) (entriesOfCodeAsSet b))) then
+ dprintn "* warning: exits from fault or finally blocks must leave the block";
+ let n = List.length (entriesOfCode b)
+ if not (n = 1) then dprintn "* warning: zero or more than one entry to a fault or finally block";
+ | FilterCatchBlock r ->
+ List.iter
+ (fun (flt,z) ->
+ let m = List.length (entriesOfCode z)
+ if not (m = 1) then dprintn "* warning: zero or more than one entry to a catch block";
+ match flt with
+ | CodeFilter y ->
+ if (CodeLabels.isNonEmpty (exitsOfCodeAsSet y)) then dprintn "* warning: exits exist from filter block - you must always exit using endfinally";
+ let n = List.length (entriesOfCode y)
+ if not (n = 1) then dprintn "* warning: zero or more than one entry to a filter block";
+ | TypeFilter _ty -> ())
+ r;
+ end;
+ | ILBasicBlock bb ->
+ if (Array.length bb.Instructions) = 0 then dprintn ("* warning: basic block " + formatCodeLabel bb.Label + " is empty")
+ elif not (instrIsBasicBlockEnd (bb.Instructions.[Array.length bb.Instructions - 1])) then failwith "* warning: bblock does not end in an appropriate instruction";
+
+ | _ -> ()
+ match code with
+ | RestrictBlock (labs,c) when (isNil labs) -> c
+ | GroupBlock ([],[c]) -> c
+ | _ -> code
+
+
+let mkBasicBlock bb = ILBasicBlock bb
+let mkScopeBlock (a,b) = GroupBlock (a,[checkILCode b])
+let mkGroupBlockFromCode (internals,codes) = RestrictBlock (internals,checkILCode (GroupBlock ([],codes)))
+let mkGroupBlock (internals,blocks) = mkGroupBlockFromCode (internals,List.map checkILCode blocks)
+
+let mkRestrictBlock lab c = RestrictBlock (CodeLabels.toList (CodeLabels.remove lab (entriesOfCodeAsSet c)),c)
+let mkTryFinallyBlock (tryblock, enterFinallyLab, finallyBlock) =
+ TryBlock(checkILCode tryblock, FinallyBlock (checkILCode (mkRestrictBlock enterFinallyLab (checkILCode finallyBlock))))
+
+let mkTryFaultBlock (tryblock, entarFaultLab, faultBlock) =
+ TryBlock(checkILCode tryblock, FaultBlock (checkILCode (mkRestrictBlock entarFaultLab (checkILCode faultBlock))))
+
+let mkTryMultiFilterCatchBlock (tryblock, clauses) =
+ TryBlock
+ (checkILCode tryblock,
+ FilterCatchBlock
+ (clauses |> List.map (fun (flt, (enter_catch_lab, catchblock)) ->
+ let fltcode =
+ match flt with
+ | Choice1Of2 (enter_filter_lab, filterblock) ->
+ CodeFilter (checkILCode (mkRestrictBlock enter_filter_lab (checkILCode filterblock)))
+ | Choice2Of2 ty ->
+ TypeFilter ty
+ fltcode,
+ checkILCode (mkRestrictBlock enter_catch_lab (checkILCode catchblock)))))
+
+
+let new_generator () =
+ let i = ref 0
+ fun _n ->
+ incr i; !i
+
+// ++GLOBAL MUTABLE STATE
+let codeLabelGenerator = (new_generator () : unit -> ILCodeLabel)
+let generateCodeLabel x = codeLabelGenerator x
+
+let uniqueEntryOfCode c =
+ match entriesOfCode c with
+ | [] -> failwith ("uniqueEntryOfCode: no entries to code")
+ | [inlab] -> inlab
+ | labs -> failwith ("uniqueEntryOfCode: need one entry to code, found: "+String.concat "," (List.map formatCodeLabel labs))
+
+let uniqueExitOfCode c =
+ match exitsOfCode c with
+ | [] -> failwith ("uniqueExitOfCode: no exits from code")
+ | [outlab] -> outlab
+ | labs -> failwith ("uniqueExitOfCode: need one exit from code, found: "+String.concat "," (List.map formatCodeLabel labs))
+
+let mkNonBranchingInstrs inplab instrs =
+ checkILCode (mkBasicBlock {Label=inplab; Instructions= Array.ofList instrs})
+
+let mkNonBranchingInstrsThen inplab instrs instr =
+ if nonNil instrs && instrIsBasicBlockEnd (List.last instrs) then failwith "mkNonBranchingInstrsThen: bblock already terminates with a control flow instruction";
+ mkNonBranchingInstrs inplab (instrs @ [ instr ])
+
+let mkNonBranchingInstrsThenRet inplab instrs =
+ mkNonBranchingInstrsThen inplab instrs I_ret
+
+let mkNonBranchingInstrsThenBr inplab instrs lab =
+ mkNonBranchingInstrsThen inplab instrs (I_br lab)
+
+let nonBranchingInstrsToCode instrs =
+ let inplab = generateCodeLabel ()
+ if nonNil instrs && instrIsBasicBlockEnd (List.last instrs) then
+ mkNonBranchingInstrs inplab instrs
+ else
+ mkNonBranchingInstrsThenRet inplab instrs
+
+let joinCode code1 code2 =
+ if not (uniqueExitOfCode code1 = uniqueEntryOfCode code2) then
+ dprintn "* warning: joinCode: exit of code1 is not entry of code 2";
+ checkILCode
+ (RestrictBlock ([uniqueExitOfCode code1],
+ (checkILCode (mkGroupBlock ([],[ code1; code2 ])))))
+
+// --------------------------------------------------------------------
+// Security declarations (2)
+// --------------------------------------------------------------------
+
+let emptyILSecurityDecls = SecurityDecls []
+let mkILSecurityDecls l = match l with [] -> emptyILSecurityDecls | _ -> SecurityDecls l
+let mkILLazySecurityDecls l = SecurityDeclsLazy l
+
+
+// --------------------------------------------------------------------
+// ILX stuff
+// --------------------------------------------------------------------
+
+let mkILTyvarTy tv = ILType.TypeVar tv
+
+
+let mkILSimpleTypar nm =
+ { Name=nm;
+ Constraints=emptyILTypes;
+ Variance=NonVariant;
+ HasReferenceTypeConstraint=false;
+ HasNotNullableValueTypeConstraint=false;
+ HasDefaultConstructorConstraint=false;
+ CustomAttrs = emptyILCustomAttrs }
+
+let gparam_of_gactual (_ga:ILType) = mkILSimpleTypar "T"
+
+let mkILFormalTypars (x: ILGenericArgsList) = List.map gparam_of_gactual x
+let mkILFormalTyparsRaw (x: ILGenericArgs) = ILList.toList (ILList.map gparam_of_gactual x)
+
+let mkILFormalGenericArgsRaw (gparams:ILGenericParameterDefs) =
+ ILList.ofList (List.mapi (fun n _gf -> mkILTyvarTy (uint16 n)) gparams)
+
+let mkILFormalGenericArgs (gparams:ILGenericParameterDefs) =
+ List.mapi (fun n _gf -> mkILTyvarTy (uint16 n)) gparams
+
+let mkILFormalBoxedTy tref gparams = mkILBoxedTy tref (mkILFormalGenericArgs gparams)
+
+// --------------------------------------------------------------------
+// Operations on class etc. defs.
+// --------------------------------------------------------------------
+
+let mkRefForNestedILTypeDef scope (enc:ILTypeDef list,td:ILTypeDef) =
+ mkILNestedTyRef(scope, (enc |> List.map (fun etd -> etd.Name)), td.Name)
+
+// --------------------------------------------------------------------
+// Operations on type tables.
+// --------------------------------------------------------------------
+
+let getName (ltd: Lazy) =
+ let td = Lazy.force ltd
+ let ns,n = splitILTypeName td.Name
+ (ns,n,td.CustomAttrs,ltd)
+
+let addILTypeDefToTable (ns,n,_cas,ltd) tab =
+ let prev =
+ (match Map.tryFind ns tab with
+ | None -> Dictionary<_,_>(1, HashIdentity.Structural)
+ | Some prev -> prev)
+ if prev.ContainsKey n then
+ let msg = sprintf "not unique type %s" (unsplitTypeName (ns,n));
+ System.Diagnostics.Debug.Assert(false,msg)
+ failwith msg
+ prev.[n] <- ltd;
+ Map.add ns prev tab
+
+let addLazyTypeDefToTable ltd larr = lazyMap (fun arr -> Array.ofList (getName ltd :: Array.toList arr)) larr
+
+let buildTable larr = lazyMap (fun arr -> Array.foldBack addILTypeDefToTable arr Map.empty) larr
+let buildTypes larr = TypeDefTable (larr, buildTable larr)
+
+(* this is not performance critical *)
+let addILTypeDef td (TypeDefTable (larr,_ltab)) = buildTypes (addLazyTypeDefToTable (notlazy td) larr)
+let mkILTypeDefs l = buildTypes (List.map (notlazy >> getName) l |> Array.ofList |> notlazy )
+let mkILTypeDefsLazy llist = buildTypes (lazyMap Array.ofList llist)
+let emptyILTypeDefs = mkILTypeDefs []
+
+// --------------------------------------------------------------------
+// Operations on method tables.
+//
+// REVIEW: this data structure looks substandard
+// --------------------------------------------------------------------
+
+let addILMethodToTable (y: ILMethodDef) tab =
+ let key = y.Name
+ let prev = Map.tryFindMulti key tab
+ Map.add key (y::prev) tab
+
+let addILMethod_to_pmap y (mds,tab) = y::mds,addILMethodToTable y tab
+let addILMethod y (Methods lpmap) = Methods (lazyMap (addILMethod_to_pmap y) lpmap)
+
+let mkILMethods l = Methods (notlazy (List.foldBack addILMethod_to_pmap l ([],Map.empty)))
+let mkILMethodsLazy l = Methods (lazy (List.foldBack addILMethod_to_pmap (Lazy.force l) ([],Map.empty)))
+let emptyILMethods = mkILMethods []
+
+let filterILMethodDefs f (Methods lpmap) =
+ Methods (lazyMap (fun (fs,_) ->
+ let l = List.filter f fs
+ (l, List.foldBack addILMethodToTable l Map.empty)) lpmap)
+
+
+// --------------------------------------------------------------------
+// Operations and defaults for modules, assemblies etc.
+// --------------------------------------------------------------------
+
+let defaultSubSystem = 3 (* this is what comes out of ILDASM on 30/04/2001 *)
+let defaultPhysAlignment = 512 (* this is what comes out of ILDASM on 30/04/2001 *)
+let defaultVirtAlignment = 0x2000 (* this is what comes out of ILDASM on 30/04/2001 *)
+let defaultImageBase = 0x034f0000 (* this is what comes out of ILDASM on 30/04/2001 *)
+
+// --------------------------------------------------------------------
+// Array types
+// --------------------------------------------------------------------
+
+let mkILArrTy (ty, shape) = ILType.Array(shape,ty)
+let mkILArr1DTy ty = mkILArrTy (ty,ILArrayShape.SingleDimensional)
+let isILArrTy ty = match ty with ILType.Array _ -> true| _ -> false
+let destILArrTy ty = match ty with ILType.Array(shape,ty) -> (shape,ty) | _ -> failwith "destILArrTy"
+
+// --------------------------------------------------------------------
+// Sigs of special types built-in
+// --------------------------------------------------------------------
+
+let tname_Object = "System.Object"
+let tname_String = "System.String"
+let tname_StringBuilder = "System.Text.StringBuilder"
+let tname_AsyncCallback = "System.AsyncCallback"
+let tname_IAsyncResult = "System.IAsyncResult"
+let tname_IComparable = "System.IComparable"
+let tname_Exception = "System.Exception"
+let tname_Type = "System.Type"
+let tname_Missing = "System.Reflection.Missing"
+let tname_Activator = "System.Activator"
+let tname_SerializationInfo = "System.Runtime.Serialization.SerializationInfo"
+let tname_StreamingContext = "System.Runtime.Serialization.StreamingContext"
+let tname_SecurityPermissionAttribute = "System.Security.Permissions.SecurityPermissionAttribute"
+let tname_Delegate = "System.Delegate"
+let tname_ValueType = "System.ValueType"
+let tname_TypedReference = "System.TypedReference"
+let tname_Enum = "System.Enum"
+let tname_MulticastDelegate = "System.MulticastDelegate"
+let tname_Array = "System.Array"
+
+let tname_Int64 = "System.Int64"
+let tname_UInt64 = "System.UInt64"
+let tname_Int32 = "System.Int32"
+let tname_UInt32 = "System.UInt32"
+let tname_Int16 = "System.Int16"
+let tname_UInt16 = "System.UInt16"
+let tname_SByte = "System.SByte"
+let tname_Byte = "System.Byte"
+let tname_Single = "System.Single"
+let tname_Double = "System.Double"
+let tname_Bool = "System.Boolean"
+let tname_Char = "System.Char"
+let tname_IntPtr = "System.IntPtr"
+let tname_UIntPtr = "System.UIntPtr"
+let tname_RuntimeArgumentHandle = "System.RuntimeArgumentHandle"
+let tname_RuntimeTypeHandle = "System.RuntimeTypeHandle"
+let tname_RuntimeMethodHandle = "System.RuntimeMethodHandle"
+let tname_RuntimeFieldHandle = "System.RuntimeFieldHandle"
+
+[]
+type ILGlobals =
+ { mscorlibScopeRef: ILScopeRef;
+ mscorlibAssemblyName: string;
+ noDebugData: bool;
+ generateDebugBrowsableData: bool;
+ tref_Object: ILTypeRef
+ ; tspec_Object: ILTypeSpec
+ ; typ_Object: ILType
+ ; tref_String: ILTypeRef
+ ; typ_String: ILType
+ ; typ_StringBuilder: ILType
+ ; typ_AsyncCallback: ILType
+ ; typ_IAsyncResult: ILType
+ ; typ_IComparable: ILType
+ ; tref_Type: ILTypeRef
+ ; typ_Type: ILType
+ ; typ_Missing: ILType
+ ; typ_Activator: ILType
+ ; typ_Delegate: ILType
+ ; typ_ValueType: ILType
+ ; typ_Enum: ILType
+ ; tspec_TypedReference: ILTypeSpec
+ ; typ_TypedReference: ILType
+ ; typ_MulticastDelegate: ILType
+ ; typ_Array: ILType
+ ; tspec_Int64: ILTypeSpec
+ ; tspec_UInt64: ILTypeSpec
+ ; tspec_Int32: ILTypeSpec
+ ; tspec_UInt32: ILTypeSpec
+ ; tspec_Int16: ILTypeSpec
+ ; tspec_UInt16: ILTypeSpec
+ ; tspec_SByte: ILTypeSpec
+ ; tspec_Byte: ILTypeSpec
+ ; tspec_Single: ILTypeSpec
+ ; tspec_Double: ILTypeSpec
+ ; tspec_IntPtr: ILTypeSpec
+ ; tspec_UIntPtr: ILTypeSpec
+ ; tspec_Char: ILTypeSpec
+ ; tspec_Bool: ILTypeSpec
+ ; typ_int8: ILType
+ ; typ_int16: ILType
+ ; typ_int32: ILType
+ ; typ_int64: ILType
+ ; typ_uint8: ILType
+ ; typ_uint16: ILType
+ ; typ_uint32: ILType
+ ; typ_uint64: ILType
+ ; typ_float32: ILType
+ ; typ_float64: ILType
+ ; typ_bool: ILType
+ ; typ_char: ILType
+ ; typ_IntPtr: ILType
+ ; typ_UIntPtr: ILType
+ ; typ_RuntimeArgumentHandle: ILType
+ ; typ_RuntimeTypeHandle: ILType
+ ; typ_RuntimeMethodHandle: ILType
+ ; typ_RuntimeFieldHandle: ILType
+ ; typ_Byte: ILType
+ ; typ_Int16: ILType
+ ; typ_Int32: ILType
+ ; typ_Int64: ILType
+ ; typ_SByte: ILType
+ ; typ_UInt16: ILType
+ ; typ_UInt32: ILType
+ ; typ_UInt64: ILType
+ ; typ_Single: ILType
+ ; typ_Double: ILType
+ ; typ_Bool: ILType
+ ; typ_Char: ILType
+ ; typ_SerializationInfo: ILType
+ ; typ_StreamingContext: ILType
+ ; tref_SecurityPermissionAttribute: ILTypeRef
+ ; tspec_Exception: ILTypeSpec
+ ; typ_Exception: ILType
+ ; mutable generatedAttribsCache: ILAttribute list
+ ; mutable debuggerBrowsableNeverAttributeCache : ILAttribute option
+ ; mutable debuggerTypeProxyAttributeCache : ILAttribute option }
+ override x.ToString() = ""
+
+let mkNormalCall mspec = I_call (Normalcall, mspec, None)
+let mkNormalCallvirt mspec = I_callvirt (Normalcall, mspec, None)
+let mkNormalCallconstraint (ty,mspec) = I_callconstraint (Normalcall, ty, mspec, None)
+let mkNormalNewobj mspec = I_newobj (mspec, None)
+
+/// Comment on common object cache sizes:
+/// mkLdArg - I can’t imagine any IL method we generate needing more than this
+/// mkLdLoc - I tried 256, and there were LdLoc allocations left, so I upped it o 512. I didn’t check again.
+/// mkStLoc - it should be the same as LdLoc (where there’s a LdLoc there must be a StLoc)
+/// mkLdcInt32 - just a guess
+
+let ldargs = [| for i in 0 .. 128 -> I_ldarg (uint16 i) |]
+let mkLdarg i = if 0us < i && i < uint16 ldargs.Length then ldargs.[int i] else I_ldarg i
+let mkLdarg0 = mkLdarg 0us
+
+let ldlocs = [| for i in 0 .. 512 -> I_ldloc (uint16 i) |]
+let mkLdloc i = if 0us < i && i < uint16 ldlocs.Length then ldlocs.[int i] else I_ldloc i
+
+let stlocs = [| for i in 0 .. 512 -> I_stloc (uint16 i) |]
+let mkStloc i = if 0us < i && i < uint16 stlocs.Length then stlocs.[int i] else I_stloc i
+
+let ldi32s = [| for i in 0 .. 256 -> AI_ldc (DT_I4,ILConst.I4 i) |]
+let mkLdcInt32 i = if 0 < i && i < ldi32s.Length then ldi32s.[i] else AI_ldc (DT_I4,ILConst.I4 i)
+
+let tname_CompilerGeneratedAttribute = "System.Runtime.CompilerServices.CompilerGeneratedAttribute"
+let tname_DebuggableAttribute = "System.Diagnostics.DebuggableAttribute"
+
+
+let mkILGlobals mscorlibScopeRef mscorlibAssemblyNameOpt (noDebugData,generateDebugBrowsableData) =
+ let mscorlibAssemblyName =
+ match mscorlibAssemblyNameOpt with
+ | Some name -> name
+ | None -> (match mscorlibScopeRef with
+ | ILScopeRef.Assembly assref -> assref.Name
+ | _ -> failwith "mkILGlobals: mscorlib ILScopeRef is not an assembly ref")
+ let tref_Object = mkILTyRef (mscorlibScopeRef,tname_Object)
+ let tspec_Object = mkILNonGenericTySpec tref_Object
+ let typ_Object = mkILBoxedType tspec_Object
+
+ let tref_String = mkILTyRef (mscorlibScopeRef,tname_String)
+ let tspec_String = mkILNonGenericTySpec tref_String
+ let typ_String = mkILBoxedType tspec_String
+
+ let tref_StringBuilder = mkILTyRef (mscorlibScopeRef,tname_StringBuilder)
+ let tspec_StringBuilder = mkILNonGenericTySpec tref_StringBuilder
+ let typ_StringBuilder = mkILBoxedType tspec_StringBuilder
+
+ let tref_AsyncCallback = mkILTyRef (mscorlibScopeRef,tname_AsyncCallback)
+ let tspec_AsyncCallback = mkILNonGenericTySpec tref_AsyncCallback
+ let typ_AsyncCallback = mkILBoxedType tspec_AsyncCallback
+
+ let tref_IAsyncResult = mkILTyRef (mscorlibScopeRef,tname_IAsyncResult)
+ let tspec_IAsyncResult = mkILNonGenericTySpec tref_IAsyncResult
+ let typ_IAsyncResult = mkILBoxedType tspec_IAsyncResult
+
+ let tref_IComparable = mkILTyRef (mscorlibScopeRef,tname_IComparable)
+ let tspec_IComparable = mkILNonGenericTySpec tref_IComparable
+ let typ_IComparable = mkILBoxedType tspec_IComparable
+
+ let tref_Exception = mkILTyRef (mscorlibScopeRef,tname_Exception)
+ let tspec_Exception = mkILNonGenericTySpec tref_Exception
+ let typ_Exception = mkILBoxedType tspec_Exception
+
+ let tref_Type = mkILTyRef(mscorlibScopeRef,tname_Type)
+ let tspec_Type = mkILNonGenericTySpec tref_Type
+ let typ_Type = mkILBoxedType tspec_Type
+
+ let tref_Missing = mkILTyRef(mscorlibScopeRef,tname_Missing)
+ let tspec_Missing = mkILNonGenericTySpec tref_Missing
+ let typ_Missing = mkILBoxedType tspec_Missing
+
+
+ let tref_Activator = mkILTyRef(mscorlibScopeRef,tname_Activator)
+ let tspec_Activator = mkILNonGenericTySpec tref_Activator
+ let typ_Activator = mkILBoxedType tspec_Activator
+
+ let tref_SerializationInfo = mkILTyRef(mscorlibScopeRef,tname_SerializationInfo)
+ let tspec_SerializationInfo = mkILNonGenericTySpec tref_SerializationInfo
+ let typ_SerializationInfo = mkILBoxedType tspec_SerializationInfo
+
+ let tref_StreamingContext = mkILTyRef(mscorlibScopeRef,tname_StreamingContext)
+ let tspec_StreamingContext = mkILNonGenericTySpec tref_StreamingContext
+ let typ_StreamingContext = ILType.Value tspec_StreamingContext
+
+ let tref_SecurityPermissionAttribute = mkILTyRef(mscorlibScopeRef,tname_SecurityPermissionAttribute)
+
+ let tref_Delegate = mkILTyRef(mscorlibScopeRef,tname_Delegate)
+ let tspec_Delegate = mkILNonGenericTySpec tref_Delegate
+ let typ_Delegate = mkILBoxedType tspec_Delegate
+
+ let tref_ValueType = mkILTyRef (mscorlibScopeRef,tname_ValueType)
+ let tspec_ValueType = mkILNonGenericTySpec tref_ValueType
+ let typ_ValueType = mkILBoxedType tspec_ValueType
+
+ let tref_TypedReference = mkILTyRef (mscorlibScopeRef,tname_TypedReference)
+ let tspec_TypedReference = mkILNonGenericTySpec tref_TypedReference
+ let typ_TypedReference = ILType.Value tspec_TypedReference
+
+ let tref_Enum = mkILTyRef (mscorlibScopeRef,tname_Enum)
+ let tspec_Enum = mkILNonGenericTySpec tref_Enum
+ let typ_Enum = mkILBoxedType tspec_Enum
+
+ let tref_MulticastDelegate = mkILTyRef (mscorlibScopeRef,tname_MulticastDelegate)
+ let tspec_MulticastDelegate = mkILNonGenericTySpec tref_MulticastDelegate
+ let typ_MulticastDelegate = mkILBoxedType tspec_MulticastDelegate
+
+ let typ_Array = mkILBoxedType (mkILNonGenericTySpec (mkILTyRef (mscorlibScopeRef,tname_Array)))
+
+ let tref_Int64 = mkILTyRef (mscorlibScopeRef,tname_Int64)
+ let tref_UInt64 = mkILTyRef (mscorlibScopeRef,tname_UInt64)
+ let tref_Int32 = mkILTyRef (mscorlibScopeRef,tname_Int32)
+ let tref_UInt32 = mkILTyRef (mscorlibScopeRef,tname_UInt32)
+ let tref_Int16 = mkILTyRef (mscorlibScopeRef,tname_Int16)
+ let tref_UInt16 = mkILTyRef (mscorlibScopeRef,tname_UInt16)
+ let tref_SByte = mkILTyRef (mscorlibScopeRef,tname_SByte)
+ let tref_Byte = mkILTyRef (mscorlibScopeRef,tname_Byte)
+ let tref_Single = mkILTyRef (mscorlibScopeRef,tname_Single)
+ let tref_Double = mkILTyRef (mscorlibScopeRef,tname_Double)
+ let tref_Bool = mkILTyRef (mscorlibScopeRef,tname_Bool)
+ let tref_Char = mkILTyRef (mscorlibScopeRef,tname_Char)
+ let tref_IntPtr = mkILTyRef (mscorlibScopeRef,tname_IntPtr)
+ let tref_UIntPtr = mkILTyRef (mscorlibScopeRef,tname_UIntPtr)
+
+ let tspec_Int64 = mkILNonGenericTySpec tref_Int64
+ let tspec_UInt64 = mkILNonGenericTySpec tref_UInt64
+ let tspec_Int32 = mkILNonGenericTySpec tref_Int32
+ let tspec_UInt32 = mkILNonGenericTySpec tref_UInt32
+ let tspec_Int16 = mkILNonGenericTySpec tref_Int16
+ let tspec_UInt16 = mkILNonGenericTySpec tref_UInt16
+ let tspec_SByte = mkILNonGenericTySpec tref_SByte
+ let tspec_Byte = mkILNonGenericTySpec tref_Byte
+ let tspec_Single = mkILNonGenericTySpec tref_Single
+ let tspec_Double = mkILNonGenericTySpec tref_Double
+ let tspec_IntPtr = mkILNonGenericTySpec tref_IntPtr
+ let tspec_UIntPtr = mkILNonGenericTySpec tref_UIntPtr
+ let tspec_Char = mkILNonGenericTySpec tref_Char
+ let tspec_Bool = mkILNonGenericTySpec tref_Bool
+
+ let typ_int8 = ILType.Value tspec_SByte
+ let typ_int16 = ILType.Value tspec_Int16
+ let typ_int32 = ILType.Value tspec_Int32
+ let typ_int64 = ILType.Value tspec_Int64
+ let typ_uint8 = ILType.Value tspec_Byte
+ let typ_uint16 = ILType.Value tspec_UInt16
+ let typ_uint32 = ILType.Value tspec_UInt32
+ let typ_uint64 = ILType.Value tspec_UInt64
+ let typ_float32 = ILType.Value tspec_Single
+ let typ_float64 = ILType.Value tspec_Double
+ let typ_bool = ILType.Value tspec_Bool
+ let typ_char = ILType.Value tspec_Char
+ let typ_IntPtr = ILType.Value tspec_IntPtr
+ let typ_UIntPtr = ILType.Value tspec_UIntPtr
+
+ let typ_SByte = ILType.Value tspec_SByte
+ let typ_Int16 = ILType.Value tspec_Int16
+ let typ_Int32 = ILType.Value tspec_Int32
+ let typ_Int64 = ILType.Value tspec_Int64
+ let typ_Byte = ILType.Value tspec_Byte
+ let typ_UInt16 = ILType.Value tspec_UInt16
+ let typ_UInt32 = ILType.Value tspec_UInt32
+ let typ_UInt64 = ILType.Value tspec_UInt64
+ let typ_Single = ILType.Value tspec_Single
+ let typ_Double = ILType.Value tspec_Double
+ let typ_Bool = ILType.Value tspec_Bool
+ let typ_Char = ILType.Value tspec_Char
+
+ let tref_RuntimeArgumentHandle = mkILTyRef (mscorlibScopeRef,tname_RuntimeArgumentHandle)
+ let tspec_RuntimeArgumentHandle = mkILNonGenericTySpec tref_RuntimeArgumentHandle
+ let typ_RuntimeArgumentHandle = ILType.Value tspec_RuntimeArgumentHandle
+ let tref_RuntimeTypeHandle = mkILTyRef (mscorlibScopeRef,tname_RuntimeTypeHandle)
+ let tspec_RuntimeTypeHandle = mkILNonGenericTySpec tref_RuntimeTypeHandle
+ let typ_RuntimeTypeHandle = ILType.Value tspec_RuntimeTypeHandle
+ let tref_RuntimeMethodHandle = mkILTyRef (mscorlibScopeRef,tname_RuntimeMethodHandle)
+ let tspec_RuntimeMethodHandle = mkILNonGenericTySpec tref_RuntimeMethodHandle
+ let typ_RuntimeMethodHandle = ILType.Value tspec_RuntimeMethodHandle
+ let tref_RuntimeFieldHandle = mkILTyRef (mscorlibScopeRef,tname_RuntimeFieldHandle)
+ let tspec_RuntimeFieldHandle = mkILNonGenericTySpec tref_RuntimeFieldHandle
+ let typ_RuntimeFieldHandle = ILType.Value tspec_RuntimeFieldHandle
+ { mscorlibScopeRef =mscorlibScopeRef
+ ; mscorlibAssemblyName =mscorlibAssemblyName
+ ; noDebugData =noDebugData
+ ; generateDebugBrowsableData =generateDebugBrowsableData
+ ; tref_Object =tref_Object
+ ; tspec_Object =tspec_Object
+ ; typ_Object =typ_Object
+ ; tref_String =tref_String
+ ; typ_String =typ_String
+ ; typ_StringBuilder =typ_StringBuilder
+ ; typ_AsyncCallback =typ_AsyncCallback
+ ; typ_IAsyncResult =typ_IAsyncResult
+ ; typ_IComparable =typ_IComparable
+ ; typ_Activator =typ_Activator
+ ; tref_Type =tref_Type
+ ; typ_Type =typ_Type
+ ; typ_Missing =typ_Missing
+ ; typ_Delegate =typ_Delegate
+ ; typ_ValueType =typ_ValueType
+ ; typ_Enum =typ_Enum
+ ; tspec_TypedReference =tspec_TypedReference
+ ; typ_TypedReference =typ_TypedReference
+ ; typ_MulticastDelegate =typ_MulticastDelegate
+ ; typ_Array =typ_Array
+ ; tspec_Int64 =tspec_Int64
+ ; tspec_UInt64 =tspec_UInt64
+ ; tspec_Int32 =tspec_Int32
+ ; tspec_UInt32 =tspec_UInt32
+ ; tspec_Int16 =tspec_Int16
+ ; tspec_UInt16 =tspec_UInt16
+ ; tspec_SByte =tspec_SByte
+ ; tspec_Byte =tspec_Byte
+ ; tspec_Single =tspec_Single
+ ; tspec_Double =tspec_Double
+ ; tspec_IntPtr =tspec_IntPtr
+ ; tspec_UIntPtr =tspec_UIntPtr
+ ; tspec_Char =tspec_Char
+ ; tspec_Bool =tspec_Bool
+ ; typ_int8 =typ_int8
+ ; typ_int16 =typ_int16
+ ; typ_int32 =typ_int32
+ ; typ_int64 =typ_int64
+ ; typ_uint8 =typ_uint8
+ ; typ_uint16 =typ_uint16
+ ; typ_uint32 =typ_uint32
+ ; typ_uint64 =typ_uint64
+ ; typ_float32 =typ_float32
+ ; typ_float64 =typ_float64
+ ; typ_bool =typ_bool
+ ; typ_char =typ_char
+ ; typ_IntPtr =typ_IntPtr
+ ; typ_UIntPtr =typ_UIntPtr
+ ; typ_RuntimeArgumentHandle =typ_RuntimeArgumentHandle
+ ; typ_RuntimeTypeHandle =typ_RuntimeTypeHandle
+ ; typ_RuntimeMethodHandle =typ_RuntimeMethodHandle
+ ; typ_RuntimeFieldHandle =typ_RuntimeFieldHandle
+
+ ; typ_Byte =typ_Byte
+ ; typ_Int16 =typ_Int16
+ ; typ_Int32 =typ_Int32
+ ; typ_Int64 =typ_Int64
+ ; typ_SByte =typ_SByte
+ ; typ_UInt16 =typ_UInt16
+ ; typ_UInt32 =typ_UInt32
+ ; typ_UInt64 =typ_UInt64
+ ; typ_Single =typ_Single
+ ; typ_Double =typ_Double
+ ; typ_Bool =typ_Bool
+ ; typ_Char =typ_Char
+ ; typ_SerializationInfo=typ_SerializationInfo
+ ; typ_StreamingContext=typ_StreamingContext
+ ; tref_SecurityPermissionAttribute=tref_SecurityPermissionAttribute
+ ; tspec_Exception =tspec_Exception
+ ; typ_Exception =typ_Exception
+ ; generatedAttribsCache = []
+ ; debuggerBrowsableNeverAttributeCache = None
+ ; debuggerTypeProxyAttributeCache = None }
+
+
+(* NOTE: ecma_ prefix refers to the standard "mscorlib" *)
+let ecmaPublicKey = PublicKeyToken (Bytes.ofInt32Array [|0xde; 0xad; 0xbe; 0xef; 0xca; 0xfe; 0xfa; 0xce |])
+
+let ecmaMscorlibScopeRef = ILScopeRef.Assembly (ILAssemblyRef.Create("mscorlib", None, Some ecmaPublicKey, true, None, None))
+
+let ecmaILGlobals = mkILGlobals ecmaMscorlibScopeRef None (false, true)
+
+let mkInitializeArrayMethSpec ilg =
+ mkILNonGenericStaticMethSpecInTy(mkILNonGenericBoxedTy(mkILTyRef(ilg.mscorlibScopeRef,"System.Runtime.CompilerServices.RuntimeHelpers")),"InitializeArray", [ilg.typ_Array;ilg.typ_RuntimeFieldHandle], ILType.Void)
+(* e.ilg. [mkMscorlibExnNewobj "System.InvalidCastException"] *)
+let mkMscorlibExnNewobj ilg eclass =
+ mkNormalNewobj (mkILNonGenericCtorMethSpec (mkILTyRef(ilg.mscorlibScopeRef,eclass),[]))
+
+let typ_is_boxed = function ILType.Boxed _ -> true | _ -> false
+let typ_is_value = function ILType.Value _ -> true | _ -> false
+
+
+let tspec_is_mscorlib ilg (tspec:ILTypeSpec) n =
+ let tref = tspec.TypeRef
+ let scoref = tref.Scope
+ (tref.Name = n) &&
+ match scoref with
+ | ILScopeRef.Assembly n -> n.Name = ilg.mscorlibAssemblyName
+ | ILScopeRef.Module _ -> false
+ | ILScopeRef.Local -> true
+
+let typ_is_boxed_mscorlib_typ ilg (ty:ILType) n =
+ typ_is_boxed ty && tspec_is_mscorlib ilg ty.TypeSpec n
+
+let typ_is_value_mscorlib_typ ilg (ty:ILType) n =
+ typ_is_value ty && tspec_is_mscorlib ilg ty.TypeSpec n
+
+let isILObjectTy ilg ty = typ_is_boxed_mscorlib_typ ilg ty tname_Object
+let isILStringTy ilg ty = typ_is_boxed_mscorlib_typ ilg ty tname_String
+let typ_is_AsyncCallback ilg ty = typ_is_boxed_mscorlib_typ ilg ty tname_AsyncCallback
+let isILTypedReferenceTy ilg ty = typ_is_value_mscorlib_typ ilg ty tname_TypedReference
+let typ_is_IAsyncResult ilg ty = typ_is_boxed_mscorlib_typ ilg ty tname_IAsyncResult
+let typ_is_IComparable ilg ty = typ_is_boxed_mscorlib_typ ilg ty tname_IComparable
+let isILSByteTy ilg ty = typ_is_value_mscorlib_typ ilg ty tname_SByte
+let isILByteTy ilg ty = typ_is_value_mscorlib_typ ilg ty tname_Byte
+let isILInt16Ty ilg ty = typ_is_value_mscorlib_typ ilg ty tname_Int16
+let isILUInt16Ty ilg ty = typ_is_value_mscorlib_typ ilg ty tname_UInt16
+let isILInt32Ty ilg ty = typ_is_value_mscorlib_typ ilg ty tname_Int32
+let isILUInt32Ty ilg ty = typ_is_value_mscorlib_typ ilg ty tname_UInt32
+let isILInt64Ty ilg ty = typ_is_value_mscorlib_typ ilg ty tname_Int64
+let isILUInt64Ty ilg ty = typ_is_value_mscorlib_typ ilg ty tname_UInt64
+let isILIntPtrTy ilg ty = typ_is_value_mscorlib_typ ilg ty tname_IntPtr
+let isILUIntPtrTy ilg ty = typ_is_value_mscorlib_typ ilg ty tname_UIntPtr
+let isILBoolTy ilg ty = typ_is_value_mscorlib_typ ilg ty tname_Bool
+let isILCharTy ilg ty = typ_is_value_mscorlib_typ ilg ty tname_Char
+let isILSingleTy ilg ty = typ_is_value_mscorlib_typ ilg ty tname_Single
+let isILDoubleTy ilg ty = typ_is_value_mscorlib_typ ilg ty tname_Double
+
+// --------------------------------------------------------------------
+// Rescoping
+// --------------------------------------------------------------------
+
+
+let qrescope_scoref scoref scoref_old =
+ match scoref,scoref_old with
+ | _,ILScopeRef.Local -> Some scoref
+ | ILScopeRef.Local,_ -> None
+ | _,ILScopeRef.Module _ -> Some scoref
+ | ILScopeRef.Module _,_ -> None
+ | _ -> None
+let qrescope_tref scoref (x:ILTypeRef) =
+ match qrescope_scoref scoref x.Scope with
+ | None -> None
+ | Some s -> Some (ILTypeRef.Create(s,x.Enclosing,x.Name))
+
+let rescopeILScopeRef x y = match qrescope_scoref x y with Some x -> x | None -> y
+let rescopeILTypeRef x y = match qrescope_tref x y with Some x -> x | None -> y
+
+// ORIGINAL IMPLEMENTATION (too many allocations
+// { tspecTypeRef=rescopeILTypeRef scoref tref;
+// tspecInst=rescopeILTypes scoref tinst }
+let rec rescopeILTypeSpecQuick scoref (tspec:ILTypeSpec) =
+ let tref = tspec.TypeRef
+ let tinst = tspec.GenericArgs
+ let qtref = qrescope_tref scoref tref
+ if ILList.isEmpty tinst && isNone qtref then
+ None (* avoid reallocation in the common case *)
+ else
+ match qtref with
+ | None -> Some (ILTypeSpec.Create (tref, rescopeILTypes scoref tinst))
+ | Some tref -> Some (ILTypeSpec.Create (tref, rescopeILTypes scoref tinst))
+
+and rescopeILTypeSpec x y =
+ match rescopeILTypeSpecQuick x y with
+ | Some x -> x
+ | None -> y
+
+and rescopeILType scoref typ =
+ match typ with
+ | ILType.Ptr t -> ILType.Ptr (rescopeILType scoref t)
+ | ILType.FunctionPointer t -> ILType.FunctionPointer (rescopeILCallSig scoref t)
+ | ILType.Byref t -> ILType.Byref (rescopeILType scoref t)
+ | ILType.Boxed cr ->
+ match rescopeILTypeSpecQuick scoref cr with
+ | Some res -> mkILBoxedType res
+ | None -> typ // avoid reallocation in the common case
+ | ILType.Array (s,ty) -> ILType.Array (s,rescopeILType scoref ty)
+ | ILType.Value cr ->
+ match rescopeILTypeSpecQuick scoref cr with
+ | Some res -> ILType.Value res
+ | None -> typ // avoid reallocation in the common case
+ | ILType.Modified(b,tref,ty) -> ILType.Modified(b,rescopeILTypeRef scoref tref, rescopeILType scoref ty)
+ | x -> x
+
+and rescopeILTypes scoref i =
+ if ILList.isEmpty i then i
+ else ILList.map (rescopeILType scoref) i
+
+and rescopeILCallSig scoref csig =
+ mkILCallSigRaw (csig.CallingConv,rescopeILTypes scoref csig.ArgTypes,rescopeILType scoref csig.ReturnType)
+
+let rescopeILMethodRef scoref (x:ILMethodRef) =
+ { mrefParent = rescopeILTypeRef scoref x.EnclosingTypeRef;
+ mrefCallconv = x.mrefCallconv;
+ mrefGenericArity=x.mrefGenericArity;
+ mrefName=x.mrefName;
+ mrefArgs = rescopeILTypes scoref x.mrefArgs;
+ mrefReturn= rescopeILType scoref x.mrefReturn }
+
+let rescopeILFieldRef scoref x =
+ { EnclosingTypeRef = rescopeILTypeRef scoref x.EnclosingTypeRef;
+ Name= x.Name;
+ Type= rescopeILType scoref x.Type }
+
+// --------------------------------------------------------------------
+// Instantiate polymorphism in types
+// --------------------------------------------------------------------
+
+let rec instILTypeSpecAux numFree inst (tspec:ILTypeSpec) =
+ ILTypeSpec.Create(tspec.TypeRef,instILGenericArgsAux numFree inst tspec.GenericArgs)
+
+and instILTypeAux numFree (inst:ILGenericArgs) typ =
+ match typ with
+ | ILType.Ptr t -> ILType.Ptr (instILTypeAux numFree inst t)
+ | ILType.FunctionPointer t -> ILType.FunctionPointer (instILCallSigAux numFree inst t)
+ | ILType.Array (a,t) -> ILType.Array (a,instILTypeAux numFree inst t)
+ | ILType.Byref t -> ILType.Byref (instILTypeAux numFree inst t)
+ | ILType.Boxed cr -> mkILBoxedType (instILTypeSpecAux numFree inst cr)
+ | ILType.Value cr -> ILType.Value (instILTypeSpecAux numFree inst cr)
+ | ILType.TypeVar v ->
+ let v = int v
+ let top = inst.Length
+ if v < numFree then typ else
+ if v - numFree >= top then
+ ILType.TypeVar (uint16 (v - top))
+ else
+ ILList.nth inst (v - numFree)
+ | x -> x
+
+and instILGenericArgsAux numFree inst i = ILList.map (instILTypeAux numFree inst) i
+
+and instILCallSigAux numFree inst csig =
+ mkILCallSigRaw (csig.CallingConv,ILList.map (instILTypeAux numFree inst) csig.ArgTypes,instILTypeAux numFree inst csig.ReturnType)
+
+let instILType i t = instILTypeAux 0 i t
+
+// --------------------------------------------------------------------
+// MS-IL: Parameters, Return types and Locals
+// --------------------------------------------------------------------
+
+let mkILParam (name,ty) =
+ { Name=name;
+ Default=None;
+ Marshal=None;
+ IsIn=false;
+ IsOut=false;
+ IsOptional=false;
+ Type=ty;
+ CustomAttrs=emptyILCustomAttrs }
+let mkILParamNamed (s,ty) = mkILParam (Some s,ty)
+let mkILParamAnon ty = mkILParam (None,ty)
+
+let mkILReturn ty : ILReturn =
+ { Marshal=None;
+ Type=ty;
+ CustomAttrs=emptyILCustomAttrs }
+
+let mkILLocal ty =
+ { IsPinned=false;
+ Type=ty; }
+
+type ILFieldSpec with
+ member fr.ActualType =
+ let env = fr.EnclosingType.GenericArgs
+ instILType env fr.FormalType
+
+// --------------------------------------------------------------------
+// Make a method mbody
+// --------------------------------------------------------------------
+
+
+let mkILMethodBody (zeroinit,locals,maxstack,code,tag) =
+ { IsZeroInit=zeroinit;
+ MaxStack=maxstack;
+ NoInlining=false;
+ Locals= locals ;
+ Code= code;
+ SourceMarker=tag }
+
+let mkMethodBody (zeroinit,locals,maxstack,code,tag) = MethodBody.IL (mkILMethodBody (zeroinit,locals,maxstack,code,tag))
+
+// --------------------------------------------------------------------
+// Make a constructor
+// --------------------------------------------------------------------
+
+let mkILVoidReturn = mkILReturn ILType.Void
+
+
+let mkILCtor (access,args,impl) =
+ { Name=".ctor";
+ mdKind=MethodKind.Ctor;
+ CallingConv=ILCallingConv.Instance;
+ Parameters=mkILParametersRaw args;
+ Return= mkILVoidReturn;
+ Access=access;
+ mdBody= mkMethBodyAux impl;
+ mdCodeKind=MethodCodeKind.IL;
+ IsInternalCall=false;
+ IsManaged=true;
+ IsForwardRef=false;
+ SecurityDecls=emptyILSecurityDecls;
+ HasSecurity=false;
+ IsEntryPoint=false;
+ GenericParams=mkILEmptyGenericParams;
+ IsReqSecObj=false;
+ IsHideBySig=false;
+ IsSpecialName=true;
+ IsUnmanagedExport=false;
+ IsSynchronized=false;
+ IsNoInline=false;
+ IsMustRun=false;
+ IsPreserveSig=false;
+ CustomAttrs = emptyILCustomAttrs; }
+
+// --------------------------------------------------------------------
+// Do-nothing ctor, just pass on to monomorphic superclass
+// --------------------------------------------------------------------
+
+let mkCallBaseConstructor (typ,args: ILType list) =
+ [ mkLdarg0; ] @
+ List.mapi (fun i _ -> mkLdarg (uint16 (i+1))) args @
+ [ mkNormalCall (mkILCtorMethSpecForTy (typ,[])) ]
+
+let mkNormalStfld fspec = I_stfld (Aligned,Nonvolatile,fspec)
+let mkNormalStsfld fspec = I_stsfld (Nonvolatile,fspec)
+let mkNormalLdsfld fspec = I_ldsfld (Nonvolatile,fspec)
+let mkNormalLdfld fspec = I_ldfld (Aligned,Nonvolatile,fspec)
+let mkNormalLdflda fspec = I_ldflda fspec
+let mkNormalLdobj dt = I_ldobj(Aligned,Nonvolatile,dt)
+let mkNormalStobj dt = I_stobj(Aligned,Nonvolatile,dt)
+
+let mkILNonGenericEmptyCtor tag superTy =
+ let ctor = mkCallBaseConstructor (superTy,[])
+ mkILCtor(ILMemberAccess.Public,[],mkMethodBody(false,[],8, nonBranchingInstrsToCode ctor,tag))
+
+// --------------------------------------------------------------------
+// Make a static, top level monomophic method - very useful for
+// creating helper ILMethodDefs for internal use.
+// --------------------------------------------------------------------
+let mkILStaticMethod (genparams,nm,access,args,ret,impl) =
+ { GenericParams=genparams;
+ Name=nm;
+ CallingConv = ILCallingConv.Static;
+ mdKind=MethodKind.Static;
+ Parameters= mkILParametersRaw args;
+ Return= ret;
+ Access=access;
+ HasSecurity=false;
+ SecurityDecls=emptyILSecurityDecls;
+ IsEntryPoint=false;
+ CustomAttrs = emptyILCustomAttrs;
+ mdBody= mkMethBodyAux impl;
+ mdCodeKind=MethodCodeKind.IL;
+ IsInternalCall=false;
+ IsManaged=true;
+ IsForwardRef=false;
+ IsReqSecObj=false;
+ IsHideBySig=false;
+ IsSpecialName=false;
+ IsUnmanagedExport=false;
+ IsSynchronized=false;
+ IsNoInline=false;
+ IsMustRun=false;
+ IsPreserveSig=false; }
+
+let mkILNonGenericStaticMethod (nm,access,args,ret,impl) =
+ mkILStaticMethod (mkILEmptyGenericParams,nm,access,args,ret,impl)
+
+let mkILClassCtor impl =
+ { Name=".cctor";
+ CallingConv=ILCallingConv.Static;
+ GenericParams=mkILEmptyGenericParams;
+ mdKind=MethodKind.Cctor;
+ Parameters=emptyILParameters;
+ Return=mkILVoidReturn;
+ Access=ILMemberAccess.Private;
+ IsEntryPoint=false;
+ HasSecurity=false;
+ SecurityDecls=emptyILSecurityDecls;
+ CustomAttrs = emptyILCustomAttrs;
+ mdBody= mkMethBodyAux impl;
+ mdCodeKind=MethodCodeKind.IL;
+ IsInternalCall=false;
+ IsManaged=true;
+ IsForwardRef=false;
+ IsReqSecObj=false;
+ IsHideBySig=false;
+ IsSpecialName=true;
+ IsUnmanagedExport=false;
+ IsSynchronized=false;
+ IsNoInline=false;
+ IsMustRun=false;
+ IsPreserveSig=false; }
+
+// --------------------------------------------------------------------
+// Make a virtual method, where the overriding is simply the default
+// (i.e. overrides by name/signature)
+// --------------------------------------------------------------------
+
+let mk_ospec (typ:ILType,callconv,nm,genparams,formal_args,formal_ret) =
+ OverridesSpec (mkILMethRef (typ.TypeRef, callconv, nm, genparams, formal_args,formal_ret), typ)
+
+let mkILGenericVirtualMethod (nm,access,genparams,actual_args,actual_ret,impl) =
+ { Name=nm;
+ GenericParams=genparams;
+ CallingConv=ILCallingConv.Instance;
+ mdKind=
+ MethodKind.Virtual
+ { IsFinal=false;
+ // REVIEW: We'll need to start setting this eventually
+ IsNewSlot = false;
+ IsCheckAccessOnOverride=true;
+ IsAbstract=(match impl with MethodBody.Abstract -> true | _ -> false) ; };
+ Parameters= mkILParametersRaw actual_args;
+ Return=actual_ret;
+ Access=access;
+ IsEntryPoint=false;
+ HasSecurity=false;
+ SecurityDecls=emptyILSecurityDecls;
+ CustomAttrs = emptyILCustomAttrs;
+ mdBody= mkMethBodyAux impl;
+ mdCodeKind=MethodCodeKind.IL;
+ IsInternalCall=false;
+ IsManaged=true;
+ IsForwardRef=false;
+ IsReqSecObj=false;
+ IsHideBySig=false;
+ IsSpecialName=false;
+ IsUnmanagedExport=false;
+ IsSynchronized=false;
+ IsNoInline=false;
+ IsMustRun=false;
+ IsPreserveSig=false; }
+
+let mkILNonGenericVirtualMethod (nm,access,args,ret,impl) =
+ mkILGenericVirtualMethod (nm,access,mkILEmptyGenericParams,args,ret,impl)
+
+let mkILGenericNonVirtualMethod (nm,access,genparams, actual_args,actual_ret, impl) =
+ { Name=nm;
+ GenericParams=genparams;
+ CallingConv=ILCallingConv.Instance;
+ mdKind=MethodKind.NonVirtual;
+ Parameters= mkILParametersRaw actual_args;
+ Return=actual_ret;
+ Access=access;
+ IsEntryPoint=false;
+ HasSecurity=false;
+ SecurityDecls=emptyILSecurityDecls;
+ CustomAttrs = emptyILCustomAttrs;
+ mdBody= mkMethBodyAux impl;
+ mdCodeKind=MethodCodeKind.IL;
+ IsInternalCall=false;
+ IsManaged=true;
+ IsForwardRef=false;
+ IsReqSecObj=false;
+ IsHideBySig=true; // see Bug343136: missing HideBySig attribute makes it problematic for C# to consume F# method overloads.
+ IsSpecialName=false;
+ IsUnmanagedExport=false;
+ IsSynchronized=false;
+ IsNoInline=false;
+ IsMustRun=false;
+ IsPreserveSig=false; }
+
+let mkILNonGenericInstanceMethod (nm,access,args,ret,impl) =
+ mkILGenericNonVirtualMethod (nm,access,mkILEmptyGenericParams,args,ret,impl)
+
+
+// --------------------------------------------------------------------
+// Add some code to the end of the .cctor for a type. Create a .cctor
+// if one doesn't exist already.
+// --------------------------------------------------------------------
+
+let ilmbody_code2code f il =
+ {il with Code = f il.Code}
+
+let mdef_code2code f md =
+ let il =
+ match md.mdBody.Contents with
+ | MethodBody.IL il-> il
+ | _ -> failwith "mdef_code2code - method not IL"
+ let b = MethodBody.IL (ilmbody_code2code f il)
+ {md with mdBody= mkMethBodyAux b }
+
+let prependInstrsToCode c1 c2 =
+ let internalLab = generateCodeLabel ()
+ joinCode (checkILCode (mkBasicBlock {Label=internalLab;
+ Instructions=Array.ofList (c1 @ [ I_br (uniqueEntryOfCode c2)])})) c2
+
+let prependInstrsToMethod new_code md =
+ mdef_code2code (prependInstrsToCode new_code) md
+
+(* Creates cctor if needed *)
+let cdef_cctorCode2CodeOrCreate tag f cd =
+ let mdefs = cd.Methods
+ let md,mdefs =
+ match mdefs.FindByName ".cctor" with
+ | [mdef] -> mdef,filterILMethodDefs (fun md -> md.Name <> ".cctor") mdefs
+ | [] -> mkILClassCtor (mkMethodBody (false,emptyILLocals,1,nonBranchingInstrsToCode [ ],tag)), mdefs
+ | _ -> failwith "bad method table: more than one .cctor found"
+ let md' = f md
+ {cd with Methods = addILMethod md' mdefs}
+
+
+let code_of_mdef (md:ILMethodDef) =
+ match md.Code with
+ | Some x -> x
+ | None -> failwith "code_of_mdef: not IL"
+
+let mkRefToILMethod (tref, md: ILMethodDef) =
+ mkILMethRefRaw (tref, md.CallingConv, md.Name, md.GenericParams.Length, md.ParameterTypes, md.Return.Type)
+
+let mkRefToILField (tref,fdef:ILFieldDef) = mkILFieldRef (tref, fdef.Name, fdef.Type)
+
+let mkRefForILMethod scope (tdefs,tdef) mdef = mkRefToILMethod (mkRefForNestedILTypeDef scope (tdefs,tdef), mdef)
+let mkRefForILField scope (tdefs,tdef) (fdef:ILFieldDef) = mkILFieldRef (mkRefForNestedILTypeDef scope (tdefs,tdef), fdef.Name, fdef.Type)
+
+
+(* Creates cctor if needed *)
+let prependInstrsToClassCtor instrs tag cd =
+ cdef_cctorCode2CodeOrCreate tag (prependInstrsToMethod instrs) cd
+
+
+let mkILField (isStatic,nm,ty,init,at,access,isLiteral) =
+ { Name=nm;
+ Type=ty;
+ IsStatic = isStatic;
+ LiteralValue = init;
+ Data=at;
+ Offset=None;
+ IsSpecialName = false;
+ Marshal=None;
+ NotSerialized=false;
+ IsInitOnly = false;
+ IsLiteral = isLiteral;
+ Access = access;
+ CustomAttrs=emptyILCustomAttrs }
+
+let mkILInstanceField (nm,ty,init,access) = mkILField (false,nm,ty,init,None,access,false)
+let mkILStaticField (nm,ty,init,at,access) = mkILField (true,nm,ty,init,at,access,false)
+let mkILLiteralField (nm,ty,init,at,access) = mkILField (true, nm, ty, Some init, at, access, true)
+
+// --------------------------------------------------------------------
+// Scopes for allocating new temporary variables.
+// --------------------------------------------------------------------
+
+type ILLocalsAllocator(numPrealloc:int) =
+ let newLocals = ResizeArray()
+ member tmps.AllocLocal loc =
+ let locn = uint16(numPrealloc + newLocals.Count)
+ newLocals.Add loc;
+ locn
+
+ member tmps.Close() = ResizeArray.toList newLocals
+
+
+let mkILFieldsLazy l = Fields (LazyOrderedMultiMap((fun (f:ILFieldDef) -> f.Name),l))
+let mkILFields l = mkILFieldsLazy (notlazy l)
+let emptyILFields = mkILFields []
+
+let mkILEventsLazy l = Events (LazyOrderedMultiMap((fun (e: ILEventDef) -> e.Name),l))
+let mkILEvents l = mkILEventsLazy (notlazy l)
+let emptyILEvents = mkILEvents []
+
+let mkILPropertiesLazy l = Properties (LazyOrderedMultiMap((fun (p: ILPropertyDef) -> p.Name),l) )
+let mkILProperties l = mkILPropertiesLazy (notlazy l)
+let emptyILProperties = mkILProperties []
+
+let addExportedTypeToTable (y: ILExportedTypeOrForwarder) tab = Map.add y.Name y tab
+let mkILExportedTypes l = ILExportedTypesAndForwarders (notlazy (List.foldBack addExportedTypeToTable l Map.empty))
+let mkILExportedTypesLazy (l:Lazy<_>) = ILExportedTypesAndForwarders (lazy (List.foldBack addExportedTypeToTable (l.Force()) Map.empty))
+
+let addNestedExportedTypeToTable (y: ILNestedExportedType) tab =
+ Map.add y.Name y tab
+
+let mkILNestedExportedTypes l =
+ ILNestedExportedTypes (notlazy (List.foldBack addNestedExportedTypeToTable l Map.empty))
+
+let mkILNestedExportedTypesLazy (l:Lazy<_>) =
+ ILNestedExportedTypes (lazy (List.foldBack addNestedExportedTypeToTable (l.Force()) Map.empty))
+
+let mkILResources l = ILResources (notlazy l)
+let mkILResourcesLazy l = ILResources l
+
+let addMethodImplToTable y tab =
+ let key = (y.Overrides.MethodRef.Name,y.Overrides.MethodRef.ArgTypes.Length)
+ let prev = Map.tryFindMulti key tab
+ Map.add key (y::prev) tab
+
+let mkILMethodImpls l = MethodImpls (notlazy (List.foldBack addMethodImplToTable l Map.empty))
+let mkILMethodImplsLazy l = MethodImpls (lazy (List.foldBack addMethodImplToTable (Lazy.force l) Map.empty))
+let emptyILMethodImpls = mkILMethodImpls []
+
+
+// --------------------------------------------------------------------
+// Make a constructor that simply takes its arguments and stuffs
+// them in fields. preblock is how to call the superclass constructor....
+// --------------------------------------------------------------------
+
+let mkILStorageCtorWithParamNames(tag,preblock,typ,flds,access) =
+ mkILCtor(access,
+ flds |> List.map (fun (pnm,_,ty) -> mkILParamNamed (pnm,ty)),
+ mkMethodBody
+ (false,emptyILLocals,2,
+ nonBranchingInstrsToCode
+ begin
+ (match tag with Some x -> [I_seqpoint x] | None -> []) @
+ preblock @
+ List.concat (List.mapi (fun n (_pnm,nm,ty) ->
+ [ mkLdarg0;
+ mkLdarg (uint16 (n+1));
+ mkNormalStfld (mkILFieldSpecInTy (typ,nm,ty));
+ ]) flds)
+ end,tag))
+
+let mkILSimpleStorageCtorWithParamNames(tag,base_tspec,typ,flds,access) =
+ let preblock =
+ match base_tspec with
+ None -> []
+ | Some tspec ->
+ ([ mkLdarg0;
+ mkNormalCall (mkILCtorMethSpecForTy (mkILBoxedType tspec,[])) ])
+ mkILStorageCtorWithParamNames(tag,preblock,typ,flds,access)
+
+let addParamNames flds =
+ flds |> List.map (fun (nm,ty) -> (nm,nm,ty))
+
+let mkILSimpleStorageCtor(tag,base_tspec,typ,flds,access) =
+ mkILSimpleStorageCtorWithParamNames(tag,base_tspec,typ, addParamNames flds, access)
+
+let mkILStorageCtor(tag,preblock,typ,flds,access) = mkILStorageCtorWithParamNames(tag,preblock,typ, addParamNames flds, access)
+
+
+let mkILGenericClass (nm, access, genparams, extends, impl, methods, fields, nestedTypes, props, events, attrs, init) =
+ { tdKind=ILTypeDefKind.Class;
+ Name=nm;
+ GenericParams= genparams;
+ Access = access;
+ Implements = mkILTypes impl;
+ IsAbstract = false;
+ IsSealed = false;
+ IsSerializable = false;
+ IsComInterop=false;
+ IsSpecialName=false;
+ Layout=ILTypeDefLayout.Auto;
+ Encoding=ILDefaultPInvokeEncoding.Ansi;
+ InitSemantics=init;
+ Extends = Some extends;
+ Methods= methods;
+ Fields= fields;
+ NestedTypes=nestedTypes;
+ CustomAttrs=attrs;
+ MethodImpls=emptyILMethodImpls;
+ Properties=props;
+ Events=events;
+ SecurityDecls=emptyILSecurityDecls;
+ HasSecurity=false;
+}
+
+let mkRawDataValueTypeDef ilg (nm,size,pack) =
+ { tdKind=ILTypeDefKind.ValueType;
+ Name = nm;
+ GenericParams= [];
+ Access = ILTypeDefAccess.Private;
+ Implements = emptyILTypes;
+ IsAbstract = false;
+ IsSealed = true;
+ Extends = Some ilg.typ_ValueType;
+ IsComInterop=false;
+ IsSerializable = false;
+ IsSpecialName=false;
+ Layout=ILTypeDefLayout.Explicit { Size=Some size; Pack=Some pack };
+ Encoding=ILDefaultPInvokeEncoding.Ansi;
+ InitSemantics=ILTypeInit.BeforeField;
+ Methods= emptyILMethods;
+ Fields= emptyILFields;
+ NestedTypes=emptyILTypeDefs;
+ CustomAttrs=emptyILCustomAttrs;
+ MethodImpls=emptyILMethodImpls;
+ Properties=emptyILProperties;
+ Events=emptyILEvents;
+ SecurityDecls=emptyILSecurityDecls;
+ HasSecurity=false; }
+
+
+let mkILSimpleClass ilg (nm, access, methods, fields, nestedTypes, props, events, attrs, init) =
+ mkILGenericClass (nm,access, mkILEmptyGenericParams, ilg.typ_Object, [], methods, fields, nestedTypes, props, events, attrs, init)
+
+let mkILTypeDefForGlobalFunctions ilg (methods,fields) = mkILSimpleClass ilg (typeNameForGlobalFunctions, ILTypeDefAccess.Public, methods, fields, emptyILTypeDefs, emptyILProperties, emptyILEvents, emptyILCustomAttrs,ILTypeInit.BeforeField)
+
+let destTypeDefsWithGlobalFunctionsFirst ilg (tdefs: ILTypeDefs) =
+ let l = tdefs.AsList
+ let top,nontop = l |> List.partition (fun td -> td.Name = typeNameForGlobalFunctions)
+ let top2 = if isNil top then [mkILTypeDefForGlobalFunctions ilg (emptyILMethods, emptyILFields)] else top
+ top2@nontop
+
+let mkILSimpleModule assname modname dll subsystemVersion useHighEntropyVA tdefs hashalg locale flags exportedTypes metadataVersion =
+ { Manifest=
+ Some { Name=assname;
+ AuxModuleHashAlgorithm= match hashalg with | Some(alg) -> alg | _ -> 0x8004; // SHA1
+ SecurityDecls=emptyILSecurityDecls;
+ PublicKey= None;
+ Version= None;
+ Locale=locale
+ CustomAttrs=emptyILCustomAttrs;
+ AssemblyLongevity=ILAssemblyLongevity.Unspecified;
+ DisableJitOptimizations= 0 <> (flags &&& 0x4000);
+ JitTracking=0 <> (flags &&& 0x8000); // always turn these on
+ Retargetable= 0 <> (flags &&& 0x100);
+ ExportedTypes=exportedTypes;
+ EntrypointElsewhere=None
+ };
+ CustomAttrs=emptyILCustomAttrs;
+ Name=modname;
+ NativeResources=[];
+ TypeDefs=tdefs;
+ SubsystemVersion = subsystemVersion
+ UseHighEntropyVA = useHighEntropyVA
+ SubSystemFlags=defaultSubSystem;
+ IsDLL=dll;
+ IsILOnly=true;
+ Platform=None;
+ StackReserveSize=None;
+ Is32Bit=false;
+ Is32BitPreferred=false;
+ Is64Bit=false;
+ PhysicalAlignment=defaultPhysAlignment;
+ VirtualAlignment=defaultVirtAlignment;
+ ImageBase=defaultImageBase;
+ MetadataVersion=metadataVersion;
+ Resources=mkILResources [];
+ }
+
+
+//-----------------------------------------------------------------------
+// Intermediate parsing structure for exception tables....
+//-----------------------------------------------------------------------
+
+type ILExceptionClause =
+ | Finally of (ILCodeLabel * ILCodeLabel)
+ | Fault of (ILCodeLabel * ILCodeLabel)
+ | FilterCatch of (ILCodeLabel * ILCodeLabel) * (ILCodeLabel * ILCodeLabel)
+ | TypeCatch of ILType * (ILCodeLabel * ILCodeLabel)
+
+type ILExceptionSpec =
+ { exnRange: (ILCodeLabel * ILCodeLabel);
+ exnClauses: ILExceptionClause list }
+
+type exceptions = ILExceptionSpec list
+
+//-----------------------------------------------------------------------
+// [instructions_to_code] makes the basic block structure of code from
+// a primitive array of instructions. We
+// do this be iterating over the instructions, pushing new basic blocks
+// everytime we encounter an address that has been recorded
+// [bbstartToCodeLabelMap].
+//-----------------------------------------------------------------------
+
+type ILLocalSpec =
+ { locRange: (ILCodeLabel * ILCodeLabel);
+ locInfos: ILDebugMapping list }
+
+type structspec = SEH of ILExceptionSpec | LOCAL of ILLocalSpec
+
+let delayInsertedToWorkaroundKnownNgenBug _s f =
+ (* Some random code to prevent inlining of this function *)
+ let mutable res = 10
+ for i = 0 to 2 do
+ res <- res + 1;
+ //printf "------------------------executing NGEN bug delay '%s', calling 'f' --------------\n" s;
+ let res = f()
+ //printf "------------------------exiting NGEN bug delay '%s' --------------\n" s;
+ res
+
+
+let popRangeM lo hi (m:Zmap<'Key,'U>) =
+ let collect k v (rvs,m) = (v :: rvs) , Zmap.remove k m
+ let rvs,m = Zmap.foldSection lo hi collect m ([],m)
+ List.rev rvs,m
+
+type BasicBlockStartsToCodeLabelsMap(instrs,tryspecs,localspecs,lab2pc) =
+
+ // Find all the interesting looking labels that form the boundaries of basic blocks.
+ // These are the destinations of branches and the boundaries of both exceptions and
+ // those blocks where locals are live.
+ let bbstartToCodeLabelMap =
+ let res = ref CodeLabels.empty
+ let add_range (a,b) = res := CodeLabels.insert a (CodeLabels.insert b !res)
+ instrs |> Array.iter (fun i -> res := CodeLabels.addList (destinationsOfInstr i) !res);
+
+ tryspecs |> List.iter (fun espec ->
+ add_range espec.exnRange;
+ List.iter (function
+ | Finally r1 | Fault r1 | TypeCatch (_,r1)-> add_range r1
+ | FilterCatch (r1,r2) -> add_range r1; add_range r2) espec.exnClauses);
+
+ localspecs |> List.iter (fun l -> add_range l.locRange) ;
+
+ !res
+
+ // Construct a map that gives a unique ILCodeLabel for each label that
+ // might be a boundary of a basic block. These will be the labels
+ // for the basic blocks we end up creating.
+ let lab2clMap = Dictionary<_,_>(10, HashIdentity.Structural)
+ let pc2clMap = Dictionary<_,_>(10, HashIdentity.Structural)
+ let addBBstartPc pc pcs cls =
+ if pc2clMap.ContainsKey pc then
+ pc2clMap.[pc], pcs, cls
+ else
+ let cl = generateCodeLabel ()
+ pc2clMap.[pc] <- cl;
+ cl, pc::pcs, CodeLabels.insert cl cls
+
+ let bbstartPcs, bbstart_code_labs =
+ CodeLabels.fold
+ (fun bbstart_lab (pcs, cls) ->
+ let pc = lab2pc bbstart_lab
+ if logging then dprintf "bblock starts with label %s at pc %d\n" (formatCodeLabel bbstart_lab) pc;
+ let cl,pcs',cls' = addBBstartPc pc pcs cls
+ lab2clMap.[bbstart_lab] <- cl;
+ pcs',
+ cls')
+ bbstartToCodeLabelMap
+ ([], CodeLabels.empty)
+ let cl0,bbstartPcs, bbstart_code_labs = addBBstartPc 0 bbstartPcs bbstart_code_labs
+
+
+ member c.InitialCodeLabel = cl0
+ member c.BasicBlockStartPositions = bbstartPcs
+ member c.BasicBlockStartCodeLabels = bbstart_code_labs
+
+ member c.lab2cl bbLab =
+ try
+ lab2clMap.[bbLab]
+ with :? KeyNotFoundException -> failwith ("basic block label "+formatCodeLabel bbLab+" not declared")
+
+ member c.pc2cl pc =
+ try
+ pc2clMap.[pc]
+ with :? KeyNotFoundException ->
+ failwith ("internal error while mapping pc "+string pc+" to code label")
+
+ member c.remapLabels i =
+ match i with
+ | I_leave l -> I_leave(c.lab2cl l)
+ | I_br l -> I_br (c.lab2cl l)
+ | I_other e -> I_other (find_extension "instr" (fun ext -> if ext.internalInstrExtIs e then Some (ext.internalInstrExtRelabel c.lab2cl e) else None) !instrExtensions)
+ | I_brcmp (x,l1,l2) -> I_brcmp(x,c.lab2cl l1, c.lab2cl l2)
+ | I_switch (ls,l) -> I_switch(List.map c.lab2cl ls, c.lab2cl l)
+ | _ -> i
+
+let disjoint_range (start_pc1,end_pc1) (start_pc2,end_pc2) =
+ ((start_pc1 : int) < start_pc2 && end_pc1 <= start_pc2) ||
+ (start_pc1 >= end_pc2 && end_pc1 > end_pc2)
+
+let merge_ranges (start_pc1,end_pc1) (start_pc2,end_pc2) =
+ (min (start_pc1:int) start_pc2, max (end_pc1:int) end_pc2)
+
+let rangeInsideRange (start_pc1,end_pc1) (start_pc2,end_pc2) =
+ (start_pc1:int) >= start_pc2 && start_pc1 < end_pc2 &&
+ (end_pc1:int) > start_pc2 && end_pc1 <= end_pc2
+
+let lranges_of_clause cl =
+ match cl with
+ | Finally r1 -> [r1]
+ | Fault r1 -> [r1]
+ | FilterCatch (r1,r2) -> [r1;r2]
+ | TypeCatch (_ty,r1) -> [r1]
+
+
+type CodeOffsetViewOfLabelledItems(lab2pc) =
+ member x.labelsToRange p = let (l1,l2) = p in lab2pc l1, lab2pc l2
+
+ member x.lrange_inside_lrange ls1 ls2 =
+ rangeInsideRange (x.labelsToRange ls1) (x.labelsToRange ls2)
+
+ member x.disjoint_lranges ls1 ls2 =
+ disjoint_range (x.labelsToRange ls1) (x.labelsToRange ls2)
+
+ member x.clause_inside_lrange cl lr =
+ List.forall (fun lr1 -> x.lrange_inside_lrange lr1 lr) (lranges_of_clause cl)
+
+ member x.clauses_inside_lrange cls lr =
+ List.forall
+ (fun cl -> x.clause_inside_lrange cl lr)
+ cls
+
+ member x.tryspec_inside_lrange tryspec1 lr =
+ (x.lrange_inside_lrange tryspec1.exnRange lr &&
+ x.clauses_inside_lrange tryspec1.exnClauses lr)
+
+ member x.tryspec_inside_clause tryspec1 cl =
+ List.exists (fun lr -> x.tryspec_inside_lrange tryspec1 lr) (lranges_of_clause cl)
+
+ member x.locspec_inside_clause locspec1 cl =
+ List.exists (fun lr -> x.lrange_inside_lrange locspec1.locRange lr) (lranges_of_clause cl)
+
+ member x.tryspec_inside_tryspec tryspec1 tryspec2 =
+ x.tryspec_inside_lrange tryspec1 tryspec2.exnRange ||
+ List.exists (fun c2 -> x.tryspec_inside_clause tryspec1 c2) tryspec2.exnClauses
+
+ member x.locspec_inside_tryspec locspec1 tryspec2 =
+ x.lrange_inside_lrange locspec1.locRange tryspec2.exnRange ||
+ List.exists (fun c2 -> x.locspec_inside_clause locspec1 c2) tryspec2.exnClauses
+
+ member x.tryspec_inside_locspec tryspec1 locspec2 =
+ x.tryspec_inside_lrange tryspec1 locspec2.locRange
+
+ member x.disjoint_clause_and_lrange cl lr =
+ List.forall (fun lr1 -> x.disjoint_lranges lr1 lr) (lranges_of_clause cl)
+
+ member x.disjoint_clauses_and_lrange cls lr =
+ List.forall (fun cl -> x.disjoint_clause_and_lrange cl lr) cls
+
+ member x.disjoint_tryspec_and_lrange tryspec1 lr =
+ (x.disjoint_lranges tryspec1.exnRange lr &&
+ x.disjoint_clauses_and_lrange tryspec1.exnClauses lr)
+
+ member x.disjoint_tryspec_and_clause tryspec1 cl =
+ List.forall (fun lr -> x.disjoint_tryspec_and_lrange tryspec1 lr) (lranges_of_clause cl)
+
+ member x.tryspec_disjoint_from_tryspec tryspec1 tryspec2 =
+ x.disjoint_tryspec_and_lrange tryspec1 tryspec2.exnRange &&
+ List.forall (fun c2 -> x.disjoint_tryspec_and_clause tryspec1 c2) tryspec2.exnClauses
+
+ member x.tryspec_disjoint_from_locspec tryspec1 locspec2 =
+ x.disjoint_tryspec_and_lrange tryspec1 locspec2.locRange
+
+ member x.locspec_disjoint_from_locspec locspec1 locspec2 =
+ x.disjoint_lranges locspec1.locRange locspec2.locRange
+
+ member x.locspec_inside_locspec locspec1 locspec2 =
+ x.lrange_inside_lrange locspec1.locRange locspec2.locRange
+
+ member x.structspec_inside_structspec specA specB = (* only for sanity checks, then can be removed *)
+ match specA,specB with
+ | SEH tryspecA,SEH tryspecB -> x.tryspec_inside_tryspec tryspecA tryspecB
+ | SEH tryspecA,LOCAL locspecB -> x.tryspec_inside_locspec tryspecA locspecB
+ | LOCAL locspecA,SEH tryspecB -> x.locspec_inside_tryspec locspecA tryspecB
+ | LOCAL locspecA,LOCAL locspecB -> x.locspec_inside_locspec locspecA locspecB
+
+ // extent (or size) is the sum of range extents
+ // We want to build in increasing containment-order, that's a partial order.
+ // Size-order implies containment-order, and size-order is a total order.
+ member x.extent_structspec ss =
+ let extent_range (start_pc,end_pc) = end_pc - start_pc
+ let extent_lrange lrange = extent_range (x.labelsToRange lrange)
+ let extent_locspec locspec = extent_lrange locspec.locRange
+ let extent_list extent_item items = List.fold (fun acc item -> acc + extent_item item) 0 items
+ let extent_list2 extent_item items = List.fold (fun acc item -> acc + extent_item item) 0 items
+ let extent_clause cl = extent_list extent_lrange (lranges_of_clause cl)
+ let extent_tryspec tryspec = extent_lrange tryspec.exnRange + (extent_list2 extent_clause tryspec.exnClauses)
+
+ match ss with
+ | LOCAL locspec -> extent_locspec locspec
+ | SEH tryspec -> extent_tryspec tryspec
+
+ (* DIAGNOSTICS: START ------------------------------ *)
+ member x.string_of_structspec ss =
+ let stringOfRange (l1,l2) =
+ let pc1,pc2 = x.labelsToRange ((l1,l2))
+ formatCodeLabel l1+"("+string pc1+")-"+ formatCodeLabel l2+"("+string pc2+")"
+ let string_of_clause cl = String.concat "+" (List.map stringOfRange (lranges_of_clause cl))
+ let string_of_tryspec tryspec = "tryspec"+ stringOfRange tryspec.exnRange + "--" + String.concat " / " (List.map string_of_clause tryspec.exnClauses)
+ let string_of_locspec locspec = "local "+(String.concat ";" (locspec.locInfos |> List.map (fun l -> l.LocalName)))+": "+ stringOfRange locspec.locRange
+ match ss with
+ | SEH tryspec -> string_of_tryspec tryspec
+ | LOCAL locspec -> string_of_locspec locspec
+
+
+
+// Stage 2b - Given an innermost tryspec, collect together the
+// blocks covered by it. Preserve the essential ordering of blocks.
+let blockForInnerTrySpec (codeOffsetView:CodeOffsetViewOfLabelledItems,
+ coverageOfCodes,
+ addBlocks,
+ computeCoveredBlocks,
+ bbstartToCodeLabelMap:BasicBlockStartsToCodeLabelsMap) tryspec state0 =
+
+ let (blocks, remainingBasicBlockStarts) = state0
+ let tryBlocks, otherBlocks = computeCoveredBlocks (codeOffsetView.labelsToRange tryspec.exnRange) blocks
+ if isNil tryBlocks then (dprintn "try block specification covers no real code"; state0) else
+ let getClause r otherBlocks =
+ let clauseBlocks, otherBlocks = computeCoveredBlocks (codeOffsetView.labelsToRange r) otherBlocks
+ if isNil clauseBlocks then
+ failwith "clause block specification covers no real code";
+ (* The next line computes the code label for the entry to the clause *)
+ let clauseEntryLabel = bbstartToCodeLabelMap.lab2cl (fst r)
+ // Now compute the overall clause, with labels still visible.
+ let clauseBlock = mkGroupBlock ([],List.map snd clauseBlocks)
+ (* if logging then dprintf "-- clause entry label is %s" clauseEntryLabel; *)
+ (clauseEntryLabel, clauseBlocks, clauseBlock), otherBlocks
+ let tryCodeBlocks = List.map snd tryBlocks
+ let tryEntryLabel = bbstartToCodeLabelMap.lab2cl (fst tryspec.exnRange)
+ let tryHiddn = CodeLabels.remove tryEntryLabel (List.foldBack (entriesOfCodeAsSet >> CodeLabels.union) tryCodeBlocks CodeLabels.empty)
+ let tryBlock = mkGroupBlock (CodeLabels.toList tryHiddn,tryCodeBlocks)
+
+ match tryspec.exnClauses with
+ | Finally _ :: _ :: _ -> failwith "finally clause combined with others"
+ | [ Finally r ] | [ Fault r ] ->
+
+ let maker =
+ match tryspec.exnClauses with
+ [ Finally _ ] -> mkTryFinallyBlock
+ | [ Fault _ ] -> mkTryFaultBlock
+ | _ -> failwith ""
+
+ let (clauseEntryLabel, clauseBlocks, clauseBlock), otherBlocks = getClause r otherBlocks
+ let newBlockRange = coverageOfCodes (tryBlocks@clauseBlocks)
+ // The next construction joins the blocks together.
+ // It automatically hides any internal labels used in the
+ // clause blocks. Only the entry to the clause is kept visible.
+ // We hide the entries to the try block up above.
+ let newBlock = maker (tryBlock,clauseEntryLabel,clauseBlock)
+ // None of the entries to the clause block are visible outside the
+ // entire try-clause construct, nor the other entries to the try block
+ // apart from the one at the. top
+ let newStarts = CodeLabels.diff remainingBasicBlockStarts (CodeLabels.union tryHiddn (entriesOfCodeAsSet clauseBlock))
+ // Now return the new block, the remaining blocks and the new set
+ // of entries.
+ addBlocks otherBlocks [(newBlockRange, newBlock)], newStarts
+
+ | clauses when clauses |> List.forall (function | FilterCatch _ -> true | TypeCatch _ -> true | _ -> false) ->
+
+ let clause_infos, otherBlocks (*(prior,posterior)*) =
+ List.fold
+ (fun (sofar,otherBlocks) cl ->
+ match cl with
+ | FilterCatch(r1,r2) ->
+ let ((lab1,_,bl1) as _info1),otherBlocks = getClause r1 otherBlocks
+ let info2,otherBlocks = getClause r2 otherBlocks
+ (sofar@[(Choice1Of2 (lab1,bl1),info2)]), otherBlocks
+ | TypeCatch(typ,r2) ->
+ let info2,otherBlocks = getClause r2 otherBlocks
+ (sofar@[(Choice2Of2 typ,info2)]), otherBlocks
+ | _ -> failwith "internal error")
+ ([],otherBlocks)
+ clauses
+ let newBlockRange =
+ // Ignore filter blocks when computing this range
+ // REVIEW: They must always come before the catch blocks.
+ coverageOfCodes
+ (tryBlocks@
+ ((List.collect (fun (_,(_,blocks2,_)) -> blocks2) clause_infos)))
+
+ // The next construction joins the blocks together.
+ // It automatically hides any internal labels used in the
+ // clause blocks. Only the entry to the clause is kept visible.
+ let newBlock =
+ mkTryMultiFilterCatchBlock
+ (tryBlock,
+ List.map
+ (fun (choice,(lab2,_,bl2)) -> choice, (lab2,bl2))
+ clause_infos)
+ // None of the entries to the filter or catch blocks are
+ // visible outside the entire exception construct.
+ let newStarts =
+ CodeLabels.diff remainingBasicBlockStarts
+ (CodeLabels.union tryHiddn
+ (List.foldBack
+ (fun (flt,(_,_,ctch_blck)) acc ->
+ CodeLabels.union
+ (match flt with
+ | Choice1Of2 (_,flt_block) -> entriesOfCodeAsSet flt_block
+ | Choice2Of2 _ -> CodeLabels.empty)
+ (CodeLabels.union (entriesOfCodeAsSet ctch_blck) acc))
+ clause_infos
+ CodeLabels.empty))
+ // Now return the new block, the remaining blocks and the new set
+ // of entries.
+ addBlocks otherBlocks [ (newBlockRange, newBlock)], newStarts
+ | _ -> failwith "invalid pattern of exception constructs"
+
+
+
+let doStructure' (codeOffsetView:CodeOffsetViewOfLabelledItems,
+ computeCoveredBlocks,
+ coverageOfCodes,
+ addBlocks,
+ bbstartToCodeLabelMap:BasicBlockStartsToCodeLabelsMap)
+ structspecs
+ blockState =
+
+ (* Stage 2b - Given an innermost tryspec, collect together the *)
+ (* blocks covered by it. Preserve the essential ordering of blocks. *)
+ let blockForInnerLocSpec locspec ((blocks, remainingBasicBlockStarts) as state0) =
+ let scopeBlocks, otherBlocks (*(prior,posterior)*) = computeCoveredBlocks (codeOffsetView.labelsToRange locspec.locRange) blocks
+ if isNil scopeBlocks then (dprintn "scope block specification covers no real code"; state0) else
+ let newBlock = mkScopeBlock (locspec.locInfos,mkGroupBlock ([],List.map snd scopeBlocks))
+ let newBlockRange = coverageOfCodes scopeBlocks
+ addBlocks otherBlocks [ (newBlockRange, newBlock)], remainingBasicBlockStarts
+
+ // Require items by increasing inclusion-order.
+ // Order by size/extent.
+ // a) size-ordering implies containment-ordering.
+ // b) size-ordering is total, so works with List.sort
+ let buildOrder = Order.orderOn codeOffsetView.extent_structspec int_order
+
+ (* checkOrder: checking is O(n^2) *)
+(*
+ let rec checkOrder = function
+ | [] -> ()
+ | sA::sBs -> List.iter (fun sB ->
+ if codeOffsetView.structspec_inside_structspec sB sA && not (codeOffsetView.structspec_inside_structspec sA sB) then (
+ dprintf "sA = %s\n" (codeOffsetView.string_of_structspec sA);
+ dprintf "sB = %s\n" (codeOffsetView.string_of_structspec sB);
+ assert false
+ )) sBs;
+ checkOrder sBs
+*)
+
+ let structspecs = List.sortWithOrder buildOrder structspecs
+
+ (* if sanity_check_order then checkOrder structspecs; *) (* note: this check is n^2 *)
+ let buildBlock blockState = function
+ | SEH tryspec -> blockForInnerTrySpec (codeOffsetView,coverageOfCodes,addBlocks,computeCoveredBlocks,bbstartToCodeLabelMap) tryspec blockState
+ | LOCAL locspec -> blockForInnerLocSpec locspec blockState
+ List.fold buildBlock blockState structspecs
+
+
+// REVIEW: this function shows up on performance traces. If we eliminated the last ILX->IL rewrites from the
+// F# compiler we could get rid of this structured code representation from Abstract IL altogether, and
+// never convert F# code into this form.
+let buildILCode methName lab2pc instrs tryspecs localspecs =
+
+ let bbstartToCodeLabelMap = BasicBlockStartsToCodeLabelsMap(instrs,tryspecs,localspecs,lab2pc)
+ let codeOffsetView = CodeOffsetViewOfLabelledItems(lab2pc)
+
+ let basicInstructions = Array.map bbstartToCodeLabelMap.remapLabels instrs
+
+ (* DIAGNOSTICS: END -------------------------------- *)
+
+ let buildCodeFromInstructionArray instrs =
+
+ // Consume instructions until we hit the end of the basic block, either
+ // by hitting a control-flow instruction or by hitting the start of the
+ // next basic block by fall-through.
+ let rec consumeBBlockInstrs instrs rinstrs (pc:int) nextBBstartPc =
+ (* rinstrs = accumulates instructions in reverse order *)
+ if pc = (Array.length instrs) then
+ dprintn "* WARNING: basic block at end of method ends without a leave, branch, return or throw. Adding throw\n";
+ pc,List.rev (I_throw :: rinstrs)
+ // The next test is for drop-through at end of bblock, when we just insert
+ // a branch to the next bblock.
+ elif (match nextBBstartPc with Some pc' -> pc = pc' | _ -> false) then
+ if logging then dprintf "-- pushing br, pc = nextBBstartPc = %d\n" pc;
+ pc,List.rev (I_br (bbstartToCodeLabelMap.pc2cl pc) :: rinstrs)
+ else
+ // Otherwise bblocks end with control-flow.
+ let i = instrs.[pc]
+ let pc' = pc + 1
+ if instrIsBasicBlockEnd i then
+ if instrIsTailcall i then
+ if pc' = instrs.Length || (match instrs.[pc'] with I_ret -> false | _ -> true) then
+ failwithf "a tailcall must be followed by a return, instrs = %A" instrs
+ elif (match nextBBstartPc with Some pc'' -> pc' = pc'' | _ -> false) then
+ // In this obscure case, someone branches to the return instruction
+ // following the tailcall, so we'd better build a basic block
+ // containing just that return instruction.
+ pc', List.rev (i :: rinstrs)
+ else
+ // Otherwise skip the return instruction, but keep the tailcall.
+ pc'+1, List.rev (i :: rinstrs)
+ else
+ pc', List.rev (i :: rinstrs)
+ else
+ // recursive case
+ consumeBBlockInstrs instrs (i::rinstrs) pc' nextBBstartPc
+
+ (* type block = (int * int) * Code // a local type (alias) would be good, good for intelisense too *)
+ let rec consumeOneBlock bbstartPc nextBBstartPc currentPc =
+ if currentPc = (Array.length instrs) then None
+ elif bbstartPc < currentPc then failwith "internal error: bad basic block structure (missing bblock start marker?)"
+ elif bbstartPc > currentPc then
+ (* dprintn ("* ignoring unreachable instruction in method: "^ methName); *)
+ consumeOneBlock bbstartPc nextBBstartPc (currentPc + 1)
+ else
+ let pc', bblockInstrs = consumeBBlockInstrs instrs [] bbstartPc nextBBstartPc
+ if logging then dprintf "-- making bblock, entry label is %s, length = %d, bbstartPc = %d\n" (formatCodeLabel (bbstartToCodeLabelMap.pc2cl bbstartPc)) (List.length bblockInstrs) bbstartPc;
+ let bblock = mkBasicBlock {Label= bbstartToCodeLabelMap.pc2cl bbstartPc; Instructions=Array.ofList bblockInstrs}
+
+ let bblockRange = (bbstartPc, pc')
+ // Return the bblock and the range of instructions that the bblock covered.
+ // Also return any remaining instructions and the pc' for the first
+ // such instruction.
+ Some ((bblockRange, bblock), pc')
+
+ let fetchBasicBlocks bbstartToCodeLabelMap currentPc =
+ let rec loop bbstartToCodeLabelMap currentPc acc =
+ match bbstartToCodeLabelMap with
+ | [] ->
+ (* if currentPc <> Array.length instrs then
+ dprintn ("* ignoring instructions at end of method: "+ methName); *)
+ List.rev acc
+ | h::t ->
+ let h2 = match t with [] -> None | h2:: _ -> assert (not (h = h2)); Some h2
+ match consumeOneBlock h h2 currentPc with
+ | None -> List.rev acc
+ | Some (bblock, currentPc') -> loop t currentPc' (bblock :: acc)
+ loop bbstartToCodeLabelMap currentPc []
+
+ let inside range (brange,_) =
+ if rangeInsideRange brange range then true else
+ if disjoint_range brange range then false else
+ failwith "exception block specification overlaps the range of a basic block"
+
+ (* A "blocks" contain blocks, ordered on startPC.
+ * Recall, a block is (range,code) where range=(pcStart,pcLast+1). *)
+ let addBlock m (((startPC,_endPC),_code) as block) =
+ match Zmap.tryFind startPC m with
+ | None -> Zmap.add startPC [block] m
+ | Some blocks -> Zmap.add startPC (block :: blocks) m in (* NOTE: may reverse block *)
+
+ let addBlocks m blocks = List.fold addBlock m blocks
+
+ let mkBlocks blocks =
+ let emptyBlocks = (Zmap.empty int_order : Zmap)
+ List.fold addBlock emptyBlocks blocks
+
+ let sanityCheck = false (* linear check - REVIEW: set false and elim checks *)
+
+ let computeCoveredBlocks ((start_pc,end_pc) as range) (blocks: Zmap ) =
+ // It is assumed that scopes never overlap.
+ // locinfo scopes could overlap if there is a bug elsewhere.
+ // If overlaps are discovered, an exception is raised. see NOTE#overlap.
+ let pcCovered,blocks = popRangeM start_pc (end_pc - 1) blocks
+ let coveredBlocks = pcCovered |> List.concat
+ // Look for bad input, e.g. overlapping locinfo scopes.
+ let overlapBlocks = List.filter (inside range >> not) coveredBlocks
+ if not (isNil overlapBlocks) then notFound(); (* see NOTE#overlap *)
+ if sanityCheck then (
+ let assertIn block = assert (inside range block)
+ let assertOut block = assert (not (inside range block))
+ List.iter assertIn coveredBlocks;
+ Zmap.iter (fun _ bs -> List.iter assertOut bs) blocks
+ );
+ coveredBlocks,blocks
+
+ let coverageOfCodes blocks =
+ match blocks with
+ | [] -> failwith "start_of_codes"
+ | [(r,_)] -> r
+ | ((r,_)::t) -> List.foldBack (fun (x,_) acc -> merge_ranges x acc) t r
+
+ delayInsertedToWorkaroundKnownNgenBug "Delay4i3" <| fun () ->
+
+ let doStructure = doStructure' (codeOffsetView, computeCoveredBlocks,coverageOfCodes,addBlocks,bbstartToCodeLabelMap)
+
+ (* Apply stage 1. Compute the blocks not taking exceptions into account. *)
+ let bblocks =
+ fetchBasicBlocks (List.sort bbstartToCodeLabelMap.BasicBlockStartPositions) 0
+
+ let bblocks = mkBlocks bblocks
+ (* Apply stage 2. Compute the overall morphed blocks. *)
+ let morphedBlocks,remaining_entries =
+ let specs1 = List.map (fun x -> SEH x) tryspecs
+ let specs2 = List.map (fun x -> LOCAL x) localspecs
+
+ try
+ doStructure (specs1 @ specs2) (bblocks,bbstartToCodeLabelMap.BasicBlockStartCodeLabels)
+ with :? KeyNotFoundException->
+ // NOTE#overlap.
+ // Here, "Not_found" indicates overlapping scopes were found.
+ // Maybe the calling code got the locspecs scopes wrong.
+ // Try recovery by discarding locspec info...
+ let string_of_tryspec _tryspec = "tryspec"
+ let stringOfRange (l1,l2) =
+ let pc1,pc2 = codeOffsetView.labelsToRange ((l1,l2))
+ formatCodeLabel l1+"("+string pc1+")-"+ formatCodeLabel l2+"("+string pc2+")"
+ let string_of_locspec locspec = "local "+(String.concat ";" (locspec.locInfos |> List.map (fun l -> l.LocalName)))+": "+ stringOfRange locspec.locRange
+
+ dprintf "\nERROR: could not find an innermost exception block or local scope, specs = \n%s\nTrying again without locals."
+ (String.concat "\n" (List.map string_of_tryspec tryspecs @ List.map string_of_locspec localspecs));
+ doStructure specs1 (bblocks,bbstartToCodeLabelMap.BasicBlockStartCodeLabels)
+
+ delayInsertedToWorkaroundKnownNgenBug "Delay4k" <| fun () ->
+
+ let morphedBlocks = Zmap.values morphedBlocks |> List.concat in (* NOTE: may mixup order *)
+ (* Now join up all the remaining blocks into one block with one entry. *)
+ if logging then dprintn "-- computing entry label";
+ if logging then dprintn ("-- entry label is "+formatCodeLabel bbstartToCodeLabelMap.InitialCodeLabel);
+ mkGroupBlock
+ (CodeLabels.toList (CodeLabels.remove bbstartToCodeLabelMap.InitialCodeLabel remaining_entries),List.map snd morphedBlocks)
+
+
+ try buildCodeFromInstructionArray basicInstructions
+ with e ->
+ dprintn ("* error while converting instructions to code for method: " + methName);
+ reraise()
+
+// --------------------------------------------------------------------
+// Detecting Delegates
+// --------------------------------------------------------------------
+
+let mkILDelegateMethods ilg (parms,rtv:ILReturn) =
+ let rty = rtv.Type
+ let one nm args ret =
+ let mdef = mkILNonGenericVirtualMethod (nm,ILMemberAccess.Public,args,mkILReturn ret,MethodBody.Abstract)
+ {mdef with
+ mdKind=
+ match mdef.mdKind with
+ | MethodKind.Virtual vinfo -> MethodKind.Virtual {vinfo with IsAbstract=false; }
+ | k -> k
+ mdCodeKind=MethodCodeKind.Runtime;
+ IsHideBySig=true; }
+ let ctor = mkILCtor(ILMemberAccess.Public, [ mkILParamNamed("object",ilg.typ_Object); mkILParamNamed("method",ilg.typ_IntPtr) ], MethodBody.Abstract)
+ let ctor = { ctor with mdCodeKind=MethodCodeKind.Runtime; IsHideBySig=true }
+ [ ctor;
+ one "Invoke" parms rty;
+ one "BeginInvoke" (parms @ [mkILParamNamed("callback",ilg.typ_AsyncCallback); mkILParamNamed("objects",ilg.typ_Object) ] ) ilg.typ_IAsyncResult;
+ one "EndInvoke" [mkILParamNamed("result",ilg.typ_IAsyncResult)] rty; ]
+
+
+let mkCtorMethSpecForDelegate ilg (typ:ILType,useUIntPtr) =
+ let scoref = typ.TypeRef.Scope
+ mkILInstanceMethSpecInTy (typ,".ctor",[rescopeILType scoref ilg.typ_Object; rescopeILType scoref (if useUIntPtr then ilg.typ_UIntPtr else ilg.typ_IntPtr)],ILType.Void,emptyILGenericArgsList)
+
+type ILEnumInfo =
+ { enumValues: (string * ILFieldInit) list;
+ enumType: ILType }
+
+let getTyOfILEnumInfo info = info.enumType
+
+let computeILEnumInfo (mdName,mdFields: ILFieldDefs) =
+ match (List.partition (fun fd -> fd.IsStatic) mdFields.AsList) with
+ | staticFields,[vfd] ->
+ { enumType = vfd.Type;
+ enumValues = staticFields |> List.map (fun fd -> (fd.Name, match fd.LiteralValue with Some i -> i | None -> failwith ("info_of_enum_tdef: badly formed enum "+mdName+": static field does not have an default value"))) }
+ | _,[] -> failwith ("info_of_enum_tdef: badly formed enum "+mdName+": no non-static field found")
+ | _,_ -> failwith ("info_of_enum_tdef: badly formed enum "+mdName+": more than one non-static field found")
+
+
+
+//---------------------------------------------------------------------
+// Primitives to help read signatures. These do not use the file cursor, but
+// pass around an int index
+//---------------------------------------------------------------------
+
+let sigptr_get_byte bytes sigptr =
+ Bytes.get bytes sigptr, sigptr + 1
+
+let sigptr_get_bool bytes sigptr =
+ let b0,sigptr = sigptr_get_byte bytes sigptr
+ (b0 = 0x01) ,sigptr
+
+let sigptr_get_u8 bytes sigptr =
+ let b0,sigptr = sigptr_get_byte bytes sigptr
+ byte b0,sigptr
+
+let sigptr_get_i8 bytes sigptr =
+ let i,sigptr = sigptr_get_u8 bytes sigptr
+ sbyte i,sigptr
+
+let sigptr_get_u16 bytes sigptr =
+ let b0,sigptr = sigptr_get_byte bytes sigptr
+ let b1,sigptr = sigptr_get_byte bytes sigptr
+ uint16 (b0 ||| (b1 <<< 8)),sigptr
+
+let sigptr_get_i16 bytes sigptr =
+ let u,sigptr = sigptr_get_u16 bytes sigptr
+ int16 u,sigptr
+
+let sigptr_get_i32 bytes sigptr =
+ let b0,sigptr = sigptr_get_byte bytes sigptr
+ let b1,sigptr = sigptr_get_byte bytes sigptr
+ let b2,sigptr = sigptr_get_byte bytes sigptr
+ let b3,sigptr = sigptr_get_byte bytes sigptr
+ b0 ||| (b1 <<< 8) ||| (b2 <<< 16) ||| (b3 <<< 24),sigptr
+
+let sigptr_get_u32 bytes sigptr =
+ let u,sigptr = sigptr_get_i32 bytes sigptr
+ uint32 u,sigptr
+
+let sigptr_get_i64 bytes sigptr =
+ let b0,sigptr = sigptr_get_byte bytes sigptr
+ let b1,sigptr = sigptr_get_byte bytes sigptr
+ let b2,sigptr = sigptr_get_byte bytes sigptr
+ let b3,sigptr = sigptr_get_byte bytes sigptr
+ let b4,sigptr = sigptr_get_byte bytes sigptr
+ let b5,sigptr = sigptr_get_byte bytes sigptr
+ let b6,sigptr = sigptr_get_byte bytes sigptr
+ let b7,sigptr = sigptr_get_byte bytes sigptr
+ int64 b0 ||| (int64 b1 <<< 8) ||| (int64 b2 <<< 16) ||| (int64 b3 <<< 24) |||
+ (int64 b4 <<< 32) ||| (int64 b5 <<< 40) ||| (int64 b6 <<< 48) ||| (int64 b7 <<< 56),
+ sigptr
+
+let sigptr_get_u64 bytes sigptr =
+ let u,sigptr = sigptr_get_i64 bytes sigptr
+ uint64 u,sigptr
+
+let float32_of_bits (x:int32) = System.BitConverter.ToSingle(System.BitConverter.GetBytes(x),0)
+let float_of_bits (x:int64) = System.BitConverter.Int64BitsToDouble(x)
+
+let sigptr_get_ieee32 bytes sigptr =
+ let u,sigptr = sigptr_get_i32 bytes sigptr
+ float32_of_bits u,sigptr
+
+let sigptr_get_ieee64 bytes sigptr =
+ let u,sigptr = sigptr_get_i64 bytes sigptr
+ float_of_bits u,sigptr
+
+let sigptr_get_intarray n (bytes:byte[]) sigptr =
+ let res = Bytes.zeroCreate n
+ for i = 0 to n - 1 do
+ res.[i] <- bytes.[sigptr + i]
+ res, sigptr + n
+
+let sigptr_get_string n bytes sigptr =
+ let intarray,sigptr = sigptr_get_intarray n bytes sigptr
+ System.Text.Encoding.UTF8.GetString(intarray , 0, intarray.Length), sigptr
+
+let sigptr_get_z_i32 bytes sigptr =
+ let b0,sigptr = sigptr_get_byte bytes sigptr
+ if b0 <= 0x7F then b0, sigptr
+ elif b0 <= 0xbf then
+ let b0 = b0 &&& 0x7f
+ let b1,sigptr = sigptr_get_byte bytes sigptr
+ (b0 <<< 8) ||| b1, sigptr
+ else
+ let b0 = b0 &&& 0x3f
+ let b1,sigptr = sigptr_get_byte bytes sigptr
+ let b2,sigptr = sigptr_get_byte bytes sigptr
+ let b3,sigptr = sigptr_get_byte bytes sigptr
+ (b0 <<< 24) ||| (b1 <<< 16) ||| (b2 <<< 8) ||| b3, sigptr
+
+let sigptr_get_serstring bytes sigptr =
+ let len,sigptr = sigptr_get_z_i32 bytes sigptr
+ sigptr_get_string ( len) bytes sigptr
+
+let sigptr_get_serstring_possibly_null bytes sigptr =
+ let b0,new_sigptr = sigptr_get_byte bytes sigptr
+ if b0 = 0xFF then // null case
+ None,new_sigptr
+ else // throw away new_sigptr, getting length & text advance
+ let len,sigptr = sigptr_get_z_i32 bytes sigptr
+ let s, sigptr = sigptr_get_string len bytes sigptr
+ Some(s),sigptr
+
+//---------------------------------------------------------------------
+// Get the public key token from the public key.
+//---------------------------------------------------------------------
+
+
+let mkRefToILAssembly (m: ILAssemblyManifest) =
+ ILAssemblyRef.Create(m.Name, None, (match m.PublicKey with Some k -> Some (PublicKey.KeyAsToken(k)) | None -> None), m.Retargetable, m.Version, m.Locale)
+
+let z_unsigned_int_size n =
+ if n <= 0x7F then 1
+ elif n <= 0x3FFF then 2
+ else 3
+
+let z_unsigned_int n =
+ if n >= 0 && n <= 0x7F then [| byte n |]
+ elif n >= 0x80 && n <= 0x3FFF then [| byte (0x80 ||| (n >>>& 8)); byte (n &&& 0xFF) |]
+ else [| byte (0xc0 ||| (n >>>& 24));
+ byte ((n >>>& 16) &&& 0xFF);
+ byte ((n >>>& 8) &&& 0xFF);
+ byte (n &&& 0xFF) |]
+
+let string_as_utf8_bytes (s:string) = System.Text.Encoding.UTF8.GetBytes s
+
+(* Little-endian encoding of int64 *)
+let dw7 n = byte ((n >>> 56) &&& 0xFFL)
+let dw6 n = byte ((n >>> 48) &&& 0xFFL)
+let dw5 n = byte ((n >>> 40) &&& 0xFFL)
+let dw4 n = byte ((n >>> 32) &&& 0xFFL)
+let dw3 n = byte ((n >>> 24) &&& 0xFFL)
+let dw2 n = byte ((n >>> 16) &&& 0xFFL)
+let dw1 n = byte ((n >>> 8) &&& 0xFFL)
+let dw0 n = byte (n &&& 0xFFL)
+
+let u8AsBytes (i:byte) = [| i |]
+let u16AsBytes x = let n = (int x) in [| byte (b0 n); byte (b1 n) |]
+let i32AsBytes i = [| byte (b0 i); byte (b1 i); byte (b2 i); byte (b3 i) |]
+let i64AsBytes i = [| dw0 i; dw1 i; dw2 i; dw3 i; dw4 i; dw5 i; dw6 i; dw7 i |]
+
+let i8AsBytes (i:sbyte) = u8AsBytes (byte i)
+let i16AsBytes (i:int16) = u16AsBytes (uint16 i)
+let u32AsBytes (i:uint32) = i32AsBytes (int32 i)
+let u64AsBytes (i:uint64) = i64AsBytes (int64 i)
+
+let bits_of_float32 (x:float32) = System.BitConverter.ToInt32(System.BitConverter.GetBytes(x),0)
+let bits_of_float (x:float) = System.BitConverter.DoubleToInt64Bits(x)
+
+let ieee32AsBytes i = i32AsBytes (bits_of_float32 i)
+let ieee64AsBytes i = i64AsBytes (bits_of_float i)
+
+let et_END = 0x00uy
+let et_VOID = 0x01uy
+let et_BOOLEAN = 0x02uy
+let et_CHAR = 0x03uy
+let et_I1 = 0x04uy
+let et_U1 = 0x05uy
+let et_I2 = 0x06uy
+let et_U2 = 0x07uy
+let et_I4 = 0x08uy
+let et_U4 = 0x09uy
+let et_I8 = 0x0Auy
+let et_U8 = 0x0Buy
+let et_R4 = 0x0Cuy
+let et_R8 = 0x0Duy
+let et_STRING = 0x0Euy
+let et_PTR = 0x0Fuy
+let et_BYREF = 0x10uy
+let et_VALUETYPE = 0x11uy
+let et_CLASS = 0x12uy
+let et_VAR = 0x13uy
+let et_ARRAY = 0x14uy
+let et_WITH = 0x15uy
+let et_TYPEDBYREF = 0x16uy
+let et_I = 0x18uy
+let et_U = 0x19uy
+let et_FNPTR = 0x1Buy
+let et_OBJECT = 0x1Cuy
+let et_SZARRAY = 0x1Duy
+let et_MVAR = 0x1Euy
+let et_CMOD_REQD = 0x1Fuy
+let et_CMOD_OPT = 0x20uy
+
+let formatILVersion ((a,b,c,d):ILVersionInfo) = sprintf "%d.%d.%d.%d" (int a) (int b) (int c) (int d)
+
+let encodeCustomAttrString s =
+ let arr = string_as_utf8_bytes s
+ Array.concat [ z_unsigned_int arr.Length; arr ]
+
+let rec encodeCustomAttrElemType x =
+ match x with
+ | ILType.Value tspec when tspec.Name = "System.SByte" -> [| et_I1 |]
+ | ILType.Value tspec when tspec.Name = "System.Byte" -> [| et_U1 |]
+ | ILType.Value tspec when tspec.Name = "System.Int16" -> [| et_I2 |]
+ | ILType.Value tspec when tspec.Name = "System.UInt16" -> [| et_U2 |]
+ | ILType.Value tspec when tspec.Name = "System.Int32" -> [| et_I4 |]
+ | ILType.Value tspec when tspec.Name = "System.UInt32" -> [| et_U4 |]
+ | ILType.Value tspec when tspec.Name = "System.Int64" -> [| et_I8 |]
+ | ILType.Value tspec when tspec.Name = "System.UInt64" -> [| et_U8 |]
+ | ILType.Value tspec when tspec.Name = "System.Double" -> [| et_R8 |]
+ | ILType.Value tspec when tspec.Name = "System.Single" -> [| et_R4 |]
+ | ILType.Value tspec when tspec.Name = "System.Char" -> [| et_CHAR |]
+ | ILType.Value tspec when tspec.Name = "System.Boolean" -> [| et_BOOLEAN |]
+ | ILType.Boxed tspec when tspec.Name = "System.String" -> [| et_STRING |]
+ | ILType.Boxed tspec when tspec.Name = "System.Object" -> [| 0x51uy |]
+ | ILType.Boxed tspec when tspec.Name = "System.Type" -> [| 0x50uy |]
+ | ILType.Value tspec -> Array.append [| 0x55uy |] (encodeCustomAttrString tspec.TypeRef.QualifiedNameWithNoShortMscorlib)
+ | ILType.Array (shape, elemType) when shape = ILArrayShape.SingleDimensional ->
+ Array.append [| et_SZARRAY |] (encodeCustomAttrElemType elemType)
+ | _ -> failwith "encodeCustomAttrElemType: unrecognized custom element type"
+
+/// Given a custom attribute element, work out the type of the .NET argument for that element
+let rec encodeCustomAttrElemTypeForObject x =
+ match x with
+ | ILAttribElem.String _ -> [| et_STRING |]
+ | ILAttribElem.Bool _ -> [| et_BOOLEAN |]
+ | ILAttribElem.Char _ -> [| et_CHAR |]
+ | ILAttribElem.SByte _ -> [| et_I1 |]
+ | ILAttribElem.Int16 _ -> [| et_I2 |]
+ | ILAttribElem.Int32 _ -> [| et_I4 |]
+ | ILAttribElem.Int64 _ -> [| et_I8 |]
+ | ILAttribElem.Byte _ -> [| et_U1 |]
+ | ILAttribElem.UInt16 _ -> [| et_U2 |]
+ | ILAttribElem.UInt32 _ -> [| et_U4 |]
+ | ILAttribElem.UInt64 _ -> [| et_U8 |]
+ | ILAttribElem.Type _ -> [| 0x50uy |]
+ | ILAttribElem.TypeRef _ -> [| 0x50uy |]
+ | ILAttribElem.Null _ -> [| et_STRING |]// yes, the 0xe prefix is used when passing a "null" to a property or argument of type "object" here
+ | ILAttribElem.Single _ -> [| et_R4 |]
+ | ILAttribElem.Double _ -> [| et_R8 |]
+ | ILAttribElem.Array (elemTy,_) -> [| yield et_SZARRAY; yield! encodeCustomAttrElemType elemTy |]
+
+
+let rec decodeCustomAttrElemType ilg bytes sigptr x =
+ match x with
+ | x when x = et_I1 -> ilg.typ_SByte, sigptr
+ | x when x = et_U1 -> ilg.typ_Byte, sigptr
+ | x when x = et_I2 -> ilg.typ_Int16, sigptr
+ | x when x = et_U2 -> ilg.typ_UInt16, sigptr
+ | x when x = et_I4 -> ilg.typ_Int32, sigptr
+ | x when x = et_U4 -> ilg.typ_UInt32, sigptr
+ | x when x = et_I8 -> ilg.typ_Int64, sigptr
+ | x when x = et_U8 -> ilg.typ_UInt64, sigptr
+ | x when x = et_R8 -> ilg.typ_Double, sigptr
+ | x when x = et_R4 -> ilg.typ_Single, sigptr
+ | x when x = et_CHAR -> ilg.typ_Char, sigptr
+ | x when x = et_BOOLEAN -> ilg.typ_Bool, sigptr
+ | x when x = et_STRING -> ilg.typ_String, sigptr
+ | x when x = et_OBJECT -> ilg.typ_Object, sigptr
+ | x when x = et_SZARRAY ->
+ let et,sigptr = sigptr_get_u8 bytes sigptr
+ let elemTy,sigptr = decodeCustomAttrElemType ilg bytes sigptr et
+ mkILArr1DTy elemTy, sigptr
+ | x when x = 0x50uy -> ilg.typ_Type, sigptr
+ | _ -> failwithf "decodeCustomAttrElemType ilg: unrecognized custom element type: %A" x
+
+
+/// Given a custom attribute element, encode it to a binary representation according to the rules in Ecma 335 Partition II.
+let rec encodeCustomAttrPrimValue ilg c =
+ match c with
+ | ILAttribElem.Bool b -> [| (if b then 0x01uy else 0x00uy) |]
+ | ILAttribElem.String None
+ | ILAttribElem.Type None
+ | ILAttribElem.TypeRef None
+ | ILAttribElem.Null -> [| 0xFFuy |]
+ | ILAttribElem.String (Some s) -> encodeCustomAttrString s
+ | ILAttribElem.Char x -> u16AsBytes (uint16 x)
+ | ILAttribElem.SByte x -> i8AsBytes x
+ | ILAttribElem.Int16 x -> i16AsBytes x
+ | ILAttribElem.Int32 x -> i32AsBytes x
+ | ILAttribElem.Int64 x -> i64AsBytes x
+ | ILAttribElem.Byte x -> u8AsBytes x
+ | ILAttribElem.UInt16 x -> u16AsBytes x
+ | ILAttribElem.UInt32 x -> u32AsBytes x
+ | ILAttribElem.UInt64 x -> u64AsBytes x
+ | ILAttribElem.Single x -> ieee32AsBytes x
+ | ILAttribElem.Double x -> ieee64AsBytes x
+ | ILAttribElem.Type (Some ty) -> encodeCustomAttrString ty.QualifiedNameWithNoShortMscorlib
+ | ILAttribElem.TypeRef (Some tref) -> encodeCustomAttrString tref.QualifiedNameWithNoShortMscorlib
+ | ILAttribElem.Array (_,elems) ->
+ [| yield! i32AsBytes elems.Length; for elem in elems do yield! encodeCustomAttrPrimValue ilg elem |]
+
+and encodeCustomAttrValue ilg ty c =
+ match ty, c with
+ | ILType.Boxed tspec, _ when tspec.Name = "System.Object" ->
+ [| yield! encodeCustomAttrElemTypeForObject c; yield! encodeCustomAttrPrimValue ilg c |]
+ | ILType.Array (shape, elemType), ILAttribElem.Array (_,elems) when shape = ILArrayShape.SingleDimensional ->
+ [| yield! i32AsBytes elems.Length; for elem in elems do yield! encodeCustomAttrValue ilg elemType elem |]
+ | _ ->
+ encodeCustomAttrPrimValue ilg c
+
+let encodeCustomAttrNamedArg ilg (nm, ty, prop, elem) =
+ [| yield (if prop then 0x54uy else 0x53uy)
+ yield! encodeCustomAttrElemType ty;
+ yield! encodeCustomAttrString nm;
+ yield! encodeCustomAttrValue ilg ty elem |]
+
+let mkILCustomAttribMethRef (ilg: ILGlobals) (mspec:ILMethodSpec, fixedArgs: list<_>, namedArgs: list<_>) =
+ let argtys = mspec.MethodRef.ArgTypes
+ let args =
+ [| yield! [| 0x01uy; 0x00uy; |]
+ for (argty,fixedArg) in Seq.zip argtys fixedArgs do
+ yield! encodeCustomAttrValue ilg argty fixedArg
+ yield! u16AsBytes (uint16 namedArgs.Length)
+ for namedArg in namedArgs do
+ yield! encodeCustomAttrNamedArg ilg namedArg |]
+
+ { Method = mspec;
+#if SILVERLIGHT
+ Arguments = fixedArgs, namedArgs
+#endif
+ Data = args }
+
+let mkILCustomAttribute ilg (tref,argtys,argvs,propvs) =
+ mkILCustomAttribMethRef ilg (mkILNonGenericCtorMethSpec (tref,argtys),argvs,propvs)
+
+(* Q: CompilerGeneratedAttribute is new in 2.0. Unconditional generation of this attribute prevents running on 1.1 Framework. (discovered running on early mono version). *)
+let tref_CompilerGeneratedAttribute ilg = mkILTyRef (ilg.mscorlibScopeRef,tname_CompilerGeneratedAttribute)
+
+let tname_DebuggerNonUserCodeAttribute = "System.Diagnostics.DebuggerNonUserCodeAttribute"
+let tname_DebuggableAttribute_DebuggingModes = "DebuggingModes"
+let tname_DebuggerHiddenAttribute = "System.Diagnostics.DebuggerHiddenAttribute"
+let tname_DebuggerDisplayAttribute = "System.Diagnostics.DebuggerDisplayAttribute"
+let tname_DebuggerTypeProxyAttribute = "System.Diagnostics.DebuggerTypeProxyAttribute"
+let tname_DebuggerStepThroughAttribute = "System.Diagnostics.DebuggerStepThroughAttribute"
+let tname_DebuggerBrowsableAttribute = "System.Diagnostics.DebuggerBrowsableAttribute"
+let tname_DebuggerBrowsableState = "System.Diagnostics.DebuggerBrowsableState"
+
+let tref_DebuggerNonUserCodeAttribute ilg = mkILTyRef (ilg.mscorlibScopeRef,tname_DebuggerNonUserCodeAttribute)
+let tref_DebuggerStepThroughAttribute ilg = mkILTyRef (ilg.mscorlibScopeRef,tname_DebuggerStepThroughAttribute)
+let tref_DebuggerHiddenAttribute ilg = mkILTyRef (ilg.mscorlibScopeRef,tname_DebuggerHiddenAttribute)
+let tref_DebuggerDisplayAttribute ilg = mkILTyRef (ilg.mscorlibScopeRef,tname_DebuggerDisplayAttribute)
+let tref_DebuggerTypeProxyAttribute ilg = mkILTyRef (ilg.mscorlibScopeRef,tname_DebuggerTypeProxyAttribute)
+let tref_DebuggerBrowsableAttribute ilg = mkILTyRef (ilg.mscorlibScopeRef,tname_DebuggerBrowsableAttribute)
+let tref_DebuggableAttribute ilg = mkILTyRef (ilg.mscorlibScopeRef,tname_DebuggableAttribute)
+let tref_DebuggableAttribute_DebuggingModes ilg = mkILNestedTyRef (ilg.mscorlibScopeRef,[tname_DebuggableAttribute],tname_DebuggableAttribute_DebuggingModes)
+
+let typ_DebuggerBrowsableState ilg =
+ let tref_DebuggerBrowsableState = mkILTyRef(ilg.mscorlibScopeRef,tname_DebuggerBrowsableState)
+ ILType.Value (mkILNonGenericTySpec tref_DebuggerBrowsableState)
+
+let mkCompilerGeneratedAttribute ilg = mkILCustomAttribute ilg (tref_CompilerGeneratedAttribute ilg,[],[],[])
+let mkDebuggerNonUserCodeAttribute ilg = mkILCustomAttribute ilg (tref_DebuggerNonUserCodeAttribute ilg,[],[],[])
+let mkDebuggerHiddenAttribute ilg = mkILCustomAttribute ilg (tref_DebuggerHiddenAttribute ilg,[],[],[])
+let mkDebuggerDisplayAttribute ilg s = mkILCustomAttribute ilg (tref_DebuggerDisplayAttribute ilg,[ilg.typ_String],[ILAttribElem.String (Some s)],[])
+let mkDebuggerTypeProxyAttribute ilg (ty:ILType) =
+ mkILCustomAttribute ilg (tref_DebuggerTypeProxyAttribute ilg,[ilg.typ_Type],[ILAttribElem.TypeRef (Some ty.TypeRef)],[])
+let mkDebuggerBrowsableAttribute ilg n = mkILCustomAttribute ilg (tref_DebuggerBrowsableAttribute ilg,[typ_DebuggerBrowsableState ilg],[ILAttribElem.Int32 n],[])
+let mkDebuggerBrowsableNeverAttribute ilg =
+ match ilg.debuggerBrowsableNeverAttributeCache with
+ | None ->
+ let res = mkDebuggerBrowsableAttribute ilg 0
+ ilg.debuggerBrowsableNeverAttributeCache <- Some res
+ res
+ | Some res -> res
+let mkDebuggerStepThroughAttribute ilg = mkILCustomAttribute ilg (tref_DebuggerStepThroughAttribute ilg,[],[],[])
+let mkDebuggableAttribute ilg (jitTracking, jitOptimizerDisabled) =
+ mkILCustomAttribute ilg (tref_DebuggableAttribute ilg,[ilg.typ_Bool;ilg.typ_Bool], [ILAttribElem.Bool jitTracking; ILAttribElem.Bool jitOptimizerDisabled],[])
+
+
+// Bug 2129. Requests attributes to be added to compiler generated methods
+let addGeneratedAttrs ilg (attrs: ILAttributes) =
+ let attribs =
+ match ilg.generatedAttribsCache with
+ | [] ->
+ let res = [ if not ilg.noDebugData then
+ yield mkCompilerGeneratedAttribute ilg
+ yield mkDebuggerNonUserCodeAttribute ilg]
+ ilg.generatedAttribsCache <- res
+ res
+ | res -> res
+ mkILCustomAttrs (attrs.AsList @ attribs)
+
+let addMethodGeneratedAttrs ilg (mdef:ILMethodDef) = {mdef with CustomAttrs = addGeneratedAttrs ilg mdef.CustomAttrs}
+let addPropertyGeneratedAttrs ilg (pdef:ILPropertyDef) = {pdef with CustomAttrs = addGeneratedAttrs ilg pdef.CustomAttrs}
+let addFieldGeneratedAttrs ilg (fdef:ILFieldDef) = {fdef with CustomAttrs = addGeneratedAttrs ilg fdef.CustomAttrs}
+
+let add_never_attrs ilg (attrs: ILAttributes) =
+ if ilg.generateDebugBrowsableData then mkILCustomAttrs (attrs.AsList @ [mkDebuggerBrowsableNeverAttribute ilg])
+ else attrs
+let addPropertyNeverAttrs ilg (pdef:ILPropertyDef) = {pdef with CustomAttrs = add_never_attrs ilg pdef.CustomAttrs}
+let addFieldNeverAttrs ilg (fdef:ILFieldDef) = {fdef with CustomAttrs = add_never_attrs ilg fdef.CustomAttrs}
+
+
+// PermissionSet is a 'blob' having the following format:
+// • A byte containing a period (.).
+// • A compressed int32 containing the number of attributes encoded in the blob.
+// • An array of attributes each containing the following:
+// o A String, which is the fully-qualified type name of the attribute. (Strings are encoded
+// as a compressed int to indicate the size followed by an array of UTF8 characters.)
+// o A set of properties, encoded as the named arguments to a custom attribute would be (as
+// in §23.3, beginning with NumNamed).
+let mkPermissionSet (ilg: ILGlobals) (action,attributes: list<(ILTypeRef * (string * ILType * ILAttribElem) list)>) =
+ let bytes =
+ [| yield (byte '.');
+ yield! z_unsigned_int attributes.Length;
+ for (tref:ILTypeRef,props) in attributes do
+ yield! encodeCustomAttrString tref.QualifiedNameWithNoShortMscorlib
+ let bytes =
+ [| yield! z_unsigned_int props.Length;
+ for (nm,typ,value) in props do
+ yield! encodeCustomAttrNamedArg ilg (nm,typ,true,value)|]
+ yield! z_unsigned_int bytes.Length;
+ yield! bytes |]
+
+ PermissionSet(action,bytes)
+
+
+// Parse an IL type signature argument within a custom attribute blob
+type ILTypeSigParser(tstring : string) =
+
+ let mutable startPos = 0
+ let mutable currentPos = 0
+
+ let reset() = startPos <- 0 ; currentPos <- 0
+ let nil = '\r' // cannot appear in a type sig
+
+ // take a look at the next value, but don't advance
+ let peek() = if currentPos < (tstring.Length-1) then tstring.[currentPos+1] else nil
+ let peekN(skip) = if currentPos < (tstring.Length - skip) then tstring.[currentPos+skip] else nil
+ // take a look at the current value, but don't advance
+ let here() = if currentPos < tstring.Length then tstring.[currentPos] else nil
+ // move on to the next character
+ let step() = currentPos <- currentPos+1
+ // ignore the current lexeme
+ let skip() = startPos <- currentPos
+ // ignore the current lexeme, advance
+ let drop() = skip() ; step() ; skip()
+ // return the current lexeme, advance
+ let take() =
+ let s = if currentPos < tstring.Length then tstring.[startPos..currentPos] else ""
+ drop()
+ s
+
+ // The format we accept is
+ // "{`[,+]}{}{}" E.g.,
+ //
+ // System.Collections.Generic.Dictionary
+ // `2[
+ // [System.Int32, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089],
+ // dev.virtualearth.net.webservices.v1.search.CategorySpecificPropertySet],
+ // mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"
+ //
+ // Note that
+ // • Since we're only reading valid IL, we assume that the signature is properly formed
+ // • For type parameters, if the type is non-local, it will be wrapped in brackets ([])
+ // • Still needs testing with jagged arrays and byref parameters
+ member private x.ParseType() =
+
+ // Does the type name start with a leading '['? If so, ignore it
+ // (if the specialization type is in another module, it will be wrapped in bracket)
+ if here() = '[' then drop()
+
+ // 1. Iterate over beginning of type, grabbing the type name and determining if it's generic or an array
+ let typeName =
+ while (peek() <> '`') && (peek() <> '[') && (peek() <> ']') && (peek() <> ',') && (peek() <> nil) do step()
+ take()
+
+ // 2. Classify the type
+
+ // Is the type generic?
+ let typeName, specializations =
+ if here() = '`' then
+ drop() // step to the number
+ // fetch the arity
+ let arity =
+ while (int(here()) >= (int('0'))) && (int(here()) <= ((int('9')))) && (int(peek()) >= (int('0'))) && (int(peek()) <= ((int('9')))) do step()
+ System.Int32.Parse(take())
+ // skip the '['
+ drop()
+ // get the specializations
+ typeName+"`"+(arity.ToString()), Some(([for _i in 0..arity-1 do yield x.ParseType()]))
+ else
+ typeName, None
+
+ // Is the type an array?
+ let rank =
+ if here() = '[' then
+ let mutable rank = 0
+
+ while here() <> ']' do
+ rank <- rank + 1
+ step()
+ drop()
+
+ Some(ILArrayShape(List.repeat rank (Some 0, None)))
+ else
+ None
+
+ // Is there a scope?
+ let scope =
+ if (here() = ',' || here() = ' ') && (peek() <> '[' && peekN(2) <> '[') then
+ let grabScopeComponent() =
+ if here() = ',' then drop() // ditch the ','
+ if here() = ' ' then drop() // ditch the ' '
+
+ while (peek() <> ',' && peek() <> ']' && peek() <> nil) do step()
+ take()
+
+ let scope =
+ [ yield grabScopeComponent() // assembly
+ yield grabScopeComponent() // version
+ yield grabScopeComponent() // culture
+ yield grabScopeComponent() // public key token
+ ] |> String.concat ","
+ ILScopeRef.Assembly(ILAssemblyRef.FromAssemblyName(System.Reflection.AssemblyName(scope)))
+ else
+ ILScopeRef.Local
+
+ // strip any extraneous trailing brackets or commas
+ if (here() = ']') then drop()
+ if (here() = ',') then drop()
+
+ // build the IL type
+ let tref = mkILTyRef(scope, typeName)
+ let genericArgs =
+ match specializations with
+ | None -> emptyILGenericArgs
+ | Some(genericArgs) -> genericArgs
+ let tspec = ILTypeSpec.Create(tref,genericArgs)
+ let ilty =
+ match tspec.Name with
+ | "System.SByte"
+ | "System.Byte"
+ | "System.Int16"
+ | "System.UInt16"
+ | "System.Int32"
+ | "System.UInt32"
+ | "System.Int64"
+ | "System.UInt64"
+ | "System.Char"
+ | "System.Double"
+ | "System.Single"
+ | "System.Boolean" -> ILType.Value(tspec)
+ | _ -> ILType.Boxed(tspec)
+
+ // if it's an array, wrap it - otherwise, just return the IL type
+ match rank with
+ | Some(r) -> ILType.Array(r,ilty)
+ | _ -> ilty
+
+ member x.ParseTypeSpec() =
+ reset()
+ let ilty = x.ParseType()
+ ILAttribElem.Type(Some(ilty))
+
+let decodeILAttribData ilg (ca: ILAttribute) scope =
+ let bytes = ca.Data
+ let sigptr = 0
+ let bb0,sigptr = sigptr_get_byte bytes sigptr
+ let bb1,sigptr = sigptr_get_byte bytes sigptr
+ if not (bb0 = 0x01 && bb1 = 0x00) then failwith "decodeILAttribData: invalid data";
+
+ let rec parseVal argty sigptr =
+ match argty with
+ | ILType.Value tspec when tspec.Name = "System.SByte" ->
+ let n,sigptr = sigptr_get_i8 bytes sigptr
+ ILAttribElem.SByte n, sigptr
+ | ILType.Value tspec when tspec.Name = "System.Byte" ->
+ let n,sigptr = sigptr_get_u8 bytes sigptr
+ ILAttribElem.Byte n, sigptr
+ | ILType.Value tspec when tspec.Name = "System.Int16" ->
+ let n,sigptr = sigptr_get_i16 bytes sigptr
+ ILAttribElem.Int16 n, sigptr
+ | ILType.Value tspec when tspec.Name = "System.UInt16" ->
+ let n,sigptr = sigptr_get_u16 bytes sigptr
+ ILAttribElem.UInt16 n, sigptr
+ | ILType.Value tspec when tspec.Name = "System.Int32" ->
+ let n,sigptr = sigptr_get_i32 bytes sigptr
+ ILAttribElem.Int32 n, sigptr
+ | ILType.Value tspec when tspec.Name = "System.UInt32" ->
+ let n,sigptr = sigptr_get_u32 bytes sigptr
+ ILAttribElem.UInt32 n, sigptr
+ | ILType.Value tspec when tspec.Name = "System.Int64" ->
+ let n,sigptr = sigptr_get_i64 bytes sigptr
+ ILAttribElem.Int64 n, sigptr
+ | ILType.Value tspec when tspec.Name = "System.UInt64" ->
+ let n,sigptr = sigptr_get_u64 bytes sigptr
+ ILAttribElem.UInt64 n, sigptr
+ | ILType.Value tspec when tspec.Name = "System.Double" ->
+ let n,sigptr = sigptr_get_ieee64 bytes sigptr
+ ILAttribElem.Double n, sigptr
+ | ILType.Value tspec when tspec.Name = "System.Single" ->
+ let n,sigptr = sigptr_get_ieee32 bytes sigptr
+ ILAttribElem.Single n, sigptr
+ | ILType.Value tspec when tspec.Name = "System.Char" ->
+ let n,sigptr = sigptr_get_u16 bytes sigptr
+ ILAttribElem.Char (char (int32 n)), sigptr
+ | ILType.Value tspec when tspec.Name = "System.Boolean" ->
+ let n,sigptr = sigptr_get_byte bytes sigptr
+ ILAttribElem.Bool (not (n = 0)), sigptr
+ | ILType.Boxed tspec when tspec.Name = "System.String" ->
+ let n,sigptr = sigptr_get_serstring_possibly_null bytes sigptr
+ ILAttribElem.String n, sigptr
+ | ILType.Boxed tspec when tspec.Name = "System.Type" ->
+ let nOpt,sigptr = sigptr_get_serstring_possibly_null bytes sigptr
+ match nOpt with
+ | None -> ILAttribElem.TypeRef(None), sigptr
+ | Some n ->
+ try
+ let parser = ILTypeSigParser(n)
+ parser.ParseTypeSpec(),sigptr
+ with e ->
+ failwith (sprintf "decodeILAttribData: error parsing type in custom attribute blob: %s" e.Message)
+ | ILType.Boxed tspec when tspec.Name = "System.Object" ->
+ let et,sigptr = sigptr_get_u8 bytes sigptr
+ if et = 0xFFuy then
+ ILAttribElem.Null, sigptr
+ else
+ let ty,sigptr = decodeCustomAttrElemType ilg bytes sigptr et
+ parseVal ty sigptr
+ | ILType.Array(shape,elemTy) when shape = ILArrayShape.SingleDimensional ->
+ let n,sigptr = sigptr_get_i32 bytes sigptr
+ let rec parseElems acc n sigptr =
+ if n = 0 then List.rev acc else
+ let v,sigptr = parseVal elemTy sigptr
+ parseElems (v ::acc) (n-1) sigptr
+ let elems = parseElems [] n sigptr
+ ILAttribElem.Array(elemTy,elems), sigptr
+ | ILType.Value _ -> (* assume it is an enumeration *)
+ let n,sigptr = sigptr_get_i32 bytes sigptr
+ ILAttribElem.Int32 n, sigptr
+ | _ -> failwith "decodeILAttribData: attribute data involves an enum or System.Type value"
+ let rec parseFixed argtys sigptr =
+ match argtys with
+ [] -> [],sigptr
+ | h::t ->
+ let nh,sigptr = parseVal h sigptr
+ let nt,sigptr = parseFixed t sigptr
+ nh ::nt, sigptr
+ let fixedArgs,sigptr = parseFixed (ILList.toList ca.Method.FormalArgTypes) sigptr
+ let nnamed,sigptr = sigptr_get_u16 bytes sigptr
+ let rec parseNamed acc n sigptr =
+ if n = 0 then List.rev acc else
+ let isPropByte,sigptr = sigptr_get_u8 bytes sigptr
+ let isProp = (int isPropByte = 0x54)
+ let et,sigptr = sigptr_get_u8 bytes sigptr
+ // We have a named value
+ let ty,sigptr =
+ // REVIEW: Post-M3, consider removing the restriction for scope - it's unnecessary
+ // because you can reconstruct scope using the qualified name from the CA Blob
+ if (0x50 = (int et) || 0x55 = (int et)) && Option.isSome scope then
+ let qualified_tname,sigptr = sigptr_get_serstring bytes sigptr
+ // we're already getting the qualified name from the binary blob
+ // if we don't split out the unqualified name from the qualified name,
+ // we'll write the qualified assembly reference string twice to the binary blob
+ let unqualified_tname = qualified_tname.Split([|','|]).[0]
+ let scoref = Option.get scope
+ let tref = mkILTyRef (scoref,unqualified_tname)
+ let tspec = mkILNonGenericTySpec tref
+ ILType.Value(tspec),sigptr
+ else
+ decodeCustomAttrElemType ilg bytes sigptr et
+ let nm,sigptr = sigptr_get_serstring bytes sigptr
+ let v,sigptr = parseVal ty sigptr
+ parseNamed ((nm,ty,isProp,v) :: acc) (n-1) sigptr
+ let named = parseNamed [] (int nnamed) sigptr
+ fixedArgs,named
+
+
+let mkDebuggableAttributeV2 ilg (jitTracking, ignoreSymbolStoreSequencePoints, jitOptimizerDisabled,enableEnC) =
+ mkILCustomAttribute ilg
+ (tref_DebuggableAttribute ilg,[mkILNonGenericValueTy (tref_DebuggableAttribute_DebuggingModes ilg)],
+ [ILAttribElem.Int32(
+ (* See System.Diagnostics.DebuggableAttribute.DebuggingModes *)
+ (if jitTracking then 1 else 0) |||
+ (if jitOptimizerDisabled then 256 else 0) |||
+ (if ignoreSymbolStoreSequencePoints then 2 else 0) |||
+ (if enableEnC then 4 else 0))],[])
+
+// --------------------------------------------------------------------
+// Functions to collect up all the references in a full module or
+// asssembly manifest. The process also allocates
+// a unique name to each unique internal assembly reference.
+// --------------------------------------------------------------------
+
+type ILReferences =
+ { AssemblyReferences: ILAssemblyRef list;
+ ModuleReferences: ILModuleRef list; }
+
+type ILReferencesAccumulator =
+ { refsA: Hashset;
+ refsM: Hashset; }
+
+let emptyILRefs =
+ { AssemblyReferences=[];
+ ModuleReferences = []; }
+
+(* Now find references. *)
+let refs_of_assref s x = Hashset.add s.refsA x
+let refs_of_modref s x = Hashset.add s.refsM x
+
+let refs_of_scoref s x =
+ match x with
+ | ILScopeRef.Local -> ()
+ | ILScopeRef.Assembly assref -> refs_of_assref s assref
+ | ILScopeRef.Module modref -> refs_of_modref s modref
+
+let refs_of_tref s (x:ILTypeRef) = refs_of_scoref s x.Scope
+
+let rec refs_of_typ s x =
+ match x with
+ | ILType.Void | ILType.TypeVar _ -> ()
+ | ILType.Modified(_,ty1,ty2) -> refs_of_tref s ty1; refs_of_typ s ty2
+ | ILType.Array (_,ty)
+ | ILType.Ptr ty | ILType.Byref ty -> refs_of_typ s ty
+ | ILType.Value tr | ILType.Boxed tr -> refs_of_tspec s tr
+ | ILType.FunctionPointer mref -> refs_of_callsig s mref
+
+and refs_of_inst s i = refs_of_typs s i
+and refs_of_tspec s (x:ILTypeSpec) = refs_of_tref s x.TypeRef; refs_of_inst s x.GenericArgs
+and refs_of_callsig s csig = refs_of_typs s csig.ArgTypes; refs_of_typ s csig.ReturnType
+and refs_of_genparam s x = refs_of_typs s x.Constraints
+and refs_of_genparams s b = List.iter (refs_of_genparam s) b
+
+and refs_of_dloc s ts = refs_of_tref s ts
+
+and refs_of_mref s (x:ILMethodRef) =
+ refs_of_dloc s x.EnclosingTypeRef ;
+ refs_of_typs s x.mrefArgs;
+ refs_of_typ s x.mrefReturn
+
+and refs_of_fref s x = refs_of_tref s x.EnclosingTypeRef; refs_of_typ s x.Type
+and refs_of_ospec s (OverridesSpec(mref,ty)) = refs_of_mref s mref; refs_of_typ s ty
+and refs_of_mspec s (x: ILMethodSpec) =
+ refs_of_mref s x.MethodRef;
+ refs_of_typ s x.EnclosingType;
+ refs_of_inst s x.GenericArgs
+
+and refs_of_fspec s x =
+ refs_of_fref s x.FieldRef;
+ refs_of_typ s x.EnclosingType
+
+and refs_of_typs s l = ILList.iter (refs_of_typ s) l
+
+and refs_of_token s x =
+ match x with
+ | ILToken.ILType ty -> refs_of_typ s ty
+ | ILToken.ILMethod mr -> refs_of_mspec s mr
+ | ILToken.ILField fr -> refs_of_fspec s fr
+
+and refs_of_custom_attr s x = refs_of_mspec s x.Method
+
+and refs_of_custom_attrs s (cas : ILAttributes) = List.iter (refs_of_custom_attr s) cas.AsList
+and refs_of_varargs s tyso = Option.iter (refs_of_typs s) tyso
+and refs_of_instr s x =
+ match x with
+ | I_call (_,mr,varargs) | I_newobj (mr,varargs) | I_callvirt (_,mr,varargs) ->
+ refs_of_mspec s mr;
+ refs_of_varargs s varargs
+ | I_callconstraint (_,tr,mr,varargs) ->
+ refs_of_typ s tr;
+ refs_of_mspec s mr;
+ refs_of_varargs s varargs
+ | I_calli (_,callsig,varargs) ->
+ refs_of_callsig s callsig; refs_of_varargs s varargs
+ | I_jmp mr | I_ldftn mr | I_ldvirtftn mr ->
+ refs_of_mspec s mr
+ | I_ldsfld (_,fr) | I_ldfld (_,_,fr) | I_ldsflda fr | I_ldflda fr | I_stsfld (_,fr) | I_stfld (_,_,fr) ->
+ refs_of_fspec s fr
+ | I_isinst ty | I_castclass ty | I_cpobj ty | I_initobj ty | I_ldobj (_,_,ty)
+ | I_stobj (_,_,ty) | I_box ty |I_unbox ty | I_unbox_any ty | I_sizeof ty
+ | I_ldelem_any (_,ty) | I_ldelema (_,_,_,ty) |I_stelem_any (_,ty) | I_newarr (_,ty)
+ | I_mkrefany ty | I_refanyval ty
+ | EI_ilzero ty -> refs_of_typ s ty
+ | I_ldtoken token -> refs_of_token s token
+ | I_stelem _|I_ldelem _|I_ldstr _|I_switch _|I_stloc _|I_stind _
+ | I_starg _|I_ldloca _|I_ldloc _|I_ldind _
+ | I_ldarga _|I_ldarg _|I_leave _|I_br _
+ | I_brcmp _|I_rethrow|I_refanytype|I_ldlen|I_throw|I_initblk _ |I_cpblk _
+ | I_localloc|I_ret |I_endfilter|I_endfinally|I_arglist
+ | I_other _ | I_break
+ | AI_add | AI_add_ovf | AI_add_ovf_un | AI_and | AI_div | AI_div_un | AI_ceq | AI_cgt | AI_cgt_un | AI_clt
+ | AI_clt_un | AI_conv _ | AI_conv_ovf _ | AI_conv_ovf_un _ | AI_mul | AI_mul_ovf | AI_mul_ovf_un | AI_rem | AI_rem_un
+ | AI_shl | AI_shr | AI_shr_un | AI_sub | AI_sub_ovf | AI_sub_ovf_un | AI_xor | AI_or | AI_neg | AI_not
+ | AI_ldnull | AI_dup | AI_pop | AI_ckfinite | AI_nop | AI_ldc _
+ | I_seqpoint _ | EI_ldlen_multi _ -> ()
+
+
+and refs_of_il_block s c =
+ match c with
+ | ILBasicBlock bb -> Array.iter (refs_of_instr s) bb.Instructions
+ | GroupBlock (_,l) -> List.iter (refs_of_il_code s) l
+ | RestrictBlock (_nms,c) -> refs_of_il_code s c
+ | TryBlock (l,r) ->
+ refs_of_il_code s l;
+ match r with
+ | FaultBlock flt -> refs_of_il_code s flt
+ | FinallyBlock flt -> refs_of_il_code s flt
+ | FilterCatchBlock clauses ->
+ clauses |> List.iter (fun (flt,ctch) ->
+ refs_of_il_code s ctch;
+ match flt with
+ | CodeFilter fltcode -> refs_of_il_code s fltcode
+ | TypeFilter ty -> refs_of_typ s ty)
+
+and refs_of_il_code s c = refs_of_il_block s c
+
+and refs_of_ilmbody s il =
+ ILList.iter (refs_of_local s) il.Locals;
+ refs_of_il_code s il.Code
+
+and refs_of_local s loc = refs_of_typ s loc.Type
+
+and refs_of_mbody s x =
+ match x with
+ | MethodBody.IL il -> refs_of_ilmbody s il
+ | MethodBody.PInvoke (attr) -> refs_of_modref s attr.Where
+ | _ -> ()
+
+and refs_of_mdef s md =
+ ILList.iter (refs_of_param s) md.Parameters;
+ refs_of_return s md.Return;
+ refs_of_mbody s md.mdBody.Contents;
+ refs_of_custom_attrs s md.CustomAttrs;
+ refs_of_genparams s md.GenericParams
+
+and refs_of_param s p = refs_of_typ s p.Type
+and refs_of_return s (rt:ILReturn) = refs_of_typ s rt.Type
+and refs_of_mdefs s x = Seq.iter (refs_of_mdef s) x
+
+and refs_of_event_def s (ed: ILEventDef) =
+ Option.iter (refs_of_typ s) ed.Type ;
+ refs_of_mref s ed.AddMethod ;
+ refs_of_mref s ed.RemoveMethod;
+ Option.iter (refs_of_mref s) ed.FireMethod ;
+ List.iter (refs_of_mref s) ed.OtherMethods ;
+ refs_of_custom_attrs s ed.CustomAttrs
+
+and refs_of_events s (x: ILEventDefs) = List.iter (refs_of_event_def s) x.AsList
+
+and refs_of_property_def s pd =
+ Option.iter (refs_of_mref s) pd.SetMethod ;
+ Option.iter (refs_of_mref s) pd.GetMethod ;
+ refs_of_typ s pd.Type ;
+ refs_of_typs s pd.Args ;
+ refs_of_custom_attrs s pd.CustomAttrs
+
+and refs_of_properties s (x: ILPropertyDefs) = List.iter (refs_of_property_def s) x.AsList
+
+and refs_of_fdef s fd =
+ refs_of_typ s fd.Type;
+ refs_of_custom_attrs s fd.CustomAttrs
+
+and refs_of_fields s fields = List.iter (refs_of_fdef s) fields
+
+and refs_of_method_impls s mimpls = List.iter (refs_of_method_impl s) mimpls
+
+and refs_of_method_impl s m =
+ refs_of_ospec s m.Overrides;
+ refs_of_mspec s m.OverrideBy
+
+and refs_of_tdef_kind _s _k = ()
+
+and refs_of_tdef s (td : ILTypeDef) =
+ refs_of_types s td.NestedTypes;
+ refs_of_genparams s td.GenericParams;
+ refs_of_typs s td.Implements;
+ Option.iter (refs_of_typ s) td.Extends;
+ refs_of_mdefs s td.Methods;
+ refs_of_fields s td.Fields.AsList;
+ refs_of_method_impls s td.MethodImpls.AsList;
+ refs_of_events s td.Events;
+ refs_of_tdef_kind s td.tdKind;
+ refs_of_custom_attrs s td.CustomAttrs;
+ refs_of_properties s td.Properties
+
+and refs_of_string _s _ = ()
+and refs_of_types s (types: ILTypeDefs) = Seq.iter (refs_of_tdef s) types
+
+and refs_of_exported_type s (c: ILExportedTypeOrForwarder) =
+ refs_of_custom_attrs s c.CustomAttrs
+
+and refs_of_exported_types s (tab: ILExportedTypesAndForwarders) = List.iter (refs_of_exported_type s) tab.AsList
+
+and refs_of_resource_where s x =
+ match x with
+ | ILResourceLocation.Local _ -> ()
+ | ILResourceLocation.File (mref,_) -> refs_of_modref s mref
+ | ILResourceLocation.Assembly aref -> refs_of_assref s aref
+
+and refs_of_resource s x =
+ refs_of_resource_where s x.Location;
+ refs_of_custom_attrs s x.CustomAttrs
+
+and refs_of_resources s (tab: ILResources) = List.iter (refs_of_resource s) tab.AsList
+
+and refs_of_modul s m =
+ refs_of_types s m.TypeDefs;
+ refs_of_resources s m.Resources;
+ Option.iter (refs_of_manifest s) m.Manifest
+
+and refs_of_manifest s m =
+ refs_of_custom_attrs s m.CustomAttrs;
+ refs_of_exported_types s m.ExportedTypes
+
+let computeILRefs modul =
+ let s =
+ { refsA = Hashset.create 10;
+ refsM = Hashset.create 5; }
+ refs_of_modul s modul;
+ { AssemblyReferences = Hashset.fold (fun x acc -> x::acc) s.refsA [];
+ ModuleReferences = Hashset.fold (fun x acc -> x::acc) s.refsM [] }
+
+let tspan = System.TimeSpan(System.DateTime.Now.Ticks - System.DateTime(2000,1,1).Ticks)
+
+let parseILVersion (vstr : string) =
+ // matches "v1.2.3.4" or "1.2.3.4". Note, if numbers are missing, returns -1 (not 0).
+ let mutable vstr = vstr.TrimStart [|'v'|]
+ // if the version string contains wildcards, replace them
+ let versionComponents = vstr.Split([|'.'|])
+
+ // account for wildcards
+ if versionComponents.Length > 2 then
+ let defaultBuild = (uint16)tspan.Days % System.UInt16.MaxValue - 1us
+ let defaultRevision = (uint16)(System.DateTime.Now.TimeOfDay.TotalSeconds / 2.0) % System.UInt16.MaxValue - 1us
+ if versionComponents.[2] = "*" then
+ if versionComponents.Length > 3 then
+ failwith "Invalid version format"
+ else
+ // set the build number to the number of days since Jan 1, 2000
+ versionComponents.[2] <- defaultBuild.ToString() ;
+ // Set the revision number to number of seconds today / 2
+ vstr <- System.String.Join(".",versionComponents) + "." + defaultRevision.ToString() ;
+ elif versionComponents.Length > 3 && versionComponents.[3] = "*" then
+ // Set the revision number to number of seconds today / 2
+ versionComponents.[3] <- defaultRevision.ToString() ;
+ vstr <- System.String.Join(".",versionComponents) ;
+
+ let version = System.Version(vstr)
+ let zero32 n = if n < 0 then 0us else uint16(n)
+ // since the minor revision will be -1 if none is specified, we need to truncate to 0 to not break existing code
+#if SILVERLIGHT
+ let minorRevision = if versionComponents.Length < 4 then 0us else uint16(version.Revision)
+#else
+ let minorRevision = if versionComponents.Length < 4 then 0us else uint16(version.MinorRevision)
+#endif
+ (zero32 version.Major, zero32 version.Minor, zero32 version.Build, minorRevision);;
+
+
+let compareILVersions (a1,a2,a3,a4) ((b1,b2,b3,b4) : ILVersionInfo) =
+ let c = compare a1 b1
+ if c <> 0 then c else
+ let c = compare a2 b2
+ if c <> 0 then c else
+ let c = compare a3 b3
+ if c <> 0 then c else
+ let c = compare a4 b4
+ if c <> 0 then c else
+ 0
+
+
+let resolveILMethodRef td (mref:ILMethodRef) =
+ let args = mref.ArgTypes
+ let nargs = args.Length
+ let nm = mref.Name
+ let possibles = td.Methods.FindByNameAndArity (nm,nargs)
+ if isNil possibles then failwith ("no method named "+nm+" found in type "+td.Name);
+ match
+ possibles |> List.filter (fun md ->
+ mref.CallingConv = md.CallingConv &&
+ // REVIEW: this uses equality on ILType. For CMOD_OPTIONAL this is not going to be correct
+ (md.Parameters,mref.ArgTypes) ||> ILList.lengthsEqAndForall2 (fun p1 p2 -> p1.Type = p2) &&
+ // REVIEW: this uses equality on ILType. For CMOD_OPTIONAL this is not going to be correct
+ md.Return.Type = mref.ReturnType) with
+ | [] ->
+ failwith ("no method named "+nm+" with appropriate argument types found in type "+td.Name);
+ | [mdef] -> mdef
+ | _ ->
+ failwith ("multiple methods named "+nm+" appear with identical argument types in type "+td.Name)
+
+let mkRefToILModule m =
+ ILModuleRef.Create(m.Name, true, None)
+
+
+let ungenericizeTypeName n =
+ let sym = '`'
+ if
+ String.contains n sym &&
+ (* check what comes after the symbol is a number *)
+ (let m = String.rindex n sym
+ let res = ref (m < n.Length - 1)
+ for i = m + 1 to n.Length - 1 do
+ res := !res && n.[i] >= '0' && n.[i] <= '9';
+ !res)
+ then
+ let pos = String.rindex n sym
+ String.sub n 0 pos
+ else n
+
+type ILEventRef =
+ { erA: ILTypeRef; erB: string }
+ static member Create(a,b) = {erA=a;erB=b}
+ member x.EnclosingTypeRef = x.erA
+ member x.Name = x.erB
+
+type ILPropertyRef =
+ { prA: ILTypeRef; prB: string }
+ static member Create (a,b) = {prA=a;prB=b}
+ member x.EnclosingTypeRef = x.prA
+ member x.Name = x.prB
+
+
+
diff --git a/src/absil/il.fsi b/src/absil/il.fsi
new file mode 100644
index 0000000..420bcdb
--- /dev/null
+++ b/src/absil/il.fsi
@@ -0,0 +1,2275 @@
+//----------------------------------------------------------------------------
+// Copyright (c) 2002-2012 Microsoft Corporation.
+//
+// This source code is subject to terms and conditions of the Apache License, Version 2.0. A
+// copy of the license can be found in the License.html file at the root of this distribution.
+// By using this source code in any fashion, you are agreeing to be bound
+// by the terms of the Apache License, Version 2.0.
+//
+// You must not remove this notice, or any other, from this software.
+//----------------------------------------------------------------------------
+
+/// The "unlinked" view of .NET metadata and code. Central to
+/// to Abstract IL library
+module Microsoft.FSharp.Compiler.AbstractIL.IL
+
+open Internal.Utilities
+open System.Collections.Generic
+
+/// The type used to store relatively small lists in the Abstract IL data structures, i.e. for ILTypes, ILGenericArgs, ILParameters and ILLocals.
+/// See comments in il.fs for why we've isolated this representation and the possible future choices we might use here.
+#if ABSIL_USES_ARRAY_FOR_ILLIST
+type ILList<'T> = 'T []
+#endif
+
+#if ABSIL_USES_THREELIST_FOR_ILLIST
+type ILList<'T> = ThreeList<'T>
+#endif
+
+//#if ABSIL_USES_LIST_FOR_ILLIST
+type ILList<'T> = 'T list
+//#endif
+
+
+// ====================================================================
+// .NET binaries can be converted to the data structures below by using
+// the functions in the "Ilread" module.
+//
+// Constituent types are listed in ascending order of complexity,
+// all the way up to the type ILModuleDef, representing the read of an IL
+// assembly (.dll or .exe), or part of a multi-module assembly. Types are
+// often specified via a concrete representation for the type (e.g. a record),
+// though some types are abstract.
+//
+// The second part of the file (after the definition of all the types)
+// specifies a large set of utilities for building objects belonging to
+// the types. You will only need to become familiar with these if you
+// are transforming code or writing a code-generating compiler.
+//
+// Several other utilities are also defined in this file:
+// 1. A code builder for turning linear sequences of instructions
+// augmented with exception tables into the more structured
+// format used for code.
+//
+// 2. The "typ_XYZ", "tspec_XYZ" and "mspec_XYZ" values which
+// can be used to reference types in the "mscorlib" assembly.
+//
+// 3. The "rescopeXYZ" functions which can be used to lift a piece of
+// metadata from one assembly and transform it to a piece of metadata
+// suitable for use from another assembly. The transformation adjusts
+// references in the metadata to take into account the assembly
+// where the metadata will now be located.
+//
+// 4. The "instantiateXYZ" utilities to replace type variables
+// by types. These are associated with generics.
+//
+// 5. The "intern_XYZ" tables for reducing the memory used by
+// generated constructs.
+//
+// 6. The "refs_of_XYZ" utilities for finding all the assemblies
+// referenced by a module.
+//
+// 7. A somewhat obscure facility to allow new instructions and types
+// to be added to the This is only used by ILX.
+// ====================================================================
+
+// Guids (Note: consider adjusting these to the System.Guid type)
+type Guid = byte[]
+
+[]
+type ILPlatform =
+ | X86
+ | AMD64
+ | IA64
+
+/// Debug info. Values of type "source" can be attached at sequence
+/// points and some other locations.
+[]
+type ILSourceDocument =
+ static member Create : language: Guid option * vendor: Guid option * documentType: Guid option * file: string -> ILSourceDocument
+ member Language: Guid option
+ member Vendor: Guid option
+ member DocumentType: Guid option
+ member File: string
+
+
+[]
+type ILSourceMarker =
+ static member Create : document: ILSourceDocument * line: int * column: int * endLine:int * endColumn: int-> ILSourceMarker
+ member Document: ILSourceDocument
+ member Line: int
+ member Column: int
+ member EndLine: int
+ member EndColumn: int
+
+/// Extensibility: ignore these unless you are generating ILX
+/// structures directly.
+[]
+type IlxExtensionType =
+ interface System.IComparable
+
+/// Represents an extension to the algebra of type kinds
+type IlxExtensionTypeKind
+
+/// Represents an extension to the algebra of instructions
+type IlxExtensionInstr
+
+[]
+type PublicKey =
+ | PublicKey of byte[]
+ | PublicKeyToken of byte[]
+ member IsKey: bool
+ member IsKeyToken: bool
+ member Key: byte[]
+ member KeyToken: byte[]
+
+type ILVersionInfo = uint16 * uint16 * uint16 * uint16
+
+[]
+type ILAssemblyRef =
+ static member Create : name: string * hash: byte[] option * publicKey: PublicKey option * retargetable: bool * version: ILVersionInfo option * locale: string option -> ILAssemblyRef
+ static member FromAssemblyName : System.Reflection.AssemblyName -> ILAssemblyRef
+ member Name: string;
+ /// The fully qualified name of the assembly reference, e.g. mscorlib, Version=1.0.3705 etc.
+ member QualifiedName: string;
+ member Hash: byte[] option;
+ member PublicKey: PublicKey option;
+ /// CLI says this indicates if the assembly can be retargeted (at runtime) to be from a different publisher.
+ member Retargetable: bool;
+ member Version: ILVersionInfo option;
+ member Locale: string option
+ interface System.IComparable
+
+[]
+type ILModuleRef =
+ static member Create : name: string * hasMetadata: bool * hash: byte[] option -> ILModuleRef
+ member Name: string
+ member HasMetadata: bool
+ member Hash: byte[] option
+ interface System.IComparable
+
+// Scope references
+//
+// Scope references are the bits of metadata attached to type names
+// that indicate where a type can be found. CIL has three
+// kinds: local, module and assembly references:
+// o Local: the type must reside in the same module as the scope reference
+// o Module: the type must reside in the indicated module in the same
+// assembly as the scope reference
+// o Assembly: The type must reside in the indicated assembly.
+// These have no implicit context. Assembly references can end up
+// binding to the assembly containing the reference, i.e.
+// may be self or mutually referential.
+//
+// Assembly reference may also resolve to type in an
+// auxiliary module of an assembly when the assembly
+// has an "exported types" (here called "classes elsewhere") table.
+//
+// We represent these references by values embedded within type
+// references. These values are usually "shared" across the data
+// structures for a module, i.e. one such value is created for each
+// assembly or module reference, and this value is reused within each
+// type object.
+//
+// Note that as with method references the term structure is not
+// _linked_, i.e. a "ILScopeRef" is still a _reference_ to a scope,
+// not the scope itself. Because the structure is not linked,
+// the Abstract IL toolset does not require
+// strongly connected inputs: you can manipulate an assembly
+// without loading all its dependent assemblies. This is the primary
+// difference between Abstract IL and Reflection, and it can be both
+// a blessing and a curse depending on the kind of manipulation you
+// wish to perform.
+//
+// Similarly, you can manipulate individual modules within
+// an assembly without having the whole assembly loaded. (But note that
+// most assemblies are single-module in any case).
+//
+// [ILScopeRef]'s _cannot_ be compared for equality in the way that
+// might be expected, in these sense that two ILScopeRef's may
+// resolve to the same assembly/module even though they are not equal.
+//
+// Aside: People have suggested normalizing all scope references
+// so that this would be possible, and early versions of this
+// toolkit did this. However, this meant that in order to load
+// each module you had to tell the toolkit which assembly it belonged to.
+// Furthermore, you had to know the exact resolved details of
+// each assembly the module refers to. This is
+// effectively like having a "fully-linked" view of the graph
+// of assemblies, like that provided in the Ilbind module. This is really problematic for compile-time tools,
+// as, for example, the policy for linking at the runtime-machine
+// may actually alter the results of linking. If such compile-time
+// assumptions are to be made then the tool built on top
+// of the toolkit rather than the toolkit itself should
+// make them.
+//
+// Scope references, type references, field references and method references
+// can be "bound" to particular assemblies using the functions in "Ilbind".
+// This simulates the resolution/binding process performed by a Common Language
+// Runtime during execution. Various tests and derived operations
+// can then be performed on the results of binding.
+[]
+[]
+type ILScopeRef =
+ /// A reference to the type in the current module
+ | Local
+ /// A reference to a type in a module in the same assembly
+ | Module of ILModuleRef
+ /// A reference to a type in another assembly
+ | Assembly of ILAssemblyRef
+ member IsLocalRef: bool
+ member IsModuleRef: bool
+ member IsAssemblyRef: bool
+ member ModuleRef: ILModuleRef
+ member AssemblyRef: ILAssemblyRef
+ member QualifiedName: string
+
+// Calling conventions.
+//
+// For nearly all purposes you simply want to use ILArgConvention.Default combined
+// with ILThisConvention.Instance or ILThisConvention.Static, i.e.
+// ILCallingConv.Instance == Callconv(ILThisConvention.Instance, ILArgConvention.Default): for an instance method
+// ILCallingConv.Static == Callconv(ILThisConvention.Static, ILArgConvention.Default): for a static method
+//
+// ILThisConvention.InstanceExplicit is only used by Managed C++, and indicates
+// that the 'this' pointer is actually explicit in the signature.
+[]
+type ILArgConvention =
+ | Default
+ | CDecl
+ | StdCall
+ | ThisCall
+ | FastCall
+ | VarArg
+
+[]
+type ILThisConvention =
+ /// accepts an implicit 'this' pointer
+ | Instance
+ /// accepts an explicit 'this' pointer
+ | InstanceExplicit
+ /// no 'this' pointer is passed
+ | Static
+
+[]
+type ILCallingConv =
+ | Callconv of ILThisConvention * ILArgConvention
+ member IsInstance : bool
+ member IsInstanceExplicit : bool
+ member IsStatic : bool
+ member ThisConv : ILThisConvention
+ member BasicConv : ILArgConvention
+ static member Instance : ILCallingConv
+ static member Static : ILCallingConv
+
+/// Array shapes. For most purposes, including verification, the
+/// rank is the only thing that matters.
+
+type ILArrayBound = int32 option
+type ILArrayBounds = ILArrayBound * ILArrayBound
+
+[]
+type ILArrayShape =
+ | ILArrayShape of ILArrayBounds list (* lobound/size pairs *)
+ member Rank : int
+ /// Bounds for a single dimensional, zero based array
+ static member SingleDimensional: ILArrayShape
+ static member FromRank : int -> ILArrayShape
+
+[]
+type ILBoxity =
+ | AsObject
+ | AsValue
+
+type ILGenericVariance =
+ | NonVariant
+ | CoVariant
+ | ContraVariant
+
+/// Type refs, i.e. references to types in some .NET assembly
+[]
+type ILTypeRef =
+ /// Create a ILTypeRef
+ static member Create : scope: ILScopeRef * enclosing: string list * name: string -> ILTypeRef
+
+ /// Where is the type, i.e. is it in this module, in another module in this assembly or in another assembly?
+ member Scope: ILScopeRef
+ /// The list of enclosing type names for a nested type. If non-nil then the first of these also contains the namespace.
+ member Enclosing: string list
+ /// The name of the type. This also contains the namespace if Enclosing is empty
+ member Name: string
+ /// The name of the type in the assembly using the '.' notation for nested types
+ member FullName: string
+ /// The name of the type in the assembly using the '+' notation for nested types
+ member BasicQualifiedName : string
+ member QualifiedName: string
+#if EXTENSIONTYPING
+ member QualifiedNameWithNoShortMscorlib: string
+#endif
+ interface System.IComparable
+
+/// Type specs and types.
+///
+/// These are the types that appear syntactically in .NET binaries.
+///
+/// Generic type definitions must be combined with
+/// an instantiation to form a type. Throughout this file,
+/// a "ref" refers to something that is uninstantiated, and
+/// a "spec" to a ref that is combined with the relevant instantiations.
+
+[]
+type ILTypeSpec =
+ static member Create : typeRef:ILTypeRef * instantiation:ILGenericArgs -> ILTypeSpec
+
+ /// Which type is being referred to?
+ member TypeRef: ILTypeRef
+ /// The type instantiation if the type is generic, otherwise empty
+ member GenericArgs: ILGenericArgs
+ member Scope: ILScopeRef
+ member Enclosing: string list
+ member Name: string
+ member FullName: string
+ interface System.IComparable
+
+and
+ []
+ ILType =
+ /// Used only in return and pointer types.
+ | Void
+ /// Array types
+ | Array of ILArrayShape * ILType
+ /// Unboxed types, including builtin types.
+ | Value of ILTypeSpec
+ /// Reference types. Also may be used for parents of members even if for members in value types.
+ | Boxed of ILTypeSpec
+ /// Unmanaged pointers. Nb. the type is used by tools and for binding only, not by the verifier.
+ | Ptr of ILType
+ /// Managed pointers.
+ | Byref of ILType
+ /// ILCode pointers.
+ | FunctionPointer of ILCallingSignature
+ /// Reference a generic arg.
+ | TypeVar of uint16
+ /// Custom modifiers.
+ | Modified of
+ /// True if modifier is "required"
+ bool *
+ /// The class of the custom modifier.
+ ILTypeRef *
+ /// The type being modified.
+ ILType
+ member TypeSpec : ILTypeSpec
+ member Boxity : ILBoxity
+ member TypeRef : ILTypeRef
+ member IsNominal : bool
+ member GenericArgs : ILGenericArgs
+ member IsTyvar : bool
+ member BasicQualifiedName : string
+ member QualifiedNameWithNoShortMscorlib : string
+
+and []
+ ILCallingSignature =
+ { CallingConv: ILCallingConv;
+ ArgTypes: ILTypes;
+ ReturnType: ILType }
+
+/// Actual generic parameters are always types.
+
+
+and ILGenericArgs = ILList
+and ILTypes = ILList
+
+
+[]
+module ILList =
+ val inline map : ('T -> 'U) -> ILList<'T> -> ILList<'U>
+ val inline mapi : (int -> 'T -> 'U) -> ILList<'T> -> ILList<'U>
+ val inline isEmpty : ILList<'T> -> bool
+ val inline toList : ILList<'T> -> 'T list
+ val inline ofList : 'T list -> ILList<'T>
+ val inline lengthsEqAndForall2 : ('T -> 'U -> bool) -> ILList<'T> -> ILList<'U> -> bool
+ val inline init : int -> (int -> 'T) -> ILList<'T>
+ val inline empty<'T> : ILList<'T>
+ val inline toArray : ILList<'T> -> 'T[]
+ val inline ofArray : 'T[] -> ILList<'T>
+ val inline nth : ILList<'T> -> int -> 'T
+ val inline iter : ('T -> unit) -> ILList<'T> -> unit
+ val inline iteri : (int -> 'T -> unit) -> ILList<'T> -> unit
+ val inline foldBack : ('T -> 'State -> 'State) -> ILList<'T> -> 'State -> 'State
+ val inline exists : ('T -> bool) -> ILList<'T> -> bool
+
+
+/// Formal identities of methods. Method refs refer to methods on
+/// named types. In general you should work with ILMethodSpec objects
+/// rather than MethodRef objects, because ILMethodSpec objects carry
+/// information about how generic methods are instantiated. MethodRef
+/// objects are only used at a few places in the Abstract IL syntax
+/// and if analyzing or generating IL you will be unlikely to come across
+/// these.
+
+[]
+type ILMethodRef =
+ static member Create : enclosingTypeRef: ILTypeRef * callingConv: ILCallingConv * name: string * genericArity: int * argTypes: ILTypes * returnType: ILType -> ILMethodRef
+ member EnclosingTypeRef: ILTypeRef
+ member CallingConv: ILCallingConv
+ member Name: string
+ member GenericArity: int
+ member ArgCount: int
+ member ArgTypes: ILTypes
+ member ReturnType: ILType
+ member CallingSignature: ILCallingSignature
+ interface System.IComparable
+
+/// Formal identities of fields.
+
+[]
+type ILFieldRef =
+ { EnclosingTypeRef: ILTypeRef;
+ Name: string;
+ Type: ILType }
+
+/// The information at the callsite of a method
+//
+// A ILMethodSpec is everything given at the callsite (apart from whether the call is a tailcall and whether it is passing
+// varargs - see the instruction set below). It is made up of
+// 1) a (possibly generic) ILMethodRef
+// 2) a "usage type" that indicates the how the type containing the declaration is being used (as
+// a value class, a boxed value class, an instantiated generic class or whatever - see below)
+// 3) an instantiation in the case where the method is generic.
+//
+// In this unbound form of the metadata, the enclosing type may be ILType.Boxed even when the member is a member of a value type or
+// enumeration. This is because the binary format of the metadata does not carry enough information in a MemberRefParent to determine
+// from the binary alone whether the enclosing type is a value type or not.
+
+[]
+type ILMethodSpec =
+ static member Create : ILType * ILMethodRef * ILGenericArgs -> ILMethodSpec
+ member MethodRef: ILMethodRef
+ member EnclosingType: ILType
+ member GenericArgs: ILGenericArgs
+ member CallingConv: ILCallingConv
+ member GenericArity: int
+ member Name: string
+ member FormalArgTypes: ILTypes
+ member FormalReturnType: ILType
+ interface System.IComparable
+
+
+/// Field specs. The data given for a ldfld, stfld etc. instruction.
+[]
+type ILFieldSpec =
+ { FieldRef: ILFieldRef;
+ EnclosingType: ILType }
+ member EnclosingTypeRef: ILTypeRef
+ member Name: string
+ member FormalType: ILType
+ member ActualType : ILType
+
+/// ILCode labels. In structured code each code label
+/// refers to a basic block somewhere in the code of the method.
+
+type ILCodeLabel = int
+
+[]
+type ILBasicType =
+ | DT_R
+ | DT_I1
+ | DT_U1
+ | DT_I2
+ | DT_U2
+ | DT_I4
+ | DT_U4
+ | DT_I8
+ | DT_U8
+ | DT_R4
+ | DT_R8
+ | DT_I
+ | DT_U
+ | DT_REF
+
+[]
+type ILToken =
+ | ILType of ILType
+ | ILMethod of ILMethodSpec
+ | ILField of ILFieldSpec
+
+[]
+type ILConst =
+ | I4 of int32
+ | I8 of int64
+ | R4 of single
+ | R8 of double
+
+type ILTailcall =
+ | Tailcall
+ | Normalcall
+
+type ILAlignment =
+ | Aligned
+ | Unaligned1
+ | Unaligned2
+ | Unaligned4
+
+type ILVolatility =
+ | Volatile
+ | Nonvolatile
+
+type ILReadonly =
+ | ReadonlyAddress
+ | NormalAddress
+
+type ILVarArgs = ILTypes option
+
+[]
+type ILComparisonInstr =
+ | BI_beq
+ | BI_bge
+ | BI_bge_un
+ | BI_bgt
+ | BI_bgt_un
+ | BI_ble
+ | BI_ble_un
+ | BI_blt
+ | BI_blt_un
+ | BI_bne_un
+ | BI_brfalse
+ | BI_brtrue
+
+/// The instruction set.
+///
+/// In general we don't categorize instructions, as different
+/// instruction groups are relevant for different types of operations.
+/// However we do collect the branch and compare instructions together
+/// because they all take an address, and the ILArithInstr ones because
+/// none of them take any direct arguments.
+[]
+type ILInstr =
+ // Basic
+ | AI_add
+ | AI_add_ovf
+ | AI_add_ovf_un
+ | AI_and
+ | AI_div
+ | AI_div_un
+ | AI_ceq
+ | AI_cgt
+ | AI_cgt_un
+ | AI_clt
+ | AI_clt_un
+ | AI_conv of ILBasicType
+ | AI_conv_ovf of ILBasicType
+ | AI_conv_ovf_un of ILBasicType
+ | AI_mul
+ | AI_mul_ovf
+ | AI_mul_ovf_un
+ | AI_rem
+ | AI_rem_un
+ | AI_shl
+ | AI_shr
+ | AI_shr_un
+ | AI_sub
+ | AI_sub_ovf
+ | AI_sub_ovf_un
+ | AI_xor
+ | AI_or
+ | AI_neg
+ | AI_not
+ | AI_ldnull
+ | AI_dup
+ | AI_pop
+ | AI_ckfinite
+ | AI_nop
+ | AI_ldc of ILBasicType * ILConst
+ | I_ldarg of uint16
+ | I_ldarga of uint16
+ | I_ldind of ILAlignment * ILVolatility * ILBasicType
+ | I_ldloc of uint16
+ | I_ldloca of uint16
+ | I_starg of uint16
+ | I_stind of ILAlignment * ILVolatility * ILBasicType
+ | I_stloc of uint16
+
+ // Control transfer
+ | I_br of ILCodeLabel
+ | I_jmp of ILMethodSpec
+ | I_brcmp of ILComparisonInstr * ILCodeLabel * ILCodeLabel (* second label is fall-through *)
+ | I_switch of (ILCodeLabel list * ILCodeLabel) (* last label is fallthrough *)
+ | I_ret
+
+ // Method call
+ | I_call of ILTailcall * ILMethodSpec * ILVarArgs
+ | I_callvirt of ILTailcall * ILMethodSpec * ILVarArgs
+ | I_callconstraint of ILTailcall * ILType * ILMethodSpec * ILVarArgs
+ | I_calli of ILTailcall * ILCallingSignature * ILVarArgs
+ | I_ldftn of ILMethodSpec
+ | I_newobj of ILMethodSpec * ILVarArgs
+
+ // Exceptions
+ | I_throw
+ | I_endfinally
+ | I_endfilter
+ | I_leave of ILCodeLabel
+ | I_rethrow
+
+ // Object instructions
+ | I_ldsfld of ILVolatility * ILFieldSpec
+ | I_ldfld of ILAlignment * ILVolatility * ILFieldSpec
+ | I_ldsflda of ILFieldSpec
+ | I_ldflda of ILFieldSpec
+ | I_stsfld of ILVolatility * ILFieldSpec
+ | I_stfld of ILAlignment * ILVolatility * ILFieldSpec
+ | I_ldstr of string
+ | I_isinst of ILType
+ | I_castclass of ILType
+ | I_ldtoken of ILToken
+ | I_ldvirtftn of ILMethodSpec
+
+ // Value type instructions
+ | I_cpobj of ILType
+ | I_initobj of ILType
+ | I_ldobj of ILAlignment * ILVolatility * ILType
+ | I_stobj of ILAlignment * ILVolatility * ILType
+ | I_box of ILType
+ | I_unbox of ILType
+ | I_unbox_any of ILType
+ | I_sizeof of ILType
+
+ // Generalized array instructions. In AbsIL these instructions include
+ // both the single-dimensional variants (with ILArrayShape == ILArrayShape.SingleDimensional)
+ // and calls to the "special" multi-dimensional "methods" such as
+ // newobj void string[,]::.ctor(int32, int32)
+ // call string string[,]::Get(int32, int32)
+ // call string& string[,]::Address(int32, int32)
+ // call void string[,]::Set(int32, int32,string)
+ // The IL reader transforms calls of this form to the corresponding
+ // generalized instruction with the corresponding ILArrayShape
+ // argument. This is done to simplify the IL and make it more uniform.
+ // The IL writer then reverses this when emitting the binary.
+ | I_ldelem of ILBasicType
+ | I_stelem of ILBasicType
+ | I_ldelema of ILReadonly * bool * ILArrayShape * ILType (* ILArrayShape = ILArrayShape.SingleDimensional for single dimensional arrays *)
+ | I_ldelem_any of ILArrayShape * ILType (* ILArrayShape = ILArrayShape.SingleDimensional for single dimensional arrays *)
+ | I_stelem_any of ILArrayShape * ILType (* ILArrayShape = ILArrayShape.SingleDimensional for single dimensional arrays *)
+ | I_newarr of ILArrayShape * ILType (* ILArrayShape = ILArrayShape.SingleDimensional for single dimensional arrays *)
+ | I_ldlen
+
+ // "System.TypedReference" related instructions: almost
+ // no languages produce these, though they do occur in mscorlib.dll
+ // System.TypedReference represents a pair of a type and a byref-pointer
+ // to a value of that type.
+ | I_mkrefany of ILType
+ | I_refanytype
+ | I_refanyval of ILType
+
+ // Debug-specific
+ // I_seqpoint is a fake instruction to represent a sequence point:
+ // the next instruction starts the execution of the
+ // statement covered by the given range - this is a
+ // dummy instruction and is not emitted
+ | I_break
+ | I_seqpoint of ILSourceMarker
+
+ // Varargs - C++ only
+ | I_arglist
+
+ // Local aggregates, i.e. stack allocated data (alloca) : C++ only
+ | I_localloc
+ | I_cpblk of ILAlignment * ILVolatility
+ | I_initblk of ILAlignment * ILVolatility
+
+ // EXTENSIONS, e.g. MS-ILX
+ | EI_ilzero of ILType
+ | EI_ldlen_multi of int32 * int32
+ | I_other of IlxExtensionInstr
+
+// REVIEW: remove this open-ended way of extending the IL and just combine with ILX
+type ILInstrSetExtension<'Extension> =
+ { instrExtDests: ('Extension -> ILCodeLabel list);
+ instrExtFallthrough: ('Extension -> ILCodeLabel option);
+ instrExtIsTailcall: ('Extension -> bool);
+ instrExtRelabel: (ILCodeLabel -> ILCodeLabel) -> 'Extension -> 'Extension; }
+
+val RegisterInstructionSetExtension: ILInstrSetExtension<'Extension> -> ('Extension -> IlxExtensionInstr) * (IlxExtensionInstr -> bool) * (IlxExtensionInstr -> 'Extension)
+
+/// A list of instructions ending in an unconditionally
+/// branching instruction. A basic block has a label which must be unique
+/// within the method it is located in. Only the first instruction of
+/// a basic block can be the target of a branch.
+//
+// Details: The last instruction is always a control flow instruction,
+// i.e. branch, tailcall, throw etc.
+//
+// For example
+// B1: ldarg 1
+// pop
+// ret
+//
+// will be one basic block:
+// ILBasicBlock("B1", [| I_ldarg(1); I_arith(AI_pop); I_ret |])
+
+type ILBasicBlock =
+ { Label: ILCodeLabel;
+ Instructions: ILInstr[] }
+ member Fallthrough: ILCodeLabel option
+
+
+/// Indicates that a particular local variable has a particular source
+/// language name within a GroupBlock. This does not effect local
+/// variable numbering, which is global over the whole method.
+type ILDebugMapping =
+ { LocalIndex: int;
+ LocalName: string; }
+
+/// ILCode
+///
+/// The code for a method is made up of a "code" object. Each "code"
+/// object gives the contents of the method in a "semi-structured" form, i.e.
+/// 1. The structure implicit in the IL exception handling tables
+/// has been made explicit
+/// 2. No relative offsets are used in the code: all branches and
+/// switch targets are made explicit as labels.
+/// 3. All "fallthroughs" from one basic block to the next have
+/// been made explicit, by adding extra "branch" instructions to
+/// the end of basic blocks which simply fallthrough to another basic
+/// block.
+///
+/// You can convert a straight-line sequence of instructions to structured
+/// code by using buildILCode and
+/// Most of the interesting code is contained in BasicBlocks. If you're
+/// just interested in getting started with the format then begin
+/// by simply considering methods which do not contain any branch
+/// instructions, or methods which do not contain any exception handling
+/// constructs.
+///
+/// The above format has the great advantage that you can insert and
+/// delete new code blocks without needing to fixup relative offsets
+/// or exception tables.
+///
+/// ILBasicBlock(bblock)
+/// See above
+///
+/// GroupBlock(localDebugInfo, blocks)
+/// A set of blocks, with interior branching between the blocks. For example
+/// B1: ldarg 1
+/// br B2
+///
+/// B2: pop
+/// ret
+///
+/// will be two basic blocks
+/// let b1 = ILBasicBlock("B1", [| I_ldarg(1); I_br("B2") |])
+/// let b2 = ILBasicBlock("B2", [| I_arith(AI_pop); I_ret |])
+/// GroupBlock([], [b1; b2])
+///
+/// A GroupBlock can include a list of debug info records for locally
+/// scoped local variables. These indicate that within the given blocks
+/// the given local variables are used for the given Debug info
+/// will only be recorded for local variables
+/// declared in these nodes, and the local variable will only appear live
+/// in the debugger for the instructions covered by this node. So if you
+/// omit or erase these nodes then no debug info will be emitted for local
+/// variables. If necessary you can have one outer ScopeBlock which specifies
+/// the information for all the local variables
+///
+/// Not all the destination labels used within a group of blocks need
+/// be satisfied by that group alone. For example, the interior "try" code
+/// of "try"-"catch" construct may be:
+/// B1: ldarg 1
+/// br B2
+///
+/// B2: pop
+/// leave B3
+///
+/// Again there will be two basic blocks grouped together:
+/// let b1 = ILBasicBlock("B1", [| I_ldarg(1); I_br("B2") |])
+/// let b2 = ILBasicBlock("B2", [| I_arith(AI_pop); I_leave("B3") |])
+/// GroupBlock([], [b1; b2])
+/// Here the code must be embedded in a method where "B3" is a label
+/// somewhere in the method.
+///
+/// RestrictBlock(labels,code)
+/// This block hides labels, i.e. the given set of labels represent
+/// wiring which is purely internal to the given code block, and may not
+/// be used as the target of a branch by any blocks which this block
+/// is placed alongside.
+///
+/// For example, if a method is made up of:
+/// B1: ldarg 1
+/// br B2
+///
+/// B2: ret
+///
+/// then the label "B2" is internal. The overall code will
+/// be two basic blocks grouped together, surrounded by a RestrictBlock.
+/// The label "B1" is then the only remaining visible entry to the method
+/// and execution will begin at that label.
+///
+/// let b1 = ILBasicBlock("B1", [| I_ldarg(1); I_br("B2") |])
+/// let b2 = ILBasicBlock("B2", [| I_arith(AI_pop); I_leave("B3") |])
+/// let gb1 = GroupBlock([], [b1; b2])
+/// RestrictBlock(["B2"], gb1)
+///
+/// RestrictBlock is necessary to build well-formed code.
+///
+/// TryBlock(trycode,seh)
+///
+/// A try-catch, try-finally or try-fault block.
+/// If an exception is raised while executing
+/// an instruction in 'trycode' then the exception handler given by
+/// 'seh' is executed.
+///
+/// Well-formedness conditions for code:
+///
+/// Well-formed code includes nodes which explicitly "hide" interior labels.
+/// For example, the code object for a method may have only one entry
+/// label which is not hidden, and this label will be the label where
+/// execution begins.
+///
+/// Both filter and catch blocks must have one
+/// and only one entry. These entry labels are not visible
+/// outside the filter and catch blocks. Filter has no
+/// exits (it always uses endfilter), catch may have exits.
+/// The "try" block can have multiple entries, i.e. you can branch
+/// into a try from outside. They can have multiple exits, each of
+/// which will be a "leave".
+///
+type ILCode =
+ | ILBasicBlock of ILBasicBlock
+ | GroupBlock of ILDebugMapping list * ILCode list
+ | RestrictBlock of ILCodeLabel list * ILCode
+ | TryBlock of ILCode * ILExceptionBlock
+
+/// The 'seh' specification can have several forms:
+///
+/// FilterCatchBlock
+/// A multi-try-filter-catch block. Execute the
+/// filters in order to determine which 'catch' block to catch the
+/// exception with. There are two kinds of filters - one for
+/// filtering exceptions by type and one by an instruction sequence.
+/// Note that filter blocks can't contain any exception blocks.
+///
+and ILExceptionBlock =
+ | FaultBlock of ILCode
+ | FinallyBlock of ILCode
+ | FilterCatchBlock of (ILFilterBlock * ILCode) list
+
+and ILFilterBlock =
+ | TypeFilter of ILType
+ | CodeFilter of ILCode
+
+val labelsOfCode: ILCode -> ILCodeLabel list
+val uniqueEntryOfCode: ILCode -> ILCodeLabel
+
+/// Field Init
+
+[]
+type ILFieldInit =
+ | String of string
+ | Bool of bool
+ | Char of uint16
+ | Int8 of sbyte
+ | Int16 of int16
+ | Int32 of int32
+ | Int64 of int64
+ | UInt8 of byte
+ | UInt16 of uint16
+ | UInt32 of uint32
+ | UInt64 of uint64
+ | Single of single
+ | Double of double
+ | Null
+
+[]
+type ILNativeVariant =
+ | Empty
+ | Null
+ | Variant
+ | Currency
+ | Decimal
+ | Date
+ | BSTR
+ | LPSTR
+ | LPWSTR
+ | IUnknown
+ | IDispatch
+ | SafeArray
+ | Error
+ | HRESULT
+ | CArray
+ | UserDefined
+ | Record
+ | FileTime
+ | Blob
+ | Stream
+ | Storage
+ | StreamedObject
+ | StoredObject
+ | BlobObject
+ | CF
+ | CLSID
+ | Void
+ | Bool
+ | Int8
+ | Int16
+ | Int32
+ | Int64
+ | Single
+ | Double
+ | UInt8
+ | UInt16
+ | UInt32
+ | UInt64
+ | PTR
+ | Array of ILNativeVariant
+ | Vector of ILNativeVariant
+ | Byref of ILNativeVariant
+ | Int
+ | UInt
+
+/// Native Types, for marshalling to the native C interface.
+/// These are taken directly from the ILASM syntax, see ECMA Spec (Partition II, 7.4).
+
+[]
+type ILNativeType =
+ | Empty
+ | Custom of Guid * string * string * byte[] (* guid,nativeTypeName,custMarshallerName,cookieString *)
+ | FixedSysString of int32
+ | FixedArray of int32
+ | Currency
+ | LPSTR
+ | LPWSTR
+ | LPTSTR
+ | ByValStr
+ | TBSTR
+ | LPSTRUCT
+ | Struct
+ | Void
+ | Bool
+ | Int8
+ | Int16
+ | Int32
+ | Int64
+ | Single
+ | Double
+ | Byte
+ | UInt16
+ | UInt32
+ | UInt64
+ | Array of ILNativeType option * (int32 * int32 option) option (* optional idx of parameter giving size plus optional additive i.e. num elems *)
+ | Int
+ | UInt
+ | Method
+ | AsAny
+ | BSTR
+ | IUnknown
+ | IDispatch
+ | Interface
+ | Error
+ | SafeArray of ILNativeVariant * string option
+ | ANSIBSTR
+ | VariantBool
+
+
+/// Local variables
+[]
+type ILLocal =
+ { Type: ILType;
+ IsPinned: bool }
+
+
+type ILLocals = ILList
+
+/// IL method bodies
+[]
+type ILMethodBody =
+ { IsZeroInit: bool;
+ /// strictly speakin should be a uint16
+ MaxStack: int32;
+ NoInlining: bool;
+ Locals: ILLocals;
+ Code: ILCode;
+ SourceMarker: ILSourceMarker option }
+
+/// Member Access
+[]
+type ILMemberAccess =
+ | Assembly
+ | CompilerControlled
+ | FamilyAndAssembly
+ | FamilyOrAssembly
+ | Family
+ | Private
+ | Public
+
+[]
+type ILAttribElem =
+ /// Represents a custom attribute parameter of type 'string'. These may be null, in which case they are encoded in a special
+ /// way as indicated by Ecma-335 Partition II.
+ | String of string option
+ | Bool of bool
+ | Char of char
+ | SByte of sbyte
+ | Int16 of int16
+ | Int32 of int32
+ | Int64 of int64
+ | Byte of byte
+ | UInt16 of uint16
+ | UInt32 of uint32
+ | UInt64 of uint64
+ | Single of single
+ | Double of double
+ | Null
+ | Type of ILType option
+ | TypeRef of ILTypeRef option
+ | Array of ILType * ILAttribElem list
+
+/// Named args: values and flags indicating if they are fields or properties
+type ILAttributeNamedArg = string * ILType * bool * ILAttribElem
+
+/// Custom attributes. See 'decodeILAttribData' for a helper to parse the byte[]
+/// to ILAttribElem's as best as possible.
+type ILAttribute =
+ { Method: ILMethodSpec;
+#if SILVERLIGHT
+ Arguments: ILAttribElem list * ILAttributeNamedArg list
+#endif
+ Data: byte[] }
+
+[]
+type ILAttributes =
+ member AsList : ILAttribute list
+
+/// Method parameters and return values
+
+type ILParameter =
+ { Name: string option;
+ Type: ILType;
+ Default: ILFieldInit option;
+ /// Marshalling map for parameters. COM Interop only.
+ Marshal: ILNativeType option;
+ IsIn: bool;
+ IsOut: bool;
+ IsOptional: bool;
+ CustomAttrs: ILAttributes }
+
+type ILParameters = ILList
+
+val typesOfILParamsRaw : ILParameters -> ILTypes
+val typesOfILParamsList : ILParameter list -> ILType list
+
+/// Method return values
+type ILReturn =
+ { Marshal: ILNativeType option;
+ Type: ILType;
+ CustomAttrs: ILAttributes }
+
+/// Security ILPermissions
+///
+/// Attached to various structures...
+
+[]
+type ILSecurityAction =
+ | Request
+ | Demand
+ | Assert
+ | Deny
+ | PermitOnly
+ | LinkCheck
+ | InheritCheck
+ | ReqMin
+ | ReqOpt
+ | ReqRefuse
+ | PreJitGrant
+ | PreJitDeny
+ | NonCasDemand
+ | NonCasLinkDemand
+ | NonCasInheritance
+ | LinkDemandChoice
+ | InheritanceDemandChoice
+ | DemandChoice
+
+type ILPermission =
+ | PermissionSet of ILSecurityAction * byte[]
+
+/// Abstract type equivalent to ILPermission list - use helpers
+/// below to construct/destruct these
+[]
+type ILPermissions =
+ member AsList : ILPermission list
+
+/// PInvoke attributes.
+[]
+type PInvokeCallingConvention =
+ | None
+ | Cdecl
+ | Stdcall
+ | Thiscall
+ | Fastcall
+ | WinApi
+
+[]
+type PInvokeCharEncoding =
+ | None
+ | Ansi
+ | Unicode
+ | Auto
+
+[]
+type PInvokeCharBestFit =
+ | UseAssembly
+ | Enabled
+ | Disabled
+
+[]
+type PInvokeThrowOnUnmappableChar =
+ | UseAssembly
+ | Enabled
+ | Disabled
+
+[]
+type PInvokeMethod =
+ { Where: ILModuleRef;
+ Name: string;
+ CallingConv: PInvokeCallingConvention;
+ CharEncoding: PInvokeCharEncoding;
+ NoMangle: bool;
+ LastError: bool;
+ ThrowOnUnmappableChar: PInvokeThrowOnUnmappableChar;
+ CharBestFit: PInvokeCharBestFit }
+
+
+/// [OverridesSpec] - refer to a method declaration in a superclass
+/// or superinterface. Used for overriding/method impls. Includes
+/// a type for the parent for the same reason that a method specs
+/// includes the type of the enclosing type, i.e. the type
+/// gives the "ILGenericArgs" at which the parent type is being used.
+
+type ILOverridesSpec =
+ | OverridesSpec of ILMethodRef * ILType
+ member MethodRef: ILMethodRef
+ member EnclosingType: ILType
+
+// REVIEW: fold this into ILMethodDef
+type ILMethodVirtualInfo =
+ { IsFinal: bool;
+ IsNewSlot: bool;
+ IsCheckAccessOnOverride: bool;
+ IsAbstract: bool; }
+
+[]
+type MethodKind =
+ | Static
+ | Cctor
+ | Ctor
+ | NonVirtual
+ | Virtual of ILMethodVirtualInfo
+
+// REVIEW: fold this into ILMethodDef
+[]
+type MethodBody =
+ | IL of ILMethodBody
+ | PInvoke of PInvokeMethod (* platform invoke to native *)
+ | Abstract
+ | Native
+
+// REVIEW: fold this into ILMethodDef
+[]
+type MethodCodeKind =
+ | IL
+ | Native
+ | Runtime
+
+/// Generic parameters. Formal generic parameter declarations
+/// may include the bounds, if any, on the generic parameter.
+type ILGenericParameterDef =
+ { Name: string;
+ /// At most one is the parent type, the others are interface types
+ Constraints: ILTypes;
+ /// Variance of type parameters, only applicable to generic parameters for generic interfaces and delegates
+ Variance: ILGenericVariance;
+ /// Indicates the type argument must be a reference type
+ HasReferenceTypeConstraint: bool;
+ CustomAttrs : ILAttributes;
+ /// Indicates the type argument must be a value type, but not Nullable
+ HasNotNullableValueTypeConstraint: bool;
+ /// Indicates the type argument must have a public nullary constructor
+ HasDefaultConstructorConstraint: bool; }
+
+
+type ILGenericParameterDefs = ILGenericParameterDef list
+
+// REVIEW: fold this into ILMethodDef
+[]
+type ILLazyMethodBody =
+ member Contents : MethodBody
+
+/// Method definitions.
+///
+/// There are several different flavours of methods (constructors,
+/// abstract, virtual, static, instance, class constructors). There
+/// is no perfect factorization of these as the combinations are not
+/// independent.
+
+[]
+type ILMethodDef =
+ { Name: string;
+ mdKind: MethodKind;
+ CallingConv: ILCallingConv;
+ Parameters: ILParameters;
+ Return: ILReturn;
+ Access: ILMemberAccess;
+ mdBody: ILLazyMethodBody;
+ mdCodeKind: MethodCodeKind;
+ IsInternalCall: bool;
+ IsManaged: bool;
+ IsForwardRef: bool;
+ SecurityDecls: ILPermissions;
+ /// Note: some methods are marked "HasSecurity" even if there are no permissions attached, e.g. if they use SuppressUnmanagedCodeSecurityAttribute
+ HasSecurity: bool;
+ IsEntryPoint:bool;
+ IsReqSecObj: bool;
+ IsHideBySig: bool;
+ IsSpecialName: bool;
+ /// The method is exported to unmanaged code using COM interop.
+ IsUnmanagedExport: bool;
+ IsSynchronized: bool;
+ IsPreserveSig: bool;
+ /// .NET 2.0 feature: SafeHandle finalizer must be run
+ IsMustRun: bool;
+ IsNoInline: bool;
+
+ GenericParams: ILGenericParameterDefs;
+ CustomAttrs: ILAttributes; }
+
+ member ParameterTypes: ILTypes;
+ member IsIL : bool
+ member Code : ILCode option
+ member Locals : ILLocals
+ member MaxStack : int32
+ member IsZeroInit : bool
+
+ /// .cctor methods. The predicates (IsClassInitializer,IsConstructor,IsStatic,IsNonVirtualInstance,IsVirtual) form a complete, non-overlapping classification of this type
+ member IsClassInitializer: bool
+ /// .ctor methods. The predicates (IsClassInitializer,IsConstructor,IsStatic,IsNonVirtualInstance,IsVirtual) form a complete, non-overlapping classification of this type
+ member IsConstructor: bool
+ /// static methods. The predicates (IsClassInitializer,IsConstructor,IsStatic,IsNonVirtualInstance,IsVirtual) form a complete, non-overlapping classification of this type
+ member IsStatic: bool
+ /// instance methods that are not virtual. The predicates (IsClassInitializer,IsConstructor,IsStatic,IsNonVirtualInstance,IsVirtual) form a complete, non-overlapping classification of this type
+ member IsNonVirtualInstance: bool
+ /// instance methods that are virtual or abstract or implement an interface slot. The predicates (IsClassInitializer,IsConstructor,IsStatic,IsNonVirtualInstance,IsVirtual) form a complete, non-overlapping classification of this type
+ member IsVirtual: bool
+
+ member IsFinal: bool
+ member IsNewSlot: bool
+ member IsCheckAccessOnOverride : bool
+ member IsAbstract: bool
+ member MethodBody : ILMethodBody
+ member CallingSignature: ILCallingSignature
+
+/// Tables of methods. Logically equivalent to a list of methods but
+/// the table is kept in a form optimized for looking up methods by
+/// name and arity.
+
+/// abstract type equivalent to [ILMethodDef list]
+[]
+type ILMethodDefs =
+ interface IEnumerable
+ member AsList : ILMethodDef list
+ member FindByName : string -> ILMethodDef list
+
+/// Field definitions
+[]
+type ILFieldDef =
+ { Name: string;
+ Type: ILType;
+ IsStatic: bool;
+ Access: ILMemberAccess;
+ Data: byte[] option;
+ LiteralValue: ILFieldInit option;
+ /// The explicit offset in bytes when explicit layout is used.
+ Offset: int32 option;
+ IsSpecialName: bool;
+ Marshal: ILNativeType option;
+ NotSerialized: bool;
+ IsLiteral: bool ;
+ IsInitOnly: bool;
+ CustomAttrs: ILAttributes; }
+
+/// Tables of fields. Logically equivalent to a list of fields but
+/// the table is kept in a form optimized for looking up fields by
+/// name.
+[]
+type ILFieldDefs =
+ member AsList : ILFieldDef list
+ member LookupByName : string -> ILFieldDef list
+
+/// Event definitions
+[]
+type ILEventDef =
+ { Type: ILType option;
+ Name: string;
+ IsRTSpecialName: bool;
+ IsSpecialName: bool;
+ AddMethod: ILMethodRef;
+ RemoveMethod: ILMethodRef;
+ FireMethod: ILMethodRef option;
+ OtherMethods: ILMethodRef list;
+ CustomAttrs: ILAttributes; }
+
+/// Table of those events in a type definition.
+[]
+type ILEventDefs =
+ member AsList : ILEventDef list
+ member LookupByName : string -> ILEventDef list
+
+/// Property definitions
+[]
+type ILPropertyDef =
+ { Name: string;
+ IsRTSpecialName: bool;
+ IsSpecialName: bool;
+ SetMethod: ILMethodRef option;
+ GetMethod: ILMethodRef option;
+ CallingConv: ILThisConvention;
+ Type: ILType;
+ Init: ILFieldInit option;
+ Args: ILTypes;
+ CustomAttrs: ILAttributes; }
+
+/// Table of those properties in a type definition.
+[]
+[]
+type ILPropertyDefs =
+ member AsList : ILPropertyDef list
+ member LookupByName : string -> ILPropertyDef list
+
+/// Method Impls
+///
+/// If there is an entry (pms --> ms) in this table, then method [ms]
+/// is used to implement method [pms] for the purposes of this class
+/// and its subclasses.
+type ILMethodImplDef =
+ { Overrides: ILOverridesSpec;
+ OverrideBy: ILMethodSpec }
+
+[]
+type ILMethodImplDefs =
+ member AsList : ILMethodImplDef list
+
+/// Type Layout information
+[]
+type ILTypeDefLayout =
+ | Auto
+ | Sequential of ILTypeDefLayoutInfo
+ | Explicit of ILTypeDefLayoutInfo
+
+and ILTypeDefLayoutInfo =
+ { Size: int32 option;
+ Pack: uint16 option }
+
+/// Indicate the initialization semantics of a type
+[]
+type ILTypeInit =
+ | BeforeField
+ | OnAny
+
+/// Default Unicode encoding for P/Invoke within a type
+[]
+type ILDefaultPInvokeEncoding =
+ | Ansi
+ | Auto
+ | Unicode
+
+/// Type Access
+[]
+type ILTypeDefAccess =
+ | Public
+ | Private
+ | Nested of ILMemberAccess
+
+/// A categorization of type definitions into "kinds"
+
+//-------------------------------------------------------------------
+// A note for the nit-picky.... In theory, the "kind" of a type
+// definition can only be partially determined prior to binding.
+// For example, you cannot really, absolutely tell if a type is
+// really, absolutely a value type until you bind the
+// super class and test it for type equality against System.ValueType.
+// However, this is unbearably annoying, as it means you
+// have to load "mscorlib" and perform bind operations
+// in order to be able to determine some quite simple
+// things. So we approximate by simply looking at the name
+// of the superclass when loading.
+// ------------------------------------------------------------------
+
+[]
+type ILTypeDefKind =
+ | Class
+ | ValueType
+ | Interface
+ | Enum
+ | Delegate
+ (* FOR EXTENSIONS, e.g. MS-ILX *)
+ | Other of IlxExtensionTypeKind
+
+/// Tables of named type definitions. The types and table may contain on-demand
+/// (lazy) computations, e.g. the actual reading of some aspects
+/// of a type definition may be delayed if the reader being used supports
+/// this.
+///
+/// This is an abstract type equivalent to "ILTypeDef list"
+[]
+[]
+type ILTypeDefs =
+ interface IEnumerable
+ member AsList : ILTypeDef list
+
+ /// Get some information about the type defs, but do not force the read of the type defs themselves
+ member AsListOfLazyTypeDefs : (string list * string * ILAttributes * Lazy) list
+
+ /// Calls to [FindByName] will result in any laziness in the overall
+ /// set of ILTypeDefs being read in in addition
+ /// to the details for the type found, but the remaining individual
+ /// type definitions will not be read.
+ member FindByName : string -> ILTypeDef
+
+/// Type Definitions
+///
+/// As for methods there are several important constraints not encoded
+/// in the type definition below, for example that the super class of
+/// an interface type is always None, or that enumerations always
+/// have a very specific form.
+and []
+ ILTypeDef =
+ { tdKind: ILTypeDefKind;
+ Name: string;
+ GenericParams: ILGenericParameterDefs;
+ Access: ILTypeDefAccess;
+ IsAbstract: bool;
+ IsSealed: bool;
+ IsSerializable: bool;
+ /// Class or interface generated for COM interop
+ IsComInterop: bool;
+ Layout: ILTypeDefLayout;
+ IsSpecialName: bool;
+ Encoding: ILDefaultPInvokeEncoding;
+ NestedTypes: ILTypeDefs;
+ Implements: ILTypes;
+ Extends: ILType option;
+ Methods: ILMethodDefs;
+ SecurityDecls: ILPermissions;
+ /// Note: some classes are marked "HasSecurity" even if there are no permissions attached, e.g. if they use SuppressUnmanagedCodeSecurityAttribute
+ HasSecurity: bool;
+ Fields: ILFieldDefs;
+ MethodImpls: ILMethodImplDefs;
+ InitSemantics: ILTypeInit;
+ Events: ILEventDefs;
+ Properties: ILPropertyDefs;
+ CustomAttrs: ILAttributes; }
+ member IsClass: bool;
+ member IsInterface: bool;
+ member IsEnum: bool;
+ member IsDelegate: bool;
+ member IsStructOrEnum : bool
+
+[]
+[]
+type ILNestedExportedTypes =
+ member AsList : ILNestedExportedType list
+
+/// "Classes Elsewhere" - classes in auxiliary modules.
+///
+/// Manifests include declarations for all the classes in an
+/// assembly, regardless of which module they are in.
+///
+/// The ".class extern" construct describes so-called exported types --
+/// these are public classes defined in the auxiliary modules of this assembly,
+/// i.e. modules other than the manifest-carrying module.
+///
+/// For example, if you have a two-module
+/// assembly (A.DLL and B.DLL), and the manifest resides in the A.DLL,
+/// then in the manifest all the public classes declared in B.DLL should
+/// be defined as exported types, i.e., as ".class extern". The public classes
+/// defined in A.DLL should not be defined as ".class extern" -- they are
+/// already available in the manifest-carrying module. The union of all
+/// public classes defined in the manifest-carrying module and all
+/// exported types defined there is the set of all classes exposed by
+/// this assembly. Thus, by analysing the metadata of the manifest-carrying
+/// module of an assembly, you can identify all the classes exposed by
+/// this assembly, and where to find them.
+///
+/// Nested classes found in external modules should also be located in
+/// this table, suitably nested inside another "ILExportedTypeOrForwarder"
+/// definition.
+
+/// these are only found in the "Nested" field of ILExportedTypeOrForwarder objects
+// REVIEW: fold this into ILExportedTypeOrForwarder. There's not much value in keeping these distinct
+and ILNestedExportedType =
+ { Name: string;
+ Access: ILMemberAccess;
+ Nested: ILNestedExportedTypes;
+ CustomAttrs: ILAttributes }
+
+/// these are only found in the ILExportedTypesAndForwarders table in the manifest
+[]
+type ILExportedTypeOrForwarder =
+ { ScopeRef: ILScopeRef;
+ /// [Namespace.]Name
+ Name: string;
+ IsForwarder: bool;
+ Access: ILTypeDefAccess;
+ Nested: ILNestedExportedTypes;
+ CustomAttrs: ILAttributes }
+
+[]
+[]
+type ILExportedTypesAndForwarders =
+ member AsList : ILExportedTypeOrForwarder list
+
+[]
+type ILResourceAccess =
+ | Public
+ | Private
+
+[]
+type ILResourceLocation =
+ | Local of (unit -> byte[]) (* resources may be re-read each time this function is called *)
+ | File of ILModuleRef * int32
+ | Assembly of ILAssemblyRef
+
+/// "Manifest ILResources" are chunks of resource data, being one of:
+/// - the data section of the current module (byte[] of resource given directly)
+/// - in an external file in this assembly (offset given in the ILResourceLocation field)
+/// - as a resources in another assembly of the same name.
+type ILResource =
+ { Name: string;
+ Location: ILResourceLocation;
+ Access: ILResourceAccess;
+ CustomAttrs: ILAttributes }
+
+/// Table of resources in a module
+[]
+[]
+type ILResources =
+ member AsList : ILResource list
+
+
+[]
+type ILAssemblyLongevity =
+ | Unspecified
+ | Library
+ | PlatformAppDomain
+ | PlatformProcess
+ | PlatformSystem
+
+/// The main module of an assembly is a module plus some manifest information.
+type ILAssemblyManifest =
+ { Name: string;
+ /// This is ID of the algorithm used for the hashes of auxiliary
+ /// files in the assembly. These hashes are stored in the
+ /// ILModuleRef.Hash fields of this assembly. These are not cryptographic
+ /// hashes: they are simple file hashes. The algorithm is normally
+ /// 0x00008004 indicating the SHA1 hash algorithm.
+ AuxModuleHashAlgorithm: int32;
+ SecurityDecls: ILPermissions;
+ /// This is the public key used to sign this
+ /// assembly (the signature itself is stored elsewhere: see the
+ /// binary format, and may not have been written if delay signing
+ /// is used). (member Name, member PublicKey) forms the full
+ /// public name of the assembly.
+ PublicKey: byte[] option;
+ Version: ILVersionInfo option;
+ Locale: string option;
+ CustomAttrs: ILAttributes;
+ AssemblyLongevity: ILAssemblyLongevity;
+ DisableJitOptimizations: bool;
+ JitTracking: bool;
+ Retargetable: bool;
+ /// Records the types impemented by this asssembly in auxiliary
+ /// modules.
+ ExportedTypes: ILExportedTypesAndForwarders;
+ /// Records whether the entrypoint resides in another module.
+ EntrypointElsewhere: ILModuleRef option;
+ }
+
+/// One module in the "current" assembly, either a main-module or
+/// an auxiliary module. The main module will have a manifest.
+///
+/// An assembly is built by joining together a "main" module plus
+/// several auxiliary modules.
+type ILModuleDef =
+ { Manifest: ILAssemblyManifest option;
+ CustomAttrs: ILAttributes;
+ Name: string;
+ TypeDefs: ILTypeDefs;
+ SubsystemVersion : int * int
+ UseHighEntropyVA : bool
+ SubSystemFlags: int32;
+ IsDLL: bool;
+ IsILOnly: bool;
+ Platform: ILPlatform option;
+ StackReserveSize: int32 option;
+ Is32Bit: bool;
+ Is32BitPreferred: bool;
+ Is64Bit: bool;
+ VirtualAlignment: int32;
+ PhysicalAlignment: int32;
+ ImageBase: int32;
+ MetadataVersion: string;
+ Resources: ILResources;
+ /// e.g. win86 resources, as the exact contents of a .res or .obj file
+ NativeResources: Lazy list; }
+ member ManifestOfAssembly: ILAssemblyManifest
+ member HasManifest : bool
+
+/// Find the method definition corresponding to the given property or
+/// event operation. These are always in the same class as the property
+/// or event. This is useful especially if your code is not using the Ilbind
+/// API to bind references.
+val resolveILMethodRef: ILTypeDef -> ILMethodRef -> ILMethodDef
+
+// ------------------------------------------------------------------
+// Type Names
+//
+// The name of a type stored in the Name field is as follows:
+// - For outer types it is, for example, System.String, i.e.
+// the namespace followed by the type name.
+// - For nested types, it is simply the type name. The namespace
+// must be gleaned from the context in which the nested type
+// lies.
+// ------------------------------------------------------------------
+
+val splitNamespace: string -> string list
+
+val splitNamespaceToArray: string -> string[]
+
+/// The splitILTypeName utility helps you split a string representing
+/// a type name into the leading namespace elements (if any), the
+/// names of any nested types and the type name itself. This function
+/// memoizes and interns the splitting of the namespace portion of
+/// the type name.
+val splitILTypeName: string -> string list * string
+
+val splitILTypeNameWithPossibleStaticArguments: string -> string[] * string
+
+/// splitTypeNameRight is like splitILTypeName except the
+/// namespace is kept as a whole string, rather than split at dots.
+val splitTypeNameRight: string -> string option * string
+
+
+val typeNameForGlobalFunctions: string
+val isTypeNameForGlobalFunctions: string -> bool
+
+val ungenericizeTypeName: string -> string (* e.g. List`1 --> List *)
+
+// ====================================================================
+// PART 2
+//
+// Making metadata. Where no explicit constructor
+// is given, you should create the concrete datatype directly,
+// e.g. by filling in all appropriate record fields.
+// ==================================================================== *)
+
+/// A table of common references to items in mscorlib. Version-neutral references
+/// can be generated using ecmaILGlobals. If you have already loaded a particular
+/// version of mscorlib you should reference items via an ILGlobals for that particular
+/// version of mscorlib built using mkILGlobals.
+[]
+type ILGlobals =
+ { mscorlibScopeRef: ILScopeRef
+ mscorlibAssemblyName: string
+ noDebugData: bool
+ generateDebugBrowsableData: bool
+ tref_Object: ILTypeRef
+ tspec_Object: ILTypeSpec
+ typ_Object: ILType
+ tref_String: ILTypeRef
+ typ_String: ILType
+ typ_StringBuilder: ILType
+ typ_AsyncCallback: ILType
+ typ_IAsyncResult: ILType
+ typ_IComparable: ILType
+ tref_Type: ILTypeRef
+ typ_Type: ILType
+ typ_Missing: ILType
+ typ_Activator: ILType
+ typ_Delegate: ILType
+ typ_ValueType: ILType
+ typ_Enum: ILType
+ tspec_TypedReference: ILTypeSpec
+ typ_TypedReference: ILType
+ typ_MulticastDelegate: ILType
+ typ_Array: ILType
+ tspec_Int64: ILTypeSpec
+ tspec_UInt64: ILTypeSpec
+ tspec_Int32: ILTypeSpec
+ tspec_UInt32: ILTypeSpec
+ tspec_Int16: ILTypeSpec
+ tspec_UInt16: ILTypeSpec
+ tspec_SByte: ILTypeSpec
+ tspec_Byte: ILTypeSpec
+ tspec_Single: ILTypeSpec
+ tspec_Double: ILTypeSpec
+ tspec_IntPtr: ILTypeSpec
+ tspec_UIntPtr: ILTypeSpec
+ tspec_Char: ILTypeSpec
+ tspec_Bool: ILTypeSpec
+ typ_int8: ILType
+ typ_int16: ILType
+ typ_int32: ILType
+ typ_int64: ILType
+ typ_uint8: ILType
+ typ_uint16: ILType
+ typ_uint32: ILType
+ typ_uint64: ILType
+ typ_float32: ILType
+ typ_float64: ILType
+ typ_bool: ILType
+ typ_char: ILType
+ typ_IntPtr: ILType
+ typ_UIntPtr: ILType
+ typ_RuntimeArgumentHandle: ILType
+ typ_RuntimeTypeHandle: ILType
+ typ_RuntimeMethodHandle: ILType
+ typ_RuntimeFieldHandle: ILType
+ typ_Byte: ILType
+ typ_Int16: ILType
+ typ_Int32: ILType
+ typ_Int64: ILType
+ typ_SByte: ILType
+ typ_UInt16: ILType
+ typ_UInt32: ILType
+ typ_UInt64: ILType
+ typ_Single: ILType
+ typ_Double: ILType
+ typ_Bool: ILType
+ typ_Char: ILType
+ typ_SerializationInfo: ILType
+ typ_StreamingContext: ILType
+ tref_SecurityPermissionAttribute : ILTypeRef
+ tspec_Exception: ILTypeSpec
+ typ_Exception: ILType
+ mutable generatedAttribsCache: ILAttribute list
+ mutable debuggerBrowsableNeverAttributeCache : ILAttribute option
+ mutable debuggerTypeProxyAttributeCache : ILAttribute option }
+
+/// Build the table of commonly used references given a ILScopeRef for mscorlib.
+val mkILGlobals : mscorlibScopeRef:ILScopeRef -> mscorlibAssemblyNameOpt:string option -> noDebugData:bool * generateDebugBrowsableData:bool -> ILGlobals
+
+
+/// When writing a binary the fake "toplevel" type definition (called )
+/// must come first. This function puts it first, and creates it in the returned list as an empty typedef if it
+/// doesn't already exist.
+val destTypeDefsWithGlobalFunctionsFirst: ILGlobals -> ILTypeDefs -> ILTypeDef list
+
+/// Note: not all custom attribute data can be decoded without binding types. In particular
+/// enums must be bound in order to discover the size of the underlying integer.
+/// The following assumes enums have size int32.
+/// It also does not completely decode System.Type attributes
+val decodeILAttribData:
+ ILGlobals ->
+ ILAttribute ->
+ ILScopeRef option ->
+ ILAttribElem list * (* fixed args *)
+ ILAttributeNamedArg list (* named args: values and flags indicating if they are fields or properties *)
+
+/// Generate simple references to assemblies and modules
+val mkSimpleAssRef: string -> ILAssemblyRef
+val mkSimpleModRef: string -> ILModuleRef
+
+val emptyILGenericArgs: ILGenericArgs
+val mkILTyvarTy: uint16 -> ILType
+
+/// Make type refs
+val mkILNestedTyRef: ILScopeRef * string list * string -> ILTypeRef
+val mkILTyRef: ILScopeRef * string -> ILTypeRef
+val mkILTyRefInTyRef: ILTypeRef * string -> ILTypeRef
+
+type ILGenericArgsList = ILType list
+val mkILGenericArgs : ILGenericArgsList -> ILGenericArgs
+/// Make type specs
+val mkILNonGenericTySpec: ILTypeRef -> ILTypeSpec
+val mkILTySpec: ILTypeRef * ILGenericArgsList -> ILTypeSpec
+val mkILTySpecRaw: ILTypeRef * ILGenericArgs -> ILTypeSpec
+
+/// Make types
+val mkILTy: ILBoxity -> ILTypeSpec -> ILType
+val mkILNamedTy: ILBoxity -> ILTypeRef -> ILGenericArgsList -> ILType
+val mkILBoxedTy: ILTypeRef -> ILGenericArgsList -> ILType
+val mkILBoxedTyRaw: ILTypeRef -> ILGenericArgs -> ILType
+val mkILValueTy: ILTypeRef -> ILGenericArgsList -> ILType
+val mkILNonGenericBoxedTy: ILTypeRef -> ILType
+val mkILNonGenericValueTy: ILTypeRef -> ILType
+val mkILArrTy: ILType * ILArrayShape -> ILType
+val mkILArr1DTy: ILType -> ILType
+val isILArrTy: ILType -> bool
+val destILArrTy: ILType -> ILArrayShape * ILType
+val mkILBoxedType : ILTypeSpec -> ILType
+
+val mkILTypes : ILType list -> ILTypes
+
+/// Make method references and specs
+val mkILMethRefRaw: ILTypeRef * ILCallingConv * string * int * ILTypes * ILType -> ILMethodRef
+val mkILMethRef: ILTypeRef * ILCallingConv * string * int * ILType list * ILType -> ILMethodRef
+val mkILMethSpec: ILMethodRef * ILBoxity * ILGenericArgsList * ILGenericArgsList -> ILMethodSpec
+val mkILMethSpecForMethRefInTyRaw: ILMethodRef * ILType * ILGenericArgs -> ILMethodSpec
+val mkILMethSpecForMethRefInTy: ILMethodRef * ILType * ILGenericArgsList -> ILMethodSpec
+val mkILMethSpecInTy: ILType * ILCallingConv * string * ILType list * ILType * ILGenericArgsList -> ILMethodSpec
+val mkILMethSpecInTyRaw: ILType * ILCallingConv * string * ILTypes * ILType * ILGenericArgs -> ILMethodSpec
+
+/// Construct references to methods on a given type
+val mkILNonGenericMethSpecInTy: ILType * ILCallingConv * string * ILType list * ILType -> ILMethodSpec
+
+/// Construct references to instance methods
+val mkILInstanceMethSpecInTy: ILType * string * ILType list * ILType * ILGenericArgsList -> ILMethodSpec
+
+/// Construct references to instance methods
+val mkILNonGenericInstanceMethSpecInTy: ILType * string * ILType list * ILType -> ILMethodSpec
+
+/// Construct references to static methods
+val mkILStaticMethSpecInTy: ILType * string * ILType list * ILType * ILGenericArgsList -> ILMethodSpec
+
+/// Construct references to static, non-generic methods
+val mkILNonGenericStaticMethSpecInTy: ILType * string * ILType list * ILType -> ILMethodSpec
+
+/// Construct references to constructors
+val mkILCtorMethSpecForTy: ILType * ILType list -> ILMethodSpec
+
+/// Construct references to fields
+val mkILFieldRef: ILTypeRef * string * ILType -> ILFieldRef
+val mkILFieldSpec: ILFieldRef * ILType -> ILFieldSpec
+val mkILFieldSpecInTy: ILType * string * ILType -> ILFieldSpec
+
+val mkILCallSigRaw: ILCallingConv * ILTypes * ILType -> ILCallingSignature
+val mkILCallSig: ILCallingConv * ILType list * ILType -> ILCallingSignature
+
+/// Make generalized verions of possibly-generic types,
+/// e.g. Given the ILTypeDef for List, return the type "List".
+
+val mkILFormalBoxedTy: ILTypeRef -> ILGenericParameterDef list -> ILType
+
+val mkILFormalTyparsRaw: ILTypes -> ILGenericParameterDefs
+val mkILFormalTypars: ILType list -> ILGenericParameterDefs
+val mkILFormalGenericArgsRaw: ILGenericParameterDefs -> ILGenericArgs
+val mkILFormalGenericArgs: ILGenericParameterDefs -> ILGenericArgsList
+val mkILSimpleTypar : string -> ILGenericParameterDef
+/// Make custom attributes
+val mkILCustomAttribMethRef:
+ ILGlobals
+ -> ILMethodSpec
+ * ILAttribElem list (* fixed args: values and implicit types *)
+ * ILAttributeNamedArg list (* named args: values and flags indicating if they are fields or properties *)
+ -> ILAttribute
+
+val mkILCustomAttribute:
+ ILGlobals
+ -> ILTypeRef * ILType list *
+ ILAttribElem list (* fixed args: values and implicit types *) *
+ ILAttributeNamedArg list (* named args: values and flags indicating if they are fields or properties *)
+ -> ILAttribute
+
+val mkPermissionSet : ILGlobals -> ILSecurityAction * (ILTypeRef * (string * ILType * ILAttribElem) list) list -> ILPermission
+
+/// Making code.
+val checkILCode: ILCode -> ILCode
+val generateCodeLabel: unit -> ILCodeLabel
+val formatCodeLabel : ILCodeLabel -> string
+
+/// Make some code that is a straight line sequence of instructions.
+/// The function will add a "return" if the last instruction is not an exiting instruction
+val nonBranchingInstrsToCode: ILInstr list -> ILCode
+
+/// Make some code that is a straight line sequence of instructions, then do
+/// some control flow. The first code label is the entry label of the generated code.
+val mkNonBranchingInstrsThen: ILCodeLabel -> ILInstr list -> ILInstr -> ILCode
+val mkNonBranchingInstrsThenBr: ILCodeLabel -> ILInstr list -> ILCodeLabel -> ILCode
+
+/// Make a basic block. The final instruction must be control flow
+val mkNonBranchingInstrs: ILCodeLabel -> ILInstr list -> ILCode
+
+/// Some more primitive helpers
+val mkBasicBlock: ILBasicBlock -> ILCode
+val mkGroupBlock: ILCodeLabel list * ILCode list -> ILCode
+
+/// Helpers for codegen: scopes for allocating new temporary variables.
+type ILLocalsAllocator =
+ new : preAlloc: int -> ILLocalsAllocator
+ member AllocLocal : ILLocal -> uint16
+ member Close : unit -> ILLocal list
+
+/// Derived functions for making some common patterns of instructions
+val mkNormalCall: ILMethodSpec -> ILInstr
+val mkNormalCallvirt: ILMethodSpec -> ILInstr
+val mkNormalCallconstraint: ILType * ILMethodSpec -> ILInstr
+val mkNormalNewobj: ILMethodSpec -> ILInstr
+val mkCallBaseConstructor : ILType * ILType list -> ILInstr list
+val mkNormalStfld: ILFieldSpec -> ILInstr
+val mkNormalStsfld: ILFieldSpec -> ILInstr
+val mkNormalLdsfld: ILFieldSpec -> ILInstr
+val mkNormalLdfld: ILFieldSpec -> ILInstr
+val mkNormalLdflda: ILFieldSpec -> ILInstr
+val mkNormalLdobj: ILType -> ILInstr
+val mkNormalStobj: ILType -> ILInstr
+val mkLdcInt32: int32 -> ILInstr
+val mkLdarg0: ILInstr
+val mkLdloc: uint16 -> ILInstr
+val mkStloc: uint16 -> ILInstr
+val mkLdarg: uint16 -> ILInstr
+
+val andTailness: ILTailcall -> bool -> ILTailcall
+
+/// Derived functions for making return, parameter and local variable
+/// objects for use in method definitions.
+val mkILParam: string option * ILType -> ILParameter
+val mkILParamAnon: ILType -> ILParameter
+val mkILParamNamed: string * ILType -> ILParameter
+val mkILReturn: ILType -> ILReturn
+val mkILLocal: ILType -> ILLocal
+val mkILLocals : ILLocal list -> ILLocals
+val emptyILLocals : ILLocals
+
+/// Make a formal generic parameters
+val mkILEmptyGenericParams: ILGenericParameterDefs
+
+/// Make method definitions
+val mkILMethodBody: initlocals:bool * ILLocals * int * ILCode * ILSourceMarker option -> ILMethodBody
+val mkMethodBody: bool * ILLocals * int * ILCode * ILSourceMarker option -> MethodBody
+
+val mkILCtor: ILMemberAccess * ILParameter list * MethodBody -> ILMethodDef
+val mkILClassCtor: MethodBody -> ILMethodDef
+val mkILNonGenericEmptyCtor: ILSourceMarker option -> ILType -> ILMethodDef
+val mkILStaticMethod: ILGenericParameterDefs * string * ILMemberAccess * ILParameter list * ILReturn * MethodBody -> ILMethodDef
+val mkILNonGenericStaticMethod: string * ILMemberAccess * ILParameter list * ILReturn * MethodBody -> ILMethodDef
+val mkILGenericVirtualMethod: string * ILMemberAccess * ILGenericParameterDefs * ILParameter list * ILReturn * MethodBody -> ILMethodDef
+val mkILGenericNonVirtualMethod: string * ILMemberAccess * ILGenericParameterDefs * ILParameter list * ILReturn * MethodBody -> ILMethodDef
+val mkILNonGenericVirtualMethod: string * ILMemberAccess * ILParameter list * ILReturn * MethodBody -> ILMethodDef
+val mkILNonGenericInstanceMethod: string * ILMemberAccess * ILParameter list * ILReturn * MethodBody -> ILMethodDef
+
+
+/// Make field definitions
+val mkILInstanceField: string * ILType * ILFieldInit option * ILMemberAccess -> ILFieldDef
+val mkILStaticField: string * ILType * ILFieldInit option * byte[] option * ILMemberAccess -> ILFieldDef
+val mkILLiteralField: string * ILType * ILFieldInit * byte[] option * ILMemberAccess -> ILFieldDef
+
+/// Make a type definition
+val mkILGenericClass: string * ILTypeDefAccess * ILGenericParameterDefs * ILType * ILType list * ILMethodDefs * ILFieldDefs * ILTypeDefs * ILPropertyDefs * ILEventDefs * ILAttributes * ILTypeInit -> ILTypeDef
+val mkILSimpleClass: ILGlobals -> string * ILTypeDefAccess * ILMethodDefs * ILFieldDefs * ILTypeDefs * ILPropertyDefs * ILEventDefs * ILAttributes * ILTypeInit -> ILTypeDef
+val mkILTypeDefForGlobalFunctions: ILGlobals -> ILMethodDefs * ILFieldDefs -> ILTypeDef
+
+/// Make a type definition for a value type used to point to raw data.
+/// These are useful when generating array initialization code
+/// according to the
+/// ldtoken field valuetype ''/'$$struct0x6000127-1' ''::'$$method0x6000127-1'
+/// call void System.Runtime.CompilerServices.RuntimeHelpers::InitializeArray(class System.Array,valuetype System.RuntimeFieldHandle)
+/// idiom.
+val mkRawDataValueTypeDef: ILGlobals -> string * size:int32 * pack:uint16 -> ILTypeDef
+
+/// Injecting code into existing code blocks. A branch will
+/// be added from the given instructions to the (unique) entry of
+/// the code, and the first instruction will be the new entry
+/// of the method. The instructions should be non-branching.
+
+val prependInstrsToCode: ILInstr list -> ILCode -> ILCode
+val prependInstrsToMethod: ILInstr list -> ILMethodDef -> ILMethodDef
+
+/// Injecting initialization code into a class.
+/// Add some code to the end of the .cctor for a type. Create a .cctor
+/// if one doesn't exist already.
+val prependInstrsToClassCtor: ILInstr list -> ILSourceMarker option -> ILTypeDef -> ILTypeDef
+
+/// Derived functions for making some simple constructors
+val mkILStorageCtor: ILSourceMarker option * ILInstr list * ILType * (string * ILType) list * ILMemberAccess -> ILMethodDef
+val mkILSimpleStorageCtor: ILSourceMarker option * ILTypeSpec option * ILType * (string * ILType) list * ILMemberAccess -> ILMethodDef
+val mkILSimpleStorageCtorWithParamNames: ILSourceMarker option * ILTypeSpec option * ILType * (string * string * ILType) list * ILMemberAccess -> ILMethodDef
+
+val mkILDelegateMethods: ILGlobals -> ILParameter list * ILReturn -> ILMethodDef list
+
+/// Given a delegate type definition which lies in a particular scope,
+/// make a reference to its constructor
+val mkCtorMethSpecForDelegate: ILGlobals -> ILType * bool -> ILMethodSpec
+
+/// The toplevel "class" for a module or assembly.
+val mkILTypeForGlobalFunctions: ILScopeRef -> ILType
+
+/// Making tables of custom attributes, etc.
+val mkILCustomAttrs: ILAttribute list -> ILAttributes
+val mkILComputedCustomAttrs: (unit -> ILAttribute list) -> ILAttributes
+val emptyILCustomAttrs: ILAttributes
+
+val mkILSecurityDecls: ILPermission list -> ILPermissions
+val mkILLazySecurityDecls: Lazy -> ILPermissions
+val emptyILSecurityDecls: ILPermissions
+
+val mkMethBodyAux : MethodBody -> ILLazyMethodBody
+val mkMethBodyLazyAux : Lazy -> ILLazyMethodBody
+
+val mkILEvents: ILEventDef list -> ILEventDefs
+val mkILEventsLazy: Lazy -> ILEventDefs
+val emptyILEvents: ILEventDefs
+
+val mkILProperties: ILPropertyDef list -> ILPropertyDefs
+val mkILPropertiesLazy: Lazy -> ILPropertyDefs
+val emptyILProperties: ILPropertyDefs
+
+val mkILMethods: ILMethodDef list -> ILMethodDefs
+val mkILMethodsLazy: Lazy -> ILMethodDefs
+val addILMethod: ILMethodDef -> ILMethodDefs -> ILMethodDefs
+val emptyILMethods: ILMethodDefs
+
+val mkILFields: ILFieldDef list -> ILFieldDefs
+val mkILFieldsLazy: Lazy -> ILFieldDefs
+val emptyILFields: ILFieldDefs
+
+val mkILMethodImpls: ILMethodImplDef list -> ILMethodImplDefs
+val mkILMethodImplsLazy: Lazy -> ILMethodImplDefs
+val emptyILMethodImpls: ILMethodImplDefs
+
+val mkILTypeDefs: ILTypeDef list -> ILTypeDefs
+val emptyILTypeDefs: ILTypeDefs
+
+/// Create table of types which is loaded/computed on-demand, and whose individual
+/// elements are also loaded/computed on-demand. Any call to tdefs.AsList will
+/// result in the laziness being forced. Operations can examine the
+/// custom attributes and name of each type in order to decide whether
+/// to proceed with examining the other details of the type.
+///
+/// Note that individual type definitions may contain further delays
+/// in their method, field and other tables.
+val mkILTypeDefsLazy: Lazy<(string list * string * ILAttributes * Lazy) list> -> ILTypeDefs
+val addILTypeDef: ILTypeDef -> ILTypeDefs -> ILTypeDefs
+
+val mkILNestedExportedTypes: ILNestedExportedType list -> ILNestedExportedTypes
+val mkILNestedExportedTypesLazy: Lazy -> ILNestedExportedTypes
+
+val mkILExportedTypes: ILExportedTypeOrForwarder list -> ILExportedTypesAndForwarders
+val mkILExportedTypesLazy: Lazy -> ILExportedTypesAndForwarders
+
+val mkILResources: ILResource list -> ILResources
+val mkILResourcesLazy: Lazy -> ILResources
+
+/// Making modules
+val mkILSimpleModule: assemblyName:string -> moduleName:string -> dll:bool -> subsystemVersion : (int * int) -> useHighEntropyVA : bool -> ILTypeDefs -> int32 option -> string option -> int -> ILExportedTypesAndForwarders -> string -> ILModuleDef
+
+/// Generate references to existing type definitions, method definitions
+/// etc. Useful for generating references, e.g. to a class we're processing
+/// Also used to reference type definitions that we've generated. [ILScopeRef]
+/// is normally ILScopeRef.Local, unless we've generated the ILTypeDef in
+/// an auxiliary module or are generating multiple assemblies at
+/// once.
+
+val mkRefForNestedILTypeDef : ILScopeRef -> ILTypeDef list * ILTypeDef -> ILTypeRef
+val mkRefForILMethod : ILScopeRef -> ILTypeDef list * ILTypeDef -> ILMethodDef -> ILMethodRef
+val mkRefForILField : ILScopeRef -> ILTypeDef list * ILTypeDef -> ILFieldDef -> ILFieldRef
+
+val mkRefToILMethod: ILTypeRef * ILMethodDef -> ILMethodRef
+val mkRefToILField: ILTypeRef * ILFieldDef -> ILFieldRef
+
+val mkRefToILAssembly: ILAssemblyManifest -> ILAssemblyRef
+val mkRefToILModule: ILModuleDef -> ILModuleRef
+
+
+// --------------------------------------------------------------------
+// Rescoping.
+//
+// Given an object O1 referenced from where1 (e.g. O1 binds to some
+// result R when referenced from where1), and given that SR2 resolves to where1 from where2,
+// produce a new O2 for use from where2 (e.g. O2 binds to R from where2)
+//
+// So, ILScopeRef tells you how to reference the original scope from
+// the new scope. e.g. if ILScopeRef is:
+// [ILScopeRef.Local] then the object is returned unchanged
+// [ILScopeRef.Module m] then an object is returned
+// where all ILScopeRef.Local references
+// become ILScopeRef.Module m
+// [ILScopeRef.Assembly m] then an object is returned
+// where all ILScopeRef.Local and ILScopeRef.Module references
+// become ILScopeRef.Assembly m
+// --------------------------------------------------------------------
+
+/// Rescoping. The first argument tells the function how to reference the original scope from
+/// the new scope.
+val rescopeILScopeRef: ILScopeRef -> ILScopeRef -> ILScopeRef
+/// Rescoping. The first argument tells the function how to reference the original scope from
+/// the new scope.
+val rescopeILTypeSpec: ILScopeRef -> ILTypeSpec -> ILTypeSpec
+/// Rescoping. The first argument tells the function how to reference the original scope from
+/// the new scope.
+val rescopeILType: ILScopeRef -> ILType -> ILType
+/// Rescoping. The first argument tells the function how to reference the original scope from
+/// the new scope.
+val rescopeILMethodRef: ILScopeRef -> ILMethodRef -> ILMethodRef
+/// Rescoping. The first argument tells the function how to reference the original scope from
+/// the new scope.
+val rescopeILFieldRef: ILScopeRef -> ILFieldRef -> ILFieldRef
+
+
+//-----------------------------------------------------------------------
+// The ILCode Builder utility.
+//----------------------------------------------------------------------
+
+[]
+type ILExceptionClause =
+ | Finally of (ILCodeLabel * ILCodeLabel)
+ | Fault of (ILCodeLabel * ILCodeLabel)
+ | FilterCatch of (ILCodeLabel * ILCodeLabel) * (ILCodeLabel * ILCodeLabel)
+ | TypeCatch of ILType * (ILCodeLabel * ILCodeLabel)
+
+type ILExceptionSpec =
+ { exnRange: (ILCodeLabel * ILCodeLabel);
+ exnClauses: ILExceptionClause list }
+
+type ILLocalSpec =
+ { locRange: (ILCodeLabel * ILCodeLabel);
+ locInfos: ILDebugMapping list }
+
+/// buildILCode: Build code from a sequence of instructions.
+///
+/// e.g. "buildILCode meth resolver instrs exns locals"
+///
+/// This makes the basic block structure of code from more primitive
+/// information, i.e. an array of instructions.
+/// [meth]: for debugging and should give the name of the method.
+/// [resolver]: should return the instruction indexes referred to
+/// by code-label strings in the instruction stream.
+/// [instrs]: the instructions themselves, perhaps with attributes giving
+/// debugging information
+/// [exns]: the table of exception-handling specifications
+/// for the method. These are again given with respect to labels which will
+/// be mapped to pc's by [resolver].
+/// [locals]: the table of specifications of when local variables are live and
+/// should appear in the debug info.
+///
+/// If the input code is well-formed, the function will returns the
+/// chop up the instruction sequence into basic blocks as required for
+/// the exception handlers and then return the tree-structured code
+/// corresponding to the instruction stream.
+/// A new set of code labels will be used throughout the resulting code.
+///
+/// The input can be badly formed in many ways: exception handlers might
+/// overlap, or scopes of local variables may overlap badly with
+/// exception handlers.
+val buildILCode:
+ string ->
+ (ILCodeLabel -> int) ->
+ ILInstr[] ->
+ ILExceptionSpec list ->
+ ILLocalSpec list ->
+ ILCode
+
+// --------------------------------------------------------------------
+// The instantiation utilities.
+// --------------------------------------------------------------------
+
+/// Instantiate type variables that occur within types and other items.
+val instILTypeAux: int -> ILGenericArgs -> ILType -> ILType
+
+/// Instantiate type variables that occur within types and other items.
+val instILType: ILGenericArgs -> ILType -> ILType
+
+// --------------------------------------------------------------------
+// ECMA globals
+// --------------------------------------------------------------------
+
+/// This is a 'vendor neutral' way of referencing mscorlib.
+val ecmaPublicKey: PublicKey
+/// This is a 'vendor neutral' way of referencing mscorlib.
+val ecmaMscorlibScopeRef: ILScopeRef
+/// This is a 'vendor neutral' collection of references to items in mscorlib.
+val ecmaILGlobals: ILGlobals
+
+
+/// Some commonly used methods
+val mkInitializeArrayMethSpec: ILGlobals -> ILMethodSpec
+
+val mkMscorlibExnNewobj: ILGlobals -> string -> ILInstr
+
+/// Some commonly used custom attibutes
+val mkDebuggableAttribute: ILGlobals -> bool (* debug tracking *) * bool (* disable JIT optimizations *) -> ILAttribute
+val mkDebuggableAttributeV2: ILGlobals -> bool (* jitTracking *) * bool (* ignoreSymbolStoreSequencePoints *) * bool (* disable JIT optimizations *) * bool (* enable EnC *) -> ILAttribute
+
+val mkCompilerGeneratedAttribute : ILGlobals -> ILAttribute
+val mkDebuggerNonUserCodeAttribute : ILGlobals -> ILAttribute
+val mkDebuggerStepThroughAttribute : ILGlobals -> ILAttribute
+val mkDebuggerHiddenAttribute : ILGlobals -> ILAttribute
+val mkDebuggerDisplayAttribute : ILGlobals -> string -> ILAttribute
+val mkDebuggerTypeProxyAttribute : ILGlobals -> ILType -> ILAttribute
+val mkDebuggerBrowsableNeverAttribute : ILGlobals -> ILAttribute
+
+val addMethodGeneratedAttrs : ILGlobals -> ILMethodDef -> ILMethodDef
+val addPropertyGeneratedAttrs : ILGlobals -> ILPropertyDef -> ILPropertyDef
+val addFieldGeneratedAttrs : ILGlobals -> ILFieldDef -> ILFieldDef
+
+val addPropertyNeverAttrs : ILGlobals -> ILPropertyDef -> ILPropertyDef
+val addFieldNeverAttrs : ILGlobals -> ILFieldDef -> ILFieldDef
+
+/// Discriminating different important built-in types
+val isILObjectTy: ILGlobals -> ILType -> bool
+val isILStringTy: ILGlobals -> ILType -> bool
+val isILSByteTy: ILGlobals -> ILType -> bool
+val isILByteTy: ILGlobals -> ILType -> bool
+val isILInt16Ty: ILGlobals -> ILType -> bool
+val isILUInt16Ty: ILGlobals -> ILType -> bool
+val isILInt32Ty: ILGlobals -> ILType -> bool
+val isILUInt32Ty: ILGlobals -> ILType -> bool
+val isILInt64Ty: ILGlobals -> ILType -> bool
+val isILUInt64Ty: ILGlobals -> ILType -> bool
+val isILIntPtrTy: ILGlobals -> ILType -> bool
+val isILUIntPtrTy: ILGlobals -> ILType -> bool
+val isILBoolTy: ILGlobals -> ILType -> bool
+val isILCharTy: ILGlobals -> ILType -> bool
+val isILTypedReferenceTy: ILGlobals -> ILType -> bool
+val isILDoubleTy: ILGlobals -> ILType -> bool
+val isILSingleTy: ILGlobals -> ILType -> bool
+
+/// Get a public key token from a public key.
+val sha1HashBytes : byte[] -> byte[] (* SHA1 hash *)
+
+/// Get a version number from a CLR version string, e.g. 1.0.3705.0
+val parseILVersion: string -> ILVersionInfo
+val formatILVersion: ILVersionInfo -> string
+val compareILVersions: ILVersionInfo -> ILVersionInfo -> int
+
+/// Decompose a type definition according to its kind.
+type ILEnumInfo =
+ { enumValues: (string * ILFieldInit) list;
+ enumType: ILType }
+
+val getTyOfILEnumInfo: ILEnumInfo -> ILType
+
+val computeILEnumInfo: string * ILFieldDefs -> ILEnumInfo
+
+// --------------------------------------------------------------------
+// For completeness. These do not occur in metadata but tools that
+// care about the existence of properties and events in the metadata
+// can benefit from them.
+// --------------------------------------------------------------------
+
+[]
+type ILEventRef =
+ static member Create : ILTypeRef * string -> ILEventRef
+ member EnclosingTypeRef: ILTypeRef
+ member Name: string
+
+[]
+type ILPropertyRef =
+ static member Create : ILTypeRef * string -> ILPropertyRef
+ member EnclosingTypeRef: ILTypeRef
+ member Name: string
+ interface System.IComparable
+
+val runningOnMono: bool
+
+type ILReferences =
+ { AssemblyReferences: ILAssemblyRef list;
+ ModuleReferences: ILModuleRef list; }
+
+/// Find the full set of assemblies referenced by a module
+val computeILRefs: ILModuleDef -> ILReferences
+val emptyILRefs: ILReferences
+
+// --------------------------------------------------------------------
+// The following functions are used to define an extension to the In reality the only extension is ILX
+
+type ILTypeDefKindExtension<'Extension> = TypeDefKindExtension
+
+val RegisterTypeDefKindExtension: ILTypeDefKindExtension<'Extension> -> ('Extension -> IlxExtensionTypeKind) * (IlxExtensionTypeKind -> bool) * (IlxExtensionTypeKind -> 'Extension)
diff --git a/src/absil/ilascii.fs b/src/absil/ilascii.fs
new file mode 100644
index 0000000..4c226f2
--- /dev/null
+++ b/src/absil/ilascii.fs
@@ -0,0 +1,284 @@
+//----------------------------------------------------------------------------
+// Copyright (c) 2002-2012 Microsoft Corporation.
+//
+// This source code is subject to terms and conditions of the Apache License, Version 2.0. A
+// copy of the license can be found in the License.html file at the root of this distribution.
+// By using this source code in any fashion, you are agreeing to be bound
+// by the terms of the Apache License, Version 2.0.
+//
+// You must not remove this notice, or any other, from this software.
+//----------------------------------------------------------------------------
+
+module Microsoft.FSharp.Compiler.AbstractIL.Internal.AsciiConstants
+
+open Internal.Utilities
+open Internal.Utilities.Collections
+
+open Microsoft.FSharp.Compiler.AbstractIL
+open Microsoft.FSharp.Compiler.AbstractIL.Internal
+open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library
+open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics
+open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.Types
+open Microsoft.FSharp.Compiler.AbstractIL.IL
+
+let parseILGlobals = ref ecmaILGlobals
+
+// --------------------------------------------------------------------
+// Table of parsing and pretty printing data for instructions.
+// - PP data is only used for instructions with no arguments
+// --------------------------------------------------------------------
+
+let noArgInstrs =
+ lazy [
+ ["ldc";"i4";"0"], mkLdcInt32 0;
+ ["ldc";"i4";"1"], mkLdcInt32 1;
+ ["ldc";"i4";"2"], mkLdcInt32 2;
+ ["ldc";"i4";"3"], mkLdcInt32 3;
+ ["ldc";"i4";"4"], mkLdcInt32 4;
+ ["ldc";"i4";"5"], mkLdcInt32 5;
+ ["ldc";"i4";"6"], mkLdcInt32 6;
+ ["ldc";"i4";"7"], mkLdcInt32 7;
+ ["ldc";"i4";"8"], mkLdcInt32 8;
+ ["ldc";"i4";"M1"], mkLdcInt32 -1;
+ ["ldc";"i4";"m1"], mkLdcInt32 -1;
+ ["stloc";"0"], mkStloc (uint16 0);
+ ["stloc";"1"], mkStloc (uint16 1);
+ ["stloc";"2"], mkStloc (uint16 2);
+ ["stloc";"3"], mkStloc (uint16 3);
+ ["ldloc";"0"], mkLdloc (uint16 0);
+ ["ldloc";"1"], mkLdloc (uint16 1);
+ ["ldloc";"2"], mkLdloc (uint16 2);
+ ["ldloc";"3"], mkLdloc (uint16 3);
+ ["ldarg";"0"], (mkLdarg (uint16 ( 0)));
+ ["ldarg";"1"], (mkLdarg (uint16 ( 1)));
+ ["ldarg";"2"], (mkLdarg (uint16 ( 2)));
+ ["ldarg";"3"], (mkLdarg (uint16 ( 3)));
+ ["ret"], I_ret;
+ ["add"], AI_add;
+ ["add";"ovf"], AI_add_ovf;
+ ["add";"ovf";"un"], AI_add_ovf_un;
+ ["and"], AI_and;
+ ["div"], AI_div;
+ ["div";"un"], AI_div_un;
+ ["ceq"], AI_ceq;
+ ["cgt"], AI_cgt;
+ ["cgt";"un"], AI_cgt_un;
+ ["clt"], AI_clt;
+ ["clt";"un"], AI_clt_un;
+ ["conv";"i1"], AI_conv DT_I1;
+ ["conv";"i2"], AI_conv DT_I2;
+ ["conv";"i4"], AI_conv DT_I4;
+ ["conv";"i8"], AI_conv DT_I8;
+ ["conv";"i"], AI_conv DT_I;
+ ["conv";"r4"], AI_conv DT_R4;
+ ["conv";"r8"], AI_conv DT_R8;
+ ["conv";"u1"], AI_conv DT_U1;
+ ["conv";"u2"], AI_conv DT_U2;
+ ["conv";"u4"], AI_conv DT_U4;
+ ["conv";"u8"], AI_conv DT_U8;
+ ["conv";"u"], AI_conv DT_U;
+ ["conv";"r"; "un"], AI_conv DT_R;
+ ["conv";"ovf";"i1"], AI_conv_ovf DT_I1;
+ ["conv";"ovf";"i2"], AI_conv_ovf DT_I2;
+ ["conv";"ovf";"i4"], AI_conv_ovf DT_I4;
+ ["conv";"ovf";"i8"], AI_conv_ovf DT_I8;
+ ["conv";"ovf";"i"], AI_conv_ovf DT_I;
+ ["conv";"ovf";"u1"], AI_conv_ovf DT_U1;
+ ["conv";"ovf";"u2"], AI_conv_ovf DT_U2;
+ ["conv";"ovf";"u4"], AI_conv_ovf DT_U4;
+ ["conv";"ovf";"u8"], AI_conv_ovf DT_U8;
+ ["conv";"ovf";"u"], AI_conv_ovf DT_U;
+ ["conv";"ovf";"i1"; "un"], AI_conv_ovf_un DT_I1;
+ ["conv";"ovf";"i2"; "un"], AI_conv_ovf_un DT_I2;
+ ["conv";"ovf";"i4"; "un"], AI_conv_ovf_un DT_I4;
+ ["conv";"ovf";"i8"; "un"], AI_conv_ovf_un DT_I8;
+ ["conv";"ovf";"i"; "un"], AI_conv_ovf_un DT_I;
+ ["conv";"ovf";"u1"; "un"], AI_conv_ovf_un DT_U1;
+ ["conv";"ovf";"u2"; "un"], AI_conv_ovf_un DT_U2;
+ ["conv";"ovf";"u4"; "un"], AI_conv_ovf_un DT_U4;
+ ["conv";"ovf";"u8"; "un"], AI_conv_ovf_un DT_U8;
+ ["conv";"ovf";"u"; "un"], AI_conv_ovf_un DT_U;
+ ["stelem";"i1"], I_stelem DT_I1;
+ ["stelem";"i2"], I_stelem DT_I2;
+ ["stelem";"i4"], I_stelem DT_I4;
+ ["stelem";"i8"], I_stelem DT_I8;
+ ["stelem";"r4"], I_stelem DT_R4;
+ ["stelem";"r8"], I_stelem DT_R8;
+ ["stelem";"i"], I_stelem DT_I;
+ ["stelem";"u"], I_stelem DT_I;
+ ["stelem";"u8"], I_stelem DT_I8;
+ ["stelem";"ref"], I_stelem DT_REF;
+ ["ldelem";"i1"], I_ldelem DT_I1;
+ ["ldelem";"i2"], I_ldelem DT_I2;
+ ["ldelem";"i4"], I_ldelem DT_I4;
+ ["ldelem";"i8"], I_ldelem DT_I8;
+ ["ldelem";"u8"], I_ldelem DT_I8;
+ ["ldelem";"u1"], I_ldelem DT_U1;
+ ["ldelem";"u2"], I_ldelem DT_U2;
+ ["ldelem";"u4"], I_ldelem DT_U4;
+ ["ldelem";"r4"], I_ldelem DT_R4;
+ ["ldelem";"r8"], I_ldelem DT_R8;
+ ["ldelem";"u"], I_ldelem DT_I; // EQUIV
+ ["ldelem";"i"], I_ldelem DT_I;
+ ["ldelem";"ref"], I_ldelem DT_REF;
+ ["mul"], AI_mul ;
+ ["mul";"ovf"], AI_mul_ovf;
+ ["mul";"ovf";"un"], AI_mul_ovf_un;
+ ["rem"], AI_rem ;
+ ["rem";"un"], AI_rem_un ;
+ ["shl"], AI_shl ;
+ ["shr"], AI_shr ;
+ ["shr";"un"], AI_shr_un;
+ ["sub"], AI_sub ;
+ ["sub";"ovf"], AI_sub_ovf;
+ ["sub";"ovf";"un"], AI_sub_ovf_un;
+ ["xor"], AI_xor;
+ ["or"], AI_or;
+ ["neg"], AI_neg;
+ ["not"], AI_not;
+ ["ldnull"], AI_ldnull;
+ ["dup"], AI_dup;
+ ["pop"], AI_pop;
+ ["ckfinite"], AI_ckfinite;
+ ["nop"], AI_nop;
+ ["break"], I_break;
+ ["arglist"], I_arglist;
+ ["endfilter"], I_endfilter;
+ ["endfinally"], I_endfinally;
+ ["refanytype"], I_refanytype;
+ ["localloc"], I_localloc;
+ ["throw"], I_throw;
+ ["ldlen"], I_ldlen;
+ ["rethrow"], I_rethrow;
+ ];;
+
+
+#if DEBUG
+let wordsOfNoArgInstr, isNoArgInstr =
+ let t =
+ lazy
+ (let t = HashMultiMap(300, HashIdentity.Structural)
+ noArgInstrs |> Lazy.force |> List.iter (fun (x,mk) -> t.Add(mk,x)) ;
+ t)
+ (fun s -> (Lazy.force t).[s]),
+ (fun s -> (Lazy.force t).ContainsKey s)
+#endif
+
+// --------------------------------------------------------------------
+// Instructions are preceded by prefixes, e.g. ".tail" etc.
+// --------------------------------------------------------------------
+
+let mk_stind (nm,dt) = (nm, (fun () -> I_stind(Aligned,Nonvolatile,dt)))
+let mk_ldind (nm,dt) = (nm, (fun () -> I_ldind(Aligned,Nonvolatile,dt)))
+
+// --------------------------------------------------------------------
+// Parsing only... Tables of different types of instructions.
+// First the different kinds of instructions.
+// --------------------------------------------------------------------
+
+type NoArgInstr = (unit -> ILInstr)
+type Int32Instr = (int32 -> ILInstr)
+type Int32Int32Instr = (int32 * int32 -> ILInstr)
+type Int64Instr = (int64 -> ILInstr)
+type DoubleInstr = (ILConst -> ILInstr)
+type MethodSpecInstr = (ILMethodSpec * ILVarArgs -> ILInstr)
+type TypeInstr = (ILType -> ILInstr)
+type IntTypeInstr = (int * ILType -> ILInstr)
+type ValueTypeInstr = (ILType -> ILInstr) (* nb. diff. interp of types to TypeInstr *)
+type StringInstr = (string -> ILInstr)
+type TokenInstr = (ILToken -> ILInstr)
+type SwitchInstr = (ILCodeLabel list * ILCodeLabel -> ILInstr)
+
+// --------------------------------------------------------------------
+// Now the generic code to make a table of instructions
+// --------------------------------------------------------------------
+
+type InstrTable<'T> = (string list * 'T) list
+type LazyInstrTable<'T> = Lazy>
+
+// --------------------------------------------------------------------
+// Now the tables of instructions
+// --------------------------------------------------------------------
+
+let NoArgInstrs =
+ lazy (((noArgInstrs |> Lazy.force |> List.map (fun (nm,i) -> (nm,(fun () -> i)))) @
+ [ (mk_stind (["stind";"u"], DT_I));
+ (mk_stind (["stind";"i"], DT_I));
+ (mk_stind (["stind";"u1"], DT_I1));(* ILX EQUIVALENT *)
+ (mk_stind (["stind";"i1"], DT_I1));
+ (mk_stind (["stind";"u2"], DT_I2));
+ (mk_stind (["stind";"i2"], DT_I2));
+ (mk_stind (["stind";"u4"], DT_I4)); (* ILX EQUIVALENT *)
+ (mk_stind (["stind";"i4"], DT_I4));
+ (mk_stind (["stind";"u8"], DT_I8)); (* ILX EQUIVALENT *)
+ (mk_stind (["stind";"i8"], DT_I8));
+ (mk_stind (["stind";"r4"], DT_R4));
+ (mk_stind (["stind";"r8"], DT_R8));
+ (mk_stind (["stind";"ref"], DT_REF));
+ (mk_ldind (["ldind";"i"], DT_I));
+ (mk_ldind (["ldind";"i1"], DT_I1));
+ (mk_ldind (["ldind";"i2"], DT_I2));
+ (mk_ldind (["ldind";"i4"], DT_I4));
+ (mk_ldind (["ldind";"i8"], DT_I8));
+ (mk_ldind (["ldind";"u1"], DT_U1));
+ (mk_ldind (["ldind";"u2"], DT_U2));
+ (mk_ldind (["ldind";"u4"], DT_U4));
+ (mk_ldind (["ldind";"u8"], DT_I8));
+ (mk_ldind (["ldind";"r4"], DT_R4));
+ (mk_ldind (["ldind";"r8"], DT_R8));
+ (mk_ldind (["ldind";"ref"], DT_REF));
+ (["cpblk"], (fun () -> I_cpblk(Aligned,Nonvolatile)));
+ (["initblk"], (fun () -> I_initblk(Aligned,Nonvolatile)));
+ ]
+ ) : NoArgInstr InstrTable);;
+
+let Int64Instrs =
+ lazy ([ (["ldc";"i8"], (fun x ->(AI_ldc (DT_I8, ILConst.I8 x)))); ] : Int64Instr InstrTable)
+
+let Int32Instrs =
+ lazy ([ (["ldc";"i4"], (fun x -> ((mkLdcInt32 x))));
+ (["ldc";"i4";"s"], (fun x -> ((mkLdcInt32 x)))); ] : Int32Instr InstrTable)
+
+let Int32Int32Instrs =
+ lazy ([ (["ldlen";"multi"], (fun (x,y) -> EI_ldlen_multi (x, y))); ] : Int32Int32Instr InstrTable)
+
+let DoubleInstrs =
+ lazy ([ (["ldc";"r4"], (fun x -> (AI_ldc (DT_R4, x))));
+ (["ldc";"r8"], (fun x -> (AI_ldc (DT_R8, x)))); ] : DoubleInstr InstrTable)
+
+let MethodSpecInstrs =
+ lazy ([ ( (["call"], (fun (mspec,y) -> I_call (Normalcall,mspec,y)))) ] : InstrTable)
+
+let StringInstrs =
+ lazy ([ (["ldstr"], (fun x -> I_ldstr x)); ] : InstrTable)
+
+let TokenInstrs =
+ lazy ([ (["ldtoken"], (fun x -> I_ldtoken x)); ] : InstrTable)
+
+
+let TypeInstrs =
+ lazy ([ (["ldelema"], (fun x -> I_ldelema (NormalAddress,false,ILArrayShape.SingleDimensional,x)));
+ (["ldelem";"any"], (fun x -> I_ldelem_any (ILArrayShape.SingleDimensional,x)));
+ (["stelem";"any"], (fun x -> I_stelem_any (ILArrayShape.SingleDimensional, x)));
+ (["newarr"], (fun x -> I_newarr (ILArrayShape.SingleDimensional,x)));
+ (["castclass"], (fun x -> I_castclass x));
+ (["ilzero"], (fun x -> EI_ilzero x));
+ (["isinst"], (fun x -> I_isinst x));
+ (["initobj";"any"], (fun x -> I_initobj x));
+ (["unbox";"any"], (fun x -> I_unbox_any x)); ] : InstrTable)
+
+let IntTypeInstrs =
+ lazy ([ (["ldelem";"multi"], (fun (x,y) -> (I_ldelem_any (ILArrayShape.FromRank x,y))));
+ (["stelem";"multi"], (fun (x,y) -> (I_stelem_any (ILArrayShape.FromRank x,y))));
+ (["newarr";"multi"], (fun (x,y) -> (I_newarr (ILArrayShape.FromRank x,y))));
+ (["ldelema";"multi"], (fun (x,y) -> (I_ldelema (NormalAddress,false,ILArrayShape.FromRank x,y)))); ] : InstrTable)
+
+let ValueTypeInstrs =
+ lazy ([ (["cpobj"], (fun x -> I_cpobj x));
+ (["initobj"], (fun x -> I_initobj x));
+ (["ldobj"], (fun z -> I_ldobj (Aligned,Nonvolatile,z)));
+ (["stobj"], (fun z -> I_stobj (Aligned,Nonvolatile,z)));
+ (["sizeof"], (fun x -> I_sizeof x));
+ (["box"], (fun x -> I_box x));
+ (["unbox"], (fun x -> I_unbox x)); ] : InstrTable)
+
diff --git a/src/absil/ilascii.fsi b/src/absil/ilascii.fsi
new file mode 100644
index 0000000..62cbaa0
--- /dev/null
+++ b/src/absil/ilascii.fsi
@@ -0,0 +1,67 @@
+//----------------------------------------------------------------------------
+//
+// Copyright (c) 2002-2012 Microsoft Corporation.
+//
+// This source code is subject to terms and conditions of the Apache License, Version 2.0. A
+// copy of the license can be found in the License.html file at the root of this distribution.
+// By using this source code in any fashion, you are agreeing to be bound
+// by the terms of the Apache License, Version 2.0.
+//
+// You must not remove this notice, or any other, from this software.
+//----------------------------------------------------------------------------
+
+/// Various constants and utilities used when parsing the ILASM format for IL
+module Microsoft.FSharp.Compiler.AbstractIL.Internal.AsciiConstants
+
+open Internal.Utilities
+
+open Microsoft.FSharp.Compiler.AbstractIL
+open Microsoft.FSharp.Compiler.AbstractIL.Internal
+open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.Types
+open Microsoft.FSharp.Compiler.AbstractIL.IL
+
+// --------------------------------------------------------------------
+// IL Parser state - must be initialized before parsing a module
+// --------------------------------------------------------------------
+
+val parseILGlobals: ILGlobals ref
+
+// --------------------------------------------------------------------
+// IL Lexer and pretty-printer tables
+// --------------------------------------------------------------------
+
+type NoArgInstr = unit -> ILInstr
+type Int32Instr = int32 -> ILInstr
+type Int32Int32Instr = int32 * int32 -> ILInstr
+type Int64Instr = int64 -> ILInstr
+type DoubleInstr = ILConst -> ILInstr
+type MethodSpecInstr = ILMethodSpec * ILVarArgs -> ILInstr
+type TypeInstr = ILType -> ILInstr
+type IntTypeInstr = int * ILType -> ILInstr
+type ValueTypeInstr = ILType -> ILInstr
+type StringInstr = string -> ILInstr
+type TokenInstr = ILToken -> ILInstr
+type SwitchInstr = ILCodeLabel list * ILCodeLabel -> ILInstr
+
+type InstrTable<'T> = (string list * 'T) list
+type LazyInstrTable<'T> = Lazy>
+
+val NoArgInstrs: LazyInstrTable
+val Int64Instrs: LazyInstrTable
+val Int32Instrs: LazyInstrTable
+val Int32Int32Instrs: LazyInstrTable
+val DoubleInstrs: LazyInstrTable
+val MethodSpecInstrs: LazyInstrTable
+val StringInstrs: LazyInstrTable
+val TokenInstrs: LazyInstrTable
+val TypeInstrs: LazyInstrTable
+val IntTypeInstrs: LazyInstrTable
+val ValueTypeInstrs: LazyInstrTable
+
+#if DEBUG
+val wordsOfNoArgInstr : (ILInstr -> string list)
+val isNoArgInstr : (ILInstr -> bool)
+#endif
+
+
+
diff --git a/src/absil/ilbinary.fs b/src/absil/ilbinary.fs
new file mode 100644
index 0000000..7dca46d
--- /dev/null
+++ b/src/absil/ilbinary.fs
@@ -0,0 +1,1031 @@
+//----------------------------------------------------------------------------
+//
+// Copyright (c) 2002-2012 Microsoft Corporation.
+//
+// This source code is subject to terms and conditions of the Apache License, Version 2.0. A
+// copy of the license can be found in the License.html file at the root of this distribution.
+// By using this source code in any fashion, you are agreeing to be bound
+// by the terms of the Apache License, Version 2.0.
+//
+// You must not remove this notice, or any other, from this software.
+//----------------------------------------------------------------------------
+
+
+module internal Microsoft.FSharp.Compiler.AbstractIL.Internal.BinaryConstants
+
+open Internal.Utilities
+open Microsoft.FSharp.Compiler.AbstractIL
+open Microsoft.FSharp.Compiler.AbstractIL.IL
+open Microsoft.FSharp.Compiler.AbstractIL.Internal
+open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library
+
+[]
+type TableName(idx: int) =
+ member x.Index = idx
+ static member FromIndex n = TableName n
+
+module TableNames =
+ let Module = TableName 0
+ let TypeRef = TableName 1
+ let TypeDef = TableName 2
+ let FieldPtr = TableName 3
+ let Field = TableName 4
+ let MethodPtr = TableName 5
+ let Method = TableName 6
+ let ParamPtr = TableName 7
+ let Param = TableName 8
+ let InterfaceImpl = TableName 9
+ let MemberRef = TableName 10
+ let Constant = TableName 11
+ let CustomAttribute = TableName 12
+ let FieldMarshal = TableName 13
+ let Permission = TableName 14
+ let ClassLayout = TableName 15
+ let FieldLayout = TableName 16
+ let StandAloneSig = TableName 17
+ let EventMap = TableName 18
+ let EventPtr = TableName 19
+ let Event = TableName 20
+ let PropertyMap = TableName 21
+ let PropertyPtr = TableName 22
+ let Property = TableName 23
+ let MethodSemantics = TableName 24
+ let MethodImpl = TableName 25
+ let ModuleRef = TableName 26
+ let TypeSpec = TableName 27
+ let ImplMap = TableName 28
+ let FieldRVA = TableName 29
+ let ENCLog = TableName 30
+ let ENCMap = TableName 31
+ let Assembly = TableName 32
+ let AssemblyProcessor = TableName 33
+ let AssemblyOS = TableName 34
+ let AssemblyRef = TableName 35
+ let AssemblyRefProcessor = TableName 36
+ let AssemblyRefOS = TableName 37
+ let File = TableName 38
+ let ExportedType = TableName 39
+ let ManifestResource = TableName 40
+ let Nested = TableName 41
+ let GenericParam = TableName 42
+ let MethodSpec = TableName 43
+ let GenericParamConstraint = TableName 44
+
+ let UserStrings = TableName 0x70 (* Special encoding of embedded UserString tokens - See 1.9 Partition III *)
+
+/// Which tables are sorted and by which column
+//
+// Sorted bit-vector as stored by CLR V1: 00fa 0133 0002 0000
+// But what does this mean? The ECMA spec does not say!
+// Metainfo -schema reports sorting as shown below.
+// But some sorting, e.g. EventMap does not seem to show
+let sortedTableInfo =
+ [ (TableNames.InterfaceImpl,0);
+ (TableNames.Constant, 1);
+ (TableNames.CustomAttribute, 0);
+ (TableNames.FieldMarshal, 0);
+ (TableNames.Permission, 1);
+ (TableNames.ClassLayout, 2);
+ (TableNames.FieldLayout, 1);
+ (TableNames.MethodSemantics, 2);
+ (TableNames.MethodImpl, 0);
+ (TableNames.ImplMap, 1);
+ (TableNames.FieldRVA, 1);
+ (TableNames.Nested, 0);
+ (TableNames.GenericParam, 2);
+ (TableNames.GenericParamConstraint, 0); ]
+
+[]
+type TypeDefOrRefTag(tag: int32) = member x.Tag = tag
+let tdor_TypeDef = TypeDefOrRefTag 0x00
+let tdor_TypeRef = TypeDefOrRefTag 0x01
+let tdor_TypeSpec = TypeDefOrRefTag 0x2
+let mkTypeDefOrRefOrSpecTag x =
+ match x with
+ | 0x00 -> tdor_TypeDef // nb. avoid reallocation
+ | 0x01 -> tdor_TypeRef
+ | 0x02 -> tdor_TypeSpec
+ | _ -> invalidArg "x" "mkTypeDefOrRefOrSpecTag"
+
+[]
+type HasConstantTag(tag: int32) = member x.Tag = tag
+let hc_FieldDef = HasConstantTag 0x0
+let hc_ParamDef = HasConstantTag 0x1
+let hc_Property = HasConstantTag 0x2
+
+let mkHasConstantTag x =
+ match x with
+ | 0x00 -> hc_FieldDef
+ | 0x01 -> hc_ParamDef
+ | 0x02 -> hc_Property
+ | _ -> invalidArg "x" "mkHasConstantTag"
+
+[]
+type HasCustomAttributeTag(tag: int32) = member x.Tag = tag
+let hca_MethodDef = HasCustomAttributeTag 0x0
+let hca_FieldDef = HasCustomAttributeTag 0x1
+let hca_TypeRef = HasCustomAttributeTag 0x2
+let hca_TypeDef = HasCustomAttributeTag 0x3
+let hca_ParamDef = HasCustomAttributeTag 0x4
+let hca_InterfaceImpl = HasCustomAttributeTag 0x5
+let hca_MemberRef = HasCustomAttributeTag 0x6
+let hca_Module = HasCustomAttributeTag 0x7
+let hca_Permission = HasCustomAttributeTag 0x8
+let hca_Property = HasCustomAttributeTag 0x9
+let hca_Event = HasCustomAttributeTag 0xa
+let hca_StandAloneSig = HasCustomAttributeTag 0xb
+let hca_ModuleRef = HasCustomAttributeTag 0xc
+let hca_TypeSpec = HasCustomAttributeTag 0xd
+let hca_Assembly = HasCustomAttributeTag 0xe
+let hca_AssemblyRef = HasCustomAttributeTag 0xf
+let hca_File = HasCustomAttributeTag 0x10
+let hca_ExportedType = HasCustomAttributeTag 0x11
+let hca_ManifestResource = HasCustomAttributeTag 0x12
+let hca_GenericParam = HasCustomAttributeTag 0x13
+let hca_GenericParamConstraint = HasCustomAttributeTag 0x14
+let hca_MethodSpec = HasCustomAttributeTag 0x15
+
+let mkHasCustomAttributeTag x =
+ match x with
+ | 0x00 -> hca_MethodDef
+ | 0x01 -> hca_FieldDef
+ | 0x02 -> hca_TypeRef
+ | 0x03 -> hca_TypeDef
+ | 0x04 -> hca_ParamDef
+ | 0x05 -> hca_InterfaceImpl
+ | 0x06 -> hca_MemberRef
+ | 0x07 -> hca_Module
+ | 0x08 -> hca_Permission
+ | 0x09 -> hca_Property
+ | 0x0a -> hca_Event
+ | 0x0b -> hca_StandAloneSig
+ | 0x0c -> hca_ModuleRef
+ | 0x0d -> hca_TypeSpec
+ | 0x0e -> hca_Assembly
+ | 0x0f -> hca_AssemblyRef
+ | 0x10 -> hca_File
+ | 0x11 -> hca_ExportedType
+ | 0x12 -> hca_ManifestResource
+ | 0x13 -> hca_GenericParam
+ | 0x14 -> hca_GenericParamConstraint
+ | 0x15 -> hca_MethodSpec
+ | _ -> HasCustomAttributeTag x
+
+[]
+type HasFieldMarshalTag(tag: int32) = member x.Tag = tag
+let hfm_FieldDef = HasFieldMarshalTag 0x00
+let hfm_ParamDef = HasFieldMarshalTag 0x01
+
+let mkHasFieldMarshalTag x =
+ match x with
+ | 0x00 -> hfm_FieldDef
+ | 0x01 -> hfm_ParamDef
+ | _ -> HasFieldMarshalTag x
+
+[]
+type HasDeclSecurityTag(tag: int32) = member x.Tag = tag
+let hds_TypeDef = HasDeclSecurityTag 0x00
+let hds_MethodDef = HasDeclSecurityTag 0x01
+let hds_Assembly = HasDeclSecurityTag 0x02
+
+let mkHasDeclSecurityTag x =
+ match x with
+ | 0x00 -> hds_TypeDef
+ | 0x01 -> hds_MethodDef
+ | 0x02 -> hds_Assembly
+ | _ -> HasDeclSecurityTag x
+
+[]
+type MemberRefParentTag(tag: int32) = member x.Tag = tag
+let mrp_TypeRef = MemberRefParentTag 0x01
+let mrp_ModuleRef = MemberRefParentTag 0x02
+let mrp_MethodDef = MemberRefParentTag 0x03
+let mrp_TypeSpec = MemberRefParentTag 0x04
+
+let mkMemberRefParentTag x =
+ match x with
+ | 0x01 -> mrp_TypeRef
+ | 0x02 -> mrp_ModuleRef
+ | 0x03 -> mrp_MethodDef
+ | 0x04 -> mrp_TypeSpec
+ | _ -> MemberRefParentTag x
+
+[]
+type HasSemanticsTag(tag: int32) = member x.Tag = tag
+let hs_Event = HasSemanticsTag 0x00
+let hs_Property = HasSemanticsTag 0x01
+
+let mkHasSemanticsTag x =
+ match x with
+ | 0x00 -> hs_Event
+ | 0x01 -> hs_Property
+ | _ -> HasSemanticsTag x
+
+[]
+type MethodDefOrRefTag(tag: int32) = member x.Tag = tag
+let mdor_MethodDef = MethodDefOrRefTag 0x00
+let mdor_MemberRef = MethodDefOrRefTag 0x01
+let mdor_MethodSpec = MethodDefOrRefTag 0x02
+
+let mkMethodDefOrRefTag x =
+ match x with
+ | 0x00 -> mdor_MethodDef
+ | 0x01 -> mdor_MemberRef
+ | 0x02 -> mdor_MethodSpec
+ | _ -> MethodDefOrRefTag x
+
+[]
+type MemberForwardedTag(tag: int32) = member x.Tag = tag
+let mf_FieldDef = MemberForwardedTag 0x00
+let mf_MethodDef = MemberForwardedTag 0x01
+
+let mkMemberForwardedTag x =
+ match x with
+ | 0x00 -> mf_FieldDef
+ | 0x01 -> mf_MethodDef
+ | _ -> MemberForwardedTag x
+
+[]
+type ImplementationTag(tag: int32) = member x.Tag = tag
+let i_File = ImplementationTag 0x00
+let i_AssemblyRef = ImplementationTag 0x01
+let i_ExportedType = ImplementationTag 0x02
+
+let mkImplementationTag x =
+ match x with
+ | 0x00 -> i_File
+ | 0x01 -> i_AssemblyRef
+ | 0x02 -> i_ExportedType
+ | _ -> ImplementationTag x
+
+[]
+type CustomAttributeTypeTag(tag: int32) = member x.Tag = tag
+let cat_MethodDef = CustomAttributeTypeTag 0x02
+let cat_MemberRef = CustomAttributeTypeTag 0x03
+
+let mkILCustomAttributeTypeTag x =
+ match x with
+ | 0x02 -> cat_MethodDef
+ | 0x03 -> cat_MemberRef
+ | _ -> CustomAttributeTypeTag x
+
+[]
+type ResolutionScopeTag(tag: int32) = member x.Tag = tag
+let rs_Module = ResolutionScopeTag 0x00
+let rs_ModuleRef = ResolutionScopeTag 0x01
+let rs_AssemblyRef = ResolutionScopeTag 0x02
+let rs_TypeRef = ResolutionScopeTag 0x03
+
+let mkResolutionScopeTag x =
+ match x with
+ | 0x00 -> rs_Module
+ | 0x01 -> rs_ModuleRef
+ | 0x02 -> rs_AssemblyRef
+ | 0x03 -> rs_TypeRef
+ | _ -> ResolutionScopeTag x
+
+[]
+type TypeOrMethodDefTag(tag: int32) = member x.Tag = tag
+let tomd_TypeDef = TypeOrMethodDefTag 0x00
+let tomd_MethodDef = TypeOrMethodDefTag 0x01
+
+let mkTypeOrMethodDefTag x =
+ match x with
+ | 0x00 -> tomd_TypeDef
+ | 0x01 -> tomd_MethodDef
+ | _ -> TypeOrMethodDefTag x
+
+let et_END = 0x00uy
+let et_VOID = 0x01uy
+let et_BOOLEAN = 0x02uy
+let et_CHAR = 0x03uy
+let et_I1 = 0x04uy
+let et_U1 = 0x05uy
+let et_I2 = 0x06uy
+let et_U2 = 0x07uy
+let et_I4 = 0x08uy
+let et_U4 = 0x09uy
+let et_I8 = 0x0Auy
+let et_U8 = 0x0Buy
+let et_R4 = 0x0Cuy
+let et_R8 = 0x0Duy
+let et_STRING = 0x0Euy
+let et_PTR = 0x0Fuy
+let et_BYREF = 0x10uy
+let et_VALUETYPE = 0x11uy
+let et_CLASS = 0x12uy
+let et_VAR = 0x13uy
+let et_ARRAY = 0x14uy
+let et_WITH = 0x15uy
+let et_TYPEDBYREF = 0x16uy
+let et_I = 0x18uy
+let et_U = 0x19uy
+let et_FNPTR = 0x1Buy
+let et_OBJECT = 0x1Cuy
+let et_SZARRAY = 0x1Duy
+let et_MVAR = 0x1euy
+let et_CMOD_REQD = 0x1Fuy
+let et_CMOD_OPT = 0x20uy
+
+let et_SENTINEL = 0x41uy // sentinel for varargs
+let et_PINNED = 0x45uy
+
+
+let i_nop = 0x00
+let i_break = 0x01
+let i_ldarg_0 = 0x02
+let i_ldarg_1 = 0x03
+let i_ldarg_2 = 0x04
+let i_ldarg_3 = 0x05
+let i_ldloc_0 = 0x06
+let i_ldloc_1 = 0x07
+let i_ldloc_2 = 0x08
+let i_ldloc_3 = 0x09
+let i_stloc_0 = 0x0a
+let i_stloc_1 = 0x0b
+let i_stloc_2 = 0x0c
+let i_stloc_3 = 0x0d
+let i_ldarg_s = 0x0e
+let i_ldarga_s = 0x0f
+let i_starg_s = 0x10
+let i_ldloc_s = 0x11
+let i_ldloca_s = 0x12
+let i_stloc_s = 0x13
+let i_ldnull = 0x14
+let i_ldc_i4_m1 = 0x15
+let i_ldc_i4_0 = 0x16
+let i_ldc_i4_1 = 0x17
+let i_ldc_i4_2 = 0x18
+let i_ldc_i4_3 = 0x19
+let i_ldc_i4_4 = 0x1a
+let i_ldc_i4_5 = 0x1b
+let i_ldc_i4_6 = 0x1c
+let i_ldc_i4_7 = 0x1d
+let i_ldc_i4_8 = 0x1e
+let i_ldc_i4_s = 0x1f
+let i_ldc_i4 = 0x20
+let i_ldc_i8 = 0x21
+let i_ldc_r4 = 0x22
+let i_ldc_r8 = 0x23
+let i_dup = 0x25
+let i_pop = 0x26
+let i_jmp = 0x27
+let i_call = 0x28
+let i_calli = 0x29
+let i_ret = 0x2a
+let i_br_s = 0x2b
+let i_brfalse_s = 0x2c
+let i_brtrue_s = 0x2d
+let i_beq_s = 0x2e
+let i_bge_s = 0x2f
+let i_bgt_s = 0x30
+let i_ble_s = 0x31
+let i_blt_s = 0x32
+let i_bne_un_s = 0x33
+let i_bge_un_s = 0x34
+let i_bgt_un_s = 0x35
+let i_ble_un_s = 0x36
+let i_blt_un_s = 0x37
+let i_br = 0x38
+let i_brfalse = 0x39
+let i_brtrue = 0x3a
+let i_beq = 0x3b
+let i_bge = 0x3c
+let i_bgt = 0x3d
+let i_ble = 0x3e
+let i_blt = 0x3f
+let i_bne_un = 0x40
+let i_bge_un = 0x41
+let i_bgt_un = 0x42
+let i_ble_un = 0x43
+let i_blt_un = 0x44
+let i_switch = 0x45
+let i_ldind_i1 = 0x46
+let i_ldind_u1 = 0x47
+let i_ldind_i2 = 0x48
+let i_ldind_u2 = 0x49
+let i_ldind_i4 = 0x4a
+let i_ldind_u4 = 0x4b
+let i_ldind_i8 = 0x4c
+let i_ldind_i = 0x4d
+let i_ldind_r4 = 0x4e
+let i_ldind_r8 = 0x4f
+let i_ldind_ref = 0x50
+let i_stind_ref = 0x51
+let i_stind_i1 = 0x52
+let i_stind_i2 = 0x53
+let i_stind_i4 = 0x54
+let i_stind_i8 = 0x55
+let i_stind_r4 = 0x56
+let i_stind_r8 = 0x57
+let i_add = 0x58
+let i_sub = 0x59
+let i_mul = 0x5a
+let i_div = 0x5b
+let i_div_un = 0x5c
+let i_rem = 0x5d
+let i_rem_un = 0x5e
+let i_and = 0x5f
+let i_or = 0x60
+let i_xor = 0x61
+let i_shl = 0x62
+let i_shr = 0x63
+let i_shr_un = 0x64
+let i_neg = 0x65
+let i_not = 0x66
+let i_conv_i1 = 0x67
+let i_conv_i2 = 0x68
+let i_conv_i4 = 0x69
+let i_conv_i8 = 0x6a
+let i_conv_r4 = 0x6b
+let i_conv_r8 = 0x6c
+let i_conv_u4 = 0x6d
+let i_conv_u8 = 0x6e
+let i_callvirt = 0x6f
+let i_cpobj = 0x70
+let i_ldobj = 0x71
+let i_ldstr = 0x72
+let i_newobj = 0x73
+let i_castclass = 0x74
+let i_isinst = 0x75
+let i_conv_r_un = 0x76
+let i_unbox = 0x79
+let i_throw = 0x7a
+let i_ldfld = 0x7b
+let i_ldflda = 0x7c
+let i_stfld = 0x7d
+let i_ldsfld = 0x7e
+let i_ldsflda = 0x7f
+let i_stsfld = 0x80
+let i_stobj = 0x81
+let i_conv_ovf_i1_un= 0x82
+let i_conv_ovf_i2_un= 0x83
+let i_conv_ovf_i4_un= 0x84
+let i_conv_ovf_i8_un= 0x85
+let i_conv_ovf_u1_un= 0x86
+let i_conv_ovf_u2_un= 0x87
+let i_conv_ovf_u4_un= 0x88
+let i_conv_ovf_u8_un= 0x89
+let i_conv_ovf_i_un = 0x8a
+let i_conv_ovf_u_un = 0x8b
+let i_box = 0x8c
+let i_newarr = 0x8d
+let i_ldlen = 0x8e
+let i_ldelema = 0x8f
+let i_ldelem_i1 = 0x90
+let i_ldelem_u1 = 0x91
+let i_ldelem_i2 = 0x92
+let i_ldelem_u2 = 0x93
+let i_ldelem_i4 = 0x94
+let i_ldelem_u4 = 0x95
+let i_ldelem_i8 = 0x96
+let i_ldelem_i = 0x97
+let i_ldelem_r4 = 0x98
+let i_ldelem_r8 = 0x99
+let i_ldelem_ref = 0x9a
+let i_stelem_i = 0x9b
+let i_stelem_i1 = 0x9c
+let i_stelem_i2 = 0x9d
+let i_stelem_i4 = 0x9e
+let i_stelem_i8 = 0x9f
+let i_stelem_r4 = 0xa0
+let i_stelem_r8 = 0xa1
+let i_stelem_ref = 0xa2
+let i_conv_ovf_i1 = 0xb3
+let i_conv_ovf_u1 = 0xb4
+let i_conv_ovf_i2 = 0xb5
+let i_conv_ovf_u2 = 0xb6
+let i_conv_ovf_i4 = 0xb7
+let i_conv_ovf_u4 = 0xb8
+let i_conv_ovf_i8 = 0xb9
+let i_conv_ovf_u8 = 0xba
+let i_refanyval = 0xc2
+let i_ckfinite = 0xc3
+let i_mkrefany = 0xc6
+let i_ldtoken = 0xd0
+let i_conv_u2 = 0xd1
+let i_conv_u1 = 0xd2
+let i_conv_i = 0xd3
+let i_conv_ovf_i = 0xd4
+let i_conv_ovf_u = 0xd5
+let i_add_ovf = 0xd6
+let i_add_ovf_un = 0xd7
+let i_mul_ovf = 0xd8
+let i_mul_ovf_un = 0xd9
+let i_sub_ovf = 0xda
+let i_sub_ovf_un = 0xdb
+let i_endfinally = 0xdc
+let i_leave = 0xdd
+let i_leave_s = 0xde
+let i_stind_i = 0xdf
+let i_conv_u = 0xe0
+let i_arglist = 0xfe00
+let i_ceq = 0xfe01
+let i_cgt = 0xfe02
+let i_cgt_un = 0xfe03
+let i_clt = 0xfe04
+let i_clt_un = 0xfe05
+let i_ldftn = 0xfe06
+let i_ldvirtftn = 0xfe07
+let i_ldarg = 0xfe09
+let i_ldarga = 0xfe0a
+let i_starg = 0xfe0b
+let i_ldloc = 0xfe0c
+let i_ldloca = 0xfe0d
+let i_stloc = 0xfe0e
+let i_localloc = 0xfe0f
+let i_endfilter = 0xfe11
+let i_unaligned = 0xfe12
+let i_volatile = 0xfe13
+let i_constrained = 0xfe16
+let i_readonly = 0xfe1e
+let i_tail = 0xfe14
+let i_initobj = 0xfe15
+let i_cpblk = 0xfe17
+let i_initblk = 0xfe18
+let i_rethrow = 0xfe1a
+let i_sizeof = 0xfe1c
+let i_refanytype = 0xfe1d
+
+let i_ldelem_any = 0xa3
+let i_stelem_any = 0xa4
+let i_unbox_any = 0xa5
+
+let mk_ldc i = (((mkLdcInt32 (i))))
+let noArgInstrs =
+ lazy [ i_ldc_i4_0, mk_ldc 0;
+ i_ldc_i4_1, mk_ldc 1;
+ i_ldc_i4_2, mk_ldc 2;
+ i_ldc_i4_3, mk_ldc 3;
+ i_ldc_i4_4, mk_ldc 4;
+ i_ldc_i4_5, mk_ldc 5;
+ i_ldc_i4_6, mk_ldc 6;
+ i_ldc_i4_7, mk_ldc 7;
+ i_ldc_i4_8, mk_ldc 8;
+ i_ldc_i4_m1, mk_ldc (0-1);
+ 0x0a, (mkStloc (uint16 ( 0)));
+ 0x0b, (mkStloc (uint16 ( 1)));
+ 0x0c, (mkStloc (uint16 ( 2)));
+ 0x0d, (mkStloc (uint16 ( 3)));
+ 0x06, (mkLdloc (uint16 ( 0)));
+ 0x07, (mkLdloc (uint16 ( 1)));
+ 0x08, (mkLdloc (uint16 ( 2)));
+ 0x09, (mkLdloc (uint16 ( 3)));
+ 0x02, (mkLdarg (uint16 ( 0)));
+ 0x03, (mkLdarg (uint16 ( 1)));
+ 0x04, (mkLdarg (uint16 ( 2)));
+ 0x05, (mkLdarg (uint16 ( 3)));
+ 0x2a, (I_ret);
+ 0x58, (AI_add);
+ 0xd6, (AI_add_ovf);
+ 0xd7, (AI_add_ovf_un);
+ 0x5f, (AI_and);
+ 0x5b, (AI_div);
+ 0x5c, (AI_div_un);
+ 0xfe01, (AI_ceq);
+ 0xfe02, (AI_cgt );
+ 0xfe03, (AI_cgt_un);
+ 0xfe04, (AI_clt);
+ 0xfe05, (AI_clt_un);
+ 0x67, ((AI_conv DT_I1));
+ 0x68, ((AI_conv DT_I2));
+ 0x69, ((AI_conv DT_I4));
+ 0x6a, ((AI_conv DT_I8));
+ 0xd3, ((AI_conv DT_I));
+ 0x6b, ((AI_conv DT_R4));
+ 0x6c, ((AI_conv DT_R8));
+ 0xd2, ((AI_conv DT_U1));
+ 0xd1, ((AI_conv DT_U2));
+ 0x6d, ((AI_conv DT_U4));
+ 0x6e, ((AI_conv DT_U8));
+ 0xe0, ((AI_conv DT_U));
+ 0x76, ((AI_conv DT_R));
+ 0xb3, ((AI_conv_ovf DT_I1));
+ 0xb5, ((AI_conv_ovf DT_I2));
+ 0xb7, ((AI_conv_ovf DT_I4));
+ 0xb9, ((AI_conv_ovf DT_I8));
+ 0xd4, ((AI_conv_ovf DT_I));
+ 0xb4, ((AI_conv_ovf DT_U1));
+ 0xb6, ((AI_conv_ovf DT_U2));
+ 0xb8, ((AI_conv_ovf DT_U4));
+ 0xba, ((AI_conv_ovf DT_U8));
+ 0xd5, ((AI_conv_ovf DT_U));
+ 0x82, ((AI_conv_ovf_un DT_I1));
+ 0x83, ((AI_conv_ovf_un DT_I2));
+ 0x84, ((AI_conv_ovf_un DT_I4));
+ 0x85, ((AI_conv_ovf_un DT_I8));
+ 0x8a, ((AI_conv_ovf_un DT_I));
+ 0x86, ((AI_conv_ovf_un DT_U1));
+ 0x87, ((AI_conv_ovf_un DT_U2));
+ 0x88, ((AI_conv_ovf_un DT_U4));
+ 0x89, ((AI_conv_ovf_un DT_U8));
+ 0x8b, ((AI_conv_ovf_un DT_U));
+ 0x9c, (I_stelem DT_I1);
+ 0x9d, (I_stelem DT_I2);
+ 0x9e, (I_stelem DT_I4);
+ 0x9f, (I_stelem DT_I8);
+ 0xa0, (I_stelem DT_R4);
+ 0xa1, (I_stelem DT_R8);
+ 0x9b, (I_stelem DT_I);
+ 0xa2, (I_stelem DT_REF);
+ 0x90, (I_ldelem DT_I1);
+ 0x92, (I_ldelem DT_I2);
+ 0x94, (I_ldelem DT_I4);
+ 0x96, (I_ldelem DT_I8);
+ 0x91, (I_ldelem DT_U1);
+ 0x93, (I_ldelem DT_U2);
+ 0x95, (I_ldelem DT_U4);
+ 0x98, (I_ldelem DT_R4);
+ 0x99, (I_ldelem DT_R8);
+ 0x97, (I_ldelem DT_I);
+ 0x9a, (I_ldelem DT_REF);
+ 0x5a, (AI_mul );
+ 0xd8, (AI_mul_ovf);
+ 0xd9, (AI_mul_ovf_un);
+ 0x5d, (AI_rem );
+ 0x5e, (AI_rem_un );
+ 0x62, (AI_shl );
+ 0x63, (AI_shr );
+ 0x64, (AI_shr_un);
+ 0x59, (AI_sub );
+ 0xda, (AI_sub_ovf);
+ 0xdb, (AI_sub_ovf_un);
+ 0x61, (AI_xor);
+ 0x60, (AI_or);
+ 0x65, (AI_neg);
+ 0x66, (AI_not);
+ i_ldnull, (AI_ldnull);
+ i_dup, (AI_dup);
+ i_pop, (AI_pop);
+ i_ckfinite, (AI_ckfinite);
+ i_nop, AI_nop;
+ i_break, I_break;
+ i_arglist, I_arglist;
+ i_endfilter, I_endfilter;
+ i_endfinally, I_endfinally;
+ i_refanytype, I_refanytype;
+ i_localloc, I_localloc;
+ i_throw, I_throw;
+ i_ldlen, I_ldlen;
+ i_rethrow, I_rethrow; ];;
+
+let isNoArgInstr i =
+ match i with
+ | (AI_ldc (DT_I4, ILConst.I4 n)) when (-1) <= n && n <= 8 -> true
+ | I_stloc n | I_ldloc n | I_ldarg n when n <= 3us -> true
+ | I_ret
+ | AI_add
+ | AI_add_ovf
+ | AI_add_ovf_un
+ | AI_and
+ | AI_div
+ | AI_div_un
+ | AI_ceq
+ | AI_cgt
+ | AI_cgt_un
+ | AI_clt
+ | AI_clt_un
+ | AI_conv DT_I1
+ | AI_conv DT_I2
+ | AI_conv DT_I4
+ | AI_conv DT_I8
+ | AI_conv DT_I
+ | AI_conv DT_R4
+ | AI_conv DT_R8
+ | AI_conv DT_U1
+ | AI_conv DT_U2
+ | AI_conv DT_U4
+ | AI_conv DT_U8
+ | AI_conv DT_U
+ | AI_conv DT_R
+ | AI_conv_ovf DT_I1
+ | AI_conv_ovf DT_I2
+ | AI_conv_ovf DT_I4
+ | AI_conv_ovf DT_I8
+ | AI_conv_ovf DT_I
+ | AI_conv_ovf DT_U1
+ | AI_conv_ovf DT_U2
+ | AI_conv_ovf DT_U4
+ | AI_conv_ovf DT_U8
+ | AI_conv_ovf DT_U
+ | AI_conv_ovf_un DT_I1
+ | AI_conv_ovf_un DT_I2
+ | AI_conv_ovf_un DT_I4
+ | AI_conv_ovf_un DT_I8
+ | AI_conv_ovf_un DT_I
+ | AI_conv_ovf_un DT_U1
+ | AI_conv_ovf_un DT_U2
+ | AI_conv_ovf_un DT_U4
+ | AI_conv_ovf_un DT_U8
+ | AI_conv_ovf_un DT_U
+ | I_stelem DT_I1
+ | I_stelem DT_I2
+ | I_stelem DT_I4
+ | I_stelem DT_I8
+ | I_stelem DT_R4
+ | I_stelem DT_R8
+ | I_stelem DT_I
+ | I_stelem DT_REF
+ | I_ldelem DT_I1
+ | I_ldelem DT_I2
+ | I_ldelem DT_I4
+ | I_ldelem DT_I8
+ | I_ldelem DT_U1
+ | I_ldelem DT_U2
+ | I_ldelem DT_U4
+ | I_ldelem DT_R4
+ | I_ldelem DT_R8
+ | I_ldelem DT_I
+ | I_ldelem DT_REF
+ | AI_mul
+ | AI_mul_ovf
+ | AI_mul_ovf_un
+ | AI_rem
+ | AI_rem_un
+ | AI_shl
+ | AI_shr
+ | AI_shr_un
+ | AI_sub
+ | AI_sub_ovf
+ | AI_sub_ovf_un
+ | AI_xor
+ | AI_or
+ | AI_neg
+ | AI_not
+ | AI_ldnull
+ | AI_dup
+ | AI_pop
+ | AI_ckfinite
+ | AI_nop
+ | I_break
+ | I_arglist
+ | I_endfilter
+ | I_endfinally
+ | I_refanytype
+ | I_localloc
+ | I_throw
+ | I_ldlen
+ | I_rethrow -> true
+ | _ -> false
+
+let ILCmpInstrMap =
+ lazy
+ (Dictionary.ofList
+ [ BI_beq , i_beq
+ BI_bgt , i_bgt
+ BI_bgt_un , i_bgt_un
+ BI_bge , i_bge
+ BI_bge_un , i_bge_un
+ BI_ble , i_ble
+ BI_ble_un , i_ble_un
+ BI_blt , i_blt
+ BI_blt_un , i_blt_un
+ BI_bne_un , i_bne_un
+ BI_brfalse , i_brfalse
+ BI_brtrue , i_brtrue ])
+
+let ILCmpInstrRevMap =
+ lazy
+ (Dictionary.ofList
+ [ BI_beq , i_beq_s
+ BI_bgt , i_bgt_s
+ BI_bgt_un , i_bgt_un_s
+ BI_bge , i_bge_s
+ BI_bge_un , i_bge_un_s
+ BI_ble , i_ble_s
+ BI_ble_un , i_ble_un_s
+ BI_blt , i_blt_s
+ BI_blt_un , i_blt_un_s
+ BI_bne_un , i_bne_un_s
+ BI_brfalse , i_brfalse_s
+ BI_brtrue , i_brtrue_s ])
+
+(* From corhdr.h *)
+
+let nt_VOID = 0x1uy
+let nt_BOOLEAN = 0x2uy
+let nt_I1 = 0x3uy
+let nt_U1 = 0x4uy
+let nt_I2 = 0x5uy
+let nt_U2 = 0x6uy
+let nt_I4 = 0x7uy
+let nt_U4 = 0x8uy
+let nt_I8 = 0x9uy
+let nt_U8 = 0xAuy
+let nt_R4 = 0xBuy
+let nt_R8 = 0xCuy
+let nt_SYSCHAR = 0xDuy
+let nt_VARIANT = 0xEuy
+let nt_CURRENCY = 0xFuy
+let nt_PTR = 0x10uy
+let nt_DECIMAL = 0x11uy
+let nt_DATE = 0x12uy
+let nt_BSTR = 0x13uy
+let nt_LPSTR = 0x14uy
+let nt_LPWSTR = 0x15uy
+let nt_LPTSTR = 0x16uy
+let nt_FIXEDSYSSTRING = 0x17uy
+let nt_OBJECTREF = 0x18uy
+let nt_IUNKNOWN = 0x19uy
+let nt_IDISPATCH = 0x1Auy
+let nt_STRUCT = 0x1Buy
+let nt_INTF = 0x1Cuy
+let nt_SAFEARRAY = 0x1Duy
+let nt_FIXEDARRAY = 0x1Euy
+let nt_INT = 0x1Fuy
+let nt_UINT = 0x20uy
+let nt_NESTEDSTRUCT = 0x21uy
+let nt_BYVALSTR = 0x22uy
+let nt_ANSIBSTR = 0x23uy
+let nt_TBSTR = 0x24uy
+let nt_VARIANTBOOL = 0x25uy
+let nt_FUNC = 0x26uy
+let nt_ASANY = 0x28uy
+let nt_ARRAY = 0x2Auy
+let nt_LPSTRUCT = 0x2Buy
+let nt_CUSTOMMARSHALER = 0x2Cuy
+let nt_ERROR = 0x2Duy
+let nt_MAX = 0x50uy
+
+(* From c:/clrenv.i386/Crt/Inc/i386/hs.h *)
+
+let vt_EMPTY = 0
+let vt_NULL = 1
+let vt_I2 = 2
+let vt_I4 = 3
+let vt_R4 = 4
+let vt_R8 = 5
+let vt_CY = 6
+let vt_DATE = 7
+let vt_BSTR = 8
+let vt_DISPATCH = 9
+let vt_ERROR = 10
+let vt_BOOL = 11
+let vt_VARIANT = 12
+let vt_UNKNOWN = 13
+let vt_DECIMAL = 14
+let vt_I1 = 16
+let vt_UI1 = 17
+let vt_UI2 = 18
+let vt_UI4 = 19
+let vt_I8 = 20
+let vt_UI8 = 21
+let vt_INT = 22
+let vt_UINT = 23
+let vt_VOID = 24
+let vt_HRESULT = 25
+let vt_PTR = 26
+let vt_SAFEARRAY = 27
+let vt_CARRAY = 28
+let vt_USERDEFINED = 29
+let vt_LPSTR = 30
+let vt_LPWSTR = 31
+let vt_RECORD = 36
+let vt_FILETIME = 64
+let vt_BLOB = 65
+let vt_STREAM = 66
+let vt_STORAGE = 67
+let vt_STREAMED_OBJECT = 68
+let vt_STORED_OBJECT = 69
+let vt_BLOB_OBJECT = 70
+let vt_CF = 71
+let vt_CLSID = 72
+let vt_VECTOR = 0x1000
+let vt_ARRAY = 0x2000
+let vt_BYREF = 0x4000
+
+
+let ILNativeTypeMap =
+ lazy [ nt_CURRENCY , ILNativeType.Currency
+ nt_BSTR , (* COM interop *) ILNativeType.BSTR
+ nt_LPSTR , ILNativeType.LPSTR
+ nt_LPWSTR , ILNativeType.LPWSTR
+ nt_LPTSTR, ILNativeType.LPTSTR
+ nt_IUNKNOWN , (* COM interop *) ILNativeType.IUnknown
+ nt_IDISPATCH , (* COM interop *) ILNativeType.IDispatch
+ nt_BYVALSTR , ILNativeType.ByValStr
+ nt_TBSTR , ILNativeType.TBSTR
+ nt_LPSTRUCT , ILNativeType.LPSTRUCT
+ nt_INTF , (* COM interop *) ILNativeType.Interface
+ nt_STRUCT , ILNativeType.Struct
+ nt_ERROR , (* COM interop *) ILNativeType.Error
+ nt_VOID , ILNativeType.Void
+ nt_BOOLEAN , ILNativeType.Bool
+ nt_I1 , ILNativeType.Int8
+ nt_I2 , ILNativeType.Int16
+ nt_I4 , ILNativeType.Int32
+ nt_I8, ILNativeType.Int64
+ nt_R4 , ILNativeType.Single
+ nt_R8 , ILNativeType.Double
+ nt_U1 , ILNativeType.Byte
+ nt_U2 , ILNativeType.UInt16
+ nt_U4 , ILNativeType.UInt32
+ nt_U8, ILNativeType.UInt64
+ nt_INT , ILNativeType.Int
+ nt_UINT, ILNativeType.UInt
+ nt_ANSIBSTR, (* COM interop *) ILNativeType.ANSIBSTR
+ nt_VARIANTBOOL, (* COM interop *) ILNativeType.VariantBool
+ nt_FUNC , ILNativeType.Method
+ nt_ASANY, ILNativeType.AsAny ]
+
+let ILNativeTypeRevMap = lazy (List.map (fun (x,y) -> (y,x)) (Lazy.force ILNativeTypeMap))
+
+let ILVariantTypeMap =
+ lazy [ ILNativeVariant.Empty , vt_EMPTY
+ ILNativeVariant.Null , vt_NULL
+ ILNativeVariant.Variant , vt_VARIANT
+ ILNativeVariant.Currency , vt_CY
+ ILNativeVariant.Decimal , vt_DECIMAL
+ ILNativeVariant.Date , vt_DATE
+ ILNativeVariant.BSTR , vt_BSTR
+ ILNativeVariant.LPSTR , vt_LPSTR
+ ILNativeVariant.LPWSTR , vt_LPWSTR
+ ILNativeVariant.IUnknown , vt_UNKNOWN
+ ILNativeVariant.IDispatch , vt_DISPATCH
+ ILNativeVariant.SafeArray , vt_SAFEARRAY
+ ILNativeVariant.Error , vt_ERROR
+ ILNativeVariant.HRESULT , vt_HRESULT
+ ILNativeVariant.CArray , vt_CARRAY
+ ILNativeVariant.UserDefined , vt_USERDEFINED
+ ILNativeVariant.Record , vt_RECORD
+ ILNativeVariant.FileTime , vt_FILETIME
+ ILNativeVariant.Blob , vt_BLOB
+ ILNativeVariant.Stream , vt_STREAM
+ ILNativeVariant.Storage , vt_STORAGE
+ ILNativeVariant.StreamedObject , vt_STREAMED_OBJECT
+ ILNativeVariant.StoredObject , vt_STORED_OBJECT
+ ILNativeVariant.BlobObject , vt_BLOB_OBJECT
+ ILNativeVariant.CF , vt_CF
+ ILNativeVariant.CLSID , vt_CLSID
+ ILNativeVariant.Void , vt_VOID
+ ILNativeVariant.Bool , vt_BOOL
+ ILNativeVariant.Int8 , vt_I1
+ ILNativeVariant.Int16 , vt_I2
+ ILNativeVariant.Int32 , vt_I4
+ ILNativeVariant.Int64 , vt_I8
+ ILNativeVariant.Single , vt_R4
+ ILNativeVariant.Double , vt_R8
+ ILNativeVariant.UInt8 , vt_UI1
+ ILNativeVariant.UInt16 , vt_UI2
+ ILNativeVariant.UInt32 , vt_UI4
+ ILNativeVariant.UInt64 , vt_UI8
+ ILNativeVariant.PTR , vt_PTR
+ ILNativeVariant.Int , vt_INT
+ ILNativeVariant.UInt , vt_UINT ]
+
+let ILVariantTypeRevMap = lazy (List.map (fun (x,y) -> (y,x)) (Lazy.force ILVariantTypeMap))
+
+let ILSecurityActionMap =
+ lazy
+ [ ILSecurityAction.Request , 0x0001
+ ILSecurityAction.Demand , 0x0002
+ ILSecurityAction.Assert , 0x0003
+ ILSecurityAction.Deny , 0x0004
+ ILSecurityAction.PermitOnly , 0x0005
+ ILSecurityAction.LinkCheck , 0x0006
+ ILSecurityAction.InheritCheck , 0x0007
+ ILSecurityAction.ReqMin , 0x0008
+ ILSecurityAction.ReqOpt , 0x0009
+ ILSecurityAction.ReqRefuse , 0x000a
+ ILSecurityAction.PreJitGrant , 0x000b
+ ILSecurityAction.PreJitDeny , 0x000c
+ ILSecurityAction.NonCasDemand , 0x000d
+ ILSecurityAction.NonCasLinkDemand , 0x000e
+ ILSecurityAction.NonCasInheritance , 0x000f
+ ILSecurityAction.LinkDemandChoice , 0x0010
+ ILSecurityAction.InheritanceDemandChoice , 0x0011
+ ILSecurityAction.DemandChoice , 0x0012 ]
+
+let ILSecurityActionRevMap = lazy (List.map (fun (x,y) -> (y,x)) (Lazy.force ILSecurityActionMap))
+
+let e_CorILMethod_TinyFormat = 0x02uy
+let e_CorILMethod_FatFormat = 0x03uy
+let e_CorILMethod_FormatMask = 0x03uy
+let e_CorILMethod_MoreSects = 0x08uy
+let e_CorILMethod_InitLocals = 0x10uy
+
+
+let e_CorILMethod_Sect_EHTable = 0x1uy
+let e_CorILMethod_Sect_FatFormat = 0x40uy
+let e_CorILMethod_Sect_MoreSects = 0x80uy
+
+let e_COR_ILEXCEPTION_CLAUSE_EXCEPTION = 0x0
+let e_COR_ILEXCEPTION_CLAUSE_FILTER = 0x1
+let e_COR_ILEXCEPTION_CLAUSE_FINALLY = 0x2
+let e_COR_ILEXCEPTION_CLAUSE_FAULT = 0x4
+
+let e_IMAGE_CEE_CS_CALLCONV_FASTCALL = 0x04uy
+let e_IMAGE_CEE_CS_CALLCONV_STDCALL = 0x02uy
+let e_IMAGE_CEE_CS_CALLCONV_THISCALL = 0x03uy
+let e_IMAGE_CEE_CS_CALLCONV_CDECL = 0x01uy
+let e_IMAGE_CEE_CS_CALLCONV_VARARG = 0x05uy
+let e_IMAGE_CEE_CS_CALLCONV_FIELD = 0x06uy
+let e_IMAGE_CEE_CS_CALLCONV_LOCAL_SIG = 0x07uy
+let e_IMAGE_CEE_CS_CALLCONV_PROPERTY = 0x08uy
+
+let e_IMAGE_CEE_CS_CALLCONV_GENERICINST = 0x0auy
+let e_IMAGE_CEE_CS_CALLCONV_GENERIC = 0x10uy
+let e_IMAGE_CEE_CS_CALLCONV_INSTANCE = 0x20uy
+let e_IMAGE_CEE_CS_CALLCONV_INSTANCE_EXPLICIT = 0x40uy
+
+
diff --git a/src/absil/ilbinary.fsi b/src/absil/ilbinary.fsi
new file mode 100644
index 0000000..6c20831
--- /dev/null
+++ b/src/absil/ilbinary.fsi
@@ -0,0 +1,555 @@
+(* (c) Microsoft Corporation. Apache 2.0 License *)
+
+/// Internal use only. Code and constants shared between binary reader/writer.
+module internal Microsoft.FSharp.Compiler.AbstractIL.Internal.BinaryConstants
+
+open Internal.Utilities
+open Microsoft.FSharp.Compiler.AbstractIL
+open Microsoft.FSharp.Compiler.AbstractIL.IL
+open Microsoft.FSharp.Compiler.AbstractIL.Internal
+
+
+[]
+type TableName =
+ member Index : int
+ static member FromIndex : int -> TableName
+
+module TableNames =
+ val Module : TableName
+ val TypeRef : TableName
+ val TypeDef : TableName
+ val FieldPtr : TableName
+ val Field : TableName
+ val MethodPtr : TableName
+ val Method : TableName
+ val ParamPtr : TableName
+ val Param : TableName
+ val InterfaceImpl : TableName
+ val MemberRef : TableName
+ val Constant : TableName
+ val CustomAttribute : TableName
+ val FieldMarshal : TableName
+ val Permission : TableName
+ val ClassLayout : TableName
+ val FieldLayout : TableName
+ val StandAloneSig : TableName
+ val EventMap : TableName
+ val EventPtr : TableName
+ val Event : TableName
+ val PropertyMap : TableName
+ val PropertyPtr : TableName
+ val Property : TableName
+ val MethodSemantics : TableName
+ val MethodImpl : TableName
+ val ModuleRef : TableName
+ val TypeSpec : TableName
+ val ImplMap : TableName
+ val FieldRVA : TableName
+ val ENCLog : TableName
+ val ENCMap : TableName
+ val Assembly : TableName
+ val AssemblyProcessor : TableName
+ val AssemblyOS : TableName
+ val AssemblyRef : TableName
+ val AssemblyRefProcessor : TableName
+ val AssemblyRefOS : TableName
+ val File : TableName
+ val ExportedType : TableName
+ val ManifestResource : TableName
+ val Nested : TableName
+ val GenericParam : TableName
+ val GenericParamConstraint : TableName
+ val MethodSpec : TableName
+ val UserStrings : TableName
+
+val sortedTableInfo : (TableName * int) list
+
+[]
+type TypeDefOrRefTag = member Tag : int32
+val tdor_TypeDef : TypeDefOrRefTag
+val tdor_TypeRef : TypeDefOrRefTag
+val tdor_TypeSpec : TypeDefOrRefTag
+
+[]
+type HasConstantTag = member Tag : int32
+val hc_FieldDef : HasConstantTag
+val hc_ParamDef : HasConstantTag
+val hc_Property : HasConstantTag
+
+[]
+type HasCustomAttributeTag = member Tag : int32
+val hca_MethodDef : HasCustomAttributeTag
+val hca_FieldDef : HasCustomAttributeTag
+val hca_TypeRef : HasCustomAttributeTag
+val hca_TypeDef : HasCustomAttributeTag
+val hca_ParamDef : HasCustomAttributeTag
+val hca_InterfaceImpl : HasCustomAttributeTag
+val hca_MemberRef : HasCustomAttributeTag
+val hca_Module : HasCustomAttributeTag
+val hca_Permission : HasCustomAttributeTag
+val hca_Property : HasCustomAttributeTag
+val hca_GenericParam : HasCustomAttributeTag
+val hca_Event : HasCustomAttributeTag
+val hca_StandAloneSig : HasCustomAttributeTag
+val hca_ModuleRef : HasCustomAttributeTag
+val hca_TypeSpec : HasCustomAttributeTag
+val hca_Assembly : HasCustomAttributeTag
+val hca_AssemblyRef : HasCustomAttributeTag
+val hca_File : HasCustomAttributeTag
+val hca_ExportedType : HasCustomAttributeTag
+val hca_ManifestResource : HasCustomAttributeTag
+
+[]
+type HasFieldMarshalTag = member Tag : int32
+val hfm_FieldDef : HasFieldMarshalTag
+val hfm_ParamDef : HasFieldMarshalTag
+
+
+[]
+type HasDeclSecurityTag = member Tag : int32
+val hds_TypeDef : HasDeclSecurityTag
+val hds_MethodDef : HasDeclSecurityTag
+val hds_Assembly : HasDeclSecurityTag
+
+
+[]
+type MemberRefParentTag = member Tag : int32
+val mrp_TypeRef : MemberRefParentTag
+val mrp_ModuleRef : MemberRefParentTag
+val mrp_MethodDef : MemberRefParentTag
+val mrp_TypeSpec : MemberRefParentTag
+
+
+[]
+type HasSemanticsTag = member Tag : int32
+val hs_Event : HasSemanticsTag
+val hs_Property : HasSemanticsTag
+
+
+[