Commits

kevinclancy committed 67abd5b

More cleaning. More comments. More contracts.

  • Participants
  • Parent commits a47bee0

Comments (0)

Files changed (3)

File LoveStudio/LuaAnalyzer/Typechecker.fs

 
     getAllAccumulationsAux ctxt Set.empty stat
 
-/// Gets types of all unbound assigns in statement
+/// Gets types of all unbound assigns in statement, checked w.r.t. context
+/// example: "local a = 5;a=6" would give []
+/// example: "a=6;local a = 'hello'; a=''" would give [("a",NumberTy)]
 let rec getAssigns (ctxt : Context) (stat : TypedStatement) : ValueEnvironment =
     let venv,tenv = ctxt.venv, ctxt.tenv
     match stat with
     | If(clauses,rng) ->
         // For if statements, we get only those variables that are assigned in
         // each clause, using the type from the first clause
-
         let clauseAssigns = List.map (getAssigns ctxt) (List.map snd clauses)
         let clause0 = clauseAssigns.[0]
         
     else
         true
 
+/// so that we can attach comments (and ascriptions?) to them
+let getLabelAndTy (ctxt : Context) (field : TypedConstructorField) =
+    match field with
+    | RecField(ann,String(k,_),v,rng) ->
+        let desc,ascs,isConstList = Type.InterpretVarAnnotation ann 1
+                
+        let ctxt = ctxt.IsNotLeftExpr.DontTrackErrors
+
+        let field = 
+            match ascs.[0] with
+            | Some ty -> 
+                {
+                    desc = desc.[0]
+                    ty = (fst >> Type.Untuple) (typeCheckExpr ctxt (Ascription(v,ty,rng)))
+                    loc = (!currentFileName,rng)
+                    isConst = isConstList.[0]
+                }
+            | None -> 
+                {
+                    desc = desc.[0]
+                    ty = (fst >> Type.Untuple) (typeCheckExpr ctxt v)
+                    loc = (!currentFileName,rng)
+                    isConst = isConstList.[0]
+                }
+
+        (k, field)
+    | _ ->
+        failwith "only structural fields allowed"
+
 let typeCheckField (ctxt : Context) (field : TypedConstructorField) =
     match field with
     | ListField(annotation,expr, _) ->
     | ErrorField(msg,_) ->
         ()
 
+let checkListElement (ctxt : Context) (expectedTy : Type) (field : TypedConstructorField) =
+    let fieldTy,rng = 
+        match field with
+        | ListField(_,v,rng) 
+        | RecField(_,Number(_,_),v,rng) ->
+            Type.Untuple (fst (typeCheckExpr ctxt.IsNotLeftExpr.DontTrackErrors v)), rng
+        | _ ->
+            failwith "unreachable"
+
+    if not (Type.IsEqual ctxt.tenv fieldTy expectedTy) then
+        addError
+            !currentFileName
+            ("Element does not have expected type " + expectedTy.ToString() + ".")
+            rng
+
+// see comment above typeCheckStat
 refTypeCheckStat := fun (ctxt : Context) (stat : TypedStatement) ->
     let venv,tenv = ctxt.venv, ctxt.tenv
     match stat with
     | ErrorStatement(_) ->
         ()
 
-// given a function type's formals return the range for the potential number
-// of arguments that it may take
-// let getFunctionTyArgRange (formals : List<type>)
+// see comment above typeCheckExpr
 refTypeCheckExpr := fun (ctxt : Context) (expr : TypedExpr) ->
     let venv, tenv = ctxt.venv, ctxt.tenv
     match expr with
     | VarArgs(rng) ->
         TupleTy([UnknownTy;UnknownTy;UnknownTy;UnknownTy;UnknownTy;UnknownTy;UnknownTy;UnknownTy;UnknownTy;UnknownTy]),None
     | Constructor(fields,rng) ->
-        
         List.iter (fun x -> (typeCheckField ctxt x)) fields
 
-        /// Returns true iff the field has literal string keys
-        let rec isStructural (field : TypedConstructorField) =
-            match field with
-            | RecField(_,String(k,_),v,_) ->
-                true
-            | _ ->
-                false
-
-        /// Returns true iff the field is a list field
-        /// TODO: fields should not be a disjoint union: list fields can be expressed with
-        /// rec fields... though error fields cannot
-        let rec isListField (field : TypedConstructorField) =
-            match field with
-            | ListField(_,_,_)
-            | RecField(_,Number(_,_),_,_) ->
-                true
-            | _ ->
-                false
-        
-        /// so that we can attach comments (and ascriptions?) to them
-        let getLabelAndTy (field : TypedConstructorField) =
-            match field with
-            | RecField(ann,String(k,_),v,rng) ->
-                let desc,ascs,isConstList = Type.InterpretVarAnnotation ann 1
-                
-                let ctxt = ctxt.IsNotLeftExpr.DontTrackErrors
-
-                let field = 
-                    match ascs.[0] with
-                    | Some ty -> 
-                        {
-                            desc = desc.[0]
-                            ty = (fst >> Type.Untuple) (typeCheckExpr ctxt (Ascription(v,ty,rng)))
-                            loc = (!currentFileName,rng)
-                            isConst = isConstList.[0]
-                        }
-                    | None -> 
-                        {
-                            desc = desc.[0]
-                            ty = (fst >> Type.Untuple) (typeCheckExpr ctxt v)
-                            loc = (!currentFileName,rng)
-                            isConst = isConstList.[0]
-                        }
-
-                (k, field)
-            | _ ->
-                failwith "only structural fields allowed"
-
-
-        if fields.Length > 0 && List.forall isStructural fields then
+        if fields.Length > 0 && List.forall TypedConstructorField.IsStructural fields then
             RecordTy(
                 "*UnnamedRecord*", 
                 "",
                 true,
                 MetamethodSet.empty, 
-                new Map<string,Field>(List.map getLabelAndTy fields),
+                new Map<string,Field>(List.map (getLabelAndTy ctxt) fields),
                 new Map<string,Method>([]), 
                 (!currentFileName,rng)
             ),
             None
-        elif fields.Length > 0 && List.forall isListField fields then 
-            let fieldTy0 = 
+        elif fields.Length > 0 && List.forall TypedConstructorField.IsListLike fields then 
+            let firstFieldValueType = 
                 match fields.[0] with
                 | ListField(_,v,_) 
                 | RecField(_,Number(_,_),v,_) ->
                     Type.Untuple (fst (typeCheckExpr ctxt.IsNotLeftExpr.DontTrackErrors v))
+                | _ ->
+                    failwith "unreachable"
 
-            let checkListElement (field : TypedConstructorField) =
-                let fieldTy,rng = 
-                    match field with
-                    | ListField(_,v,rng) 
-                    | RecField(_,Number(_,_),v,rng) ->
-                        Type.Untuple (fst (typeCheckExpr ctxt.IsNotLeftExpr.DontTrackErrors v)), rng
-
-                if not (Type.IsEqual tenv fieldTy fieldTy0) then
-                    addError
-                        !currentFileName
-                        ("Element does not have expected type " + fieldTy0.ToString() + ".")
-                        rng
-
-            List.iter checkListElement fields
+            List.iter (checkListElement ctxt firstFieldValueType) fields
 
             let metaset = {
                 MetamethodSet.empty with
-                    Index = Some("index into table", NumberTy, fieldTy0)
+                    Index = Some("index into table", NumberTy, firstFieldValueType)
             }
 
             RecordTy(
                 refStubDefLoc := meth.loc
                 refStubTy := meth.ty
             meth.ty,None
-        | (RecordTy(name,_,_,_,_,methods,_),OpMethInd, String(str,_)) ->
-            if ctxt.trackErrors then
-                addError
-                    !currentFileName
-                    (name + " does not have a method called " + str)
-                    rng
-            UnknownTy,None
+        | (RecordTy(name,_,_,_,_,_,_),OpMethInd, String(str,_))
         | (OpenRecordTy(name,_,_,_,_,_,_),OpMethInd, String(str,_)) ->
             if ctxt.trackErrors then
                 addError
                     rng
                 UnknownTy,None
             elif ctxt.isLeftExpr then
-                NewFieldTy,None//RecordTy("*NewField*","",None,MetamethodSet.empty,Map.empty,Map.empty,("",(0,0)))
+                NewFieldTy,None
             else
                 if ctxt.trackErrors then
                     addError

File LoveStudio/LuaAnalyzer/TypedSyntax.fs

     | RecField of Option<Annotation>*TypedExpr*TypedExpr*Range
     | ErrorField of string*Range
 
+type TypedConstructorField with
+    static member public IsStructural (field : TypedConstructorField) =
+        match field with
+        | RecField(_,String(k,_),v,_) ->
+            true
+        | _ ->
+            false        
+
+    //TODO: there is no reason to have separate list and rec fields
+    static member public IsListLike (field : TypedConstructorField) =
+        match field with
+        | ListField(_,_,_)
+        | RecField(_,Number(_,_),_,_) ->
+            true
+        | _ ->
+            false
+
 /// 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) =

File LoveStudio/LuaAnalyzer/TypedSyntax.fsi

     | RecField of Option<Annotation>*TypedExpr*TypedExpr*Range
     | ErrorField of string*Range
 
+    static member public IsStructural : TypedConstructorField -> bool  
+
+    static member public IsListLike : TypedConstructorField -> bool
+
 /// Gets the range of character indices for the text corresponding to the
 /// given expression in the source file it was extracted from.
 val getExprRange : TypedExpr -> Range