Commits

kevinclancy committed 4cb75b7

for better or worse, changed Method to a record type. Also got rid of
EmptyMetamethodSet (it's the static member "empty" of MetamethodSet now)

Comments (0)

Files changed (9)

ClassicTypeCollector/Main.fs

                     (fileName, nameRng)
                 )
 
-            Map.empty, new MethodMap([(fieldName,(desc,methodTy,false,(fileName,nameRng)))])
+            Map.empty, new MethodMap([(fieldName,{desc=desc;ty=methodTy;isAbstract=false;loc=(fileName,nameRng)})])
         else
             let fieldTy = 
                 FunctionTy(
             modname,
             "", //TODO: we need to yoink module descriptions
             false,
-            EmptyMetamethodSet, 
+            MetamethodSet.empty, 
             fields,
             methods,
             (path,rng)

LoveStudio/LuaAnalyzer/BasePlugin.fs

                 true,
                 loc
             )
-            
-        (name, (description, newTy, false, NoLocation))
+
+        (name, {desc=description;ty=newTy;isAbstract=false;loc=NoLocation})
     | UnknownTy ->
-        (name, (description, UnknownTy, false, NoLocation)) 
+        (name, {desc=description;ty=UnknownTy;isAbstract=false;loc=NoLocation}) 
     | _ ->
         failwith "error reading XML: methods must have function type."
         
             seq []
         else
             element.Element(!!"methods").Elements()
-    
+        
     let methods = new Map<string,Method>(List.map (readMethod env) (Seq.toList methods))
 
     RecordTy(
         name, 
         description, 
         false,
-        EmptyMetamethodSet, 
+        MetamethodSet.empty, 
         cover supertypeFields fields,
         cover supertypeMethods methods,
         NoLocation
         | RecordTy(name,desc,_,metaset,fields,methods,defLocation) ->
             let metaset =
                 {
-                EmptyMetamethodSet with
+                MetamethodSet.empty with
                     Concat = Some ("concatenate two strings", UserDefinedTy("string"), UserDefinedTy("string"))
                     Len = Some ("get the length of the string", NumberTy)
                     Eq = Some ("are these two strings equal?",UserDefinedTy("string"),BoolTy)
                 }
             RecordTy(name,desc,false,metaset,fields,methods,defLocation)
         | _ ->
-            failwith "...no"
+            failwith "unreachable"
 
     let tenv = ctxt.tenv
     

LoveStudio/LuaAnalyzer/Context.fs

 
 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. 
                 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)
         }
 
+    /// 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 =
                 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 () =
             {
                 trackErrors = false
             }
 
+    /// A context identical to this one, except intended for left expressions
     member this.IsLeftExpr
         with get () =
             {
                 isLeftExpr = true
             }
 
+    /// A context identical to this one, except intended for non-left expressions
     member this.IsNotLeftExpr
         with get () =
             {
                 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 () =
             {

LoveStudio/LuaAnalyzer/LuaAnalyzer.fs

                 let field = fields.Item fieldOrMethodName
                 false, (field.desc,field.ty,field.loc)
             else if methods.ContainsKey fieldOrMethodName then
-                let desc,ty,_,loc = methods.Item fieldOrMethodName
+                let {desc=desc;ty=ty;isAbstract=_;loc=loc} = methods.Item fieldOrMethodName
                 true, (desc,ty,loc)
             else
                 false, ("", UnknownTy, NoLocation)
         let fieldList = new GenList<string*string*string>()
         for kv in fields do
             let name = kv.Key
-            let {desc = desc;ty=ty;loc=_} = kv.Value
-            fieldList.Add(name,ty.ToString(),desc)
+            let field = kv.Value
+            fieldList.Add(name,field.ty.ToString(),field.desc)
         
         let methodList = new GenList<string*string*string>()
         for kv in methods do
             let name = kv.Key
-            let (desc,ty,_,_) = kv.Value
+            let {desc=desc;ty=ty;isAbstract=_;loc=_} = kv.Value
             methodList.Add(name,ty.ToString(),desc)            
         
         {

LoveStudio/LuaAnalyzer/ProjectChecker.fs

 /// Iterates through each module mentioned in the subtype graph contained in tenv,
 /// collecting an instance and a constructor type from each one, accumulating these
 /// types into the consMap and typeMap fields of the environment.
-let buildExternalTypes (tenv : TypeEnvironment) 
-                       (collectorMap : Map<string,TypeCollector>) 
-                       (astMap : Map<string,TypedStatement>) 
+let buildExternalTypes (tenv : TypeEnvironment)
+                       (collectorMap : Map<string,TypeCollector>)
+                       (astMap : Map<string,TypedStatement>)
                        : TypeEnvironment =
 
-    //Contract.Ensures(tenv.instanceTypes.Count <= tenv.typeMap.Count)
-    //Contract.Ensures(tenv.consMap.Count <= tenv.typeMap.Count) 
-
+    //In tenv, all built-in, API, and project-defined types have
+    //been recorded in instanceTypes, but actual types for the project-defined
+    //ones have not been entered into typeMap
+    Contract.Requires(tenv.typeMap.Count <= tenv.instanceTypes.Count) 
+    
+    // In the result, all project-defined instance types have been entered
+    // into the typeMap. Constructor types have potentially been added
+    // to the typeMap as well, so strict equality is not guaranteed.
+    Contract.Ensures(Contract.Result<TypeEnvironment>().typeMap.Count >= Contract.Result<TypeEnvironment>().instanceTypes.Count)
+    
     let foldType (tenv : TypeEnvironment) (typeName : string) : TypeEnvironment =
         if tenv.instanceTypes.Contains typeName then
             let fileName = tenv.typeFiles.Item typeName
 /// Returns the resulting context.
 let buildGlobalCtxt (ctxt : Context) (modules : seq<string*string*TypedStatement*int64>) (globalsModName : string) =
     
-    Contract.Ensures(ctxt.tenv.typeMap.Count = Contract.OldValue(ctxt.tenv.typeMap.Count))
-    Contract.Ensures(ctxt.venv.Count >= Contract.OldValue(ctxt.venv.Count))
+    Contract.Ensures(Contract.Result<Context>().tenv.typeMap.Count = ctxt.tenv.typeMap.Count)
+    Contract.Ensures(Contract.Result<Context>().venv.Count >= ctxt.venv.Count)
 
-    let res = Seq.tryFind (fun (fileName,modName,_,_) -> modName = globalsModName) modules
+    let globalsModule = Seq.tryFind (fun (fileName,modName,_,_) -> modName = globalsModName) modules
     
-    match res with
+    match globalsModule with
     | Some(fileName,_,ast,_) ->
         currentFileName := fileName
         let userGlobals = getAssigns ctxt ast
                        (astMap : Map<string,TypedStatement>) 
                        : Context  =
     
-    Contract.Ensures (ctxt.tenv.typeMap.Count >= Contract.OldValue(ctxt.tenv.typeMap.Count))
+    Contract.Ensures (Contract.Result<Context>().tenv.typeMap.Count >= ctxt.tenv.typeMap.Count)
 
     let topSortedTypeNames = ctxt.tenv.TopSortedTypeNames
     
             let ast = astMap.Item modName
             let collector = collectorMap.Item modName
             let collectedTypeMap = collector.internalTypeBuilder ctxt modName fileName ast
-            
+
             let tenv = 
                 {
                 tenv with
     
     List.fold foldModule ctxt topSortedTypeNames
 
+/// Sets currentFileName to fileName and then type checks ast w.r.t. baseCtxt
 let typeCheck (baseCtxt : Context) (fileName : string) (ast : TypedStatement) =
     currentFileName := fileName
     typeCheckStat baseCtxt ast
 /// stub (a call to lucbdnioua) to extract from.
 ///
 /// Given a project and a file within that project, typechecks the specified
-/// file, recording the context when the typechecker reach a call to "lucbdnioua",
+/// file, recording the context when the typechecker reaches a call to "lucbdnioua",
 /// It is assumed that exactly one call to lucbdnioua exists in the file.
 let getStubContextInProject (modules : seq<LuaModule>) (targetFile : string) =
     ignore (runTypeCollectors modules (Some(targetFile)) None)
     !refStubContext
 
-/// ctxt - a context
-/// ast - a syntax tree
+/// ctxt - a context to typecheck ast with
+/// ast - a syntax tree with an embedded placeholder to extract the context at
 ///
-/// Typechecks 
+/// Typechecks the supplied statement w.r.t. the supplied context, recording
+/// the context when the typechecker reaches a call to "lucbdnioua". It is assumed
+/// that exactly one such call exists in the statement.
 let getStubContext (ctxt : Context) (ast : TypedStatement) =
     ignore (typeCheckStat ctxt ast)
     !refStubContext

LoveStudio/LuaAnalyzer/Type.fs

     edges : Map<string,List<string>>
 }
 
-/// Description, type, isAbstract, definition location
-/// TODO: change this to a record type ala field (but think about which 
-/// approach is better; maybe we need to change the other way, but I doubt it)
-and Method = string*Type*bool*DefinitionLocation
+/// Describes an operation which can be performed by an object.
+and Method = 
+    {
+        /// A description of the method's behavior
+        desc : string
+        /// They type of the method.
+        /// Must be a function type with at least one formal parameter,
+        /// the leading parameter being a non-typed self reference.
+        // Typing the self argument would make it difficult to reuse methods
+        // via inheritence. Instead, the typing of the self argument should
+        // be done by a type collector's decorate callback.
+        ty : Type
+        /// Whether or not the method is abstract. 
+        isAbstract : bool
+        /// The location (filename, char index) at which this identifier was 
+        /// delcared.
+        loc : DefinitionLocation
+    }
 
+/// Many identifiers occurring in programs refer to runtime values. These
+/// identifiers are associated the statically computed satellite data 
+/// contained in Field.
 and Field =
     {
+        /// A description of the identifier's purpose
         desc : string
+        /// A statically computed type of the values that the identifier
+        /// denotes. Since this is not a sound type system, runtime values
+        /// associated with this identifier may sometimes not actually belong
+        /// to this type; the goal is to design the type system to minimize
+        /// the frequency of theses scenarios without limiting the programmer.
         ty : Type
-        loc : DefinitionLocation 
+        /// The location (filename, char index) at which this identifier was 
+        /// delcared.
+        loc : DefinitionLocation
+        /// Whether or not this identifier can be reassigned to expressions
+        /// determined to have type *ty*.
         isConst : bool
     }
 
     /// fields and methods which can be indexed, as well as a set of operator
     /// overloads (i.e. metamethods). 
     | RecordTy of string*string*bool*MetamethodSet*Map<string,Field>*Map<string,Method>*DefinitionLocation
-    
     /// Like record, but allows new fields to be added. TODO: comment more
     | OpenRecordTy of string*string*bool*MetamethodSet*Map<string,Field>*Map<string,Method>*DefinitionLocation
-    
     /// When an open record in an lexp gets indexed by a field it doesn't
     /// have, the resulting type is NewField. NewField is a treated as a 
     /// supertype of anything so that its variables can be assigned to anything.
     | NewFieldTy
-
     /// Function(desc,params,rets,method, deflocation) -
     /// desc - description of the function
     /// params - name/description/type triples for each formal parameter
     Gt : Option<BinOpTy>
     /// Binary '>=' operator type, if defined
     Ge : Option<BinOpTy>
-    /// Binary 'and' operator type, if defined
+    
+    /// Binary 'and' operator type, if defined; for certain built-in types only
     And : Option<BinOpTy>
-    /// Binary 'or' operator type, if defined
+    /// Binary 'or' operator type, if defined; for certain built-in types only
     Or : Option<BinOpTy>
-    /// Unary 'not' operator type, if defined
+    /// Unary 'not' operator type, if defined; for certain built-in types only
     Not : Option<UnOpTy>
 
     /// Binary '[]' operator type, if defined
     Call : Option< string*List<string*string*Type>*List<string*Type>*bool*DefinitionLocation > 
 }
 
-/// Default metamethod set, defining metamethods only for the == and ~=
-/// operators, which can be applied to operands of any type.
-let EmptyMetamethodSet = {
-    Add = None
-    Sub = None
-    Mul = None
-    Div = None
-    Mod = None
-    Pow = None
-    Unm = None
-    Concat = None
-    Len = None
-    Eq = Some("equal",UnknownTy,BoolTy)
-    Ne = Some("not equal",UnknownTy,BoolTy)
-    Lt = None
-    Le = None
-    Gt = None
-    Ge = None
-    And = None
-    Or = None
-    Not = None
-    Index = None
-    Call = None
-}
 
 type MetamethodSet with
+    /// Default metamethod set, defining metamethods only for the == and ~=
+    /// operators, which can be applied to operands of any type.
     static member empty
         with get () =
-            EmptyMetamethodSet
+            {
+                Add = None
+                Sub = None
+                Mul = None
+                Div = None
+                Mod = None
+                Pow = None
+                Unm = None
+                Concat = None
+                Len = None
+                Eq = Some("equal",UnknownTy,BoolTy)
+                Ne = Some("not equal",UnknownTy,BoolTy)
+                Lt = None
+                Le = None
+                Gt = None
+                Ge = None
+                And = None
+                Or = None
+                Not = None
+                Index = None
+                Call = None
+            }
 
+
+    /// Returns a metamethod set which is the result of covering a with b.
+    ///
+    /// i.e. a metamethod set which uses all of the metamethods
+    /// of b which are defined. For those which does b does not define,
+    /// it uses a's metamethods if they exist. If neither set defines
+    /// an operator, the resulting set does not define that operator.
     static member cover (a : MetamethodSet) (b : MetamethodSet) =
-        { EmptyMetamethodSet with
+        { MetamethodSet.empty with
             Add = if Option.isSome b.Add then b.Add else a.Add
             Sub = if Option.isSome b.Sub then b.Sub else a.Sub
             Mul = if Option.isSome b.Mul then b.Mul else a.Mul
         }
             
 type TypeEnvironment with
+    /// An empty type environment
     static member empty
         with get () =
             {
                 edges = Map.empty
             }
     
+    /// A list of all typenames appearing in the nominal subtyping
+    /// graph, topologically sorted. what does it mean for a list to be 
+    /// topologically sorted? See the wikipedia page on it: *insert url here*.
+    /// Also, read CLRS; you'll learn a bunch of other cool algorithms in 
+    /// addition to the topological sort.
     member this.TopSortedTypeNames
         with get() =
             let subtypeEdges = this.edges
     | RecordTy(name,description,srcExpr,metamethods,fieldMap,methodMap,rng) ->
         Some (metamethods,fieldMap,methodMap)
     | UnknownTy ->
-        Some (EmptyMetamethodSet,Map.empty,Map.empty)
+        Some (MetamethodSet.empty,Map.empty,Map.empty)
     | _ ->
         None
 
         }
     | NumberTy ->
         {
-            EmptyMetamethodSet with
+            MetamethodSet.empty with
                 Add = Some ("Add two numbers",NumberTy,NumberTy)
                 Sub = Some ("Subtract right-hand number from left-hand number",NumberTy,NumberTy)
                 Mul = Some ("Multiply two numbers",NumberTy,NumberTy)
         }
     | StringTy ->
         {
-            EmptyMetamethodSet with
+            MetamethodSet.empty with
                 Concat = Some ("concatenate two strings", StringTy, StringTy)
                 Len = Some ("get the length of the string", NumberTy)
                 Eq = Some ("are these two strings equal?",NillableTy(StringTy),BoolTy)
         }
     | BoolTy ->
         {
-            EmptyMetamethodSet with
+            MetamethodSet.empty with
                 And = Some ("boolean and", BoolTy, BoolTy)
                 Or = Some ("boolean or", BoolTy, BoolTy)
                 Not = Some ("boolean not", BoolTy)
             Call = None
         }        
     | _ ->
-        EmptyMetamethodSet
+        MetamethodSet.empty
 
 /// Used for when someone tries to override a method using an incorrect 
 /// type signature.
     | (UnknownTy,UnknownTy) ->
         ()
     | (RecordTy(nameA,_,_,metamethodsA,fieldsA,methodsA,(fileA,rngA)), RecordTy(nameB,_,_,metamethodsB,fieldsB,methodsB,(fileB,rngB))) ->
-        let compatMethod methNameB (name,methTyB,_,methLocB) =
+        let compatMethod methNameB (methB : Method) =
             if not (methodsA.ContainsKey methNameB) then
                 //TODO: we need the record type to carry defLocation here
                 raise( StructuralSubtypingError("class does not contain " + methNameB + " method from supertype",fileA,rngA) )
             else
-                let _,methTyA,_,(methFileA, methRngA) = methodsA.Item methNameB
-                if not (Type.IsEqual env methTyA methTyB) then
+                let methA = methodsA.Item methNameB
+                let (methFileA,methRngA) = methA.loc
+                if not (Type.IsEqual env methA.ty methB.ty) then
                     raise( StructuralSubtypingError(methNameB + " does not match between " + nameA + " and " + nameB, methFileA, methRngA) )
         
         Map.iter compatMethod methodsB
                  raise( StructuralSubtypingError("record does not contain " + fieldNameB + " field ", fileA,rngA) )
             else
                 let fieldA = fieldsA.Item fieldNameB
-                let {desc=_;ty=_;loc=(fieldFileA,fieldRngA)} = fieldA 
+                let (fieldFileA,fieldRngA) = fieldA.loc
                 if fieldA.isConst && fieldB.isConst then
                     let isSub,expl = Type.IsSubtypeOf env fieldA.ty fieldB.ty
                     if not isSub then

LoveStudio/LuaAnalyzer/Typechecker.fs

                 "*UnnamedRecord*", 
                 "",
                 true,
-                EmptyMetamethodSet, 
+                MetamethodSet.empty, 
                 new Map<string,Field>(List.map getLabelAndTy fields),
                 new Map<string,Method>([]), 
                 (!currentFileName,rng)
             List.iter checkListElement fields
 
             let metaset = {
-                EmptyMetamethodSet with
+                MetamethodSet.empty with
                     Index = Some("index into table", NumberTy, fieldTy0)
             }
 
             UnknownTy,None
         | (OpenRecordTy(_,_,_,_,_,methods,_),OpMethInd, String(str,mrng))
         | (RecordTy(_,_,_,_,_,methods,_),OpMethInd, String(str,mrng)) when methods.ContainsKey str ->
-            match methods.Item str with
-            | (desc,ty,abs,loc) ->
-                if ctxt.queryPos.IsSome && inRange ctxt.queryPos.Value mrng then
-                    refStubDesc := desc
-                    refStubDefLoc := loc
-                    refStubTy := ty
-                ty,None
+            let meth = methods.Item str
+            if ctxt.queryPos.IsSome && inRange ctxt.queryPos.Value mrng then
+                refStubDesc := meth.desc
+                refStubDefLoc := meth.loc
+                refStubTy := meth.ty
+            meth.ty,None
         | (RecordTy(name,_,_,_,_,methods,_),OpMethInd, String(str,_)) ->
             if ctxt.trackErrors then
                 addError

LoveStudio/LuaAnalyzer/TypedSyntax.fs

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

LoveStudio/LuaAnalyzer/Utils.fs

     if lst.Length < targetLength then
         padList lst filler targetLength
     else
-        popnBack lst (lst.Length-targetLength)
+        popnBack lst (lst.Length-targetLength)