Source

love studio / LoveStudio / LuaAnalyzer / TypedSyntax.fs

///
/// Typed abstract syntax, generated by combining standard lua abstract syntax 
/// with comment-embedded annotations.
///

module LuaAnalyzer.TypedSyntax

open Annotations
open Syntax
open Type
type Range = int*int

///
/// A statement is an expression which denotes a command to the lua VM,
/// telling it to alter the state of the program in some way. 
///
type TypedStatement =
    /// If((condition,chunk) list, rng)
    /// Occurs in source as "if *cond1* then *chunk1* elseif *cond2* then *chunk2* ... end"
    /// trailing else clauses are represented by using true as the condition. 
    | If of List<TypedExpr*TypedStatement>*Range
    /// While(cond,body,rng) - repeatedly test condition and execute body until 
    /// condition evaluates to false. Occurs in source as "while *cond* do *body* end"
    | While of TypedExpr*TypedStatement*Range
    /// Do(body) - execute the statement contained in the body. used to introduce
    /// a new scope for global variables. Occurs in source as "do *body* end"
    | Do of TypedStatement*Range
    /// ForNum(var, start, fin, step, body,rng)
    /// occurs in source as "for *var*=*start*,*fin*,*step* do *body* end"
    | ForNum of TypedExpr*TypedExpr*TypedExpr*TypedExpr*TypedStatement*Range
    /// ForGeneric([v1,v2,...],[g1,g2,...],body,rng)
    /// occurs in source as "for *v1*,*v2*... = *g1*,*g2*,... do *body* end"
    | ForGeneric of List<TypedExpr>*List<TypedExpr>*TypedStatement*Range
    /// Repeat(cond,body) 
    /// occurs in source as "repeat *body* until *cond*"
    | Repeat of TypedExpr*TypedStatement*Range
    /// LocalAssign(varTypeAscriptions=[a1,a2,...],varDescriptions=[d1,d2,...],
    /// lexprs=[l1,l2,...],rexprs=[r1,r2,...])
    /// occurs in source as "--@var(a1) d1 @var(a2) d2 ... local l1,l2,...=r1,r2,..."
    | LocalAssign of Option<Annotation>*List<TypedExpr>*List<TypedExpr>*Range
    /// Assign(varTypeAscriptions=[a1,a2,...],varDescriptions=[d1,d2,...],
    /// lexprs=[l1,l2,...], rexprs=[r1,r2,...])
    /// occurs in source as "--@var(a1) d1 @var(a2) d2 ... l1,l2,... = r1,r2..."
    | Assign of Option<Annotation>*List<TypedExpr>*List<TypedExpr>*Range
    /// Return([e1,e2,...])
    /// occurs in source as "return *e1*,*e2*,..."
    | Return of List<TypedExpr>*Range
    /// Break
    /// occurs in source as "break"
    | Break of Range
    /// Call(callExp)
    /// occurs in source as *callExp*
    | Call of TypedExpr*Range
    /// Sequence(first, second,rng) - executes the first statement and then the second
    /// in order. 
    /// occurs in source as "*first* *second*"
    | Sequence of TypedStatement*TypedStatement*Range
    /// DoNothing(rng)
    | DoNothing of Range
    /// Used to represent a failed attempt to parse and type a statement.
    | ErrorStatement of string*Range

///
/// A term which denotes a value.
/// 
and TypedExpr =
    /// A numberic literal
    | Number of double*Range
    /// String(str,rng)  - A string literal denoting string str
    | String of string*Range
    /// A nil literal, occurs in source as "nil"
    | Nil of Range
    /// A literal expression for the boolean value true, occurs in source as "true"
    | True of Range
    /// A literal expression for the boolean value true, occurs in source as "true"
    | False of Range
    /// An expression denoting a variable number of arguments. Occurs in source as "..."
    | VarArgs of Range
    /// An expression denoting a table.
    | Constructor of List<TypedConstructorField>*Range
    /// Function(desc,selfName,formals,hasVarargs,retTypes, body, annotation, range)
    /// A literal expression which defines a function.
    /// 
    /// desc - a description of the function
    /// selfName - a name for the function to refer to itself recursively with
    /// formals - a list of name/description/type triples for each formal parameter
    /// hasVarargs - true iff the function has var args
    /// retTypes - a list of description/type pairs for each formal return value
    /// body - the body to execute whenever the function is called
    /// annotation - a description of the metadata provided by the user in comments
    /// range - the range of characters in which this function appears in its source file
    | Function of string*Option<string>*List<string*string*Type>*bool*List<string*Type>*TypedStatement*Range
    /// A unary operation on one subexpression.
    | UnOpExpr of UnOp*TypedExpr*Range
    /// A binary operation on two subexpressions.
    | BinOpExpr of BinOp*TypedExpr*TypedExpr*Range
    /// A parenthesized expression.
    | ParenthesizedExpr of TypedExpr*Range
    /// An identifier.
    | NameExpr of Name*Range
    /// A call expressions
    | CallExpr of TypedExpr*List<TypedExpr>*Range
    /// An expression which ascribes a type to a subexpression.
    | Ascription of TypedExpr*Type*Range
    /// Used to represent a failed attempt to parse and type an expression.
    | ErrorExpr of string*Range

and TypedConstructorField =
    | ListField of Option<Annotation>*TypedExpr*Range
    | RecField of Option<Annotation>*TypedExpr*TypedExpr*Range
    | ErrorField of string*Range

/// Gets the range of character indices for the text corresponding to the
/// given expression in the source file it was extracted from.
let getExprRange (expr : TypedExpr) =
    match expr with
    | Number(_,rng)
    | String(_,rng)
    | Nil(rng)
    | True(rng)
    | False(rng)
    | VarArgs(rng)
    | Constructor(_,rng)
    | Function(_,_,_,_,_,_,rng)
    | UnOpExpr(_,_,rng)
    | BinOpExpr(_,_,_,rng)
    | ParenthesizedExpr(_,rng)
    | NameExpr(_,rng)
    | CallExpr(_,_,rng)
    | Ascription(_,_,rng)
    | ErrorExpr(_,rng) ->
        rng

let getFieldRange (field : TypedConstructorField) =
    match field with
    | ListField(_,_,rng)
    | RecField(_,_,_,rng)
    | ErrorField(_,rng) ->
        rng

let refTypeStatement : Ref<Statement -> TypedStatement> = ref (fun x -> DoNothing(0,0))

/// Converts a statement into a typed statement
let typeStatement (stat : Statement) : TypedStatement =
    (!refTypeStatement) stat

let refTypeExpr : Ref<Expr -> TypedExpr> = ref (fun x -> TypedExpr.Nil(0,0))

/// Converts an expression into a typed expression
let typeExpr (expr : Expr) : TypedExpr =
    (!refTypeExpr) expr

let refTypeConstructorField = ref (fun x -> TypedConstructorField.ErrorField("",(0,0)))

/// Converts a constructor field into a typed constructor
let typeConstructorField (field : ConstructorField) =
    (!refTypeConstructorField) field

refTypeStatement := fun (stat : Syntax.Statement) ->
    match stat with
    | Syntax.Sequence(s0,s1,rng) ->
        Sequence(typeStatement s0, typeStatement s1, rng)
    | Syntax.Call(expr,rng) ->
        Call(typeExpr expr, rng)
    | Syntax.If(clauses,rng) ->
        let typedClauses = List.map (fun (cond,bod) -> (typeExpr cond, typeStatement bod)) clauses
        If(typedClauses,rng)
    | Syntax.While(cond,body,rng) ->
        let typedCond = typeExpr cond
        let typedBody = typeStatement body
        While(typedCond,typedBody,rng)
    | Syntax.Do(body,rng) ->
        let typedBody = typeStatement body
        Do(typedBody, rng)
    | Syntax.ForNum(var,start,fin,step,body,rng) ->
        let typedVar = typeExpr var
        let typedStart = typeExpr start
        let typedFin = typeExpr fin
        let typedStep = typeExpr step
        let typedBody = typeStatement body
        ForNum(typedVar,typedStart,typedFin,typedStep,typedBody, rng)
    | Syntax.ForGeneric(vars,gens,body,rng) ->
        let typedVars = List.map typeExpr vars
        let typedGens = List.map typeExpr gens
        let typedBody = typeStatement body
        ForGeneric(typedVars,typedGens,typedBody,rng)
    | Syntax.Repeat(cond,body,rng) ->
        let typedCond = typeExpr cond
        let typedBody = typeStatement body
        Repeat(typedCond,typedBody,rng)
    | Syntax.LocalAssign(names,exprs,annotation,rng) ->
        let typedNames = List.map typeExpr names
        let typedExprs = List.map typeExpr exprs

        LocalAssign(
            annotation,
            typedNames,
            typedExprs,
            rng
        )

    | Syntax.Assign(names,exprs,annotation,rng) ->
        let typedNames = List.map typeExpr names
        let typedExprs = List.map typeExpr exprs

        Assign(
            annotation,
            typedNames,
            typedExprs,
            rng
        )
    | Syntax.Return(vals,rng) ->
        let typedVals = List.map typeExpr vals
        Return(typedVals,rng)
    | Syntax.Break(rng) ->
        Break(rng)
    | Syntax.DoNothing(rng) ->
        DoNothing(rng)
    | Syntax.ErrorStatement(msg,rng) ->
        ErrorStatement(msg, rng)

refTypeExpr := fun (expr : Syntax.Expr) ->
    match expr with
    | Syntax.Number(v,rng) ->
        Number(v,rng)
    | Syntax.String(v,rng) ->
        String(v,rng)
    | Syntax.Nil(rng) ->
        Nil(rng)
    | Syntax.True(rng) ->
        True(rng)
    | Syntax.False(rng) ->
        False(rng)
    | Syntax.VarArgs(rng) ->
        VarArgs(rng)
    | Syntax.Constructor(fields,rng) ->
        let typedFields = List.map typeConstructorField fields
        Constructor(typedFields,rng)
    | Syntax.Function(selfName, formals,hasVarArgs,body,annotation,rng) ->
        match annotation with
        | Some (desc, paramList, retList, varList) ->
            let getParamInfo (formal : Expr) =
                match formal with
                | Syntax.NameExpr(f,rng) ->
                    match List.tryFind (fun (name,desc,tyName) -> name = f) paramList with
                    | Some (name,desc,tyName) ->
                        (f,desc,Type.FromString tyName)
                    | None ->
                        (f,"",UnknownTy)
                | _ ->
                    failwith "asdfasg"

            let typedFormals = List.map getParamInfo formals
            let typedRets = List.map (fun (name,desc) -> desc,Type.FromString name) retList
            Function(desc,selfName,typedFormals,hasVarArgs,typedRets, typeStatement body, rng)
        | None ->
            let typedFormals = List.map (fun (Syntax.NameExpr(f,_)) -> (f,"",UnknownTy)) formals
            let typedRets = []
            Function("",selfName,typedFormals,hasVarArgs,typedRets, typeStatement body, rng)
    | Syntax.UnOpExpr(op,expr,rng) ->
        UnOpExpr(op, typeExpr expr, rng)
    | Syntax.BinOpExpr(op,a,b,rng) ->
        BinOpExpr(op, typeExpr a, typeExpr b, rng)
    | Syntax.ParenthesizedExpr(expr, rng) ->
        ParenthesizedExpr(typeExpr expr, rng)
    | Syntax.NameExpr(name, rng) ->
        NameExpr(name,rng)
    | Syntax.CallExpr(toCallExpr,argExprs,rng) ->
        let typedToCallExpr = typeExpr toCallExpr
        let typedArgExprs = List.map typeExpr argExprs
        CallExpr(typedToCallExpr,typedArgExprs,rng)
    | Syntax.ErrorExpr(msg,rng) ->
        ErrorExpr(msg,rng)

refTypeConstructorField := fun (consField : Syntax.ConstructorField) ->
    match consField with
    | Syntax.ListField(annotation,expr,rng) ->
        ListField(annotation,typeExpr expr, rng)
    | Syntax.RecField(annotation,keyExpr,valExpr,rng) ->
        RecField(annotation, typeExpr keyExpr, typeExpr valExpr, rng)
    | Syntax.ErrorField(msg, rng) ->
        ErrorField(msg,rng)

/// Statement(exprs,stats)
///
/// Matches a statement in which exprs contains all of the expressions
/// which are direct subterms of the scrutinee and stats contains all
/// statements which are direct subterms of the scrutinee.
///
/// This active pattern allows the user to decompose a statement into
/// its subexpresions and substatements in a way that is homogenous
/// across all Statement constructs. This is useful for searching
/// syntax trees for things like errors.
let (|TypedStatement|) (stat : TypedStatement) =
    match stat with
    /// If((condition,chunk) list)
    | If(clauses, _) ->
        let exprs,stats = List.unzip clauses
        (exprs,stats)
    | While(cond,body,_) ->
        ([cond],[body])
    | Do(stmt,_) ->
        ([],[stmt])
    | ForNum(var,start,fin,step,body,_) ->
        ([var;start;fin;step], [body])
    | ForGeneric(vars, gens, stmt, _) ->
        (List.append vars gens,[stmt])
    | Repeat(expr,stat,_) ->
        ([expr],[stat])
    | LocalAssign(_,lvals,rvals,_) ->
        (List.append lvals rvals,[])
    | Assign(_,lvals,rvals,_) ->
        (List.append lvals rvals, [])
    | Return(exprs,_) ->
        (exprs, [])
    | Break(_) ->
        ([],[])
    | Call(expr, _) ->
        ([expr],[])
    | Sequence(s0,s1,_) ->
        ([],[s0;s1])
    | DoNothing(_) ->
        ([],[])
    | ErrorStatement(_,_) ->
        ([],[])

/// Expr(exprs,statement,fields)
///
/// Matches an expr in which exprs contains all of the expressions
/// which are direct subterms of the scrutinee, stats contains all
/// statements which are direct subterms of the scrutinee, and fields
/// contains all constructor fields which are direct subterms of the 
/// scrutinee.
///
/// This active pattern allows the user to decompose an expression into
/// its subexpresions and substatements in a way that is homogenous
/// across all Expr constructs. This is useful for searching
/// syntax trees for things like errors.
let (|TypedExpr|) (expr : TypedExpr) =
    match expr with
    | Number(_,_)
    | String(_,_)
    | Nil(_)
    | True(_)
    | False(_)
    | VarArgs(_) 
    | NameExpr(_,_)
    | ErrorExpr(_,_) ->
        ([],[],[])
    | Constructor(fields,_) ->
        ([],[],fields)
    | Function(_,_,args,_,_,stat,_) ->
        ([],[stat],[])
    | UnOpExpr(_,expr,_) ->
        ([expr],[],[])
    | BinOpExpr(_,e0,e1,_) ->
        ([e0;e1],[],[])
    | ParenthesizedExpr(e,_) ->
        ([e],[],[])
    | CallExpr(func,args,_) ->
        (func :: args, [], [])

let (|TypedConstructorField|) (field : TypedConstructorField) : List<TypedExpr>*List<TypedStatement>*List<TypedConstructorField> =
    match field with
    | ListField(_,expr,_) ->
        ([expr],[],[])
    | RecField(_,e0,e1,_) ->
        ([e0;e1],[],[])
    | ErrorField(_,_) ->
        ([],[],[])

//in sig
let rec (|NameChain|_|) (lexp : TypedExpr) =
    let rec (|NameChainAux|_|) (lexp : TypedExpr) =
        match lexp with
        | BinOpExpr(OpInd, l, String(name,_), _) ->
            match l with
            | NameChainAux(names) ->
                Some (name :: names)
            | _ ->
                None
        | NameExpr(name,_) ->
            Some [name]
        | _ ->
            None

    match lexp with
    | NameChainAux(names) ->
        // Since we peel off names right-to-left, we reverse in order
        // to yield the intuitive left-to-right format
        Some (List.rev names)
    | _ ->
        None