Type Checker

Author: Seng-Jik

YukimiScript.CodeGen.Lua/Lua.fs

@@ -44,7 +44,7 @@ let generateLua (Intermediate scenes) : string =
                             | Symbol "nil" -> "nil"
                             | Symbol x -> "api." + x
                             | Integer x -> string x
-                            | Number x -> string x
+                            | Real x -> string x
                             | String x -> "\"" + Constants.string2literal x + "\"")
 
                     if not <| List.isEmpty args then

YukimiScript.Parser.Test/TestConstants.fs

@@ -31,11 +31,11 @@ let testNumbers () =
 
     for _ in 0 .. 16 do
         let i = float (rnd.Next()) + rnd.NextDouble()
-        testConstant (string i) <| Number i
+        testConstant (string i) <| Real i
         let j = -(float (rnd.Next()) + rnd.NextDouble())
-        testConstant (string j) <| Number j
+        testConstant (string j) <| Real j
 
-    testConstant "- 176.00" <| Number -176.0
+    testConstant "- 176.00" <| Real -176.0
 
 
 [<Test>]

YukimiScript.Parser.Test/TestStatments.fs

@@ -16,4 +16,4 @@ let testCommandCall () =
                 Integer -256 ]
           NamedArgs =
               [ "effect", Symbol "a"
-                "camera", Number -2.0 ] }
+                "camera", Real -2.0 ] }

YukimiScript.Parser/Constants.fs

@@ -33,7 +33,7 @@ let private numberParser, integerParser =
             do! literal "."
             let! b = unsignedIntegerString
 
-            return Number <| float (sign + a + "." + b)
+            return Real <| float (sign + a + "." + b)
         }
         |> name "number"
 

YukimiScript.Parser/Dom.fs

@@ -166,7 +166,7 @@ module Dom =
             (fun (sceneDef, block, debugInfo) ->
                 Macro.expandBlock macros block
                 |> Result.map (fun x -> sceneDef, x, debugInfo))
-        |> ParserMonad.switchResultList
+        |> ParserMonad.sequenceRL
         |> Result.map (fun scenes -> { x with Scenes = scenes })
 
 
@@ -225,9 +225,9 @@ module Dom =
 
         let linkToExternCommands (sceneDef, block, debugInfo) =
             List.map linkSingleCommand block
-            |> ParserMonad.switchResultList
+            |> ParserMonad.sequenceRL
             |> Result.map (fun block -> sceneDef, (block: Block), debugInfo)
 
         List.map linkToExternCommands x.Scenes
-        |> ParserMonad.switchResultList
+        |> ParserMonad.sequenceRL
         |> Result.map (fun scenes -> { x with Scenes = scenes })

YukimiScript.Parser/Elements.fs

@@ -3,7 +3,7 @@
 
 type Constant =
     | String of string
-    | Number of float
+    | Real of float
     | Integer of int32
     | Symbol of string
 

YukimiScript.Parser/Macro.fs

@@ -92,7 +92,7 @@ let matchArguments debugInfo (x: Parameter list) (c: CommandCall) : Result<(stri
     |> Result.bind
         (fun () ->
             List.map (fun x -> matchArg x.Parameter) x
-            |> switchResultList)
+            |> sequenceRL)
 
 
 let private matchMacro debug x macro =
@@ -140,19 +140,19 @@ let rec private expandSingleOperation macros operation : Result<Block, exn> =
                 | x -> x
                 >> expandSingleOperation macros
             )
-            |> switchResultList
+            |> sequenceRL
             |> Result.map List.concat
     | x -> Ok [ x ]
 
 
 let expandBlock macros (block: Block) =
     List.map (expandSingleOperation macros) block
-    |> switchResultList
+    |> sequenceRL
     |> Result.map List.concat
 
 
 let expandSystemMacros (block: Block) =
-    let systemMacros = [ "__diagram_link_to" ]
+    let systemMacros = [ "__diagram_link_to"; "__type" ]
 
     block
     |> List.map

YukimiScript.Parser/Parser.fs

@@ -56,7 +56,7 @@ let parseLines (line: string []) : Result<Parsed list, (int * exn) list> =
             | _ -> None)
 
     if List.isEmpty errors then
-        match switchResultList parsed with
+        match sequenceRL parsed with
         | Ok x -> Ok x
         | _ -> failwith "Internal Error"
     else

YukimiScript.Parser/ParserMonad.fs

@@ -39,7 +39,7 @@ let tryWith (f: exn -> Parser<'a>) (a: Parser<'a>) : Parser<'a> =
 let explicit (a: Parser<'a>) : Parser<'a> = mapError raise a
 
 
-let switchResultList (x: Result<'a, 'b> list) : Result<'a list, 'b> =
+let sequenceRL (x: Result<'a, 'b> list) : Result<'a list, 'b> =
     (x, Ok [])
     ||> List.foldBack
             (fun x state ->

YukimiScript.Parser/TypeChecker.fs

@@ -0,0 +1,93 @@
+module YukimiScript.Parser.TypeChecker
+
+open YukimiScript.Parser.Elements
+
+
+type SimpleType =
+    | Int'
+    | Real'
+    | String'
+    | Symbol'
+
+
+type ParameterType = ParameterType of name: string * Set<SimpleType>
+
+
+module Types = 
+    let any = ParameterType ("any", set [ Int'; Real'; String'; Symbol' ])
+    let int = ParameterType ("int", set [ Int' ])
+    let number = ParameterType ("number", set [ Int'; Real' ])
+    let real = ParameterType ("real", set [ Real' ])
+    let symbol = ParameterType ("symbol", set [ Symbol' ])
+    let void' = ParameterType ("void", set [])
+    let all = [ any; int; number; real; symbol; void' ]
+
+
+let sumParameterType (ParameterType (n1, s1)) (ParameterType (n2, s2)) =
+    ParameterType (n1 + " | " + n2, Set.union s1 s2)
+
+
+let checkType = 
+    function
+    | String _ -> String'
+    | Integer _ -> Int'
+    | Real _ -> Real'
+    | Symbol _ -> Symbol'
+
+    
+exception TypeCheckFailedException of DebugInformation * int * ParameterType * SimpleType
+
+
+let matchType d i (ParameterType (t, types)) (argType: SimpleType) : Result<unit, exn> =
+    if Set.contains argType types
+    then Ok ()
+    else Error <| TypeCheckFailedException (d, i, (ParameterType (t, types)), argType)
+
+
+let matchCallTypes d (pars: ParameterType list) (argType: SimpleType list) =
+    List.zip pars argType |> List.mapi (fun i (a, b) -> matchType d i a b)
+    |> ParserMonad.sequenceRL |> Result.map ignore
+
+
+let matchCall d (pars: ParameterType list) (argType: Constant list) =
+    argType |> List.map checkType |> matchCallTypes d pars
+
+
+exception IsNotAType of string
+
+
+let parametersTypeFromBlock (par: Parameter list) (b: Block) =
+    let typeMacroParams = 
+        [ { Parameter = "param"; Default = None }
+          { Parameter = "type"; Default = None } ]
+    
+    List.choose (function
+        | CommandCall c, d when c.Callee = "__type" -> Some (c, d)
+        | _ -> None) b
+    |> List.map (fun (c, d) -> Macro.matchArguments d typeMacroParams c)
+    |> ParserMonad.sequenceRL
+    |> Result.bind (fun x ->
+        let paramTypePairs =
+            List.map (readOnlyDict >> fun x ->
+                match x["param"], x["type"] with
+                | Symbol par, Symbol t -> par, t
+                | _ -> failwith "parametersTypeFromBlock: failed!") x
+                
+        par
+        |> List.map (fun { Parameter = name; Default = _ } -> 
+            paramTypePairs
+            |> List.filter (fst >> (=) name)
+            |> List.map snd
+            |> function
+                | [] -> Ok Types.any
+                | types -> 
+                    types
+                    |> List.map (fun typeName -> 
+                        Types.all
+                        |> List.tryFind (fun (ParameterType (n, _)) -> n = typeName)
+                        |> function
+                            | Some x -> Ok x
+                            | None -> Error <| IsNotAType typeName)
+                    |> ParserMonad.sequenceRL
+                    |> Result.map (List.reduce sumParameterType))
+        |> ParserMonad.sequenceRL)