@@ -27,8 +27,7 @@ public class ParseCoordinator : IParseCoordinator
27
27
{
28
28
public RubberduckParserState State { get { return _state ; } }
29
29
30
- private readonly ConcurrentDictionary < IVBComponent , Tuple < Task , CancellationTokenSource > > _currentTasks =
31
- new ConcurrentDictionary < IVBComponent , Tuple < Task , CancellationTokenSource > > ( ) ;
30
+ private const int _maxDegreeOfParserParallelism = 8 ;
32
31
33
32
private readonly IDictionary < IVBComponent , IDictionary < Tuple < string , DeclarationType > , Attributes > > _componentAttributes
34
33
= new Dictionary < IVBComponent , IDictionary < Tuple < string , DeclarationType > , Attributes > > ( ) ;
@@ -84,6 +83,20 @@ private void ReparseRequested(object sender, EventArgs e)
84
83
}
85
84
}
86
85
86
+ private void Cancel ( bool createNewTokenSource = true )
87
+ {
88
+ lock ( _cancellationTokens [ 0 ] )
89
+ {
90
+ _cancellationTokens [ 0 ] . Cancel ( ) ;
91
+ _cancellationTokens [ 0 ] . Dispose ( ) ;
92
+ if ( createNewTokenSource )
93
+ {
94
+ _cancellationTokens . Add ( new CancellationTokenSource ( ) ) ;
95
+ }
96
+ _cancellationTokens . RemoveAt ( 0 ) ;
97
+ }
98
+ }
99
+
87
100
/// <summary>
88
101
/// For the use of tests only
89
102
/// </summary>
@@ -96,21 +109,40 @@ public void Parse(CancellationTokenSource token)
96
109
// tests do not fire events when components are removed--clear components
97
110
ClearComponentStateCacheForTests ( ) ;
98
111
99
- SyncComReferences ( State . Projects ) ;
100
- State . RefreshFinder ( _hostApp ) ;
101
-
102
- AddBuiltInDeclarations ( ) ;
103
- State . RefreshFinder ( _hostApp ) ;
112
+ ExecuteCommenParseActivities ( components , token ) ;
113
+
114
+ }
104
115
116
+ private void ExecuteCommenParseActivities ( List < IVBComponent > components , CancellationTokenSource token )
117
+ {
105
118
SetModuleStates ( components , ParserState . Pending ) ;
106
119
120
+ SyncComReferences ( State . Projects ) ;
121
+ RefreshDeclarationFinder ( ) ;
122
+
123
+ AddBuiltInDeclarations ( ) ;
124
+ RefreshDeclarationFinder ( ) ;
125
+
107
126
// invalidation cleanup should go into ParseAsync?
108
127
CleanUpComponentAttributes ( components ) ;
109
128
129
+ if ( token . IsCancellationRequested )
130
+ {
131
+ return ;
132
+ }
133
+
110
134
_projectDeclarations . Clear ( ) ;
111
135
State . ClearBuiltInReferences ( ) ;
112
136
113
- ParseComponents ( components , token ) ;
137
+ ParseComponents ( components , token . Token ) ;
138
+
139
+ if ( token . IsCancellationRequested || State . Status >= ParserState . Error )
140
+ {
141
+ return ;
142
+ }
143
+
144
+ ResolveAllDeclarations ( components , token . Token ) ;
145
+ RefreshDeclarationFinder ( ) ;
114
146
115
147
if ( token . IsCancellationRequested || State . Status >= ParserState . Error )
116
148
{
@@ -120,9 +152,13 @@ public void Parse(CancellationTokenSource token)
120
152
State . SetStatusAndFireStateChanged ( this , ParserState . ResolvedDeclarations ) ;
121
153
122
154
ResolveReferences ( token . Token ) ;
123
-
155
+
124
156
State . RebuildSelectionCache ( ) ;
157
+ }
125
158
159
+ private void RefreshDeclarationFinder ( )
160
+ {
161
+ State . RefreshFinder ( _hostApp ) ;
126
162
}
127
163
128
164
private void SetModuleStates ( List < IVBComponent > components , ParserState parserState )
@@ -152,36 +188,92 @@ private void ClearComponentStateCacheForTests()
152
188
}
153
189
}
154
190
155
- private void ParseComponents ( List < IVBComponent > components , CancellationTokenSource token )
191
+ private void ParseComponents ( List < IVBComponent > components , CancellationToken token )
156
192
{
157
- var parseTasks = new Task [ components . Count ] ;
158
- for ( var i = 0 ; i < components . Count ; i ++ )
159
- {
160
- var index = i ;
161
- parseTasks [ i ] = new Task ( ( ) =>
193
+ var options = new ParallelOptions ( ) ;
194
+ options . CancellationToken = token ;
195
+ options . MaxDegreeOfParallelism = _maxDegreeOfParserParallelism ;
196
+
197
+ Parallel . ForEach ( components ,
198
+ options ,
199
+ component =>
162
200
{
163
- ParseAsync ( components [ index ] , token ) . Wait ( token . Token ) ;
201
+ State . ClearStateCache ( component ) ;
202
+ State . SetModuleState ( component , ParserState . Parsing ) ;
203
+ var finishedParseTask = FinishedParseComponentTask ( component , token ) ;
204
+ ProcessComponentParseResults ( component , finishedParseTask ) ;
205
+ }
206
+ ) ;
207
+ }
164
208
165
- if ( token . IsCancellationRequested )
166
- {
167
- return ;
168
- }
209
+ private Task < ComponentParseTask . ParseCompletionArgs > FinishedParseComponentTask ( IVBComponent component , CancellationToken token , TokenStreamRewriter rewriter = null )
210
+ {
211
+ var tcs = new TaskCompletionSource < ComponentParseTask . ParseCompletionArgs > ( ) ;
169
212
170
- if ( State . Status == ParserState . Error ) { return ; }
213
+ var preprocessor = _preprocessorFactory ( ) ;
214
+ var parser = new ComponentParseTask ( component , preprocessor , _attributeParser , rewriter ) ;
171
215
172
- var qualifiedName = new QualifiedModuleName ( components [ index ] ) ;
216
+ parser . ParseFailure += ( sender , e ) =>
217
+ {
218
+ tcs . SetException ( e . Cause ) ;
219
+ } ;
220
+ parser . ParseCompleted += ( sender , e ) =>
221
+ {
222
+ tcs . SetResult ( e ) ;
223
+ } ;
173
224
174
- State . SetModuleState ( components [ index ] , ParserState . ResolvingDeclarations ) ;
225
+ parser . Start ( token ) ;
175
226
176
- ResolveDeclarations ( qualifiedName . Component ,
177
- State . ParseTrees . Find ( s => s . Key == qualifiedName ) . Value ) ;
178
- } ) ;
227
+ return tcs . Task ;
228
+ }
229
+
230
+
231
+ private void ProcessComponentParseResults ( IVBComponent component , Task < ComponentParseTask . ParseCompletionArgs > finishedParseTask )
232
+ {
233
+ finishedParseTask . Wait ( ) ;
234
+ if ( finishedParseTask . IsFaulted )
235
+ {
236
+ State . SetModuleState ( component , ParserState . Error , finishedParseTask . Exception . InnerException as SyntaxErrorException ) ;
237
+ }
238
+ else if ( finishedParseTask . IsCompleted )
239
+ {
240
+ var result = finishedParseTask . Result ;
241
+ lock ( State )
242
+ {
243
+ lock ( component )
244
+ {
245
+ State . SetModuleAttributes ( component , result . Attributes ) ;
246
+ State . AddParseTree ( component , result . ParseTree ) ;
247
+ State . AddTokenStream ( component , result . Tokens ) ;
248
+ State . SetModuleComments ( component , result . Comments ) ;
249
+ State . SetModuleAnnotations ( component , result . Annotations ) ;
179
250
180
- parseTasks [ i ] . Start ( ) ;
251
+ // This really needs to go last
252
+ State . SetModuleState ( component , ParserState . Parsed ) ;
253
+ }
254
+ }
181
255
}
182
- Task . WaitAll ( parseTasks ) ;
183
256
}
184
257
258
+ private void ResolveAllDeclarations ( List < IVBComponent > components , CancellationToken token )
259
+ {
260
+ var options = new ParallelOptions ( ) ;
261
+ options . CancellationToken = token ;
262
+ options . MaxDegreeOfParallelism = _maxDegreeOfParserParallelism ;
263
+
264
+ Parallel . ForEach ( components ,
265
+ options ,
266
+ component =>
267
+ {
268
+ var qualifiedName = new QualifiedModuleName ( component ) ;
269
+ State . SetModuleState ( component , ParserState . ResolvingDeclarations ) ;
270
+ ResolveDeclarations ( qualifiedName . Component ,
271
+ State . ParseTrees . Find ( s => s . Key == qualifiedName ) . Value ) ;
272
+ }
273
+ ) ;
274
+ }
275
+
276
+
185
277
private void ResolveReferences ( CancellationToken token )
186
278
{
187
279
Task . WaitAll ( ResolveReferencesAsync ( token ) ) ;
@@ -212,39 +304,7 @@ private void ParseAll(object requestor, CancellationTokenSource token)
212
304
//return; // returning here leaves state in 'ResolvedDeclarations' when a module is removed, which disables refresh
213
305
}
214
306
215
- SetModuleStates ( toParse , ParserState . Pending ) ;
216
-
217
- SyncComReferences ( State . Projects ) ;
218
- State . RefreshFinder ( _hostApp ) ;
219
-
220
- AddBuiltInDeclarations ( ) ;
221
- State . RefreshFinder ( _hostApp ) ;
222
-
223
- // invalidation cleanup should go into ParseAsync?
224
- CleanUpComponentAttributes ( components ) ;
225
-
226
- if ( token . IsCancellationRequested )
227
- {
228
- return ;
229
- }
230
-
231
- _projectDeclarations . Clear ( ) ;
232
- State . ClearBuiltInReferences ( ) ;
233
-
234
- ParseComponents ( toParse , token ) ;
235
-
236
- if ( token . IsCancellationRequested || State . Status >= ParserState . Error )
237
- {
238
- return ;
239
- }
240
-
241
- Debug . Assert ( State . ParseTrees . Count == components . Count , string . Format ( "ParserState has {0} parse trees for {1} components." , State . ParseTrees . Count , components . Count ) ) ;
242
-
243
- State . SetStatusAndFireStateChanged ( requestor , ParserState . ResolvedDeclarations ) ;
244
-
245
- ResolveReferences ( token . Token ) ;
246
-
247
- State . RebuildSelectionCache ( ) ;
307
+ ExecuteCommenParseActivities ( components , token ) ;
248
308
}
249
309
250
310
/// <summary>
@@ -521,81 +581,6 @@ private void UnloadComReference(IReference reference, IReadOnlyList<IVBProject>
521
581
}
522
582
}
523
583
524
- private Task ParseAsync ( IVBComponent component , CancellationTokenSource token , TokenStreamRewriter rewriter = null )
525
- {
526
- State . ClearStateCache ( component ) ;
527
-
528
- var task = new Task ( ( ) => ParseAsyncInternal ( component , token . Token , rewriter ) ) ;
529
- _currentTasks . TryAdd ( component , Tuple . Create ( task , token ) ) ;
530
-
531
- Tuple < Task , CancellationTokenSource > removedTask ;
532
- task . ContinueWith ( t => _currentTasks . TryRemove ( component , out removedTask ) , token . Token ) ; // default also executes on cancel
533
- // See http://stackoverflow.com/questions/6800705/why-is-taskscheduler-current-the-default-taskscheduler
534
- task . Start ( TaskScheduler . Default ) ;
535
- return task ;
536
- }
537
-
538
- private void Cancel ( bool createNewTokenSource = true )
539
- {
540
- lock ( _cancellationTokens [ 0 ] )
541
- {
542
- _cancellationTokens [ 0 ] . Cancel ( ) ;
543
- _cancellationTokens [ 0 ] . Dispose ( ) ;
544
- if ( createNewTokenSource )
545
- {
546
- _cancellationTokens . Add ( new CancellationTokenSource ( ) ) ;
547
- }
548
- _cancellationTokens . RemoveAt ( 0 ) ;
549
- }
550
- }
551
-
552
- private void ParseAsyncInternal ( IVBComponent component , CancellationToken token , TokenStreamRewriter rewriter = null )
553
- {
554
- State . SetModuleState ( component , ParserState . Parsing ) ;
555
-
556
- var preprocessor = _preprocessorFactory ( ) ;
557
- var parser = new ComponentParseTask ( component , preprocessor , _attributeParser , rewriter ) ;
558
-
559
- var finishedParseTask = FinishedComponentParseTask ( parser , token ) ; //This runs synchronously.
560
-
561
- if ( finishedParseTask . IsFaulted )
562
- {
563
- State . SetModuleState ( component , ParserState . Error , finishedParseTask . Exception . InnerException as SyntaxErrorException ) ;
564
- }
565
- else if ( finishedParseTask . IsCompleted )
566
- {
567
- var result = finishedParseTask . Result ;
568
- lock ( State )
569
- {
570
- lock ( component )
571
- {
572
- State . SetModuleAttributes ( component , result . Attributes ) ;
573
- State . AddParseTree ( component , result . ParseTree ) ;
574
- State . AddTokenStream ( component , result . Tokens ) ;
575
- State . SetModuleComments ( component , result . Comments ) ;
576
- State . SetModuleAnnotations ( component , result . Annotations ) ;
577
-
578
- // This really needs to go last
579
- State . SetModuleState ( component , ParserState . Parsed ) ;
580
- }
581
- }
582
- }
583
- }
584
-
585
- private Task < ComponentParseTask . ParseCompletionArgs > FinishedComponentParseTask ( ComponentParseTask parser , CancellationToken token )
586
- {
587
- var tcs = new TaskCompletionSource < ComponentParseTask . ParseCompletionArgs > ( ) ;
588
- parser . ParseFailure += ( sender , e ) =>
589
- {
590
- tcs . SetException ( e . Cause ) ;
591
- } ;
592
- parser . ParseCompleted += ( sender , e ) =>
593
- {
594
- tcs . SetResult ( e ) ;
595
- } ;
596
- parser . Start ( token ) ;
597
- return tcs . Task ;
598
- }
599
584
600
585
private readonly ConcurrentDictionary < string , Declaration > _projectDeclarations = new ConcurrentDictionary < string , Declaration > ( ) ;
601
586
private void ResolveDeclarations ( IVBComponent component , IParseTree tree )
0 commit comments