/compiler/3.1/Nov2013/src/fsharp/vs/IncrementalBuild.fs

Large files files are truncated, but you can click here to view the full file

namespace Microsoft.FSharp.Compiler

#nowarn "57"

open Internal.Utilities.Debug

open Internal.Utilities.FileSystem

open System

open System.IO

open System.Reflection             

open System.Diagnostics

open System.Collections.Generic

open System



open Microsoft.FSharp.Compiler

open Microsoft.FSharp.Compiler.Range

open Microsoft.FSharp.Compiler.Build

open Microsoft.FSharp.Compiler.Tastops

open Microsoft.FSharp.Compiler.ErrorLogger

open Microsoft.FSharp.Compiler.Lib

open Microsoft.FSharp.Compiler.AbstractIL

open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library 



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

        static member toInt (Id id) = id

        override id.ToString() = match id with Id(n) ->sprintf "Id(%d)" n

            

    [<NoEquality; NoComparison>]

    /// 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 * (obj[] -> obj)



        /// ScalarMap (uniqueRuleId, outputName, input, taskFunction)

        ///

        /// A build rule representing the transformation of a single input to a single output

        | ScalarMap of Id * string * ScalarBuildRule * (obj->obj)



        /// Get the Id for the given ScalarBuildRule.

        static member GetId = function

            | ScalarInput(id,_) ->id

            | ScalarDemultiplex(id,_,_,_) ->id

            | ScalarMap(id,_,_,_) ->id

        /// Get the Name for the givenScalarExpr.

        static member GetName = function

            | ScalarInput(_,n) ->n                

            | ScalarDemultiplex(_,n,_,_) ->n

            | ScalarMap(_,n,_,_) ->n                

        override ve.ToString() = 

            match ve with 

            | ScalarInput(Id id,name) ->sprintf "InputScalar(%d,%s)" id name

            | ScalarDemultiplex(Id id,name,_,_) ->sprintf "ScalarDemultiplex(%d,%s)" id name

            | ScalarMap(Id id,name,_,_) ->sprintf "ScalarMap(%d,%s)" id name



    /// 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 combinining a single scalar accumulator input with a vector of inputs

        | VectorScanLeft of Id * string * ScalarBuildRule * VectorBuildRule * (obj->obj->Eventually<obj>)



        /// VectorMap (uniqueRuleId, outputName, inputs, taskFunction)

        ///

        /// A build rule representing the parallel map of the inputs to outputs

        | VectorMap of Id * string * VectorBuildRule * (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 * (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 * (obj->obj[])



        /// Get the Id for the given VectorBuildRule.

        static member GetId = function

            | VectorInput(id,_) ->id

            | VectorScanLeft(id,_,_,_,_) ->id

            | VectorMap(id,_,_,_) ->id

            | VectorStamp(id,_,_,_) ->id

            | VectorMultiplex(id,_,_,_) ->id

        /// Get the Name for the given VectorBuildRule.

        static member GetName = function

            | VectorInput(_,n) ->n

            | VectorScanLeft(_,n,_,_,_) ->n

            | VectorMap(_,n,_,_) ->n

            | VectorStamp(_,n,_,_) ->n

            | VectorMultiplex(_,n,_,_) ->n

        override ve.ToString() = 

            match ve with 

            | VectorInput(Id id,name) ->sprintf "VectorInput(%d,%s)" id name

            | VectorScanLeft(Id id,name,_,_,_) ->sprintf "VectorScanLeft(%d,%s)" id name

            | VectorMap(Id id,name,_,_) ->sprintf "VectorMap(%d,%s)" id name

            | VectorStamp(Id id,name,_,_) ->sprintf "VectorStamp(%d,%s)" id name

            | VectorMultiplex(Id id,name,_,_) ->sprintf "VectorMultiplex(%d,%s)" id name

        

    [<NoEquality; NoComparison>]

    type BuildRuleExpr =

        | ScalarBuildRule of ScalarBuildRule

        | VectorBuildRule of VectorBuildRule      

        /// Get the Id for the given Expr.

        static member GetId = function

            | ScalarBuildRule se ->ScalarBuildRule.GetId se

            | VectorBuildRule ve ->VectorBuildRule.GetId ve      

        /// Get the Name for the given Expr.

        static member GetName= function

            | ScalarBuildRule se ->ScalarBuildRule.GetName se

            | VectorBuildRule ve ->VectorBuildRule.GetName ve      

        override e.ToString() = 

            match e with 

            | ScalarBuildRule _ -> sprintf "ScalarBuildRule se" 

            | VectorBuildRule _ -> sprintf "VectorBuildRule ve"



    // Ids of exprs            

    let nextid = ref 999 // Number ids starting with 1000 to discern them

    let NextId() =

        nextid:=!nextid+1

        Id(!nextid)                    

        

    type IScalar = 

        abstract GetScalarExpr : unit -> ScalarBuildRule

    type IVector =

        abstract GetVectorExpr : unit-> VectorBuildRule

            

    type Scalar<'T> =  interface  end



    type Vector<'T> = interface end

    

    /// The outputs of a build        

    [<NoEquality; NoComparison>]

    type NamedOutput = 

        | NamedVectorOutput of string * IVector

        | NamedScalarOutput of string * 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 rec 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(n,v) -> n,VectorBuildRule(v.GetVectorExpr())

                                                 | NamedScalarOutput(n,s) -> n,ScalarBuildRule(s.GetScalarExpr())) }

        

        // Ensure that all names are unique.

        let EnsureUniqueNames (expr:BuildRuleExpr) (acc:Map<string,Id>) = 

            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 = BuildRuleExpr.GetId(expr)

            let name = BuildRuleExpr.GetName(expr)

            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() = 

        

            let rec IsEvaluated(is) =

                match is with

                | UnevaluatedInput -> false

                | SingleMappedVectorInput iss -> iss |> Array.forall IsEvaluated

                | _ -> true

            IsEvaluated(is)

        override is.ToString() = sprintf "%A" is

            

    

    /// A slot for holding a single result.

    type Result =

        | NotAvailable

        | InProgress of (unit -> Eventually<obj>) * DateTime 

        | Available of obj * DateTime * InputSignature

        /// Get the available result. Throw an exception if not available.

        static member GetAvailable = function Available(o,_,_) ->o  | _->failwith "No available result"

        /// Get the time stamp if available. Otheriwse MaxValue.        

        static member Timestamp = function Available(_,ts,_) ->ts | InProgress(_,ts) -> ts | _-> DateTime.MaxValue

        /// Get the time stamp if available. Otheriwse MaxValue.        

        static member InputSignature = function Available(_,_,signature) ->signature | _-> UnevaluatedInput

        

        member x.ResultIsInProgress =  match x with | InProgress _ -> true | _ -> false

        member x.GetInProgressContinuation() =  match x with | InProgress (f,_) -> f() | _ -> failwith "not in progress"

        member x.TryGetAvailable() =  match x with | InProgress _ | NotAvailable -> None | Available(obj,dt,i) -> Some(obj,dt,i)



        override r.ToString() = 

            match r with 

            | NotAvailable -> "NotAvailable"

            | InProgress _ -> "InProgress"

            | Available(o, ts, _) -> sprintf "Available('%s' as of %A)" (o.ToString()) ts

            

    /// 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() =

//            use t = Trace.Call("IncrementalBuildVerbose", "MaxTimestamp",  fun _->sprintf "vector of size=%d" size)

            let Maximize (lasttimestamp:DateTime) (_,result) = 

                let thistimestamp = Result.Timestamp result

                let m = max lasttimestamp thistimestamp

//                use t = Trace.Call("IncrementalBuildVerbose", "Maximize",  fun _->sprintf "last=%s this=%s max=%s" (lasttimestamp.ToString()) (thistimestamp.ToString()) (m.ToString()))

                m

            List.fold Maximize zeroElementTimestamp (asList.Force())

        member rv.Signature() =

            let l = asList.Force()

            let l = l |> List.map(fun (_,result) ->Result.InputSignature result)

            SingleMappedVectorInput (l|>List.toArray)

                                  

        member rv.FoldLeft f s : 'a = List.fold f s (asList.Force())

        override rv.ToString() = asList.ToString()   // NOTE: Force()ing this inside ToString() leads to StackOverflowException and very undesirable debugging behavior for all of F#

                

    /// A result of performing build actions

    [<NoEquality; NoComparison>]

    type ResultSet =

        | ScalarResult of Result

        | VectorResult of ResultVector

        override rs.ToString() = 

            match rs with

            | ScalarResult(sr) ->sprintf "ScalarResult(%s)" (sr.ToString())

            | VectorResult(rs) ->sprintf "VectorResult(%s)" (rs.ToString())

                            

    /// Action timing

    module Time =     

#if SILVERLIGHT

        let Action<'T> taskname slot func : 'T =  func()

#else

        let sw = new Stopwatch()

        let Action<'T> taskname slot func : 'T= 

            if Trace.ShouldLog("IncrementalBuildWorkUnits") then 

                let slotMessage = 

                    if slot= -1 then sprintf "%s" taskname

                    else sprintf "%s over slot %d" taskname slot

                // Timings and memory

                let maxGen = System.GC.MaxGeneration

                let ptime = System.Diagnostics.Process.GetCurrentProcess()

                let timePrev = ptime.UserProcessorTime.TotalSeconds

                let gcPrev = [| for i in 0 .. maxGen -> System.GC.CollectionCount i |]

                let pbPrev = ptime.PrivateMemorySize64 in                



                // Call the function

                let result = func()

                

                // Report.

                let timeNow = ptime.UserProcessorTime.TotalSeconds

                let pbNow = ptime.PrivateMemorySize64

                let spanGC = [| for i in 0 .. maxGen -> System.GC.CollectionCount i - gcPrev.[i] |]

                

                Trace.PrintLine("IncrementalBuildWorkUnits", fun _ ->

                                                        sprintf "%s TIME: %4.3f MEM: %3d (delta) G0: %3d G1: %2d G2: %2d" 

                                                            slotMessage

                                                            (timeNow - timePrev) 

                                                            (pbNow - pbPrev)

                                                            spanGC.[min 0 maxGen] 

                                                            spanGC.[min 1 maxGen] 

                                                            spanGC.[min 2 maxGen])

                result

            else func()            

#endif

        

    /// Result of a particular action over the bound build tree

    [<NoEquality; NoComparison>]

    type ActionResult = 

        | IndexedResult of Id * int * (*slotcount*) int * Eventually<obj> * DateTime 

        | ScalarValuedResult of Id * obj * DateTime * InputSignature

        | VectorValuedResult of Id * obj[] * DateTime * InputSignature

        | ResizeResult of Id * (*slotcount*) int

        override ar.ToString() = 

            match ar with

            | IndexedResult(id,slot,slotcount,_,dt) ->sprintf "IndexedResult(%d,%d,%d,obj,%A)" (Id.toInt id) slot slotcount dt

            | ScalarValuedResult(id,_,dt,inputsig) ->sprintf "ScalarValuedResult(%d,obj,%A,%A)" (Id.toInt id) dt inputsig

            | VectorValuedResult(id,_,dt,inputsig) ->sprintf "VectorValuedResult(%d,obj[],%A,%A)" (Id.toInt id) dt inputsig

            | ResizeResult(id,slotcount) ->sprintf "ResizeResult(%d,%d)" (Id.toInt id) slotcount

        

        

    /// A pending action over the bound build tree

    [<NoEquality; NoComparison>]

    type Action = 

        | IndexedAction of Id * (*taskname*)string * int * (*slotcount*) int * DateTime * (unit->Eventually<obj>)

        | ScalarAction of Id * (*taskname*)string * DateTime * InputSignature * (unit->obj)

        | VectorAction of Id * (*taskname*)string * DateTime * InputSignature *  (unit->obj[])

        | ResizeResultAction of Id * (*slotcount*) int 

        /// Execute one action and return a corresponding result.

        static member Execute action = 

            match action with

            | IndexedAction(id,taskname,slot,slotcount,timestamp,func) -> IndexedResult(id,slot,slotcount,Time.Action taskname slot func,timestamp)

            | ScalarAction(id,taskname,timestamp,inputsig,func) -> ScalarValuedResult(id,Time.Action taskname (-1) func,timestamp,inputsig)

            | VectorAction(id,taskname,timestamp,inputsig,func) -> VectorValuedResult(id,Time.Action taskname (-1) func,timestamp,inputsig)

            | ResizeResultAction(id,slotcount) -> ResizeResult(id,slotcount)

     

    /// String helper functions for when there's no %A

    type String = 

        static member OfList2 l =

            " ["^String.Join(",\n ", List.toArray (l|>List.map (fun (v1,v2) ->((box v1).ToString()) + ";" + ((box v2).ToString())))) + " ]"

            

    /// A set of build rules and the corresponding, possibly partial, results from building.

    [<Sealed>]

    type PartialBuild(rules:BuildRules, results:Map<Id,ResultSet>) = 

        member bt.Rules = rules

        member bt.Results = results

        override bt.ToString() = 

            let sb = new System.Text.StringBuilder()

            results |> Map.iter(fun id result->

                                    let id = Id.toInt id

                                    let s = sprintf "\n    {Id=%d,ResultSet=%s}" id (result.ToString())

                                    let _ = sb.Append(s)

                                    ())

            sprintf "{Rules={%s}\n Results={%s}}" (String.OfList2 rules.RuleList) (sb.ToString())

   

    /// Given an expression, find the expected width.

    let rec GetVectorWidthByExpr(bt:PartialBuild,ve:VectorBuildRule) = 

        let KnownValue ve = 

            match bt.Results.TryFind(VectorBuildRule.GetId ve) 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 ve  

        | VectorInput _

        | VectorMultiplex _ -> KnownValue ve  

        

    /// 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, seek:string) : BuildRuleExpr = 

        let MatchName (expr:BuildRuleExpr) (acc:BuildRuleExpr option) : BuildRuleExpr option =

            let name = BuildRuleExpr.GetName(expr)

            if name = seek 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 %d" (Id.toInt seek))



    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(ScalarBuildRule.GetId se) with 

        | Some(resultSet) ->

            match se,resultSet with

            | ScalarInput _,ScalarResult(r)

            | ScalarMap _,ScalarResult(r)

            | ScalarDemultiplex _,ScalarResult(r) ->r

            | se,result->failwith (sprintf "GetScalarExprResult had no match for %A,%A" se result) 

        | None->NotAvailable



    let GetVectorExprResultVector(bt:PartialBuild, ve:VectorBuildRule) =

        match bt.Results.TryFind(VectorBuildRule.GetId ve) with 

        | Some(resultSet) ->

            match ve,resultSet with

            | VectorScanLeft _,VectorResult rv

            | VectorMap _,VectorResult rv

            | VectorInput _,VectorResult rv

            | VectorStamp _,VectorResult rv

            | VectorMultiplex _,VectorResult rv -> Some rv

            | ve,result->failwith (sprintf "GetVectorExprResultVector had no match for %A,%A" ve result) 

        | None->None



    let GetVectorExprResult(bt:PartialBuild, ve:VectorBuildRule, slot) =

        match bt.Results.TryFind(VectorBuildRule.GetId ve) 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

            | ve,result->failwith (sprintf "GetVectorExprResult had no match for %A,%A" ve result) 

        | None->NotAvailable



    /// Get the maximum build stamp for an output.

    let MaxTimestamp(bt:PartialBuild,id,_inputstamp) = 

        match bt.Results.TryFind(id) with

        | Some(resultset) -> 

            match resultset with 

            | ScalarResult(rs) -> Result.Timestamp rs

            | 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) -> Result.InputSignature rs

            | VectorResult rv -> rv.Signature()

        | None -> UnevaluatedInput               

     

    /// Get all the results for the given expr.

    let AllResultsOfExpr extractor (bt:PartialBuild) expr = 

        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(VectorBuildRule.GetId(expr))





   

        

    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, vectorinputs, scalarinputs) = 

        let now = DateTime.Now

        let rec ApplyScalarExpr(se,results) =

            match se with

            | ScalarInput(id,n) -> 

                let matches = scalarinputs 

                                |> List.filter (fun (inputname,_) ->inputname=n) 

                                |> List.map (fun (_,inputvalue:obj) -> ScalarResult(Available(inputvalue,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 = vectorinputs 

                                |> List.filter (fun (inputname,_,_) ->inputname=n) 

                                |> List.map (fun (_,size,inputvalues:obj list) ->

                                                        let results = inputvalues|>List.mapi(fun i value->i,Available(value,now,BoundInputVector))

                                                        VectorResult(ResultVector(size,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)

        

        

    /// Visit each executable action and call actionFunc with the given accumulator.

    let ForeachAction output bt (actionFunc:Action->'acc->'acc) (acc:'acc) =

        use t = Trace.Call("IncrementalBuildVerbose", "ForeachAction",  fun _->sprintf "name=%s" output)

        let seen = Dictionary<_,_>()

        let Seen(id) = 

            if seen.ContainsKey(id) then true

            else seen.[id]<-true

                 false

                 

        let HasChanged(inputtimestamp,outputtimestamp) =

           if inputtimestamp<>outputtimestamp then

               Trace.PrintLine("IncrementalBuildVerbose", fun _ -> sprintf "Input timestamp is %A. Output timestamp is %A." inputtimestamp outputtimestamp)

               true

           else false

           

           

        let ShouldEvaluate(bt,currentsig:InputSignature,id) =

            let isAvailable = currentsig.IsEvaluated()

            if isAvailable then 

                let priorsig = Signature(bt,id)

                currentsig<>priorsig

            else false

            

        /// Make sure the result vector saved matches the size of expr

        let ResizeVectorExpr(ve:VectorBuildRule,acc)  = 

            let id = VectorBuildRule.GetId ve

            match GetVectorWidthByExpr(bt,ve) with

            | Some(expectedWidth) ->

                match bt.Results.TryFind(id) with

                | Some(found) ->

                    match found with

                    | VectorResult rv ->

                        if rv.Size<> expectedWidth then 

                            actionFunc (ResizeResultAction(id,expectedWidth)) acc

                        else acc

                    | _ -> acc

                | None -> acc        

            | None -> acc           

        

        let rec VisitVector ve acc =

        

            if Seen(VectorBuildRule.GetId ve) then acc

            else

                Trace.PrintLine("IncrementalBuildVerbose", fun _ -> sprintf "In ForeachAction at vector expression %s" (ve.ToString()))

                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 GetInputAccumulator slot =

                                if slot=0 then GetScalarExprResult(bt,accumulatorExpr) 

                                else GetVectorExprResult(bt,ve,slot-1)

                        

                            let Scan slot =

                                let accumulatorResult = GetInputAccumulator slot

                                let inputResult = GetVectorExprResult(bt,inputExpr,slot)

                                match accumulatorResult,inputResult with 

                                | Available(accumulator,accumulatortimesamp,_accumulatorInputSig),Available(input,inputtimestamp,_inputSig) ->

                                    let inputtimestamp = max inputtimestamp accumulatortimesamp

                                    let prevoutput = GetVectorExprResult(bt,ve,slot)

                                    let outputtimestamp = Result.Timestamp prevoutput

                                    let scanOp = 

                                        if HasChanged(inputtimestamp,outputtimestamp) then

                                            Some (fun () -> func accumulator input)

                                        elif prevoutput.ResultIsInProgress then

                                            Some prevoutput.GetInProgressContinuation

                                        else 

                                            // up-to-date and complete, no work required

                                            None

                                    match scanOp with 

                                    | Some scanOp -> Some(actionFunc (IndexedAction(id,taskname,slot,cardinality,inputtimestamp,scanOp)) acc)

                                    | None -> None

                                | _ -> None                            

                                

                            match ([0..cardinality-1]|>List.tryPick Scan) with Some(acc) ->acc | None->acc

                        | None -> acc

                    

                    // Check each slot for an action that may be performed.

                    VisitVector 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,VectorBuildRule.GetId(inputExpr),DateTime.MinValue)

                                let outputtimestamp = MaxTimestamp(bt,id,DateTime.MinValue)

                                if HasChanged(inputtimestamp,outputtimestamp) then

                                    Trace.PrintLine("IncrementalBuildVerbose", fun _ -> sprintf "Vector Map with cardinality zero setting output timestamp to %A." inputtimestamp)

                                    actionFunc (VectorAction(id,taskname,inputtimestamp,EmptyTimeStampedInput inputtimestamp, fun _ ->[||])) acc

                                else acc

                            else                                                

                                let MapResults acc slot =

                                    let inputtimestamp = Result.Timestamp (GetVectorExprResult(bt,inputExpr,slot))

                                    let outputtimestamp = Result.Timestamp (GetVectorExprResult(bt,ve,slot))

                                    if HasChanged(inputtimestamp,outputtimestamp) then

                                        let OneToOneOp() =

                                            Eventually.Done (func (Result.GetAvailable (GetVectorExprResult(bt,inputExpr,slot))))

                                        actionFunc (IndexedAction(id,taskname,slot,cardinality,inputtimestamp,OneToOneOp)) acc

                                    else acc

                                [0..cardinality-1] |> List.fold MapResults acc                         

                        | None -> acc

                    VisitVector 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,VectorBuildRule.GetId(inputExpr),DateTime.MinValue)

                                let outputtimestamp = MaxTimestamp(bt,id,DateTime.MinValue)

                                if HasChanged(inputtimestamp,outputtimestamp) then

                                    Trace.PrintLine("IncrementalBuildVerbose", fun _ -> sprintf "Vector Stamp with cardinality zero setting output timestamp to %A." inputtimestamp)

                                    actionFunc (VectorAction(id,taskname,inputtimestamp,EmptyTimeStampedInput inputtimestamp,fun _ ->[||])) acc

                                else acc

                            else                 

                                let CheckStamp acc slot = 

                                    let inputresult = GetVectorExprResult(bt,inputExpr,slot)

                                    match inputresult with

                                    | Available(ires,_,_) ->

                                        let oldtimestamp = Result.Timestamp (GetVectorExprResult(bt,ve,slot))

                                        let newtimestamp = func ires

                                        if newtimestamp<>oldtimestamp then 

                                            Trace.PrintLine("IncrementalBuildVerbose", fun _ -> sprintf "Old timestamp was %A. New timestamp is %A." oldtimestamp newtimestamp)

                                            actionFunc (IndexedAction(id,taskname,slot,cardinality,newtimestamp, fun _ -> Eventually.Done ires)) acc

                                        else acc

                                    | _ -> acc

                                [0..cardinality-1] |> List.fold CheckStamp acc

                        | None -> acc

                    VisitVector inputExpr acc

                | VectorMultiplex(id, taskname, inputExpr, func) -> 

                    VisitScalar inputExpr

                        (match GetScalarExprResult(bt,inputExpr) with

                         | Available(inp,inputtimestamp,inputsig) ->

                           let outputtimestamp = MaxTimestamp(bt,id,inputtimestamp)

                           if HasChanged(inputtimestamp,outputtimestamp) then

                               let MultiplexOp() = func inp

                               actionFunc (VectorAction(id,taskname,inputtimestamp,inputsig,MultiplexOp)) acc

                           else acc

                         | _->acc)                

        and VisitScalar se acc =

            if Seen(ScalarBuildRule.GetId se) then acc

            else

                Trace.PrintLine("IncrementalBuildVerbose", fun _ -> sprintf "In ForeachAction at scalar expression %s" (se.ToString()))

                match se with

                | ScalarInput _ ->acc

                | ScalarDemultiplex(id,taskname,inputExpr,func) ->

                    VisitVector inputExpr 

                            (

                                match GetVectorExprResultVector(bt,inputExpr) with

                                | Some(inputresult) ->   

                                    let currentsig = inputresult.Signature()

                                    if ShouldEvaluate(bt,currentsig,id) then

                                        let inputtimestamp = MaxTimestamp(bt, VectorBuildRule.GetId(inputExpr), DateTime.MaxValue) 

                                        let DemultiplexOp() = 

                                            let input = AvailableAllResultsOfExpr bt inputExpr |> List.toArray

                                            func input

                                        actionFunc (ScalarAction(id,taskname,inputtimestamp,currentsig,DemultiplexOp)) acc

                                    else acc

                                | None -> acc

                            )

                | ScalarMap(id,taskname,inputExpr,func) ->

                    VisitScalar inputExpr

                        (match GetScalarExprResult(bt,inputExpr) with

                         | Available(inp,inputtimestamp,inputsig) ->

                           let outputtimestamp = MaxTimestamp(bt, id, inputtimestamp)

                           if HasChanged(inputtimestamp,outputtimestamp) then

                               let MapOp() = func inp

                               actionFunc (ScalarAction(id,taskname,inputtimestamp,inputsig,MapOp)) acc

                           else acc

                         | _->acc)

                         

        let Visit expr acc = 

            match expr with

            | ScalarBuildRule se ->VisitScalar se acc

            | VectorBuildRule ve ->VisitVector ve acc                    

                    

        let filtered = bt.Rules.RuleList |> List.filter (fun (s,_) -> s = output) |> List.map snd

        List.foldBack Visit filtered acc

    

    /// Given the result of a single action, apply that action to the Build

    let ApplyResult(actionResult:ActionResult,bt:PartialBuild) = 

        use t = Trace.Call("IncrementalBuildVerbose", "ApplyResult", fun _ -> "")

        let result = 

            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 -> 

                            Trace.PrintLine("FSharpBackgroundBuildVerbose", fun _ -> "Eventually.Done...")

                            Available(res,timestamp, IndexedValueElement timestamp)

                        | Eventually.NotYetDone f -> 

                            Trace.PrintLine("FSharpBackgroundBuildVerbose", fun _ -> "Eventually.NotYetDone...")

                            InProgress (f,timestamp)

                    let results = rv.Resize(slotcount).Set(index,result)

                    PartialBuild(bt.Rules, Map.add id (VectorResult(results)) bt.Results)

                | _->failwith "Unexpected"

        result

        

    /// Evaluate the result of a single output

    let EvalLeafsFirst output bt =

        use t = Trace.Call("IncrementalBuildVerbose", "EvalLeafsFirst", fun _->sprintf "name=%s" output)



        let ExecuteApply action bt = 

            let actionResult = Action.Execute(action)

            ApplyResult(actionResult,bt)

        let rec Eval(bt,gen) =

            Trace.PrintLine("FSharpBackgroundBuildVerbose", fun _ -> sprintf "---- Build generation %d ----" gen)

            #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 newBt = ForeachAction output bt ExecuteApply bt

            if newBt=bt then bt else Eval(newBt,gen+1)

        Eval(bt,0)

        

    let Step output (bt:PartialBuild) = 

        use t = Trace.Call("IncrementalBuildVerbose", "Step", fun _->sprintf "name=%s" output)

        

        let BuildActionList() = 

            use t = Trace.Call("IncrementalBuildVerbose", "BuildActionList", fun _->sprintf "name=%s" output)

            let Cons action list =  action :: list  

            // Hey look, we're building up the whole list, executing one thing and then throwing

            // the list away. What about saving the list inside the Build instance?

            ForeachAction output bt Cons []

            

        let ExecuteOneAction(worklist) = 

            use t = Trace.Call("IncrementalBuildVerbose", "ExecuteOneAction", fun _->sprintf "name=%s" output)

            match worklist with 

            | action::_ ->

                let actionResult = Action.Execute(action)

                Some(ApplyResult(actionResult,bt))

            | _->None

            

        ExecuteOneAction(BuildActionList())                

        

    /// Eval by calling step over and over until done.

    let rec EvalStepwise output bt = 

        use t = Trace.Call("IncrementalBuildVerbose", "EvalStepwise", fun _->sprintf "name=%s" output)

        let rec Evaluate(output,bt)= 

            let newBt = Step output bt

            match newBt with

            | Some(newBt) -> Evaluate(output,newBt)

            | None->bt

        Evaluate(output,bt)

        

  /// Evaluate a build.

    let Eval output bt = EvalLeafsFirst output bt



  /// Get a scalar vector. Result must be available

    let GetScalarResult<'T>(name,bt) : ('T*DateTime) option = 

        use t = Trace.Call("IncrementalBuildVerbose", "GetScalarResult", fun _->sprintf "name=%s" name)

        match GetTopLevelExprByName(bt,name) with 

        | ScalarBuildRule se ->

            let id = ScalarBuildRule.GetId se

            match bt.Results.TryFind(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>(name,bt) : 'T[] = 

        match GetTopLevelExprByName(bt,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>(name,slot,bt) : ('T*DateTime) option = 

        match GetTopLevelExprByName(bt,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 GetSlotByInput<'T>(name:string,input:'T,build:PartialBuild,equals:'T->'T->bool) : int = 

        let expr = GetExprByName(build,name)

        let id = BuildRuleExpr.GetId(expr)

        let resultSet = Option.get ( build.Results.TryFind(id))

        match resultSet with 

        | VectorResult rv ->

            let MatchNames acc (slot,result) = 

                match result with

                | Available(o,_,_) ->

                    let o = o :?> 'T

                    if equals o input then Some slot else acc

                | _ -> acc

            let slotOption = rv.FoldLeft MatchNames None

            match slotOption with 

            | Some slot -> slot

            | _ -> failwith (sprintf "Could not find requested input '%A' named '%s' in set %+A" input name rv)

        | _ -> 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 pe.GetVectorExpr() = expr }



    /// Declares a scalar build input.

    let InputScalar<'T> name = 

        let expr = ScalarInput(NextId(),name)

        { new Scalar<'T>

          interface IScalar with

               override pe.GetScalarExpr() = expr }

    

    module Scalar =

    

        let Map (taskname:string) (task:'I->'O) (input:Scalar<'I>) : Scalar<'O> =

            let BoxingMap i = box(task(unbox(i)))

            let input = (input:?>IScalar).GetScalarExpr()

            let expr = ScalarMap(NextId(),taskname,input,BoxingMap)

            { new Scalar<'O>

              interface IScalar with

                   override pe.GetScalarExpr() = expr}

                   

        let Multiplex (taskname:string) (task:'I -> 'O array) (input:Scalar<'I>) : Vector<'O> =      

            let BoxingMultiplex i = Array.map box (task(unbox(i)))

            let input = (input:?>IScalar).GetScalarExpr()

            let expr = VectorMultiplex(NextId(),taskname,input,BoxingMultiplex) 

            { new Vector<'O>

              interface IVector with

                   override pe.GetVectorExpr() = expr}    

            

    module Vector =

        /// Maps one vector to another using the given function.    

        let Map (taskname:string) (task:'I ->'O) (input:Vector<'I>) : Vector<'O> = 

            let BoxingMapVector i =

                box(task(unbox i))

            let input = (input:?>IVector).GetVectorExpr()

            let expr = VectorMap(NextId(),taskname,input,BoxingMapVector) 

            { new Vector<'O>

              interface IVector with

                   override pe.GetVectorExpr() = 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:'A -> 'I -> Eventually<'A>) (acc:Scalar<'A>) (input:Vector<'I>) : Vector<'A> =

            let BoxingScanLeft a i =

                Eventually.box(task (unbox a) (unbox i))

            let acc = (acc:?>IScalar).GetScalarExpr()

            le…