/compiler/2.0/Aug2011.1/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 System

open System.IO

open System.Reflection             

open System.Diagnostics

open System.Collections.Generic

open System



open Microsoft.FSharp.Compiler.Tastops

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

    type ScalarExpr = 

        | ScalarInput of Id * (*name*)string

        | ScalarDemultiplex of Id * (*name*)string * (*input*) VectorExpr * (*task function*) (obj array -> obj)

        | ScalarMap of Id * (*name*) string * (*input*) ScalarExpr * (*task function*) (obj->obj)

        /// Get the Id for the given ScalarExpr.

        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

    and VectorExpr = 

        | VectorInput of Id * (*name*)string * Type

        | VectorScanLeft of Id * (*name*)string * (*accumulator*)ScalarExpr * (*input vector*)VectorExpr * (*task function*)(obj->obj->Eventually<obj>)

        | VectorMap of Id * (*taskname*)string * (*input*)VectorExpr * (*task function*)(obj->obj) 

        | VectorStamp of Id * (*taskname*)string * (*input*)VectorExpr * (*task function*)(obj->DateTime)

        | VectorMultiplex of Id * (*taskname*)string * (*input*)ScalarExpr * (*task function*)(obj->obj array)

        /// Get the Id for the given VectorExpr.

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

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

        | ScalarExpr of ScalarExpr

        | VectorExpr of VectorExpr      

        /// Get the Id for the given Expr.

        static member GetId = function

            | ScalarExpr(se)->ScalarExpr.GetId(se)

            | VectorExpr(ve)->VectorExpr.GetId(ve)      

        /// Get the Name for the given Expr.

        static member GetName= function

            | ScalarExpr(se)->ScalarExpr.GetName(se)

            | VectorExpr(ve)->VectorExpr.GetName(ve)      

        override e.ToString() = 

            match e with 

            | ScalarExpr _ -> sprintf "ScalarExpr(se)" 

            | VectorExpr _ -> sprintf "VectorExpr(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 -> ScalarExpr

    type IVector =

        abstract GetVectorExpr : unit-> VectorExpr

            

    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



    /// Visit each task and call op with the given accumulator.

    let ForeachExpr(rules, op, acc)=

        let rec VisitVector (ve:VectorExpr) acc = 

            match ve with

            | VectorInput(_)->op (VectorExpr ve) acc

            | VectorScanLeft(_,_,a,i,_)->op (VectorExpr ve) (VisitVector i (VisitScalar a acc))

            | VectorMap(_,_,i,_)

            | VectorStamp(_,_,i,_)->op (VectorExpr ve) (VisitVector i acc)

            | VectorMultiplex(_,_,i,_)->op (VectorExpr ve) (VisitScalar i acc)

        and VisitScalar (se:ScalarExpr) acc = 

            match se with

            | ScalarInput(_)->op (ScalarExpr se) acc

            | ScalarDemultiplex(_,_,i,_)->op (ScalarExpr se) (VisitVector i acc)

            | ScalarMap(_,_,i,_)->op (ScalarExpr se) (VisitScalar i acc)

        let rec Visit (expr:Expr) acc =  

            match expr with

            | ScalarExpr(se)->VisitScalar se acc

            | VectorExpr(ve)->VisitVector ve acc

        List.foldBack Visit (rules |> List.map(snd)) acc            

    

    /// Convert from interfaces into discriminated union.

    let ToBuild (names:NamedOutput list) : (string * Expr) list = 



        // Create the rules.

        let CreateRules() = names |> List.map(function NamedVectorOutput(n,v) -> n,VectorExpr(v.GetVectorExpr())

                                                     | NamedScalarOutput(n,s) -> n,ScalarExpr(s.GetScalarExpr()))

        

        // Ensure that all names are unique.

        let EnsureUniqueNames (expr:Expr) (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 = Expr.GetId(expr)

            let name = Expr.GetName(expr)

            AddUniqueIdToNameMapping(id,name)

        

        // Validate the rule tree

        let ValidateRules(rules:(string*Expr) list) =

            ForeachExpr(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 array

        | 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 array * 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 array,%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 array)

        | 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 Build(rules:(string * Expr) list, 

               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) (sb.ToString())

   

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

    let rec GetVectorWidthByExpr(bt:Build,ve:VectorExpr) = 

        let KnownValue(ve) = 

            match bt.Results.TryFind(VectorExpr.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:Build, seek:string) =

        bt.Rules |> List.filter(fun(name,_)->name=seek) |> List.map(fun(_,root)->root) |> List.head

    

    /// Get an expression matching the given name.

    let GetExprByName(bt:Build, seek:string) : Expr = 

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

            let name = Expr.GetName(expr)

            if name = seek then Some(expr) else acc

        let matchOption = ForeachExpr(bt.Rules,MatchName,None)

        Option.get matchOption



    // Given an Id, find the corresponding expression.

    let GetExprById(bt:Build, seek:Id) : Expr= 

        let rec VectorExprOfId(ve) =

            match ve with

            | VectorInput(id,_,_)->if seek=id then Some(VectorExpr(ve)) else None

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

                if seek=id then Some(VectorExpr(ve)) else

                    let result = ScalarExprOfId(a) 

                    match result with Some _ -> result | None->VectorExprOfId(i)

            | VectorMap(id,_,i,_)->if seek=id then Some(VectorExpr(ve)) else VectorExprOfId(i)

            | VectorStamp(id,_,i,_)->if seek=id then Some(VectorExpr(ve)) else VectorExprOfId(i)

            | VectorMultiplex(id,_,i,_)->if seek=id then Some(VectorExpr(ve)) else ScalarExprOfId(i)

        and ScalarExprOfId(se) =

            match se with

            | ScalarInput(id,_)->if seek=id then Some(ScalarExpr(se)) else None

            | ScalarDemultiplex(id,_,i,_)->if seek=id then Some(ScalarExpr(se)) else VectorExprOfId(i)

            | ScalarMap(id,_,i,_)->if seek=id then Some(ScalarExpr(se)) else ScalarExprOfId(i)

        let ExprOfId(expr:Expr) = 

            match expr with

            | ScalarExpr(se)->ScalarExprOfId(se)

            | VectorExpr(ve)->VectorExprOfId(ve)

        let exprs = bt.Rules |> 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:Build) seek = 

        match GetExprById(bt,seek) with 

        | ScalarExpr(_)->failwith "Attempt to get width of scalar." 

        | VectorExpr(ve)->Option.get (GetVectorWidthByExpr(bt,ve))



    let GetScalarExprResult(bt:Build, se:ScalarExpr) =

        match bt.Results.TryFind(ScalarExpr.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:Build, ve:VectorExpr) =

        match bt.Results.TryFind(VectorExpr.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:Build, ve:VectorExpr, slot) =

        match bt.Results.TryFind(VectorExpr.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:Build,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:Build,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:Build) 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(VectorExpr.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(build:(string*Expr) list, 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

            | ScalarExpr(se)->ApplyScalarExpr(se,results)

            | VectorExpr(ve)->ApplyVectorExpr(ve,results)

                                                                             

        // Place vector inputs into results map.

        let results = List.foldBack ApplyExpr (build|>List.map(snd)) (Map.empty)

        Build(build,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:VectorExpr,acc)  = 

            let id = VectorExpr.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(VectorExpr.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,VectorExpr.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,VectorExpr.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(ScalarExpr.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, VectorExpr.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

            | ScalarExpr(se)->VisitScalar se acc

            | VectorExpr(ve)->VisitVector ve acc                    

                    

        let filtered = bt.Rules |> 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:Build) = 

        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

                        Build(bt.Rules,results)

                    | _ -> failwith "Unexpected"                

                | None -> failwith "Unexpected"

            | ScalarValuedResult(id,value,timestamp,inputsig)->

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

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

        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)

        

    // Note: this discards its slot. This causes TypecheckStates to be evaluated for all files

    // even if we only need one such state. This is especially noticeable on startup of

    // large solutions, where no intellisense is available until all files have been typechecked

    let EvalSlot(output,_,bt) = EvalLeafsFirst output bt

        

    let Eval = EvalLeafsFirst



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

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

        match GetTopLevelExprByName(bt,name) with 

        | ScalarExpr(se)->

            let id = ScalarExpr.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

        | VectorExpr _ -> failwith "Expected scalar."

    

    let GetVectorResult<'T>(name,bt) : 'T array = 

        match GetTopLevelExprByName(bt,name) with 

        | ScalarExpr _ -> failwith "Expected vector."

        | VectorExpr ve -> AvailableAllResultsOfExpr bt ve |> List.map(unbox) |> Array.ofList

        

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

        match GetTopLevelExprByName(bt,name) with 

        | ScalarExpr _ -> failwith "Expected vector expression"

        | VectorExpr 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:Build,equals:'T->'T->bool) : int = 

        let expr = GetExprByName(build,name)

        let id = Expr.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            



    let InputVector<'T> name = 

        let expr = VectorInput(NextId(),name,typeof<'T>) 

        { new Vector<'T>

          interface IVector with

               override pe.GetVectorExpr() = expr }



    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 =

        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 }            

            

        

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

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

            let expr = VectorScanLeft(NextId(),taskname,acc,input,BoxingScanLeft) 

            { new Vector<'A>

              interface IVector with

                   override pe.GetVectorExpr() = expr }    

            

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

            let BoxingDemultiplex i =

                box(task (Array.map unbox i) )

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

            let expr = ScalarDemultiplex(NextId(),taskname,input,BoxingDemultiplex)

            { new Scalar<'O>

              interface IScalar with

                   override pe.GetScalarExpr() = expr }                

            

        let Stamp (taskname:string) (task:'I -> DateTime) (input:Vector<'I>) : Vector<'I> =

            let BoxingTouch i =

                task(unbox i)

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

            let expr = VectorStamp(NextId(),taskname,input,BoxingTouch) 

            { new Vector<'I>

              interface IVector with

                   override pe.GetVectorExpr() = expr }    

                  

        let AsScalar (taskname:string) (input:Vector<'I>) : Scalar<'I array> = 

            Demultiplex taskname (fun v->v) input

                   

    type BuildScope() =

        let outputs = ref []

        member b.DeclareScalarOutput(name,output:Scalar<'t>)=

            let output:IScalar = output:?>IScalar

            outputs := NamedScalarOutput(name,output) :: !outputs

        member b.DeclareVectorOutput(name,output:Vector<'t>)=

            let output:IVector = output:?>IVector

            outputs := NamedVectorOutput(name,output) :: !outputs

        member b.GetConcreteBuild(vectorinputs,scalarinputs) =

            ToBound(ToBuild(!outputs),vectorinputs,scalarinputs)   





// ------------------------------------------------------------------------------------------

// The incremental build definition for parsing and typechecking F#

// ------------------------------------------------------------------------------------------

module internal FsiGeneration =



    open Internal.Utilities

    open Internal.Utilities.Collections



    open IncrementalBuild

    open Microsoft.FSharp.Compiler.Build

    open Microsoft.FSharp.Compiler.Fscopts

    open Microsoft.FSharp.Compiler.Ast

    open Microsoft.FSharp.Compiler.ErrorLogger

    o…