@@ -8,152 +8,150 @@ module Comment = Napkin_comment
8
8
9
9
type mode = ParseForTypeChecker | Default
10
10
11
- type regionStatus = Report | Silent
12
-
13
- type t = {
14
- mode : mode ;
15
- mutable scanner : Scanner .t ;
16
- mutable token : Token .t ;
17
- mutable startPos : Lexing .position ;
18
- mutable endPos : Lexing .position ;
19
- mutable prevEndPos : Lexing .position ;
20
- mutable breadcrumbs : (Grammar .t * Lexing .position ) list ;
21
- mutable errors : Reporting .parseError list ;
22
- mutable diagnostics : Diagnostics .t list ;
23
- mutable comments : Comment .t list ;
24
- mutable regions : regionStatus ref list ;
25
- }
26
-
27
- let err ?startPos ?endPos p error =
28
- let d = Diagnostics. make
29
- ~filename: p.scanner.filename
30
- ~start Pos:(match startPos with | Some pos -> pos | None -> p.startPos)
31
- ~end Pos:(match endPos with | Some pos -> pos | None -> p.endPos)
11
+ type regionStatus = Report | Silent
12
+
13
+ type t = {
14
+ mode : mode ;
15
+ mutable scanner : Scanner .t ;
16
+ mutable token : Token .t ;
17
+ mutable startPos : Lexing .position ;
18
+ mutable endPos : Lexing .position ;
19
+ mutable prevEndPos : Lexing .position ;
20
+ mutable breadcrumbs : (Grammar .t * Lexing .position ) list ;
21
+ mutable errors : Reporting .parseError list ;
22
+ mutable diagnostics : Diagnostics .t list ;
23
+ mutable comments : Comment .t list ;
24
+ mutable regions : regionStatus ref list ;
25
+ }
26
+
27
+ let err ?startPos ?endPos p error =
28
+ let d = Diagnostics. make
29
+ ~filename: p.scanner.filename
30
+ ~start Pos:(match startPos with | Some pos -> pos | None -> p.startPos)
31
+ ~end Pos:(match endPos with | Some pos -> pos | None -> p.endPos)
32
+ error
33
+ in
34
+ try
35
+ if (! (List. hd p.regions) = Report ) then (
36
+ p.diagnostics < - d::p.diagnostics;
37
+ List. hd p.regions := Silent
38
+ )
39
+ with Failure _ -> ()
40
+
41
+ let beginRegion p =
42
+ p.regions < - ref Report :: p.regions
43
+ let endRegion p =
44
+ try p.regions < - List. tl p.regions with Failure _ -> ()
45
+
46
+ (* Advance to the next non-comment token and store any encountered comment
47
+ * in the parser's state. Every comment contains the end position of its
48
+ * previous token to facilite comment interleaving *)
49
+ let rec next ?prevEndPos p =
50
+ let prevEndPos = match prevEndPos with Some pos -> pos | None -> p.endPos in
51
+ let (startPos, endPos, token) = Scanner. scan p.scanner in
52
+ match token with
53
+ | Comment c ->
54
+ Comment. setPrevTokEndPos c p.endPos;
55
+ p.comments < - c::p.comments;
56
+ p.prevEndPos < - p.endPos;
57
+ p.endPos < - endPos;
58
+ next ~prev EndPos p
59
+ | _ ->
60
+ p.token < - token;
61
+ (* p.prevEndPos <- prevEndPos; *)
62
+ p.prevEndPos < - prevEndPos;
63
+ p.startPos < - startPos;
64
+ p.endPos < - endPos
65
+
66
+ let checkProgress ~prevEndPos ~result p =
67
+ if p.endPos == prevEndPos
68
+ then None
69
+ else Some result
70
+
71
+ let make ?(mode =ParseForTypeChecker ) ?line src filename =
72
+ let scanner = Scanner. make ~filename ?line (Bytes. of_string src) in
73
+ let parserState = {
74
+ mode;
75
+ scanner;
76
+ token = Token. Eof ;
77
+ startPos = Lexing. dummy_pos;
78
+ prevEndPos = Lexing. dummy_pos;
79
+ endPos = Lexing. dummy_pos;
80
+ breadcrumbs = [] ;
81
+ errors = [] ;
82
+ diagnostics = [] ;
83
+ comments = [] ;
84
+ regions = [ref Report ];
85
+ } in
86
+ parserState.scanner.err < - (fun ~startPos ~endPos error ->
87
+ let diagnostic = Diagnostics. make
88
+ ~filename
89
+ ~start Pos
90
+ ~end Pos
32
91
error
33
92
in
34
- try
35
- if (! (List. hd p.regions) = Report ) then (
36
- p.diagnostics < - d::p.diagnostics;
37
- List. hd p.regions := Silent
38
- )
39
- with Failure _ -> ()
40
-
41
- let beginRegion p =
42
- p.regions < - ref Report :: p.regions
43
- let endRegion p =
44
- try p.regions < - List. tl p.regions with Failure _ -> ()
45
-
46
- (* Advance to the next non-comment token and store any encountered comment
47
- * in the parser's state. Every comment contains the end position of its
48
- * previous token to facilite comment interleaving *)
49
- let rec next ?prevEndPos p =
50
- let prevEndPos = match prevEndPos with Some pos -> pos | None -> p.endPos in
51
- let (startPos, endPos, token) = Scanner. scan p.scanner in
52
- match token with
53
- | Comment c ->
54
- Comment. setPrevTokEndPos c p.endPos;
55
- p.comments < - c::p.comments;
56
- p.prevEndPos < - p.endPos;
57
- p.endPos < - endPos;
58
- next ~prev EndPos p
59
- | _ ->
60
- p.token < - token;
61
- (* p.prevEndPos <- prevEndPos; *)
62
- p.prevEndPos < - prevEndPos;
63
- p.startPos < - startPos;
64
- p.endPos < - endPos
65
-
66
- let checkProgress ~prevEndPos ~result p =
67
- if p.endPos == prevEndPos
68
- then None
69
- else Some result
70
-
71
- let make ?(mode =ParseForTypeChecker ) src filename =
72
- let scanner = Scanner. make (Bytes. of_string src) filename in
73
- let parserState = {
74
- mode;
75
- scanner;
76
- token = Token. Eof ;
77
- startPos = Lexing. dummy_pos;
78
- prevEndPos = Lexing. dummy_pos;
79
- endPos = Lexing. dummy_pos;
80
- breadcrumbs = [] ;
81
- errors = [] ;
82
- diagnostics = [] ;
83
- comments = [] ;
84
- regions = [ref Report ];
85
- } in
86
- parserState.scanner.err < - (fun ~startPos ~endPos error ->
87
- let diagnostic = Diagnostics. make
88
- ~filename
89
- ~start Pos
90
- ~end Pos
91
- error
92
- in
93
- parserState.diagnostics < - diagnostic::parserState.diagnostics
94
- );
95
- next parserState;
96
- parserState
97
-
98
- let leaveBreadcrumb p circumstance =
99
- let crumb = (circumstance, p.startPos) in
100
- p.breadcrumbs < - crumb::p.breadcrumbs
101
-
102
- let eatBreadcrumb p =
103
- match p.breadcrumbs with
104
- | [] -> ()
105
- | _ ::crumbs -> p.breadcrumbs < - crumbs
106
-
107
- let optional p token =
108
- if p.token = token then
109
- let () = next p in true
110
- else
111
- false
112
-
113
- let expect ?grammar token p =
114
- if p.token = token then
115
- next p
116
- else
117
- let error = Diagnostics. expected ?grammar p.prevEndPos token in
118
- err ~start Pos:p.prevEndPos p error
119
-
120
- (* Don't use immutable copies here, it trashes certain heuristics
121
- * in the ocaml compiler, resulting in massive slowdowns of the parser *)
122
- let lookahead p callback =
123
- let err = p.scanner.err in
124
- let ch = p.scanner.ch in
125
- let offset = p.scanner.offset in
126
- let rdOffset = p.scanner.rdOffset in
127
- let lineOffset = p.scanner.lineOffset in
128
- let lnum = p.scanner.lnum in
129
- let mode = p.scanner.mode in
130
- let token = p.token in
131
- let startPos = p.startPos in
132
- let endPos = p.endPos in
133
- let prevEndPos = p.prevEndPos in
134
- let breadcrumbs = p.breadcrumbs in
135
- let errors = p.errors in
136
- let diagnostics = p.diagnostics in
137
- let comments = p.comments in
138
-
139
- let res = callback p in
140
-
141
- p.scanner.err < - err;
142
- p.scanner.ch < - ch;
143
- p.scanner.offset < - offset;
144
- p.scanner.rdOffset < - rdOffset;
145
- p.scanner.lineOffset < - lineOffset;
146
- p.scanner.lnum < - lnum;
147
- p.scanner.mode < - mode;
148
- p.token < - token;
149
- p.startPos < - startPos;
150
- p.endPos < - endPos;
151
- p.prevEndPos < - prevEndPos;
152
- p.breadcrumbs < - breadcrumbs;
153
- p.errors < - errors;
154
- p.diagnostics < - diagnostics;
155
- p.comments < - comments;
156
-
157
- res
158
-
159
-
93
+ parserState.diagnostics < - diagnostic::parserState.diagnostics
94
+ );
95
+ next parserState;
96
+ parserState
97
+
98
+ let leaveBreadcrumb p circumstance =
99
+ let crumb = (circumstance, p.startPos) in
100
+ p.breadcrumbs < - crumb::p.breadcrumbs
101
+
102
+ let eatBreadcrumb p =
103
+ match p.breadcrumbs with
104
+ | [] -> ()
105
+ | _ ::crumbs -> p.breadcrumbs < - crumbs
106
+
107
+ let optional p token =
108
+ if p.token = token then
109
+ let () = next p in true
110
+ else
111
+ false
112
+
113
+ let expect ?grammar token p =
114
+ if p.token = token then
115
+ next p
116
+ else
117
+ let error = Diagnostics. expected ?grammar p.prevEndPos token in
118
+ err ~start Pos:p.prevEndPos p error
119
+
120
+ (* Don't use immutable copies here, it trashes certain heuristics
121
+ * in the ocaml compiler, resulting in massive slowdowns of the parser *)
122
+ let lookahead p callback =
123
+ let err = p.scanner.err in
124
+ let ch = p.scanner.ch in
125
+ let offset = p.scanner.offset in
126
+ let rdOffset = p.scanner.rdOffset in
127
+ let lineOffset = p.scanner.lineOffset in
128
+ let lnum = p.scanner.lnum in
129
+ let mode = p.scanner.mode in
130
+ let token = p.token in
131
+ let startPos = p.startPos in
132
+ let endPos = p.endPos in
133
+ let prevEndPos = p.prevEndPos in
134
+ let breadcrumbs = p.breadcrumbs in
135
+ let errors = p.errors in
136
+ let diagnostics = p.diagnostics in
137
+ let comments = p.comments in
138
+
139
+ let res = callback p in
140
+
141
+ p.scanner.err < - err;
142
+ p.scanner.ch < - ch;
143
+ p.scanner.offset < - offset;
144
+ p.scanner.rdOffset < - rdOffset;
145
+ p.scanner.lineOffset < - lineOffset;
146
+ p.scanner.lnum < - lnum;
147
+ p.scanner.mode < - mode;
148
+ p.token < - token;
149
+ p.startPos < - startPos;
150
+ p.endPos < - endPos;
151
+ p.prevEndPos < - prevEndPos;
152
+ p.breadcrumbs < - breadcrumbs;
153
+ p.errors < - errors;
154
+ p.diagnostics < - diagnostics;
155
+ p.comments < - comments;
156
+
157
+ res
0 commit comments