diff --git a/src/fsharp/absil/illib.fs b/src/fsharp/absil/illib.fs index 264427d4f87..87f3afaba47 100644 --- a/src/fsharp/absil/illib.fs +++ b/src/fsharp/absil/illib.fs @@ -813,6 +813,8 @@ type CancellableBuilder() = member x.Combine(e1, e2) = e1 |> Cancellable.bind (fun () -> e2) + member x.For(es, f) = es |> Cancellable.each f + member x.TryWith(e, handler) = Cancellable.tryWith e handler member x.Using(resource, e) = Cancellable.tryFinally (e resource) (fun () -> (resource :> IDisposable).Dispose()) diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 0a02759b70b..64e1526dc39 100755 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -38,948 +38,11 @@ open Internal.Utilities.Collections [] module internal IncrementalBuild = - /// A particular node in the Expr language. Use an int for keys instead of the entire Expr to avoid extra hashing. - type Id = Id of int - - [] - /// A build rule representing a single output - type ScalarBuildRule = - /// ScalarInput (uniqueRuleId, outputName) - /// - /// A build rule representing a single input, producing the input as its single scalar result - | ScalarInput of Id * string - - /// ScalarDemultiplex (uniqueRuleId, outputName, input, taskFunction) - /// - /// A build rule representing the merge of a set of inputs to a single output - | ScalarDemultiplex of Id * string * VectorBuildRule * (CompilationThreadToken -> obj[] -> Cancellable) - - /// ScalarMap (uniqueRuleId, outputName, input, taskFunction) - /// - /// A build rule representing the transformation of a single input to a single output - /// THIS CASE IS CURRENTLY UNUSED - | ScalarMap of Id * string * ScalarBuildRule * (CompilationThreadToken -> obj -> obj) - - /// Get the Id for the given ScalarBuildRule. - member x.Id = - match x with - | ScalarInput(id, _) -> id - | ScalarDemultiplex(id, _, _, _) -> id - | ScalarMap(id, _, _, _) -> id - - /// Get the Name for the givenScalarExpr. - member x.Name = - match x with - | ScalarInput(_, n) -> n - | ScalarDemultiplex(_, n, _, _) -> n - | ScalarMap(_, n, _, _) -> n - - /// A build rule with a vector of outputs - and VectorBuildRule = - /// VectorInput (uniqueRuleId, outputName) - /// - /// A build rule representing the transformation of a single input to a single output - | VectorInput of Id * string - - /// VectorInput (uniqueRuleId, outputName, initialAccumulator, inputs, taskFunction) - /// - /// A build rule representing the scan-left combining a single scalar accumulator input with a vector of inputs - | VectorScanLeft of Id * string * ScalarBuildRule * VectorBuildRule * (CompilationThreadToken -> obj -> obj->Eventually) - - /// VectorMap (uniqueRuleId, outputName, inputs, taskFunction) - /// - /// A build rule representing the parallel map of the inputs to outputs - | VectorMap of Id * string * VectorBuildRule * (CompilationThreadToken -> obj -> obj) - - /// VectorStamp (uniqueRuleId, outputName, inputs, stampFunction) - /// - /// A build rule representing pairing the inputs with a timestamp specified by the given function. - | VectorStamp of Id * string * VectorBuildRule * (TimeStampCache -> CompilationThreadToken -> obj -> DateTime) - - /// VectorMultiplex (uniqueRuleId, outputName, input, taskFunction) - /// - /// A build rule representing taking a single input and transforming it to a vector of outputs - | VectorMultiplex of Id * string * ScalarBuildRule * (CompilationThreadToken -> obj -> obj[]) - - /// Get the Id for the given VectorBuildRule. - member x.Id = - match x with - | VectorInput(id, _) -> id - | VectorScanLeft(id, _, _, _, _) -> id - | VectorMap(id, _, _, _) -> id - | VectorStamp (id, _, _, _) -> id - | VectorMultiplex(id, _, _, _) -> id - /// Get the Name for the given VectorBuildRule. - member x.Name = - match x with - | VectorInput(_, n) -> n - | VectorScanLeft(_, n, _, _, _) -> n - | VectorMap(_, n, _, _) -> n - | VectorStamp (_, n, _, _) -> n - | VectorMultiplex(_, n, _, _) -> n - - [] - type BuildRuleExpr = - | ScalarBuildRule of ScalarBuildRule - | VectorBuildRule of VectorBuildRule - /// Get the Id for the given Expr. - member x.Id = - match x with - | ScalarBuildRule se -> se.Id - | VectorBuildRule ve -> ve.Id - /// Get the Name for the given Expr. - member x.Name = - match x with - | ScalarBuildRule se -> se.Name - | VectorBuildRule ve -> ve.Name - - // Ids of exprs - let mutable nextid = 999 // Number ids starting with 1000 to discern them - let NextId() = - nextid <- nextid + 1 - Id(nextid) - - type INode = - abstract Name: string - - type IScalar = - inherit INode - abstract Expr: ScalarBuildRule - - type IVector = - inherit INode - abstract Expr: VectorBuildRule - - type Scalar<'T> = interface inherit IScalar end - - type Vector<'T> = interface inherit IVector end - - /// The outputs of a build - [] - type NamedOutput = - | NamedVectorOutput of IVector - | NamedScalarOutput of IScalar - - type BuildRules = { RuleList: (string * BuildRuleExpr) list } - - /// Visit each task and call op with the given accumulator. - let FoldOverBuildRules(rules: BuildRules, op, acc)= - let rec visitVector (ve: VectorBuildRule) acc = - match ve with - | VectorInput _ -> op (VectorBuildRule ve) acc - | VectorScanLeft(_, _, a, i, _) -> op (VectorBuildRule ve) (visitVector i (visitScalar a acc)) - | VectorMap(_, _, i, _) - | VectorStamp (_, _, i, _) -> op (VectorBuildRule ve) (visitVector i acc) - | VectorMultiplex(_, _, i, _) -> op (VectorBuildRule ve) (visitScalar i acc) - - and visitScalar (se: ScalarBuildRule) acc = - match se with - | ScalarInput _ -> op (ScalarBuildRule se) acc - | ScalarDemultiplex(_, _, i, _) -> op (ScalarBuildRule se) (visitVector i acc) - | ScalarMap(_, _, i, _) -> op (ScalarBuildRule se) (visitScalar i acc) - - let visitRule (expr: BuildRuleExpr) acc = - match expr with - | ScalarBuildRule se ->visitScalar se acc - | VectorBuildRule ve ->visitVector ve acc - - List.foldBack visitRule (rules.RuleList |> List.map snd) acc - - /// Convert from interfaces into discriminated union. - let ToBuild (names: NamedOutput list): BuildRules = - - // Create the rules. - let createRules() = - { RuleList = names |> List.map (function NamedVectorOutput v -> v.Name, VectorBuildRule(v.Expr) - | NamedScalarOutput s -> s.Name, ScalarBuildRule(s.Expr)) } - - // Ensure that all names are unique. - let ensureUniqueNames (expr: BuildRuleExpr) (acc: Map) = - let AddUniqueIdToNameMapping(id, name)= - match acc.TryFind name with - | Some priorId -> - if id<>priorId then failwith (sprintf "Two build expressions had the same name: %s" name) - else acc - | None-> Map.add name id acc - let id = expr.Id - let name = expr.Name - AddUniqueIdToNameMapping(id, name) - - // Validate the rule tree - let validateRules (rules: BuildRules) = - FoldOverBuildRules(rules, ensureUniqueNames, Map.empty) |> ignore - - // Convert and validate - let rules = createRules() - validateRules rules - rules - - /// These describe the input conditions for a result. If conditions change then the result is invalid. - type InputSignature = - | SingleMappedVectorInput of InputSignature[] - | EmptyTimeStampedInput of DateTime - | BoundInputScalar // An external input into the build - | BoundInputVector // An external input into the build - | IndexedValueElement of DateTime - | UnevaluatedInput - - /// Return true if the result is fully evaluated - member is.IsEvaluated = - match is with - | UnevaluatedInput -> false - | SingleMappedVectorInput iss -> iss |> Array.forall (fun is -> is.IsEvaluated) - | _ -> true - - - /// A slot for holding a single result. - type Result = - | NotAvailable - | InProgress of (CompilationThreadToken -> Eventually) * DateTime - | Available of obj * DateTime * InputSignature - - /// Get the available result. Throw an exception if not available. - member x.GetAvailable() = match x with Available (o, _, _) ->o | _ -> failwith "No available result" - - /// Get the time stamp if available. Otherwise MaxValue. - member x.Timestamp = match x with Available (_, ts, _) -> ts | InProgress(_, ts) -> ts | _ -> DateTime.MaxValue - - /// Get the time stamp if available. Otherwise MaxValue. - member x.InputSignature = match x with Available (_, _, signature) -> signature | _ -> UnevaluatedInput - - member x.ResultIsInProgress = match x with | InProgress _ -> true | _ -> false - member x.GetInProgressContinuation ctok = match x with | InProgress (f, _) -> f ctok | _ -> failwith "not in progress" - member x.TryGetAvailable() = match x with | InProgress _ | NotAvailable -> None | Available (obj, dt, i) -> Some (obj, dt, i) - - /// An immutable sparse vector of results. - type ResultVector(size, zeroElementTimestamp, map) = - let get slot = - match Map.tryFind slot map with - | Some result ->result - | None->NotAvailable - let asList = lazy List.map (fun i->i, get i) [0..size-1] - - static member OfSize size = ResultVector(size, DateTime.MinValue, Map.empty) - member rv.Size = size - member rv.Get slot = get slot - member rv.Resize newSize = - if size<>newSize then - ResultVector(newSize, zeroElementTimestamp, map |> Map.filter(fun s _ -> s < newSize)) - else rv - - member rv.Set(slot, value) = -#if DEBUG - if slot<0 then failwith "ResultVector slot less than zero" - if slot>=size then failwith "ResultVector slot too big" -#endif - ResultVector(size, zeroElementTimestamp, Map.add slot value map) - - member rv.MaxTimestamp() = - let maximize (lastTimestamp: DateTime) (_, result: Result) = max lastTimestamp result.Timestamp - List.fold maximize zeroElementTimestamp (asList.Force()) - - member rv.Signature() = - let l = asList.Force() - let l = l |> List.map (fun (_, result) -> result.InputSignature) - SingleMappedVectorInput (l|>List.toArray) - - member rv.FoldLeft f s: 'a = List.fold f s (asList.Force()) - - /// A result of performing build actions - [] - type ResultSet = - | ScalarResult of Result - | VectorResult of ResultVector - - /// Result of a particular action over the bound build tree - [] - type ActionResult = - | IndexedResult of Id * int * (*slotcount*) int * Eventually * DateTime - | ScalarValuedResult of Id * obj * DateTime * InputSignature - | VectorValuedResult of Id * obj[] * DateTime * InputSignature - | ResizeResult of Id * (*slotcount*) int - - - /// A pending action over the bound build tree - [] - type Action = - | IndexedAction of Id * (*taskname*)string * int * (*slotcount*) int * DateTime * (CompilationThreadToken -> Eventually) - | ScalarAction of Id * (*taskname*)string * DateTime * InputSignature * (CompilationThreadToken -> Cancellable) - | VectorAction of Id * (*taskname*)string * DateTime * InputSignature * (CompilationThreadToken -> Cancellable) - | ResizeResultAction of Id * (*slotcount*) int - /// Execute one action and return a corresponding result. - member action.Execute ctok = - cancellable { - match action with - | IndexedAction(id, _taskname, slot, slotcount, timestamp, func) -> let res = func ctok in return IndexedResult(id, slot, slotcount, res, timestamp) - | ScalarAction(id, _taskname, timestamp, inputsig, func) -> let! res = func ctok in return ScalarValuedResult(id, res, timestamp, inputsig) - | VectorAction(id, _taskname, timestamp, inputsig, func) -> let! res = func ctok in return VectorValuedResult(id, res, timestamp, inputsig) - | ResizeResultAction(id, slotcount) -> return ResizeResult(id, slotcount) - } - - /// A set of build rules and the corresponding, possibly partial, results from building. - [] - type PartialBuild(rules: BuildRules, results: Map) = - member bt.Rules = rules - member bt.Results = results - - /// Given an expression, find the expected width. - let rec GetVectorWidthByExpr(bt: PartialBuild, ve: VectorBuildRule) = - let id = ve.Id - let KnownValue() = - match bt.Results.TryFind id with - | Some resultSet -> - match resultSet with - | VectorResult rv ->Some rv.Size - | _ -> failwith "Expected vector to have vector result." - | None-> None - match ve with - | VectorScanLeft(_, _, _, i, _) - | VectorMap(_, _, i, _) - | VectorStamp (_, _, i, _) -> - match GetVectorWidthByExpr(bt, i) with - | Some _ as r -> r - | None -> KnownValue() - | VectorInput _ - | VectorMultiplex _ -> KnownValue() - - /// Given an expression name, get the corresponding expression. - let GetTopLevelExprByName(bt: PartialBuild, seek: string) = - bt.Rules.RuleList |> List.filter(fun(name, _) ->name=seek) |> List.map (fun(_, root) ->root) |> List.head - - /// Get an expression matching the given name. - let GetExprByName(bt: PartialBuild, node: INode): BuildRuleExpr = - let matchName (expr: BuildRuleExpr) (acc: BuildRuleExpr option): BuildRuleExpr option = - if expr.Name = node.Name then Some expr else acc - let matchOption = FoldOverBuildRules(bt.Rules, matchName, None) - Option.get matchOption - - // Given an Id, find the corresponding expression. - let GetExprById(bt: PartialBuild, seek: Id): BuildRuleExpr= - let rec vectorExprOfId ve = - match ve with - | VectorInput(id, _) ->if seek=id then Some (VectorBuildRule ve) else None - | VectorScanLeft(id, _, a, i, _) -> - if seek=id then Some (VectorBuildRule ve) else - let result = scalarExprOfId a - match result with Some _ -> result | None->vectorExprOfId i - | VectorMap(id, _, i, _) ->if seek=id then Some (VectorBuildRule ve) else vectorExprOfId i - | VectorStamp (id, _, i, _) ->if seek=id then Some (VectorBuildRule ve) else vectorExprOfId i - | VectorMultiplex(id, _, i, _) ->if seek=id then Some (VectorBuildRule ve) else scalarExprOfId i - - and scalarExprOfId se = - match se with - | ScalarInput(id, _) ->if seek=id then Some (ScalarBuildRule se) else None - | ScalarDemultiplex(id, _, i, _) ->if seek=id then Some (ScalarBuildRule se) else vectorExprOfId i - | ScalarMap(id, _, i, _) ->if seek=id then Some (ScalarBuildRule se) else scalarExprOfId i - - let exprOfId(expr: BuildRuleExpr) = - match expr with - | ScalarBuildRule se ->scalarExprOfId se - | VectorBuildRule ve ->vectorExprOfId ve - - let exprs = bt.Rules.RuleList |> List.map (fun(_, root) ->exprOfId root) |> List.filter Option.isSome - match exprs with - | Some expr :: _ -> expr - | _ -> failwith (sprintf "GetExprById did not find an expression for Id") - - let GetVectorWidthById (bt: PartialBuild) seek = - match GetExprById(bt, seek) with - | ScalarBuildRule _ ->failwith "Attempt to get width of scalar." - | VectorBuildRule ve -> Option.get (GetVectorWidthByExpr(bt, ve)) - - let GetScalarExprResult (bt: PartialBuild, se: ScalarBuildRule) = - match bt.Results.TryFind (se.Id) with - | Some resultSet -> - match se, resultSet with - | ScalarInput _, ScalarResult r - | ScalarMap _, ScalarResult r - | ScalarDemultiplex _, ScalarResult r ->r - | _ ->failwith "GetScalarExprResult had no match" - | None->NotAvailable - - let GetVectorExprResultVector (bt: PartialBuild, ve: VectorBuildRule) = - match bt.Results.TryFind (ve.Id) with - | Some resultSet -> - match ve, resultSet with - | VectorScanLeft _, VectorResult rv - | VectorMap _, VectorResult rv - | VectorInput _, VectorResult rv - | VectorStamp _, VectorResult rv - | VectorMultiplex _, VectorResult rv -> Some rv - | _ -> failwith "GetVectorExprResultVector had no match" - | None->None - - let GetVectorExprResult (bt: PartialBuild, ve: VectorBuildRule, slot) = - match bt.Results.TryFind ve.Id with - | Some resultSet -> - match ve, resultSet with - | VectorScanLeft _, VectorResult rv - | VectorMap _, VectorResult rv - | VectorInput _, VectorResult rv - | VectorStamp _, VectorResult rv -> rv.Get slot - | VectorMultiplex _, VectorResult rv -> rv.Get slot - | _ -> failwith "GetVectorExprResult had no match" - | None->NotAvailable - - /// Get the maximum build stamp for an output. - let MaxTimestamp(bt: PartialBuild, id) = - match bt.Results.TryFind id with - | Some resultSet -> - match resultSet with - | ScalarResult rs -> rs.Timestamp - | VectorResult rv -> rv.MaxTimestamp() - | None -> DateTime.MaxValue - - let Signature(bt: PartialBuild, id) = - match bt.Results.TryFind id with - | Some resultSet -> - match resultSet with - | ScalarResult rs -> rs.InputSignature - | VectorResult rv -> rv.Signature() - | None -> UnevaluatedInput - - /// Get all the results for the given expr. - let AllResultsOfExpr extractor (bt: PartialBuild) (expr: VectorBuildRule) = - let GetAvailable (rv: ResultVector) = - let Extract acc (_, result) = (extractor result) :: acc - List.rev (rv.FoldLeft Extract []) - let GetVectorResultById id = - match bt.Results.TryFind id with - | Some found -> - match found with - | VectorResult rv ->GetAvailable rv - | _ -> failwith "wrong result type" - | None -> [] - - GetVectorResultById(expr.Id) - - - - [] - type BuildInput = - | Vector of INode * obj list - | Scalar of INode * obj - - /// Declare a named scalar output. - static member ScalarInput (node: Scalar<'T>, value: 'T) = BuildInput.Scalar(node, box value) - static member VectorInput(node: Vector<'T>, values: 'T list) = BuildInput.Vector(node, List.map box values) - - - let AvailableAllResultsOfExpr bt expr = - let msg = "Expected all results to be available" - AllResultsOfExpr (function Available (o, _, _) -> o | _ -> failwith msg) bt expr - - /// Bind a set of build rules to a set of input values. - let ToBound(buildRules: BuildRules, inputs: BuildInput list) = - let now = DateTime.UtcNow - let rec applyScalarExpr(se, results) = - match se with - | ScalarInput(id, n) -> - let matches = - [ for input in inputs do - match input with - | BuildInput.Scalar (node, value) -> - if node.Name = n then - yield ScalarResult(Available (value, now, BoundInputScalar)) - | _ -> () ] - List.foldBack (Map.add id) matches results - | ScalarMap(_, _, se, _) ->applyScalarExpr(se, results) - | ScalarDemultiplex(_, _, ve, _) ->ApplyVectorExpr(ve, results) - and ApplyVectorExpr(ve, results) = - match ve with - | VectorInput(id, n) -> - let matches = - [ for input in inputs do - match input with - | BuildInput.Scalar _ -> () - | BuildInput.Vector (node, values) -> - if node.Name = n then - let results = values|>List.mapi(fun i value->i, Available (value, now, BoundInputVector)) - yield VectorResult(ResultVector(values.Length, DateTime.MinValue, results|>Map.ofList)) ] - List.foldBack (Map.add id) matches results - | VectorScanLeft(_, _, a, i, _) ->ApplyVectorExpr(i, applyScalarExpr(a, results)) - | VectorMap(_, _, i, _) - | VectorStamp (_, _, i, _) ->ApplyVectorExpr(i, results) - | VectorMultiplex(_, _, i, _) ->applyScalarExpr(i, results) - - let applyExpr expr results = - match expr with - | ScalarBuildRule se ->applyScalarExpr(se, results) - | VectorBuildRule ve ->ApplyVectorExpr(ve, results) - - // Place vector inputs into results map. - let results = List.foldBack applyExpr (buildRules.RuleList |> List.map snd) Map.empty - PartialBuild(buildRules, results) - - type Target = Target of INode * int option - - /// Visit each executable action necessary to evaluate the given output (with an optional slot in a - /// vector output). Call actionFunc with the given accumulator. - let ForeachAction cache ctok (Target(output, optSlot)) bt (actionFunc: Action -> 'T -> 'T) (acc:'T) = - let seen = Dictionary() - let isSeen id = - if seen.ContainsKey id then true - else - seen.[id] <- true - false - - let shouldEvaluate(bt, currentSig: InputSignature, id) = - if currentSig.IsEvaluated then - currentSig <> Signature(bt, id) - else false - - /// Make sure the result vector saved matches the size of expr - let resizeVectorExpr(ve: VectorBuildRule, acc) = - match GetVectorWidthByExpr(bt, ve) with - | Some expectedWidth -> - match bt.Results.TryFind ve.Id with - | Some found -> - match found with - | VectorResult rv -> - if rv.Size <> expectedWidth then - actionFunc (ResizeResultAction(ve.Id, expectedWidth)) acc - else acc - | _ -> acc - | None -> acc - | None -> acc - - let rec visitVector optSlot (ve: VectorBuildRule) acc = - - if isSeen ve.Id then acc - else - let acc = resizeVectorExpr(ve, acc) - match ve with - | VectorInput _ -> acc - | VectorScanLeft(id, taskname, accumulatorExpr, inputExpr, func) -> - let acc = - match GetVectorWidthByExpr(bt, ve) with - | Some cardinality -> - let limit = match optSlot with None -> cardinality | Some slot -> (slot+1) - - let Scan slot = - let accumulatorResult = - if slot=0 then GetScalarExprResult (bt, accumulatorExpr) - else GetVectorExprResult (bt, ve, slot-1) - - let inputResult = GetVectorExprResult (bt, inputExpr, slot) - match accumulatorResult, inputResult with - | Available (accumulator, accumulatorTimestamp, _accumulatorInputSig), Available (input, inputTimestamp, _inputSig) -> - let inputTimestamp = max inputTimestamp accumulatorTimestamp - let prevOutput = GetVectorExprResult (bt, ve, slot) - let outputTimestamp = prevOutput.Timestamp - let scanOpOpt = - if inputTimestamp <> outputTimestamp then - Some (fun ctok -> func ctok accumulator input) - elif prevOutput.ResultIsInProgress then - Some prevOutput.GetInProgressContinuation - else - // up-to-date and complete, no work required - None - match scanOpOpt with - | Some scanOp -> Some (actionFunc (IndexedAction(id, taskname, slot, cardinality, inputTimestamp, scanOp)) acc) - | None -> None - | _ -> None - - match ([0..limit-1]|>List.tryPick Scan) with Some acc ->acc | None->acc - | None -> acc - - // Check each slot for an action that may be performed. - visitVector None inputExpr (visitScalar accumulatorExpr acc) - - | VectorMap(id, taskname, inputExpr, func) -> - let acc = - match GetVectorWidthByExpr(bt, ve) with - | Some cardinality -> - if cardinality=0 then - // For vector length zero, just propagate the prior timestamp. - let inputTimestamp = MaxTimestamp(bt, inputExpr.Id) - let outputTimestamp = MaxTimestamp(bt, id) - if inputTimestamp <> outputTimestamp then - actionFunc (VectorAction(id, taskname, inputTimestamp, EmptyTimeStampedInput inputTimestamp, fun _ -> cancellable.Return [||])) acc - else acc - else - let MapResults acc slot = - let inputTimestamp = GetVectorExprResult(bt, inputExpr, slot).Timestamp - let outputTimestamp = GetVectorExprResult(bt, ve, slot).Timestamp - if inputTimestamp <> outputTimestamp then - let OneToOneOp ctok = - Eventually.Done (func ctok (GetVectorExprResult(bt, inputExpr, slot).GetAvailable())) - actionFunc (IndexedAction(id, taskname, slot, cardinality, inputTimestamp, OneToOneOp)) acc - else acc - match optSlot with - | None -> - [0..cardinality-1] |> List.fold MapResults acc - | Some slot -> - MapResults acc slot - | None -> acc - - visitVector optSlot inputExpr acc - - | VectorStamp (id, taskname, inputExpr, func) -> - - // For every result that is available, check time stamps. - let acc = - match GetVectorWidthByExpr(bt, ve) with - | Some cardinality -> - if cardinality=0 then - // For vector length zero, just propagate the prior timestamp. - let inputTimestamp = MaxTimestamp(bt, inputExpr.Id) - let outputTimestamp = MaxTimestamp(bt, id) - if inputTimestamp <> outputTimestamp then - actionFunc (VectorAction(id, taskname, inputTimestamp, EmptyTimeStampedInput inputTimestamp, fun _ -> cancellable.Return [||])) acc - else acc - else - let checkStamp acc slot = - let inputResult = GetVectorExprResult (bt, inputExpr, slot) - match inputResult with - | Available (ires, _, _) -> - let oldTimestamp = GetVectorExprResult(bt, ve, slot).Timestamp - let newTimestamp = func cache ctok ires - if newTimestamp <> oldTimestamp then - actionFunc (IndexedAction(id, taskname, slot, cardinality, newTimestamp, fun _ -> Eventually.Done ires)) acc - else acc - | _ -> acc - match optSlot with - | None -> - [0..cardinality-1] |> List.fold checkStamp acc - | Some slot -> - checkStamp acc slot - | None -> acc - visitVector optSlot inputExpr acc - - | VectorMultiplex(id, taskname, inputExpr, func) -> - let acc = - match GetScalarExprResult (bt, inputExpr) with - | Available (inp, inputTimestamp, inputsig) -> - let outputTimestamp = MaxTimestamp(bt, id) - if inputTimestamp <> outputTimestamp then - let MultiplexOp ctok = func ctok inp |> cancellable.Return - actionFunc (VectorAction(id, taskname, inputTimestamp, inputsig, MultiplexOp)) acc - else acc - | _ -> acc - visitScalar inputExpr acc - - and visitScalar (se: ScalarBuildRule) acc = - if isSeen se.Id then acc - else - match se with - | ScalarInput _ -> acc - | ScalarDemultiplex (id, taskname, inputExpr, func) -> - let acc = - match GetVectorExprResultVector (bt, inputExpr) with - | Some inputResult -> - let currentSig = inputResult.Signature() - if shouldEvaluate(bt, currentSig, id) then - let inputTimestamp = MaxTimestamp(bt, inputExpr.Id) - let DemultiplexOp ctok = - cancellable { - let input = AvailableAllResultsOfExpr bt inputExpr |> List.toArray - return! func ctok input - } - actionFunc (ScalarAction(id, taskname, inputTimestamp, currentSig, DemultiplexOp)) acc - else acc - | None -> acc - - visitVector None inputExpr acc - - | ScalarMap (id, taskname, inputExpr, func) -> - let acc = - match GetScalarExprResult (bt, inputExpr) with - | Available (inp, inputTimestamp, inputsig) -> - let outputTimestamp = MaxTimestamp(bt, id) - if inputTimestamp <> outputTimestamp then - let MapOp ctok = func ctok inp |> cancellable.Return - actionFunc (ScalarAction(id, taskname, inputTimestamp, inputsig, MapOp)) acc - else acc - | _ -> acc - - visitScalar inputExpr acc - - - let expr = bt.Rules.RuleList |> List.find (fun (s, _) -> s = output.Name) |> snd - match expr with - | ScalarBuildRule se -> visitScalar se acc - | VectorBuildRule ve -> visitVector optSlot ve acc - - let CollectActions cache target (bt: PartialBuild) = - // Explanation: This is a false reuse of 'ForeachAction' where the ctok is unused, we are - // just iterating to determine if there is work to do. This means this is safe to call from any thread. - let ctok = AssumeCompilationThreadWithoutEvidence () - ForeachAction cache ctok target bt (fun a l -> a :: l) [] - - /// Compute the max timestamp on all available inputs - let ComputeMaxTimeStamp cache ctok output (bt: PartialBuild) acc = - let expr = bt.Rules.RuleList |> List.find (fun (s, _) -> s = output) |> snd - match expr with - | VectorBuildRule (VectorStamp (_id, _taskname, inputExpr, func) as ve) -> - match GetVectorWidthByExpr(bt, ve) with - | Some cardinality -> - let CheckStamp acc slot = - match GetVectorExprResult (bt, inputExpr, slot) with - | Available (ires, _, _) -> max acc (func cache ctok ires) - | _ -> acc - [0..cardinality-1] |> List.fold CheckStamp acc - | None -> acc - - | _ -> failwith "expected a VectorStamp" - - /// Given the result of a single action, apply that action to the Build - let ApplyResult(actionResult: ActionResult, bt: PartialBuild) = - match actionResult with - | ResizeResult(id, slotcount) -> - match bt.Results.TryFind id with - | Some resultSet -> - match resultSet with - | VectorResult rv -> - let rv = rv.Resize slotcount - let results = Map.add id (VectorResult rv) bt.Results - PartialBuild(bt.Rules, results) - | _ -> failwith "Unexpected" - | None -> failwith "Unexpected" - | ScalarValuedResult(id, value, timestamp, inputsig) -> - PartialBuild(bt.Rules, Map.add id (ScalarResult(Available (value, timestamp, inputsig))) bt.Results) - | VectorValuedResult(id, values, timestamp, inputsig) -> - let Append acc slot = - Map.add slot (Available (values.[slot], timestamp, inputsig)) acc - let results = [0..values.Length-1]|>List.fold Append Map.empty - let results = VectorResult(ResultVector(values.Length, timestamp, results)) - let bt = PartialBuild(bt.Rules, Map.add id results bt.Results) - bt - - | IndexedResult(id, index, slotcount, value, timestamp) -> - let width = GetVectorWidthById bt id - let priorResults = bt.Results.TryFind id - let prior = - match priorResults with - | Some prior ->prior - | None->VectorResult(ResultVector.OfSize width) - match prior with - | VectorResult rv -> - let result = - match value with - | Eventually.Done res -> - Available (res, timestamp, IndexedValueElement timestamp) - | Eventually.NotYetDone f -> - InProgress (f, timestamp) - let results = rv.Resize(slotcount).Set(index, result) - PartialBuild(bt.Rules, Map.add id (VectorResult results) bt.Results) - | _ -> failwith "Unexpected" - let mutable injectCancellationFault = false let LocallyInjectCancellationFault() = injectCancellationFault <- true { new IDisposable with member __.Dispose() = injectCancellationFault <- false } - /// Apply the result, and call the 'save' function to update the build. - let ExecuteApply (ctok: CompilationThreadToken) save (action: Action) bt = - cancellable { - let! actionResult = action.Execute ctok - let newBt = ApplyResult(actionResult, bt) - save ctok newBt - return newBt - } - - /// Evaluate the result of a single output - let EvalLeafsFirst cache ctok save target bt = - - let rec eval(bt, gen) = - cancellable { - #if DEBUG - // This can happen, for example, if there is a task whose timestamp never stops increasing. - // Possibly could detect this case directly. - if gen>5000 then failwith "Infinite loop in incremental builder?" - #endif - - let workList = CollectActions cache target bt - - let! newBt = - (bt, workList) ||> Cancellable.fold (fun bt action -> - if injectCancellationFault then - Cancellable.canceled() - else - ExecuteApply ctok save action bt) - - if newBt=bt then return bt else return! eval(newBt, gen+1) - } - eval(bt, 0) - - /// Evaluate one step of the build. Call the 'save' function to save the intermediate result. - let Step cache ctok save target (bt: PartialBuild) = - cancellable { - // REVIEW: we're building up the whole list of actions on the fringe of the work tree, - // executing one thing and then throwing the list away. What about saving the list inside the Build instance? - let workList = CollectActions cache target bt - - match workList with - | action :: _ -> - let! res = ExecuteApply ctok save action bt - return Some res - | _ -> - return None - } - - /// Evaluate an output of the build. - /// - /// Intermediate progress along the way may be saved through the use of the 'save' function. - let Eval cache ctok save node bt = EvalLeafsFirst cache ctok save (Target(node, None)) bt - - /// Evaluate an output of the build. - /// - /// Intermediate progress along the way may be saved through the use of the 'save' function. - let EvalUpTo cache ctok save (node, n) bt = EvalLeafsFirst cache ctok save (Target(node, Some n)) bt - - /// Check if an output is up-to-date and ready - let IsReady cache target bt = - let workList = CollectActions cache target bt - workList.IsEmpty - - /// Check if an output is up-to-date and ready - let MaxTimeStampInDependencies cache ctok target bt = - ComputeMaxTimeStamp cache ctok target bt DateTime.MinValue - - /// Get a scalar vector. Result must be available - let GetScalarResult<'T>(node: Scalar<'T>, bt): ('T*DateTime) option = - match GetTopLevelExprByName(bt, node.Name) with - | ScalarBuildRule se -> - match bt.Results.TryFind se.Id with - | Some result -> - match result with - | ScalarResult sr -> - match sr.TryGetAvailable() with - | Some (r, timestamp, _) -> Some (downcast r, timestamp) - | None -> None - | _ ->failwith "Expected a scalar result." - | None->None - | VectorBuildRule _ -> failwith "Expected scalar." - - /// Get a result vector. All results must be available or thrown an exception. - let GetVectorResult<'T>(node: Vector<'T>, bt): 'T[] = - match GetTopLevelExprByName(bt, node.Name) with - | ScalarBuildRule _ -> failwith "Expected vector." - | VectorBuildRule ve -> AvailableAllResultsOfExpr bt ve |> List.map unbox |> Array.ofList - - /// Get an element of vector result or None if there were no results. - let GetVectorResultBySlot<'T>(node: Vector<'T>, slot, bt): ('T*DateTime) option = - match GetTopLevelExprByName(bt, node.Name) with - | ScalarBuildRule _ -> failwith "Expected vector expression" - | VectorBuildRule ve -> - match GetVectorExprResult(bt, ve, slot).TryGetAvailable() with - | Some (o, timestamp, _) -> Some (downcast o, timestamp) - | None->None - - /// Given an input value, find the corresponding slot. - let TryGetSlotByInput<'T>(node: Vector<'T>, build: PartialBuild, found:'T->bool): int option = - let expr = GetExprByName(build, node) - let id = expr.Id - match build.Results.TryFind id with - | None -> None - | Some resultSet -> - match resultSet with - | VectorResult rv -> - let MatchNames acc (slot, result) = - match result with - | Available (o, _, _) -> - let o = o :?> 'T - if found o then Some slot else acc - | _ -> acc - let slotOption = rv.FoldLeft MatchNames None - slotOption - // failwith (sprintf "Could not find requested input '%A' named '%s' in set %+A" input name rv) - | _ -> None // failwith (sprintf "Could not find requested input: %A" input) - - - // Redeclare functions in the incremental build scope----------------------------------------------------------------------- - - // Methods for declaring inputs and outputs - - /// Declares a vector build input. - let InputVector<'T> name = - let expr = VectorInput(NextId(), name) - { new Vector<'T> - interface IVector with - override __.Name = name - override pe.Expr = expr } - - /// Declares a scalar build input. - let InputScalar<'T> name = - let expr = ScalarInput(NextId(), name) - { new Scalar<'T> - interface IScalar with - override __.Name = name - override pe.Expr = expr } - - - module Vector = - /// Maps one vector to another using the given function. - let Map (taskname: string) (task: CompilationThreadToken -> 'I -> 'O) (input: Vector<'I>): Vector<'O> = - let input = input.Expr - let expr = VectorMap(NextId(), taskname, input, (fun ctok x -> box (task ctok (unbox x)))) - { new Vector<'O> - interface IVector with - override __.Name = taskname - override pe.Expr = expr } - - - /// Apply a function to each element of the vector, threading an accumulator argument - /// through the computation. Returns intermediate results in a vector. - let ScanLeft (taskname: string) (task: CompilationThreadToken -> 'A -> 'I -> Eventually<'A>) (acc: Scalar<'A>) (input: Vector<'I>): Vector<'A> = - let BoxingScanLeft ctok a i = Eventually.box(task ctok (unbox a) (unbox i)) - let acc = acc.Expr - let input = input.Expr - let expr = VectorScanLeft(NextId(), taskname, acc, input, BoxingScanLeft) - { new Vector<'A> - interface IVector with - override __.Name = taskname - override pe.Expr = expr } - - /// Apply a function to a vector to get a scalar value. - let Demultiplex (taskname: string) (task: CompilationThreadToken -> 'I[] -> Cancellable<'O>) (input: Vector<'I>): Scalar<'O> = - let BoxingDemultiplex ctok inps = - cancellable { - let! res = task ctok (Array.map unbox inps) - return box res - } - let input = input.Expr - let expr = ScalarDemultiplex(NextId(), taskname, input, BoxingDemultiplex) - { new Scalar<'O> - interface IScalar with - override __.Name = taskname - override pe.Expr = expr } - - /// Creates a new vector with the same items but with - /// timestamp specified by the passed-in function. - let Stamp (taskname: string) (task: TimeStampCache -> CompilationThreadToken -> 'I -> DateTime) (input: Vector<'I>): Vector<'I> = - let input = input.Expr - let expr = VectorStamp (NextId(), taskname, input, (fun cache ctok x -> task cache ctok (unbox x))) - { new Vector<'I> - interface IVector with - override __.Name = taskname - override pe.Expr = expr } - - let AsScalar (taskname: string) (input: Vector<'I>): Scalar<'I array> = - Demultiplex taskname (fun _ctok x -> cancellable.Return x) input - - let VectorInput(node: Vector<'T>, values: 'T list) = (node.Name, values.Length, List.map box values) - - /// Declare build outputs and bind them to real values. - type BuildDescriptionScope() = - let mutable outputs = [] - - /// Declare a named scalar output. - member b.DeclareScalarOutput(output: Scalar<'T>)= - outputs <- NamedScalarOutput output :: outputs - - /// Declare a named vector output. - member b.DeclareVectorOutput(output: Vector<'T>)= - outputs <- NamedVectorOutput output :: outputs - - /// Set the concrete inputs for this build - member b.GetInitialPartialBuild(inputs: BuildInput list) = - ToBound(ToBuild outputs, inputs) - - - - // Record the most recent IncrementalBuilder events, so we can more easily unit test/debug the // 'incremental' behavior of the product. module IncrementalBuilderEventTesting = @@ -1647,7 +710,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput /// This is a build task function that gets placed into the build rules as the computation for a Vector.Demultiplex /// // Link all the assemblies together and produce the input typecheck accumulator - let CombineImportedAssembliesTask ctok _ : Cancellable = + let CombineImportedAssembliesTask ctok : Cancellable = cancellable { let errorLogger = CompilationErrorLogger("CombineImportedAssembliesTask", tcConfig.errorSeverityOptions) // Return the disposable object that cleans up @@ -1841,42 +904,203 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput // START OF BUILD DESCRIPTION // Inputs - let fileNamesNode = InputVector "FileNames" - let referencedAssembliesNode = InputVector*(TimeStampCache -> CompilationThreadToken -> DateTime)> "ReferencedAssemblies" + let fileNames = sourceFiles |> Array.ofList // TODO: This should be an immutable array. + let referencedAssemblies = nonFrameworkAssemblyInputs |> Array.ofList // TODO: This should be an immutable array. + + let stampedFileNames = Array.init fileNames.Length (fun _ -> DateTime.MinValue) + let stampedReferencedAssemblies = Array.init referencedAssemblies.Length (fun _ -> DateTime.MinValue) + let mutable initialSemanticModel = None + let semanticModels = Array.zeroCreate fileNames.Length + let mutable finalizedSemanticModel = None + + let computeStampedFileName (cache: TimeStampCache) (ctok: CompilationThreadToken) slot fileInfo cont = + let currentStamp = stampedFileNames.[slot] + let stamp = StampFileNameTask cache ctok fileInfo + + if currentStamp <> stamp then + // Something changed, the finalized view of the project must be invalidated. + finalizedSemanticModel <- None + + // Invalidate the file and all files below it. + stampedFileNames.[slot..] + |> Array.iteri (fun j _ -> + stampedFileNames.[slot + j] <- StampFileNameTask cache ctok fileNames.[slot + j] + semanticModels.[slot + j] <- None + ) + + if semanticModels.[slot].IsNone then + cont slot fileInfo + + let computeStampedFileNames (cache: TimeStampCache) (ctok: CompilationThreadToken) = + fileNames + |> Array.iteri (fun i fileInfo -> + computeStampedFileName cache ctok i fileInfo (fun _ _ -> ()) + ) + + let computeStampedReferencedAssemblies (cache: TimeStampCache) (ctok: CompilationThreadToken) = + let mutable referencesUpdated = false + referencedAssemblies + |> Array.iteri (fun i asmInfo -> + let currentStamp = stampedReferencedAssemblies.[i] + let stamp = StampReferencedAssemblyTask cache ctok asmInfo + + if currentStamp <> stamp then + referencesUpdated <- true + stampedReferencedAssemblies.[i] <- stamp + ) - // Build - let stampedFileNamesNode = Vector.Stamp "SourceFileTimeStamps" StampFileNameTask fileNamesNode - let stampedReferencedAssembliesNode = Vector.Stamp "StampReferencedAssembly" StampReferencedAssemblyTask referencedAssembliesNode - let initialSemanticModelNode = Vector.Demultiplex "CombineImportedAssemblies" CombineImportedAssembliesTask stampedReferencedAssembliesNode - let semanticModelNodes = Vector.ScanLeft "TypeCheckingStates" (fun ctok semanticModel n -> TypeCheckTask ctok semanticModel (ParseTask ctok n)) initialSemanticModelNode stampedFileNamesNode - let finalizedSemanticModelNode = Vector.Demultiplex "FinalizeTypeCheck" FinalizeTypeCheckTask semanticModelNodes - - // Outputs - let buildDescription = new BuildDescriptionScope () - - do buildDescription.DeclareVectorOutput stampedFileNamesNode - do buildDescription.DeclareVectorOutput stampedReferencedAssembliesNode - do buildDescription.DeclareVectorOutput semanticModelNodes - do buildDescription.DeclareScalarOutput initialSemanticModelNode - do buildDescription.DeclareScalarOutput finalizedSemanticModelNode + if referencesUpdated then + // Something changed, the finalized view of the project must be invalidated. + // This is the only place where the initial semantic model will be invalidated. + initialSemanticModel <- None + finalizedSemanticModel <- None - // END OF BUILD DESCRIPTION - // --------------------------------------------------------------------------------------------- + for i = 0 to stampedFileNames.Length - 1 do + stampedFileNames.[i] <- DateTime.MinValue + semanticModels.[i] <- None - do IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBECreated) + let getStampedFileNames cache ctok = + computeStampedFileNames cache ctok + stampedFileNames + + let getStampedReferencedAssemblies cache ctok = + computeStampedReferencedAssemblies cache ctok + stampedReferencedAssemblies + + let computeInitialSemanticModel (ctok: CompilationThreadToken) = + cancellable { + match initialSemanticModel with + | None -> + let! result = CombineImportedAssembliesTask ctok + initialSemanticModel <- Some result + return result + | Some result -> + return result + } + + let computeSemanticModel (cache: TimeStampCache) (ctok: CompilationThreadToken) (slot: int) = + if IncrementalBuild.injectCancellationFault then Cancellable.canceled () + else + + cancellable { + let! initial = computeInitialSemanticModel ctok + + let fileInfo = fileNames.[slot] + + computeStampedFileName cache ctok slot fileInfo (fun slot fileInfo -> + let prevSemanticModel = + match slot with + | 0 (* first file *) -> initial + | _ -> + match semanticModels.[slot - 1] with + | Some(prevSemanticModel) -> prevSemanticModel + | _ -> + // This shouldn't happen, but on the off-chance, just grab the initial semantic model. + initial + + let semanticModel = TypeCheckTask ctok prevSemanticModel (ParseTask ctok fileInfo) |> Eventually.force ctok + + semanticModels.[slot] <- Some semanticModel + ) + } + + let computeSemanticModels (cache: TimeStampCache) (ctok: CompilationThreadToken) = + cancellable { + for slot = 0 to fileNames.Length - 1 do + do! computeSemanticModel cache ctok slot + } + + let computeFinalizedSemanticModel (cache: TimeStampCache) (ctok: CompilationThreadToken) = + cancellable { + let! _ = computeSemanticModels cache ctok - let buildInputs = [ BuildInput.VectorInput (fileNamesNode, sourceFiles) - BuildInput.VectorInput (referencedAssembliesNode, nonFrameworkAssemblyInputs) ] + match finalizedSemanticModel with + | Some result -> return result + | _ -> + let semanticModels = semanticModels |> Array.choose id + + let! result = FinalizeTypeCheckTask ctok semanticModels + let result = (result, DateTime.UtcNow) + finalizedSemanticModel <- Some result + return result + } - // This is the initial representation of progress through the build, i.e. we have made no progress. - let mutable partialBuild = buildDescription.GetInitialPartialBuild buildInputs + let step (cache: TimeStampCache) (ctok: CompilationThreadToken) = + cancellable { + computeStampedReferencedAssemblies cache ctok + computeStampedFileNames cache ctok - let SavePartialBuild (ctok: CompilationThreadToken) b = - RequireCompilationThread ctok // modifying state - partialBuild <- b + match semanticModels |> Array.tryFindIndex (fun x -> x.IsNone) with + | Some slot -> + do! computeSemanticModel cache ctok slot + return true + | _ -> + return false + } - let MaxTimeStampInDependencies cache (ctok: CompilationThreadToken) (output: INode) = - IncrementalBuild.MaxTimeStampInDependencies cache ctok output.Name partialBuild + let tryGetBeforeSlot slot = + match slot with + | 0 (* first file *) -> + match initialSemanticModel with + | Some initial -> + (initial, DateTime.MinValue) + |> Some + | _ -> + None + | _ -> + match semanticModels.[slot - 1] with + | Some semanticModel -> + (semanticModel, stampedFileNames.[slot - 1]) + |> Some + | _ -> + None + + let eval cache ctok targetSlot = + if targetSlot < 0 then + cancellable { + computeStampedReferencedAssemblies cache ctok + + let! result = computeInitialSemanticModel ctok + return Some(result, DateTime.MinValue) + } + else + let evalUpTo = + cancellable { + for slot = 0 to targetSlot do + do! computeSemanticModel cache ctok slot + } + cancellable { + computeStampedReferencedAssemblies cache ctok + + let! _ = evalUpTo + + return + semanticModels.[targetSlot] + |> Option.map (fun semanticModel -> + (semanticModel, stampedFileNames.[targetSlot]) + ) + } + + let tryGetFinalized cache ctok = + cancellable { + computeStampedReferencedAssemblies cache ctok + + let! res = computeFinalizedSemanticModel cache ctok + return Some res + } + + let MaxTimeStampInDependencies cache (ctok: CompilationThreadToken) getStamps = + let stamps = getStamps cache ctok + if Array.isEmpty stamps then + DateTime.MinValue + else + stamps + |> Array.max + + // END OF BUILD DESCRIPTION + // --------------------------------------------------------------------------------------------- + + do IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBECreated) member __.TcConfig = tcConfig @@ -1899,21 +1123,17 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput member __.Step (ctok: CompilationThreadToken) = cancellable { let cache = TimeStampCache defaultTimeStamp // One per step - let! res = IncrementalBuild.Step cache ctok SavePartialBuild (Target(semanticModelNodes, None)) partialBuild - match res with - | None -> + let! res = step cache ctok + if not res then projectChecked.Trigger() return false - | Some _ -> + else return true } member builder.GetCheckResultsBeforeFileInProjectEvenIfStale filename: PartialCheckResults option = let slotOfFile = builder.GetSlotOfFileName filename - let result = - match slotOfFile with - | (*first file*) 0 -> GetScalarResult(initialSemanticModelNode, partialBuild) - | _ -> GetVectorResultBySlot(semanticModelNodes, slotOfFile-1, partialBuild) + let result = tryGetBeforeSlot slotOfFile match result with | Some (semanticModel, timestamp) -> Some (PartialCheckResults.Create (semanticModel, timestamp)) @@ -1922,24 +1142,14 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput member builder.AreCheckResultsBeforeFileInProjectReady filename = let slotOfFile = builder.GetSlotOfFileName filename - let cache = TimeStampCache defaultTimeStamp - match slotOfFile with - | (*first file*) 0 -> IncrementalBuild.IsReady cache (Target(initialSemanticModelNode, None)) partialBuild - | _ -> IncrementalBuild.IsReady cache (Target(semanticModelNodes, Some (slotOfFile-1))) partialBuild + match tryGetBeforeSlot slotOfFile with + | Some _ -> true + | _ -> false member __.GetCheckResultsBeforeSlotInProject (ctok: CompilationThreadToken, slotOfFile) = cancellable { let cache = TimeStampCache defaultTimeStamp - let! result = - cancellable { - match slotOfFile with - | (*first file*) 0 -> - let! build = IncrementalBuild.Eval cache ctok SavePartialBuild initialSemanticModelNode partialBuild - return GetScalarResult(initialSemanticModelNode, build) - | _ -> - let! build = IncrementalBuild.EvalUpTo cache ctok SavePartialBuild (semanticModelNodes, (slotOfFile-1)) partialBuild - return GetVectorResultBySlot(semanticModelNodes, slotOfFile-1, build) - } + let! result = eval cache ctok (slotOfFile - 1) match result with | Some (semanticModel, timestamp) -> return PartialCheckResults.Create (semanticModel, timestamp) @@ -1971,20 +1181,13 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput member __.GetCheckResultsAndImplementationsForProject(ctok: CompilationThreadToken) = cancellable { let cache = TimeStampCache defaultTimeStamp - let! build = IncrementalBuild.Eval cache ctok SavePartialBuild finalizedSemanticModelNode partialBuild - match GetScalarResult(finalizedSemanticModelNode, build) with + + match! tryGetFinalized cache ctok with | Some ((ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt, semanticModel), timestamp) -> return PartialCheckResults.Create (semanticModel, timestamp), ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt | None -> - // helpers to diagnose https://github.com/Microsoft/visualfsharp/pull/2460/ - let brname = match GetTopLevelExprByName(build, finalizedSemanticModelNode.Name) with ScalarBuildRule se ->se.Id | _ -> Id 0xdeadbeef - let data = (finalizedSemanticModelNode.Name, - ((build.Results :> IDictionary<_, _>).Keys |> Seq.toArray), - brname, - build.Results.ContainsKey brname, - build.Results.TryFind brname |> Option.map (function ScalarResult sr -> Some(sr.TryGetAvailable().IsSome) | _ -> None)) - let msg = sprintf "Build was not evaluated, expected the results to be ready after 'Eval' (GetCheckResultsAndImplementationsForProject, data = %A)." data - return! failwith msg + let msg = "Build was not evaluated, expected the results to be ready after 'tryGetFinalized')." + return! failwith msg } member this.GetFullCheckResultsAndImplementationsForProject(ctok: CompilationThreadToken) = @@ -2000,8 +1203,8 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput } member __.GetLogicalTimeStampForProject(cache, ctok: CompilationThreadToken) = - let t1 = MaxTimeStampInDependencies cache ctok stampedFileNamesNode - let t2 = MaxTimeStampInDependencies cache ctok stampedReferencedAssembliesNode + let t1 = MaxTimeStampInDependencies cache ctok getStampedReferencedAssemblies + let t2 = MaxTimeStampInDependencies cache ctok getStampedFileNames max t1 t2 member __.TryGetSlotOfFileName(filename: string) = @@ -2011,7 +1214,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput String.Compare(filename, f2, StringComparison.CurrentCultureIgnoreCase)=0 || String.Compare(FileSystem.GetFullPathShim filename, FileSystem.GetFullPathShim f2, StringComparison.CurrentCultureIgnoreCase)=0 result - match TryGetSlotByInput(fileNamesNode, partialBuild, CompareFileNames) with + match fileNames |> Array.tryFindIndex CompareFileNames with | Some slot -> Some slot | None -> None @@ -2020,11 +1223,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput | Some slot -> slot | None -> failwith (sprintf "The file '%s' was not part of the project. Did you call InvalidateConfiguration when the list of files in the project changed?" filename) - member __.GetSlotsCount () = - let expr = GetExprByName(partialBuild, fileNamesNode) - match partialBuild.Results.TryFind(expr.Id) with - | Some (VectorResult vr) -> vr.Size - | _ -> failwith "Failed to find sizes" + member __.GetSlotsCount () = fileNames.Length member this.ContainsFile(filename: string) = (this.TryGetSlotOfFileName filename).IsSome @@ -2032,17 +1231,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput member builder.GetParseResultsForFile (ctok: CompilationThreadToken, filename) = cancellable { let slotOfFile = builder.GetSlotOfFileName filename - let! results = - cancellable { - match GetVectorResultBySlot(stampedFileNamesNode, slotOfFile, partialBuild) with - | Some (results, _) -> return results - | None -> - let cache = TimeStampCache defaultTimeStamp - let! build = IncrementalBuild.EvalUpTo cache ctok SavePartialBuild (stampedFileNamesNode, slotOfFile) partialBuild - match GetVectorResultBySlot(stampedFileNamesNode, slotOfFile, build) with - | Some (results, _) -> return results - | None -> return! failwith "Build was not evaluated, expected the results to be ready after 'Eval' (GetParseResultsForFile)." - } + let results = fileNames.[slotOfFile] // re-parse on demand instead of retaining let syntaxTree = ParseTask ctok results return syntaxTree.Parse None diff --git a/src/fsharp/service/IncrementalBuild.fsi b/src/fsharp/service/IncrementalBuild.fsi index 729c258add4..b3607332b7b 100755 --- a/src/fsharp/service/IncrementalBuild.fsi +++ b/src/fsharp/service/IncrementalBuild.fsi @@ -247,93 +247,6 @@ type internal IncrementalBuilder = /// Generalized Incremental Builder. This is exposed only for unit testing purposes. module internal IncrementalBuild = - type INode = - abstract Name: string - - type ScalarBuildRule - type VectorBuildRule - - [] - type IScalar = - inherit INode - abstract Expr: ScalarBuildRule - - [] - type IVector = - inherit INode - abstract Expr: VectorBuildRule - - type Scalar<'T> = interface inherit IScalar end - - type Vector<'T> = interface inherit IVector end - - /// A set of build rules and the corresponding, possibly partial, results from building. - type PartialBuild - - /// Declares a vector build input. - /// Only required for unit testing. - val InputScalar : string -> Scalar<'T> - - /// Declares a scalar build input. - /// Only required for unit testing. - val InputVector : string -> Vector<'T> - - /// Methods for acting on build Vectors - /// Only required for unit testing. - module Vector = - /// Maps one vector to another using the given function. - val Map : string -> (CompilationThreadToken -> 'I -> 'O) -> Vector<'I> -> Vector<'O> - /// Updates the creates a new vector with the same items but with - /// timestamp specified by the passed-in function. - val Stamp : string -> (TimeStampCache -> CompilationThreadToken -> 'I -> System.DateTime) -> Vector<'I> -> Vector<'I> - /// Apply a function to each element of the vector, threading an accumulator argument - /// through the computation. Returns intermediate results in a vector. - val ScanLeft : string -> (CompilationThreadToken -> 'A -> 'I -> Eventually<'A>) -> Scalar<'A> -> Vector<'I> -> Vector<'A> - /// Apply a function to a vector to get a scalar value. - val Demultiplex : string -> (CompilationThreadToken -> 'I[] -> Cancellable<'O>)->Vector<'I> -> Scalar<'O> - /// Convert a Vector into a Scalar. - val AsScalar: string -> Vector<'I> -> Scalar<'I[]> - - type Target = Target of INode * int option /// Used for unit testing. Causes all steps of underlying incremental graph evaluation to cancel val LocallyInjectCancellationFault : unit -> IDisposable - - /// Evaluate a build. Only required for unit testing. - val Eval : TimeStampCache -> CompilationThreadToken -> (CompilationThreadToken -> PartialBuild -> unit) -> INode -> PartialBuild -> Cancellable - - /// Evaluate a build for a vector up to a limit. Only required for unit testing. - val EvalUpTo : TimeStampCache -> CompilationThreadToken -> (CompilationThreadToken -> PartialBuild -> unit) -> INode * int -> PartialBuild -> Cancellable - - /// Do one step in the build. Only required for unit testing. - val Step : TimeStampCache -> CompilationThreadToken -> (CompilationThreadToken -> PartialBuild -> unit) -> Target -> PartialBuild -> Cancellable - - /// Get a scalar vector. Result must be available. Only required for unit testing. - val GetScalarResult : Scalar<'T> * PartialBuild -> ('T * System.DateTime) option - - /// Get a result vector. All results must be available or thrown an exception. Only required for unit testing. - val GetVectorResult : Vector<'T> * PartialBuild -> 'T[] - - /// Get an element of vector result or None if there were no results. Only required for unit testing. - val GetVectorResultBySlot<'T> : Vector<'T> * int * PartialBuild -> ('T * System.DateTime) option - - [] - type BuildInput = - /// Declare a named scalar output. - static member ScalarInput: node:Scalar<'T> * value: 'T -> BuildInput - static member VectorInput: node:Vector<'T> * values: 'T list -> BuildInput - - /// Declare build outputs and bind them to real values. - /// Only required for unit testing. - type BuildDescriptionScope = - new : unit -> BuildDescriptionScope - - /// Declare a named scalar output. - member DeclareScalarOutput : output:Scalar<'T> -> unit - - /// Declare a named vector output. - member DeclareVectorOutput : output:Vector<'T> -> unit - - /// Set the concrete inputs for this build. - member GetInitialPartialBuild : inputs: BuildInput list -> PartialBuild - diff --git a/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs b/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs index ae080ea92cc..03f777c2602 100644 --- a/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs +++ b/tests/FSharp.Compiler.Service.Tests/SurfaceArea.netstandard.fs @@ -18037,16 +18037,17 @@ FSharp.Compiler.AbstractIL.Internal.Library+Array: T[][] heads[T](T[]) FSharp.Compiler.AbstractIL.Internal.Library+Array: Void revInPlace[T](T[]) FSharp.Compiler.AbstractIL.Internal.Library+Array: a[] mapq[a](Microsoft.FSharp.Core.FSharpFunc`2[a,a], a[]) FSharp.Compiler.AbstractIL.Internal.Library+Array: a[] replace[a](Int32, a, a[]) -FSharp.Compiler.AbstractIL.Internal.Library+CancellableBuilder: Cancellable`1 Bind[i,j](Cancellable`1, Microsoft.FSharp.Core.FSharpFunc`2[i,FSharp.Compiler.AbstractIL.Internal.Library+Cancellable`1[j]]) -FSharp.Compiler.AbstractIL.Internal.Library+CancellableBuilder: Cancellable`1 Combine[f](Cancellable`1, Cancellable`1) +FSharp.Compiler.AbstractIL.Internal.Library+CancellableBuilder: Cancellable`1 Bind[k,l](Cancellable`1, Microsoft.FSharp.Core.FSharpFunc`2[k,FSharp.Compiler.AbstractIL.Internal.Library+Cancellable`1[l]]) +FSharp.Compiler.AbstractIL.Internal.Library+CancellableBuilder: Cancellable`1 Combine[h](Cancellable`1, Cancellable`1) FSharp.Compiler.AbstractIL.Internal.Library+CancellableBuilder: Cancellable`1 Delay[a](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,FSharp.Compiler.AbstractIL.Internal.Library+Cancellable`1[a]]) -FSharp.Compiler.AbstractIL.Internal.Library+CancellableBuilder: Cancellable`1 Return[h](h) +FSharp.Compiler.AbstractIL.Internal.Library+CancellableBuilder: Cancellable`1 For[f,g](System.Collections.Generic.IEnumerable`1[f], Microsoft.FSharp.Core.FSharpFunc`2[f,FSharp.Compiler.AbstractIL.Internal.Library+Cancellable`1[g]]) +FSharp.Compiler.AbstractIL.Internal.Library+CancellableBuilder: Cancellable`1 Return[j](j) FSharp.Compiler.AbstractIL.Internal.Library+CancellableBuilder: Cancellable`1 TryFinally[b](Cancellable`1, Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit]) FSharp.Compiler.AbstractIL.Internal.Library+CancellableBuilder: Cancellable`1 TryWith[e](Cancellable`1, Microsoft.FSharp.Core.FSharpFunc`2[System.Exception,FSharp.Compiler.AbstractIL.Internal.Library+Cancellable`1[e]]) FSharp.Compiler.AbstractIL.Internal.Library+CancellableBuilder: Cancellable`1 Using[c,d](c, Microsoft.FSharp.Core.FSharpFunc`2[c,FSharp.Compiler.AbstractIL.Internal.Library+Cancellable`1[d]]) FSharp.Compiler.AbstractIL.Internal.Library+CancellableBuilder: Cancellable`1 Zero() FSharp.Compiler.AbstractIL.Internal.Library+CancellableBuilder: Void .ctor() -FSharp.Compiler.AbstractIL.Internal.Library+CancellableBuilder: g ReturnFrom[g](g) +FSharp.Compiler.AbstractIL.Internal.Library+CancellableBuilder: i ReturnFrom[i](i) FSharp.Compiler.AbstractIL.Internal.Library+CancellableModule: Cancellable`1 bind[a,b](Microsoft.FSharp.Core.FSharpFunc`2[a,FSharp.Compiler.AbstractIL.Internal.Library+Cancellable`1[b]], Cancellable`1) FSharp.Compiler.AbstractIL.Internal.Library+CancellableModule: Cancellable`1 canceled[a]() FSharp.Compiler.AbstractIL.Internal.Library+CancellableModule: Cancellable`1 delay[T](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,FSharp.Compiler.AbstractIL.Internal.Library+Cancellable`1[T]]) diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.IncrementalBuild.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.IncrementalBuild.fs deleted file mode 100644 index 57f66145bfc..00000000000 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.IncrementalBuild.fs +++ /dev/null @@ -1,628 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -namespace Tests.LanguageService - -open System -open System.IO -open System.Threading -open System.Threading.Tasks -open NUnit.Framework -#if NUNIT_V2 -#else -open NUnit.Framework.Constraints -#endif -open Salsa.Salsa -open Salsa.VsOpsUtils -open FSharp.Compiler -open FSharp.Compiler.CompilerConfig -open FSharp.Compiler.SourceCodeServices -open FSharp.Compiler.IncrementalBuild -open FSharp.Compiler.AbstractIL.Internal.Library - -// Useful methods that someday might go into IncrementalBuild -module internal Vector = - /// Convert from vector to a scalar - let ToScalar<'I> (taskname:string) (input:Vector<'I>) : Scalar<'I array> = - let Identity _ inArray = inArray |> cancellable.Return - Vector.Demultiplex taskname Identity input - -[] -module internal Values = - let ctok = AssumeCompilationThreadWithoutEvidence() - -[] -[] -[] -[] -type IncrementalBuild() = - - let save _ctok _ = () - - /// Called per test - [] - member this.Setup() = - //Trace.Log <- "IncrementalBuild" - () - - - // This test is related to - // 835552 Language service loses track of files in project due to intermitent file read failures - // It verifies that incremental builder can handle changes to timestamps that happen _before_ the - // stamp function exists. This ensures there's not a race in the data gathered for tracking file - // timestamps in parsing. - [] - member public rb.StampUpdate() = - let path = Path.GetTempFileName() - - let TouchFile() = - printfn "Touching file" - File.WriteAllText(path,"Some text") - - let updateStamp = ref true - - let StampFile _cache _ctok filename = - let result = File.GetLastWriteTimeUtc(filename) - if !updateStamp then - // Here, simulate that VS is writing to our file. - TouchFile() - result - - let Map _ctok filename = - "map:"+filename - - let buildDesc = new BuildDescriptionScope() - let input = InputVector "InputVector" - let stamped = Vector.Stamp "Stamp" StampFile input - let mapped = Vector.Map "Map" Map stamped - buildDesc.DeclareVectorOutput mapped - let inputs = [ BuildInput.VectorInput(input, [path]) ] - let bound = buildDesc.GetInitialPartialBuild inputs - - let DoCertainStep bound = - let cache = TimeStampCache(System.DateTime.UtcNow) - match IncrementalBuild.Step cache ctok save (Target(mapped,None)) bound |> Cancellable.runWithoutCancellation with - | Some bound -> bound - | None -> failwith "Expected to be able to step" - - // While updateStamp is true we should be able to step as continuously - // because there will always be more to bound. - let mutable bound = bound - for i in 0..5 do - printfn "Iteration %d" i - bound <- DoCertainStep bound - System.Threading.Thread.Sleep 2000 - - // Now, turn off updateStamp and the build should just finish. - updateStamp:=false - bound <- DoCertainStep bound - bound <- DoCertainStep bound - let cache = TimeStampCache(System.DateTime.UtcNow) - match IncrementalBuild.Step cache ctok save (Target (mapped, None)) bound |> Cancellable.runWithoutCancellation with - | Some bound -> failwith "Build should have stopped" - | None -> () - - - /// Test that stamp works - [] - member public rb.StampScan() = - - let mapSuffix = ref "Suffix1" - let Scan ctok acc filename = - eventually { return acc+"-"+filename+"-"+(!mapSuffix) } - - let stampAs = ref DateTime.UtcNow - let StampFile _cache _ctok filename = - !stampAs - - let buildDesc = new BuildDescriptionScope() - let input = InputVector "InputVector" - let acc = InputScalar "Accumulator" - let stamped = Vector.Stamp "Stamp" StampFile input - let scanned = Vector.ScanLeft "Scan" Scan acc stamped - buildDesc.DeclareVectorOutput scanned - let inputs = - [ BuildInput.VectorInput(input, ["File1.fs"; "File2.fs"; "File3.fs"]) - BuildInput.ScalarInput(acc, "AccVal") ] - let bound = buildDesc.GetInitialPartialBuild inputs - - printf "-[Step1]----------------------------------------------------------------------------------------\n" - // Evaluate the first time. - let cache = TimeStampCache(System.DateTime.UtcNow) - let bound = Eval cache ctok save scanned bound |> Cancellable.runWithoutCancellation - let r = GetVectorResult (scanned, bound) - Assert.AreEqual("AccVal-File1.fs-Suffix1-File2.fs-Suffix1",r.[1]) - - printf "-[Step2]----------------------------------------------------------------------------------------\n" - // Evaluate the second time. No change should be seen. - mapSuffix:="Suffix2" - let cache = TimeStampCache(System.DateTime.UtcNow) - let bound = Eval cache ctok save scanned bound |> Cancellable.runWithoutCancellation - let r = GetVectorResult (scanned,bound) - Assert.AreEqual("AccVal-File1.fs-Suffix1-File2.fs-Suffix1",r.[1]) - - printf "-[Step3]----------------------------------------------------------------------------------------\n" - // Evaluate a third time with timestamps updated. Should cause a rebuild - System.Threading.Thread.Sleep 10 // Sleep a little to avoid grabbing the same 'Now' - stampAs:=DateTime.UtcNow - let cache = TimeStampCache(System.DateTime.UtcNow) - let bound = Eval cache ctok save scanned bound |> Cancellable.runWithoutCancellation - let r = GetVectorResult (scanned,bound) - Assert.AreEqual("AccVal-File1.fs-Suffix2-File2.fs-Suffix2",r.[1]) - - - /// Test case of zero elements in a vector - [] - member public rb.aaZeroElementVector() = // Starts with 'aa' to put it at the front. - let stamp = ref DateTime.UtcNow - let Stamp _cache _ctok (s:string) = !stamp - let Map ctok (s:string) = s - let Demult ctok (a:string[]) = a.Length |> cancellable.Return - - let buildDesc = new BuildDescriptionScope() - let inputVector = InputVector "InputVector" - let stamped = Vector.Stamp "Stamp" Stamp inputVector - let mapped = Vector.Map "Map" Map stamped - let result = Vector.Demultiplex "Demult" Demult mapped - buildDesc.DeclareVectorOutput stamped - buildDesc.DeclareVectorOutput mapped - buildDesc.DeclareScalarOutput result - - // Try first with one input - let inputs1 = [ BuildInput.VectorInput(inputVector, [""]) ] - let build1 = buildDesc.GetInitialPartialBuild inputs1 - - let cache = TimeStampCache(System.DateTime.UtcNow) - let build1Evaled = Eval cache ctok save result build1 |> Cancellable.runWithoutCancellation - let r1 = GetScalarResult (result, build1Evaled) - match r1 with - | Some(v,dt) -> Assert.AreEqual(1,v) - | None -> failwith "Expected the value 1 to be returned." - - // Now with zero. This was the original bug. - stamp := DateTime.UtcNow - let inputs0 = [ BuildInput.VectorInput(inputVector, []) ] - let build0 = buildDesc.GetInitialPartialBuild inputs0 - - let cache = TimeStampCache(System.DateTime.UtcNow) - let build0Evaled = Eval cache ctok save result build0 |> Cancellable.runWithoutCancellation - let r0 = GetScalarResult (result, build0Evaled) - match r0 with - | Some(v,dt) -> Assert.AreEqual(0,v) - | None -> failwith "Expected the value 0 to be returned." - () - - - /// Here, we want a multiplex to increase the number of items processed. - [] - member public rb.MultiplexTransitionUp() = - let elements = ref 1 - let timestamp = ref System.DateTime.UtcNow - let Input() : string array = [| for i in 1..!elements -> sprintf "Element %d" i |] - let Stamp _cache ctok s = !timestamp - let Map ctok (s:string) = sprintf "Mapped %s " s - let Result ctok (a:string[]) = String.Join(",", a) |> cancellable.Return - let now = System.DateTime.UtcNow - let FixedTimestamp _cache _ctok _ = now - - let buildDesc = new BuildDescriptionScope() - let input = InputVector "InputVector" - let stampedInput = Vector.Stamp "StampInput" Stamp input - //let demultiplexedInput = Vector.Demultiplex "DemultInput" Demult stampedInput - //let multiplexed = Scalar.Multiplex "Mult" Mult demultiplexedInput - let mapped = Vector.Map "Map" Map stampedInput - let mapped = Vector.Stamp "FixedTime" FixedTimestamp mapped // Change in vector size should x-ray through even if timestamps haven't changed in remaining items. - let result = Vector.Demultiplex "DemultResult" Result mapped - buildDesc.DeclareScalarOutput result - - // Create the build. - let inputs = [ BuildInput.VectorInput(input, ["Input 0"]) ] - let bound = buildDesc.GetInitialPartialBuild inputs - - // Evaluate it with value 1 - elements := 1 - let cache = TimeStampCache(System.DateTime.UtcNow) - let bound = Eval cache ctok save result bound |> Cancellable.runWithoutCancellation - let r1 = GetScalarResult(result, bound) - match r1 with - | Some(s,dt) -> printfn "%s" s - | None -> failwith "" - - // Now, re-evaluate it with value 2 - elements := 2 - System.Threading.Thread.Sleep(100) - timestamp := System.DateTime.UtcNow - - let cache = TimeStampCache(System.DateTime.UtcNow) - let bound = Eval cache ctok save result bound |> Cancellable.runWithoutCancellation - let r2 = GetScalarResult (result, bound) - match r2 with - | Some(s,dt) -> Assert.AreEqual("Mapped Input 0 ",s) - | None -> failwith "" - - (* - /// Here, we want a multiplex to decrease the number of items processed. - [] - member public rb.MultiplexTransitionDown() = - let elements = ref 1 - let timestamp = ref System.DateTime.UtcNow - let Mult(s:string) : string array = [| for i in 1..!elements -> sprintf "Element %d" i |] - let Stamp(s) = !timestamp - let Map(s:string) = - printfn "Map called with %s" s - sprintf "Mapped %s " s - let Demult(a:string array) : string = - printfn "Demult called with %d items" a.Length - sprintf "Demult %s" (String.Join(",",a)) - let Result(a:string array) : string = - let result = String.Join(",", a) - printfn "Result called with %d items returns %s" a.Length result - result - let now = System.DateTime.UtcNow - let FixedTimestamp _ = - printfn "Fixing timestamp" - now - - let buildDesc = new BuildDescriptionScope() - let input = InputVector "InputVector" - let stampedInput = Vector.Stamp "StampInput" Stamp input - let demultiplexedInput = Vector.Demultiplex "DemultInput" Demult stampedInput - let multiplexed = Scalar.Multiplex "Mult" Mult demultiplexedInput - let mapped = Vector.Map "Map" Map multiplexed - let fixedmapped = Vector.Stamp "FixedTime" FixedTimestamp mapped // Change in vector size should x-ray through even if timestamps haven't changed in remaining items. - let result = Vector.Demultiplex "DemultResult" Result fixedmapped - - buildDesc.DeclareScalarOutput demultiplexedInput - buildDesc.DeclareVectorOutput mapped - buildDesc.DeclareVectorOutput fixedmapped - buildDesc.DeclareScalarOutput result - - // Create the build. - let bound = buildDesc.GetInitialPartialBuild(["InputVector",1,[box "Input 0"]],[]) - - // Evaluate it with value 2 - elements := 2 - let bound = Eval result bound - let r1 = GetScalarResult(result, bound) - match r1 with - | Some(s,dt) -> printfn "%s" s - | None -> failwith "" - - // Now, re-evaluate it with value 1 - elements := 1 - System.Threading.Thread.Sleep(100) - timestamp := System.DateTime.UtcNow - - let buildDemuxed = Eval demultiplexedInput bound - let rdm = GetScalarResult (demultiplexedInput,buildDemuxed) - match rdm with - | Some(s,dt)->Assert.AreEqual("Demult Input 0", s) - | None -> failwith "unexpected" - - let buildMapped = Eval mapped bound - let mp = GetVectorResult (mapped,buildMapped) - Assert.AreEqual(1,mp.Length) - let melem = mp.[0] - Assert.AreEqual("Mapped Element 1 ", melem) - - let buildFixedMapped = Eval fixedmapped buildMapped - let mp = GetVectorResult (fixedmapped,buildFixedMapped) - Assert.AreEqual(1,mp.Length) - let melem = mp.[0] - Assert.AreEqual("Mapped Element 1 ", melem) - - let bound = Eval result bound - let r2 = GetScalarResult(result, bound) - match r2 with - | Some(s,dt) -> Assert.AreEqual("Mapped Element 1 ",s) - | None -> failwith "unexpected" - *) - - /// Test that stamp works - [] - member public rb.StampMap() = - - let mapSuffix = ref "Suffix1" - let MapIt ctok filename = - filename+"."+(!mapSuffix) - - let stampAs = ref DateTime.UtcNow - let StampFile _cache ctok filename = - !stampAs - - let buildDesc = new BuildDescriptionScope() - let input = InputVector "InputVector" - let stamped = Vector.Stamp "Stamp" StampFile input - let mapped = Vector.Map "Map" MapIt stamped - buildDesc.DeclareVectorOutput mapped - let inputs = [ BuildInput.VectorInput(input, ["File1.fs";"File2.fs";"File3.fs"]) ] - let bound = buildDesc.GetInitialPartialBuild inputs - - printf "-[Step1]----------------------------------------------------------------------------------------\n" - // Evaluate the first time. - let cache = TimeStampCache(System.DateTime.UtcNow) - let bound = Eval cache ctok save mapped bound |> Cancellable.runWithoutCancellation - let r = GetVectorResult (mapped,bound) - Assert.AreEqual("File2.fs.Suffix1",r.[1]) - - printf "-[Step2]----------------------------------------------------------------------------------------\n" - // Evaluate the second time. No change should be seen. - mapSuffix:="Suffix2" - let cache = TimeStampCache(System.DateTime.UtcNow) - let bound = Eval cache ctok save mapped bound |> Cancellable.runWithoutCancellation - let r = GetVectorResult (mapped,bound) - Assert.AreEqual("File2.fs.Suffix1",r.[1]) - - printf "-[Step3]----------------------------------------------------------------------------------------\n" - // Evaluate a third time with timestamps updated. Should cause a rebuild - let cache = TimeStampCache(System.DateTime.UtcNow) - while !stampAs = DateTime.UtcNow do - System.Threading.Thread.Sleep 10 // Sleep a little to avoid grabbing the same 'Now' - stampAs:=DateTime.UtcNow - let bound = Eval cache ctok save mapped bound |> Cancellable.runWithoutCancellation - let r = GetVectorResult (mapped,bound) - Assert.AreEqual("File2.fs.Suffix2",r.[1]) - - /// Test that stamp works - [] - member public rb.StampDemultiplex() = - - let joinedResult = ref "Join1" - let Join ctok (filenames:_[]) = - !joinedResult |> cancellable.Return - - let stampAs = ref DateTime.UtcNow - let StampFile _cache ctok filename = - !stampAs - - let buildDesc = new BuildDescriptionScope() - let input = InputVector "InputVector" - let stamped = Vector.Stamp "Stamp" StampFile input - let joined = Vector.Demultiplex "Demultiplex" Join stamped - buildDesc.DeclareScalarOutput joined - let inputs = [ BuildInput.VectorInput(input, ["File1.fs";"File2.fs";"File3.fs"]) ] - let bound = buildDesc.GetInitialPartialBuild inputs - - printf "-[Step1]----------------------------------------------------------------------------------------\n" - // Evaluate the first time. - let cache = TimeStampCache(System.DateTime.UtcNow) - let bound = Eval cache ctok save joined bound |> Cancellable.runWithoutCancellation - let (r,_) = Option.get (GetScalarResult(joined,bound)) - Assert.AreEqual("Join1",r) - - printf "-[Step2]----------------------------------------------------------------------------------------\n" - // Evaluate the second time. No change should be seen. - joinedResult:="Join2" - let cache = TimeStampCache(System.DateTime.UtcNow) - let bound = Eval cache ctok save joined bound |> Cancellable.runWithoutCancellation - let (r,_) = Option.get (GetScalarResult (joined,bound)) - Assert.AreEqual("Join1",r) - - printf "-[Step3]----------------------------------------------------------------------------------------\n" - // Evaluate a third time with timestamps updated. Should cause a rebuild - while !stampAs = DateTime.UtcNow do - System.Threading.Thread.Sleep 10 // Sleep a little to avoid grabbing the same 'Now' - stampAs:=DateTime.UtcNow - let cache = TimeStampCache(System.DateTime.UtcNow) - let bound = Eval cache ctok save joined bound |> Cancellable.runWithoutCancellation - let (r,_) = Option.get (GetScalarResult (joined,bound)) - Assert.AreEqual("Join2",r) - - - /// Test that Demultiplex followed by ScanLeft works - [] - member public rb.DemultiplexScanLeft() = - let Size ctok (ar:_[]) = ar.Length |> cancellable.Return - let Scan ctok acc (file :string) = eventually { return acc + file.Length } - let buildDesc = new BuildDescriptionScope() - let inVector = InputVector "InputVector" - let vectorSize = Vector.Demultiplex "Demultiplex" Size inVector - let scanned = Vector.ScanLeft "Scan" Scan vectorSize inVector - buildDesc.DeclareScalarOutput vectorSize - buildDesc.DeclareVectorOutput scanned - let inputs = [ BuildInput.VectorInput(inVector, ["File1.fs";"File2.fs";"File3.fs"]) ] - let bound = buildDesc.GetInitialPartialBuild inputs - - let cache = TimeStampCache(System.DateTime.UtcNow) - let e = Eval cache ctok save scanned bound |> Cancellable.runWithoutCancellation - let r = GetScalarResult (vectorSize,e) - match r with - | Some(r,_) -> Assert.AreEqual(3,r) - | None -> Assert.Fail("No size was returned") - - - /// Test that a simple scalar action works. - [] - member public rb.Scalar() = - let buildDesc = new BuildDescriptionScope() - let inScalar = InputScalar "Scalar" - buildDesc.DeclareScalarOutput inScalar - let inputs = [ BuildInput.ScalarInput(inScalar, "A Scalar Value") ] - let bound = buildDesc.GetInitialPartialBuild inputs - - let cache = TimeStampCache(System.DateTime.UtcNow) - let e = Eval cache ctok save inScalar bound |> Cancellable.runWithoutCancellation - let r = GetScalarResult(inScalar,e) - match r with - | Some(r,_) -> Assert.AreEqual("A Scalar Value", r) - | None -> Assert.Fail() - - /// Test that ScanLeft works. - [] - member public rb.ScanLeft() = - let DoIt ctok (a:int*string) (b:string) = - eventually { return ((fst a)+1,b) } - - let buildDesc = new BuildDescriptionScope() - let inScalar = InputScalar "InputScalar" - let inVector = InputVector "InputVector" - let result = Vector.ScanLeft "DoIt" DoIt inScalar inVector - buildDesc.DeclareVectorOutput result - - let inputs = - [ BuildInput.VectorInput(inVector, ["File1.fs";"File2.fs";"File3.fs"]); - BuildInput.ScalarInput(inScalar, (5,"")) ] - - let bound = buildDesc.GetInitialPartialBuild(inputs) - let cache = TimeStampCache(System.DateTime.UtcNow) - let e = Eval cache ctok save result bound |> Cancellable.runWithoutCancellation - let r = GetVectorResult(result,e) - if [| (6,"File1.fs"); (7,"File2.fs"); (8, "File3.fs") |] <> r then - printfn "Got %A" r - Assert.Fail() - () - - /// Convert a vector to a scalar - [] - member public rb.ToScalar() = - let buildDesc = new BuildDescriptionScope() - let inVector = InputVector "InputVector" - let result = Vector.ToScalar "ToScalar" inVector - buildDesc.DeclareScalarOutput result - let inputs = [ BuildInput.VectorInput(inVector, ["File1.fs";"File2.fs";"File3.fs"]) ] - let bound = buildDesc.GetInitialPartialBuild(inputs) - - let cache = TimeStampCache(System.DateTime.UtcNow) - let e = Eval cache ctok save result bound |> Cancellable.runWithoutCancellation - let r = GetScalarResult (result, e) - match r with - | Some(r,ts)-> - if "File3.fs"<>(r.[2]) then - printf "Got %A\n" (r.[2]) - Assert.Fail() - | None -> Assert.Fail() - - - - /// Check a cancellation - [] - member public rb.``Can cancel Eval``() = - let buildDesc = new BuildDescriptionScope() - let inVector = InputVector "InputVector" - let result = Vector.ToScalar "ToScalar" inVector - buildDesc.DeclareScalarOutput result - let inputs = [ BuildInput.VectorInput(inVector, ["File1.fs";"File2.fs";"File3.fs"]) ] - let bound = buildDesc.GetInitialPartialBuild(inputs) - - let cts = new CancellationTokenSource() - cts.Cancel() - let res = - let cache = TimeStampCache(System.DateTime.UtcNow) - match Eval cache ctok save result bound |> Cancellable.run cts.Token with - | ValueOrCancelled.Cancelled _ -> true - | ValueOrCancelled.Value _ -> false - Assert.AreEqual(res, true) - - - /// This test replicates the data flow of the assembly reference model. It includes several concepts - /// that were new at the time: Scalars, Invalidation, Disposal - [] - member public rb.AssemblyReferenceModel() = - let ParseTask ctok filename = sprintf "Parse(%s)" filename - let now = System.DateTime.UtcNow - let StampFileNameTask _cache ctok filename = now - let TimestampReferencedAssemblyTask _cache ctok reference = now - let ApplyMetaCommands ctok (parseResults:string[]) = "tcConfig-of("+String.Join(",",parseResults)+")" - let GetReferencedAssemblyNames ctok (tcConfig) = [|"Assembly1.dll";"Assembly2.dll";"Assembly3.dll"|] - let ReadAssembly ctok assemblyName = sprintf "tcImport-of(%s)" assemblyName - let CombineImportedAssembliesTask ctok imports = "tcAcc" |> cancellable.Return - let TypeCheckTask ctok tcAcc parseResults = eventually { return tcAcc } - let FinalizeTypeCheckTask ctok results = "finalized" |> cancellable.Return - - // Build rules. - let buildDesc = new BuildDescriptionScope() - - // Inputs - let fileNamesNode = InputVector "Filenames" - let referencedAssembliesNode = InputVector "ReferencedAssemblies" - - //Build - let stampedFileNamesNode = Vector.Stamp "SourceFileTimeStamps" StampFileNameTask fileNamesNode - let parseTreesNode = Vector.Map "ParseTrees" ParseTask stampedFileNamesNode - let stampedReferencedAssembliesNode = Vector.Stamp "TimestampReferencedAssembly" TimestampReferencedAssemblyTask referencedAssembliesNode - - let initialTcAccNode = Vector.Demultiplex "CombineImportedAssemblies" CombineImportedAssembliesTask stampedReferencedAssembliesNode - - let tcStatesNode = Vector.ScanLeft "TypeCheckingStates" TypeCheckTask initialTcAccNode parseTreesNode - - let finalizedTypeCheckNode = Vector.Demultiplex "FinalizeTypeCheck" FinalizeTypeCheckTask tcStatesNode - let buildDesc = new BuildDescriptionScope () - - do buildDesc.DeclareVectorOutput stampedFileNamesNode - do buildDesc.DeclareVectorOutput stampedReferencedAssembliesNode - do buildDesc.DeclareVectorOutput parseTreesNode - do buildDesc.DeclareVectorOutput tcStatesNode - do buildDesc.DeclareScalarOutput initialTcAccNode - do buildDesc.DeclareScalarOutput finalizedTypeCheckNode - - let inputs = - [ BuildInput.VectorInput(fileNamesNode, ["File1.fs";"File2.fs";"File3.fs"]); - BuildInput.VectorInput(referencedAssembliesNode, [("lib1.dll", now);("lib2.dll", now)]) ] - let bound = buildDesc.GetInitialPartialBuild(inputs) - let cache = TimeStampCache(System.DateTime.UtcNow) - let e = Eval cache ctok save finalizedTypeCheckNode bound |> Cancellable.runWithoutCancellation - let r = GetScalarResult(finalizedTypeCheckNode,e) - - () - - [] - member public rb.OneToOneWorks() = - let VectorModify ctok (input:int) : string = - sprintf "Transformation of %d" input - - let buildDesc = new BuildDescriptionScope() - let inputs = InputVector "Inputs" - let outputs = Vector.Map "Modify" VectorModify inputs - buildDesc.DeclareVectorOutput outputs - let inputs = [ BuildInput.VectorInput(inputs, [1;2;3;4]) ] - let bound = buildDesc.GetInitialPartialBuild inputs - - let cache = TimeStampCache(System.DateTime.UtcNow) - let evaled = Eval cache ctok save outputs bound |> Cancellable.runWithoutCancellation - let outputs = GetVectorResult(outputs,evaled) - Assert.AreEqual("Transformation of 4", outputs.[3]) - () - - /// In this bug, the desired output is between other outputs. - /// The getExprById function couldn't find it. - [] - member public rb.HiddenOutputGroup() = - let VectorModify ctok (input:int) : string = - sprintf "Transformation of %d" input - - let buildDesc = new BuildDescriptionScope() - let inputs = InputVector "Inputs" - let outputs = Vector.Map "Modify" VectorModify inputs - buildDesc.DeclareVectorOutput inputs - buildDesc.DeclareVectorOutput inputs - buildDesc.DeclareVectorOutput inputs - buildDesc.DeclareVectorOutput outputs - buildDesc.DeclareVectorOutput inputs - buildDesc.DeclareVectorOutput inputs - buildDesc.DeclareVectorOutput inputs - let inputs = [ BuildInput.VectorInput(inputs, [1;2;3;4]) ] - let bound = buildDesc.GetInitialPartialBuild inputs - - let cache = TimeStampCache(System.DateTime.UtcNow) - let evaled = Eval cache ctok save outputs bound |> Cancellable.runWithoutCancellation - let outputs = GetVectorResult(outputs,evaled) - Assert.AreEqual("Transformation of 4", outputs.[3]) - () - - /// Empty build should just be a NOP. - [] - member public rb.EmptyBuildIsNop() = - let VectorModify ctok (input:int) : string = - sprintf "Transformation of %d" input - - let buildDesc = new BuildDescriptionScope() - let inputs = InputVector "Inputs" - let outputs = Vector.Map "Modify" VectorModify inputs - buildDesc.DeclareVectorOutput outputs - let inputs = [ BuildInput.VectorInput(inputs, []) ] - let bound = buildDesc.GetInitialPartialBuild inputs - - let cache = TimeStampCache(System.DateTime.UtcNow) - let evaled = Eval cache ctok save outputs bound |> Cancellable.runWithoutCancellation - let outputs = GetVectorResult(outputs,evaled) - () - diff --git a/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj b/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj index c3028d5b8c9..0d7eb34bbcb 100644 --- a/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj +++ b/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj @@ -40,7 +40,6 @@ -