diff --git a/README.md b/README.md index 37ec0d1da39a4421d1265bb41fae77fdc3ff3467..cf7dccba92780ddec0cc074e3d7c71458d62a44f 100644 --- a/README.md +++ b/README.md @@ -43,3 +43,4 @@ Although the primary focus of this repo is F# for Windows and the Visual Studio ###Get In Touch Keep up with the Visual F# Team and the development of the Visual F# Tools by following us [@VisualFSharp](https://twitter.com/VisualFSharp) or subscribing to our [team blog](http://blogs.msdn.com/b/fsharpteam/). + diff --git a/src/absil/il.fs b/src/absil/il.fs index 5fe7972f13cad928d4c1c5379033f5ae249666d9..4bb79148bf47d199b2f762cf6a9e824fad19885f 100644 --- a/src/absil/il.fs +++ b/src/absil/il.fs @@ -215,22 +215,18 @@ module SHA1 = else k60to79 - type chan = SHABytes of byte[] - type sha_instream = - { stream: chan; + type SHAStream = + { stream: byte[]; mutable pos: int; mutable eof: bool; } - let rot_left32 x n = (x <<< n) ||| (x >>>& (32-n)) + let rotLeft32 x n = (x <<< n) ||| (x >>>& (32-n)) - let inline sha_eof sha = sha.eof - - (* padding and length (in bits!) recorded at end *) - let sha_after_eof sha = + + // padding and length (in bits!) recorded at end + let shaAfterEof sha = let n = sha.pos - let len = - (match sha.stream with - | SHABytes s -> s.Length) + let len = sha.stream.Length if n = len then 0x80 else let padded_len = (((len + 9 + 63) / 64) * 64) - 8 @@ -245,22 +241,21 @@ module SHA1 = 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; + let shaRead8 sha = + let s = sha.stream + let b = if sha.pos >= s.Length then shaAfterEof 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 shaRead32 sha = + let b0 = shaRead8 sha + let b1 = shaRead8 sha + let b2 = shaRead8 sha + let b3 = shaRead8 sha let res = (b0 <<< 24) ||| (b1 <<< 16) ||| (b2 <<< 8) ||| b3 res - let sha1_hash sha = + let sha1Hash sha = let mutable h0 = 0x67452301 let mutable h1 = 0xEFCDAB89 let mutable h2 = 0x98BADCFE @@ -272,21 +267,21 @@ module SHA1 = let mutable d = 0 let mutable e = 0 let w = Array.create 80 0x00 - while (not (sha_eof sha)) do + while (not sha.eof) do for i = 0 to 15 do - w.[i] <- sha_read32 sha + w.[i] <- shaRead32 sha for t = 16 to 79 do - w.[t] <- rot_left32 (w.[t-3] ^^^ w.[t-8] ^^^ w.[t-14] ^^^ w.[t-16]) 1 + w.[t] <- rotLeft32 (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) + let temp = (rotLeft32 a 5) + f(t,b,c,d) + e + w.[t] + k(t) e <- d d <- c - c <- rot_left32 b 30 + c <- rotLeft32 b 30 b <- a a <- temp h0 <- h0 + a @@ -297,7 +292,7 @@ module SHA1 = 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 + let (_h0,_h1,_h2,h3,h4) = sha1Hash { stream = 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; |] diff --git a/src/absil/ilascii.fs b/src/absil/ilascii.fs index f2bd0a4b2d3437f9b6183c640c7193f27b61c861..bd4e1e8c354b5fcb49cd6dee29825466753ebbf7 100644 --- a/src/absil/ilascii.fs +++ b/src/absil/ilascii.fs @@ -12,7 +12,7 @@ open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.Types open Microsoft.FSharp.Compiler.AbstractIL.IL -// set to the proper value at build.fs (BuildFrameworkTcImports) +// set to the proper value at CompileOps.fs (BuildFrameworkTcImports) let parseILGlobals = ref EcmaILGlobals // -------------------------------------------------------------------- diff --git a/src/absil/illib.fs b/src/absil/illib.fs index 7f2cb63dd4fc44494efb5013954a5972699253d2..ae7d81e065216780b83b17a9890db4f7f80fe903 100644 --- a/src/absil/illib.fs +++ b/src/absil/illib.fs @@ -465,6 +465,7 @@ module Dictionary = // FUTURE CLEANUP: remove this adhoc collection type Hashset<'T> = Dictionary<'T,int> + [] module Hashset = let create (n:int) = new Hashset<'T>(n, HashIdentity.Structural) @@ -498,6 +499,28 @@ type ResultOrException<'TResult> = | Result of 'TResult | Exception of System.Exception +[] +module ResultOrException = + + let success a = Result a + let raze (b:exn) = Exception b + + // map + let (|?>) res f = + match res with + | Result x -> Result(f x ) + | Exception err -> Exception err + + let ForceRaise res = + match res with + | Result x -> x + | Exception err -> raise err + + let otherwise f x = + match x with + | Result x -> success x + | Exception _err -> f() + //------------------------------------------------------------------------- // Library: extensions to flat list (immutable arrays) diff --git a/src/absil/ilwrite.fs b/src/absil/ilwrite.fs index e206f3a71147ad70254ebd2a66f6b8ff7f3cd5d6..b6aaa862c3f0683f710c5bfc727a9cc64164cda3 100644 --- a/src/absil/ilwrite.fs +++ b/src/absil/ilwrite.fs @@ -35,7 +35,7 @@ let reportTime = let t = System.Diagnostics.Process.GetCurrentProcess().UserProcessorTime.TotalSeconds let prev = match !tPrev with None -> 0.0 | Some t -> t let first = match !tFirst with None -> (tFirst := Some t; t) | Some t -> t - dprintf "ilwrite: TIME %10.3f (total) %10.3f (delta) - %s\n" (t - first) (t - prev) descr; + dprintf "ilwrite: TIME %10.3f (total) %10.3f (delta) - %s\n" (t - first) (t - prev) descr tPrev := Some t //--------------------------------------------------------------------- @@ -85,12 +85,12 @@ type ByteBuffer with if n >= 0 && n <= 0x7F then buf.EmitIntAsByte n elif n >= 0x80 && n <= 0x3FFF then - buf.EmitIntAsByte (0x80 ||| (n >>> 8)); + buf.EmitIntAsByte (0x80 ||| (n >>> 8)) buf.EmitIntAsByte (n &&& 0xFF) else - buf.EmitIntAsByte (0xc0l ||| ((n >>> 24) &&& 0xFF)); - buf.EmitIntAsByte ( (n >>> 16) &&& 0xFF); - buf.EmitIntAsByte ( (n >>> 8) &&& 0xFF); + buf.EmitIntAsByte (0xc0l ||| ((n >>> 24) &&& 0xFF)) + buf.EmitIntAsByte ( (n >>> 16) &&& 0xFF) + buf.EmitIntAsByte ( (n >>> 8) &&& 0xFF) buf.EmitIntAsByte ( n &&& 0xFF) member buf.EmitPadding n = @@ -142,15 +142,15 @@ let markerForUnicodeBytes (b:byte[]) = /// Check that the data held at a fixup is some special magic value, as a sanity check /// to ensure the fixup is being placed at a ood lcoation. let checkFixup32 (data: byte[]) offset exp = - if data.[offset + 3] <> b3 exp then failwith "fixup sanity check failed"; - if data.[offset + 2] <> b2 exp then failwith "fixup sanity check failed"; - if data.[offset + 1] <> b1 exp then failwith "fixup sanity check failed"; + if data.[offset + 3] <> b3 exp then failwith "fixup sanity check failed" + if data.[offset + 2] <> b2 exp then failwith "fixup sanity check failed" + if data.[offset + 1] <> b1 exp then failwith "fixup sanity check failed" if data.[offset] <> b0 exp then failwith "fixup sanity check failed" let applyFixup32 (data:byte[]) offset v = - data.[offset] <- b0 v; - data.[offset+1] <- b1 v; - data.[offset+2] <- b2 v; + data.[offset] <- b0 v + data.[offset+1] <- b1 v + data.[offset+2] <- b2 v data.[offset+3] <- b3 v // -------------------------------------------------------------------- @@ -160,39 +160,39 @@ let applyFixup32 (data:byte[]) offset v = type PdbDocumentData = ILSourceDocument type PdbLocalVar = - { Name: string; - Signature: byte[]; + { Name: string + Signature: byte[] /// the local index the name corresponds to Index: int32 } type PdbMethodScope = - { Children: PdbMethodScope array; - StartOffset: int; - EndOffset: int; - Locals: PdbLocalVar array; - (* REVIEW open_namespaces: pdb_namespace array; *) } + { Children: PdbMethodScope array + StartOffset: int + EndOffset: int + Locals: PdbLocalVar array + (* REVIEW open_namespaces: pdb_namespace array *) } type PdbSourceLoc = - { Document: int; - Line: int; - Column: int; } + { Document: int + Line: int + Column: int } type PdbSequencePoint = - { Document: int; - Offset: int; - Line: int; - Column: int; - EndLine: int; - EndColumn: int; } + { Document: int + Offset: int + Line: int + Column: int + EndLine: int + EndColumn: int } override x.ToString() = sprintf "(%d,%d)-(%d,%d)" x.Line x.Column x.EndLine x.EndColumn type PdbMethodData = - { MethToken: int32; - MethName:string; - Params: PdbLocalVar array; - RootScope: PdbMethodScope; - Range: (PdbSourceLoc * PdbSourceLoc) option; - SequencePoints: PdbSequencePoint array; } + { MethToken: int32 + MethName:string + Params: PdbLocalVar array + RootScope: PdbMethodScope + Range: (PdbSourceLoc * PdbSourceLoc) option + SequencePoints: PdbSequencePoint array } module SequencePoint = let orderBySource sp1 sp2 = @@ -210,10 +210,10 @@ let sizeof_IMAGE_DEBUG_DIRECTORY = 28 [] type PdbData = - { EntryPoint: int32 option; + { EntryPoint: int32 option // MVID of the generated .NET module (used by MDB files to identify debug info) - ModuleID: byte[]; - Documents: PdbDocumentData[]; + ModuleID: byte[] + Documents: PdbDocumentData[] Methods: PdbMethodData[] } //--------------------------------------------------------------------- @@ -222,7 +222,7 @@ type PdbData = //--------------------------------------------------------------------- let WritePdbInfo fixupOverlappingSequencePoints showTimes f fpdb info = - (try FileSystem.FileDelete fpdb with _ -> ()); + (try FileSystem.FileDelete fpdb with _ -> ()) let pdbw = ref Unchecked.defaultof try @@ -235,12 +235,12 @@ let WritePdbInfo fixupOverlappingSequencePoints showTimes f fpdb info = let docs = info.Documents |> Array.map (fun doc -> pdbDefineDocument !pdbw doc.File) let getDocument i = - if i < 0 || i > docs.Length then failwith "getDocument: bad doc number"; + if i < 0 || i > docs.Length then failwith "getDocument: bad doc number" docs.[i] - reportTime showTimes (sprintf "PDB: Defined %d documents" info.Documents.Length); - Array.sortInPlaceBy (fun x -> x.MethToken) info.Methods; + reportTime showTimes (sprintf "PDB: Defined %d documents" info.Documents.Length) + Array.sortInPlaceBy (fun x -> x.MethToken) info.Methods - reportTime showTimes (sprintf "PDB: Sorted %d methods" info.Methods.Length); + reportTime showTimes (sprintf "PDB: Sorted %d methods" info.Methods.Length) // This next bit is a workaround. The sequence points we get // from F# (which has nothing to do with this module) are actually expression @@ -258,7 +258,7 @@ let WritePdbInfo fixupOverlappingSequencePoints showTimes f fpdb info = let allSps = Array.mapi (fun i sp -> (i,sp)) allSps if fixupOverlappingSequencePoints then // sort the sequence points into source order - Array.sortInPlaceWith (fun (_,sp1) (_,sp2) -> SequencePoint.orderBySource sp1 sp2) allSps; + Array.sortInPlaceWith (fun (_,sp1) (_,sp2) -> SequencePoint.orderBySource sp1 sp2) allSps // shorten the ranges of any that overlap with following sequence points // sort the sequence points back into offset order for i = 0 to Array.length allSps - 2 do @@ -269,9 +269,9 @@ let WritePdbInfo fixupOverlappingSequencePoints showTimes f fpdb info = (sp1.EndLine = sp2.Line && sp1.EndColumn >= sp2.Column)) then let adjustToPrevLine = (sp1.Line < sp2.Line) - allSps.[i] <- n,{sp1 with EndLine = (if adjustToPrevLine then sp2.Line-1 else sp2.Line); - EndColumn = (if adjustToPrevLine then 80 else sp2.Column); } - Array.sortInPlaceBy fst allSps; + allSps.[i] <- n,{sp1 with EndLine = (if adjustToPrevLine then sp2.Line-1 else sp2.Line) + EndColumn = (if adjustToPrevLine then 80 else sp2.Column) } + Array.sortInPlaceBy fst allSps @@ -279,15 +279,15 @@ let WritePdbInfo fixupOverlappingSequencePoints showTimes f fpdb info = info.Methods |> Array.iteri (fun i minfo -> let sps = Array.sub allSps !spOffset spCounts.[i] - spOffset := !spOffset + spCounts.[i]; + spOffset := !spOffset + spCounts.[i] begin match minfo.Range with | None -> () | Some (a,b) -> - pdbOpenMethod !pdbw minfo.MethToken; + pdbOpenMethod !pdbw minfo.MethToken pdbSetMethodRange !pdbw (getDocument a.Document) a.Line a.Column - (getDocument b.Document) b.Line b.Column; + (getDocument b.Document) b.Line b.Column // Partition the sequence points by document let spsets = @@ -304,34 +304,34 @@ let WritePdbInfo fixupOverlappingSequencePoints showTimes f fpdb info = spsets |> List.iter (fun spset -> if spset.Length > 0 then - Array.sortInPlaceWith SequencePoint.orderByOffset spset; + Array.sortInPlaceWith SequencePoint.orderByOffset spset let sps = spset |> Array.map (fun sp -> - // Ildiag.dprintf "token 0x%08lx has an sp at offset 0x%08x\n" minfo.MethToken sp.Offset; + // Ildiag.dprintf "token 0x%08lx has an sp at offset 0x%08x\n" minfo.MethToken sp.Offset (sp.Offset, sp.Line, sp.Column,sp.EndLine, sp.EndColumn)) // Use of alloca in implementation of pdbDefineSequencePoints can give stack overflow here if sps.Length < 5000 then - pdbDefineSequencePoints !pdbw (getDocument spset.[0].Document) sps;); + pdbDefineSequencePoints !pdbw (getDocument spset.[0].Document) sps) // Write the scopes let rec writePdbScope top sco = if top || sco.Locals.Length <> 0 || sco.Children.Length <> 0 then - pdbOpenScope !pdbw sco.StartOffset; - sco.Locals |> Array.iter (fun v -> pdbDefineLocalVariable !pdbw v.Name v.Signature v.Index); - sco.Children |> Array.iter (writePdbScope false); - pdbCloseScope !pdbw sco.EndOffset; - writePdbScope true minfo.RootScope; + pdbOpenScope !pdbw sco.StartOffset + sco.Locals |> Array.iter (fun v -> pdbDefineLocalVariable !pdbw v.Name v.Signature v.Index) + sco.Children |> Array.iter (writePdbScope false) + pdbCloseScope !pdbw sco.EndOffset + writePdbScope true minfo.RootScope pdbCloseMethod !pdbw - end); - reportTime showTimes "PDB: Wrote methods"; + end) + reportTime showTimes "PDB: Wrote methods" let res = pdbGetDebugInfo !pdbw for pdbDoc in docs do pdbCloseDocument pdbDoc pdbClose !pdbw f fpdb; - reportTime showTimes "PDB: Closed"; + reportTime showTimes "PDB: Closed" res //--------------------------------------------------------------------- @@ -383,7 +383,7 @@ let createWriter (f:string) = let WriteMdbInfo fmdb f info = // Note, if we can’t delete it code will fail later - (try FileSystem.FileDelete fmdb with _ -> ()); + (try FileSystem.FileDelete fmdb with _ -> ()) // Try loading the MDB symbol writer from an assembly available on Mono dynamically // Report an error if the assembly is not available. @@ -514,7 +514,7 @@ type ILStrongNameSigner = member s.SignatureSize = try Support.signerSignatureSize(s.PublicKey) with e -> - failwith ("A call to StrongNameSignatureSize failed ("+e.Message+")"); + failwith ("A call to StrongNameSignatureSize failed ("+e.Message+")") 0x80 member s.SignFile file = @@ -755,48 +755,48 @@ let envForOverrideSpec (ospec:ILOverridesSpec) = { EnclosingTyparCount=ospec.Enc [] type MetadataTable<'T> = - { name: string; - dict: Dictionary<'T, int>; // given a row, find its entry number + { name: string + dict: Dictionary<'T, int> // given a row, find its entry number #if DEBUG - mutable lookups: int; + mutable lookups: int #endif - mutable rows: ResizeArray<'T> ; } + mutable rows: ResizeArray<'T> } member x.Count = x.rows.Count static member New(nm,hashEq) = - { name=nm; + { name=nm #if DEBUG - lookups=0; + lookups=0 #endif - dict = new Dictionary<_,_>(100, hashEq); - rows= new ResizeArray<_>(); } + dict = new Dictionary<_,_>(100, hashEq) + rows= new ResizeArray<_>() } member tbl.EntriesAsArray = #if DEBUG - if showEntryLookups then dprintf "--> table %s had %d entries and %d lookups\n" tbl.name tbl.Count tbl.lookups; + if showEntryLookups then dprintf "--> table %s had %d entries and %d lookups\n" tbl.name tbl.Count tbl.lookups #endif tbl.rows |> ResizeArray.toArray member tbl.Entries = #if DEBUG - if showEntryLookups then dprintf "--> table %s had %d entries and %d lookups\n" tbl.name tbl.Count tbl.lookups; + if showEntryLookups then dprintf "--> table %s had %d entries and %d lookups\n" tbl.name tbl.Count tbl.lookups #endif tbl.rows |> ResizeArray.toList member tbl.AddSharedEntry x = let n = tbl.rows.Count + 1 - tbl.dict.[x] <- n; - tbl.rows.Add(x); + tbl.dict.[x] <- n + tbl.rows.Add(x) n member tbl.AddUnsharedEntry x = let n = tbl.rows.Count + 1 - tbl.rows.Add(x); + tbl.rows.Add(x) n member tbl.FindOrAddSharedEntry x = #if DEBUG - tbl.lookups <- tbl.lookups + 1; + tbl.lookups <- tbl.lookups + 1 #endif let mutable res = Unchecked.defaultof<_> let ok = tbl.dict.TryGetValue(x,&res) @@ -806,9 +806,9 @@ type MetadataTable<'T> = /// This is only used in one special place - see further below. member tbl.SetRowsOfTable t = - tbl.rows <- ResizeArray.ofArray t; + tbl.rows <- ResizeArray.ofArray t let h = tbl.dict - h.Clear(); + h.Clear() t |> Array.iteri (fun i x -> h.[x] <- (i+1)) member tbl.AddUniqueEntry nm geterr x = @@ -877,52 +877,52 @@ type TypeDefTableKey = TdKey of string list (* enclosing *) * string (* type nam [] type cenv = - { primaryAssembly: ILScopeRef; - ilg: ILGlobals; - emitTailcalls: bool; - showTimes: bool; - desiredMetadataVersion: ILVersionInfo; - requiredDataFixups: (int32 * (int * bool)) list ref; + { primaryAssembly: ILScopeRef + ilg: ILGlobals + emitTailcalls: bool + showTimes: bool + desiredMetadataVersion: ILVersionInfo + requiredDataFixups: (int32 * (int * bool)) list ref /// References to strings in codestreams: offset of code and a (fixup-location , string token) list) - mutable requiredStringFixups: (int32 * (int * int) list) list; - codeChunks: ByteBuffer; - mutable nextCodeAddr: int32; + mutable requiredStringFixups: (int32 * (int * int) list) list + codeChunks: ByteBuffer + mutable nextCodeAddr: int32 // Collected debug information mutable moduleGuid: byte[] - generatePdb: bool; - pdbinfo: ResizeArray; - documents: MetadataTable; + generatePdb: bool + pdbinfo: ResizeArray + documents: MetadataTable /// Raw data, to go into the data section - data: ByteBuffer; + data: ByteBuffer /// Raw resource data, to go into the data section - resources: ByteBuffer; - mutable entrypoint: (bool * int) option; + resources: ByteBuffer + mutable entrypoint: (bool * int) option /// Caches - trefCache: Dictionary; + trefCache: Dictionary /// The following are all used to generate unique items in the output - tables: array>; - AssemblyRefs: MetadataTable; - fieldDefs: MetadataTable; - methodDefIdxsByKey: MetadataTable; - methodDefIdxs: Dictionary; - propertyDefs: MetadataTable; - eventDefs: MetadataTable; - typeDefs: MetadataTable; - guids: MetadataTable; - blobs: MetadataTable; - strings: MetadataTable; - userStrings: MetadataTable; + tables: array> + AssemblyRefs: MetadataTable + fieldDefs: MetadataTable + methodDefIdxsByKey: MetadataTable + methodDefIdxs: Dictionary + propertyDefs: MetadataTable + eventDefs: MetadataTable + typeDefs: MetadataTable + guids: MetadataTable + blobs: MetadataTable + strings: MetadataTable + userStrings: MetadataTable } member cenv.GetTable (tab:TableName) = cenv.tables.[tab.Index] member cenv.AddCode ((reqdStringFixupsOffset,requiredStringFixups),code) = - if align 4 cenv.nextCodeAddr <> cenv.nextCodeAddr then dprintn "warning: code not 4-byte aligned"; - cenv.requiredStringFixups <- (cenv.nextCodeAddr + reqdStringFixupsOffset, requiredStringFixups) :: cenv.requiredStringFixups; - cenv.codeChunks.EmitBytes code; + if align 4 cenv.nextCodeAddr <> cenv.nextCodeAddr then dprintn "warning: code not 4-byte aligned" + cenv.requiredStringFixups <- (cenv.nextCodeAddr + reqdStringFixupsOffset, requiredStringFixups) :: cenv.requiredStringFixups + cenv.codeChunks.EmitBytes code cenv.nextCodeAddr <- cenv.nextCodeAddr + code.Length member cenv.GetCode() = cenv.codeChunks.Close() @@ -964,14 +964,14 @@ let peOptionalHeaderByteByCLRVersion v = // returned by writeBinaryAndReportMappings [] type ILTokenMappings = - { TypeDefTokenMap: ILTypeDef list * ILTypeDef -> int32; - FieldDefTokenMap: ILTypeDef list * ILTypeDef -> ILFieldDef -> int32; - MethodDefTokenMap: ILTypeDef list * ILTypeDef -> ILMethodDef -> int32; - PropertyTokenMap: ILTypeDef list * ILTypeDef -> ILPropertyDef -> int32; + { TypeDefTokenMap: ILTypeDef list * ILTypeDef -> int32 + FieldDefTokenMap: ILTypeDef list * ILTypeDef -> ILFieldDef -> int32 + MethodDefTokenMap: ILTypeDef list * ILTypeDef -> ILMethodDef -> int32 + PropertyTokenMap: ILTypeDef list * ILTypeDef -> ILPropertyDef -> int32 EventTokenMap: ILTypeDef list * ILTypeDef -> ILEventDef -> int32 } let recordRequiredDataFixup requiredDataFixups (buf: ByteBuffer) pos lab = - requiredDataFixups := (pos,lab) :: !requiredDataFixups; + requiredDataFixups := (pos,lab) :: !requiredDataFixups // Write a special value in that we check later when applying the fixup buf.EmitInt32 0xdeaddddd @@ -1007,7 +1007,7 @@ let GetTypeNameAsElemPair cenv n = //===================================================================== let rec GenTypeDefPass1 enc cenv (td:ILTypeDef) = - ignore (cenv.typeDefs.AddUniqueEntry "type index" (fun (TdKey (_,n)) -> n) (TdKey (enc,td.Name))); + ignore (cenv.typeDefs.AddUniqueEntry "type index" (fun (TdKey (_,n)) -> n) (TdKey (enc,td.Name))) GenTypeDefsPass1 (enc@[td.Name]) cenv td.NestedTypes.AsList and GenTypeDefsPass1 enc cenv tds = List.iter (GenTypeDefPass1 enc cenv) tds @@ -1053,9 +1053,9 @@ and GetModuleRefAsRow cenv (mref:ILModuleRef) = and GetModuleRefAsFileRow cenv (mref:ILModuleRef) = SimpleSharedRow - [| ULong (if mref.HasMetadata then 0x0000 else 0x0001); - StringE (GetStringHeapIdx cenv mref.Name); - (match mref.Hash with None -> Blob 0 | Some s -> Blob (GetBytesAsBlobIdx cenv s)); |] + [| ULong (if mref.HasMetadata then 0x0000 else 0x0001) + StringE (GetStringHeapIdx cenv mref.Name) + (match mref.Hash with None -> Blob 0 | Some s -> Blob (GetBytesAsBlobIdx cenv s)) |] and GetModuleRefAsIdx cenv mref = FindOrAddRow cenv TableNames.ModuleRef (GetModuleRefAsRow cenv mref) @@ -1094,7 +1094,7 @@ and GetTypeRefAsTypeRefIdx cenv tref = let mutable res = 0 if cenv.trefCache.TryGetValue(tref,&res) then res else let res = FindOrAddRow cenv TableNames.TypeRef (GetTypeRefAsTypeRefRow cenv tref) - cenv.trefCache.[tref] <- res; + cenv.trefCache.[tref] <- res res and GetTypeDescAsTypeRefIdx cenv (scoref,enc,n) = @@ -1131,10 +1131,10 @@ let getTypeDefOrRefAsUncodedToken (tag,idx) = let EmitArrayShape (bb: ByteBuffer) (ILArrayShape shape) = let sized = List.filter (function (_,Some _) -> true | _ -> false) shape let lobounded = List.filter (function (Some _,_) -> true | _ -> false) shape - bb.EmitZ32 shape.Length; - bb.EmitZ32 sized.Length; - sized |> List.iter (function (_,Some sz) -> bb.EmitZ32 sz | _ -> failwith "?"); - bb.EmitZ32 lobounded.Length; + bb.EmitZ32 shape.Length + bb.EmitZ32 sized.Length + sized |> List.iter (function (_,Some sz) -> bb.EmitZ32 sz | _ -> failwith "?") + bb.EmitZ32 lobounded.Length lobounded |> List.iter (function (Some low,_) -> bb.EmitZ32 low | _ -> failwith "?") let hasthisToByte hasthis = @@ -1158,13 +1158,13 @@ let callconvToByte ntypars (Callconv (hasthis,bcc)) = // REVIEW: write into an accumuating buffer let rec EmitTypeSpec cenv env (bb: ByteBuffer) (et,tspec:ILTypeSpec) = if ILList.isEmpty tspec.GenericArgs then - bb.EmitByte et; + bb.EmitByte et emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tspec.Scope,tspec.Enclosing,tspec.Name) else - bb.EmitByte et_WITH; - bb.EmitByte et; - emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tspec.Scope,tspec.Enclosing,tspec.Name); - bb.EmitZ32 tspec.GenericArgs.Length; + bb.EmitByte et_WITH + bb.EmitByte et + emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tspec.Scope,tspec.Enclosing,tspec.Name) + bb.EmitZ32 tspec.GenericArgs.Length EmitTypes cenv env bb tspec.GenericArgs and GetTypeAsTypeDefOrRef cenv env (ty:ILType) = @@ -1218,41 +1218,41 @@ and EmitType cenv env bb ty = | ILType.TypeVar tv -> let cgparams = env.EnclosingTyparCount if int32 tv < cgparams then - bb.EmitByte et_VAR; + bb.EmitByte et_VAR bb.EmitZ32 (int32 tv) else - bb.EmitByte et_MVAR; + bb.EmitByte et_MVAR bb.EmitZ32 (int32 tv - cgparams) | ILType.Byref typ -> - bb.EmitByte et_BYREF; + bb.EmitByte et_BYREF EmitType cenv env bb typ | ILType.Ptr typ -> - bb.EmitByte et_PTR; + bb.EmitByte et_PTR EmitType cenv env bb typ | ILType.Void -> bb.EmitByte et_VOID | ILType.FunctionPointer x -> - bb.EmitByte et_FNPTR; + bb.EmitByte et_FNPTR EmitCallsig cenv env bb (x.CallingConv,x.ArgTypes,x.ReturnType,None,0) | ILType.Modified (req,tref,ty) -> - bb.EmitByte (if req then et_CMOD_REQD else et_CMOD_OPT); - emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tref.Scope, tref.Enclosing,tref.Name); + bb.EmitByte (if req then et_CMOD_REQD else et_CMOD_OPT) + emitTypeInfoAsTypeDefOrRefEncoded cenv bb (tref.Scope, tref.Enclosing,tref.Name) EmitType cenv env bb ty | _ -> failwith "EmitType" and EmitCallsig cenv env bb (callconv,args:ILTypes,ret,varargs:ILVarArgs,genarity) = - bb.EmitByte (callconvToByte genarity callconv); - if genarity > 0 then bb.EmitZ32 genarity; - bb.EmitZ32 ((args.Length + (match varargs with None -> 0 | Some l -> l.Length))); - EmitType cenv env bb ret; - args |> ILList.iter (EmitType cenv env bb); + bb.EmitByte (callconvToByte genarity callconv) + if genarity > 0 then bb.EmitZ32 genarity + bb.EmitZ32 ((args.Length + (match varargs with None -> 0 | Some l -> l.Length))) + EmitType cenv env bb ret + args |> ILList.iter (EmitType cenv env bb) match varargs with | None -> ()// no extra arg = no sentinel | Some tys -> if ILList.isEmpty tys then () // no extra arg = no sentinel else - bb.EmitByte et_SENTINEL; + bb.EmitByte et_SENTINEL ILList.iter (EmitType cenv env bb) tys and GetCallsigAsBytes cenv env x = emitBytesViaBuffer (fun bb -> EmitCallsig cenv env bb x) @@ -1300,41 +1300,41 @@ and EmitNativeType bb ty = let u1 = System.Text.Encoding.UTF8.GetBytes nativeTypeName let u2 = System.Text.Encoding.UTF8.GetBytes custMarshallerName let u3 = cookieString - bb.EmitByte nt_CUSTOMMARSHALER; - bb.EmitZ32 guid.Length; - bb.EmitBytes guid; - bb.EmitZ32 u1.Length; bb.EmitBytes u1; - bb.EmitZ32 u2.Length; bb.EmitBytes u2; + bb.EmitByte nt_CUSTOMMARSHALER + bb.EmitZ32 guid.Length + bb.EmitBytes guid + bb.EmitZ32 u1.Length; bb.EmitBytes u1 + bb.EmitZ32 u2.Length; bb.EmitBytes u2 bb.EmitZ32 u3.Length; bb.EmitBytes u3 | ILNativeType.FixedSysString i -> - bb.EmitByte nt_FIXEDSYSSTRING; + bb.EmitByte nt_FIXEDSYSSTRING bb.EmitZ32 i | ILNativeType.FixedArray i -> - bb.EmitByte nt_FIXEDARRAY; + bb.EmitByte nt_FIXEDARRAY bb.EmitZ32 i | (* COM interop *) ILNativeType.SafeArray (vt,name) -> - bb.EmitByte nt_SAFEARRAY; - bb.EmitZ32 (GetVariantTypeAsInt32 vt); + bb.EmitByte nt_SAFEARRAY + bb.EmitZ32 (GetVariantTypeAsInt32 vt) match name with | None -> () | Some n -> let u1 = Bytes.stringAsUtf8NullTerminated n bb.EmitZ32 (Array.length u1) ; bb.EmitBytes u1 | ILNativeType.Array (nt,sizeinfo) -> (* REVIEW: check if this corresponds to the ECMA spec *) - bb.EmitByte nt_ARRAY; + bb.EmitByte nt_ARRAY match nt with | None -> bb.EmitZ32 (int nt_MAX) | Some ntt -> (if ntt = ILNativeType.Empty then bb.EmitZ32 (int nt_MAX) else - EmitNativeType bb ntt); + EmitNativeType bb ntt) match sizeinfo with | None -> () // chunk out with zeroes because some tools (e.g. asmmeta) read these poorly and expect further elements. | Some (pnum,additive) -> // ParamNum - bb.EmitZ32 pnum; + bb.EmitZ32 pnum (* ElemMul *) (* z_u32 0x1l *) match additive with | None -> () @@ -1450,11 +1450,11 @@ let rec GetTypeDefAsRow cenv env _enc (td:ILTypeDef) = let tdorTag, tdorRow = GetTypeOptionAsTypeDefOrRef cenv env td.Extends UnsharedRow - [| ULong flags ; - nelem; - nselem; - TypeDefOrRefOrSpec (tdorTag, tdorRow); - SimpleIndex (TableNames.Field, cenv.fieldDefs.Count + 1); + [| ULong flags + nelem + nselem + TypeDefOrRefOrSpec (tdorTag, tdorRow) + SimpleIndex (TableNames.Field, cenv.fieldDefs.Count + 1) SimpleIndex (TableNames.Method,cenv.methodDefIdxsByKey.Count + 1) |] and GetTypeOptionAsTypeDefOrRef cenv env tyOpt = @@ -1464,12 +1464,12 @@ and GetTypeOptionAsTypeDefOrRef cenv env tyOpt = and GetTypeDefAsPropertyMapRow cenv tidx = UnsharedRow - [| SimpleIndex (TableNames.TypeDef, tidx); + [| SimpleIndex (TableNames.TypeDef, tidx) SimpleIndex (TableNames.Property, cenv.propertyDefs.Count + 1) |] and GetTypeDefAsEventMapRow cenv tidx = UnsharedRow - [| SimpleIndex (TableNames.TypeDef, tidx); + [| SimpleIndex (TableNames.TypeDef, tidx) SimpleIndex (TableNames.Event, cenv.eventDefs.Count + 1) |] and GetKeyForFieldDef tidx (fd: ILFieldDef) = @@ -1486,10 +1486,10 @@ and GenMethodDefPass2 cenv tidx md = cenv.methodDefIdxsByKey.AddUniqueEntry "method" (fun (key:MethodDefKey) -> - dprintn "Duplicate in method table is:"; - dprintn (" Type index: "+string key.TypeIdx); - dprintn (" Method name: "+key.Name); - dprintn (" Method arity (num generic params): "+string key.GenericArity); + dprintn "Duplicate in method table is:" + dprintn (" Type index: "+string key.TypeIdx) + dprintn (" Method name: "+key.Name) + dprintn (" Method arity (num generic params): "+string key.GenericArity) key.Name ) (GetKeyForMethodDef tidx md) @@ -1505,7 +1505,7 @@ and GenPropertyDefPass2 cenv tidx x = and GetTypeAsImplementsRow cenv env tidx ty = let tdorTag,tdorRow = GetTypeAsTypeDefOrRef cenv env ty UnsharedRow - [| SimpleIndex (TableNames.TypeDef, tidx); + [| SimpleIndex (TableNames.TypeDef, tidx) TypeDefOrRefOrSpec (tdorTag,tdorRow) |] and GenImplementsPass2 cenv env tidx ty = @@ -1522,33 +1522,33 @@ and GenTypeDefPass2 pidx enc cenv (td:ILTypeDef) = let env = envForTypeDef td let tidx = GetIdxForTypeDef cenv (TdKey(enc,td.Name)) let tidx2 = AddUnsharedRow cenv TableNames.TypeDef (GetTypeDefAsRow cenv env enc td) - if tidx <> tidx2 then failwith "index of typedef on second pass does not match index on first pass"; + if tidx <> tidx2 then failwith "index of typedef on second pass does not match index on first pass" // Add entries to auxiliary mapping tables, e.g. Nested, PropertyMap etc. // Note Nested is organised differntly to the others... if nonNil enc then AddUnsharedRow cenv TableNames.Nested (UnsharedRow - [| SimpleIndex (TableNames.TypeDef, tidx); - SimpleIndex (TableNames.TypeDef, pidx) |]) |> ignore; + [| SimpleIndex (TableNames.TypeDef, tidx) + SimpleIndex (TableNames.TypeDef, pidx) |]) |> ignore let props = td.Properties.AsList if nonNil props then - AddUnsharedRow cenv TableNames.PropertyMap (GetTypeDefAsPropertyMapRow cenv tidx) |> ignore; + AddUnsharedRow cenv TableNames.PropertyMap (GetTypeDefAsPropertyMapRow cenv tidx) |> ignore let events = td.Events.AsList if nonNil events then - AddUnsharedRow cenv TableNames.EventMap (GetTypeDefAsEventMapRow cenv tidx) |> ignore; + AddUnsharedRow cenv TableNames.EventMap (GetTypeDefAsEventMapRow cenv tidx) |> ignore // Now generate or assign index numbers for tables referenced by the maps. // Don't yet generate contents of these tables - leave that to pass3, as // code may need to embed these entries. - td.Implements |> ILList.iter (GenImplementsPass2 cenv env tidx); - props |> List.iter (GenPropertyDefPass2 cenv tidx); - events |> List.iter (GenEventDefPass2 cenv tidx); - td.Fields.AsList |> List.iter (GenFieldDefPass2 cenv tidx); - td.Methods |> Seq.iter (GenMethodDefPass2 cenv tidx); + td.Implements |> ILList.iter (GenImplementsPass2 cenv env tidx) + props |> List.iter (GenPropertyDefPass2 cenv tidx) + events |> List.iter (GenEventDefPass2 cenv tidx) + td.Fields.AsList |> List.iter (GenFieldDefPass2 cenv tidx) + td.Methods |> Seq.iter (GenMethodDefPass2 cenv tidx) td.NestedTypes.AsList |> GenTypeDefsPass2 tidx (enc@[td.Name]) cenv with e -> - failwith ("Error in pass2 for type "+td.Name+", error: "+e.Message); + failwith ("Error in pass2 for type "+td.Name+", error: "+e.Message) and GenTypeDefsPass2 pidx enc cenv tds = List.iter (GenTypeDefPass2 pidx enc cenv) tds @@ -1575,14 +1575,14 @@ let FindMethodDefIdx cenv mdkey = | Some x -> x | None -> raise MethodDefNotFound let (TdKey (tenc,tname)) = typeNameOfIdx mdkey.TypeIdx - dprintn ("The local method '"+(String.concat "." (tenc@[tname]))+"'::'"+mdkey.Name+"' was referenced but not declared"); - dprintn ("generic arity: "+string mdkey.GenericArity); + dprintn ("The local method '"+(String.concat "." (tenc@[tname]))+"'::'"+mdkey.Name+"' was referenced but not declared") + dprintn ("generic arity: "+string mdkey.GenericArity) cenv.methodDefIdxsByKey.dict |> Seq.iter (fun (KeyValue(mdkey2,_)) -> if mdkey2.TypeIdx = mdkey.TypeIdx && mdkey.Name = mdkey2.Name then let (TdKey (tenc2,tname2)) = typeNameOfIdx mdkey2.TypeIdx - dprintn ("A method in '"+(String.concat "." (tenc2@[tname2]))+"' had the right name but the wrong signature:"); - dprintn ("generic arity: "+string mdkey2.GenericArity) ; - dprintn (sprintf "mdkey2: %A" mdkey2)) ; + dprintn ("A method in '"+(String.concat "." (tenc2@[tname2]))+"' had the right name but the wrong signature:") + dprintn ("generic arity: "+string mdkey2.GenericArity) + dprintn (sprintf "mdkey2: %A" mdkey2)) raise MethodDefNotFound @@ -1592,7 +1592,7 @@ let rec GetMethodDefIdx cenv md = and FindFieldDefIdx cenv fdkey = try cenv.fieldDefs.GetTableEntry fdkey with :? KeyNotFoundException -> - errorR(InternalError("The local field "+fdkey.Name+" was referenced but not declared",range0)); + errorR(InternalError("The local field "+fdkey.Name+" was referenced but not declared",range0)) 1 and GetFieldDefAsFieldDefIdx cenv tidx fd = @@ -1609,12 +1609,12 @@ let GetMethodRefAsMethodDefIdx cenv (mref:ILMethodRef) = let tref = mref.EnclosingTypeRef try if not (isTypeRefLocal tref) then - failwithf "method referred to by method impl, event or property is not in a type defined in this module, method ref is %A" mref; + failwithf "method referred to by method impl, event or property is not in a type defined in this module, method ref is %A" mref let tidx = GetIdxForTypeDef cenv (TdKey(tref.Enclosing,tref.Name)) let mdkey = MethodDefKey (tidx,mref.GenericArity, mref.Name, mref.ReturnType, mref.ArgTypes, mref.CallingConv.IsStatic) FindMethodDefIdx cenv mdkey with e -> - failwithf "Error in GetMethodRefAsMethodDefIdx for mref = %A, error: %s" (mref.Name, tref.Name) e.Message; + failwithf "Error in GetMethodRefAsMethodDefIdx for mref = %A, error: %s" (mref.Name, tref.Name) e.Message let rec MethodRefInfoAsMemberRefRow cenv env fenv (nm,typ,callconv,args,ret,varargs,genarity) = MemberRefRow(GetTypeAsMemberRefParent cenv env typ, @@ -1631,7 +1631,7 @@ let GetMethodRefInfoAsMemberRefIdx cenv env ((_,typ,_,_,_,_,_) as minfo) = let GetMethodRefInfoAsMethodRefOrDef isAlwaysMethodDef cenv env ((nm,typ:ILType,cc,args,ret,varargs,genarity) as minfo) = if isNone varargs && (isAlwaysMethodDef || isTypeLocal typ) then - if not typ.IsNominal then failwith "GetMethodRefInfoAsMethodRefOrDef: unexpected local tref-typ"; + if not typ.IsNominal then failwith "GetMethodRefInfoAsMethodRefOrDef: unexpected local tref-typ" try (mdor_MethodDef, GetMethodRefAsMethodDefIdx cenv (mkILMethRefRaw(typ.TypeRef, cc, nm, genarity, args,ret))) with MethodDefNotFound -> (mdor_MemberRef, GetMethodRefInfoAsMemberRefIdx cenv env minfo) else (mdor_MemberRef, GetMethodRefInfoAsMemberRefIdx cenv env minfo) @@ -1645,12 +1645,12 @@ let rec GetMethodSpecInfoAsMethodSpecIdx cenv env (nm,typ,cc,args,ret,varargs,mi let mdorTag,mdorRow = GetMethodRefInfoAsMethodRefOrDef false cenv env (nm,typ,cc,args,ret,varargs,minst.Length) let blob = emitBytesViaBuffer (fun bb -> - bb.EmitByte e_IMAGE_CEE_CS_CALLCONV_GENERICINST; - bb.EmitZ32 minst.Length; + bb.EmitByte e_IMAGE_CEE_CS_CALLCONV_GENERICINST + bb.EmitZ32 minst.Length minst |> ILList.iter (EmitType cenv env bb)) FindOrAddRow cenv TableNames.MethodSpec (SimpleSharedRow - [| MethodDefOrRef (mdorTag,mdorRow); + [| MethodDefOrRef (mdorTag,mdorRow) Blob (GetBytesAsBlobIdx cenv blob) |]) and GetMethodDefOrRefAsUncodedToken (tag,idx) = @@ -1709,7 +1709,7 @@ let rec GetOverridesSpecAsMemberRefIdx cenv env ospec = and GetOverridesSpecAsMethodDefOrRef cenv env (ospec:ILOverridesSpec) = let typ = ospec.EnclosingType if isTypeLocal typ then - if not typ.IsNominal then failwith "GetOverridesSpecAsMethodDefOrRef: unexpected local tref-typ"; + if not typ.IsNominal then failwith "GetOverridesSpecAsMethodDefOrRef: unexpected local tref-typ" try (mdor_MethodDef, GetMethodRefAsMethodDefIdx cenv ospec.MethodRef) with MethodDefNotFound -> (mdor_MemberRef, GetOverridesSpecAsMemberRefIdx cenv env ospec) else @@ -1752,9 +1752,9 @@ let rec GetCustomAttrDataAsBlobIdx cenv (data:byte[]) = and GetCustomAttrRow cenv hca attr = let cat = GetMethodRefAsCustomAttribType cenv attr.Method.MethodRef UnsharedRow - [| HasCustomAttribute (fst hca, snd hca); - CustomAttributeType (fst cat, snd cat); - Blob (GetCustomAttrDataAsBlobIdx cenv attr.Data); |] + [| HasCustomAttribute (fst hca, snd hca) + CustomAttributeType (fst cat, snd cat) + Blob (GetCustomAttrDataAsBlobIdx cenv attr.Data) |] and GenCustomAttrPass3Or4 cenv hca attr = AddUnsharedRow cenv TableNames.CustomAttribute (GetCustomAttrRow cenv hca attr) |> ignore @@ -1768,9 +1768,9 @@ and GenCustomAttrsPass3Or4 cenv hca (attrs: ILAttributes) = let rec GetSecurityDeclRow cenv hds (PermissionSet (action, s)) = UnsharedRow - [| UShort (uint16 (List.assoc action (Lazy.force ILSecurityActionMap))); - HasDeclSecurity (fst hds, snd hds); - Blob (GetBytesAsBlobIdx cenv s); |] + [| UShort (uint16 (List.assoc action (Lazy.force ILSecurityActionMap))) + HasDeclSecurity (fst hds, snd hds) + Blob (GetBytesAsBlobIdx cenv s) |] and GenSecurityDeclPass3 cenv hds attr = AddUnsharedRow cenv TableNames.Permission (GetSecurityDeclRow cenv hds attr) |> ignore @@ -1793,7 +1793,7 @@ and GetFieldSpecAsMemberRefIdx cenv env fspec = // REVIEW: write into an accumuating buffer and EmitFieldSpecSig cenv env (bb: ByteBuffer) (fspec:ILFieldSpec) = - bb.EmitByte e_IMAGE_CEE_CS_CALLCONV_FIELD; + bb.EmitByte e_IMAGE_CEE_CS_CALLCONV_FIELD EmitType cenv env bb fspec.FormalType and GetFieldSpecSigAsBytes cenv env x = @@ -1805,7 +1805,7 @@ and GetFieldSpecSigAsBlobIdx cenv env x = and GetFieldSpecAsFieldDefOrRef cenv env (fspec:ILFieldSpec) = let typ = fspec.EnclosingType if isTypeLocal typ then - if not typ.IsNominal then failwith "GetFieldSpecAsFieldDefOrRef: unexpected local tref-typ"; + if not typ.IsNominal then failwith "GetFieldSpecAsFieldDefOrRef: unexpected local tref-typ" let tref = typ.TypeRef let tidx = GetIdxForTypeDef cenv (TdKey(tref.Enclosing,tref.Name)) let fdkey = FieldDefKey (tidx,fspec.Name, fspec.FormalType) @@ -1838,8 +1838,8 @@ let GetCallsigAsStandAloneSigIdx cenv env info = // -------------------------------------------------------------------- let EmitLocalSig cenv env (bb: ByteBuffer) (locals: ILLocals) = - bb.EmitByte e_IMAGE_CEE_CS_CALLCONV_LOCAL_SIG; - bb.EmitZ32 locals.Length; + bb.EmitByte e_IMAGE_CEE_CS_CALLCONV_LOCAL_SIG + bb.EmitZ32 locals.Length locals |> ILList.iter (fun l -> EmitType cenv env bb l.Type) let GetLocalSigAsBlobHeapIdx cenv env locals = @@ -1867,21 +1867,21 @@ type CodeBuffer = // - locations of embedded handles into the string table // - the exception table // -------------------------------------------------------------------- - { code: ByteBuffer; + { code: ByteBuffer /// (instruction; optional short form); start of instr in code buffer; code loc for the end of the instruction the fixup resides in ; where is the destination of the fixup - mutable reqdBrFixups: ((int * int option) * int * ILCodeLabel list) list; - availBrFixups: Dictionary ; + mutable reqdBrFixups: ((int * int option) * int * ILCodeLabel list) list + availBrFixups: Dictionary /// code loc to fixup in code buffer - mutable reqdStringFixupsInMethod: (int * int) list; + mutable reqdStringFixupsInMethod: (int * int) list /// data for exception handling clauses - mutable seh: ExceptionClauseSpec list; - seqpoints: ResizeArray; } + mutable seh: ExceptionClauseSpec list + seqpoints: ResizeArray } static member Create _nm = - { seh = []; - code= ByteBuffer.Create 200; - reqdBrFixups=[]; - reqdStringFixupsInMethod=[]; + { seh = [] + code= ByteBuffer.Create 200 + reqdBrFixups=[] + reqdStringFixupsInMethod=[] availBrFixups = Dictionary<_,_>(10, HashIdentity.Structural) seqpoints = new ResizeArray<_>(10) } @@ -1893,12 +1893,12 @@ type CodeBuffer = // table indexes are 1-based, document array indexes are 0-based let doc = (cenv.documents.FindOrAddSharedEntry m.Document) - 1 codebuf.seqpoints.Add - { Document=doc; - Offset= codebuf.code.Position; - Line=m.Line; - Column=m.Column; - EndLine=m.EndLine; - EndColumn=m.EndColumn; } + { Document=doc + Offset= codebuf.code.Position + Line=m.Line + Column=m.Column + EndLine=m.EndLine + EndColumn=m.EndColumn } member codebuf.EmitByte x = codebuf.code.EmitIntAsByte x member codebuf.EmitUInt16 x = codebuf.code.EmitUInt16 x @@ -1908,17 +1908,17 @@ type CodeBuffer = member codebuf.EmitUncodedToken u = codebuf.EmitInt32 u member codebuf.RecordReqdStringFixup stringidx = - codebuf.reqdStringFixupsInMethod <- (codebuf.code.Position, stringidx) :: codebuf.reqdStringFixupsInMethod; + codebuf.reqdStringFixupsInMethod <- (codebuf.code.Position, stringidx) :: codebuf.reqdStringFixupsInMethod // Write a special value in that we check later when applying the fixup codebuf.EmitInt32 0xdeadbeef member codebuf.RecordReqdBrFixups i tgs = - codebuf.reqdBrFixups <- (i, codebuf.code.Position, tgs) :: codebuf.reqdBrFixups; + codebuf.reqdBrFixups <- (i, codebuf.code.Position, tgs) :: codebuf.reqdBrFixups // Write a special value in that we check later when applying the fixup // Value is 0x11 {deadbbbb}* where 11 is for the instruction and deadbbbb is for each target - codebuf.EmitByte 0x11; // for the instruction + codebuf.EmitByte 0x11 // for the instruction (if fst i = i_switch then - codebuf.EmitInt32 tgs.Length); + codebuf.EmitInt32 tgs.Length) List.iter (fun _ -> codebuf.EmitInt32 0xdeadbbbb) tgs member codebuf.RecordReqdBrFixup i tg = codebuf.RecordReqdBrFixups i [tg] @@ -1973,25 +1973,25 @@ module Codebuf = begin // Copy over a chunk of non-branching code let nobranch_len = origEndOfNoBranchBlock - origStartOfNoBranchBlock - newCode.EmitBytes origCode.[origStartOfNoBranchBlock..origStartOfNoBranchBlock+nobranch_len-1]; + newCode.EmitBytes origCode.[origStartOfNoBranchBlock..origStartOfNoBranchBlock+nobranch_len-1] // Record how to adjust addresses in this range, including the branch instruction // we write below, or the end of the method if we're doing the last bblock - adjustments := (origStartOfNoBranchBlock,origEndOfNoBranchBlock,newStartOfNoBranchBlock) :: !adjustments; + adjustments := (origStartOfNoBranchBlock,origEndOfNoBranchBlock,newStartOfNoBranchBlock) :: !adjustments // Increment locations to the branch instruction we're really interested in - origWhere := origEndOfNoBranchBlock; - newWhere := !newWhere + nobranch_len; + origWhere := origEndOfNoBranchBlock + newWhere := !newWhere + nobranch_len // Now do the branch instruction. Decide whether the fixup will be short or long in the new code if doingLast then doneLast := true else let (i,origStartOfInstr,tgs:ILCodeLabel list) = List.head !remainingReqdFixups - remainingReqdFixups := List.tail !remainingReqdFixups; - if origCode.[origStartOfInstr] <> 0x11uy then failwith "br fixup sanity check failed (1)"; + remainingReqdFixups := List.tail !remainingReqdFixups + if origCode.[origStartOfInstr] <> 0x11uy then failwith "br fixup sanity check failed (1)" let i_length = if fst i = i_switch then 5 else 1 - origWhere := !origWhere + i_length; + origWhere := !origWhere + i_length let origEndOfInstr = origStartOfInstr + i_length + 4 * tgs.Length let newEndOfInstrIfSmall = !newWhere + i_length + 1 @@ -2005,7 +2005,7 @@ module Codebuf = begin // Use the original offsets to compute if the branch is small or large. This is // a safe approximation because code only gets smaller. if not (origAvailBrFixups.ContainsKey tg) then - dprintn ("branch target " + formatCodeLabel tg + " not found in code"); + dprintn ("branch target " + formatCodeLabel tg + " not found in code") let origDest = if origAvailBrFixups.ContainsKey tg then origAvailBrFixups.[tg] else 666666 @@ -2013,33 +2013,33 @@ module Codebuf = begin -128 <= origRelOffset && origRelOffset <= 127 end -> - newCode.EmitIntAsByte i_short; + newCode.EmitIntAsByte i_short true | (i_long,_),_ -> - newCode.EmitIntAsByte i_long; + newCode.EmitIntAsByte i_long (if i_long = i_switch then - newCode.EmitInt32 tgs.Length); + newCode.EmitInt32 tgs.Length) false - newWhere := !newWhere + i_length; - if !newWhere <> newCode.Position then dprintn "mismatch between newWhere and newCode"; + newWhere := !newWhere + i_length + if !newWhere <> newCode.Position then dprintn "mismatch between newWhere and newCode" tgs |> List.iter (fun tg -> let origFixupLoc = !origWhere - checkFixup32 origCode origFixupLoc 0xdeadbbbb; + checkFixup32 origCode origFixupLoc 0xdeadbbbb if short then - newReqdBrFixups := (!newWhere, newEndOfInstrIfSmall, tg, true) :: !newReqdBrFixups; - newCode.EmitIntAsByte 0x98; (* sanity check *) - newWhere := !newWhere + 1; + newReqdBrFixups := (!newWhere, newEndOfInstrIfSmall, tg, true) :: !newReqdBrFixups + newCode.EmitIntAsByte 0x98 (* sanity check *) + newWhere := !newWhere + 1 else - newReqdBrFixups := (!newWhere, newEndOfInstrIfBig, tg, false) :: !newReqdBrFixups; - newCode.EmitInt32 0xf00dd00f; (* sanity check *) - newWhere := !newWhere + 4; - if !newWhere <> newCode.Position then dprintn "mismatch between newWhere and newCode"; - origWhere := !origWhere + 4); + newReqdBrFixups := (!newWhere, newEndOfInstrIfBig, tg, false) :: !newReqdBrFixups + newCode.EmitInt32 0xf00dd00f (* sanity check *) + newWhere := !newWhere + 4 + if !newWhere <> newCode.Position then dprintn "mismatch between newWhere and newCode" + origWhere := !origWhere + 4) - if !origWhere <> origEndOfInstr then dprintn "mismatch between origWhere and origEndOfInstr"; + if !origWhere <> origEndOfInstr then dprintn "mismatch between origWhere and origEndOfInstr" let adjuster = let arr = Array.ofList (List.rev !adjustments) @@ -2074,25 +2074,25 @@ module Codebuf = begin let newScopes = let rec remap scope = - {scope with StartOffset = adjuster scope.StartOffset; - EndOffset = adjuster scope.EndOffset; + {scope with StartOffset = adjuster scope.StartOffset + EndOffset = adjuster scope.EndOffset Children = Array.map remap scope.Children } List.map remap origScopes // Now apply the adjusted fixups in the new code newReqdBrFixups |> List.iter (fun (newFixupLoc,endOfInstr,tg, small) -> if not (newAvailBrFixups.ContainsKey tg) then - failwith ("target "+formatCodeLabel tg+" not found in new fixups"); + failwith ("target "+formatCodeLabel tg+" not found in new fixups") try let n = newAvailBrFixups.[tg] let relOffset = (n - endOfInstr) if small then - if Bytes.get newCode newFixupLoc <> 0x98 then failwith "br fixupsanity check failed"; - newCode.[newFixupLoc] <- b0 relOffset; + if Bytes.get newCode newFixupLoc <> 0x98 then failwith "br fixupsanity check failed" + newCode.[newFixupLoc] <- b0 relOffset else - checkFixup32 newCode newFixupLoc 0xf00dd00fl; + checkFixup32 newCode newFixupLoc 0xf00dd00fl applyFixup32 newCode newFixupLoc relOffset - with :? KeyNotFoundException -> ()); + with :? KeyNotFoundException -> ()) newCode, newReqdStringFixups, newExnClauses, newSeqPoints, newScopes @@ -2129,44 +2129,44 @@ module Codebuf = begin /// Emit the code for an instruction let emitInstrCode (codebuf: CodeBuffer) i = if i > 0xFF then - assert (i >>> 8 = 0xFE); - codebuf.EmitByte ((i >>> 8) &&& 0xFF); - codebuf.EmitByte (i &&& 0xFF); + assert (i >>> 8 = 0xFE) + codebuf.EmitByte ((i >>> 8) &&& 0xFF) + codebuf.EmitByte (i &&& 0xFF) else codebuf.EmitByte i let emitTypeInstr cenv codebuf env i ty = - emitInstrCode codebuf i; + emitInstrCode codebuf i codebuf.EmitUncodedToken (getTypeDefOrRefAsUncodedToken (GetTypeAsTypeDefOrRef cenv env ty)) let emitMethodSpecInfoInstr cenv codebuf env i mspecinfo = - emitInstrCode codebuf i; + emitInstrCode codebuf i codebuf.EmitUncodedToken (GetMethodSpecInfoAsUncodedToken cenv env mspecinfo) let emitMethodSpecInstr cenv codebuf env i mspec = - emitInstrCode codebuf i; + emitInstrCode codebuf i codebuf.EmitUncodedToken (GetMethodSpecAsUncodedToken cenv env mspec) let emitFieldSpecInstr cenv codebuf env i fspec = - emitInstrCode codebuf i; + emitInstrCode codebuf i codebuf.EmitUncodedToken (GetFieldDefOrRefAsUncodedToken (GetFieldSpecAsFieldDefOrRef cenv env fspec)) let emitShortUInt16Instr codebuf (i_short,i) x = let n = int32 x if n <= 255 then - emitInstrCode codebuf i_short; - codebuf.EmitByte n; + emitInstrCode codebuf i_short + codebuf.EmitByte n else - emitInstrCode codebuf i; - codebuf.EmitUInt16 x; + emitInstrCode codebuf i + codebuf.EmitUInt16 x let emitShortInt32Instr codebuf (i_short,i) x = if x >= (-128) && x <= 127 then - emitInstrCode codebuf i_short; - codebuf.EmitByte (if x < 0x0 then x + 256 else x); + emitInstrCode codebuf i_short + codebuf.EmitByte (if x < 0x0 then x + 256 else x) else - emitInstrCode codebuf i; - codebuf.EmitInt32 x; + emitInstrCode codebuf i + codebuf.EmitInt32 x let emitTailness (cenv: cenv) codebuf tl = if tl = Tailcall && cenv.emitTailcalls then emitInstrCode codebuf i_tail @@ -2178,7 +2178,7 @@ module Codebuf = begin if tl = Volatile then emitInstrCode codebuf i_volatile let emitConstrained cenv codebuf env ty = - emitInstrCode codebuf i_constrained; + emitInstrCode codebuf i_constrained codebuf.EmitUncodedToken (getTypeDefOrRefAsUncodedToken (GetTypeAsTypeDefOrRef cenv env ty)) let emitAlignment codebuf tl = @@ -2198,17 +2198,17 @@ module Codebuf = begin | I_seqpoint s -> codebuf.EmitSeqPoint cenv s | I_leave tg -> codebuf.RecordReqdBrFixup (i_leave,Some i_leave_s) tg | I_call (tl,mspec,varargs) -> - emitTailness cenv codebuf tl; - emitMethodSpecInstr cenv codebuf env i_call (mspec,varargs); + emitTailness cenv codebuf tl + emitMethodSpecInstr cenv codebuf env i_call (mspec,varargs) emitAfterTailcall codebuf tl | I_callvirt (tl,mspec,varargs) -> - emitTailness cenv codebuf tl; - emitMethodSpecInstr cenv codebuf env i_callvirt (mspec,varargs); + emitTailness cenv codebuf tl + emitMethodSpecInstr cenv codebuf env i_callvirt (mspec,varargs) emitAfterTailcall codebuf tl | I_callconstraint (tl,ty,mspec,varargs) -> - emitTailness cenv codebuf tl; - emitConstrained cenv codebuf env ty; - emitMethodSpecInstr cenv codebuf env i_callvirt (mspec,varargs); + emitTailness cenv codebuf tl + emitConstrained cenv codebuf env ty + emitMethodSpecInstr cenv codebuf env i_callvirt (mspec,varargs) emitAfterTailcall codebuf tl | I_newobj (mspec,varargs) -> emitMethodSpecInstr cenv codebuf env i_newobj (mspec,varargs) @@ -2218,9 +2218,9 @@ module Codebuf = begin emitMethodSpecInstr cenv codebuf env i_ldvirtftn (mspec,None) | I_calli (tl,callsig,varargs) -> - emitTailness cenv codebuf tl; - emitInstrCode codebuf i_calli; - codebuf.EmitUncodedToken (getUncodedToken TableNames.StandAloneSig (GetCallsigAsStandAloneSigIdx cenv env (callsig,varargs))); + emitTailness cenv codebuf tl + emitInstrCode codebuf i_calli + codebuf.EmitUncodedToken (getUncodedToken TableNames.StandAloneSig (GetCallsigAsStandAloneSigIdx cenv env (callsig,varargs))) emitAfterTailcall codebuf tl | I_ldarg u16 -> emitShortUInt16Instr codebuf (i_ldarg_s,i_ldarg) u16 @@ -2231,29 +2231,29 @@ module Codebuf = begin | I_ldloca u16 -> emitShortUInt16Instr codebuf (i_ldloca_s,i_ldloca) u16 | I_cpblk (al,vol) -> - emitAlignment codebuf al; - emitVolatility codebuf vol; + emitAlignment codebuf al + emitVolatility codebuf vol emitInstrCode codebuf i_cpblk | I_initblk (al,vol) -> - emitAlignment codebuf al; - emitVolatility codebuf vol; + emitAlignment codebuf al + emitVolatility codebuf vol emitInstrCode codebuf i_initblk | (AI_ldc (DT_I4, ILConst.I4 x)) -> emitShortInt32Instr codebuf (i_ldc_i4_s,i_ldc_i4) x | (AI_ldc (DT_I8, ILConst.I8 x)) -> - emitInstrCode codebuf i_ldc_i8; - codebuf.EmitInt64 x; + emitInstrCode codebuf i_ldc_i8 + codebuf.EmitInt64 x | (AI_ldc (_, ILConst.R4 x)) -> - emitInstrCode codebuf i_ldc_r4; + emitInstrCode codebuf i_ldc_r4 codebuf.EmitInt32 (bitsOfSingle x) | (AI_ldc (_, ILConst.R8 x)) -> - emitInstrCode codebuf i_ldc_r8; + emitInstrCode codebuf i_ldc_r8 codebuf.EmitInt64 (bitsOfDouble x) | I_ldind (al,vol,dt) -> - emitAlignment codebuf al; - emitVolatility codebuf vol; + emitAlignment codebuf al + emitVolatility codebuf vol emitInstrCode codebuf (match dt with | DT_I -> i_ldind_i @@ -2299,8 +2299,8 @@ module Codebuf = begin | _ -> failwith "ldelem") | I_stind (al,vol,dt) -> - emitAlignment codebuf al; - emitVolatility codebuf vol; + emitAlignment codebuf al + emitVolatility codebuf vol emitInstrCode codebuf (match dt with | DT_U | DT_I -> i_stind_i @@ -2316,26 +2316,26 @@ module Codebuf = begin | I_switch (labs,_) -> codebuf.RecordReqdBrFixups (i_switch,None) labs | I_ldfld (al,vol,fspec) -> - emitAlignment codebuf al; - emitVolatility codebuf vol; + emitAlignment codebuf al + emitVolatility codebuf vol emitFieldSpecInstr cenv codebuf env i_ldfld fspec | I_ldflda fspec -> emitFieldSpecInstr cenv codebuf env i_ldflda fspec | I_ldsfld (vol,fspec) -> - emitVolatility codebuf vol; + emitVolatility codebuf vol emitFieldSpecInstr cenv codebuf env i_ldsfld fspec | I_ldsflda fspec -> emitFieldSpecInstr cenv codebuf env i_ldsflda fspec | I_stfld (al,vol,fspec) -> - emitAlignment codebuf al; - emitVolatility codebuf vol; + emitAlignment codebuf al + emitVolatility codebuf vol emitFieldSpecInstr cenv codebuf env i_stfld fspec | I_stsfld (vol,fspec) -> - emitVolatility codebuf vol; + emitVolatility codebuf vol emitFieldSpecInstr cenv codebuf env i_stsfld fspec | I_ldtoken tok -> - emitInstrCode codebuf i_ldtoken; + emitInstrCode codebuf i_ldtoken codebuf.EmitUncodedToken (match tok with | ILToken.ILType typ -> @@ -2355,7 +2355,7 @@ module Codebuf = begin | (true,idx) -> getUncodedToken TableNames.Field idx | (false,idx) -> getUncodedToken TableNames.MemberRef idx) | I_ldstr s -> - emitInstrCode codebuf i_ldstr; + emitInstrCode codebuf i_ldstr codebuf.RecordReqdStringFixup (GetUserStringHeapIdx cenv s) | I_box ty -> emitTypeInstr cenv codebuf env i_box ty @@ -2385,7 +2385,7 @@ module Codebuf = begin | I_ldelema (ro,_isNativePtr,shape,ty) -> if (ro = ReadonlyAddress) then - emitInstrCode codebuf i_readonly; + emitInstrCode codebuf i_readonly if (shape = ILArrayShape.SingleDimensional) then emitTypeInstr cenv codebuf env i_ldelema ty else @@ -2398,17 +2398,17 @@ module Codebuf = begin | I_mkrefany ty -> emitTypeInstr cenv codebuf env i_mkrefany ty | I_initobj ty -> emitTypeInstr cenv codebuf env i_initobj ty | I_ldobj (al,vol,ty) -> - emitAlignment codebuf al; - emitVolatility codebuf vol; + emitAlignment codebuf al + emitVolatility codebuf vol emitTypeInstr cenv codebuf env i_ldobj ty | I_stobj (al,vol,ty) -> - emitAlignment codebuf al; - emitVolatility codebuf vol; + emitAlignment codebuf al + emitVolatility codebuf vol emitTypeInstr cenv codebuf env i_stobj ty | I_cpobj ty -> emitTypeInstr cenv codebuf env i_cpobj ty | I_sizeof ty -> emitTypeInstr cenv codebuf env i_sizeof ty | EI_ldlen_multi (_,m) -> - emitShortInt32Instr codebuf (i_ldc_i4_s,i_ldc_i4) m; + emitShortInt32Instr codebuf (i_ldc_i4_s,i_ldc_i4) m emitInstr cenv codebuf env (mkNormalCall(mkILNonGenericMethSpecInTy(cenv.ilg.typ_Array, ILCallingConv.Instance, "GetLength", [(cenv.ilg.typ_int32)], (cenv.ilg.typ_int32)))) | _ -> failwith "an IL instruction cannot be emitted" @@ -2417,31 +2417,31 @@ module Codebuf = begin let mkScopeNode cenv (localSigs: _[]) (a,b,ls,ch) = if (isNil ls || not cenv.generatePdb) then ch else - [ { Children= Array.ofList ch; - StartOffset=a; - EndOffset=b; + [ { Children= Array.ofList ch + StartOffset=a + EndOffset=b Locals= Array.ofList (List.map - (fun x -> { Name=x.LocalName; - Signature= (try localSigs.[x.LocalIndex] with _ -> failwith ("local variable index "+string x.LocalIndex+"in debug info does not reference a valid local")); + (fun x -> { Name=x.LocalName + Signature= (try localSigs.[x.LocalIndex] with _ -> failwith ("local variable index "+string x.LocalIndex+"in debug info does not reference a valid local")) Index= x.LocalIndex } ) (List.filter (fun v -> v.LocalName <> "") ls)) } ] let rec emitCode cenv localSigs codebuf env (susp,code) = match code with | TryBlock (c,seh) -> - commitSusp codebuf susp (uniqueEntryOfCode c); + commitSusp codebuf susp (uniqueEntryOfCode c) let tryStart = codebuf.code.Position let susp,child1,scope1 = emitCode cenv localSigs codebuf env (None,c) - commitSuspNoDest codebuf susp; + commitSuspNoDest codebuf susp let tryFinish = codebuf.code.Position let exnBranches = match seh with | FaultBlock flt -> let handlerStart = codebuf.code.Position let susp,child2,scope2 = emitCode cenv localSigs codebuf env (None,flt) - commitSuspNoDest codebuf susp; + commitSuspNoDest codebuf susp let handlerFinish = codebuf.code.Position [ Some (tryStart,(tryFinish - tryStart), handlerStart,(handlerFinish - handlerStart), @@ -2451,7 +2451,7 @@ module Codebuf = begin | FinallyBlock flt -> let handlerStart = codebuf.code.Position let susp,child2,scope2 = emitCode cenv localSigs codebuf env (None,flt) - commitSuspNoDest codebuf susp; + commitSuspNoDest codebuf susp let handlerFinish = codebuf.code.Position [ Some (tryStart,(tryFinish - tryStart), handlerStart,(handlerFinish - handlerStart), @@ -2464,7 +2464,7 @@ module Codebuf = begin | TypeFilter typ -> let handlerStart = codebuf.code.Position let susp,child2,scope2 = emitCode cenv localSigs codebuf env (None,ctch) - commitSuspNoDest codebuf susp; + commitSuspNoDest codebuf susp let handlerFinish = codebuf.code.Position Some (tryStart,(tryFinish - tryStart), handlerStart,(handlerFinish - handlerStart), @@ -2474,10 +2474,10 @@ module Codebuf = begin let filterStart = codebuf.code.Position let susp,child2,scope2 = emitCode cenv localSigs codebuf env (None,fltcode) - commitSuspNoDest codebuf susp; + commitSuspNoDest codebuf susp let handlerStart = codebuf.code.Position let susp,child3,scope3 = emitCode cenv localSigs codebuf env (None,ctch) - commitSuspNoDest codebuf susp; + commitSuspNoDest codebuf susp let handlerFinish = codebuf.code.Position Some (tryStart, @@ -2506,8 +2506,8 @@ module Codebuf = begin let childScopes = ref [] // Push the results of collecting one sub-block into the reference cells let collect (susp,seh,scopes) = - newSusp := susp; - childSEH := seh :: !childSEH; + newSusp := susp + childSEH := seh :: !childSEH childScopes := scopes :: !childScopes // Close the collection by generating the (susp,node,scope-node) triple let close () = @@ -2520,12 +2520,12 @@ module Codebuf = begin | [c] -> // emitCodeLinear sequence of nested blocks emitCodeLinear (!newSusp,c) (fun results -> - collect results; + collect results cont (close())) | codes -> // Multiple blocks: leave the linear sequence and process each seperately - codes |> List.iter (fun c -> collect (emitCode cenv localSigs codebuf env (!newSusp,c))); + codes |> List.iter (fun c -> collect (emitCode cenv localSigs codebuf env (!newSusp,c))) cont(close()) | c -> // leave the linear sequence @@ -2536,11 +2536,11 @@ module Codebuf = begin | ILBasicBlock bb -> // Leaf case: one basic block - commitSusp codebuf susp bb.Label; - codebuf.RecordAvailBrFixup bb.Label; + commitSusp codebuf susp bb.Label + codebuf.RecordAvailBrFixup bb.Label let instrs = bb.Instructions for i = 0 to instrs.Length - 1 do - emitInstr cenv codebuf env instrs.[i]; + emitInstr cenv codebuf env instrs.[i] bb.Fallthrough, Tip, [] and brToSusp (codebuf: CodeBuffer) dest = codebuf.RecordReqdBrFixup (i_br,Some i_br_s) dest @@ -2562,7 +2562,7 @@ module Codebuf = begin | Node clauses -> List.iter (emitExceptionHandlerTree2 codebuf) clauses and emitExceptionHandlerTree2 (codebuf: CodeBuffer) (x,childSEH) = - List.iter (emitExceptionHandlerTree codebuf) childSEH; // internal first + List.iter (emitExceptionHandlerTree codebuf) childSEH // internal first match x with | None -> () | Some clause -> codebuf.EmitExceptionClause clause @@ -2571,8 +2571,8 @@ module Codebuf = begin let codebuf = CodeBuffer.Create nm let finalSusp, SEHTree, origScopes = emitCode cenv localSigs codebuf env (Some (uniqueEntryOfCode code),code) - (match finalSusp with Some dest -> brToSusp codebuf dest | _ -> ()); - emitExceptionHandlerTree codebuf SEHTree; + (match finalSusp with Some dest -> brToSusp codebuf dest | _ -> ()) + emitExceptionHandlerTree codebuf SEHTree let origCode = codebuf.code.Close() let origExnClauses = List.rev codebuf.seh let origReqdStringFixups = codebuf.reqdStringFixupsInMethod @@ -2584,10 +2584,10 @@ module Codebuf = begin applyBrFixups origCode origExnClauses origReqdStringFixups origAvailBrFixups origReqdBrFixups origSeqPoints origScopes let rootScope = - { Children= Array.ofList newScopes; - StartOffset=0; - EndOffset=newCode.Length; - Locals=[| |]; } + { Children= Array.ofList newScopes + StartOffset=0 + EndOffset=newCode.Length + Locals=[| |] } (newReqdStringFixups,newExnClauses, newCode, newSeqPoints, rootScope) @@ -2597,7 +2597,7 @@ end // ILMethodBody --> bytes // -------------------------------------------------------------------- let GetFieldDefTypeAsBlobIdx cenv env ty = - let bytes = emitBytesViaBuffer (fun bb -> bb.EmitByte e_IMAGE_CEE_CS_CALLCONV_FIELD; + let bytes = emitBytesViaBuffer (fun bb -> bb.EmitByte e_IMAGE_CEE_CS_CALLCONV_FIELD EmitType cenv env bb ty) GetBytesAsBlobIdx cenv bytes @@ -2606,7 +2606,7 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = if cenv.generatePdb then il.Locals |> ILList.toArray |> Array.map (fun l -> // Write a fake entry for the local signature headed by e_IMAGE_CEE_CS_CALLCONV_FIELD. This is referenced by the PDB file - ignore (FindOrAddRow cenv TableNames.StandAloneSig (SimpleSharedRow [| Blob (GetFieldDefTypeAsBlobIdx cenv env l.Type) |])); + ignore (FindOrAddRow cenv TableNames.StandAloneSig (SimpleSharedRow [| Blob (GetFieldDefTypeAsBlobIdx cenv env l.Type) |])) // Now write the type GetTypeAsBytes cenv env l.Type) else @@ -2621,9 +2621,9 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = let alignedCodeSize = align 4 (codeSize + 1) let codePadding = (alignedCodeSize - (codeSize + 1)) let requiredStringFixups' = (1,requiredStringFixups) - methbuf.EmitByte (byte codeSize <<< 2 ||| e_CorILMethod_TinyFormat); - methbuf.EmitBytes code; - methbuf.EmitPadding codePadding; + methbuf.EmitByte (byte codeSize <<< 2 ||| e_CorILMethod_TinyFormat) + methbuf.EmitBytes code + methbuf.EmitPadding codePadding (requiredStringFixups', methbuf.Close()), seqpoints, scopes else // Use Fat format @@ -2640,13 +2640,13 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = let alignedCodeSize = align 0x4 codeSize let codePadding = (alignedCodeSize - codeSize) - methbuf.EmitByte flags; - methbuf.EmitByte 0x30uy; // last four bits record size of fat header in 4 byte chunks - this is always 12 bytes = 3 four word chunks - methbuf.EmitUInt16 (uint16 il.MaxStack); - methbuf.EmitInt32 codeSize; - methbuf.EmitInt32 localToken; - methbuf.EmitBytes code; - methbuf.EmitPadding codePadding; + methbuf.EmitByte flags + methbuf.EmitByte 0x30uy // last four bits record size of fat header in 4 byte chunks - this is always 12 bytes = 3 four word chunks + methbuf.EmitUInt16 (uint16 il.MaxStack) + methbuf.EmitInt32 codeSize + methbuf.EmitInt32 localToken + methbuf.EmitBytes code + methbuf.EmitPadding codePadding if nonNil seh then // Can we use the small exception handling table format? @@ -2669,31 +2669,31 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) = | TypeFilterClause uncoded -> uncoded if canUseSmall then - methbuf.EmitByte e_CorILMethod_Sect_EHTable; - methbuf.EmitByte (b0 smallSize); - methbuf.EmitByte 0x00uy; - methbuf.EmitByte 0x00uy; + methbuf.EmitByte e_CorILMethod_Sect_EHTable + methbuf.EmitByte (b0 smallSize) + methbuf.EmitByte 0x00uy + methbuf.EmitByte 0x00uy seh |> List.iter (fun (st1,sz1,st2,sz2,kind) -> let k32 = kindAsInt32 kind - methbuf.EmitInt32AsUInt16 k32; - methbuf.EmitInt32AsUInt16 st1; - methbuf.EmitByte (b0 sz1); - methbuf.EmitInt32AsUInt16 st2; - methbuf.EmitByte (b0 sz2); + methbuf.EmitInt32AsUInt16 k32 + methbuf.EmitInt32AsUInt16 st1 + methbuf.EmitByte (b0 sz1) + methbuf.EmitInt32AsUInt16 st2 + methbuf.EmitByte (b0 sz2) methbuf.EmitInt32 (kindAsExtraInt32 kind)) else let bigSize = (seh.Length * 24 + 4) - methbuf.EmitByte (e_CorILMethod_Sect_EHTable ||| e_CorILMethod_Sect_FatFormat); - methbuf.EmitByte (b0 bigSize); - methbuf.EmitByte (b1 bigSize); - methbuf.EmitByte (b2 bigSize); + methbuf.EmitByte (e_CorILMethod_Sect_EHTable ||| e_CorILMethod_Sect_FatFormat) + methbuf.EmitByte (b0 bigSize) + methbuf.EmitByte (b1 bigSize) + methbuf.EmitByte (b2 bigSize) seh |> List.iter (fun (st1,sz1,st2,sz2,kind) -> let k32 = kindAsInt32 kind - methbuf.EmitInt32 k32; - methbuf.EmitInt32 st1; - methbuf.EmitInt32 sz1; - methbuf.EmitInt32 st2; - methbuf.EmitInt32 sz2; + methbuf.EmitInt32 k32 + methbuf.EmitInt32 st1 + methbuf.EmitInt32 sz1 + methbuf.EmitInt32 st2 + methbuf.EmitInt32 sz2 methbuf.EmitInt32 (kindAsExtraInt32 kind)) let requiredStringFixups' = (12,requiredStringFixups) @@ -2717,21 +2717,21 @@ let rec GetFieldDefAsFieldDefRow cenv env (fd: ILFieldDef) = (if (fd.Marshal <> None) then 0x1000 else 0x0) ||| (if (fd.Data <> None) then 0x0100 else 0x0) UnsharedRow - [| UShort (uint16 flags); - StringE (GetStringHeapIdx cenv fd.Name); - Blob (GetFieldDefSigAsBlobIdx cenv env fd ); |] + [| UShort (uint16 flags) + StringE (GetStringHeapIdx cenv fd.Name) + Blob (GetFieldDefSigAsBlobIdx cenv env fd ) |] and GetFieldDefSigAsBlobIdx cenv env fd = GetFieldDefTypeAsBlobIdx cenv env fd.Type and GenFieldDefPass3 cenv env fd = let fidx = AddUnsharedRow cenv TableNames.Field (GetFieldDefAsFieldDefRow cenv env fd) - GenCustomAttrsPass3Or4 cenv (hca_FieldDef,fidx) fd.CustomAttrs; + GenCustomAttrsPass3Or4 cenv (hca_FieldDef,fidx) fd.CustomAttrs // Write FieldRVA table - fixups into data section done later match fd.Data with | None -> () | Some b -> let offs = cenv.data.Position - cenv.data.EmitBytes b; + cenv.data.EmitBytes b AddUnsharedRow cenv TableNames.FieldRVA (UnsharedRow [| Data (offs, false); SimpleIndex (TableNames.Field,fidx) |]) |> ignore // Write FieldMarshal table @@ -2739,7 +2739,7 @@ and GenFieldDefPass3 cenv env fd = | None -> () | Some ntyp -> AddUnsharedRow cenv TableNames.FieldMarshal - (UnsharedRow [| HasFieldMarshal (hfm_FieldDef, fidx); + (UnsharedRow [| HasFieldMarshal (hfm_FieldDef, fidx) Blob (GetNativeTypeAsBlobIdx cenv ntyp) |]) |> ignore // Write Contant table match fd.LiteralValue with @@ -2747,16 +2747,15 @@ and GenFieldDefPass3 cenv env fd = | Some i -> AddUnsharedRow cenv TableNames.Constant (UnsharedRow - [| GetFieldInitFlags i; - HasConstant (hc_FieldDef, fidx); + [| GetFieldInitFlags i + HasConstant (hc_FieldDef, fidx) Blob (GetFieldInitAsBlobIdx cenv i) |]) |> ignore // Write FieldLayout table match fd.Offset with | None -> () | Some offset -> AddUnsharedRow cenv TableNames.FieldLayout - (UnsharedRow [| ULong offset; - SimpleIndex (TableNames.Field, fidx) |]) |> ignore + (UnsharedRow [| ULong offset; SimpleIndex (TableNames.Field, fidx) |]) |> ignore // -------------------------------------------------------------------- @@ -2776,22 +2775,22 @@ let rec GetGenericParamAsGenericParamRow cenv _env idx owner gp = let mdVersionMajor,_ = metadataSchemaVersionSupportedByCLRVersion cenv.desiredMetadataVersion if (mdVersionMajor = 1) then SimpleSharedRow - [| UShort (uint16 idx); - UShort (uint16 flags); - TypeOrMethodDef (fst owner, snd owner); - StringE (GetStringHeapIdx cenv gp.Name); - TypeDefOrRefOrSpec (tdor_TypeDef, 0); (* empty kind field in deprecated metadata *) |] + [| UShort (uint16 idx) + UShort (uint16 flags) + TypeOrMethodDef (fst owner, snd owner) + StringE (GetStringHeapIdx cenv gp.Name) + TypeDefOrRefOrSpec (tdor_TypeDef, 0) (* empty kind field in deprecated metadata *) |] else SimpleSharedRow - [| UShort (uint16 idx); - UShort (uint16 flags); - TypeOrMethodDef (fst owner, snd owner); + [| UShort (uint16 idx) + UShort (uint16 flags) + TypeOrMethodDef (fst owner, snd owner) StringE (GetStringHeapIdx cenv gp.Name) |] and GenTypeAsGenericParamConstraintRow cenv env gpidx ty = let tdorTag,tdorRow = GetTypeAsTypeDefOrRef cenv env ty UnsharedRow - [| SimpleIndex (TableNames.GenericParam, gpidx); + [| SimpleIndex (TableNames.GenericParam, gpidx) TypeDefOrRefOrSpec (tdorTag,tdorRow) |] and GenGenericParamConstraintPass4 cenv env gpidx ty = @@ -2822,8 +2821,8 @@ let rec GetParamAsParamRow cenv _env seq param = (if param.Marshal <> None then 0x2000 else 0x0000) UnsharedRow - [| UShort (uint16 flags); - UShort (uint16 seq); + [| UShort (uint16 flags) + UShort (uint16 seq) StringE (GetStringHeapIdxOption cenv param.Name) |] and GenParamPass3 cenv env seq param = @@ -2831,32 +2830,31 @@ and GenParamPass3 cenv env seq param = then () else let pidx = AddUnsharedRow cenv TableNames.Param (GetParamAsParamRow cenv env seq param) - GenCustomAttrsPass3Or4 cenv (hca_ParamDef,pidx) param.CustomAttrs; + GenCustomAttrsPass3Or4 cenv (hca_ParamDef,pidx) param.CustomAttrs // Write FieldRVA table - fixups into data section done later match param.Marshal with | None -> () | Some ntyp -> AddUnsharedRow cenv TableNames.FieldMarshal - (UnsharedRow [| HasFieldMarshal (hfm_ParamDef, pidx); - Blob (GetNativeTypeAsBlobIdx cenv ntyp) |]) |> ignore + (UnsharedRow [| HasFieldMarshal (hfm_ParamDef, pidx); Blob (GetNativeTypeAsBlobIdx cenv ntyp) |]) |> ignore let GenReturnAsParamRow (returnv : ILReturn) = let flags = (if returnv.Marshal <> None then 0x2000 else 0x0000) UnsharedRow - [| UShort (uint16 flags); - UShort 0us; (* sequence num. *) + [| UShort (uint16 flags) + UShort 0us (* sequence num. *) StringE 0 |] let GenReturnPass3 cenv (returnv: ILReturn) = if isSome returnv.Marshal || nonNil returnv.CustomAttrs.AsList then let pidx = AddUnsharedRow cenv TableNames.Param (GenReturnAsParamRow returnv) - GenCustomAttrsPass3Or4 cenv (hca_ParamDef,pidx) returnv.CustomAttrs; + GenCustomAttrsPass3Or4 cenv (hca_ParamDef,pidx) returnv.CustomAttrs match returnv.Marshal with | None -> () | Some ntyp -> AddUnsharedRow cenv TableNames.FieldMarshal (UnsharedRow - [| HasFieldMarshal (hfm_ParamDef, pidx); + [| HasFieldMarshal (hfm_ParamDef, pidx) Blob (GetNativeTypeAsBlobIdx cenv ntyp) |]) |> ignore // -------------------------------------------------------------------- @@ -2865,10 +2863,10 @@ let GenReturnPass3 cenv (returnv: ILReturn) = let GetMethodDefSigAsBytes cenv env (mdef: ILMethodDef) = emitBytesViaBuffer (fun bb -> - bb.EmitByte (callconvToByte mdef.GenericParams.Length mdef.CallingConv); - if mdef.GenericParams.Length > 0 then bb.EmitZ32 mdef.GenericParams.Length; - bb.EmitZ32 mdef.Parameters.Length; - EmitType cenv env bb mdef.Return.Type; + bb.EmitByte (callconvToByte mdef.GenericParams.Length mdef.CallingConv) + if mdef.GenericParams.Length > 0 then bb.EmitZ32 mdef.GenericParams.Length + bb.EmitZ32 mdef.Parameters.Length + EmitType cenv env bb mdef.Return.Type mdef.ParameterTypes |> ILList.iter (EmitType cenv env bb)) let GenMethodDefSigAsBlobIdx cenv env mdef = @@ -2910,7 +2908,7 @@ let GenMethodDefAsRow cenv env midx (md: ILMethodDef) = if md.IsEntryPoint then if cenv.entrypoint <> None then failwith "duplicate entrypoint" - else cenv.entrypoint <- Some (true, midx); + else cenv.entrypoint <- Some (true, midx) let codeAddr = (match md.mdBody.Contents with | MethodBody.IL ilmbody -> @@ -2920,37 +2918,37 @@ let GenMethodDefAsRow cenv env midx (md: ILMethodDef) = // Now record the PDB record for this method - we write this out later. if cenv.generatePdb then cenv.pdbinfo.Add - { MethToken=getUncodedToken TableNames.Method midx; - MethName=md.Name; - Params= [| |]; (* REVIEW *) - RootScope = rootScope; + { MethToken=getUncodedToken TableNames.Method midx + MethName=md.Name + Params= [| |] (* REVIEW *) + RootScope = rootScope Range= match ilmbody.SourceMarker with | Some m when cenv.generatePdb -> // table indexes are 1-based, document array indexes are 0-based let doc = (cenv.documents.FindOrAddSharedEntry m.Document) - 1 - Some ({ Document=doc; - Line=m.Line; - Column=m.Column; }, - { Document=doc; - Line=m.EndLine; - Column=m.EndColumn; }) + Some ({ Document=doc + Line=m.Line + Column=m.Column }, + { Document=doc + Line=m.EndLine + Column=m.EndColumn }) | _ -> None - SequencePoints=seqpoints; }; + SequencePoints=seqpoints } - cenv.AddCode code; + cenv.AddCode code addr | MethodBody.Native -> - failwith "cannot write body of native method - Abstract IL cannot roundtrip mixed native/managed binaries"; + failwith "cannot write body of native method - Abstract IL cannot roundtrip mixed native/managed binaries" | _ -> 0x0000) UnsharedRow - [| ULong codeAddr ; - UShort (uint16 implflags); - UShort (uint16 flags); - StringE (GetStringHeapIdx cenv md.Name); - Blob (GenMethodDefSigAsBlobIdx cenv env md); + [| ULong codeAddr + UShort (uint16 implflags) + UShort (uint16 flags) + StringE (GetStringHeapIdx cenv md.Name) + Blob (GenMethodDefSigAsBlobIdx cenv env md) SimpleIndex(TableNames.Param,cenv.GetTable(TableNames.Param).Count + 1) |] let GenMethodImplPass3 cenv env _tgparams tidx mimpl = @@ -2958,19 +2956,19 @@ let GenMethodImplPass3 cenv env _tgparams tidx mimpl = let midx2Tag, midx2Row = GetOverridesSpecAsMethodDefOrRef cenv env mimpl.Overrides AddUnsharedRow cenv TableNames.MethodImpl (UnsharedRow - [| SimpleIndex (TableNames.TypeDef, tidx); - MethodDefOrRef (midxTag, midxRow); + [| SimpleIndex (TableNames.TypeDef, tidx) + MethodDefOrRef (midxTag, midxRow) MethodDefOrRef (midx2Tag, midx2Row) |]) |> ignore let GenMethodDefPass3 cenv env (md:ILMethodDef) = let midx = GetMethodDefIdx cenv md let idx2 = AddUnsharedRow cenv TableNames.Method (GenMethodDefAsRow cenv env midx md) - if midx <> idx2 then failwith "index of method def on pass 3 does not match index on pass 2"; - GenReturnPass3 cenv md.Return; - md.Parameters |> ILList.iteri (fun n param -> GenParamPass3 cenv env (n+1) param) ; - md.CustomAttrs |> GenCustomAttrsPass3Or4 cenv (hca_MethodDef,midx) ; - md.SecurityDecls.AsList |> GenSecurityDeclsPass3 cenv (hds_MethodDef,midx); - md.GenericParams |> List.iteri (fun n gp -> GenGenericParamPass3 cenv env n (tomd_MethodDef, midx) gp) ; + if midx <> idx2 then failwith "index of method def on pass 3 does not match index on pass 2" + GenReturnPass3 cenv md.Return + md.Parameters |> ILList.iteri (fun n param -> GenParamPass3 cenv env (n+1) param) + md.CustomAttrs |> GenCustomAttrsPass3Or4 cenv (hca_MethodDef,midx) + md.SecurityDecls.AsList |> GenSecurityDeclsPass3 cenv (hds_MethodDef,midx) + md.GenericParams |> List.iteri (fun n gp -> GenGenericParamPass3 cenv env n (tomd_MethodDef, midx) gp) match md.mdBody.Contents with | MethodBody.PInvoke attr -> let flags = @@ -3002,10 +3000,10 @@ let GenMethodDefPass3 cenv env (md:ILMethodDef) = (if attr.LastError then 0x0040 else 0x0000) AddUnsharedRow cenv TableNames.ImplMap (UnsharedRow - [| UShort (uint16 flags); - MemberForwarded (mf_MethodDef,midx); - StringE (GetStringHeapIdx cenv attr.Name); - SimpleIndex (TableNames.ModuleRef, GetModuleRefAsIdx cenv attr.Where); |]) |> ignore + [| UShort (uint16 flags) + MemberForwarded (mf_MethodDef,midx) + StringE (GetStringHeapIdx cenv attr.Name) + SimpleIndex (TableNames.ModuleRef, GetModuleRefAsIdx cenv attr.Where) |]) |> ignore | _ -> () let GenMethodDefPass4 cenv env md = @@ -3017,8 +3015,8 @@ let GenPropertyMethodSemanticsPass3 cenv pidx kind mref = let midx = try GetMethodRefAsMethodDefIdx cenv mref with MethodDefNotFound -> 1 AddUnsharedRow cenv TableNames.MethodSemantics (UnsharedRow - [| UShort (uint16 kind); - SimpleIndex (TableNames.Method,midx); + [| UShort (uint16 kind) + SimpleIndex (TableNames.Method,midx) HasSemantics (hs_Property, pidx) |]) |> ignore let rec GetPropertySigAsBlobIdx cenv env prop = @@ -3027,9 +3025,9 @@ let rec GetPropertySigAsBlobIdx cenv env prop = and GetPropertySigAsBytes cenv env prop = emitBytesViaBuffer (fun bb -> let b = ((hasthisToByte prop.CallingConv) ||| e_IMAGE_CEE_CS_CALLCONV_PROPERTY) - bb.EmitByte b; - bb.EmitZ32 prop.Args.Length; - EmitType cenv env bb prop.Type; + bb.EmitByte b + bb.EmitZ32 prop.Args.Length + EmitType cenv env bb prop.Type prop.Args |> ILList.iter (EmitType cenv env bb)) and GetPropertyAsPropertyRow cenv env (prop:ILPropertyDef) = @@ -3038,23 +3036,23 @@ and GetPropertyAsPropertyRow cenv env (prop:ILPropertyDef) = (if prop.IsRTSpecialName then 0x0400 else 0x0) ||| (if prop.Init <> None then 0x1000 else 0x0) UnsharedRow - [| UShort (uint16 flags); - StringE (GetStringHeapIdx cenv prop.Name); - Blob (GetPropertySigAsBlobIdx cenv env prop); |] + [| UShort (uint16 flags) + StringE (GetStringHeapIdx cenv prop.Name) + Blob (GetPropertySigAsBlobIdx cenv env prop) |] /// ILPropertyDef --> Property Row + MethodSemantics entries and GenPropertyPass3 cenv env prop = let pidx = AddUnsharedRow cenv TableNames.Property (GetPropertyAsPropertyRow cenv env prop) - prop.SetMethod |> Option.iter (GenPropertyMethodSemanticsPass3 cenv pidx 0x0001) ; - prop.GetMethod |> Option.iter (GenPropertyMethodSemanticsPass3 cenv pidx 0x0002) ; + prop.SetMethod |> Option.iter (GenPropertyMethodSemanticsPass3 cenv pidx 0x0001) + prop.GetMethod |> Option.iter (GenPropertyMethodSemanticsPass3 cenv pidx 0x0002) // Write Constant table match prop.Init with | None -> () | Some i -> AddUnsharedRow cenv TableNames.Constant (UnsharedRow - [| GetFieldInitFlags i; - HasConstant (hc_Property, pidx); + [| GetFieldInitFlags i + HasConstant (hc_Property, pidx) Blob (GetFieldInitAsBlobIdx cenv i) |]) |> ignore GenCustomAttrsPass3Or4 cenv (hca_Property,pidx) prop.CustomAttrs @@ -3062,8 +3060,8 @@ let rec GenEventMethodSemanticsPass3 cenv eidx kind mref = let addIdx = try GetMethodRefAsMethodDefIdx cenv mref with MethodDefNotFound -> 1 AddUnsharedRow cenv TableNames.MethodSemantics (UnsharedRow - [| UShort (uint16 kind); - SimpleIndex (TableNames.Method,addIdx); + [| UShort (uint16 kind) + SimpleIndex (TableNames.Method,addIdx) HasSemantics (hs_Event, eidx) |]) |> ignore /// ILEventDef --> Event Row + MethodSemantics entries @@ -3073,8 +3071,8 @@ and GenEventAsEventRow cenv env (md: ILEventDef) = (if md.IsRTSpecialName then 0x0400 else 0x0) let tdorTag, tdorRow = GetTypeOptionAsTypeDefOrRef cenv env md.Type UnsharedRow - [| UShort (uint16 flags); - StringE (GetStringHeapIdx cenv md.Name); + [| UShort (uint16 flags) + StringE (GetStringHeapIdx cenv md.Name) TypeDefOrRefOrSpec (tdorTag,tdorRow) |] and GenEventPass3 cenv env (md: ILEventDef) = @@ -3082,7 +3080,7 @@ and GenEventPass3 cenv env (md: ILEventDef) = md.AddMethod |> GenEventMethodSemanticsPass3 cenv eidx 0x0008 md.RemoveMethod |> GenEventMethodSemanticsPass3 cenv eidx 0x0010 Option.iter (GenEventMethodSemanticsPass3 cenv eidx 0x0020) md.FireMethod - List.iter (GenEventMethodSemanticsPass3 cenv eidx 0x0004) md.OtherMethods; + List.iter (GenEventMethodSemanticsPass3 cenv eidx 0x0004) md.OtherMethods GenCustomAttrsPass3Or4 cenv (hca_Event,eidx) md.CustomAttrs @@ -3101,17 +3099,17 @@ let rec GetResourceAsManifestResourceRow cenv r = let alignedOffset = (align 0x8 offset) let pad = alignedOffset - offset let resourceSize = b.Length - cenv.resources.EmitPadding pad; - cenv.resources.EmitInt32 resourceSize; - cenv.resources.EmitBytes b; + cenv.resources.EmitPadding pad + cenv.resources.EmitInt32 resourceSize + cenv.resources.EmitBytes b Data (alignedOffset,true), (i_File, 0) | ILResourceLocation.File (mref,offset) -> ULong offset, (i_File, GetModuleRefAsFileIdx cenv mref) | ILResourceLocation.Assembly aref -> ULong 0x0, (i_AssemblyRef, GetAssemblyRefAsIdx cenv aref) UnsharedRow - [| data; - ULong (match r.Access with ILResourceAccess.Public -> 0x01 | ILResourceAccess.Private -> 0x02); - StringE (GetStringHeapIdx cenv r.Name); - Implementation (fst impl, snd impl); |] + [| data + ULong (match r.Access with ILResourceAccess.Public -> 0x01 | ILResourceAccess.Private -> 0x02) + StringE (GetStringHeapIdx cenv r.Name) + Implementation (fst impl, snd impl) |] and GenResourcePass3 cenv r = let idx = AddUnsharedRow cenv TableNames.ManifestResource (GetResourceAsManifestResourceRow cenv r) @@ -3125,11 +3123,11 @@ let rec GenTypeDefPass3 enc cenv (td:ILTypeDef) = try let env = envForTypeDef td let tidx = GetIdxForTypeDef cenv (TdKey(enc,td.Name)) - td.Properties.AsList |> List.iter (GenPropertyPass3 cenv env); - td.Events.AsList |> List.iter (GenEventPass3 cenv env); - td.Fields.AsList |> List.iter (GenFieldDefPass3 cenv env); - td.Methods |> Seq.iter (GenMethodDefPass3 cenv env); - td.MethodImpls.AsList |> List.iter (GenMethodImplPass3 cenv env td.GenericParams.Length tidx); + td.Properties.AsList |> List.iter (GenPropertyPass3 cenv env) + td.Events.AsList |> List.iter (GenEventPass3 cenv env) + td.Fields.AsList |> List.iter (GenFieldDefPass3 cenv env) + td.Methods |> Seq.iter (GenMethodDefPass3 cenv env) + td.MethodImpls.AsList |> List.iter (GenMethodImplPass3 cenv env td.GenericParams.Length tidx) // ClassLayout entry if needed match td.Layout with | ILTypeDefLayout.Auto -> () @@ -3137,16 +3135,16 @@ let rec GenTypeDefPass3 enc cenv (td:ILTypeDef) = if isSome layout.Pack || isSome layout.Size then AddUnsharedRow cenv TableNames.ClassLayout (UnsharedRow - [| UShort (match layout.Pack with None -> uint16 0x0 | Some p -> p); - ULong (match layout.Size with None -> 0x0 | Some p -> p); + [| UShort (match layout.Pack with None -> uint16 0x0 | Some p -> p) + ULong (match layout.Size with None -> 0x0 | Some p -> p) SimpleIndex (TableNames.TypeDef, tidx) |]) |> ignore - td.SecurityDecls.AsList |> GenSecurityDeclsPass3 cenv (hds_TypeDef,tidx); - td.CustomAttrs |> GenCustomAttrsPass3Or4 cenv (hca_TypeDef,tidx); - td.GenericParams |> List.iteri (fun n gp -> GenGenericParamPass3 cenv env n (tomd_TypeDef,tidx) gp) ; - td.NestedTypes.AsList |> GenTypeDefsPass3 (enc@[td.Name]) cenv; + td.SecurityDecls.AsList |> GenSecurityDeclsPass3 cenv (hds_TypeDef,tidx) + td.CustomAttrs |> GenCustomAttrsPass3Or4 cenv (hca_TypeDef,tidx) + td.GenericParams |> List.iteri (fun n gp -> GenGenericParamPass3 cenv env n (tomd_TypeDef,tidx) gp) + td.NestedTypes.AsList |> GenTypeDefsPass3 (enc@[td.Name]) cenv with e -> - failwith ("Error in pass3 for type "+td.Name+", error: "+e.Message); + failwith ("Error in pass3 for type "+td.Name+", error: "+e.Message) reraise() raise e @@ -3160,11 +3158,11 @@ let rec GenTypeDefPass4 enc cenv (td:ILTypeDef) = try let env = envForTypeDef td let tidx = GetIdxForTypeDef cenv (TdKey(enc,td.Name)) - td.Methods |> Seq.iter (GenMethodDefPass4 cenv env) ; - List.iteri (fun n gp -> GenGenericParamPass4 cenv env n (tomd_TypeDef,tidx) gp) td.GenericParams; - GenTypeDefsPass4 (enc@[td.Name]) cenv td.NestedTypes.AsList; + td.Methods |> Seq.iter (GenMethodDefPass4 cenv env) + List.iteri (fun n gp -> GenGenericParamPass4 cenv env n (tomd_TypeDef,tidx) gp) td.GenericParams + GenTypeDefsPass4 (enc@[td.Name]) cenv td.NestedTypes.AsList with e -> - failwith ("Error in pass4 for type "+td.Name+", error: "+e.Message); + failwith ("Error in pass4 for type "+td.Name+", error: "+e.Message) reraise() raise e @@ -3180,12 +3178,12 @@ let rec GenNestedExportedTypePass3 cenv cidx (ce: ILNestedExportedType) = let nidx = AddUnsharedRow cenv TableNames.ExportedType (UnsharedRow - [| ULong flags ; - ULong 0x0; - StringE (GetStringHeapIdx cenv ce.Name); - StringE 0; + [| ULong flags + ULong 0x0 + StringE (GetStringHeapIdx cenv ce.Name) + StringE 0 Implementation (i_ExportedType, cidx) |]) - GenCustomAttrsPass3Or4 cenv (hca_ExportedType,nidx) ce.CustomAttrs; + GenCustomAttrsPass3Or4 cenv (hca_ExportedType,nidx) ce.CustomAttrs GenNestedExportedTypesPass3 cenv nidx ce.Nested and GenNestedExportedTypesPass3 cenv nidx (nce: ILNestedExportedTypes) = @@ -3199,16 +3197,16 @@ and GenExportedTypePass3 cenv (ce: ILExportedTypeOrForwarder) = let cidx = AddUnsharedRow cenv TableNames.ExportedType (UnsharedRow - [| ULong flags ; - ULong 0x0; - nelem; - nselem; - Implementation (fst impl, snd impl); |]) - GenCustomAttrsPass3Or4 cenv (hca_ExportedType,cidx) ce.CustomAttrs; + [| ULong flags + ULong 0x0 + nelem + nselem + Implementation (fst impl, snd impl) |]) + GenCustomAttrsPass3Or4 cenv (hca_ExportedType,cidx) ce.CustomAttrs GenNestedExportedTypesPass3 cenv cidx ce.Nested and GenExportedTypesPass3 cenv (ce: ILExportedTypesAndForwarders) = - List.iter (GenExportedTypePass3 cenv) ce.AsList; + List.iter (GenExportedTypePass3 cenv) ce.AsList // -------------------------------------------------------------------- // manifest --> generate Assembly row @@ -3216,11 +3214,11 @@ and GenExportedTypesPass3 cenv (ce: ILExportedTypesAndForwarders) = and GetManifsetAsAssemblyRow cenv m = UnsharedRow - [|ULong m.AuxModuleHashAlgorithm; - UShort (match m.Version with None -> 0us | Some (x,_,_,_) -> x); - UShort (match m.Version with None -> 0us | Some (_,y,_,_) -> y); - UShort (match m.Version with None -> 0us | Some (_,_,z,_) -> z); - UShort (match m.Version with None -> 0us | Some (_,_,_,w) -> w); + [|ULong m.AuxModuleHashAlgorithm + UShort (match m.Version with None -> 0us | Some (x,_,_,_) -> x) + UShort (match m.Version with None -> 0us | Some (_,y,_,_) -> y) + UShort (match m.Version with None -> 0us | Some (_,_,z,_) -> z) + UShort (match m.Version with None -> 0us | Some (_,_,_,w) -> w) ULong ( (match m.AssemblyLongevity with | ILAssemblyLongevity.Unspecified -> 0x0000 @@ -3235,21 +3233,21 @@ and GetManifsetAsAssemblyRow cenv m = (if m.JitTracking then 0x8000 else 0x0) ||| (if m.DisableJitOptimizations then 0x4000 else 0x0) ||| (match m.PublicKey with None -> 0x0000 | Some _ -> 0x0001) ||| - 0x0000); - (match m.PublicKey with None -> Blob 0 | Some x -> Blob (GetBytesAsBlobIdx cenv x)); - StringE (GetStringHeapIdx cenv m.Name); - (match m.Locale with None -> StringE 0 | Some x -> StringE (GetStringHeapIdx cenv x)); |] + 0x0000) + (match m.PublicKey with None -> Blob 0 | Some x -> Blob (GetBytesAsBlobIdx cenv x)) + StringE (GetStringHeapIdx cenv m.Name) + (match m.Locale with None -> StringE 0 | Some x -> StringE (GetStringHeapIdx cenv x)) |] and GenManifestPass3 cenv m = let aidx = AddUnsharedRow cenv TableNames.Assembly (GetManifsetAsAssemblyRow cenv m) - GenSecurityDeclsPass3 cenv (hds_Assembly,aidx) m.SecurityDecls.AsList; - GenCustomAttrsPass3Or4 cenv (hca_Assembly,aidx) m.CustomAttrs; - GenExportedTypesPass3 cenv m.ExportedTypes; + GenSecurityDeclsPass3 cenv (hds_Assembly,aidx) m.SecurityDecls.AsList + GenCustomAttrsPass3Or4 cenv (hca_Assembly,aidx) m.CustomAttrs + GenExportedTypesPass3 cenv m.ExportedTypes // Record the entrypoint decl if needed. match m.EntrypointElsewhere with | Some mref -> if cenv.entrypoint <> None then failwith "duplicate entrypoint" - else cenv.entrypoint <- Some (false, GetModuleRefAsIdx cenv mref); + else cenv.entrypoint <- Some (false, GetModuleRefAsIdx cenv mref) | None -> () and newGuid (modul: ILModuleDef) = @@ -3263,10 +3261,10 @@ and GetModuleAsRow cenv (modul: ILModuleDef) = let modulGuid = newGuid modul cenv.moduleGuid <- modulGuid UnsharedRow - [| UShort (uint16 0x0); - StringE (GetStringHeapIdx cenv modul.Name); - Guid (GetGuidIdx cenv modulGuid); - Guid 0; + [| UShort (uint16 0x0) + StringE (GetStringHeapIdx cenv modul.Name) + Guid (GetGuidIdx cenv modulGuid) + Guid 0 Guid 0 |] @@ -3290,63 +3288,63 @@ let SortTableRows tab (rows:IGenericRow[]) = let GenModule (cenv : cenv) (modul: ILModuleDef) = let midx = AddUnsharedRow cenv TableNames.Module (GetModuleAsRow cenv modul) - List.iter (GenResourcePass3 cenv) modul.Resources.AsList; + List.iter (GenResourcePass3 cenv) modul.Resources.AsList let tds = destTypeDefsWithGlobalFunctionsFirst cenv.ilg modul.TypeDefs - reportTime cenv.showTimes "Module Generation Preparation"; - GenTypeDefsPass1 [] cenv tds; - reportTime cenv.showTimes "Module Generation Pass 1"; - GenTypeDefsPass2 0 [] cenv tds; - reportTime cenv.showTimes "Module Generation Pass 2"; - (match modul.Manifest with None -> () | Some m -> GenManifestPass3 cenv m); - GenTypeDefsPass3 [] cenv tds; - reportTime cenv.showTimes "Module Generation Pass 3"; - GenCustomAttrsPass3Or4 cenv (hca_Module,midx) modul.CustomAttrs; + reportTime cenv.showTimes "Module Generation Preparation" + GenTypeDefsPass1 [] cenv tds + reportTime cenv.showTimes "Module Generation Pass 1" + GenTypeDefsPass2 0 [] cenv tds + reportTime cenv.showTimes "Module Generation Pass 2" + (match modul.Manifest with None -> () | Some m -> GenManifestPass3 cenv m) + GenTypeDefsPass3 [] cenv tds + reportTime cenv.showTimes "Module Generation Pass 3" + GenCustomAttrsPass3Or4 cenv (hca_Module,midx) modul.CustomAttrs // GenericParam is the only sorted table indexed by Columns in other tables (GenericParamConstraint\CustomAttributes). // Hence we need to sort it before we emit any entries in GenericParamConstraint\CustomAttributes that are attached to generic params. // Note this mutates the rows in a table. 'SetRowsOfTable' clears // the key --> index map since it is no longer valid - cenv.GetTable(TableNames.GenericParam).SetRowsOfTable (SortTableRows TableNames.GenericParam (cenv.GetTable(TableNames.GenericParam).EntriesAsArray)); - GenTypeDefsPass4 [] cenv tds; + cenv.GetTable(TableNames.GenericParam).SetRowsOfTable (SortTableRows TableNames.GenericParam (cenv.GetTable(TableNames.GenericParam).EntriesAsArray)) + GenTypeDefsPass4 [] cenv tds reportTime cenv.showTimes "Module Generation Pass 4" let generateIL requiredDataFixups (desiredMetadataVersion,generatePdb, ilg : ILGlobals, emitTailcalls,showTimes) (m : ILModuleDef) noDebugData cilStartAddress = let isDll = m.IsDLL let cenv = - { primaryAssembly=ilg.traits.ScopeRef; - emitTailcalls=emitTailcalls; - showTimes=showTimes; - ilg = mkILGlobals ilg.traits None noDebugData; // assumes mscorlib is Scope_assembly _ ILScopeRef - desiredMetadataVersion=desiredMetadataVersion; - requiredDataFixups= requiredDataFixups; - requiredStringFixups = []; - codeChunks=ByteBuffer.Create 40000; - nextCodeAddr = cilStartAddress; - data = ByteBuffer.Create 200; - resources = ByteBuffer.Create 200; - tables= Array.init 64 (fun i -> MetadataTable<_>.New ("row table "+string i,System.Collections.Generic.EqualityComparer.Default)); - AssemblyRefs = MetadataTable<_>.New("ILAssemblyRef",System.Collections.Generic.EqualityComparer.Default); - documents=MetadataTable<_>.New("pdbdocs",System.Collections.Generic.EqualityComparer.Default); - trefCache=new Dictionary<_,_>(100); - pdbinfo= new ResizeArray<_>(200); - moduleGuid= Array.zeroCreate 16; - fieldDefs= MetadataTable<_>.New("field defs",System.Collections.Generic.EqualityComparer.Default); - methodDefIdxsByKey = MetadataTable<_>.New("method defs",System.Collections.Generic.EqualityComparer.Default); + { primaryAssembly=ilg.traits.ScopeRef + emitTailcalls=emitTailcalls + showTimes=showTimes + ilg = mkILGlobals ilg.traits None noDebugData // assumes mscorlib is Scope_assembly _ ILScopeRef + desiredMetadataVersion=desiredMetadataVersion + requiredDataFixups= requiredDataFixups + requiredStringFixups = [] + codeChunks=ByteBuffer.Create 40000 + nextCodeAddr = cilStartAddress + data = ByteBuffer.Create 200 + resources = ByteBuffer.Create 200 + tables= Array.init 64 (fun i -> MetadataTable<_>.New ("row table "+string i,System.Collections.Generic.EqualityComparer.Default)) + AssemblyRefs = MetadataTable<_>.New("ILAssemblyRef",System.Collections.Generic.EqualityComparer.Default) + documents=MetadataTable<_>.New("pdbdocs",System.Collections.Generic.EqualityComparer.Default) + trefCache=new Dictionary<_,_>(100) + pdbinfo= new ResizeArray<_>(200) + moduleGuid= Array.zeroCreate 16 + fieldDefs= MetadataTable<_>.New("field defs",System.Collections.Generic.EqualityComparer.Default) + methodDefIdxsByKey = MetadataTable<_>.New("method defs",System.Collections.Generic.EqualityComparer.Default) // This uses reference identity on ILMethodDef objects - methodDefIdxs = new Dictionary<_,_>(100, HashIdentity.Reference); - propertyDefs = MetadataTable<_>.New("property defs",System.Collections.Generic.EqualityComparer.Default); - eventDefs = MetadataTable<_>.New("event defs",System.Collections.Generic.EqualityComparer.Default); - typeDefs = MetadataTable<_>.New("type defs",System.Collections.Generic.EqualityComparer.Default); - entrypoint=None; - generatePdb=generatePdb; + methodDefIdxs = new Dictionary<_,_>(100, HashIdentity.Reference) + propertyDefs = MetadataTable<_>.New("property defs",System.Collections.Generic.EqualityComparer.Default) + eventDefs = MetadataTable<_>.New("event defs",System.Collections.Generic.EqualityComparer.Default) + typeDefs = MetadataTable<_>.New("type defs",System.Collections.Generic.EqualityComparer.Default) + entrypoint=None + generatePdb=generatePdb // These must use structural comparison since they are keyed by arrays - guids=MetadataTable<_>.New("guids",HashIdentity.Structural); - blobs= MetadataTable<_>.New("blobs",HashIdentity.Structural); - strings= MetadataTable<_>.New("strings",System.Collections.Generic.EqualityComparer.Default); - userStrings= MetadataTable<_>.New("user strings",System.Collections.Generic.EqualityComparer.Default); } + guids=MetadataTable<_>.New("guids",HashIdentity.Structural) + blobs= MetadataTable<_>.New("blobs",HashIdentity.Structural) + strings= MetadataTable<_>.New("strings",System.Collections.Generic.EqualityComparer.Default) + userStrings= MetadataTable<_>.New("user strings",System.Collections.Generic.EqualityComparer.Default) } // Now the main compilation step - GenModule cenv m; + GenModule cenv m // Fetch out some of the results let entryPointToken = @@ -3354,13 +3352,13 @@ let generateIL requiredDataFixups (desiredMetadataVersion,generatePdb, ilg : ILG | Some (epHere,tok) -> getUncodedToken (if epHere then TableNames.Method else TableNames.File) tok | None -> - if not isDll then dprintn "warning: no entrypoint specified in executable binary"; + if not isDll then dprintn "warning: no entrypoint specified in executable binary" 0x0 let pdbData = - { EntryPoint= (if isDll then None else Some entryPointToken); - ModuleID = cenv.moduleGuid; - Documents = cenv.documents.EntriesAsArray; + { EntryPoint= (if isDll then None else Some entryPointToken) + ModuleID = cenv.moduleGuid + Documents = cenv.documents.EntriesAsArray Methods= cenv.pdbinfo.ToArray() } let idxForNextedTypeDef (tds:ILTypeDef list, td:ILTypeDef) = @@ -3376,20 +3374,20 @@ let generateIL requiredDataFixups (desiredMetadataVersion,generatePdb, ilg : ILG // turn idx tbls into token maps let mappings = { TypeDefTokenMap = (fun t -> - getUncodedToken TableNames.TypeDef (idxForNextedTypeDef t)); + getUncodedToken TableNames.TypeDef (idxForNextedTypeDef t)) FieldDefTokenMap = (fun t fd -> let tidx = idxForNextedTypeDef t - getUncodedToken TableNames.Field (GetFieldDefAsFieldDefIdx cenv tidx fd)); + getUncodedToken TableNames.Field (GetFieldDefAsFieldDefIdx cenv tidx fd)) MethodDefTokenMap = (fun t md -> let tidx = idxForNextedTypeDef t - getUncodedToken TableNames.Method (FindMethodDefIdx cenv (GetKeyForMethodDef tidx md))); + getUncodedToken TableNames.Method (FindMethodDefIdx cenv (GetKeyForMethodDef tidx md))) PropertyTokenMap = (fun t pd -> let tidx = idxForNextedTypeDef t - getUncodedToken TableNames.Property (cenv.propertyDefs.GetTableEntry (GetKeyForPropertyDef tidx pd))); + getUncodedToken TableNames.Property (cenv.propertyDefs.GetTableEntry (GetKeyForPropertyDef tidx pd))) EventTokenMap = (fun t ed -> let tidx = idxForNextedTypeDef t getUncodedToken TableNames.Event (cenv.eventDefs.GetTableEntry (EventKey (tidx, ed.Name)))) } - reportTime cenv.showTimes "Finalize Module Generation Results"; + reportTime cenv.showTimes "Finalize Module Generation Results" // New return the results let data = cenv.data.Close() let resources = cenv.resources.Close() @@ -3401,7 +3399,7 @@ let generateIL requiredDataFixups (desiredMetadataVersion,generatePdb, ilg : ILG //===================================================================== type BinaryChunk = - { size: int32; + { size: int32 addr: int32 } let chunk sz next = ({addr=next; size=sz},next + sz) @@ -3418,14 +3416,14 @@ module FileSystemUtilites = if runningOnMono then try let monoPosix = Assembly.Load("Mono.Posix, Version=2.0.0.0, Culture=neutral, PublicKeyToken=0738eb9f132ed756") - if progress then eprintf "loading type Mono.Unix.UnixFileInfo...\n"; + if progress then eprintf "loading type Mono.Unix.UnixFileInfo...\n" let monoUnixFileInfo = monoPosix.GetType("Mono.Unix.UnixFileSystemInfo") let fileEntry = monoUnixFileInfo.InvokeMember("GetFileSystemEntry", (BindingFlags.InvokeMethod ||| BindingFlags.Static ||| BindingFlags.Public), null, null, [| box filename |],System.Globalization.CultureInfo.InvariantCulture) let prevPermissions = monoUnixFileInfo.InvokeMember("get_FileAccessPermissions", (BindingFlags.InvokeMethod ||| BindingFlags.Instance ||| BindingFlags.Public), null, fileEntry, [| |],System.Globalization.CultureInfo.InvariantCulture) |> unbox // Add 0x000001ED (UserReadWriteExecute, GroupReadExecute, OtherReadExecute) to the access permissions on Unix monoUnixFileInfo.InvokeMember("set_FileAccessPermissions", (BindingFlags.InvokeMethod ||| BindingFlags.Instance ||| BindingFlags.Public), null, fileEntry, [| box (prevPermissions ||| 0x000001ED) |],System.Globalization.CultureInfo.InvariantCulture) |> ignore with e -> - if progress then eprintf "failure: %s...\n" (e.ToString()); + if progress then eprintf "failure: %s...\n" (e.ToString()) // Fail silently let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls,showTimes) modul noDebugData cilStartAddress = @@ -3439,7 +3437,7 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls let strings,userStrings,blobs,guids,tables,entryPointToken,code,requiredStringFixups,data,resources,pdbData,mappings = generateIL requiredDataFixups (desiredMetadataVersion,generatePdb,ilg,emitTailcalls,showTimes) modul noDebugData cilStartAddress - reportTime showTimes "Generated Tables and Code"; + reportTime showTimes "Generated Tables and Code" let tableSize (tab: TableName) = tables.[tab.Index].Length // Now place the code @@ -3512,7 +3510,7 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls (if tableSize (TableNames.GenericParamConstraint) > 0 then 0x00001000 else 0x00000000) ||| 0x00000200 - reportTime showTimes "Layout Header of Tables"; + reportTime showTimes "Layout Header of Tables" let guidAddress n = (if n = 0 then 0 else (n - 1) * 0x10 + 0x01) @@ -3520,48 +3518,48 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls let tab = Array.create (strings.Length + 1) 0 let pos = ref 1 for i = 1 to strings.Length do - tab.[i] <- !pos; + tab.[i] <- !pos let s = strings.[i - 1] pos := !pos + s.Length tab let stringAddress n = - if n >= Array.length stringAddressTable then failwith ("string index "+string n+" out of range"); + if n >= Array.length stringAddressTable then failwith ("string index "+string n+" out of range") stringAddressTable.[n] let userStringAddressTable = let tab = Array.create (Array.length userStrings + 1) 0 let pos = ref 1 for i = 1 to Array.length userStrings do - tab.[i] <- !pos; + tab.[i] <- !pos let s = userStrings.[i - 1] let n = s.Length + 1 pos := !pos + n + ByteBuffer.Z32Size n tab let userStringAddress n = - if n >= Array.length userStringAddressTable then failwith "userString index out of range"; + if n >= Array.length userStringAddressTable then failwith "userString index out of range" userStringAddressTable.[n] let blobAddressTable = let tab = Array.create (blobs.Length + 1) 0 let pos = ref 1 for i = 1 to blobs.Length do - tab.[i] <- !pos; + tab.[i] <- !pos let blob = blobs.[i - 1] pos := !pos + blob.Length + ByteBuffer.Z32Size blob.Length tab let blobAddress n = - if n >= blobAddressTable.Length then failwith "blob index out of range"; + if n >= blobAddressTable.Length then failwith "blob index out of range" blobAddressTable.[n] - reportTime showTimes "Build String/Blob Address Tables"; + reportTime showTimes "Build String/Blob Address Tables" let sortedTables = Array.init 64 (fun i -> tables.[i] |> SortTableRows (TableName.FromIndex i)) - reportTime showTimes "Sort Tables"; + reportTime showTimes "Sort Tables" let codedTables = @@ -3657,18 +3655,18 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls // Now the coded tables themselves - first the schemata header tablesBuf.EmitIntsAsBytes [| 0x00; 0x00; 0x00; 0x00; - mdtableVersionMajor; // major version of table schemata - mdtableVersionMinor; // minor version of table schemata + mdtableVersionMajor // major version of table schemata + mdtableVersionMinor // minor version of table schemata - ((if stringsBig then 0x01 else 0x00) ||| // bit vector for heap size - (if guidsBig then 0x02 else 0x00) ||| - (if blobsBig then 0x04 else 0x00)); - 0x01; (* reserved, always 1 *) |]; + ((if stringsBig then 0x01 else 0x00) ||| // bit vector for heap size + (if guidsBig then 0x02 else 0x00) ||| + (if blobsBig then 0x04 else 0x00)) + 0x01 (* reserved, always 1 *) |] - tablesBuf.EmitInt32 valid1; - tablesBuf.EmitInt32 valid2; - tablesBuf.EmitInt32 sorted1; - tablesBuf.EmitInt32 sorted2; + tablesBuf.EmitInt32 valid1 + tablesBuf.EmitInt32 valid2 + tablesBuf.EmitInt32 sorted1 + tablesBuf.EmitInt32 sorted2 // Numbers of rows in various tables for rows in sortedTables do @@ -3676,7 +3674,7 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls tablesBuf.EmitInt32 rows.Length - reportTime showTimes "Write Header of tablebuf"; + reportTime showTimes "Write Header of tablebuf" // The tables themselves for rows in sortedTables do @@ -3712,7 +3710,7 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls tablesBuf.Close() - reportTime showTimes "Write Tables to tablebuf"; + reportTime showTimes "Write Tables to tablebuf" let tablesStreamUnpaddedSize = codedTables.Length // QUERY: extra 4 empty bytes in array.exe - why? Include some extra padding after @@ -3729,7 +3727,7 @@ let writeILMetadataAndCode (generatePdb,desiredMetadataVersion,ilg,emitTailcalls let blobsChunk,_next = chunk blobsStreamPaddedSize next let blobsStreamPadding = blobsChunk.size - blobsStreamUnpaddedSize - reportTime showTimes "Layout Metadata"; + reportTime showTimes "Layout Metadata" let metadata = let mdbuf = ByteBuffer.Create 500000 @@ -4217,117 +4215,117 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: // Note that the defaults differ between x86 and x64 if modul.Is64Bit then let size = defaultArg modul.StackReserveSize 0x400000 |> int64 - writeInt64 os size; // Stack Reserve Size Always 0x400000 (4Mb) (see Section 23.1). - writeInt64 os 0x4000L; // Stack Commit Size Always 0x4000 (16Kb) (see Section 23.1). - writeInt64 os 0x100000L; // Heap Reserve Size Always 0x100000 (1Mb) (see Section 23.1). + writeInt64 os size // Stack Reserve Size Always 0x400000 (4Mb) (see Section 23.1). + writeInt64 os 0x4000L // Stack Commit Size Always 0x4000 (16Kb) (see Section 23.1). + writeInt64 os 0x100000L // Heap Reserve Size Always 0x100000 (1Mb) (see Section 23.1). writeInt64 os 0x2000L // Heap Commit Size Always 0x800 (8Kb) (see Section 23.1). else let size = defaultArg modul.StackReserveSize 0x100000 - writeInt32 os size; // Stack Reserve Size Always 0x100000 (1Mb) (see Section 23.1). - writeInt32 os 0x1000; // Stack Commit Size Always 0x1000 (4Kb) (see Section 23.1). - writeInt32 os 0x100000; // Heap Reserve Size Always 0x100000 (1Mb) (see Section 23.1). - writeInt32 os 0x1000; // Heap Commit Size Always 0x1000 (4Kb) (see Section 23.1). + writeInt32 os size // Stack Reserve Size Always 0x100000 (1Mb) (see Section 23.1). + writeInt32 os 0x1000 // Stack Commit Size Always 0x1000 (4Kb) (see Section 23.1). + writeInt32 os 0x100000 // Heap Reserve Size Always 0x100000 (1Mb) (see Section 23.1). + writeInt32 os 0x1000 // Heap Commit Size Always 0x1000 (4Kb) (see Section 23.1). // 000000f0 - x86 location, moving on, for x64, add 0x10 - writeInt32 os 0x00; // Loader Flags Always 0 (see Section 23.1) - writeInt32 os 0x10; // Number of Data Directories: Always 0x10 (see Section 23.1). - writeInt32 os 0x00; - writeInt32 os 0x00; // Export Table Always 0 (see Section 23.1). + writeInt32 os 0x00 // Loader Flags Always 0 (see Section 23.1) + writeInt32 os 0x10 // Number of Data Directories: Always 0x10 (see Section 23.1). + writeInt32 os 0x00 + writeInt32 os 0x00 // Export Table Always 0 (see Section 23.1). // 00000100 - writeDirectory os importTableChunk; // Import Table RVA of Import Table, (see clause 24.3.1). e.g. 0000b530 + writeDirectory os importTableChunk // Import Table RVA of Import Table, (see clause 24.3.1). e.g. 0000b530 // Native Resource Table: ECMA says Always 0 (see Section 23.1), but mscorlib and other files with resources bound into executable do not. For the moment assume the resources table is always the first resource in the file. - writeDirectory os nativeResourcesChunk; + writeDirectory os nativeResourcesChunk // 00000110 - writeInt32 os 0x00; // Exception Table Always 0 (see Section 23.1). - writeInt32 os 0x00; // Exception Table Always 0 (see Section 23.1). - writeInt32 os 0x00; // Certificate Table Always 0 (see Section 23.1). - writeInt32 os 0x00; // Certificate Table Always 0 (see Section 23.1). + writeInt32 os 0x00 // Exception Table Always 0 (see Section 23.1). + writeInt32 os 0x00 // Exception Table Always 0 (see Section 23.1). + writeInt32 os 0x00 // Certificate Table Always 0 (see Section 23.1). + writeInt32 os 0x00 // Certificate Table Always 0 (see Section 23.1). // 00000120 - writeDirectory os baseRelocTableChunk; - writeDirectory os debugDirectoryChunk; // Debug Directory + writeDirectory os baseRelocTableChunk + writeDirectory os debugDirectoryChunk // Debug Directory // 00000130 - writeInt32 os 0x00; // Copyright Always 0 (see Section 23.1). - writeInt32 os 0x00; // Copyright Always 0 (see Section 23.1). - writeInt32 os 0x00; // Global Ptr Always 0 (see Section 23.1). - writeInt32 os 0x00; // Global Ptr Always 0 (see Section 23.1). + writeInt32 os 0x00 // Copyright Always 0 (see Section 23.1). + writeInt32 os 0x00 // Copyright Always 0 (see Section 23.1). + writeInt32 os 0x00 // Global Ptr Always 0 (see Section 23.1). + writeInt32 os 0x00 // Global Ptr Always 0 (see Section 23.1). // 00000140 - writeInt32 os 0x00; // Load Config Table Always 0 (see Section 23.1). - writeInt32 os 0x00; // Load Config Table Always 0 (see Section 23.1). - writeInt32 os 0x00; // TLS Table Always 0 (see Section 23.1). - writeInt32 os 0x00; // TLS Table Always 0 (see Section 23.1). + writeInt32 os 0x00 // Load Config Table Always 0 (see Section 23.1). + writeInt32 os 0x00 // Load Config Table Always 0 (see Section 23.1). + writeInt32 os 0x00 // TLS Table Always 0 (see Section 23.1). + writeInt32 os 0x00 // TLS Table Always 0 (see Section 23.1). // 00000150 - writeInt32 os 0x00; // Bound Import Always 0 (see Section 23.1). - writeInt32 os 0x00; // Bound Import Always 0 (see Section 23.1). - writeDirectory os importAddrTableChunk; // Import Addr Table, (see clause 24.3.1). e.g. 0x00002000 + writeInt32 os 0x00 // Bound Import Always 0 (see Section 23.1). + writeInt32 os 0x00 // Bound Import Always 0 (see Section 23.1). + writeDirectory os importAddrTableChunk // Import Addr Table, (see clause 24.3.1). e.g. 0x00002000 // 00000160 - writeInt32 os 0x00; // Delay Import Descriptor Always 0 (see Section 23.1). - writeInt32 os 0x00; // Delay Import Descriptor Always 0 (see Section 23.1). - writeDirectory os cliHeaderChunk; + writeInt32 os 0x00 // Delay Import Descriptor Always 0 (see Section 23.1). + writeInt32 os 0x00 // Delay Import Descriptor Always 0 (see Section 23.1). + writeDirectory os cliHeaderChunk // 00000170 - writeInt32 os 0x00; // Reserved Always 0 (see Section 23.1). - writeInt32 os 0x00; // Reserved Always 0 (see Section 23.1). + writeInt32 os 0x00 // Reserved Always 0 (see Section 23.1). + writeInt32 os 0x00 // Reserved Always 0 (see Section 23.1). - write (Some textSectionHeaderChunk.addr) os "text section header" [| |]; + write (Some textSectionHeaderChunk.addr) os "text section header" [| |] // 00000178 - writeBytes os [| 0x2euy; 0x74uy; 0x65uy; 0x78uy; 0x74uy; 0x00uy; 0x00uy; 0x00uy; |]; // ".text\000\000\000" + writeBytes os [| 0x2euy; 0x74uy; 0x65uy; 0x78uy; 0x74uy; 0x00uy; 0x00uy; 0x00uy; |] // ".text\000\000\000" // 00000180 - writeInt32 os textSectionSize; // VirtualSize: Total size of the section when loaded into memory in bytes rounded to Section Alignment. If this value is greater than Size of Raw Data, the section is zero-padded. e.g. 0x00009584 - writeInt32 os textSectionAddr; // VirtualAddress For executable images this is the address of the first byte of the section, when loaded into memory, relative to the image base. e.g. 0x00020000 - writeInt32 os textSectionPhysSize; // SizeOfRawData Size of the initialized data on disk in bytes, shall be a multiple of FileAlignment from the PE header. If this is less than VirtualSize the remainder of the section is zero filled. Because this field is rounded while the VirtualSize field is not it is possible for this to be greater than VirtualSize as well. When a section contains only uninitialized data, this field should be 0. 0x00009600 - writeInt32 os textSectionPhysLoc; // PointerToRawData RVA to section’s first page within the PE file. This shall be a multiple of FileAlignment from the optional header. When a section contains only uninitialized data, this field should be 0. e.g. 00000200 + writeInt32 os textSectionSize // VirtualSize: Total size of the section when loaded into memory in bytes rounded to Section Alignment. If this value is greater than Size of Raw Data, the section is zero-padded. e.g. 0x00009584 + writeInt32 os textSectionAddr // VirtualAddress For executable images this is the address of the first byte of the section, when loaded into memory, relative to the image base. e.g. 0x00020000 + writeInt32 os textSectionPhysSize // SizeOfRawData Size of the initialized data on disk in bytes, shall be a multiple of FileAlignment from the PE header. If this is less than VirtualSize the remainder of the section is zero filled. Because this field is rounded while the VirtualSize field is not it is possible for this to be greater than VirtualSize as well. When a section contains only uninitialized data, this field should be 0. 0x00009600 + writeInt32 os textSectionPhysLoc // PointerToRawData RVA to section’s first page within the PE file. This shall be a multiple of FileAlignment from the optional header. When a section contains only uninitialized data, this field should be 0. e.g. 00000200 // 00000190 - writeInt32 os 0x00; // PointerToRelocations RVA of Relocation section. - writeInt32 os 0x00; // PointerToLinenumbers Always 0 (see Section 23.1). + writeInt32 os 0x00 // PointerToRelocations RVA of Relocation section. + writeInt32 os 0x00 // PointerToLinenumbers Always 0 (see Section 23.1). // 00000198 - writeInt32AsUInt16 os 0x00;// NumberOfRelocations Number of relocations, set to 0 if unused. - writeInt32AsUInt16 os 0x00; // NumberOfLinenumbers Always 0 (see Section 23.1). - writeBytes os [| 0x20uy; 0x00uy; 0x00uy; 0x60uy |]; // Characteristics Flags describing section’s characteristics, see below. IMAGE_SCN_CNT_CODE || IMAGE_SCN_MEM_EXECUTE || IMAGE_SCN_MEM_READ + writeInt32AsUInt16 os 0x00// NumberOfRelocations Number of relocations, set to 0 if unused. + writeInt32AsUInt16 os 0x00 // NumberOfLinenumbers Always 0 (see Section 23.1). + writeBytes os [| 0x20uy; 0x00uy; 0x00uy; 0x60uy |] // Characteristics Flags describing section’s characteristics, see below. IMAGE_SCN_CNT_CODE || IMAGE_SCN_MEM_EXECUTE || IMAGE_SCN_MEM_READ - write (Some dataSectionHeaderChunk.addr) os "data section header" [| |]; + write (Some dataSectionHeaderChunk.addr) os "data section header" [| |] // 000001a0 - writeBytes os [| 0x2euy; 0x72uy; 0x73uy; 0x72uy; 0x63uy; 0x00uy; 0x00uy; 0x00uy; |]; // ".rsrc\000\000\000" - // writeBytes os [| 0x2e; 0x73; 0x64; 0x61; 0x74; 0x61; 0x00; 0x00; |]; // ".sdata\000\000" - writeInt32 os dataSectionSize; // VirtualSize: Total size of the section when loaded into memory in bytes rounded to Section Alignment. If this value is greater than Size of Raw Data, the section is zero-padded. e.g. 0x0000000c - writeInt32 os dataSectionAddr; // VirtualAddress For executable images this is the address of the first byte of the section, when loaded into memory, relative to the image base. e.g. 0x0000c000 + writeBytes os [| 0x2euy; 0x72uy; 0x73uy; 0x72uy; 0x63uy; 0x00uy; 0x00uy; 0x00uy; |] // ".rsrc\000\000\000" + // writeBytes os [| 0x2e; 0x73; 0x64; 0x61; 0x74; 0x61; 0x00; 0x00; |] // ".sdata\000\000" + writeInt32 os dataSectionSize // VirtualSize: Total size of the section when loaded into memory in bytes rounded to Section Alignment. If this value is greater than Size of Raw Data, the section is zero-padded. e.g. 0x0000000c + writeInt32 os dataSectionAddr // VirtualAddress For executable images this is the address of the first byte of the section, when loaded into memory, relative to the image base. e.g. 0x0000c000 // 000001b0 - writeInt32 os dataSectionPhysSize; // SizeOfRawData Size of the initialized data on disk in bytes, shall be a multiple of FileAlignment from the PE header. If this is less than VirtualSize the remainder of the section is zero filled. Because this field is rounded while the VirtualSize field is not it is possible for this to be greater than VirtualSize as well. When a section contains only uninitialized data, this field should be 0. e.g. 0x00000200 - writeInt32 os dataSectionPhysLoc; // PointerToRawData QUERY: Why does ECMA say "RVA" here? Offset to section’s first page within the PE file. This shall be a multiple of FileAlignment from the optional header. When a section contains only uninitialized data, this field should be 0. e.g. 0x00009800 + writeInt32 os dataSectionPhysSize // SizeOfRawData Size of the initialized data on disk in bytes, shall be a multiple of FileAlignment from the PE header. If this is less than VirtualSize the remainder of the section is zero filled. Because this field is rounded while the VirtualSize field is not it is possible for this to be greater than VirtualSize as well. When a section contains only uninitialized data, this field should be 0. e.g. 0x00000200 + writeInt32 os dataSectionPhysLoc // PointerToRawData QUERY: Why does ECMA say "RVA" here? Offset to section’s first page within the PE file. This shall be a multiple of FileAlignment from the optional header. When a section contains only uninitialized data, this field should be 0. e.g. 0x00009800 // 000001b8 - writeInt32 os 0x00; // PointerToRelocations RVA of Relocation section. - writeInt32 os 0x00; // PointerToLinenumbers Always 0 (see Section 23.1). + writeInt32 os 0x00 // PointerToRelocations RVA of Relocation section. + writeInt32 os 0x00 // PointerToLinenumbers Always 0 (see Section 23.1). // 000001c0 - writeInt32AsUInt16 os 0x00; // NumberOfRelocations Number of relocations, set to 0 if unused. - writeInt32AsUInt16 os 0x00; // NumberOfLinenumbers Always 0 (see Section 23.1). - writeBytes os [| 0x40uy; 0x00uy; 0x00uy; 0x40uy |]; // Characteristics Flags: IMAGE_SCN_MEM_READ | IMAGE_SCN_CNT_INITIALIZED_DATA + writeInt32AsUInt16 os 0x00 // NumberOfRelocations Number of relocations, set to 0 if unused. + writeInt32AsUInt16 os 0x00 // NumberOfLinenumbers Always 0 (see Section 23.1). + writeBytes os [| 0x40uy; 0x00uy; 0x00uy; 0x40uy |] // Characteristics Flags: IMAGE_SCN_MEM_READ | IMAGE_SCN_CNT_INITIALIZED_DATA - write (Some relocSectionHeaderChunk.addr) os "reloc section header" [| |]; + write (Some relocSectionHeaderChunk.addr) os "reloc section header" [| |] // 000001a0 - writeBytes os [| 0x2euy; 0x72uy; 0x65uy; 0x6cuy; 0x6fuy; 0x63uy; 0x00uy; 0x00uy; |]; // ".reloc\000\000" - writeInt32 os relocSectionSize; // VirtualSize: Total size of the section when loaded into memory in bytes rounded to Section Alignment. If this value is greater than Size of Raw Data, the section is zero-padded. e.g. 0x0000000c - writeInt32 os relocSectionAddr; // VirtualAddress For executable images this is the address of the first byte of the section, when loaded into memory, relative to the image base. e.g. 0x0000c000 + writeBytes os [| 0x2euy; 0x72uy; 0x65uy; 0x6cuy; 0x6fuy; 0x63uy; 0x00uy; 0x00uy; |] // ".reloc\000\000" + writeInt32 os relocSectionSize // VirtualSize: Total size of the section when loaded into memory in bytes rounded to Section Alignment. If this value is greater than Size of Raw Data, the section is zero-padded. e.g. 0x0000000c + writeInt32 os relocSectionAddr // VirtualAddress For executable images this is the address of the first byte of the section, when loaded into memory, relative to the image base. e.g. 0x0000c000 // 000001b0 - writeInt32 os relocSectionPhysSize; // SizeOfRawData Size of the initialized reloc on disk in bytes, shall be a multiple of FileAlignment from the PE header. If this is less than VirtualSize the remainder of the section is zero filled. Because this field is rounded while the VirtualSize field is not it is possible for this to be greater than VirtualSize as well. When a section contains only uninitialized reloc, this field should be 0. e.g. 0x00000200 - writeInt32 os relocSectionPhysLoc; // PointerToRawData QUERY: Why does ECMA say "RVA" here? Offset to section’s first page within the PE file. This shall be a multiple of FileAlignment from the optional header. When a section contains only uninitialized reloc, this field should be 0. e.g. 0x00009800 + writeInt32 os relocSectionPhysSize // SizeOfRawData Size of the initialized reloc on disk in bytes, shall be a multiple of FileAlignment from the PE header. If this is less than VirtualSize the remainder of the section is zero filled. Because this field is rounded while the VirtualSize field is not it is possible for this to be greater than VirtualSize as well. When a section contains only uninitialized reloc, this field should be 0. e.g. 0x00000200 + writeInt32 os relocSectionPhysLoc // PointerToRawData QUERY: Why does ECMA say "RVA" here? Offset to section’s first page within the PE file. This shall be a multiple of FileAlignment from the optional header. When a section contains only uninitialized reloc, this field should be 0. e.g. 0x00009800 // 000001b8 - writeInt32 os 0x00; // PointerToRelocations RVA of Relocation section. - writeInt32 os 0x00; // PointerToLinenumbers Always 0 (see Section 23.1). + writeInt32 os 0x00 // PointerToRelocations RVA of Relocation section. + writeInt32 os 0x00 // PointerToLinenumbers Always 0 (see Section 23.1). // 000001c0 - writeInt32AsUInt16 os 0x00; // NumberOfRelocations Number of relocations, set to 0 if unused. - writeInt32AsUInt16 os 0x00; // NumberOfLinenumbers Always 0 (see Section 23.1). - writeBytes os [| 0x40uy; 0x00uy; 0x00uy; 0x42uy |]; // Characteristics Flags: IMAGE_SCN_CNT_INITIALIZED_DATA | IMAGE_SCN_MEM_READ | + writeInt32AsUInt16 os 0x00 // NumberOfRelocations Number of relocations, set to 0 if unused. + writeInt32AsUInt16 os 0x00 // NumberOfLinenumbers Always 0 (see Section 23.1). + writeBytes os [| 0x40uy; 0x00uy; 0x00uy; 0x42uy |] // Characteristics Flags: IMAGE_SCN_CNT_INITIALIZED_DATA | IMAGE_SCN_MEM_READ | - writePadding os "pad to text begin" (textSectionPhysLoc - headerSize); + writePadding os "pad to text begin" (textSectionPhysLoc - headerSize) // TEXT SECTION: e.g. 0x200 let textV2P v = v - textSectionAddr + textSectionPhysLoc // e.g. 0x0200 - write (Some (textV2P importAddrTableChunk.addr)) os "import addr table" [| |]; - writeInt32 os importNameHintTableChunk.addr; - writeInt32 os 0x00; // QUERY 4 bytes of zeros not 2 like ECMA 24.3.1 says + write (Some (textV2P importAddrTableChunk.addr)) os "import addr table" [| |] + writeInt32 os importNameHintTableChunk.addr + writeInt32 os 0x00 // QUERY 4 bytes of zeros not 2 like ECMA 24.3.1 says // e.g. 0x0208 @@ -4340,106 +4338,106 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: let headerVersionMajor,headerVersionMinor = headerVersionSupportedByCLRVersion desiredMetadataVersion writePadding os "pad to cli header" cliHeaderPadding - write (Some (textV2P cliHeaderChunk.addr)) os "cli header" [| |]; - writeInt32 os 0x48; // size of header - writeInt32AsUInt16 os headerVersionMajor; // Major part of minimum version of CLR reqd. - writeInt32AsUInt16 os headerVersionMinor; // Minor part of minimum version of CLR reqd. ... + write (Some (textV2P cliHeaderChunk.addr)) os "cli header" [| |] + writeInt32 os 0x48 // size of header + writeInt32AsUInt16 os headerVersionMajor // Major part of minimum version of CLR reqd. + writeInt32AsUInt16 os headerVersionMinor // Minor part of minimum version of CLR reqd. ... // e.g. 0x0210 - writeDirectory os metadataChunk; - writeInt32 os flags; + writeDirectory os metadataChunk + writeInt32 os flags - writeInt32 os entryPointToken; - write None os "rest of cli header" [| |]; + writeInt32 os entryPointToken + write None os "rest of cli header" [| |] // e.g. 0x0220 - writeDirectory os resourcesChunk; - writeDirectory os strongnameChunk; + writeDirectory os resourcesChunk + writeDirectory os strongnameChunk // e.g. 0x0230 - writeInt32 os 0x00; // code manager table, always 0 - writeInt32 os 0x00; // code manager table, always 0 - writeDirectory os vtfixupsChunk; + writeInt32 os 0x00 // code manager table, always 0 + writeInt32 os 0x00 // code manager table, always 0 + writeDirectory os vtfixupsChunk // e.g. 0x0240 - writeInt32 os 0x00; // export addr table jumps, always 0 - writeInt32 os 0x00; // export addr table jumps, always 0 - writeInt32 os 0x00; // managed native header, always 0 - writeInt32 os 0x00; // managed native header, always 0 + writeInt32 os 0x00 // export addr table jumps, always 0 + writeInt32 os 0x00 // export addr table jumps, always 0 + writeInt32 os 0x00 // managed native header, always 0 + writeInt32 os 0x00 // managed native header, always 0 - writeBytes os code; - write None os "code padding" codePadding; + writeBytes os code + write None os "code padding" codePadding - writeBytes os metadata; + writeBytes os metadata // write 0x80 bytes of empty space for encrypted SHA1 hash, written by SN.EXE or call to signing API if signer <> None then - write (Some (textV2P strongnameChunk.addr)) os "strongname" (Array.create strongnameChunk.size 0x0uy); + write (Some (textV2P strongnameChunk.addr)) os "strongname" (Array.create strongnameChunk.size 0x0uy) - write (Some (textV2P resourcesChunk.addr)) os "raw resources" [| |]; - writeBytes os resources; - write (Some (textV2P rawdataChunk.addr)) os "raw data" [| |]; - writeBytes os data; + write (Some (textV2P resourcesChunk.addr)) os "raw resources" [| |] + writeBytes os resources + write (Some (textV2P rawdataChunk.addr)) os "raw data" [| |] + writeBytes os data writePadding os "start of import table" importTableChunkPrePadding // vtfixups would go here - write (Some (textV2P importTableChunk.addr)) os "import table" [| |]; + write (Some (textV2P importTableChunk.addr)) os "import table" [| |] - writeInt32 os importLookupTableChunk.addr; - writeInt32 os 0x00; - writeInt32 os 0x00; - writeInt32 os mscoreeStringChunk.addr; - writeInt32 os importAddrTableChunk.addr; - writeInt32 os 0x00; - writeInt32 os 0x00; - writeInt32 os 0x00; - writeInt32 os 0x00; - writeInt32 os 0x00; + writeInt32 os importLookupTableChunk.addr + writeInt32 os 0x00 + writeInt32 os 0x00 + writeInt32 os mscoreeStringChunk.addr + writeInt32 os importAddrTableChunk.addr + writeInt32 os 0x00 + writeInt32 os 0x00 + writeInt32 os 0x00 + writeInt32 os 0x00 + writeInt32 os 0x00 - write (Some (textV2P importLookupTableChunk.addr)) os "import lookup table" [| |]; - writeInt32 os importNameHintTableChunk.addr; - writeInt32 os 0x00; - writeInt32 os 0x00; - writeInt32 os 0x00; - writeInt32 os 0x00; + write (Some (textV2P importLookupTableChunk.addr)) os "import lookup table" [| |] + writeInt32 os importNameHintTableChunk.addr + writeInt32 os 0x00 + writeInt32 os 0x00 + writeInt32 os 0x00 + writeInt32 os 0x00 - write (Some (textV2P importNameHintTableChunk.addr)) os "import name hint table" [| |]; + write (Some (textV2P importNameHintTableChunk.addr)) os "import name hint table" [| |] // Two zero bytes of hint, then Case sensitive, null-terminated ASCII string containing name to import. // Shall _CorExeMain a .exe file _CorDllMain for a .dll file. if isDll then writeBytes os [| 0x00uy; 0x00uy; 0x5fuy; 0x43uy ; 0x6fuy; 0x72uy; 0x44uy; 0x6cuy; 0x6cuy; 0x4duy; 0x61uy; 0x69uy; 0x6euy; 0x00uy |] else - writeBytes os [| 0x00uy; 0x00uy; 0x5fuy; 0x43uy; 0x6fuy; 0x72uy; 0x45uy; 0x78uy; 0x65uy; 0x4duy; 0x61uy; 0x69uy; 0x6euy; 0x00uy |]; + writeBytes os [| 0x00uy; 0x00uy; 0x5fuy; 0x43uy; 0x6fuy; 0x72uy; 0x45uy; 0x78uy; 0x65uy; 0x4duy; 0x61uy; 0x69uy; 0x6euy; 0x00uy |] write (Some (textV2P mscoreeStringChunk.addr)) os "mscoree string" - [| 0x6duy; 0x73uy; 0x63uy; 0x6fuy ; 0x72uy; 0x65uy ; 0x65uy; 0x2euy ; 0x64uy; 0x6cuy ; 0x6cuy; 0x00uy ; |]; + [| 0x6duy; 0x73uy; 0x63uy; 0x6fuy ; 0x72uy; 0x65uy ; 0x65uy; 0x2euy ; 0x64uy; 0x6cuy ; 0x6cuy; 0x00uy ; |] - writePadding os "end of import tab" importTableChunkPadding; + writePadding os "end of import tab" importTableChunkPadding - writePadding os "head of entrypoint" 0x03; + writePadding os "head of entrypoint" 0x03 let ep = (imageBaseReal + textSectionAddr) write (Some (textV2P entrypointCodeChunk.addr)) os " entrypoint code" - [| 0xFFuy; 0x25uy; (* x86 Instructions for entry *) b0 ep; b1 ep; b2 ep; b3 ep |]; + [| 0xFFuy; 0x25uy; (* x86 Instructions for entry *) b0 ep; b1 ep; b2 ep; b3 ep |] if isItanium then write (Some (textV2P globalpointerCodeChunk.addr)) os " itanium global pointer" - [| 0x0uy; 0x0uy; 0x0uy; 0x0uy; 0x0uy; 0x0uy; 0x0uy; 0x0uy |]; + [| 0x0uy; 0x0uy; 0x0uy; 0x0uy; 0x0uy; 0x0uy; 0x0uy; 0x0uy |] if pdbfile.IsSome then - write (Some (textV2P debugDirectoryChunk.addr)) os "debug directory" (Array.create sizeof_IMAGE_DEBUG_DIRECTORY 0x0uy); - write (Some (textV2P debugDataChunk.addr)) os "debug data" (Array.create debugDataChunk.size 0x0uy); + write (Some (textV2P debugDirectoryChunk.addr)) os "debug directory" (Array.create sizeof_IMAGE_DEBUG_DIRECTORY 0x0uy) + write (Some (textV2P debugDataChunk.addr)) os "debug data" (Array.create debugDataChunk.size 0x0uy) - writePadding os "end of .text" (dataSectionPhysLoc - textSectionPhysLoc - textSectionSize); + writePadding os "end of .text" (dataSectionPhysLoc - textSectionPhysLoc - textSectionSize) // DATA SECTION match nativeResources with | [||] -> () | resources -> - write (Some (dataSectionVirtToPhys nativeResourcesChunk.addr)) os "raw native resources" [| |]; - writeBytes os resources; + write (Some (dataSectionVirtToPhys nativeResourcesChunk.addr)) os "raw native resources" [| |] + writeBytes os resources if dummydatap.size <> 0x0 then - write (Some (dataSectionVirtToPhys dummydatap.addr)) os "dummy data" [| 0x0uy |]; + write (Some (dataSectionVirtToPhys dummydatap.addr)) os "dummy data" [| 0x0uy |] - writePadding os "end of .rsrc" (relocSectionPhysLoc - dataSectionPhysLoc - dataSectionSize); + writePadding os "end of .rsrc" (relocSectionPhysLoc - dataSectionPhysLoc - dataSectionSize) // RELOC SECTION @@ -4461,10 +4459,10 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: [| b0 entrypointFixupBlock; b1 entrypointFixupBlock; b2 entrypointFixupBlock; b3 entrypointFixupBlock; 0x0cuy; 0x00uy; 0x00uy; 0x00uy; b0 reloc; b1 reloc; - b0 reloc2; b1 reloc2; |]; - writePadding os "end of .reloc" (imageEndSectionPhysLoc - relocSectionPhysLoc - relocSectionSize); + b0 reloc2; b1 reloc2; |] + writePadding os "end of .reloc" (imageEndSectionPhysLoc - relocSectionPhysLoc - relocSectionSize) - os.Close(); + os.Close() try FileSystemUtilites.setExecutablePermission outfile @@ -4475,13 +4473,13 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: // Looks like a finally... with e -> (try - os.Close(); + os.Close() FileSystem.FileDelete outfile - with _ -> ()); + with _ -> ()) reraise() - reportTime showTimes "Writing Image"; + reportTime showTimes "Writing Image" if dumpDebugInfo then DumpDebugInfo outfile pdbData @@ -4495,113 +4493,74 @@ let writeBinaryAndReportMappings (outfile, ilg, pdbfile: string option, signer: | Some fpdb -> try let idd = WritePdbInfo fixupOverlappingSequencePoints showTimes outfile fpdb pdbData - reportTime showTimes "Generate PDB Info"; + reportTime showTimes "Generate PDB Info" // Now we have the debug data we can go back and fill in the debug directory in the image let fs2 = new FileStream(outfile, FileMode.OpenOrCreate, FileAccess.Write, FileShare.Read, 0x1000, false) let os2 = new BinaryWriter(fs2) try // write the IMAGE_DEBUG_DIRECTORY - os2.BaseStream.Seek (int64 (textV2P debugDirectoryChunk.addr), SeekOrigin.Begin) |> ignore; - writeInt32 os2 idd.iddCharacteristics; // IMAGE_DEBUG_DIRECTORY.Characteristics - writeInt32 os2 timestamp; - writeInt32AsUInt16 os2 idd.iddMajorVersion; - writeInt32AsUInt16 os2 idd.iddMinorVersion; - writeInt32 os2 idd.iddType; - writeInt32 os2 idd.iddData.Length; // IMAGE_DEBUG_DIRECTORY.SizeOfData - writeInt32 os2 debugDataChunk.addr; // IMAGE_DEBUG_DIRECTORY.AddressOfRawData - writeInt32 os2 (textV2P debugDataChunk.addr);// IMAGE_DEBUG_DIRECTORY.PointerToRawData - - (* dprintf "idd.iddCharacteristics = %ld\n" idd.iddCharacteristics; - dprintf "iddMajorVersion = %ld\n" idd.iddMajorVersion; - dprintf "iddMinorVersion = %ld\n" idd.iddMinorVersion; - dprintf "iddType = %ld\n" idd.iddType; - dprintf "iddData = (%A) = %s\n" idd.iddData (System.Text.Encoding.UTF8.GetString idd.iddData); *) + os2.BaseStream.Seek (int64 (textV2P debugDirectoryChunk.addr), SeekOrigin.Begin) |> ignore + writeInt32 os2 idd.iddCharacteristics // IMAGE_DEBUG_DIRECTORY.Characteristics + writeInt32 os2 timestamp + writeInt32AsUInt16 os2 idd.iddMajorVersion + writeInt32AsUInt16 os2 idd.iddMinorVersion + writeInt32 os2 idd.iddType + writeInt32 os2 idd.iddData.Length // IMAGE_DEBUG_DIRECTORY.SizeOfData + writeInt32 os2 debugDataChunk.addr // IMAGE_DEBUG_DIRECTORY.AddressOfRawData + writeInt32 os2 (textV2P debugDataChunk.addr)// IMAGE_DEBUG_DIRECTORY.PointerToRawData + + (* dprintf "idd.iddCharacteristics = %ld\n" idd.iddCharacteristics + dprintf "iddMajorVersion = %ld\n" idd.iddMajorVersion + dprintf "iddMinorVersion = %ld\n" idd.iddMinorVersion + dprintf "iddType = %ld\n" idd.iddType + dprintf "iddData = (%A) = %s\n" idd.iddData (System.Text.Encoding.UTF8.GetString idd.iddData) *) // write the debug raw data as given us by the PDB writer - os2.BaseStream.Seek (int64 (textV2P debugDataChunk.addr), SeekOrigin.Begin) |> ignore; + os2.BaseStream.Seek (int64 (textV2P debugDataChunk.addr), SeekOrigin.Begin) |> ignore if debugDataChunk.size < idd.iddData.Length then - failwith "Debug data area is not big enough. Debug info may not be usable"; - writeBytes os2 idd.iddData; + failwith "Debug data area is not big enough. Debug info may not be usable" + writeBytes os2 idd.iddData os2.Close() with e -> - failwith ("Error while writing debug directory entry: "+e.Message); - (try os2.Close(); FileSystem.FileDelete outfile with _ -> ()); + failwith ("Error while writing debug directory entry: "+e.Message) + (try os2.Close(); FileSystem.FileDelete outfile with _ -> ()) reraise() with e -> reraise() - end; - reportTime showTimes "Finalize PDB"; + end + reportTime showTimes "Finalize PDB" /// Sign the binary. No further changes to binary allowed past this point! match signer with | None -> () | Some s -> try - s.SignFile outfile; + s.SignFile outfile s.Close() with e -> - failwith ("Warning: A call to StrongNameSignatureGeneration failed ("+e.Message+")"); - (try s.Close() with _ -> ()); - (try FileSystem.FileDelete outfile with _ -> ()); + failwith ("Warning: A call to StrongNameSignatureGeneration failed ("+e.Message+")") + (try s.Close() with _ -> ()) + (try FileSystem.FileDelete outfile with _ -> ()) () - reportTime showTimes "Signing Image"; + reportTime showTimes "Signing Image" //Finished writing and signing the binary and debug info... mappings type options = - { ilg: ILGlobals; - pdbfile: string option; - signer: ILStrongNameSigner option; - fixupOverlappingSequencePoints: bool; - emitTailcalls : bool; - showTimes: bool; + { ilg: ILGlobals + pdbfile: string option + signer: ILStrongNameSigner option + fixupOverlappingSequencePoints: bool + emitTailcalls : bool + showTimes: bool dumpDebugInfo:bool } -let WriteILBinary outfile (args: options) modul noDebugData = - ignore (writeBinaryAndReportMappings (outfile, args.ilg, args.pdbfile, args.signer, args.fixupOverlappingSequencePoints, args.emitTailcalls, args.showTimes, args.dumpDebugInfo) modul noDebugData) - - - -(****************************************************** -** Notes on supporting the Itanium ** -******************************************************* -IA64 codegen on the CLR isn’t documented, and getting it working involved a certain amount of reverse-engineering -peverify.exe and various binaries generated by ILAsm and other managed compiles. Here are some lessons learned, -documented for posterity and the 0 other people writing managed compilers for the Itanium: - -- Even if you’re not utilizing the global pointer in your Itanium binary, -you should be setting aside space for it in .text. (Preferably near the native stub.) -- PEVerify checks for two .reloc table entries on the Itanium - one for the native stub, and one -for the global pointer RVA. It doesn’t matter what you set these values to - -their addresses can be zeroed out, but they must have IMAGE_REL_BASED_DIR64 set! -(So, yes, you may find yourself setting this flag on an empty, unnecessary table slot!) -- On the Itanium, it’s best to have your tables qword aligned. (Though, peverify checks for dword alignment.) -- A different, weird set of DLL characteristics are necessary for the Itanium. -I won’t detail them here, but it’s interesting given that this field isn’t supposed to vary between platforms, -and is supposedly marked as deprecated. -- There are two schools to generating CLR binaries on for the Itanium - I’ll call them the “ALink” school -and the “ILAsm” school. - - The ALink school relies on some quirks in the CLR to omit a lot of stuff that, admittedly, isn’t necessary. The binaries are basically IL-only, with some flags set to make them nominally Itanium: - - It omits the .reloc table - - It doesn’t set aside memory for global pointer storage - - There’s no native stub - - There’s no import table, mscoree reference / startup symbol hint - - A manifest is inserted by default. - These omissions are understandable, given the platform/jitting/capabilities of the language, - but they’re basically relying on an idiosyncracy of the runtime to get away with creating a “bad” binary. - - - The ILAsm school actually writes everything out: - - It has a reloc table with the requisite two entries - - It sets aside memory for a global pointer, even if it doesn’t utilize one - - It actually inserts a native stub for the Itanium! (Though, I have no idea what - instructions, specifically, are emitted, and I couldn’t dig up the sources to ILAsm to - find out) - - There’s the requisite mscoree reference, etc. - - No manifest is inserted -*******************************************************) +let WriteILBinary (outfile, args, ilModule, noDebugData) = + ignore (writeBinaryAndReportMappings (outfile, args.ilg, args.pdbfile, args.signer, args.fixupOverlappingSequencePoints, args.emitTailcalls, args.showTimes, args.dumpDebugInfo) ilModule noDebugData) + diff --git a/src/absil/ilwrite.fsi b/src/absil/ilwrite.fsi index f63a65278eca5e35713bf053a0663242543a755b..2d9f6e4385ed22e2c41eccf78533f54ba725e539 100644 --- a/src/absil/ilwrite.fsi +++ b/src/absil/ilwrite.fsi @@ -16,21 +16,16 @@ type ILStrongNameSigner = static member OpenKeyContainer: string -> ILStrongNameSigner type options = - { ilg: ILGlobals - pdbfile: string option; - signer : ILStrongNameSigner option; - fixupOverlappingSequencePoints : bool; - emitTailcalls: bool; - showTimes : bool; - dumpDebugInfo : bool } + { ilg: ILGlobals + pdbfile: string option + signer : ILStrongNameSigner option + fixupOverlappingSequencePoints : bool + emitTailcalls: bool + showTimes : bool + dumpDebugInfo : bool } /// Write a binary to the file system. Extra configuration parameters can also be specified. -val WriteILBinary: - filename: string -> - options: options -> - input: ILModuleDef -> - noDebugData: bool -> - unit +val WriteILBinary: filename: string * options: options * input: ILModuleDef * noDebugData: bool -> unit diff --git a/src/fsharp/augment.fs b/src/fsharp/AugmentWithHashCompare.fs similarity index 98% rename from src/fsharp/augment.fs rename to src/fsharp/AugmentWithHashCompare.fs index 41c8e225d26ff530ea31335db73746f3b7ba780c..5b750bc75ffb1e04e1e92819bc34aaad94809aad 100644 --- a/src/fsharp/augment.fs +++ b/src/fsharp/AugmentWithHashCompare.fs @@ -1,7 +1,8 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. /// Generate the hash/compare functions we add to user-defined types by default. -module internal Microsoft.FSharp.Compiler.Augment +module internal Microsoft.FSharp.Compiler.AugmentWithHashCompare + open Internal.Utilities open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.AbstractIL @@ -14,7 +15,7 @@ open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.PrettyNaming open Microsoft.FSharp.Compiler.Lib -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.Infos let mkIComparableCompareToSlotSig g = @@ -189,7 +190,7 @@ let mkRecdCompare g tcref (tycon:Tycon) = let compe = mkILCallGetComparer g m let mkTest (fspec:RecdField) = let fty = fspec.FormalType - let fref = mkNestedRecdFieldRef tcref fspec + let fref = tcref.MakeNestedRecdFieldRef fspec let m = fref.Range mkCallGenericComparisonWithComparerOuter g m fty compe @@ -213,7 +214,7 @@ let mkRecdCompareWithComparer g tcref (tycon:Tycon) (_thisv,thise) (_,thate) com let mkTest (fspec:RecdField) = let fty = fspec.FormalType - let fref = mkNestedRecdFieldRef tcref fspec + let fref = tcref.MakeNestedRecdFieldRef fspec let m = fref.Range mkCallGenericComparisonWithComparerOuter g m fty compe @@ -237,7 +238,7 @@ let mkRecdEquality g tcref (tycon:Tycon) = let thisv,thatv,thise,thate = mkThisVarThatVar g m ty let mkTest (fspec:RecdField) = let fty = fspec.FormalType - let fref = mkNestedRecdFieldRef tcref fspec + let fref = tcref.MakeNestedRecdFieldRef fspec let m = fref.Range mkCallGenericEqualityEROuter g m fty (mkRecdFieldGetViaExprAddr(thise, fref, tinst, m)) @@ -258,7 +259,7 @@ let mkRecdEqualityWithComparer g tcref (tycon:Tycon) (_thisv,thise) thatobje (th let mkTest (fspec:RecdField) = let fty = fspec.FormalType - let fref = mkNestedRecdFieldRef tcref fspec + let fref = tcref.MakeNestedRecdFieldRef fspec let m = fref.Range mkCallGenericEqualityWithComparerOuter g m fty @@ -338,7 +339,7 @@ let mkUnionCompare g tcref (tycon:Tycon) = let expr = let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) let mkCase ucase = - let cref = mkNestedUnionCaseRef tcref ucase + let cref = tcref.MakeNestedUnionCaseRef ucase let m = cref.Range let thisucv,thisucve = mkCompGenLocal m "thisCast" (mkProvenUnionCaseTy cref tinst) let thatucv,thatucve = mkCompGenLocal m "objCast" (mkProvenUnionCaseTy cref tinst) @@ -395,7 +396,7 @@ let mkUnionCompareWithComparer g tcref (tycon:Tycon) (_thisv,thise) (thatv,thate let expr = let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) let mkCase ucase = - let cref = mkNestedUnionCaseRef tcref ucase + let cref = tcref.MakeNestedUnionCaseRef ucase let m = cref.Range let thisucv,thisucve = mkCompGenLocal m "thisCastu" (mkProvenUnionCaseTy cref tinst) let thatucv,thatucve = mkCompGenLocal m "thatCastu" (mkProvenUnionCaseTy cref tinst) @@ -454,7 +455,7 @@ let mkUnionEquality g tcref (tycon:Tycon) = let expr = let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) let mkCase ucase = - let cref = mkNestedUnionCaseRef tcref ucase + let cref = tcref.MakeNestedUnionCaseRef ucase let m = cref.Range let thisucv,thisucve = mkCompGenLocal m "thisCast" (mkProvenUnionCaseTy cref tinst) let thatucv,thatucve = mkCompGenLocal m "objCast" (mkProvenUnionCaseTy cref tinst) @@ -509,7 +510,7 @@ let mkUnionEqualityWithComparer g tcref (tycon:Tycon) (_thisv,thise) thatobje (t let expr = let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) let mkCase ucase = - let cref = mkNestedUnionCaseRef tcref ucase + let cref = tcref.MakeNestedUnionCaseRef ucase let m = cref.Range let thisucv,thisucve = mkCompGenLocal m "thisCastu" (mkProvenUnionCaseTy cref tinst) let thatucv,thatucve = mkCompGenLocal m "thatCastu" (mkProvenUnionCaseTy cref tinst) @@ -566,7 +567,7 @@ let mkRecdHashWithComparer g tcref (tycon:Tycon) compe = let thisv,thise = mkThisVar g m ty let mkFieldHash (fspec:RecdField) = let fty = fspec.FormalType - let fref = mkNestedRecdFieldRef tcref fspec + let fref = tcref.MakeNestedRecdFieldRef fspec let m = fref.Range let e = mkRecdFieldGetViaExprAddr(thise, fref, tinst, m) @@ -604,7 +605,7 @@ let mkUnionHashWithComparer g tcref (tycon:Tycon) compe = let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m ) let accv,acce = mkMutableCompGenLocal m "i" g.int_ty let mkCase i ucase1 = - let c1ref = mkNestedUnionCaseRef tcref ucase1 + let c1ref = tcref.MakeNestedUnionCaseRef ucase1 let ucv,ucve = mkCompGenLocal m "unionCase" (mkProvenUnionCaseTy c1ref tinst) let m = c1ref.Range let mkHash j (rfield:RecdField) = @@ -817,7 +818,7 @@ let TyconIsCandidateForAugmentationWithHash g tycon = TyconIsCandidateForAugment // IComparable semantics associated with F# types. //------------------------------------------------------------------------- -let slotImplMethod (final,c,slotsig) = +let slotImplMethod (final,c,slotsig) : ValMemberInfo = { ImplementedSlotSigs=[slotsig]; MemberFlags= { IsInstance=true; @@ -828,7 +829,7 @@ let slotImplMethod (final,c,slotsig) = IsImplemented=false; ApparentParent=c} -let nonVirtualMethod c = +let nonVirtualMethod c : ValMemberInfo = { ImplementedSlotSigs=[]; MemberFlags={ IsInstance=true; IsDispatchSlot=false; diff --git a/src/fsharp/augment.fsi b/src/fsharp/AugmentWithHashCompare.fsi similarity index 94% rename from src/fsharp/augment.fsi rename to src/fsharp/AugmentWithHashCompare.fsi index 602c0cc2bc06ad672fc7e21b7f0fc90f6ee964a6..5d0e7220be1dd876e3bf8d8326fb455e02cee327 100644 --- a/src/fsharp/augment.fsi +++ b/src/fsharp/AugmentWithHashCompare.fsi @@ -1,7 +1,7 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. /// Generate the hash/compare functions we add to user-defined types by default. -module internal Microsoft.FSharp.Compiler.Augment +module internal Microsoft.FSharp.Compiler.AugmentWithHashCompare open Internal.Utilities open Microsoft.FSharp.Compiler.AbstractIL @@ -9,7 +9,7 @@ open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.Tast -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals val CheckAugmentationAttribs : bool -> TcGlobals -> Import.ImportMap -> Tycon -> unit val TyconIsCandidateForAugmentationWithCompare : TcGlobals -> Tycon -> bool diff --git a/src/fsharp/formats.fs b/src/fsharp/CheckFormatStrings.fs similarity index 98% rename from src/fsharp/formats.fs rename to src/fsharp/CheckFormatStrings.fs index 12e79af2674652cbdeb942c6406a7fbfc2018736..b5bc537745cb502b6dd2f70cc9eacfbf8076a8ca 100644 --- a/src/fsharp/formats.fs +++ b/src/fsharp/CheckFormatStrings.fs @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. -module internal Microsoft.FSharp.Compiler.Formats +module internal Microsoft.FSharp.Compiler.CheckFormatStrings open Internal.Utilities open Microsoft.FSharp.Compiler @@ -11,7 +11,7 @@ open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.ConstraintSolver type FormatItem = Simple of TType | FuncAndVal diff --git a/src/fsharp/formats.fsi b/src/fsharp/CheckFormatStrings.fsi similarity index 72% rename from src/fsharp/formats.fsi rename to src/fsharp/CheckFormatStrings.fsi index 1016ef34cc468da3d09d599331038ff676c0c244..0773039671a375a5abb075d66374c9b61a5ab17f 100644 --- a/src/fsharp/formats.fsi +++ b/src/fsharp/CheckFormatStrings.fsi @@ -5,11 +5,12 @@ /// /// Must be updated if the Printf runtime component is updated. -module internal Microsoft.FSharp.Compiler.Formats +module internal Microsoft.FSharp.Compiler.CheckFormatStrings open Internal.Utilities open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.Tast +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.AbstractIL.Internal -val ParseFormatString : Range.range -> Env.TcGlobals -> string -> TType -> TType -> TType -> TType * TType +val ParseFormatString : Range.range -> TcGlobals -> string -> TType -> TType -> TType -> TType * TType diff --git a/src/fsharp/build.fs b/src/fsharp/CompileOps.fs similarity index 90% rename from src/fsharp/build.fs rename to src/fsharp/CompileOps.fs index cda122e9a8df3c0ae15d58f8e8159342f659cf7c..1f007f087fa9d9502ea795e3885cf8808361f0e5 100644 --- a/src/fsharp/build.fs +++ b/src/fsharp/CompileOps.fs @@ -1,28 +1,28 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. -/// Loading initial context, reporting errors etc. -module internal Microsoft.FSharp.Compiler.Build +/// Coordinating compiler operations - configuration, loading initial context, reporting errors etc. +module internal Microsoft.FSharp.Compiler.CompileOps + open System open System.Text open System.IO open System.Collections.Generic open Internal.Utilities open Internal.Utilities.Text +open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics -open Microsoft.FSharp.Compiler.Pickle +open Microsoft.FSharp.Compiler.TastPickle open Microsoft.FSharp.Compiler.Range -open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.TypeChecker open Microsoft.FSharp.Compiler.SR open Microsoft.FSharp.Compiler.DiagnosticMessage module Tc = Microsoft.FSharp.Compiler.TypeChecker -module SR = Microsoft.FSharp.Compiler.SR open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.Range @@ -31,14 +31,14 @@ open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.Tastops.DebugPrint -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.Lexhelp open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.Infos open Microsoft.FSharp.Compiler.ConstraintSolver open Microsoft.FSharp.Compiler.MSBuildResolver -open Microsoft.FSharp.Compiler.Typrelns -open Microsoft.FSharp.Compiler.Nameres +open Microsoft.FSharp.Compiler.TypeRelations +open Microsoft.FSharp.Compiler.NameResolution open Microsoft.FSharp.Compiler.PrettyNaming open Internal.Utilities.FileSystem open Internal.Utilities.Collections @@ -71,13 +71,13 @@ open FullCompiler // Some Globals //-------------------------------------------------------------------------- -let sigSuffixes = [".mli";".fsi"] +let FSharpSigFileSuffixes = [".mli";".fsi"] let mlCompatSuffixes = [".mli";".ml"] -let implSuffixes = [".ml";".fs";".fsscript";".fsx"] +let FSharpImplFileSuffixes = [".ml";".fs";".fsscript";".fsx"] let resSuffixes = [".resx"] -let scriptSuffixes = [".fsscript";".fsx"] -let doNotRequireNamespaceOrModuleSuffixes = [".mli";".ml"] @ scriptSuffixes -let lightSyntaxDefaultExtensions : string list = [ ".fs";".fsscript";".fsx";".fsi" ] +let FSharpScriptFileSuffixes = [".fsscript";".fsx"] +let doNotRequireNamespaceOrModuleSuffixes = [".mli";".ml"] @ FSharpScriptFileSuffixes +let FSharpLightSyntaxFileSuffixes : string list = [ ".fs";".fsscript";".fsx";".fsi" ] //---------------------------------------------------------------------------- @@ -102,7 +102,7 @@ exception HashLoadedScriptConsideredSource of range exception InvalidInternalsVisibleToAssemblyName of (*badName*)string * (*fileName option*) string option -let RangeOfError(err:PhasedError) = +let GetRangeOfError(err:PhasedError) = let rec RangeFromException = function | ErrorFromAddingConstraint(_,err2,_) -> RangeFromException err2 #if EXTENSIONTYPING @@ -154,8 +154,8 @@ let RangeOfError(err:PhasedError) = | FullAbstraction(_,m) | InterfaceNotRevealed(_,_,m) | WrappedError (_,m) - | Patcompile.MatchIncomplete (_,_,m) - | Patcompile.RuleNeverMatched m + | PatternMatchCompilation.MatchIncomplete (_,_,m) + | PatternMatchCompilation.RuleNeverMatched m | ValNotMutable(_,_,m) | ValNotLocal(_,_,m) | MissingFields(_,m) @@ -191,7 +191,6 @@ let RangeOfError(err:PhasedError) = | UnresolvedOverloading(_,_,_,m) | UnresolvedConversionOperator (_,_,_,m) | PossibleOverload(_,_,_, m) - //| PossibleBestOverload(_,_,m) | VirtualAugmentationOnNullValuedType(m) | NonVirtualAugmentationOnNullValuedType(m) | NonRigidTypar(_,_,_,_,_,m) @@ -266,8 +265,8 @@ let GetErrorNumber(err:PhasedError) = | LetRecEvaluatedOutOfOrder _ -> 22 | NameClash _ -> 23 // 24 cannot be reused - | Patcompile.MatchIncomplete _ -> 25 - | Patcompile.RuleNeverMatched _ -> 26 + | PatternMatchCompilation.MatchIncomplete _ -> 25 + | PatternMatchCompilation.RuleNeverMatched _ -> 26 | ValNotMutable _ -> 27 | ValNotLocal _ -> 28 | MissingFields _ -> 29 @@ -723,13 +722,9 @@ let OutputPhasedErrorR (os:System.Text.StringBuilder) (err:PhasedError) = os.Append(Duplicate2E().Format k (DecompileOpName s)) |> ignore | UndefinedName(_,k,id,_) -> os.Append(k (DecompileOpName id.idText)) |> ignore - - | InternalUndefinedTyconItem(f,tcref,s) -> - let _, errs = f((fullDisplayTextOfTyconRef tcref), s) - os.Append(errs) |> ignore - | InternalUndefinedItemRef(f,smr,ccuName,s) -> - let _, errs = f(smr, ccuName, s) - os.Append(errs) |> ignore + | InternalUndefinedItemRef(f,smr,ccuName,s) -> + let _, errs = f(smr, ccuName, s) + os.Append(errs) |> ignore | FieldNotMutable _ -> os.Append(FieldNotMutableE().Format) |> ignore | FieldsFromDifferentTypes (_,fref1,fref2,_) -> @@ -1203,7 +1198,7 @@ let OutputPhasedErrorR (os:System.Text.StringBuilder) (err:PhasedError) = #endif | FullAbstraction(s,_) -> os.Append(FullAbstractionE().Format s) |> ignore | WrappedError (exn,_) -> OutputExceptionR os exn - | Patcompile.MatchIncomplete (isComp,cexOpt,_) -> + | PatternMatchCompilation.MatchIncomplete (isComp,cexOpt,_) -> os.Append(MatchIncomplete1E().Format) |> ignore match cexOpt with | None -> () @@ -1211,7 +1206,7 @@ let OutputPhasedErrorR (os:System.Text.StringBuilder) (err:PhasedError) = | Some (cex,true) -> os.Append(MatchIncomplete3E().Format cex) |> ignore if isComp then os.Append(MatchIncomplete4E().Format) |> ignore - | Patcompile.RuleNeverMatched _ -> os.Append(RuleNeverMatchedE().Format) |> ignore + | PatternMatchCompilation.RuleNeverMatched _ -> os.Append(RuleNeverMatchedE().Format) |> ignore | ValNotMutable _ -> os.Append(ValNotMutableE().Format) |> ignore | ValNotLocal _ -> os.Append(ValNotLocalE().Format) |> ignore | ObsoleteError (s, _) @@ -1371,35 +1366,33 @@ let SanitizeFileName fileName implicitIncludeDir = with _ -> fileName +[] type ErrorLocation = - { - Range : range - File : string - TextRepresentation : string - IsEmpty : bool - } + { Range : range + File : string + TextRepresentation : string + IsEmpty : bool } +[] type CanonicalInformation = - { - ErrorNumber : int - Subcategory : string - TextRepresentation : string - } + { ErrorNumber : int + Subcategory : string + TextRepresentation : string } +[] type DetailedIssueInfo = - { - Location : ErrorLocation option - Canonical : CanonicalInformation - Message : string - } + { Location : ErrorLocation option + Canonical : CanonicalInformation + Message : string } +[] type ErrorOrWarning = | Short of bool * string | Long of bool * DetailedIssueInfo /// returns sequence that contains ErrorOrWarning for the given error + ErrorOrWarning for all related errors let CollectErrorOrWarning (implicitIncludeDir,showFullPaths,flattenErrors,errorStyle,warn, err:PhasedError) = - let outputWhere (showFullPaths,errorStyle) m = + let outputWhere (showFullPaths,errorStyle) m : ErrorLocation = if m = rangeStartup || m = rangeCmdArgs then { Range = m; TextRepresentation = ""; IsEmpty = true; File = "" } else @@ -1449,11 +1442,11 @@ let CollectErrorOrWarning (implicitIncludeDir,showFullPaths,flattenErrors,errorS let errors = ResizeArray() let report err = let OutputWhere(err) = - match RangeOfError err with + match GetRangeOfError err with | Some m -> Some(outputWhere (showFullPaths,errorStyle) m) | None -> None - let OutputCanonicalInformation(err:PhasedError,subcategory, errorNumber) = + let OutputCanonicalInformation(err:PhasedError,subcategory, errorNumber) : CanonicalInformation = let text = match errorStyle with // Show the subcategory for --vserrors so that we can fish it out in Visual Studio and use it to determine error stickiness. @@ -1469,7 +1462,7 @@ let CollectErrorOrWarning (implicitIncludeDir,showFullPaths,flattenErrors,errorS OutputPhasedError os mainError flattenErrors; os.ToString() - let entry = { Location = where; Canonical = canonical; Message = message } + let entry : DetailedIssueInfo = { Location = where; Canonical = canonical; Message = message } errors.Add ( ErrorOrWarning.Long( not warn, entry ) ) @@ -1484,7 +1477,7 @@ let CollectErrorOrWarning (implicitIncludeDir,showFullPaths,flattenErrors,errorS OutputPhasedError os err flattenErrors os.ToString() - let entry = { Location = relWhere; Canonical = relCanonical; Message = relMessage} + let entry : DetailedIssueInfo = { Location = relWhere; Canonical = relCanonical; Message = relMessage} errors.Add( ErrorOrWarning.Long (not warn, entry) ) | _ -> @@ -1514,9 +1507,9 @@ let rec OutputErrorOrWarning (implicitIncludeDir,showFullPaths,flattenErrors,err for e in errors do Printf.bprintf os "\n" match e with - | Short(_, txt) -> + | ErrorOrWarning.Short(_, txt) -> os.Append txt |> ignore - | Long(_, details) -> + | ErrorOrWarning.Long(_, details) -> match details.Location with | Some l when not l.IsEmpty -> os.Append(l.TextRepresentation) |> ignore | _ -> () @@ -1524,7 +1517,7 @@ let rec OutputErrorOrWarning (implicitIncludeDir,showFullPaths,flattenErrors,err os.Append( details.Message ) |> ignore let OutputErrorOrWarningContext prefix fileLineFn os err = - match RangeOfError err with + match GetRangeOfError err with | None -> () | Some m -> let filename = m.FileName @@ -1681,6 +1674,7 @@ type CompilerTarget = type ResolveAssemblyReferenceMode = Speculative | ReportErrors +/// Represents the file or string used for the --version flag type VersionFlag = | VersionString of string | VersionFile of string @@ -1741,7 +1735,7 @@ type ImportedAssembly = IsProviderGenerated: bool mutable TypeProviders: Tainted list; #endif - FSharpOptimizationData : Microsoft.FSharp.Control.Lazy> } + FSharpOptimizationData : Microsoft.FSharp.Control.Lazy> } type AvailableImportedAssembly = | ResolvedImportedAssembly of ImportedAssembly @@ -1958,7 +1952,7 @@ type TcConfigBuilder = mutable doTLR : bool (* run TLR pass? *) mutable doFinalSimplify : bool (* do final simplification pass *) mutable optsOn : bool (* optimizations are turned on *) - mutable optSettings : Opt.OptimizationSettings + mutable optSettings : Optimizer.OptimizationSettings mutable emitTailcalls : bool mutable lcid : int option @@ -2121,7 +2115,7 @@ type TcConfigBuilder = doTLR = false doFinalSimplify = false optsOn = false - optSettings = Opt.OptimizationSettings.Defaults + optSettings = Optimizer.OptimizationSettings.Defaults emitTailcalls = true lcid = None // See bug 6071 for product banner spec @@ -2155,7 +2149,7 @@ type TcConfigBuilder = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter) if sourceFiles = [] then errorR(Error(FSComp.SR.buildNoInputsSpecified(),rangeCmdArgs)); let ext() = match tcConfigB.target with Dll -> ".dll" | Module -> ".netmodule" | ConsoleExe | WinExe -> ".exe" - let implFiles = sourceFiles |> List.filter (fun lower -> List.exists (Filename.checkSuffix (String.lowercase lower)) implSuffixes) + let implFiles = sourceFiles |> List.filter (fun lower -> List.exists (Filename.checkSuffix (String.lowercase lower)) FSharpImplFileSuffixes) let outfile = match tcConfigB.outputFile, List.rev implFiles with | None,[] -> "out" + ext() @@ -2649,7 +2643,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = member tcConfig.ComputeLightSyntaxInitialStatus filename = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter) let lower = String.lowercase filename - let lightOnByDefault = List.exists (Filename.checkSuffix lower) lightSyntaxDefaultExtensions + let lightOnByDefault = List.exists (Filename.checkSuffix lower) FSharpLightSyntaxFileSuffixes if lightOnByDefault then (tcConfig.light <> Some(false)) else (tcConfig.light = Some(true) ) member tcConfig.GetAvailableLoadedSources() = @@ -2940,17 +2934,15 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = member tcConfig.CoreLibraryDllReference() = fslibReference -let warningMem n l = List.mem n l - -let ReportWarning (globalWarnLevel : int) (specificWarnOff : int list) (specificWarnOn : int list) err = +let ReportWarning (globalWarnLevel : int, specificWarnOff : int list, specificWarnOn : int list) err = let n = GetErrorNumber err - warningOn err globalWarnLevel specificWarnOn && not (warningMem n specificWarnOff) + warningOn err globalWarnLevel specificWarnOn && not (List.mem n specificWarnOff) -let ReportWarningAsError (globalWarnLevel : int) (specificWarnOff : int list) (specificWarnOn : int list) (specificWarnAsError : int list) (specificWarnAsWarn : int list) (globalWarnAsError : bool) err = - (warningOn err globalWarnLevel specificWarnOn) && - not(warningMem (GetErrorNumber err) specificWarnAsWarn) && - ((globalWarnAsError && not (warningMem (GetErrorNumber err) specificWarnOff)) || - warningMem (GetErrorNumber err) specificWarnAsError) +let ReportWarningAsError (globalWarnLevel : int, specificWarnOff : int list, specificWarnOn : int list, specificWarnAsError : int list, specificWarnAsWarn : int list, globalWarnAsError : bool) err = + warningOn err globalWarnLevel specificWarnOn && + not (List.mem (GetErrorNumber err) specificWarnAsWarn) && + ((globalWarnAsError && not (List.mem (GetErrorNumber err) specificWarnOff)) || + List.mem (GetErrorNumber err) specificWarnAsError) //---------------------------------------------------------------------------- // Scoped #nowarn pragmas @@ -2991,7 +2983,7 @@ type ErrorLoggerFilteringByScopedPragmas (checkFile,scopedPragmas,errorLogger:Er override x.WarnSinkImpl err = let report = let warningNum = GetErrorNumber err - match RangeOfError err with + match GetRangeOfError err with | Some m -> not (scopedPragmas |> List.exists (fun pragma -> match pragma with @@ -3033,7 +3025,7 @@ let CanonicalizeFilename filename = let IsScript filename = let lower = String.lowercase filename - scriptSuffixes |> List.exists (Filename.checkSuffix lower) + FSharpScriptFileSuffixes |> List.exists (Filename.checkSuffix lower) // Give a unique name to the different kinds of inputs. Used to correlate signature and implementation files // QualFileNameOfModuleName - files with a single module declaration or an anonymous module @@ -3041,7 +3033,7 @@ let QualFileNameOfModuleName m filename modname = QualifiedNameOfFile(mkSynId m let QualFileNameOfFilename m filename = QualifiedNameOfFile(mkSynId m (CanonicalizeFilename filename + (if IsScript filename then "$fsx" else ""))) // Interactive fragments -let QualFileNameOfUniquePath (m, p: string list) = QualifiedNameOfFile(mkSynId m (String.concat "_" p)) +let ComputeQualifiedNameOfFileFromUniquePath (m, p: string list) = QualifiedNameOfFile(mkSynId m (String.concat "_" p)) let QualFileNameOfSpecs filename specs = match specs with @@ -3053,7 +3045,7 @@ let QualFileNameOfImpls filename specs = | [SynModuleOrNamespace(modname,true,_,_,_,_,m)] -> QualFileNameOfModuleName m filename modname | _ -> QualFileNameOfFilename (rangeN filename 1) filename -let PrepandPathToQualFileName x (QualifiedNameOfFile(q)) = QualFileNameOfUniquePath (q.idRange,pathOfLid x@[q.idText]) +let PrepandPathToQualFileName x (QualifiedNameOfFile(q)) = ComputeQualifiedNameOfFileFromUniquePath (q.idRange,pathOfLid x@[q.idText]) let PrepandPathToImpl x (SynModuleOrNamespace(p,c,d,e,f,g,h)) = SynModuleOrNamespace(x@p,c,d,e,f,g,h) let PrepandPathToSpec x (SynModuleOrNamespaceSig(p,c,d,e,f,g,h)) = SynModuleOrNamespaceSig(x@p,c,d,e,f,g,h) @@ -3184,10 +3176,10 @@ let ParseInput (lexer,errorLogger:ErrorLogger,lexbuf:UnicodeLexing.Lexbuf,defaul if mlCompatSuffixes |> List.exists (Filename.checkSuffix lower) then mlCompatWarning (FSComp.SR.buildCompilingExtensionIsForML()) rangeStartup; - if implSuffixes |> List.exists (Filename.checkSuffix lower) then + if FSharpImplFileSuffixes |> List.exists (Filename.checkSuffix lower) then let impl = Parser.implementationFile lexer lexbuf PostParseModuleImpls (defaultNamespace,filename,isLastCompiland,impl) - elif sigSuffixes |> List.exists (Filename.checkSuffix lower) then + elif FSharpSigFileSuffixes |> List.exists (Filename.checkSuffix lower) then let intfs = Parser.signatureFile lexer lexbuf PostParseModuleSpecs (defaultNamespace,filename,isLastCompiland,intfs) else @@ -3213,7 +3205,7 @@ let ParseOneInputLexbuf (tcConfig:TcConfig,lexResourceManager,conditionalCompila let input = Lexhelp.usingLexbufForParsing (lexbuf,filename) (fun lexbuf -> if verbose then dprintn ("Parsing... "+shortFilename); - let tokenizer = Lexfilter.LexFilter(lightSyntaxStatus, tcConfig.compilingFslib, Lexer.token lexargs skip, lexbuf) + let tokenizer = LexFilter.LexFilter(lightSyntaxStatus, tcConfig.compilingFslib, Lexer.token lexargs skip, lexbuf) if tcConfig.tokenizeOnly then while true do @@ -3255,7 +3247,7 @@ let ParseOneInputLexbuf (tcConfig:TcConfig,lexResourceManager,conditionalCompila let ParseOneInputFile (tcConfig:TcConfig,lexResourceManager,conditionalCompilationDefines,filename,isLastCompiland,errorLogger,retryLocked) = try let lower = String.lowercase filename - if List.exists (Filename.checkSuffix lower) (sigSuffixes@implSuffixes) then + if List.exists (Filename.checkSuffix lower) (FSharpSigFileSuffixes@FSharpImplFileSuffixes) then if not(FileSystem.SafeExists(filename)) then error(Error(FSComp.SR.buildCouldNotFindSourceFile(filename),rangeStartup)) // bug 3155: if the file name is indirect, use a full path @@ -3330,7 +3322,7 @@ type TcAssemblyResolutions(results : AssemblyResolution list, unresolved : Unres #endif #if DEBUG let itFailed = ref false - let addedText = "\nIf you want to debug this right now, attach a debugger, and put a breakpoint in 'build.fs' near the text '!itFailed', and you can re-step through the assembly resolution logic." + let addedText = "\nIf you want to debug this right now, attach a debugger, and put a breakpoint in 'CompileOps.fs' near the text '!itFailed', and you can re-step through the assembly resolution logic." unresolved |> List.iter (fun (UnresolvedAssemblyReference(referenceText,_ranges)) -> if referenceText.Contains("mscorlib") then @@ -3363,7 +3355,6 @@ type TcAssemblyResolutions(results : AssemblyResolution list, unresolved : Unres //---------------------------------------------------------------------------- // Typecheck and optimization environments on disk //-------------------------------------------------------------------------- -open Pickle let IsSignatureDataResource (r: ILResource) = String.hasPrefix r.Name FSharpSignatureDataResourceName let IsOptimizationDataResource (r: ILResource) = String.hasPrefix r.Name FSharpOptimizationDataResourceName @@ -3393,38 +3384,30 @@ let PickleToResource file g scope rname p x = CustomAttrs = emptyILCustomAttrs } #endif -let GetSignatureData (file, ilScopeRef, ilModule, byteReader) : PickledDataWithReferences = - unpickleObjWithDanglingCcus file ilScopeRef ilModule unpickleModuleInfo (byteReader()) +let GetSignatureData (file, ilScopeRef, ilModule, byteReader) : PickledDataWithReferences = + unpickleObjWithDanglingCcus file ilScopeRef ilModule unpickleCcuInfo (byteReader()) #if NO_COMPILER_BACKEND #else let WriteSignatureData (tcConfig:TcConfig,tcGlobals,exportRemapping,ccu:CcuThunk,file) : ILResource = let mspec = ccu.Contents -#if DEBUG - if !verboseStamps then - dprintf "Signature data before remap:\n%s\n" (Layout.showL (Layout.squashTo 192 (entityL mspec))); - dprintf "---------------------- START OF APPLYING EXPORT REMAPPING TO SIGNATURE DATA------------\n"; -#endif let mspec = ApplyExportRemappingToEntity tcGlobals exportRemapping mspec -#if DEBUG - if !verboseStamps then - dprintf "---------------------- END OF APPLYING EXPORT REMAPPING TO SIGNATURE DATA------------\n"; - dprintf "Signature data after remap:\n%s\n" (Layout.showL (Layout.squashTo 192 (entityL mspec))); -#endif - PickleToResource file tcGlobals ccu (FSharpSignatureDataResourceName+"."+ccu.AssemblyName) pickleModuleInfo + PickleToResource file tcGlobals ccu (FSharpSignatureDataResourceName+"."+ccu.AssemblyName) pickleCcuInfo { mspec=mspec; compileTimeWorkingDir=tcConfig.implicitIncludeDir; usesQuotations = ccu.UsesFSharp20PlusQuotations } #endif // NO_COMPILER_BACKEND let GetOptimizationData (file, ilScopeRef, ilModule, byteReader) = - unpickleObjWithDanglingCcus file ilScopeRef ilModule Opt.u_LazyModuleInfo (byteReader()) + unpickleObjWithDanglingCcus file ilScopeRef ilModule Optimizer.u_CcuOptimizationInfo (byteReader()) #if NO_COMPILER_BACKEND #else let WriteOptimizationData (tcGlobals, file, ccu,modulInfo) = - if verbose then dprintf "Optimization data after remap:\n%s\n" (Layout.showL (Layout.squashTo 192 (Opt.moduleInfoL tcGlobals modulInfo))); - PickleToResource file tcGlobals ccu (FSharpOptimizationDataResourceName+"."+ccu.AssemblyName) Opt.p_LazyModuleInfo modulInfo +#if DEBUG + if verbose then dprintf "Optimization data after remap:\n%s\n" (Layout.showL (Layout.squashTo 192 (Optimizer.moduleInfoL tcGlobals modulInfo))); +#endif + PickleToResource file tcGlobals ccu (FSharpOptimizationDataResourceName+"."+ccu.AssemblyName) Optimizer.p_CcuOptimizationInfo modulInfo #endif //---------------------------------------------------------------------------- @@ -3440,10 +3423,17 @@ let availableToOptionalCcu = function // TcConfigProvider //-------------------------------------------------------------------------- +/// Represents a computation to return a TcConfig. Normally this is just a constant immutable TcConfig, +/// but for F# Interactive it may be based on an underlying mutable TcConfigBuilder. type TcConfigProvider = | TcConfigProvider of (unit -> TcConfig) member x.Get() = (let (TcConfigProvider(f)) = x in f()) + + /// Get a TcConfigProvider which will return only the exact TcConfig. static member Constant(tcConfig) = TcConfigProvider(fun () -> tcConfig) + + /// Get a TcConfigProvider which will continue to respect changes in the underlying + /// TcConfigBuilder rather than delivering snapshots. static member BasedOnMutableBuilder(tcConfigB) = TcConfigProvider(fun () -> TcConfig.Create(tcConfigB,validate=false)) @@ -3452,7 +3442,7 @@ type TcConfigProvider = //-------------------------------------------------------------------------- -/// Tables of imported assemblies. +/// Repreesnts a table of imported assemblies with their resolutions. [] type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResolutions, importsBase:TcImports option, ilGlobalsOpt) = @@ -3621,16 +3611,16 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti ILScopeRef = ilScopeRef; ILAssemblyRefs = ilAssemblyRefs } tcImports.RegisterDll(dllinfo); - let ccuData = + let ccuData : CcuData = { IsFSharp=false; UsesFSharp20PlusQuotations=false; - InvalidateEvent=(new Event<_>()).Publish; + InvalidateEvent=(new Event<_>()).Publish IsProviderGenerated = true - QualifiedName= Some (assembly.PUntaint((fun a -> a.FullName), m)); - Contents = NewCcuContents ilScopeRef m ilShortAssemName (NewEmptyModuleOrNamespaceType Namespace) ; - ILScopeRef = ilScopeRef; - Stamp = newStamp(); - SourceCodeDirectory = ""; + QualifiedName= Some (assembly.PUntaint((fun a -> a.FullName), m)) + Contents = NewCcuContents ilScopeRef m ilShortAssemName (NewEmptyModuleOrNamespaceType Namespace) + ILScopeRef = ilScopeRef + Stamp = newStamp() + SourceCodeDirectory = "" FileName = Some fileName MemberSignatureEquality = (fun ty1 ty2 -> Tastops.typeEquivAux EraseAll g ty1 ty2) ImportProvidedType = (fun ty -> Import.ImportProvidedType (tcImports.GetImportMap()) m ty) @@ -3638,14 +3628,14 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let ccu = CcuThunk.Create(ilShortAssemName,ccuData) let ccuinfo = - { FSharpViewOfMetadata=ccu; - ILScopeRef = ilScopeRef; - AssemblyAutoOpenAttributes = []; - AssemblyInternalsVisibleToAttributes = []; - IsProviderGenerated = true; - TypeProviders=[]; + { FSharpViewOfMetadata=ccu + ILScopeRef = ilScopeRef + AssemblyAutoOpenAttributes = [] + AssemblyInternalsVisibleToAttributes = [] + IsProviderGenerated = true + TypeProviders=[] FSharpOptimizationData = notlazy None } - tcImports.RegisterCcu(ccuinfo); + tcImports.RegisterCcu(ccuinfo) // Yes, it is generative true, dllinfo.ProviderGeneratedStaticLinkMap @@ -3691,7 +3681,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let pdbDir = (try Filename.directoryName filename with _ -> ".") let pdbFile = (try Filename.chopExtension filename with _ -> filename)+".pdb" if FileSystem.SafeExists pdbFile then - if verbose then dprintf "reading PDB file %s from directory %s\n" pdbFile pdbDir; + if verbose then dprintf "reading PDB file %s from directory %s\n" pdbFile pdbDir Some pdbDir else None @@ -3700,7 +3690,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let ilILBinaryReader = OpenILBinary(filename,tcConfig.optimizeForMemory,tcConfig.openBinariesInMemory,ilGlobalsOpt,pdbPathOption, tcConfig.primaryAssembly.Name, tcConfig.noDebugData, tcConfig.shadowCopyReferences) - tcImports.AttachDisposeAction(fun _ -> ILBinaryReader.CloseILModuleReader ilILBinaryReader); + tcImports.AttachDisposeAction(fun _ -> ILBinaryReader.CloseILModuleReader ilILBinaryReader) ilILBinaryReader.ILModuleDef, ilILBinaryReader.ILAssemblyRefs with e -> error(Error(FSComp.SR.buildErrorOpeningBinaryFile(filename, e.Message),m)) @@ -3882,7 +3872,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti match providers with | [] -> if wasApproved then - warning(Error(FSComp.SR.etHostingAssemblyFoundWithoutHosts(fileNameOfRuntimeAssembly,typeof.FullName),m)); + warning(Error(FSComp.SR.etHostingAssemblyFoundWithoutHosts(fileNameOfRuntimeAssembly,typeof.FullName),m)) | _ -> if typeProviderEnvironment.showResolutionMessages then @@ -3948,7 +3938,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti | _ -> error(InternalError("PrepareToImportReferencedIlDll: cannot reference .NET netmodules directly, reference the containing assembly instead",m)) let nm = aref.Name - if verbose then dprintn ("Converting IL assembly to F# data structures "+nm); + if verbose then dprintn ("Converting IL assembly to F# data structures "+nm) let auxModuleLoader = tcImports.MkLoaderForMultiModuleIlAssemblies m let invalidateCcu = new Event<_>() let ccu = Import.ImportILAssembly(tcImports.GetImportMap,m,auxModuleLoader,ilScopeRef,tcConfig.implicitIncludeDir, Some filename,ilModule,invalidateCcu.Publish) @@ -3956,16 +3946,16 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let ilg = defaultArg ilGlobalsOpt EcmaILGlobals let ccuinfo = - { FSharpViewOfMetadata=ccu; - ILScopeRef = ilScopeRef; - AssemblyAutoOpenAttributes = GetAutoOpenAttributes ilg ilModule; - AssemblyInternalsVisibleToAttributes = GetInternalsVisibleToAttributes ilg ilModule; + { FSharpViewOfMetadata=ccu + ILScopeRef = ilScopeRef + AssemblyAutoOpenAttributes = GetAutoOpenAttributes ilg ilModule + AssemblyInternalsVisibleToAttributes = GetInternalsVisibleToAttributes ilg ilModule #if EXTENSIONTYPING - IsProviderGenerated = false; - TypeProviders = []; + IsProviderGenerated = false + TypeProviders = [] #endif FSharpOptimizationData = notlazy None } - tcImports.RegisterCcu(ccuinfo); + tcImports.RegisterCcu(ccuinfo) let phase2 () = #if EXTENSIONTYPING ccuinfo.TypeProviders <- tcImports.ImportTypeProviderExtensions (tpApprovals, displayPSTypeProviderSecurityDialogBlockingUI, tcConfig, filename, ilScopeRef, ilModule.ManifestOfAssembly.CustomAttrs.AsList, ccu.Contents, invalidateCcu, m) @@ -3985,14 +3975,14 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let ilModule = dllinfo.RawMetadata let ilScopeRef = dllinfo.ILScopeRef let ilShortAssemName = getNameOfScopeRef ilScopeRef - if verbose then dprintn ("Converting F# assembly to F# data structures "+(getNameOfScopeRef ilScopeRef)); + if verbose then dprintn ("Converting F# assembly to F# data structures "+(getNameOfScopeRef ilScopeRef)) let attrs = GetCustomAttributesOfIlModule ilModule - assert (List.exists IsSignatureDataVersionAttr attrs); - if verbose then dprintn ("Relinking interface info from F# assembly "+ilShortAssemName); + assert (List.exists IsSignatureDataVersionAttr attrs) + if verbose then dprintn ("Relinking interface info from F# assembly "+ilShortAssemName) let resources = ilModule.Resources.AsList let externalSigAndOptData = ["FSharp.Core";"FSharp.LanguageService.Compiler"] if not(List.contains ilShortAssemName externalSigAndOptData) then - assert (List.exists IsSignatureDataResource resources); + assert (List.exists IsSignatureDataResource resources) let optDataReaders = resources |> List.choose (fun r -> if IsOptimizationDataResource r then Some(GetOptimizationDataResourceName r,r.GetByteReader(m)) else None) @@ -4009,9 +3999,9 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti if List.contains ilShortAssemName externalSigAndOptData then let sigFileName = Path.ChangeExtension(filename, "sigdata") if not sigDataReaders.IsEmpty then - error(Error(FSComp.SR.buildDidNotExpectSigdataResource(),m)); + error(Error(FSComp.SR.buildDidNotExpectSigdataResource(),m)) if not (FileSystem.SafeExists sigFileName) then - error(Error(FSComp.SR.buildExpectedSigdataFile(), m)); + error(Error(FSComp.SR.buildExpectedSigdataFile(), m)) [ (ilShortAssemName, (fun () -> FileSystem.ReadAllBytesShim sigFileName))] else sigDataReaders @@ -4024,16 +4014,16 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti if List.contains ilShortAssemName externalSigAndOptData then let optDataFile = Path.ChangeExtension(filename, "optdata") if not optDataReaders.IsEmpty then - error(Error(FSComp.SR.buildDidNotExpectOptDataResource(),m)); + error(Error(FSComp.SR.buildDidNotExpectOptDataResource(),m)) if not (FileSystem.SafeExists optDataFile) then - error(Error(FSComp.SR.buildExpectedFileAlongSideFSharpCore(optDataFile),m)); + error(Error(FSComp.SR.buildExpectedFileAlongSideFSharpCore(optDataFile),m)) [ (ilShortAssemName, (fun () -> FileSystem.ReadAllBytesShim optDataFile))] else optDataReaders let optDatas = Map.ofList optDataReaders - let minfo : PickledModuleInfo = data.RawData + let minfo : PickledCcuInfo = data.RawData let mspec = minfo.mspec #if EXTENSIONTYPING @@ -4112,7 +4102,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let phase2 () = (* Relink *) (* dprintf "Phase2: %s\n" filename; REMOVE DIAGNOSTICS *) - ccuRawDataAndInfos |> List.iter (fun (data,_,_) -> data.OptionalFixup(fun nm -> availableToOptionalCcu(tcImports.FindCcu(m,nm,lookupOnly=false))) |> ignore); + ccuRawDataAndInfos |> List.iter (fun (data,_,_) -> data.OptionalFixup(fun nm -> availableToOptionalCcu(tcImports.FindCcu(m,nm,lookupOnly=false))) |> ignore) #if EXTENSIONTYPING ccuRawDataAndInfos |> List.iter (fun (_,_,phase2) -> phase2()) #endif @@ -4344,7 +4334,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti sysCcu.FSharpViewOfMetadata else let search = - seq { yield sysCcu.FSharpViewOfMetadata; + seq { yield sysCcu.FSharpViewOfMetadata yield! frameworkTcImports.GetCcusInDeclOrder() for dllName in SystemAssemblies tcConfig.primaryAssembly.Name do match frameworkTcImports.CcuTable.TryFind dllName with @@ -4423,11 +4413,8 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti disposeActions <- [] for action in actions do action() -//---------------------------------------------------------------------------- -// Add "#r" and "#I" declarations to the tcConfig -//-------------------------------------------------------------------------- - -// Add the reference and add the ccu to the type checking environment . Only used by F# Interactive +/// Process #r in F# Interactive. +/// Adds the reference to the tcImports and add the ccu to the type checking environment. let RequireDLL (tcImports:TcImports) tcEnv m file = let RequireResolved = function | ResolvedImportedAssembly(ccuinfo) -> ccuinfo @@ -4573,29 +4560,34 @@ let ApplyMetaCommandsFromInputToTcConfig (tcConfig:TcConfig) (inp:ParsedInput,pa ProcessMetaCommandsFromInput (getWarningNumber, addReferencedAssemblyByPath, addLoadedSource) tcConfigB inp pathOfMetaCommandSource () TcConfig.Create(tcConfigB,validate=false) -let GetAssemblyResolutionInformation(tcConfig : TcConfig) : AssemblyResolution list * UnresolvedAssemblyReference list = +//---------------------------------------------------------------------------- +// Compute the load closure of a set of script files +//-------------------------------------------------------------------------- + +let GetAssemblyResolutionInformation(tcConfig : TcConfig) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter) let assemblyList = TcAssemblyResolutions.GetAllDllReferences(tcConfig) let resolutions = TcAssemblyResolutions.Resolve(tcConfig,assemblyList,[]) resolutions.GetAssemblyResolutions(),resolutions.GetUnresolvedReferences() -type LoadClosure = { - /// The source files along with the ranges of the #load positions in each file. - SourceFiles: (string * range list) list - /// The resolved references along with the ranges of the #r positions in each file. - References: (string * AssemblyResolution list) list - /// The list of references that were not resolved during load closure. These may still be extension references. - UnresolvedReferences : UnresolvedAssemblyReference list - /// The list of all sources in the closure with inputs when available - Inputs: (string * ParsedInput option) list - /// The #nowarns - NoWarns: (string * range list) list - /// Errors seen while parsing root of closure - RootErrors : PhasedError list - /// Warnings seen while parsing root of closure - RootWarnings : PhasedError list - } - +[] +type LoadClosure = + { /// The source files along with the ranges of the #load positions in each file. + SourceFiles: (string * range list) list + /// The resolved references along with the ranges of the #r positions in each file. + References: (string * AssemblyResolution list) list + /// The list of references that were not resolved during load closure. These may still be extension references. + UnresolvedReferences : UnresolvedAssemblyReference list + /// The list of all sources in the closure with inputs when available + Inputs: (string * ParsedInput option) list + /// The #nowarns + NoWarns: (string * range list) list + /// Errors seen while parsing root of closure + RootErrors : PhasedError list + /// Warnings seen while parsing root of closure + RootWarnings : PhasedError list } + + [] type CodeContext = | Evaluation // in fsi.exe @@ -4606,11 +4598,11 @@ type CodeContext = module private ScriptPreprocessClosure = open Internal.Utilities.Text.Lexing - type private ClosureDirective = + type ClosureDirective = | SourceFile of string * range * string // filename, range, source text | ClosedSourceFile of string * range * ParsedInput option * PhasedError list * PhasedError list * (string * range) list // filename, range, errors, warnings, nowarns - type private Observed() = + type Observed() = let seen = System.Collections.Generic.Dictionary<_,bool>() member ob.SetSeen(check) = if not(seen.ContainsKey(check)) then @@ -4638,7 +4630,7 @@ module private ScriptPreprocessClosure = ParseOneInputLexbuf (tcConfig,lexResourceManager,defines,lexbuf,filename,isLastCompiland,errorLogger) /// Create a TcConfig for load closure starting from a single .fsx file - let CreateScriptSourceTcConfig(filename:string,codeContext) = + let CreateScriptSourceTcConfig (filename:string, codeContext) = let projectDir = Path.GetDirectoryName(filename) let isInteractive = (codeContext = CodeContext.Evaluation) let isInvalidationSupported = (codeContext = CodeContext.Editing) @@ -4656,7 +4648,7 @@ module private ScriptPreprocessClosure = tcConfigB.implicitlyResolveAssemblies <- false TcConfig.Create(tcConfigB,validate=true) - let private SourceFileOfFilename(filename,m,inputCodePage:int option) : ClosureDirective list = + let SourceFileOfFilename(filename,m,inputCodePage:int option) : ClosureDirective list = try let filename = FileSystem.SafeGetFullPath(filename) use stream = FileSystem.FileStreamReadShim filename @@ -4689,7 +4681,7 @@ module private ScriptPreprocessClosure = let tcConfigB = tcConfig.CloneOfOriginalBuilder TcConfig.Create(tcConfigB,validate=false),nowarns - let private FindClosureDirectives(closureDirectives,tcConfig:TcConfig,codeContext,lexResourceManager:Lexhelp.LexResourceManager) = + let FindClosureDirectives(closureDirectives,tcConfig:TcConfig,codeContext,lexResourceManager:Lexhelp.LexResourceManager) = let tcConfig = ref tcConfig let observedSources = Observed() @@ -4732,7 +4724,7 @@ module private ScriptPreprocessClosure = closureDirectives |> List.map FindClosure |> List.concat, !tcConfig /// Reduce the full directive closure into LoadClosure - let private GetLoadClosure(rootFilename,closureDirectives,tcConfig,codeContext) = + let GetLoadClosure(rootFilename,closureDirectives,tcConfig,codeContext) = // Mark the last file as isLastCompiland. closureDirectives is currently reversed. let closureDirectives = @@ -4745,15 +4737,14 @@ module private ScriptPreprocessClosure = let sourceFiles = ref [] let sourceInputs = ref [] let globalNoWarns = ref [] - let ExtractOne = function + for directive in closureDirectives do + match directive with | ClosedSourceFile(filename,m,input,_,_,noWarns) -> let filename = FileSystem.SafeGetFullPath(filename) sourceFiles := (filename,m) :: !sourceFiles globalNoWarns := (!globalNoWarns @ noWarns) sourceInputs := (filename,input) :: !sourceInputs | _ -> failwith "Unexpected" - - closureDirectives |> List.iter ExtractOne // This unreverses the list of sources // Resolve all references. let resolutionErrors = ref [] @@ -4776,7 +4767,7 @@ module private ScriptPreprocessClosure = | _ -> [],[] // When no file existed. let isRootRange exn = - match RangeOfError exn with + match GetRangeOfError exn with | Some m -> // Return true if the error was *not* from a #load-ed file. let isArgParameterWhileNotEditing = (codeContext <> CodeContext.Editing) && (m = range0 || m = rangeStartup || m = rangeCmdArgs) @@ -4788,17 +4779,18 @@ module private ScriptPreprocessClosure = let rootErrors = rootErrors |> List.filter isRootRange let rootWarnings = rootWarnings |> List.filter isRootRange - let result = {SourceFiles = List.groupByFirst !sourceFiles - References = List.groupByFirst references - UnresolvedReferences = unresolvedReferences - Inputs = !sourceInputs - NoWarns = List.groupByFirst !globalNoWarns - RootErrors = rootErrors - RootWarnings = rootWarnings} + let result : LoadClosure = + { SourceFiles = List.groupByFirst !sourceFiles + References = List.groupByFirst references + UnresolvedReferences = unresolvedReferences + Inputs = !sourceInputs + NoWarns = List.groupByFirst !globalNoWarns + RootErrors = rootErrors + RootWarnings = rootWarnings} + result - - /// Given source text, find the full load closure - /// Used from service.fs, when editing a script file + + /// Given source text, find the full load closure. Used from service.fs, when editing a script file let GetFullClosureOfScriptSource(filename,source,codeContext,lexResourceManager:Lexhelp.LexResourceManager) = let tcConfig = CreateScriptSourceTcConfig(filename,codeContext) let protoClosure = [SourceFile(filename,range0,source)] @@ -4815,30 +4807,27 @@ module private ScriptPreprocessClosure = type LoadClosure with // Used from service.fs, when editing a script file - static member ComputeClosureOfSourceText(filename:string,source:string,codeContext,lexResourceManager:Lexhelp.LexResourceManager) : LoadClosure = + static member ComputeClosureOfSourceText (filename:string, source:string, codeContext, lexResourceManager:Lexhelp. LexResourceManager) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parse) - ScriptPreprocessClosure.GetFullClosureOfScriptSource(filename,source,codeContext,lexResourceManager) + ScriptPreprocessClosure.GetFullClosureOfScriptSource (filename, source, codeContext, lexResourceManager) /// Used from fsi.fs and fsc.fs, for #load and command line. /// The resulting references are then added to a TcConfig. - static member ComputeClosureOfSourceFiles(tcConfig:TcConfig,files:(string*range) list,codeContext,useDefaultScriptingReferences:bool,lexResourceManager:Lexhelp.LexResourceManager) : LoadClosure = + static member ComputeClosureOfSourceFiles (tcConfig:TcConfig, files:(string*range) list, codeContext, useDefaultScriptingReferences:bool, lexResourceManager:Lexhelp.LexResourceManager) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parse) - ScriptPreprocessClosure.GetFullClosureOfScriptFiles(tcConfig,files,codeContext,useDefaultScriptingReferences,lexResourceManager) + ScriptPreprocessClosure.GetFullClosureOfScriptFiles (tcConfig, files, codeContext, useDefaultScriptingReferences, lexResourceManager) //---------------------------------------------------------------------------- -// Build the initial type checking environment +// Initial type checking environment //-------------------------------------------------------------------------- -let implicitOpen tcGlobals amap m tcEnv p = - if verbose then dprintf "opening %s\n" p - Tc.TcOpenDecl TcResultsSink.NoSink tcGlobals amap m m tcEnv (pathToSynLid m (splitNamespace p)) - -let GetInitialTypecheckerEnv (assemblyName:string option) (initm:range) (tcConfig:TcConfig) (tcImports:TcImports) tcGlobals = +/// Build the initial type checking environment +let GetInitialTcEnv (assemblyName:string option, initm:range, tcConfig:TcConfig, tcImports:TcImports, tcGlobals) = let initm = initm.StartRange - if verbose then dprintf "--- building initial tcEnv\n" - let internalsAreVisibleHere (ccuinfo:ImportedAssembly) = + + let internalsAreVisibleHere (asm:ImportedAssembly) = match assemblyName with | None -> false | Some assemblyName -> @@ -4846,30 +4835,56 @@ let GetInitialTypecheckerEnv (assemblyName:string option) (initm:range) (tcConfi try System.Reflection.AssemblyName(visibleTo).Name = assemblyName with e -> - warning(InvalidInternalsVisibleToAssemblyName(visibleTo,ccuinfo.FSharpViewOfMetadata.FileName)) + warning(InvalidInternalsVisibleToAssemblyName(visibleTo,asm.FSharpViewOfMetadata.FileName)) false - let internalsVisibleTos = ccuinfo.AssemblyInternalsVisibleToAttributes + let internalsVisibleTos = asm.AssemblyInternalsVisibleToAttributes List.exists isTargetAssemblyName internalsVisibleTos - let ccus = tcImports.GetImportedAssemblies() |> List.map (fun ccuinfo -> ccuinfo.FSharpViewOfMetadata, - ccuinfo.AssemblyAutoOpenAttributes, - ccuinfo |> internalsAreVisibleHere) + + let ccus = + tcImports.GetImportedAssemblies() + |> List.map (fun asm -> asm.FSharpViewOfMetadata, asm.AssemblyAutoOpenAttributes, asm |> internalsAreVisibleHere) + let amap = tcImports.GetImportMap() - let tcEnv = Tc.CreateInitialTcEnv(tcGlobals,amap,initm,ccus) |> (fun tce -> - if tcConfig.checkOverflow then - List.fold (implicitOpen tcGlobals amap initm) tce [FSharpLib.CoreOperatorsCheckedName] - else - tce) - if verbose then dprintf "--- opening implicit paths\n" - if verbose then dprintf "--- GetInitialTypecheckerEnv, top modules = %s\n" (String.concat ";" (NameMap.domainL tcEnv.NameEnv.eModulesAndNamespaces)) - if verbose then dprintf "<-- GetInitialTypecheckerEnv\n" + + let tcEnv = Tc.CreateInitialTcEnv(tcGlobals, amap, initm, ccus) + + let tcEnv = + if tcConfig.checkOverflow then + Tc.TcOpenDecl TcResultsSink.NoSink tcGlobals amap initm initm tcEnv (pathToSynLid initm (splitNamespace FSharpLib.CoreOperatorsCheckedName)) + else + tcEnv tcEnv //---------------------------------------------------------------------------- -// TYPECHECK -//-------------------------------------------------------------------------- +// Fault injection -(* The incremental state of type checking files *) -(* REVIEW: clean this up *) +/// Inject faults into checking +let CheckSimulateException(tcConfig:TcConfig) = + match tcConfig.simulateException with + | Some("tc-oom") -> raise(System.OutOfMemoryException()) + | Some("tc-an") -> raise(System.ArgumentNullException("simulated")) + | Some("tc-invop") -> raise(System.InvalidOperationException()) + | Some("tc-av") -> raise(System.AccessViolationException()) + | Some("tc-aor") -> raise(System.ArgumentOutOfRangeException()) + | Some("tc-dv0") -> raise(System.DivideByZeroException()) + | Some("tc-nfn") -> raise(System.NotFiniteNumberException()) + | Some("tc-oe") -> raise(System.OverflowException()) + | Some("tc-atmm") -> raise(System.ArrayTypeMismatchException()) + | Some("tc-bif") -> raise(System.BadImageFormatException()) + | Some("tc-knf") -> raise(System.Collections.Generic.KeyNotFoundException()) + | Some("tc-ior") -> raise(System.IndexOutOfRangeException()) + | Some("tc-ic") -> raise(System.InvalidCastException()) + | Some("tc-ip") -> raise(System.InvalidProgramException()) + | Some("tc-ma") -> raise(System.MemberAccessException()) + | Some("tc-ni") -> raise(System.NotImplementedException()) + | Some("tc-nr") -> raise(System.NullReferenceException()) + | Some("tc-oc") -> raise(System.OperationCanceledException()) + | Some("tc-fail") -> failwith "simulated" + | _ -> () + +//---------------------------------------------------------------------------- +// Type-check sets of files +//-------------------------------------------------------------------------- type RootSigs = Zmap type RootImpls = Zset @@ -4883,7 +4898,7 @@ type TcState = tcsNiceNameGen: NiceNameGenerator tcsTcSigEnv: TcEnv tcsTcImplEnv: TcEnv - (* The accumulated results of type checking for this assembly *) + /// The accumulated results of type checking for this assembly tcsRootSigsAndImpls : TypecheckerSigsAndImpls } member x.NiceNameGenerator = x.tcsNiceNameGen member x.TcEnvFromSignatures = x.tcsTcSigEnv @@ -4895,9 +4910,8 @@ type TcState = tcsTcImplEnv = tcEnvAtEndOfLastInput } -let TypecheckInitialState(m,ccuName,tcConfig:TcConfig,tcGlobals,tcImports:TcImports,niceNameGen,tcEnv0) = +let GetInitialTcState(m,ccuName,tcConfig:TcConfig,tcGlobals,tcImports:TcImports,niceNameGen,tcEnv0) = ignore tcImports - if verbose then dprintf "Typecheck (constructing initial state)....\n" // Create a ccu to hold all the results of compilation let ccuType = NewCcuContents ILScopeRef.Local m ccuName (NewEmptyModuleOrNamespaceType Namespace) let ccu = @@ -4917,7 +4931,7 @@ let TypecheckInitialState(m,ccuName,tcConfig:TcConfig,tcGlobals,tcImports:TcImpo MemberSignatureEquality= (Tastops.typeEquivAux EraseAll tcGlobals) TypeForwarders=Map.empty }) - (* OK, is this is the F# library CCU then fix it up. *) + // OK, is this is the FSharp.Core CCU then fix it up. if tcConfig.compilingFslib then tcGlobals.fslibCcu.Fixup(ccu) @@ -4932,32 +4946,9 @@ let TypecheckInitialState(m,ccuName,tcConfig:TcConfig,tcGlobals,tcImports:TcImpo tcsTcImplEnv=tcEnv0 tcsRootSigsAndImpls = RootSigsAndImpls (rootSigs, rootImpls, allSigModulTyp, allImplementedSigModulTyp) } -let CheckSimulateException(tcConfig:TcConfig) = - match tcConfig.simulateException with - | Some("tc-oom") -> raise(System.OutOfMemoryException()) - | Some("tc-an") -> raise(System.ArgumentNullException("simulated")) - | Some("tc-invop") -> raise(System.InvalidOperationException()) - | Some("tc-av") -> raise(System.AccessViolationException()) - | Some("tc-aor") -> raise(System.ArgumentOutOfRangeException()) - | Some("tc-dv0") -> raise(System.DivideByZeroException()) - | Some("tc-nfn") -> raise(System.NotFiniteNumberException()) - | Some("tc-oe") -> raise(System.OverflowException()) - | Some("tc-atmm") -> raise(System.ArrayTypeMismatchException()) - | Some("tc-bif") -> raise(System.BadImageFormatException()) - | Some("tc-knf") -> raise(System.Collections.Generic.KeyNotFoundException()) - | Some("tc-ior") -> raise(System.IndexOutOfRangeException()) - | Some("tc-ic") -> raise(System.InvalidCastException()) - | Some("tc-ip") -> raise(System.InvalidProgramException()) - | Some("tc-ma") -> raise(System.MemberAccessException()) - | Some("tc-ni") -> raise(System.NotImplementedException()) - | Some("tc-nr") -> raise(System.NullReferenceException()) - | Some("tc-oc") -> raise(System.OperationCanceledException()) - | Some("tc-fail") -> failwith "simulated" - | _ -> () - -(* Typecheck a single file or interactive entry into F# Interactive *) -let TypecheckOneInputEventually +/// Typecheck a single file or interactive entry into F# Interactive +let TypeCheckOneInputEventually (checkForErrors , tcConfig:TcConfig, tcImports:TcImports, tcGlobals, prefixPathOpt, tcSink, tcState: TcState, inp: ParsedInput) = eventually { @@ -4969,31 +4960,19 @@ let TypecheckOneInputEventually let! (topAttrs, mimpls,tcEnvAtEnd,tcSigEnv,tcImplEnv,topSigsAndImpls,ccuType) = eventually { match inp with - | ParsedInput.SigFile (ParsedSigFileInput(filename,qualNameOfFile, _,_,_) as file) -> + | ParsedInput.SigFile (ParsedSigFileInput(_, qualNameOfFile, _, _, _) as file) -> // Check if we've seen this top module signature before. if Zmap.mem qualNameOfFile rootSigs then errorR(Error(FSComp.SR.buildSignatureAlreadySpecified(qualNameOfFile.Text),m.StartRange)) - (* Check if the implementation came first in compilation order *) + // Check if the implementation came first in compilation order if Zset.contains qualNameOfFile rootImpls then errorR(Error(FSComp.SR.buildImplementationAlreadyGivenDetail(qualNameOfFile.Text),m)) // Typecheck the signature file -#if DEBUG - if !verboseStamps then - dprintf "---------------------- START CHECK %A ------------\n" filename -#else - filename |> ignore -#endif let! (tcEnvAtEnd,tcEnv,smodulTypeRoot) = - Tc.TypecheckOneSigFile (tcGlobals,tcState.tcsNiceNameGen,amap,tcState.tcsCcu,checkForErrors,tcConfig.conditionalCompilationDefines,tcSink) tcState.tcsTcSigEnv file - -#if DEBUG - if !verboseStamps then - dprintf "Type-checked signature:\n%s\n" (Layout.showL (Layout.squashTo 192 (entityTypeL smodulTypeRoot))) - dprintf "---------------------- END CHECK %A ------------\n" filename -#endif + Tc.TypeCheckOneSigFile (tcGlobals,tcState.tcsNiceNameGen,amap,tcState.tcsCcu,checkForErrors,tcConfig.conditionalCompilationDefines,tcSink) tcState.tcsTcSigEnv file let rootSigs = Zmap.add qualNameOfFile smodulTypeRoot rootSigs @@ -5005,7 +4984,7 @@ let TypecheckOneInputEventually let m = qualNameOfFile.Range TcOpenDecl tcSink tcGlobals amap m m tcEnv prefixPath - let res = (EmptyTopAttrs, [],tcEnvAtEnd,tcEnv,tcState.tcsTcImplEnv,RootSigsAndImpls(rootSigs,rootImpls, allSigModulTyp, allImplementedSigModulTyp ),tcState.tcsCcuType) + let res = (EmptyTopAttrs, [], tcEnvAtEnd, tcEnv, tcState.tcsTcImplEnv, RootSigsAndImpls(rootSigs, rootImpls, allSigModulTyp, allImplementedSigModulTyp), tcState.tcsCcuType) return res | ParsedInput.ImplFile (ParsedImplFileInput(filename,_,qualNameOfFile,_,_,_,_) as file) -> @@ -5021,24 +5000,14 @@ let TypecheckOneInputEventually let tcImplEnv = tcState.tcsTcImplEnv -#if DEBUG - if !verboseStamps then - dprintf "---------------------- START CHECK %A ------------\n" filename -#endif // Typecheck the implementation file let! topAttrs,implFile,tcEnvAtEnd = - Tc.TypecheckOneImplFile (tcGlobals,tcState.tcsNiceNameGen,amap,tcState.tcsCcu,checkForErrors,tcConfig.conditionalCompilationDefines,tcSink) tcImplEnv rootSigOpt file + Tc.TypeCheckOneImplFile (tcGlobals,tcState.tcsNiceNameGen,amap,tcState.tcsCcu,checkForErrors,tcConfig.conditionalCompilationDefines,tcSink) tcImplEnv rootSigOpt file let hadSig = isSome rootSigOpt let implFileSigType = SigTypeOfImplFile implFile -#if DEBUG - if !verboseStamps then - dprintf "Implementation signature:\n%s\n" (Layout.showL (Layout.squashTo 192 (entityTypeL implFileSigType))) - dprintf "---------------------- END CHECK %A ------------\n" filename -#endif - - if verbose then dprintf "done TypecheckOneImplFile...\n" + if verbose then dprintf "done TypeCheckOneImplFile...\n" let rootImpls = Zset.add qualNameOfFile rootImpls // Only add it to the environment if it didn't have a signature @@ -5064,7 +5033,7 @@ let TypecheckOneInputEventually | Some prefixPath when not hadSig -> TcOpenDecl tcSink tcGlobals amap m m tcSigEnv prefixPath | _ -> tcSigEnv - let allImplementedSigModulTyp = combineModuleOrNamespaceTypeList [] m [implFileSigType; allImplementedSigModulTyp] + let allImplementedSigModulTyp = CombineCcuContentFragments m [implFileSigType; allImplementedSigModulTyp] // Add it to the CCU let ccuType = @@ -5072,7 +5041,7 @@ let TypecheckOneInputEventually // [CHECK: Why? This seriously degraded performance] NewCcuContents ILScopeRef.Local m tcState.tcsCcu.AssemblyName allImplementedSigModulTyp - if verbose then dprintf "done TypecheckOneInputEventually...\n" + if verbose then dprintf "done TypeCheckOneInputEventually...\n" let topSigsAndImpls = RootSigsAndImpls(rootSigs,rootImpls,allSigModulTyp,allImplementedSigModulTyp) let res = (topAttrs,[implFile], tcEnvAtEnd, tcSigEnv, tcImplEnv, topSigsAndImpls, ccuType) @@ -5089,34 +5058,33 @@ let TypecheckOneInputEventually return (tcState.TcEnvFromSignatures,EmptyTopAttrs,[]),tcState } -let TypecheckOneInput (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp = +let TypeCheckOneInput (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp = // 'use' ensures that the warning handler is restored at the end use unwindEL = PushErrorLoggerPhaseUntilUnwind(fun oldLogger -> GetErrorLoggerFilteringByScopedPragmas(false,GetScopedPragmasForInput(inp),oldLogger) ) use unwindBP = PushThreadBuildPhaseUntilUnwind (BuildPhase.TypeCheck) - TypecheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp) |> Eventually.force + TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp) |> Eventually.force -let TypecheckMultipleInputsFinish(results,tcState: TcState) = +let TypeCheckMultipleInputsFinish(results,tcState: TcState) = let tcEnvsAtEndFile,topAttrs,mimpls = List.unzip3 results let topAttrs = List.foldBack CombineTopAttrs topAttrs EmptyTopAttrs let mimpls = List.concat mimpls // This is the environment required by fsi.exe when incrementally adding definitions let tcEnvAtEndOfLastFile = (match tcEnvsAtEndFile with h :: _ -> h | _ -> tcState.TcEnvFromSignatures) - if verbose then dprintf "done TypecheckMultipleInputs...\n" (tcEnvAtEndOfLastFile,topAttrs,mimpls),tcState -let TypecheckMultipleInputs(checkForErrors,tcConfig:TcConfig,tcImports,tcGlobals,prefixPathOpt,tcState,inputs) = - let results,tcState = List.mapFold (TypecheckOneInput (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) tcState inputs - TypecheckMultipleInputsFinish(results,tcState) +let TypeCheckMultipleInputs (checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) = + let results,tcState = (tcState, inputs) ||> List.mapFold (TypeCheckOneInput (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) + TypeCheckMultipleInputsFinish(results,tcState) -let TypecheckSingleInputAndFinishEventually(checkForErrors,tcConfig:TcConfig,tcImports,tcGlobals,prefixPathOpt,tcSink,tcState,input) = +let TypeCheckSingleInputAndFinishEventually(checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) = eventually { - let! results,tcState = TypecheckOneInputEventually(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) - return TypecheckMultipleInputsFinish([results],tcState) + let! results,tcState = TypeCheckOneInputEventually(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) + return TypeCheckMultipleInputsFinish([results],tcState) } -let TypecheckClosedInputSetFinish(mimpls,tcState) = +let TypeCheckClosedInputSetFinish (mimpls, tcState) = // Publish the latest contents to the CCU tcState.tcsCcu.Deref.Contents <- tcState.tcsCcuType @@ -5125,292 +5093,16 @@ let TypecheckClosedInputSetFinish(mimpls,tcState) = rootSigs |> Zmap.iter (fun qualNameOfFile _ -> if not (Zset.contains qualNameOfFile rootImpls) then errorR(Error(FSComp.SR.buildSignatureWithoutImplementation(qualNameOfFile.Text), qualNameOfFile.Range))) - if verbose then dprintf "done TypecheckClosedInputSet...\n" + let tassembly = TAssembly(mimpls) tcState, tassembly -let TypecheckClosedInputSet(checkForErrors,tcConfig,tcImports,tcGlobals,prefixPathOpt,tcState,inputs) = +let TypeCheckClosedInputSet (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) = // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions - let (tcEnvAtEndOfLastFile,topAttrs,mimpls),tcState = TypecheckMultipleInputs (checkForErrors,tcConfig,tcImports,tcGlobals,prefixPathOpt,tcState,inputs) - let tcState,tassembly = TypecheckClosedInputSetFinish (mimpls, tcState) + let (tcEnvAtEndOfLastFile, topAttrs, mimpls),tcState = TypeCheckMultipleInputs (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) + let tcState,tassembly = TypeCheckClosedInputSetFinish (mimpls, tcState) tcState, topAttrs, tassembly, tcEnvAtEndOfLastFile -type OptionSwitch = - | On - | Off - -type OptionSpec = - | OptionClear of bool ref - | OptionFloat of (float -> unit) - | OptionInt of (int -> unit) - | OptionSwitch of (OptionSwitch -> unit) - | OptionIntList of (int -> unit) - | OptionIntListSwitch of (int -> OptionSwitch -> unit) - | OptionRest of (string -> unit) - | OptionSet of bool ref - | OptionString of (string -> unit) - | OptionStringList of (string -> unit) - | OptionStringListSwitch of (string -> OptionSwitch -> unit) - | OptionUnit of (unit -> unit) - | OptionHelp of (CompilerOptionBlock list -> unit) // like OptionUnit, but given the "options" - | OptionGeneral of (string list -> bool) * (string list -> string list) // Applies? * (ApplyReturningResidualArgs) - -and CompilerOption = CompilerOption of string * string * OptionSpec * Option * string option -and CompilerOptionBlock = PublicOptions of string * CompilerOption list | PrivateOptions of CompilerOption list -let blockOptions = function PublicOptions (_,opts) -> opts | PrivateOptions opts -> opts - -let filterCompilerOptionBlock pred block = - match block with - | PublicOptions(heading,opts) -> PublicOptions(heading,List.filter pred opts) - | PrivateOptions(opts) -> PrivateOptions(List.filter pred opts) - -let compilerOptionUsage (CompilerOption(s,tag,spec,_,_)) = - let s = if s="--" then "" else s (* s="flag" for "--flag" options. s="--" for "--" option. Adjust printing here for "--" case. *) - match spec with - | (OptionUnit _ | OptionSet _ | OptionClear _ | OptionHelp _) -> sprintf "--%s" s - | OptionStringList _ -> sprintf "--%s:%s" s tag - | OptionIntList _ -> sprintf "--%s:%s" s tag - | OptionSwitch _ -> sprintf "--%s[+|-]" s - | OptionStringListSwitch _ -> sprintf "--%s[+|-]:%s" s tag - | OptionIntListSwitch _ -> sprintf "--%s[+|-]:%s" s tag - | OptionString _ -> sprintf "--%s:%s" s tag - | OptionInt _ -> sprintf "--%s:%s" s tag - | OptionFloat _ -> sprintf "--%s:%s" s tag - | OptionRest _ -> sprintf "--%s ..." s - | OptionGeneral _ -> if tag="" then sprintf "%s" s else sprintf "%s:%s" s tag (* still being decided *) - -let printCompilerOption (CompilerOption(_s,_tag,_spec,_,help) as compilerOption) = - let flagWidth = 30 // fixed width for printing of flags, e.g. --warnaserror: - let defaultLineWidth = 80 // the fallback width - let lineWidth = try System.Console.BufferWidth with e -> defaultLineWidth - let lineWidth = if lineWidth=0 then defaultLineWidth else lineWidth (* Have seen BufferWidth=0 on Linux/Mono *) - // Lines have this form: - // flagWidth chars - for flags description or padding on continuation lines. - // single space - space. - // description - words upto but excluding the final character of the line. - assert(flagWidth = 30) - printf "%-30s" (compilerOptionUsage compilerOption) - let printWord column (word:string) = - // Have printed upto column. - // Now print the next word including any preceeding whitespace. - // Returns the column printed to (suited to folding). - if column + 1 (*space*) + word.Length >= lineWidth then // NOTE: "equality" ensures final character of the line is never printed - printfn "" (* newline *) - assert(flagWidth = 30) - printf "%-30s %s" ""(*<--flags*) word - flagWidth + 1 + word.Length - else - printf " %s" word - column + 1 + word.Length - let words = match help with None -> [| |] | Some s -> s.Split [| ' ' |] - let _finalColumn = Array.fold printWord flagWidth words - printfn "" (* newline *) - -let printPublicOptions (heading,opts) = - if nonNil opts then - printfn "" - printfn "" - printfn "\t\t%s" heading - List.iter printCompilerOption opts - -let printCompilerOptionBlocks blocks = - let equals x y = x=y - let publicBlocks = List.choose (function PrivateOptions _ -> None | PublicOptions (heading,opts) -> Some (heading,opts)) blocks - let consider doneHeadings (heading, _opts) = - if Set.contains heading doneHeadings then - doneHeadings - else - let headingOptions = List.filter (fst >> equals heading) publicBlocks |> List.map snd |> List.concat - printPublicOptions (heading,headingOptions) - Set.add heading doneHeadings - List.fold consider Set.empty publicBlocks |> ignore> - -(* For QA *) -let dumpCompilerOption prefix (CompilerOption(str, _, spec, _, _)) = - printf "section='%-25s' ! option=%-30s kind=" prefix str - match spec with - | OptionUnit _ -> printf "OptionUnit" - | OptionSet _ -> printf "OptionSet" - | OptionClear _ -> printf "OptionClear" - | OptionHelp _ -> printf "OptionHelp" - | OptionStringList _ -> printf "OptionStringList" - | OptionIntList _ -> printf "OptionIntList" - | OptionSwitch _ -> printf "OptionSwitch" - | OptionStringListSwitch _ -> printf "OptionStringListSwitch" - | OptionIntListSwitch _ -> printf "OptionIntListSwitch" - | OptionString _ -> printf "OptionString" - | OptionInt _ -> printf "OptionInt" - | OptionFloat _ -> printf "OptionFloat" - | OptionRest _ -> printf "OptionRest" - | OptionGeneral _ -> printf "OptionGeneral" - printf "\n" -let dumpCompilerOptionBlock = function - | PublicOptions (heading,opts) -> List.iter (dumpCompilerOption heading) opts - | PrivateOptions opts -> List.iter (dumpCompilerOption "NoSection") opts -let dumpCompilerOptionBlocks blocks = List.iter dumpCompilerOptionBlock blocks - -let isSlashOpt (opt:string) = - opt.[0] = '/' && (opt.Length = 1 || not (opt.[1..].Contains "/")) - -//---------------------------------------------------------------------------- -// The argument parser is used by both the VS plug-in and the fsc.exe to -// parse the include file path and other front-end arguments. -// -// The language service uses this function too. It's important to continue -// processing flags even if an error is seen in one so that the best possible -// intellisense can be show. -//-------------------------------------------------------------------------- -let ParseCompilerOptions (collectOtherArgument : string -> unit) (blocks: CompilerOptionBlock list) args = - use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter) - - let specs : CompilerOption list = List.collect blockOptions blocks - - // returns a tuple - the option token, the option argument string - let parseOption (s : string) = - // grab the option token - let opts = s.Split([|':'|]) - let mutable opt = opts.[0] - if opt = "" then - () - // if it doesn't start with a '-' or '/', reject outright - elif opt.[0] <> '-' && opt.[0] <> '/' then - opt <- "" - elif opt <> "--" then - // is it an abbreviated or MSFT-style option? - // if so, strip the first character and move on with your life - if opt.Length = 2 || isSlashOpt opt then - opt <- opt.[1 ..] - // else, it should be a non-abbreviated option starting with "--" - elif opt.Length > 3 && opt.StartsWith("--") then - opt <- opt.[2 ..] - else - opt <- "" - - // get the argument string - let optArgs = if opts.Length > 1 then String.Join(":",opts.[1 ..]) else "" - opt, optArgs - - let getOptionArg compilerOption (argString : string) = - if argString = "" then - errorR(Error(FSComp.SR.buildOptionRequiresParameter(compilerOptionUsage compilerOption),rangeCmdArgs)) - argString - - let getOptionArgList compilerOption (argString : string) = - if argString = "" then - errorR(Error(FSComp.SR.buildOptionRequiresParameter(compilerOptionUsage compilerOption),rangeCmdArgs)) - [] - else - argString.Split([|',';';'|]) |> List.ofArray - - let getSwitchOpt (opt : string) = - // if opt is a switch, strip the '+' or '-' - if opt <> "--" && opt.Length > 1 && (opt.EndsWith("+",StringComparison.Ordinal) || opt.EndsWith("-",StringComparison.Ordinal)) then - opt.[0 .. opt.Length - 2] - else - opt - - let getSwitch (s: string) = - let s = (s.Split([|':'|])).[0] - if s <> "--" && s.EndsWith("-",StringComparison.Ordinal) then Off else On - - let rec processArg args = - match args with - | [] -> () - | opt :: t -> - - let optToken, argString = parseOption opt - - let reportDeprecatedOption errOpt = - match errOpt with - | Some(e) -> warning(e) - | None -> () - - let rec attempt l = - match l with - | (CompilerOption(s, _, OptionHelp f, d, _) :: _) when optToken = s && argString = "" -> - reportDeprecatedOption d - f blocks; t - | (CompilerOption(s, _, OptionUnit f, d, _) :: _) when optToken = s && argString = "" -> - reportDeprecatedOption d - f (); t - | (CompilerOption(s, _, OptionSwitch f, d, _) :: _) when getSwitchOpt(optToken) = s && argString = "" -> - reportDeprecatedOption d - f (getSwitch opt); t - | (CompilerOption(s, _, OptionSet f, d, _) :: _) when optToken = s && argString = "" -> - reportDeprecatedOption d - f := true; t - | (CompilerOption(s, _, OptionClear f, d, _) :: _) when optToken = s && argString = "" -> - reportDeprecatedOption d - f := false; t - | (CompilerOption(s, _, OptionString f, d, _) as compilerOption :: _) when optToken = s -> - reportDeprecatedOption d - let oa = getOptionArg compilerOption argString - if oa <> "" then - f (getOptionArg compilerOption oa) - t - | (CompilerOption(s, _, OptionInt f, d, _) as compilerOption :: _) when optToken = s -> - reportDeprecatedOption d - let oa = getOptionArg compilerOption argString - if oa <> "" then - f (try int32 (oa) with _ -> - errorR(Error(FSComp.SR.buildArgInvalidInt(getOptionArg compilerOption argString),rangeCmdArgs)); 0) - t - | (CompilerOption(s, _, OptionFloat f, d, _) as compilerOption :: _) when optToken = s -> - reportDeprecatedOption d - let oa = getOptionArg compilerOption argString - if oa <> "" then - f (try float (oa) with _ -> - errorR(Error(FSComp.SR.buildArgInvalidFloat(getOptionArg compilerOption argString), rangeCmdArgs)); 0.0) - t - | (CompilerOption(s, _, OptionRest f, d, _) :: _) when optToken = s -> - reportDeprecatedOption d - List.iter f t; [] - | (CompilerOption(s, _, OptionIntList f, d, _) as compilerOption :: _) when optToken = s -> - reportDeprecatedOption d - let al = getOptionArgList compilerOption argString - if al <> [] then - List.iter (fun i -> f (try int32 i with _ -> errorR(Error(FSComp.SR.buildArgInvalidInt(i),rangeCmdArgs)); 0)) al ; - t - | (CompilerOption(s, _, OptionIntListSwitch f, d, _) as compilerOption :: _) when getSwitchOpt(optToken) = s -> - reportDeprecatedOption d - let al = getOptionArgList compilerOption argString - if al <> [] then - let switch = getSwitch(opt) - List.iter (fun i -> f (try int32 i with _ -> errorR(Error(FSComp.SR.buildArgInvalidInt(i),rangeCmdArgs)); 0) switch) al - t - // here - | (CompilerOption(s, _, OptionStringList f, d, _) as compilerOption :: _) when optToken = s -> - reportDeprecatedOption d - let al = getOptionArgList compilerOption argString - if al <> [] then - List.iter (fun s -> f s) (getOptionArgList compilerOption argString) - t - | (CompilerOption(s, _, OptionStringListSwitch f, d, _) as compilerOption :: _) when getSwitchOpt(optToken) = s -> - reportDeprecatedOption d - let al = getOptionArgList compilerOption argString - if al <> [] then - let switch = getSwitch(opt) - List.iter (fun s -> f s switch) (getOptionArgList compilerOption argString) - t - | (CompilerOption(_, _, OptionGeneral (pred,exec), d, _) :: _) when pred args -> - reportDeprecatedOption d - let rest = exec args in rest // arguments taken, rest remaining - | (_ :: more) -> attempt more - | [] -> - if opt.Length = 0 || opt.[0] = '-' || isSlashOpt opt - then - // want the whole opt token - delimiter and all - let unrecOpt = (opt.Split([|':'|]).[0]) - errorR(Error(FSComp.SR.buildUnrecognizedOption(unrecOpt),rangeCmdArgs)) - t - else - (collectOtherArgument opt; t) - let rest = attempt specs - processArg rest - - let result = processArg args - result -do() diff --git a/src/fsharp/build.fsi b/src/fsharp/CompileOps.fsi similarity index 68% rename from src/fsharp/build.fsi rename to src/fsharp/CompileOps.fsi index cbdfe10e5ce0fca962d6f1adb906a40ebc582799..2e2824f094ac46a9685ace876f0dd725c8a0f958 100644 --- a/src/fsharp/build.fsi +++ b/src/fsharp/CompileOps.fsi @@ -1,7 +1,7 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. -/// Loading initial context, reporting errors etc. -module internal Microsoft.FSharp.Compiler.Build +/// Coordinating compiler operations - configuration, loading initial context, reporting errors etc. +module internal Microsoft.FSharp.Compiler.CompileOps open System.Text open Internal.Utilities @@ -19,7 +19,7 @@ open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.Infos open Microsoft.FSharp.Compiler.MSBuildResolver -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Core.CompilerServices #if EXTENSIONTYPING open Microsoft.FSharp.Compiler.ExtensionTyping @@ -37,73 +37,87 @@ module internal FullCompiler = #endif +//---------------------------------------------------------------------------- +// File names and known file suffixes +//-------------------------------------------------------------------------- + /// Signature file suffixes -val sigSuffixes : string list +val FSharpSigFileSuffixes : string list /// Implementation file suffixes -val implSuffixes : string list +val FSharpImplFileSuffixes : string list /// Script file suffixes -val scriptSuffixes : string list +val FSharpScriptFileSuffixes : string list val IsScript : string -> bool /// File suffixes where #light is the default -val lightSyntaxDefaultExtensions : string list +val FSharpLightSyntaxFileSuffixes : string list + + +/// Get the name used for FSharp.Core +val GetFSharpCoreLibraryName : unit -> string //---------------------------------------------------------------------------- // Parsing inputs //-------------------------------------------------------------------------- -val QualFileNameOfUniquePath : range * string list -> Ast.QualifiedNameOfFile +val ComputeQualifiedNameOfFileFromUniquePath : range * string list -> Ast.QualifiedNameOfFile val PrependPathToInput : Ast.Ident list -> Ast.ParsedInput -> Ast.ParsedInput val ParseInput : (UnicodeLexing.Lexbuf -> Parser.token) * ErrorLogger * UnicodeLexing.Lexbuf * string option * string * isLastCompiland: bool -> Ast.ParsedInput - - //---------------------------------------------------------------------------- -// Errors +// Error and warnings //-------------------------------------------------------------------------- +/// Represents the style being used to format errros type ErrorStyle = | DefaultErrors | EmacsErrors | TestErrors - | VSErrors - + | VSErrors -val RangeOfError : PhasedError -> range option +/// Get the location associated with an error +val GetRangeOfError : PhasedError -> range option + +/// Get the number associated with an error val GetErrorNumber : PhasedError -> int + +/// Split errors into a "main" error and a set of associated errors val SplitRelatedErrors : PhasedError -> PhasedError * PhasedError list + +/// Output an error to a buffer val OutputPhasedError : StringBuilder -> PhasedError -> bool -> unit -val SanitizeFileName : filename:string -> implicitIncludeDir:string -> string + +/// Output an error or warning to a buffer val OutputErrorOrWarning : implicitIncludeDir:string * showFullPaths: bool * flattenErrors: bool * errorStyle: ErrorStyle * warning:bool -> StringBuilder -> PhasedError -> unit + +/// Output extra context information for an error or warning to a buffer val OutputErrorOrWarningContext : prefix:string -> fileLineFunction:(string -> int -> string) -> StringBuilder -> PhasedError -> unit +[] type ErrorLocation = - { - Range : range - File : string - TextRepresentation : string - IsEmpty : bool - } + { Range : range + File : string + TextRepresentation : string + IsEmpty : bool } +[] type CanonicalInformation = - { - ErrorNumber : int - Subcategory : string - TextRepresentation : string - } + { ErrorNumber : int + Subcategory : string + TextRepresentation : string } +[] type DetailedIssueInfo = - { - Location : ErrorLocation option - Canonical : CanonicalInformation - Message : string - } + { Location : ErrorLocation option + Canonical : CanonicalInformation + Message : string } +[] type ErrorOrWarning = | Short of bool * string | Long of bool * DetailedIssueInfo @@ -111,40 +125,9 @@ type ErrorOrWarning = val CollectErrorOrWarning : implicitIncludeDir:string * showFullPaths: bool * flattenErrors: bool * errorStyle: ErrorStyle * warning:bool * PhasedError -> seq //---------------------------------------------------------------------------- -// Options and configuration +// Resolve assembly references //-------------------------------------------------------------------------- -// For command-line options that can be suffixed with +/- -type OptionSwitch = - | On - | Off - -/// The spec value describes the action of the argument, -/// and whether it expects a following parameter. -type OptionSpec = - | OptionClear of bool ref - | OptionFloat of (float -> unit) - | OptionInt of (int -> unit) - | OptionSwitch of (OptionSwitch -> unit) - | OptionIntList of (int -> unit) - | OptionIntListSwitch of (int -> OptionSwitch -> unit) - | OptionRest of (string -> unit) - | OptionSet of bool ref - | OptionString of (string -> unit) - | OptionStringList of (string -> unit) - | OptionStringListSwitch of (string -> OptionSwitch -> unit) - | OptionUnit of (unit -> unit) - | OptionHelp of (CompilerOptionBlock list -> unit) // like OptionUnit, but given the "options" - | OptionGeneral of (string list -> bool) * (string list -> string list) // Applies? * (ApplyReturningResidualArgs) -and CompilerOption = - /// CompilerOption(name, argumentDescriptionString, actionSpec, exceptionOpt, helpTextOpt - CompilerOption of string * string * OptionSpec * Option * string option -and CompilerOptionBlock = PublicOptions of string * CompilerOption list | PrivateOptions of CompilerOption list - -val printCompilerOptionBlocks : CompilerOptionBlock list -> unit // for printing usage -val dumpCompilerOptionBlocks : CompilerOptionBlock list -> unit // for QA -val filterCompilerOptionBlock : (CompilerOption -> bool) -> CompilerOptionBlock -> CompilerOptionBlock - exception AssemblyNotResolved of (*originalName*) string * range exception FileNameNotResolved of (*filename*) string * (*description of searched locations*) string * range exception DeprecatedCommandLineOptionFull of string * range @@ -193,60 +176,65 @@ type ResolveAssemblyReferenceMode = | Speculative | ReportErrors +//---------------------------------------------------------------------------- +// TcConfig +//-------------------------------------------------------------------------- + +/// Represents the file or string used for the --version flag type VersionFlag = | VersionString of string | VersionFile of string | VersionNone - member GetVersionInfo : (*implicitIncludeDir:*)string -> ILVersionInfo - member GetVersionString : (*implicitIncludeDir:*)string -> string + member GetVersionInfo : implicitIncludeDir:string -> ILVersionInfo + member GetVersionString : implicitIncludeDir:string -> string type TcConfigBuilder = - { mutable primaryAssembly : PrimaryAssembly; - mutable autoResolveOpenDirectivesToDlls: bool; - mutable noFeedback: bool; - mutable stackReserveSize: int32 option; - mutable implicitIncludeDir: string; - mutable openBinariesInMemory: bool; - mutable openDebugInformationForLaterStaticLinking: bool; - defaultFSharpBinariesDir: string; - mutable compilingFslib: bool; - mutable compilingFslib20: string option; - mutable compilingFslib40: bool; - mutable useIncrementalBuilder: bool; - mutable includes: string list; - mutable implicitOpens: string list; - mutable useFsiAuxLib: bool; - mutable framework: bool; + { mutable primaryAssembly : PrimaryAssembly + mutable autoResolveOpenDirectivesToDlls: bool + mutable noFeedback: bool + mutable stackReserveSize: int32 option + mutable implicitIncludeDir: string + mutable openBinariesInMemory: bool + mutable openDebugInformationForLaterStaticLinking: bool + defaultFSharpBinariesDir: string + mutable compilingFslib: bool + mutable compilingFslib20: string option + mutable compilingFslib40: bool + mutable useIncrementalBuilder: bool + mutable includes: string list + mutable implicitOpens: string list + mutable useFsiAuxLib: bool + mutable framework: bool mutable resolutionEnvironment : Microsoft.FSharp.Compiler.MSBuildResolver.ResolutionEnvironment mutable implicitlyResolveAssemblies : bool mutable addVersionSpecificFrameworkReferences : bool /// Set if the user has explicitly turned indentation-aware syntax on/off - mutable light: bool option; - mutable conditionalCompilationDefines: string list; + mutable light: bool option + mutable conditionalCompilationDefines: string list /// Sources added into the build with #load - mutable loadedSources: (range * string) list; + mutable loadedSources: (range * string) list - mutable referencedDLLs: AssemblyReference list; - mutable knownUnresolvedReferences : UnresolvedAssemblyReference list; - optimizeForMemory: bool; + mutable referencedDLLs: AssemblyReference list + mutable knownUnresolvedReferences : UnresolvedAssemblyReference list + optimizeForMemory: bool mutable subsystemVersion : int * int mutable useHighEntropyVA : bool - mutable inputCodePage: int option; - mutable embedResources : string list; - mutable globalWarnAsError: bool; - mutable globalWarnLevel: int; - mutable specificWarnOff: int list; - mutable specificWarnOn: int list; + mutable inputCodePage: int option + mutable embedResources : string list + mutable globalWarnAsError: bool + mutable globalWarnLevel: int + mutable specificWarnOff: int list + mutable specificWarnOn: int list mutable specificWarnAsError: int list mutable specificWarnAsWarn : int list - mutable mlCompatibility:bool; - mutable checkOverflow:bool; - mutable showReferenceResolutions:bool; - mutable outputFile : string option; - mutable resolutionFrameworkRegistryBase : string; - mutable resolutionAssemblyFoldersSuffix : string; - mutable resolutionAssemblyFoldersConditions : string; + mutable mlCompatibility:bool + mutable checkOverflow:bool + mutable showReferenceResolutions:bool + mutable outputFile : string option + mutable resolutionFrameworkRegistryBase : string + mutable resolutionAssemblyFoldersSuffix : string + mutable resolutionAssemblyFoldersConditions : string mutable platform : ILPlatform option mutable prefer32Bit : bool mutable useMonoResolution : bool @@ -305,7 +293,7 @@ type TcConfigBuilder = mutable doTLR : bool mutable doFinalSimplify : bool mutable optsOn : bool - mutable optSettings : Opt.OptimizationSettings + mutable optSettings : Optimizer.OptimizationSettings mutable emitTailcalls : bool mutable lcid : int option mutable productNameForBannerText : string @@ -354,44 +342,44 @@ type TcConfigBuilder = // Immutable TcConfig type TcConfig = member primaryAssembly: PrimaryAssembly - member autoResolveOpenDirectivesToDlls: bool; - member noFeedback: bool; - member stackReserveSize: int32 option; - member implicitIncludeDir: string; - member openBinariesInMemory: bool; - member openDebugInformationForLaterStaticLinking: bool; - member fsharpBinariesDir: string; - member compilingFslib: bool; - member compilingFslib20: string option; - member compilingFslib40: bool; - member useIncrementalBuilder: bool; - member includes: string list; - member implicitOpens: string list; - member useFsiAuxLib: bool; - member framework: bool; + member autoResolveOpenDirectivesToDlls: bool + member noFeedback: bool + member stackReserveSize: int32 option + member implicitIncludeDir: string + member openBinariesInMemory: bool + member openDebugInformationForLaterStaticLinking: bool + member fsharpBinariesDir: string + member compilingFslib: bool + member compilingFslib20: string option + member compilingFslib40: bool + member useIncrementalBuilder: bool + member includes: string list + member implicitOpens: string list + member useFsiAuxLib: bool + member framework: bool member implicitlyResolveAssemblies : bool /// Set if the user has explicitly turned indentation-aware syntax on/off - member light: bool option; - member conditionalCompilationDefines: string list; + member light: bool option + member conditionalCompilationDefines: string list member subsystemVersion : int * int member useHighEntropyVA : bool - member referencedDLLs: AssemblyReference list; - member optimizeForMemory: bool; - member inputCodePage: int option; - member embedResources : string list; - member globalWarnAsError: bool; - member globalWarnLevel: int; - member specificWarnOn: int list; - member specificWarnOff: int list; + member referencedDLLs: AssemblyReference list + member optimizeForMemory: bool + member inputCodePage: int option + member embedResources : string list + member globalWarnAsError: bool + member globalWarnLevel: int + member specificWarnOn: int list + member specificWarnOff: int list member specificWarnAsError: int list member specificWarnAsWarn : int list - member mlCompatibility:bool; - member checkOverflow:bool; - member showReferenceResolutions:bool; - member outputFile : string option; - member resolutionFrameworkRegistryBase : string; - member resolutionAssemblyFoldersSuffix : string; - member resolutionAssemblyFoldersConditions : string; + member mlCompatibility:bool + member checkOverflow:bool + member showReferenceResolutions:bool + member outputFile : string option + member resolutionFrameworkRegistryBase : string + member resolutionAssemblyFoldersSuffix : string + member resolutionAssemblyFoldersConditions : string member platform : ILPlatform option member prefer32Bit : bool member useMonoResolution : bool @@ -449,7 +437,7 @@ type TcConfig = member doDetuple : bool member doTLR : bool member doFinalSimplify : bool - member optSettings : Opt.OptimizationSettings + member optSettings : Optimizer.OptimizationSettings member emitTailcalls : bool member lcid : int option member optsOn : bool @@ -491,13 +479,25 @@ type TcConfig = static member Create : TcConfigBuilder * validate: bool -> TcConfig +/// Represents a computation to return a TcConfig. Normally this is just a constant immutable TcConfig, +/// but for F# Interactive it may be based on an underlying mutable TcConfigBuilder. +[] +type TcConfigProvider = + /// Get a TcConfigProvider which will return only the exact TcConfig. + static member Constant : TcConfig -> TcConfigProvider + + /// Get a TcConfigProvider which will continue to respect changes in the underlying + /// TcConfigBuilder rather than delivering snapshots. + static member BasedOnMutableBuilder : TcConfigBuilder -> TcConfigProvider //---------------------------------------------------------------------------- // Tables of referenced DLLs //-------------------------------------------------------------------------- +/// Represents a resolved imported binary +[] type ImportedBinary = - { FileName: string; + { FileName: string RawMetadata: ILModuleDef #if EXTENSIONTYPING ProviderGeneratedAssembly: System.Reflection.Assembly option @@ -507,16 +507,18 @@ type ImportedBinary = ILAssemblyRefs : ILAssemblyRef list ILScopeRef: ILScopeRef} +/// Represents a resolved imported assembly +[] type ImportedAssembly = - { ILScopeRef: ILScopeRef; - FSharpViewOfMetadata: CcuThunk; - AssemblyAutoOpenAttributes: string list; - AssemblyInternalsVisibleToAttributes: string list; + { ILScopeRef: ILScopeRef + FSharpViewOfMetadata: CcuThunk + AssemblyAutoOpenAttributes: string list + AssemblyInternalsVisibleToAttributes: string list #if EXTENSIONTYPING - IsProviderGenerated: bool; - mutable TypeProviders: Tainted list; + IsProviderGenerated: bool + mutable TypeProviders: Tainted list #endif - FSharpOptimizationData : Lazy> } + FSharpOptimizationData : Lazy> } [] @@ -527,11 +529,8 @@ type TcAssemblyResolutions = static member BuildFromPriorResolutions : TcConfig * AssemblyResolution list * UnresolvedAssemblyReference list -> TcAssemblyResolutions -[] -type TcConfigProvider = - static member Constant : TcConfig -> TcConfigProvider - static member BasedOnMutableBuilder : TcConfigBuilder -> TcConfigProvider +/// Repreesnts a table of imported assemblies with their resolutions. [] type TcImports = interface System.IDisposable @@ -573,117 +572,156 @@ type TcImports = // Special resources in DLLs //-------------------------------------------------------------------------- +/// Determine if an IL resource attached to an F# assemnly is an F# signature data resource val IsSignatureDataResource : ILResource -> bool + +/// Determine if an IL resource attached to an F# assemnly is an F# optimization data resource val IsOptimizationDataResource : ILResource -> bool + +/// Determine if an IL resource attached to an F# assemnly is an F# quotation data resource for reflected definitions val IsReflectedDefinitionsResource : ILResource -> bool #if NO_COMPILER_BACKEND #else +/// Write F# signature data as an IL resource val WriteSignatureData : TcConfig * TcGlobals * Tastops.Remap * CcuThunk * string -> ILResource -val WriteOptimizationData : TcGlobals * string * CcuThunk * Opt.LazyModuleInfo -> ILResource -#endif -val GetNameOfILModule : ILModuleDef -> string +/// Write F# optimization data as an IL resource +val WriteOptimizationData : TcGlobals * string * CcuThunk * Optimizer.LazyModuleInfo -> ILResource +#endif -val GetFSharpCoreLibraryName : unit -> string //---------------------------------------------------------------------------- -// Finding and requiring DLLs +// #r and other directives //-------------------------------------------------------------------------- +/// Process #r in F# Interactive. +/// Adds the reference to the tcImports and add the ccu to the type checking environment. val RequireDLL : TcImports -> TcEnv -> range -> string -> TcEnv * (ImportedBinary list * ImportedAssembly list) -//---------------------------------------------------------------------------- -// Processing # commands -//-------------------------------------------------------------------------- - +/// Processing # commands val ProcessMetaCommandsFromInput : ('T -> range * string -> 'T) * ('T -> range * string -> 'T) * ('T -> range * string -> unit) -> TcConfigBuilder -> Ast.ParsedInput -> string -> 'T -> 'T +/// Process all the #r, #I etc. in an input +val ApplyMetaCommandsFromInputToTcConfig : TcConfig -> (Ast.ParsedInput * string) -> TcConfig -val GetScopedPragmasForInput : Ast.ParsedInput -> ScopedPragma list -val GetErrorLoggerFilteringByScopedPragmas : checkFile:bool * ScopedPragma list * ErrorLogger -> ErrorLogger - +/// Process the #nowarn in an input val ApplyNoWarnsToTcConfig : TcConfig -> (Ast.ParsedInput*string) -> TcConfig -val ApplyMetaCommandsFromInputToTcConfig : TcConfig -> (Ast.ParsedInput * string) -> TcConfig -val GetAssemblyResolutionInformation : TcConfig -> AssemblyResolution list * UnresolvedAssemblyReference list + //---------------------------------------------------------------------------- -// Loading the default library sets +// Scoped pragmas //-------------------------------------------------------------------------- - + +/// Find the scoped #nowarn pragmas with their range information +val GetScopedPragmasForInput : Ast.ParsedInput -> ScopedPragma list + +/// Get an error logger that filters the reporting of warnings based on scoped pragma information +val GetErrorLoggerFilteringByScopedPragmas : checkFile:bool * ScopedPragma list * ErrorLogger -> ErrorLogger + +/// This list is the default set of references for "non-project" files. val DefaultBasicReferencesForOutOfProjectSources : string list //---------------------------------------------------------------------------- -// Parsing inputs +// Parsing //-------------------------------------------------------------------------- + +/// Parse one input file val ParseOneInputFile : TcConfig * Lexhelp.LexResourceManager * string list * string * isLastCompiland: bool * ErrorLogger * (*retryLocked*) bool -> ParsedInput option //---------------------------------------------------------------------------- // Type checking and querying the type checking state //-------------------------------------------------------------------------- -val GetInitialTypecheckerEnv : string option -> range -> TcConfig -> TcImports -> TcGlobals -> TcEnv +/// Get the initial type checking environment including the loading of mscorlib/System.Core, FSharp.Core +/// applying the InternalsVisibleTo in referenced assemblies and opening 'Checked' if requested. +val GetInitialTcEnv : string option * range * TcConfig * TcImports * TcGlobals -> TcEnv [] +/// Represents the incremental type checking state for a set of inputs type TcState = member NiceNameGenerator : Ast.NiceNameGenerator + + /// The CcuThunk for the current assembly being checked member Ccu : CcuThunk + + /// Get the typing environment implied by the set of signature files and/or inferred signatures of implementation files checked so far member TcEnvFromSignatures : TcEnv - member NextStateAfterIncrementalFragment : TcEnv -> TcState + + /// Get the typing environment implied by the set of implemetation files checked so far member TcEnvFromImpls : TcEnv -val TypecheckInitialState : + member NextStateAfterIncrementalFragment : TcEnv -> TcState + +/// Get the initial type checking state for a set of inputs +val GetInitialTcState : range * string * TcConfig * TcGlobals * TcImports * Ast.NiceNameGenerator * TcEnv -> TcState -val TypecheckOneInputEventually : - (unit -> bool) * TcConfig * TcImports * TcGlobals * Ast.LongIdent option * Nameres.TcResultsSink * TcState * Ast.ParsedInput +/// Check one input, returned as an Eventually computation +val TypeCheckOneInputEventually : + (unit -> bool) * TcConfig * TcImports * TcGlobals * Ast.LongIdent option * NameResolution.TcResultsSink * TcState * Ast.ParsedInput -> Eventually<(TcEnv * TopAttribs * Tast.TypedImplFile list) * TcState> -val TypecheckMultipleInputsFinish : - (TcEnv * TopAttribs * 'T list) list * TcState - -> (TcEnv * TopAttribs * 'T list) * TcState +/// Finish the checking of multiple inputs +val TypeCheckMultipleInputsFinish : (TcEnv * TopAttribs * 'T list) list * TcState -> (TcEnv * TopAttribs * 'T list) * TcState -val TypecheckClosedInputSetFinish : - TypedImplFile list * TcState - -> TcState * TypedAssembly +/// Finish the checking of a closed set of inputs +val TypeCheckClosedInputSetFinish : TypedImplFile list * TcState -> TcState * TypedAssembly -val TypecheckClosedInputSet : +/// Check a closed set of inputs +val TypeCheckClosedInputSet : (unit -> bool) * TcConfig * TcImports * TcGlobals * Ast.LongIdent option * TcState * Ast.ParsedInput list -> TcState * TopAttribs * Tast.TypedAssembly * TcEnv -val TypecheckSingleInputAndFinishEventually : - (unit -> bool) * TcConfig * TcImports * TcGlobals * Ast.LongIdent option * Nameres.TcResultsSink * TcState * Ast.ParsedInput +/// Check a single input and finish the checking +val TypeCheckSingleInputAndFinishEventually : + (unit -> bool) * TcConfig * TcImports * TcGlobals * Ast.LongIdent option * NameResolution.TcResultsSink * TcState * Ast.ParsedInput -> Eventually<(TcEnv * TopAttribs * Tast.TypedImplFile list) * TcState> -val ParseCompilerOptions : (string -> unit) -> CompilerOptionBlock list -> string list -> unit -val ReportWarning : int -> int list -> int list -> PhasedError -> bool -val ReportWarningAsError : int -> int list -> int list -> int list -> int list -> bool -> PhasedError -> bool +/// Indicates if we should report a warning +val ReportWarning : globalWarnLevel: int * specificWarnOff: int list * specificWarnOn: int list -> PhasedError -> bool + +/// Indicates if we should report a warning as an error +val ReportWarningAsError : globalWarnLevel: int * specificWarnOff: int list * specificWarnOn: int list * specificWarnAsError: int list * specificWarnAsWarn: int list * globalWarnAsError: bool -> PhasedError -> bool //---------------------------------------------------------------------------- // #load closure //-------------------------------------------------------------------------- + +[] type CodeContext = | Evaluation | Compilation | Editing +[] type LoadClosure = { /// The source files along with the ranges of the #load positions in each file. - SourceFiles: (string * range list) list - /// The resolved references along with the ranges of the #r positions in each file. - References: (string * AssemblyResolution list) list - /// The list of references that were not resolved during load closure. These may still be extension references. - UnresolvedReferences : UnresolvedAssemblyReference list - /// The list of all sources in the closure with inputs when available - Inputs: (string * ParsedInput option) list - /// The #nowarns - NoWarns: (string * range list) list - /// *Parse* errors seen while parsing root of closure - RootErrors : PhasedError list - /// *Parse* warnings seen while parsing root of closure - RootWarnings : PhasedError list } + SourceFiles: (string * range list) list + + /// The resolved references along with the ranges of the #r positions in each file. + References: (string * AssemblyResolution list) list + + /// The list of references that were not resolved during load closure. These may still be extension references. + UnresolvedReferences : UnresolvedAssemblyReference list + + /// The list of all sources in the closure with inputs when available + Inputs: (string * ParsedInput option) list + + /// The #nowarns + NoWarns: (string * range list) list + + /// *Parse* errors seen while parsing root of closure + RootErrors : PhasedError list + + /// *Parse* warnings seen while parsing root of closure + RootWarnings : PhasedError list } + + // Used from service.fs, when editing a script file static member ComputeClosureOfSourceText : filename : string * source : string * implicitDefines:CodeContext * lexResourceManager : Lexhelp.LexResourceManager -> LoadClosure + + /// Used from fsi.fs and fsc.fs, for #load and command line. The resulting references are then added to a TcConfig. static member ComputeClosureOfSourceFiles : tcConfig:TcConfig * (string * range) list * implicitDefines:CodeContext * useDefaultScriptingReferences : bool * lexResourceManager : Lexhelp.LexResourceManager -> LoadClosure diff --git a/src/fsharp/fscopts.fs b/src/fsharp/CompileOptions.fs similarity index 77% rename from src/fsharp/fscopts.fs rename to src/fsharp/CompileOptions.fs index c91875fd3b4cde4f0fdfb9abbc204623453e90e1..4e5d20ec5698fd49c6a85b5919f2af48aa1755ac 100644 --- a/src/fsharp/fscopts.fs +++ b/src/fsharp/CompileOptions.fs @@ -2,7 +2,7 @@ // # FSComp.SR.opts -module internal Microsoft.FSharp.Compiler.Fscopts +module internal Microsoft.FSharp.Compiler.CompileOptions open Internal.Utilities open System @@ -14,8 +14,8 @@ open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics -open Microsoft.FSharp.Compiler.Build -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.CompileOps +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.TypeChecker open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops @@ -28,7 +28,7 @@ open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.Lexhelp #if NO_COMPILER_BACKEND #else -open Microsoft.FSharp.Compiler.Ilxgen +open Microsoft.FSharp.Compiler.IlxGen #endif @@ -39,6 +39,295 @@ module Attributes = [] do() +//---------------------------------------------------------------------------- +// Compiler option parser +// +// The argument parser is used by both the VS plug-in and the fsc.exe to +// parse the include file path and other front-end arguments. +// +// The language service uses this function too. It's important to continue +// processing flags even if an error is seen in one so that the best possible +// intellisense can be show. +//-------------------------------------------------------------------------- + +[] +type OptionSwitch = + | On + | Off + +type OptionSpec = + | OptionClear of bool ref + | OptionFloat of (float -> unit) + | OptionInt of (int -> unit) + | OptionSwitch of (OptionSwitch -> unit) + | OptionIntList of (int -> unit) + | OptionIntListSwitch of (int -> OptionSwitch -> unit) + | OptionRest of (string -> unit) + | OptionSet of bool ref + | OptionString of (string -> unit) + | OptionStringList of (string -> unit) + | OptionStringListSwitch of (string -> OptionSwitch -> unit) + | OptionUnit of (unit -> unit) + | OptionHelp of (CompilerOptionBlock list -> unit) // like OptionUnit, but given the "options" + | OptionGeneral of (string list -> bool) * (string list -> string list) // Applies? * (ApplyReturningResidualArgs) + +and CompilerOption = CompilerOption of string * string * OptionSpec * Option * string option +and CompilerOptionBlock = PublicOptions of string * CompilerOption list | PrivateOptions of CompilerOption list + +let GetOptionsOfBlock block = + match block with + | PublicOptions (_,opts) -> opts + | PrivateOptions opts -> opts + +let FilterCompilerOptionBlock pred block = + match block with + | PublicOptions(heading,opts) -> PublicOptions(heading,List.filter pred opts) + | PrivateOptions(opts) -> PrivateOptions(List.filter pred opts) + +let compilerOptionUsage (CompilerOption(s,tag,spec,_,_)) = + let s = if s="--" then "" else s (* s="flag" for "--flag" options. s="--" for "--" option. Adjust printing here for "--" case. *) + match spec with + | (OptionUnit _ | OptionSet _ | OptionClear _ | OptionHelp _) -> sprintf "--%s" s + | OptionStringList _ -> sprintf "--%s:%s" s tag + | OptionIntList _ -> sprintf "--%s:%s" s tag + | OptionSwitch _ -> sprintf "--%s[+|-]" s + | OptionStringListSwitch _ -> sprintf "--%s[+|-]:%s" s tag + | OptionIntListSwitch _ -> sprintf "--%s[+|-]:%s" s tag + | OptionString _ -> sprintf "--%s:%s" s tag + | OptionInt _ -> sprintf "--%s:%s" s tag + | OptionFloat _ -> sprintf "--%s:%s" s tag + | OptionRest _ -> sprintf "--%s ..." s + | OptionGeneral _ -> if tag="" then sprintf "%s" s else sprintf "%s:%s" s tag (* still being decided *) + +let PrintCompilerOption (CompilerOption(_s,_tag,_spec,_,help) as compilerOption) = + let flagWidth = 30 // fixed width for printing of flags, e.g. --warnaserror: + let defaultLineWidth = 80 // the fallback width + let lineWidth = try System.Console.BufferWidth with e -> defaultLineWidth + let lineWidth = if lineWidth=0 then defaultLineWidth else lineWidth (* Have seen BufferWidth=0 on Linux/Mono *) + // Lines have this form: + // flagWidth chars - for flags description or padding on continuation lines. + // single space - space. + // description - words upto but excluding the final character of the line. + assert(flagWidth = 30) + printf "%-30s" (compilerOptionUsage compilerOption) + let printWord column (word:string) = + // Have printed upto column. + // Now print the next word including any preceeding whitespace. + // Returns the column printed to (suited to folding). + if column + 1 (*space*) + word.Length >= lineWidth then // NOTE: "equality" ensures final character of the line is never printed + printfn "" (* newline *) + assert(flagWidth = 30) + printf "%-30s %s" ""(*<--flags*) word + flagWidth + 1 + word.Length + else + printf " %s" word + column + 1 + word.Length + let words = match help with None -> [| |] | Some s -> s.Split [| ' ' |] + let _finalColumn = Array.fold printWord flagWidth words + printfn "" (* newline *) + +let PrintPublicOptions (heading,opts) = + if nonNil opts then + printfn "" + printfn "" + printfn "\t\t%s" heading + List.iter PrintCompilerOption opts + +let PrintCompilerOptionBlocks blocks = + let equals x y = x=y + let publicBlocks = List.choose (function PrivateOptions _ -> None | PublicOptions (heading,opts) -> Some (heading,opts)) blocks + let consider doneHeadings (heading, _opts) = + if Set.contains heading doneHeadings then + doneHeadings + else + let headingOptions = List.filter (fst >> equals heading) publicBlocks |> List.map snd |> List.concat + PrintPublicOptions (heading,headingOptions) + Set.add heading doneHeadings + List.fold consider Set.empty publicBlocks |> ignore> + +(* For QA *) +let dumpCompilerOption prefix (CompilerOption(str, _, spec, _, _)) = + printf "section='%-25s' ! option=%-30s kind=" prefix str + match spec with + | OptionUnit _ -> printf "OptionUnit" + | OptionSet _ -> printf "OptionSet" + | OptionClear _ -> printf "OptionClear" + | OptionHelp _ -> printf "OptionHelp" + | OptionStringList _ -> printf "OptionStringList" + | OptionIntList _ -> printf "OptionIntList" + | OptionSwitch _ -> printf "OptionSwitch" + | OptionStringListSwitch _ -> printf "OptionStringListSwitch" + | OptionIntListSwitch _ -> printf "OptionIntListSwitch" + | OptionString _ -> printf "OptionString" + | OptionInt _ -> printf "OptionInt" + | OptionFloat _ -> printf "OptionFloat" + | OptionRest _ -> printf "OptionRest" + | OptionGeneral _ -> printf "OptionGeneral" + printf "\n" +let dumpCompilerOptionBlock = function + | PublicOptions (heading,opts) -> List.iter (dumpCompilerOption heading) opts + | PrivateOptions opts -> List.iter (dumpCompilerOption "NoSection") opts +let DumpCompilerOptionBlocks blocks = List.iter dumpCompilerOptionBlock blocks + +let isSlashOpt (opt:string) = + opt.[0] = '/' && (opt.Length = 1 || not (opt.[1..].Contains "/")) + +let ParseCompilerOptions (collectOtherArgument : string -> unit, blocks: CompilerOptionBlock list, args) = + use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter) + + let specs = List.collect GetOptionsOfBlock blocks + + // returns a tuple - the option token, the option argument string + let parseOption (s : string) = + // grab the option token + let opts = s.Split([|':'|]) + let mutable opt = opts.[0] + if opt = "" then + () + // if it doesn't start with a '-' or '/', reject outright + elif opt.[0] <> '-' && opt.[0] <> '/' then + opt <- "" + elif opt <> "--" then + // is it an abbreviated or MSFT-style option? + // if so, strip the first character and move on with your life + if opt.Length = 2 || isSlashOpt opt then + opt <- opt.[1 ..] + // else, it should be a non-abbreviated option starting with "--" + elif opt.Length > 3 && opt.StartsWith("--") then + opt <- opt.[2 ..] + else + opt <- "" + + // get the argument string + let optArgs = if opts.Length > 1 then String.Join(":",opts.[1 ..]) else "" + opt, optArgs + + let getOptionArg compilerOption (argString : string) = + if argString = "" then + errorR(Error(FSComp.SR.buildOptionRequiresParameter(compilerOptionUsage compilerOption),rangeCmdArgs)) + argString + + let getOptionArgList compilerOption (argString : string) = + if argString = "" then + errorR(Error(FSComp.SR.buildOptionRequiresParameter(compilerOptionUsage compilerOption),rangeCmdArgs)) + [] + else + argString.Split([|',';';'|]) |> List.ofArray + + let getSwitchOpt (opt : string) = + // if opt is a switch, strip the '+' or '-' + if opt <> "--" && opt.Length > 1 && (opt.EndsWith("+",StringComparison.Ordinal) || opt.EndsWith("-",StringComparison.Ordinal)) then + opt.[0 .. opt.Length - 2] + else + opt + + let getSwitch (s: string) = + let s = (s.Split([|':'|])).[0] + if s <> "--" && s.EndsWith("-",StringComparison.Ordinal) then OptionSwitch.Off else OptionSwitch.On + + let rec processArg args = + match args with + | [] -> () + | opt :: t -> + + let optToken, argString = parseOption opt + + let reportDeprecatedOption errOpt = + match errOpt with + | Some(e) -> warning(e) + | None -> () + + let rec attempt l = + match l with + | (CompilerOption(s, _, OptionHelp f, d, _) :: _) when optToken = s && argString = "" -> + reportDeprecatedOption d + f blocks; t + | (CompilerOption(s, _, OptionUnit f, d, _) :: _) when optToken = s && argString = "" -> + reportDeprecatedOption d + f (); t + | (CompilerOption(s, _, OptionSwitch f, d, _) :: _) when getSwitchOpt(optToken) = s && argString = "" -> + reportDeprecatedOption d + f (getSwitch opt); t + | (CompilerOption(s, _, OptionSet f, d, _) :: _) when optToken = s && argString = "" -> + reportDeprecatedOption d + f := true; t + | (CompilerOption(s, _, OptionClear f, d, _) :: _) when optToken = s && argString = "" -> + reportDeprecatedOption d + f := false; t + | (CompilerOption(s, _, OptionString f, d, _) as compilerOption :: _) when optToken = s -> + reportDeprecatedOption d + let oa = getOptionArg compilerOption argString + if oa <> "" then + f (getOptionArg compilerOption oa) + t + | (CompilerOption(s, _, OptionInt f, d, _) as compilerOption :: _) when optToken = s -> + reportDeprecatedOption d + let oa = getOptionArg compilerOption argString + if oa <> "" then + f (try int32 (oa) with _ -> + errorR(Error(FSComp.SR.buildArgInvalidInt(getOptionArg compilerOption argString),rangeCmdArgs)); 0) + t + | (CompilerOption(s, _, OptionFloat f, d, _) as compilerOption :: _) when optToken = s -> + reportDeprecatedOption d + let oa = getOptionArg compilerOption argString + if oa <> "" then + f (try float (oa) with _ -> + errorR(Error(FSComp.SR.buildArgInvalidFloat(getOptionArg compilerOption argString), rangeCmdArgs)); 0.0) + t + | (CompilerOption(s, _, OptionRest f, d, _) :: _) when optToken = s -> + reportDeprecatedOption d + List.iter f t; [] + | (CompilerOption(s, _, OptionIntList f, d, _) as compilerOption :: _) when optToken = s -> + reportDeprecatedOption d + let al = getOptionArgList compilerOption argString + if al <> [] then + List.iter (fun i -> f (try int32 i with _ -> errorR(Error(FSComp.SR.buildArgInvalidInt(i),rangeCmdArgs)); 0)) al ; + t + | (CompilerOption(s, _, OptionIntListSwitch f, d, _) as compilerOption :: _) when getSwitchOpt(optToken) = s -> + reportDeprecatedOption d + let al = getOptionArgList compilerOption argString + if al <> [] then + let switch = getSwitch(opt) + List.iter (fun i -> f (try int32 i with _ -> errorR(Error(FSComp.SR.buildArgInvalidInt(i),rangeCmdArgs)); 0) switch) al + t + // here + | (CompilerOption(s, _, OptionStringList f, d, _) as compilerOption :: _) when optToken = s -> + reportDeprecatedOption d + let al = getOptionArgList compilerOption argString + if al <> [] then + List.iter (fun s -> f s) (getOptionArgList compilerOption argString) + t + | (CompilerOption(s, _, OptionStringListSwitch f, d, _) as compilerOption :: _) when getSwitchOpt(optToken) = s -> + reportDeprecatedOption d + let al = getOptionArgList compilerOption argString + if al <> [] then + let switch = getSwitch(opt) + List.iter (fun s -> f s switch) (getOptionArgList compilerOption argString) + t + | (CompilerOption(_, _, OptionGeneral (pred,exec), d, _) :: _) when pred args -> + reportDeprecatedOption d + let rest = exec args in rest // arguments taken, rest remaining + | (_ :: more) -> attempt more + | [] -> + if opt.Length = 0 || opt.[0] = '-' || isSlashOpt opt + then + // want the whole opt token - delimiter and all + let unrecOpt = (opt.Split([|':'|]).[0]) + errorR(Error(FSComp.SR.buildUnrecognizedOption(unrecOpt),rangeCmdArgs)) + t + else + (collectOtherArgument opt; t) + let rest = attempt specs + processArg rest + + let result = processArg args + result + + +//---------------------------------------------------------------------------- +// Compiler options +//-------------------------------------------------------------------------- + let lexFilterVerbose = false let mutable enableConsoleColoring = true // global state @@ -70,28 +359,28 @@ let SetOptimizeOn(tcConfigB : TcConfigBuilder) = tcConfigB.doFinalSimplify <- true; let SetOptimizeSwitch (tcConfigB : TcConfigBuilder) switch = - if (switch = On) then SetOptimizeOn(tcConfigB) else SetOptimizeOff(tcConfigB) + if (switch = OptionSwitch.On) then SetOptimizeOn(tcConfigB) else SetOptimizeOff(tcConfigB) let SetTailcallSwitch (tcConfigB : TcConfigBuilder) switch = - tcConfigB.emitTailcalls <- (switch = On) + tcConfigB.emitTailcalls <- (switch = OptionSwitch.On) let jitoptimizeSwitch (tcConfigB : TcConfigBuilder) switch = - tcConfigB.optSettings <- { tcConfigB.optSettings with jitOptUser = Some (switch = On) } + tcConfigB.optSettings <- { tcConfigB.optSettings with jitOptUser = Some (switch = OptionSwitch.On) } let localoptimizeSwitch (tcConfigB : TcConfigBuilder) switch = - tcConfigB.optSettings <- { tcConfigB.optSettings with localOptUser = Some (switch = On) } + tcConfigB.optSettings <- { tcConfigB.optSettings with localOptUser = Some (switch = OptionSwitch.On) } let crossOptimizeSwitch (tcConfigB : TcConfigBuilder) switch = - tcConfigB.optSettings <- { tcConfigB.optSettings with crossModuleOptUser = Some (switch = On) } + tcConfigB.optSettings <- { tcConfigB.optSettings with crossModuleOptUser = Some (switch = OptionSwitch.On) } let splittingSwitch (tcConfigB : TcConfigBuilder) switch = - tcConfigB.optSettings <- { tcConfigB.optSettings with abstractBigTargets = switch = On } + tcConfigB.optSettings <- { tcConfigB.optSettings with abstractBigTargets = switch = OptionSwitch.On } let callVirtSwitch (tcConfigB : TcConfigBuilder) switch = - tcConfigB.alwaysCallVirt <- switch = On + tcConfigB.alwaysCallVirt <- switch = OptionSwitch.On let useHighEntropyVASwitch (tcConfigB : TcConfigBuilder) switch = - tcConfigB.useHighEntropyVA <- switch = On + tcConfigB.useHighEntropyVA <- switch = OptionSwitch.On let subSystemVersionSwitch (tcConfigB : TcConfigBuilder) (text : string) = let fail() = error(Error(FSComp.SR.optsInvalidSubSystemVersion(text), rangeCmdArgs)) @@ -123,14 +412,14 @@ let SetDebugSwitch (tcConfigB : TcConfigBuilder) (dtype : string option) (s : Op | "pdbonly" -> tcConfigB.jitTracking <- false | "full" -> tcConfigB.jitTracking <- true | _ -> error(Error(FSComp.SR.optsUnrecognizedDebugType(s), rangeCmdArgs)) - | None -> tcConfigB.jitTracking <- s = On - tcConfigB.debuginfo <- s = On ; + | None -> tcConfigB.jitTracking <- s = OptionSwitch.On + tcConfigB.debuginfo <- s = OptionSwitch.On let setOutFileName tcConfigB s = tcConfigB.outputFile <- Some s let setSignatureFile tcConfigB s = - tcConfigB.printSignature <- true ; + tcConfigB.printSignature <- true tcConfigB.printSignatureFile <- s // option tags @@ -194,11 +483,11 @@ let inputFileFlagsFsc tcConfigB = inputFileFlagsBoth tcConfigB let errorsAndWarningsFlags (tcConfigB : TcConfigBuilder) = [ - CompilerOption("warnaserror", tagNone, OptionSwitch(fun switch -> tcConfigB.globalWarnAsError <- switch <> Off), None, + CompilerOption("warnaserror", tagNone, OptionSwitch(fun switch -> tcConfigB.globalWarnAsError <- switch <> OptionSwitch.Off), None, Some (FSComp.SR.optsWarnaserrorPM())); CompilerOption("warnaserror", tagWarnList, OptionIntListSwitch (fun n switch -> - if switch = Off then + if switch = OptionSwitch.Off then tcConfigB.specificWarnAsError <- ListSet.remove (=) n tcConfigB.specificWarnAsError ; tcConfigB.specificWarnAsWarn <- ListSet.insert (=) n tcConfigB.specificWarnAsWarn else @@ -218,7 +507,7 @@ let errorsAndWarningsFlags (tcConfigB : TcConfigBuilder) = CompilerOption("warnon", tagWarnList, OptionStringList (fun n -> tcConfigB.TurnWarningOn(rangeCmdArgs,n)), None, Some(FSComp.SR.optsWarnOn())); - CompilerOption("consolecolors", tagNone, OptionSwitch (fun switch -> enableConsoleColoring <- switch=On), None, + CompilerOption("consolecolors", tagNone, OptionSwitch (fun switch -> enableConsoleColoring <- switch = OptionSwitch.On), None, Some (FSComp.SR.optsConsoleColors())) ] @@ -244,7 +533,7 @@ let outputFileFlagsFsc (tcConfigB : TcConfigBuilder) = CompilerOption("target", tagModule, OptionString (SetTarget tcConfigB), None, Some (FSComp.SR.optsBuildModule())); - CompilerOption("delaysign", tagNone, OptionSwitch (fun s -> tcConfigB.delaysign <- (s = On)), None, + CompilerOption("delaysign", tagNone, OptionSwitch (fun s -> tcConfigB.delaysign <- (s = OptionSwitch.On)), None, Some (FSComp.SR.optsDelaySign())); CompilerOption("doc", tagFile, OptionString (fun s -> tcConfigB.xmlDocOutputFile <- Some s), None, @@ -301,7 +590,7 @@ let codeGenerationFlags (tcConfigB : TcConfigBuilder) = CompilerOption("debug", tagNone, OptionSwitch (SetDebugSwitch tcConfigB None), None, Some (FSComp.SR.optsDebugPM())); - CompilerOption("debug", tagFullPDBOnly, OptionString (fun s -> SetDebugSwitch tcConfigB (Some(s)) On), None, + CompilerOption("debug", tagFullPDBOnly, OptionString (fun s -> SetDebugSwitch tcConfigB (Some(s)) OptionSwitch.On), None, Some (FSComp.SR.optsDebug())); CompilerOption("optimize", tagNone, OptionSwitch (SetOptimizeSwitch tcConfigB) , None, @@ -326,7 +615,7 @@ let mlCompatibilityFlag (tcConfigB : TcConfigBuilder) = Some (FSComp.SR.optsMlcompatibility())) let languageFlags tcConfigB = [ - CompilerOption("checked", tagNone, OptionSwitch (fun switch -> tcConfigB.checkOverflow <- (switch = On)), None, + CompilerOption("checked", tagNone, OptionSwitch (fun switch -> tcConfigB.checkOverflow <- (switch = OptionSwitch.On)), None, Some (FSComp.SR.optsChecked())); CompilerOption("define", tagString, OptionString (defineSymbol tcConfigB), None, Some (FSComp.SR.optsDefine())); @@ -417,7 +706,7 @@ let advancedFlagsFsc tcConfigB = yield CompilerOption("highentropyva", tagNone, OptionSwitch (useHighEntropyVASwitch tcConfigB), None, Some (FSComp.SR.optsUseHighEntropyVA())) yield CompilerOption("subsystemversion", tagString, OptionString (subSystemVersionSwitch tcConfigB), None, Some (FSComp.SR.optsSubSystemVersion())) yield CompilerOption("targetprofile", tagString, OptionString (setTargetProfile tcConfigB), None, Some(FSComp.SR.optsTargetProfile())) - yield CompilerOption("quotations-debug", tagNone, OptionSwitch(fun switch -> tcConfigB.emitDebugInfoInQuotations <- switch = On), None, Some(FSComp.SR.optsEmitDebugInfoInQuotations())) + yield CompilerOption("quotations-debug", tagNone, OptionSwitch(fun switch -> tcConfigB.emitDebugInfoInQuotations <- switch = OptionSwitch.On), None, Some(FSComp.SR.optsEmitDebugInfoInQuotations())) ] // OptionBlock: Internal options (test use only) @@ -427,7 +716,7 @@ let testFlag tcConfigB = CompilerOption("test", tagString, OptionString (fun s -> match s with | "ErrorRanges" -> tcConfigB.errorStyle <- ErrorStyle.TestErrors - | "MemberBodyRanges" -> PostTypecheckSemanticChecks.testFlagMemberBody := true + | "MemberBodyRanges" -> PostTypeCheckSemanticChecks.testFlagMemberBody := true | "Tracking" -> Lib.tracking := true (* general purpose on/off diagnostics flag *) | "NoNeedToTailcall" -> tcConfigB.optSettings <- { tcConfigB.optSettings with reportNoNeedToTailcall = true } | "FunctionSizes" -> tcConfigB.optSettings <- { tcConfigB.optSettings with reportFunctionSizes = true } @@ -454,13 +743,7 @@ let vsSpecificFlags (tcConfigB: TcConfigBuilder) = let internalFlags (tcConfigB:TcConfigBuilder) = [ CompilerOption("use-incremental-build", tagNone, OptionUnit (fun () -> tcConfigB.useIncrementalBuilder <- true), None, None) - CompilerOption("stamps", tagNone, OptionUnit (fun () -> -#if DEBUG - Tast.verboseStamps := true -#else - () -#endif - ), Some(InternalCommandLineOption("--stamps", rangeCmdArgs)), None); + CompilerOption("stamps", tagNone, OptionUnit (fun () -> ()), Some(InternalCommandLineOption("--stamps", rangeCmdArgs)), None); CompilerOption("ranges", tagNone, OptionSet Tastops.DebugPrint.layoutRanges, Some(InternalCommandLineOption("--ranges", rangeCmdArgs)), None); CompilerOption("terms" , tagNone, OptionUnit (fun () -> tcConfigB.showTerms <- true), Some(InternalCommandLineOption("--terms", rangeCmdArgs)), None); CompilerOption("termsfile" , tagNone, OptionUnit (fun () -> tcConfigB.writeTermsToFiles <- true), Some(InternalCommandLineOption("--termsfile", rangeCmdArgs)), None); @@ -476,7 +759,7 @@ let internalFlags (tcConfigB:TcConfigBuilder) = CompilerOption("tlr", tagInt, OptionInt (setFlag (fun v -> tcConfigB.doTLR <- v)), Some(InternalCommandLineOption("--tlr", rangeCmdArgs)), None); CompilerOption("finalSimplify", tagInt, OptionInt (setFlag (fun v -> tcConfigB.doFinalSimplify <- v)), Some(InternalCommandLineOption("--finalSimplify", rangeCmdArgs)), None); #if TLR_LIFT - CompilerOption("tlrlift", tagNone, OptionInt (setFlag (fun v -> Tlr.liftTLR := v)), Some(InternalCommandLineOption("--tlrlift", rangeCmdArgs)), None); + CompilerOption("tlrlift", tagNone, OptionInt (setFlag (fun v -> InnerLambdasToTopLevelFuncs.liftTLR := v)), Some(InternalCommandLineOption("--tlrlift", rangeCmdArgs)), None); #endif CompilerOption("parseonly", tagNone, OptionUnit (fun () -> tcConfigB.parseOnly <- true), Some(InternalCommandLineOption("--parseonly", rangeCmdArgs)), None); CompilerOption("typecheckonly", tagNone, OptionUnit (fun () -> tcConfigB.typeCheckOnly <- true), Some(InternalCommandLineOption("--typecheckonly", rangeCmdArgs)), None); @@ -582,7 +865,7 @@ let DisplayBannerText tcConfigB = /// FSC only help. (FSI has it's own help function). let displayHelpFsc tcConfigB (blocks:CompilerOptionBlock list) = DisplayBannerText tcConfigB; - printCompilerOptionBlocks blocks + PrintCompilerOptionBlocks blocks exit 0 let miscFlagsBoth tcConfigB = @@ -621,7 +904,7 @@ let abbreviatedFlagsFsc tcConfigB = CompilerOption("full-help", tagNone, OptionHelp (fun blocks -> displayHelpFsc tcConfigB blocks), None, Some(FSComp.SR.optsShortFormOf("--help"))) ] -let abbrevFlagSet tcConfigB isFsc = +let GetAbbrevFlagSet tcConfigB isFsc = let mutable argList : string list = [] for c in ((if isFsc then abbreviatedFlagsFsc else abbreviatedFlagsFsi) tcConfigB) do match c with @@ -653,7 +936,7 @@ let PostProcessCompilerArgs (abbrevArgs : string Set) (args : string []) = let testingAndQAFlags _tcConfigB = [ - CompilerOption("dumpAllCommandLineOptions", tagNone, OptionHelp(fun blocks -> dumpCompilerOptionBlocks blocks), None, None) // "Command line options") + CompilerOption("dumpAllCommandLineOptions", tagNone, OptionHelp(fun blocks -> DumpCompilerOptionBlocks blocks), None, None) // "Command line options") ] @@ -709,7 +992,7 @@ let GetCoreFscCompilerOptions (tcConfigB: TcConfigBuilder) = /// Filter out OptionHelp which does printing then exit. This is not wanted in the context of VS!! let GetCoreServiceCompilerOptions (tcConfigB:TcConfigBuilder) = let isHelpOption = function CompilerOption(_,_,OptionHelp _,_,_) -> true | _ -> false - List.map (filterCompilerOptionBlock (isHelpOption >> not)) (GetCoreFscCompilerOptions tcConfigB) + List.map (FilterCompilerOptionBlock (isHelpOption >> not)) (GetCoreFscCompilerOptions tcConfigB) /// The core/common options used by fsi.exe. [note, some additional options are added in fsi.fs]. let GetCoreFsiCompilerOptions (tcConfigB: TcConfigBuilder) = @@ -819,18 +1102,18 @@ let ReportTime (tcConfig:TcConfig) descr = // OPTIMIZATION - support - addDllToOptEnv //---------------------------------------------------------------------------- -let AddExternalCcuToOpimizationEnv tcGlobals optEnv ccuinfo = +let AddExternalCcuToOpimizationEnv tcGlobals optEnv (ccuinfo: ImportedAssembly) = match ccuinfo.FSharpOptimizationData.Force() with | None -> optEnv - | Some(data) -> Opt.BindCcu ccuinfo.FSharpViewOfMetadata data optEnv tcGlobals + | Some(data) -> Optimizer.BindCcu ccuinfo.FSharpViewOfMetadata data optEnv tcGlobals //---------------------------------------------------------------------------- // OPTIMIZATION - support - optimize //---------------------------------------------------------------------------- -let InitialOptimizationEnv (tcImports:TcImports) (tcGlobals:TcGlobals) = +let GetInitialOptimizationEnv (tcImports:TcImports, tcGlobals:TcGlobals) = let ccuinfos = tcImports.GetImportedAssemblies() - let optEnv = Opt.IncrementalOptimizationEnv.Empty + let optEnv = Optimizer.IncrementalOptimizationEnv.Empty let optEnv = List.fold (AddExternalCcuToOpimizationEnv tcGlobals) optEnv ccuinfos optEnv @@ -859,7 +1142,7 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM //ReportTime tcConfig ("Initial simplify"); let optEnvFirstLoop,implFile,implFileOptData = - Opt.OptimizeImplFile(optSettings,ccu,tcGlobals,tcVal, importMap,optEnvFirstLoop,isIncrementalFragment,tcConfig.emitTailcalls,implFile) + Optimizer.OptimizeImplFile(optSettings,ccu,tcGlobals,tcVal, importMap,optEnvFirstLoop,isIncrementalFragment,tcConfig.emitTailcalls,implFile) let implFile = AutoBox.TransformImplFile tcGlobals importMap implFile @@ -867,13 +1150,13 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM let optSettings = { optSettings with abstractBigTargets = false } let optSettings = { optSettings with reportingPhase = false } #if DEBUG - if tcConfig.showOptimizationData then dprintf "Optimization implFileOptData:\n%s\n" (Layout.showL (Layout.squashTo 192 (Opt.moduleInfoL tcGlobals implFileOptData))); + if tcConfig.showOptimizationData then dprintf "Optimization implFileOptData:\n%s\n" (Layout.showL (Layout.squashTo 192 (Optimizer.moduleInfoL tcGlobals implFileOptData))); #endif let implFile,optEnvExtraLoop = if tcConfig.extraOptimizationIterations > 0 then //ReportTime tcConfig ("Extra simplification loop"); - let optEnvExtraLoop,implFile, _ = Opt.OptimizeImplFile(optSettings,ccu,tcGlobals,tcVal, importMap,optEnvExtraLoop,isIncrementalFragment,tcConfig.emitTailcalls,implFile) + let optEnvExtraLoop,implFile, _ = Optimizer.OptimizeImplFile(optSettings,ccu,tcGlobals,tcVal, importMap,optEnvExtraLoop,isIncrementalFragment,tcConfig.emitTailcalls,implFile) //PrintWholeAssemblyImplementation tcConfig outfile (sprintf "extra-loop-%d" n) implFile; implFile,optEnvExtraLoop else @@ -889,16 +1172,16 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM let implFile = if tcConfig.doTLR then - implFile |> Tlr.MakeTLRDecisions ccu tcGlobals + implFile |> InnerLambdasToTopLevelFuncs.MakeTLRDecisions ccu tcGlobals else implFile let implFile = - Lowertop.LowerImplFile tcGlobals implFile + LowerCallsAndSeqs.LowerImplFile tcGlobals implFile let implFile,optEnvFinalSimplify = if tcConfig.doFinalSimplify then //ReportTime tcConfig ("Final simplify pass"); - let optEnvFinalSimplify,implFile, _ = Opt.OptimizeImplFile(optSettings,ccu,tcGlobals,tcVal, importMap,optEnvFinalSimplify,isIncrementalFragment,tcConfig.emitTailcalls,implFile) + let optEnvFinalSimplify,implFile, _ = Optimizer.OptimizeImplFile(optSettings,ccu,tcGlobals,tcVal, importMap,optEnvFinalSimplify,isIncrementalFragment,tcConfig.emitTailcalls,implFile) //PrintWholeAssemblyImplementation tcConfig outfile "post-rec-opt" implFile; implFile,optEnvFinalSimplify else @@ -906,7 +1189,7 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM (implFile,implFileOptData),(optEnvFirstLoop,optEnvExtraLoop,optEnvFinalSimplify)) let implFiles,implFileOptDatas = List.unzip results - let assemblyOptData = Opt.UnionModuleInfos implFileOptDatas + let assemblyOptData = Optimizer.UnionOptimizationInfos implFileOptDatas let tassembly = TAssembly(implFiles) PrintWholeAssemblyImplementation tcConfig outfile "pass-end" tassembly; ReportTime tcConfig ("Ending Optimizations"); @@ -919,7 +1202,7 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM //---------------------------------------------------------------------------- let CreateIlxAssemblyGenerator (_tcConfig:TcConfig,tcImports:TcImports,tcGlobals, tcVal, generatedCcu) = - let ilxGenerator = new Ilxgen.IlxAssemblyGenerator (tcImports.GetImportMap(), tcGlobals, tcVal, generatedCcu) + let ilxGenerator = new IlxGen.IlxAssemblyGenerator (tcImports.GetImportMap(), tcGlobals, tcVal, generatedCcu) let ccus = tcImports.GetCcusInDeclOrder() ilxGenerator.AddExternalCcus ccus ilxGenerator @@ -958,7 +1241,7 @@ let NormalizeAssemblyRefs (tcImports:TcImports) scoref = | Some dllInfo -> dllInfo.ILScopeRef | None -> scoref -let fsharpModuleName (t:CompilerTarget) (s:string) = +let GetGeneratedILModuleName (t:CompilerTarget) (s:string) = // return the name of the file as a module name let ext = match t with | Dll -> "dll" | Module -> "netmodule" | _ -> "exe" s + "." + ext diff --git a/src/fsharp/CompileOptions.fsi b/src/fsharp/CompileOptions.fsi new file mode 100644 index 0000000000000000000000000000000000000000..b99f6a4e7bc6c6f0ce848e3590253cea7372bb46 --- /dev/null +++ b/src/fsharp/CompileOptions.fsi @@ -0,0 +1,100 @@ +// Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +module internal Microsoft.FSharp.Compiler.CompileOptions + +open Internal.Utilities +open Microsoft.FSharp.Compiler +open Microsoft.FSharp.Compiler.AbstractIL +open Microsoft.FSharp.Compiler.AbstractIL.IL +open Microsoft.FSharp.Compiler.AbstractIL.Internal +open Microsoft.FSharp.Compiler.CompileOps +open Microsoft.FSharp.Compiler.ErrorLogger +open Microsoft.FSharp.Compiler.Ast +open Microsoft.FSharp.Compiler.Tast +open Microsoft.FSharp.Compiler.Import +open Microsoft.FSharp.Compiler.Optimizer +open Microsoft.FSharp.Compiler.TcGlobals + +//---------------------------------------------------------------------------- +// Compiler Option Parser +//-------------------------------------------------------------------------- + +// For command-line options that can be suffixed with +/- +[] +type OptionSwitch = + | On + | Off + +/// The spec value describes the action of the argument, +/// and whether it expects a following parameter. +type OptionSpec = + | OptionClear of bool ref + | OptionFloat of (float -> unit) + | OptionInt of (int -> unit) + | OptionSwitch of (OptionSwitch -> unit) + | OptionIntList of (int -> unit) + | OptionIntListSwitch of (int -> OptionSwitch -> unit) + | OptionRest of (string -> unit) + | OptionSet of bool ref + | OptionString of (string -> unit) + | OptionStringList of (string -> unit) + | OptionStringListSwitch of (string -> OptionSwitch -> unit) + | OptionUnit of (unit -> unit) + | OptionHelp of (CompilerOptionBlock list -> unit) // like OptionUnit, but given the "options" + | OptionGeneral of (string list -> bool) * (string list -> string list) // Applies? * (ApplyReturningResidualArgs) + +and CompilerOption = + /// CompilerOption(name, argumentDescriptionString, actionSpec, exceptionOpt, helpTextOpt + | CompilerOption of string * string * OptionSpec * Option * string option + +and CompilerOptionBlock = + | PublicOptions of string * CompilerOption list + | PrivateOptions of CompilerOption list + +val PrintCompilerOptionBlocks : CompilerOptionBlock list -> unit // for printing usage +val DumpCompilerOptionBlocks : CompilerOptionBlock list -> unit // for QA +val FilterCompilerOptionBlock : (CompilerOption -> bool) -> CompilerOptionBlock -> CompilerOptionBlock + +/// Parse and process a set of compiler options +val ParseCompilerOptions : (string -> unit) * CompilerOptionBlock list * string list -> unit + + +//---------------------------------------------------------------------------- +// Compiler Options +//-------------------------------------------------------------------------- + +val DisplayBannerText : TcConfigBuilder -> unit + +val GetCoreFscCompilerOptions : TcConfigBuilder -> CompilerOptionBlock list +val GetCoreFsiCompilerOptions : TcConfigBuilder -> CompilerOptionBlock list +val GetCoreServiceCompilerOptions : TcConfigBuilder -> CompilerOptionBlock list + +// Expose the "setters" for some user switches, to enable setting of defaults +val SetOptimizeSwitch : TcConfigBuilder -> OptionSwitch -> unit +val SetTailcallSwitch : TcConfigBuilder -> OptionSwitch -> unit +val SetDebugSwitch : TcConfigBuilder -> string option -> OptionSwitch -> unit +val PrintOptionInfo : TcConfigBuilder -> unit + +val GetGeneratedILModuleName : CompilerTarget -> string -> string + +#if NO_COMPILER_BACKEND +#else +val GetInitialOptimizationEnv : TcImports * TcGlobals -> IncrementalOptimizationEnv +val AddExternalCcuToOpimizationEnv : TcGlobals -> IncrementalOptimizationEnv -> ImportedAssembly -> IncrementalOptimizationEnv +val ApplyAllOptimizations : TcConfig * TcGlobals * ConstraintSolver.TcValF * string * ImportMap * bool * IncrementalOptimizationEnv * CcuThunk * TypedAssembly -> TypedAssembly * Optimizer.LazyModuleInfo * IncrementalOptimizationEnv + +val CreateIlxAssemblyGenerator : TcConfig * TcImports * TcGlobals * ConstraintSolver.TcValF * CcuThunk -> IlxGen.IlxAssemblyGenerator + +val GenerateIlxCode : IlxGen.IlxGenBackend * bool * bool * TcConfig * TypeChecker.TopAttribs * TypedAssembly * string * bool * IlxGen.IlxAssemblyGenerator -> IlxGen.IlxGenResults +#endif + +// Used during static linking +val NormalizeAssemblyRefs : TcImports -> (AbstractIL.IL.ILScopeRef -> AbstractIL.IL.ILScopeRef) + +// Miscellany +val ignoreFailureOnMono1_1_16 : (unit -> unit) -> unit +val mutable enableConsoleColoring : bool +val DoWithErrorColor : bool -> (unit -> 'a) -> 'a +val ReportTime : TcConfig -> string -> unit +val GetAbbrevFlagSet : TcConfigBuilder -> bool -> Set +val PostProcessCompilerArgs : string Set -> string [] -> string list diff --git a/src/fsharp/csolve.fs b/src/fsharp/ConstraintSolver.fs similarity index 99% rename from src/fsharp/csolve.fs rename to src/fsharp/ConstraintSolver.fs index 70e35b2ce3c99bc01bb15ba04e14f82a30811167..928ba122d75579b726f58e1c4bb34ffb83efa1f9 100644 --- a/src/fsharp/csolve.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -45,12 +45,12 @@ open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.Tastops.DebugPrint -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.Infos open Microsoft.FSharp.Compiler.Infos.AccessibilityLogic open Microsoft.FSharp.Compiler.Infos.AttributeChecking -open Microsoft.FSharp.Compiler.Typrelns +open Microsoft.FSharp.Compiler.TypeRelations open Microsoft.FSharp.Compiler.PrettyNaming //------------------------------------------------------------------------- @@ -121,9 +121,9 @@ exception ConstraintSolverMissingConstraint of DisplayEnv * Tast.Typar * Tast.Ty exception ConstraintSolverError of string * range * range exception ConstraintSolverRelatedInformation of string option * range * exn -exception ErrorFromApplyingDefault of Env.TcGlobals * DisplayEnv * Tast.Typar * TType * exn * range -exception ErrorFromAddingTypeEquation of Env.TcGlobals * DisplayEnv * TType * TType * exn * range -exception ErrorsFromAddingSubsumptionConstraint of Env.TcGlobals * DisplayEnv * TType * TType * exn * range +exception ErrorFromApplyingDefault of TcGlobals * DisplayEnv * Tast.Typar * TType * exn * range +exception ErrorFromAddingTypeEquation of TcGlobals * DisplayEnv * TType * TType * exn * range +exception ErrorsFromAddingSubsumptionConstraint of TcGlobals * DisplayEnv * TType * TType * exn * range exception ErrorFromAddingConstraint of DisplayEnv * exn * range exception PossibleOverload of DisplayEnv * string * exn * range exception UnresolvedOverloading of DisplayEnv * exn list * string * range @@ -136,7 +136,7 @@ type TcValF = (ValRef -> ValUseFlag -> TType list -> range -> Expr * TType) type ConstraintSolverState = { - g: Env.TcGlobals; + g: TcGlobals; amap: Import.ImportMap; InfoReader : InfoReader; TcVal : TcValF @@ -1290,7 +1290,7 @@ and MemberConstraintSolutionOfMethInfo css m minfo minst = let minst = [] // GENERIC TYPE PROVIDERS: for generics, we would have an minst here let allArgVars, allArgs = minfo.GetParamTypes(amap, m, minst) |> List.concat |> List.mapi (fun i ty -> mkLocal m ("arg"+string i) ty) |> List.unzip let objArgVars, objArgs = (if minfo.IsInstance then [mkLocal m "this" minfo.EnclosingType] else []) |> List.unzip - let callMethInfoOpt, callExpr,callExprTy = Typrelns.ProvidedMethodCalls.BuildInvokerExpressionForProvidedMethodCall css.TcVal (g, amap, mi, objArgs, NeverMutates, false, ValUseFlag.NormalValUse, allArgs, m) + let callMethInfoOpt, callExpr,callExprTy = TypeRelations.ProvidedMethodCalls.BuildInvokerExpressionForProvidedMethodCall css.TcVal (g, amap, mi, objArgs, NeverMutates, false, ValUseFlag.NormalValUse, allArgs, m) let closedExprSln = ClosedExprSln (mkLambdas m [] (objArgVars@allArgVars) (callExpr, callExprTy) ) // If the call is a simple call to an IL method with all the arguments in the natural order, then revert to use ILMethSln. // This is important for calls to operators on generated provided types. There is an (unchecked) condition @@ -1644,7 +1644,7 @@ and SolveTypeSupportsComparison (csenv:ConstraintSolverEnv) ndeep m2 trace ty = // Give a good error for structural types excluded from the comparison relation because of their fields elif (isAppTy g ty && let tcref = tcrefOfAppTy g ty - Augment.TyconIsCandidateForAugmentationWithCompare g tcref.Deref && + AugmentWithHashCompare.TyconIsCandidateForAugmentationWithCompare g tcref.Deref && isNone tcref.GeneratedCompareToWithComparerValues) then ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison3(NicePrint.minimalStringOfType denv ty),m,m2)) @@ -1672,7 +1672,7 @@ and SolveTypSupportsEquality (csenv:ConstraintSolverEnv) ndeep m2 trace ty = let tcref,tinst = destAppTy g ty // Give a good error for structural types excluded from the equality relation because of their fields - if (Augment.TyconIsCandidateForAugmentationWithEquals g tcref.Deref && + if (AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals g tcref.Deref && isNone tcref.GeneratedHashAndEqualsWithComparerValues) then ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality3(NicePrint.minimalStringOfType denv ty),m,m2)) diff --git a/src/fsharp/csolve.fsi b/src/fsharp/ConstraintSolver.fsi similarity index 85% rename from src/fsharp/csolve.fsi rename to src/fsharp/ConstraintSolver.fsi index f1a600f1002d09caacea17e146904461a76f7593..6d9b2b7bc9f6c4e633c0f3125890decc695eff98 100644 --- a/src/fsharp/csolve.fsi +++ b/src/fsharp/ConstraintSolver.fsi @@ -1,5 +1,6 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. +/// Solves constraints using a mutable constraint-solver state module internal Microsoft.FSharp.Compiler.ConstraintSolver open Internal.Utilities @@ -15,18 +16,32 @@ open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.Import open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.Tast -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.Infos +/// Create a type variable representing the use of a "_" in F# code val NewAnonTypar : TyparKind * range * TyparRigidity * TyparStaticReq * TyparDynamicReq -> Typar + +/// Create an inference type variable val NewInferenceType : unit -> TType + +/// Create an inference type variable representing an error condition when checking an expression val NewErrorType : unit -> TType + +/// Create an inference type variable representing an error condition when checking a measure val NewErrorMeasure : unit -> MeasureExpr + +/// Create a list of inference type variables, one for each element in the input list val NewInferenceTypes : 'a list -> TType list +/// Given a set of formal type parameters and their constraints, make new inference type variables for +/// each and ensure that the constraints on the new type variables are adjusted to refer to these. val FreshenAndFixupTypars : range -> TyparRigidity -> Typars -> TType list -> Typars -> Typars * TyparInst * TType list + val FreshenTypeInst : range -> Typars -> Typars * TyparInst * TType list + val FreshenTypars : range -> Typars -> TType list + val FreshenMethInfo : range -> MethInfo -> TType list exception ConstraintSolverTupleDiffLengths of DisplayEnv * TType list * TType list * range * range @@ -42,16 +57,15 @@ exception ErrorsFromAddingSubsumptionConstraint of TcGlobals * DisplayEn exception ErrorFromAddingConstraint of DisplayEnv * exn * range exception UnresolvedConversionOperator of DisplayEnv * TType * TType * range exception PossibleOverload of DisplayEnv * string * exn * range -exception UnresolvedOverloading of DisplayEnv * exn list (* PossibleOverload list *) * string * range -//exception PossibleBestOverload of DisplayEnv * string * range +exception UnresolvedOverloading of DisplayEnv * exn list * string * range exception NonRigidTypar of DisplayEnv * string option * range * TType * TType * range -/// function type that denotes captured tcVal used in constraint solver +/// A function that denotes captured tcVal, Used in constraint solver and elsewhere to get appropriate expressions for a ValRef. type TcValF = (ValRef -> ValUseFlag -> TType list -> range -> Expr * TType) [] type ConstraintSolverState = - static member New: TcGlobals * Import.ImportMap * InfoReader * TcValF-> ConstraintSolverState + static member New: TcGlobals * Import.ImportMap * InfoReader * TcValF -> ConstraintSolverState type ConstraintSolverEnv @@ -69,10 +83,9 @@ val SimplifyMeasuresInTypeScheme : TcGlobals -> bool -> Typars -> TT val SolveTyparEqualsTyp : ConstraintSolverEnv -> int -> range -> OptionalTrace -> TType -> TType -> OperationResult val SolveTypEqualsTypKeepAbbrevs : ConstraintSolverEnv -> int -> range -> OptionalTrace -> TType -> TType -> OperationResult val CanonicalizeRelevantMemberConstraints : ConstraintSolverEnv -> int -> OptionalTrace -> Typars -> OperationResult -val ResolveOverloading : ConstraintSolverEnv -> OptionalTrace -> string -> ndeep: int -> bool -> int * int -> AccessorDomain -> Typrelns.CalledMeth list -> bool -> TType option -> Typrelns.CalledMeth option * OperationResult -val UnifyUniqueOverloading : ConstraintSolverEnv -> int * int -> string -> AccessorDomain -> Typrelns.CalledMeth list -> TType -> OperationResult +val ResolveOverloading : ConstraintSolverEnv -> OptionalTrace -> string -> ndeep: int -> bool -> int * int -> AccessorDomain -> TypeRelations.CalledMeth list -> bool -> TType option -> TypeRelations.CalledMeth option * OperationResult +val UnifyUniqueOverloading : ConstraintSolverEnv -> int * int -> string -> AccessorDomain -> TypeRelations.CalledMeth list -> TType -> OperationResult val EliminateConstraintsForGeneralizedTypars : ConstraintSolverEnv -> OptionalTrace -> Typars -> unit -//val AdjustCalledArgType : TcGlobals -> InfoReader -> bool -> Typrelns.CalledArg -> Typrelns.CallerArg<'T> -> TType val CheckDeclaredTypars : DisplayEnv -> ConstraintSolverState -> range -> Typars -> Typars -> unit diff --git a/src/fsharp/detuple.fs b/src/fsharp/DetupleArgs.fs similarity index 81% rename from src/fsharp/detuple.fs rename to src/fsharp/DetupleArgs.fs index 3265f5d634b04426942823726cb3adb61755475f..521fc2435f08259f05506f7d52bb8debbf641093 100644 --- a/src/fsharp/detuple.fs +++ b/src/fsharp/DetupleArgs.fs @@ -3,18 +3,17 @@ module internal Microsoft.FSharp.Compiler.Detuple open Internal.Utilities +open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library -open Microsoft.FSharp.Compiler - open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.Tastops.DebugPrint -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.Layout open Microsoft.FSharp.Compiler.PrettyNaming open Microsoft.FSharp.Compiler.Lib @@ -168,7 +167,7 @@ let (|TyappAndApp|_|) e = // GetValsBoundInExpr //------------------------------------------------------------------------- -module GlobalUsageAnalysis = begin +module GlobalUsageAnalysis = let bindAccBounds vals (_isInDTree,v) = Zset.add v vals let GetValsBoundInExpr expr = @@ -184,59 +183,60 @@ module GlobalUsageAnalysis = begin type accessor = TupleGet of int * TType list + /// Expr information. + /// For each v, + /// (a) log it's usage site context = accessors // APP type-inst args + /// where first accessor in list applies first to the v/app. + /// (b) log it's binding site representation. type Results = - (* Expr information. - * For each v, - * (a) log it's usage site context = accessors // APP type-inst args - * where first accessor in list applies first to the v/app. - * (b) log it's binding site representation. - *------ - * Future, could generalise to be graph representation of expr. (partly there). - * This type used to be called "usage". - *) - { Uses : Zmap; (* v -> context / APP inst args *) - Defns : Zmap; (* v -> binding repr *) - DecisionTreeBindings : Zset; (* bound in a decision tree? *) - RecursiveBindings : Zmap; (* v -> v list * recursive? -- the others in the mutual binding *) - TopLevelBindings : Zset; - IterationIsAtTopLevel : bool - } + { /// v -> context / APP inst args + Uses : Zmap + /// v -> binding repr + Defns : Zmap + /// bound in a decision tree? + DecisionTreeBindings : Zset + /// v -> v list * recursive? -- the others in the mutual binding + RecursiveBindings : Zmap + TopLevelBindings : Zset + IterationIsAtTopLevel : bool } let z0 = - { Uses = Zmap.empty valOrder; - Defns = Zmap.empty valOrder; - RecursiveBindings = Zmap.empty valOrder; - DecisionTreeBindings = Zset.empty valOrder; - TopLevelBindings = Zset.empty valOrder; - IterationIsAtTopLevel = true - } - - // Note: this routine is called very frequently + { Uses = Zmap.empty valOrder + Defns = Zmap.empty valOrder + RecursiveBindings = Zmap.empty valOrder + DecisionTreeBindings = Zset.empty valOrder + TopLevelBindings = Zset.empty valOrder + IterationIsAtTopLevel = true } + + /// Log the use of a value with a particular tuple chape at a callsite + /// Note: this routine is called very frequently let logUse (f:Val) tup z = {z with Uses = match Zmap.tryFind f z.Uses with | Some sites -> Zmap.add f (tup::sites) z.Uses | None -> Zmap.add f [tup] z.Uses } + /// Log the definition of a binding let logBinding z (isInDTree,v) = let z = if isInDTree then {z with DecisionTreeBindings = Zset.add v z.DecisionTreeBindings} else z let z = if z.IterationIsAtTopLevel then {z with TopLevelBindings = Zset.add v z.TopLevelBindings} else z z + /// Log the definition of a non-recursive binding let logNonRecBinding z (bind:Binding) = - (* log mubind v -> vs *) let v = bind.Var let vs = FlatList.one v {z with RecursiveBindings = Zmap.add v (false,vs) z.RecursiveBindings; Defns = Zmap.add v bind.Expr z.Defns } + /// Log the definition of a recursive binding let logRecBindings z binds = - (* log mubind v -> vs *) let vs = valsOfBinds binds {z with RecursiveBindings = (z.RecursiveBindings,vs) ||> FlatList.fold (fun mubinds v -> Zmap.add v (true,vs) mubinds); Defns = (z.Defns,binds) ||> FlatList.fold (fun eqns bind -> Zmap.add bind.Var bind.Expr eqns) } + /// Work locally under a lambda of some kind let foldUnderLambda f z x = let saved = z.IterationIsAtTopLevel let z = {z with IterationIsAtTopLevel=false} @@ -244,49 +244,24 @@ module GlobalUsageAnalysis = begin let z = {z with IterationIsAtTopLevel=saved} z -#if DEBUG - let dumpXInfo z = - let soAccessor (TupleGet (n,_ts)) = "#" ^ string n - let dumpSite v (accessors,inst,args) = - dprintf "- use %s%s %s %s\n" - (showL (valL v)) - (match inst with - [] -> "" - | _ -> "@[" ^ showL (commaListL (List.map typeL inst)) ^ "]") - (showL (spaceListL (List.map exprL args))) - (match accessors with - [] -> "" - | _ -> "|> " ^ String.concat " " (List.map soAccessor accessors)) - let dumpUse v sites = List.iter (dumpSite v) sites - let dumpTop (v:Val) = dprintf "- toplevel: %s\n" v.LogicalName - if false then - ( dprintf "usage:\n"; - Zmap.iter dumpUse z.Uses; - Zset.iter dumpTop z.TopLevelBindings - ) - else - () -#endif - - //------------------------------------------------------------------------- // GlobalUsageAnalysis - FoldExpr, foldBind collectors //------------------------------------------------------------------------- + // Fold expr, intercepts selected exprs. + // "val v" - count [] callpattern of v + // "app (f,args)" - count callpattern of f + //--- + // On intercepted nodes, must continue exprF fold over any subexpressions, e.g. args. + //------ + // Also, noting top-level bindings, + // so must cancel top-level "foldUnderLambda" whenever step under loop/lambda: + // - lambdas + // - try/with and try/finally + // - for body + // - match targets + // - tmethods let UsageFolders g = - // Fold expr, intercepts selected exprs. - // "val v" - count [] callpattern of v - // "app (f,args)" - count callpattern of f - //--- - // On intercepted nodes, must continue exprF fold over any subexpressions, e.g. args. - //------ - // Also, noting top-level bindings, - // so must cancel top-level "foldUnderLambda" whenever step under loop/lambda: - // - lambdas - // - try/with and try/finally - // - for body - // - match targets - // - tmethods let foldLocalVal f z (vref: ValRef) = if valRefInThisAssembly g.compilingFslib vref then f z vref.Deref else z @@ -331,12 +306,12 @@ module GlobalUsageAnalysis = begin let tmethodIntercept exprF z = function TObjExprMethod(_,_,_,_,e,_m) -> Some (foldUnderLambda exprF z e) {ExprFolder0 with - exprIntercept = exprUsageIntercept; - nonRecBindingsIntercept = logNonRecBinding; - recBindingsIntercept = logRecBindings; - valBindingSiteIntercept = logBinding; - targetIntercept = targetIntercept; - tmethodIntercept = tmethodIntercept; + exprIntercept = exprUsageIntercept + nonRecBindingsIntercept = logNonRecBinding + recBindingsIntercept = logRecBindings + valBindingSiteIntercept = logBinding + targetIntercept = targetIntercept + tmethodIntercept = tmethodIntercept } @@ -349,8 +324,6 @@ module GlobalUsageAnalysis = begin let z = FoldImplFile folder z0 expr z -end - open GlobalUsageAnalysis @@ -364,23 +337,17 @@ let mkLocalVal m name ty topValInfo = let compgen = false in (* REVIEW: review: should this be true? *) NewVal(name,m,None,ty,Immutable,compgen,topValInfo,taccessPublic,ValNotInRecScope,None,NormalVal,[],ValInline.Optional,XmlDoc.Empty,false,false,false,false,false,false,None,ParentNone) -let dprintTerm header expr = - if false then - let str = Layout.showL (Layout.squashTo 192 (implFileL expr)) (* improve cxty! *) - dprintf "\n\n\n%s:\n%s\n" header str - else - () - //------------------------------------------------------------------------- // TupleStructure = tuple structure //------------------------------------------------------------------------- -type TupleStructure = (* tuple structure *) +type TupleStructure = | UnknownTS | TupleTS of TupleStructure list -let rec ValReprInfoForTS = function +let rec ValReprInfoForTS ts = + match ts with | UnknownTS -> [ValReprInfo.unnamedTopArg] | TupleTS ts -> ts |> List.collect ValReprInfoForTS @@ -396,7 +363,9 @@ let checkTS = function | TupleTS [_] -> internalError "exprTS: Tuple[x] not expected. (singleton tuples should not exist." | ts -> ts -let rec uncheckedExprTS = function (* explicit tuple-structure in expr *) +/// explicit tuple-structure in expr +let rec uncheckedExprTS expr = + match expr with | Expr.Op(TOp.Tuple,_tys,args,_) -> TupleTS (List.map uncheckedExprTS args) | _ -> UnknownTS @@ -415,35 +384,28 @@ let rebuildTS g m ts vs = match vs,ts with | [] ,UnknownTS -> internalError "rebuildTS: not enough fringe to build tuple" | v::vs,UnknownTS -> vs,(exprForVal m v,v.Type) - | vs ,TupleTS tss -> let vs,xtys = List.foldMap rebuild vs tss - let xs,tys = List.unzip xtys - let x = mkTupled g m xs tys - let ty = mkTupledTy g tys - vs,(x,ty) + | vs ,TupleTS tss -> + let vs,xtys = List.foldMap rebuild vs tss + let xs,tys = List.unzip xtys + let x = mkTupled g m xs tys + let ty = mkTupledTy g tys + vs,(x,ty) let vs,(x,_ty) = rebuild vs ts if vs.Length <> 0 then internalError "rebuildTS: had move fringe vars than fringe. REPORT BUG" else (); x -(* naive string concats, just for testing *) - /// CallPattern is tuple-structure for each argument position. /// - callsites have a CallPattern (possibly instancing fOrig at tuple types...). /// - the definition lambdas may imply a one-level CallPattern /// - the definition formal projection info suggests a CallPattern -type CallPattern = - TupleStructure list (* equality/ordering ok on this type *) +type CallPattern = TupleStructure list let callPatternOrder = (compare : CallPattern -> CallPattern -> int) let argsCP exprs = List.map exprTS exprs let noArgsCP = [] let isTrivialCP xs = (isNil xs) -#if DEBUG -let rec soTS = function (UnknownTS) -> "_" | TupleTS ss -> "(" ^ String.concat "," (List.map soTS ss) ^ ")" -let soCP tss = String.concat ";" (List.map soTS tss) -#endif - let rec minimalCallPattern callPattern = match callPattern with | [] -> [] @@ -453,7 +415,6 @@ let rec minimalCallPattern callPattern = | tss -> UnknownTS::tss (* non triv tss tail *) | (TupleTS ts)::tss -> TupleTS ts :: minimalCallPattern tss -/// INTERSECTION. /// Combines a list of callpatterns into one common callpattern. let commonCallPattern callPatterns = let rec andCPs cpA cpB = @@ -487,10 +448,9 @@ type TransformedFormal = /// - yb1..ybp - replacement formal choices for x1...xp. /// - transformedVal - replaces f. type Transform = - { transformCallPattern : CallPattern; - transformedFormals : TransformedFormal list; (* REVIEW: could push these to fixup binding site *) - transformedVal : Val; - } + { transformCallPattern : CallPattern + transformedFormals : TransformedFormal list + transformedVal : Val } //------------------------------------------------------------------------- @@ -530,26 +490,10 @@ let mkTransform g (f:Val) m tps x1Ntys rty (callPattern,tyfringes: (TType list * let argtys = tys1r @ tysrN let fCty = mkLambdaTy tps argtys rty let transformedVal = mkLocalVal f.Range (globalNng.FreshCompilerGeneratedName (f.LogicalName,f.Range)) fCty topValInfo - (*dprintf "mkTransform: f=%s\n" (showL (valL f)); - dprintf "mkTransform: tps=%s\n" (showL (commaListL (List.map typarL tps))); - dprintf "mkTransform: callPattern=%s\n" (soCP callPattern); - dprintf "mkTransform: tyfringes=%s\n" (showL (commaListL (List.map (fun fr -> tupleL (List.map typeL fr)) tyfringes))); - dprintf "mkTransform: tys1r=%s\n" (showL (commaListL (List.map typeL tys1r))); - dprintf "mkTransform: tysrN=%s\n" (showL (commaListL (List.map typeL tysrN))); - dprintf "mkTransform: rty =%s\n" ((showType rty)); - *) - { transformCallPattern = callPattern; - transformedFormals = transformedFormals; - transformedVal = transformedVal; - } - -#if DEBUG -open Microsoft.FSharp.Compiler.Layout -let dumpTransform trans = - dprintf " - cp : %s\n - transformedVal : %s\n\n" - (soCP trans.transformCallPattern) - (showL (valL trans.transformedVal)) -#endif + { transformCallPattern = callPattern + transformedFormals = transformedFormals + transformedVal = transformedVal } + //------------------------------------------------------------------------- // transform - vTransforms - support @@ -618,34 +562,23 @@ let decideFormalSuggestedCP g z tys vss = // transform - decideTransform //------------------------------------------------------------------------- -let decideTransform g z v callPatterns (m,tps,vss:Val list list,rty) (* tys are types of outer args *) = +let decideTransform g z v callPatterns (m,tps,vss:Val list list,rty) = let tys = List.map (typeOfLambdaArg m) vss (* arg types *) (* NOTE: 'a in arg types may have been instanced at different tuples... *) (* commonCallPattern has to handle those cases. *) let callPattern = commonCallPattern callPatterns // common CallPattern let callPattern = List.take vss.Length callPattern // restricted to max nArgs - (* NOW: get formal callPattern by defn usage of formals *) + // Get formal callPattern by defn usage of formals let formalCallPattern = decideFormalSuggestedCP g z tys vss let callPattern = List.take callPattern.Length formalCallPattern - // zip with information about known args + // Zip with information about known args let callPattern,tyfringes = zipCallPatternArgTys m g callPattern vss - // drop trivial tail AND + // Drop trivial tail AND let callPattern = minimalCallPattern callPattern - // shorten tyfringes (zippable) + // Shorten tyfringes (zippable) let tyfringes = List.take callPattern.Length tyfringes - (*dprintf "decideTransform: for v=%s\n" (showL (valL v)); - List.iter (fun cp -> dprintf "- site cp = %s\n" (soCP cp)) callPatterns; - dprintf "- common cp = %s\n" (soCP cp); - dprintf "- front cp = %s\n" (soCP cp); - dprintf "- arg tys = %s\n" (showL (commaListL (List.map typeL tys))); - dprintf "- formalCallPattern = %s\n" (soCP formalCallPattern); - dprintf "- front formalCallPattern = %s\n" (soCP cp); - dprintf "- zipped cp = %s\n" (soCP cp); - dprintf "- tyfringes = %s\n" (showL (commaListL (List.map (List.length >> intL) tyfringes))); - dprintf "- minimal cp = %s\n\n" (soCP cp); - *) if isTrivialCP callPattern then - None (* no transform *) + None // no transform else Some (v,mkTransform g v m tps tys rty (callPattern,tyfringes)) @@ -670,9 +603,9 @@ let eligibleVal g (v:Val) = let determineTransforms g (z : GlobalUsageAnalysis.Results) = let selectTransform f sites = if not (eligibleVal g f) then None else - (* consider f, if it has top-level lambda (meaning has term args) *) + // Consider f, if it has top-level lambda (meaning has term args) match Zmap.tryFind f z.Defns with - | None -> None (* no binding site, so no transform *) + | None -> None // no binding site, so no transform | Some e -> let tps,vss,_b,rty = stripTopLambda (e,f.Type) match List.concat vss with @@ -686,12 +619,6 @@ let determineTransforms g (z : GlobalUsageAnalysis.Results) = let vtransforms = Zmap.ofList valOrder vtransforms vtransforms -#if DEBUG -let dumpVTransform v tr = - dprintf "Transform for %s\n" (showL (valL v)); - dumpTransform tr; - stdout.Flush() -#endif //------------------------------------------------------------------------- @@ -699,10 +626,10 @@ let dumpVTransform v tr = //------------------------------------------------------------------------- type penv = - { transforms : Zmap; (* planned transforms *) - ccu : CcuThunk; - g : Env.TcGlobals; - } + { // The planned transforms + transforms : Zmap + ccu : CcuThunk + g : TcGlobals } let hasTransfrom penv f = Zmap.tryFind f penv.transforms @@ -716,9 +643,11 @@ let hasTransfrom penv f = Zmap.tryFind f penv.transforms - also factor buildProjections, so they share common tmps. *) -type env = {eg : TcGlobals; - prefix : string; - m : Range.range; } +type env = + { eg : TcGlobals + prefix : string + m : Range.range } + let suffixE env s = {env with prefix = env.prefix ^ s} let rangeE env m = {env with m = m} @@ -892,15 +821,16 @@ let passBinds penv binds = binds |> FlatList.map (passBind penv) // 3. run pass over following code. //------------------------------------------------------------------------- -let passBindRhs _penv conv (TBind (v,repr,letSeqPtOpt)) = TBind(v,conv repr,letSeqPtOpt) +let passBindRhs conv (TBind (v,repr,letSeqPtOpt)) = TBind(v,conv repr,letSeqPtOpt) + let preInterceptExpr (penv:penv) conv expr = match expr with | Expr.LetRec (binds,e,m,_) -> - let binds = FlatList.map (passBindRhs penv conv) binds + let binds = FlatList.map (passBindRhs conv) binds let binds = passBinds penv binds Some (mkLetRecBinds m binds (conv e)) | Expr.Let (bind,e,m,_) -> - let bind = passBindRhs penv conv bind + let bind = passBindRhs conv bind let bind = passBind penv bind Some (mkLetBind m bind (conv e)) | TyappAndApp(f,fty,tys,args,m) -> @@ -926,9 +856,9 @@ let postTransformExpr (penv:penv) expr = let passImplFile penv ass = - ass |> RewriteImplFile {PreIntercept =None (* Some (preInterceptExpr penv) *); + ass |> RewriteImplFile {PreIntercept =None PreInterceptBinding=None - PostTransform= postTransformExpr penv (* (fun _ -> None) *); + PostTransform= postTransformExpr penv IsUnderQuotations=false } @@ -942,17 +872,7 @@ let DetupleImplFile ccu g expr = // For each Val, decide Some "transform", or None if not changing let vtrans = determineTransforms g z -#if DEBUG - // Diagnostics - summary of planned transforms - if verbose then dprintf "note: detuple - %d functions transformed\n" (List.length (Zmap.keys vtrans)); - if verbose then Zmap.iter dumpVTransform vtrans; -#endif - - (* Pass over term, rewriting bindings and fixing up call sites, under penv *) + // Pass over term, rewriting bindings and fixing up call sites, under penv let penv = {g=g; transforms = vtrans; ccu = ccu} - if verbose then dprintTerm "DetupleAssembly before:" expr; - if verbose then dprintf "DetupleAssembly: pass\n"; let expr = passImplFile penv expr - if verbose then dprintTerm "DetupleAssembly after:" expr; - if verbose then dprintf "DetupleAssembly: done\n"; expr diff --git a/src/fsharp/detuple.fsi b/src/fsharp/DetupleArgs.fsi similarity index 89% rename from src/fsharp/detuple.fsi rename to src/fsharp/DetupleArgs.fsi index 254e887bcf5f95190e0d7b5ea9a10a80bc0f78d6..efdaacf7f1f4bfaa82fdc88ea0bd5d0274251cf6 100644 --- a/src/fsharp/detuple.fsi +++ b/src/fsharp/DetupleArgs.fsi @@ -7,11 +7,12 @@ open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.Tast +open Microsoft.FSharp.Compiler.TcGlobals (* detuple pass: *) -val DetupleImplFile : CcuThunk -> Env.TcGlobals -> TypedImplFile -> TypedImplFile +val DetupleImplFile : CcuThunk -> TcGlobals -> TypedImplFile -> TypedImplFile module GlobalUsageAnalysis = val GetValsBoundInExpr : Expr -> Zset @@ -35,4 +36,4 @@ module GlobalUsageAnalysis = /// top of expr toplevel? (true) IterationIsAtTopLevel : bool; } - val GetUsageInfoOfImplFile : Env.TcGlobals -> TypedImplFile -> Results + val GetUsageInfoOfImplFile : TcGlobals -> TypedImplFile -> Results diff --git a/src/fsharp/ExtensibleDumper.fs b/src/fsharp/ExtensibleDumper.fs deleted file mode 100644 index 8415ad4596c5d374b8877a744b28ec18ca5a7e9d..0000000000000000000000000000000000000000 --- a/src/fsharp/ExtensibleDumper.fs +++ /dev/null @@ -1,60 +0,0 @@ -// Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. - -namespace Internal.Utilities.Diagnostic -open System -open System.Diagnostics -open System.Reflection -open System.Collections.Generic - -#if EXTENSIBLE_DUMPER -#if DEBUG - -type internal ExtensibleDumper(x:obj) = - static let mutable dumpers = new Dictionary() - - [] - member self.Debug = ExtensibleDumper.Dump(x) - - static member Dump(o:obj) : string = - if o = null then "null" - else - let dumpeeType = o.GetType() - - let DeriveDumperName(dumpeeType:Type) = - "Internal.Utilities.Diagnostic." + dumpeeType.Name + "Dumper" - - match dumpers.TryGetValue(dumpeeType) with - | true, Some(dumperType, methodInfo) -> - try - let dumper = Activator.CreateInstance(dumperType,[| o |]) - let result = methodInfo.Invoke(dumper, [||]) - downcast result - with e -> "Exception during dump: "+e.Message - | true, None -> - "There is no dumper named "+(DeriveDumperName dumpeeType)+" with single constructor that takes "+dumpeeType.Name+" and property named Dump." - | false, _ -> - let TryAdd(dumpeeType:Type) = - let dumperDerivedName = DeriveDumperName(dumpeeType) - let dumperAssembly = dumpeeType.Assembly // Dumper must live in the same assembly as dumpee - let dumperType = dumperAssembly.GetType(dumperDerivedName, (*throwOnError*)false) - if dumperType <> null then - let dumpMethod = dumperType.GetMethod("ToString") - if dumpMethod <> null then - let constructors = dumperType.GetConstructors() - if constructors.Length = 1 then - let constr = constructors.[0] - let parameters = constr.GetParameters() - if parameters.Length = 1 then - dumpers.[o.GetType()] <- Some(dumperType,dumpMethod) - dumpers.ContainsKey(o.GetType()) - - if (not(TryAdd(o.GetType()))) then - if (not(TryAdd(o.GetType().BaseType))) then - dumpers.[dumpeeType] <- None - ExtensibleDumper.Dump(o) // Show the message - - - - -#endif -#endif diff --git a/src/fsharp/ExtensibleDumper.fsi b/src/fsharp/ExtensibleDumper.fsi deleted file mode 100644 index be32bd56542c6bb81be90d89a3be283ccd5e388b..0000000000000000000000000000000000000000 --- a/src/fsharp/ExtensibleDumper.fsi +++ /dev/null @@ -1,20 +0,0 @@ -// Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. - -namespace Internal.Utilities.Diagnostic -open System -open System.Diagnostics -open System.Reflection -open System.Collections.Generic - -#if EXTENSIBLE_DUMPER -#if DEBUG - -type internal ExtensibleDumper = - class - new : x:obj -> ExtensibleDumper - member Debug : string - static member Dump : o:obj -> string - end - -#endif -#endif diff --git a/src/fsharp/est.fs b/src/fsharp/ExtensionTyping.fs similarity index 100% rename from src/fsharp/est.fs rename to src/fsharp/ExtensionTyping.fs diff --git a/src/fsharp/est.fsi b/src/fsharp/ExtensionTyping.fsi similarity index 100% rename from src/fsharp/est.fsi rename to src/fsharp/ExtensionTyping.fsi diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt index f6ed2fdbdf4d3c7c739378e69e2198ca03fb2322..9d5cf0a7926940231b8ff6ab3e64c460e46c9c64 100644 --- a/src/fsharp/FSComp.txt +++ b/src/fsharp/FSComp.txt @@ -12,7 +12,7 @@ undefinedNameRecordLabel,"The record label '%s' is not defined" undefinedNameTypeParameter,"The type parameter '%s' is not defined" undefinedNamePatternDiscriminator,"The pattern discriminator '%s' is not defined" # ----------------------------------------------------------------------------- -# build.fs +# CompileOps.fs # ----------------------------------------------------------------------------- buildUnexpectedTypeArgs,"The non-generic type '%s' does not expect any type arguments, but here is given %d type argument(s)" 203,buildInvalidWarningNumber,"Invalid warning number '%s'" diff --git a/src/fsharp/FSharp.Compiler-proto/FSharp.Compiler-proto.fsproj b/src/fsharp/FSharp.Compiler-proto/FSharp.Compiler-proto.fsproj index b31633ef0f3fd034d7471d6feff7e2f842ebf8bb..871d1dd846eff840dacd8fe5c398b18b7852daca 100644 --- a/src/fsharp/FSharp.Compiler-proto/FSharp.Compiler-proto.fsproj +++ b/src/fsharp/FSharp.Compiler-proto/FSharp.Compiler-proto.fsproj @@ -228,14 +228,14 @@ ilxsettings.fs - - pubclo.fsi + + EraseClosures.fsi + + + EraseClosures.fs - - pubclo.fs - - - cu_erase.fs + + EraseUnions.fs InternalFileSystemUtils.fsi @@ -243,11 +243,11 @@ InternalFileSystemUtils.fs - - unilex.fsi + + UnicodeLexing.fsi - - unilex.fs + + UnicodeLexing.fs layout.fsi @@ -268,11 +268,14 @@ - - sreflect.fsi + + ast.fs + + + QuotationPickler.fsi - - sreflect.fs + + QuotationPickler.fs QueueList.fs @@ -280,23 +283,23 @@ tast.fs - - env.fs - - - tastops.fsi - - - tastops.fs + + TcGlobals.fs + + + TastOps.fsi + + + TastOps.fs + + + TastPickle.fsi - - pickle.fsi + + TastPickle.fs - - pickle.fs - - - lexfilter.fs + + LexFilter.fs import.fsi @@ -310,95 +313,89 @@ NicePrint.fs - - augment.fsi - - - augment.fs - - - outcome.fsi + + AugmentWithHashCompare.fsi - - outcome.fs + + AugmentWithHashCompare.fs - - nameres.fsi + + NameResolution.fsi - - nameres.fs + + NameResolution.fs - - typrelns.fs + + TypeRelations.fs - - patcompile.fsi + + PatternMatchCompilation.fsi - - patcompile.fs + + PatternMatchCompilation.fs - - csolve.fsi + + ConstraintSolver.fsi + + + ConstraintSolver.fs - - csolve.fs + + CheckFormatStrings.fsi - - formats.fsi + + CheckFormatStrings.fs - - formats.fs + + FindUnsolved.fs - - unsolved.fs + + QuotationTranslator.fsi - - creflect.fsi + + QuotationTranslator.fs - - creflect.fs + + PostInferenceChecks.fsi - - check.fsi + + PostInferenceChecks.fs - - check.fs + + TypeChecker.fsi - - tc.fsi + + TypeChecker.fs - - tc.fs - - - opt.fsi + + Optimizer.fsi autobox.fs - - opt.fs - - - detuple.fsi + + Optimizer.fs - - detuple.fs + + DetupleArgs.fsi + + + DetupleArgs.fs - - tlr.fsi + + InnerLambdasToTopLevelFuncs.fsi - - tlr.fs + + InnerLambdasToTopLevelFuncs.fs - - lowertop.fs + + LowerCallsAndSeqs.fs - - ilxgen.fsi + + IlxGen.fsi - - ilxgen.fs + + IlxGen.fs TraceCall.fsi @@ -406,17 +403,17 @@ TraceCall.fs - - build.fsi + + CompileOps.fsi - - build.fs + + CompileOps.fs - - fscopts.fsi + + CompileOptions.fsi - - fscopts.fs + + CompileOptions.fs IncrementalBuild.fsi diff --git a/src/fsharp/FSharp.Compiler/FSharp.Compiler.fsproj b/src/fsharp/FSharp.Compiler/FSharp.Compiler.fsproj index fc6dc81aced106619ffd0b43d02464e719a4e437..9b9513cfa343b3737f18e6a0f42bc426c286891c 100644 --- a/src/fsharp/FSharp.Compiler/FSharp.Compiler.fsproj +++ b/src/fsharp/FSharp.Compiler/FSharp.Compiler.fsproj @@ -51,17 +51,11 @@ LexYaccRuntime\prim-parsing.fs - - Utilities\ExtensibleDumper.fsi + + Utilities\ResizeArray.fsi - - Utilities\ExtensibleDumper.fs - - - Utilities\resizearray.fsi - - - Utilities\resizearray.fs + + Utilities\ResizeArray.fs Utilities\HashMultiMap.fsi @@ -136,10 +130,10 @@ Utilities\TraceCall.fs - ErrorLogging\rational.fsi + Utilities\rational.fsi - ErrorLogging\rational.fs + Utilities\rational.fs ErrorLogging\range.fsi @@ -235,17 +229,17 @@ ILXErase\ilxsettings.fs - - ILXErase\pubclo.fsi + + ILXErase\EraseClosures.fsi - - ILXErase\pubclo.fs + + ILXErase\EraseClosures.fs - - ILXErase\cu_erase.fsi + + ILXErase\EraseUnions.fsi - - ILXErase\cu_erase.fs + + ILXErase\EraseUnions.fs --lexlib Internal.Utilities.Text.Lexing @@ -267,11 +261,11 @@ --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing ParserAndUntypedAST\pars.fsy - - ParserAndUntypedAST\unilex.fsi + + ParserAndUntypedAST\UnicodeLexing.fsi - - ParserAndUntypedAST\unilex.fs + + ParserAndUntypedAST\UnicodeLexing.fs ParserAndUntypedAST\layout.fsi @@ -300,7 +294,7 @@ ParserAndUntypedAST\lex.fs - + ParserAndUntypedAST\lexfilter.fs @@ -309,35 +303,35 @@ TypedAST\tainted.fs - - TypedAST\est.fsi + + TypedAST\ExtensionTyping.fsi - - TypedAST\est.fs + + TypedAST\ExtensionTyping.fs - - TypedAST\sreflect.fsi + + TypedAST\QuotationPickler.fsi - - TypedAST\sreflect.fs + + TypedAST\QuotationPickler.fs TypedAST\tast.fs - - TypedAST\env.fs + + TypedAST\TcGlobals.fs - - TypedAST\tastops.fsi + + TypedAST\TastOps.fsi - - TypedAST\tastops.fs + + TypedAST\TastOps.fs - - TypedAST\pickle.fsi + + TypedAST\TastPickle.fsi - - TypedAST\pickle.fs + + TypedAST\TastPickle.fs Logic\import.fsi @@ -351,107 +345,101 @@ Logic\NicePrint.fs - - Logic\augment.fsi - - - Logic\augment.fs + + Logic\AugmentWithHashCompare.fsi - - Logic\outcome.fsi + + Logic\AugmentWithHashCompare.fs - - Logic\outcome.fs + + Logic\NameResolution.fsi - - Logic\nameres.fsi + + Logic\NameResolution.fs - - Logic\nameres.fs + + Logic\TypeRelations.fs - - Logic\typrelns.fs + + Logic\PatternMatchCompilation.fsi - - Logic\patcompile.fsi + + Logic\PatternMatchCompilation.fs - - Logic\patcompile.fs + + Logic\ConstraintSolver.fsi - - Logic\csolve.fsi + + Logic\ConstraintSolver.fs - - Logic\csolve.fs + + Logic\CheckFormatStrings.fsi - - Logic\formats.fsi + + Logic\CheckFormatStrings.fs - - Logic\formats.fs + + Logic\FindUnsolved.fs - - Logic\unsolved.fs + + Logic\QuotationTranslator.fsi - - Logic\creflect.fsi + + Logic\QuotationTranslator.fs - - Logic\creflect.fs + + Logic\PostInferenceChecks.fsi - - Logic\check.fsi + + Logic\PostInferenceChecks.fs - - Logic\check.fs + + Logic\TypeChecker.fsi - - Logic\tc.fsi + + Logic\TypeChecker.fs - - Logic\tc.fs + + Optimize\Optimizer.fsi - - Optimize\opt.fsi + + Optimize\Optimizer.fs - - Optimize\opt.fs + + Optimize\DetupleArgs.fsi - - Optimize\detuple.fsi + + Optimize\DetupleArgs.fs - - Optimize\detuple.fs + + Optimize\InnerLambdasToTopLevelFuncs.fsi - - Optimize\tlr.fsi + + Optimize\InnerLambdasToTopLevelFuncs.fs - - Optimize\tlr.fs - - - Optimize\lowertop.fs + + Optimize\LowerCallsAndSeqs.fs Optimize\autobox.fs - - CodeGen\ilxgen.fsi + + CodeGen\IlxGen.fsi - - CodeGen\ilxgen.fs + + CodeGen\IlxGen.fs - - Driver\build.fsi + + Driver\CompileOps.fsi - - Driver\build.fs + + Driver\CompileOps.fs - - Driver\fscopts.fsi + + Driver\CompileOptions.fsi - - Driver\fscopts.fs + + Driver\CompileOptions.fs Driver\IncrementalBuild.fsi @@ -510,11 +498,6 @@ Service\service.fs - InternalsVisibleTo.fs diff --git a/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj b/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj index c3b939c572dfe089ea909e6a9941b744c53c6d43..a3fb8f2a56dcff124d431448e6020541ecc57cbf 100644 --- a/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj +++ b/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj @@ -36,432 +36,429 @@ assemblyinfo.FSharp.Compiler.dll.fs - - --lexlib Internal.Utilities.Text.Lexing - pplex.fsl - - - Microsoft.FSharp.Compiler.PPParser - Microsoft.FSharp.Compiler - --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing - pppars.fsy - - - --lexlib Internal.Utilities.Text.Lexing - lex.fsl - - - --lexlib Internal.Utilities.Text.Lexing - illex.fsl - - - Microsoft.FSharp.Compiler.Parser - Microsoft.FSharp.Compiler - --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing - pars.fsy - - - Microsoft.FSharp.Compiler.AbstractIL.Internal.AsciiParser - Microsoft.FSharp.Compiler.AbstractIL - --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing - ilpars.fsy - - - ExtensibleDumper.fsi - - - ExtensibleDumper.fs - - sformat.fsi + ErrorText\sformat.fsi - sformat.fs + ErrorText\sformat.fs - sr.fsi + ErrorText\sr.fsi - sr.fs + ErrorText\sr.fs - prim-lexing.fsi + LexYaccRuntime\prim-lexing.fsi - prim-lexing.fs + LexYaccRuntime\prim-lexing.fs - prim-parsing.fsi + LexYaccRuntime\prim-parsing.fsi - prim-parsing.fs + LexYaccRuntime\prim-parsing.fs - resizearray.fsi + Utilities\resizearray.fsi - resizearray.fs + Utilities\resizearray.fs - HashMultiMap.fsi + Utilities\HashMultiMap.fsi - HashMultiMap.fs + Utilities\HashMultiMap.fs - TaggedCollections.fsi + Utilities\TaggedCollections.fsi - TaggedCollections.fs + Utilities\TaggedCollections.fs - FlatList.fs + Utilities\FlatList.fs + + + Utilities\QueueList.fs - illib.fs + Utilities\illib.fs - filename.fsi + Utilities\filename.fsi - filename.fs + Utilities\filename.fs - zmap.fsi + Utilities\zmap.fsi - zmap.fs + Utilities\zmap.fs - zset.fsi + Utilities\zset.fsi - zset.fs + Utilities\zset.fs - bytes.fsi + Utilities\bytes.fsi - bytes.fs + Utilities\bytes.fs - ildiag.fsi + Utilities\ildiag.fsi - ildiag.fs + Utilities\ildiag.fs + + + Utilities\lib.fs + + + Utilities\InternalCollections.fsi + + + Utilities\InternalCollections.fs + + + Utilities\InternalFileSystemUtils.fsi + + + Utilities\InternalFileSystemUtils.fs + + + Utilities\rational.fsi + + + Utilities\rational.fs + + + Utilities\TraceCall.fs + + + ErrorLogging\range.fsi + + + ErrorLogging\range.fs + + + ErrorLogging\ErrorLogger.fs - ReferenceResolution.fs + ReferenceResolution\ReferenceResolution.fs + + --lexlib Internal.Utilities.Text.Lexing + AbsIL\illex.fsl + + + Microsoft.FSharp.Compiler.AbstractIL.Internal.AsciiParser + Microsoft.FSharp.Compiler.AbstractIL + --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing + AbsIL\ilpars.fsy + - il.fsi + AbsIL\il.fsi - il.fs + AbsIL\il.fs - ilx.fsi + AbsIL\ilx.fsi - ilx.fs + AbsIL\ilx.fs - ilascii.fsi + AbsIL\ilascii.fsi - ilascii.fs + AbsIL\ilascii.fs - ilprint.fsi + AbsIL\ilprint.fsi - ilprint.fs + AbsIL\ilprint.fs - ilmorph.fsi + AbsIL\ilmorph.fsi - ilmorph.fs + AbsIL\ilmorph.fs - ilsupp.fsi + AbsIL\ilsupp.fsi - ilsupp.fs + AbsIL\ilsupp.fs - - - - ilbinary.fsi - - - ilbinary.fs - - - lib.fs - - - range.fsi + + AbsIL\ilpars.fs - - range.fs + + AbsIL\illex.fs - - rational.fsi - - - rational.fs - - - ErrorLogger.fs - - - tainted.fsi - - - tainted.fs - - - InternalCollections.fsi + + AbsIL\ilbinary.fsi - - InternalCollections.fs + + AbsIL\ilbinary.fs - ilread.fsi + AbsIL\ilread.fsi - ilread.fs + AbsIL\ilread.fs - CompilerLocationUtils.fs + CompilerLocation\CompilerLocationUtils.fs - PrettyNaming.fs + PrettyNaming\PrettyNaming.fs - ilxsettings.fs + ILXErase\ilxsettings.fs - - InternalFileSystemUtils.fsi - - - InternalFileSystemUtils.fs - - - unilex.fsi + + --lexlib Internal.Utilities.Text.Lexing + ParserAndUntypedAST\pplex.fsl + + + Microsoft.FSharp.Compiler.PPParser + Microsoft.FSharp.Compiler + --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing + ParserAndUntypedAST\pppars.fsy + + + --lexlib Internal.Utilities.Text.Lexing + ParserAndUntypedAST\lex.fsl + + + Microsoft.FSharp.Compiler.Parser + Microsoft.FSharp.Compiler + --internal --lexlib Internal.Utilities.Text.Lexing --parslib Internal.Utilities.Text.Parsing + ParserAndUntypedAST\pars.fsy + + + ParserAndUntypedAST\UnicodeLexing.fsi - - unilex.fs + + ParserAndUntypedAST\UnicodeLexing.fs - layout.fsi + ParserAndUntypedAST\layout.fsi - layout.fs + ParserAndUntypedAST\layout.fs - ast.fs + ParserAndUntypedAST\ast.fs - - est.fsi + + ParserAndUntypedAST\pppars.fs - - est.fs + + ParserAndUntypedAST\pars.fs - - lexhelp.fsi + ParserAndUntypedAST\lexhelp.fsi - lexhelp.fs + ParserAndUntypedAST\lexhelp.fs - - - - - sreflect.fsi + + ParserAndUntypedAST\pplex.fs - - sreflect.fs + + ParserAndUntypedAST\lex.fs - - QueueList.fs + + ParserAndUntypedAST\lexfilter.fs - - tast.fs + + TypedAST\tainted.fsi - - env.fs + + TypedAST\tainted.fs - - tastops.fsi + + TypedAST\ExtensionTyping.fsi - - tastops.fs + + TypedAST\ExtensionTyping.fs - - pickle.fsi + + TypedAST\QuotationPickler.fsi - - pickle.fs + + TypedAST\QuotationPickler.fs - - lexfilter.fs + + TypedAST\tast.fs - - import.fsi + + TypedAST\TcGlobals.fs - - import.fs + + TypedAST\TastOps.fsi - - infos.fs + + TypedAST\TastOps.fs - - NicePrint.fs + + TypedAST\TastPickle.fsi - - augment.fsi + + TypedAST\TastPickle.fs - - augment.fs + + Logic\import.fsi - - outcome.fsi + + Logic\import.fs - - outcome.fs + + Logic\infos.fs - - nameres.fsi + + Logic\NicePrint.fs - - nameres.fs + + Logic\AugmentWithHashCompare.fsi - - typrelns.fs + + Logic\AugmentWithHashCompare.fs - - patcompile.fsi + + Logic\NameResolution.fsi - - patcompile.fs + + Logic\NameResolution.fs - - csolve.fsi + + Logic\TypeRelations.fs - - csolve.fs + + Logic\PatternMatchCompilation.fsi - - formats.fsi + + Logic\PatternMatchCompilation.fs - - formats.fs + + Logic\ConstraintSolver.fsi - - unsolved.fs + + Logic\ConstraintSolver.fs - - creflect.fsi + + Logic\CheckFormatStrings.fsi - - creflect.fs + + Logic\CheckFormatStrings.fs - - check.fsi + + Logic\FindUnsolved.fs - - check.fs + + Logic\QuotationTranslator.fsi - - tc.fsi + + Logic\QuotationTranslator.fs - - tc.fs + + Logic\PostInferenceChecks.fsi - - opt.fsi + + Logic\PostInferenceChecks.fs - - opt.fs + + Logic\TypeChecker.fsi - - TraceCall.fsi + + Logic\TypeChecker.fs - - TraceCall.fs + + Optimize\Optimizer.fsi + + + Optimize\Optimizer.fs - - build.fsi + + Driver\CompileOps.fsi - - build.fs + + Driver\CompileOps.fs - - fscopts.fsi + + Driver\CompileOptions.fsi - - fscopts.fs + + Driver\CompileOptions.fs - IncrementalBuild.fsi + Driver\IncrementalBuild.fsi - IncrementalBuild.fs + Driver\IncrementalBuild.fs - fsc.fs + Driver\fsc.fs - Reactor.fsi + Service\Reactor.fsi - Reactor.fs + Service\Reactor.fs - ServiceLexing.fsi + Service\ServiceLexing.fsi - ServiceLexing.fs + Service\ServiceLexing.fs - ServiceConstants.fs + Service\ServiceConstants.fs - ServiceParseTreeWalk.fs + Service\ServiceParseTreeWalk.fs - ServiceNavigation.fsi + Service\ServiceNavigation.fsi - ServiceNavigation.fs + Service\ServiceNavigation.fs - ServiceParamInfoLocations.fsi + Service\ServiceParamInfoLocations.fsi - ServiceParamInfoLocations.fs + Service\ServiceParamInfoLocations.fs - ServiceUntypedParse.fsi + Service\ServiceUntypedParse.fsi - ServiceUntypedParse.fs + Service\ServiceUntypedParse.fs - ServiceDeclarations.fsi + Service\ServiceDeclarations.fsi - ServiceDeclarations.fs + Service\ServiceDeclarations.fs - service.fsi + Service\service.fsi - service.fs + Service\service.fs diff --git a/src/fsharp/unsolved.fs b/src/fsharp/FindUnsolved.fs similarity index 99% rename from src/fsharp/unsolved.fs rename to src/fsharp/FindUnsolved.fs index 221cff97a0be31d3cd9c1a64232f03d5ac975aba..b1032468908714d005a68139e17a14685c68c3c6 100644 --- a/src/fsharp/unsolved.fs +++ b/src/fsharp/FindUnsolved.fs @@ -19,11 +19,11 @@ open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.Layout open Microsoft.FSharp.Compiler.AbstractIL.IL -open Microsoft.FSharp.Compiler.Typrelns +open Microsoft.FSharp.Compiler.TypeRelations open Microsoft.FSharp.Compiler.Infos type env = Nix diff --git a/src/fsharp/ilxgen.fs b/src/fsharp/IlxGen.fs similarity index 99% rename from src/fsharp/ilxgen.fs rename to src/fsharp/IlxGen.fs index 58897a6daac49d2c4acaea35942661b6de864537..1855ab27ef554990fa866af9a6b1c3d0c99c650f 100644 --- a/src/fsharp/ilxgen.fs +++ b/src/fsharp/IlxGen.fs @@ -4,7 +4,7 @@ // The ILX generator. //-------------------------------------------------------------------------- -module internal Microsoft.FSharp.Compiler.Ilxgen +module internal Microsoft.FSharp.Compiler.IlxGen #nowarn "44" // This construct is deprecated. please use List.item @@ -29,10 +29,10 @@ open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.PrettyNaming -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.Layout open Microsoft.FSharp.Compiler.Lib -open Microsoft.FSharp.Compiler.Typrelns +open Microsoft.FSharp.Compiler.TypeRelations open Microsoft.FSharp.Compiler.TypeChecker open Microsoft.FSharp.Compiler.Infos open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.Types @@ -194,7 +194,7 @@ type IlxGenOptions = /// Compilation environment for compiling a fragment of an assembly [] type cenv = - { g: Env.TcGlobals + { g: TcGlobals TcVal : ConstraintSolver.TcValF viewCcu: CcuThunk opts: IlxGenOptions @@ -432,16 +432,16 @@ and GenTypeAux amap m g (tyenv: TypeReprEnv) voidOK ptrsOK ty = match stripTyEqnsAndMeasureEqns g ty with | TType_app (tcref, tinst) -> GenNamedTyAppAux amap m g tyenv ptrsOK tcref tinst | TType_tuple args -> GenTypeAux amap m g tyenv VoidNotOK ptrsOK (mkCompiledTupleTy g args) - | TType_fun (dty, returnTy) -> EraseIlxFuncs.mkILFuncTy g.ilxPubCloEnv (GenTypeArgAux amap m g tyenv dty) (GenTypeArgAux amap m g tyenv returnTy) + | TType_fun (dty, returnTy) -> EraseClosures.mkILFuncTy g.ilxPubCloEnv (GenTypeArgAux amap m g tyenv dty) (GenTypeArgAux amap m g tyenv returnTy) | TType_ucase (ucref, args) -> let cuspec,idx = GenUnionCaseSpec amap m g tyenv ucref args - EraseIlxUnions.GetILTypeForAlternative cuspec idx + EraseUnions.GetILTypeForAlternative cuspec idx | TType_forall (tps, tau) -> let tps = DropErasedTypars tps if tps.IsEmpty then GenTypeAux amap m g tyenv VoidNotOK ptrsOK tau - else EraseIlxFuncs.mkILTyFuncTy g.ilxPubCloEnv + else EraseClosures.mkILTyFuncTy g.ilxPubCloEnv | TType_var tp -> mkILTyvarTy tyenv.[tp,m] | TType_measure _ -> g.ilg.typ_int32 @@ -771,7 +771,7 @@ let StorageForValRef m (v: ValRef) eenv = StorageForVal m v.Deref eenv let IsValRefIsDllImport g (vref:ValRef) = vref.Attribs |> HasFSharpAttributeOpt g g.attrib_DllImportAttribute -let GetMethodSpecForMemberVal amap g memberInfo (vref:ValRef) = +let GetMethodSpecForMemberVal amap g (memberInfo:ValMemberInfo) (vref:ValRef) = let m = vref.Range let tps,curriedArgInfos,returnTy,retInfo = assert(vref.ValReprInfo.IsSome); @@ -924,7 +924,7 @@ let ComputeStorageForNonLocalTopVal amap g cloc modref (v:Val) = let rec ComputeStorageForNonLocalModuleOrNamespaceRef amap g cloc acc (modref:ModuleOrNamespaceRef) (modul:ModuleOrNamespace) = let acc = (acc, modul.ModuleOrNamespaceType.ModuleAndNamespaceDefinitions) ||> List.fold (fun acc smodul -> - ComputeStorageForNonLocalModuleOrNamespaceRef amap g (CompLocForSubModuleOrNamespace cloc smodul) acc (modref.MkNestedTyconRef smodul) smodul) + ComputeStorageForNonLocalModuleOrNamespaceRef amap g (CompLocForSubModuleOrNamespace cloc smodul) acc (modref.NestedTyconRef smodul) smodul) let acc = (acc, modul.ModuleOrNamespaceType.AllValsAndMembers) ||> Seq.fold (fun acc v -> @@ -1679,7 +1679,7 @@ let rec GenExpr cenv (cgbuf:CodeGenBuffer) eenv sp expr sequel = if not (WillGenerateSequencePoint sp expr) && not (AlwaysSuppressSequencePoint sp expr) then CG.EmitSeqPoint cgbuf expr.Range; - match (if compileSequenceExpressions then Lowertop.LowerSeqExpr cenv.g cenv.amap expr else None) with + match (if compileSequenceExpressions then LowerCallsAndSeqs.LowerSeqExpr cenv.g cenv.amap expr else None) with | Some info -> GenSequenceExpr cenv cgbuf eenv info sequel | None -> @@ -2042,7 +2042,7 @@ and GenAllocRecd cenv cgbuf eenv ctorInfo (tcref,argtys,args,m) sequel = (args,relevantFields) ||> List.iter2 (fun e f -> CG.EmitInstr cgbuf (pop 0) (Push (if tcref.IsStructOrEnumTycon then [ILType.Byref typ] else [typ])) mkLdarg0; GenExpr cenv cgbuf eenv SPSuppress e Continue; - GenFieldStore false cenv cgbuf eenv (mkNestedRecdFieldRef tcref f,argtys,m) discard) + GenFieldStore false cenv cgbuf eenv (tcref.MakeNestedRecdFieldRef f,argtys,m) discard) // Object construction doesn't generate a true value. // Object constructions will always just get thrown away so this is safe GenSequel cenv eenv.cloc cgbuf sequel @@ -2103,9 +2103,9 @@ and GenNewArray cenv cgbuf eenv (elems: Expr list,elemTy,m) sequel = and GenCoerce cenv cgbuf eenv (e,tgty,m,srcty) sequel = // Is this an upcast? - if Typrelns.TypeDefinitelySubsumesTypeNoCoercion 0 cenv.g cenv.amap m tgty srcty && + if TypeRelations.TypeDefinitelySubsumesTypeNoCoercion 0 cenv.g cenv.amap m tgty srcty && // Do an extra check - should not be needed - Typrelns.TypeFeasiblySubsumesType 0 cenv.g cenv.amap m tgty Typrelns.NoCoerce srcty then + TypeRelations.TypeFeasiblySubsumesType 0 cenv.g cenv.amap m tgty TypeRelations.NoCoerce srcty then begin // The .NET IL doesn't always support implict subsumption for interface types, e.g. at stack merge points // Hence be conservative here and always cast explicitly. @@ -2167,7 +2167,7 @@ and GenSetExnField cenv cgbuf eenv (e,ecref,fieldNum,e2,m) sequel = and GenUnionCaseProof cenv cgbuf eenv (e,ucref,tyargs,m) sequel = GenExpr cenv cgbuf eenv SPSuppress e Continue; let cuspec,idx = GenUnionCaseSpec cenv.amap m cenv.g eenv.tyenv ucref tyargs - let fty = EraseIlxUnions.GetILTypeForAlternative cuspec idx + let fty = EraseUnions.GetILTypeForAlternative cuspec idx CG.EmitInstrs cgbuf (pop 1) (Push [fty]) [ mkIlxInstr (EI_castdata(false,cuspec,idx)); ]; GenSequel cenv eenv.cloc cgbuf sequel @@ -2682,7 +2682,7 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel = let whereSaved,eenv = (eenv,laterArgs) ||> List.mapFold (fun eenv laterArg -> // Only save arguments that have effects - if Opt.ExprHasEffect cenv.g laterArg then + if Optimizer.ExprHasEffect cenv.g laterArg then let ilTy = laterArg |> tyOfExpr cenv.g |> GenType cenv.amap m cenv.g eenv.tyenv let loc,eenv = AllocLocal cenv cgbuf eenv true (ilxgenGlobalNng.FreshCompilerGeneratedName ("arg",m), ilTy) scopeMarks GenExpr cenv cgbuf eenv SPSuppress laterArg Continue @@ -3656,7 +3656,7 @@ and GenObjectExpr cenv cgbuf eenvouter expr (baseType,baseValOpt,basecall,overri cgbuf.mgbuf.AddTypeDef(ilCloTypeRef, cloTypeDef, false, false); CountClosure(); GenGetLocalVals cenv cgbuf eenvouter m cloFreeVars; - CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [ EraseIlxFuncs.mkTyOfLambdas cenv.g.ilxPubCloEnv ilCloLambdas]) (I_newobj (ilxCloSpec.Constructor,None)); + CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [ EraseClosures.mkTyOfLambdas cenv.g.ilxPubCloEnv ilCloLambdas]) (I_newobj (ilxCloSpec.Constructor,None)); GenSequel cenv eenvouter.cloc cgbuf sequel and GenSequenceExpr cenv (cgbuf:CodeGenBuffer) eenvouter (nextEnumeratorValRef:ValRef,pcvref:ValRef,currvref:ValRef,stateVars,generateNextExpr,closeExpr,checkCloseExpr:Expr,seqElemTy, m) sequel = @@ -3851,7 +3851,7 @@ and GenLambdaVal cenv (cgbuf:CodeGenBuffer) eenv (cloinfo,m) = GenGetLocalVals cenv cgbuf eenv m cloinfo.cloFreeVars; CG.EmitInstr cgbuf (pop cloinfo.cloILFreeVars.Length) - (Push [EraseIlxFuncs.mkTyOfLambdas cenv.g.ilxPubCloEnv cloinfo.ilCloLambdas]) + (Push [EraseClosures.mkTyOfLambdas cenv.g.ilxPubCloEnv cloinfo.ilCloLambdas]) (I_newobj (cloinfo.cloSpec.Constructor,None)) and GenLambda cenv cgbuf eenv isLocalTypeFunc selfv expr sequel = @@ -4184,7 +4184,7 @@ and GenDelegateExpr cenv cgbuf eenvouter expr (TObjExprMethod((TSlotSig(_,delega let ctxtGenericArgsForDelegee = GenGenericArgs m eenvouter.tyenv cloFreeTyvars let ilxCloSpec = IlxClosureSpec.Create(IlxClosureRef(ilDelegeeTypeRef, ilCloLambdas, ilCloFreeVars), mkILGenericArgs ctxtGenericArgsForDelegee) GenGetLocalVals cenv cgbuf eenvouter m cloFreeVars; - CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [EraseIlxFuncs.mkTyOfLambdas cenv.g.ilxPubCloEnv ilCloLambdas]) (I_newobj (ilxCloSpec.Constructor,None)); + CG.EmitInstr cgbuf (pop ilCloFreeVars.Length) (Push [EraseClosures.mkTyOfLambdas cenv.g.ilxPubCloEnv ilCloLambdas]) (I_newobj (ilxCloSpec.Constructor,None)); let ilDelegeeTyOuter = mkILBoxedTy ilDelegeeTypeRef ctxtGenericArgsForDelegee let ilDelegeeInvokeMethOuter = mkILNonGenericInstanceMethSpecInTy (ilDelegeeTyOuter,"Invoke",typesOfILParamsList ilDelegeeParams, ilDelegeeRet.Type) @@ -6326,7 +6326,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = let isPropHidden = ((fspec.IsCompilerGenerated && not tycon.IsEnumTycon) || hiddenRepr || - IsHiddenRecdField eenv.sigToImplRemapInfo (mkNestedRecdFieldRef tcref fspec)) + IsHiddenRecdField eenv.sigToImplRemapInfo (tcref.MakeNestedRecdFieldRef fspec)) let ilType = GenType cenv.amap m cenv.g eenvinner.tyenv fspec.FormalType let ilFieldName = ComputeFieldName tycon fspec @@ -6448,7 +6448,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon:Tycon) = eenv.valsInScope.TryFind cenv.g.new_format_vref.Deref) with | Some(Lazy(Method(_,_,sprintfMethSpec,_,_,_))), Some(Lazy(Method(_,_,newFormatMethSpec,_,_,_))) -> // The type returned by the 'sprintf' call - let funcTy = EraseIlxFuncs.mkILFuncTy cenv.g.ilxPubCloEnv ilThisTy cenv.g.ilg.typ_String + let funcTy = EraseClosures.mkILFuncTy cenv.g.ilxPubCloEnv ilThisTy cenv.g.ilg.typ_String // Give the instantiation of the printf format object, i.e. a Format`5 object compatible with StringFormat let newFormatMethSpec = mkILMethSpec(newFormatMethSpec.MethodRef,AsObject, [// 'T -> string' @@ -6959,8 +6959,8 @@ let defaultOf = /// Top-level val bindings are stored (for example) in static fields. /// In the FSI case, these fields are be created and initialised, so we can recover the object. -/// Ilxgen knows how v was stored, and then ilreflect knows how this storage was generated. -/// Ilxgen converts (v:Tast.Val) to AbsIL datatstructures. +/// IlxGen knows how v was stored, and then ilreflect knows how this storage was generated. +/// IlxGen converts (v:Tast.Val) to AbsIL datatstructures. /// Ilreflect converts from AbsIL datatstructures to emitted Type, FieldInfo, MethodInfo etc. let LookupGeneratedValue (amap:Import.ImportMap) (ctxt: ExecutionContext) g eenv (v:Val) = try @@ -7056,7 +7056,7 @@ let LookupGeneratedInfo (ctxt: ExecutionContext) (g:TcGlobals) eenv (v:Val) = /// The published API from the ILX code generator -type IlxAssemblyGenerator(amap: Import.ImportMap, tcGlobals: Env.TcGlobals, tcVal : ConstraintSolver.TcValF, ccu: Tast.CcuThunk) = +type IlxAssemblyGenerator(amap: Import.ImportMap, tcGlobals: TcGlobals, tcVal : ConstraintSolver.TcValF, ccu: Tast.CcuThunk) = // The incremental state held by the ILX code generator let mutable ilxGenEnv = GetEmptyIlxGenEnv tcGlobals.ilg ccu diff --git a/src/fsharp/ilxgen.fsi b/src/fsharp/IlxGen.fsi similarity index 95% rename from src/fsharp/ilxgen.fsi rename to src/fsharp/IlxGen.fsi index 6cc7fab17bf915bb4c813e17775f9307be8841b2..7f1745910c56c58b5aa52a95424c595d5c070046 100644 --- a/src/fsharp/ilxgen.fsi +++ b/src/fsharp/IlxGen.fsi @@ -1,14 +1,15 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. -module internal Microsoft.FSharp.Compiler.Ilxgen +module internal Microsoft.FSharp.Compiler.IlxGen +open System +open System.IO +open System.Reflection open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.Tast -open System -open System.IO -open System.Reflection +open Microsoft.FSharp.Compiler.TcGlobals /// Indicates how the generated IL code is ultimately emitted type IlxGenBackend = @@ -60,7 +61,7 @@ type ExecutionContext = /// An incremental ILX code generator for a single assembly type public IlxAssemblyGenerator = /// Create an incremental ILX code generator for a single assembly - new : Import.ImportMap * Env.TcGlobals * ConstraintSolver.TcValF * CcuThunk -> IlxAssemblyGenerator + new : Import.ImportMap * TcGlobals * ConstraintSolver.TcValF * CcuThunk -> IlxAssemblyGenerator /// Register a set of referenced assemblies with the ILX code generator member AddExternalCcus : CcuThunk list -> unit diff --git a/src/fsharp/tlr.fs b/src/fsharp/InnerLambdasToTopLevelFuncs.fs similarity index 99% rename from src/fsharp/tlr.fs rename to src/fsharp/InnerLambdasToTopLevelFuncs.fs index c84f1ad95d5abd1f24b97c6f07af85e63be27ea6..7792c3af4771548f86d5ace65689dc4e8b5474b0 100644 --- a/src/fsharp/tlr.fs +++ b/src/fsharp/InnerLambdasToTopLevelFuncs.fs @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. -module internal Microsoft.FSharp.Compiler.Tlr +module internal Microsoft.FSharp.Compiler.InnerLambdasToTopLevelFuncs open Internal.Utilities open Microsoft.FSharp.Compiler.AbstractIL @@ -14,7 +14,7 @@ open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.Tastops.DebugPrint -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.Layout open Microsoft.FSharp.Compiler.Detuple.GlobalUsageAnalysis open Microsoft.FSharp.Compiler.Lib @@ -868,7 +868,7 @@ module Pass4_RewriteAssembly = [] type RewriteContext = { ccu : CcuThunk; - g : Env.TcGlobals; + g : TcGlobals; tlrS : Zset ; topValS : Zset ; arityM : Zmap ; @@ -1048,9 +1048,9 @@ module Pass4_RewriteAssembly = let newTlrBinds,tlrRebinds = TransTLRBindings penv tlrBs let aenvBinds = GetAEnvBindings penv fclass // lower nonTlrBs if they are GTL - // QUERY: we repeat this logic in Lowertop. Do we really need to do this here? + // QUERY: we repeat this logic in LowerCallsAndSeqs. Do we really need to do this here? // QUERY: yes and no - if we don't, we have an unrealizable term, and many decisions must - // QUERY: correlate with Lowertop. + // QUERY: correlate with LowerCallsAndSeqs. let forceTopBindToHaveArity (bind:Binding) = if penv.topValS.Contains(bind.Var) then ConvertBind penv.g bind else bind diff --git a/src/fsharp/tlr.fsi b/src/fsharp/InnerLambdasToTopLevelFuncs.fsi similarity index 55% rename from src/fsharp/tlr.fsi rename to src/fsharp/InnerLambdasToTopLevelFuncs.fsi index c0b16fcaeea80a31b9c5361a88ba71a73852e199..1c6225cb119c576c5b3a86fa3af80ef9e325f069 100644 --- a/src/fsharp/tlr.fsi +++ b/src/fsharp/InnerLambdasToTopLevelFuncs.fsi @@ -1,10 +1,11 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. -module internal Microsoft.FSharp.Compiler.Tlr +module internal Microsoft.FSharp.Compiler.InnerLambdasToTopLevelFuncs open Microsoft.FSharp.Compiler +open Microsoft.FSharp.Compiler.TcGlobals -val MakeTLRDecisions : Tast.CcuThunk -> Env.TcGlobals -> Tast.TypedImplFile -> Tast.TypedImplFile +val MakeTLRDecisions : Tast.CcuThunk -> TcGlobals -> Tast.TypedImplFile -> Tast.TypedImplFile #if TLR_LIFT val liftTLR : bool ref #endif diff --git a/src/fsharp/lexfilter.fs b/src/fsharp/LexFilter.fs similarity index 99% rename from src/fsharp/lexfilter.fs rename to src/fsharp/LexFilter.fs index 81cf6a0ed5b69fd92116abf5bc9d175d20bd43f7..d7183777f5d5c9b8719c13966881683a6e9d203a 100644 --- a/src/fsharp/lexfilter.fs +++ b/src/fsharp/LexFilter.fs @@ -2,7 +2,7 @@ /// LexFilter - process the token stream prior to parsing. /// Implements the offside rule and a copule of other lexical transformations. -module internal Microsoft.FSharp.Compiler.Lexfilter +module internal Microsoft.FSharp.Compiler.LexFilter open Internal.Utilities open Internal.Utilities.Text.Lexing diff --git a/src/fsharp/lowertop.fs b/src/fsharp/LowerCallsAndSeqs.fs similarity index 99% rename from src/fsharp/lowertop.fs rename to src/fsharp/LowerCallsAndSeqs.fs index a1da0e71ede3f6c1c37522c04f38467208f8ad0d..eaea08b433c2d7a2cc670dceabb5b61a720184d8 100644 --- a/src/fsharp/lowertop.fs +++ b/src/fsharp/LowerCallsAndSeqs.fs @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. -module internal Microsoft.FSharp.Compiler.Lowertop +module internal Microsoft.FSharp.Compiler.LowerCallsAndSeqs open Internal.Utilities open Microsoft.FSharp.Compiler.AbstractIL @@ -17,7 +17,7 @@ open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.Lib -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.PrettyNaming //---------------------------------------------------------------------------- diff --git a/src/fsharp/nameres.fs b/src/fsharp/NameResolution.fs similarity index 98% rename from src/fsharp/nameres.fs rename to src/fsharp/NameResolution.fs index febdc26da28362d20ed6da864db48f5453c0e83a..50b1e4f0186df20e3dc8f4ab3ae8c7ab6b6b4d8c 100644 --- a/src/fsharp/nameres.fs +++ b/src/fsharp/NameResolution.fs @@ -5,7 +5,7 @@ //------------------------------------------------------------------------- -module internal Microsoft.FSharp.Compiler.Nameres +module internal Microsoft.FSharp.Compiler.NameResolution open Internal.Utilities open Microsoft.FSharp.Compiler @@ -15,14 +15,14 @@ open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.Import -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library +open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library.ResultOrException open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Microsoft.FSharp.Compiler.AbstractIL.IL // Abstract IL -open Microsoft.FSharp.Compiler.Outcome open Microsoft.FSharp.Compiler.Infos open Microsoft.FSharp.Compiler.Infos.AccessibilityLogic open Microsoft.FSharp.Compiler.Infos.AttributeChecking @@ -546,7 +546,7 @@ let AddUnionCases2 bulkAddMode (eUnqualifiedItems: LayeredMap<_,_>) (ucrefs :Uni let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g:TcGlobals) amap m nenv (tcref:TyconRef) = let isIL = tcref.IsILTycon - let ucrefs = if isIL then [] else tcref.UnionCasesAsList |> List.map (mkNestedUnionCaseRef tcref) + let ucrefs = if isIL then [] else tcref.UnionCasesAsList |> List.map tcref.MakeNestedUnionCaseRef let flds = if isIL then [| |] else tcref.AllFieldsArray let eIndexedExtensionMembers, eUnindexedExtensionMembers = @@ -562,7 +562,7 @@ let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g:TcGlobals) else (nenv.eFieldLabels,flds) ||> Array.fold (fun acc f -> if f.IsStatic || f.IsCompilerGenerated then acc - else AddRecdField (mkNestedRecdFieldRef tcref f) acc) + else AddRecdField (tcref.MakeNestedRecdFieldRef f) acc) let eUnqualifiedItems = let tab = nenv.eUnqualifiedItems @@ -650,7 +650,7 @@ let AddModuleAbbrevToNameEnv (id:Ident) nenv modrefs = let MakeNestedModuleRefs (modref: ModuleOrNamespaceRef) = modref.ModuleOrNamespaceType.ModuleAndNamespaceDefinitions - |> List.map modref.MkNestedTyconRef + |> List.map modref.NestedTyconRef /// Add a set of module or namespace to the name resolution environment, including any sub-modules marked 'AutoOpen' // @@ -687,8 +687,8 @@ and AddModuleOrNamespaceContentsToNameEnv (g:TcGlobals) amap (ad:AccessorDomain) let exncs = mty.ExceptionDefinitions let nenv = { nenv with eDisplayEnv= nenv.eDisplayEnv.AddOpenModuleOrNamespace modref } - let tcrefs = tycons |> List.map modref.MkNestedTyconRef |> List.filter (IsEntityAccessible amap m ad) - let exrefs = exncs |> List.map modref.MkNestedTyconRef |> List.filter (IsEntityAccessible amap m ad) + let tcrefs = tycons |> List.map modref.NestedTyconRef |> List.filter (IsEntityAccessible amap m ad) + let exrefs = exncs |> List.map modref.NestedTyconRef |> List.filter (IsEntityAccessible amap m ad) let nenv = (nenv,exrefs) ||> List.fold (AddExceptionDeclsToNameEnv BulkAdd.Yes) let nenv = (nenv,tcrefs) ||> AddTyconRefsToNameEnv BulkAdd.Yes false g amap m false let vrefs = @@ -957,7 +957,7 @@ let AddEntityForProvidedType (amap: Import.ImportMap, modref: ModuleOrNamespaceR let isSuppressRelocate = amap.g.isInteractive || st.PUntaint((fun st -> st.IsSuppressRelocate),m) let tycon = Construct.NewProvidedTycon(resolutionEnvironment, st, importProvidedType, isSuppressRelocate, m) modref.ModuleOrNamespaceType.AddProvidedTypeEntity(tycon) - let tcref = modref.MkNestedTyconRef tycon + let tcref = modref.NestedTyconRef tycon System.Diagnostics.Debug.Assert modref.TryDeref.IsSome tcref @@ -1005,10 +1005,10 @@ let LookupTypeNameInEntityMaybeHaveArity (amap, m, nm, staticResInfo:TypeNameRes | TypeNameResolutionStaticArgsInfo.Indefinite -> match LookupTypeNameInEntityNoArity m nm mtyp with | [] -> [] - | tycons -> tycons |> List.map modref.MkNestedTyconRef + | tycons -> tycons |> List.map modref.NestedTyconRef | TypeNameResolutionStaticArgsInfo.Definite _ -> match LookupTypeNameInEntityHaveArity nm staticResInfo mtyp with - | Some tycon -> [modref.MkNestedTyconRef tycon] + | Some tycon -> [modref.NestedTyconRef tycon] | None -> [] #if EXTENSIONTYPING let tcrefs = @@ -1063,7 +1063,7 @@ let GetNestedTypesOfType (ad, ncenv:NameResolver, optFilter, staticResInfo, chec #endif mty.TypesByAccessNames.Values |> Seq.toList - |> List.map (tcref.MkNestedTyconRef >> MakeNestedType ncenv tinst m) + |> List.map (tcref.NestedTyconRef >> MakeNestedType ncenv tinst m) |> List.filter (IsTypeAccessible g ncenv.amap m ad) else []) @@ -1314,8 +1314,8 @@ let rec ResolveLongIndentAsModuleOrNamespace amap m fullyQualified (nenv:NameRes | [] -> success (depth,modref,mty) | id:: rest -> match mty.ModulesAndNamespacesByDemangledName.TryFind id.idText with - | Some mspec when IsEntityAccessible amap m ad (modref.MkNestedTyconRef mspec) -> - let subref = modref.MkNestedTyconRef mspec + | Some mspec when IsEntityAccessible amap m ad (modref.NestedTyconRef mspec) -> + let subref = modref.NestedTyconRef mspec look (depth+1) subref mspec.ModuleOrNamespaceType rest | _ -> raze (UndefinedName(depth,FSComp.SR.undefinedNameNamespace,id,[])) @@ -1499,7 +1499,7 @@ let TryFindUnionCaseOfType g typ nm = let tcref,tinst = destAppTy g typ match tcref.GetUnionCaseByName nm with | None -> None - | Some ucase -> Some(UnionCaseInfo(tinst,mkNestedUnionCaseRef tcref ucase)) + | Some ucase -> Some(UnionCaseInfo(tinst,tcref.MakeNestedUnionCaseRef ucase)) else None @@ -1639,7 +1639,7 @@ let private ResolveLongIdentInTyconRefs (ncenv:NameResolver) nenv lookupKind dep //------------------------------------------------------------------------- let (|AccessibleEntityRef|_|) amap m ad (modref: ModuleOrNamespaceRef) mspec = - let eref = modref.MkNestedTyconRef mspec + let eref = modref.NestedTyconRef mspec if IsEntityAccessible amap m ad eref then Some eref else None let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeNameResInfo: TypeNameResolutionInfo) ad resInfo depth m modref (mty:ModuleOrNamespaceType) (lid :Ident list) = @@ -1653,15 +1653,15 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN success(resInfo,Item.Value (mkNestedValRef modref vspec),rest) | _-> match TryFindTypeWithUnionCase modref id with - | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.MkNestedTyconRef tycon) -> - let ucref = mkUnionCaseRef (modref.MkNestedTyconRef tycon) id.idText + | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> + let ucref = mkUnionCaseRef (modref.NestedTyconRef tycon) id.idText let showDeprecated = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs let ucinfo = FreshenUnionCaseRef ncenv m ucref success (resInfo,Item.UnionCase(ucinfo,showDeprecated),rest) | _ -> match mty.ExceptionDefinitionsByDemangledName.TryFind(id.idText) with - | Some excon when IsTyconReprAccessible ncenv.amap m ad (modref.MkNestedTyconRef excon) -> - success (resInfo,Item.ExnCase (modref.MkNestedTyconRef excon),rest) + | Some excon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef excon) -> + success (resInfo,Item.ExnCase (modref.NestedTyconRef excon),rest) | _ -> // Something in a type? @@ -1855,16 +1855,16 @@ let rec ResolvePatternLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv num | id :: rest -> let m = unionRanges m id.idRange match TryFindTypeWithUnionCase modref id with - | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.MkNestedTyconRef tycon) -> - let tcref = modref.MkNestedTyconRef tycon + | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> + let tcref = modref.NestedTyconRef tycon let ucref = mkUnionCaseRef tcref id.idText let showDeprecated = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs let ucinfo = FreshenUnionCaseRef ncenv m ucref success (resInfo,Item.UnionCase(ucinfo,showDeprecated),rest) | _ -> match mty.ExceptionDefinitionsByDemangledName.TryFind(id.idText) with - | Some exnc when IsEntityAccessible ncenv.amap m ad (modref.MkNestedTyconRef exnc) -> - success (resInfo,Item.ExnCase (modref.MkNestedTyconRef exnc),rest) + | Some exnc when IsEntityAccessible ncenv.amap m ad (modref.NestedTyconRef exnc) -> + success (resInfo,Item.ExnCase (modref.NestedTyconRef exnc),rest) | _ -> // An active pattern constructor in a module match (ActivePatternElemsOfModuleOrNamespace modref).TryFind(id.idText) with @@ -2146,9 +2146,9 @@ let rec ResolveFieldInModuleOrNamespace (ncenv:NameResolver) nenv ad (resInfo:Re // search for module-qualified names, e.g. { Microsoft.FSharp.Core.contents = 1 } let modulScopedFieldNames = match TryFindTypeWithRecdField modref id with - | Some tycon when IsEntityAccessible ncenv.amap m ad (modref.MkNestedTyconRef tycon) -> + | Some tycon when IsEntityAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> let showDeprecated = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs - success(FieldResolution(modref.MkNestedRecdFieldRef tycon id,showDeprecated), rest) + success(FieldResolution(modref.RecdFieldRefInNestedTycon tycon id,showDeprecated), rest) | _ -> error // search for type-qualified names, e.g. { Microsoft.FSharp.Core.Ref.contents = 1 } let tyconSearch = @@ -2440,7 +2440,7 @@ let rec PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThen f plid (m | [] -> f modref | id:: rest -> match mty.ModulesAndNamespacesByDemangledName.TryFind(id) with - | Some mty -> PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThen f rest (modref.MkNestedTyconRef mty) + | Some mty -> PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThen f rest (modref.NestedTyconRef mty) | None -> [] let PartialResolveLongIndentAsModuleOrNamespaceThen (nenv:NameResolutionEnv) plid f = @@ -2553,7 +2553,7 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso not minfo.IsExtensionMember && match minfo.LogicalName with | "GetType" -> false - | "GetHashCode" -> isObjTy g minfo.EnclosingType && not (Augment.TypeDefinitelyHasEquality g typ) + | "GetHashCode" -> isObjTy g minfo.EnclosingType && not (AugmentWithHashCompare.TypeDefinitelyHasEquality g typ) | "ToString" -> false | "Equals" -> if not (isObjTy g minfo.EnclosingType) then @@ -2561,7 +2561,7 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso false elif minfo.IsInstance then // System.Object has only one instance Equals method and we want to suppress it unless Augment.TypeDefinitelyHasEquality is true - not (Augment.TypeDefinitelyHasEquality g typ) + not (AugmentWithHashCompare.TypeDefinitelyHasEquality g typ) else // System.Object has only one static Equals method and we always want to suppress it true @@ -2734,12 +2734,12 @@ let rec private EntityRefContainsSomethingAccessible (ncenv: NameResolver) m ad (mty.AllEntities |> QueueList.exists (fun tc -> not tc.IsModuleOrNamespace && - not (IsTyconUnseen ad g ncenv.amap m (modref.MkNestedTyconRef tc)))) || + not (IsTyconUnseen ad g ncenv.amap m (modref.NestedTyconRef tc)))) || // Search the sub-modules of the namespace/modulefor something accessible (mty.ModulesAndNamespacesByDemangledName |> NameMap.exists (fun _ submod -> - let submodref = modref.MkNestedTyconRef submod + let submodref = modref.NestedTyconRef submod EntityRefContainsSomethingAccessible ncenv m ad submodref)) let rec ResolvePartialLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv isApplicableMeth m ad (modref:ModuleOrNamespaceRef) plid allowObsolete = @@ -2749,7 +2749,7 @@ let rec ResolvePartialLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv is let tycons = mty.TypeDefinitions |> List.filter (fun tcref -> not (tcref.LogicalName.Contains(","))) - |> List.filter (fun tycon -> not (IsTyconUnseen ad g ncenv.amap m (modref.MkNestedTyconRef tycon))) + |> List.filter (fun tycon -> not (IsTyconUnseen ad g ncenv.amap m (modref.NestedTyconRef tycon))) let ilTyconNames = mty.TypesByAccessNames.Values @@ -2784,7 +2784,7 @@ let rec ResolvePartialLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv is // Collect up the accessible F# exception declarations in the module @ (mty.ExceptionDefinitionsByDemangledName |> NameMap.range - |> List.map modref.MkNestedTyconRef + |> List.map modref.NestedTyconRef |> List.filter (IsTyconUnseen ad g ncenv.amap m >> not) |> List.map Item.ExnCase) @@ -2793,30 +2793,30 @@ let rec ResolvePartialLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv is |> NameMap.range |> List.filter (fun x -> x.DemangledModuleOrNamespaceName |> notFakeContainerModule ilTyconNames) |> List.filter (fun x -> x.DemangledModuleOrNamespaceName |> IsInterestingModuleName) - |> List.map modref.MkNestedTyconRef + |> List.map modref.NestedTyconRef |> List.filter (IsTyconUnseen ad g ncenv.amap m >> not) |> List.filter (EntityRefContainsSomethingAccessible ncenv m ad) |> List.map ItemForModuleOrNamespaceRef) // Get all the types and .NET constructor groups accessible from here @ (tycons - |> List.map (modref.MkNestedTyconRef >> ItemOfTyconRef ncenv m) ) + |> List.map (modref.NestedTyconRef >> ItemOfTyconRef ncenv m) ) @ (tycons - |> List.map (modref.MkNestedTyconRef >> InfosForTyconConstructors ncenv m ad) |> List.concat) + |> List.map (modref.NestedTyconRef >> InfosForTyconConstructors ncenv m ad) |> List.concat) | id :: rest -> (match mty.ModulesAndNamespacesByDemangledName.TryFind(id) with | Some mspec - when not (IsTyconUnseenObsoleteSpec ad g ncenv.amap m (modref.MkNestedTyconRef mspec) allowObsolete) -> + when not (IsTyconUnseenObsoleteSpec ad g ncenv.amap m (modref.NestedTyconRef mspec) allowObsolete) -> let allowObsolete = rest <> [] && allowObsolete - ResolvePartialLongIdentInModuleOrNamespace ncenv nenv isApplicableMeth m ad (modref.MkNestedTyconRef mspec) rest allowObsolete + ResolvePartialLongIdentInModuleOrNamespace ncenv nenv isApplicableMeth m ad (modref.NestedTyconRef mspec) rest allowObsolete | _ -> []) @ (LookupTypeNameInEntityNoArity m id modref.ModuleOrNamespaceType |> List.collect (fun tycon -> - let tcref = modref.MkNestedTyconRef tycon + let tcref = modref.NestedTyconRef tycon if not (IsTyconUnseenObsoleteSpec ad g ncenv.amap m tcref allowObsolete) then tcref |> generalizedTyconRef |> ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad true rest else @@ -2930,7 +2930,7 @@ let rec ResolvePartialLongIdentInModuleOrNamespaceForRecordFields (ncenv: NameRe mty.TypeDefinitions |> List.filter (fun tcref -> not (tcref.LogicalName.Contains(","))) |> List.filter (fun tycon -> tycon.IsRecordTycon) - |> List.filter (fun tycon -> not (IsTyconUnseen ad g ncenv.amap m (modref.MkNestedTyconRef tycon))) + |> List.filter (fun tycon -> not (IsTyconUnseen ad g ncenv.amap m (modref.NestedTyconRef tycon))) let ilTyconNames = mty.TypesByAccessNames.Values @@ -2945,17 +2945,17 @@ let rec ResolvePartialLongIdentInModuleOrNamespaceForRecordFields (ncenv: NameRe |> NameMap.range |> List.filter (fun x -> x.DemangledModuleOrNamespaceName |> notFakeContainerModule ilTyconNames) |> List.filter (fun x -> x.DemangledModuleOrNamespaceName |> IsInterestingModuleName) - |> List.map modref.MkNestedTyconRef + |> List.map modref.NestedTyconRef |> List.filter (IsTyconUnseen ad g ncenv.amap m >> not) |> List.filter (EntityRefContainsSomethingAccessible ncenv m ad) |> List.map ItemForModuleOrNamespaceRef) // Collect all accessible record types - @ (tycons |> List.map (modref.MkNestedTyconRef >> ItemOfTyconRef ncenv m) ) + @ (tycons |> List.map (modref.NestedTyconRef >> ItemOfTyconRef ncenv m) ) @ [ // accessible record fields for tycon in tycons do - if IsEntityAccessible ncenv.amap m ad (modref.MkNestedTyconRef tycon) then - let ttype = FreshenTycon ncenv m (modref.MkNestedTyconRef tycon) + if IsEntityAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) then + let ttype = FreshenTycon ncenv m (modref.NestedTyconRef tycon) yield! ncenv.InfoReader.GetRecordOrClassFieldsOfType(None, ad, m, ttype) |> List.map Item.RecdField @@ -2964,9 +2964,9 @@ let rec ResolvePartialLongIdentInModuleOrNamespaceForRecordFields (ncenv: NameRe | id :: rest -> (match mty.ModulesAndNamespacesByDemangledName.TryFind(id) with | Some mspec - when not (IsTyconUnseenObsoleteSpec ad g ncenv.amap m (modref.MkNestedTyconRef mspec) allowObsolete) -> + when not (IsTyconUnseenObsoleteSpec ad g ncenv.amap m (modref.NestedTyconRef mspec) allowObsolete) -> let allowObsolete = rest <> [] && allowObsolete - ResolvePartialLongIdentInModuleOrNamespaceForRecordFields ncenv nenv m ad (modref.MkNestedTyconRef mspec) rest allowObsolete + ResolvePartialLongIdentInModuleOrNamespaceForRecordFields ncenv nenv m ad (modref.NestedTyconRef mspec) rest allowObsolete | _ -> []) @ ( match rest with @@ -2976,7 +2976,7 @@ let rec ResolvePartialLongIdentInModuleOrNamespaceForRecordFields (ncenv: NameRe tycons |> List.filter (fun tc -> tc.IsRecordTycon) |> List.collect (fun tycon -> - let tcref = modref.MkNestedTyconRef tycon + let tcref = modref.NestedTyconRef tycon let ttype = FreshenTycon ncenv m tcref ncenv.InfoReader.GetRecordOrClassFieldsOfType(None, ad, m, ttype ) ) diff --git a/src/fsharp/nameres.fsi b/src/fsharp/NameResolution.fsi similarity index 99% rename from src/fsharp/nameres.fsi rename to src/fsharp/NameResolution.fsi index 89c7f1732efd96198dc01043451b9d4ae9e914a8..3587fea36822d3d9f5c0c88bcf1d29997ed53741 100644 --- a/src/fsharp/nameres.fsi +++ b/src/fsharp/NameResolution.fsi @@ -1,16 +1,15 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. -module internal Microsoft.FSharp.Compiler.Nameres +module internal Microsoft.FSharp.Compiler.NameResolution open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.Infos open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.Import -open Microsoft.FSharp.Compiler.Outcome open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library open Microsoft.FSharp.Compiler.PrettyNaming diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index 209a60d442436750a4839451a2442c1dc2265dfc..66b955dff0e0a35b87f7fa34b123be0a51ea8453 100644 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -22,7 +22,7 @@ open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.Tastops.DebugPrint -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.AbstractIL.IL (* Abstract IL *) open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.Infos @@ -1323,7 +1323,7 @@ module private TastDefinitionPrinting = let isGenerated = if isUnionCase then isGeneratedUnionCaseField else isGeneratedExceptionField sepListL (wordL "*") (List.mapi (layoutUnionOrExceptionField denv isGenerated) fields) - let layoutUnionCase denv prefixL ucase = + let layoutUnionCase denv prefixL (ucase:UnionCase) = let nmL = wordL (DemangleOperatorName ucase.Id.idText) //let nmL = layoutAccessibility denv ucase.Accessibility nmL match ucase.RecdFields with diff --git a/src/fsharp/opt.fs b/src/fsharp/Optimizer.fs similarity index 99% rename from src/fsharp/opt.fs rename to src/fsharp/Optimizer.fs index ec20d321a538a86894fd70cdda7f28ebcfa73a2c..0b702fd3725ef184e4e41e01b8f863ef56dbbb16 100644 --- a/src/fsharp/opt.fs +++ b/src/fsharp/Optimizer.fs @@ -7,7 +7,7 @@ //------------------------------------------------------------------------- -module internal Microsoft.FSharp.Compiler.Opt +module internal Microsoft.FSharp.Compiler.Optimizer open Internal.Utilities open Microsoft.FSharp.Compiler.AbstractIL @@ -19,7 +19,7 @@ open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics -open Microsoft.FSharp.Compiler.Pickle +open Microsoft.FSharp.Compiler.TastPickle open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.ErrorLogger @@ -28,10 +28,10 @@ open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.Tastops.DebugPrint open Microsoft.FSharp.Compiler.TypeChecker -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.Layout -open Microsoft.FSharp.Compiler.Typrelns +open Microsoft.FSharp.Compiler.TypeRelations open Microsoft.FSharp.Compiler.Infos open System.Collections.Generic @@ -145,7 +145,10 @@ type ModuleInfo = ModuleOrNamespaceInfos: NameMap } and LazyModuleInfo = Lazy +type ImplFileOptimizationInfo = LazyModuleInfo +type CcuOptimizationInfo = LazyModuleInfo +#if DEBUG let braceL x = leftL "{" ^^ x ^^ rightL "}" let seqL xL xs = Seq.fold (fun z x -> z @@ xL x) emptyL xs let namemapL xL xmap = NameMap.foldBack (fun nm x z -> xL nm x @@ z) xmap emptyL @@ -169,6 +172,7 @@ and moduleInfoL g (x:LazyModuleInfo) = and valInfoL g (x:ValInfo) = braceL ((wordL "ValExprInfo: " @@ exprValueInfoL g x.ValExprInfo) @@ (wordL "ValMakesNoCriticalTailcalls:" @@ wordL (if x.ValMakesNoCriticalTailcalls then "true" else "false"))) +#endif type Summary<'Info> = { Info: 'Info; @@ -306,7 +310,7 @@ type OptimizationSettings = #else type cenv = - { g: Env.TcGlobals; + { g: TcGlobals; TcVal : ConstraintSolver.TcValF amap: Import.ImportMap; optimizing: bool; @@ -374,10 +378,10 @@ let check (vref: ValRef) (res:ValInfo) = let EmptyModuleInfo = notlazy { ValInfos = ValInfos([]); ModuleOrNamespaceInfos = Map.empty } -let rec UnionModuleInfos (minfos : seq) = +let rec UnionOptimizationInfos (minfos : seq) = notlazy { ValInfos = ValInfos(seq { for minfo in minfos do yield! minfo.Force().ValInfos.Entries }) - ModuleOrNamespaceInfos = minfos |> Seq.map (fun m -> m.Force().ModuleOrNamespaceInfos) |> NameMap.union UnionModuleInfos } + ModuleOrNamespaceInfos = minfos |> Seq.map (fun m -> m.Force().ModuleOrNamespaceInfos) |> NameMap.union UnionOptimizationInfos } let FindOrCreateModuleInfo n (ss: Map<_,_>) = match ss.TryFind n with @@ -490,9 +494,13 @@ let BindTypeVarsToUnknown (tps:Typar list) env = tp.Data.typar_id <- ident (nm,tp.Range)); List.fold (fun sofar arg -> BindTypeVar arg UnknownTypeValue sofar) env tps -let BindCcu (ccu:Tast.CcuThunk) mval env cenv = +let BindCcu (ccu:Tast.CcuThunk) mval env (g:TcGlobals) = +#if DEBUG if verboseOptimizationInfo then - dprintf "*** Reloading optimization data for assembly %s, info = \n%s\n" ccu.AssemblyName (showL (Layout.squashTo 192 (moduleInfoL cenv mval))); + dprintf "*** Reloading optimization data for assembly %s, info = \n%s\n" ccu.AssemblyName (showL (Layout.squashTo 192 (moduleInfoL g mval))); +#else + ignore g +#endif { env with globalModuleInfos=env.globalModuleInfos.Add(ccu.AssemblyName,mval) } @@ -626,12 +634,16 @@ let (|StripInt32Value|_|) = function StripConstValue(Const.Int32 n) -> Some n | //------------------------------------------------------------------------- let MakeValueInfoForValue g m vref vinfo = +#if DEBUG let rec check x = match x with | ValValue (vref2,detail) -> if valRefEq g vref vref2 then error(Error(FSComp.SR.optRecursiveValValue(showL(exprValueInfoL g vinfo)),m)) else check detail | SizeValue (_n,detail) -> check detail | _ -> () check vinfo; +#else + ignore g; ignore m; +#endif ValValue (vref,vinfo) |> BoundValueInfoBySize let MakeValueInfoForRecord tcref argvals = RecdValue (tcref,argvals) |> BoundValueInfoBySize @@ -1032,12 +1044,12 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = | TupleValue vinfos -> TupleValue (Array.map abstractExprInfo vinfos) | RecdValue (tcref,vinfos) -> - if hiddenTyconRepr tcref.Deref || Array.exists (mkNestedRecdFieldRef tcref >> hiddenRecdField) tcref.AllFieldsArray + if hiddenTyconRepr tcref.Deref || Array.exists (tcref.MakeNestedRecdFieldRef >> hiddenRecdField) tcref.AllFieldsArray then UnknownValue else RecdValue (tcref,Array.map abstractExprInfo vinfos) | UnionCaseValue(ucref,vinfos) -> let tcref = ucref.TyconRef - if hiddenTyconRepr ucref.Tycon || tcref.UnionCasesArray |> Array.exists (mkNestedUnionCaseRef tcref >> hiddenUnionCase) + if hiddenTyconRepr ucref.Tycon || tcref.UnionCasesArray |> Array.exists (tcref.MakeNestedUnionCaseRef >> hiddenUnionCase) then UnknownValue else UnionCaseValue (ucref,Array.map abstractExprInfo vinfos) | SizeValue(_vdepth,vinfo) -> MakeSizedValueInfo (abstractExprInfo vinfo) @@ -1061,7 +1073,7 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = abstractLazyModulInfo /// Hide all information except what we need for "must inline". We always save this optimization information -let AbstractLazyModulInfoToEssentials = +let AbstractOptimizationInfoToEssentials = let rec abstractModulInfo (ss:ModuleInfo) = { ModuleOrNamespaceInfos = NameMap.map (Lazy.force >> abstractModulInfo >> notlazy) ss.ModuleOrNamespaceInfos; @@ -1155,7 +1167,7 @@ let AbstractExprInfoByVars (boundVars:Val list,boundTyVars) ivalue = // Remap optimization information, e.g. to use public stable references so we can pickle it // to disk. //------------------------------------------------------------------------- -let RemapLazyModulInfo g tmenv = +let RemapOptimizationInfo g tmenv = let rec remapExprInfo ivalue = if verboseOptimizationInfo then dprintf "remapExprInfo\n"; @@ -1173,7 +1185,7 @@ let RemapLazyModulInfo g tmenv = let remapValInfo v = { ValExprInfo=remapExprInfo v.ValExprInfo; ValMakesNoCriticalTailcalls=v.ValMakesNoCriticalTailcalls } let rec remapModulInfo ss = if verboseOptimizationInfo then dprintf "remapModulInfo\n"; - { ModuleOrNamespaceInfos = ss.ModuleOrNamespaceInfos |> NameMap.map RemapLazyModulInfo; + { ModuleOrNamespaceInfos = ss.ModuleOrNamespaceInfos |> NameMap.map remapLazyModulInfo; ValInfos = ss.ValInfos.Map (fun (vref,vinfo) -> let vref' = remapValRef tmenv vref let vinfo = remapValInfo vinfo @@ -1181,10 +1193,10 @@ let RemapLazyModulInfo g tmenv = if vinfo.ValMakesNoCriticalTailcalls then vref'.Deref.SetMakesNoCriticalTailcalls() (vref',vinfo)) } - and RemapLazyModulInfo ss = + and remapLazyModulInfo ss = ss |> Lazy.force |> remapModulInfo |> notlazy - RemapLazyModulInfo + remapLazyModulInfo //------------------------------------------------------------------------- // Hide information when a value is no longer visible @@ -1192,11 +1204,19 @@ let RemapLazyModulInfo g tmenv = let AbstractAndRemapModulInfo msg g m (repackage,hidden) info = let mrpi = mkRepackageRemapping repackage +#if DEBUG if verboseOptimizationInfo then dprintf "%s - %a - Optimization data prior to trim: \n%s\n" msg outputRange m (Layout.showL (Layout.squashTo 192 (moduleInfoL g info))); +#else + ignore (msg,m) +#endif let info = info |> AbstractLazyModulInfoByHiding false hidden +#if DEBUG if verboseOptimizationInfo then dprintf "%s - %a - Optimization data after trim:\n%s\n" msg outputRange m (Layout.showL (Layout.squashTo 192 (moduleInfoL g info))); - let info = info |> RemapLazyModulInfo g mrpi +#endif + let info = info |> RemapOptimizationInfo g mrpi +#if DEBUG if verboseOptimizationInfo then dprintf "%s - %a - Optimization data after remap:\n%s\n" msg outputRange m (Layout.showL (Layout.squashTo 192 (moduleInfoL g info))); +#endif info //------------------------------------------------------------------------- @@ -1735,7 +1755,7 @@ let rec OptimizeExpr cenv (env:IncrementalOptimizationEnv) expr = let topValInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps,[],ValReprInfo.unnamedRetVal) let ty = tryMkForallTy tps rty OptimizeLambdas None cenv env topValInfo expr ty - | Expr.TyChoose _ -> OptimizeExpr cenv env (Typrelns.ChooseTyparSolutionsForFreeChoiceTypars cenv.g cenv.amap expr) + | Expr.TyChoose _ -> OptimizeExpr cenv env (TypeRelations.ChooseTyparSolutionsForFreeChoiceTypars cenv.g cenv.amap expr) | Expr.Match(spMatch,exprm,dtree,targets,m,ty) -> OptimizeMatch cenv env (spMatch,exprm,dtree,targets,m,ty) | Expr.LetRec (binds,e,m,_) -> OptimizeLetRec cenv env (binds,e,m) | Expr.StaticOptimization (constraints,e2,e3,m) -> @@ -3036,7 +3056,9 @@ and OptimizeBinding cenv isRec env (TBind(v,e,spBind)) = else einfo if v.MustInline && IsPartialExprVal einfo.Info then errorR(InternalError("the mustinline value '"^v.LogicalName^"' was not inferred to have a known value",v.Range)); +#if DEBUG if verboseOptimizations then dprintf "val %s gets opt info %s\n" (showL(valL v)) (showL(exprValueInfoL cenv.g einfo.Info)); +#endif let env = BindInternalLocalVal cenv v (mkValInfo einfo v) env (TBind(v,repr',spBind), einfo), env @@ -3169,7 +3191,7 @@ and OptimizeModuleDefs cenv (env,bindInfosColl) defs = if verboseOptimizations then dprintf "OptimizeModuleDefs\n"; let defs,(env,bindInfosColl) = List.mapFold (OptimizeModuleDef cenv) (env,bindInfosColl) defs let defs,minfos = List.unzip defs - (defs,UnionModuleInfos minfos),(env,bindInfosColl) + (defs,UnionOptimizationInfos minfos),(env,bindInfosColl) and OptimizeImplFileInternal cenv env isIncrementalFragment (TImplFile(qname, pragmas, (ModuleOrNamespaceExprWithSig(mty,_,_) as mexpr), hasExplicitEntryPoint,isScript)) = let env,mexpr',minfo = @@ -3239,6 +3261,7 @@ and p_ModuleInfo x st = and p_LazyModuleInfo x st = p_lazy p_ModuleInfo x st +let p_CcuOptimizationInfo x st = p_LazyModuleInfo x st #endif // !NO_COMPILER_BACKEND @@ -3267,3 +3290,4 @@ and u_ModuleInfo st = and u_LazyModuleInfo st = u_lazy u_ModuleInfo st +let u_CcuOptimizationInfo st = u_LazyModuleInfo st diff --git a/src/fsharp/opt.fsi b/src/fsharp/Optimizer.fsi similarity index 54% rename from src/fsharp/opt.fsi rename to src/fsharp/Optimizer.fsi index ab33a344e5949e26a032bf68fe47cd27bae16e9f..94f378d9308d8b0c60d19b9ef1a8009055e45d88 100644 --- a/src/fsharp/opt.fsi +++ b/src/fsharp/Optimizer.fsi @@ -1,11 +1,11 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. -module internal Microsoft.FSharp.Compiler.Opt +module internal Microsoft.FSharp.Compiler.Optimizer open Internal.Utilities open Microsoft.FSharp.Compiler -open Microsoft.FSharp.Compiler.Env open Microsoft.FSharp.Compiler.Tast +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.Internal @@ -30,6 +30,8 @@ type OptimizationSettings = /// Optimization information type ModuleInfo type LazyModuleInfo = Lazy +type ImplFileOptimizationInfo = LazyModuleInfo +type CcuOptimizationInfo = LazyModuleInfo #if NO_COMPILER_BACKEND #else @@ -38,22 +40,30 @@ type IncrementalOptimizationEnv = static member Empty : IncrementalOptimizationEnv /// For building optimization environments incrementally -val internal BindCcu : CcuThunk -> LazyModuleInfo -> IncrementalOptimizationEnv -> TcGlobals -> IncrementalOptimizationEnv +val internal BindCcu : CcuThunk -> CcuOptimizationInfo -> IncrementalOptimizationEnv -> TcGlobals -> IncrementalOptimizationEnv -/// The entry point. Boolean indicates 'incremental extension' in FSI -val internal OptimizeImplFile : OptimizationSettings * CcuThunk (* scope *) * Env.TcGlobals * ConstraintSolver.TcValF * Import.ImportMap * IncrementalOptimizationEnv * isIncrementalFragment: bool * emitTaicalls: bool * TypedImplFile -> IncrementalOptimizationEnv * TypedImplFile * LazyModuleInfo +/// Optimize one implementation file in the given environment +val internal OptimizeImplFile : OptimizationSettings * CcuThunk * TcGlobals * ConstraintSolver.TcValF * Import.ImportMap * IncrementalOptimizationEnv * isIncrementalFragment: bool * emitTaicalls: bool * TypedImplFile -> IncrementalOptimizationEnv * TypedImplFile * ImplFileOptimizationInfo +#if DEBUG /// Displaying optimization data val internal moduleInfoL : TcGlobals -> LazyModuleInfo -> Layout.layout +#endif /// Saving and re-reading optimization information -val p_LazyModuleInfo : LazyModuleInfo -> Pickle.WriterState -> unit +val p_CcuOptimizationInfo : CcuOptimizationInfo -> TastPickle.WriterState -> unit /// Rewrite the modul info using the export remapping -val RemapLazyModulInfo : Env.TcGlobals -> Tastops.Remap -> (LazyModuleInfo -> LazyModuleInfo) -val AbstractLazyModulInfoToEssentials : (LazyModuleInfo -> LazyModuleInfo) -val UnionModuleInfos: seq -> LazyModuleInfo -val ExprHasEffect: Env.TcGlobals -> Expr -> bool +val RemapOptimizationInfo : TcGlobals -> Tastops.Remap -> (CcuOptimizationInfo -> CcuOptimizationInfo) + +/// Ensure that 'internal' items are not exported in the optimization info +val AbstractOptimizationInfoToEssentials : (CcuOptimizationInfo -> CcuOptimizationInfo) + +/// Combine optimization infos +val UnionOptimizationInfos: seq -> CcuOptimizationInfo + +/// Check if an expression has an effect +val ExprHasEffect: TcGlobals -> Expr -> bool #endif -val internal u_LazyModuleInfo : Pickle.ReaderState -> LazyModuleInfo +val internal u_CcuOptimizationInfo : TastPickle.ReaderState -> CcuOptimizationInfo diff --git a/src/fsharp/patcompile.fs b/src/fsharp/PatternMatchCompilation.fs similarity index 99% rename from src/fsharp/patcompile.fs rename to src/fsharp/PatternMatchCompilation.fs index 3b18175425f91747ae9f4e8678192352c0f8fcc5..d44033ad8d3045c6b296747e70b74d4ff07c79b0 100644 --- a/src/fsharp/patcompile.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. -module internal Microsoft.FSharp.Compiler.Patcompile +module internal Microsoft.FSharp.Compiler.PatternMatchCompilation open System.Collections.Generic open Internal.Utilities @@ -17,8 +17,8 @@ open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.Infos open Microsoft.FSharp.Compiler.Tastops.DebugPrint open Microsoft.FSharp.Compiler.PrettyNaming -open Microsoft.FSharp.Compiler.Typrelns -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TypeRelations +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.Lib exception MatchIncomplete of bool * (string * bool) option * range @@ -112,11 +112,11 @@ let BindSubExprOfInput g amap gtps (PBind(v,tyscheme)) m (SubExpr(accessf,(ve2,v mkTyparTy gtp else someSolved := true - Typrelns.ChooseTyparSolution g amap gtp + TypeRelations.ChooseTyparSolution g amap gtp let solutions = List.map freezeVar gtps if !someSolved then - Typrelns.IterativelySubstituteTyparSolutions g gtps solutions + TypeRelations.IterativelySubstituteTyparSolutions g gtps solutions else solutions diff --git a/src/fsharp/patcompile.fsi b/src/fsharp/PatternMatchCompilation.fsi similarity index 94% rename from src/fsharp/patcompile.fsi rename to src/fsharp/PatternMatchCompilation.fsi index cb82196756b1e91ec88fc55b4f144a8b051b810b..169b7201113ba8d8c9991ad9e704319c42de4fe2 100644 --- a/src/fsharp/patcompile.fsi +++ b/src/fsharp/PatternMatchCompilation.fsi @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. -module internal Microsoft.FSharp.Compiler.Patcompile +module internal Microsoft.FSharp.Compiler.PatternMatchCompilation open Internal.Utilities open Microsoft.FSharp.Compiler @@ -8,6 +8,7 @@ open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.Range @@ -47,8 +48,8 @@ and TypedMatchClause = /// Compile a pattern into a decision tree and a set of targets. val internal CompilePattern : - Env.TcGlobals -> - Tastops.DisplayEnv -> + TcGlobals -> + DisplayEnv -> Import.ImportMap -> // range of the expression we are matching on range -> diff --git a/src/fsharp/check.fs b/src/fsharp/PostInferenceChecks.fs similarity index 99% rename from src/fsharp/check.fs rename to src/fsharp/PostInferenceChecks.fs index 02aece18860d8b4d2068517186b9e1a7445440b9..47ec79b1b537bc034a646e4748ed0e83673d7e21 100644 --- a/src/fsharp/check.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -1,26 +1,28 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. -module internal Microsoft.FSharp.Compiler.PostTypecheckSemanticChecks +/// Implements a set of checks on the TAST for a file that can only be performed after type inference +/// is complete. +module internal Microsoft.FSharp.Compiler.PostTypeCheckSemanticChecks open System.Collections.Generic open Internal.Utilities + +open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library -open Microsoft.FSharp.Compiler - open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.Layout open Microsoft.FSharp.Compiler.AbstractIL.IL -open Microsoft.FSharp.Compiler.Typrelns +open Microsoft.FSharp.Compiler.TypeRelations open Microsoft.FSharp.Compiler.Infos open Microsoft.FSharp.Compiler.PrettyNaming @@ -31,11 +33,11 @@ open Microsoft.FSharp.Compiler.PrettyNaming //-------------------------------------------------------------------------- let testFlagMemberBody = ref false -let testHookMemberBody membInfo (expr:Expr) = +let testHookMemberBody (membInfo: ValMemberInfo) (expr:Expr) = if !testFlagMemberBody then let m = expr.Range printf "TestMemberBody,%A,%s,%d,%d,%d,%d\n" - (membInfo.MemberFlags.MemberKind) + membInfo.MemberFlags.MemberKind m.FileName m.StartLine m.StartColumn @@ -187,7 +189,7 @@ let BindVals cenv vs = List.iter (BindVal cenv) vs let rec CheckTypeDeep ((visitTyp,visitTyconRef,visitByrefsOfByrefs,visitTraitSolution) as f) typ = // We iterate the _solved_ constraints as well, to pick up any record of trait constraint solutions // This means we walk _all_ the constraints _everywhere_ in a type, including - // those attached to _solved_ type variables. This is used by PostTypecheckSemanticChecks to detect uses of + // those attached to _solved_ type variables. This is used by PostTypeCheckSemanticChecks to detect uses of // values as solutions to trait constraints and determine if inference has caused the value to escape its scope. // The only record of these solutions is in the _solved_ constraints of types. // In an ideal world we would, instead, record the solutions to these constraints as "witness variables" in expressions, @@ -733,7 +735,7 @@ and CheckExprOp cenv env (op,tyargs,args,m) context = CheckTypeInstNoByrefs cenv m tyargs; CheckExprs cenv env args -and CheckLambdas memInfo cenv env inlined topValInfo alwaysCheckNoReraise e m ety = +and CheckLambdas (memInfo: ValMemberInfo option) cenv env inlined topValInfo alwaysCheckNoReraise e m ety = // The topValInfo here says we are _guaranteeing_ to compile a function value // as a .NET method with precisely the corresponding argument counts. match e with @@ -1163,7 +1165,7 @@ let CheckRecdField isUnion cenv env (tycon:Tycon) (rfield:RecdField) = let isHidden = IsHiddenTycon env.sigToImplRemapInfo tycon || IsHiddenTyconRepr env.sigToImplRemapInfo tycon || - (not isUnion && IsHiddenRecdField env.sigToImplRemapInfo (mkNestedRecdFieldRef (mkLocalTyconRef tycon) rfield)) + (not isUnion && IsHiddenRecdField env.sigToImplRemapInfo ((mkLocalTyconRef tycon).MakeNestedRecdFieldRef rfield)) let access = AdjustAccess isHidden (fun () -> tycon.CompilationPath) rfield.Accessibility CheckTypeForAccess cenv (fun () -> rfield.Name) access rfield.Range rfield.FormalType; CheckTypePermitByrefs cenv rfield.Range rfield.FormalType; diff --git a/src/fsharp/PostInferenceChecks.fsi b/src/fsharp/PostInferenceChecks.fsi new file mode 100644 index 0000000000000000000000000000000000000000..b2665479fc04cb96c463ed07d05de2ff48bd36e6 --- /dev/null +++ b/src/fsharp/PostInferenceChecks.fsi @@ -0,0 +1,11 @@ +// Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +/// Implements a set of checks on the TAST for a file that can only be performed after type inference +/// is complete. +module internal Microsoft.FSharp.Compiler.PostTypeCheckSemanticChecks + +open Microsoft.FSharp.Compiler +open Microsoft.FSharp.Compiler.TcGlobals + +val testFlagMemberBody : bool ref +val CheckTopImpl : TcGlobals * Import.ImportMap * bool * Infos.InfoReader * Tast.CompilationPath list * Tast.CcuThunk * Tastops.DisplayEnv * Tast.ModuleOrNamespaceExprWithSig * Tast.Attribs * bool -> bool diff --git a/src/fsharp/sreflect.fs b/src/fsharp/QuotationPickler.fs similarity index 100% rename from src/fsharp/sreflect.fs rename to src/fsharp/QuotationPickler.fs diff --git a/src/fsharp/sreflect.fsi b/src/fsharp/QuotationPickler.fsi similarity index 100% rename from src/fsharp/sreflect.fsi rename to src/fsharp/QuotationPickler.fsi diff --git a/src/fsharp/creflect.fs b/src/fsharp/QuotationTranslator.fs similarity index 99% rename from src/fsharp/creflect.fs rename to src/fsharp/QuotationTranslator.fs index 1785af219ed29b7aef61ae7772ae0688c00096a6..565eb2b65f0b746d25a0bee40f1341b6bb2e257d 100644 --- a/src/fsharp/creflect.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -15,8 +15,8 @@ open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.PrettyNaming open Microsoft.FSharp.Compiler.ErrorLogger -open Microsoft.FSharp.Compiler.Env -open Microsoft.FSharp.Compiler.Typrelns +open Microsoft.FSharp.Compiler.TcGlobals +open Microsoft.FSharp.Compiler.TypeRelations open Microsoft.FSharp.Compiler.Range open System.Collections.Generic @@ -38,7 +38,7 @@ type QuotationSerializationFormat = | FSharp_20_Plus type QuotationGenerationScope = - { g: Env.TcGlobals; + { g: TcGlobals; amap: Import.ImportMap; scope: CcuThunk; // Accumulate the references to type definitions @@ -405,7 +405,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. QP.mkDelegate(tyargR, fR) | Expr.StaticOptimization (_,_,x,_) -> ConvExpr cenv env x - | Expr.TyChoose _ -> ConvExpr cenv env (Typrelns.ChooseTyparSolutionsForFreeChoiceTypars cenv.g cenv.amap expr) + | Expr.TyChoose _ -> ConvExpr cenv env (TypeRelations.ChooseTyparSolutionsForFreeChoiceTypars cenv.g cenv.amap expr) | Expr.Sequential (x0,x1,ThenDoSeq,_,_) -> QP.mkSequential(ConvExpr cenv env x0, ConvExpr cenv env x1) | Expr.Obj (_lambdaId,_typ,_basev,_basecall,_overrides,_iimpls,m) -> wfail(Error(FSComp.SR.crefQuotationsCantContainObjExprs(),m)) diff --git a/src/fsharp/creflect.fsi b/src/fsharp/QuotationTranslator.fsi similarity index 83% rename from src/fsharp/creflect.fsi rename to src/fsharp/QuotationTranslator.fsi index 616bb00611988b2e9862bb419006b0d7d856ae09..74acfe49b4613aed18cdb657f81a36415fd6dc4f 100644 --- a/src/fsharp/creflect.fsi +++ b/src/fsharp/QuotationTranslator.fsi @@ -6,7 +6,9 @@ module internal Microsoft.FSharp.Compiler.QuotationTranslator open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.Range +open Microsoft.FSharp.Compiler.Import open Microsoft.FSharp.Compiler.Tast +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.AbstractIL.IL @@ -31,9 +33,9 @@ type QuotationSerializationFormat = [] type QuotationGenerationScope = - static member Create: Env.TcGlobals * Import.ImportMap * CcuThunk * IsReflectedDefinition -> QuotationGenerationScope + static member Create: TcGlobals * ImportMap * CcuThunk * IsReflectedDefinition -> QuotationGenerationScope member Close: unit -> ILTypeRef list * (TType * range) list * (Expr * range) list - static member ComputeQuotationFormat : Env.TcGlobals -> QuotationSerializationFormat + static member ComputeQuotationFormat : TcGlobals -> QuotationSerializationFormat val ConvExprPublic : QuotationGenerationScope -> QuotationTranslationEnv -> Expr -> QuotationPickler.ExprData val ConvMethodBase : QuotationGenerationScope -> QuotationTranslationEnv -> string * Val -> QuotationPickler.MethodBaseData diff --git a/src/fsharp/tastops.fs b/src/fsharp/TastOps.fs similarity index 99% rename from src/fsharp/tastops.fs rename to src/fsharp/TastOps.fs index 8004bade597eb81ba18c82629a40c2678b53b82e..7d0da7308b76d32058572865fe51216ecc700fa4 100644 --- a/src/fsharp/tastops.fs +++ b/src/fsharp/TastOps.fs @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. -/// Derived expression manipulation and construction functions. +/// Defines derived expression manipulation and construction functions. module internal Microsoft.FSharp.Compiler.Tastops #nowarn "44" // This construct is deprecated. please use List.item @@ -20,7 +20,7 @@ open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Microsoft.FSharp.Compiler.Lib -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.Layout open Microsoft.FSharp.Compiler.PrettyNaming #if EXTENSIONTYPING @@ -2817,9 +2817,6 @@ module DebugPrint = begin stat let stampL _n w = -#if DEBUG - if !verboseStamps then w ^^ sepL "#" ^^ int64L _n else -#endif w let layoutTyconRef (tc:TyconRef) = wordL tc.DisplayNameWithStaticParameters |> stampL tc.Stamp @@ -3018,11 +3015,6 @@ module DebugPrint = begin let valL (vspec:Val) = let vsL = wordL (DecompileOpName vspec.LogicalName) |> stampL vspec.Stamp - let vsL = -#if DEBUG - if !verboseStamps then vsL ^^ rightL (if isSome(vspec.PublicPath) then "+" else "-") else -#endif - vsL let vsL = vsL -- layoutAttribs (vspec.Attribs) vsL @@ -3131,7 +3123,7 @@ module DebugPrint = begin let layoutUnionCaseArgTypes argtys = sepListL (wordL "*") (List.map typeL argtys) - let ucaseL prefixL ucase = + let ucaseL prefixL (ucase: UnionCase) = let nmL = wordL (DemangleOperatorName ucase.Id.idText) match ucase.RecdFields |> List.map (fun rfld -> rfld.FormalType) with | [] -> (prefixL ^^ nmL) @@ -3229,17 +3221,6 @@ module DebugPrint = begin | Expr.Val (v,flags,_) -> let xL = valL v.Deref let xL = -#if DEBUG - if !verboseStamps then - let tag = - match v with - | VRefLocal _ -> "" - | VRefNonLocal _ -> "!!" - xL ^^ rightL tag - else -#endif - xL - let xL = match flags with | PossibleConstrainedCall _ -> xL ^^ rightL "" | CtorValUsedAsSelfInit -> xL ^^ rightL "" @@ -3528,7 +3509,7 @@ let accEntityRemap (msigty:ModuleOrNamespaceType) (entity:Entity) (mrpi,mhi) = mhi | _ -> // The field is not in the signature. Hence it is regarded as hidden. - let rfref = mkNestedRecdFieldRef tcref rfield + let rfref = tcref.MakeNestedRecdFieldRef rfield { mhi with mhiRecdFields = Zset.add rfref mhi.mhiRecdFields }) entity.AllFieldsArray |> List.foldBack (fun (ucase:UnionCase) mhi -> @@ -3538,7 +3519,7 @@ let accEntityRemap (msigty:ModuleOrNamespaceType) (entity:Entity) (mrpi,mhi) = mhi | _ -> // The constructor is not in the signature. Hence it is regarded as hidden. - let ucref = mkNestedUnionCaseRef tcref ucase + let ucref = tcref.MakeNestedUnionCaseRef ucase { mhi with mhiUnionCases = Zset.add ucref mhi.mhiUnionCases }) (entity.UnionCasesAsList) (mrpi,mhi) @@ -3575,10 +3556,6 @@ let accValRemap g aenv (msigty:ModuleOrNamespaceType) (implVal:Val) (mrpi,mhi) = (mrpi,mhi) | Some (sigVal:Val) -> // The value is in the signature. Add the repackage entry. -#if DEBUG - if !verboseStamps then dprintf "accValRemap, remap value %s#%d --> %s#%d\n" implVal.LogicalName implVal.Stamp sigVal.LogicalName sigVal.Stamp; -#endif - let mrpi = { mrpi with mrpiVals = (vref,mkLocalValRef sigVal) :: mrpi.mrpiVals } (mrpi,mhi) @@ -3677,7 +3654,7 @@ let accTyconHidingInfoAtAssemblyBoundary (tycon:Tycon) mhi = (fun (rfield:RecdField) mhi -> if not (canAccessFromEverywhere rfield.Accessibility) then let tcref = mkLocalTyconRef tycon - let rfref = mkNestedRecdFieldRef tcref rfield + let rfref = tcref.MakeNestedRecdFieldRef rfield { mhi with mhiRecdFields = Zset.add rfref mhi.mhiRecdFields } else mhi) tycon.AllFieldsArray @@ -3685,7 +3662,7 @@ let accTyconHidingInfoAtAssemblyBoundary (tycon:Tycon) mhi = (fun (ucase:UnionCase) mhi -> if not (canAccessFromEverywhere ucase.Accessibility) then let tcref = mkLocalTyconRef tycon - let ucref = mkNestedUnionCaseRef tcref ucase + let ucref = tcref.MakeNestedUnionCaseRef ucase { mhi with mhiUnionCases = Zset.add ucref mhi.mhiUnionCases } else mhi) (tycon.UnionCasesAsList) @@ -4456,9 +4433,6 @@ and remapValReprInfo g tmenv (ValReprInfo(tpNames,arginfosl,retInfo)) = ValReprInfo(tpNames,List.mapSquared (remapArgData g tmenv) arginfosl, remapArgData g tmenv retInfo) and remapValData g tmenv d = -#if DEBUG - if !verboseStamps then dprintf "remap val data #%d\n" d.val_stamp; -#endif let ty = d.val_type let topValInfo = d.val_repr_info let ty' = ty |> remapPossibleForallTy g tmenv @@ -4702,7 +4676,7 @@ and remapRecdField g tmenv x = rfield_fattribs = x.rfield_fattribs |> remapAttribs g tmenv; } and remapRecdFields g tmenv (x:TyconRecdFields) = x.AllFieldsAsList |> List.map (remapRecdField g tmenv) |> MakeRecdFieldsTable -and remapUnionCase g tmenv x = +and remapUnionCase g tmenv (x:UnionCase) = { x with FieldTable = x.FieldTable |> remapRecdFields g tmenv; ReturnType = x.ReturnType |> remapType tmenv; @@ -4809,13 +4783,6 @@ and copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs = // Values need to be copied and renamed. let vs',tmenvinner = copyAndRemapAndBindVals g compgen tmenvinner vs -#if DEBUG - if !verboseStamps then - for tycon in tycons do - dprintf "copyAndRemapAndBindTyconsAndVals: tycon %s#%d\n" tycon.LogicalName tycon.Stamp; - for v in vs do - dprintf "copyAndRemapAndBindTyconsAndVals: val %s#%d\n" v.LogicalName v.Stamp; -#endif // "if a type constructor is hidden then all its inner values and inner type constructors must also be hidden" // Hence we can just lookup the inner tycon/value mappings in the tables. @@ -4824,10 +4791,6 @@ and copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs = let vref = try let res = tmenvinner.valRemap.[v] -#if DEBUG - if !verboseStamps then - dprintf "remaped internal value %s#%d --> %s#%d\n" v.LogicalName v.Stamp res.LogicalName res.Stamp; -#endif res with :? KeyNotFoundException -> errorR(InternalError(sprintf "couldn't remap internal value '%s'" v.LogicalName,v.Range)); @@ -4838,10 +4801,6 @@ and copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs = let tcref = try let res = tmenvinner.tyconRefRemap.[mkLocalTyconRef tycon] -#if DEBUG - if !verboseStamps then - dprintf "remaped internal tycon %s#%d --> %s#%d\n" tycon.LogicalName tycon.Stamp res.LogicalName res.Stamp; -#endif res with :? KeyNotFoundException -> errorR(InternalError("couldn't remap internal tycon "^showL(DebugPrint.tyconL tycon),tycon.Range)); @@ -5024,7 +4983,7 @@ and remarkBind m (TBind(v,repr,_)) = //-------------------------------------------------------------------------- let isRecdOrStructFieldAllocObservable (f:RecdField) = not f.IsStatic && f.IsMutable -let ucaseAllocObservable uc = uc.FieldTable.FieldsByIndex |> Array.exists isRecdOrStructFieldAllocObservable +let ucaseAllocObservable (uc:UnionCase) = uc.FieldTable.FieldsByIndex |> Array.exists isRecdOrStructFieldAllocObservable let isUnionCaseAllocObservable (uc:UnionCaseRef) = uc.UnionCase |> ucaseAllocObservable let isRecdOrUnionOrStructTyconAllocObservable (_g:TcGlobals) (tycon:Tycon) = @@ -7072,7 +7031,7 @@ let ModuleNameIsMangled g attrs = let CompileAsEvent g attrs = HasFSharpAttribute g g.attrib_CLIEventAttribute attrs -let MemberIsCompiledAsInstance g parent isExtensionMember membInfo attrs = +let MemberIsCompiledAsInstance g parent isExtensionMember (membInfo:ValMemberInfo) attrs = // All extension members are compiled as static members if isExtensionMember then false // Anything implementing a dispatch slot is compiled as an instance member @@ -7416,9 +7375,6 @@ let MakeExportRemapping viewedCcu (mspec:ModuleOrNamespace) = let accEntityRemap (entity:Entity) acc = match tryRescopeEntity viewedCcu entity with | Some eref -> -#if DEBUG - if !verboseStamps then dprintf "adding export remapping for entity %s#%d\n" entity.LogicalName entity.Stamp; -#endif addTyconRefRemap (mkLocalTyconRef entity) eref acc | None -> if entity.IsNamespace then @@ -7430,9 +7386,6 @@ let MakeExportRemapping viewedCcu (mspec:ModuleOrNamespace) = // The acc contains the entity remappings match tryRescopeVal viewedCcu acc vspec with | Some vref -> -#if DEBUG - if !verboseStamps then dprintf "adding export remapping for value %s#%d\n" vspec.LogicalName vspec.Stamp; -#endif {acc with valRemap=acc.valRemap.Add vspec vref } | None -> error(InternalError("Unexpected value without a pubpath when remapping assembly data",vspec.Range)) @@ -7601,7 +7554,7 @@ let EvalArithBinOp (opInt8, opInt16, opInt32, opInt64, opUInt8, opUInt16, opUInt | _ -> error (Error ( FSComp.SR.tastNotAConstantExpression(),m)) with :? System.OverflowException -> error (Error ( FSComp.SR.tastConstantExpressionOverflow(),m)) -// See also PostTypecheckSemanticChecks.CheckAttribArgExpr, which must match this precisely +// See also PostTypeCheckSemanticChecks.CheckAttribArgExpr, which must match this precisely let rec EvalAttribArgExpr g x = match x with diff --git a/src/fsharp/tastops.fsi b/src/fsharp/TastOps.fsi similarity index 96% rename from src/fsharp/tastops.fsi rename to src/fsharp/TastOps.fsi index 447f9f1fe418596862317c805853a2ab1264351e..a522c743ef1d61b166af12a521b5dcc8f8ae5bce 100644 --- a/src/fsharp/tastops.fsi +++ b/src/fsharp/TastOps.fsi @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. -/// Derived expression manipulation and construction functions. +/// Defines derived expression manipulation and construction functions. module internal Microsoft.FSharp.Compiler.Tastops open System.Text @@ -15,7 +15,7 @@ open Microsoft.FSharp.Compiler.Rational open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.Tast -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.Layout open Microsoft.FSharp.Compiler.Lib @@ -1195,30 +1195,30 @@ val mkLdelem : TcGlobals -> range -> TType -> Expr -> Expr -> Expr //------------------------------------------------------------------------- val TryDecodeILAttribute : TcGlobals -> ILTypeRef -> ILScopeRef option -> ILAttributes -> (ILAttribElem list * ILAttributeNamedArg list) option -val TryFindILAttribute : Env.BuiltinAttribInfo -> ILAttributes -> bool -val TryFindILAttributeOpt : Env.BuiltinAttribInfo option -> ILAttributes -> bool - -val IsMatchingFSharpAttribute : TcGlobals -> Env.BuiltinAttribInfo -> Attrib -> bool -val IsMatchingFSharpAttributeOpt : TcGlobals -> Env.BuiltinAttribInfo option -> Attrib -> bool -val HasFSharpAttribute : TcGlobals -> Env.BuiltinAttribInfo -> Attribs -> bool -val HasFSharpAttributeOpt : TcGlobals -> Env.BuiltinAttribInfo option -> Attribs -> bool -val TryFindFSharpAttribute : TcGlobals -> Env.BuiltinAttribInfo -> Attribs -> Attrib option -val TryFindFSharpAttributeOpt : TcGlobals -> Env.BuiltinAttribInfo option -> Attribs -> Attrib option -val TryFindFSharpBoolAttribute : TcGlobals -> Env.BuiltinAttribInfo -> Attribs -> bool option -val TryFindFSharpBoolAttributeAssumeFalse : TcGlobals -> Env.BuiltinAttribInfo -> Attribs -> bool option -val TryFindFSharpStringAttribute : TcGlobals -> Env.BuiltinAttribInfo -> Attribs -> string option -val TryFindFSharpInt32Attribute : TcGlobals -> Env.BuiltinAttribInfo -> Attribs -> int32 option +val TryFindILAttribute : BuiltinAttribInfo -> ILAttributes -> bool +val TryFindILAttributeOpt : BuiltinAttribInfo option -> ILAttributes -> bool + +val IsMatchingFSharpAttribute : TcGlobals -> BuiltinAttribInfo -> Attrib -> bool +val IsMatchingFSharpAttributeOpt : TcGlobals -> BuiltinAttribInfo option -> Attrib -> bool +val HasFSharpAttribute : TcGlobals -> BuiltinAttribInfo -> Attribs -> bool +val HasFSharpAttributeOpt : TcGlobals -> BuiltinAttribInfo option -> Attribs -> bool +val TryFindFSharpAttribute : TcGlobals -> BuiltinAttribInfo -> Attribs -> Attrib option +val TryFindFSharpAttributeOpt : TcGlobals -> BuiltinAttribInfo option -> Attribs -> Attrib option +val TryFindFSharpBoolAttribute : TcGlobals -> BuiltinAttribInfo -> Attribs -> bool option +val TryFindFSharpBoolAttributeAssumeFalse : TcGlobals -> BuiltinAttribInfo -> Attribs -> bool option +val TryFindFSharpStringAttribute : TcGlobals -> BuiltinAttribInfo -> Attribs -> string option +val TryFindFSharpInt32Attribute : TcGlobals -> BuiltinAttribInfo -> Attribs -> int32 option /// Try to find a specific attribute on a type definition, where the attribute accepts a string argument. /// /// This is used to detect the 'DefaultMemberAttribute' and 'ConditionalAttribute' attributes (on type definitions) -val TryFindTyconRefStringAttribute : TcGlobals -> range -> Env.BuiltinAttribInfo -> TyconRef -> string option +val TryFindTyconRefStringAttribute : TcGlobals -> range -> BuiltinAttribInfo -> TyconRef -> string option /// Try to find a specific attribute on a type definition, where the attribute accepts a bool argument. -val TryFindTyconRefBoolAttribute : TcGlobals -> range -> Env.BuiltinAttribInfo -> TyconRef -> bool option +val TryFindTyconRefBoolAttribute : TcGlobals -> range -> BuiltinAttribInfo -> TyconRef -> bool option /// Try to find a specific attribute on a type definition -val TyconRefHasAttribute : TcGlobals -> range -> Env.BuiltinAttribInfo -> TyconRef -> bool +val TyconRefHasAttribute : TcGlobals -> range -> BuiltinAttribInfo -> TyconRef -> bool /// Try to find the AttributeUsage attribute, looking for the value of the AllowMultiple named parameter val TryFindAttributeUsageAttribute : TcGlobals -> range -> TyconRef -> bool option @@ -1298,14 +1298,14 @@ type StaticOptimizationAnswer = | Yes = 1y | No = -1y | Unknown = 0y -val DecideStaticOptimizations : Env.TcGlobals -> StaticOptimization list -> StaticOptimizationAnswer -val mkStaticOptimizationExpr : Env.TcGlobals -> StaticOptimization list * Expr * Expr * range -> Expr +val DecideStaticOptimizations : TcGlobals -> StaticOptimization list -> StaticOptimizationAnswer +val mkStaticOptimizationExpr : TcGlobals -> StaticOptimization list * Expr * Expr * range -> Expr //--------------------------------------------------------------------------- // Build for loops //------------------------------------------------------------------------- -val mkFastForLoop : Env.TcGlobals -> SequencePointInfoForForLoop * range * Val * Expr * bool * Expr * Expr -> Expr +val mkFastForLoop : TcGlobals -> SequencePointInfoForForLoop * range * Val * Expr * bool * Expr * Expr -> Expr //--------------------------------------------------------------------------- // Active pattern helpers @@ -1315,16 +1315,16 @@ type ActivePatternElemRef with member Name : string val TryGetActivePatternInfo : ValRef -> PrettyNaming.ActivePatternInfo option -val mkChoiceCaseRef : Env.TcGlobals -> range -> int -> int -> UnionCaseRef +val mkChoiceCaseRef : TcGlobals -> range -> int -> int -> UnionCaseRef type PrettyNaming.ActivePatternInfo with member Names : string list member IsTotal: bool - member ResultType : Env.TcGlobals -> range -> TType list -> TType - member OverallType : Env.TcGlobals -> range -> TType -> TType list -> TType + member ResultType : TcGlobals -> range -> TType list -> TType + member OverallType : TcGlobals -> range -> TType -> TType list -> TType -val doesActivePatternHaveFreeTypars : Env.TcGlobals -> ValRef -> bool +val doesActivePatternHaveFreeTypars : TcGlobals -> ValRef -> bool //--------------------------------------------------------------------------- // Structural rewrites diff --git a/src/fsharp/pickle.fs b/src/fsharp/TastPickle.fs similarity index 99% rename from src/fsharp/pickle.fs rename to src/fsharp/TastPickle.fs index 730da22cff831c090489a54443664be22d3c7cac..3d37b36b46b37166090debf98e070c704564bc0a 100644 --- a/src/fsharp/pickle.fs +++ b/src/fsharp/TastPickle.fs @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. -module internal Microsoft.FSharp.Compiler.Pickle +module internal Microsoft.FSharp.Compiler.TastPickle open System.Collections.Generic open System.Text @@ -19,6 +19,7 @@ open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.Rational open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.Tast +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.ErrorLogger @@ -121,7 +122,7 @@ type WriterState = opubpaths: Table; onlerefs: Table; osimpletyps: Table; - oglobals : Env.TcGlobals; + oglobals : TcGlobals; ofile : string; } let pfailwith st str = ffailwith st.ofile str @@ -1270,10 +1271,12 @@ let p_typs = (p_list p_typ) let fill_p_attribs,p_attribs = p_hole() -let p_nonlocal_val_ref {EnclosingEntity=a;ItemKey= key } st = +let p_nonlocal_val_ref (nlv:NonLocalValOrMemberRef) st = + let a = nlv.EnclosingEntity + let key = nlv.ItemKey let pkey = key.PartialKey - p_tcref "nlvref" a st; - p_option p_string pkey.MemberParentMangledName st; + p_tcref "nlvref" a st + p_option p_string pkey.MemberParentMangledName st p_bool pkey.MemberIsOverride st; p_string pkey.LogicalName st; p_int pkey.TotalArgCount st; @@ -1291,14 +1294,15 @@ let fill_u_typ,u_typ = u_hole() let u_typs = (u_list u_typ) let fill_u_attribs,u_attribs = u_hole() -let u_nonlocal_val_ref st = +let u_nonlocal_val_ref st : NonLocalValOrMemberRef = let a = u_tcref st let b1 = u_option u_string st let b2 = u_bool st let b3 = u_string st let c = u_int st let d = u_option u_typ st - {EnclosingEntity = a; ItemKey=ValLinkageFullKey({ MemberParentMangledName=b1; MemberIsOverride=b2;LogicalName=b3; TotalArgCount=c }, d) } + { EnclosingEntity = a + ItemKey=ValLinkageFullKey({ MemberParentMangledName=b1; MemberIsOverride=b2;LogicalName=b3; TotalArgCount=c }, d) } let u_vref st = let tag = u_byte st @@ -1783,7 +1787,7 @@ and p_attrib_expr (AttribExpr(e1,e2)) st = and p_attrib_arg (AttribNamedArg(a,b,c,d)) st = p_tup4 p_string p_typ p_bool p_attrib_expr (a,b,c,d) st -and p_member_info x st = +and p_member_info (x:ValMemberInfo) st = p_tup4 (p_tcref "member_info") p_MemberFlags (p_list p_slotsig) p_bool (x.ApparentParent,x.MemberFlags,x.ImplementedSlotSigs,x.IsImplemented) st @@ -2064,7 +2068,7 @@ and u_attrib_arg st = let a,b,c,d = u_tup4 u_string u_typ u_bool u_attrib_expr st AttribNamedArg(a,b,c,d) -and u_member_info st = +and u_member_info st : ValMemberInfo = let x2,x3,x4,x5 = u_tup4 u_tcref u_MemberFlags (u_list u_slotsig) u_bool st { ApparentParent=x2; MemberFlags=x3; @@ -2524,12 +2528,12 @@ let _ = fill_u_FlatVals (u_FlatList u_Val) #if INCLUDE_METADATA_WRITER let pickleModuleOrNamespace mspec st = p_tycon_spec mspec st -let pickleModuleInfo minfo st = +let pickleCcuInfo minfo st = p_tup4 pickleModuleOrNamespace p_string p_bool (p_space 3) (minfo.mspec, minfo.compileTimeWorkingDir, minfo.usesQuotations,()) st #endif let unpickleModuleOrNamespace st = u_tycon_spec st -let unpickleModuleInfo st = +let unpickleCcuInfo st = let a,b,c,_space = u_tup4 unpickleModuleOrNamespace u_string u_bool (u_space 3) st { mspec=a; compileTimeWorkingDir=b; usesQuotations=c } diff --git a/src/fsharp/TastPickle.fsi b/src/fsharp/TastPickle.fsi new file mode 100644 index 0000000000000000000000000000000000000000..b70f2bd493bfc15e0fb4ea0df28f480ee7ed6bed --- /dev/null +++ b/src/fsharp/TastPickle.fsi @@ -0,0 +1,151 @@ +// Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +/// Defines the framework for serializing and de-serializing TAST data structures as binary blobs for the F# metadata format. +module internal Microsoft.FSharp.Compiler.TastPickle + +open Internal.Utilities +open Microsoft.FSharp.Compiler +open Microsoft.FSharp.Compiler.AbstractIL +open Microsoft.FSharp.Compiler.AbstractIL.IL +open Microsoft.FSharp.Compiler.AbstractIL.Internal +open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library +open Microsoft.FSharp.Compiler.Tast +open Microsoft.FSharp.Compiler.TcGlobals + +/// Represents desereialized data with a dangling set of CCU fixup thunks indexed by name +[] +type PickledDataWithReferences<'RawData> = + { /// The data that uses a collection of CcuThunks internally + RawData: 'RawData; + /// The assumptions that need to be fixed up + FixupThunks: list } + + member Fixup : (CcuReference -> CcuThunk) -> 'RawData + /// Like Fixup but loader may return None, in which case there is no fixup. + member OptionalFixup: (CcuReference -> CcuThunk option) -> 'RawData + +#if INCLUDE_METADATA_WRITER +/// The type of state written to by picklers +type WriterState + +/// A function to pickle a value into a given stateful writer +type pickler<'T> = 'T -> WriterState -> unit + +/// Serialize a byte +val internal p_byte : int -> WriterState -> unit + +/// Serialize a boolean value +val internal p_bool : bool -> WriterState -> unit + +/// Serialize an integer +val internal p_int : int -> WriterState -> unit + +/// Serialize a string +val internal p_string : string -> WriterState -> unit + +/// Serialize a lazy value (eagerly) +val internal p_lazy : pickler<'T> -> Lazy<'T> pickler + +/// Serialize a tuple of data +val inline internal p_tup2 : pickler<'T1> -> pickler<'T2> -> pickler<'T1 * 'T2> + +/// Serialize a tuple of data +val inline internal p_tup3 : pickler<'T1> -> pickler<'T2> -> pickler<'T3> -> pickler<'T1 * 'T2 * 'T3> + +/// Serialize a tuple of data +val inline internal p_tup4 : pickler<'T1> -> pickler<'T2> -> pickler<'T3> -> pickler<'T4> -> pickler<'T1 * 'T2 * 'T3 * 'T4> + +/// Serialize an array of data +val internal p_array : pickler<'T> -> pickler<'T[]> + +/// Serialize a namemap of data +val internal p_namemap : pickler<'T> -> pickler> + +/// Serialize a TAST constant +val internal p_const : pickler + +/// Serialize a TAST value reference +val internal p_vref : string -> pickler + +/// Serialize a TAST type or entity reference +val internal p_tcref : string -> pickler + +/// Serialize a TAST union case reference +val internal p_ucref : pickler + +/// Serialize a TAST expresion +val internal p_expr : pickler + +/// Serialize a TAST type +val internal p_typ : pickler + +/// Serialize a TAST description of a compilation unit +val internal pickleCcuInfo : pickler + +/// Serialize an arbitrary object using the given pickler +val pickleObjWithDanglingCcus : string -> TcGlobals -> scope:CcuThunk -> pickler<'T> -> 'T -> byte[] +#else +#endif + +/// The type of state unpicklers read from +type ReaderState + +/// A function to read a value from a given state +type unpickler<'T> = ReaderState -> 'T + +/// Deserialize a byte +val internal u_byte : ReaderState -> int + +/// Deserialize a bool +val internal u_bool : ReaderState -> bool + +/// Deserialize an integer +val internal u_int : ReaderState -> int + +/// Deserialize a string +val internal u_string : ReaderState -> string + +/// Deserialize a lazy value (eagerly) +val internal u_lazy : unpickler<'T> -> unpickler> + +/// Deserialize a tuple +val inline internal u_tup2 : unpickler<'T2> -> unpickler<'T3> -> unpickler<'T2 * 'T3> + +/// Deserialize a tuple +val inline internal u_tup3 : unpickler<'T2> -> unpickler<'T3> -> unpickler<'T4> -> unpickler<'T2 * 'T3 * 'T4> + +/// Deserialize a tuple +val inline internal u_tup4 : unpickler<'T2> -> unpickler<'T3> -> unpickler<'T4> -> unpickler<'T5> -> unpickler<'T2 * 'T3 * 'T4 * 'T5> + +/// Deserialize an array of values +val internal u_array : unpickler<'T> -> unpickler<'T[]> + +/// Deserialize a namemap +val internal u_namemap : unpickler<'T> -> unpickler> + +/// Deserialize a TAST constant +val internal u_const : unpickler + +/// Deserialize a TAST value reference +val internal u_vref : unpickler + +/// Deserialize a TAST type reference +val internal u_tcref : unpickler + +/// Deserialize a TAST union case reference +val internal u_ucref : unpickler + +/// Deserialize a TAST expression +val internal u_expr : unpickler + +/// Deserialize a TAST type +val internal u_typ : unpickler + +/// Deserialize a TAST description of a compilation unit +val internal unpickleCcuInfo : ReaderState -> PickledCcuInfo + +/// Deserialize an arbitrary object which may have holes referring to other compilation units +val internal unpickleObjWithDanglingCcus : string -> viewedScope:ILScopeRef -> ilModule:ILModuleDef -> ('T unpickler) -> byte[] -> PickledDataWithReferences<'T> + + + diff --git a/src/fsharp/env.fs b/src/fsharp/TcGlobals.fs similarity index 72% rename from src/fsharp/env.fs rename to src/fsharp/TcGlobals.fs index 940bcf4caab827804856b87f605e87f45ff63a49..6205c82efe6392289bfb5e212ae73a6662d3b92f 100644 --- a/src/fsharp/env.fs +++ b/src/fsharp/TcGlobals.fs @@ -1,15 +1,12 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. -//------------------------------------------------------------------------- -// Define Initial Environment. A bunch of types and values are hard-wired -// into the compiler. This lets the compiler perform particular optimizations -// for these types and values, for example emitting optimized calls for -// comparison and hashing functions. The compiler generates the compiled code -// for these types and values when the the --compiling-fslib switch is -// provided when linking the FSharp.Core.dll assembly. -//------------------------------------------------------------------------- - -module internal Microsoft.FSharp.Compiler.Env +/// Defines the global environment for all type checking. +/// +/// The environment (TcGlobals) are well-known types and values are hard-wired +/// into the compiler. This lets the compiler perform particular optimizations +/// for these types and values, for example emitting optimized calls for +/// comparison and hashing functions. +module internal Microsoft.FSharp.Compiler.TcGlobals #nowarn "44" // This construct is deprecated. please use List.item @@ -120,432 +117,432 @@ type public BuiltinAttribInfo = [] type public TcGlobals = - { ilg : ILGlobals; + { ilg : ILGlobals #if NO_COMPILER_BACKEND #else - ilxPubCloEnv : EraseIlxFuncs.cenv; + ilxPubCloEnv : EraseClosures.cenv #endif emitDebugInfoInQuotations : bool - compilingFslib: bool; - mlCompatibility : bool; - directoryToResolveRelativePaths : string; - fslibCcu: CcuThunk; - sysCcu: CcuThunk; - using40environment: bool; - indirectCallArrayMethods: bool; - better_tcref_map: TyconRef -> TypeInst -> TType option; - refcell_tcr_canon: TyconRef; - option_tcr_canon : TyconRef; - choice2_tcr : TyconRef; - choice3_tcr : TyconRef; - choice4_tcr : TyconRef; - choice5_tcr : TyconRef; - choice6_tcr : TyconRef; - choice7_tcr : TyconRef; - list_tcr_canon : TyconRef; - set_tcr_canon : TyconRef; - map_tcr_canon : TyconRef; - lazy_tcr_canon : TyconRef; + compilingFslib: bool + mlCompatibility : bool + directoryToResolveRelativePaths : string + fslibCcu: CcuThunk + sysCcu: CcuThunk + using40environment: bool + indirectCallArrayMethods: bool + better_tcref_map: TyconRef -> TypeInst -> TType option + refcell_tcr_canon: TyconRef + option_tcr_canon : TyconRef + choice2_tcr : TyconRef + choice3_tcr : TyconRef + choice4_tcr : TyconRef + choice5_tcr : TyconRef + choice6_tcr : TyconRef + choice7_tcr : TyconRef + list_tcr_canon : TyconRef + set_tcr_canon : TyconRef + map_tcr_canon : TyconRef + lazy_tcr_canon : TyconRef // These have a slightly different behaviour when compiling GetFSharpCoreLibraryName // hence they are 'methods' on the TcGlobals structure. - unionCaseRefEq : UnionCaseRef -> UnionCaseRef -> bool; - valRefEq : ValRef -> ValRef -> bool; - - refcell_tcr_nice: TyconRef; - option_tcr_nice : TyconRef; - list_tcr_nice : TyconRef; - lazy_tcr_nice : TyconRef; - - format_tcr : TyconRef; - expr_tcr : TyconRef; - raw_expr_tcr : TyconRef; - nativeint_tcr : TyconRef; - int32_tcr : TyconRef; - int16_tcr : TyconRef; - int64_tcr : TyconRef; - uint16_tcr : TyconRef; - uint32_tcr : TyconRef; - uint64_tcr : TyconRef; - sbyte_tcr : TyconRef; - decimal_tcr : TyconRef; - date_tcr : TyconRef; - pdecimal_tcr : TyconRef; - byte_tcr : TyconRef; - bool_tcr : TyconRef; - unit_tcr_canon : TyconRef; - unit_tcr_nice : TyconRef; - exn_tcr : TyconRef; - char_tcr : TyconRef; - float_tcr : TyconRef; - float32_tcr : TyconRef; - pfloat_tcr : TyconRef; - pfloat32_tcr : TyconRef; - pint_tcr : TyconRef; - pint8_tcr : TyconRef; - pint16_tcr : TyconRef; - pint64_tcr : TyconRef; - byref_tcr : TyconRef; - nativeptr_tcr : TyconRef; - ilsigptr_tcr : TyconRef; - fastFunc_tcr : TyconRef; - array_tcr_nice : TyconRef; - seq_tcr : TyconRef; - seq_base_tcr : TyconRef; + unionCaseRefEq : UnionCaseRef -> UnionCaseRef -> bool + valRefEq : ValRef -> ValRef -> bool + + refcell_tcr_nice: TyconRef + option_tcr_nice : TyconRef + list_tcr_nice : TyconRef + lazy_tcr_nice : TyconRef + + format_tcr : TyconRef + expr_tcr : TyconRef + raw_expr_tcr : TyconRef + nativeint_tcr : TyconRef + int32_tcr : TyconRef + int16_tcr : TyconRef + int64_tcr : TyconRef + uint16_tcr : TyconRef + uint32_tcr : TyconRef + uint64_tcr : TyconRef + sbyte_tcr : TyconRef + decimal_tcr : TyconRef + date_tcr : TyconRef + pdecimal_tcr : TyconRef + byte_tcr : TyconRef + bool_tcr : TyconRef + unit_tcr_canon : TyconRef + unit_tcr_nice : TyconRef + exn_tcr : TyconRef + char_tcr : TyconRef + float_tcr : TyconRef + float32_tcr : TyconRef + pfloat_tcr : TyconRef + pfloat32_tcr : TyconRef + pint_tcr : TyconRef + pint8_tcr : TyconRef + pint16_tcr : TyconRef + pint64_tcr : TyconRef + byref_tcr : TyconRef + nativeptr_tcr : TyconRef + ilsigptr_tcr : TyconRef + fastFunc_tcr : TyconRef + array_tcr_nice : TyconRef + seq_tcr : TyconRef + seq_base_tcr : TyconRef measureproduct_tcr : TyconRef measureinverse_tcr : TyconRef measureone_tcr : TyconRef - il_arr_tcr_map : TyconRef[]; - tuple1_tcr : TyconRef; - tuple2_tcr : TyconRef; - tuple3_tcr : TyconRef; - tuple4_tcr : TyconRef; - tuple5_tcr : TyconRef; - tuple6_tcr : TyconRef; - tuple7_tcr : TyconRef; - tuple8_tcr : TyconRef; - - tcref_IQueryable : TyconRef; - tcref_IObservable : TyconRef; - tcref_IObserver : TyconRef; - fslib_IEvent2_tcr : TyconRef; - fslib_IDelegateEvent_tcr: TyconRef; - system_Nullable_tcref : TyconRef; - system_GenericIComparable_tcref : TyconRef; - system_GenericIEquatable_tcref : TyconRef; - system_IndexOutOfRangeException_tcref : TyconRef; - int_ty : TType; - nativeint_ty : TType; - unativeint_ty : TType; - int32_ty : TType; - int16_ty : TType; - int64_ty : TType; - uint16_ty : TType; - uint32_ty : TType; - uint64_ty : TType; - sbyte_ty : TType; - byte_ty : TType; - bool_ty : TType; - string_ty : TType; - obj_ty : TType; - unit_ty : TType; - exn_ty : TType; - char_ty : TType; - decimal_ty : TType; - float_ty : TType; - float32_ty : TType; - system_Array_typ : TType; - system_Object_typ : TType; - system_IDisposable_typ : TType; - system_Value_typ : TType; - system_Delegate_typ : TType; - system_MulticastDelegate_typ : TType; - system_Enum_typ : TType; - system_Exception_typ : TType; - system_Int32_typ : TType; - system_String_typ : TType; - system_Type_typ : TType; - system_TypedReference_tcref : TyconRef option; - system_ArgIterator_tcref : TyconRef option; - system_Decimal_tcref : TyconRef; - system_SByte_tcref : TyconRef; - system_Int16_tcref : TyconRef; - system_Int32_tcref : TyconRef; - system_Int64_tcref : TyconRef; - system_IntPtr_tcref : TyconRef; - system_Bool_tcref : TyconRef; - system_Char_tcref : TyconRef; - system_Byte_tcref : TyconRef; - system_UInt16_tcref : TyconRef; - system_UInt32_tcref : TyconRef; - system_UInt64_tcref : TyconRef; - system_UIntPtr_tcref : TyconRef; - system_Single_tcref : TyconRef; - system_Double_tcref : TyconRef; - system_RuntimeArgumentHandle_tcref : TyconRef option; - system_RuntimeTypeHandle_typ : TType; - system_RuntimeMethodHandle_typ : TType; - system_MarshalByRefObject_tcref : TyconRef option; - system_MarshalByRefObject_typ : TType option; - system_Reflection_MethodInfo_typ : TType; - system_Array_tcref : TyconRef; - system_Object_tcref : TyconRef; - system_Void_tcref : TyconRef; - system_LinqExpression_tcref : TyconRef; - mk_IComparable_ty : TType; - mk_IStructuralComparable_ty : TType; - mk_IStructuralEquatable_ty : TType; - mk_IComparer_ty : TType; - mk_IEqualityComparer_ty : TType; - tcref_System_Collections_IComparer : TyconRef; - tcref_System_Collections_IEqualityComparer : TyconRef; - tcref_System_Collections_Generic_IEqualityComparer : TyconRef; - tcref_System_Collections_Generic_Dictionary : TyconRef; - tcref_System_IComparable : TyconRef; - tcref_System_IStructuralComparable : TyconRef; - tcref_System_IStructuralEquatable : TyconRef; - tcref_LanguagePrimitives : TyconRef; - attrib_CustomOperationAttribute : BuiltinAttribInfo; - attrib_ProjectionParameterAttribute : BuiltinAttribInfo; - attrib_AttributeUsageAttribute : BuiltinAttribInfo; - attrib_ParamArrayAttribute : BuiltinAttribInfo; - attrib_IDispatchConstantAttribute : BuiltinAttribInfo option; - attrib_IUnknownConstantAttribute : BuiltinAttribInfo option; - attrib_SystemObsolete : BuiltinAttribInfo; - attrib_DllImportAttribute : BuiltinAttribInfo option; - attrib_CompiledNameAttribute : BuiltinAttribInfo; - attrib_NonSerializedAttribute : BuiltinAttribInfo option; - attrib_AutoSerializableAttribute : BuiltinAttribInfo; - attrib_StructLayoutAttribute : BuiltinAttribInfo; - attrib_TypeForwardedToAttribute : BuiltinAttribInfo; - attrib_ComVisibleAttribute : BuiltinAttribInfo; - attrib_ComImportAttribute : BuiltinAttribInfo option; - attrib_FieldOffsetAttribute : BuiltinAttribInfo; - attrib_MarshalAsAttribute : BuiltinAttribInfo option; - attrib_InAttribute : BuiltinAttribInfo option; - attrib_OutAttribute : BuiltinAttribInfo; - attrib_OptionalAttribute : BuiltinAttribInfo option; - attrib_ThreadStaticAttribute : BuiltinAttribInfo option; - attrib_SpecialNameAttribute : BuiltinAttribInfo option; - attrib_VolatileFieldAttribute : BuiltinAttribInfo; - attrib_ContextStaticAttribute : BuiltinAttribInfo option; - attrib_FlagsAttribute : BuiltinAttribInfo; - attrib_DefaultMemberAttribute : BuiltinAttribInfo; - attrib_DebuggerDisplayAttribute : BuiltinAttribInfo; - attrib_DebuggerTypeProxyAttribute : BuiltinAttribInfo; - attrib_PreserveSigAttribute : BuiltinAttribInfo option; - attrib_MethodImplAttribute : BuiltinAttribInfo; - attrib_ExtensionAttribute : BuiltinAttribInfo; - tcref_System_Collections_Generic_IList : TyconRef; - tcref_System_Collections_Generic_IReadOnlyList : TyconRef; - tcref_System_Collections_Generic_ICollection : TyconRef; - tcref_System_Collections_Generic_IReadOnlyCollection : TyconRef; - tcref_System_Collections_Generic_IEnumerable : TyconRef; - tcref_System_Collections_IEnumerable : TyconRef; - tcref_System_Collections_Generic_IEnumerator : TyconRef; - tcref_System_Attribute : TyconRef; - - attrib_RequireQualifiedAccessAttribute : BuiltinAttribInfo; - attrib_EntryPointAttribute : BuiltinAttribInfo; - attrib_DefaultAugmentationAttribute : BuiltinAttribInfo; - attrib_CompilerMessageAttribute : BuiltinAttribInfo; - attrib_ExperimentalAttribute : BuiltinAttribInfo; - attrib_UnverifiableAttribute : BuiltinAttribInfo; - attrib_LiteralAttribute : BuiltinAttribInfo; - attrib_ConditionalAttribute : BuiltinAttribInfo; - attrib_OptionalArgumentAttribute : BuiltinAttribInfo; - attrib_RequiresExplicitTypeArgumentsAttribute : BuiltinAttribInfo; - attrib_DefaultValueAttribute : BuiltinAttribInfo; - attrib_ClassAttribute : BuiltinAttribInfo; - attrib_InterfaceAttribute : BuiltinAttribInfo; - attrib_StructAttribute : BuiltinAttribInfo; - attrib_ReflectedDefinitionAttribute : BuiltinAttribInfo; - attrib_AutoOpenAttribute : BuiltinAttribInfo; - attrib_CompilationRepresentationAttribute : BuiltinAttribInfo; - attrib_CompilationArgumentCountsAttribute : BuiltinAttribInfo; - attrib_CompilationMappingAttribute : BuiltinAttribInfo; - - attrib_CLIEventAttribute : BuiltinAttribInfo; - attrib_AllowNullLiteralAttribute : BuiltinAttribInfo; - attrib_CLIMutableAttribute : BuiltinAttribInfo; - attrib_NoComparisonAttribute : BuiltinAttribInfo; - attrib_NoEqualityAttribute : BuiltinAttribInfo; - attrib_CustomComparisonAttribute : BuiltinAttribInfo; - attrib_CustomEqualityAttribute : BuiltinAttribInfo; - attrib_EqualityConditionalOnAttribute : BuiltinAttribInfo; - attrib_ComparisonConditionalOnAttribute : BuiltinAttribInfo; - attrib_ReferenceEqualityAttribute : BuiltinAttribInfo; - attrib_StructuralEqualityAttribute : BuiltinAttribInfo; - attrib_StructuralComparisonAttribute : BuiltinAttribInfo; - attrib_SealedAttribute : BuiltinAttribInfo; - attrib_AbstractClassAttribute : BuiltinAttribInfo; - attrib_GeneralizableValueAttribute : BuiltinAttribInfo; - attrib_MeasureAttribute : BuiltinAttribInfo; - attrib_MeasureableAttribute : BuiltinAttribInfo; - attrib_NoDynamicInvocationAttribute : BuiltinAttribInfo; + il_arr_tcr_map : TyconRef[] + tuple1_tcr : TyconRef + tuple2_tcr : TyconRef + tuple3_tcr : TyconRef + tuple4_tcr : TyconRef + tuple5_tcr : TyconRef + tuple6_tcr : TyconRef + tuple7_tcr : TyconRef + tuple8_tcr : TyconRef + + tcref_IQueryable : TyconRef + tcref_IObservable : TyconRef + tcref_IObserver : TyconRef + fslib_IEvent2_tcr : TyconRef + fslib_IDelegateEvent_tcr: TyconRef + system_Nullable_tcref : TyconRef + system_GenericIComparable_tcref : TyconRef + system_GenericIEquatable_tcref : TyconRef + system_IndexOutOfRangeException_tcref : TyconRef + int_ty : TType + nativeint_ty : TType + unativeint_ty : TType + int32_ty : TType + int16_ty : TType + int64_ty : TType + uint16_ty : TType + uint32_ty : TType + uint64_ty : TType + sbyte_ty : TType + byte_ty : TType + bool_ty : TType + string_ty : TType + obj_ty : TType + unit_ty : TType + exn_ty : TType + char_ty : TType + decimal_ty : TType + float_ty : TType + float32_ty : TType + system_Array_typ : TType + system_Object_typ : TType + system_IDisposable_typ : TType + system_Value_typ : TType + system_Delegate_typ : TType + system_MulticastDelegate_typ : TType + system_Enum_typ : TType + system_Exception_typ : TType + system_Int32_typ : TType + system_String_typ : TType + system_Type_typ : TType + system_TypedReference_tcref : TyconRef option + system_ArgIterator_tcref : TyconRef option + system_Decimal_tcref : TyconRef + system_SByte_tcref : TyconRef + system_Int16_tcref : TyconRef + system_Int32_tcref : TyconRef + system_Int64_tcref : TyconRef + system_IntPtr_tcref : TyconRef + system_Bool_tcref : TyconRef + system_Char_tcref : TyconRef + system_Byte_tcref : TyconRef + system_UInt16_tcref : TyconRef + system_UInt32_tcref : TyconRef + system_UInt64_tcref : TyconRef + system_UIntPtr_tcref : TyconRef + system_Single_tcref : TyconRef + system_Double_tcref : TyconRef + system_RuntimeArgumentHandle_tcref : TyconRef option + system_RuntimeTypeHandle_typ : TType + system_RuntimeMethodHandle_typ : TType + system_MarshalByRefObject_tcref : TyconRef option + system_MarshalByRefObject_typ : TType option + system_Reflection_MethodInfo_typ : TType + system_Array_tcref : TyconRef + system_Object_tcref : TyconRef + system_Void_tcref : TyconRef + system_LinqExpression_tcref : TyconRef + mk_IComparable_ty : TType + mk_IStructuralComparable_ty : TType + mk_IStructuralEquatable_ty : TType + mk_IComparer_ty : TType + mk_IEqualityComparer_ty : TType + tcref_System_Collections_IComparer : TyconRef + tcref_System_Collections_IEqualityComparer : TyconRef + tcref_System_Collections_Generic_IEqualityComparer : TyconRef + tcref_System_Collections_Generic_Dictionary : TyconRef + tcref_System_IComparable : TyconRef + tcref_System_IStructuralComparable : TyconRef + tcref_System_IStructuralEquatable : TyconRef + tcref_LanguagePrimitives : TyconRef + attrib_CustomOperationAttribute : BuiltinAttribInfo + attrib_ProjectionParameterAttribute : BuiltinAttribInfo + attrib_AttributeUsageAttribute : BuiltinAttribInfo + attrib_ParamArrayAttribute : BuiltinAttribInfo + attrib_IDispatchConstantAttribute : BuiltinAttribInfo option + attrib_IUnknownConstantAttribute : BuiltinAttribInfo option + attrib_SystemObsolete : BuiltinAttribInfo + attrib_DllImportAttribute : BuiltinAttribInfo option + attrib_CompiledNameAttribute : BuiltinAttribInfo + attrib_NonSerializedAttribute : BuiltinAttribInfo option + attrib_AutoSerializableAttribute : BuiltinAttribInfo + attrib_StructLayoutAttribute : BuiltinAttribInfo + attrib_TypeForwardedToAttribute : BuiltinAttribInfo + attrib_ComVisibleAttribute : BuiltinAttribInfo + attrib_ComImportAttribute : BuiltinAttribInfo option + attrib_FieldOffsetAttribute : BuiltinAttribInfo + attrib_MarshalAsAttribute : BuiltinAttribInfo option + attrib_InAttribute : BuiltinAttribInfo option + attrib_OutAttribute : BuiltinAttribInfo + attrib_OptionalAttribute : BuiltinAttribInfo option + attrib_ThreadStaticAttribute : BuiltinAttribInfo option + attrib_SpecialNameAttribute : BuiltinAttribInfo option + attrib_VolatileFieldAttribute : BuiltinAttribInfo + attrib_ContextStaticAttribute : BuiltinAttribInfo option + attrib_FlagsAttribute : BuiltinAttribInfo + attrib_DefaultMemberAttribute : BuiltinAttribInfo + attrib_DebuggerDisplayAttribute : BuiltinAttribInfo + attrib_DebuggerTypeProxyAttribute : BuiltinAttribInfo + attrib_PreserveSigAttribute : BuiltinAttribInfo option + attrib_MethodImplAttribute : BuiltinAttribInfo + attrib_ExtensionAttribute : BuiltinAttribInfo + tcref_System_Collections_Generic_IList : TyconRef + tcref_System_Collections_Generic_IReadOnlyList : TyconRef + tcref_System_Collections_Generic_ICollection : TyconRef + tcref_System_Collections_Generic_IReadOnlyCollection : TyconRef + tcref_System_Collections_Generic_IEnumerable : TyconRef + tcref_System_Collections_IEnumerable : TyconRef + tcref_System_Collections_Generic_IEnumerator : TyconRef + tcref_System_Attribute : TyconRef + + attrib_RequireQualifiedAccessAttribute : BuiltinAttribInfo + attrib_EntryPointAttribute : BuiltinAttribInfo + attrib_DefaultAugmentationAttribute : BuiltinAttribInfo + attrib_CompilerMessageAttribute : BuiltinAttribInfo + attrib_ExperimentalAttribute : BuiltinAttribInfo + attrib_UnverifiableAttribute : BuiltinAttribInfo + attrib_LiteralAttribute : BuiltinAttribInfo + attrib_ConditionalAttribute : BuiltinAttribInfo + attrib_OptionalArgumentAttribute : BuiltinAttribInfo + attrib_RequiresExplicitTypeArgumentsAttribute : BuiltinAttribInfo + attrib_DefaultValueAttribute : BuiltinAttribInfo + attrib_ClassAttribute : BuiltinAttribInfo + attrib_InterfaceAttribute : BuiltinAttribInfo + attrib_StructAttribute : BuiltinAttribInfo + attrib_ReflectedDefinitionAttribute : BuiltinAttribInfo + attrib_AutoOpenAttribute : BuiltinAttribInfo + attrib_CompilationRepresentationAttribute : BuiltinAttribInfo + attrib_CompilationArgumentCountsAttribute : BuiltinAttribInfo + attrib_CompilationMappingAttribute : BuiltinAttribInfo + + attrib_CLIEventAttribute : BuiltinAttribInfo + attrib_AllowNullLiteralAttribute : BuiltinAttribInfo + attrib_CLIMutableAttribute : BuiltinAttribInfo + attrib_NoComparisonAttribute : BuiltinAttribInfo + attrib_NoEqualityAttribute : BuiltinAttribInfo + attrib_CustomComparisonAttribute : BuiltinAttribInfo + attrib_CustomEqualityAttribute : BuiltinAttribInfo + attrib_EqualityConditionalOnAttribute : BuiltinAttribInfo + attrib_ComparisonConditionalOnAttribute : BuiltinAttribInfo + attrib_ReferenceEqualityAttribute : BuiltinAttribInfo + attrib_StructuralEqualityAttribute : BuiltinAttribInfo + attrib_StructuralComparisonAttribute : BuiltinAttribInfo + attrib_SealedAttribute : BuiltinAttribInfo + attrib_AbstractClassAttribute : BuiltinAttribInfo + attrib_GeneralizableValueAttribute : BuiltinAttribInfo + attrib_MeasureAttribute : BuiltinAttribInfo + attrib_MeasureableAttribute : BuiltinAttribInfo + attrib_NoDynamicInvocationAttribute : BuiltinAttribInfo - attrib_SecurityAttribute : BuiltinAttribInfo option; - attrib_SecurityCriticalAttribute : BuiltinAttribInfo; - attrib_SecuritySafeCriticalAttribute : BuiltinAttribInfo; + attrib_SecurityAttribute : BuiltinAttribInfo option + attrib_SecurityCriticalAttribute : BuiltinAttribInfo + attrib_SecuritySafeCriticalAttribute : BuiltinAttribInfo - cons_ucref : UnionCaseRef; - nil_ucref : UnionCaseRef; + cons_ucref : UnionCaseRef + nil_ucref : UnionCaseRef (* These are the library values the compiler needs to know about *) - seq_vref : ValRef; - and_vref : ValRef; - and2_vref : ValRef; - addrof_vref : ValRef; - addrof2_vref : ValRef; - or_vref : ValRef; - or2_vref : ValRef; + seq_vref : ValRef + and_vref : ValRef + and2_vref : ValRef + addrof_vref : ValRef + addrof2_vref : ValRef + or_vref : ValRef + or2_vref : ValRef // 'inner' refers to "after optimization boils away inlined functions" - generic_equality_er_inner_vref : ValRef; - generic_equality_per_inner_vref : ValRef; - generic_equality_withc_inner_vref : ValRef; - generic_comparison_inner_vref : ValRef; - generic_comparison_withc_inner_vref : ValRef; - generic_hash_inner_vref : ValRef; - generic_hash_withc_inner_vref : ValRef; - reference_equality_inner_vref : ValRef; - - compare_operator_vref : ValRef; - equals_operator_vref : ValRef; - equals_nullable_operator_vref : ValRef; - nullable_equals_nullable_operator_vref : ValRef; - nullable_equals_operator_vref : ValRef; - not_equals_operator_vref : ValRef; - less_than_operator_vref : ValRef; - less_than_or_equals_operator_vref : ValRef; - greater_than_operator_vref : ValRef; - greater_than_or_equals_operator_vref : ValRef; + generic_equality_er_inner_vref : ValRef + generic_equality_per_inner_vref : ValRef + generic_equality_withc_inner_vref : ValRef + generic_comparison_inner_vref : ValRef + generic_comparison_withc_inner_vref : ValRef + generic_hash_inner_vref : ValRef + generic_hash_withc_inner_vref : ValRef + reference_equality_inner_vref : ValRef + + compare_operator_vref : ValRef + equals_operator_vref : ValRef + equals_nullable_operator_vref : ValRef + nullable_equals_nullable_operator_vref : ValRef + nullable_equals_operator_vref : ValRef + not_equals_operator_vref : ValRef + less_than_operator_vref : ValRef + less_than_or_equals_operator_vref : ValRef + greater_than_operator_vref : ValRef + greater_than_or_equals_operator_vref : ValRef - bitwise_or_vref : ValRef; - bitwise_and_vref : ValRef; - bitwise_xor_vref : ValRef; - bitwise_unary_not_vref : ValRef; - bitwise_shift_left_vref : ValRef; - bitwise_shift_right_vref : ValRef; - unchecked_addition_vref : ValRef; - unchecked_unary_plus_vref : ValRef; - unchecked_unary_minus_vref : ValRef; - unchecked_unary_not_vref : ValRef; - unchecked_subtraction_vref : ValRef; - unchecked_multiply_vref : ValRef; - unchecked_defaultof_vref : ValRef; + bitwise_or_vref : ValRef + bitwise_and_vref : ValRef + bitwise_xor_vref : ValRef + bitwise_unary_not_vref : ValRef + bitwise_shift_left_vref : ValRef + bitwise_shift_right_vref : ValRef + unchecked_addition_vref : ValRef + unchecked_unary_plus_vref : ValRef + unchecked_unary_minus_vref : ValRef + unchecked_unary_not_vref : ValRef + unchecked_subtraction_vref : ValRef + unchecked_multiply_vref : ValRef + unchecked_defaultof_vref : ValRef unchecked_subtraction_info : IntrinsicValRef - seq_info : IntrinsicValRef; - reraise_info : IntrinsicValRef; - reraise_vref : ValRef; - typeof_info : IntrinsicValRef; - typeof_vref : ValRef; - methodhandleof_info : IntrinsicValRef; - methodhandleof_vref : ValRef; - sizeof_vref : ValRef; - typedefof_info : IntrinsicValRef; - typedefof_vref : ValRef; - enum_vref : ValRef; + seq_info : IntrinsicValRef + reraise_info : IntrinsicValRef + reraise_vref : ValRef + typeof_info : IntrinsicValRef + typeof_vref : ValRef + methodhandleof_info : IntrinsicValRef + methodhandleof_vref : ValRef + sizeof_vref : ValRef + typedefof_info : IntrinsicValRef + typedefof_vref : ValRef + enum_vref : ValRef enumOfValue_vref : ValRef - new_decimal_info : IntrinsicValRef; + new_decimal_info : IntrinsicValRef // 'outer' refers to 'before optimization has boiled away inlined functions' // Augmentation generation generates calls to these functions // Optimization generates calls to these functions - generic_comparison_withc_outer_info : IntrinsicValRef; - generic_equality_er_outer_info : IntrinsicValRef; - generic_equality_withc_outer_info : IntrinsicValRef; - generic_hash_withc_outer_info : IntrinsicValRef; + generic_comparison_withc_outer_info : IntrinsicValRef + generic_equality_er_outer_info : IntrinsicValRef + generic_equality_withc_outer_info : IntrinsicValRef + generic_hash_withc_outer_info : IntrinsicValRef // Augmentation generation and pattern match compilation generates calls to this function - equals_operator_info : IntrinsicValRef; + equals_operator_info : IntrinsicValRef - query_source_vref : ValRef; - query_value_vref : ValRef; - query_run_value_vref : ValRef; - query_run_enumerable_vref : ValRef; - query_for_vref : ValRef; - query_yield_vref : ValRef; - query_yield_from_vref : ValRef; - query_select_vref : ValRef; - query_where_vref : ValRef; - query_zero_vref : ValRef; - query_builder_tcref : TyconRef; - generic_hash_withc_tuple2_vref : ValRef; - generic_hash_withc_tuple3_vref : ValRef; - generic_hash_withc_tuple4_vref : ValRef; - generic_hash_withc_tuple5_vref : ValRef; - generic_equals_withc_tuple2_vref : ValRef; - generic_equals_withc_tuple3_vref : ValRef; - generic_equals_withc_tuple4_vref : ValRef; - generic_equals_withc_tuple5_vref : ValRef; - generic_compare_withc_tuple2_vref : ValRef; - generic_compare_withc_tuple3_vref : ValRef; - generic_compare_withc_tuple4_vref : ValRef; - generic_compare_withc_tuple5_vref : ValRef; - generic_equality_withc_outer_vref : ValRef; - - create_instance_info : IntrinsicValRef; - create_event_info : IntrinsicValRef; - unbox_vref : ValRef; - unbox_fast_vref : ValRef; - istype_vref : ValRef; - istype_fast_vref : ValRef; - get_generic_comparer_info : IntrinsicValRef; - get_generic_er_equality_comparer_info : IntrinsicValRef; - get_generic_per_equality_comparer_info : IntrinsicValRef; - unbox_info : IntrinsicValRef; - unbox_fast_info : IntrinsicValRef; - istype_info : IntrinsicValRef; - istype_fast_info : IntrinsicValRef; - - dispose_info : IntrinsicValRef; - - range_op_vref : ValRef; - range_int32_op_vref : ValRef; - //range_step_op_vref : ValRef; - array_get_vref : ValRef; - array2D_get_vref : ValRef; - array3D_get_vref : ValRef; - array4D_get_vref : ValRef; - seq_collect_vref : ValRef; - seq_collect_info : IntrinsicValRef; - seq_using_info : IntrinsicValRef; - seq_using_vref : ValRef; - seq_delay_info : IntrinsicValRef; - seq_delay_vref : ValRef; - seq_append_info : IntrinsicValRef; - seq_append_vref : ValRef; - seq_generated_info : IntrinsicValRef; - seq_generated_vref : ValRef; - seq_finally_info : IntrinsicValRef; - seq_finally_vref : ValRef; - seq_of_functions_info : IntrinsicValRef; - seq_of_functions_vref : ValRef; - seq_to_array_info : IntrinsicValRef; - seq_to_list_info : IntrinsicValRef; - seq_map_info : IntrinsicValRef; - seq_map_vref : ValRef; - seq_singleton_info : IntrinsicValRef; - seq_singleton_vref : ValRef; - seq_empty_info : IntrinsicValRef; - seq_empty_vref : ValRef; - new_format_info : IntrinsicValRef; - raise_info : IntrinsicValRef; - lazy_force_info : IntrinsicValRef; - lazy_create_info : IntrinsicValRef; - - array_get_info : IntrinsicValRef; - array_length_info : IntrinsicValRef; - array2D_get_info : IntrinsicValRef; - array3D_get_info : IntrinsicValRef; - array4D_get_info : IntrinsicValRef; - deserialize_quoted_FSharp_20_plus_info : IntrinsicValRef; - deserialize_quoted_FSharp_40_plus_info : IntrinsicValRef; - cast_quotation_info : IntrinsicValRef; - lift_value_info : IntrinsicValRef; - lift_value_with_name_info : IntrinsicValRef; - lift_value_with_defn_info : IntrinsicValRef; - query_source_as_enum_info : IntrinsicValRef; - new_query_source_info : IntrinsicValRef; - fail_init_info : IntrinsicValRef; - fail_static_init_info : IntrinsicValRef; - check_this_info : IntrinsicValRef; - quote_to_linq_lambda_info : IntrinsicValRef; - sprintf_vref : ValRef; - splice_expr_vref : ValRef; - splice_raw_expr_vref : ValRef; - new_format_vref : ValRef; - mkSysTyconRef : string list -> string -> TyconRef; + query_source_vref : ValRef + query_value_vref : ValRef + query_run_value_vref : ValRef + query_run_enumerable_vref : ValRef + query_for_vref : ValRef + query_yield_vref : ValRef + query_yield_from_vref : ValRef + query_select_vref : ValRef + query_where_vref : ValRef + query_zero_vref : ValRef + query_builder_tcref : TyconRef + generic_hash_withc_tuple2_vref : ValRef + generic_hash_withc_tuple3_vref : ValRef + generic_hash_withc_tuple4_vref : ValRef + generic_hash_withc_tuple5_vref : ValRef + generic_equals_withc_tuple2_vref : ValRef + generic_equals_withc_tuple3_vref : ValRef + generic_equals_withc_tuple4_vref : ValRef + generic_equals_withc_tuple5_vref : ValRef + generic_compare_withc_tuple2_vref : ValRef + generic_compare_withc_tuple3_vref : ValRef + generic_compare_withc_tuple4_vref : ValRef + generic_compare_withc_tuple5_vref : ValRef + generic_equality_withc_outer_vref : ValRef + + create_instance_info : IntrinsicValRef + create_event_info : IntrinsicValRef + unbox_vref : ValRef + unbox_fast_vref : ValRef + istype_vref : ValRef + istype_fast_vref : ValRef + get_generic_comparer_info : IntrinsicValRef + get_generic_er_equality_comparer_info : IntrinsicValRef + get_generic_per_equality_comparer_info : IntrinsicValRef + unbox_info : IntrinsicValRef + unbox_fast_info : IntrinsicValRef + istype_info : IntrinsicValRef + istype_fast_info : IntrinsicValRef + + dispose_info : IntrinsicValRef + + range_op_vref : ValRef + range_int32_op_vref : ValRef + //range_step_op_vref : ValRef + array_get_vref : ValRef + array2D_get_vref : ValRef + array3D_get_vref : ValRef + array4D_get_vref : ValRef + seq_collect_vref : ValRef + seq_collect_info : IntrinsicValRef + seq_using_info : IntrinsicValRef + seq_using_vref : ValRef + seq_delay_info : IntrinsicValRef + seq_delay_vref : ValRef + seq_append_info : IntrinsicValRef + seq_append_vref : ValRef + seq_generated_info : IntrinsicValRef + seq_generated_vref : ValRef + seq_finally_info : IntrinsicValRef + seq_finally_vref : ValRef + seq_of_functions_info : IntrinsicValRef + seq_of_functions_vref : ValRef + seq_to_array_info : IntrinsicValRef + seq_to_list_info : IntrinsicValRef + seq_map_info : IntrinsicValRef + seq_map_vref : ValRef + seq_singleton_info : IntrinsicValRef + seq_singleton_vref : ValRef + seq_empty_info : IntrinsicValRef + seq_empty_vref : ValRef + new_format_info : IntrinsicValRef + raise_info : IntrinsicValRef + lazy_force_info : IntrinsicValRef + lazy_create_info : IntrinsicValRef + + array_get_info : IntrinsicValRef + array_length_info : IntrinsicValRef + array2D_get_info : IntrinsicValRef + array3D_get_info : IntrinsicValRef + array4D_get_info : IntrinsicValRef + deserialize_quoted_FSharp_20_plus_info : IntrinsicValRef + deserialize_quoted_FSharp_40_plus_info : IntrinsicValRef + cast_quotation_info : IntrinsicValRef + lift_value_info : IntrinsicValRef + lift_value_with_name_info : IntrinsicValRef + lift_value_with_defn_info : IntrinsicValRef + query_source_as_enum_info : IntrinsicValRef + new_query_source_info : IntrinsicValRef + fail_init_info : IntrinsicValRef + fail_static_init_info : IntrinsicValRef + check_this_info : IntrinsicValRef + quote_to_linq_lambda_info : IntrinsicValRef + sprintf_vref : ValRef + splice_expr_vref : ValRef + splice_raw_expr_vref : ValRef + new_format_vref : ValRef + mkSysTyconRef : string list -> string -> TyconRef // A list of types that are explicitly suppressed from the F# intellisense // Note that the suppression checks for the precise name of the type // so the lowercase versions are visible - suppressed_types : TyconRef list; + suppressed_types : TyconRef list /// Memoization table to help minimize the number of ILSourceDocument objects we create - memoize_file : int -> IL.ILSourceDocument; + memoize_file : int -> IL.ILSourceDocument // Are we assuming all code gen is for F# interactive, with no static linking isInteractive : bool // A table of all intrinsics that the compiler cares about @@ -682,13 +679,13 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa let system_RuntimeMethodHandle_typ = mkSysNonGenericTy sys "RuntimeMethodHandle" - let mk_unop_ty ty = [[ty]], ty - let mk_binop_ty ty = [[ty]; [ty]], ty - let mk_shiftop_ty ty = [[ty]; [int_ty]], ty - let mk_binop_ty3 ty1 ty2 ty3 = [[ty1]; [ty2]], ty3 - let mk_rel_sig ty = [[ty];[ty]],bool_ty - let mk_compare_sig ty = [[ty];[ty]],int_ty - let mk_hash_sig ty = [[ty]], int_ty + let mk_unop_ty ty = [[ty]], ty + let mk_binop_ty ty = [[ty]; [ty]], ty + let mk_shiftop_ty ty = [[ty]; [int_ty]], ty + let mk_binop_ty3 ty1 ty2 ty3 = [[ty1]; [ty2]], ty3 + let mk_rel_sig ty = [[ty];[ty]],bool_ty + let mk_compare_sig ty = [[ty];[ty]],int_ty + let mk_hash_sig ty = [[ty]], int_ty let mk_compare_withc_sig ty = [[mk_IComparer_ty];[ty]; [ty]], int_ty let mk_equality_withc_sig ty = [[mk_IEqualityComparer_ty];[ty];[ty]], bool_ty let mk_hash_withc_sig ty = [[mk_IEqualityComparer_ty]; [ty]], int_ty @@ -970,259 +967,259 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa let check_this_info = makeIntrinsicValRef(fslib_MFIntrinsicFunctions_nleref, "CheckThis" ,None ,None ,[vara], ([[varaTy]], varaTy)) let quote_to_linq_lambda_info = makeIntrinsicValRef(fslib_MFLinqRuntimeHelpersQuotationConverter_nleref, "QuotationToLambdaExpression" ,None ,None ,[vara], ([[mkQuotedExprTy varaTy]], mkLinqExpressionTy varaTy)) - { ilg=ilg; + { ilg=ilg #if NO_COMPILER_BACKEND #else - ilxPubCloEnv=EraseIlxFuncs.new_cenv(ilg) + ilxPubCloEnv=EraseClosures.new_cenv(ilg) #endif knownIntrinsics = knownIntrinsics knownFSharpCoreModules = knownFSharpCoreModules - compilingFslib = compilingFslib; - mlCompatibility = mlCompatibility; + compilingFslib = compilingFslib + mlCompatibility = mlCompatibility emitDebugInfoInQuotations = emitDebugInfoInQuotations - directoryToResolveRelativePaths= directoryToResolveRelativePaths; - unionCaseRefEq = unionCaseRefEq; - valRefEq = valRefEq; - fslibCcu = fslibCcu; - using40environment = using40environment; - indirectCallArrayMethods = indirectCallArrayMethods; - sysCcu = sysCcu; - refcell_tcr_canon = mk_MFCore_tcref fslibCcu "Ref`1"; - option_tcr_canon = mk_MFCore_tcref fslibCcu "Option`1"; - list_tcr_canon = mk_MFCollections_tcref fslibCcu "List`1"; - set_tcr_canon = mk_MFCollections_tcref fslibCcu "Set`1"; - map_tcr_canon = mk_MFCollections_tcref fslibCcu "Map`2"; - lazy_tcr_canon = lazy_tcr; - refcell_tcr_nice = mk_MFCore_tcref fslibCcu "ref`1"; - array_tcr_nice = il_arr_tcr_map.[0]; - option_tcr_nice = option_tcr_nice; - list_tcr_nice = list_tcr_nice; - lazy_tcr_nice = lazy_tcr_nice; - format_tcr = format_tcr; - expr_tcr = expr_tcr; - raw_expr_tcr = raw_expr_tcr; - nativeint_tcr = nativeint_tcr; - int32_tcr = int32_tcr; - int16_tcr = int16_tcr; - int64_tcr = int64_tcr; - uint16_tcr = uint16_tcr; - uint32_tcr = uint32_tcr; - uint64_tcr = uint64_tcr; - sbyte_tcr = sbyte_tcr; - decimal_tcr = decimal_tcr; - date_tcr = date_tcr; - pdecimal_tcr = pdecimal_tcr; - byte_tcr = byte_tcr; - bool_tcr = bool_tcr; - unit_tcr_canon = unit_tcr_canon; - unit_tcr_nice = unit_tcr_nice; - exn_tcr = exn_tcr; - char_tcr = char_tcr; - float_tcr = float_tcr; - float32_tcr = float32_tcr; - pfloat_tcr = pfloat_tcr; - pfloat32_tcr = pfloat32_tcr; - pint_tcr = pint_tcr; - pint8_tcr = pint8_tcr; - pint16_tcr = pint16_tcr; - pint64_tcr = pint64_tcr; - byref_tcr = byref_tcr; - nativeptr_tcr = nativeptr_tcr; - ilsigptr_tcr = ilsigptr_tcr; - fastFunc_tcr = fastFunc_tcr; + directoryToResolveRelativePaths= directoryToResolveRelativePaths + unionCaseRefEq = unionCaseRefEq + valRefEq = valRefEq + fslibCcu = fslibCcu + using40environment = using40environment + indirectCallArrayMethods = indirectCallArrayMethods + sysCcu = sysCcu + refcell_tcr_canon = mk_MFCore_tcref fslibCcu "Ref`1" + option_tcr_canon = mk_MFCore_tcref fslibCcu "Option`1" + list_tcr_canon = mk_MFCollections_tcref fslibCcu "List`1" + set_tcr_canon = mk_MFCollections_tcref fslibCcu "Set`1" + map_tcr_canon = mk_MFCollections_tcref fslibCcu "Map`2" + lazy_tcr_canon = lazy_tcr + refcell_tcr_nice = mk_MFCore_tcref fslibCcu "ref`1" + array_tcr_nice = il_arr_tcr_map.[0] + option_tcr_nice = option_tcr_nice + list_tcr_nice = list_tcr_nice + lazy_tcr_nice = lazy_tcr_nice + format_tcr = format_tcr + expr_tcr = expr_tcr + raw_expr_tcr = raw_expr_tcr + nativeint_tcr = nativeint_tcr + int32_tcr = int32_tcr + int16_tcr = int16_tcr + int64_tcr = int64_tcr + uint16_tcr = uint16_tcr + uint32_tcr = uint32_tcr + uint64_tcr = uint64_tcr + sbyte_tcr = sbyte_tcr + decimal_tcr = decimal_tcr + date_tcr = date_tcr + pdecimal_tcr = pdecimal_tcr + byte_tcr = byte_tcr + bool_tcr = bool_tcr + unit_tcr_canon = unit_tcr_canon + unit_tcr_nice = unit_tcr_nice + exn_tcr = exn_tcr + char_tcr = char_tcr + float_tcr = float_tcr + float32_tcr = float32_tcr + pfloat_tcr = pfloat_tcr + pfloat32_tcr = pfloat32_tcr + pint_tcr = pint_tcr + pint8_tcr = pint8_tcr + pint16_tcr = pint16_tcr + pint64_tcr = pint64_tcr + byref_tcr = byref_tcr + nativeptr_tcr = nativeptr_tcr + ilsigptr_tcr = ilsigptr_tcr + fastFunc_tcr = fastFunc_tcr tcref_IQueryable = tcref_IQueryable - tcref_IObservable = tcref_IObservable; - tcref_IObserver = tcref_IObserver; - fslib_IEvent2_tcr = fslib_IEvent2_tcr; - fslib_IDelegateEvent_tcr = fslib_IDelegateEvent_tcr; - seq_tcr = seq_tcr; - seq_base_tcr = mk_MFCompilerServices_tcref fslibCcu "GeneratedSequenceBase`1"; - measureproduct_tcr = mk_MFCompilerServices_tcref fslibCcu "MeasureProduct`2"; - measureinverse_tcr = mk_MFCompilerServices_tcref fslibCcu "MeasureInverse`1"; - measureone_tcr = mk_MFCompilerServices_tcref fslibCcu "MeasureOne"; - il_arr_tcr_map = il_arr_tcr_map; - tuple1_tcr = tuple1_tcr; - tuple2_tcr = tuple2_tcr; - tuple3_tcr = tuple3_tcr; - tuple4_tcr = tuple4_tcr; - tuple5_tcr = tuple5_tcr; - tuple6_tcr = tuple6_tcr; - tuple7_tcr = tuple7_tcr; - tuple8_tcr = tuple8_tcr; - choice2_tcr = choice2_tcr; - choice3_tcr = choice3_tcr; - choice4_tcr = choice4_tcr; - choice5_tcr = choice5_tcr; - choice6_tcr = choice6_tcr; - choice7_tcr = choice7_tcr; - nativeint_ty = mkNonGenericTy nativeint_tcr; - unativeint_ty = mkNonGenericTy unativeint_tcr; - int32_ty = mkNonGenericTy int32_tcr; - int16_ty = mkNonGenericTy int16_tcr; - int64_ty = mkNonGenericTy int64_tcr; - uint16_ty = mkNonGenericTy uint16_tcr; - uint32_ty = mkNonGenericTy uint32_tcr; - uint64_ty = mkNonGenericTy uint64_tcr; - sbyte_ty = mkNonGenericTy sbyte_tcr; - byte_ty = byte_ty; - bool_ty = bool_ty; - int_ty = int_ty; - string_ty = string_ty; - obj_ty = mkNonGenericTy obj_tcr; - unit_ty = unit_ty; - exn_ty = mkNonGenericTy exn_tcr; - char_ty = mkNonGenericTy char_tcr; - decimal_ty = mkNonGenericTy decimal_tcr; - float_ty = mkNonGenericTy float_tcr; - float32_ty = mkNonGenericTy float32_tcr; - memoize_file = memoize_file.Apply; - - system_Array_typ = mkSysNonGenericTy sys "Array"; - system_Object_typ = mkSysNonGenericTy sys "Object"; - system_IDisposable_typ = mkSysNonGenericTy sys "IDisposable"; - system_Value_typ = mkSysNonGenericTy sys "ValueType"; - system_Delegate_typ = mkSysNonGenericTy sys "Delegate"; - system_MulticastDelegate_typ = mkSysNonGenericTy sys "MulticastDelegate"; - system_Enum_typ = mkSysNonGenericTy sys "Enum"; - system_Exception_typ = mkSysNonGenericTy sys "Exception"; - system_String_typ = mkSysNonGenericTy sys "String"; - system_Int32_typ = mkSysNonGenericTy sys "Int32"; - system_Type_typ = system_Type_typ; + tcref_IObservable = tcref_IObservable + tcref_IObserver = tcref_IObserver + fslib_IEvent2_tcr = fslib_IEvent2_tcr + fslib_IDelegateEvent_tcr = fslib_IDelegateEvent_tcr + seq_tcr = seq_tcr + seq_base_tcr = mk_MFCompilerServices_tcref fslibCcu "GeneratedSequenceBase`1" + measureproduct_tcr = mk_MFCompilerServices_tcref fslibCcu "MeasureProduct`2" + measureinverse_tcr = mk_MFCompilerServices_tcref fslibCcu "MeasureInverse`1" + measureone_tcr = mk_MFCompilerServices_tcref fslibCcu "MeasureOne" + il_arr_tcr_map = il_arr_tcr_map + tuple1_tcr = tuple1_tcr + tuple2_tcr = tuple2_tcr + tuple3_tcr = tuple3_tcr + tuple4_tcr = tuple4_tcr + tuple5_tcr = tuple5_tcr + tuple6_tcr = tuple6_tcr + tuple7_tcr = tuple7_tcr + tuple8_tcr = tuple8_tcr + choice2_tcr = choice2_tcr + choice3_tcr = choice3_tcr + choice4_tcr = choice4_tcr + choice5_tcr = choice5_tcr + choice6_tcr = choice6_tcr + choice7_tcr = choice7_tcr + nativeint_ty = mkNonGenericTy nativeint_tcr + unativeint_ty = mkNonGenericTy unativeint_tcr + int32_ty = mkNonGenericTy int32_tcr + int16_ty = mkNonGenericTy int16_tcr + int64_ty = mkNonGenericTy int64_tcr + uint16_ty = mkNonGenericTy uint16_tcr + uint32_ty = mkNonGenericTy uint32_tcr + uint64_ty = mkNonGenericTy uint64_tcr + sbyte_ty = mkNonGenericTy sbyte_tcr + byte_ty = byte_ty + bool_ty = bool_ty + int_ty = int_ty + string_ty = string_ty + obj_ty = mkNonGenericTy obj_tcr + unit_ty = unit_ty + exn_ty = mkNonGenericTy exn_tcr + char_ty = mkNonGenericTy char_tcr + decimal_ty = mkNonGenericTy decimal_tcr + float_ty = mkNonGenericTy float_tcr + float32_ty = mkNonGenericTy float32_tcr + memoize_file = memoize_file.Apply + + system_Array_typ = mkSysNonGenericTy sys "Array" + system_Object_typ = mkSysNonGenericTy sys "Object" + system_IDisposable_typ = mkSysNonGenericTy sys "IDisposable" + system_Value_typ = mkSysNonGenericTy sys "ValueType" + system_Delegate_typ = mkSysNonGenericTy sys "Delegate" + system_MulticastDelegate_typ = mkSysNonGenericTy sys "MulticastDelegate" + system_Enum_typ = mkSysNonGenericTy sys "Enum" + system_Exception_typ = mkSysNonGenericTy sys "Exception" + system_String_typ = mkSysNonGenericTy sys "String" + system_Int32_typ = mkSysNonGenericTy sys "Int32" + system_Type_typ = system_Type_typ system_TypedReference_tcref = if ilg.traits.TypedReferenceTypeScopeRef.IsSome then Some(mkSysTyconRef sys "TypedReference") else None system_ArgIterator_tcref = if ilg.traits.ArgIteratorTypeScopeRef.IsSome then Some(mkSysTyconRef sys "ArgIterator") else None - system_RuntimeArgumentHandle_tcref = if ilg.traits.RuntimeArgumentHandleTypeScopeRef.IsSome then Some (mkSysTyconRef sys "RuntimeArgumentHandle") else None; - system_SByte_tcref = mkSysTyconRef sys "SByte"; - system_Decimal_tcref = mkSysTyconRef sys "Decimal"; - system_Int16_tcref = mkSysTyconRef sys "Int16"; - system_Int32_tcref = mkSysTyconRef sys "Int32"; - system_Int64_tcref = mkSysTyconRef sys "Int64"; - system_IntPtr_tcref = mkSysTyconRef sys "IntPtr"; - system_Bool_tcref = mkSysTyconRef sys "Boolean"; - system_Byte_tcref = mkSysTyconRef sys "Byte"; - system_UInt16_tcref = mkSysTyconRef sys "UInt16"; - system_Char_tcref = mkSysTyconRef sys "Char"; - system_UInt32_tcref = mkSysTyconRef sys "UInt32"; - system_UInt64_tcref = mkSysTyconRef sys "UInt64"; - system_UIntPtr_tcref = mkSysTyconRef sys "UIntPtr"; - system_Single_tcref = mkSysTyconRef sys "Single"; - system_Double_tcref = mkSysTyconRef sys "Double"; - system_RuntimeTypeHandle_typ = mkSysNonGenericTy sys "RuntimeTypeHandle"; - system_RuntimeMethodHandle_typ = system_RuntimeMethodHandle_typ; + system_RuntimeArgumentHandle_tcref = if ilg.traits.RuntimeArgumentHandleTypeScopeRef.IsSome then Some (mkSysTyconRef sys "RuntimeArgumentHandle") else None + system_SByte_tcref = mkSysTyconRef sys "SByte" + system_Decimal_tcref = mkSysTyconRef sys "Decimal" + system_Int16_tcref = mkSysTyconRef sys "Int16" + system_Int32_tcref = mkSysTyconRef sys "Int32" + system_Int64_tcref = mkSysTyconRef sys "Int64" + system_IntPtr_tcref = mkSysTyconRef sys "IntPtr" + system_Bool_tcref = mkSysTyconRef sys "Boolean" + system_Byte_tcref = mkSysTyconRef sys "Byte" + system_UInt16_tcref = mkSysTyconRef sys "UInt16" + system_Char_tcref = mkSysTyconRef sys "Char" + system_UInt32_tcref = mkSysTyconRef sys "UInt32" + system_UInt64_tcref = mkSysTyconRef sys "UInt64" + system_UIntPtr_tcref = mkSysTyconRef sys "UIntPtr" + system_Single_tcref = mkSysTyconRef sys "Single" + system_Double_tcref = mkSysTyconRef sys "Double" + system_RuntimeTypeHandle_typ = mkSysNonGenericTy sys "RuntimeTypeHandle" + system_RuntimeMethodHandle_typ = system_RuntimeMethodHandle_typ system_MarshalByRefObject_tcref = if ilg.traits.MarshalByRefObjectScopeRef.IsSome then Some(mkSysTyconRef sys "MarshalByRefObject") else None system_MarshalByRefObject_typ = if ilg.traits.MarshalByRefObjectScopeRef.IsSome then Some(mkSysNonGenericTy sys "MarshalByRefObject") else None - system_Reflection_MethodInfo_typ = system_Reflection_MethodInfo_typ; + system_Reflection_MethodInfo_typ = system_Reflection_MethodInfo_typ - system_Array_tcref = mkSysTyconRef sys "Array"; - system_Object_tcref = mkSysTyconRef sys "Object"; - system_Void_tcref = mkSysTyconRef sys "Void"; - system_IndexOutOfRangeException_tcref = mkSysTyconRef sys "IndexOutOfRangeException"; - system_Nullable_tcref = nullable_tcr; - system_GenericIComparable_tcref = mkSysTyconRef sys "IComparable`1"; - system_GenericIEquatable_tcref = mkSysTyconRef sys "IEquatable`1"; - mk_IComparable_ty = mkSysNonGenericTy sys "IComparable"; - system_LinqExpression_tcref = linqExpression_tcr; - - mk_IStructuralComparable_ty = mkSysNonGenericTy sysCollections "IStructuralComparable"; + system_Array_tcref = mkSysTyconRef sys "Array" + system_Object_tcref = mkSysTyconRef sys "Object" + system_Void_tcref = mkSysTyconRef sys "Void" + system_IndexOutOfRangeException_tcref = mkSysTyconRef sys "IndexOutOfRangeException" + system_Nullable_tcref = nullable_tcr + system_GenericIComparable_tcref = mkSysTyconRef sys "IComparable`1" + system_GenericIEquatable_tcref = mkSysTyconRef sys "IEquatable`1" + mk_IComparable_ty = mkSysNonGenericTy sys "IComparable" + system_LinqExpression_tcref = linqExpression_tcr + + mk_IStructuralComparable_ty = mkSysNonGenericTy sysCollections "IStructuralComparable" - mk_IStructuralEquatable_ty = mkSysNonGenericTy sysCollections "IStructuralEquatable"; - - mk_IComparer_ty = mk_IComparer_ty; - mk_IEqualityComparer_ty = mk_IEqualityComparer_ty; - tcref_System_Collections_IComparer = mkSysTyconRef sysCollections "IComparer"; - tcref_System_Collections_IEqualityComparer = mkSysTyconRef sysCollections "IEqualityComparer"; - tcref_System_Collections_Generic_IEqualityComparer = mkSysTyconRef sysGenerics "IEqualityComparer`1"; - tcref_System_Collections_Generic_Dictionary = mkSysTyconRef sysGenerics "Dictionary`2"; + mk_IStructuralEquatable_ty = mkSysNonGenericTy sysCollections "IStructuralEquatable" + + mk_IComparer_ty = mk_IComparer_ty + mk_IEqualityComparer_ty = mk_IEqualityComparer_ty + tcref_System_Collections_IComparer = mkSysTyconRef sysCollections "IComparer" + tcref_System_Collections_IEqualityComparer = mkSysTyconRef sysCollections "IEqualityComparer" + tcref_System_Collections_Generic_IEqualityComparer = mkSysTyconRef sysGenerics "IEqualityComparer`1" + tcref_System_Collections_Generic_Dictionary = mkSysTyconRef sysGenerics "Dictionary`2" tcref_System_IComparable = mkSysTyconRef sys "IComparable" tcref_System_IStructuralComparable = mkSysTyconRef sysCollections "IStructuralComparable" - tcref_System_IStructuralEquatable = mkSysTyconRef sysCollections "IStructuralEquatable"; + tcref_System_IStructuralEquatable = mkSysTyconRef sysCollections "IStructuralEquatable" - tcref_LanguagePrimitives = mk_MFCore_tcref fslibCcu "LanguagePrimitives"; + tcref_LanguagePrimitives = mk_MFCore_tcref fslibCcu "LanguagePrimitives" - tcref_System_Collections_Generic_IList = mkSysTyconRef sysGenerics "IList`1"; - tcref_System_Collections_Generic_IReadOnlyList = mkSysTyconRef sysGenerics "IReadOnlyList`1"; - tcref_System_Collections_Generic_ICollection = mkSysTyconRef sysGenerics "ICollection`1"; - tcref_System_Collections_Generic_IReadOnlyCollection = mkSysTyconRef sysGenerics "IReadOnlyCollection`1"; + tcref_System_Collections_Generic_IList = mkSysTyconRef sysGenerics "IList`1" + tcref_System_Collections_Generic_IReadOnlyList = mkSysTyconRef sysGenerics "IReadOnlyList`1" + tcref_System_Collections_Generic_ICollection = mkSysTyconRef sysGenerics "ICollection`1" + tcref_System_Collections_Generic_IReadOnlyCollection = mkSysTyconRef sysGenerics "IReadOnlyCollection`1" tcref_System_Collections_IEnumerable = tcref_System_Collections_IEnumerable - tcref_System_Collections_Generic_IEnumerable = IEnumerable_tcr; - tcref_System_Collections_Generic_IEnumerator = IEnumerator_tcr; + tcref_System_Collections_Generic_IEnumerable = IEnumerable_tcr + tcref_System_Collections_Generic_IEnumerator = IEnumerator_tcr - tcref_System_Attribute = System_Attribute_tcr; + tcref_System_Attribute = System_Attribute_tcr - attrib_AttributeUsageAttribute = mkSystemRuntimeAttrib "System.AttributeUsageAttribute"; - attrib_ParamArrayAttribute = mkSystemRuntimeAttrib "System.ParamArrayAttribute"; + attrib_AttributeUsageAttribute = mkSystemRuntimeAttrib "System.AttributeUsageAttribute" + attrib_ParamArrayAttribute = mkSystemRuntimeAttrib "System.ParamArrayAttribute" attrib_IDispatchConstantAttribute = if ilg.traits.IDispatchConstantAttributeScopeRef.IsSome then Some(mkSystemRuntimeAttrib "System.Runtime.CompilerServices.IDispatchConstantAttribute") else None attrib_IUnknownConstantAttribute = if ilg.traits.IUnknownConstantAttributeScopeRef.IsSome then Some (mkSystemRuntimeAttrib "System.Runtime.CompilerServices.IUnknownConstantAttribute") else None - attrib_SystemObsolete = mkSystemRuntimeAttrib "System.ObsoleteAttribute"; - attrib_DllImportAttribute = mkSystemRuntimeInteropServicesAttribute "System.Runtime.InteropServices.DllImportAttribute"; - attrib_StructLayoutAttribute = mkSystemRuntimeAttrib "System.Runtime.InteropServices.StructLayoutAttribute"; - attrib_TypeForwardedToAttribute = mkSystemRuntimeAttrib "System.Runtime.CompilerServices.TypeForwardedToAttribute"; - attrib_ComVisibleAttribute = mkSystemRuntimeAttrib "System.Runtime.InteropServices.ComVisibleAttribute"; - attrib_ComImportAttribute = mkSystemRuntimeInteropServicesAttribute "System.Runtime.InteropServices.ComImportAttribute"; - attrib_FieldOffsetAttribute = mkSystemRuntimeAttrib "System.Runtime.InteropServices.FieldOffsetAttribute" ; - attrib_MarshalAsAttribute = mkSystemRuntimeInteropServicesAttribute "System.Runtime.InteropServices.MarshalAsAttribute"; - attrib_InAttribute = mkSystemRuntimeInteropServicesAttribute "System.Runtime.InteropServices.InAttribute" ; - attrib_OutAttribute = mkSystemRuntimeAttrib "System.Runtime.InteropServices.OutAttribute" ; - attrib_OptionalAttribute = mkSystemRuntimeInteropServicesAttribute "System.Runtime.InteropServices.OptionalAttribute" ; + attrib_SystemObsolete = mkSystemRuntimeAttrib "System.ObsoleteAttribute" + attrib_DllImportAttribute = mkSystemRuntimeInteropServicesAttribute "System.Runtime.InteropServices.DllImportAttribute" + attrib_StructLayoutAttribute = mkSystemRuntimeAttrib "System.Runtime.InteropServices.StructLayoutAttribute" + attrib_TypeForwardedToAttribute = mkSystemRuntimeAttrib "System.Runtime.CompilerServices.TypeForwardedToAttribute" + attrib_ComVisibleAttribute = mkSystemRuntimeAttrib "System.Runtime.InteropServices.ComVisibleAttribute" + attrib_ComImportAttribute = mkSystemRuntimeInteropServicesAttribute "System.Runtime.InteropServices.ComImportAttribute" + attrib_FieldOffsetAttribute = mkSystemRuntimeAttrib "System.Runtime.InteropServices.FieldOffsetAttribute" + attrib_MarshalAsAttribute = mkSystemRuntimeInteropServicesAttribute "System.Runtime.InteropServices.MarshalAsAttribute" + attrib_InAttribute = mkSystemRuntimeInteropServicesAttribute "System.Runtime.InteropServices.InAttribute" + attrib_OutAttribute = mkSystemRuntimeAttrib "System.Runtime.InteropServices.OutAttribute" + attrib_OptionalAttribute = mkSystemRuntimeInteropServicesAttribute "System.Runtime.InteropServices.OptionalAttribute" attrib_ThreadStaticAttribute = if ilg.traits.ThreadStaticAttributeScopeRef.IsSome then Some(mkSystemRuntimeAttrib "System.ThreadStaticAttribute") else None attrib_SpecialNameAttribute = if ilg.traits.SpecialNameAttributeScopeRef.IsSome then Some(mkSystemRuntimeAttrib "System.Runtime.CompilerServices.SpecialNameAttribute") else None - attrib_VolatileFieldAttribute = mk_MFCore_attrib "VolatileFieldAttribute"; - attrib_ContextStaticAttribute = if ilg.traits.ContextStaticAttributeScopeRef.IsSome then Some (mkSystemRuntimeAttrib "System.ContextStaticAttribute") else None; - attrib_FlagsAttribute = mkSystemRuntimeAttrib "System.FlagsAttribute"; - attrib_DefaultMemberAttribute = mkSystemRuntimeAttrib "System.Reflection.DefaultMemberAttribute"; - attrib_DebuggerDisplayAttribute = mkSystemDiagnosticsDebugAttribute "System.Diagnostics.DebuggerDisplayAttribute"; - attrib_DebuggerTypeProxyAttribute = mkSystemDiagnosticsDebugAttribute "System.Diagnostics.DebuggerTypeProxyAttribute"; - attrib_PreserveSigAttribute = mkSystemRuntimeInteropServicesAttribute "System.Runtime.InteropServices.PreserveSigAttribute"; - attrib_MethodImplAttribute = mkSystemRuntimeAttrib "System.Runtime.CompilerServices.MethodImplAttribute"; - attrib_ExtensionAttribute = mkSystemRuntimeAttrib "System.Runtime.CompilerServices.ExtensionAttribute"; + attrib_VolatileFieldAttribute = mk_MFCore_attrib "VolatileFieldAttribute" + attrib_ContextStaticAttribute = if ilg.traits.ContextStaticAttributeScopeRef.IsSome then Some (mkSystemRuntimeAttrib "System.ContextStaticAttribute") else None + attrib_FlagsAttribute = mkSystemRuntimeAttrib "System.FlagsAttribute" + attrib_DefaultMemberAttribute = mkSystemRuntimeAttrib "System.Reflection.DefaultMemberAttribute" + attrib_DebuggerDisplayAttribute = mkSystemDiagnosticsDebugAttribute "System.Diagnostics.DebuggerDisplayAttribute" + attrib_DebuggerTypeProxyAttribute = mkSystemDiagnosticsDebugAttribute "System.Diagnostics.DebuggerTypeProxyAttribute" + attrib_PreserveSigAttribute = mkSystemRuntimeInteropServicesAttribute "System.Runtime.InteropServices.PreserveSigAttribute" + attrib_MethodImplAttribute = mkSystemRuntimeAttrib "System.Runtime.CompilerServices.MethodImplAttribute" + attrib_ExtensionAttribute = mkSystemRuntimeAttrib "System.Runtime.CompilerServices.ExtensionAttribute" - attrib_ProjectionParameterAttribute = mk_MFCore_attrib "ProjectionParameterAttribute"; - attrib_CustomOperationAttribute = mk_MFCore_attrib "CustomOperationAttribute"; - attrib_NonSerializedAttribute = if ilg.traits.NonSerializedAttributeScopeRef.IsSome then Some(mkSystemRuntimeAttrib "System.NonSerializedAttribute") else None; - attrib_AutoSerializableAttribute = mk_MFCore_attrib "AutoSerializableAttribute"; - attrib_RequireQualifiedAccessAttribute = mk_MFCore_attrib "RequireQualifiedAccessAttribute"; - attrib_EntryPointAttribute = mk_MFCore_attrib "EntryPointAttribute"; - attrib_DefaultAugmentationAttribute = mk_MFCore_attrib "DefaultAugmentationAttribute"; - attrib_CompilerMessageAttribute = mk_MFCore_attrib "CompilerMessageAttribute"; - attrib_ExperimentalAttribute = mk_MFCore_attrib "ExperimentalAttribute"; - attrib_UnverifiableAttribute = mk_MFCore_attrib "UnverifiableAttribute"; - attrib_LiteralAttribute = mk_MFCore_attrib "LiteralAttribute"; - attrib_ConditionalAttribute = mkSystemRuntimeAttrib "System.Diagnostics.ConditionalAttribute"; - attrib_OptionalArgumentAttribute = mk_MFCore_attrib "OptionalArgumentAttribute"; - attrib_RequiresExplicitTypeArgumentsAttribute = mk_MFCore_attrib "RequiresExplicitTypeArgumentsAttribute"; - attrib_DefaultValueAttribute = mk_MFCore_attrib "DefaultValueAttribute"; - attrib_ClassAttribute = mk_MFCore_attrib "ClassAttribute"; - attrib_InterfaceAttribute = mk_MFCore_attrib "InterfaceAttribute"; - attrib_StructAttribute = mk_MFCore_attrib "StructAttribute"; - attrib_ReflectedDefinitionAttribute = mk_MFCore_attrib "ReflectedDefinitionAttribute"; - attrib_CompiledNameAttribute = mk_MFCore_attrib "CompiledNameAttribute"; - attrib_AutoOpenAttribute = mk_MFCore_attrib "AutoOpenAttribute"; - attrib_CompilationRepresentationAttribute = mk_MFCore_attrib "CompilationRepresentationAttribute"; - attrib_CompilationArgumentCountsAttribute = mk_MFCore_attrib "CompilationArgumentCountsAttribute"; - attrib_CompilationMappingAttribute = mk_MFCore_attrib "CompilationMappingAttribute"; - attrib_CLIEventAttribute = mk_MFCore_attrib "CLIEventAttribute"; - attrib_CLIMutableAttribute = mk_MFCore_attrib "CLIMutableAttribute"; - attrib_AllowNullLiteralAttribute = mk_MFCore_attrib "AllowNullLiteralAttribute"; - attrib_NoEqualityAttribute = mk_MFCore_attrib "NoEqualityAttribute"; - attrib_NoComparisonAttribute = mk_MFCore_attrib "NoComparisonAttribute"; - attrib_CustomEqualityAttribute = mk_MFCore_attrib "CustomEqualityAttribute"; - attrib_CustomComparisonAttribute = mk_MFCore_attrib "CustomComparisonAttribute"; - attrib_EqualityConditionalOnAttribute = mk_MFCore_attrib "EqualityConditionalOnAttribute"; - attrib_ComparisonConditionalOnAttribute = mk_MFCore_attrib "ComparisonConditionalOnAttribute"; - attrib_ReferenceEqualityAttribute = mk_MFCore_attrib "ReferenceEqualityAttribute"; - attrib_StructuralEqualityAttribute = mk_MFCore_attrib "StructuralEqualityAttribute"; - attrib_StructuralComparisonAttribute = mk_MFCore_attrib "StructuralComparisonAttribute"; - attrib_SealedAttribute = mk_MFCore_attrib "SealedAttribute"; - attrib_AbstractClassAttribute = mk_MFCore_attrib "AbstractClassAttribute"; - attrib_GeneralizableValueAttribute = mk_MFCore_attrib "GeneralizableValueAttribute"; - attrib_MeasureAttribute = mk_MFCore_attrib "MeasureAttribute"; - attrib_MeasureableAttribute = mk_MFCore_attrib "MeasureAnnotatedAbbreviationAttribute"; - attrib_NoDynamicInvocationAttribute = mk_MFCore_attrib "NoDynamicInvocationAttribute"; + attrib_ProjectionParameterAttribute = mk_MFCore_attrib "ProjectionParameterAttribute" + attrib_CustomOperationAttribute = mk_MFCore_attrib "CustomOperationAttribute" + attrib_NonSerializedAttribute = if ilg.traits.NonSerializedAttributeScopeRef.IsSome then Some(mkSystemRuntimeAttrib "System.NonSerializedAttribute") else None + attrib_AutoSerializableAttribute = mk_MFCore_attrib "AutoSerializableAttribute" + attrib_RequireQualifiedAccessAttribute = mk_MFCore_attrib "RequireQualifiedAccessAttribute" + attrib_EntryPointAttribute = mk_MFCore_attrib "EntryPointAttribute" + attrib_DefaultAugmentationAttribute = mk_MFCore_attrib "DefaultAugmentationAttribute" + attrib_CompilerMessageAttribute = mk_MFCore_attrib "CompilerMessageAttribute" + attrib_ExperimentalAttribute = mk_MFCore_attrib "ExperimentalAttribute" + attrib_UnverifiableAttribute = mk_MFCore_attrib "UnverifiableAttribute" + attrib_LiteralAttribute = mk_MFCore_attrib "LiteralAttribute" + attrib_ConditionalAttribute = mkSystemRuntimeAttrib "System.Diagnostics.ConditionalAttribute" + attrib_OptionalArgumentAttribute = mk_MFCore_attrib "OptionalArgumentAttribute" + attrib_RequiresExplicitTypeArgumentsAttribute = mk_MFCore_attrib "RequiresExplicitTypeArgumentsAttribute" + attrib_DefaultValueAttribute = mk_MFCore_attrib "DefaultValueAttribute" + attrib_ClassAttribute = mk_MFCore_attrib "ClassAttribute" + attrib_InterfaceAttribute = mk_MFCore_attrib "InterfaceAttribute" + attrib_StructAttribute = mk_MFCore_attrib "StructAttribute" + attrib_ReflectedDefinitionAttribute = mk_MFCore_attrib "ReflectedDefinitionAttribute" + attrib_CompiledNameAttribute = mk_MFCore_attrib "CompiledNameAttribute" + attrib_AutoOpenAttribute = mk_MFCore_attrib "AutoOpenAttribute" + attrib_CompilationRepresentationAttribute = mk_MFCore_attrib "CompilationRepresentationAttribute" + attrib_CompilationArgumentCountsAttribute = mk_MFCore_attrib "CompilationArgumentCountsAttribute" + attrib_CompilationMappingAttribute = mk_MFCore_attrib "CompilationMappingAttribute" + attrib_CLIEventAttribute = mk_MFCore_attrib "CLIEventAttribute" + attrib_CLIMutableAttribute = mk_MFCore_attrib "CLIMutableAttribute" + attrib_AllowNullLiteralAttribute = mk_MFCore_attrib "AllowNullLiteralAttribute" + attrib_NoEqualityAttribute = mk_MFCore_attrib "NoEqualityAttribute" + attrib_NoComparisonAttribute = mk_MFCore_attrib "NoComparisonAttribute" + attrib_CustomEqualityAttribute = mk_MFCore_attrib "CustomEqualityAttribute" + attrib_CustomComparisonAttribute = mk_MFCore_attrib "CustomComparisonAttribute" + attrib_EqualityConditionalOnAttribute = mk_MFCore_attrib "EqualityConditionalOnAttribute" + attrib_ComparisonConditionalOnAttribute = mk_MFCore_attrib "ComparisonConditionalOnAttribute" + attrib_ReferenceEqualityAttribute = mk_MFCore_attrib "ReferenceEqualityAttribute" + attrib_StructuralEqualityAttribute = mk_MFCore_attrib "StructuralEqualityAttribute" + attrib_StructuralComparisonAttribute = mk_MFCore_attrib "StructuralComparisonAttribute" + attrib_SealedAttribute = mk_MFCore_attrib "SealedAttribute" + attrib_AbstractClassAttribute = mk_MFCore_attrib "AbstractClassAttribute" + attrib_GeneralizableValueAttribute = mk_MFCore_attrib "GeneralizableValueAttribute" + attrib_MeasureAttribute = mk_MFCore_attrib "MeasureAttribute" + attrib_MeasureableAttribute = mk_MFCore_attrib "MeasureAnnotatedAbbreviationAttribute" + attrib_NoDynamicInvocationAttribute = mk_MFCore_attrib "NoDynamicInvocationAttribute" attrib_SecurityAttribute = if ilg.traits.SecurityPermissionAttributeTypeScopeRef.IsSome then Some(mkSystemRuntimeAttrib"System.Security.Permissions.SecurityAttribute") else None attrib_SecurityCriticalAttribute = mkSystemRuntimeAttrib "System.Security.SecurityCriticalAttribute" attrib_SecuritySafeCriticalAttribute = mkSystemRuntimeAttrib "System.Security.SecuritySafeCriticalAttribute" @@ -1234,36 +1231,36 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa better_tcref_map = begin let entries1 = - [ "Int32", int_tcr; - "IntPtr", nativeint_tcr; - "UIntPtr", unativeint_tcr; - "Int16",int16_tcr; - "Int64",int64_tcr; - "UInt16",uint16_tcr; - "UInt32",uint32_tcr; - "UInt64",uint64_tcr; - "SByte",sbyte_tcr; - "Decimal",decimal_tcr; - "Byte",byte_tcr; - "Boolean",bool_tcr; - "String",string_tcr; - "Object",obj_tcr; - "Exception",exn_tcr; - "Char",char_tcr; - "Double",float_tcr; - "Single",float32_tcr;] + [ "Int32", int_tcr + "IntPtr", nativeint_tcr + "UIntPtr", unativeint_tcr + "Int16",int16_tcr + "Int64",int64_tcr + "UInt16",uint16_tcr + "UInt32",uint32_tcr + "UInt64",uint64_tcr + "SByte",sbyte_tcr + "Decimal",decimal_tcr + "Byte",byte_tcr + "Boolean",bool_tcr + "String",string_tcr + "Object",obj_tcr + "Exception",exn_tcr + "Char",char_tcr + "Double",float_tcr + "Single",float32_tcr] |> List.map (fun (nm,tcr) -> let ty = mkNonGenericTy tcr nm, mkSysTyconRef sys nm, (fun _ -> ty)) let entries2 = - [ "FSharpFunc`2", fastFunc_tcr, (fun tinst -> mkFunTy (List.nth tinst 0) (List.nth tinst 1)); - "Tuple`2", tuple2_tcr, decodeTupleTy; - "Tuple`3", tuple3_tcr, decodeTupleTy; - "Tuple`4", tuple4_tcr, decodeTupleTy; - "Tuple`5", tuple5_tcr, decodeTupleTy; - "Tuple`6", tuple6_tcr, decodeTupleTy; - "Tuple`7", tuple7_tcr, decodeTupleTy; - "Tuple`8", tuple8_tcr, decodeTupleTy;] + [ "FSharpFunc`2", fastFunc_tcr, (fun tinst -> mkFunTy (List.nth tinst 0) (List.nth tinst 1)) + "Tuple`2", tuple2_tcr, decodeTupleTy + "Tuple`3", tuple3_tcr, decodeTupleTy + "Tuple`4", tuple4_tcr, decodeTupleTy + "Tuple`5", tuple5_tcr, decodeTupleTy + "Tuple`6", tuple6_tcr, decodeTupleTy + "Tuple`7", tuple7_tcr, decodeTupleTy + "Tuple`8", tuple8_tcr, decodeTupleTy] let entries = (entries1 @ entries2) if compilingFslib then @@ -1290,175 +1287,175 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa (fun tcref2 tinst -> if dict.ContainsKey tcref2.Stamp then Some(dict.[tcref2.Stamp] tinst) else None) - end; + end - new_decimal_info = new_decimal_info; - seq_info = seq_info; - seq_vref = (ValRefForIntrinsic seq_info) ; - and_vref = (ValRefForIntrinsic and_info) ; - and2_vref = (ValRefForIntrinsic and2_info); - addrof_vref = (ValRefForIntrinsic addrof_info); - addrof2_vref = (ValRefForIntrinsic addrof2_info); - or_vref = (ValRefForIntrinsic or_info); - //splice_vref = (ValRefForIntrinsic splice_info); - splice_expr_vref = (ValRefForIntrinsic splice_expr_info); - splice_raw_expr_vref = (ValRefForIntrinsic splice_raw_expr_info); - or2_vref = (ValRefForIntrinsic or2_info); - generic_equality_er_inner_vref = ValRefForIntrinsic generic_equality_er_inner_info; - generic_equality_per_inner_vref = ValRefForIntrinsic generic_equality_per_inner_info; - generic_equality_withc_inner_vref = ValRefForIntrinsic generic_equality_withc_inner_info; - generic_comparison_inner_vref = ValRefForIntrinsic generic_comparison_inner_info; - generic_comparison_withc_inner_vref = ValRefForIntrinsic generic_comparison_withc_inner_info; - generic_comparison_withc_outer_info = generic_comparison_withc_outer_info; - generic_equality_er_outer_info = generic_equality_er_outer_info; - generic_equality_withc_outer_info = generic_equality_withc_outer_info; - generic_hash_withc_outer_info = generic_hash_withc_outer_info; - generic_hash_inner_vref = ValRefForIntrinsic generic_hash_inner_info; - generic_hash_withc_inner_vref = ValRefForIntrinsic generic_hash_withc_inner_info; - - reference_equality_inner_vref = ValRefForIntrinsic reference_equality_inner_info; - - bitwise_or_vref = ValRefForIntrinsic bitwise_or_info; - bitwise_and_vref = ValRefForIntrinsic bitwise_and_info; - bitwise_xor_vref = ValRefForIntrinsic bitwise_xor_info; - bitwise_unary_not_vref = ValRefForIntrinsic bitwise_unary_not_info; - bitwise_shift_left_vref = ValRefForIntrinsic bitwise_shift_left_info; - bitwise_shift_right_vref = ValRefForIntrinsic bitwise_shift_right_info; - unchecked_addition_vref = ValRefForIntrinsic unchecked_addition_info; - unchecked_unary_plus_vref = ValRefForIntrinsic unchecked_unary_plus_info; - unchecked_unary_minus_vref = ValRefForIntrinsic unchecked_unary_minus_info; - unchecked_unary_not_vref = ValRefForIntrinsic unchecked_unary_not_info; - unchecked_subtraction_vref = ValRefForIntrinsic unchecked_subtraction_info; - unchecked_multiply_vref = ValRefForIntrinsic unchecked_multiply_info; - unchecked_defaultof_vref = ValRefForIntrinsic unchecked_defaultof_info; + new_decimal_info = new_decimal_info + seq_info = seq_info + seq_vref = (ValRefForIntrinsic seq_info) + and_vref = (ValRefForIntrinsic and_info) + and2_vref = (ValRefForIntrinsic and2_info) + addrof_vref = (ValRefForIntrinsic addrof_info) + addrof2_vref = (ValRefForIntrinsic addrof2_info) + or_vref = (ValRefForIntrinsic or_info) + //splice_vref = (ValRefForIntrinsic splice_info) + splice_expr_vref = (ValRefForIntrinsic splice_expr_info) + splice_raw_expr_vref = (ValRefForIntrinsic splice_raw_expr_info) + or2_vref = (ValRefForIntrinsic or2_info) + generic_equality_er_inner_vref = ValRefForIntrinsic generic_equality_er_inner_info + generic_equality_per_inner_vref = ValRefForIntrinsic generic_equality_per_inner_info + generic_equality_withc_inner_vref = ValRefForIntrinsic generic_equality_withc_inner_info + generic_comparison_inner_vref = ValRefForIntrinsic generic_comparison_inner_info + generic_comparison_withc_inner_vref = ValRefForIntrinsic generic_comparison_withc_inner_info + generic_comparison_withc_outer_info = generic_comparison_withc_outer_info + generic_equality_er_outer_info = generic_equality_er_outer_info + generic_equality_withc_outer_info = generic_equality_withc_outer_info + generic_hash_withc_outer_info = generic_hash_withc_outer_info + generic_hash_inner_vref = ValRefForIntrinsic generic_hash_inner_info + generic_hash_withc_inner_vref = ValRefForIntrinsic generic_hash_withc_inner_info + + reference_equality_inner_vref = ValRefForIntrinsic reference_equality_inner_info + + bitwise_or_vref = ValRefForIntrinsic bitwise_or_info + bitwise_and_vref = ValRefForIntrinsic bitwise_and_info + bitwise_xor_vref = ValRefForIntrinsic bitwise_xor_info + bitwise_unary_not_vref = ValRefForIntrinsic bitwise_unary_not_info + bitwise_shift_left_vref = ValRefForIntrinsic bitwise_shift_left_info + bitwise_shift_right_vref = ValRefForIntrinsic bitwise_shift_right_info + unchecked_addition_vref = ValRefForIntrinsic unchecked_addition_info + unchecked_unary_plus_vref = ValRefForIntrinsic unchecked_unary_plus_info + unchecked_unary_minus_vref = ValRefForIntrinsic unchecked_unary_minus_info + unchecked_unary_not_vref = ValRefForIntrinsic unchecked_unary_not_info + unchecked_subtraction_vref = ValRefForIntrinsic unchecked_subtraction_info + unchecked_multiply_vref = ValRefForIntrinsic unchecked_multiply_info + unchecked_defaultof_vref = ValRefForIntrinsic unchecked_defaultof_info unchecked_subtraction_info = unchecked_subtraction_info - compare_operator_vref = ValRefForIntrinsic compare_operator_info; - equals_operator_vref = ValRefForIntrinsic equals_operator_info; - equals_nullable_operator_vref = ValRefForIntrinsic equals_nullable_operator_info; - nullable_equals_nullable_operator_vref = ValRefForIntrinsic nullable_equals_nullable_operator_info; - nullable_equals_operator_vref = ValRefForIntrinsic nullable_equals_operator_info; - not_equals_operator_vref = ValRefForIntrinsic not_equals_operator_info; - less_than_operator_vref = ValRefForIntrinsic less_than_operator_info; - less_than_or_equals_operator_vref = ValRefForIntrinsic less_than_or_equals_operator_info; - greater_than_operator_vref = ValRefForIntrinsic greater_than_operator_info; - greater_than_or_equals_operator_vref = ValRefForIntrinsic greater_than_or_equals_operator_info; - - equals_operator_info = equals_operator_info; - - raise_info = raise_info; - reraise_info = reraise_info; - reraise_vref = ValRefForIntrinsic reraise_info; - methodhandleof_info = methodhandleof_info; - methodhandleof_vref = ValRefForIntrinsic methodhandleof_info; - typeof_info = typeof_info; - typeof_vref = ValRefForIntrinsic typeof_info; - sizeof_vref = ValRefForIntrinsic sizeof_info; - typedefof_info = typedefof_info; - typedefof_vref = ValRefForIntrinsic typedefof_info; - enum_vref = ValRefForIntrinsic enum_info; - enumOfValue_vref = ValRefForIntrinsic enumOfValue_info; - range_op_vref = ValRefForIntrinsic range_op_info; - range_int32_op_vref = ValRefForIntrinsic range_int32_op_info; - //range_step_op_vref = ValRefForIntrinsic range_step_op_info; + compare_operator_vref = ValRefForIntrinsic compare_operator_info + equals_operator_vref = ValRefForIntrinsic equals_operator_info + equals_nullable_operator_vref = ValRefForIntrinsic equals_nullable_operator_info + nullable_equals_nullable_operator_vref = ValRefForIntrinsic nullable_equals_nullable_operator_info + nullable_equals_operator_vref = ValRefForIntrinsic nullable_equals_operator_info + not_equals_operator_vref = ValRefForIntrinsic not_equals_operator_info + less_than_operator_vref = ValRefForIntrinsic less_than_operator_info + less_than_or_equals_operator_vref = ValRefForIntrinsic less_than_or_equals_operator_info + greater_than_operator_vref = ValRefForIntrinsic greater_than_operator_info + greater_than_or_equals_operator_vref = ValRefForIntrinsic greater_than_or_equals_operator_info + + equals_operator_info = equals_operator_info + + raise_info = raise_info + reraise_info = reraise_info + reraise_vref = ValRefForIntrinsic reraise_info + methodhandleof_info = methodhandleof_info + methodhandleof_vref = ValRefForIntrinsic methodhandleof_info + typeof_info = typeof_info + typeof_vref = ValRefForIntrinsic typeof_info + sizeof_vref = ValRefForIntrinsic sizeof_info + typedefof_info = typedefof_info + typedefof_vref = ValRefForIntrinsic typedefof_info + enum_vref = ValRefForIntrinsic enum_info + enumOfValue_vref = ValRefForIntrinsic enumOfValue_info + range_op_vref = ValRefForIntrinsic range_op_info + range_int32_op_vref = ValRefForIntrinsic range_int32_op_info + //range_step_op_vref = ValRefForIntrinsic range_step_op_info array_length_info = array_length_info - array_get_vref = ValRefForIntrinsic array_get_info; - array2D_get_vref = ValRefForIntrinsic array2D_get_info; - array3D_get_vref = ValRefForIntrinsic array3D_get_info; - array4D_get_vref = ValRefForIntrinsic array4D_get_info; - seq_singleton_vref = ValRefForIntrinsic seq_singleton_info; - seq_collect_vref = ValRefForIntrinsic seq_collect_info; - seq_collect_info = seq_collect_info; - seq_using_info = seq_using_info; - seq_using_vref = ValRefForIntrinsic seq_using_info; - seq_delay_info = seq_delay_info; - seq_delay_vref = ValRefForIntrinsic seq_delay_info; - seq_append_info = seq_append_info; - seq_append_vref = ValRefForIntrinsic seq_append_info; - seq_generated_info = seq_generated_info; - seq_generated_vref = ValRefForIntrinsic seq_generated_info; - seq_finally_info = seq_finally_info; - seq_finally_vref = ValRefForIntrinsic seq_finally_info; - seq_of_functions_info = seq_of_functions_info; - seq_of_functions_vref = ValRefForIntrinsic seq_of_functions_info; - seq_map_info = seq_map_info; - seq_map_vref = ValRefForIntrinsic seq_map_info; - seq_singleton_info = seq_singleton_info; - seq_empty_info = seq_empty_info; - seq_empty_vref = ValRefForIntrinsic seq_empty_info; - new_format_info = new_format_info; - new_format_vref = ValRefForIntrinsic new_format_info; - sprintf_vref = ValRefForIntrinsic sprintf_info; - unbox_vref = ValRefForIntrinsic unbox_info; - unbox_fast_vref = ValRefForIntrinsic unbox_fast_info; - istype_vref = ValRefForIntrinsic istype_info; - istype_fast_vref = ValRefForIntrinsic istype_fast_info; - unbox_info = unbox_info; - get_generic_comparer_info = get_generic_comparer_info; - get_generic_er_equality_comparer_info = get_generic_er_equality_comparer_info; - get_generic_per_equality_comparer_info = get_generic_per_equality_comparer_info; - dispose_info = dispose_info; - unbox_fast_info = unbox_fast_info; - istype_info = istype_info; - istype_fast_info = istype_fast_info; - lazy_force_info = lazy_force_info; - lazy_create_info = lazy_create_info; - create_instance_info = create_instance_info; - create_event_info = create_event_info; - seq_to_list_info = seq_to_list_info; - seq_to_array_info = seq_to_array_info; - array_get_info = array_get_info; - array2D_get_info = array2D_get_info; - array3D_get_info = array3D_get_info; - array4D_get_info = array4D_get_info; - deserialize_quoted_FSharp_20_plus_info = deserialize_quoted_FSharp_20_plus_info; - deserialize_quoted_FSharp_40_plus_info = deserialize_quoted_FSharp_40_plus_info; - cast_quotation_info = cast_quotation_info; - lift_value_info = lift_value_info; - lift_value_with_name_info = lift_value_with_name_info; - lift_value_with_defn_info = lift_value_with_defn_info; - query_source_as_enum_info = query_source_as_enum_info; - new_query_source_info = new_query_source_info; - query_source_vref = ValRefForIntrinsic query_source_info; - query_value_vref = ValRefForIntrinsic query_value_info; - query_run_value_vref = ValRefForIntrinsic query_run_value_info; - query_run_enumerable_vref = ValRefForIntrinsic query_run_enumerable_info; - query_for_vref = ValRefForIntrinsic query_for_value_info; - query_yield_vref = ValRefForIntrinsic query_yield_value_info; - query_yield_from_vref = ValRefForIntrinsic query_yield_from_value_info; - query_select_vref = ValRefForIntrinsic query_select_value_info; - query_where_vref = ValRefForIntrinsic query_where_value_info; - query_zero_vref = ValRefForIntrinsic query_zero_value_info; - query_builder_tcref = query_builder_tcref; - fail_init_info = fail_init_info; - fail_static_init_info = fail_static_init_info; - check_this_info = check_this_info; - quote_to_linq_lambda_info = quote_to_linq_lambda_info; - - - generic_hash_withc_tuple2_vref = ValRefForIntrinsic generic_hash_withc_tuple2_info; - generic_hash_withc_tuple3_vref = ValRefForIntrinsic generic_hash_withc_tuple3_info; - generic_hash_withc_tuple4_vref = ValRefForIntrinsic generic_hash_withc_tuple4_info; - generic_hash_withc_tuple5_vref = ValRefForIntrinsic generic_hash_withc_tuple5_info; - generic_equals_withc_tuple2_vref = ValRefForIntrinsic generic_equals_withc_tuple2_info; - generic_equals_withc_tuple3_vref = ValRefForIntrinsic generic_equals_withc_tuple3_info; - generic_equals_withc_tuple4_vref = ValRefForIntrinsic generic_equals_withc_tuple4_info; - generic_equals_withc_tuple5_vref = ValRefForIntrinsic generic_equals_withc_tuple5_info; - generic_compare_withc_tuple2_vref = ValRefForIntrinsic generic_compare_withc_tuple2_info; - generic_compare_withc_tuple3_vref = ValRefForIntrinsic generic_compare_withc_tuple3_info; - generic_compare_withc_tuple4_vref = ValRefForIntrinsic generic_compare_withc_tuple4_info; - generic_compare_withc_tuple5_vref = ValRefForIntrinsic generic_compare_withc_tuple5_info; - generic_equality_withc_outer_vref = ValRefForIntrinsic generic_equality_withc_outer_info; - - - cons_ucref = cons_ucref; - nil_ucref = nil_ucref; + array_get_vref = ValRefForIntrinsic array_get_info + array2D_get_vref = ValRefForIntrinsic array2D_get_info + array3D_get_vref = ValRefForIntrinsic array3D_get_info + array4D_get_vref = ValRefForIntrinsic array4D_get_info + seq_singleton_vref = ValRefForIntrinsic seq_singleton_info + seq_collect_vref = ValRefForIntrinsic seq_collect_info + seq_collect_info = seq_collect_info + seq_using_info = seq_using_info + seq_using_vref = ValRefForIntrinsic seq_using_info + seq_delay_info = seq_delay_info + seq_delay_vref = ValRefForIntrinsic seq_delay_info + seq_append_info = seq_append_info + seq_append_vref = ValRefForIntrinsic seq_append_info + seq_generated_info = seq_generated_info + seq_generated_vref = ValRefForIntrinsic seq_generated_info + seq_finally_info = seq_finally_info + seq_finally_vref = ValRefForIntrinsic seq_finally_info + seq_of_functions_info = seq_of_functions_info + seq_of_functions_vref = ValRefForIntrinsic seq_of_functions_info + seq_map_info = seq_map_info + seq_map_vref = ValRefForIntrinsic seq_map_info + seq_singleton_info = seq_singleton_info + seq_empty_info = seq_empty_info + seq_empty_vref = ValRefForIntrinsic seq_empty_info + new_format_info = new_format_info + new_format_vref = ValRefForIntrinsic new_format_info + sprintf_vref = ValRefForIntrinsic sprintf_info + unbox_vref = ValRefForIntrinsic unbox_info + unbox_fast_vref = ValRefForIntrinsic unbox_fast_info + istype_vref = ValRefForIntrinsic istype_info + istype_fast_vref = ValRefForIntrinsic istype_fast_info + unbox_info = unbox_info + get_generic_comparer_info = get_generic_comparer_info + get_generic_er_equality_comparer_info = get_generic_er_equality_comparer_info + get_generic_per_equality_comparer_info = get_generic_per_equality_comparer_info + dispose_info = dispose_info + unbox_fast_info = unbox_fast_info + istype_info = istype_info + istype_fast_info = istype_fast_info + lazy_force_info = lazy_force_info + lazy_create_info = lazy_create_info + create_instance_info = create_instance_info + create_event_info = create_event_info + seq_to_list_info = seq_to_list_info + seq_to_array_info = seq_to_array_info + array_get_info = array_get_info + array2D_get_info = array2D_get_info + array3D_get_info = array3D_get_info + array4D_get_info = array4D_get_info + deserialize_quoted_FSharp_20_plus_info = deserialize_quoted_FSharp_20_plus_info + deserialize_quoted_FSharp_40_plus_info = deserialize_quoted_FSharp_40_plus_info + cast_quotation_info = cast_quotation_info + lift_value_info = lift_value_info + lift_value_with_name_info = lift_value_with_name_info + lift_value_with_defn_info = lift_value_with_defn_info + query_source_as_enum_info = query_source_as_enum_info + new_query_source_info = new_query_source_info + query_source_vref = ValRefForIntrinsic query_source_info + query_value_vref = ValRefForIntrinsic query_value_info + query_run_value_vref = ValRefForIntrinsic query_run_value_info + query_run_enumerable_vref = ValRefForIntrinsic query_run_enumerable_info + query_for_vref = ValRefForIntrinsic query_for_value_info + query_yield_vref = ValRefForIntrinsic query_yield_value_info + query_yield_from_vref = ValRefForIntrinsic query_yield_from_value_info + query_select_vref = ValRefForIntrinsic query_select_value_info + query_where_vref = ValRefForIntrinsic query_where_value_info + query_zero_vref = ValRefForIntrinsic query_zero_value_info + query_builder_tcref = query_builder_tcref + fail_init_info = fail_init_info + fail_static_init_info = fail_static_init_info + check_this_info = check_this_info + quote_to_linq_lambda_info = quote_to_linq_lambda_info + + + generic_hash_withc_tuple2_vref = ValRefForIntrinsic generic_hash_withc_tuple2_info + generic_hash_withc_tuple3_vref = ValRefForIntrinsic generic_hash_withc_tuple3_info + generic_hash_withc_tuple4_vref = ValRefForIntrinsic generic_hash_withc_tuple4_info + generic_hash_withc_tuple5_vref = ValRefForIntrinsic generic_hash_withc_tuple5_info + generic_equals_withc_tuple2_vref = ValRefForIntrinsic generic_equals_withc_tuple2_info + generic_equals_withc_tuple3_vref = ValRefForIntrinsic generic_equals_withc_tuple3_info + generic_equals_withc_tuple4_vref = ValRefForIntrinsic generic_equals_withc_tuple4_info + generic_equals_withc_tuple5_vref = ValRefForIntrinsic generic_equals_withc_tuple5_info + generic_compare_withc_tuple2_vref = ValRefForIntrinsic generic_compare_withc_tuple2_info + generic_compare_withc_tuple3_vref = ValRefForIntrinsic generic_compare_withc_tuple3_info + generic_compare_withc_tuple4_vref = ValRefForIntrinsic generic_compare_withc_tuple4_info + generic_compare_withc_tuple5_vref = ValRefForIntrinsic generic_compare_withc_tuple5_info + generic_equality_withc_outer_vref = ValRefForIntrinsic generic_equality_withc_outer_info + + + cons_ucref = cons_ucref + nil_ucref = nil_ucref - suppressed_types = suppressed_types; + suppressed_types = suppressed_types isInteractive=isInteractive mkSysTyconRef=mkSysTyconRef } -let public mkMscorlibAttrib g nm : BuiltinAttribInfo = +let public mkMscorlibAttrib g nm = let path, typeName = splitILTypeName nm AttribInfo(mkILTyRef (g.ilg.traits.ScopeRef,nm), g.mkSysTyconRef path typeName) diff --git a/src/fsharp/tc.fs b/src/fsharp/TypeChecker.fs similarity index 99% rename from src/fsharp/tc.fs rename to src/fsharp/TypeChecker.fs index e8a15980172f182adc5a7c3a6c5c79c029e1cbd1..6da70f771ff7f271ec92e9bdaede7f69f199c4e9 100644 --- a/src/fsharp/tc.fs +++ b/src/fsharp/TypeChecker.fs @@ -12,6 +12,7 @@ open Microsoft.FSharp.Compiler.AbstractIL open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.AbstractIL.Internal open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library +open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library.ResultOrException open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Microsoft.FSharp.Compiler @@ -22,18 +23,17 @@ open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.Tastops.DebugPrint -open Microsoft.FSharp.Compiler.Patcompile -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.PatternMatchCompilation +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.Layout -open Microsoft.FSharp.Compiler.Outcome open Microsoft.FSharp.Compiler.Infos open Microsoft.FSharp.Compiler.Infos.AccessibilityLogic open Microsoft.FSharp.Compiler.Infos.AttributeChecking -open Microsoft.FSharp.Compiler.Typrelns +open Microsoft.FSharp.Compiler.TypeRelations open Microsoft.FSharp.Compiler.ConstraintSolver -open Microsoft.FSharp.Compiler.Nameres +open Microsoft.FSharp.Compiler.NameResolution open Microsoft.FSharp.Compiler.PrettyNaming open System open System.Collections.Generic @@ -471,7 +471,7 @@ let AddDeclaredTypars check typars env = /// - the set of active fixups for "letrec" type inference [] type cenv = - { g: Env.TcGlobals + { g: TcGlobals /// Push an entry every time a recursive value binding is used, /// in order to be able to fix up recursive type applications as @@ -555,7 +555,7 @@ let MakeInnerEnv env nm modKind = let path = env.ePath @ [nm] (* Note: here we allocate a new module type accumulator *) let mtypeAcc = ref (NewEmptyModuleOrNamespaceType modKind) - let cpath = mkNestedCPath env.eCompPath nm.idText modKind + let cpath = env.eCompPath.NestedCompPath nm.idText modKind { env with ePath = path eCompPath = cpath eAccessPath = cpath @@ -572,7 +572,7 @@ let MakeInnerEnvForTyconRef _cenv env tcref isExtrinsicExtension = // Regular members get access to protected stuff let env = EnterFamilyRegion tcref env // Note: assumes no nesting - let eAccessPath = mkNestedCPath env.eCompPath tcref.LogicalName ModuleOrType + let eAccessPath = env.eCompPath.NestedCompPath tcref.LogicalName ModuleOrType { env with eAccessRights = computeAccessRights eAccessPath env.eInternalsVisibleCompPaths env.eFamilyType // update this computed field eAccessPath = eAccessPath } @@ -597,14 +597,14 @@ let LocateEnv ccu env enclosingNamespacePath = let env = List.fold (fun env id -> MakeInnerEnv env id Namespace |> fst) env enclosingNamespacePath env -let BuildRootModuleType enclosingNamespacePath cpath mtyp = +let BuildRootModuleType enclosingNamespacePath (cpath:CompilationPath) mtyp = (enclosingNamespacePath,(cpath, mtyp)) - ||> List.foldBack (fun id (cpath, mtyp) -> (parentCompPath cpath, wrapModuleOrNamespaceTypeInNamespace id (parentCompPath cpath) mtyp)) + ||> List.foldBack (fun id (cpath, mtyp) -> (cpath.ParentCompPath, wrapModuleOrNamespaceTypeInNamespace id cpath.ParentCompPath mtyp)) |> snd -let BuildRootModuleExpr enclosingNamespacePath cpath mexpr = +let BuildRootModuleExpr enclosingNamespacePath (cpath:CompilationPath) mexpr = (enclosingNamespacePath,(cpath, mexpr)) - ||> List.foldBack (fun id (cpath, mexpr) -> (parentCompPath cpath, wrapModuleOrNamespaceExprInNamespace id (parentCompPath cpath) mexpr)) + ||> List.foldBack (fun id (cpath, mexpr) -> (cpath.ParentCompPath, wrapModuleOrNamespaceExprInNamespace id cpath.ParentCompPath mexpr)) |> snd let TryStripPrefixPath (g:TcGlobals) (enclosingNamespacePath: Ident list) = @@ -940,7 +940,7 @@ type ValMemberInfoTransient = ValMemberInfoTransient of ValMemberInfo * string * let MakeMemberDataAndMangledNameForMemberVal(g,tcref,isExtrinsic,attrs,optImplSlotTys,memberFlags,valSynData,id,isCompGen) = let logicalName = ComputeLogicalName id memberFlags let optIntfSlotTys = if optImplSlotTys |> List.forall (isInterfaceTy g) then optImplSlotTys else [] - let memberInfo = + let memberInfo : ValMemberInfo = { ApparentParent=tcref MemberFlags=memberFlags IsImplemented=false @@ -1165,7 +1165,7 @@ type CheckedBindingInfo = bool * (* immutable? *) Tast.Attribs * XmlDoc * - (TcPatPhase2Input -> Patcompile.Pattern) * + (TcPatPhase2Input -> PatternMatchCompilation.Pattern) * ExplicitTyparInfo * NameMap * Expr * @@ -2924,7 +2924,7 @@ let BuildILFieldGet g amap m objExpr (finfo:ILFieldInfo) = | _ -> #endif let wrap,objExpr = mkExprAddrOfExpr g isValueType false NeverMutates objExpr None m - // The empty instantiation on the AbstractIL fspec is OK, since we make the correct fspec in Ilxgen.GenAsm + // The empty instantiation on the AbstractIL fspec is OK, since we make the correct fspec in IlxGen.GenAsm // This ensures we always get the type instantiation right when doing this from // polymorphic code, after inlining etc. * let fspec = mkILFieldSpec(fref,mkILNamedTy valu fref.EnclosingTypeRef []) @@ -2936,7 +2936,7 @@ let BuildILFieldSet g m objExpr (finfo:ILFieldInfo) argExpr = let isValueType = finfo.IsValueType let valu = if isValueType then AsValue else AsObject let tinst = finfo.TypeInst - // The empty instantiation on the AbstractIL fspec is OK, since we make the correct fspec in Ilxgen.gen_asm + // The empty instantiation on the AbstractIL fspec is OK, since we make the correct fspec in IlxGen.GenAsm // This ensures we always get the type instantiation right when doing this from // polymorphic code, after inlining etc. * let fspec = mkILFieldSpec(fref,mkILNamedTy valu fref.EnclosingTypeRef []) @@ -2949,7 +2949,7 @@ let BuildILStaticFieldSet m (finfo:ILFieldInfo) argExpr = let isValueType = finfo.IsValueType let valu = if isValueType then AsValue else AsObject let tinst = finfo.TypeInst - // The empty instantiation on the AbstractIL fspec is OK, since we make the correct fspec in Ilxgen.gen_asm + // The empty instantiation on the AbstractIL fspec is OK, since we make the correct fspec in IlxGen.GenAsm // This ensures we always get the type instantiation right when doing this from // polymorphic code, after inlining etc. let fspec = mkILFieldSpec(fref,mkILNamedTy valu fref.EnclosingTypeRef []) @@ -5881,7 +5881,7 @@ and TcRecordConstruction cenv overallTy env tpenv optOrigExpr objTy fldsList m = fspecs |> List.filter (fun rfld -> rfld.Name |> fieldNameUnbound) |> List.filter (fun f -> not f.IsZeroInit) - |> List.map (fun fspec ->fspec.Name, mkRecdFieldGet cenv.g (oldve',mkNestedRecdFieldRef tcref fspec,tinst,m)) + |> List.map (fun fspec ->fspec.Name, mkRecdFieldGet cenv.g (oldve',tcref.MakeNestedRecdFieldRef fspec,tinst,m)) let fldsList = fldsList @ oldFldsList @@ -6270,7 +6270,7 @@ and TcConstStringExpr cenv overallTy env m tpenv s = let ty' = mkPrintfFormatTy cenv.g aty bty cty dty ety if (not (isObjTy cenv.g overallTy) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy ty') then // Parse the format string to work out the phantom types - let aty',ety' = (try Formats.ParseFormatString m cenv.g s bty cty dty with Failure s -> error (Error(FSComp.SR.tcUnableToParseFormatString(s),m))) + let aty',ety' = (try CheckFormatStrings.ParseFormatString m cenv.g s bty cty dty with Failure s -> error (Error(FSComp.SR.tcUnableToParseFormatString(s),m))) UnifyTypes cenv env m aty aty' UnifyTypes cenv env m ety ety' mkCallNewFormat cenv.g m aty bty cty dty ety (mkString cenv.g m s),tpenv @@ -6537,7 +6537,7 @@ and TcQuotationExpr cenv overallTy env tpenv (_oper,raw,ast,isFromQueryExpressio // Coerce it if needed let expr = if raw then mkCoerceExpr(expr,(mkRawQuotedExprTy cenv.g),m,(tyOfExpr cenv.g expr)) else expr - // We serialize the quoted expression to bytes in Ilxgen after type inference etc. is complete. + // We serialize the quoted expression to bytes in IlxGen after type inference etc. is complete. expr,tpenv //------------------------------------------------------------------------- @@ -8293,7 +8293,7 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution let isValueType = finfo.IsValueType let valu = if isValueType then AsValue else AsObject - // The empty instantiation on the fspec is OK, since we make the correct fspec in Ilxgen.gen_asm + // The empty instantiation on the fspec is OK, since we make the correct fspec in IlxGen.GenAsm // This ensures we always get the type instantiation right when doing this from // polymorphic code, after inlining etc. let fspec = mkILFieldSpec(fref,mkILNamedTy valu fref.EnclosingTypeRef []) @@ -9699,7 +9699,7 @@ and TcAttribute cenv (env: TcEnv) attrTgt (synAttr: SynAttribute) = match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInAttribute OpenQualified env.eNameResEnv ad tycon TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No with | Exception err -> raze(err) | _ -> success(TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInAttribute env tpenv (SynType.App(SynType.LongIdent(LongIdentWithDots(tycon,[])),None,[],[],None,false,mAttr)) ) - ForceRaise ((try1 (tyid.idText + "Attribute")) |> Outcome.otherwise (fun () -> (try1 tyid.idText))) + ForceRaise ((try1 (tyid.idText + "Attribute")) |> ResultOrException.otherwise (fun () -> (try1 tyid.idText))) let ad = env.eAccessRights @@ -12869,7 +12869,7 @@ module AddAugmentationDeclarations = begin let AddGenericCompareDeclarations cenv (env: TcEnv) (scSet:Set) (tycon:Tycon) = - if Augment.TyconIsCandidateForAugmentationWithCompare cenv.g tycon && scSet.Contains tycon.Stamp then + if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithCompare cenv.g tycon && scSet.Contains tycon.Stamp then let tcref = mkLocalTyconRef tycon let tcaug = tycon.TypeContents let _,typ = if tcref.Deref.IsExceptionDecl then [],cenv.g.exn_ty else generalizeTyconRef tcref @@ -12890,8 +12890,8 @@ module AddAugmentationDeclarations = begin errorR(Error(FSComp.SR.tcImplementsIStructuralComparableExplicitly(tycon.DisplayName),m)) else let hasExplicitGenericIComparable = tycon.HasInterface cenv.g genericIComparableTy - let cvspec1,cvspec2 = Augment.MakeValsForCompareAugmentation cenv.g tcref - let cvspec3 = Augment.MakeValsForCompareWithComparerAugmentation cenv.g tcref + let cvspec1,cvspec2 = AugmentWithHashCompare.MakeValsForCompareAugmentation cenv.g tcref + let cvspec3 = AugmentWithHashCompare.MakeValsForCompareWithComparerAugmentation cenv.g tcref PublishInterface cenv env.DisplayEnv tcref m true cenv.g.mk_IStructuralComparable_ty PublishInterface cenv env.DisplayEnv tcref m true cenv.g.mk_IComparable_ty @@ -12906,7 +12906,7 @@ module AddAugmentationDeclarations = begin let AddGenericEqualityWithComparerDeclarations cenv (env: TcEnv) (seSet:Set) (tycon:Tycon) = - if Augment.TyconIsCandidateForAugmentationWithEquals cenv.g tycon && seSet.Contains tycon.Stamp then + if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals cenv.g tycon && seSet.Contains tycon.Stamp then let tcref = mkLocalTyconRef tycon let tcaug = tycon.TypeContents let m = tycon.Range @@ -12916,7 +12916,7 @@ module AddAugmentationDeclarations = begin if hasExplicitIStructuralEquatable then errorR(Error(FSComp.SR.tcImplementsIStructuralEquatableExplicitly(tycon.DisplayName),m)) else - let evspec1,evspec2,evspec3 = Augment.MakeValsForEqualityWithComparerAugmentation cenv.g tcref + let evspec1,evspec2,evspec3 = AugmentWithHashCompare.MakeValsForEqualityWithComparerAugmentation cenv.g tcref PublishInterface cenv env.DisplayEnv tcref m true cenv.g.mk_IStructuralEquatable_ty tcaug.SetHashAndEqualsWith (mkLocalValRef evspec1, mkLocalValRef evspec2, mkLocalValRef evspec3) PublishValueDefn cenv env ModuleOrMemberBinding evspec1 @@ -12925,20 +12925,20 @@ module AddAugmentationDeclarations = begin let AddGenericCompareBindings cenv (tycon:Tycon) = - if (* Augment.TyconIsCandidateForAugmentationWithCompare cenv.g tycon && *) isSome tycon.GeneratedCompareToValues then - Augment.MakeBindingsForCompareAugmentation cenv.g tycon + if (* AugmentWithHashCompare.TyconIsCandidateForAugmentationWithCompare cenv.g tycon && *) isSome tycon.GeneratedCompareToValues then + AugmentWithHashCompare.MakeBindingsForCompareAugmentation cenv.g tycon else [] let AddGenericCompareWithComparerBindings cenv (tycon:Tycon) = - if (* Augment.TyconIsCandidateForAugmentationWithCompare cenv.g tycon && *) isSome tycon.GeneratedCompareToWithComparerValues then - (Augment.MakeBindingsForCompareWithComparerAugmentation cenv.g tycon) + if (* AugmentWithHashCompare.TyconIsCandidateForAugmentationWithCompare cenv.g tycon && *) isSome tycon.GeneratedCompareToWithComparerValues then + (AugmentWithHashCompare.MakeBindingsForCompareWithComparerAugmentation cenv.g tycon) else [] let AddGenericEqualityWithComparerBindings cenv (tycon:Tycon) = - if Augment.TyconIsCandidateForAugmentationWithEquals cenv.g tycon && isSome tycon.GeneratedHashAndEqualsWithComparerValues then - (Augment.MakeBindingsForEqualityWithComparerAugmentation cenv.g tycon) + if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals cenv.g tycon && isSome tycon.GeneratedHashAndEqualsWithComparerValues then + (AugmentWithHashCompare.MakeBindingsForEqualityWithComparerAugmentation cenv.g tycon) else [] @@ -12954,7 +12954,7 @@ module AddAugmentationDeclarations = begin // We can only add the Equals override after we've done the augmentation becuase we have to wait until // tycon.HasOverride can give correct results let AddGenericEqualityBindings cenv (env: TcEnv) tycon = - if Augment.TyconIsCandidateForAugmentationWithEquals cenv.g tycon then + if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals cenv.g tycon then let tcref = mkLocalTyconRef tycon let tcaug = tycon.TypeContents let _,typ = if tcref.Deref.IsExceptionDecl then [],cenv.g.exn_ty else generalizeTyconRef tcref @@ -12972,13 +12972,13 @@ module AddAugmentationDeclarations = begin if not hasExplicitObjectEqualsOverride && isSome tycon.GeneratedHashAndEqualsWithComparerValues then - let vspec1,vspec2 = Augment.MakeValsForEqualsAugmentation cenv.g tcref + let vspec1,vspec2 = AugmentWithHashCompare.MakeValsForEqualsAugmentation cenv.g tcref tcaug.SetEquals (mkLocalValRef vspec1, mkLocalValRef vspec2) if not tycon.IsExceptionDecl then PublishInterface cenv env.DisplayEnv tcref m true (mkAppTy cenv.g.system_GenericIEquatable_tcref [typ]) PublishValueDefn cenv env ModuleOrMemberBinding vspec1 PublishValueDefn cenv env ModuleOrMemberBinding vspec2 - Augment.MakeBindingsForEqualsAugmentation cenv.g tycon + AugmentWithHashCompare.MakeBindingsForEqualsAugmentation cenv.g tycon else [] else [] @@ -12994,7 +12994,7 @@ module TyconConstraintInference = begin // Initially, assume the equality relation is available for all structural type definitions let initialAssumedTycons = set [ for tycon in tycons do - if Augment.TyconIsCandidateForAugmentationWithCompare cenv.g tycon then + if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithCompare cenv.g tycon then yield tycon.Stamp ] // Initially, don't assume that the equality relation is dependent on any type varaibles @@ -13059,7 +13059,7 @@ module TyconConstraintInference = begin let newSet = assumedTycons |> Set.filter (fun tyconStamp -> let (tycon,structuralTypes) = tab.[tyconStamp] - if cenv.g.compilingFslib && Augment.TyconIsCandidateForAugmentationWithCompare cenv.g tycon && not (HasFSharpAttribute g g.attrib_StructuralComparisonAttribute tycon.Attribs) && not (HasFSharpAttribute g g.attrib_NoComparisonAttribute tycon.Attribs) then + if cenv.g.compilingFslib && AugmentWithHashCompare.TyconIsCandidateForAugmentationWithCompare cenv.g tycon && not (HasFSharpAttribute g g.attrib_StructuralComparisonAttribute tycon.Attribs) && not (HasFSharpAttribute g g.attrib_NoComparisonAttribute tycon.Attribs) then errorR(Error(FSComp.SR.tcFSharpCoreRequiresExplicit(),tycon.Range)) let res = (structuralTypes |> List.forall (fst >> checkIfFieldTypeSupportsComparison tycon)) @@ -13122,7 +13122,7 @@ module TyconConstraintInference = begin // Initially, assume the equality relation is available for all structural type definitions let initialAssumedTycons = set [ for tycon in tycons do - if Augment.TyconIsCandidateForAugmentationWithEquals cenv.g tycon then + if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals cenv.g tycon then yield tycon.Stamp ] // Initially, don't assume that the equality relation is dependent on any type varaibles @@ -13163,7 +13163,7 @@ module TyconConstraintInference = begin let tcref,tinst = destAppTy g ty (if initialAssumedTycons.Contains tcref.Stamp then assumedTycons.Contains tcref.Stamp - elif Augment.TyconIsCandidateForAugmentationWithEquals g tcref.Deref then + elif AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals g tcref.Deref then isSome tcref.GeneratedHashAndEqualsWithComparerValues else true) @@ -13183,7 +13183,7 @@ module TyconConstraintInference = begin let newSet = assumedTycons |> Set.filter (fun tyconStamp -> let (tycon,structuralTypes) = tab.[tyconStamp] - if cenv.g.compilingFslib && Augment.TyconIsCandidateForAugmentationWithEquals cenv.g tycon && not (HasFSharpAttribute g g.attrib_StructuralEqualityAttribute tycon.Attribs) && not (HasFSharpAttribute g g.attrib_NoEqualityAttribute tycon.Attribs) then + if cenv.g.compilingFslib && AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals cenv.g tycon && not (HasFSharpAttribute g g.attrib_StructuralEqualityAttribute tycon.Attribs) && not (HasFSharpAttribute g g.attrib_NoEqualityAttribute tycon.Attribs) then errorR(Error(FSComp.SR.tcFSharpCoreRequiresExplicit(),tycon.Range)) // Remove structural types with incomparable elements from the assumedTycons @@ -13193,7 +13193,7 @@ module TyconConstraintInference = begin if not res then match TryFindFSharpBoolAttribute g g.attrib_StructuralEqualityAttribute tycon.Attribs with | Some(true) -> - if Augment.TyconIsCandidateForAugmentationWithEquals cenv.g tycon then + if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals cenv.g tycon then match structuralTypes |> List.tryFind (fst >> checkIfFieldTypeSupportsEquality tycon >> not) with | None -> assert false @@ -13208,7 +13208,7 @@ module TyconConstraintInference = begin | Some(false) -> () | None -> - if Augment.TyconIsCandidateForAugmentationWithEquals cenv.g tycon then + if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals cenv.g tycon then match structuralTypes |> List.tryFind (fst >> checkIfFieldTypeSupportsEquality tycon >> not) with | None -> assert false @@ -13640,7 +13640,7 @@ module EstablishTypeDefinitionCores = begin | _ -> failwith "unreachable" if ExtensionTyping.IsGeneratedTypeDirectReference (typeBeforeArguments, m) then - let optGeneratedTypePath = Some (mangledPathOfCompPath tcref.CompilationPath @ [ tcref.LogicalName ]) + let optGeneratedTypePath = Some (tcref.CompilationPath.MangledPath @ [ tcref.LogicalName ]) let _hasNoArgs,providedTypeAfterStaticArguments,checkTypeName = TcProvidedTypeAppToStaticConstantArgs cenv envinner optGeneratedTypePath tpenv tcrefBeforeStaticArguments args m let isGenerated = providedTypeAfterStaticArguments.PUntaint((fun st -> not st.IsErased),m) if isGenerated then @@ -13731,7 +13731,7 @@ module EstablishTypeDefinitionCores = begin error(Error(FSComp.SR.etErasedTypeUsedInGeneration(desig,nm),m)) // Embed the type into the module we're compiling - let cpath = mkNestedCPath eref.CompilationPath eref.LogicalName ModuleOrNamespaceKind.ModuleOrType + let cpath = eref.CompilationPath.NestedCompPath eref.LogicalName ModuleOrNamespaceKind.ModuleOrType let access = combineAccess tycon.Accessibility (if st.PUntaint((fun st -> st.IsPublic || st.IsNestedPublic), m) then taccessPublic else taccessPrivate cpath) let nestedTycon = Construct.NewProvidedTycon(resolutionEnvironment, st, @@ -13740,7 +13740,7 @@ module EstablishTypeDefinitionCores = begin m=m, cpath=cpath, access = access) eref.ModuleOrNamespaceType.AddProvidedTypeEntity(nestedTycon) - let nestedTyRef = eref.MkNestedTyconRef nestedTycon + let nestedTyRef = eref.NestedTyconRef nestedTycon let ilOrigTypeRef = GetOriginalILTypeRefOfProvidedType (st, m) // Record the details so we can map System.Type --> TyconRef @@ -14050,10 +14050,10 @@ module EstablishTypeDefinitionCores = begin let nenv = envinner.NameEnv // Record fields should be visible from IntelliSense, so add fake names for them (similarly to "let a = ..") for fspec in (fields |> List.filter (fun fspec -> not fspec.IsCompilerGenerated)) do - let info = RecdFieldInfo(thisTyInst, mkNestedRecdFieldRef thisTyconRef fspec) + let info = RecdFieldInfo(thisTyInst, thisTyconRef.MakeNestedRecdFieldRef fspec) let nenv' = AddFakeNameToNameEnv fspec.Name nenv (Item.RecdField info) // Name resolution gives better info for tooltips - let item = FreshenRecdFieldRef cenv.nameResolver m (mkNestedRecdFieldRef thisTyconRef fspec) + let item = FreshenRecdFieldRef cenv.nameResolver m (thisTyconRef.MakeNestedRecdFieldRef fspec) CallNameResolutionSink cenv.tcSink (fspec.Range,nenv,item,item,ItemOccurence.Binding,envinner.DisplayEnv,ad) // Environment is needed for completions CallEnvSink cenv.tcSink (fspec.Range, nenv', ad) @@ -15100,7 +15100,7 @@ let rec TcSignatureElement cenv parent endm (env: TcEnv) e : Eventually = | None -> env // Publish the combined module type - env.eModuleOrNamespaceTypeAccumulator := combineModuleOrNamespaceTypeList [] m [!(env.eModuleOrNamespaceTypeAccumulator); modulTypeRoot] + env.eModuleOrNamespaceTypeAccumulator := CombineCcuContentFragments m [!(env.eModuleOrNamespaceTypeAccumulator); modulTypeRoot] env return env @@ -15334,7 +15334,7 @@ let rec TcModuleOrNamespaceElement (cenv:cenv) parent scopem env e = // : ((Modu | None -> env // Publish the combined module type - env.eModuleOrNamespaceTypeAccumulator := combineModuleOrNamespaceTypeList [] m [!(env.eModuleOrNamespaceTypeAccumulator); modulTypeRoot] + env.eModuleOrNamespaceTypeAccumulator := CombineCcuContentFragments m [!(env.eModuleOrNamespaceTypeAccumulator); modulTypeRoot] env let mexprRoot = BuildRootModuleExpr enclosingNamespacePath envinner.eCompPath mexpr @@ -15408,7 +15408,7 @@ and TcModuleOrNamespace cenv env (id,isModule,defs,xml,modAttrs,vis,m:range) = //-------------------------------------------------------------------------- -// TypecheckOneImplFile - Typecheck all the namespace fragments in a file. +// TypeCheckOneImplFile - Typecheck all the namespace fragments in a file. //-------------------------------------------------------------------------- @@ -15574,7 +15574,7 @@ let CheckModuleSignature g cenv m denvAtEnd rootSigOpt implFileTypePriorToSig im /// Check an entire implementation file /// Typecheck, then close the inference scope and then check the file meets its signature (if any) -let TypecheckOneImplFile +let TypeCheckOneImplFile // checkForErrors: A function to help us stop reporting cascading errors (g, niceNameGen, amap, topCcu, checkForErrors, conditionalDefines, tcSink) env @@ -15639,14 +15639,14 @@ let TypecheckOneImplFile with e -> errorRecovery e m) - // We ALWAYS run the PostTypecheckSemanticChecks phase, though we if we have already encountered some + // We ALWAYS run the PostTypeCheckSemanticChecks phase, though we if we have already encountered some // errors we turn off error reporting. THis is because it performs various fixups over the TAST, e.g. // assigning nice names for inference variables. let hasExplicitEntryPoint = conditionallySuppressErrorReporting (checkForErrors()) (fun () -> try let reportErrors = not (checkForErrors()) - Microsoft.FSharp.Compiler.PostTypecheckSemanticChecks.CheckTopImpl (g,cenv.amap,reportErrors,cenv.infoReader,env.eInternalsVisibleCompPaths,cenv.topCcu,envAtEnd.DisplayEnv, implFileExprAfterSig,extraAttribs,isLastCompiland) + Microsoft.FSharp.Compiler.PostTypeCheckSemanticChecks.CheckTopImpl (g,cenv.amap,reportErrors,cenv.infoReader,env.eInternalsVisibleCompPaths,cenv.topCcu,envAtEnd.DisplayEnv, implFileExprAfterSig,extraAttribs,isLastCompiland) with e -> errorRecovery e m false) @@ -15659,7 +15659,7 @@ let TypecheckOneImplFile /// Check an entire sginature file -let TypecheckOneSigFile +let TypeCheckOneSigFile (g,niceNameGen,amap,topCcu,checkForErrors,conditionalDefines,tcSink) tcEnv (ParsedSigFileInput(_,qualNameOfFile,_, _,sigFileFrags)) = diff --git a/src/fsharp/TypeChecker.fsi b/src/fsharp/TypeChecker.fsi new file mode 100644 index 0000000000000000000000000000000000000000..3cb326ff735d94c74a10cf89f7b639fd0a52e164 --- /dev/null +++ b/src/fsharp/TypeChecker.fsi @@ -0,0 +1,110 @@ +// Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +module internal Microsoft.FSharp.Compiler.TypeChecker + +open Internal.Utilities +open Microsoft.FSharp.Compiler +open Microsoft.FSharp.Compiler.AbstractIL +open Microsoft.FSharp.Compiler.AbstractIL.IL +open Microsoft.FSharp.Compiler.AbstractIL.Internal +open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library +open Microsoft.FSharp.Compiler.Range +open Microsoft.FSharp.Compiler.Ast +open Microsoft.FSharp.Compiler.ErrorLogger +open Microsoft.FSharp.Compiler.Tast +open Microsoft.FSharp.Compiler.Tastops +open Microsoft.FSharp.Compiler.Lib +open Microsoft.FSharp.Compiler.Infos +open Microsoft.FSharp.Compiler.Import +open Microsoft.FSharp.Compiler.TcGlobals + +open System.Collections.Generic + +[] +type TcEnv = + member DisplayEnv : DisplayEnv + member NameEnv : NameResolution.NameResolutionEnv + +val CreateInitialTcEnv : TcGlobals * ImportMap * range * (CcuThunk * string list * bool) list -> TcEnv +val AddCcuToTcEnv : TcGlobals * ImportMap * range * TcEnv * CcuThunk * autoOpens: string list * bool -> TcEnv +val AddLocalRootModuleOrNamespace : NameResolution.TcResultsSink -> TcGlobals -> ImportMap -> range -> TcEnv -> ModuleOrNamespaceType -> TcEnv +val TcOpenDecl : NameResolution.TcResultsSink -> TcGlobals -> ImportMap -> range -> range -> TcEnv -> Ast.LongIdent -> TcEnv + +type TopAttribs = + { mainMethodAttrs : Attribs; + netModuleAttrs : Attribs; + assemblyAttrs : Attribs } + +type ConditionalDefines = + string list + +val EmptyTopAttrs : TopAttribs +val CombineTopAttrs : TopAttribs -> TopAttribs -> TopAttribs + +val TypeCheckOneImplFile : + TcGlobals * NiceNameGenerator * ImportMap * CcuThunk * (unit -> bool) * ConditionalDefines * NameResolution.TcResultsSink + -> TcEnv + -> Tast.ModuleOrNamespaceType option + -> ParsedImplFileInput + -> Eventually + +val TypeCheckOneSigFile : + TcGlobals * NiceNameGenerator * ImportMap * CcuThunk * (unit -> bool) * ConditionalDefines * NameResolution.TcResultsSink + -> TcEnv + -> ParsedSigFileInput + -> Eventually + +//------------------------------------------------------------------------- +// Some of the exceptions arising from type checking. These should be moved to +// use ErrorLogger. +//------------------------------------------------------------------------- + +exception BakedInMemberConstraintName of string * range +exception FunctionExpected of DisplayEnv * TType * range +exception NotAFunction of DisplayEnv * TType * range * range +exception Recursion of DisplayEnv * Ast.Ident * TType * TType * range +exception RecursiveUseCheckedAtRuntime of DisplayEnv * ValRef * range +exception LetRecEvaluatedOutOfOrder of DisplayEnv * ValRef * ValRef * range +exception LetRecCheckedAtRuntime of range +exception LetRecUnsound of DisplayEnv * ValRef list * range +exception TyconBadArgs of DisplayEnv * TyconRef * int * range +exception UnionCaseWrongArguments of DisplayEnv * int * int * range +exception UnionCaseWrongNumberOfArgs of DisplayEnv * int * int * range +exception FieldsFromDifferentTypes of DisplayEnv * RecdFieldRef * RecdFieldRef * range +exception FieldGivenTwice of DisplayEnv * RecdFieldRef * range +exception MissingFields of string list * range +exception UnitTypeExpected of DisplayEnv * TType * bool * range +exception FunctionValueUnexpected of DisplayEnv * TType * range +exception UnionPatternsBindDifferentNames of range +exception VarBoundTwice of Ast.Ident +exception ValueRestriction of DisplayEnv * bool * Val * Typar * range +exception FieldNotMutable of DisplayEnv * RecdFieldRef * range +exception ValNotMutable of DisplayEnv * ValRef * range +exception ValNotLocal of DisplayEnv * ValRef * range +exception InvalidRuntimeCoercion of DisplayEnv * TType * TType * range +exception IndeterminateRuntimeCoercion of DisplayEnv * TType * TType * range +exception IndeterminateStaticCoercion of DisplayEnv * TType * TType * range +exception StaticCoercionShouldUseBox of DisplayEnv * TType * TType * range +exception RuntimeCoercionSourceSealed of DisplayEnv * TType * range +exception CoercionTargetSealed of DisplayEnv * TType * range +exception UpcastUnnecessary of range +exception TypeTestUnnecessary of range +exception SelfRefObjCtor of bool * range +exception VirtualAugmentationOnNullValuedType of range +exception NonVirtualAugmentationOnNullValuedType of range +exception UseOfAddressOfOperator of range +exception DeprecatedThreadStaticBindingWarning of range +exception NotUpperCaseConstructor of range +exception IntfImplInIntrinsicAugmentation of range +exception IntfImplInExtrinsicAugmentation of range +exception OverrideInIntrinsicAugmentation of range +exception OverrideInExtrinsicAugmentation of range +exception NonUniqueInferredAbstractSlot of TcGlobals * DisplayEnv * string * MethInfo * MethInfo * range +exception StandardOperatorRedefinitionWarning of string * range +exception ParameterlessStructCtor of range + +val TcFieldInit : range -> ILFieldInit -> Tast.Const + +val IsSecurityAttribute : TcGlobals -> ImportMap -> Dictionary -> Attrib -> range -> bool +val IsSecurityCriticalAttribute : TcGlobals -> Attrib -> bool +val LightweightTcValForUsingInBuildMethodCall : g : TcGlobals -> vref:ValRef -> vrefFlags : ValUseFlag -> vrefTypeInst : TTypes -> m : range -> Expr * TType \ No newline at end of file diff --git a/src/fsharp/typrelns.fs b/src/fsharp/TypeRelations.fs similarity index 99% rename from src/fsharp/typrelns.fs rename to src/fsharp/TypeRelations.fs index ed85703e3cb2c34c027a46ea8cc2665c8e261e2a..3abc3980b3ff66b6243e066f5260b2c37dc90582 100644 --- a/src/fsharp/typrelns.fs +++ b/src/fsharp/TypeRelations.fs @@ -2,7 +2,7 @@ /// Primary relations on types and signatures, with the exception of /// constraint solving and method overload resolution. -module internal Microsoft.FSharp.Compiler.Typrelns +module internal Microsoft.FSharp.Compiler.TypeRelations open Internal.Utilities open System.Text @@ -19,13 +19,13 @@ open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.Tastops.DebugPrint -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.Infos open Microsoft.FSharp.Compiler.PrettyNaming open Microsoft.FSharp.Compiler.Infos.AccessibilityLogic -open Microsoft.FSharp.Compiler.Nameres +open Microsoft.FSharp.Compiler.NameResolution #if EXTENSIONTYPING open Microsoft.FSharp.Compiler.ExtensionTyping @@ -237,7 +237,7 @@ let ChooseTyparSolutionsForFreeChoiceTypars g amap e = /// Break apart lambdas. Needs ChooseTyparSolutionsForFreeChoiceTypars because it's used in -/// PostTypecheckSemanticChecks before we've eliminated these nodes. +/// PostTypeCheckSemanticChecks before we've eliminated these nodes. let tryDestTopLambda g amap (ValReprInfo (tpNames,_,_) as tvd) (e,ty) = let rec stripLambdaUpto n (e,ty) = match e with @@ -716,7 +716,7 @@ module SignatureConformance = begin let ucases1 = r1.UnionCasesAsList let ucases2 = r2.UnionCasesAsList if ucases1.Length <> ucases2.Length then - let names l = List.map (fun c -> c.Id.idText) l + let names (l: UnionCase list) = l |> List.map (fun c -> c.Id.idText) reportNiceError "union case" (names ucases1) (names ucases2) else List.forall2 (checkUnionCase aenv) ucases1 ucases2 | (TRecdRepr implFields), (TRecdRepr sigFields) -> @@ -1649,7 +1649,7 @@ let MakeCalledArgs amap m (minfo:MethInfo) minst = /// and returns a CalledMeth object for further analysis. type CalledMeth<'T> (infoReader:InfoReader, - nameEnv: Microsoft.FSharp.Compiler.Nameres.NameResolutionEnv option, + nameEnv: NameResolutionEnv option, isCheckingAttributeCall, freshenMethInfo,// a function to help generate fresh type variables the property setters methods in generic classes m, @@ -1945,12 +1945,12 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader:InfoReader) isImp not tycon.IsFSharpInterfaceTycon then (* Warn when we're doing this for class types *) - if Augment.TyconIsCandidateForAugmentationWithEquals g tycon then + if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals g tycon then warning(Error(FSComp.SR.typrelTypeImplementsIComparableShouldOverrideObjectEquals(tycon.DisplayName),tycon.Range)) else warning(Error(FSComp.SR.typrelTypeImplementsIComparableDefaultObjectEqualsProvided(tycon.DisplayName),tycon.Range)) - Augment.CheckAugmentationAttribs isImplementation g amap tycon + AugmentWithHashCompare.CheckAugmentationAttribs isImplementation g amap tycon // Check some conditions about generic comparison and hashing. We can only check this condition after we've done the augmentation if isImplementation #if EXTENSIONTYPING diff --git a/src/fsharp/unilex.fs b/src/fsharp/UnicodeLexing.fs similarity index 100% rename from src/fsharp/unilex.fs rename to src/fsharp/UnicodeLexing.fs diff --git a/src/fsharp/unilex.fsi b/src/fsharp/UnicodeLexing.fsi similarity index 100% rename from src/fsharp/unilex.fsi rename to src/fsharp/UnicodeLexing.fsi diff --git a/src/fsharp/ast.fs b/src/fsharp/ast.fs index d554332850f0e958afe01d888858d0354249f01f..a07c40ec2a7b5899e3f5cb4ed18149964354b0a6 100644 --- a/src/fsharp/ast.fs +++ b/src/fsharp/ast.fs @@ -2072,7 +2072,7 @@ and LexCont = LexerWhitespaceContinuation /// The error raised by the parse_error_rich function, which is called by the parser engine /// when a syntax error occurs. The first object is the ParseErrorContext which contains a dump of /// information about the grammar at the point where the error occured, e.g. what tokens -/// are valid to shift next at that point in the grammar. This information is processed in build.fs. +/// are valid to shift next at that point in the grammar. This information is processed in CompileOps.fs. [] exception SyntaxError of obj (* ParseErrorContext<_> *) * range diff --git a/src/fsharp/autobox.fs b/src/fsharp/autobox.fs index d665133dd15f86949ebaeea756c687a3722e6b7a..f576b61e5a8c2a50dad90173b26d034d2d04ae8b 100644 --- a/src/fsharp/autobox.fs +++ b/src/fsharp/autobox.fs @@ -10,8 +10,8 @@ open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.Lib -open Microsoft.FSharp.Compiler.Env -open Microsoft.FSharp.Compiler.Typrelns +open Microsoft.FSharp.Compiler.TcGlobals +open Microsoft.FSharp.Compiler.TypeRelations //---------------------------------------------------------------------------- // Decide the set of mutable locals to promote to heap-allocated reference cells diff --git a/src/fsharp/check.fsi b/src/fsharp/check.fsi deleted file mode 100644 index b0c3ac8cf0d2ddd549fc43d2e044d39c41d3ac95..0000000000000000000000000000000000000000 --- a/src/fsharp/check.fsi +++ /dev/null @@ -1,9 +0,0 @@ -// Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. - -module internal Microsoft.FSharp.Compiler.PostTypecheckSemanticChecks - -open Internal.Utilities -open Microsoft.FSharp.Compiler - -val testFlagMemberBody : bool ref -val CheckTopImpl : Env.TcGlobals * Import.ImportMap * bool * Infos.InfoReader * Tast.CompilationPath list * Tast.CcuThunk * Tastops.DisplayEnv * Tast.ModuleOrNamespaceExprWithSig * Tast.Attribs * bool -> bool diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 35eee0580e86941630acfe9f5c50e9a47ebaf254..5240c157a6ae41d82662c153a2a2ce16ff198c9c 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -12,7 +12,11 @@ module internal Microsoft.FSharp.Compiler.Driver +open System +open System.Diagnostics +open System.Globalization open System.IO +open System.Threading open System.Reflection open System.Collections.Generic open System.Runtime.CompilerServices @@ -29,13 +33,10 @@ open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Microsoft.FSharp.Compiler.AbstractIL.IL #if NO_COMPILER_BACKEND #else -open Microsoft.FSharp.Compiler.Ilxgen +open Microsoft.FSharp.Compiler.IlxGen #endif open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.ErrorLogger -#if SQM_SUPPORT -open Microsoft.FSharp.Compiler.SqmLogger -#endif open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.TypeChecker open Microsoft.FSharp.Compiler.Infos @@ -43,143 +44,80 @@ open Microsoft.FSharp.Compiler.Infos.AccessibilityLogic open Microsoft.FSharp.Compiler.Infos.AttributeChecking open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops -open Microsoft.FSharp.Compiler.Opt -open Microsoft.FSharp.Compiler.Env -open Microsoft.FSharp.Compiler.Build +open Microsoft.FSharp.Compiler.Optimizer +open Microsoft.FSharp.Compiler.TcGlobals +open Microsoft.FSharp.Compiler.CompileOps open Microsoft.FSharp.Compiler.Lib -open Microsoft.FSharp.Compiler.Fscopts +open Microsoft.FSharp.Compiler.CompileOptions open Microsoft.FSharp.Compiler.DiagnosticMessage #if EXTENSIONTYPING open Microsoft.FSharp.Compiler.ExtensionTyping #endif -#nowarn "45" // This method will be made public in the underlying IL because it may implement an interface or override a method +//---------------------------------------------------------------------------- +// No SQM logging support +//---------------------------------------------------------------------------- -/////////////////////////////////////////////////////////////////////////////////////////////////////////////// -// This code has logic for a prefix of the compile that is also used by the project system to do the front-end -// logic that starts at command-line arguments and gets as far as importing all references (used for deciding -// to pop up the type provider security dialog). -/////////////////////////////////////////////////////////////////////////////////////////////////////////////// +#if SQM_SUPPORT +open Microsoft.FSharp.Compiler.SqmLogger +#else +let SqmLoggerWithConfigBuilder _tcConfigB _errorNumbers _warningNumbers = () +let SqmLoggerWithConfig _tcConfig _errorNumbers _warningNumbers = () +#endif + +#nowarn "45" // This method will be made public in the underlying IL because it may implement an interface or override a method //---------------------------------------------------------------------------- // Reporting - warnings, errors //---------------------------------------------------------------------------- -type ErrorLoggerThatAccumulatesErrors private (implicitIncludeDir, showFullPaths, flatErrors, errorStyle, globalWarnLevel, specificWarnOn, specificWarnOff, specificWarnAsError, specificWarnAsWarn, globalWarnAsError) = - inherit ErrorLogger("ErrorLoggerThatAccumulatesErrors") - let messages = ResizeArray() - let mutable errorsCount = 0 - new(tcConfigB : TcConfigBuilder) = - ErrorLoggerThatAccumulatesErrors( - tcConfigB.implicitIncludeDir, - tcConfigB.showFullPaths, - tcConfigB.flatErrors, - tcConfigB.errorStyle, - tcConfigB.globalWarnLevel, - tcConfigB.specificWarnOn, - tcConfigB.specificWarnOff, - tcConfigB.specificWarnAsError, - tcConfigB.specificWarnAsWarn, - tcConfigB.globalWarnAsError - ) - new(tcConfig : TcConfig) = - ErrorLoggerThatAccumulatesErrors( - tcConfig.implicitIncludeDir, - tcConfig.showFullPaths, - tcConfig.flatErrors, - tcConfig.errorStyle, - tcConfig.globalWarnLevel, - tcConfig.specificWarnOn, - tcConfig.specificWarnOff, - tcConfig.specificWarnAsError, - tcConfig.specificWarnAsWarn, - tcConfig.globalWarnAsError - ) - member this.ProcessMessage(err, isError) = - let writer = new System.IO.StringWriter() - - let writeError err = - writeViaBufferWithEnvironmentNewLines writer (OutputErrorOrWarning (implicitIncludeDir, showFullPaths, flatErrors, errorStyle, false)) err - - let isError = - if isError then - writeError err - true - else - if (ReportWarningAsError globalWarnLevel specificWarnOff specificWarnOn specificWarnAsError specificWarnAsWarn globalWarnAsError err) then - writeError err - true - elif ReportWarning globalWarnLevel specificWarnOff specificWarnOn err then - writeViaBufferWithEnvironmentNewLines writer (OutputErrorOrWarning (implicitIncludeDir, showFullPaths, flatErrors, errorStyle, true)) err - false - else - false // will not be used - let text = writer.ToString() - if text.Length <> 0 then Some (isError, text) else None - - member this.GetMessages() = List.ofSeq messages - override this.ErrorSinkImpl(err) = - errorsCount <- errorsCount + 1 - messages.Add(this.ProcessMessage(err, true).Value) - override this.WarnSinkImpl(warn) = - match this.ProcessMessage (warn, false) with - | Some ((isError, _) as res) -> - if isError then errorsCount <- errorsCount + 1 - messages.Add(res) - | _ -> () - - override this.ErrorCount = errorsCount - [] -type ErrorLoggerThatQuitsAfterMaxErrors(tcConfigB:TcConfigBuilder, exiter : Exiter, caption) = +type ErrorLoggerThatQuitsAfterMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, caption) = inherit ErrorLogger(caption) - let errors = ref 0 - let errorNumbers = ref [] - let warningNumbers = ref [] + let mutable errors = 0 + let mutable errorNumbers = [] + let mutable warningNumbers = [] abstract HandleIssue : tcConfigB : TcConfigBuilder * error : PhasedError * isWarning : bool -> unit abstract HandleTooManyErrors : text : string -> unit - override x.ErrorCount = !errors + override x.ErrorCount = errors override x.ErrorSinkImpl(err) = - if !errors >= tcConfigB.maxErrors then - x.HandleTooManyErrors(FSComp.SR.fscTooManyErrors()) -#if SQM_SUPPORT - SqmLoggerWithConfigBuilder tcConfigB !errorNumbers !warningNumbers -#endif - exiter.Exit 1 + if errors >= tcConfigB.maxErrors then + x.HandleTooManyErrors(FSComp.SR.fscTooManyErrors()) + SqmLoggerWithConfigBuilder tcConfigB errorNumbers warningNumbers + exiter.Exit 1 - x.HandleIssue(tcConfigB, err, false) + x.HandleIssue(tcConfigB, err, false) - incr errors - errorNumbers := (GetErrorNumber err) :: !errorNumbers + errors <- errors + 1 + errorNumbers <- (GetErrorNumber err) :: errorNumbers - match err.Exception with - | InternalError _ - | Failure _ - | :? KeyNotFoundException -> - match tcConfigB.simulateException with - | Some _ -> () // Don't show an assert for simulateException case so that unittests can run without an assert dialog. - | None -> System.Diagnostics.Debug.Assert(false,sprintf "Bug seen in compiler: %s" (err.ToString())) - | _ -> - () + match err.Exception with + | InternalError _ + | Failure _ + | :? KeyNotFoundException -> + match tcConfigB.simulateException with + | Some _ -> () // Don't show an assert for simulateException case so that unittests can run without an assert dialog. + | None -> Debug.Assert(false,sprintf "Bug seen in compiler: %s" (err.ToString())) + | _ -> + () override x.WarnSinkImpl(err) = - if (ReportWarningAsError tcConfigB.globalWarnLevel tcConfigB.specificWarnOff tcConfigB.specificWarnOn tcConfigB.specificWarnAsError tcConfigB.specificWarnAsWarn tcConfigB.globalWarnAsError err) then + if ReportWarningAsError (tcConfigB.globalWarnLevel, tcConfigB.specificWarnOff, tcConfigB.specificWarnOn, tcConfigB.specificWarnAsError, tcConfigB.specificWarnAsWarn, tcConfigB.globalWarnAsError) err then x.ErrorSink(err) - elif ReportWarning tcConfigB.globalWarnLevel tcConfigB.specificWarnOff tcConfigB.specificWarnOn err then + elif ReportWarning (tcConfigB.globalWarnLevel, tcConfigB.specificWarnOff, tcConfigB.specificWarnOn) err then x.HandleIssue(tcConfigB, err, true) - warningNumbers := (GetErrorNumber err) :: !warningNumbers + warningNumbers <- (GetErrorNumber err) :: warningNumbers - override x.WarningNumbers = !warningNumbers - override x.ErrorNumbers = !errorNumbers + override x.WarningNumbers = warningNumbers + override x.ErrorNumbers = errorNumbers /// Create an error logger that counts and prints errors let ConsoleErrorLoggerThatQuitsAfterMaxErrors (tcConfigB:TcConfigBuilder, exiter : Exiter) : ErrorLogger = - upcast { - new ErrorLoggerThatQuitsAfterMaxErrors(tcConfigB, exiter, "ConsoleErrorLoggerThatQuitsAfterMaxErrors") with + { new ErrorLoggerThatQuitsAfterMaxErrors(tcConfigB, exiter, "ConsoleErrorLoggerThatQuitsAfterMaxErrors") with member this.HandleTooManyErrors(text : string) = DoWithErrorColor true (fun () -> Printf.eprintfn "%s" text) @@ -188,37 +126,25 @@ let ConsoleErrorLoggerThatQuitsAfterMaxErrors (tcConfigB:TcConfigBuilder, exiter DoWithErrorColor isWarning (fun () -> (writeViaBufferWithEnvironmentNewLines stderr (OutputErrorOrWarning (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.errorStyle,isWarning)) err; stderr.WriteLine()) - ); - } - -// val TypeCheck : TcConfig * TcImports * TcGlobals * ErrorLogger * string * NiceNameGenerator * TypeChecker.TcEnv * Input list * Exiter -> -// TcState * TypeChecker.TopAttribs * Tast.TypedAssembly * TypeChecker.TcEnv -let TypeCheck (tcConfig,tcImports,tcGlobals,errorLogger:ErrorLogger,assemblyName,niceNameGen,tcEnv0,inputs, exiter : Exiter) = - try - if isNil inputs then error(Error(FSComp.SR.fscNoImplementationFiles(),Range.rangeStartup)) - let ccuName = assemblyName - let tcInitialState = TypecheckInitialState (rangeStartup,ccuName,tcConfig,tcGlobals,tcImports,niceNameGen,tcEnv0) - TypecheckClosedInputSet ((fun () -> errorLogger.ErrorCount > 0),tcConfig,tcImports,tcGlobals,None,tcInitialState,inputs) - with e -> - errorRecovery e rangeStartup -#if SQM_SUPPORT - SqmLoggerWithConfig tcConfig errorLogger.ErrorNumbers errorLogger.WarningNumbers -#endif - exiter.Exit 1 + ) + } :> _ /// This error logger delays the messages it recieves. At the end, call ForwardDelayedErrorsAndWarnings /// to send the held messages. -type DelayAndForwardErrorLogger(exiter : Exiter, errorLoggerProvider : ErrorLoggerProvider) = +type DelayAndForwardErrorLogger(exiter: Exiter, errorLoggerProvider: ErrorLoggerProvider) = inherit ErrorLogger("DelayAndForwardErrorLogger") - let mapToErrorNumber items = - items |> Seq.map (fun (err,_) -> GetErrorNumber err) |> Seq.toList + let delayed = new ResizeArray<_>() - let errors = ref 0 + let mutable errors = 0 + override x.ErrorSinkImpl(e) = - errors := !errors + 1 + errors <- errors + 1 delayed.Add (e,true) + override x.ErrorCount = delayed |> Seq.filter snd |> Seq.length + override x.WarnSinkImpl(e) = delayed.Add(e,false) + member x.ForwardDelayedErrorsAndWarnings(errorLogger:ErrorLogger) = // Eagerly grab all the errors and warnings from the mutable collection let errors = delayed |> Seq.toList @@ -227,18 +153,60 @@ type DelayAndForwardErrorLogger(exiter : Exiter, errorLoggerProvider : ErrorLogg if isError then errorLogger.ErrorSink(e) else errorLogger.WarnSink(e) // Clear errors just reported. Keep errors count. delayed.Clear() + member x.ForwardDelayedErrorsAndWarnings(tcConfigB:TcConfigBuilder) = let errorLogger = errorLoggerProvider.CreateErrorLoggerThatQuitsAfterMaxErrors(tcConfigB, exiter) x.ForwardDelayedErrorsAndWarnings(errorLogger) - member x.FullErrorCount = !errors - override x.WarningNumbers = delayed |> Seq.filter(fun (_, flag) -> flag = false) |> mapToErrorNumber - override x.ErrorNumbers = delayed |> Seq.filter(fun (_, flag) -> flag = true) |> mapToErrorNumber + + member x.FullErrorCount = errors + + override x.WarningNumbers = delayed |> Seq.filter (snd >> not) |> Seq.map (fst >> GetErrorNumber) |> Seq.toList + override x.ErrorNumbers = delayed |> Seq.filter snd |> Seq.map (fst >> GetErrorNumber) |> Seq.toList and [] ErrorLoggerProvider() = member this.CreateDelayAndForwardLogger(exiter) = DelayAndForwardErrorLogger(exiter, this) abstract CreateErrorLoggerThatQuitsAfterMaxErrors : tcConfigBuilder : TcConfigBuilder * exiter : Exiter -> ErrorLogger +let AbortOnError (errorLogger:ErrorLogger, _tcConfig:TcConfig, exiter : Exiter) = + if errorLogger.ErrorCount > 0 then + SqmLoggerWithConfig _tcConfig errorLogger.ErrorNumbers errorLogger.WarningNumbers + exiter.Exit 1 + +type DefaultLoggerProvider() = + inherit ErrorLoggerProvider() + override this.CreateErrorLoggerThatQuitsAfterMaxErrors(tcConfigBuilder, exiter) = ConsoleErrorLoggerThatQuitsAfterMaxErrors(tcConfigBuilder, exiter) + +//---------------------------------------------------------------------------- +// Cleaning up + +/// Track a set of resources to cleanup +type DisposablesTracker() = + let items = Stack() + member this.Register(i) = items.Push i + interface IDisposable with + member this.Dispose() = + let l = List.ofSeq items + items.Clear() + for i in l do + try i.Dispose() with _ -> () + + +//---------------------------------------------------------------------------- + +/// Type checking a set of inputs +let TypeCheck (tcConfig, tcImports, tcGlobals, errorLogger:ErrorLogger, assemblyName, niceNameGen, tcEnv0, inputs, exiter: Exiter) = + try + if isNil inputs then error(Error(FSComp.SR.fscNoImplementationFiles(),Range.rangeStartup)) + let ccuName = assemblyName + let tcInitialState = GetInitialTcState (rangeStartup,ccuName,tcConfig,tcGlobals,tcImports,niceNameGen,tcEnv0) + TypeCheckClosedInputSet ((fun () -> errorLogger.ErrorCount > 0),tcConfig,tcImports,tcGlobals,None,tcInitialState,inputs) + with e -> + errorRecovery e rangeStartup + SqmLoggerWithConfig tcConfig errorLogger.ErrorNumbers errorLogger.WarningNumbers + exiter.Exit 1 + + /// Check for .fsx and, if present, compute the load closure for of #loaded files. let AdjustForScriptCompile(tcConfigB:TcConfigBuilder,commandLineSourceFiles,lexResourceManager) = @@ -278,54 +246,39 @@ let AdjustForScriptCompile(tcConfigB:TcConfigBuilder,commandLineSourceFiles,lexR List.rev !allSources -let abortOnError (errorLogger:ErrorLogger, _tcConfig:TcConfig, exiter : Exiter) = - if errorLogger.ErrorCount > 0 then -#if SQM_SUPPORT - SqmLoggerWithConfig _tcConfig errorLogger.ErrorNumbers errorLogger.WarningNumbers -#endif - exiter.Exit 1 - -type DelayedDisposables() = - let items = Stack() - member this.Register(i) = items.Push i - interface System.IDisposable with - member this.Dispose() = - let l = List.ofSeq items - items.Clear() - for i in l do - try i.Dispose() with _ -> () -type DefaultLoggerProvider() = - inherit ErrorLoggerProvider() - override this.CreateErrorLoggerThatQuitsAfterMaxErrors(tcConfigBuilder, exiter) = ConsoleErrorLoggerThatQuitsAfterMaxErrors(tcConfigBuilder, exiter) +/////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// This code has logic for a prefix of the compile that is also used by the project system to do the front-end +// logic that starts at command-line arguments and gets as far as importing all references (used for deciding +// to pop up the type provider security dialog). +// // The project system needs to be able to somehow crack open assemblies to look for type providers in order to pop up the security dialog when necessary when a user does 'Build'. // Rather than have the PS re-code that logic, it re-uses the existing code in the very front end of the compiler that parses the command-line and imports the referenced assemblies. // This code used to be in fsc.exe. The PS only references FSharp.LanguageService.Compiler, so this code moved from fsc.exe to FS.C.S.dll so that the PS can re-use it. // A great deal of the logic of this function is repeated in fsi.fs, so maybe should refactor fsi.fs to call into this as well. -let getTcImportsFromCommandLine(displayPSTypeProviderSecurityDialogBlockingUI : (string->unit) option, - argv : string[], - defaultFSharpBinariesDir : string, - directoryBuildingFrom : string, - lcidFromCodePage : int option, - setProcessThreadLocals : TcConfigBuilder -> unit, - displayBannerIfNeeded : TcConfigBuilder -> unit, - optimizeForMemory : bool, - exiter : Exiter, - errorLoggerProvider : ErrorLoggerProvider, - disposables : DelayedDisposables) - : TcGlobals * TcImports * TcImports * Tast.CcuThunk * Tast.TypedAssembly * TypeChecker.TopAttribs * TcConfig * string * string option * string * ErrorLogger - = +let GetTcImportsFromCommandLine + (displayPSTypeProviderSecurityDialogBlockingUI : (string->unit) option, + argv : string[], + defaultFSharpBinariesDir : string, + directoryBuildingFrom : string, + lcidFromCodePage : int option, + setProcessThreadLocals : TcConfigBuilder -> unit, + displayBannerIfNeeded : TcConfigBuilder -> unit, + optimizeForMemory : bool, + exiter : Exiter, + errorLoggerProvider : ErrorLoggerProvider, + disposables : DisposablesTracker) = - let tcConfigB = Build.TcConfigBuilder.CreateNew(defaultFSharpBinariesDir, optimizeForMemory, directoryBuildingFrom, isInteractive=false, isInvalidationSupported=false) + let tcConfigB = TcConfigBuilder.CreateNew(defaultFSharpBinariesDir, optimizeForMemory, directoryBuildingFrom, isInteractive=false, isInvalidationSupported=false) // Preset: --optimize+ -g --tailcalls+ (see 4505) - SetOptimizeSwitch tcConfigB On - SetDebugSwitch tcConfigB None Off - SetTailcallSwitch tcConfigB On + SetOptimizeSwitch tcConfigB OptionSwitch.On + SetDebugSwitch tcConfigB None OptionSwitch.Off + SetTailcallSwitch tcConfigB OptionSwitch.On // Now install a delayed logger to hold all errors from flags until after all flags have been parsed (for example, --vserrors) - let delayForFlagsLogger = errorLoggerProvider.CreateDelayAndForwardLogger(exiter)// DelayAndForwardErrorLogger(exiter) + let delayForFlagsLogger = errorLoggerProvider.CreateDelayAndForwardLogger(exiter) let _unwindEL_1 = PushErrorLoggerPhaseUntilUnwind (fun _ -> delayForFlagsLogger) // Share intern'd strings across all lexing/parsing @@ -345,10 +298,10 @@ let getTcImportsFromCommandLine(displayPSTypeProviderSecurityDialogBlockingUI : tcConfigB.AddEmbeddedResource name else inputFilesRef := name :: !inputFilesRef - let abbrevArgs = abbrevFlagSet tcConfigB true + let abbrevArgs = GetAbbrevFlagSet tcConfigB true // This is where flags are interpreted by the command line fsc.exe. - ParseCompilerOptions collect (GetCoreFscCompilerOptions tcConfigB) (List.tail (PostProcessCompilerArgs abbrevArgs argv)) + ParseCompilerOptions (collect, GetCoreFscCompilerOptions tcConfigB, List.tail (PostProcessCompilerArgs abbrevArgs argv)) let inputFiles = List.rev !inputFilesRef // Check if we have a codepage from the console @@ -358,7 +311,7 @@ let getTcImportsFromCommandLine(displayPSTypeProviderSecurityDialogBlockingUI : setProcessThreadLocals(tcConfigB) - (* step - get dll references *) + // Get DLL references let dllFiles,sourceFiles = List.partition Filename.isDll inputFiles match dllFiles with | [] -> () @@ -369,12 +322,9 @@ let getTcImportsFromCommandLine(displayPSTypeProviderSecurityDialogBlockingUI : let sourceFiles = AdjustForScriptCompile(tcConfigB,sourceFiles,lexResourceManager) sourceFiles - with - e -> + with e -> errorRecovery e rangeStartup -#if SQM_SUPPORT SqmLoggerWithConfigBuilder tcConfigB delayForFlagsLogger.ErrorNumbers delayForFlagsLogger.WarningNumbers -#endif delayForFlagsLogger.ForwardDelayedErrorsAndWarnings(tcConfigB) exiter.Exit 1 @@ -388,17 +338,13 @@ let getTcImportsFromCommandLine(displayPSTypeProviderSecurityDialogBlockingUI : tcConfigB.DecideNames sourceFiles with e -> errorRecovery e rangeStartup -#if SQM_SUPPORT SqmLoggerWithConfigBuilder tcConfigB delayForFlagsLogger.ErrorNumbers delayForFlagsLogger.WarningNumbers -#endif delayForFlagsLogger.ForwardDelayedErrorsAndWarnings(tcConfigB) exiter.Exit 1 // DecideNames may give "no inputs" error. Abort on error at this point. bug://3911 if not tcConfigB.continueAfterParseFailure && delayForFlagsLogger.FullErrorCount > 0 then -#if SQM_SUPPORT SqmLoggerWithConfigBuilder tcConfigB delayForFlagsLogger.ErrorNumbers delayForFlagsLogger.WarningNumbers -#endif delayForFlagsLogger.ForwardDelayedErrorsAndWarnings(tcConfigB) exiter.Exit 1 @@ -407,9 +353,7 @@ let getTcImportsFromCommandLine(displayPSTypeProviderSecurityDialogBlockingUI : try TcConfig.Create(tcConfigB,validate=false) with e -> -#if SQM_SUPPORT SqmLoggerWithConfigBuilder tcConfigB delayForFlagsLogger.ErrorNumbers delayForFlagsLogger.WarningNumbers -#endif delayForFlagsLogger.ForwardDelayedErrorsAndWarnings(tcConfigB) exiter.Exit 1 @@ -423,7 +367,7 @@ let getTcImportsFromCommandLine(displayPSTypeProviderSecurityDialogBlockingUI : // step - decideNames if not tcConfigB.continueAfterParseFailure then - abortOnError(errorLogger, tcConfig, exiter) + AbortOnError(errorLogger, tcConfig, exiter) let tcGlobals,tcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig = @@ -441,7 +385,6 @@ let getTcImportsFromCommandLine(displayPSTypeProviderSecurityDialogBlockingUI : else ReportTime tcConfig "Import mscorlib and FSharp.Core.dll" - ReportTime tcConfig "Import system references" let foundationalTcConfigP = TcConfigProvider.Constant(tcConfig) let sysRes,otherRes,knownUnresolved = TcAssemblyResolutions.SplitNonFoundationalResolutions(tcConfig) let tcGlobals,frameworkTcImports = TcImports.BuildFrameworkTcImports (foundationalTcConfigP, sysRes, otherRes) @@ -452,7 +395,7 @@ let getTcImportsFromCommandLine(displayPSTypeProviderSecurityDialogBlockingUI : // step - parse sourceFiles ReportTime tcConfig "Parse inputs" use unwindParsePhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parse) - let inputs : (ParsedInput * string) list = + let inputs = try sourceFiles |> tcConfig.ComputeCanContainEntryPoint @@ -466,14 +409,12 @@ let getTcImportsFromCommandLine(displayPSTypeProviderSecurityDialogBlockingUI : ) with e -> errorRecoveryNoRange e -#if SQM_SUPPORT SqmLoggerWithConfig tcConfig errorLogger.ErrorNumbers errorLogger.WarningNumbers -#endif exiter.Exit 1 if tcConfig.parseOnly then exiter.Exit 0 if not tcConfig.continueAfterParseFailure then - abortOnError(errorLogger, tcConfig, exiter) + AbortOnError(errorLogger, tcConfig, exiter) if tcConfig.printAst then inputs |> List.iter (fun (input,_filename) -> printf "AST:\n"; printfn "%+A" input; printf "\n") @@ -490,13 +431,13 @@ let getTcImportsFromCommandLine(displayPSTypeProviderSecurityDialogBlockingUI : disposables.Register tcImports if not tcConfig.continueAfterParseFailure then - abortOnError(errorLogger, tcConfig, exiter) + AbortOnError(errorLogger, tcConfig, exiter) if tcConfig.importAllReferencesOnly then exiter.Exit 0 ReportTime tcConfig "Typecheck" use unwindParsePhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.TypeCheck) - let tcEnv0 = GetInitialTypecheckerEnv (Some assemblyName) rangeStartup tcConfig tcImports tcGlobals + let tcEnv0 = GetInitialTcEnv (Some assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals) // typecheck let inputs : ParsedInput list = inputs |> List.map fst @@ -504,7 +445,7 @@ let getTcImportsFromCommandLine(displayPSTypeProviderSecurityDialogBlockingUI : TypeCheck(tcConfig,tcImports,tcGlobals,errorLogger,assemblyName,NiceNameGenerator(),tcEnv0,inputs,exiter) let generatedCcu = tcState.Ccu - abortOnError(errorLogger, tcConfig, exiter) + AbortOnError(errorLogger, tcConfig, exiter) ReportTime tcConfig "Typechecked" (tcGlobals,tcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig) @@ -512,33 +453,37 @@ let getTcImportsFromCommandLine(displayPSTypeProviderSecurityDialogBlockingUI : tcGlobals,tcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig,outfile,pdbfile,assemblyName,errorLogger // only called from the project system, as a way to run the front end of the compiler far enough to determine if we need to pop up the dialog (and do so if necessary) -let runFromCommandLineToImportingAssemblies(displayPSTypeProviderSecurityDialogBlockingUI : (string -> unit), - argv : string[], - defaultFSharpBinariesDir : string, - directoryBuildingFrom : string, - exiter : Exiter) = - - use d = new DelayedDisposables() // ensure that any resources that can be allocated in getTcImportsFromCommandLine will be correctly disposed - - let tcGlobals,tcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig,outfile,pdbfile,assemblyName,errorLogger = - getTcImportsFromCommandLine(Some displayPSTypeProviderSecurityDialogBlockingUI, argv, defaultFSharpBinariesDir, directoryBuildingFrom, None, (fun _ -> ()), - (fun tcConfigB -> - // (kind of abusing this lambda for an unintended purpose, but this is a convenient and correctly-timed place to poke the tcConfigB) - tcConfigB.importAllReferencesOnly <- true // stop after importing assemblies (do not typecheck, we don't need typechecking) - // for flags below, see IncrementalBuilder.fs:CreateBackgroundBuilderForProjectOptions, as there are many similarities, as these are the two places that we create this from VS code-paths - tcConfigB.openBinariesInMemory <- true // uses more memory but means we don't take read-exclusions on the DLLs we reference (important for VS code path) - tcConfigB.openDebugInformationForLaterStaticLinking <- false // Never open PDB files for the PS, even if --standalone is specified - if tcConfigB.framework then - System.Diagnostics.Debug.Assert(false, "Project system requires --noframework flag") - tcConfigB.framework<-false - ), - true, // optimizeForMemory - want small memory footprint in VS - exiter, - DefaultLoggerProvider(), // this function always use default set of loggers - d) - - // we don't care about the result, we just called 'getTcImportsFromCommandLine' to have the effect of popping up the dialog if the TP is unknown - ignore(tcGlobals,tcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig,outfile,pdbfile,assemblyName,errorLogger) +let ProcessCommandLineArgsAndImportAssemblies + (displayPSTypeProviderSecurityDialogBlockingUI : (string -> unit), + argv : string[], + defaultFSharpBinariesDir : string, + directoryBuildingFrom : string, + exiter : Exiter) = + + use disposables = new DisposablesTracker() // ensure that any resources that can be allocated in GetTcImportsFromCommandLine will be correctly disposed + + // We don't care about the result, we just called 'GetTcImportsFromCommandLine' to have the effect of popping up the dialog if the TP is unknown + GetTcImportsFromCommandLine + (Some displayPSTypeProviderSecurityDialogBlockingUI, + argv, + defaultFSharpBinariesDir, + directoryBuildingFrom, + None, + (fun _ -> ()), // setProcessThreadLocals + (fun tcConfigB -> + // (kind of abusing this lambda for an unintended purpose, but this is a convenient and correctly-timed place to poke the tcConfigB) + tcConfigB.importAllReferencesOnly <- true // stop after importing assemblies (do not typecheck, we don't need typechecking) + // for flags below, see IncrementalBuilder.fs:CreateBackgroundBuilderForProjectOptions, as there are many similarities, as these are the two places that we create this from VS code-paths + tcConfigB.openBinariesInMemory <- true // uses more memory but means we don't take read-exclusions on the DLLs we reference (important for VS code path) + tcConfigB.openDebugInformationForLaterStaticLinking <- false // Never open PDB files for the PS, even if --standalone is specified + if tcConfigB.framework then + Debug.Assert(false, "Project system requires --noframework flag") + tcConfigB.framework<-false), + true, // optimizeForMemory - want small memory footprint in VS + exiter, + DefaultLoggerProvider(), // this function always use default set of loggers + disposables) + |> ignore #if NO_COMPILER_BACKEND @@ -548,33 +493,33 @@ let runFromCommandLineToImportingAssemblies(displayPSTypeProviderSecurityDialogB // Code from here on down is just used by fsc.exe /////////////////////////////////////////////////////////////////////////////////////////////////////////////// -let BuildInitialDisplayEnvForSigFileGeneration tcGlobals = - let denv = DisplayEnv.Empty tcGlobals - let denv = - { denv with - showImperativeTyparAnnotations=true; - showHiddenMembers=true; - showObsoleteMembers=true; - showAttributes=true; } - denv.SetOpenPaths - [ FSharpLib.RootPath - FSharpLib.CorePath - FSharpLib.CollectionsPath - FSharpLib.ControlPath - (IL.splitNamespace FSharpLib.ExtraTopLevelOperatorsName); ] +module InterfaceFileWriter = + let BuildInitialDisplayEnvForSigFileGeneration tcGlobals = + let denv = DisplayEnv.Empty tcGlobals + let denv = + { denv with + showImperativeTyparAnnotations=true + showHiddenMembers=true + showObsoleteMembers=true + showAttributes=true } + denv.SetOpenPaths + [ FSharpLib.RootPath + FSharpLib.CorePath + FSharpLib.CollectionsPath + FSharpLib.ControlPath + (IL.splitNamespace FSharpLib.ExtraTopLevelOperatorsName) ] -module InterfaceFileWriter = let WriteInterfaceFile (tcGlobals, tcConfig:TcConfig, infoReader, typedAssembly) = let (TAssembly declaredImpls) = typedAssembly /// Use a UTF-8 Encoding with no Byte Order Mark let os = - if tcConfig.printSignatureFile="" then System.Console.Out + if tcConfig.printSignatureFile="" then Console.Out else (File.CreateText tcConfig.printSignatureFile :> TextWriter) - if tcConfig.printSignatureFile <> "" && not (List.exists (Filename.checkSuffix tcConfig.printSignatureFile) lightSyntaxDefaultExtensions) then + if tcConfig.printSignatureFile <> "" && not (List.exists (Filename.checkSuffix tcConfig.printSignatureFile) FSharpLightSyntaxFileSuffixes) then fprintfn os "#light" fprintfn os "" @@ -591,7 +536,7 @@ module XmlDocWriter = let getDoc xmlDoc = match XmlDoc.Process xmlDoc with | XmlDoc [| |] -> "" - | XmlDoc strs -> strs |> Array.toList |> String.concat System.Environment.NewLine + | XmlDoc strs -> strs |> Array.toList |> String.concat Environment.NewLine let hasDoc xmlDoc = // No need to process the xml doc - just need to know if there's anything there @@ -699,18 +644,13 @@ module XmlDocWriter = // cmd line - option state //---------------------------------------------------------------------------- -let getModuleFileName() = - Path.Combine(System.AppDomain.CurrentDomain.BaseDirectory, - System.AppDomain.CurrentDomain.FriendlyName) - -let defaultFSharpBinariesDir = Filename.directoryName (getModuleFileName()) - +let defaultFSharpBinariesDir = + let exeName = Path.Combine(AppDomain.CurrentDomain.BaseDirectory, AppDomain.CurrentDomain.FriendlyName) + Filename.directoryName exeName let outpath outfile extn = String.concat "." (["out"; Filename.chopExtension (Filename.fileNameOfPath outfile); extn]) - - let GenerateInterfaceData(tcConfig:TcConfig) = (* (tcConfig.target = Dll || tcConfig.target = Module) && *) not tcConfig.standalone && not tcConfig.noSignatureData @@ -744,9 +684,7 @@ let EncodeInterfaceData(tcConfig:TcConfig,tcGlobals,exportRemapping,_errorLogger [],[] with e -> errorRecoveryNoRange e -#if SQM_SUPPORT SqmLoggerWithConfig tcConfig _errorLogger.ErrorNumbers _errorLogger.WarningNumbers -#endif exiter.Exit 1 @@ -760,14 +698,14 @@ let GenerateOptimizationData(tcConfig) = let EncodeOptimizationData(tcGlobals,tcConfig,outfile,exportRemapping,data) = if GenerateOptimizationData tcConfig then - let data = map2Of2 (Opt.RemapLazyModulInfo tcGlobals exportRemapping) data + let data = map2Of2 (Optimizer.RemapOptimizationInfo tcGlobals exportRemapping) data if verbose then dprintn "Generating optimization data attribute..."; // REVIEW: need a better test for this let outFileNoExtension = Filename.chopExtension outfile let isCompilerServiceDll = outFileNoExtension.Contains("FSharp.LanguageService.Compiler") if tcConfig.useOptimizationDataFile || tcGlobals.compilingFslib || isCompilerServiceDll then let ccu,modulInfo = data - let bytes = Pickle.pickleObjWithDanglingCcus outfile tcGlobals ccu Opt.p_LazyModuleInfo modulInfo + let bytes = TastPickle.pickleObjWithDanglingCcus outfile tcGlobals ccu Optimizer.p_CcuOptimizationInfo modulInfo let optDataFileName = (Filename.chopExtension outfile)+".optdata" File.WriteAllBytes(optDataFileName,bytes); // As with the sigdata file, the optdata gets written to a file for FSharp.Core, FSharp.Compiler.Silverlight and FSharp.LanguageService.Compiler @@ -776,7 +714,7 @@ let EncodeOptimizationData(tcGlobals,tcConfig,outfile,exportRemapping,data) = else let (ccu, optData) = if tcConfig.onlyEssentialOptimizationData || tcConfig.useOptimizationDataFile - then map2Of2 Opt.AbstractLazyModulInfoToEssentials data + then map2Of2 Optimizer.AbstractOptimizationInfoToEssentials data else data [ WriteOptimizationData (tcGlobals, outfile, ccu, optData) ] else @@ -1007,23 +945,19 @@ module AttributeHelpers = | _ -> None -let injectedCompatTypes = set [ "System.Tuple`1"; - "System.Tuple`2" ; - "System.Tuple`3" ; - "System.Tuple`4"; - "System.Tuple`5"; - "System.Tuple`6"; - "System.Tuple`7"; - "System.Tuple`8"; - "System.ITuple"; - "System.Tuple"; - //"System.System_LazyDebugView`1"; - //"System.Threading.LazyExecutionMode"; - //"System.Threading.LazyInternalExceptionHolder"; - //"System.Threading.LazyBlock`1"; - "System.Collections.IStructuralComparable"; - "System.Collections.IStructuralEquatable"; - ] +let injectedCompatTypes = + set [ "System.Tuple`1" + "System.Tuple`2" + "System.Tuple`3" + "System.Tuple`4" + "System.Tuple`5" + "System.Tuple`6" + "System.Tuple`7" + "System.Tuple`8" + "System.ITuple" + "System.Tuple" + "System.Collections.IStructuralComparable" + "System.Collections.IStructuralEquatable" ] let typesForwardedToMscorlib = set [ "System.AggregateException"; @@ -1090,7 +1024,7 @@ module MainModuleBuilder = // Add the type forwarders to any .NET DLL post-.NET-2.0, to give binary compatibility let exportedTypesList = if (tcConfig.compilingFslib && tcConfig.compilingFslib40) then (List.append (createMscorlibExportList tcGlobals) (createSystemNumericsExportList tcGlobals)) else [] - mkILSimpleModule assemblyName (fsharpModuleName tcConfig.target assemblyName) (tcConfig.target = Dll || tcConfig.target = Module) tcConfig.subsystemVersion tcConfig.useHighEntropyVA ilTypeDefs hashAlg locale flags (mkILExportedTypes exportedTypesList) metadataVersion + mkILSimpleModule assemblyName (GetGeneratedILModuleName tcConfig.target assemblyName) (tcConfig.target = Dll || tcConfig.target = Module) tcConfig.subsystemVersion tcConfig.useHighEntropyVA ilTypeDefs hashAlg locale flags (mkILExportedTypes exportedTypesList) metadataVersion let disableJitOptimizations = not (tcConfig.optSettings.jitOpt()) @@ -1181,7 +1115,7 @@ module MainModuleBuilder = CustomAttrs=emptyILCustomAttrs } ] //NOTE: the culture string can be turned into a number using this: - // sprintf "%04x" (System.Globalization.CultureInfo.GetCultureInfo("en").KeyboardLayoutId ) + // sprintf "%04x" (CultureInfo.GetCultureInfo("en").KeyboardLayoutId ) let assemblyVersionResources = let assemblyVersion = match tcConfig.version with @@ -1421,16 +1355,12 @@ module StaticLinker = ilxMainModule, rewriteExternalRefsToLocalRefs - #if DEBUG - let PrintModule outfile x = - use os = File.CreateText(outfile) :> TextWriter - ILAsciiWriter.output_module os x - #endif - - + // LEGACY: This is only used when compiling an FSharp.Core for .NET 2.0 (FSharp.Core 2.3.0.0). We no longer + // build new FSharp.Core for that configuration. + // // Find all IL modules that are to be statically linked given the static linking roots. - let FindAndAddMscorlibTypesForStaticLinkingIntoFSharpCoreLibrary (tcConfig:TcConfig, ilGlobals:ILGlobals, ilxMainModule) = - let mscorlib40 = tcConfig.compilingFslib20.Value // + @"\..\.NET Framework 4.0 Pre Beta\mscorlib.dll" + let LegacyFindAndAddMscorlibTypesForStaticLinkingIntoFSharpCoreLibraryForNet20 (tcConfig:TcConfig, ilGlobals:ILGlobals, ilxMainModule) = + let mscorlib40 = tcConfig.compilingFslib20.Value let ilBinaryReader = let ilGlobals = mkILGlobals (IL.mkMscorlibBasedTraits ILScopeRef.Local) (Some ilGlobals.primaryAssemblyName) tcConfig.noDebugData @@ -1609,16 +1539,16 @@ module StaticLinker = | Some provAssemStaticLinkInfo -> yield (importedBinary,provAssemStaticLinkInfo) ] #endif if tcConfig.compilingFslib && tcConfig.compilingFslib20.IsSome then - (fun (ilxMainModule,_) -> FindAndAddMscorlibTypesForStaticLinkingIntoFSharpCoreLibrary (tcConfig, ilGlobals, ilxMainModule)) + (fun ilxMainModule -> LegacyFindAndAddMscorlibTypesForStaticLinkingIntoFSharpCoreLibraryForNet20 (tcConfig, ilGlobals, ilxMainModule)) elif not tcConfig.standalone && tcConfig.extraStaticLinkRoots.IsEmpty #if EXTENSIONTYPING && providerGeneratedAssemblies.IsEmpty #endif then - (fun (ilxMainModule,_outfile) -> ilxMainModule) + (fun ilxMainModule -> ilxMainModule) else - (fun (ilxMainModule,outfile) -> + (fun ilxMainModule -> ReportTime tcConfig "Find assembly references"; let dependentILModules = FindDependentILModulesForStaticLinking (tcConfig, tcImports,ilxMainModule) @@ -1768,13 +1698,6 @@ module StaticLinker = let rewriteAssemblyRefsToMatchLibraries = NormalizeAssemblyRefs tcImports Morphs.morphILTypeRefsInILModuleMemoized ilGlobals (Morphs.morphILScopeRefsInILTypeRef (validateTargetPlatform >> rewriteExternalRefsToLocalRefs >> rewriteAssemblyRefsToMatchLibraries)) ilxMainModule - #if DEBUG - // Print it out if requested - if tcConfig.writeGeneratedILFiles then (let _ = PrintModule (outpath outfile "ilx.main") ilxMainModule in ()); - #else - ignore outfile - #endif - ilxMainModule) //---------------------------------------------------------------------------- @@ -1784,65 +1707,46 @@ module StaticLinker = type SigningInfo = SigningInfo of (* delaysign:*) bool * (*signer:*) string option * (*container:*) string option module FileWriter = - let EmitIL (tcConfig:TcConfig,ilGlobals,_errorLogger:ErrorLogger,outfile,pdbfile,ilxMainModule,signingInfo:SigningInfo,exiter:Exiter) = - let (SigningInfo(delaysign,signer,container)) = signingInfo + let EmitIL (tcConfig:TcConfig, ilGlobals, _errorLogger:ErrorLogger, outfile, pdbfile, ilxMainModule, signingInfo:SigningInfo, exiter:Exiter) = + let (SigningInfo(delaysign, signerOpt, container)) = signingInfo try - #if DEBUG - if tcConfig.writeGeneratedILFiles then dprintn "Printing module..."; - if tcConfig.writeGeneratedILFiles then StaticLinker.PrintModule (outpath outfile "il.txt") ilxMainModule; - #endif if !progress then dprintn "Writing assembly..."; try - ILBinaryWriter.WriteILBinary - outfile - { ilg = ilGlobals - pdbfile=pdbfile; - emitTailcalls= tcConfig.emitTailcalls; - showTimes=tcConfig.showTimes; - - signer = - begin - // REVIEW: favor the container over the key file - C# appears to do this - if isSome container then - Some(ILBinaryWriter.ILStrongNameSigner.OpenKeyContainer container.Value) - else - match signer with - | None -> None - | Some(s) -> - try + let signer = + // Favor the container over the key file - C# appears to do this + if isSome container then + Some(ILBinaryWriter.ILStrongNameSigner.OpenKeyContainer container.Value) + else + match signerOpt with + | None -> None + | Some s -> + try if delaysign then - Some (ILBinaryWriter.ILStrongNameSigner.OpenPublicKeyFile s) + Some (ILBinaryWriter.ILStrongNameSigner.OpenPublicKeyFile s) else - Some (ILBinaryWriter.ILStrongNameSigner.OpenKeyPairFile s) - with e -> - // Note:: don't use errorR here since we really want to fail and not produce a binary - error(Error(FSComp.SR.fscKeyFileCouldNotBeOpened(s),rangeCmdArgs)) - end; - fixupOverlappingSequencePoints = false; - dumpDebugInfo =tcConfig.dumpDebugInfo } - ilxMainModule - tcConfig.noDebugData + Some (ILBinaryWriter.ILStrongNameSigner.OpenKeyPairFile s) + with e -> + // Note:: don't use errorR here since we really want to fail and not produce a binary + error(Error(FSComp.SR.fscKeyFileCouldNotBeOpened(s),rangeCmdArgs)) + let options : ILBinaryWriter.options = + { ilg = ilGlobals + pdbfile = pdbfile + emitTailcalls = tcConfig.emitTailcalls + showTimes = tcConfig.showTimes + signer = signer + fixupOverlappingSequencePoints = false + dumpDebugInfo = tcConfig.dumpDebugInfo } + ILBinaryWriter.WriteILBinary (outfile, options, ilxMainModule, tcConfig.noDebugData) + with Failure msg -> error(Error(FSComp.SR.fscProblemWritingBinary(outfile,msg), rangeCmdArgs)) with e -> errorRecoveryNoRange e -#if SQM_SUPPORT SqmLoggerWithConfig tcConfig _errorLogger.ErrorNumbers _errorLogger.WarningNumbers -#endif exiter.Exit 1 - let WriteStatsFile (tcConfig:TcConfig,outfile) = - if tcConfig.stats then - try - use oc = new StreamWriter((outpath outfile "stats.txt"),append=false,encoding=Encoding.UTF8) :> TextWriter -#if STATISTICS - Ilread.report oc; -#endif - Ilxgen.ReportStatistics oc; - with _ -> () - -let ValidateKeySigningAttributes (tcConfig : TcConfig) tcGlobals topAttrs = +let ValidateKeySigningAttributes (tcConfig : TcConfig, tcGlobals, topAttrs) = let delaySignAttrib = AttributeHelpers.TryFindBoolAttribute tcGlobals "System.Reflection.AssemblyDelaySignAttribute" topAttrs.assemblyAttrs let signerAttrib = AttributeHelpers.TryFindStringAttribute tcGlobals "System.Reflection.AssemblyKeyFileAttribute" topAttrs.assemblyAttrs let containerAttrib = AttributeHelpers.TryFindStringAttribute tcGlobals "System.Reflection.AssemblyKeyNameAttribute" topAttrs.assemblyAttrs @@ -1887,12 +1791,6 @@ let ValidateKeySigningAttributes (tcConfig : TcConfig) tcGlobals topAttrs = SigningInfo (delaysign,signer,container) -/// Checks if specified file name is absolute path. If yes - returns the name as is, otherwise makes full path using tcConfig.implicitIncludeDir as base. -let expandFileNameIfNeeded (tcConfig : TcConfig) name = - if System.IO.Path.IsPathRooted name then name - else - System.IO.Path.Combine(tcConfig.implicitIncludeDir, name) - //---------------------------------------------------------------------------- // main - split up to make sure that we can GC the // dead data at the end of each phase. We explicitly communicate arguments @@ -1900,54 +1798,53 @@ let expandFileNameIfNeeded (tcConfig : TcConfig) name = //----------------------------------------------------------------------------- [] -type Args<'a> = Args of 'a +type Args<'T> = Args of 'T -let main0(argv,bannerAlreadyPrinted,exiter:Exiter, errorLoggerProvider : ErrorLoggerProvider, disposables : DelayedDisposables) = +let main0(argv,bannerAlreadyPrinted,exiter:Exiter, errorLoggerProvider : ErrorLoggerProvider, disposables : DisposablesTracker) = // See Bug 735819 let lcidFromCodePage = - if (System.Console.OutputEncoding.CodePage <> 65001) && - (System.Console.OutputEncoding.CodePage <> System.Threading.Thread.CurrentThread.CurrentUICulture.TextInfo.OEMCodePage) && - (System.Console.OutputEncoding.CodePage <> System.Threading.Thread.CurrentThread.CurrentUICulture.TextInfo.ANSICodePage) then - System.Threading.Thread.CurrentThread.CurrentUICulture <- new System.Globalization.CultureInfo("en-US") + if (Console.OutputEncoding.CodePage <> 65001) && + (Console.OutputEncoding.CodePage <> Thread.CurrentThread.CurrentUICulture.TextInfo.OEMCodePage) && + (Console.OutputEncoding.CodePage <> Thread.CurrentThread.CurrentUICulture.TextInfo.ANSICodePage) then + Thread.CurrentThread.CurrentUICulture <- new CultureInfo("en-US") Some(1033) else None let tcGlobals,tcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig,outfile,pdbfile,assemblyName,errorLogger = - getTcImportsFromCommandLine(None, argv, defaultFSharpBinariesDir, Directory.GetCurrentDirectory(), lcidFromCodePage, (fun tcConfigB -> - match tcConfigB.lcid with - | Some(n) -> System.Threading.Thread.CurrentThread.CurrentUICulture <- new System.Globalization.CultureInfo(n) - | None -> () + GetTcImportsFromCommandLine + (None, argv, defaultFSharpBinariesDir, Directory.GetCurrentDirectory(), + lcidFromCodePage, + // setProcessThreadLocals + (fun tcConfigB -> + match tcConfigB.lcid with + | Some(n) -> Thread.CurrentThread.CurrentUICulture <- new CultureInfo(n) + | None -> () - if tcConfigB.utf8output then - let prev = System.Console.OutputEncoding - System.Console.OutputEncoding <- Encoding.UTF8 - System.AppDomain.CurrentDomain.ProcessExit.Add(fun _ -> System.Console.OutputEncoding <- prev) - ), (fun tcConfigB -> - // display the banner text, if necessary - if not bannerAlreadyPrinted then - Microsoft.FSharp.Compiler.Fscopts.DisplayBannerText tcConfigB - ), - false, // optimizeForMemory - fsc.exe can use as much memory as it likes to try to compile as fast as possible - exiter, - errorLoggerProvider, - disposables - - ) - - tcGlobals,tcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig,outfile,pdbfile,assemblyName,errorLogger, exiter - -// TcGlobals * TcImports * TcImports * CcuThunk * TypedAssembly * TopAttribs * TcConfig * string * string * string* ErrorLogger* Exiter -let main1(tcGlobals,tcImports : TcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig : TcConfig, outfile,pdbfile,assemblyName,errorLogger, exiter : Exiter) = - + if tcConfigB.utf8output then + let prev = Console.OutputEncoding + Console.OutputEncoding <- Encoding.UTF8 + System.AppDomain.CurrentDomain.ProcessExit.Add(fun _ -> Console.OutputEncoding <- prev)), + (fun tcConfigB -> + // display the banner text, if necessary + if not bannerAlreadyPrinted then + DisplayBannerText tcConfigB), + false, // optimizeForMemory - fsc.exe can use as much memory as it likes to try to compile as fast as possible + exiter, + errorLoggerProvider, + disposables) + + tcGlobals,tcImports,frameworkTcImports,generatedCcu,typedAssembly,topAttrs,tcConfig,outfile,pdbfile,assemblyName,errorLogger,exiter + +let main1(tcGlobals, tcImports: TcImports, frameworkTcImports, generatedCcu, typedAssembly, topAttrs, tcConfig: TcConfig, outfile, pdbfile, assemblyName, errorLogger, exiter: Exiter) = if tcConfig.typeCheckOnly then exiter.Exit 0 use unwindPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.CodeGen) - let signingInfo = ValidateKeySigningAttributes tcConfig tcGlobals topAttrs + let signingInfo = ValidateKeySigningAttributes (tcConfig, tcGlobals, topAttrs) - abortOnError(errorLogger,tcConfig,exiter) + AbortOnError(errorLogger,tcConfig,exiter) // Build an updated errorLogger that filters according to the scopedPragmas. Then install // it as the updated global error logger and never remove it @@ -1979,7 +1876,7 @@ let main1(tcGlobals,tcImports : TcImports,frameworkTcImports,generatedCcu,typedA XmlDocWriter.computeXmlDocSigs (tcGlobals,generatedCcu) ReportTime tcConfig ("Write XML docs"); tcConfig.xmlDocOutputFile |> Option.iter ( fun xmlFile -> - let xmlFile = expandFileNameIfNeeded tcConfig xmlFile + let xmlFile = tcConfig.MakePathAbsolute xmlFile XmlDocWriter.writeXmlDoc (assemblyName,generatedCcu,xmlFile) ) ReportTime tcConfig ("Write HTML docs"); @@ -1989,31 +1886,23 @@ let main1(tcGlobals,tcImports : TcImports,frameworkTcImports,generatedCcu,typedA // Pass on only the minimimum information required for the next phase to ensure GC kicks in. // In principle the JIT should be able to do good liveness analysis to clean things up, but the // data structures involved here are so large we can't take the risk. - Args(tcConfig,tcImports,frameworkTcImports,tcGlobals,errorLogger,generatedCcu,outfile,typedAssembly,topAttrs,pdbfile,assemblyName,assemVerFromAttrib,signingInfo,exiter) + Args(tcConfig, tcImports, frameworkTcImports, tcGlobals, errorLogger, generatedCcu, outfile, typedAssembly, topAttrs, pdbfile, assemblyName, assemVerFromAttrib, signingInfo, exiter) -let main2(Args(tcConfig,tcImports,frameworkTcImports : TcImports,tcGlobals,errorLogger,generatedCcu:CcuThunk,outfile,typedAssembly,topAttrs,pdbfile,assemblyName,assemVerFromAttrib,signingInfo,exiter:Exiter)) = +let main2(Args(tcConfig, tcImports, frameworkTcImports: TcImports, tcGlobals, errorLogger, generatedCcu: CcuThunk, outfile, typedAssembly, topAttrs, pdbfile, assemblyName, assemVerFromAttrib, signingInfo, exiter: Exiter)) = ReportTime tcConfig ("Encode Interface Data"); -#if DEBUG - if !verboseStamps then - dprintf "---------------------- START MAKE EXPORT REMAPPING ------------\n"; -#endif let exportRemapping = MakeExportRemapping generatedCcu generatedCcu.Contents -#if DEBUG - if !verboseStamps then - dprintf "---------------------- END MAKE EXPORT REMAPPING ------------\n"; -#endif let sigDataAttributes,sigDataResources = - EncodeInterfaceData(tcConfig,tcGlobals,exportRemapping,errorLogger,generatedCcu,outfile,exiter) + EncodeInterfaceData(tcConfig, tcGlobals, exportRemapping, errorLogger, generatedCcu, outfile, exiter) if !progress && tcConfig.optSettings.jitOptUser = Some false then dprintf "Note, optimizations are off.\n"; (* optimize *) use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Optimize) - let optEnv0 = InitialOptimizationEnv tcImports tcGlobals + let optEnv0 = GetInitialOptimizationEnv (tcImports, tcGlobals) let importMap = tcImports.GetImportMap() let metadataVersion = @@ -2022,7 +1911,7 @@ let main2(Args(tcConfig,tcImports,frameworkTcImports : TcImports,tcGlobals,error | _ -> match (frameworkTcImports.DllTable.TryFind tcConfig.primaryAssembly.Name) with | Some(ib) -> ib.RawMetadata.MetadataVersion | _ -> "" let optimizedImpls,optimizationData,_ = ApplyAllOptimizations (tcConfig, tcGlobals, (LightweightTcValForUsingInBuildMethodCall tcGlobals), outfile, importMap, false, optEnv0, generatedCcu, typedAssembly) - abortOnError(errorLogger,tcConfig,exiter) + AbortOnError(errorLogger,tcConfig,exiter) ReportTime tcConfig ("Encoding OptData"); let optDataResources = EncodeOptimizationData(tcGlobals,tcConfig,outfile,exportRemapping,(generatedCcu,optimizationData)) @@ -2050,7 +1939,7 @@ let main2(Args(tcConfig,tcImports,frameworkTcImports : TcImports,tcGlobals,error // data structures involved here are so large we can't take the risk. Args(tcConfig,tcImports,tcGlobals,errorLogger,generatedCcu,outfile,optimizedImpls,topAttrs,pdbfile,assemblyName, (sigDataAttributes, sigDataResources), optDataResources,assemVerFromAttrib,signingInfo,metadataVersion,exiter) -let main2b(Args(tcConfig:TcConfig,tcImports,tcGlobals,errorLogger,generatedCcu:CcuThunk,outfile,optimizedImpls,topAttrs,pdbfile,assemblyName,idata,optDataResources,assemVerFromAttrib,signingInfo,metadataVersion,exiter:Exiter)) = +let main2b(Args(tcConfig: TcConfig, tcImports, tcGlobals, errorLogger, generatedCcu: CcuThunk, outfile, optimizedImpls, topAttrs, pdbfile, assemblyName, idata, optDataResources, assemVerFromAttrib, signingInfo, metadataVersion, exiter: Exiter)) = // Compute a static linker. let ilGlobals = tcGlobals.ilg @@ -2076,71 +1965,57 @@ let main2b(Args(tcConfig:TcConfig,tcImports,tcGlobals,errorLogger,generatedCcu:C let ilxMainModule = MainModuleBuilder.CreateMainModule (tcConfig,tcGlobals,pdbfile,assemblyName,outfile,topAttrs,idata,optDataResources,codegenResults,assemVerFromAttrib,metadataVersion,secDecls) -#if DEBUG - // Print code before bailing out from the compiler due to errors - // in the backend of the compiler. The partially-generated - // ILX code often contains useful information. - if tcConfig.writeGeneratedILFiles then StaticLinker.PrintModule (outpath outfile "ilx.txt") ilxMainModule; -#endif - abortOnError(errorLogger,tcConfig,exiter) + AbortOnError(errorLogger,tcConfig,exiter) Args (tcConfig,errorLogger,staticLinker,ilGlobals,outfile,pdbfile,ilxMainModule,signingInfo,exiter) -let main2c(Args(tcConfig,errorLogger,staticLinker,ilGlobals,outfile,pdbfile,ilxMainModule,signingInfo,exiter:Exiter)) = +let main2c(Args(tcConfig, errorLogger, staticLinker, ilGlobals, outfile, pdbfile, ilxMainModule, signingInfo, exiter: Exiter)) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.IlGen) ReportTime tcConfig "ILX -> IL (Unions)"; - let ilxMainModule = EraseIlxUnions.ConvModule ilGlobals ilxMainModule + let ilxMainModule = EraseUnions.ConvModule ilGlobals ilxMainModule ReportTime tcConfig "ILX -> IL (Funcs)"; - let ilxMainModule = EraseIlxFuncs.ConvModule ilGlobals ilxMainModule + let ilxMainModule = EraseClosures.ConvModule ilGlobals ilxMainModule - abortOnError(errorLogger,tcConfig,exiter) + AbortOnError(errorLogger,tcConfig,exiter) Args(tcConfig,errorLogger,staticLinker,ilGlobals,ilxMainModule,outfile,pdbfile,signingInfo,exiter) -let main3(Args(tcConfig,errorLogger:ErrorLogger,staticLinker,ilGlobals,ilxMainModule,outfile,pdbfile,signingInfo,exiter:Exiter)) = +let main3(Args(tcConfig, errorLogger: ErrorLogger, staticLinker, ilGlobals, ilxMainModule, outfile, pdbfile, signingInfo, exiter:Exiter)) = let ilxMainModule = - try staticLinker (ilxMainModule,outfile) + try staticLinker ilxMainModule with e -> errorRecoveryNoRange e -#if SQM_SUPPORT SqmLoggerWithConfig tcConfig errorLogger.ErrorNumbers errorLogger.WarningNumbers -#endif exiter.Exit 1 - abortOnError(errorLogger,tcConfig,exiter) + AbortOnError(errorLogger,tcConfig,exiter) Args (tcConfig,errorLogger,ilGlobals,ilxMainModule,outfile,pdbfile,signingInfo,exiter) -let main4(Args(tcConfig,errorLogger:ErrorLogger,ilGlobals,ilxMainModule,outfile,pdbfile,signingInfo,exiter)) = +let main4 (Args (tcConfig, errorLogger: ErrorLogger, ilGlobals, ilxMainModule, outfile, pdbfile, signingInfo, exiter)) = ReportTime tcConfig "Write .NET Binary" use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Output) - let outfile = expandFileNameIfNeeded tcConfig outfile + let outfile = tcConfig.MakePathAbsolute outfile - let pdbfile = pdbfile |> Option.map ((expandFileNameIfNeeded tcConfig) >> Path.GetFullPath) - FileWriter.EmitIL (tcConfig,ilGlobals,errorLogger,outfile,pdbfile,ilxMainModule,signingInfo,exiter) + let pdbfile = pdbfile |> Option.map (tcConfig.MakePathAbsolute >> Path.GetFullPath) + FileWriter.EmitIL (tcConfig, ilGlobals, errorLogger, outfile, pdbfile, ilxMainModule, signingInfo, exiter) - ReportTime tcConfig "Write Stats File" - FileWriter.WriteStatsFile (tcConfig,outfile) - - abortOnError(errorLogger,tcConfig,exiter) + AbortOnError(errorLogger, tcConfig, exiter) if tcConfig.showLoadedAssemblies then for a in System.AppDomain.CurrentDomain.GetAssemblies() do dprintfn "%s" a.FullName -#if SQM_SUPPORT SqmLoggerWithConfig tcConfig errorLogger.ErrorNumbers errorLogger.WarningNumbers -#endif ReportTime tcConfig "Exiting" let typecheckAndCompile(argv,bannerAlreadyPrinted,exiter:Exiter, errorLoggerProvider) = - // Don's note: "GC of intermediate data is really, really important here" - use d = new DelayedDisposables() - main0(argv,bannerAlreadyPrinted,exiter, errorLoggerProvider, d) + use disposables = new DisposablesTracker() + main0(argv,bannerAlreadyPrinted,exiter, errorLoggerProvider, disposables) |> main1 |> main2 |> main2b @@ -2148,17 +2023,16 @@ let typecheckAndCompile(argv,bannerAlreadyPrinted,exiter:Exiter, errorLoggerProv |> main3 |> main4 -let mainCompile (argv,bannerAlreadyPrinted,exiter:Exiter) = +let mainCompile (argv, bannerAlreadyPrinted, exiter:Exiter) = // Enabling batch latency mode currently overrides app config . // If batch mode is ever removed or changed, revisit use of . System.Runtime.GCSettings.LatencyMode <- System.Runtime.GCLatencyMode.Batch typecheckAndCompile(argv, bannerAlreadyPrinted, exiter, DefaultLoggerProvider()) +[] type CompilationOutput = - { - Errors : seq - Warnings : seq - } + { Errors : ErrorOrWarning[] + Warnings : ErrorOrWarning[] } type InProcCompiler() = member this.Compile(argv) = @@ -2166,23 +2040,21 @@ type InProcCompiler() = let errors = ResizeArray() let warnings = ResizeArray() - let rec loggerProvider = { - new ErrorLoggerProvider() with + let loggerProvider = + { new ErrorLoggerProvider() with member log.CreateErrorLoggerThatQuitsAfterMaxErrors(tcConfigBuilder, exiter) = - upcast { - new ErrorLoggerThatQuitsAfterMaxErrors(tcConfigBuilder, exiter, "InProcCompilerErrorLoggerThatQuitsAfterMaxErrors") with + { new ErrorLoggerThatQuitsAfterMaxErrors(tcConfigBuilder, exiter, "InProcCompilerErrorLoggerThatQuitsAfterMaxErrors") with member this.HandleTooManyErrors(text) = warnings.Add(ErrorOrWarning.Short(false, text)) member this.HandleIssue(tcConfigBuilder, err, isWarning) = let errs = CollectErrorOrWarning(tcConfigBuilder.implicitIncludeDir, tcConfigBuilder.showFullPaths, tcConfigBuilder.flatErrors, tcConfigBuilder.errorStyle, isWarning, err) let container = if isWarning then warnings else errors - container.AddRange(errs) - } - } - let exitCode = ref 0 - let exiter = { - new Exiter with - member this.Exit n = exitCode := n; raise StopProcessing + container.AddRange(errs) } + :> ErrorLogger } + let exitCode = ref 0 + let exiter = + { new Exiter with + member this.Exit n = exitCode := n; raise StopProcessing } try typecheckAndCompile(argv, false, exiter, loggerProvider) with @@ -2191,267 +2063,8 @@ type InProcCompiler() = exitCode := 1 () - let output = { Warnings = warnings; Errors = errors} + let output : CompilationOutput = { Warnings = warnings.ToArray(); Errors = errors.ToArray()} !exitCode = 0, output -/// Collect the output from the stdout and stderr streams, character by character, -/// recording the console color used along the way. -type private OutputCollector() = - let output = ResizeArray() - let outWriter isOut = - { new TextWriter() with - member x.Write(c:char) = lock output (fun () -> output.Add (isOut, (try Some System.Console.ForegroundColor with _ -> None) ,c)) - member x.Encoding = Encoding.UTF8 } - do System.Console.SetOut (outWriter true) - do System.Console.SetError (outWriter false) - member x.GetTextAndClear() = lock output (fun () -> let res = output.ToArray() in output.Clear(); res) - -/// Implement the optional resident compilation service -module FSharpResidentCompiler = - - open System - open System.Diagnostics - open System.Runtime.Remoting.Channels - open System.Runtime.Remoting - open System.Runtime.Remoting.Lifetime - - /// The compilation server, which runs in the server process. Accessed by clients using .NET remoting. - type FSharpCompilationServer(exiter:Exiter) = - inherit MarshalByRefObject() - - static let onWindows = - match System.Environment.OSVersion.Platform with - | PlatformID.Win32NT | PlatformID.Win32S | PlatformID.Win32Windows | PlatformID.WinCE -> true - | _ -> false - - // The channel/socket name is qualified by the user name (and domain on windows) - static let domainName = if onWindows then Environment.GetEnvironmentVariable "USERDOMAIN" else "" - static let userName = Environment.GetEnvironmentVariable (if onWindows then "USERNAME" else "USER") - // Use different base channel names on mono and CLR as a CLR remoting process can't talk - // to a mono server - static let baseChannelName = if runningOnMono then "FSCChannelMono" else "FSCChannel" - static let channelName = baseChannelName + "_" + domainName + "_" + userName - static let serverName = if runningOnMono then "FSCServerMono" else "FSCSever" - static let mutable serverExists = true - - let outputCollector = new OutputCollector() - - // This background agent ensures all compilation requests sent to the server are serialized - let agent = MailboxProcessor<_>.Start(fun inbox -> - async { - while true do - let! (pwd,argv, reply: AsyncReplyChannel<_>) = inbox.Receive() - if !progress then printfn "server agent: got compilation request, argv = %A" argv - let exitCode = - try - Environment.CurrentDirectory <- pwd - mainCompile (argv, true, exiter); - if !progress then printfn "server: finished compilation request, argv = %A" argv - 0 - with e -> - if !progress then printfn "server: finished compilation request with errors, argv = %A" argv - errorRecoveryNoRange e - 1 - let output = outputCollector.GetTextAndClear() - reply.Reply(output, exitCode) - GC.Collect(3) - // Exit the server if there are no outstanding requests and the - // current memory usage after collection is over 200MB - if inbox.CurrentQueueLength = 0 && GC.GetTotalMemory(true) > 200L * 1024L * 1024L then - Environment.Exit 0 - }) - - member x.Run() = - while serverExists do - if !progress then printfn "server: startup thread sleeping..." - System.Threading.Thread.Sleep 1000 - - abstract Ping : unit -> string - abstract Compile : string * string[] -> (bool * System.ConsoleColor option * char) [] * int - default x.Ping() = "ping" - default x.Compile (pwd,argv) = - if !progress then printfn "server: got compilation request, (pwd, argv) = %A" (pwd, argv) - agent.PostAndReply(fun reply -> (pwd,argv,reply)) - - override x.Finalize() = - serverExists <- false - - // This is called on the server object by .NET remoting to initialize the lifetime characteristics - // of the server object. - override x.InitializeLifetimeService() = - let lease = (base.InitializeLifetimeService() :?> ILease) - if (lease.CurrentState = LeaseState.Initial) then - lease.InitialLeaseTime <- TimeSpan.FromDays(1.0); - lease.SponsorshipTimeout <- TimeSpan.FromMinutes(2.0); - lease.RenewOnCallTime <- TimeSpan.FromDays(1.0); - box lease - - static member RunServer(exiter:Exiter) = - progress := condition "FSHARP_SERVER_PROGRESS" - if !progress then printfn "server: initializing server object" - let server = new FSharpCompilationServer(exiter) - let chan = new Ipc.IpcChannel(channelName) - ChannelServices.RegisterChannel(chan,false); - RemotingServices.Marshal(server,serverName) |> ignore - - // On Unix, the file permissions of the implicit socket need to be set correctly to make this - // private to the user. - if runningOnMono then - try - let monoPosix = System.Reflection.Assembly.Load("Mono.Posix, Version=2.0.0.0, Culture=neutral, PublicKeyToken=0738eb9f132ed756") - let monoUnixFileInfo = monoPosix.GetType("Mono.Unix.UnixFileSystemInfo") - let socketName = Path.Combine(FileSystem.GetTempPathShim(), channelName) - let fileEntry = monoUnixFileInfo.InvokeMember("GetFileSystemEntry", (BindingFlags.InvokeMethod ||| BindingFlags.Static ||| BindingFlags.Public), null, null, [| box socketName |],System.Globalization.CultureInfo.InvariantCulture) - // Add 0x00000180 (UserReadWriteExecute) to the access permissions on Unix - monoUnixFileInfo.InvokeMember("set_FileAccessPermissions", (BindingFlags.InvokeMethod ||| BindingFlags.Instance ||| BindingFlags.Public), null, fileEntry, [| box 0x00000180 |],System.Globalization.CultureInfo.InvariantCulture) |> ignore -#if DEBUG - printfn "server: good, set permissions on socket name '%s'" socketName - let fileEntry = monoUnixFileInfo.InvokeMember("GetFileSystemEntry", (BindingFlags.InvokeMethod ||| BindingFlags.Static ||| BindingFlags.Public), null, null, [| box socketName |],System.Globalization.CultureInfo.InvariantCulture) - let currPermissions = monoUnixFileInfo.InvokeMember("get_FileAccessPermissions", (BindingFlags.InvokeMethod ||| BindingFlags.Instance ||| BindingFlags.Public), null, fileEntry, [| |],System.Globalization.CultureInfo.InvariantCulture) |> unbox - if !progress then printfn "server: currPermissions = '%o' (octal)" currPermissions -#endif - with e -> -#if DEBUG - printfn "server: failed to set permissions on socket, perhaps on windows? Is is not needed there." -#endif - () - // Fail silently - server.Run() - - static member private ConnectToServer() = - Activator.GetObject(typeof,"ipc://" + channelName + "/" + serverName) - :?> FSharpCompilationServer - - static member TryCompileUsingServer(argv) = - let pwd = System.Environment.CurrentDirectory - let clientOpt = - // Detect the absence of the channel via the exception. Probably not the best way. - // Different exceptions get thrown here on Mono and Windows. - let client = FSharpCompilationServer.ConnectToServer() - try - if !progress then printfn "client: attempting to connect to existing service (1)" - client.Ping() |> ignore - if !progress then printfn "client: connected to existing service" - Some client - with _ -> - let procInfo = - if runningOnMono then - let shellName, useShellExecute = - match System.Environment.GetEnvironmentVariable("FSC_MONO") with - | null -> - if onWindows then - Path.Combine(Path.GetDirectoryName (typeof.Assembly.Location), @"..\..\..\bin\mono.exe"), false - else - "mono", true - | path -> path, false - - // e.g. "C:\Program Files\Mono-2.6.1\lib\mono\2.0\mscorlib.dll" --> "C:\Program Files\Mono-2.6.1\bin\mono.exe" - ProcessStartInfo(FileName = shellName, - Arguments = typeof.Assembly.Location + " /server", - CreateNoWindow = true, - UseShellExecute = useShellExecute) - else - ProcessStartInfo(FileName=typeof.Assembly.Location, - Arguments = "/server", - CreateNoWindow = true, - UseShellExecute = false) - - let cmdProcess = new Process(StartInfo=procInfo) - - //let exitE = cmdProcess.Exited |> Observable.map (fun x -> x) - - cmdProcess.Start() |> ignore - //exitE.Add(fun _ -> if !progress then eprintfn "client: the server has exited") - cmdProcess.EnableRaisingEvents <- true; - - // Create the client proxy and attempt to connect to the server - let rec tryAcccesServer nRemaining = - if nRemaining = 0 then - // Failed to connect to server, give up - None - else - try - if !progress then printfn "client: attempting to connect to existing service (2)" - client.Ping() |> ignore - if !progress then printfn "client: connected to existing service" - Some client - // Detect the absence of the channel via the exception. Probably not the best way. - // Different exceptions get thrown here on Mono and Windows. - with _ (* System.Runtime.Remoting.RemotingException *) -> - // Sleep a bit - System.Threading.Thread.Sleep 50 - tryAcccesServer (nRemaining - 1) - - tryAcccesServer 20 - - match clientOpt with - | Some client -> - if !progress then printfn "client: calling client.Compile(%A)" argv - // Install the global error logger and never remove it. This logger does have all command-line flags considered. - try - let (output, exitCode) = - try client.Compile (pwd, argv) - with e -> - printfn "server error: %s" (e.ToString()) - raise (Error (FSComp.SR.fscRemotingError(), rangeStartup)) - - if !progress then printfn "client: returned from client.Compile(%A), res = %d" argv exitCode - use holder = - try let originalConsoleColor = Console.ForegroundColor - { new System.IDisposable with member x.Dispose() = Console.ForegroundColor <- originalConsoleColor } - with _ -> null - let mutable prevConsoleColor = try Console.ForegroundColor with _ -> ConsoleColor.Black - for (isOut, consoleColorOpt, c:char) in output do - try match consoleColorOpt with - | Some consoleColor -> - if prevConsoleColor <> consoleColor then - Console.ForegroundColor <- consoleColor; - | None -> () - with _ -> () - c |> (if isOut then System.Console.Out.Write else System.Console.Error.Write) - Some exitCode - with err -> - let sb = System.Text.StringBuilder() - OutputErrorOrWarning (pwd,true,false,ErrorStyle.DefaultErrors,true) sb (PhasedError.Create(err,BuildPhase.Compile)) - eprintfn "%s" (sb.ToString()) - // We continue on and compile in-process - the server appears to have died half way through. - None - | None -> - None - -let main argv = - let inline hasArgument name args = - args |> Array.exists (fun x -> x = ("--" + name) || x = ("/" + name)) - let inline stripArgument name args = - args |> Array.filter (fun x -> x <> ("--" + name) && x <> ("/" + name)) - - // Check for --pause as the very first step so that a compiler can be attached here. - if hasArgument "pause" argv then - System.Console.WriteLine("Press any key to continue...") - System.Console.ReadKey() |> ignore - - if runningOnMono && hasArgument "resident" argv then - let argv = stripArgument "resident" argv - - if not (hasArgument "nologo" argv) then - printfn "%s" (FSComp.SR.buildProductName(FSharpEnvironment.FSharpTeamVersionNumber)) - printfn "%s" (FSComp.SR.optsCopyright()) - - let exitCodeOpt = FSharpResidentCompiler.FSharpCompilationServer.TryCompileUsingServer argv - match exitCodeOpt with - | Some exitCode -> exitCode - | None -> - mainCompile (argv, true, QuitProcessExiter) - 0 - - elif runningOnMono && hasArgument "server" argv then - // Install the right exiter so we can catch "StopProcessing" without exiting the server - let exiter = { new Exiter with member x.Exit n = raise StopProcessing } - FSharpResidentCompiler.FSharpCompilationServer.RunServer(exiter) - 0 - - else - mainCompile (argv, false, QuitProcessExiter) - 0 #endif diff --git a/src/fsharp/fsc.fsi b/src/fsharp/fsc.fsi index 7529828a05cfd1cc8b0430f18bc11f6e0a939d01..129a97a1d6e44b27ec6c706b488d1acfeea70d6a 100644 --- a/src/fsharp/fsc.fsi +++ b/src/fsharp/fsc.fsi @@ -3,34 +3,24 @@ module internal Microsoft.FSharp.Compiler.Driver open Microsoft.FSharp.Compiler.ErrorLogger -open Microsoft.FSharp.Compiler.Build +open Microsoft.FSharp.Compiler.CompileOps open Microsoft.FSharp.Compiler.Env open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.TypeChecker /// the F# project system calls this to pop up type provider security dialog if needed -val internal runFromCommandLineToImportingAssemblies : (string -> unit) * string[] * string * string * Exiter -> unit +val internal ProcessCommandLineArgsAndImportAssemblies : (string -> unit) * string[] * string * string * Exiter -> unit #if NO_COMPILER_BACKEND #else -[] -type ErrorLoggerThatAccumulatesErrors = - inherit ErrorLogger - new : TcConfigBuilder -> ErrorLoggerThatAccumulatesErrors - new : TcConfig -> ErrorLoggerThatAccumulatesErrors - member GetMessages : unit -> (bool * string) list - member ProcessMessage : PhasedError * bool -> (bool * string) option - - /// fsc.exe calls this val mainCompile : argv : string[] * bannerAlreadyPrinted : bool * exiter : Exiter -> unit +[] type CompilationOutput = - { - Errors : seq - Warnings : seq - } + { Errors : ErrorOrWarning[] + Warnings : ErrorOrWarning[] } type InProcCompiler = new : unit -> InProcCompiler diff --git a/src/fsharp/fscmain.fs b/src/fsharp/fscmain.fs index 4f047b9db279e8102fb9ba1a20105575a08451fb..73ef2adec3d00315893b103736ae6be92e40cacc 100644 --- a/src/fsharp/fscmain.fs +++ b/src/fsharp/fscmain.fs @@ -2,6 +2,11 @@ module internal Microsoft.FSharp.Compiler.CommandLineMain +open System +open System.Diagnostics +open System.IO +open System.Reflection +open System.Runtime.CompilerServices open Microsoft.FSharp.Compiler open Microsoft.FSharp.Compiler.AbstractIL.IL // runningOnMono open Microsoft.FSharp.Compiler.ErrorLogger @@ -9,16 +14,11 @@ open Microsoft.FSharp.Compiler.Driver open Internal.Utilities open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Compiler.Range -open Microsoft.FSharp.Compiler.Build -open System.Runtime.CompilerServices +open Microsoft.FSharp.Compiler.CompileOps /// Implement the optional resident compilation service module FSharpResidentCompiler = - open System - open System.Diagnostics - open System.IO - open System.Reflection open System.Runtime.Remoting.Channels open System.Runtime.Remoting open System.Runtime.Remoting.Lifetime @@ -30,10 +30,10 @@ module FSharpResidentCompiler = let output = ResizeArray() let outWriter isOut = { new TextWriter() with - member x.Write(c:char) = lock output (fun () -> output.Add (isOut, (try Some System.Console.ForegroundColor with _ -> None) ,c)) + member x.Write(c:char) = lock output (fun () -> output.Add (isOut, (try Some Console.ForegroundColor with _ -> None) ,c)) member x.Encoding = Encoding.UTF8 } - do System.Console.SetOut (outWriter true) - do System.Console.SetError (outWriter false) + do Console.SetOut (outWriter true) + do Console.SetError (outWriter false) member x.GetTextAndClear() = lock output (fun () -> let res = output.ToArray() in output.Clear(); res) /// The compilation server, which runs in the server process. Accessed by clients using .NET remoting. @@ -229,7 +229,7 @@ module FSharpResidentCompiler = Console.ForegroundColor <- consoleColor; | None -> () with _ -> () - c |> (if isOut then System.Console.Out.Write else System.Console.Error.Write) + c |> (if isOut then Console.Out.Write else Console.Error.Write) Some exitCode with err -> let sb = System.Text.StringBuilder() @@ -244,8 +244,8 @@ module Driver = let main argv = // Check for --pause as the very first step so that a compiler can be attached here. if argv |> Array.exists (fun x -> x = "/pause" || x = "--pause") then - System.Console.WriteLine("Press any key to continue...") - System.Console.ReadKey() |> ignore + Console.WriteLine("Press any key to continue...") + Console.ReadKey() |> ignore if runningOnMono && argv |> Array.exists (fun x -> x = "/resident" || x = "--resident") then let argv = argv |> Array.filter (fun x -> x <> "/resident" && x <> "--resident") diff --git a/src/fsharp/fscopts.fsi b/src/fsharp/fscopts.fsi deleted file mode 100644 index 676a129756fe13ad566aaef0e46c5871788b45a1..0000000000000000000000000000000000000000 --- a/src/fsharp/fscopts.fsi +++ /dev/null @@ -1,57 +0,0 @@ -// Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. - -module internal Microsoft.FSharp.Compiler.Fscopts - -open Internal.Utilities -open Microsoft.FSharp.Compiler.AbstractIL -open Microsoft.FSharp.Compiler.AbstractIL.IL -open Microsoft.FSharp.Compiler.AbstractIL.Internal -open Microsoft.FSharp.Compiler -open Microsoft.FSharp.Compiler.Build -open Microsoft.FSharp.Compiler.ErrorLogger -open Microsoft.FSharp.Compiler.Ast -open Microsoft.FSharp.Compiler.Tast -#if NO_COMPILER_BACKEND -#else -open Microsoft.FSharp.Compiler.Ilxgen -#endif -open Microsoft.FSharp.Compiler.Import -open Microsoft.FSharp.Compiler.Opt -open Microsoft.FSharp.Compiler.Env - -val DisplayBannerText : TcConfigBuilder -> unit - -//val GetCompilerOptions : TcConfigBuilder -> CompilerOption list -> CompilerOption list -val GetCoreFscCompilerOptions : TcConfigBuilder -> CompilerOptionBlock list -val GetCoreFsiCompilerOptions : TcConfigBuilder -> CompilerOptionBlock list -val GetCoreServiceCompilerOptions : TcConfigBuilder -> CompilerOptionBlock list - -// Expose the "setters" for some user switches, to enable setting of defaults -val SetOptimizeSwitch : TcConfigBuilder -> OptionSwitch -> unit -val SetTailcallSwitch : TcConfigBuilder -> OptionSwitch -> unit -val SetDebugSwitch : TcConfigBuilder -> string option -> OptionSwitch -> unit -val PrintOptionInfo : TcConfigBuilder -> unit - -val fsharpModuleName : CompilerTarget -> string -> string - -#if NO_COMPILER_BACKEND -#else -val InitialOptimizationEnv : TcImports -> TcGlobals -> IncrementalOptimizationEnv -val AddExternalCcuToOpimizationEnv : TcGlobals -> IncrementalOptimizationEnv -> ImportedAssembly -> IncrementalOptimizationEnv -val ApplyAllOptimizations : TcConfig * TcGlobals * ConstraintSolver.TcValF * string * ImportMap * bool * IncrementalOptimizationEnv * CcuThunk * TypedAssembly -> TypedAssembly * Opt.LazyModuleInfo * IncrementalOptimizationEnv - -val CreateIlxAssemblyGenerator : TcConfig * TcImports * TcGlobals * ConstraintSolver.TcValF * CcuThunk -> IlxAssemblyGenerator - -val GenerateIlxCode : IlxGenBackend * bool * bool * TcConfig * TypeChecker.TopAttribs * TypedAssembly * string * bool * IlxAssemblyGenerator -> IlxGenResults -#endif - -// Used during static linking -val NormalizeAssemblyRefs : TcImports -> (AbstractIL.IL.ILScopeRef -> AbstractIL.IL.ILScopeRef) - -// Miscellany -val ignoreFailureOnMono1_1_16 : (unit -> unit) -> unit -val mutable enableConsoleColoring : bool -val DoWithErrorColor : bool -> (unit -> 'a) -> 'a -val ReportTime : TcConfig -> string -> unit -val abbrevFlagSet : TcConfigBuilder -> bool -> Set -val PostProcessCompilerArgs : string Set -> string [] -> string list diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index bb6535305fa8d522e60bc15ea64275a90fa16a35..9a9b7e3477aa6fa5fe9853b2b44956bbb0f74fa2 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -34,10 +34,10 @@ open Microsoft.FSharp.Compiler.AbstractIL.ILRuntimeWriter open Microsoft.FSharp.Compiler.Interactive.Settings open Microsoft.FSharp.Compiler.Interactive.RuntimeHelpers open Microsoft.FSharp.Compiler.Lib -open Microsoft.FSharp.Compiler.Fscopts +open Microsoft.FSharp.Compiler.CompileOptions open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics open Microsoft.FSharp.Compiler.AbstractIL.IL -open Microsoft.FSharp.Compiler.Ilxgen +open Microsoft.FSharp.Compiler.IlxGen open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.ErrorLogger @@ -45,12 +45,12 @@ open Microsoft.FSharp.Compiler.TypeChecker open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Infos open Microsoft.FSharp.Compiler.Tastops -open Microsoft.FSharp.Compiler.Opt -open Microsoft.FSharp.Compiler.Env -open Microsoft.FSharp.Compiler.Build +open Microsoft.FSharp.Compiler.Optimizer +open Microsoft.FSharp.Compiler.TcGlobals +open Microsoft.FSharp.Compiler.CompileOps open Microsoft.FSharp.Compiler.Lexhelp open Microsoft.FSharp.Compiler.Layout -open Microsoft.FSharp.Compiler.PostTypecheckSemanticChecks +open Microsoft.FSharp.Compiler.PostTypeCheckSemanticChecks open Internal.Utilities.Collections open Internal.Utilities.StructuredFormat @@ -229,13 +229,13 @@ type internal FsiValuePrinter(ilGlobals, generateDebugInfo, resolvePath, outWrit Layout.wordL "" /// Display the signature of an F# value declaration, along with its actual value. - member valuePrinter.InvokeDeclLayout (emEnv, ilxGenerator: Ilxgen.IlxAssemblyGenerator, v:Val) = + member valuePrinter.InvokeDeclLayout (emEnv, ilxGenerator: IlxAssemblyGenerator, v:Val) = // Implemented via a lookup from v to a concrete (System.Object,System.Type). // This (obj,objTy) pair can then be fed to the fsi value printer. // Note: The value may be (null:Object). // Note: A System.Type allows the value printer guide printing of nulls, e.g. as None or []. //------- - // Ilxgen knows what the v:Val was converted to w.r.t. AbsIL datastructures. + // IlxGen knows what the v:Val was converted to w.r.t. AbsIL datastructures. // Ilreflect knows what the AbsIL was generated to. // Combining these allows for obtaining the (obj,objTy) by reflection where possible. // This assumes the v:Val was given appropriate storage, e.g. StaticField. @@ -365,9 +365,9 @@ type internal ErrorLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, fsiStd override x.WarnSinkImpl(err) = DoWithErrorColor true (fun () -> - if ReportWarningAsError tcConfigB.globalWarnLevel tcConfigB.specificWarnOff tcConfigB.specificWarnOn tcConfigB.specificWarnAsError tcConfigB.specificWarnAsWarn tcConfigB.globalWarnAsError err then + if ReportWarningAsError (tcConfigB.globalWarnLevel, tcConfigB.specificWarnOff, tcConfigB.specificWarnOn, tcConfigB.specificWarnAsError, tcConfigB.specificWarnAsWarn, tcConfigB.globalWarnAsError) err then x.ErrorSinkHelper err - elif ReportWarning tcConfigB.globalWarnLevel tcConfigB.specificWarnOff tcConfigB.specificWarnOn err then + elif ReportWarning (tcConfigB.globalWarnLevel, tcConfigB.specificWarnOff, tcConfigB.specificWarnOn) err then fsiConsoleOutput.Error.WriteLine() writeViaBufferWithEnvironmentNewLines fsiConsoleOutput.Error (OutputErrorOrWarningContext " " fsiStdinSyphon.GetLine) err writeViaBufferWithEnvironmentNewLines fsiConsoleOutput.Error (OutputErrorOrWarning (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.errorStyle,true)) err @@ -438,7 +438,7 @@ type internal FsiCommandLineOptions(argv: string[], tcConfigB, fsiConsoleOutput: DisplayBannerText tcConfigB; fprintfn fsiConsoleOutput.Out "" fprintfn fsiConsoleOutput.Out "%s" (FSIstrings.SR.fsiUsage(executableFileName.Value)) - printCompilerOptionBlocks blocks + PrintCompilerOptionBlocks blocks exit 0 // option tags @@ -482,8 +482,8 @@ type internal FsiCommandLineOptions(argv: string[], tcConfigB, fsiConsoleOutput: PrivateOptions( [ // Private options, related to diagnostics around console probing - CompilerOption("probeconsole","", OptionSwitch (fun flag -> probeToSeeIfConsoleWorks <- flag=On), None, None); // "Probe to see if Console looks functional"); - CompilerOption("peekahead","", OptionSwitch (fun flag -> peekAheadOnConsoleToPermitTyping <- flag=On), None, None); // "Probe to see if Console looks functional"); + CompilerOption("probeconsole","", OptionSwitch (fun flag -> probeToSeeIfConsoleWorks <- flag=OptionSwitch.On), None, None); // "Probe to see if Console looks functional"); + CompilerOption("peekahead","", OptionSwitch (fun flag -> peekAheadOnConsoleToPermitTyping <- flag=OptionSwitch.On), None, None); // "Probe to see if Console looks functional"); ]) ] @@ -505,12 +505,12 @@ type internal FsiCommandLineOptions(argv: string[], tcConfigB, fsiConsoleOutput: ]); PublicOptions(FSComp.SR.optsHelpBannerAdvanced(), [CompilerOption("exec", "", OptionUnit (fun () -> interact <- false), None, Some (FSIstrings.SR.fsiExec())); - CompilerOption("gui", tagNone, OptionSwitch(fun flag -> gui <- (flag = On)),None,Some (FSIstrings.SR.fsiGui())); + CompilerOption("gui", tagNone, OptionSwitch(fun flag -> gui <- (flag = OptionSwitch.On)),None,Some (FSIstrings.SR.fsiGui())); CompilerOption("quiet", "", OptionUnit (fun () -> tcConfigB.noFeedback <- true), None,Some (FSIstrings.SR.fsiQuiet())); (* Renamed --readline and --no-readline to --tabcompletion:+|- *) - CompilerOption("readline", tagNone, OptionSwitch(fun flag -> enableConsoleKeyProcessing <- (flag = On)), None, Some(FSIstrings.SR.fsiReadline())); - CompilerOption("quotations-debug", tagNone, OptionSwitch(fun switch -> tcConfigB.emitDebugInfoInQuotations <- switch = On),None, Some(FSIstrings.SR.fsiEmitDebugInfoInQuotations())); - CompilerOption("shadowcopyreferences", tagNone, OptionSwitch(fun flag -> tcConfigB.shadowCopyReferences <- flag = On), None, Some(FSIstrings.SR.shadowCopyReferences())); + CompilerOption("readline", tagNone, OptionSwitch(fun flag -> enableConsoleKeyProcessing <- (flag = OptionSwitch.On)), None, Some(FSIstrings.SR.fsiReadline())); + CompilerOption("quotations-debug", tagNone, OptionSwitch(fun switch -> tcConfigB.emitDebugInfoInQuotations <- switch = OptionSwitch.On),None, Some(FSIstrings.SR.fsiEmitDebugInfoInQuotations())); + CompilerOption("shadowcopyreferences", tagNone, OptionSwitch(fun flag -> tcConfigB.shadowCopyReferences <- flag = OptionSwitch.On), None, Some(FSIstrings.SR.shadowCopyReferences())); ]); ] @@ -520,12 +520,12 @@ type internal FsiCommandLineOptions(argv: string[], tcConfigB, fsiConsoleOutput: /// Rather than start processing, just collect names, then process them. let sourceFiles = let collect name = - let fsx = Build.IsScript name + let fsx = CompileOps.IsScript name inputFilesAcc <- inputFilesAcc @ [(name,fsx)] // O(n^2), but n small... try let fsiCompilerOptions = fsiUsagePrefix tcConfigB @ GetCoreFsiCompilerOptions tcConfigB @ fsiUsageSuffix tcConfigB - let abbrevArgs = abbrevFlagSet tcConfigB false - ParseCompilerOptions collect fsiCompilerOptions (List.tail (PostProcessCompilerArgs abbrevArgs argv)) + let abbrevArgs = GetAbbrevFlagSet tcConfigB false + ParseCompilerOptions (collect, fsiCompilerOptions, List.tail (PostProcessCompilerArgs abbrevArgs argv)) with e -> stopProcessingRecovery e range0; exit 1; inputFilesAcc @@ -727,11 +727,11 @@ type internal FsiConsoleInput(fsiOptions: FsiCommandLineOptions, inReader: TextR [] [] type internal FsiDynamicCompilerState = - { optEnv : Opt.IncrementalOptimizationEnv + { optEnv : Optimizer.IncrementalOptimizationEnv emEnv : ILRuntimeWriter.emEnv - tcGlobals : Env.TcGlobals - tcState : Build.TcState - ilxGenerator : Ilxgen.IlxAssemblyGenerator + tcGlobals : TcGlobals + tcState : TcState + ilxGenerator : IlxGen.IlxAssemblyGenerator // Why is this not in FsiOptions? timing : bool debugBreak : bool } @@ -783,7 +783,7 @@ type internal FsiDynamicCompiler /// Add attributes let CreateModuleFragment (tcConfigB, assemblyName, codegenResults) = if !progress then fprintfn fsiConsoleOutput.Out "Creating main module..."; - let mainModule = mkILSimpleModule assemblyName (fsharpModuleName tcConfigB.target assemblyName) (tcConfigB.target = Dll) tcConfigB.subsystemVersion tcConfigB.useHighEntropyVA (mkILTypeDefs codegenResults.ilTypeDefs) None None 0x0 (mkILExportedTypes []) "" + let mainModule = mkILSimpleModule assemblyName (GetGeneratedILModuleName tcConfigB.target assemblyName) (tcConfigB.target = Dll) tcConfigB.subsystemVersion tcConfigB.useHighEntropyVA (mkILTypeDefs codegenResults.ilTypeDefs) None None 0x0 (mkILExportedTypes []) "" { mainModule with Manifest = (let man = mainModule.ManifestOfAssembly @@ -799,7 +799,7 @@ type internal FsiDynamicCompiler // Typecheck. The lock stops the type checker running at the same time as the // server intellisense implementation (which is currently incomplete and #if disabled) let (tcState:TcState),topCustomAttrs,declaredImpls,tcEnvAtEndOfLastInput = - lock tcLockObject (fun _ -> TypecheckClosedInputSet(errorLogger.CheckForErrors,tcConfig,tcImports,tcGlobals, Some prefixPath,tcState,inputs)) + lock tcLockObject (fun _ -> TypeCheckClosedInputSet(errorLogger.CheckForErrors,tcConfig,tcImports,tcGlobals, Some prefixPath,tcState,inputs)) #if DEBUG // Logging/debugging @@ -837,9 +837,9 @@ type internal FsiDynamicCompiler errorLogger.AbortOnError(); ReportTime tcConfig "ILX -> IL (Unions)"; - let ilxMainModule = EraseIlxUnions.ConvModule ilGlobals ilxMainModule + let ilxMainModule = EraseUnions.ConvModule ilGlobals ilxMainModule ReportTime tcConfig "ILX -> IL (Funcs)"; - let ilxMainModule = EraseIlxFuncs.ConvModule ilGlobals ilxMainModule + let ilxMainModule = EraseClosures.ConvModule ilGlobals ilxMainModule errorLogger.AbortOnError(); @@ -944,7 +944,7 @@ type internal FsiDynamicCompiler let prefix = mkFragmentPath i let prefixPath = pathOfLid prefix let impl = SynModuleOrNamespace(prefix,(* isModule: *) true,defs,PreXmlDoc.Empty,[],None,rangeStdin) - let input = ParsedInput.ImplFile(ParsedImplFileInput(filename,true, QualFileNameOfUniquePath (rangeStdin,prefixPath),[],[],[impl],true (* isLastCompiland *) )) + let input = ParsedInput.ImplFile(ParsedImplFileInput(filename,true, ComputeQualifiedNameOfFileFromUniquePath (rangeStdin,prefixPath),[],[],[impl],true (* isLastCompiland *) )) let istate,tcEnvAtEndOfLastInput = ProcessInputs (istate, [input], showTypes, true, isInteractiveItExpr, prefix) let tcState = istate.tcState { istate with tcState = tcState.NextStateAfterIncrementalFragment(tcEnvAtEndOfLastInput) } @@ -962,7 +962,7 @@ type internal FsiDynamicCompiler let istate = fsiDynamicCompiler.EvalParsedDefinitions (istate, false, true, defs) // Snarf the type for 'it' via the binding match istate.tcState.TcEnvFromImpls.NameEnv.FindUnqualifiedItem itName with - | Nameres.Item.Value vref -> + | NameResolution.Item.Value vref -> if not tcConfig.noFeedback then valuePrinter.InvokeExprPrinter (istate.tcState.TcEnvFromImpls.DisplayEnv, vref.Deref) @@ -1076,21 +1076,21 @@ type internal FsiDynamicCompiler member __.GetInitialInteractiveState () = let tcConfig = TcConfig.Create(tcConfigB,validate=false) - let optEnv0 = InitialOptimizationEnv tcImports tcGlobals + let optEnv0 = GetInitialOptimizationEnv (tcImports, tcGlobals) let emEnv = ILRuntimeWriter.emEnv0 - let tcEnv = GetInitialTypecheckerEnv None rangeStdin tcConfig tcImports tcGlobals + let tcEnv = GetInitialTcEnv (None, rangeStdin, tcConfig, tcImports, tcGlobals) let ccuName = assemblyName - let tcState = TypecheckInitialState (rangeStdin,ccuName,tcConfig,tcGlobals,tcImports,niceNameGen,tcEnv) + let tcState = GetInitialTcState (rangeStdin, ccuName, tcConfig, tcGlobals, tcImports, niceNameGen, tcEnv) let ilxGenerator = CreateIlxAssemblyGenerator(tcConfig,tcImports,tcGlobals, (LightweightTcValForUsingInBuildMethodCall tcGlobals), tcState.Ccu ) - {optEnv = optEnv0; - emEnv = emEnv; - tcGlobals = tcGlobals; - tcState = tcState; - ilxGenerator = ilxGenerator; - timing = false; - debugBreak = false; + {optEnv = optEnv0 + emEnv = emEnv + tcGlobals = tcGlobals + tcState = tcState + ilxGenerator = ilxGenerator + timing = false + debugBreak = false } @@ -1114,10 +1114,10 @@ type internal FsiIntellisenseProvider(tcGlobals, tcImports: TcImports) = let amap = tcImports.GetImportMap() let infoReader = new Infos.InfoReader(tcGlobals,amap) - let ncenv = new Nameres.NameResolver(tcGlobals,amap,infoReader,Nameres.FakeInstantiationGenerator) + let ncenv = new NameResolution.NameResolver(tcGlobals,amap,infoReader,NameResolution.FakeInstantiationGenerator) // Note: for the accessor domain we should use (AccessRightsOfEnv tcState.TcEnvFromImpls) let ad = Infos.AccessibleFromSomeFSharpCode - let nItems = Nameres.ResolvePartialLongIdent ncenv tcState.TcEnvFromImpls.NameEnv (ConstraintSolver.IsApplicableMethApprox tcGlobals amap rangeStdin) rangeStdin ad lid false + let nItems = NameResolution.ResolvePartialLongIdent ncenv tcState.TcEnvFromImpls.NameEnv (ConstraintSolver.IsApplicableMethApprox tcGlobals amap rangeStdin) rangeStdin ad lid false let names = nItems |> List.map (fun d -> d.DisplayName tcGlobals) let names = names |> List.filter (fun (name:string) -> name.StartsWith(stem,StringComparison.Ordinal)) names @@ -1139,7 +1139,7 @@ type internal FsiIntellisenseProvider(tcGlobals, tcImports: TcImports) = names with e -> - System.Windows.Forms.MessageBox.Show("FsiGetDeclarations: throws:\n" ^ e.ToString()) |> ignore; + System.Windows.Forms.MessageBox.Show("FsiGetDeclarations: throws:\n" ^ e.ToString()) |> ignore [| |] #endif @@ -1197,33 +1197,33 @@ type internal FsiInterruptController(fsiOptions : FsiCommandLineOptions, // REVIEW: streamline all this code to use the same code on Windows and Posix. member controller.InstallKillThread(threadToKill:Thread, pauseMilliseconds:int) = - if !progress then fprintfn fsiConsoleOutput.Out "installing CtrlC handler"; + if !progress then fprintfn fsiConsoleOutput.Out "installing CtrlC handler" // WINDOWS TECHNIQUE: .NET has more safe points, and you can do more when a safe point. // Hence we actually start up the killer thread within the handler. try let raiseCtrlC() = SetCurrentUICultureForThread fsiOptions.FsiLCID - fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.fsiInterrupt()); - stdinInterruptState <- StdinEOFPermittedBecauseCtrlCRecentlyPressed; + fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.fsiInterrupt()) + stdinInterruptState <- StdinEOFPermittedBecauseCtrlCRecentlyPressed if (interruptAllowed = InterruptCanRaiseException) then - killThreadRequest <- ThreadAbortRequest; + killThreadRequest <- ThreadAbortRequest let killerThread = new Thread(new ThreadStart(fun () -> SetCurrentUICultureForThread fsiOptions.FsiLCID // sleep long enough to allow ControlEventHandler handler on main thread to return // Also sleep to give computations a bit of time to terminate - Thread.Sleep(pauseMilliseconds); + Thread.Sleep(pauseMilliseconds) if (killThreadRequest = ThreadAbortRequest) then - if !progress then fsiConsoleOutput.uprintnfn "%s" (FSIstrings.SR.fsiAbortingMainThread()); - killThreadRequest <- NoRequest; - threadToKill.Abort(); + if !progress then fsiConsoleOutput.uprintnfn "%s" (FSIstrings.SR.fsiAbortingMainThread()) + killThreadRequest <- NoRequest + threadToKill.Abort() ()),Name="ControlCAbortThread") - killerThread.IsBackground <- true; + killerThread.IsBackground <- true killerThread.Start() let ctrlEventHandler = new NativeMethods.ControlEventHandler(fun i -> if i = CTRL_C then (raiseCtrlC(); true) else false ) - ctrlEventHandlers <- ctrlEventHandler :: ctrlEventHandlers; - ctrlEventActions <- raiseCtrlC :: ctrlEventActions; + ctrlEventHandlers <- ctrlEventHandler :: ctrlEventHandlers + ctrlEventActions <- raiseCtrlC :: ctrlEventActions let _resultOK = NativeMethods.SetConsoleCtrlHandler(ctrlEventHandler,true) false // don't exit via kill thread with e -> @@ -1235,32 +1235,32 @@ type internal FsiInterruptController(fsiOptions : FsiCommandLineOptions, match (try Choice1Of2(Assembly.Load("Mono.Posix, Version=2.0.0.0, Culture=neutral, PublicKeyToken=0738eb9f132ed756")) with e -> Choice2Of2 e) with | Choice1Of2(monoPosix) -> try - if !progress then fprintfn fsiConsoleOutput.Error "loading type Mono.Unix.Native.Stdlib..."; + if !progress then fprintfn fsiConsoleOutput.Error "loading type Mono.Unix.Native.Stdlib..." let monoUnixStdlib = monoPosix.GetType("Mono.Unix.Native.Stdlib") - if !progress then fprintfn fsiConsoleOutput.Error "loading type Mono.Unix.Native.SignalHandler..."; + if !progress then fprintfn fsiConsoleOutput.Error "loading type Mono.Unix.Native.SignalHandler..." let monoUnixSignalHandler = monoPosix.GetType("Mono.Unix.Native.SignalHandler") - if !progress then fprintfn fsiConsoleOutput.Error "creating delegate..."; - controller.PosixInvoke(-1); + if !progress then fprintfn fsiConsoleOutput.Error "creating delegate..." + controller.PosixInvoke(-1) let monoHandler = System.Delegate.CreateDelegate(monoUnixSignalHandler,controller,"PosixInvoke") - if !progress then fprintfn fsiConsoleOutput.Error "registering signal handler..."; + if !progress then fprintfn fsiConsoleOutput.Error "registering signal handler..." let monoSignalNumber = System.Enum.Parse(monoPosix.GetType("Mono.Unix.Native.Signum"),"SIGINT") let register () = Utilities.callStaticMethod monoUnixStdlib "signal" [ monoSignalNumber; box monoHandler ] |> ignore - posixReinstate <- register; - register(); + posixReinstate <- register + register() let killerThread = new Thread(new ThreadStart(fun () -> SetCurrentUICultureForThread fsiOptions.FsiLCID while true do //fprintf fsiConsoleOutput.Error "\n- kill thread loop...\n"; errorWriter.Flush(); - Thread.Sleep(pauseMilliseconds*2); + Thread.Sleep(pauseMilliseconds*2) match killThreadRequest with | PrintInterruptRequest -> - fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.fsiInterrupt()); fsiConsoleOutput.Error.Flush(); - killThreadRequest <- NoRequest; + fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.fsiInterrupt()); fsiConsoleOutput.Error.Flush() + killThreadRequest <- NoRequest | ThreadAbortRequest -> - fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.fsiInterrupt()); fsiConsoleOutput.Error.Flush(); - if !progress then fsiConsoleOutput.uprintnfn "%s" (FSIstrings.SR.fsiAbortingMainThread()); - killThreadRequest <- NoRequest; + fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.fsiInterrupt()); fsiConsoleOutput.Error.Flush() + if !progress then fsiConsoleOutput.uprintnfn "%s" (FSIstrings.SR.fsiAbortingMainThread()) + killThreadRequest <- NoRequest threadToKill.Abort() | ExitRequest -> // Mono has some wierd behaviour where it blocks on exit @@ -1271,12 +1271,12 @@ type internal FsiInterruptController(fsiOptions : FsiCommandLineOptions, // // Anyway, we make "#q" work this case by setting ExitRequest and brutally calling // the process-wide 'exit' - fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.fsiExit()); fsiConsoleOutput.Error.Flush(); + fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.fsiExit()); fsiConsoleOutput.Error.Flush() Utilities.callStaticMethod monoUnixStdlib "exit" [ box 0 ] |> ignore | _ -> () done),Name="ControlCAbortAlternativeThread") - killerThread.IsBackground <- true; - killerThread.Start(); + killerThread.IsBackground <- true + killerThread.Start() true // exit via kill thread to workaround block-on-exit bugs with Mono once a CtrlC has been pressed with e -> fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.fsiCouldNotInstallCtrlCHandler(e.Message)) @@ -1291,8 +1291,8 @@ type internal FsiInterruptController(fsiOptions : FsiCommandLineOptions, // since we are not allowed to JIT a signal handler. THis also ensures the "PosixInvoke" // method is not eliminated by dead-code elimination if n >= 0 then - posixReinstate(); - stdinInterruptState <- StdinEOFPermittedBecauseCtrlCRecentlyPressed; + posixReinstate() + stdinInterruptState <- StdinEOFPermittedBecauseCtrlCRecentlyPressed killThreadRequest <- if (interruptAllowed = InterruptCanRaiseException) then ThreadAbortRequest else PrintInterruptRequest @@ -1362,7 +1362,7 @@ module internal MagicAssemblyResolution = let tcConfig = TcConfig.Create(tcConfigB,validate=false) let fullAssemName = args.Name let simpleAssemName = fullAssemName.Split([| ',' |]).[0] - if !progress then fsiConsoleOutput.uprintfn "ATTEMPT MAGIC LOAD ON ASSEMBLY, simpleAssemName = %s" simpleAssemName; // "Attempting to load a dynamically required assembly in response to an AssemblyResolve event by using known static assembly references..." + if !progress then fsiConsoleOutput.uprintfn "ATTEMPT MAGIC LOAD ON ASSEMBLY, simpleAssemName = %s" simpleAssemName // "Attempting to load a dynamically required assembly in response to an AssemblyResolve event by using known static assembly references..." // Special case: Mono Windows Forms attempts to load an assembly called something like "Windows.Forms.resources" // We can't resolve this, so don't try. @@ -1394,12 +1394,12 @@ module internal MagicAssemblyResolution = | OkResult (warns, [r]) -> OkResult (warns, Choice1Of2 r.resolvedPath) | _ -> - if !progress then fsiConsoleOutput.uprintfn "ATTEMPT LOAD, assemblyReferenceTextDll = %s" assemblyReferenceTextDll; + if !progress then fsiConsoleOutput.uprintfn "ATTEMPT LOAD, assemblyReferenceTextDll = %s" assemblyReferenceTextDll /// Take a look through the files quoted, perhaps with explicit paths let searchResult = (tcConfig.referencedDLLs |> List.tryPick (fun assemblyReference -> - if !progress then fsiConsoleOutput.uprintfn "ATTEMPT MAGIC LOAD ON FILE, referencedDLL = %s" assemblyReference.Text; + if !progress then fsiConsoleOutput.uprintfn "ATTEMPT MAGIC LOAD ON FILE, referencedDLL = %s" assemblyReference.Text if System.String.Compare(Filename.fileNameOfPath assemblyReference.Text, assemblyReferenceTextDll,StringComparison.OrdinalIgnoreCase) = 0 || System.String.Compare(Filename.fileNameOfPath assemblyReference.Text, assemblyReferenceTextExe,StringComparison.OrdinalIgnoreCase) = 0 then Some(tcImports.TryResolveAssemblyReference(assemblyReference,ResolveAssemblyReferenceMode.Speculative)) @@ -1427,14 +1427,14 @@ module internal MagicAssemblyResolution = let res = CommitOperationResult overallSearchResult match res with | Choice1Of2 assemblyName -> - if simpleAssemName <> "Mono.Posix" then fsiConsoleOutput.uprintfn "%s" (FSIstrings.SR.fsiBindingSessionTo(assemblyName)); + if simpleAssemName <> "Mono.Posix" then fsiConsoleOutput.uprintfn "%s" (FSIstrings.SR.fsiBindingSessionTo(assemblyName)) assemblyLoadFrom assemblyName | Choice2Of2 assembly -> assembly with e -> - stopProcessingRecovery e range0; - null)); + stopProcessingRecovery e range0 + null)) //---------------------------------------------------------------------------- // Reading stdin @@ -1456,17 +1456,17 @@ type internal FsiStdinLexerProvider let LexbufFromLineReader (fsiStdinSyphon: FsiStdinSyphon) readf = UnicodeLexing.FunctionAsLexbuf (fun (buf: char[], start, len) -> - //fprintf fsiConsoleOutput.Out "Calling ReadLine\n"; + //fprintf fsiConsoleOutput.Out "Calling ReadLine\n" let inputOption = try Some(readf()) with :? EndOfStreamException -> None - inputOption |> Option.iter (fun t -> fsiStdinSyphon.Add (t + "\n")); + inputOption |> Option.iter (fun t -> fsiStdinSyphon.Add (t + "\n")) match inputOption with | Some(null) | None -> - if !progress then fprintfn fsiConsoleOutput.Out "End of file from TextReader.ReadLine"; + if !progress then fprintfn fsiConsoleOutput.Out "End of file from TextReader.ReadLine" 0 | Some (input:string) -> let input = input + "\n" let ninput = input.Length - if ninput > len then fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.fsiLineTooLong()); + if ninput > len then fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.fsiLineTooLong()) let ntrimmed = min len ninput for i = 0 to ntrimmed-1 do buf.[i+start] <- input.[i] @@ -1485,11 +1485,11 @@ type internal FsiStdinLexerProvider let CreateLexerForLexBuffer (sourceFileName, lexbuf) = - Lexhelp.resetLexbufPos sourceFileName lexbuf; + Lexhelp.resetLexbufPos sourceFileName lexbuf let skip = true // don't report whitespace from lexer let defines = "INTERACTIVE"::tcConfigB.conditionalCompilationDefines let lexargs = mkLexargs (sourceFileName,defines, interactiveInputLightSyntaxStatus, lexResourceManager, ref [], errorLogger) - let tokenizer = Lexfilter.LexFilter(interactiveInputLightSyntaxStatus, tcConfigB.compilingFslib, Lexer.token lexargs skip, lexbuf) + let tokenizer = LexFilter.LexFilter(interactiveInputLightSyntaxStatus, tcConfigB.compilingFslib, Lexer.token lexargs skip, lexbuf) tokenizer @@ -1505,7 +1505,7 @@ type internal FsiStdinLexerProvider | _ -> LexbufFromLineReader fsiStdinSyphon (fun () -> fsiConsoleInput.In.ReadLine() |> removeZeroCharsFromString) - fsiStdinSyphon.Reset(); + fsiStdinSyphon.Reset() CreateLexerForLexBuffer (Lexhelp.stdinMockFilename, lexbuf) // Create a new lexer to read an "included" script file @@ -1539,10 +1539,10 @@ type internal FsiInteractionProcessor let InteractiveCatch f istate = try // reset error count - errorLogger.ResetErrorCount(); + errorLogger.ResetErrorCount() f istate with e -> - stopProcessingRecovery e range0; + stopProcessingRecovery e range0 istate,CompletedWithReportedError @@ -1558,10 +1558,10 @@ type internal FsiInteractionProcessor /// Parse one interaction. Called on the parser thread. - let ParseInteraction (tokenizer:Lexfilter.LexFilter) = + let ParseInteraction (tokenizer:LexFilter.LexFilter) = let lastToken = ref Parser.ELSE // Any token besides SEMICOLON_SEMICOLON will do for initial value try - if !progress then fprintfn fsiConsoleOutput.Out "In ParseInteraction..."; + if !progress then fprintfn fsiConsoleOutput.Out "In ParseInteraction..." let input = Lexhelp.reusingLexbufForParsing tokenizer.LexBuffer (fun () -> @@ -1581,7 +1581,7 @@ type internal FsiInteractionProcessor && not tokenizer.LexBuffer.IsPastEndOfStream do tok <- tokenizer.Lexer tokenizer.LexBuffer - stopProcessingRecovery e range0; + stopProcessingRecovery e range0 None /// Execute a single parsed interaction. Called on the GUI/execute/main thread. @@ -1620,16 +1620,16 @@ type internal FsiInteractionProcessor | IHash (ParsedHashDirective("I",[path],m),_) -> tcConfigB.AddIncludePath (m,path, tcConfig.implicitIncludeDir) - fsiConsoleOutput.uprintnfnn "%s" (FSIstrings.SR.fsiDidAHashI(tcConfig.MakePathAbsolute path)); + fsiConsoleOutput.uprintnfnn "%s" (FSIstrings.SR.fsiDidAHashI(tcConfig.MakePathAbsolute path)) istate,Completed | IHash (ParsedHashDirective("cd",[path],m),_) -> - ChangeDirectory path m; + ChangeDirectory path m istate,Completed | IHash (ParsedHashDirective("silentCd",[path],m),_) -> - ChangeDirectory path m; - fsiConsolePrompt.SkipNext(); (* "silent" directive *) + ChangeDirectory path m + fsiConsolePrompt.SkipNext() (* "silent" directive *) istate,Completed | IHash (ParsedHashDirective("dbgbreak",[],_),_) -> @@ -1650,20 +1650,20 @@ type internal FsiInteractionProcessor {istate with timing = (v = "on")},Completed | IHash (ParsedHashDirective("nowarn",numbers,m),_) -> - List.iter (fun (d:string) -> tcConfigB.TurnWarningOff(m,d)) numbers; + List.iter (fun (d:string) -> tcConfigB.TurnWarningOff(m,d)) numbers istate,Completed | IHash (ParsedHashDirective("terms",[],_),_) -> - tcConfigB.showTerms <- not tcConfig.showTerms; + tcConfigB.showTerms <- not tcConfig.showTerms istate,Completed | IHash (ParsedHashDirective("types",[],_),_) -> - fsiOptions.ShowTypes <- not fsiOptions.ShowTypes; + fsiOptions.ShowTypes <- not fsiOptions.ShowTypes istate,Completed #if DEBUG | IHash (ParsedHashDirective("ilcode",[],_m),_) -> - fsiOptions.ShowILCode <- not fsiOptions.ShowILCode; + fsiOptions.ShowILCode <- not fsiOptions.ShowILCode istate,Completed | IHash (ParsedHashDirective("info",[],_m),_) -> @@ -1673,16 +1673,16 @@ type internal FsiInteractionProcessor | IHash (ParsedHashDirective(("q" | "quit"),[],_),_) -> if exitViaKillThread then - fsiInterruptController.InterruptRequest <- ExitRequest; + fsiInterruptController.InterruptRequest <- ExitRequest Thread.Sleep(1000) - exit 0; + exit 0 | IHash (ParsedHashDirective("help",[],_),_) -> - fsiOptions.ShowHelp(); + fsiOptions.ShowHelp() istate,Completed | IHash (ParsedHashDirective(c,arg,_),_) -> - fsiConsoleOutput.uprintfn "%s" (FSIstrings.SR.fsiInvalidDirective(c, String.concat " " arg)); // REVIEW: uprintnfnn - like other directives above + fsiConsoleOutput.uprintfn "%s" (FSIstrings.SR.fsiInvalidDirective(c, String.concat " " arg)) // REVIEW: uprintnfnn - like other directives above istate,Completed (* REVIEW: cont = CompletedWithReportedError *) ) @@ -1774,7 +1774,7 @@ type internal FsiInteractionProcessor /// /// During processing of startup scripts, this runs on the main thread. - member __.ParseAndProcessAndEvalOneInteractionFromLexbuf (exitViaKillThread, runCodeOnMainThread, istate:FsiDynamicCompilerState, tokenizer:Lexfilter.LexFilter) = + member __.ParseAndProcessAndEvalOneInteractionFromLexbuf (exitViaKillThread, runCodeOnMainThread, istate:FsiDynamicCompilerState, tokenizer:LexFilter.LexFilter) = if tokenizer.LexBuffer.IsPastEndOfStream then let stepStatus = @@ -2136,18 +2136,19 @@ type internal FsiEvaluationSession (argv:string[], inReader:TextReader, outWrite let defaultFSharpBinariesDir = System.AppDomain.CurrentDomain.BaseDirectory - let tcConfigB = Build.TcConfigBuilder.CreateNew(defaultFSharpBinariesDir, - true, // long running: optimizeForMemory - Directory.GetCurrentDirectory(),isInteractive=true, - isInvalidationSupported=false) + let tcConfigB = + TcConfigBuilder.CreateNew(defaultFSharpBinariesDir, + true, // long running: optimizeForMemory + Directory.GetCurrentDirectory(),isInteractive=true, + isInvalidationSupported=false) let tcConfigP = TcConfigProvider.BasedOnMutableBuilder(tcConfigB) do tcConfigB.resolutionEnvironment <- MSBuildResolver.RuntimeLike // See Bug 3608 do tcConfigB.useFsiAuxLib <- true // Preset: --optimize+ -g --tailcalls+ (see 4505) - do SetOptimizeSwitch tcConfigB On - do SetDebugSwitch tcConfigB (Some "pdbonly") On - do SetTailcallSwitch tcConfigB On + do SetOptimizeSwitch tcConfigB OptionSwitch.On + do SetDebugSwitch tcConfigB (Some "pdbonly") OptionSwitch.On + do SetTailcallSwitch tcConfigB OptionSwitch.On // set platform depending on whether the current process is a 64-bit process. // BUG 429882 : FsiAnyCPU.exe issues warnings (x64 v MSIL) when referencing 64-bit assemblies diff --git a/src/fsharp/import.fs b/src/fsharp/import.fs index 0b133438825876221db3e34801835be6ee918f42..3dea89d0779552a324026f1b9511dff9d667ebfd 100644 --- a/src/fsharp/import.fs +++ b/src/fsharp/import.fs @@ -1,5 +1,6 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. +/// Functions to import .NET binary metadata as TAST objects module internal Microsoft.FSharp.Compiler.Import #nowarn "44" // This construct is deprecated. please use List.item @@ -7,15 +8,15 @@ module internal Microsoft.FSharp.Compiler.Import open System.Reflection open System.Collections.Generic open Internal.Utilities + open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library open Microsoft.FSharp.Compiler - open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.AbstractIL.IL -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.Ast open Microsoft.FSharp.Compiler.ErrorLogger #if EXTENSIONTYPING @@ -52,7 +53,7 @@ type AssemblyLoader = /// /// There is normally only one ImportMap for any assembly compilation, though additional instances can be created /// using tcImports.GetImportMap() if needed, and it is not harmful if multiple instances are used. The object -/// serves as an interface through to the tables stored in the primary TcImports structures defined in build.fs. +/// serves as an interface through to the tables stored in the primary TcImports structures defined in CompileOps.fs. [] type ImportMap(g:TcGlobals,assemblyLoader:AssemblyLoader) = let typeRefToTyconRefCache = new System.Collections.Generic.Dictionary() @@ -101,7 +102,7 @@ let ImportTypeRefData (env:ImportMap) m (scoref,path,typeName) = () #endif match tryRescopeEntity ccu tycon with - | None -> error (Error(FSComp.SR.impImportedAssemblyUsesNotPublicType(String.concat "." (Array.toList path@[typeName])),m)); + | None -> error (Error(FSComp.SR.impImportedAssemblyUsesNotPublicType(String.concat "." (Array.toList path@[typeName])),m)) | Some tcref -> tcref @@ -392,7 +393,7 @@ let ImportILGenericParameters amap m scoref tinst (gps: ILGenericParameterDefs) let constraints = if gp.HasReferenceTypeConstraint then (TyparConstraint.IsReferenceType(m)::constraints) else constraints let constraints = if gp.HasNotNullableValueTypeConstraint then (TyparConstraint.IsNonNullableStruct(m)::constraints) else constraints let constraints = if gp.HasDefaultConstructorConstraint then (TyparConstraint.RequiresDefaultConstructor(m)::constraints) else constraints - tp.FixupConstraints constraints); + tp.FixupConstraints constraints) tps @@ -416,7 +417,7 @@ let multisetDiscriminateAndMap nodef tipf (items: ('Key list * 'Value) list) = match keylist with | [] -> () | key::rest -> - buckets.[key] <- (rest,v) :: (if buckets.ContainsKey key then buckets.[key] else []); + buckets.[key] <- (rest,v) :: (if buckets.ContainsKey key then buckets.[key] else []) [ for (KeyValue(key,items)) in buckets -> nodef key items ] @@ -424,10 +425,10 @@ let multisetDiscriminateAndMap nodef tipf (items: ('Key list * 'Value) list) = /// Import an IL type definition as a new F# TAST Entity node. -let rec ImportILTypeDef amap m scoref cpath enc nm (tdef:ILTypeDef) = +let rec ImportILTypeDef amap m scoref (cpath:CompilationPath) enc nm (tdef:ILTypeDef) = let lazyModuleOrNamespaceTypeForNestedTypes = lazy - let cpath = mkNestedCPath cpath nm ModuleOrType + let cpath = cpath.NestedCompPath nm ModuleOrType ImportILTypeDefs amap m scoref cpath (enc@[tdef]) tdef.NestedTypes // Add the type itself. NewILTycon @@ -442,7 +443,7 @@ let rec ImportILTypeDef amap m scoref cpath enc nm (tdef:ILTypeDef) = /// Import a list of (possibly nested) IL types as a new ModuleOrNamespaceType node /// containing new entities, bucketing by namespace along the way. -and ImportILTypeDefList amap m cpath enc items = +and ImportILTypeDefList amap m (cpath:CompilationPath) enc items = // Split into the ones with namespaces and without. Add the ones with namespaces in buckets. // That is, discriminate based in the first element of the namespace list (e.g. "System") // and, for each bag, fold-in a lazy computation to add the types under that bag . @@ -455,7 +456,7 @@ and ImportILTypeDefList amap m cpath enc items = items |> multisetDiscriminateAndMap (fun n tgs -> - let modty = lazy (ImportILTypeDefList amap m (mkNestedCPath cpath n Namespace) enc tgs) + let modty = lazy (ImportILTypeDefList amap m (cpath.NestedCompPath n Namespace) enc tgs) NewModuleOrNamespace (Some cpath) taccessPublic (mkSynId m n) XmlDoc.Empty [] modty) (fun (n,info:Lazy<_>) -> let (scoref2,_,lazyTypeDef:Lazy) = info.Force() @@ -512,7 +513,7 @@ let ImportILAssemblyTypeDefs (amap, m, auxModLoader, aref, mainmod:ILModuleDef) let scoref = ILScopeRef.Assembly aref let mtypsForExportedTypes = ImportILAssemblyExportedTypes amap m auxModLoader scoref mainmod.ManifestOfAssembly.ExportedTypes let mainmod = ImportILAssemblyMainTypeDefs amap m scoref mainmod - combineModuleOrNamespaceTypeList [] m (mainmod :: mtypsForExportedTypes) + CombineCcuContentFragments m (mainmod :: mtypsForExportedTypes) /// Import the type forwarder table for an IL assembly let ImportILAssemblyTypeForwarders (amap, m, exportedTypes:ILExportedTypesAndForwarders) = @@ -544,19 +545,19 @@ let ImportILAssembly(amap:(unit -> ImportMap),m,auxModuleLoader,sref,sourceDir,f | _ -> error(InternalError("ImportILAssembly: cannot reference .NET netmodules directly, reference the containing assembly instead",m)) let nm = aref.Name let mty = ImportILAssemblyTypeDefs(amap,m,auxModuleLoader,aref,ilModule) - let ccuData = - { IsFSharp=false; - UsesFSharp20PlusQuotations=false; + let ccuData : CcuData = + { IsFSharp=false + UsesFSharp20PlusQuotations=false #if EXTENSIONTYPING - InvalidateEvent=invalidateCcu; - IsProviderGenerated = false; + InvalidateEvent=invalidateCcu + IsProviderGenerated = false ImportProvidedType = (fun ty -> ImportProvidedType (amap()) m ty) #endif - QualifiedName= Some sref.QualifiedName; - Contents = NewCcuContents sref m nm mty ; - ILScopeRef = sref; - Stamp = newStamp(); - SourceCodeDirectory = sourceDir; // note: not an accurate value, but IL assemblies don't give us this information in any attributes. + QualifiedName= Some sref.QualifiedName + Contents = NewCcuContents sref m nm mty + ILScopeRef = sref + Stamp = newStamp() + SourceCodeDirectory = sourceDir // note: not an accurate value, but IL assemblies don't give us this information in any attributes. FileName = filename MemberSignatureEquality= (fun ty1 ty2 -> Tastops.typeEquivAux EraseAll (amap()).g ty1 ty2) TypeForwarders = diff --git a/src/fsharp/import.fsi b/src/fsharp/import.fsi index 042c309c09628cad5f162a82a805345b50e4a7da..cb98038cd806760516719423c32e782a7e127095 100644 --- a/src/fsharp/import.fsi +++ b/src/fsharp/import.fsi @@ -1,8 +1,10 @@ // Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. +/// Functions to import .NET binary metadata as TAST objects module internal Microsoft.FSharp.Compiler.Import open Microsoft.FSharp.Compiler.Tast +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.AbstractIL.IL #if EXTENSIONTYPING @@ -34,16 +36,16 @@ type AssemblyLoader = /// /// There is normally only one ImportMap for any assembly compilation, though additional instances can be created /// using tcImports.GetImportMap() if needed, and it is not harmful if multiple instances are used. The object -/// serves as an interface through to the tables stored in the primary TcImports structures defined in build.fs. +/// serves as an interface through to the tables stored in the primary TcImports structures defined in CompileOps.fs. [] type ImportMap = - new : g:Env.TcGlobals * assemblyLoader:AssemblyLoader -> ImportMap + new : g:TcGlobals * assemblyLoader:AssemblyLoader -> ImportMap /// The AssemblyLoader for the import context member assemblyLoader : AssemblyLoader /// The TcGlobals for the import context - member g : Env.TcGlobals + member g : TcGlobals /// Import a reference to a type definition, given an AbstractIL ILTypeRef, with caching val internal ImportILTypeRef : ImportMap -> range -> ILTypeRef -> TyconRef diff --git a/src/fsharp/infos.fs b/src/fsharp/infos.fs index 01038d705cc7f6d5c8816db34c2b4609a712c810..30d34ea81f2304876b734a0c6dd724d789d39515 100644 --- a/src/fsharp/infos.fs +++ b/src/fsharp/infos.fs @@ -19,7 +19,7 @@ open Microsoft.FSharp.Compiler.ErrorLogger open Microsoft.FSharp.Compiler.Tast open Microsoft.FSharp.Compiler.Tastops open Microsoft.FSharp.Compiler.Tastops.DebugPrint -open Microsoft.FSharp.Compiler.Env +open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.AbstractIL.IL open Microsoft.FSharp.Compiler.Lib open Microsoft.FSharp.Core.Printf @@ -3017,7 +3017,7 @@ type PropertyCollector(g,amap,m,typ,optFilter,ad) = else props.[pinfo] <- pinfo - member x.Collect(membInfo,vref:ValRef) = + member x.Collect(membInfo:ValMemberInfo,vref:ValRef) = match membInfo.MemberFlags.MemberKind with | MemberKind.PropertyGet -> let pinfo = FSProp(g,typ,Some vref,None) @@ -3145,8 +3145,8 @@ type InfoReader(g:TcGlobals, amap:Import.ImportMap) = infos /// Make a reference to a record or class field - let MakeRecdFieldInfo g typ tcref fspec = - RecdFieldInfo(argsOfAppTy g typ,mkNestedRecdFieldRef tcref fspec) + let MakeRecdFieldInfo g typ (tcref:TyconRef) fspec = + RecdFieldInfo(argsOfAppTy g typ,tcref.MakeNestedRecdFieldRef fspec) /// Get the F#-declared record fields or class 'val' fields of a type let GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter,_ad) _m typ = diff --git a/src/fsharp/layout.fs b/src/fsharp/layout.fs index 48ee99d9c2d3bc450c81d1fa146f5bb630e58236..d3614f31c43fba2ea052b0c3da8e511a4e209b30 100644 --- a/src/fsharp/layout.fs +++ b/src/fsharp/layout.fs @@ -18,28 +18,25 @@ let spaces n = new String(' ',n) //-------------------------------------------------------------------------- let rec juxtLeft = function - Leaf (jl,_text,_jr) -> jl + | Leaf (jl,_text,_jr) -> jl | Node (jl,_l,_jm,_r,_jr,_joint) -> jl | Attr (_tag,_attrs,l) -> juxtLeft l let rec juxtRight = function - Leaf (_jl,_text,jr) -> jr + | Leaf (_jl,_text,jr) -> jr | Node (_jl,_l,_jm,_r,jr,_joint) -> jr | Attr (_tag,_attrs,l) -> juxtRight l -(* NOTE: - * emptyL might be better represented as a constructor, - * so then (Sep"") would have true meaning - *) +// NOTE: emptyL might be better represented as a constructor, so then (Sep"") would have true meaning let emptyL = Leaf (true,box "",true) let isEmptyL = function Leaf(true,tag,true) when unbox tag = "" -> true | _ -> false let mkNode l r joint = if isEmptyL l then r else if isEmptyL r then l else - let jl = juxtLeft l in - let jm = juxtRight l || juxtLeft r in - let jr = juxtRight r in + let jl = juxtLeft l + let jm = juxtRight l || juxtLeft r + let jr = juxtRight r Node(jl,l,jm,r,jr,joint) @@ -53,14 +50,8 @@ let rightL (str:string) = Leaf (true ,box str,false) let leftL (str:string) = Leaf (false,box str,true) let aboveL l r = mkNode l r (Broken 0) -let joinN i l r = mkNode l r (Breakable i) -let join = joinN 0 -let join1 = joinN 1 -let join2 = joinN 2 -let join3 = joinN 3 let tagAttrL str attrs ly = Attr (str,attrs,ly) -let linkL str ly = tagAttrL "html:a" [("href",str)] ly //-------------------------------------------------------------------------- //INDEX: constructors derived @@ -96,12 +87,12 @@ let sepListL x y = tagListL (fun prefixL -> prefixL ^^ x) y let bracketL l = leftL "(" ^^ l ^^ rightL ")" let tupleL xs = bracketL (sepListL (sepL ",") xs) let aboveListL = function - [] -> emptyL + | [] -> emptyL | [x] -> x | x::ys -> List.fold (fun pre y -> pre @@ y) x ys let optionL xL = function - None -> wordL "None" + | None -> wordL "None" | Some x -> wordL "Some" -- (xL x) let listL xL xs = leftL "[" ^^ sepListL (sepL ";") (List.map xL xs) ^^ rightL "]" @@ -219,20 +210,17 @@ let squashTo maxWidth layout = layout //-------------------------------------------------------------------------- -//INDEX: render +//INDEX: LayoutRenderer //-------------------------------------------------------------------------- -type render<'a,'b> = - (* exists 'b. - -- could use object type to get "exists 'b" on private state, - *) - abstract Start : unit -> 'b; - abstract AddText : 'b -> string -> 'b; - abstract AddBreak : 'b -> int -> 'b; - abstract AddTag : 'b -> string * (string * string) list * bool -> 'b; +type LayoutRenderer<'a,'b> = + abstract Start : unit -> 'b + abstract AddText : 'b -> string -> 'b + abstract AddBreak : 'b -> int -> 'b + abstract AddTag : 'b -> string * (string * string) list * bool -> 'b abstract Finish : 'b -> 'a -let renderL (rr: render<_,_>) layout = +let renderL (rr: LayoutRenderer<_,_>) layout = let rec addL z pos i layout k = match layout with (* pos is tab level *) @@ -262,7 +250,7 @@ let renderL (rr: render<_,_>) layout = /// string render let stringR = - { new render with + { new LayoutRenderer with member x.Start () = [] member x.AddText rstrs text = text::rstrs member x.AddBreak rstrs n = (spaces n) :: "\n" :: rstrs @@ -272,9 +260,9 @@ let stringR = type NoState = NoState type NoResult = NoResult -/// channel render +/// channel LayoutRenderer let channelR (chan:TextWriter) = - { new render with + { new LayoutRenderer with member r.Start () = NoState member r.AddText z s = chan.Write s; z member r.AddBreak z n = chan.WriteLine(); chan.Write (spaces n); z @@ -283,40 +271,13 @@ let channelR (chan:TextWriter) = /// buffer render let bufferR os = - { new render with + { new LayoutRenderer with member r.Start () = NoState member r.AddText z s = bprintf os "%s" s; z member r.AddBreak z n = bprintf os "\n"; bprintf os "%s" (spaces n); z member r.AddTag z (tag,attrs,start) = z member r.Finish z = NoResult } -/// html render - wraps HTML encoding (REVIEW) and hyperlinks -let htmlR (baseR : render<'Res,'State>) = - { new render<'Res,'State> with - member r.Start () = baseR.Start() - member r.AddText z s = baseR.AddText z s; (* REVIEW: escape HTML chars *) - member r.AddBreak z n = baseR.AddBreak z n - member r.AddTag z (tag,attrs,start) = - match tag,attrs with - | "html:a",[("href",link)] -> - if start - then baseR.AddText z (sprintf "" link) - else baseR.AddText z (sprintf "") - | _ -> z - member r.Finish z = baseR.Finish z } - -/// indent render - wraps fixed indentation -let indentR indent (baseR : render<'Res,'State>) = - { new render<'Res,'State> with - member r.Start () = - let z = baseR.Start() - let z = baseR.AddText z (spaces indent) - z - member r.AddText z s = baseR.AddText z s; (* REVIEW: escape HTML chars *) - member r.AddBreak z n = baseR.AddBreak z (n+indent); - member r.AddTag z (tag,attrs,start) = baseR.AddTag z (tag,attrs,start) - member r.Finish z = baseR.Finish z } - //-------------------------------------------------------------------------- //INDEX: showL, outL are most common //-------------------------------------------------------------------------- diff --git a/src/fsharp/layout.fsi b/src/fsharp/layout.fsi index e5070926a994af3368c23b7e19663bde9959e9c0..b3671ab1039f641cccca4c4284f834daadfd1dec 100644 --- a/src/fsharp/layout.fsi +++ b/src/fsharp/layout.fsi @@ -39,32 +39,28 @@ val aboveListL : Layout list -> Layout val optionL : ('a -> Layout) -> 'a option -> Layout val listL : ('a -> Layout) -> 'a list -> Layout -val linkL : string -> Layout -> Layout - val squashTo : int -> Layout -> Layout val showL : Layout -> string val outL : TextWriter -> Layout -> unit val bufferL : StringBuilder -> Layout -> unit -(* render a Layout yielding an 'a using a 'b (hidden state) type *) -type ('a,'b) render = - abstract Start : unit -> 'b; - abstract AddText : 'b -> string -> 'b; - abstract AddBreak : 'b -> int -> 'b; - abstract AddTag : 'b -> string * (string * string) list * bool -> 'b; +/// render a Layout yielding an 'a using a 'b (hidden state) type +type LayoutRenderer<'a,'b> = + abstract Start : unit -> 'b + abstract AddText : 'b -> string -> 'b + abstract AddBreak : 'b -> int -> 'b + abstract AddTag : 'b -> string * (string * string) list * bool -> 'b abstract Finish : 'b -> 'a -(* Run a render on a Layout *) -val renderL : ('b,'a) render -> Layout -> 'b - -(* Primitive renders *) -val stringR : (string,string list) render type NoState = NoState type NoResult = NoResult -val channelR : TextWriter -> (NoResult,NoState) render -val bufferR : StringBuilder -> (NoResult,NoState) render -(* Combinator renders *) -val htmlR : ('a,'b) render -> ('a,'b) render (* assumes in 
 context *)
-val indentR  : int -> ('a,'b) render -> ('a,'b) render
+/// Run a render on a Layout       
+val renderL  : LayoutRenderer<'b,'a> -> Layout -> 'b
+
+/// Primitive renders 
+val stringR  : LayoutRenderer
+val channelR : TextWriter -> LayoutRenderer
+val bufferR  : StringBuilder -> LayoutRenderer
+
diff --git a/src/fsharp/lib.fs b/src/fsharp/lib.fs
index ee5d2818c694b957eef441da098b0a42a7892067..fee5e7c848b622abcf6bfa3c6fe460c63c726b11 100644
--- a/src/fsharp/lib.fs
+++ b/src/fsharp/lib.fs
@@ -88,48 +88,6 @@ module NameMap =
     let domainL m = Zset.elements (domain m)
 
 
-(*
-
-//-------------------------------------------------------------------------
-// Library: Atoms
-//------------------------------------------------------------------------
-
-type AtomTable = 
-    { LookupTable : Dictionary
-      EncodeTable : Dictionary }
-    member at.Encode(name:string) = 
-        let mutable res = 0 
-        let idx = 
-            if at.EncodeTable.TryGetValue(name, &res) then 
-                res
-            else
-                let idx = at.EncodeTable.Count
-                at.LookupTable.[idx] <- name
-                at.EncodeTable.[name] <- idx
-                idx
-        Atom(res
-#if DEBUG
-             ,at
-#endif
-            )
-
-
-and Atom internal (idx:int32
-#if DEBUG
-                   ,_provider:AtomTable
-#endif
-                   ) =
-    member __.Index = idx
-    member __.Deref(provider: AtomTable) = 
-       
-#if DEBUG
-        assert (provider = _provider)
-        assert (provider.LookupTable.ContainsKey idx)
-#endif
-        provider.LookupTable.[idx]
-*)            
-
-    
 
 //---------------------------------------------------------------------------
 // Library: Pre\Post checks
@@ -481,7 +439,7 @@ let inline cacheOptRef cache f =
 // and goes depending on whether components are NGEN'd or not, e.g. 'ngen install FSharp.COmpiler.dll'
 // One workaround for the bug is to break NGEN loading and fixups into smaller fragments. Roughly speaking, the NGEN
 // loading process works by doing delayed fixups of references in NGEN code. This happens on a per-method
-// basis. For example, one manifestation is that a "print" before calling a method like Lexfilter.create gets
+// basis. For example, one manifestation is that a "print" before calling a method like LexFilter.create gets
 // displayed but the corresponding "print" in the body of that function doesn't get displayed. In between, the NGEN
 // image loader is performing a whole bunch of fixups of the NGEN code for the body of that method, and also for
 // bodies of methods referred to by that method. That second bit is very important: the fixup causing the crash may
diff --git a/src/fsharp/outcome.fs b/src/fsharp/outcome.fs
deleted file mode 100644
index d2a348d455f119cdef1b0f7a8b1acd88d7851bb5..0000000000000000000000000000000000000000
--- a/src/fsharp/outcome.fs
+++ /dev/null
@@ -1,30 +0,0 @@
-// Copyright (c) Microsoft Open Technologies, Inc.  All Rights Reserved.  Licensed under the Apache License, Version 2.0.  See License.txt in the project root for license information.
-
-// --------------------------------------------------------------------	
-// Outcomes.  These are used to describe steps of a machine that
-// may raise errors.  The errors can be trapped.
-// --------------------------------------------------------------------	
-
-module internal Microsoft.FSharp.Compiler.Outcome
-
-open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library
-
-let success a = Result a
-let raze (b:exn) = Exception b
-
-// map
-let (|?>) res f = 
-  match res with 
-  | Result x -> Result(f x )
-  | Exception err -> Exception err
-  
-let ForceRaise = function
-  | Result x -> x
-  | Exception err -> raise err
-
-let otherwise f x =
-  match x with 
-  | Result x -> success x
-  | Exception _err -> f()
-
-    
diff --git a/src/fsharp/outcome.fsi b/src/fsharp/outcome.fsi
deleted file mode 100644
index 64cd9f4968d5b7431a11b56abae98c4b28b1e9c0..0000000000000000000000000000000000000000
--- a/src/fsharp/outcome.fsi
+++ /dev/null
@@ -1,11 +0,0 @@
-// Copyright (c) Microsoft Open Technologies, Inc.  All Rights Reserved.  Licensed under the Apache License, Version 2.0.  See License.txt in the project root for license information.
-
-module internal Microsoft.FSharp.Compiler.Outcome
-
-open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library
-
-val success : 'T -> ResultOrException<'T>
-val raze : exn -> ResultOrException<'T>
-val ( |?> ) : ResultOrException<'T> -> ('T -> 'U) -> ResultOrException<'U>
-val ForceRaise : ResultOrException<'T> -> 'T
-val otherwise : (unit -> ResultOrException<'T>) -> ResultOrException<'T> -> ResultOrException<'T>
diff --git a/src/fsharp/pickle.fsi b/src/fsharp/pickle.fsi
deleted file mode 100644
index deba917e2bffa09f011492c931556218af0f488b..0000000000000000000000000000000000000000
--- a/src/fsharp/pickle.fsi
+++ /dev/null
@@ -1,75 +0,0 @@
-// Copyright (c) Microsoft Open Technologies, Inc.  All Rights Reserved.  Licensed under the Apache License, Version 2.0.  See License.txt in the project root for license information.
-
-module internal Microsoft.FSharp.Compiler.Pickle 
-
-open Internal.Utilities
-open Microsoft.FSharp.Compiler 
-open Microsoft.FSharp.Compiler.AbstractIL 
-open Microsoft.FSharp.Compiler.AbstractIL.IL
-open Microsoft.FSharp.Compiler.AbstractIL.Internal 
-open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library
-open Microsoft.FSharp.Compiler.Tast
-
-// Fixup pickled data w.r.t. a set of CCU thunks indexed by name
-[]
-type PickledDataWithReferences<'RawData> = 
-    { /// The data that uses a collection of CcuThunks internally
-      RawData: 'RawData; 
-      /// The assumptions that need to be fixed up
-      FixupThunks: list } 
-
-    member Fixup : (CcuReference -> CcuThunk) -> 'RawData
-    /// Like Fixup but loader may return None, in which case there is no fixup.
-    member OptionalFixup: (CcuReference -> CcuThunk option) -> 'RawData
-    
-#if INCLUDE_METADATA_WRITER
-type WriterState 
-
-type pickler<'T> = 'T -> WriterState -> unit
-val internal p_byte : int -> WriterState -> unit
-val internal p_bool : bool -> WriterState -> unit
-val internal p_int : int -> WriterState -> unit
-val internal p_string : string -> WriterState -> unit
-val internal p_lazy : 'T pickler -> Lazy<'T> pickler
-val inline  internal p_tup2 : ('T1 pickler) -> ('T2 pickler) -> ('T1 * 'T2) pickler
-val inline  internal p_tup3 : ('T1 pickler) -> ('T2 pickler) -> ('T3 pickler) -> ('T1 * 'T2 * 'T3) pickler
-val inline  internal p_tup4 : ('T1 pickler) -> ('T2 pickler) -> ('T3 pickler) -> ('T4 pickler) -> ('T1 * 'T2 * 'T3 * 'T4) pickler
-val internal p_array : 'T pickler -> 'T[] pickler
-val internal p_namemap : 'T pickler -> NameMap<'T> pickler
-val internal p_const : Const pickler
-val internal p_vref : string -> ValRef pickler
-val internal p_tcref : string -> TyconRef pickler
-val internal p_ucref : UnionCaseRef pickler
-val internal p_expr : Expr pickler
-val internal p_typ : TType pickler
-val internal pickleModuleOrNamespace : pickler
-val internal pickleModuleInfo : pickler
-val pickleObjWithDanglingCcus : string -> Env.TcGlobals -> scope:CcuThunk -> ('T pickler) -> 'T -> byte[]
-#else
-#endif
-
-type ReaderState 
-
-type unpickler<'T> = ReaderState -> 'T
-val internal u_byte : ReaderState -> int
-val internal u_bool : ReaderState -> bool
-val internal u_int : ReaderState -> int
-val internal u_string : ReaderState -> string
-val internal u_lazy : 'T unpickler -> Lazy<'T> unpickler
-val inline  internal u_tup2 : ('T2 unpickler) -> ('T3 unpickler ) -> ('T2 * 'T3) unpickler
-val inline  internal u_tup3 : ('T2 unpickler) -> ('T3 unpickler ) -> ('T4 unpickler ) -> ('T2 * 'T3 * 'T4) unpickler
-val inline  internal u_tup4 : ('T2 unpickler) -> ('T3 unpickler ) -> ('T4 unpickler ) -> ('T5 unpickler) -> ('T2 * 'T3 * 'T4 * 'T5) unpickler
-val internal u_array : 'T unpickler -> 'T[] unpickler
-val internal u_namemap : 'T unpickler -> NameMap<'T> unpickler
-val internal u_const : Const unpickler
-val internal u_vref : ValRef unpickler
-val internal u_tcref : TyconRef unpickler
-val internal u_ucref : UnionCaseRef unpickler
-val internal u_expr : Expr unpickler
-val internal u_typ : TType unpickler
-val internal unpickleModuleOrNamespace : ReaderState -> ModuleOrNamespace
-val internal unpickleModuleInfo : ReaderState -> PickledModuleInfo
-val internal unpickleObjWithDanglingCcus : string -> viewedScope:ILScopeRef -> ilModule:ILModuleDef -> ('T  unpickler) -> byte[] ->  PickledDataWithReferences<'T>
-
-
-
diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs
index 725206e61ed897060c697418c10378bdfe34a240..17496380228f1047a87b6d58d5e2f50dfd65bda3 100644
--- a/src/fsharp/tast.fs
+++ b/src/fsharp/tast.fs
@@ -1,5 +1,9 @@
 // Copyright (c) Microsoft Open Technologies, Inc.  All Rights Reserved.  Licensed under the Apache License, Version 2.0.  See License.txt in the project root for license information.
   
+//-------------------------------------------------------------------------
+// Defines the typed abstract syntax trees used throughout the F# compiler.
+//------------------------------------------------------------------------- 
+
 module internal Microsoft.FSharp.Compiler.Tast 
 
 open System
@@ -28,11 +32,6 @@ open Microsoft.FSharp.Compiler.ExtensionTyping
 open Microsoft.FSharp.Core.CompilerServices
 #endif
 
-#if DEBUG
-///verboseStamps: print #stamp on each id -- very verbose - but sometimes useful. Turn on using '--stamps'
-let verboseStamps = ref false
-#endif
-
 /// Unique name generator for stamps attached to lambdas and object expressions
 type Unique = int64
 //++GLOBAL MUTABLE STATE
@@ -239,6 +238,7 @@ type ValFlags(flags:int64) =
         // Clear the IsGeneratedEventVal, since there's no use in propagating specialname information for generated add/remove event vals
                                                       (flags       &&&    ~~~0b011001100000000000L) 
 
+/// Represents the kind of a type parameter
 []
 type TyparKind = 
     | Type 
@@ -407,11 +407,6 @@ type ModuleOrNamespaceKind =
     | Namespace
 
 
-/// The information ILXGEN needs about the location of an item
-type CompilationPath = 
-    | CompPath of ILScopeRef * (string * ModuleOrNamespaceKind) list
-    member x.ILScopeRef = (let (CompPath(scoref,_)) = x in scoref)
-    member x.AccessPath = (let (CompPath(_,p)) = x in p)
 
 
 /// A public path records where a construct lives within the global namespace
@@ -424,19 +419,25 @@ type PublicPath      =
         pp.[0..pp.Length-2]
 
 
+/// The information ILXGEN needs about the location of an item
+type CompilationPath = 
+    | CompPath of ILScopeRef * (string * ModuleOrNamespaceKind) list
+    member x.ILScopeRef = (let (CompPath(scoref,_)) = x in scoref)
+    member x.AccessPath = (let (CompPath(_,p)) = x in p)
+    member x.MangledPath = List.map fst x.AccessPath
+    member x.NestedPublicPath (id:Ident) = PubPath(Array.append (Array.ofList x.MangledPath) [| id.idText |])
+    member x.ParentCompPath = 
+        let a,_ = List.frontAndBack x.AccessPath
+        CompPath(x.ILScopeRef,a)
+    member x.NestedCompPath n modKind = CompPath(x.ILScopeRef,x.AccessPath@[(n,modKind)])
+
+
 let getNameOfScopeRef sref = 
     match sref with 
     | ILScopeRef.Local -> ""
     | ILScopeRef.Module mref -> mref.Name
     | ILScopeRef.Assembly aref -> aref.Name
-let mangledTextOfCompPath (CompPath(scoref,path)) = getNameOfScopeRef scoref + "/" + textOfPath (List.map fst path)
-  
-let mangledPathOfCompPath (CompPath(_,path))  = List.map fst path
-let publicPathOfCompPath (id:Ident) cpath = PubPath(Array.append (Array.ofList (mangledPathOfCompPath cpath)) [| id.idText |])
-let parentCompPath (CompPath(scoref,cpath)) = 
-    let a,_ = List.frontAndBack cpath 
-    CompPath(scoref,a)
-let mkNestedCPath (CompPath(scoref,p)) n modKind = CompPath(scoref,p@[(n,modKind)])
+
 
 #if EXTENSIONTYPING
 let definitionLocationOfProvidedItem (p : Tainted<#IProvidedCustomAttributeProvider>) =
@@ -451,18 +452,19 @@ let definitionLocationOfProvidedItem (p : Tainted<#IProvidedCustomAttributeProvi
     
 #endif
 
-// Type definitions, exception definitions, module definitions and
-// namespace definitions are all 'entities'. These have too much in common to make it 
-// worth factoring them out as separate types.
+/// Represents a type definition, exception definition, module definition or namespace definition.
 [] 
 type Entity = 
     { mutable Data: EntityData }
     /// The name of the namespace, module or type, possibly with mangling, e.g. List`1, List or FailureException 
     member x.LogicalName = x.Data.entity_logical_name
+
     /// The compiled name of the namespace, module or type, e.g. FSharpList`1, ListModule or FailureException 
     member x.CompiledName = match x.Data.entity_compiled_name with None -> x.LogicalName | Some s -> s
+
     /// The display name of the namespace, module or type, e.g. List instead of List`1, and no static parameters
     member x.DisplayName = x.GetDisplayName(false, false)
+
     /// The display name of the namespace, module or type with <_,_,_> added for generic types, plus static parameters if any
     member x.DisplayNameWithStaticParametersAndUnderscoreTypars = x.GetDisplayName(true, true)
 
@@ -669,7 +671,6 @@ type Entity =
 
     /// Get a list of all instance fields for F#-defined record, struct and class fields in this type definition.
     /// including hidden fields from the compilation of implicit class constructions.
-
     // NOTE: This method doesn't perform particularly well, and is over-used, but doesn't seem to appear on performance traces
     member x.AllInstanceFieldsAsList = x.AllFieldsAsList |> List.filter (fun f -> not f.IsStatic)
 
@@ -712,20 +713,16 @@ type Entity =
         | None -> None
 
     
-    // OSGN support
     /// Create a new entity with empty, unlinked data. Only used during unpickling of F# metadata.
     static member NewUnlinked() : Entity = { Data = nullableSlotEmpty() }
+
     /// Create a new entity with the given backing data. Only used during unpickling of F# metadata.
-    static member New reason (data: EntityData) : Entity  = 
-#if DEBUG
-        if !verboseStamps then 
-            dprintf "entity %s#%d (%s)\n" data.entity_logical_name data.entity_stamp reason
-#else
-        ignore(reason)
-#endif
+    static member New _reason (data: EntityData) : Entity  = 
         { Data = data }
+
     /// Link an entity based on empty, unlinked data to the given data. Only used during unpickling of F# metadata.
     member x.Link tg = x.Data <- nullableSlotFull(tg)
+
     /// Indicates if the entity is linked to backing data. Only used during unpickling of F# metadata.
     member x.IsLinked = match box x.Data with null -> false | _ -> true 
 
@@ -837,12 +834,16 @@ type Entity =
 
     /// Gets any implicit hash/equals (with comparer argument) methods added to an F# record, union or struct type definition.
     member x.GeneratedHashAndEqualsWithComparerValues = x.TypeContents.tcaug_hash_and_equals_withc 
+
     /// Gets any implicit CompareTo (with comparer argument) methods added to an F# record, union or struct type definition.
     member x.GeneratedCompareToWithComparerValues = x.TypeContents.tcaug_compare_withc
+
     /// Gets any implicit CompareTo methods added to an F# record, union or struct type definition.
     member x.GeneratedCompareToValues = x.TypeContents.tcaug_compare
+
     /// Gets any implicit hash/equals methods added to an F# record, union or struct type definition.
     member x.GeneratedHashAndEqualsValues = x.TypeContents.tcaug_equals
+
     /// Gets all implicit hash/equals/compare methods added to an F# record, union or struct type definition.
     member x.AllGeneratedValues = 
         [ match x.GeneratedCompareToValues with 
@@ -1128,36 +1129,47 @@ and
 
 #if EXTENSIONTYPING
 and 
-   [< RequireQualifiedAccess; NoComparison; NoEquality>]
+   []
    
    /// The information kept about a provided type
    TProvidedTypeInfo = 
    { /// The parameters given to the provider that provided to this type.
      ResolutionEnvironment : ExtensionTyping.ResolutionEnvironment
+
      /// The underlying System.Type (wrapped as a ProvidedType to make sure we don't call random things on
      /// System.Type, and wrapped as Tainted to make sure we track which provider this came from, for reporting
      /// error messages)
      ProvidedType:  Tainted
+
      /// The base type of the type. We use it to compute the compiled representation of the type for erased types.
      /// Reading is delayed, since it does an import on the underlying type
      LazyBaseType: LazyWithContext 
+
      /// A flag read eagerly from the provided type and used to compute basic properties of the type definition.
      IsClass:  bool 
+
      /// A flag read eagerly from the provided type and used to compute basic properties of the type definition.
      IsSealed:  bool 
+
      /// A flag read eagerly from the provided type and used to compute basic properties of the type definition.
      IsInterface:  bool 
      /// A flag read eagerly from the provided type and used to compute basic properties of the type definition.
      IsStructOrEnum: bool 
+
      /// A flag read eagerly from the provided type and used to compute basic properties of the type definition.
      IsEnum: bool 
+
      /// A type read from the provided type and used to compute basic properties of the type definition.
      /// Reading is delayed, since it does an import on the underlying type
      UnderlyingTypeOfEnum: (unit -> TType) 
+
      /// A flag read from the provided type and used to compute basic properties of the type definition.
      /// Reading is delayed, since it looks at the .BaseType
      IsDelegate: (unit -> bool) 
+
+     /// Indicates the type is erased
      IsErased: bool 
+
      /// Indicates the type is generated, but type-relocation is suppressed
      IsSuppressRelocate : bool }
 
@@ -1172,12 +1184,16 @@ and
   TyconObjModelKind = 
     /// Indicates the type is a class (also used for units-of-measure)
     | TTyconClass 
+
     /// Indicates the type is an interface 
     | TTyconInterface 
+
     /// Indicates the type is a struct 
     | TTyconStruct 
+
     /// Indicates the type is a delegate with the given Invoke signature 
     | TTyconDelegate of SlotSig 
+
     /// Indicates the type is an enumeration 
     | TTyconEnum
     
@@ -1190,17 +1206,19 @@ and
     []
     TyconObjModelData = 
     { /// Indicates whether the type declaration is a class, interface, enum, delegate or struct 
-      fsobjmodel_kind: TyconObjModelKind;
+      fsobjmodel_kind: TyconObjModelKind
+
       /// The declared abstract slots of the class, interface or struct 
-      fsobjmodel_vslots: ValRef list; 
+      fsobjmodel_vslots: ValRef list
+
       /// The fields of the class, struct or enum 
       fsobjmodel_rfields: TyconRecdFields }
 
 and 
-    []
+    []
     TyconRecdFields = 
     { /// The fields of the record, in declaration order. 
-      FieldsByIndex: RecdField[];
+      FieldsByIndex: RecdField[]
       
       /// The fields of the record, indexed by name. 
       FieldsByName : NameMap }
@@ -1215,10 +1233,10 @@ and
     member x.TrueInstanceFieldsAsList = x.AllFieldsAsList |> List.filter (fun f -> not f.IsStatic && not f.IsCompilerGenerated)   
 
 and 
-    []
+    []
     TyconUnionCases = 
     { /// The cases of the discriminated union, in declaration order. 
-      CasesByIndex: UnionCase[];
+      CasesByIndex: UnionCase[]
       /// The cases of the discriminated union, indexed by name. 
       CasesByName : NameMap
     }
@@ -1229,36 +1247,43 @@ and
     member x.UnionCasesAsList = x.CasesByIndex |> Array.toList
 
 and 
-    []
+    []
     TyconUnionData =
     { /// The cases contained in the discriminated union. 
-      CasesTable: TyconUnionCases;
+      CasesTable: TyconUnionCases
       /// The ILX data structure representing the discriminated union. 
-      CompiledRepresentation: IlxUnionRef cache; 
+      CompiledRepresentation: IlxUnionRef cache 
     }
     member x.UnionCasesAsList = x.CasesTable.CasesByIndex |> Array.toList
 
 and 
-    []
+    []
     []
     UnionCase =
     { /// Data carried by the case. 
-      FieldTable: TyconRecdFields;
+      FieldTable: TyconRecdFields
+
       /// Return type constructed by the case. Normally exactly the type of the enclosing type, sometimes an abbreviation of it 
-      ReturnType: TType;
+      ReturnType: TType
+
       /// Name of the case in generated IL code 
-      CompiledName: string;
+      CompiledName: string
+
       /// Documentation for the case 
-      XmlDoc : XmlDoc;
+      XmlDoc : XmlDoc
+
       /// XML documentation signature for the case
-      mutable XmlDocSig : string;
+      mutable XmlDocSig : string
+
       /// Name/range of the case 
-      Id: Ident; 
+      Id: Ident 
+
       ///  Indicates the declared visibility of the union constructor, not taking signatures into account 
-      Accessibility: Accessibility; 
+      Accessibility: Accessibility 
+
       /// Attributes, attached to the generated static method to make instances of the case 
       // MUTABILITY: used when propagating signature attributes into the implementation.
-      mutable Attribs: Attribs; }
+      mutable Attribs: Attribs }
 
     member uc.Range = uc.Id.idRange
     member uc.DisplayName = uc.Id.idText
@@ -1273,53 +1298,92 @@ and
     []
     RecdField =
     { /// Is the field declared mutable in F#? 
-      rfield_mutable: bool;
+      rfield_mutable: bool
+
       /// Documentation for the field 
-      rfield_xmldoc : XmlDoc;
+      rfield_xmldoc : XmlDoc
+
       /// XML Documentation signature for the field
-      mutable rfield_xmldocsig : string;
+      mutable rfield_xmldocsig : string
+
       /// The type of the field, w.r.t. the generic parameters of the enclosing type constructor 
-      rfield_type: TType;
+      rfield_type: TType
+
       /// Indicates a static field 
-      rfield_static: bool;
+      rfield_static: bool
+
       /// Indicates a volatile field 
-      rfield_volatile: bool;
+      rfield_volatile: bool
+
       /// Indicates a compiler generated field, not visible to Intellisense or name resolution 
-      rfield_secret: bool;
+      rfield_secret: bool
+
       /// The default initialization info, for static literals 
-      rfield_const: Const option; 
+      rfield_const: Const option 
+
       ///  Indicates the declared visibility of the field, not taking signatures into account 
-      rfield_access: Accessibility; 
+      rfield_access: Accessibility 
+
       /// Attributes attached to generated property 
       // MUTABILITY: used when propagating signature attributes into the implementation.
-      mutable rfield_pattribs: Attribs; 
+      mutable rfield_pattribs: Attribs 
+
       /// Attributes attached to generated field 
       // MUTABILITY: used when propagating signature attributes into the implementation.
-      mutable rfield_fattribs: Attribs; 
+      mutable rfield_fattribs: Attribs 
+
       /// Name/declaration-location of the field 
       rfield_id: Ident }
+
+    ///  Indicates the declared visibility of the field, not taking signatures into account 
     member v.Accessibility = v.rfield_access
+
+    /// Attributes attached to generated property 
     member v.PropertyAttribs = v.rfield_pattribs
+
+    /// Attributes attached to generated field 
     member v.FieldAttribs = v.rfield_fattribs
+
+    /// Declaration-location of the field 
     member v.Range = v.rfield_id.idRange
+
+    /// Name/declaration-location of the field 
     member v.Id = v.rfield_id
+
+    /// Name of the field 
     member v.Name = v.rfield_id.idText
+
+      /// Indicates a compiler generated field, not visible to Intellisense or name resolution 
     member v.IsCompilerGenerated = v.rfield_secret
+
+    /// Is the field declared mutable in F#? 
     member v.IsMutable = v.rfield_mutable
+
+    /// Indicates a static field 
     member v.IsStatic = v.rfield_static
+
+    /// Indicates a volatile field 
     member v.IsVolatile = v.rfield_volatile
+
+    /// The type of the field, w.r.t. the generic parameters of the enclosing type constructor 
     member v.FormalType = v.rfield_type
+
+    /// XML Documentation signature for the field
     member v.XmlDoc = v.rfield_xmldoc
+
+    /// Get or set the XML documentation signature for the field
     member v.XmlDocSig
         with get() = v.rfield_xmldocsig
         and set(x) = v.rfield_xmldocsig <- x
 
+    /// The default initialization info, for static literals 
     member v.LiteralValue = 
         match v.rfield_const  with 
         | None -> None
         | Some Const.Zero -> None
         | Some k -> Some k
 
+    /// Indicates if the field is zero-initialized
     member v.IsZeroInit = 
         match v.rfield_const  with 
         | None -> false 
@@ -1329,10 +1393,13 @@ and
 and ExceptionInfo =
     /// Indicates that an exception is an abbreviation for the given exception 
     | TExnAbbrevRepr of TyconRef 
+
     /// Indicates that an exception is shorthand for the given .NET exception type 
     | TExnAsmRepr of ILTypeRef
+
     /// Indicates that an exception carries the given record of values 
     | TExnFresh of TyconRecdFields
+
     /// Indicates that an exception is abstract, i.e. is in a signature file, and we do not know the representation 
     | TExnNone
 
@@ -1469,7 +1536,7 @@ and
       /// Get a table of values indexed by logical name
       member mtyp.AllValsByLogicalName = 
           let addValByName (x:Val) tab = 
-             // Note: names may occur twice prior to raising errors about this in PostTypecheckSemanticChecks
+             // Note: names may occur twice prior to raising errors about this in PostTypeCheckSemanticChecks
              // Earlier ones take precedence sice we report errors about the later ones
              if not x.IsMember && not x.IsCompilerGenerated then 
                  NameMap.add x.LogicalName x tab 
@@ -1509,8 +1576,11 @@ and Tycon = Entity
 /// A set of static methods for constructing types.
 and Construct = 
       
-    static member NewModuleOrNamespaceType mkind tycons vals = ModuleOrNamespaceType(mkind, QueueList.ofList vals, QueueList.ofList tycons)
-    static member NewEmptyModuleOrNamespaceType mkind = Construct.NewModuleOrNamespaceType mkind [] []
+    static member NewModuleOrNamespaceType mkind tycons vals = 
+        ModuleOrNamespaceType(mkind, QueueList.ofList vals, QueueList.ofList tycons)
+
+    static member NewEmptyModuleOrNamespaceType mkind = 
+        Construct.NewModuleOrNamespaceType mkind [] []
 
 #if EXTENSIONTYPING
 
@@ -1576,32 +1646,32 @@ and Construct =
                 let enclosingName = ExtensionTyping.GetFSharpPathToProvidedType(st,m)
                 CompPath(ilScopeRef,enclosingName |> List.map(fun id->id,ModuleOrNamespaceKind.Namespace))
             | Some p -> p
-        let pubpath = publicPathOfCompPath id cpath
+        let pubpath = cpath.NestedPublicPath id
 
         let repr = Construct.NewProvidedTyconRepr(resolutionEnvironment, st, importProvidedType, isSuppressRelocate, m)
 
         Tycon.New "tycon"
-          { entity_stamp=stamp;
+          { entity_stamp=stamp
             entity_logical_name=name
-            entity_compiled_name=None;
-            entity_kind=kind;
-            entity_range=m;
-            entity_flags=EntityFlags(usesPrefixDisplay=false, isModuleOrNamespace=false,preEstablishedHasDefaultCtor=false, hasSelfReferentialCtor=false);
-            entity_attribs=[]; // fetched on demand via est.fs API
-            entity_typars= LazyWithContext.NotLazy [];
-            entity_tycon_abbrev = None;
-            entity_tycon_repr = repr;
-            entity_tycon_repr_accessibility = TAccess([]);
-            entity_exn_info=TExnNone;
-            entity_tycon_tcaug=TyconAugmentation.Create();
-            entity_modul_contents = lazy new ModuleOrNamespaceType(Namespace, QueueList.ofList [], QueueList.ofList []);
+            entity_compiled_name=None
+            entity_kind=kind
+            entity_range=m
+            entity_flags=EntityFlags(usesPrefixDisplay=false, isModuleOrNamespace=false,preEstablishedHasDefaultCtor=false, hasSelfReferentialCtor=false)
+            entity_attribs=[] // fetched on demand via est.fs API
+            entity_typars= LazyWithContext.NotLazy []
+            entity_tycon_abbrev = None
+            entity_tycon_repr = repr
+            entity_tycon_repr_accessibility = TAccess([])
+            entity_exn_info=TExnNone
+            entity_tycon_tcaug=TyconAugmentation.Create()
+            entity_modul_contents = lazy new ModuleOrNamespaceType(Namespace, QueueList.ofList [], QueueList.ofList [])
             // Generated types get internal accessibility
-            entity_accessiblity= access;
-            entity_xmldoc =  XmlDoc [||]; // fetched on demand via est.fs API
-            entity_xmldocsig="";        
-            entity_pubpath = Some pubpath;
-            entity_cpath = Some cpath;
-            entity_il_repr_cache = newCache(); } 
+            entity_accessiblity= access
+            entity_xmldoc =  XmlDoc [||] // fetched on demand via est.fs API
+            entity_xmldocsig=""        
+            entity_pubpath = Some pubpath
+            entity_cpath = Some cpath
+            entity_il_repr_cache = newCache() } 
 #endif
 
     static member NewModuleOrNamespace cpath access (id:Ident) xml attribs mtype = 
@@ -1621,13 +1691,14 @@ and Construct =
             entity_tycon_repr_accessibility = access
             entity_exn_info=TExnNone
             entity_tycon_tcaug=TyconAugmentation.Create()
-            entity_pubpath=cpath |> Option.map (publicPathOfCompPath id)
+            entity_pubpath=cpath |> Option.map (fun (cp:CompilationPath) -> cp.NestedPublicPath id)
             entity_cpath=cpath
             entity_accessiblity=access
             entity_attribs=attribs
             entity_xmldoc=xml
             entity_xmldocsig=""        
             entity_il_repr_cache = newCache() } 
+
 and Accessibility = 
     /// Indicates the construct can only be accessed from any code in the given type constructor, module or assembly. [] indicates global scope. 
     | TAccess of CompilationPath list
@@ -1681,36 +1752,56 @@ and
     { mutable Data: TyparData
       /// A cached TAST type used when this type variable is used as type.
       mutable AsType: TType }
+
+    /// The name of the type parameter 
     member x.Name                = x.Data.typar_id.idText
+
+    /// The range of the identifier for the type parameter definition
     member x.Range               = x.Data.typar_id.idRange
+
+    /// The identifier for a type parameter definition
     member x.Id                  = x.Data.typar_id
-    /// The unique stamp of the typar definition
+
+    /// The unique stamp of the type parameter
     member x.Stamp               = x.Data.typar_stamp
+
     /// The inferred equivalence for the type inference variable, if any.
     member x.Solution            = x.Data.typar_solution
+
     /// The inferred constraints for the type inference variable, if any
     member x.Constraints         = x.Data.typar_constraints
+
     /// Indicates if the type variable is compiler generated, i.e. is an implicit type inference variable 
     member x.IsCompilerGenerated = x.Data.typar_flags.IsCompilerGenerated
+
     /// Indicates if the type variable can be sovled or given new constraints. The status of a type variable
     /// generally always evolves towards being either rigid or solved. 
     member x.Rigidity            = x.Data.typar_flags.Rigidity
+
     /// Indicates if a type parameter is needed at runtime and may not be eliminated
     member x.DynamicReq          = x.Data.typar_flags.DynamicReq
+
     /// Indicates that whether or not a generic type definition satisfies the equality constraint is dependent on whether this type variable satisfies the equality constraint.
     member x.EqualityConditionalOn = x.Data.typar_flags.EqualityConditionalOn
+
     /// Indicates that whether or not a generic type definition satisfies the comparison constraint is dependent on whether this type variable satisfies the comparison constraint.
     member x.ComparisonConditionalOn = x.Data.typar_flags.ComparisonConditionalOn
+
     /// Indicates if the type variable has a static "head type" requirement, i.e. ^a variables used in FSharp.Core and member constraints.
     member x.StaticReq           = x.Data.typar_flags.StaticReq
+
     /// Indicates if the type inference variable was generated after an error when type checking expressions or patterns
     member x.IsFromError         = x.Data.typar_flags.IsFromError
+
     /// Indicates whether a type variable can be instantiated by types or units-of-measure.
     member x.Kind                = x.Data.typar_flags.Kind
+
     /// Indicates whether a type variable is erased in compiled .NET IL code, i.e. whether it is a unit-of-measure variable
     member x.IsErased            = match x.Kind with TyparKind.Type -> false | _ -> true
+
     /// The declared attributes of the type parameter. Empty for type inference variables and parameters from .NET 
     member x.Attribs             = x.Data.typar_attribs
+
     /// Indicates the display name of a type variable
     member x.DisplayName = if x.Name = "?" then "?"+string x.Stamp else x.Name
 
@@ -1829,6 +1920,7 @@ and
     []
     /// Indicates the solution of a member constraint during inference.
     TraitConstraintSln = 
+
     /// FSMethSln(typ, vref, minst)
     ///
     /// Indicates a trait is solved by an F# method.
@@ -1887,10 +1979,13 @@ and
     []
     Val = 
     { mutable Data: ValData }
+
     /// The place where the value was defined. 
     member x.Range = x.Data.val_range
+
     /// A unique stamp within the context of this invocation of the compiler process 
     member x.Stamp = x.Data.val_stamp
+
     /// The type of the value. 
     /// May be a TType_forall for a generic value. 
     /// May be a type variable or type containing type variables during type inference. 
@@ -1967,10 +2062,7 @@ and
     /// a true body. These cases are often causes of bugs in the compiler.
     member x.MemberInfo                 = x.Data.val_member_info
 
-    /// Indicates if this is a member, and if so, gives some more data about the member.
-    ///
-    /// Note, the value may still be (a) an extension member or (b) and abtract slot without
-    /// a true body. These cases are often causes of bugs in the compiler.
+    /// Indicates if this is a member
     member x.IsMember                   = x.MemberInfo.IsSome
 
     /// Indicates if this is a member, excluding extension members
@@ -2018,7 +2110,7 @@ and
     /// Indicates if the backing field for a static value is suppressed.
     member x.IsCompiledAsStaticPropertyWithoutField = x.Data.val_flags.IsCompiledAsStaticPropertyWithoutField
 
-    /// Indicates if this is allows the use of an explicit type instantiation (i.e. does it itself have explciti type arguments,
+    /// Indicates if this value allows the use of an explicit type instantiation (i.e. does it itself have explicit type arguments,
     /// or does it have a signature?)
     member x.PermitsExplicitTypeInstantiation = x.Data.val_flags.PermitsExplicitTypeInstantiation
 
@@ -2230,7 +2322,7 @@ and
     
     
 and 
-    []
+    []
     []
     ValData =
 
@@ -2288,7 +2380,7 @@ and
       mutable val_xmldocsig : string } 
 
 and 
-    []
+    []
     ValMemberInfo = 
     { /// The parent type. For an extension member this is the type being extended 
       ApparentParent: TyconRef  
@@ -2303,7 +2395,7 @@ and
 
 
 and 
-    []
+    []
     NonLocalValOrMemberRef = 
     { /// A reference to the entity containing the value or member. THis will always be a non-local reference
       EnclosingEntity : EntityRef 
@@ -2393,14 +2485,14 @@ and NonLocalEntityRef    =
                 | [(_,st)] ->
                     // 'entity' is at position i in the dereference chain. We resolved to position 'j'.
                     // Inject namespaces until we're an position j, and then inject the type.
-                    // Note: this is similar to code in build.fs
+                    // Note: this is similar to code in CompileOps.fs
                     let rec injectNamespacesFromIToJ (entity: Entity) k = 
                         if k = j  then 
                             let newEntity = Construct.NewProvidedTycon(resolutionEnvironment, st, ccu.ImportProvidedType, false, m)
                             entity.ModuleOrNamespaceType.AddProvidedTypeEntity(newEntity)
                             newEntity
                         else
-                            let cpath = mkNestedCPath entity.CompilationPath entity.LogicalName ModuleOrNamespaceKind.Namespace
+                            let cpath = entity.CompilationPath.NestedCompPath entity.LogicalName ModuleOrNamespaceKind.Namespace
                             let newEntity = 
                                 Construct.NewModuleOrNamespace 
                                     (Some cpath) 
@@ -2478,7 +2570,7 @@ and NonLocalEntityRef    =
         match nleref.TryDeref with 
         | Some res -> res
         | None -> 
-              errorR (InternalUndefinedItemRef (FSComp.SR.tastUndefinedItemRefModuleNamespace, nleref.DisplayName, nleref.AssemblyName, "")); 
+              errorR (InternalUndefinedItemRef (FSComp.SR.tastUndefinedItemRefModuleNamespace, nleref.DisplayName, nleref.AssemblyName, "")) 
               raise (KeyNotFoundException())
         
     /// Try to get the details of the module or namespace fragment referred to by this non-local reference.
@@ -2512,8 +2604,8 @@ and
         | None -> 
              ()
 
-    // Dereference the TyconRef to a Tycon. Amortize the cost of doing this.
-    // This path should not allocate in the amortized case
+    /// Dereference the TyconRef to a Tycon. Amortize the cost of doing this.
+    /// This path should not allocate in the amortized case
     member tcr.Deref = 
         match box tcr.binding with 
         | null ->
@@ -2524,7 +2616,7 @@ and
         | _ -> 
             tcr.binding
 
-    // Dereference the TyconRef to a Tycon option.
+    /// Dereference the TyconRef to a Tycon option.
     member tcr.TryDeref = 
         match box tcr.binding with 
         | null -> 
@@ -2547,35 +2639,47 @@ and
 
     /// Gets the data indicating the compiled representation of a type or module in terms of Abstract IL data structures.
     member x.CompiledRepresentation = x.Deref.CompiledRepresentation
+
     /// Gets the data indicating the compiled representation of a named type or module in terms of Abstract IL data structures.
     member x.CompiledRepresentationForNamedType = x.Deref.CompiledRepresentationForNamedType
+
     /// The name of the namespace, module or type, possibly with mangling, e.g. List`1, List or FailureException 
     member x.LogicalName = x.Deref.LogicalName
+
     /// The compiled name of the namespace, module or type, e.g. FSharpList`1, ListModule or FailureException 
     member x.CompiledName = x.Deref.CompiledName
+
     /// The display name of the namespace, module or type, e.g. List instead of List`1, not including static parameters
     member x.DisplayName = x.Deref.DisplayName
+
     /// The display name of the namespace, module or type with <_,_,_> added for generic types,  including static parameters
     member x.DisplayNameWithStaticParametersAndUnderscoreTypars = x.Deref.DisplayNameWithStaticParametersAndUnderscoreTypars
+
     /// The display name of the namespace, module or type, e.g. List instead of List`1, including static parameters
     member x.DisplayNameWithStaticParameters = x.Deref.DisplayNameWithStaticParameters
+
     /// The code location where the module, namespace or type is defined.
     member x.Range = x.Deref.Range
+
     /// A unique stamp for this module, namespace or type definition within the context of this compilation. 
     /// Note that because of signatures, there are situations where in a single compilation the "same" 
     /// module, namespace or type may have two distinct Entity objects that have distinct stamps.
     member x.Stamp = x.Deref.Stamp
+
     /// The F#-defined custom attributes of the entity, if any. If the entity is backed by Abstract IL or provided metadata
     /// then this does not include any attributes from those sources.
     member x.Attribs = x.Deref.Attribs
+
     /// The XML documentation of the entity, if any. If the entity is backed by provided metadata
     /// then this _does_ include this documentation. If the entity is backed by Abstract IL metadata
     /// or comes from another F# assembly then it does not (because the documentation will get read from 
     /// an XML file).
     member x.XmlDoc = x.Deref.XmlDoc
+
     /// The XML documentation sig-string of the entity, if any, to use to lookup an .xml doc file. This also acts
     /// as a cache for this sig-string computation.
     member x.XmlDocSig = x.Deref.XmlDocSig
+
     /// The logical contents of the entity when it is a module or namespace fragment.
     member x.ModuleOrNamespaceType = x.Deref.ModuleOrNamespaceType
     
@@ -2584,14 +2688,19 @@ and
 
     /// The logical contents of the entity when it is a type definition.
     member x.TypeContents = x.Deref.TypeContents
+
     /// The kind of the type definition - is it a measure definition or a type definition?
     member x.TypeOrMeasureKind = x.Deref.TypeOrMeasureKind
+
     /// The identifier at the point of declaration of the type definition.
     member x.Id = x.Deref.Id
+
     /// The information about the r.h.s. of a type definition, if any. For example, the r.h.s. of a union or record type.
     member x.TypeReprInfo = x.Deref.TypeReprInfo
+
     /// The information about the r.h.s. of an F# exception definition, if any. 
     member x.ExceptionInfo        = x.Deref.ExceptionInfo
+
     /// Indicates if the entity represents an F# exception declaration.
     member x.IsExceptionDecl      = x.Deref.IsExceptionDecl
     
@@ -2599,128 +2708,181 @@ and
     /// 
     /// Lazy because it may read metadata, must provide a context "range" in case error occurs reading metadata.
     member x.Typars m             = x.Deref.Typars m
+
     /// Get the type parameters for an entity that is a type declaration, otherwise return the empty list.
     member x.TyparsNoRange        = x.Deref.TyparsNoRange
+
     /// Indicates if this entity is an F# type abbreviation definition
     member x.TypeAbbrev           = x.Deref.TypeAbbrev
+
+    /// Indicates if this entity is an F# type abbreviation definition
     member x.IsTypeAbbrev         = x.Deref.IsTypeAbbrev
+
     /// Get the value representing the accessiblity of the r.h.s. of an F# type definition.
     member x.TypeReprAccessibility = x.Deref.TypeReprAccessibility
+
     /// Get the cache of the compiled ILTypeRef representation of this module or type.
     member x.CompiledReprCache    = x.Deref.CompiledReprCache
+
     /// Get a blob of data indicating how this type is nested in other namespaces, modules or types.
     member x.PublicPath : PublicPath option = x.Deref.PublicPath
+
     /// Get the value representing the accessiblity of an F# type definition or module.
     member x.Accessibility        = x.Deref.Accessibility
+
     /// Indicates the type prefers the "tycon" syntax for display etc. 
     member x.IsPrefixDisplay      = x.Deref.IsPrefixDisplay
+
     /// Indicates the "tycon blob" is actually a module 
     member x.IsModuleOrNamespace  = x.Deref.IsModuleOrNamespace
+
     /// Indicates if the entity is a namespace
     member x.IsNamespace          = x.Deref.IsNamespace
+
     /// Indicates if the entity is an F# module definition
     member x.IsModule             = x.Deref.IsModule
+
+    /// Get a blob of data indicating how this type is nested inside other namespaces, modules and types.
     member x.CompilationPathOpt   = x.Deref.CompilationPathOpt
+
 #if EXTENSIONTYPING
     /// Indicates if the entity is a provided namespace fragment
     member x.IsProvided               = x.Deref.IsProvided
+
     /// Indicates if the entity is a provided namespace fragment
     member x.IsProvidedNamespace      = x.Deref.IsProvidedNamespace
+
     /// Indicates if the entity is an erased provided type definition
     member x.IsProvidedErasedTycon    = x.Deref.IsProvidedErasedTycon
+
     /// Indicates if the entity is a generated provided type definition, i.e. not erased.
     member x.IsProvidedGeneratedTycon = x.Deref.IsProvidedGeneratedTycon
 #endif
+
     /// Get a blob of data indicating how this type is nested inside other namespaces, modules and types.
     member x.CompilationPath      = x.Deref.CompilationPath
+
     /// Get a table of fields for all the F#-defined record, struct and class fields in this type definition, including
     /// static fields, 'val' declarations and hidden fields from the compilation of implicit class constructions.
     member x.AllFieldTable        = x.Deref.AllFieldTable
+
     /// Get an array of fields for all the F#-defined record, struct and class fields in this type definition, including
     /// static fields, 'val' declarations and hidden fields from the compilation of implicit class constructions.
     member x.AllFieldsArray       = x.Deref.AllFieldsArray
+
     /// Get a list of fields for all the F#-defined record, struct and class fields in this type definition, including
     /// static fields, 'val' declarations and hidden fields from the compilation of implicit class constructions.
     member x.AllFieldsAsList = x.Deref.AllFieldsAsList
+
     /// Get a list of all fields for F#-defined record, struct and class fields in this type definition,
     /// including static fields, but excluding compiler-generate fields.
     member x.TrueFieldsAsList = x.Deref.TrueFieldsAsList
+
     /// Get a list of all instance fields for F#-defined record, struct and class fields in this type definition,
     /// excluding compiler-generate fields.
     member x.TrueInstanceFieldsAsList = x.Deref.TrueInstanceFieldsAsList
+
     /// Get a list of all instance fields for F#-defined record, struct and class fields in this type definition.
     /// including hidden fields from the compilation of implicit class constructions.
     // NOTE: This method doesn't perform particularly well, and is over-used, but doesn't seem to appear on performance traces
     member x.AllInstanceFieldsAsList = x.Deref.AllInstanceFieldsAsList
+
     /// Get a field by index in definition order
     member x.GetFieldByIndex  n        = x.Deref.GetFieldByIndex n
+
     /// Get a field by name.
     member x.GetFieldByName n          = x.Deref.GetFieldByName n
+
     /// Get the union cases and other union-type information for a type, if any
     member x.UnionTypeInfo             = x.Deref.UnionTypeInfo
+
     /// Get the union cases for a type, if any
     member x.UnionCasesArray           = x.Deref.UnionCasesArray
+
     /// Get the union cases for a type, if any, as a list
     member x.UnionCasesAsList          = x.Deref.UnionCasesAsList
+
     /// Get a union case of a type by name
     member x.GetUnionCaseByName n      = x.Deref.GetUnionCaseByName n
+
     /// Get the blob of information associated with an F# object-model type definition, i.e. class, interface, struct etc.
     member x.FSharpObjectModelTypeInfo = x.Deref.FSharpObjectModelTypeInfo
+
     /// Gets the immediate interface definitions of an F# type definition. Further interfaces may be supported through class and interface inheritance.
     member x.ImmediateInterfacesOfFSharpTycon   = x.Deref.ImmediateInterfacesOfFSharpTycon
+
     /// Gets the immediate interface types of an F# type definition. Further interfaces may be supported through class and interface inheritance.
     member x.ImmediateInterfaceTypesOfFSharpTycon = x.Deref.ImmediateInterfaceTypesOfFSharpTycon
+
     /// Gets the immediate members of an F# type definition, excluding compiler-generated ones.
     /// Note: result is alphabetically sorted, then for each name the results are in declaration order
     member x.MembersOfFSharpTyconSorted = x.Deref.MembersOfFSharpTyconSorted
+
     /// Gets all immediate members of an F# type definition keyed by name, including compiler-generated ones.
     /// Note: result is a indexed table, and for each name the results are in reverse declaration order
     member x.MembersOfFSharpTyconByName = x.Deref.MembersOfFSharpTyconByName
+
     /// Indicates if this is a struct or enum type definition , i.e. a value type definition
     member x.IsStructOrEnumTycon       = x.Deref.IsStructOrEnumTycon
+
     /// Indicates if this is an F# type definition which is one of the special types in FSharp.Core.dll which uses 
     /// an assembly-code representation for the type, e.g. the primitive array type constructor.
     member x.IsAsmReprTycon            = x.Deref.IsAsmReprTycon
+
     /// Indicates if this is an F# type definition which is one of the special types in FSharp.Core.dll like 'float<_>' which
     /// defines a measure type with a relation to an existing non-measure type as a representation.
     member x.IsMeasureableReprTycon    = x.Deref.IsMeasureableReprTycon
+
     /// Indicates if the entity is erased, either a measure definition, or an erased provided type definition
     member x.IsErased                  = x.Deref.IsErased
     
     /// Gets any implicit hash/equals (with comparer argument) methods added to an F# record, union or struct type definition.
     member x.GeneratedHashAndEqualsWithComparerValues = x.Deref.GeneratedHashAndEqualsWithComparerValues
+
     /// Gets any implicit CompareTo (with comparer argument) methods added to an F# record, union or struct type definition.
     member x.GeneratedCompareToWithComparerValues = x.Deref.GeneratedCompareToWithComparerValues
+
     /// Gets any implicit CompareTo methods added to an F# record, union or struct type definition.
     member x.GeneratedCompareToValues = x.Deref.GeneratedCompareToValues
+
     /// Gets any implicit hash/equals methods added to an F# record, union or struct type definition.
     member x.GeneratedHashAndEqualsValues = x.Deref.GeneratedHashAndEqualsValues
     
     /// Indicate if this is a type definition backed by Abstract IL metadata.
     member x.IsILTycon                = x.Deref.IsILTycon
+
     /// Get the Abstract IL scope, nesting and metadata for this 
     /// type definition, assuming it is backed by Abstract IL metadata.
     member x.ILTyconInfo              = x.Deref.ILTyconInfo
+
     /// Get the Abstract IL metadata for this type definition, assuming it is backed by Abstract IL metadata.
     member x.ILTyconRawMetadata       = x.Deref.ILTyconRawMetadata
+
     /// Indicate if this is a type whose r.h.s. is known to be a union type definition.
     member x.IsUnionTycon             = x.Deref.IsUnionTycon
+
     /// Indicates if this is an F# type definition whose r.h.s. is known to be a record type definition.
     member x.IsRecordTycon            = x.Deref.IsRecordTycon
+
     /// Indicates if this is an F# type definition whose r.h.s. is known to be some kind of F# object model definition
     member x.IsFSharpObjectModelTycon = x.Deref.IsFSharpObjectModelTycon
+
     /// Indicates if this is an F# type definition whose r.h.s. definition is unknown (i.e. a traditional ML 'abstract' type in a signature,
     /// which in F# is called a 'unknown representation' type).
     member x.IsHiddenReprTycon        = x.Deref.IsHiddenReprTycon
 
     /// Indicates if this is an F#-defined interface type definition 
     member x.IsFSharpInterfaceTycon   = x.Deref.IsFSharpInterfaceTycon
+
     /// Indicates if this is an F#-defined delegate type definition 
     member x.IsFSharpDelegateTycon    = x.Deref.IsFSharpDelegateTycon
+
     /// Indicates if this is an F#-defined enum type definition 
     member x.IsFSharpEnumTycon        = x.Deref.IsFSharpEnumTycon
+
     /// Indicates if this is a .NET-defined enum type definition 
     member x.IsILEnumTycon            = x.Deref.IsILEnumTycon
+
     /// Indicates if this is an enum type definition 
     member x.IsEnumTycon              = x.Deref.IsEnumTycon
 
@@ -2729,14 +2891,17 @@ and
 
     /// Indicates if this is a .NET-defined struct or enum type definition , i.e. a value type definition
     member x.IsILStructOrEnumTycon          = x.Deref.IsILStructOrEnumTycon
+
     /// Indicates if we have pre-determined that a type definition has a default constructor.
     member x.PreEstablishedHasDefaultConstructor = x.Deref.PreEstablishedHasDefaultConstructor
+
     /// Indicates if we have pre-determined that a type definition has a self-referential constructor using 'as x'
     member x.HasSelfReferentialConstructor = x.Deref.HasSelfReferentialConstructor
 
 
 /// note: ModuleOrNamespaceRef and TyconRef are type equivalent 
 and ModuleOrNamespaceRef       = EntityRef
+
 and TyconRef       = EntityRef
 
 /// References are either local or nonlocal
@@ -2753,6 +2918,7 @@ and
     member x.PrivateTarget = x.binding
     member x.ResolvedTarget = x.binding
 
+    /// Dereference the ValRef to a Val.
     member vr.Deref = 
         match box vr.binding with 
         | null ->
@@ -2767,6 +2933,7 @@ and
             res 
         | _ -> vr.binding
 
+    /// Dereference the ValRef to a Val option.
     member vr.TryDeref = 
         match box vr.binding with 
         | null -> 
@@ -2781,55 +2948,153 @@ and
         | _ -> 
             Some vr.binding
 
+    /// The type of the value. May be a TType_forall for a generic value. 
+    /// May be a type variable or type containing type variables during type inference. 
     member x.Type                       = x.Deref.Type
+
+    /// Get the type of the value including any generic type parameters
     member x.TypeScheme                 = x.Deref.TypeScheme
+
+    /// Get the type of the value after removing any generic type parameters
     member x.TauType                    = x.Deref.TauType
+
     member x.Typars                     = x.Deref.Typars
     member x.LogicalName                = x.Deref.LogicalName
     member x.DisplayName                = x.Deref.DisplayName
     member x.CoreDisplayName            = x.Deref.CoreDisplayName
     member x.Range                      = x.Deref.Range
 
+    /// Get the value representing the accessiblity of an F# type definition or module.
     member x.Accessibility              = x.Deref.Accessibility
+
+    /// The parent type or module, if any (None for expression bindings and parameters)
     member x.ActualParent               = x.Deref.ActualParent
+
+    /// Get the apparent parent entity for the value, i.e. the entity under with which the
+    /// value is associated. For extension members this is the nominal type the member extends.
+    /// For other values it is just the actual parent.
     member x.ApparentParent             = x.Deref.ApparentParent
+
+    /// Range of the definition (implementation) of the value, used by Visual Studio 
+    /// Updated by mutation when the implementation is matched against the signature. 
     member x.DefinitionRange            = x.Deref.DefinitionRange
+
+    /// The value of a value or member marked with [] 
     member x.LiteralValue               = x.Deref.LiteralValue
+
     member x.Id                         = x.Deref.Id
+
+    /// Get the name of the value, assuming it is compiled as a property.
+    ///   - If this is a property then this is 'Foo' 
+    ///   - If this is an implementation of an abstract slot then this is the name of the property implemented by the abstract slot
     member x.PropertyName               = x.Deref.PropertyName
+
+    /// A unique stamp within the context of this invocation of the compiler process 
     member x.Stamp                      = x.Deref.Stamp
+
+    /// Is this represented as a "top level" static binding (i.e. a static field, static member,
+    /// instance member), rather than an "inner" binding that may result in a closure.
     member x.IsCompiledAsTopLevel       = x.Deref.IsCompiledAsTopLevel
+
+    /// Indicates if this member is an F#-defined dispatch slot.
     member x.IsDispatchSlot             = x.Deref.IsDispatchSlot
+
+    /// The name of the method in compiled code (with some exceptions where ilxgen.fs decides not to use a method impl)
     member x.CompiledName         = x.Deref.CompiledName
 
+    /// Get the public path to the value, if any? Should be set if and only if
+    /// IsMemberOrModuleBinding is set.
     member x.PublicPath                 = x.Deref.PublicPath
+
+    /// The quotation expression associated with a value given the [] tag
     member x.ReflectedDefinition        = x.Deref.ReflectedDefinition
+
+    /// Indicates if this is an F#-defined 'new' constructor member
     member x.IsConstructor              = x.Deref.IsConstructor
+
+    /// Indicates if this value was a member declared 'override' or an implementation of an interface slot
     member x.IsOverrideOrExplicitImpl   = x.Deref.IsOverrideOrExplicitImpl
+
+    /// Is this a member, if so some more data about the member.
     member x.MemberInfo                 = x.Deref.MemberInfo
+
+    /// Indicates if this is a member
     member x.IsMember                   = x.Deref.IsMember
+
+    /// Indicates if this is an F#-defined value in a module, or an extension member, but excluding compiler generated bindings from optimizations
     member x.IsModuleBinding            = x.Deref.IsModuleBinding
+
+    /// Indicates if this is an F#-defined instance member. 
+    ///
+    /// Note, the value may still be (a) an extension member or (b) and abtract slot without
+    /// a true body. These cases are often causes of bugs in the compiler.
     member x.IsInstanceMember           = x.Deref.IsInstanceMember
 
+    /// Indicates if this value is declared 'mutable'
     member x.IsMutable                  = x.Deref.IsMutable
+
+    /// Indicates if this value allows the use of an explicit type instantiation (i.e. does it itself have explicit type arguments,
+    /// or does it have a signature?)
     member x.PermitsExplicitTypeInstantiation  = x.Deref.PermitsExplicitTypeInstantiation
+
+    /// Indicates if this is inferred to be a method or function that definitely makes no critical tailcalls?
     member x.MakesNoCriticalTailcalls  = x.Deref.MakesNoCriticalTailcalls
+
+    /// Is this a member definition or module definition?
     member x.IsMemberOrModuleBinding    = x.Deref.IsMemberOrModuleBinding
+
+    /// Indicates if this is an F#-defined extension member
     member x.IsExtensionMember          = x.Deref.IsExtensionMember
+
+    /// Indicates if this is a constructor member generated from the de-sugaring of implicit constructor for a class type?
     member x.IsIncrClassConstructor = x.Deref.IsIncrClassConstructor
+
+    /// Indicates if this is a member generated from the de-sugaring of 'let' function bindings in the implicit class syntax?
     member x.IsIncrClassGeneratedMember = x.Deref.IsIncrClassGeneratedMember
+
+    /// Get the information about a recursive value used during type inference
     member x.RecursiveValInfo           = x.Deref.RecursiveValInfo
+
+    /// Indicates if this is a 'base' or 'this' value?
     member x.BaseOrThisInfo             = x.Deref.BaseOrThisInfo
+
+    //  Indicates if this value was declared to be a type function, e.g. "let f<'a> = typeof<'a>"
     member x.IsTypeFunction             = x.Deref.IsTypeFunction
+
+    /// Records the "extra information" for a value compiled as a method.
+    ///
+    /// This indicates the number of arguments in each position for a curried function.
     member x.ValReprInfo                 = x.Deref.ValReprInfo
+
+    /// Get the inline declaration on the value
     member x.InlineInfo                 = x.Deref.InlineInfo
+
+    /// Indicates whether the inline declaration for the value indicate that the value must be inlined?
     member x.MustInline                 = x.Deref.MustInline
+
+    /// Indicates whether this value was generated by the compiler.
+    ///
+    /// Note: this is true for the overrides generated by hash/compare augmentations
     member x.IsCompilerGenerated        = x.Deref.IsCompilerGenerated
+
+    /// Get the declared attributes for the value
     member x.Attribs                    = x.Deref.Attribs
+
+    /// Get the declared documentation for the value
     member x.XmlDoc                     = x.Deref.XmlDoc
+
+    /// Get or set the signature for the value's XML documentation
     member x.XmlDocSig                  = x.Deref.XmlDocSig
+
+    /// Get the actual parent entity for the value (a module or a type), i.e. the entity under which the
+    /// value will appear in compiled code. For extension members this is the module where the extension member
+    /// is declared.
     member x.TopValActualParent         = x.Deref.TopValActualParent
+
+    /// Get the apparent parent entity for a member
     member x.MemberApparentParent       = x.Deref.MemberApparentParent
+
+    /// Get the number of 'this'/'self' object arguments for the member. Instance extension members return '1'.
     member x.NumObjArgs                 = x.Deref.NumObjArgs
 
     override x.ToString() = 
@@ -2841,23 +3106,46 @@ and UnionCaseRef =
     member x.TyconRef = let (UCRef(tcref,_)) = x in tcref
     member x.CaseName = let (UCRef(_,nm)) = x in nm
     member x.Tycon = x.TyconRef.Deref
+    member x.UnionCase = 
+        match x.TyconRef.GetUnionCaseByName x.CaseName with 
+        | Some res -> res
+        | None -> error(InternalError(sprintf "union case %s not found in type %s" x.CaseName x.TyconRef.LogicalName, x.TyconRef.Range))
+    member x.Attribs = x.UnionCase.Attribs
+    member x.Range = x.UnionCase.Range
+    member x.Index = 
+        try 
+           // REVIEW: this could be faster, e.g. by storing the index in the NameMap 
+            x.TyconRef.UnionCasesArray |> Array.findIndex (fun ucspec -> ucspec.DisplayName = x.CaseName) 
+        with :? KeyNotFoundException -> 
+            error(InternalError(sprintf "union case %s not found in type %s" x.CaseName x.TyconRef.LogicalName, x.TyconRef.Range))
+    member x.AllFieldsAsList = x.UnionCase.FieldTable.AllFieldsAsList
+    member x.ReturnType = x.UnionCase.ReturnType
+    member x.FieldByIndex n = x.UnionCase.FieldTable.FieldByIndex n
 
 and RecdFieldRef = 
     | RFRef of TyconRef * string
     member x.TyconRef = let (RFRef(tcref,_)) = x in tcref
     member x.FieldName = let (RFRef(_,id)) = x in id
     member x.Tycon = x.TyconRef.Deref
+    member x.RecdField = 
+        let (RFRef(tcref,id)) = x
+        match tcref.GetFieldByName id with 
+        | Some res -> res
+        | None -> error(InternalError(sprintf "field %s not found in type %s" id tcref.LogicalName, tcref.Range))
+    member x.PropertyAttribs = x.RecdField.PropertyAttribs
+    member x.Range = x.RecdField.Range
+
+    member x.Index =
+        let (RFRef(tcref,id)) = x
+        try 
+            // REVIEW: this could be faster, e.g. by storing the index in the NameMap 
+            tcref.AllFieldsArray |> Array.findIndex (fun rfspec -> rfspec.Name = id)  
+        with :? KeyNotFoundException -> 
+            error(InternalError(sprintf "field %s not found in type %s" id tcref.LogicalName, tcref.Range))
 
 and 
   /// The algebra of types
     []
-// REMOVING because of possible stack overflow 
-
-#if EXTENSIBLE_DUMPER
-#if DEBUG
-    [)>]
-#endif  
-#endif  
     TType =
 
     /// TType_forall(typars, bodyTy).
@@ -2892,6 +3180,7 @@ and
 
     /// Indicates the type is a unit-of-measure expression being used as an argument to a type or member
     | TType_measure of MeasureExpr
+
     override x.ToString() =  
         match x with 
         | TType_forall (_tps,ty) -> "forall _. " + ty.ToString()
@@ -2925,7 +3214,7 @@ and MeasureExpr =
     | MeasureRationalPower of MeasureExpr * Rational
 
 and 
-    []
+    []
     CcuData = 
     { /// Holds the filename for the DLL, if any 
       FileName: string option 
@@ -3109,7 +3398,7 @@ and CcuResolutionResult =
     | UnresolvedCcu of string
 
 /// Represents the information saved in the assembly signature data resource for an F# assembly
-and PickledModuleInfo =
+and PickledCcuInfo =
   { mspec: ModuleOrNamespace
     compileTimeWorkingDir: string
     usesQuotations : bool }
@@ -3121,22 +3410,23 @@ and PickledModuleInfo =
 and Attribs = Attrib list 
 
 and AttribKind = 
-  /// Indicates an attribute refers to a type defined in an imported .NET assembly 
-  | ILAttrib of ILMethodRef 
-  /// Indicates an attribute refers to a type defined in an imported F# assembly 
-  | FSAttrib of ValRef
+    /// Indicates an attribute refers to a type defined in an imported .NET assembly 
+    | ILAttrib of ILMethodRef 
+    /// Indicates an attribute refers to a type defined in an imported F# assembly 
+    | FSAttrib of ValRef
 
 /// Attrib(kind,unnamedArgs,propVal,appliedToAGetterOrSetter,targetsOpt,range)
 and Attrib = 
-  | Attrib of TyconRef * AttribKind * AttribExpr list * AttribNamedArg list * bool * AttributeTargets option * range
+    | Attrib of TyconRef * AttribKind * AttribExpr list * AttribNamedArg list * bool * AttributeTargets option * range
 
 /// We keep both source expression and evaluated expression around to help intellisense and signature printing
 and AttribExpr = 
     /// AttribExpr(source, evaluated)
-    AttribExpr of Expr * Expr 
+    | AttribExpr of Expr * Expr 
 
 /// AttribNamedArg(name,type,isField,value)
-and AttribNamedArg = AttribNamedArg of (string*TType*bool*AttribExpr)
+and AttribNamedArg = 
+    | AttribNamedArg of (string*TType*bool*AttribExpr)
 
 /// Constants in expressions
 and []
@@ -3281,9 +3571,9 @@ and
     []
     ArgReprInfo = 
     { 
-      // MUTABILITY; used when propagating signature attributes into the implementation.
+      // MUTABILITY: used when propagating signature attributes into the implementation.
       mutable Attribs : Attribs 
-      // MUTABILITY; used when propagating names of parameters from signature into the implementation.
+      // MUTABILITY: used when propagating names of parameters from signature into the implementation.
       mutable Name : Ident option  }
 
 /// Records the extra metadata stored about typars for type parameters
@@ -3751,47 +4041,6 @@ let ccuEq (mv1: CcuThunk) (mv2: CcuThunk) =
 /// For derefencing in the middle of a pattern
 let (|ValDeref|) (vr :ValRef) = vr.Deref
 
-//---------------------------------------------------------------------------
-// Get information from refs
-//---------------------------------------------------------------------------
-
-exception InternalUndefinedTyconItem of (string * string -> int * string) * TyconRef * string
-
-type UnionCaseRef with 
-    member x.UnionCase = 
-        let (UCRef(tcref,nm)) = x
-        match tcref.GetUnionCaseByName nm with 
-        | Some res -> res
-        | None -> error (InternalUndefinedTyconItem (FSComp.SR.tastUndefinedTyconItemUnionCase, tcref, nm))
-    member x.Attribs = x.UnionCase.Attribs
-    member x.Range = x.UnionCase.Range
-    member x.Index = 
-        let (UCRef(tcref,id)) = x
-        try 
-           // REVIEW: this could be faster, e.g. by storing the index in the NameMap 
-            tcref.UnionCasesArray |> Array.findIndex (fun ucspec -> ucspec.DisplayName = id) 
-        with :? KeyNotFoundException -> 
-            error(InternalError(sprintf "union case %s not found in type %s" id tcref.LogicalName, tcref.Range))
-    member x.AllFieldsAsList = x.UnionCase.FieldTable.AllFieldsAsList
-    member x.ReturnType = x.UnionCase.ReturnType
-    member x.FieldByIndex n = x.UnionCase.FieldTable.FieldByIndex n
-
-type RecdFieldRef with 
-    member x.RecdField = 
-        let (RFRef(tcref,id)) = x
-        match tcref.GetFieldByName id with 
-        | Some res -> res
-        | None -> error (InternalUndefinedTyconItem (FSComp.SR.tastUndefinedTyconItemField, tcref, id))
-    member x.PropertyAttribs = x.RecdField.PropertyAttribs
-    member x.Range = x.RecdField.Range
-
-    member x.Index =
-        let (RFRef(tcref,id)) = x
-        try 
-            // REVIEW: this could be faster, e.g. by storing the index in the NameMap 
-            tcref.AllFieldsArray |> Array.findIndex (fun rfspec -> rfspec.Name = id)  
-        with :? KeyNotFoundException -> 
-            error(InternalError(sprintf "field %s not found in type %s" id tcref.LogicalName, tcref.Range))
 
 //--------------------------------------------------------------------------
 // Make references to TAST items
@@ -3820,25 +4069,24 @@ let mkNestedNonLocalEntityRef (nleref:NonLocalEntityRef) id = mkNonLocalEntityRe
 let mkNonLocalTyconRef nleref id = ERefNonLocal (mkNestedNonLocalEntityRef nleref id)
 let mkNonLocalTyconRefPreResolved x nleref id = ERefNonLocalPreResolved x (mkNestedNonLocalEntityRef nleref id)
 
-let mkNestedUnionCaseRef tcref (uc: UnionCase) = mkUnionCaseRef tcref uc.Id.idText
-let mkNestedRecdFieldRef tcref (rf: RecdField) = mkRecdFieldRef tcref rf.Name
-
 type EntityRef with 
     
-    member tcref.UnionCasesAsRefList         = tcref.UnionCasesAsList         |> List.map (mkNestedUnionCaseRef tcref)
-    member tcref.TrueInstanceFieldsAsRefList = tcref.TrueInstanceFieldsAsList |> List.map (mkNestedRecdFieldRef tcref)
-    member tcref.AllFieldAsRefList           = tcref.AllFieldsAsList          |> List.map (mkNestedRecdFieldRef tcref)
+    member tcref.UnionCasesAsRefList         = tcref.UnionCasesAsList         |> List.map tcref.MakeNestedUnionCaseRef
+    member tcref.TrueInstanceFieldsAsRefList = tcref.TrueInstanceFieldsAsList |> List.map tcref.MakeNestedRecdFieldRef
+    member tcref.AllFieldAsRefList           = tcref.AllFieldsAsList          |> List.map tcref.MakeNestedRecdFieldRef
 
-    member tcref.MkNestedTyconRef (x:Entity) : TyconRef  = 
+    member tcref.NestedTyconRef (x:Entity) = 
         match tcref with 
         | ERefLocal _ -> mkLocalTyconRef x
         | ERefNonLocal nlr -> mkNonLocalTyconRefPreResolved x nlr x.LogicalName
 
-    member tcref.MkNestedRecdFieldRef tycon (rf:Ident) = mkRecdFieldRef (tcref.MkNestedTyconRef tycon) rf.idText 
+    member tcref.RecdFieldRefInNestedTycon tycon (id:Ident) = mkRecdFieldRef (tcref.NestedTyconRef tycon) id.idText 
+    member tcref.MakeNestedRecdFieldRef  (rf: RecdField) = mkRecdFieldRef tcref rf.Name
+    member tcref.MakeNestedUnionCaseRef  (uc: UnionCase) = mkUnionCaseRef tcref uc.Id.idText
 
 /// Make a reference to a union case for type in a module or namespace
 let mkModuleUnionCaseRef (modref:ModuleOrNamespaceRef) tycon uc = 
-    mkNestedUnionCaseRef (modref.MkNestedTyconRef tycon) uc
+    (modref.NestedTyconRef tycon).MakeNestedUnionCaseRef uc
 
 let VRefLocal    x : ValRef = { binding=x; nlr=Unchecked.defaultof<_> }      
 let VRefNonLocal x : ValRef = { binding=Unchecked.defaultof<_>; nlr=x }      
@@ -3879,7 +4127,7 @@ let copyTypars tps = List.map copyTypar tps
 //-------------------------------------------------------------------------- 
     
 let tryShortcutSolvedUnitPar canShortcut (r:Typar) = 
-    if r.Kind = TyparKind.Type then failwith "tryShortcutSolvedUnitPar: kind=type";
+    if r.Kind = TyparKind.Type then failwith "tryShortcutSolvedUnitPar: kind=type"
     match r.Solution with
     | Some (TType_measure unt) -> 
         if canShortcut then 
@@ -4097,7 +4345,9 @@ let primValRefEq compilingFslib fslibCcu (x : ValRef) (y : ValRef) =
 // pubpath/cpath mess
 //---------------------------------------------------------------------------
 
-let stringOfAccess (TAccess paths) = String.concat ";" (List.map mangledTextOfCompPath paths)
+let stringOfAccess (TAccess paths) = 
+    let mangledTextOfCompPath (CompPath(scoref,path)) = getNameOfScopeRef scoref + "/" + textOfPath (List.map fst path)  
+    String.concat ";" (List.map mangledTextOfCompPath paths)
 
 let demangledPathOfCompPath (CompPath(_,path)) = 
     path |> List.map (fun (nm,k) -> Entity.DemangleEntityName nm k)
@@ -4145,16 +4395,16 @@ let combineAccess (TAccess a1) (TAccess a2) = TAccess(a1@a2)
 
 let NewFreeVarsCache() = newCache ()
 
-let MakeUnionCasesTable ucs = 
+let MakeUnionCasesTable ucs : TyconUnionCases = 
     { CasesByIndex = Array.ofList ucs 
       CasesByName = NameMap.ofKeyedList (fun uc -> uc.DisplayName) ucs }
                                                                   
-let MakeRecdFieldsTable ucs = 
+let MakeRecdFieldsTable ucs : TyconRecdFields = 
     { FieldsByIndex = Array.ofList ucs 
       FieldsByName = ucs  |> NameMap.ofKeyedList (fun rfld -> rfld.Name) }
                                                                   
 
-let MakeUnionCases ucs = 
+let MakeUnionCases ucs : TyconUnionData = 
     { CasesTable=MakeUnionCasesTable ucs 
       CompiledRepresentation=newCache() }
 
@@ -4173,7 +4423,7 @@ let NewTypar (kind,rigid,Typar(id,staticReq,isCompGen),isFromError,dynamicReq,at
 
 let NewRigidTypar nm m = NewTypar (TyparKind.Type,TyparRigidity.Rigid,Typar(mkSynId m nm,NoStaticReq,true),false,TyparDynamicReq.Yes,[],false,false)
 
-let NewUnionCase id nm tys rty attribs docOption access = 
+let NewUnionCase id nm tys rty attribs docOption access : UnionCase = 
     { Id=id
       CompiledName=nm
       XmlDoc=docOption
@@ -4200,7 +4450,7 @@ let NewExn cpath (id:Ident) access repr attribs doc =
         entity_tycon_tcaug=TyconAugmentation.Create()
         entity_xmldoc=doc
         entity_xmldocsig=""
-        entity_pubpath=cpath |> Option.map (publicPathOfCompPath id)
+        entity_pubpath=cpath |> Option.map (fun (cp:CompilationPath) -> cp.NestedPublicPath id)
         entity_accessiblity=access
         entity_tycon_repr_accessibility=access
         entity_modul_contents = notlazy (NewEmptyModuleOrNamespaceType ModuleOrType)
@@ -4246,7 +4496,7 @@ let NewTycon (cpath, nm, m, access, reprAccess, kind, typars, docOption, usesPre
         entity_accessiblity=access
         entity_xmldoc = docOption
         entity_xmldocsig=""        
-        entity_pubpath=cpath |> Option.map (publicPathOfCompPath (mkSynId m nm))
+        entity_pubpath=cpath |> Option.map (fun (cp:CompilationPath) -> cp.NestedPublicPath (mkSynId m nm))
         entity_cpath = cpath
         entity_il_repr_cache = newCache() } 
 
@@ -4269,9 +4519,6 @@ let NewModuleOrNamespace cpath access (id:Ident) xml attribs mtype = Construct.N
 
 let NewVal (logicalName:string,m:range,compiledName,ty,isMutable,isCompGen,arity,access,recValInfo,specialRepr,baseOrThis,attribs,inlineInfo,doc,isModuleOrMemberBinding,isExtensionMember,isIncrClassSpecialMember,isTyFunc,allowTypeInst,isGeneratedEventVal,konst,actualParent) : Val = 
     let stamp = newStamp() 
-#if DEBUG
-    if !verboseStamps then dprintf "NewVal, %s#%d\n" logicalName stamp
-#endif
     Val.New
         { val_stamp = stamp
           val_logical_name=logicalName
@@ -4306,10 +4553,7 @@ let NewCcuContents sref m nm mty =
 let NewModifiedTycon f (orig:Tycon) = 
     let stamp = newStamp() 
     let data = orig.Data 
-#if DEBUG
-    if !verboseStamps then dprintf "NewModifiedTycon, %s#%d, based on %s#%d\n" orig.LogicalName stamp orig.LogicalName data.entity_stamp
-#endif
-    Tycon.New "NewModifiedTycon" (f { data with entity_stamp=stamp; }) 
+    Tycon.New "NewModifiedTycon" (f { data with entity_stamp=stamp }) 
     
 /// Create a module Tycon based on an existing one using the function 'f'. 
 /// We require that we be given the parent for the new module. 
@@ -4324,9 +4568,6 @@ let NewModifiedModuleOrNamespace f orig =
 let NewModifiedVal f (orig:Val) = 
     let data = orig.Data
     let stamp = newStamp() 
-#if DEBUG
-    if !verboseStamps then dprintf "NewModifiedVal, stamp #%d, based on stamp #%d\n" stamp data.val_stamp
-#endif
     let data' = f { data with val_stamp=stamp }
     Val.New data'
 
@@ -4335,60 +4576,59 @@ let NewClonedTycon orig =  NewModifiedTycon (fun d -> d) orig
 
 //------------------------------------------------------------------------------
 
-/// Combine two maps where the given function reconciles entries that have the same key
-let private combineMaps f m1 m2 = 
-    Map.foldBack (fun k v acc -> Map.add k (if Map.containsKey k m2 then f [v;Map.find k m2] else f [v]) acc) m1 
-      (Map.foldBack (fun k v acc -> if Map.containsKey k m1 then acc else Map.add k (f [v]) acc) m2 Map.empty)
-
-let private combineMultiMaps f (m1: MultiMap<_,_>) (m2: MultiMap<_,_>) = 
-    Map.foldBack (fun k v acc -> List.foldBack (MultiMap.add k) (if Map.containsKey k m2 then f [v;Map.find k m2] else f [v]) acc) m1 
-      (Map.foldBack (fun k v acc -> if Map.containsKey k m1 then acc else List.foldBack (MultiMap.add k) (f [v]) acc) m2 MultiMap.empty)
-
-
-/// Combine module types when multiple namespace fragments contribute to the
-/// same namespace, making new module specs as we go.
-let rec private combineModuleOrNamespaceTypes path m (mty1:ModuleOrNamespaceType)  (mty2:ModuleOrNamespaceType)  = 
-    match mty1.ModuleOrNamespaceKind,mty2.ModuleOrNamespaceKind  with 
-    | Namespace,Namespace -> 
-        let kind = mty1.ModuleOrNamespaceKind
-        // REVIEW: this is not preserving order as we merge namespace declaration groups
-        let entities = 
-            (mty1.AllEntitiesByLogicalMangledName,mty2.AllEntitiesByLogicalMangledName) 
-            ||>  combineMaps (combineEntityList path) 
-
-        let vals = QueueList.append mty1.AllValsAndMembers mty2.AllValsAndMembers
-
-        new ModuleOrNamespaceType(kind, vals, QueueList.ofList (NameMap.range entities))
-
-    | Namespace, _ | _,Namespace -> 
-        error(Error(FSComp.SR.tastNamespaceAndModuleWithSameNameInAssembly(textOfPath path),m))
-
-    | _-> 
-        error(Error(FSComp.SR.tastTwoModulesWithSameNameInAssembly(textOfPath path),m))
-
-and private combineEntityList path l = 
-    match l with
-    | h :: t -> List.fold (combineEntites path) h t
-    | _ -> failwith "combineEntityList"
-
-and private combineEntites path (entity1:Entity) (entity2:Entity) = 
-
-    match entity1.IsModuleOrNamespace, entity2.IsModuleOrNamespace with
-    | true,true -> 
-        entity1 |> NewModifiedTycon (fun data1 -> 
-                    { data1 with 
-                         entity_xmldoc = XmlDoc.Merge entity1.XmlDoc entity2.XmlDoc
-                         entity_attribs = entity1.Attribs @ entity2.Attribs
-                         entity_modul_contents=lazy (combineModuleOrNamespaceTypes (path@[entity2.DemangledModuleOrNamespaceName]) entity2.Range entity1.ModuleOrNamespaceType entity2.ModuleOrNamespaceType); }) 
-    | false,false -> 
-        error(Error(FSComp.SR.tastDuplicateTypeDefinitionInAssembly(entity2.LogicalName, textOfPath path),entity2.Range))
-    | _,_ -> 
-        error(Error(FSComp.SR.tastConflictingModuleAndTypeDefinitionInAssembly(entity2.LogicalName, textOfPath path),entity2.Range))
+/// Combine a list of ModuleOrNamespaceType's making up the description of a CCU. checking there are now
+/// duplicate modules etc.
+let CombineCcuContentFragments m l = 
+
+    let CombineMaps f m1 m2 = 
+        Map.foldBack (fun k v acc -> Map.add k (if Map.containsKey k m2 then f [v;Map.find k m2] else f [v]) acc) m1 
+          (Map.foldBack (fun k v acc -> if Map.containsKey k m1 then acc else Map.add k (f [v]) acc) m2 Map.empty)
+
+    /// Combine module types when multiple namespace fragments contribute to the
+    /// same namespace, making new module specs as we go.
+    let rec CombineModuleOrNamespaceTypes path m (mty1:ModuleOrNamespaceType)  (mty2:ModuleOrNamespaceType)  = 
+        match mty1.ModuleOrNamespaceKind,mty2.ModuleOrNamespaceKind  with 
+        | Namespace,Namespace -> 
+            let kind = mty1.ModuleOrNamespaceKind
+            let entities = 
+                (mty1.AllEntitiesByLogicalMangledName,mty2.AllEntitiesByLogicalMangledName) 
+                ||>  CombineMaps (CombineEntityList path) 
+
+            let vals = QueueList.append mty1.AllValsAndMembers mty2.AllValsAndMembers
+
+            ModuleOrNamespaceType(kind, vals, QueueList.ofList (NameMap.range entities))
+
+        | Namespace, _ | _,Namespace -> 
+            error(Error(FSComp.SR.tastNamespaceAndModuleWithSameNameInAssembly(textOfPath path),m))
+
+        | _-> 
+            error(Error(FSComp.SR.tastTwoModulesWithSameNameInAssembly(textOfPath path),m))
+
+    and CombineEntityList path l = 
+        match l with
+        | h :: t -> List.fold (CombineEntites path) h t
+        | _ -> failwith "CombineEntityList"
+
+    and CombineEntites path (entity1:Entity) (entity2:Entity) = 
+
+        match entity1.IsModuleOrNamespace, entity2.IsModuleOrNamespace with
+        | true,true -> 
+            entity1 |> NewModifiedTycon (fun data1 -> 
+                        { data1 with 
+                             entity_xmldoc = XmlDoc.Merge entity1.XmlDoc entity2.XmlDoc
+                             entity_attribs = entity1.Attribs @ entity2.Attribs
+                             entity_modul_contents=lazy (CombineModuleOrNamespaceTypes (path@[entity2.DemangledModuleOrNamespaceName]) entity2.Range entity1.ModuleOrNamespaceType entity2.ModuleOrNamespaceType) }) 
+        | false,false -> 
+            error(Error(FSComp.SR.tastDuplicateTypeDefinitionInAssembly(entity2.LogicalName, textOfPath path),entity2.Range))
+        | _,_ -> 
+            error(Error(FSComp.SR.tastConflictingModuleAndTypeDefinitionInAssembly(entity2.LogicalName, textOfPath path),entity2.Range))
     
-and combineModuleOrNamespaceTypeList path m l = 
-    match l with
-    | h :: t -> List.fold (combineModuleOrNamespaceTypes path m) h t
-    | _ -> failwith "combineModuleOrNamespaceTypeList"
+    and CombineModuleOrNamespaceTypeList path m l = 
+        match l with
+        | h :: t -> List.fold (CombineModuleOrNamespaceTypes path m) h t
+        | _ -> failwith "CombineModuleOrNamespaceTypeList"
+
+    CombineModuleOrNamespaceTypeList [] m l
 
 //--------------------------------------------------------------------------
 // Resource format for pickled data
diff --git a/src/fsharp/tc.fsi b/src/fsharp/tc.fsi
deleted file mode 100644
index ce46550bcb2bf50642311cc5d1841615748f4174..0000000000000000000000000000000000000000
--- a/src/fsharp/tc.fsi
+++ /dev/null
@@ -1,111 +0,0 @@
-// Copyright (c) Microsoft Open Technologies, Inc.  All Rights Reserved.  Licensed under the Apache License, Version 2.0.  See License.txt in the project root for license information.
-
-module internal Microsoft.FSharp.Compiler.TypeChecker
-
-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
-open Microsoft.FSharp.Compiler 
-
-open Microsoft.FSharp.Compiler.Range
-open Microsoft.FSharp.Compiler.Ast
-open Microsoft.FSharp.Compiler.ErrorLogger
-open Microsoft.FSharp.Compiler.Tast
-open Microsoft.FSharp.Compiler.Tastops
-open Microsoft.FSharp.Compiler.Lib
-open Microsoft.FSharp.Compiler.Infos
-open Microsoft.FSharp.Compiler.Import
-open Microsoft.FSharp.Compiler.Env
-
-open System.Collections.Generic
-
-[]
-type TcEnv =
-    member DisplayEnv : DisplayEnv
-    member NameEnv : Nameres.NameResolutionEnv
-
-(* Incremental construction of environments, e.g. for F# Interactive *)
-val internal CreateInitialTcEnv : TcGlobals * ImportMap * range * (CcuThunk * string list * bool) list -> TcEnv 
-val internal AddCcuToTcEnv      : TcGlobals * ImportMap * range * TcEnv * CcuThunk * autoOpens: string list * bool -> TcEnv 
-val internal AddLocalRootModuleOrNamespace : Nameres.TcResultsSink -> TcGlobals -> ImportMap -> range -> TcEnv -> ModuleOrNamespaceType -> TcEnv
-val internal TcOpenDecl         : Nameres.TcResultsSink  -> TcGlobals -> ImportMap -> range -> range -> TcEnv -> Ast.LongIdent -> TcEnv 
-
-type TopAttribs =
-    { mainMethodAttrs : Attribs;
-      netModuleAttrs  : Attribs;
-      assemblyAttrs   : Attribs  }
-
-type ConditionalDefines = 
-    string list
-
-val internal EmptyTopAttrs : TopAttribs
-val internal CombineTopAttrs : TopAttribs -> TopAttribs -> TopAttribs
-
-val internal TypecheckOneImplFile : 
-      TcGlobals * NiceNameGenerator * ImportMap * CcuThunk * (unit -> bool) * ConditionalDefines * Nameres.TcResultsSink
-      -> TcEnv 
-      -> Tast.ModuleOrNamespaceType option
-      -> ParsedImplFileInput
-      -> Eventually
-
-val internal TypecheckOneSigFile : 
-      TcGlobals * NiceNameGenerator * ImportMap * CcuThunk  * (unit -> bool) * ConditionalDefines * Nameres.TcResultsSink 
-      -> TcEnv                             
-      -> ParsedSigFileInput
-      -> Eventually
-
-//-------------------------------------------------------------------------
-// exceptions arising from type checking 
-//------------------------------------------------------------------------- 
-
-exception internal BakedInMemberConstraintName of string * range
-exception internal FunctionExpected of DisplayEnv * TType * range
-exception internal NotAFunction of DisplayEnv * TType * range * range
-exception internal Recursion of DisplayEnv * Ast.Ident * TType * TType * range
-exception internal RecursiveUseCheckedAtRuntime of DisplayEnv * ValRef * range
-exception internal LetRecEvaluatedOutOfOrder of DisplayEnv * ValRef * ValRef * range
-exception internal LetRecCheckedAtRuntime of range
-exception internal LetRecUnsound of DisplayEnv * ValRef list * range
-exception internal TyconBadArgs of DisplayEnv * TyconRef * int * range
-exception internal UnionCaseWrongArguments of DisplayEnv * int * int * range
-exception internal UnionCaseWrongNumberOfArgs of DisplayEnv * int * int * range
-exception internal FieldsFromDifferentTypes of DisplayEnv * RecdFieldRef * RecdFieldRef * range
-exception internal FieldGivenTwice of DisplayEnv * RecdFieldRef * range
-exception internal MissingFields of string list * range
-exception internal UnitTypeExpected of DisplayEnv * TType * bool * range
-exception internal FunctionValueUnexpected of DisplayEnv * TType * range
-exception internal UnionPatternsBindDifferentNames of range
-exception internal VarBoundTwice of Ast.Ident
-exception internal ValueRestriction of DisplayEnv * bool * Val * Typar * range
-exception internal FieldNotMutable of DisplayEnv * RecdFieldRef * range
-exception internal ValNotMutable of DisplayEnv * ValRef * range
-exception internal ValNotLocal of DisplayEnv * ValRef * range
-exception internal InvalidRuntimeCoercion of DisplayEnv * TType * TType * range
-exception internal IndeterminateRuntimeCoercion of DisplayEnv * TType * TType * range
-exception internal IndeterminateStaticCoercion of DisplayEnv * TType * TType * range
-exception internal StaticCoercionShouldUseBox of DisplayEnv * TType * TType * range
-exception internal RuntimeCoercionSourceSealed of DisplayEnv * TType * range
-exception internal CoercionTargetSealed of DisplayEnv * TType * range
-exception internal UpcastUnnecessary of range
-exception internal TypeTestUnnecessary of range
-exception internal SelfRefObjCtor of bool * range
-exception internal VirtualAugmentationOnNullValuedType of range
-exception internal NonVirtualAugmentationOnNullValuedType of range
-exception internal UseOfAddressOfOperator of range
-exception internal DeprecatedThreadStaticBindingWarning of range
-exception internal NotUpperCaseConstructor of range
-exception internal IntfImplInIntrinsicAugmentation of range
-exception internal IntfImplInExtrinsicAugmentation of range
-exception internal OverrideInIntrinsicAugmentation of range
-exception internal OverrideInExtrinsicAugmentation of range
-exception internal NonUniqueInferredAbstractSlot of TcGlobals * DisplayEnv * string * MethInfo * MethInfo * range
-exception internal StandardOperatorRedefinitionWarning of string * range
-exception internal ParameterlessStructCtor of range
-
-val internal TcFieldInit : range -> ILFieldInit -> Tast.Const
-
-val IsSecurityAttribute : TcGlobals -> ImportMap -> Dictionary -> Attrib -> range -> bool
-val IsSecurityCriticalAttribute : TcGlobals -> Attrib -> bool
-val LightweightTcValForUsingInBuildMethodCall : g : TcGlobals -> vref:ValRef -> vrefFlags : ValUseFlag -> vrefTypeInst : TTypes -> m : range -> Expr * TType
\ No newline at end of file
diff --git a/src/fsharp/vs/IncrementalBuild.fs b/src/fsharp/vs/IncrementalBuild.fs
index 59ca37f8b570fc55689be34929a8c26a62a3c3f4..dfabec5f5ce251e1f91db89de0a9da1cb8a738cd 100644
--- a/src/fsharp/vs/IncrementalBuild.fs
+++ b/src/fsharp/vs/IncrementalBuild.fs
@@ -13,8 +13,10 @@ open System
 
 open Microsoft.FSharp.Compiler
 open Microsoft.FSharp.Compiler.Range
-open Microsoft.FSharp.Compiler.Build
+open Microsoft.FSharp.Compiler.CompileOps
+open Microsoft.FSharp.Compiler.CompileOptions
 open Microsoft.FSharp.Compiler.Tastops
+open Microsoft.FSharp.Compiler.TcGlobals
 open Microsoft.FSharp.Compiler.ErrorLogger
 open Microsoft.FSharp.Compiler.Lib
 open Microsoft.FSharp.Compiler.AbstractIL
@@ -1014,7 +1016,7 @@ type ErrorInfo = {
 
     /// Decompose a warning or error into parts: position, severity, message
     static member internal CreateFromException(exn,warn,trim:bool,fallbackRange:range) = 
-        let m = match RangeOfError exn with Some m -> m | None -> fallbackRange 
+        let m = match GetRangeOfError exn with Some m -> m | None -> fallbackRange 
         let (s1:int),(s2:int) = Pos.toVS m.Start
         let (s3:int),(s4:int) = Pos.toVS (if trim then m.Start else m.End)
         let msg = bufs (fun buf -> OutputPhasedError buf exn false)
@@ -1081,11 +1083,11 @@ module internal IncrementalFSharpBuild =
     open Internal.Utilities.Collections
 
     open IncrementalBuild
-    open Microsoft.FSharp.Compiler.Build
-    open Microsoft.FSharp.Compiler.Fscopts
+    open Microsoft.FSharp.Compiler.CompileOps
+    open Microsoft.FSharp.Compiler.CompileOptions
     open Microsoft.FSharp.Compiler.Ast
     open Microsoft.FSharp.Compiler.ErrorLogger
-    open Microsoft.FSharp.Compiler.Env
+    open Microsoft.FSharp.Compiler.TcGlobals
     open Microsoft.FSharp.Compiler.TypeChecker
     open Microsoft.FSharp.Compiler.Tast 
     open Microsoft.FSharp.Compiler.Range
@@ -1209,11 +1211,11 @@ module internal IncrementalFSharpBuild =
         let errorsSeenInScope = new ResizeArray<_>()
             
         let warningOrError warn exn = 
-            let warn = warn && not (ReportWarningAsError tcConfig.globalWarnLevel tcConfig.specificWarnOff tcConfig.specificWarnOn tcConfig.specificWarnAsError tcConfig.specificWarnAsWarn tcConfig.globalWarnAsError exn)                
+            let warn = warn && not (ReportWarningAsError (tcConfig.globalWarnLevel, tcConfig.specificWarnOff, tcConfig.specificWarnOn, tcConfig.specificWarnAsError, tcConfig.specificWarnAsWarn, tcConfig.globalWarnAsError) exn)                
             if not warn then
                 errorsSeenInScope.Add(exn)
                 errorLogger.ErrorSink(exn)                
-            else if ReportWarning tcConfig.globalWarnLevel tcConfig.specificWarnOff tcConfig.specificWarnOn exn then 
+            else if ReportWarning (tcConfig.globalWarnLevel, tcConfig.specificWarnOff, tcConfig.specificWarnOn) exn then 
                 warningsSeenInScope.Add(exn)
                 errorLogger.WarnSink(exn)                    
 
@@ -1427,8 +1429,8 @@ module internal IncrementalFSharpBuild =
                     errorLogger.Warning(e)
                     frameworkTcImports           
 
-            let tcEnv0 = GetInitialTypecheckerEnv (Some assemblyName) rangeStartup tcConfig tcImports tcGlobals
-            let tcState0 = TypecheckInitialState (rangeStartup,assemblyName,tcConfig,tcGlobals,tcImports,niceNameGen,tcEnv0)
+            let tcEnv0 = GetInitialTcEnv (Some assemblyName, rangeStartup, tcConfig, tcImports, tcGlobals)
+            let tcState0 = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, niceNameGen, tcEnv0)
             let tcAcc = 
                 { tcGlobals=tcGlobals
                   tcImports=tcImports
@@ -1456,11 +1458,11 @@ module internal IncrementalFSharpBuild =
                         Trace.PrintLine("FSharpBackgroundBuild", fun _ -> sprintf "Typechecking %s..." filename)                
                         beforeTypeCheckFile.Trigger filename
                         let! (tcEnv,topAttribs,typedImplFiles),tcState = 
-                            TypecheckOneInputEventually ((fun () -> errorLogger.ErrorCount > 0),
+                            TypeCheckOneInputEventually ((fun () -> errorLogger.ErrorCount > 0),
                                                          tcConfig,tcAcc.tcImports,
                                                          tcAcc.tcGlobals,
                                                          None,
-                                                         Nameres.TcResultsSink.NoSink,
+                                                         NameResolution.TcResultsSink.NoSink,
                                                          tcAcc.tcState,input)
                         
                         /// Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away
@@ -1505,8 +1507,8 @@ module internal IncrementalFSharpBuild =
             Trace.PrintLine("FSharpBackgroundBuildVerbose", fun _ -> sprintf "Finalizing Type Check" )
             let finalAcc = tcStates.[tcStates.Length-1]
             let results = tcStates |> List.ofArray |> List.map (fun acc-> acc.tcEnv, (Option.get acc.topAttribs), acc.typedImplFiles)
-            let (tcEnvAtEndOfLastFile,topAttrs,mimpls),tcState = TypecheckMultipleInputsFinish (results,finalAcc.tcState)
-            let tcState,tassembly = TypecheckClosedInputSetFinish (mimpls,tcState)
+            let (tcEnvAtEndOfLastFile,topAttrs,mimpls),tcState = TypeCheckMultipleInputsFinish (results,finalAcc.tcState)
+            let tcState,tassembly = TypeCheckClosedInputSetFinish (mimpls,tcState)
             tcState, topAttrs, tassembly, tcEnvAtEndOfLastFile, finalAcc.tcImports, finalAcc.tcGlobals, finalAcc.tcConfig
 
         // END OF BUILD TASK FUNCTIONS
@@ -1542,7 +1544,7 @@ module internal IncrementalFSharpBuild =
         let fileDependencies = 
             let unresolvedFileDependencies = 
                 unresolvedReferences
-                |> List.map (function Microsoft.FSharp.Compiler.Build.UnresolvedAssemblyReference(referenceText, _) -> referenceText)
+                |> List.map (function Microsoft.FSharp.Compiler.CompileOps.UnresolvedAssemblyReference(referenceText, _) -> referenceText)
                 |> List.filter(fun referenceText->not(Path.IsInvalidPath(referenceText))) // Exclude things that are definitely not a file name
                 |> List.map(fun referenceText -> if FileSystem.IsPathRootedShim(referenceText) then referenceText else System.IO.Path.Combine(projectDirectory,referenceText))
                 |> List.map (fun file->{Filename =  file; ExistenceDependency = true; IncrementalBuildDependency = true })
@@ -1618,7 +1620,7 @@ module internal IncrementalFSharpBuild =
         member __.TypeCheck() = 
             let newPartialBuild = IncrementalBuild.Eval "FinalizeTypeCheck" partialBuild
             partialBuild <- newPartialBuild
-            match GetScalarResult("FinalizeTypeCheck",partialBuild) with
+            match GetScalarResult("FinalizeTypeCheck",partialBuild) with
             | Some((tcState,topAttribs,typedAssembly,tcEnv,tcImports,tcGlobals,tcConfig),_) -> tcState,topAttribs,typedAssembly,tcEnv,tcImports,tcGlobals,tcConfig
             | None -> failwith "Build was not evaluated."
         
@@ -1668,7 +1670,7 @@ module internal IncrementalFSharpBuild =
             let tcConfigB = 
                 let defaultFSharpBinariesDir = Internal.Utilities.FSharpEnvironment.BinFolderOfDefaultFSharpCompiler.Value
                     
-                // see also fsc.fs:runFromCommandLineToImportingAssemblies(), as there are many similarities to where the PS creates a tcConfigB
+                // see also fsc.fs:ProcessCommandLineArgsAndImportAssemblies(), as there are many similarities to where the PS creates a tcConfigB
                 let tcConfigB = 
                     TcConfigBuilder.CreateNew(defaultFSharpBinariesDir, implicitIncludeDir=projectDirectory, 
                                               optimizeForMemory=true, isInteractive=false, isInvalidationSupported=true) 
@@ -1686,10 +1688,7 @@ module internal IncrementalFSharpBuild =
 
                 // Apply command-line arguments.
                 try
-                    ParseCompilerOptions
-                        (fun _sourceOrDll -> () )
-                        (Fscopts.GetCoreServiceCompilerOptions tcConfigB)
-                        commandLineArgs             
+                    ParseCompilerOptions ((fun _sourceOrDll -> () ), CompileOptions.GetCoreServiceCompilerOptions tcConfigB, commandLineArgs)
                 with e -> errorRecovery e range0
 
 
diff --git a/src/fsharp/vs/IncrementalBuild.fsi b/src/fsharp/vs/IncrementalBuild.fsi
index 104072bbcb89d88ea72e89f54f4a65fe032ac110..fd5e807f54a8b08b43fe9c03376192c6c7da62fe 100644
--- a/src/fsharp/vs/IncrementalBuild.fsi
+++ b/src/fsharp/vs/IncrementalBuild.fsi
@@ -6,7 +6,8 @@ open Microsoft.FSharp.Compiler
 open Microsoft.FSharp.Compiler.Range
 open Microsoft.FSharp.Compiler.ErrorLogger
 open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library
-open Microsoft.FSharp.Compiler.Build
+open Microsoft.FSharp.Compiler.TcGlobals
+open Microsoft.FSharp.Compiler.CompileOps
 
 
 []
@@ -124,7 +125,7 @@ module internal IncrementalFSharpBuild =
       }    
     
   type IncrementalBuilder = 
-      new : tcConfig : Build.TcConfig * projectDirectory : string * assemblyName : string * niceNameGen : Microsoft.FSharp.Compiler.Ast.NiceNameGenerator *
+      new : tcConfig : TcConfig * projectDirectory : string * assemblyName : string * niceNameGen : Microsoft.FSharp.Compiler.Ast.NiceNameGenerator *
             lexResourceManager : Microsoft.FSharp.Compiler.Lexhelp.LexResourceManager * sourceFiles : string list * ensureReactive : bool *
             errorLogger : ErrorLogger * keepGeneratedTypedAssembly:bool
         -> IncrementalBuilder
@@ -137,7 +138,7 @@ module internal IncrementalFSharpBuild =
       member IsAlive : bool
 
       /// The TcConfig passed in to the builder creation.
-      member TcConfig : Build.TcConfig
+      member TcConfig : TcConfig
 
       /// Raised just before a file is type-checked, to invalidate the state of the file in VS and force VS to request a new direct typecheck of the file.
       /// The incremental builder also typechecks the file (error and intellisense results from the backgroud builder are not
@@ -159,10 +160,10 @@ module internal IncrementalFSharpBuild =
       /// Ensure that the given file has been typechecked.
       /// Get the preceding typecheck state of a slot, allow stale results.
       member GetAntecedentTypeCheckResultsBySlot :
-        int -> (Build.TcState * Build.TcImports * Microsoft.FSharp.Compiler.Env.TcGlobals * Build.TcConfig * (PhasedError * bool) list * System.DateTime) option
+        int -> (TcState * TcImports * Microsoft.FSharp.Compiler.TcGlobals.TcGlobals * TcConfig * (PhasedError * bool) list * System.DateTime) option
 
       /// Get the final typecheck result. Only allowed when 'generateTypedImplFiles' was set on Create, otherwise the TypedAssembly will have not implementations.
-      member TypeCheck : unit -> Build.TcState * TypeChecker.TopAttribs * Tast.TypedAssembly * TypeChecker.TcEnv * Build.TcImports * Env.TcGlobals * Build.TcConfig
+      member TypeCheck : unit -> TcState * TypeChecker.TopAttribs * Tast.TypedAssembly * TypeChecker.TcEnv * TcImports * TcGlobals * TcConfig
 
       /// Attempts to find the slot of the given input file name. Throws an exception if it couldn't find it.    
       member GetSlotOfFileName : string -> int
diff --git a/src/fsharp/vs/ServiceDeclarations.fs b/src/fsharp/vs/ServiceDeclarations.fs
index b8641654d82844f2a9aee1d81b45a0b9181b2858..1cbfa1b432207a73adab548c98e547b7cde91707 100644
--- a/src/fsharp/vs/ServiceDeclarations.fs
+++ b/src/fsharp/vs/ServiceDeclarations.fs
@@ -20,18 +20,18 @@ open Microsoft.FSharp.Compiler
 open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics 
 open Microsoft.FSharp.Compiler.PrettyNaming
 
-open Microsoft.FSharp.Compiler.Env 
+open Microsoft.FSharp.Compiler.TcGlobals 
 open Microsoft.FSharp.Compiler.Parser
 open Microsoft.FSharp.Compiler.Range
 open Microsoft.FSharp.Compiler.Ast
 open Microsoft.FSharp.Compiler.ErrorLogger
-open Microsoft.FSharp.Compiler.Build
+open Microsoft.FSharp.Compiler.CompileOps
 open Microsoft.FSharp.Compiler.Tast
 open Microsoft.FSharp.Compiler.Tastops
 open Microsoft.FSharp.Compiler.Lib
 open Microsoft.FSharp.Compiler.Layout
 open Microsoft.FSharp.Compiler.Infos
-open Microsoft.FSharp.Compiler.Nameres
+open Microsoft.FSharp.Compiler.NameResolution
 open ItemDescriptionIcons 
 
 module EnvMisc2 =
diff --git a/src/fsharp/vs/ServiceDeclarations.fsi b/src/fsharp/vs/ServiceDeclarations.fsi
index cc011e3cd4564fdc8c3dc95859ec1d64f1861615..ead479606d88ec10a9def581f735bd0e89902b4a 100644
--- a/src/fsharp/vs/ServiceDeclarations.fsi
+++ b/src/fsharp/vs/ServiceDeclarations.fsi
@@ -10,9 +10,9 @@ namespace Microsoft.FSharp.Compiler.SourceCodeServices
 open Microsoft.FSharp.Compiler 
 open Microsoft.FSharp.Compiler.Range
 open System.Collections.Generic
-open Microsoft.FSharp.Compiler.Env 
+open Microsoft.FSharp.Compiler.TcGlobals 
 open Microsoft.FSharp.Compiler.Infos
-open Microsoft.FSharp.Compiler.Nameres
+open Microsoft.FSharp.Compiler.NameResolution
 open Microsoft.FSharp.Compiler.Tast
 open Microsoft.FSharp.Compiler.Tastops
 
diff --git a/src/fsharp/vs/ServiceLexing.fs b/src/fsharp/vs/ServiceLexing.fs
index 975a03e6ba8dd0c7289a69c95f366aa9e12327ca..b330581238525fc0ffbac7034a222727693ac107 100644
--- a/src/fsharp/vs/ServiceLexing.fs
+++ b/src/fsharp/vs/ServiceLexing.fs
@@ -535,7 +535,7 @@ type internal LineTokenizer(text:string,
     let lexbuf = UnicodeLexing.StringAsLexbuf text
     
     let mutable singleLineTokenState = SingleLineTokenState.BeforeHash
-    let fsx = Build.IsScript(filename)
+    let fsx = CompileOps.IsScript(filename)
 
     // ----------------------------------------------------------------------------------
     // This implements post-processing of #directive tokens - not very elegant, but it works...
@@ -646,7 +646,7 @@ type internal LineTokenizer(text:string,
                   | RQUOTE_DOT (s,raw) -> 
                       delayToken(DOT, rightc, rightc)
                       false, (RQUOTE (s,raw), leftc, rightc - 1)
-                  | INFIX_COMPARE_OP (Lexfilter.TyparsCloseOp(greaters,afterOp) as opstr) -> 
+                  | INFIX_COMPARE_OP (LexFilter.TyparsCloseOp(greaters,afterOp) as opstr) -> 
                       match afterOp with
                       | None -> ()
                       | Some tok -> delayToken(tok, leftc + greaters.Length, rightc)
diff --git a/src/fsharp/vs/ServiceUntypedParse.fs b/src/fsharp/vs/ServiceUntypedParse.fs
index b4d790c68230fcbed39febc322fa5231d7716328..0c259558d769f9de04c782ef5fa45e7fcdbca50c 100644
--- a/src/fsharp/vs/ServiceUntypedParse.fs
+++ b/src/fsharp/vs/ServiceUntypedParse.fs
@@ -17,15 +17,15 @@ open Internal.Utilities.Debug
 open Microsoft.FSharp.Compiler.Range
 open Microsoft.FSharp.Compiler.Ast
 open Microsoft.FSharp.Compiler.ErrorLogger
-open Microsoft.FSharp.Compiler.Build
+open Microsoft.FSharp.Compiler.CompileOps
 open Microsoft.FSharp.Compiler.Lib
 
 /// Methods for dealing with F# sources files.
 module internal SourceFile =
     /// Source file extensions
-    let private compilableExtensions = Build.sigSuffixes @ Build.implSuffixes @ Build.scriptSuffixes
+    let private compilableExtensions = CompileOps.FSharpSigFileSuffixes @ CompileOps.FSharpImplFileSuffixes @ CompileOps.FSharpScriptFileSuffixes
     /// Single file projects extensions
-    let private singleFileProjectExtensions = Build.scriptSuffixes
+    let private singleFileProjectExtensions = CompileOps.FSharpScriptFileSuffixes
     /// Whether or not this file is compilable
     let IsCompilable file =
         let ext = Path.GetExtension(file)
@@ -42,7 +42,7 @@ module internal SourceFileImpl =
 
     /// Additonal #defines that should be in place when editing a file in a file editor such as VS.
     let AdditionalDefinesForUseInEditor(filename) =
-        if Build.IsScript(filename) then ["INTERACTIVE";"EDITING"] // This is still used by the foreground parse
+        if CompileOps.IsScript(filename) then ["INTERACTIVE";"EDITING"] // This is still used by the foreground parse
         else ["COMPILED";"EDITING"]
            
 type CompletionPath = string list * string option // plid * residue
diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs
index a343858a15b81d70329938968c98e06cfaffb154..5184b9b80a3db97867b1a569afa4b672804a900e 100644
--- a/src/fsharp/vs/service.fs
+++ b/src/fsharp/vs/service.fs
@@ -13,10 +13,10 @@ open System.Threading
 open System.Collections.Generic
  
 open Microsoft.FSharp.Core.Printf
+open Microsoft.FSharp.Compiler 
 open Microsoft.FSharp.Compiler.AbstractIL
 open Microsoft.FSharp.Compiler.AbstractIL.Internal  
 open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library  
-open Microsoft.FSharp.Compiler 
 open Microsoft.FSharp.Compiler.MSBuildResolver
 open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics 
 open Microsoft.FSharp.Compiler.PrettyNaming
@@ -24,13 +24,13 @@ open Internal.Utilities.Collections
 open Internal.Utilities.Debug
 open System.Security.Permissions
 
-open Microsoft.FSharp.Compiler.Env 
+open Microsoft.FSharp.Compiler.TcGlobals 
 open Microsoft.FSharp.Compiler.Parser
 open Microsoft.FSharp.Compiler.Range
 open Microsoft.FSharp.Compiler.Ast
 open Microsoft.FSharp.Compiler.ErrorLogger
 open Microsoft.FSharp.Compiler.Lexhelp
-open Microsoft.FSharp.Compiler.Build
+open Microsoft.FSharp.Compiler.CompileOps
 open Microsoft.FSharp.Compiler.Tast
 open Microsoft.FSharp.Compiler.Tastops
 open Microsoft.FSharp.Compiler.Tastops.DebugPrint
@@ -39,7 +39,7 @@ open Microsoft.FSharp.Compiler.AbstractIL.IL
 open Microsoft.FSharp.Compiler.Layout
 open Microsoft.FSharp.Compiler.TypeChecker
 open Microsoft.FSharp.Compiler.Infos
-open Microsoft.FSharp.Compiler.Nameres
+open Microsoft.FSharp.Compiler.NameResolution
 open Internal.Utilities.StructuredFormat
 open ItemDescriptionIcons 
 open ItemDescriptionsImpl 
@@ -376,7 +376,7 @@ type Names = string list
 type NamesWithResidue = Names * string 
 
 []
-type CapturedNameResolution(p:pos, i:Item, io:ItemOccurence, de:DisplayEnv, nre:Nameres.NameResolutionEnv, ad:AccessorDomain, m:range) =
+type CapturedNameResolution(p:pos, i:Item, io:ItemOccurence, de:DisplayEnv, nre:NameResolution.NameResolutionEnv, ad:AccessorDomain, m:range) =
     member this.Pos = p
     member this.Item = i
     member this.ItemOccurence = io
@@ -394,8 +394,8 @@ type CapturedNameResolution(p:pos, i:Item, io:ItemOccurence, de:DisplayEnv, nre:
 []
 type TypeCheckInfo
           (/// Information corresponding to miscellaneous command-line options (--define, etc).
-           _sTcConfig: Build.TcConfig,
-           g: Env.TcGlobals,
+           _sTcConfig: TcConfig,
+           g: TcGlobals,
            /// AssemblyName -> IL-Module 
            amap: Import.ImportMap,
            /// project directory, or directory containing the file that generated this scope if no project directory given 
@@ -403,9 +403,9 @@ type TypeCheckInfo
            sFile:string,
            /// Name resolution environments for every interesting region in the file. These regions may
            /// overlap, in which case the smallest region applicable should be used.
-           sEnvs: ResizeArray,
+           sEnvs: ResizeArray,
            /// This is a name resolution environment to use if no better match can be found.
-           sFallback:Nameres.NameResolutionEnv,
+           sFallback:NameResolution.NameResolutionEnv,
            /// Information of exact types found for expressions, that can be to the left of a dot.
            /// Also for exact name resolutions
            /// pos -- line and column
@@ -414,9 +414,9 @@ type TypeCheckInfo
            /// DisplayEnv -- information about printing. For example, should redundant keywords be hidden?
            /// NameResolutionEnv -- naming environment--for example, currently open namespaces.
            /// range -- the starting and ending position      
-           capturedExprTypings: ResizeArray<(pos * TType * DisplayEnv * Nameres.NameResolutionEnv * AccessorDomain * range)>,
-           capturedNameResolutions: ResizeArray<(pos * Item * ItemOccurence * DisplayEnv * Nameres.NameResolutionEnv * AccessorDomain * range)>,
-           capturedResolutionsWithMethodGroups: ResizeArray<(pos * Item * ItemOccurence * DisplayEnv * Nameres.NameResolutionEnv * AccessorDomain * range)>,
+           capturedExprTypings: ResizeArray<(pos * TType * DisplayEnv * NameResolution.NameResolutionEnv * AccessorDomain * range)>,
+           capturedNameResolutions: ResizeArray<(pos * Item * ItemOccurence * DisplayEnv * NameResolution.NameResolutionEnv * AccessorDomain * range)>,
+           capturedResolutionsWithMethodGroups: ResizeArray<(pos * Item * ItemOccurence * DisplayEnv * NameResolution.NameResolutionEnv * AccessorDomain * range)>,
            loadClosure : LoadClosure option,
            syncop:(unit->unit)->unit,
            checkAlive : (unit -> bool),
@@ -436,7 +436,7 @@ type TypeCheckInfo
     let getDataTipTextCache = AgedLookup(recentForgroundTypeCheckLookupSize,areSame=(fun (x,y) -> x = y))
     
     let infoReader = new InfoReader(g,amap)
-    let ncenv = new NameResolver(g,amap,infoReader,Nameres.FakeInstantiationGenerator)
+    let ncenv = new NameResolver(g,amap,infoReader,NameResolution.FakeInstantiationGenerator)
     
     /// Find the most precise naming environment for the given line and column
     let GetBestEnvForPos cursorPos  =
@@ -576,7 +576,7 @@ type TypeCheckInfo
                     // check that type of value is the same or subtype of tcref
                     // yes - allow access to protected members
                     // no - strip ability to access protected members
-                    if Microsoft.FSharp.Compiler.Typrelns.TypeFeasiblySubsumesType 0 g amap m tcref Microsoft.FSharp.Compiler.Typrelns.CanCoerce ty then
+                    if Microsoft.FSharp.Compiler.TypeRelations.TypeFeasiblySubsumesType 0 g amap m tcref Microsoft.FSharp.Compiler.TypeRelations.CanCoerce ty then
                         ad
                     else
                         AccessibleFrom(paths, None)
@@ -670,7 +670,7 @@ type TypeCheckInfo
                                             posEq r.Start rq.Start)
         match bestQual with
         | Some (_,typ,denv,_nenv,ad,m) when isRecdTy denv.g typ ->
-            let items = Nameres.ResolveRecordOrClassFieldsOfType ncenv m ad typ false
+            let items = NameResolution.ResolveRecordOrClassFieldsOfType ncenv m ad typ false
             Some (items, denv, m)
         | _ -> None
 
@@ -731,7 +731,7 @@ type TypeCheckInfo
         Trace.PrintLine("CompilerServicesVerbose", fun () -> sprintf "GetEnvironmentLookupResolutions: line = %d, colAtEndOfNamesAndResidue = %d, plid = %+A, showObsolete = %b\n" line colAtEndOfNamesAndResidue plid showObsolete)
         let cursorPos = Pos.fromVS line colAtEndOfNamesAndResidue
         let (nenv,ad),m = GetBestEnvForPos cursorPos
-        let items = Nameres.ResolvePartialLongIdent ncenv nenv (ConstraintSolver.IsApplicableMethApprox g amap m) m ad plid showObsolete
+        let items = NameResolution.ResolvePartialLongIdent ncenv nenv (ConstraintSolver.IsApplicableMethApprox g amap m) m ad plid showObsolete
         let items = items |> RemoveDuplicateItems g 
         let items = items |> RemoveExplicitlySuppressed g
         let items = items |> FilterItemsForCtors filterCtors 
@@ -743,7 +743,7 @@ type TypeCheckInfo
     let GetClassOrRecordFieldsEnvironmentLookupResolutions(line,colAtEndOfNamesAndResidue, plid, (_residue : string option)) = 
         let cursorPos = Pos.fromVS line colAtEndOfNamesAndResidue
         let (nenv, ad),m = GetBestEnvForPos cursorPos
-        let items = Nameres.ResolvePartialLongIdentToClassOrRecdFields ncenv nenv m ad plid false
+        let items = NameResolution.ResolvePartialLongIdentToClassOrRecdFields ncenv nenv m ad plid false
         let items = items |> RemoveDuplicateItems g 
         let items = items |> RemoveExplicitlySuppressed g
         items, nenv.DisplayEnv,m 
@@ -1261,20 +1261,20 @@ module internal Parser =
                 else exn
             if reportErrors then 
                 let report exn = 
-                    let warn = warn && not (ReportWarningAsError tcConfig.globalWarnLevel tcConfig.specificWarnOff tcConfig.specificWarnOn tcConfig.specificWarnAsError tcConfig.specificWarnAsWarn tcConfig.globalWarnAsError exn)                
-                    if (not warn || ReportWarning tcConfig.globalWarnLevel tcConfig.specificWarnOff tcConfig.specificWarnOn exn) then 
+                    let warn = warn && not (ReportWarningAsError (tcConfig.globalWarnLevel, tcConfig.specificWarnOff, tcConfig.specificWarnOn, tcConfig.specificWarnAsError, tcConfig.specificWarnAsWarn, tcConfig.globalWarnAsError) exn)                
+                    if (not warn || ReportWarning (tcConfig.globalWarnLevel, tcConfig.specificWarnOff, tcConfig.specificWarnOn) exn) then 
                         let oneError trim exn = 
                             // We use the first line of the file as a fallbackRange for reporting unexpected errors.
                             // Not ideal, but it's hard to see what else to do.
                             let fallbackRange = rangeN mainInputFileName 1
                             let ei = ErrorInfo.CreateFromExceptionAndAdjustEof(exn,warn,trim,fallbackRange,fileInfo)
-                            if (ei.FileName=mainInputFileName) || (ei.FileName=Microsoft.FSharp.Compiler.Env.DummyFileNameForRangesWithoutASpecificLocation) then
+                            if (ei.FileName=mainInputFileName) || (ei.FileName=Microsoft.FSharp.Compiler.TcGlobals.DummyFileNameForRangesWithoutASpecificLocation) then
                                 Trace.PrintLine("UntypedParseAux", fun _ -> sprintf "Reporting one error: %s\n" (ei.ToString()))
                                 errorsAndWarningsCollector.Add ei
                                 if not warn then 
                                     errorCount <- errorCount + 1
                       
-                        let mainError,relatedErrors = Build.SplitRelatedErrors exn 
+                        let mainError,relatedErrors = CompileOps.SplitRelatedErrors exn 
                         oneError false mainError
                         List.iter (oneError true) relatedErrors
                 match exn with
@@ -1357,7 +1357,7 @@ module internal Parser =
               Lexhelp.usingLexbufForParsing (lexbuf, mainInputFileName) (fun lexbuf -> 
                   try 
                     let skip = true
-                    let tokenizer = Lexfilter.LexFilter (lightSyntaxStatus, tcConfig.compilingFslib, Lexer.token lexargs skip, lexbuf)
+                    let tokenizer = LexFilter.LexFilter (lightSyntaxStatus, tcConfig.compilingFslib, Lexer.token lexargs skip, lexbuf)
                     let lexfun = tokenizer.Lexer
                     if matchBracesOnly then 
                         // Quick bracket matching parse  
@@ -1392,7 +1392,7 @@ module internal Parser =
                             tcConfig.target.IsExe && 
                             projectSourceFiles.Length >= 1 && 
                             System.String.Compare(List.last projectSourceFiles,mainInputFileName,StringComparison.CurrentCultureIgnoreCase)=0
-                        let isLastCompiland = isLastCompiland || Build.IsScript(mainInputFileName)  
+                        let isLastCompiland = isLastCompiland || CompileOps.IsScript(mainInputFileName)  
 
                         let parseResult = ParseInput(lexfun,errHandler.ErrorLogger,lexbuf,None,mainInputFileName,isLastCompiland)
                         Some parseResult
@@ -1422,7 +1422,7 @@ module internal Parser =
                                             member __.Equals((p1,i1),(p2,i2)) = posEq p1 p2 && i1 =  i2 } )
         let capturedMethodGroupResolutions = new ResizeArray<_>(100)
         let allowedRange (m:range) = not m.IsSynthetic
-        interface Nameres.ITypecheckResultsSink with
+        interface NameResolution.ITypecheckResultsSink with
             member sink.NotifyEnvWithScope(m,nenv,ad) = 
                 if allowedRange m then 
                     capturedEnvs.Add((m,nenv,ad)) 
@@ -1516,7 +1516,7 @@ module internal Parser =
                 loadClosure.RootWarnings |> List.iter warnSink
                 
 
-                let fileOfBackgroundError err = (match RangeOfError (fst err) with Some m-> m.FileName | None -> null)
+                let fileOfBackgroundError err = (match GetRangeOfError (fst err) with Some m-> m.FileName | None -> null)
                 let sameFile file hashLoadInFile = 
                     (0 = String.Compare(fst hashLoadInFile, file, StringComparison.OrdinalIgnoreCase))
 
@@ -1577,7 +1577,7 @@ module internal Parser =
                     let checkForErrors() = (parseHadErrors || errHandler.ErrorCount > 0)
                     // Typecheck is potentially a long running operation. We chop it up here with an Eventually continuation and, at each slice, give a chance
                     // for the client to claim the result as obsolete and have the typecheck abort.
-                    let computation = TypecheckSingleInputAndFinishEventually(checkForErrors,tcConfig, tcImports, tcGlobals, None, TcResultsSink.WithSink sink, tcState, parsedMainInput)
+                    let computation = TypeCheckSingleInputAndFinishEventually(checkForErrors,tcConfig, tcImports, tcGlobals, None, TcResultsSink.WithSink sink, tcState, parsedMainInput)
                     match computation |> Eventually.forceWhile (fun () -> not (isResultObsolete())) with
                     | Some((tcEnvAtEnd,_,_),_) -> Some tcEnvAtEnd
                     | None -> None // Means 'aborted'
@@ -1609,7 +1609,7 @@ module internal Parser =
         reraise()
 
 type internal UnresolvedReferencesSet = 
-    val private set : System.Collections.Generic.HashSet
+    val private set : System.Collections.Generic.HashSet
     new(unresolved) = {set = System.Collections.Generic.HashSet(unresolved, HashIdentity.Structural)}
 
     override this.Equals(o) = 
@@ -2215,7 +2215,7 @@ module internal PrettyNaming =
 #if DEBUG
 
 namespace Internal.Utilities.Diagnostic
-open Microsoft.FSharp.Compiler.Env
+open Microsoft.FSharp.Compiler.TcGlobals
 open Microsoft.FSharp.Compiler.Tastops 
 open Microsoft.FSharp.Compiler.Infos
 open Microsoft.FSharp.Compiler
diff --git a/src/fsharp/vs/service.fsi b/src/fsharp/vs/service.fsi
index f678689cdc68dfdf50a4d8632468562443c08fde..acf32204bd6e1d915d467ba9f6f3dca41d080e90 100644
--- a/src/fsharp/vs/service.fsi
+++ b/src/fsharp/vs/service.fsi
@@ -215,7 +215,7 @@ type internal InteractiveChecker =
 #if FSI_SERVER_INTELLISENSE
 // These functions determine all declarations, called by fsi.fs for fsi-server requests.
 module internal FsiIntelisense =
-    val getDeclarations : Build.TcConfig * Env.TcGlobals * Build.TcImports * Build.TcState -> string -> string[] -> (string * string * string * int)[]
+    val getDeclarations : Build.TcConfig * TcGlobals * Build.TcImports * Build.TcState -> string -> string[] -> (string * string * string * int)[]
 #endif
 
 module internal PrettyNaming =
diff --git a/src/ilx/pubclo.fs b/src/ilx/EraseClosures.fs
similarity index 99%
rename from src/ilx/pubclo.fs
rename to src/ilx/EraseClosures.fs
index d94eacb3868a500e06ea3ade2ad8887bdd71b099..fcb1ef5673159dff446ed4e7f4dc29efa8531587 100644
--- a/src/ilx/pubclo.fs
+++ b/src/ilx/EraseClosures.fs
@@ -1,6 +1,6 @@
 // Copyright (c) Microsoft Open Technologies, Inc.  All Rights Reserved.  Licensed under the Apache License, Version 2.0.  See License.txt in the project root for license information.
 
-module internal Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.EraseIlxFuncs
+module internal Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.EraseClosures
 
 open Internal.Utilities
 
diff --git a/src/ilx/pubclo.fsi b/src/ilx/EraseClosures.fsi
similarity index 97%
rename from src/ilx/pubclo.fsi
rename to src/ilx/EraseClosures.fsi
index 9c0fa3850c80a70de8c890ed8ff1f1be3d3bff2e..f112953846c4b65af04a8673f6afd2fbefabb7f6 100644
--- a/src/ilx/pubclo.fsi
+++ b/src/ilx/EraseClosures.fsi
@@ -1,7 +1,7 @@
 // Copyright (c) Microsoft Open Technologies, Inc.  All Rights Reserved.  Licensed under the Apache License, Version 2.0.  See License.txt in the project root for license information.
 
 /// Compiler use only.  Erase closures
-module internal Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.EraseIlxFuncs
+module internal Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.EraseClosures
 
 open Microsoft.FSharp.Compiler.AbstractIL
 open Microsoft.FSharp.Compiler.AbstractIL.IL 
diff --git a/src/ilx/cu_erase.fs b/src/ilx/EraseUnions.fs
similarity index 99%
rename from src/ilx/cu_erase.fs
rename to src/ilx/EraseUnions.fs
index 1a2be51f2ce26da74a4b04f988ea6af9e879807a..831dbf92a7c71b63e7835ce41388a96c11eb6f09 100644
--- a/src/ilx/cu_erase.fs
+++ b/src/ilx/EraseUnions.fs
@@ -5,7 +5,7 @@
 // -------------------------------------------------------------------- 
 
 
-module internal Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.EraseIlxUnions
+module internal Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.EraseUnions
 
 open Internal.Utilities
 open Microsoft.FSharp.Compiler.AbstractIL 
diff --git a/src/ilx/cu_erase.fsi b/src/ilx/EraseUnions.fsi
similarity index 97%
rename from src/ilx/cu_erase.fsi
rename to src/ilx/EraseUnions.fsi
index ef7c3d0a88c5ac8bef1b3517ecc661c98e11f345..4889c7b25760601158691f194e043eabffbacc1c 100644
--- a/src/ilx/cu_erase.fsi
+++ b/src/ilx/EraseUnions.fsi
@@ -4,7 +4,7 @@
 // Compiler use only.  Erase discriminated unions.
 // -------------------------------------------------------------------- 
 
-module internal Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.EraseIlxUnions
+module internal Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.EraseUnions
 
 open Microsoft.FSharp.Compiler.AbstractIL.IL
 open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX.Types
diff --git a/src/utils/resizearray.fs b/src/utils/ResizeArray.fs
similarity index 100%
rename from src/utils/resizearray.fs
rename to src/utils/ResizeArray.fs
diff --git a/src/utils/resizearray.fsi b/src/utils/ResizeArray.fsi
similarity index 100%
rename from src/utils/resizearray.fsi
rename to src/utils/ResizeArray.fsi
diff --git a/src/utils/sformat.fs b/src/utils/sformat.fs
index e8dc0a37c2c3b01868116cfc52b59423688e88f9..35e25169b0469f827d074b3c14f5a14c384ac017 100644
--- a/src/utils/sformat.fs
+++ b/src/utils/sformat.fs
@@ -145,12 +145,6 @@ namespace Microsoft.FSharp.Text.StructuredFormat
 
         let aboveL  l r = mkNode l r (Broken 0)
 
-        let joinN i l r = mkNode l r (Breakable i)                                      
-        let join  = joinN 0
-        let join1 = joinN 1
-        let join2 = joinN 2
-        let join3 = joinN 3
-
         let tagAttrL tag attrs l = Attr(tag,attrs,l)
 
         let apply2 f l r = if isEmptyL l then r else
@@ -168,9 +162,9 @@ namespace Microsoft.FSharp.Text.StructuredFormat
             | [x]   -> x
             | x::xs ->
                 let rec process' prefixL = function
-                    []    -> prefixL
+                  | []    -> prefixL
                   | y::ys -> process' ((tagger prefixL) ++ y) ys
-                in  process' x xs
+                process' x xs
             
         let commaListL x = tagListL (fun prefixL -> prefixL ^^ rightL ",") x
         let semiListL x  = tagListL (fun prefixL -> prefixL ^^ rightL ";") x
@@ -184,7 +178,7 @@ namespace Microsoft.FSharp.Text.StructuredFormat
           | x::ys -> List.fold (fun pre y -> pre @@ y) x ys
 
         let optionL xL = function
-            None   -> wordL "None"
+          | None   -> wordL "None"
           | Some x -> wordL "Some" -- (xL x)
 
         let listL xL xs = leftL "[" ^^ sepListL (sepL ";") (List.map xL xs) ^^ rightL "]"
diff --git a/tests/fsharpqa/testenv/src/FSharp.Compiler.Hosted/Compiler.fs b/tests/fsharpqa/testenv/src/FSharp.Compiler.Hosted/Compiler.fs
index 9cf04457823e06f0fb25724cc24ee5bf08a2cbc5..0aa7ac3bb427d3d3b32aa2039b5ef2dffced616f 100644
--- a/tests/fsharpqa/testenv/src/FSharp.Compiler.Hosted/Compiler.fs
+++ b/tests/fsharpqa/testenv/src/FSharp.Compiler.Hosted/Compiler.fs
@@ -50,9 +50,9 @@ type FscCompiler() =
         }
 
     /// converts short and long issue types to the same CompilationIssue reprsentation
-    let convert (issue : Microsoft.FSharp.Compiler.Build.ErrorOrWarning) : CompilationIssue = 
+    let convert issue : CompilationIssue = 
         match issue with
-        | Microsoft.FSharp.Compiler.Build.ErrorOrWarning.Short(isError, text) -> 
+        | Microsoft.FSharp.Compiler.CompileOps.ErrorOrWarning.Short(isError, text) -> 
             {
                 Location = emptyLocation
                 Code = ""
@@ -61,7 +61,7 @@ type FscCompiler() =
                 Text = text
                 Type = if isError then CompilationIssueType.Error else CompilationIssueType.Warning
             }
-        | Microsoft.FSharp.Compiler.Build.ErrorOrWarning.Long(isError, details) ->
+        | Microsoft.FSharp.Compiler.CompileOps.ErrorOrWarning.Long(isError, details) ->
             let loc, file = 
                 match details.Location with
                 | Some l when not l.IsEmpty -> 
diff --git a/vsintegration/src/unittests/Tests.Watson.fs b/vsintegration/src/unittests/Tests.Watson.fs
index 3f202302915d35a7c3b3ce9972e524cf1dda8247..0f2775ecdf1980f1cd48e0c2c0f8890bfb5f0b57 100644
--- a/vsintegration/src/unittests/Tests.Watson.fs
+++ b/vsintegration/src/unittests/Tests.Watson.fs
@@ -27,7 +27,7 @@ type Check =
         try 
             try
 #if DEBUG
-                Microsoft.FSharp.Compiler.Build.FullCompiler.showAssertForUnexpectedException := false
+                Microsoft.FSharp.Compiler.CompileOps.FullCompiler.showAssertForUnexpectedException := false
 #endif
                 if (File.Exists("watson-test.fs")) then
                     File.Delete("watson-test.fs")
@@ -37,13 +37,13 @@ type Check =
             with 
             | :? 'TException as e -> 
                 let msg = e.ToString();
-                if msg.Contains("ReportTime") || msg.Contains("TypecheckOneInput") then ()
+                if msg.Contains("ReportTime") || msg.Contains("TypeCheckOneInput") then ()
                 else
                     printfn "%s" msg
                     Assert.Fail("The correct callstack was not reported to watson.")
         finally               
 #if DEBUG
-            Microsoft.FSharp.Compiler.Build.FullCompiler.showAssertForUnexpectedException := true
+            Microsoft.FSharp.Compiler.CompileOps.FullCompiler.showAssertForUnexpectedException := true 
 #endif
         File.Delete("watson-test.fs")
 
diff --git a/vsintegration/src/vs/FsPkgs/FSharp.Project/FS/Project.fs b/vsintegration/src/vs/FsPkgs/FSharp.Project/FS/Project.fs
index 2844cc40d7cce13d6d7cfe141891fee51b59a5c1..64e504cd88af394c8c1d0c86b0a8981545b9533d 100644
--- a/vsintegration/src/vs/FsPkgs/FSharp.Project/FS/Project.fs
+++ b/vsintegration/src/vs/FsPkgs/FSharp.Project/FS/Project.fs
@@ -1757,7 +1757,7 @@ See also ...\SetupAuthoring\FSharp\Registry\FSProjSys_Registration.wxs, e.g.
                                     TypeProviderSecurityGlobals.invalidationCallback()  
                                 let argv = Array.append flags sources  // flags + sources = entire command line
                                 let defaultFSharpBinariesDir = Internal.Utilities.FSharpEnvironment.BinFolderOfDefaultFSharpCompiler.Value
-                                Microsoft.FSharp.Compiler.Driver.runFromCommandLineToImportingAssemblies(dialog, argv, defaultFSharpBinariesDir, x.ProjectFolder, 
+                                Microsoft.FSharp.Compiler.Driver.ProcessCommandLineArgsAndImportAssemblies(dialog, argv, defaultFSharpBinariesDir, x.ProjectFolder, 
                                             { new Microsoft.FSharp.Compiler.ErrorLogger.Exiter with 
                                                 member x.Exit(n) = 
                                                     match n with