Attach TypeInfo

Author: Seng-Jik

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/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,32 @@ 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 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
+                                        | _ -> false) block
+                                then
+                                    match 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,16 +117,7 @@ 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
@@ -138,28 +148,23 @@ module Dom =
 
 
     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
-
-                          yield! Text.expandTextBlock x debugInfo ]
-                    | x -> [ x ])
+        let mapBlock =
+            List.collect (function
+                | Text x, debugInfo ->
+                    [ if debugInfo.Comment.IsSome then
+                            EmptyLine, debugInfo
 
-            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, _, b, _) -> a, b) x.Macros
 
         x.Scenes
         |> List.map
@@ -199,7 +204,7 @@ module Dom =
 
 
     let linkToExternCommands (x: Dom) : Result<Dom, exn> =
-        let externs = systemCommands @ List.map fst x.Externs
+        let externs = systemCommands @ List.map (fun (x, _, _) -> x) x.Externs
 
         let linkSingleCommand (op, debugInfo) =
             match op with

YukimiScript.Parser/TypeChecker.fs

@@ -19,8 +19,7 @@ module Types =
     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 all = [ any; int; number; real; symbol ]
 
 
 let sumParameterType (ParameterType (n1, s1)) (ParameterType (n2, s2)) =
@@ -56,7 +55,10 @@ let matchCall d (pars: ParameterType list) (argType: Constant list) =
 exception IsNotAType of string
 
 
-let parametersTypeFromBlock (par: Parameter list) (b: Block) =
+type BlockParamTypes = (string * ParameterType) list
+
+
+let parametersTypeFromBlock (par: Parameter list) (b: Block) : Result<BlockParamTypes, exn> =
     let typeMacroParams = 
         [ { Parameter = "param"; Default = None }
           { Parameter = "type"; Default = None } ]
@@ -79,7 +81,7 @@ let parametersTypeFromBlock (par: Parameter list) (b: Block) =
             |> List.filter (fst >> (=) name)
             |> List.map snd
             |> function
-                | [] -> Ok Types.any
+                | [] -> Ok (name, Types.any)
                 | types -> 
                     types
                     |> List.map (fun typeName -> 
@@ -89,5 +91,6 @@ let parametersTypeFromBlock (par: Parameter list) (b: Block) =
                             | Some x -> Ok x
                             | None -> Error <| IsNotAType typeName)
                     |> ParserMonad.sequenceRL
-                    |> Result.map (List.reduce sumParameterType))
+                    |> Result.map (fun t -> 
+                        name, List.reduce sumParameterType t))
         |> ParserMonad.sequenceRL)