Merge pull request #641 from dsyme/integrate-776

Integrate from fsharp\fsharp master

Author: dsyme

.gitignore

@@ -198,3 +198,7 @@ src/fsharp/FSharp.Compiler.Service/FSIstrings.fs
 src/fsharp/FSharp.Compiler.Service/FSIstrings.resx
 Tools/
 Backup/
+tests/fsharp/core/array/dont.run.peverify
+tests/fsharp/core/innerpoly/dont.run.peverify
+tests/fsharp/typecheck/sigs/neg94-pre.dll
+times

src/absil/il.fs

@@ -38,8 +38,6 @@ let runningOnMono =
 
 let _ = if logging then dprintn "* warning: Il.logging is on"
 
-let isNil x = match x with [] -> true | _ -> false
-let nonNil x = match x with [] -> false | _ -> true
 let int_order = LanguagePrimitives.FastGenericComparer<int>
 
 let notlazy v = Lazy.CreateFromValue v
@@ -86,11 +84,7 @@ let memoizeNamespaceRightTable = new ConcurrentDictionary<string,string option *
 
 
 let splitNamespace nm =
-    let mutable res = Unchecked.defaultof<_>
-    let ok = memoizeNamespaceTable.TryGetValue(nm,&res)
-    if ok then res else
-    let x = splitNamespaceAux nm
-    (memoizeNamespaceTable.[nm] <- x; x)
+    memoizeNamespaceTable.GetOrAdd(nm, splitNamespaceAux)
 
 let splitNamespaceMemoized nm = splitNamespace nm
 
@@ -99,12 +93,9 @@ let memoizeNamespaceArrayTable =
     Concurrent.ConcurrentDictionary<string,string[]>()
 
 let splitNamespaceToArray nm =
-    let mutable res = Unchecked.defaultof<_>
-    let ok = memoizeNamespaceArrayTable.TryGetValue(nm,&res)
-    if ok then res else
-    let x = Array.ofList (splitNamespace nm)
-    (memoizeNamespaceArrayTable.[nm] <- x; x)
-
+    memoizeNamespaceArrayTable.GetOrAdd(nm, fun nm -> 
+        let x = Array.ofList (splitNamespace nm)
+        x)
 
 let splitILTypeName (nm:string) = 
     match nm.LastIndexOf '.' with
@@ -157,11 +148,7 @@ let splitTypeNameRightAux nm =
     else None, nm
 
 let splitTypeNameRight nm =
-    let mutable res = Unchecked.defaultof<_>
-    let ok = memoizeNamespaceRightTable.TryGetValue(nm,&res)
-    if ok then res else
-    let x = splitTypeNameRightAux nm
-    (memoizeNamespaceRightTable.[nm] <- x; x)
+    memoizeNamespaceRightTable.GetOrAdd(nm, splitTypeNameRightAux)
 
 // -------------------------------------------------------------------- 
 // Ordered lists with a lookup table
@@ -1987,7 +1974,7 @@ let mkILFieldRef(tref,nm,ty) = { EnclosingTypeRef=tref; Name=nm; Type=ty}
 let mkILFieldSpec (tref,ty) = { FieldRef= tref; EnclosingType=ty }
 
 let mkILFieldSpecInTy (typ:ILType,nm,fty) = 
-  mkILFieldSpec (mkILFieldRef (typ.TypeRef,nm,fty), typ)
+    mkILFieldSpec (mkILFieldRef (typ.TypeRef,nm,fty), typ)
 
 let emptyILCustomAttrs = ILAttributes (fun () -> [| |])
 
@@ -2650,7 +2637,7 @@ let rec rescopeILTypeSpecQuick scoref (tspec:ILTypeSpec) =
     let tref = tspec.TypeRef
     let tinst = tspec.GenericArgs
     let qtref = qrescope_tref scoref tref
-    if ILList.isEmpty tinst && isNone qtref then 
+    if ILList.isEmpty tinst && Option.isNone qtref then 
         None (* avoid reallocation in the common case *)
     else
         match qtref with 
@@ -3692,12 +3679,13 @@ type ILGlobals with
         mkILCustomAttribute this (mkSystemDiagnosticsDebuggableTypeRef this, [this.typ_Bool; this.typ_Bool], [ILAttribElem.Bool false; ILAttribElem.Bool jitOptimizerDisabled], [])
 
 
-    member this.mkDebuggableAttributeV2(ignoreSymbolStoreSequencePoints, jitOptimizerDisabled, enableEnC) =
+    member this.mkDebuggableAttributeV2(jitTracking, ignoreSymbolStoreSequencePoints, jitOptimizerDisabled, enableEnC) =
         let tref = mkSystemDiagnosticsDebuggableTypeRef this
         mkILCustomAttribute this 
           (tref,[mkILNonGenericValueTy (tref_DebuggableAttribute_DebuggingModes this)],
            (* See System.Diagnostics.DebuggableAttribute.DebuggingModes *)
-           [ILAttribElem.Int32( (if jitOptimizerDisabled then 256 else 0) |||  
+           [ILAttribElem.Int32( (if jitTracking then 1 else 0) |||
+                                (if jitOptimizerDisabled then 256 else 0) |||  
                                 (if ignoreSymbolStoreSequencePoints then 2 else 0) |||
                                 (if enableEnC then 4 else 0))],[])
 
@@ -4288,7 +4276,7 @@ let rec unscopeILTypeSpecQuick (tspec:ILTypeSpec) =
     let tref = tspec.TypeRef
     let tinst = tspec.GenericArgs
     let qtref = qunscope_tref tref
-    if ILList.isEmpty tinst && isNone qtref then 
+    if ILList.isEmpty tinst && Option.isNone qtref then 
         None (* avoid reallocation in the common case *)
     else
         match qtref with 
@@ -4329,7 +4317,7 @@ let resolveILMethodRefWithRescope r td (mref:ILMethodRef) =
     let nargs = args.Length
     let nm = mref.Name
     let possibles = td.Methods.FindByNameAndArity (nm,nargs)
-    if isNil possibles then failwith ("no method named "+nm+" found in type "+td.Name);
+    if List.isEmpty possibles then failwith ("no method named "+nm+" found in type "+td.Name);
     let argTypes = mref.ArgTypes |> List.map r
     let retType : ILType = r mref.ReturnType
     match 

src/absil/il.fsi

@@ -1624,7 +1624,7 @@ type ILGlobals =
       with
       member mkDebuggableAttribute: bool (* disable JIT optimizations *) -> ILAttribute
       /// Some commonly used custom attibutes
-      member mkDebuggableAttributeV2               : bool (* ignoreSymbolStoreSequencePoints *) * bool (* disable JIT optimizations *) * bool (* enable EnC *) -> ILAttribute
+      member mkDebuggableAttributeV2               : bool (* jitTracking *) * bool (* ignoreSymbolStoreSequencePoints *) * bool (* disable JIT optimizations *) * bool (* enable EnC *) -> ILAttribute
       member mkCompilerGeneratedAttribute          : unit -> ILAttribute
       member mkDebuggerNonUserCodeAttribute        : unit -> ILAttribute
       member mkDebuggerStepThroughAttribute        : unit -> ILAttribute

src/absil/illib.fs

@@ -20,13 +20,8 @@ let (>>>&) (x:int32) (n:int32) = int32 (uint32 x >>> n)
 
 let notlazy v = Lazy<_>.CreateFromValue v
 
-let isSome x = match x with None -> false | _ -> true
-let isNone x = match x with None -> true | _ -> false
-let isNil x = match x with [] -> true | _ -> false
-let nonNil x = match x with [] -> false | _ -> true
-let isNull (x : 'T) = match (x :> obj) with null -> true | _ -> false
-let isNonNull (x : 'T) = match (x :> obj) with null -> false | _ -> true
-let nonNull msg x = if isNonNull x then x else failwith ("null: " ^ msg) 
+let inline isNonNull x = not (isNull x)
+let inline nonNull msg x = if isNull x then failwith ("null: " ^ msg) else x
 let (===) x y = LanguagePrimitives.PhysicalEquality x y
 
 //---------------------------------------------------------------------
@@ -438,7 +433,7 @@ module String =
         else
             None
 
-    let hasPrefix s t = isSome (tryDropPrefix s t)
+    let hasPrefix s t = Option.isSome (tryDropPrefix s t)
     let dropPrefix s t = match (tryDropPrefix s t) with Some(res) -> res | None -> failwith "dropPrefix"
 
     let dropSuffix s t = match (tryDropSuffix s t) with Some(res) -> res | None -> failwith "dropSuffix"
@@ -716,8 +711,8 @@ type LazyWithContext<'T,'ctxt> =
           funcOrException = box f;
           findOriginalException = findOriginalException }
     static member NotLazy(x:'T) : LazyWithContext<'T,'ctxt> = 
-        { value = x;
-          funcOrException = null;
+        { value = x
+          funcOrException = null
           findOriginalException = id }
     member x.IsDelayed = (match x.funcOrException with null -> false | :? LazyWithContextFailure -> false | _ -> true)
     member x.IsForced = (match x.funcOrException with null -> true | _ -> false)
@@ -785,6 +780,7 @@ module NameMap =
     let exists f m = Map.foldBack (fun x y sofar -> sofar || f x y) m false
     let ofKeyedList f l = List.foldBack (fun x acc -> Map.add (f x) x acc) l Map.empty
     let ofList l : NameMap<'T> = Map.ofList l
+    let ofSeq l : NameMap<'T> = Map.ofSeq l
     let ofFlatList (l:FlatList<_>) : NameMap<'T> = FlatList.toMap l
     let toList (l: NameMap<'T>) = Map.toList l
     let layer (m1 : NameMap<'T>) m2 = Map.foldBack Map.add m1 m2

src/absil/ilprint.fs

@@ -285,7 +285,7 @@ and goutput_gparam env os (gf: ILGenericParameterDef) =
   output_parens (output_seq "," (goutput_typ env)) os gf.Constraints
 
 and goutput_gparams env os b = 
-  if nonNil b then 
+  if not (List.isEmpty b) then 
      output_string os "<"; output_seq "," (goutput_gparam env) os b;  output_string os ">"; () 
 
 and output_bcc os bcc =

src/absil/ilread.fs

@@ -153,9 +153,6 @@ module MemoryMapping =
     let OPEN_EXISTING   = 0x0003
     let OPEN_ALWAYS  = 0x0004
 
-let derefByte (p:nativeint) = 
-    NativePtr.read (NativePtr.ofNativeInt<byte> p) 
-
 type MemoryMappedFile(hMap: MemoryMapping.HANDLE, start:nativeint) =
     inherit BinaryFile()
 
@@ -182,37 +179,38 @@ type MemoryMappedFile(hMap: MemoryMapping.HANDLE, start:nativeint) =
         start + nativeint i
 
     override m.ReadByte i = 
-        derefByte (m.Addr i)
+        Marshal.ReadByte(m.Addr i)
 
     override m.ReadBytes i len = 
         let res = Bytes.zeroCreate len
         Marshal.Copy(m.Addr i, res, 0,len)
         res
 
     override m.ReadInt32 i = 
-        NativePtr.read (NativePtr.ofNativeInt<int32> (m.Addr i)) 
+        Marshal.ReadInt32(m.Addr i)
 
     override m.ReadUInt16 i = 
-        NativePtr.read (NativePtr.ofNativeInt<uint16> (m.Addr i)) 
+        uint16(Marshal.ReadInt16(m.Addr i))
 
     member m.Close() = 
         ignore(MemoryMapping.UnmapViewOfFile start)
         ignore(MemoryMapping.CloseHandle hMap)
 
     override m.CountUtf8String i = 
-        let start = m.Addr i  
+        let start = m.Addr i
         let mutable p = start 
-        while derefByte p <> 0uy do
+        while Marshal.ReadByte(p) <> 0uy do
             p <- p + 1n
         int (p - start) 
 
     override m.ReadUTF8String i = 
         let n = m.CountUtf8String i
-#if FX_RESHAPED_REFLECTION
-        System.Text.Encoding.UTF8.GetString(NativePtr.ofNativeInt (m.Addr i), n)
-#else
-        new System.String(NativePtr.ofNativeInt (m.Addr i), 0, n, System.Text.Encoding.UTF8)
-#endif
+        System.Runtime.InteropServices.Marshal.PtrToStringAnsi((m.Addr i), n)
+//#if FX_RESHAPED_REFLECTION
+//        System.Text.Encoding.UTF8.GetString(NativePtr.ofNativeInt (m.Addr i), n)
+//#else
+//        new System.String(NativePtr.ofNativeInt (m.Addr i), 0, n, System.Text.Encoding.UTF8)
+//#endif
 
 
 //---------------------------------------------------------------------
@@ -1486,7 +1484,7 @@ let dataEndPoints ctxtH =
                   let rva = ctxt.resourcesAddr + offset
                   res := ("manifest resource", rva) :: !res
             !res
-        if isNil dataStartPoints then [] 
+        if List.isEmpty dataStartPoints then [] 
         else
           let methodRVAs = 
               let res = ref []
@@ -2184,7 +2182,7 @@ and seekReadMemberRefAsMethodDataUncached ctxtH (MemberRefAsMspecIdx (numtypars,
 
 and seekReadMemberRefAsMethDataNoVarArgs ctxt numtypars idx : MethodData =
    let (VarArgMethodData(enclTyp, cc, nm, argtys,varargs, retty,minst)) =  seekReadMemberRefAsMethodData ctxt numtypars idx
-   if isSome varargs then dprintf "ignoring sentinel and varargs in ILMethodDef token signature"
+   if Option.isSome varargs then dprintf "ignoring sentinel and varargs in ILMethodDef token signature"
    (MethodData(enclTyp, cc, nm, argtys, retty,minst))
 
 and seekReadMethodSpecAsMethodData ctxt numtypars idx =  
@@ -3964,16 +3962,20 @@ let OpenILModuleReader infile opts =
 
 // ++GLOBAL MUTABLE STATE
 let ilModuleReaderCache = 
-    new Internal.Utilities.Collections.AgedLookup<(string * System.DateTime),ILModuleReader>(0, areSame=(fun (x,y) -> x = y))
+    new Internal.Utilities.Collections.AgedLookup<(string * System.DateTime * string * bool),ILModuleReader>(0, areSame=(fun (x,y) -> x = y))
 
 
 let OpenILModuleReaderAfterReadingAllBytes infile opts = 
     // Pseudo-normalize the paths.
     let key,succeeded = 
-        try (FileSystem.GetFullPathShim(infile), FileSystem.GetLastWriteTimeShim(infile)), true
+        try 
+           (FileSystem.GetFullPathShim(infile), 
+            FileSystem.GetLastWriteTimeShim(infile), 
+            opts.ilGlobals.primaryAssemblyName,
+            opts.ilGlobals.noDebugData), true
         with e -> 
             System.Diagnostics.Debug.Assert(false, "Failed to compute key in OpenILModuleReaderAfterReadingAllBytes cache. Falling back to uncached.") 
-            ("",System.DateTime.Now), false
+            ("",System.DateTime.Now,"",false), false
     let cacheResult = 
         if not succeeded then None // Fall back to uncached.
         else if opts.pdbPath.IsSome then None // can't used a cached entry when reading PDBs, since it makes the returned object IDisposable
@@ -3987,7 +3989,7 @@ let OpenILModuleReaderAfterReadingAllBytes infile opts =
             { modul = modul 
               ilAssemblyRefs = ilAssemblyRefs
               dispose = (fun () -> ClosePdbReader pdb) }
-        if isNone pdb && succeeded then 
+        if Option.isNone pdb && succeeded then 
             ilModuleReaderCache.Put(key, ilModuleReader)
         ilModuleReader
 

src/absil/ilreflect.fs

@@ -1493,7 +1493,7 @@ let rec buildMethodPass3 cenv tref modB (typB:TypeBuilder) emEnv (mdef : ILMetho
     | ".cctor" | ".ctor" ->
           let consB = envGetConsB emEnv mref
           // Constructors can not have generic parameters
-          assert isNil mdef.GenericParams
+          assert List.isEmpty mdef.GenericParams
           // Value parameters       
           let defineParameter (i,attr,name) = consB.DefineParameterAndLog(i+1,attr,name)
           mdef.Parameters |> ILList.iteri (emitParameter cenv emEnv defineParameter);