Fix dotnet#44 - Problems using FSI on a project

src/fsharp/build.fs

@@ -5027,17 +5027,26 @@ let TypecheckOneInputEventually
 
                 // Only add it to the environment if it didn't have a signature 
                 let m = qualNameOfFile.Range
+
+                // Add the implementation as to the implementation env
                 let tcImplEnv = Tc.AddLocalRootModuleOrNamespace TcResultsSink.NoSink tcGlobals amap m tcImplEnv implFileSigType
+
+                // Add the implementation as to the signature env (unless it had an explicit signature)
                 let tcSigEnv = 
                     if hadSig then tcState.tcsTcSigEnv 
                     else Tc.AddLocalRootModuleOrNamespace TcResultsSink.NoSink tcGlobals amap m tcState.tcsTcSigEnv implFileSigType
 
-                // Open the prefixPath for fsi.exe 
+                // Open the prefixPath for fsi.exe (tcImplEnv)
                 let tcImplEnv = 
                     match prefixPathOpt with 
-                    | None -> tcImplEnv 
-                    | Some prefixPath -> 
-                        TcOpenDecl tcSink tcGlobals amap m m tcImplEnv prefixPath
+                    | Some prefixPath -> TcOpenDecl tcSink tcGlobals amap m m tcImplEnv prefixPath
+                    | _ -> tcImplEnv 
+
+                // Open the prefixPath for fsi.exe (tcSigEnv)
+                let tcSigEnv = 
+                    match prefixPathOpt with 
+                    | Some prefixPath when not hadSig -> TcOpenDecl tcSink tcGlobals amap m m tcSigEnv prefixPath
+                    | _ -> tcSigEnv 
 
                 let allImplementedSigModulTyp = combineModuleOrNamespaceTypeList [] m [implFileSigType; allImplementedSigModulTyp]
 
@@ -5050,7 +5059,7 @@ let TypecheckOneInputEventually
                 if verbose then  dprintf "done TypecheckOneInputEventually...\n"
 
                 let topSigsAndImpls = RootSigsAndImpls(rootSigs,rootImpls,allSigModulTyp,allImplementedSigModulTyp)
-                let res = (topAttrs,[implFile], tcEnvAtEnd, tcSigEnv, tcImplEnv,topSigsAndImpls,ccuType)
+                let res = (topAttrs,[implFile], tcEnvAtEnd, tcSigEnv, tcImplEnv, topSigsAndImpls, ccuType)
                 return res }
 
       return (tcEnvAtEnd,topAttrs,mimpls),

src/fsharp/tc.fs

@@ -607,12 +607,20 @@ let BuildRootModuleExpr enclosingNamespacePath cpath mexpr =
         ||> List.foldBack (fun id (cpath, mexpr) -> (parentCompPath cpath, wrapModuleOrNamespaceExprInNamespace id (parentCompPath cpath) mexpr))
         |> snd
 
-let ImplicitlyOpenOwnNamespace tcSink g amap scopem enclosingNamespacePath env = 
+let ImplicitlyOpenOwnNamespace tcSink g amap scopem (enclosingNamespacePath: Ident list) env = 
     if isNil enclosingNamespacePath then 
         env
     else
+        // Skip "FSI_0002" prefixes when determining the path to open implicitly
+        let enclosingNamespacePathToOpen = 
+            match enclosingNamespacePath with 
+            | p::rest when  p.idText.StartsWith(FsiDynamicModulePrefix,System.StringComparison.Ordinal) && 
+                            p.idText.[FsiDynamicModulePrefix.Length..] |> String.forall System.Char.IsDigit &&
+                            rest.Length > 0 -> rest
+            | rest -> rest
+
         let ad = env.eAccessRights
-        match ResolveLongIndentAsModuleOrNamespace amap scopem OpenQualified env.eNameResEnv ad enclosingNamespacePath with 
+        match ResolveLongIndentAsModuleOrNamespace amap scopem OpenQualified env.eNameResEnv ad enclosingNamespacePathToOpen with 
         | Result modrefs -> OpenModulesOrNamespaces tcSink g amap scopem false env (List.map p23 modrefs)
         | Exception _ ->  env
 
@@ -913,8 +921,8 @@ let ComputeLogicalName (id:Ident) memberFlags =
         | (".ctor" | ".cctor") as r ->  errorR(Error(FSComp.SR.tcInvalidMemberNameCtor(),id.idRange)); r
         | r -> r
     | MemberKind.PropertyGetSet ->  error(InternalError(FSComp.SR.tcMemberKindPropertyGetSetNotExpected(),id.idRange))
-    | MemberKind.PropertyGet ->  "get_"^id.idText
-    | MemberKind.PropertySet ->  "set_"^id.idText 
+    | MemberKind.PropertyGet ->  "get_" + id.idText
+    | MemberKind.PropertySet ->  "set_" + id.idText 
 
 /// ValMemberInfoTransient(memberInfo,logicalName,compiledName)
 type ValMemberInfoTransient = ValMemberInfoTransient of ValMemberInfo * string * string 
@@ -945,7 +953,7 @@ let MakeMemberDataAndMangledNameForMemberVal(g,tcref,isExtrinsic,attrs,optImplSl
     let compiledName = 
         if isExtrinsic then 
              let tname = tcref.LogicalName
-             let text = tname^"."^logicalName
+             let text = tname + "." + logicalName
              let text = if memberFlags.MemberKind <> MemberKind.Constructor && memberFlags.MemberKind <> MemberKind.ClassConstructor && not memberFlags.IsInstance then text^".Static" else text
              let text = if memberFlags.IsOverrideOrExplicitImpl then text^".Override" else text
              text
@@ -4040,8 +4048,8 @@ and TcValSpec cenv env declKind newOk containerInfo memFlagsOpt thisTyOpt tpenv
                          thisTy --> (delTy --> cenv.g.unit_ty)
                        else 
                          (delTy --> cenv.g.unit_ty)
-                    yield reallyGenerateOneMember(ident("add_"^id.idText,id.idRange),valSynInfo,ty,memberFlags)
-                    yield reallyGenerateOneMember(ident("remove_"^id.idText,id.idRange),valSynInfo,ty,memberFlags) ]
+                    yield reallyGenerateOneMember(ident("add_" + id.idText,id.idRange),valSynInfo,ty,memberFlags)
+                    yield reallyGenerateOneMember(ident("remove_" + id.idText,id.idRange),valSynInfo,ty,memberFlags) ]
 
 
 
@@ -4628,7 +4636,7 @@ and TcSimplePats cenv optArgsOK  checkCxs ty env (tpenv,names,takenNames:Set<_>)
         // This is a little awkward since it would be nice if this was
         // uniform with the process where we give names to other (more complex)
         // patterns used in argument position, e.g. "let f (D(x)) = ..."
-        let id = ident("unitVar"^string takenNames.Count,m)
+        let id = ident("unitVar" + string takenNames.Count,m)
         UnifyTypes cenv env m ty cenv.g.unit_ty
         let _,names,takenNames = TcPatBindingName cenv env id ty false None None (ValInline.Optional,permitInferTypars,noArgOrRetAttribs,false,None,true) (names,takenNames)
         [id.idText],(tpenv,names,takenNames)
@@ -6248,7 +6256,7 @@ and TcConstExpr cenv overallTy env m tpenv c  =
 
     | SynConst.UserNum (s,suffix) -> 
         let expr = 
-            let modName = ("NumericLiteral"^suffix)
+            let modName = ("NumericLiteral" + suffix)
             let ad = env.eAccessRights
             match ResolveLongIndentAsModuleOrNamespace cenv.amap m OpenQualified env.eNameResEnv ad [ident (modName,m)] with 
             | Result []
@@ -7973,7 +7981,7 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution
                     // This is where the constructor expects arguments but is not applied to arguments, hence build a lambda 
                     nargtys, 
                     (fun () -> 
-                        let vs,args = argtys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg"^string i) ty) |> List.unzip
+                        let vs,args = argtys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg" + string i) ty) |> List.unzip
                         let constrApp = mkConstrApp mItem args
                         let lam = mkMultiLambda mItem vs (constrApp, tyOfExpr cenv.g constrApp)
                         lam)
@@ -8113,7 +8121,7 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution
         let argTys = argTypars |> List.map mkTyparTy 
         let retTy = mkTyparTy retTypar
 
-        let vs,ves = argTys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg"^string i) ty) |> List.unzip
+        let vs,ves = argTys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg" + string i) ty) |> List.unzip
 
         let memberFlags = StaticMemberFlags MemberKind.Member
         let logicalCompiledName = ComputeLogicalName id memberFlags
@@ -13203,7 +13211,7 @@ module TcExceptionDeclarations = begin
         let args = match args with (UnionCaseFields args) -> args | _ -> error(Error(FSComp.SR.tcExplicitTypeSpecificationCannotBeUsedForExceptionConstructors(),m))
         let ad = env.eAccessRights
 
-        let args' = List.mapi (fun i fdef -> TcRecdUnionAndEnumDeclarations.TcAnonFieldDecl cenv env parent tpenv ("Data"^string i) fdef) args
+        let args' = List.mapi (fun i fdef -> TcRecdUnionAndEnumDeclarations.TcAnonFieldDecl cenv env parent tpenv ("Data" + string i) fdef) args
         TcRecdUnionAndEnumDeclarations.ValidateFieldNames(args, args')
         if not (String.isUpper id.idText) then errorR(NotUpperCaseConstructor(m))
         let vis,cpath = ComputeAccessAndCompPath env None m vis parent
@@ -15004,12 +15012,14 @@ let rec TcSignatureElement cenv parent endm (env: TcEnv) e : Eventually<TcEnv> =
                  CheckNamespaceModuleOrTypeName cenv.g id
 
             let enclosingNamespacePath = if isModule then fst (List.frontAndBack longId) else longId
+
             let defs = 
                 if isModule then 
                     [SynModuleSigDecl.NestedModule(ComponentInfo(attribs,[], [],[snd(List.frontAndBack longId)],xml,false,vis,m),defs,m)] 
                 else 
                     defs
             let envinner = LocateEnv cenv.topCcu env enclosingNamespacePath
+
             let envinner = ImplicitlyOpenOwnNamespace cenv.tcSink cenv.g cenv.amap m enclosingNamespacePath envinner
 
             let! envAtEnd = TcSignatureElements cenv ParentNone m.EndRange envinner xml defs
@@ -15223,7 +15233,7 @@ let rec TcModuleOrNamespaceElement (cenv:cenv) parent scopem env e = // : ((Modu
 
       | SynModuleDecl.NamespaceFragment(SynModuleOrNamespace(longId,isModule,defs,xml,attribs,vis,m)) ->
 
-          if !progress then dprintn ("Typecheck implementation "^textOfLid longId)
+          if !progress then dprintn ("Typecheck implementation " + textOfLid longId)
           let endm = m.EndRange
 
           do for id in longId do 

tests/fsharp/core/fsi-reload/a1.fs

@@ -0,0 +1,3 @@
+namespace Project
+
+type DU = A | B

tests/fsharp/core/fsi-reload/a2.fs

@@ -0,0 +1,3 @@
+namespace Project
+
+type B = { Prop : DU }

tests/fsharp/core/fsi-reload/b1.fs

@@ -0,0 +1,3 @@
+namespace Project
+
+type DU = A | B

tests/fsharp/core/fsi-reload/b2.fs

@@ -0,0 +1,3 @@
+namespace Project
+
+type B = { Prop : DU }

tests/fsharp/core/fsi-reload/b2.fsi

@@ -0,0 +1,3 @@
+namespace Project
+
+type B = { Prop : DU }

tests/fsharp/core/fsi-reload/load1.fsx

@@ -0,0 +1,5 @@
+// Test the case where a2.fs is in the same namespace as a1.fs, and so the namespace is implicitly opened
+#load "a1.fs"
+#load "a2.fs"
+
+let os = System.IO.File.CreateText "test.ok" in os.Close() 

tests/fsharp/core/fsi-reload/load2.fsx

@@ -0,0 +1,5 @@
+// Test the case where b2.fsi/fs is in the same namespace as b1.fs, and so the namespace is implicitly opened
+#load "b1.fs"
+#load "b2.fsi" "b2.fs" 
+
+let os = System.IO.File.CreateText "test.ok" in os.Close() 

tests/fsharp/core/fsi-reload/run.bat

@@ -9,6 +9,23 @@ call %~d0%~p0..\..\..\config.bat
   "%FSI%" %fsi_flags%  --maxerrors:1 < test1.ml
   if NOT EXIST test.ok goto SetError
 
+  if exist test.ok (del /f /q test.ok)
+  "%FSI%" %fsi_flags%  --maxerrors:1 load1.fsx
+  if NOT EXIST test.ok goto SetError
+
+  if exist test.ok (del /f /q test.ok)
+  "%FSI%" %fsi_flags%  --maxerrors:1 load2.fsx
+  if NOT EXIST test.ok goto SetError
+
+  REM Check we can alo compile, for sanity's sake
+  "%FSC%" load1.fsx
+  @if ERRORLEVEL 1 goto Error
+
+  REM Check we can alo compile, for sanity's sake
+  "%FSC%" load2.fsx
+  @if ERRORLEVEL 1 goto Error
+
+
 :Ok
 echo Ran fsharp %~f0 ok.
 endlocal