Skip to content

Commit 10ea05d

Browse files
rneatherwayrneatherway
committed
Merge pull request #70 from rneatherway/fix-stackoverflow
Fix stackoverflow
2 parents c7a7956 + 9705e01 commit 10ea05d

File tree

1 file changed

+165
-176
lines changed

1 file changed

+165
-176
lines changed

‎FsAutoComplete/Program.fs‎

Lines changed: 165 additions & 176 deletions
Original file line numberDiff line numberDiff line change
@@ -83,185 +83,174 @@ module internal Main =
8383

8484
let commandQueue = new FSharpx.Control.BlockingQueueAgent<Command>(10)
8585

86-
let rec main (state:State) : int =
87-
currentFiles <- state.Files
88-
89-
try
90-
match commandQueue.Get() with
91-
| Parse(file,kind,lines) ->
92-
let parse fileName text options =
93-
let task =
94-
async {
95-
let! _parseResults, checkResults = checker.ParseAndCheckFileInProject(fileName, 0, text, options)
96-
match checkResults with
97-
| FSharpCheckFileAnswer.Aborted -> ()
98-
| FSharpCheckFileAnswer.Succeeded results ->
99-
Response.errors(results.Errors)
100-
if state.ColorizationOutput then
101-
Response.colorizations(results.GetExtraColorizationsAlternate())
102-
}
103-
match kind with
104-
| Synchronous -> Response.info "Synchronous parsing started"
105-
Async.RunSynchronously task
106-
| Normal -> Response.info "Background parsing started"
107-
Async.StartImmediate task
108-
109-
let file = Path.GetFullPath file
110-
let text = String.concat "\n" lines
111-
112-
if Utils.isAScript file then
113-
let checkOptions = checker.GetProjectOptionsFromScript(file, text)
114-
let state = state.WithFileTextAndCheckerOptions(file, lines, checkOptions)
115-
parse file text checkOptions
116-
main state
117-
else
118-
let state, checkOptions = state.WithFileTextGetCheckerOptions(file, lines)
119-
parse file text checkOptions
120-
main state
121-
122-
| Project (file,time) ->
123-
let file = Path.GetFullPath file
124-
125-
// The FileSystemWatcher often triggers multiple times for
126-
// each event, as editors often modify files in several steps.
127-
// This 'debounces' the events, by only reloading a max of once
128-
// per second.
129-
match state.ProjectLoadTimes.TryFind file with
130-
| Some oldtime when time - oldtime < TimeSpan.FromSeconds(1.0) -> main state
131-
| _ ->
132-
133-
match checker.TryGetProjectOptions(file) with
134-
| Result.Failure s ->
135-
Response.error(s)
136-
main state
137-
138-
| Result.Success(po, projectFiles, outFileOpt, references, frameworkOpt) ->
139-
Response.project(file, projectFiles, outFileOpt, references, frameworkOpt)
140-
141-
let fsw = new FileSystemWatcher()
142-
fsw.Path <- Path.GetDirectoryName file
143-
fsw.Filter <- Path.GetFileName file
144-
fsw.Changed.Add(fun _ -> commandQueue.Add(Project (file, DateTime.Now)))
145-
fsw.EnableRaisingEvents <- true
146-
147-
let checkOptions =
148-
projectFiles
149-
|> List.fold (fun s f -> Map.add f po s) state.FileCheckOptions
150-
let loadTimes = Map.add file time state.ProjectLoadTimes
151-
main { state with FileCheckOptions = checkOptions
152-
ProjectLoadTimes = loadTimes }
153-
154-
| Declarations file ->
155-
let file = Path.GetFullPath file
156-
match state.TryGetFileCheckerOptionsWithSource(file) with
157-
| Failure s -> Response.error(s)
158-
| Success (checkOptions, source) ->
159-
let decls = checker.GetDeclarations(file, source, checkOptions)
160-
Response.declarations(decls)
161-
162-
main state
163-
164-
| HelpText sym ->
165-
match Map.tryFind sym state.HelpText with
166-
| None -> Response.error (sprintf "No help text available for symbol '%s'" sym)
167-
| Some tip -> Response.helpText(sym, tip)
168-
169-
main state
170-
171-
| PosCommand(cmd, file, line, col, timeout, filter) ->
172-
let file = Path.GetFullPath file
173-
match state.TryGetFileCheckerOptionsWithLinesAndLineStr(file, line, col) with
174-
| Failure s -> Response.error(s)
175-
main state
176-
| Success (options, lines, lineStr) ->
177-
// TODO: Should sometimes pass options.Source in here to force a reparse
178-
// for completions e.g. `(some typed expr).$`
179-
let tyResOpt = checker.TryGetRecentTypeCheckResultsForFile(file, options)
180-
match tyResOpt with
181-
| None -> Response.info "Cached typecheck results not yet available"; main state
182-
| Some tyRes ->
183-
184-
match cmd with
185-
| Completion ->
186-
match tyRes.TryGetCompletions line col lineStr timeout filter with
187-
| Some (decls, residue) ->
188-
let declName (d: FSharpDeclarationListItem) = d.Name
189-
190-
// Send the first helptext without being requested.
191-
// This allows it to be displayed immediately in the editor.
192-
let firstMatchOpt =
193-
Array.sortBy declName decls
194-
|> Array.tryFind (fun d -> (declName d).StartsWith residue)
195-
match firstMatchOpt with
196-
| None -> ()
197-
| Some d -> Response.helpText(d.Name, d.DescriptionText)
198-
199-
Response.completion(decls)
200-
201-
let helptext =
202-
Seq.fold (fun m d -> Map.add (declName d) d.DescriptionText m) Map.empty decls
203-
main { state with HelpText = helptext }
204-
205-
| None ->
206-
Response.error "Timed out while fetching completions"
207-
main state
208-
209-
| ToolTip ->
210-
// A failure is only info here, as this command is expected to be
211-
// used 'on idle', and frequent errors are expected.
212-
match tyRes.TryGetToolTip line col lineStr with
213-
| Result.Failure s -> Response.info(s)
214-
| Result.Success tip -> Response.toolTip(tip)
215-
216-
main state
217-
218-
| SymbolUse ->
219-
// A failure is only info here, as this command is expected to be
220-
// used 'on idle', and frequent errors are expected.
221-
match tyRes.TryGetSymbolUse line col lineStr with
222-
| Result.Failure s -> Response.info(s)
223-
| Result.Success (sym,usages) -> Response.symbolUse(sym,usages)
224-
225-
main state
226-
227-
| FindDeclaration ->
228-
match tyRes.TryFindDeclaration line col lineStr with
229-
| Result.Failure s -> Response.error s
230-
| Result.Success range -> Response.findDeclaration(range)
231-
232-
main state
233-
234-
| Methods ->
235-
match tyRes.TryGetMethodOverrides lines line col with
236-
| Result.Failure s -> Response.error s
237-
| Result.Success (meth, commas) -> Response.methods(meth, commas)
238-
239-
main state
240-
241-
| CompilerLocation ->
242-
Response.compilerLocation Environment.fsc Environment.fsi Environment.msbuild
243-
main state
244-
245-
| Colorization enabled ->
246-
main { state with ColorizationOutput = enabled }
247-
248-
| Error(msg) ->
249-
Response.error msg
250-
main state
251-
252-
| Quit ->
253-
0
254-
255-
with e ->
256-
let msg = "Unexpected internal error. Please report at \
257-
https://github.com/fsharp/FsAutoComplete/issues, \
258-
attaching the exception information:\n"
259-
+ e.ToString()
260-
Response.error msg
261-
main state
86+
let main (state:State) : int =
87+
let mutable state = state
88+
let mutable quit = false
89+
90+
while not quit do
91+
currentFiles <- state.Files
92+
try
93+
match commandQueue.Get() with
94+
| Parse(file,kind,lines) ->
95+
let colorizations = state.ColorizationOutput
96+
let parse fileName text options =
97+
let task =
98+
async {
99+
let! _parseResults, checkResults = checker.ParseAndCheckFileInProject(fileName, 0, text, options)
100+
match checkResults with
101+
| FSharpCheckFileAnswer.Aborted -> ()
102+
| FSharpCheckFileAnswer.Succeeded results ->
103+
Response.errors(results.Errors)
104+
if colorizations then
105+
Response.colorizations(results.GetExtraColorizationsAlternate())
106+
}
107+
match kind with
108+
| Synchronous -> Response.info "Synchronous parsing started"
109+
Async.RunSynchronously task
110+
| Normal -> Response.info "Background parsing started"
111+
Async.StartImmediate task
112+
113+
let file = Path.GetFullPath file
114+
let text = String.concat "\n" lines
115+
116+
if Utils.isAScript file then
117+
let checkOptions = checker.GetProjectOptionsFromScript(file, text)
118+
parse file text checkOptions
119+
state <- state.WithFileTextAndCheckerOptions(file, lines, checkOptions)
120+
else
121+
let state', checkOptions = state.WithFileTextGetCheckerOptions(file, lines)
122+
parse file text checkOptions
123+
state <- state'
124+
125+
| Project (file,time) ->
126+
let file = Path.GetFullPath file
127+
128+
// The FileSystemWatcher often triggers multiple times for
129+
// each event, as editors often modify files in several steps.
130+
// This 'debounces' the events, by only reloading a max of once
131+
// per second.
132+
match state.ProjectLoadTimes.TryFind file with
133+
| Some oldtime when time - oldtime < TimeSpan.FromSeconds(1.0) -> ()
134+
| _ ->
135+
136+
match checker.TryGetProjectOptions(file) with
137+
| Result.Failure s ->
138+
Response.error(s)
139+
140+
| Result.Success(po, projectFiles, outFileOpt, references, frameworkOpt) ->
141+
Response.project(file, projectFiles, outFileOpt, references, frameworkOpt)
142+
143+
let fsw = new FileSystemWatcher()
144+
fsw.Path <- Path.GetDirectoryName file
145+
fsw.Filter <- Path.GetFileName file
146+
fsw.Changed.Add(fun _ -> commandQueue.Add(Project (file, DateTime.Now)))
147+
fsw.EnableRaisingEvents <- true
148+
149+
let checkOptions =
150+
projectFiles
151+
|> List.fold (fun s f -> Map.add f po s) state.FileCheckOptions
152+
let loadTimes = Map.add file time state.ProjectLoadTimes
153+
state <- { state with FileCheckOptions = checkOptions
154+
ProjectLoadTimes = loadTimes }
155+
156+
| Declarations file ->
157+
let file = Path.GetFullPath file
158+
match state.TryGetFileCheckerOptionsWithSource(file) with
159+
| Failure s -> Response.error(s)
160+
| Success (checkOptions, source) ->
161+
let decls = checker.GetDeclarations(file, source, checkOptions)
162+
Response.declarations(decls)
163+
164+
| HelpText sym ->
165+
match Map.tryFind sym state.HelpText with
166+
| None -> Response.error (sprintf "No help text available for symbol '%s'" sym)
167+
| Some tip -> Response.helpText(sym, tip)
168+
169+
| PosCommand(cmd, file, line, col, timeout, filter) ->
170+
let file = Path.GetFullPath file
171+
match state.TryGetFileCheckerOptionsWithLinesAndLineStr(file, line, col) with
172+
| Failure s -> Response.error(s)
173+
| Success (options, lines, lineStr) ->
174+
// TODO: Should sometimes pass options.Source in here to force a reparse
175+
// for completions e.g. `(some typed expr).$`
176+
let tyResOpt = checker.TryGetRecentTypeCheckResultsForFile(file, options)
177+
match tyResOpt with
178+
| None -> Response.info "Cached typecheck results not yet available"
179+
| Some tyRes ->
180+
181+
match cmd with
182+
| Completion ->
183+
match tyRes.TryGetCompletions line col lineStr timeout filter with
184+
| Some (decls, residue) ->
185+
let declName (d: FSharpDeclarationListItem) = d.Name
186+
187+
// Send the first helptext without being requested.
188+
// This allows it to be displayed immediately in the editor.
189+
let firstMatchOpt =
190+
Array.sortBy declName decls
191+
|> Array.tryFind (fun d -> (declName d).StartsWith residue)
192+
match firstMatchOpt with
193+
| None -> ()
194+
| Some d -> Response.helpText(d.Name, d.DescriptionText)
195+
196+
Response.completion(decls)
197+
198+
let helptext =
199+
Seq.fold (fun m d -> Map.add (declName d) d.DescriptionText m) Map.empty decls
200+
state <- { state with HelpText = helptext }
201+
202+
| None ->
203+
Response.error "Timed out while fetching completions"
204+
205+
| ToolTip ->
206+
// A failure is only info here, as this command is expected to be
207+
// used 'on idle', and frequent errors are expected.
208+
match tyRes.TryGetToolTip line col lineStr with
209+
| Result.Failure s -> Response.info(s)
210+
| Result.Success tip -> Response.toolTip(tip)
211+
212+
| SymbolUse ->
213+
// A failure is only info here, as this command is expected to be
214+
// used 'on idle', and frequent errors are expected.
215+
match tyRes.TryGetSymbolUse line col lineStr with
216+
| Result.Failure s -> Response.info(s)
217+
| Result.Success (sym,usages) -> Response.symbolUse(sym,usages)
218+
219+
| FindDeclaration ->
220+
match tyRes.TryFindDeclaration line col lineStr with
221+
| Result.Failure s -> Response.error s
222+
| Result.Success range -> Response.findDeclaration(range)
223+
224+
| Methods ->
225+
match tyRes.TryGetMethodOverrides lines line col with
226+
| Result.Failure s -> Response.error s
227+
| Result.Success (meth, commas) -> Response.methods(meth, commas)
228+
229+
| CompilerLocation ->
230+
Response.compilerLocation Environment.fsc Environment.fsi Environment.msbuild
231+
232+
| Colorization enabled ->
233+
state <- { state with ColorizationOutput = enabled }
234+
235+
| Error(msg) ->
236+
Response.error msg
237+
238+
| Quit ->
239+
quit <- true
240+
241+
with e ->
242+
let msg = "Unexpected internal error. Please report at \
243+
https://github.com/fsharp/FsAutoComplete/issues, \
244+
attaching the exception information:\n"
245+
+ e.ToString()
246+
Response.error msg
247+
248+
0
262249

263250
[<EntryPoint>]
264251
let entry args =
252+
Console.InputEncoding <- Text.Encoding.UTF8
253+
Console.OutputEncoding <- Text.Encoding.UTF8
265254
let extra = Options.p.Parse args
266255
if extra.Count <> 0 then
267256
printfn "Unrecognised arguments: %s" (String.concat "," extra)

0 commit comments

Comments
 (0)