Skip to content

Commit fc812ce

Browse files
Seng-JikSeng-Jik
committed
Bug fixed.
1 parent 3e093b0 commit fc812ce

File tree

3 files changed

+87
-50
lines changed

3 files changed

+87
-50
lines changed

‎YukimiScript.Parser/Dom.fs‎

Lines changed: 23 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -124,27 +124,29 @@ module Dom =
124124

125125

126126
let analyze (fileName: string) (x: Parsed seq) : Result<Dom, exn> =
127-
let finalState =
128-
x
129-
|> Seq.indexed
130-
|> Seq.map
131-
(fun (lineNumber, { Line = line; Comment = comment }) ->
132-
line,
133-
{ LineNumber = lineNumber + 1
134-
Comment = comment
135-
File = fileName })
136-
|> Seq.fold
137-
(fun state x -> Result.bind (fun state -> analyzeFold state x) state)
138-
(Ok { Result = empty; CurrentBlock = None })
139-
|> Result.map saveCurrentBlock
140-
141-
finalState
142-
|> Result.map
143-
(fun x ->
144-
{ Scenes = List.rev x.Result.Scenes
145-
Macros = List.rev x.Result.Macros
146-
Externs = List.rev x.Result.Externs
147-
HangingEmptyLine = List.rev x.Result.HangingEmptyLine })
127+
try
128+
let finalState =
129+
x
130+
|> Seq.indexed
131+
|> Seq.map
132+
(fun (lineNumber, { Line = line; Comment = comment }) ->
133+
line,
134+
{ LineNumber = lineNumber + 1
135+
Comment = comment
136+
File = fileName })
137+
|> Seq.fold
138+
(fun state x -> Result.bind (fun state -> analyzeFold state x) state)
139+
(Ok { Result = empty; CurrentBlock = None })
140+
|> Result.map saveCurrentBlock
141+
142+
finalState
143+
|> Result.map
144+
(fun x ->
145+
{ Scenes = List.rev x.Result.Scenes
146+
Macros = List.rev x.Result.Macros
147+
Externs = List.rev x.Result.Externs
148+
HangingEmptyLine = List.rev x.Result.HangingEmptyLine })
149+
with e -> Error e
148150

149151

150152
let expandTextCommands (x: Dom) : Dom =

‎YukimiScript.Parser/ErrorStringing.fs‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@ open YukimiScript.Parser.Macro
77
open YukimiScript.Parser.ParserMonad
88
open YukimiScript.Parser.TopLevels
99
open YukimiScript.Parser.Diagram
10+
open YukimiScript.Parser.TypeChecker
1011
open System.IO
1112

1213

@@ -21,6 +22,15 @@ let header (debug: Elements.DebugInformation) =
2122

2223
let schinese: ErrorStringing =
2324
function
25+
| TypeChecker.TypeCheckFailedException (d, i, ParameterType (name, _), a) ->
26+
header d
27+
+ "第" + string (i + 1) + "个参数的类型应当为" + name + "，但传入了" +
28+
match a with
29+
| Int' -> "int"
30+
| Real' -> "real"
31+
| String' -> "string"
32+
| Symbol' -> "symbol"
33+
+ "。"
2434
| InvalidSymbolException -> "非法符号。"
2535
| InvalidStringCharException x -> "字符串中存在非法字符\"" + x + "\"。"
2636
| HangingOperationException debug -> header debug + "存在悬浮操作。"

‎YukimiScript.Parser/TypeChecker.fs‎

Lines changed: 54 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -43,54 +43,79 @@ let matchType d i (ParameterType (t, types)) (argType: SimpleType) : Result<unit
4343
else Error <| TypeCheckFailedException (d, i, (ParameterType (t, types)), argType)
4444

4545

46-
let matchCallTypes d (pars: ParameterType list) (argType: SimpleType list) =
47-
List.zip pars argType |> List.mapi (fun i (a, b) -> matchType d i a b)
48-
|> ParserMonad.sequenceRL |> Result.map ignore
46+
exception IsNotAType of string
4947

5048

51-
let matchCall d (pars: ParameterType list) (argType: Constant list) =
52-
argType |> List.map checkType |> matchCallTypes d pars
49+
type BlockParamTypes = (string * ParameterType) list
5350

5451

55-
exception IsNotAType of string
52+
let checkApplyTypeCorrect d (paramTypes: BlockParamTypes) (args: (string * Constant) list) =
53+
paramTypes
54+
|> List.mapi (fun i (paramName, paramType) ->
55+
args
56+
|> List.find (fst >> ((=) paramName))
57+
|> snd
58+
|> checkType
59+
|> matchType d i paramType)
60+
|> ParserMonad.sequenceRL
61+
|> Result.map (fun _ -> args)
5662

5763

58-
type BlockParamTypes = (string * ParameterType) list
64+
exception CannotGetParameterException of (string * DebugInformation) list
5965

6066

6167
let parametersTypeFromBlock (par: Parameter list) (b: Block) : Result<BlockParamTypes, exn> =
6268
let typeMacroParams =
6369
[ { Parameter = "param"; Default = None }
6470
{ Parameter = "type"; Default = None } ]
71+
72+
let typeMacroParamsTypes =
73+
[ "param", Types.symbol
74+
"type", Types.symbol ]
6575

6676
List.choose (function
6777
| CommandCall c, d when c.Callee = "__type" -> Some (c, d)
6878
| _ -> None) b
69-
|> List.map (fun (c, d) -> Macro.matchArguments d typeMacroParams c)
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))
7083
|> ParserMonad.sequenceRL
7184
|> Result.bind (fun x ->
7285
let paramTypePairs =
73-
List.map (readOnlyDict >> fun x ->
86+
List.map (fun (x, d) ->
87+
x
88+
|> readOnlyDict
89+
|> fun x ->
7490
match x.["param"], x.["type"] with
75-
| Symbol par, Symbol t -> par, t
91+
| Symbol par, Symbol t -> par, t, d
7692
| _ -> failwith "parametersTypeFromBlock: failed!") x
77-
78-
par
79-
|> List.map (fun { Parameter = name; Default = _ } ->
93+
94+
let dummy =
8095
paramTypePairs
81-
|> List.filter (fst >> (=) name)
82-
|> List.map snd
83-
|> function
84-
| [] -> Ok (name, Types.any)
85-
| types ->
86-
types
87-
|> List.map (fun typeName ->
88-
Types.all
89-
|> List.tryFind (fun (ParameterType (n, _)) -> n = typeName)
90-
|> function
91-
| Some x -> Ok x
92-
| None -> Error <| IsNotAType typeName)
93-
|> ParserMonad.sequenceRL
94-
|> Result.map (fun t ->
95-
name, List.reduce sumParameterType t))
96-
|> ParserMonad.sequenceRL)
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)

0 commit comments

Comments
 (0)