Merge pull request #437 from rojepp/integrate_2015_10_13

dsyme · dsyme · commit bdd19ea28002 · 2015-10-13T21:00:03.000+01:00
Integrate 2015-10-13
diff --git a/src/fsharp/CompileOptions.fs b/src/fsharp/CompileOptions.fs
@@ -1137,17 +1137,17 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM
     let optEnv0 = optEnv
     let (TAssembly(implFiles)) = tassembly
     ReportTime tcConfig ("Optimizations");
-    let results,(optEnvFirstLoop,_,_) = 
-        ((optEnv0,optEnv0,optEnv0),implFiles) ||> List.mapFold (fun (optEnvFirstLoop,optEnvExtraLoop,optEnvFinalSimplify) implFile -> 
+    let results,(optEnvFirstLoop,_,_,_) = 
+        ((optEnv0,optEnv0,optEnv0,SignatureHidingInfo.Empty),implFiles) ||> List.mapFold (fun (optEnvFirstLoop,optEnvExtraLoop,optEnvFinalSimplify,hidden) implFile -> 
 
             // Only do abstract_big_targets on the first pass!  Only do it when TLR is on!  
             let optSettings = tcConfig.optSettings 
             let optSettings = { optSettings with abstractBigTargets = tcConfig.doTLR }
             let optSettings = { optSettings with reportingPhase = true }
             
             //ReportTime tcConfig ("Initial simplify");
-            let optEnvFirstLoop,implFile,implFileOptData = 
-                Optimizer.OptimizeImplFile(optSettings,ccu,tcGlobals,tcVal, importMap,optEnvFirstLoop,isIncrementalFragment,tcConfig.emitTailcalls,implFile)
+            let optEnvFirstLoop,implFile,implFileOptData,hidden = 
+                Optimizer.OptimizeImplFile(optSettings,ccu,tcGlobals,tcVal, importMap,optEnvFirstLoop,isIncrementalFragment,tcConfig.emitTailcalls,hidden,implFile)
 
             let implFile = AutoBox.TransformImplFile tcGlobals importMap implFile 
                             
@@ -1161,7 +1161,7 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM
             let implFile,optEnvExtraLoop = 
                 if tcConfig.extraOptimizationIterations > 0 then 
                     //ReportTime tcConfig ("Extra simplification loop");
-                    let optEnvExtraLoop,implFile, _ = Optimizer.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,hidden,implFile)
                     //PrintWholeAssemblyImplementation tcConfig outfile (sprintf "extra-loop-%d" n) implFile;
                     implFile,optEnvExtraLoop
                 else
@@ -1186,12 +1186,12 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM
             let implFile,optEnvFinalSimplify =
                 if tcConfig.doFinalSimplify then 
                     //ReportTime tcConfig ("Final simplify pass");
-                    let optEnvFinalSimplify,implFile, _ = Optimizer.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,hidden,implFile)
                     //PrintWholeAssemblyImplementation tcConfig outfile "post-rec-opt" implFile;
                     implFile,optEnvFinalSimplify 
                 else 
                     implFile,optEnvFinalSimplify 
-            (implFile,implFileOptData),(optEnvFirstLoop,optEnvExtraLoop,optEnvFinalSimplify))
+            (implFile,implFileOptData),(optEnvFirstLoop,optEnvExtraLoop,optEnvFinalSimplify,hidden))
 
     let implFiles,implFileOptDatas = List.unzip results
     let assemblyOptData = Optimizer.UnionOptimizationInfos implFileOptDatas
diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt
@@ -1344,3 +1344,4 @@ estApplyStaticArgumentsForMethodNotImplemented,"A type provider implemented GetS
 3187,checkNotSufficientlyGenericBecauseOfScope,"Type inference caused the type variable %s to escape its scope. Consider adding an explicit type parameter declaration or adjusting your code to be less generic."
 3188,checkNotSufficientlyGenericBecauseOfScopeAnon,"Type inference caused an inference type variable to escape its scope. Consider adding type annotations to make your code less generic."
 3189,checkRaiseFamilyFunctionArgumentCount,"Redundant arguments are being ignored in function '%s'. Expected %d but got %d arguments."
+3190,checkLowercaseLiteralBindingInPattern,"Lowercase literal '%s' is being shadowed by a new pattern with the same name. Only uppercase and module-prefixed literals can be used as named patterns."
diff --git a/src/fsharp/LexFilter.fs b/src/fsharp/LexFilter.fs
@@ -565,7 +565,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
         let tokenLexbufState = getLexbufState()
         savedLexbufState <- tokenLexbufState
         haveLexbufState <- true
-        TokenTup(token, tokenLexbufState, PositionTuple(lastTokenStart, lastTokenEnd))
+        TokenTup(token,tokenLexbufState,PositionTuple(lastTokenStart,lastTokenEnd))
 
     //----------------------------------------------------------------------------
     // Fetch a raw token, either from the old lexer or from our delayedStack
@@ -635,7 +635,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
     let pushCtxt tokenTup (newCtxt:Context) =
         let rec unindentationLimit strict stack = 
             match newCtxt,stack with 
-            | _, [] -> PositionWithColumn (newCtxt.StartPos, -1) 
+            | _, [] -> PositionWithColumn(newCtxt.StartPos, -1) 
 
             // ignore Vanilla because a SeqBlock is always coming 
             | _, (CtxtVanilla _ :: rest) -> unindentationLimit strict rest
@@ -647,8 +647,8 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
             // '(match' limited by minimum of two  
             | _,(((CtxtMatch _) as ctxt1) :: CtxtSeqBlock _ :: (CtxtParen ((BEGIN | LPAREN),_) as ctxt2) :: _rest)
                       -> if ctxt1.StartCol <= ctxt2.StartCol 
-                         then PositionWithColumn (ctxt1.StartPos,ctxt1.StartCol) 
-                         else PositionWithColumn (ctxt2.StartPos,ctxt2.StartCol) 
+                         then PositionWithColumn(ctxt1.StartPos,ctxt1.StartCol) 
+                         else PositionWithColumn(ctxt2.StartPos,ctxt2.StartCol) 
 
              // 'let ... = function' limited by 'let', precisely  
              // This covers the common form 
@@ -657,15 +657,15 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
              //     | Case1 -> ...       
              //     | Case2 -> ...       
             | (CtxtMatchClauses _), (CtxtFunction _ :: CtxtSeqBlock _ :: (CtxtLetDecl  _ as limitCtxt) :: _rest)
-                      -> PositionWithColumn (limitCtxt.StartPos,limitCtxt.StartCol)
+                      -> PositionWithColumn(limitCtxt.StartPos,limitCtxt.StartCol)
 
             // Otherwise 'function ...' places no limit until we hit a CtxtLetDecl etc...  (Recursive) 
             | (CtxtMatchClauses _), (CtxtFunction _ :: rest)
                       -> unindentationLimit false rest
 
             // 'try ... with'  limited by 'try'  
             | _,(CtxtMatchClauses _ :: (CtxtTry _ as limitCtxt) :: _rest)
-                      -> PositionWithColumn (limitCtxt.StartPos,limitCtxt.StartCol)
+                      -> PositionWithColumn(limitCtxt.StartPos,limitCtxt.StartCol)
 
             // 'fun ->' places no limit until we hit a CtxtLetDecl etc...  (Recursive) 
             | _,(CtxtFun _ :: rest)
@@ -684,7 +684,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
             // This is a serious thing to allow, but is required since there is no "return" in this language.
             // Without it there is no way of escaping special cases in large bits of code without indenting the main case.
             | CtxtSeqBlock _, (CtxtElse _  :: (CtxtIf _ as limitCtxt) :: _rest) 
-                      -> PositionWithColumn (limitCtxt.StartPos,limitCtxt.StartCol)
+                      -> PositionWithColumn(limitCtxt.StartPos,limitCtxt.StartCol)
 
             // Permitted inner-construct precise block alighnment: 
             //           interface ...
@@ -695,7 +695,7 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
             //           with ... 
             //           end 
             | CtxtWithAsAugment _,((CtxtInterfaceHead _ | CtxtMemberHead _ | CtxtException _ | CtxtTypeDefns _) as limitCtxt  :: _rest)
-                      -> PositionWithColumn (limitCtxt.StartPos,limitCtxt.StartCol) 
+                      -> PositionWithColumn(limitCtxt.StartPos,limitCtxt.StartCol) 
 
             // Permit unindentation via parentheses (or begin/end) following a 'then', 'else' or 'do':
             //        if nr > 0 then (  
@@ -766,12 +766,12 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
             // 'type C = interface ... '       limited by 'type' 
             // 'type C = struct ... '       limited by 'type' 
             | _,(CtxtParen ((CLASS | STRUCT | INTERFACE),_) :: CtxtSeqBlock _ :: (CtxtTypeDefns _ as limitCtxt) ::  _)
-                      -> PositionWithColumn (limitCtxt.StartPos,limitCtxt.StartCol + 1) 
+                      -> PositionWithColumn(limitCtxt.StartPos,limitCtxt.StartCol + 1) 
 
             // REVIEW: document these 
             | _,(CtxtSeqBlock _ :: CtxtParen((BEGIN | LPAREN | LBRACK | LBRACK_BAR),_) :: CtxtVanilla _ :: (CtxtSeqBlock _ as limitCtxt) :: _)
             | (CtxtSeqBlock _),(CtxtParen ((BEGIN | LPAREN | LBRACE | LBRACK | LBRACK_BAR)      ,_) :: CtxtSeqBlock _ :: ((CtxtTypeDefns _ | CtxtLetDecl _ | CtxtMemberBody _ | CtxtWithAsLet _) as limitCtxt) ::  _)
-                      -> PositionWithColumn (limitCtxt.StartPos,limitCtxt.StartCol + 1) 
+                      -> PositionWithColumn(limitCtxt.StartPos,limitCtxt.StartCol + 1) 
 
             // Permitted inner-construct (e.g. "then" block and "else" block in overall 
             // "if-then-else" block ) block alighnment: 
@@ -780,22 +780,22 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
             //           elif expr  
             //           else expr  
             | (CtxtIf   _ | CtxtElse _ | CtxtThen _), (CtxtIf _ as limitCtxt) :: _rest  
-                      -> PositionWithColumn (limitCtxt.StartPos,limitCtxt.StartCol)
+                      -> PositionWithColumn(limitCtxt.StartPos,limitCtxt.StartCol)
             // Permitted inner-construct precise block alighnment: 
             //           while  ... 
             //           do expr
             //           done   
             | (CtxtDo _), ((CtxtFor  _ | CtxtWhile _) as limitCtxt) :: _rest  
-                      -> PositionWithColumn (limitCtxt.StartPos,limitCtxt.StartCol)
+                      -> PositionWithColumn(limitCtxt.StartPos,limitCtxt.StartCol)
 
 
             // These contexts all require indentation by at least one space 
             | _,((CtxtInterfaceHead _ | CtxtNamespaceHead _ | CtxtModuleHead _ | CtxtException _ | CtxtModuleBody (_,false) | CtxtIf _ | CtxtWithAsLet _ | CtxtLetDecl _ | CtxtMemberHead _ | CtxtMemberBody _) as limitCtxt :: _) 
-                      -> PositionWithColumn (limitCtxt.StartPos,limitCtxt.StartCol + 1) 
+                      -> PositionWithColumn(limitCtxt.StartPos,limitCtxt.StartCol + 1) 
 
             // These contexts can have their contents exactly aligning 
             | _,((CtxtParen _ | CtxtFor _ | CtxtWhen _ | CtxtWhile _ | CtxtTypeDefns _ | CtxtMatch _  | CtxtModuleBody (_,true) | CtxtNamespaceBody _ | CtxtTry _ | CtxtMatchClauses _ | CtxtSeqBlock _) as limitCtxt :: _)
-                      -> PositionWithColumn (limitCtxt.StartPos,limitCtxt.StartCol) 
+                      -> PositionWithColumn(limitCtxt.StartPos,limitCtxt.StartCol) 
        
         match newCtxt with 
         // Don't bother to check pushes of Vanilla blocks since we've 
diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs
@@ -615,7 +615,10 @@ let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g:TcGlobals)
         ePatItems = ePatItems
         eIndexedExtensionMembers = eIndexedExtensionMembers 
         eUnindexedExtensionMembers = eUnindexedExtensionMembers }
-    
+
+let TryFindPatternByName name {ePatItems = patternMap} =
+    NameMap.tryFind name patternMap
+
 /// Add a set of type definitions to the name resolution environment 
 let AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap m  root nenv tcrefs = 
     let env = List.fold (AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition g amap m) nenv tcrefs
diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi
@@ -109,6 +109,9 @@ type FullyQualifiedFlag =
 [<RequireQualifiedAccess>]
 type BulkAdd = Yes | No
 
+/// Lookup patterns in name resolution environment
+val internal TryFindPatternByName : string -> NameResolutionEnv -> Item option
+
 /// Add extra items to the environment for Visual Studio, e.g. static members 
 val internal AddFakeNamedValRefToNameEnv : string -> NameResolutionEnv -> ValRef -> NameResolutionEnv
 
diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs
@@ -3193,7 +3193,7 @@ and OptimizeModuleDefs cenv (env,bindInfosColl) defs =
     let defs,minfos = List.unzip defs
     (defs,UnionOptimizationInfos minfos),(env,bindInfosColl)
    
-and OptimizeImplFileInternal cenv env isIncrementalFragment (TImplFile(qname, pragmas, (ModuleOrNamespaceExprWithSig(mty,_,_) as mexpr), hasExplicitEntryPoint,isScript)) =
+and OptimizeImplFileInternal cenv env isIncrementalFragment hidden (TImplFile(qname, pragmas, (ModuleOrNamespaceExprWithSig(mty,_,_) as mexpr), hasExplicitEntryPoint,isScript)) =
     let env,mexpr',minfo  = 
         match mexpr with 
         // FSI: FSI compiles everything as if you're typing incrementally into one module 
@@ -3209,16 +3209,16 @@ and OptimizeImplFileInternal cenv env isIncrementalFragment (TImplFile(qname, pr
             let env = { env with localExternalVals=env.localExternalVals.MarkAsCollapsible() } // take the chance to flatten to a dictionary
             env, mexpr', minfo
 
-    let hidden = ComputeHidingInfoAtAssemblyBoundary mty
+    let hidden = ComputeHidingInfoAtAssemblyBoundary mty hidden
 
     let minfo = AbstractLazyModulInfoByHiding true hidden minfo
-    env, TImplFile(qname,pragmas,mexpr',hasExplicitEntryPoint,isScript), minfo
+    env, TImplFile(qname,pragmas,mexpr',hasExplicitEntryPoint,isScript), minfo, hidden
 
 //-------------------------------------------------------------------------
 // Entry point
 //------------------------------------------------------------------------- 
 
-let OptimizeImplFile(settings,ccu,tcGlobals,tcVal, importMap,optEnv,isIncrementalFragment,emitTailcalls,mimpls) =
+let OptimizeImplFile(settings,ccu,tcGlobals,tcVal, importMap,optEnv,isIncrementalFragment,emitTailcalls,hidden,mimpls) =
     let cenv = 
         { settings=settings;
           scope=ccu; 
@@ -3229,7 +3229,7 @@ let OptimizeImplFile(settings,ccu,tcGlobals,tcVal, importMap,optEnv,isIncrementa
           localInternalVals=new System.Collections.Generic.Dictionary<Stamp,ValInfo>(10000);
           emitTailcalls=emitTailcalls;
           casApplied=new Dictionary<Stamp,bool>() }
-    OptimizeImplFileInternal cenv optEnv isIncrementalFragment mimpls 
+    OptimizeImplFileInternal cenv optEnv isIncrementalFragment hidden mimpls  
 
 
 //-------------------------------------------------------------------------
diff --git a/src/fsharp/Optimizer.fsi b/src/fsharp/Optimizer.fsi
@@ -5,6 +5,7 @@ module internal Microsoft.FSharp.Compiler.Optimizer
 open Internal.Utilities
 open Microsoft.FSharp.Compiler 
 open Microsoft.FSharp.Compiler.Tast
+open Microsoft.FSharp.Compiler.Tastops
 open Microsoft.FSharp.Compiler.TcGlobals 
 open Microsoft.FSharp.Compiler.AbstractIL 
 open Microsoft.FSharp.Compiler.AbstractIL.Internal 
@@ -43,7 +44,7 @@ type IncrementalOptimizationEnv =
 val internal BindCcu : CcuThunk -> CcuOptimizationInfo -> IncrementalOptimizationEnv -> TcGlobals -> IncrementalOptimizationEnv
 
 /// 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
+val internal OptimizeImplFile : OptimizationSettings *  CcuThunk * TcGlobals * ConstraintSolver.TcValF * Import.ImportMap * IncrementalOptimizationEnv * isIncrementalFragment: bool * emitTaicalls: bool * SignatureHidingInfo * TypedImplFile -> IncrementalOptimizationEnv * TypedImplFile * ImplFileOptimizationInfo * SignatureHidingInfo
 
 #if DEBUG
 /// Displaying optimization data
diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs
@@ -82,12 +82,14 @@ let emptyTyparInst = ([] : TyparInst)
 type Remap =
     { tpinst : TyparInst;
       valRemap: ValRemap;
-      tyconRefRemap : TyconRefRemap }
+      tyconRefRemap : TyconRefRemap;
+      removeTraitSolutions: bool }
 
 let emptyRemap = 
     { tpinst        = emptyTyparInst; 
       tyconRefRemap = emptyTyconRefRemap;
-      valRemap      = ValMap.Empty }
+      valRemap      = ValMap.Empty;
+      removeTraitSolutions = false }
 
 type Remap with 
     static member Empty = emptyRemap
@@ -228,6 +230,7 @@ and remapTraitAux tyenv (TTrait(typs,nm,mf,argtys,rty,slnCell)) =
     let slnCell = 
         match !slnCell with 
         | None -> None
+        | _ when tyenv.removeTraitSolutions -> None
         | Some sln -> 
             let sln = 
                 match sln with 
@@ -343,7 +346,8 @@ let remapSlotSig remapAttrib tyenv (TSlotSig(nm,typ, ctps,methTypars,paraml, rty
 let mkInstRemap tpinst = 
     { tyconRefRemap = emptyTyconRefRemap; 
       tpinst        = tpinst; 
-      valRemap      = ValMap.Empty }
+      valRemap      = ValMap.Empty;
+      removeTraitSolutions = false }
 
 // entry points for "typar -> TType" instantiation 
 let instType              tpinst x = if List.isEmpty tpinst then x else remapTypeAux  (mkInstRemap tpinst) x
@@ -1264,6 +1268,8 @@ let tryRescopeEntity viewedCcu (entity:Entity) : EntityRef option =
 let tryRescopeVal viewedCcu (entityRemap:Remap) (vspec:Val) : ValRef option = 
     match vspec.PublicPath with 
     | Some (ValPubPath(p,fullLinkageKey)) -> 
+        // The type information in the val linkage doesn't need to keep any information to trait solutions.
+        let entityRemap = { entityRemap with removeTraitSolutions = true }
         let fullLinkageKey = remapValLinkage entityRemap fullLinkageKey
         let vref = 
             // This compensates for the somewhat poor design decision in the F# compiler and metadata where
@@ -3482,7 +3488,8 @@ let addValRemap v v' tmenv =
 let mkRepackageRemapping mrpi = 
     { valRemap = ValMap.OfList (mrpi.mrpiVals |> List.map (fun (vref,x) -> vref.Deref, x));
       tpinst = emptyTyparInst; 
-      tyconRefRemap = TyconRefMap.OfList mrpi.mrpiEntities }
+      tyconRefRemap = TyconRefMap.OfList mrpi.mrpiEntities
+      removeTraitSolutions = false }
 
 //--------------------------------------------------------------------------
 // Compute instances of the above for mty -> mty
@@ -3695,9 +3702,9 @@ let rec accModuleOrNamespaceHidingInfoAtAssemblyBoundary mty acc =
     let acc = QueueList.foldBack accValHidingInfoAtAssemblyBoundary mty.AllValsAndMembers acc
     acc 
 
-let ComputeHidingInfoAtAssemblyBoundary mty = 
+let ComputeHidingInfoAtAssemblyBoundary mty acc = 
 //     dprintf "ComputeRemappingFromInferredSignatureToExplicitSignature,\nmty = %s\nmmsigty=%s\n" (showL(entityTypeL mty)) (showL(entityTypeL msigty)); 
-    accModuleOrNamespaceHidingInfoAtAssemblyBoundary mty SignatureHidingInfo.Empty
+    accModuleOrNamespaceHidingInfoAtAssemblyBoundary mty acc
 
 //--------------------------------------------------------------------------
 // Compute instances of the above for mexpr -> mty
diff --git a/src/fsharp/TastOps.fsi b/src/fsharp/TastOps.fsi
diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs
diff --git a/src/fsharp/TypeRelations.fs b/src/fsharp/TypeRelations.fs
diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs
