Skip to content

Commit 8cc822e

Browse files
Seng-JikSeng-Jik
committed
Type Check Tested.
1 parent fc812ce commit 8cc822e

File tree

5 files changed

+87
-76
lines changed

5 files changed

+87
-76
lines changed

‎YukimiScript.Parser/Diagram.fs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,10 @@ let analyze (files: (string * Dom) list) : Result<Diagram, exn> =
4545
let p = { Parameter = "target"; Default = None }
4646

4747
matchArguments debug [ p ] c
48+
|> Result.bind (
49+
TypeChecker.checkApplyTypeCorrect
50+
debug
51+
[ "target", TypeChecker.Types.string ])
4852
|> function
4953
| Ok [ "target", (String target) ] -> Some target
5054
| Error e -> raise e

‎YukimiScript.Parser/Dom.fs‎

Lines changed: 17 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -61,7 +61,7 @@ module Dom =
6161
match label with
6262
| MacroDefination x ->
6363
let block = List.rev block
64-
match parametersTypeFromBlock x.Param block with
64+
match Macro.parametersTypeFromBlock x.Param block with
6565
| Ok t -> (x, t, block, debugInfo) :: state.Result.Macros
6666
| Error e -> raise e
6767
| _ -> state.Result.Macros
@@ -77,9 +77,10 @@ module Dom =
7777
if
7878
List.forall (fst >> function
7979
| CommandCall c when c.Callee = "__type" -> true
80+
| EmptyLine -> true
8081
| _ -> false) block
8182
then
82-
match parametersTypeFromBlock p block with
83+
match Macro.parametersTypeFromBlock p block with
8384
| Ok t ->
8485
(ExternCommand (n, p), t, debugInfo)
8586
:: state.Result.Externs
@@ -148,7 +149,6 @@ module Dom =
148149
HangingEmptyLine = List.rev x.Result.HangingEmptyLine })
149150
with e -> Error e
150151

151-
152152
let expandTextCommands (x: Dom) : Dom =
153153
let mapBlock =
154154
List.collect (function
@@ -166,7 +166,7 @@ module Dom =
166166

167167
let expandUserMacros (x: Dom) =
168168
let macros =
169-
List.map (fun (a, _, b, _) -> a, b) x.Macros
169+
List.map (fun (a, t, b, _) -> a, t, b) x.Macros
170170

171171
x.Scenes
172172
|> List.map
@@ -190,43 +190,44 @@ module Dom =
190190
exception ExternCommandDefinationNotFoundException of string * DebugInformation
191191

192192

193-
let private systemCommands =
193+
let private systemCommands : (ExternDefination * BlockParamTypes) list =
194194
let parse str =
195195
TopLevels.topLevels
196196
|> ParserMonad.run str
197197
|> function
198198
| Ok (ExternDefination x) -> x
199199
| _ -> failwith "Bug here!"
200200

201-
[ parse "- extern __text_begin character=null"
202-
parse "- extern __text_type text"
203-
parse "- extern __text_pushMark mark"
204-
parse "- extern __text_popMark mark"
205-
parse "- extern __text_end hasMore" ]
201+
[ parse "- extern __text_begin character=null", [ "character", Types.symbol ]
202+
parse "- extern __text_type text", [ "text", Types.string ]
203+
parse "- extern __text_pushMark mark", [ "mark", Types.symbol ]
204+
parse "- extern __text_popMark mark", [ "mark", Types.symbol ]
205+
parse "- extern __text_end hasMore", [ "hasMore", Types.symbol] ]
206206

207207

208208
let linkToExternCommands (x: Dom) : Result<Dom, exn> =
209-
let externs = systemCommands @ List.map (fun (x, _, _) -> x) x.Externs
210-
209+
let externs = systemCommands @ List.map (fun (x, t, _) -> x, t) x.Externs
210+
211211
let linkSingleCommand (op, debugInfo) =
212212
match op with
213213
| Text _ -> Error MustExpandTextBeforeLinkException
214214
| CommandCall c ->
215-
match List.tryFind (fun (ExternCommand (name, _)) -> name = c.Callee) externs with
215+
match List.tryFind (fun (ExternCommand (name, _), _) -> name = c.Callee) externs with
216216
| None ->
217217
Error
218218
<| ExternCommandDefinationNotFoundException(c.Callee, debugInfo)
219-
| Some (ExternCommand (_, param)) ->
219+
| Some (ExternCommand (_, param), t) ->
220220
Macro.matchArguments debugInfo param c
221+
|> Result.bind (checkApplyTypeCorrect debugInfo t)
221222
|> Result.map
222223
(fun args ->
223224
let args =
224225
List.map (fun { Parameter = param } -> List.find (fst >> (=) param) args |> snd) param
225226

226227
CommandCall
227228
{ c with
228-
UnnamedArgs = args
229-
NamedArgs = [] })
229+
UnnamedArgs = args
230+
NamedArgs = [] })
230231
| x -> Ok x
231232
|> Result.map (fun x -> x, debugInfo)
232233

‎YukimiScript.Parser/Macro.fs‎

Lines changed: 64 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
module internal YukimiScript.Parser.Macro
22

33
open YukimiScript.Parser.Elements
4+
open TypeChecker
45
open ParserMonad
56
open Basics
67
open Constants
@@ -96,16 +97,18 @@ let matchArguments debugInfo (x: Parameter list) (c: CommandCall) : Result<(stri
9697

9798

9899
let private matchMacro debug x macro =
99-
let pred (macro: MacroDefination, _) = macro.Name = x.Callee
100+
let pred (macro: MacroDefination, _, _) = macro.Name = x.Callee
100101

101102
match List.tryFind pred macro with
102103
| None -> Error NoMacroMatchedException
103-
| Some (macro, _) when macro.Param.Length < x.UnnamedArgs.Length ->
104+
| Some (macro, _, _) when macro.Param.Length < x.UnnamedArgs.Length ->
104105
Error
105106
<| ArgumentsTooMuchException(debug, macro, x)
106-
| Some (macro, other) ->
107+
| Some (macro, t, other) ->
107108
matchArguments debug macro.Param x
109+
|> Result.bind (checkApplyTypeCorrect debug t)
108110
|> Result.map (fun args -> macro, other, args)
111+
109112

110113

111114
let private replaceParamToArgs args macroBody =
@@ -131,7 +134,7 @@ let rec private expandSingleOperation macros operation : Result<Block, exn> =
131134
| Ok (macro, macroBody: Block, args) ->
132135
let macros =
133136
macros
134-
|> List.filter (fun (x, _) -> x.Name <> macro.Name)
137+
|> List.filter (fun (x, _, _) -> x.Name <> macro.Name)
135138

136139
macroBody
137140
|> List.map (
@@ -159,3 +162,60 @@ let expandSystemMacros (block: Block) =
159162
(function
160163
| CommandCall cmdCall, dbg when List.exists ((=) cmdCall.Callee) systemMacros -> EmptyLine, dbg
161164
| x -> x)
165+
166+
167+
let parametersTypeFromBlock (par: Parameter list) (b: Block) : Result<BlockParamTypes, exn> =
168+
let typeMacroParams =
169+
[ { Parameter = "param"; Default = None }
170+
{ Parameter = "type"; Default = None } ]
171+
172+
let typeMacroParamsTypes =
173+
[ "param", Types.symbol
174+
"type", Types.symbol ]
175+
176+
List.choose (function
177+
| CommandCall c, d when c.Callee = "__type" -> Some (c, d)
178+
| _ -> None) b
179+
|> List.map (fun (c, d) ->
180+
matchArguments d typeMacroParams c
181+
|> Result.bind (checkApplyTypeCorrect d typeMacroParamsTypes)
182+
|> Result.map (fun x -> x, d))
183+
|> sequenceRL
184+
|> Result.bind (fun x ->
185+
let paramTypePairs =
186+
List.map (fun (x, d) ->
187+
x
188+
|> readOnlyDict
189+
|> fun x ->
190+
match x.["param"], x.["type"] with
191+
| Symbol par, Symbol t -> par, t, d
192+
| _ -> failwith "parametersTypeFromBlock: failed!") x
193+
194+
let dummy =
195+
paramTypePairs
196+
|> List.filter (not << fun (n, _, d) ->
197+
List.exists (fun p -> p.Parameter = n) par)
198+
|> List.map (fun (n, _, d) -> n, d)
199+
200+
if List.length dummy = 0
201+
then
202+
par
203+
|> List.map (fun { Parameter = name; Default = _ } ->
204+
paramTypePairs
205+
|> List.filter ((=) name << fun (n, _, _) -> n)
206+
|> List.map (fun (_, t, d) -> t, d)
207+
|> function
208+
| [] -> Ok (name, Types.any)
209+
| types ->
210+
types
211+
|> List.map (fun (typeName, d) ->
212+
Types.all
213+
|> List.tryFind (fun (ParameterType (n, _)) -> n = typeName)
214+
|> function
215+
| Some x -> Ok x
216+
| None -> Error <| IsNotAType typeName)
217+
|> sequenceRL
218+
|> Result.map (fun t ->
219+
name, List.reduce sumParameterType t))
220+
|> sequenceRL
221+
else Error <| CannotGetParameterException dummy)

‎YukimiScript.Parser/TypeChecker.fs‎

Lines changed: 1 addition & 55 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,7 @@ module Types =
1919
let number = ParameterType ("number", set [ Int'; Real' ])
2020
let real = ParameterType ("real", set [ Real' ])
2121
let symbol = ParameterType ("symbol", set [ Symbol' ])
22+
let string = ParameterType ("string", set [ String' ])
2223
let all = [ any; int; number; real; symbol ]
2324

2425

@@ -64,58 +65,3 @@ let checkApplyTypeCorrect d (paramTypes: BlockParamTypes) (args: (string * Const
6465
exception CannotGetParameterException of (string * DebugInformation) list
6566

6667

67-
let parametersTypeFromBlock (par: Parameter list) (b: Block) : Result<BlockParamTypes, exn> =
68-
let typeMacroParams =
69-
[ { Parameter = "param"; Default = None }
70-
{ Parameter = "type"; Default = None } ]
71-
72-
let typeMacroParamsTypes =
73-
[ "param", Types.symbol
74-
"type", Types.symbol ]
75-
76-
List.choose (function
77-
| CommandCall c, d when c.Callee = "__type" -> Some (c, d)
78-
| _ -> None) b
79-
|> List.map (fun (c, d) ->
80-
Macro.matchArguments d typeMacroParams c
81-
|> Result.bind (checkApplyTypeCorrect d typeMacroParamsTypes)
82-
|> Result.map (fun x -> x, d))
83-
|> ParserMonad.sequenceRL
84-
|> Result.bind (fun x ->
85-
let paramTypePairs =
86-
List.map (fun (x, d) ->
87-
x
88-
|> readOnlyDict
89-
|> fun x ->
90-
match x.["param"], x.["type"] with
91-
| Symbol par, Symbol t -> par, t, d
92-
| _ -> failwith "parametersTypeFromBlock: failed!") x
93-
94-
let dummy =
95-
paramTypePairs
96-
|> List.filter (not << fun (n, _, d) ->
97-
List.exists (fun p -> p.Parameter = n) par)
98-
|> List.map (fun (n, _, d) -> n, d)
99-
100-
if List.length dummy = 0
101-
then
102-
par
103-
|> List.map (fun { Parameter = name; Default = _ } ->
104-
paramTypePairs
105-
|> List.filter ((=) name << fun (n, _, _) -> n)
106-
|> List.map (fun (_, t, d) -> t, d)
107-
|> function
108-
| [] -> Ok (name, Types.any)
109-
| types ->
110-
types
111-
|> List.map (fun (typeName, d) ->
112-
Types.all
113-
|> List.tryFind (fun (ParameterType (n, _)) -> n = typeName)
114-
|> function
115-
| Some x -> Ok x
116-
| None -> Error <| IsNotAType typeName)
117-
|> ParserMonad.sequenceRL
118-
|> Result.map (fun t ->
119-
name, List.reduce sumParameterType t))
120-
|> ParserMonad.sequenceRL
121-
else Error <| CannotGetParameterException dummy)

‎YukimiScript.Parser/YukimiScript.Parser.fsproj‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,8 +8,8 @@
88
<Compile Include="ParserMonad.fs" />
99
<Compile Include="Basics.fs" />
1010
<Compile Include="Constants.fs" />
11-
<Compile Include="Macro.fs" />
1211
<Compile Include="TypeChecker.fs" />
12+
<Compile Include="Macro.fs" />
1313
<Compile Include="TopLevels.fs" />
1414
<Compile Include="Statment.fs" />
1515
<Compile Include="Text.fs" />

0 commit comments

Comments
 (0)