Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 0 additions & 3 deletions VisualFSharp.sln
Original file line number Diff line number Diff line change
Expand Up @@ -126,9 +126,6 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution
EndProjectSection
EndProject
Global
GlobalSection(Performance) = preSolution
HasPerformanceSessions = true
EndGlobalSection
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
Debug|x86 = Debug|x86
Expand Down
4 changes: 3 additions & 1 deletion src/absil/ildiag.fs
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,9 @@ module internal Microsoft.FSharp.Compiler.AbstractIL.Diagnostics
open Internal.Utilities

let diagnosticsLog = ref (Some stdout)

let setDiagnosticsChannel s = diagnosticsLog := s

let dflushn () = match !diagnosticsLog with None -> () | Some d -> d.WriteLine(); d.Flush()
let dflush () = match !diagnosticsLog with None -> () | Some d -> d.Flush()
let dprintn (s:string) =
Expand All @@ -18,4 +21,3 @@ let dprintf (fmt: Format<_,_,_,_>) =
let dprintfn (fmt: Format<_,_,_,_>) =
Printf.kfprintf dflushn (match !diagnosticsLog with None -> System.IO.TextWriter.Null | Some d -> d) fmt

let setDiagnosticsChannel s = diagnosticsLog := s
3 changes: 1 addition & 2 deletions src/absil/ildiag.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -11,9 +11,8 @@ module internal Microsoft.FSharp.Compiler.AbstractIL.Diagnostics
open System.IO
open Microsoft.FSharp.Core.Printf

val public setDiagnosticsChannel: TextWriter option -> unit
val public setDiagnosticsChannel: TextWriter option -> unit

val public dprintfn: TextWriterFormat<'a> -> 'a
val public dprintf: TextWriterFormat<'a> -> 'a

val public dprintn: string -> unit
1,581 changes: 784 additions & 797 deletions src/absil/ilread.fs

Large diffs are not rendered by default.

9 changes: 7 additions & 2 deletions src/fsharp/CompileOps.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1476,10 +1476,10 @@ let CollectErrorOrWarning (implicitIncludeDir,showFullPaths,flattenErrors,errorS

match err.Exception with
| ReportedError _ ->
dprintf "Unexpected ReportedError" (* this should actually never happen *)
assert ("" = "Unexpected ReportedError") // this should never happen
Seq.empty
| StopProcessing ->
dprintf "Unexpected StopProcessing" (* this should actually never happen *)
assert ("" = "Unexpected StopProcessing") // this should never happen
Seq.empty
| _ ->
let errors = ResizeArray()
Expand Down Expand Up @@ -2962,6 +2962,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) =
let logmessage showMessages =
if showMessages && tcConfig.showReferenceResolutions then (fun (message:string)->dprintf "%s\n" message)
else ignore

let logwarning showMessages =
(fun code message->
if showMessages && mode = ReportErrors then
Expand All @@ -2975,6 +2976,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) =
| _ ->
(if code = "MSB3245" then errorR else warning)
(MSBuildReferenceResolutionWarning(code,message,errorAndWarningRange)))

let logerror showMessages =
(fun code message ->
if showMessages && mode = ReportErrors then
Expand All @@ -2988,10 +2990,12 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) =
| Some(X86) -> "x86"
| Some(AMD64) -> "amd64"
| Some(IA64) -> "ia64"

let outputDirectory =
match tcConfig.outputFile with
| Some(outputFile) -> tcConfig.MakePathAbsolute outputFile
| None -> tcConfig.implicitIncludeDir

let targetFrameworkDirectories =
match tcConfig.clrRoot with
| Some(clrRoot) -> [tcConfig.MakePathAbsolute clrRoot]
Expand Down Expand Up @@ -3033,6 +3037,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) =
|> Array.map(fun i->(p13 groupedReferences.[i]),(p23 groupedReferences.[i]),i)
|> Array.filter (fun (_,i0,_)->resolvedAsFile|>Array.exists(fun (i1,_) -> i0=i1)|>not)
|> Array.map(fun (ref,_,i)->ref,string i)

let resolutions = Resolve(toMsBuild,(*showMessages*)true)

// Map back to original assembly resolutions.
Expand Down
50 changes: 26 additions & 24 deletions src/fsharp/ConstraintSolver.fs
Original file line number Diff line number Diff line change
Expand Up @@ -160,44 +160,45 @@ type TcValF = (ValRef -> ValUseFlag -> TType list -> range -> Expr * TType)

type ConstraintSolverState =
{
g: TcGlobals;
amap: Import.ImportMap;
InfoReader : InfoReader;
g: TcGlobals
amap: Import.ImportMap
InfoReader : InfoReader
TcVal : TcValF
/// This table stores all unsolved, ungeneralized trait constraints, indexed by free type variable.
/// That is, there will be one entry in this table for each free type variable in
/// each outstanding, unsolved, ungeneralized trait constraint. Constraints are removed from the table and resolved
/// each time a solution to an index variable is found.
mutable ExtraCxs: HashMultiMap<Stamp, (TraitConstraintInfo * range)>;
mutable ExtraCxs: HashMultiMap<Stamp, (TraitConstraintInfo * range)>
}

static member New(g,amap,infoReader, tcVal) =
{ g=g; amap=amap;
{ g=g
amap=amap
ExtraCxs= HashMultiMap(10, HashIdentity.Structural)
InfoReader=infoReader
TcVal = tcVal } ;
TcVal = tcVal }


type ConstraintSolverEnv =
{
SolverState: ConstraintSolverState;
SolverState: ConstraintSolverState
eContextInfo: ContextInfo
MatchingOnly : bool
m: range;
EquivEnv: TypeEquivEnv;
m: range
EquivEnv: TypeEquivEnv
DisplayEnv : DisplayEnv
}
member csenv.InfoReader = csenv.SolverState.InfoReader
member csenv.g = csenv.SolverState.g
member csenv.amap = csenv.SolverState.amap

let MakeConstraintSolverEnv contextInfo css m denv =
{ SolverState=css;
m=m;
{ SolverState=css
m=m
eContextInfo = contextInfo
// Indicates that when unifiying ty1 = ty2, only type variables in ty1 may be solved
MatchingOnly=false;
EquivEnv=TypeEquivEnv.Empty;
MatchingOnly=false
EquivEnv=TypeEquivEnv.Empty
DisplayEnv = denv }


Expand Down Expand Up @@ -303,9 +304,10 @@ let BakedInTraitConstraintNames =
// Run the constraint solver with undo (used during method overload resolution)

type Trace =
| Trace of (unit -> unit) list ref
static member New () = Trace (ref [])
member t.Undo () = let (Trace trace) = t in List.iter (fun a -> a ()) !trace
{ mutable actions: (unit -> unit) list }
static member New () = { actions = [] }
member t.Undo () = List.iter (fun a -> a ()) t.actions
member t.Push f = t.actions <- f :: t.actions

type OptionalTrace =
| NoTrace
Expand Down Expand Up @@ -417,7 +419,7 @@ let rec TransactStaticReq (csenv:ConstraintSolverEnv) trace (tpr:Typar) req =
let orig = tpr.StaticReq
match trace with
| NoTrace -> ()
| WithTrace (Trace actions) -> actions := (fun () -> tpr.SetStaticReq orig) :: !actions
| WithTrace trace -> trace.Push (fun () -> tpr.SetStaticReq orig)
tpr.SetStaticReq req;
CompleteD

Expand Down Expand Up @@ -446,7 +448,7 @@ let rec TransactDynamicReq trace (tpr:Typar) req =
let orig = tpr.DynamicReq
match trace with
| NoTrace -> ()
| WithTrace (Trace actions) -> actions := (fun () -> tpr.SetDynamicReq orig) :: !actions
| WithTrace trace -> trace.Push (fun () -> tpr.SetDynamicReq orig)
tpr.SetDynamicReq req;
CompleteD

Expand Down Expand Up @@ -673,7 +675,7 @@ let rec SolveTyparEqualsTyp (csenv:ConstraintSolverEnv) ndeep m2 trace ty1 ty =
let tpdata = r.Data
match trace with
| NoTrace -> ()
| WithTrace (Trace actions) -> actions := (fun () -> tpdata.typar_solution <- None) :: !actions
| WithTrace trace -> trace.Push (fun () -> tpdata.typar_solution <- None)
tpdata.typar_solution <- Some ty;

(* dprintf "setting typar %d to type %s at %a\n" r.Stamp ((DebugPrint.showType ty)) outputRange m; *)
Expand Down Expand Up @@ -1343,7 +1345,7 @@ and TransactMemberConstraintSolution traitInfo trace sln =
traitInfo.Solution <- Some sln
match trace with
| NoTrace -> ()
| WithTrace (Trace actions) -> actions := (fun () -> traitInfo.Solution <- prev) :: !actions
| WithTrace trace -> trace.Push (fun () -> traitInfo.Solution <- prev)

/// Only consider overload resolution if canonicalizing or all the types are now nominal.
/// That is, don't perform resolution if more nominal information may influence the set of available overloads
Expand Down Expand Up @@ -1410,7 +1412,7 @@ and SolveRelevantMemberConstraintsForTypar (csenv:ConstraintSolverEnv) ndeep per

match trace with
| NoTrace -> ()
| WithTrace (Trace actions) -> actions := (fun () -> cxs |> List.iter (fun cx -> cxst.Add(tpn,cx))) :: !actions
| WithTrace trace -> trace.Push (fun () -> cxs |> List.iter (fun cx -> cxst.Add(tpn,cx)))

cxs |> AtLeastOneD (fun (traitInfo,m2) ->
let csenv = { csenv with m = m2 }
Expand All @@ -1437,7 +1439,7 @@ and AddMemberConstraint (csenv:ConstraintSolverEnv) ndeep m2 trace traitInfo sup
if not (cxs |> List.exists (fun (traitInfo2,_) -> traitsAEquiv g aenv traitInfo traitInfo2)) then
match trace with
| NoTrace -> ()
| WithTrace (Trace actions) -> actions := (fun () -> csenv.SolverState.ExtraCxs.Remove tpn) :: !actions
| WithTrace trace -> trace.Push (fun () -> csenv.SolverState.ExtraCxs.Remove tpn)
csenv.SolverState.ExtraCxs.Add (tpn,(traitInfo,m2))
);

Expand Down Expand Up @@ -1613,7 +1615,7 @@ and AddConstraint (csenv:ConstraintSolverEnv) ndeep m2 trace tp newConstraint =
let orig = d.typar_constraints
begin match trace with
| NoTrace -> ()
| WithTrace (Trace actions) -> actions := (fun () -> d.typar_constraints <- orig) :: !actions
| WithTrace trace -> trace.Push (fun () -> d.typar_constraints <- orig)
end;
d.typar_constraints <- newConstraints;

Expand Down Expand Up @@ -2404,7 +2406,7 @@ let EliminateConstraintsForGeneralizedTypars csenv trace (generalizedTypars: Typ
cxst.Remove tpn;
match trace with
| NoTrace -> ()
| WithTrace (Trace actions) -> actions := (fun () -> (csenv.SolverState.ExtraCxs.Add (tpn,cx))) :: !actions)
| WithTrace trace -> trace.Push (fun () -> (csenv.SolverState.ExtraCxs.Add (tpn,cx))))
)


Expand Down
3 changes: 2 additions & 1 deletion src/fsharp/ConstraintSolver.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -98,7 +98,8 @@ val BakedInTraitConstraintNames : string list

val MakeConstraintSolverEnv : ContextInfo -> ConstraintSolverState -> range -> DisplayEnv -> ConstraintSolverEnv

type Trace = Trace of (unit -> unit) list ref
[<Sealed; NoEquality; NoComparison>]
type Trace

type OptionalTrace =
| NoTrace
Expand Down
6 changes: 0 additions & 6 deletions src/fsharp/FSharp.Compiler-proto/FSharp.Compiler-proto.fsproj
Original file line number Diff line number Diff line change
Expand Up @@ -434,12 +434,6 @@
<Compile Include="..\IlxGen.fs">
<Link>IlxGen.fs</Link>
</Compile>
<Compile Include="..\TraceCall.fsi">
<Link>TraceCall.fsi</Link>
</Compile>
<Compile Include="..\TraceCall.fs">
<Link>TraceCall.fs</Link>
</Compile>
<Compile Include="..\CompileOps.fsi">
<Link>CompileOps.fsi</Link>
</Compile>
Expand Down
6 changes: 0 additions & 6 deletions src/fsharp/FSharp.Compiler/FSharp.Compiler.fsproj
Original file line number Diff line number Diff line change
Expand Up @@ -141,12 +141,6 @@
<Compile Include="..\lib.fs">
<Link>Utilities\lib.fs</Link>
</Compile>
<Compile Include="..\TraceCall.fsi">
<Link>Utilities\TraceCall.fsi</Link>
</Compile>
<Compile Include="..\TraceCall.fs">
<Link>Utilities\TraceCall.fs</Link>
</Compile>
<Compile Include="..\rational.fsi">
<Link>Utilities\rational.fsi</Link>
</Compile>
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -151,9 +151,6 @@
<Compile Include="..\rational.fs">
<Link>Utilities\rational.fs</Link>
</Compile>
<Compile Include="..\TraceCall.fs">
<Link>Utilities\TraceCall.fs</Link>
</Compile>
<Compile Include="..\range.fsi">
<Link>ErrorLogging\range.fsi</Link>
</Compile>
Expand Down Expand Up @@ -564,7 +561,6 @@
<Reference Include="System.Numerics" />
<Reference Include="System.Drawing" />
<Reference Include="System.Windows.Forms" />
<Reference Include="System.Runtime.Remoting" />
<Reference Include="Microsoft.VisualStudio.OLE.Interop.dll" />
<Reference Include="Microsoft.VisualStudio.Shell.Immutable.10.0.dll" />
<Reference Include="Microsoft.VisualStudio.Shell.Immutable.11.0.dll" />
Expand Down
Loading