Type Checker Support

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.CommandLineTool/Compile.fs

@@ -52,7 +52,7 @@ let private findRepeat (items: (string * Elements.DebugInformation) seq) =
 
 let checkRepeat errStringing (dom: Dom) =
     dom.Externs
-    |> Seq.map (fun (Elements.ExternCommand (cmd, _), dbg) -> cmd, dbg)
+    |> Seq.map (fun (Elements.ExternCommand (cmd, _), _, dbg) -> cmd, dbg)
     |> findRepeat
     |> Seq.tryHead
     |> function
@@ -74,7 +74,7 @@ let checkRepeat errStringing (dom: Dom) =
             |> unwrapDomException errStringing
 
     dom.Macros
-    |> Seq.map (fun (s, _, dbg) -> s.Name, dbg)
+    |> Seq.map (fun (s, _, _, dbg) -> s.Name, dbg)
     |> findRepeat
     |> Seq.tryHead
     |> function

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

@@ -27,7 +27,7 @@ exception DiagramMacroErrorException of DebugInformation
 exception CannotFindSceneException of string
 
 
-let analyze (files: (string * Dom) list) : Result<Diagram> =
+let analyze (files: (string * Dom) list) : Result<Diagram, exn> =
     try
         let fileNodes, arrows =
             files
@@ -45,6 +45,10 @@ let analyze (files: (string * Dom) list) : Result<Diagram> =
                                             let p = { Parameter = "target"; Default = None }
 
                                             matchArguments debug [ p ] c
+                                            |> Result.bind (
+                                                TypeChecker.checkApplyTypeCorrect
+                                                    debug
+                                                    [ "target", TypeChecker.Types.string ])
                                             |> function
                                                 | Ok [ "target", (String target) ] -> Some target
                                                 | Error e -> raise e

YukimiScript.Parser/Dom.fs

@@ -2,12 +2,13 @@ namespace YukimiScript.Parser
 
 open YukimiScript.Parser.Parser
 open YukimiScript.Parser.Elements
+open YukimiScript.Parser.TypeChecker
 
 
 type Dom =
     { HangingEmptyLine: DebugInformation list
-      Externs: (ExternDefination * DebugInformation) list
-      Macros: (MacroDefination * Block * DebugInformation) list
+      Externs: (ExternDefination * BlockParamTypes * DebugInformation) list
+      Macros: (MacroDefination * BlockParamTypes * Block * DebugInformation) list
       Scenes: (SceneDefination * Block * DebugInformation) list }
 
 
@@ -46,6 +47,9 @@ module Dom =
     exception ExternRepeatException of name: string * debugInfo: DebugInformation seq
 
 
+    exception ExternCannotHasContentException of name: string * DebugInformation
+
+
     let private saveCurrentBlock state =
         match state.CurrentBlock with
         | None -> state
@@ -56,17 +60,33 @@ module Dom =
                         Macros =
                             match label with
                             | MacroDefination x ->
-                                (x, List.rev block, debugInfo)
-                                :: state.Result.Macros
-                            | SceneDefination _ -> state.Result.Macros
-                            | _ -> raise UnknownException
+                                let block = List.rev block
+                                match Macro.parametersTypeFromBlock x.Param block with
+                                | Ok t -> (x, t, block, debugInfo) :: state.Result.Macros
+                                | Error e -> raise e
+                            | _ -> state.Result.Macros
                         Scenes =
                             match label with
-                            | MacroDefination _ -> state.Result.Scenes
                             | SceneDefination x ->
                                 (x, List.rev block, debugInfo)
                                 :: state.Result.Scenes
-                            | _ -> raise UnknownException } }
+                            | _ -> state.Result.Scenes
+                        Externs =
+                            match label with
+                            | ExternDefination (ExternCommand (n, p)) ->
+                                if
+                                    List.forall (fst >> function
+                                        | CommandCall c when c.Callee = "__type" -> true
+                                        | EmptyLine -> true
+                                        | _ -> false) block
+                                then
+                                    match Macro.parametersTypeFromBlock p block with
+                                    | Ok t -> 
+                                        (ExternCommand (n, p), t, debugInfo) 
+                                        :: state.Result.Externs
+                                    | Error e -> raise e
+                                else raise <| ExternCannotHasContentException (n, debugInfo)
+                            | _ -> state.Result.Externs} }
 
 
     let private analyzeFold state (line, debugInfo) =
@@ -98,75 +118,62 @@ module Dom =
         | Line.Text x -> pushOperation <| Text x
         | SceneDefination scene -> Ok <| setLabel state (SceneDefination scene)
         | MacroDefination macro -> Ok <| setLabel state (MacroDefination macro)
-        | ExternDefination (ExternCommand (name, param)) ->
-            let nextState = saveCurrentBlock state
-
-            { nextState with
-                  Result =
-                      { nextState.Result with
-                            Externs =
-                                (ExternCommand(name, param), debugInfo)
-                                :: nextState.Result.Externs } }
-            |> Ok
+        | ExternDefination extern' ->  Ok <| setLabel state (ExternDefination extern')
 
 
     exception CannotDefineSceneInLibException of string
 
 
-    let analyze (fileName: string) (x: Parsed seq) : Result<Dom> =
-        let finalState =
-            x
-            |> Seq.indexed
-            |> Seq.map
-                (fun (lineNumber, { Line = line; Comment = comment }) ->
-                    line,
-                    { LineNumber = lineNumber + 1
-                      Comment = comment
-                      File = fileName })
-            |> Seq.fold
-                (fun state x -> Result.bind (fun state -> analyzeFold state x) state)
-                (Ok { Result = empty; CurrentBlock = None })
-            |> Result.map saveCurrentBlock
-
-        finalState
-        |> Result.map
-            (fun x ->
-                { Scenes = List.rev x.Result.Scenes
-                  Macros = List.rev x.Result.Macros
-                  Externs = List.rev x.Result.Externs
-                  HangingEmptyLine = List.rev x.Result.HangingEmptyLine })
-
+    let analyze (fileName: string) (x: Parsed seq) : Result<Dom, exn> =
+        try
+            let finalState =
+                x
+                |> Seq.indexed
+                |> Seq.map
+                    (fun (lineNumber, { Line = line; Comment = comment }) ->
+                        line,
+                        { LineNumber = lineNumber + 1
+                          Comment = comment
+                          File = fileName })
+                |> Seq.fold
+                    (fun state x -> Result.bind (fun state -> analyzeFold state x) state)
+                    (Ok { Result = empty; CurrentBlock = None })
+                |> Result.map saveCurrentBlock
+
+            finalState
+            |> Result.map
+                (fun x ->
+                    { Scenes = List.rev x.Result.Scenes
+                      Macros = List.rev x.Result.Macros
+                      Externs = List.rev x.Result.Externs
+                      HangingEmptyLine = List.rev x.Result.HangingEmptyLine })
+        with e -> Error e
 
     let expandTextCommands (x: Dom) : Dom =
-        let mapBlock (defination, block, debugInfo) =
-            let block =
-                block
-                |> List.collect
-                    (function
-                    | Text x, debugInfo ->
-                        [ if debugInfo.Comment.IsSome then
-                              EmptyLine, debugInfo
+        let mapBlock =
+            List.collect (function
+                | Text x, debugInfo ->
+                    [ if debugInfo.Comment.IsSome then
+                            EmptyLine, debugInfo
 
-                          yield! Text.expandTextBlock x debugInfo ]
-                    | x -> [ x ])
-
-            defination, block, debugInfo
+                      yield! Text.expandTextBlock x debugInfo ]
+                | x -> [ x ])
 
         { x with
-              Scenes = List.map mapBlock x.Scenes
-              Macros = List.map mapBlock x.Macros }
+              Scenes = List.map (fun (def, block, d) -> def, mapBlock block, d) x.Scenes
+              Macros = List.map (fun (def, t, b, d) -> def, t, mapBlock b, d) x.Macros }
 
 
     let expandUserMacros (x: Dom) =
         let macros =
-            List.map (fun (a, b, _) -> a, b) x.Macros
+            List.map (fun (a, t, b, _) -> a, t, b) x.Macros
 
         x.Scenes
         |> List.map
             (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 })
 
 
@@ -183,51 +190,52 @@ module Dom =
     exception ExternCommandDefinationNotFoundException of string * DebugInformation
 
 
-    let private systemCommands =
+    let private systemCommands : (ExternDefination * BlockParamTypes) list =
         let parse str =
             TopLevels.topLevels
             |> ParserMonad.run str
             |> function
                 | Ok (ExternDefination x) -> x
                 | _ -> failwith "Bug here!"
 
-        [ parse "- extern __text_begin character=null"
-          parse "- extern __text_type text"
-          parse "- extern __text_pushMark mark"
-          parse "- extern __text_popMark mark"
-          parse "- extern __text_end hasMore" ]
-
+        [ parse "- extern __text_begin character=null", [ "character", Types.symbol ]
+          parse "- extern __text_type text", [ "text", Types.string ]
+          parse "- extern __text_pushMark mark", [ "mark", Types.symbol ]
+          parse "- extern __text_popMark mark", [ "mark", Types.symbol ]
+          parse "- extern __text_end hasMore", [ "hasMore", Types.symbol] ]
 
-    let linkToExternCommands (x: Dom) : Result<Dom> =
-        let externs = systemCommands @ List.map fst x.Externs
 
+    let linkToExternCommands (x: Dom) : Result<Dom, exn> =
+        let externs = systemCommands @ List.map (fun (x, t, _) -> x, t) x.Externs
+            
         let linkSingleCommand (op, debugInfo) =
             match op with
             | Text _ -> Error MustExpandTextBeforeLinkException
             | CommandCall c ->
-                match List.tryFind (fun (ExternCommand (name, _)) -> name = c.Callee) externs with
+                match List.tryFind (fun (ExternCommand (name, _), _) -> name = c.Callee) externs with
                 | None ->
                     Error
                     <| ExternCommandDefinationNotFoundException(c.Callee, debugInfo)
-                | Some (ExternCommand (_, param)) ->
+                | Some (ExternCommand (_, param), t) ->
                     Macro.matchArguments debugInfo param c
+                    |> Result.bind (checkApplyTypeCorrect debugInfo t)
                     |> Result.map
                         (fun args ->
                             let args =
                                 List.map (fun { Parameter = param } -> List.find (fst >> (=) param) args |> snd) param
 
                             CommandCall
                                 { c with
-                                      UnnamedArgs = args
-                                      NamedArgs = [] })
+                                        UnnamedArgs = args
+                                        NamedArgs = [] })
             | x -> Ok x
             |> Result.map (fun x -> x, debugInfo)
 
         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/EditorHelper.fs

@@ -4,10 +4,10 @@ open YukimiScript.Parser
 open YukimiScript.Parser.Elements
 
 
-type Runner<'State> = 'State -> CommandCall -> Result<'State>
+type Runner<'State> = 'State -> CommandCall -> Result<'State, exn>
 
 
-let rec run (state: 'State) (runner: Runner<'State>) (ops: Block) : Result<'State> =
+let rec run (state: 'State) (runner: Runner<'State>) (ops: Block) : Result<'State, exn> =
     match Seq.tryHead ops with
     | None -> Ok state
     | Some (EmptyLine, _) -> run state runner <| List.tail ops
@@ -30,6 +30,6 @@ let dispatch (dispatcher: CommandCall -> Runner<'State>) : Runner<'State> = fun
 
 
 type RunnerWrapper<'TState>(init: 'TState, mainRunner: Runner<'TState>) =
-    member _.Run(state: 'TState, ops: Block) : Result<'TState> = run state mainRunner ops
+    member _.Run(state: 'TState, ops: Block) : Result<'TState, exn> = run state mainRunner ops
 
-    member x.Run(ops: Block) : Result<'TState> = x.Run(init, ops)
+    member x.Run(ops: Block) : Result<'TState, exn> = x.Run(init, ops)

YukimiScript.Parser/Elements.fs

@@ -1,11 +1,9 @@
 namespace YukimiScript.Parser.Elements
 
-open YukimiScript.Parser
-
 
 type Constant =
     | String of string
-    | Number of float
+    | Real of float
     | Integer of int32
     | Symbol of string
 
@@ -76,12 +74,12 @@ module Operation =
     exception CanNotConvertToOperationException of Line
 
 
-    let ofLine: Line -> Result<Operation> =
+    let ofLine: Line -> Operation =
         function
-        | Line.Text t -> Ok <| Text t
-        | Line.CommandCall c -> Ok <| CommandCall c
-        | Line.EmptyLine -> Ok <| EmptyLine
-        | x -> Error <| CanNotConvertToOperationException x
+        | Line.Text t -> Text t
+        | Line.CommandCall c -> CommandCall c
+        | Line.EmptyLine -> EmptyLine
+        | x -> raise <| CanNotConvertToOperationException x
 
 
 type Block = (Operation * DebugInformation) list

YukimiScript.Parser/ErrorStringing.fs

@@ -7,6 +7,7 @@ open YukimiScript.Parser.Macro
 open YukimiScript.Parser.ParserMonad
 open YukimiScript.Parser.TopLevels
 open YukimiScript.Parser.Diagram
+open YukimiScript.Parser.TypeChecker
 open System.IO
 
 
@@ -21,6 +22,15 @@ let header (debug: Elements.DebugInformation) =
 
 let schinese: ErrorStringing =
     function
+    | TypeChecker.TypeCheckFailedException (d, i, ParameterType (name, _), a) ->
+        header d 
+        + "第" + string (i + 1) + "个参数的类型应当为" + name + "，但传入了" +
+        match a with
+        | Int' -> "int"
+        | Real' -> "real"
+        | String' -> "string"
+        | Symbol' -> "symbol"
+        + "。"
     | InvalidSymbolException -> "非法符号。"
     | InvalidStringCharException x -> "字符串中存在非法字符\"" + x + "\"。"
     | HangingOperationException debug -> header debug + "存在悬浮操作。"