Source

love studio / LoveStudio / LuaAnalyzer / Context.fs

Full commit
module LuaAnalyzer.Context

open Type
open System.Diagnostics.Contracts

type ValueEnvironment = Map<string,Field>

/// A structure which serves as an argument to typechecking functions. It stores
/// all information necessary for typechecking (but external to) the term being typechecked.
///
/// Context structures are modified in a purely functional manner when passed to
/// recursive invocations of the typechecker on the children of the syntax node being
/// checked. 
type Context = {
    
    /// value environment -- maps variable names to variable types. 
    venv : ValueEnvironment

    /// Type Environment -- Contains all known information about types
    tenv : TypeEnvironment

    /// The position in the source file of the term that the user has 
    /// requested information about.
    queryPos : Option<int>

    /// True iff we should generate are messages whenever errors are encountered
    trackErrors : bool

    /// True iff we are checking an expression on the left-hand side of an assignment
    isLeftExpr : bool

    /// True tells the typechecker that assigning variables which are not 
    /// in the context should add them to the context.
    /// (this is true when checking globals.lua, but should be false most of the time)
    addGlobals : bool
}

type Context with

    static member empty
        with get () =
            {
                venv = Map.empty
                tenv = TypeEnvironment.empty
                queryPos = None
                trackErrors = false
                isLeftExpr = false
                addGlobals = false
            }

    /// Adds a value to the value environment with the 
    /// specified name and field.
    member this.AddValue (name : string, field : Field) =
        {
        this with
            venv = this.venv.Add(name,field)
        }

    member this.HasValPath (path : List<string>) : bool =
        (this.FieldFromPath path).IsSome

    member this.FieldFromPath (path : List<string>) : Option<Field> =
        Contract.Requires(path.Length > 0)
        let rec fieldFromPath (path : List<string>) (field : Field) =
            match path with
            | head :: rest ->
                let ty = Type.Coerce this.tenv field.ty
                match ty with
                | RecordTy(_,_,_,_,fields,_,_)
                | OpenRecordTy(_,_,_,_,fields,_,_) ->
                    if fields.ContainsKey head then
                        fieldFromPath rest fields.[head]
                    else
                        None
                | _ ->
                    None
            | [] ->
                Some field

        if this.venv.ContainsKey path.[0] then
            fieldFromPath path.Tail this.venv.[path.[0]]
        else
            None



    /// Undoes all types in the type environment (in effect,
    /// reducing all deduced types to their permanent types).
    member this.UndoAllDeductions
        with get () =
            let mapEntry key field =
                { field with ty = Type.UndoDeductions field.ty }

            {
            this with
                venv = Map.map mapEntry this.venv
            }

    /// A context identical to this one, except that it tracks errors
    member this.TrackErrors
        with get () =
            {
            this with
                trackErrors = true
            }
    
    /// A context identical to this one, except that it does not track errors
    member this.DontTrackErrors
        with get () =
            {
            this with
                trackErrors = false
            }

    /// A context identical to this one, except intended for left expressions
    member this.IsLeftExpr
        with get () =
            {
            this with
                isLeftExpr = true
            }

    /// A context identical to this one, except intended for non-left expressions
    member this.IsNotLeftExpr
        with get () =
            {
            this with
                isLeftExpr = false
            }

    /// A context identical to this one, but which tells the typechecker to
    /// add new global assignments to the value environment rather than
    /// generating "identifier not in context" errors
    member this.AddGlobals
        with get () =
            {
            this with
                addGlobals = true
            }
    
    /// A context identical to this one, but which tells the typechecker
    /// to generate errors upon encountering the assignment of names
    /// which are not currently in the value environment.
    member this.DontAddGlobals
        with get () =
            {
            this with
                addGlobals = false
            }

/// Contains all globals loaded from API definition XML files.
let baseContext : Ref< Context > = ref (Context.empty)

/// Gets the base context, which is the portion of the context consisting
/// of values defined by various external APIs and standard libraries, and
/// which is not affected by the projected at all.
let getBaseContext () =
    !baseContext

/// Sets the base context, which is the portion of the context consisting
/// of values defined by various external APIs and standard libraries, and
/// which is not affected by the projected at all.
let setBaseContext (ctxt : Context) =
    baseContext := ctxt