@@ -10,69 +10,90 @@ open System.Diagnostics
1010open System.Threading
1111
1212[<assembly: System.Runtime.InteropServices.ComVisible( false ) >]
13- [<assembly: System.CLSCompliant( true ) >]
14- do ()
13+ [<assembly: System.CLSCompliant( true ) >]
14+ do ()
1515
1616type IEventLoop =
17- abstract Run : unit -> bool
18- abstract Invoke : ( unit -> 'T ) -> 'T
19- abstract ScheduleRestart : unit -> unit
20-
17+ abstract Run: unit -> bool
18+ abstract Invoke: ( unit -> 'T ) -> 'T
19+ abstract ScheduleRestart: unit -> unit
20+
2121// An implementation of IEventLoop suitable for the command-line console
2222[<AutoSerializable( false ) >]
23- type internal SimpleEventLoop () =
23+ type internal SimpleEventLoop () =
2424 let runSignal = new AutoResetEvent( false )
2525 let exitSignal = new AutoResetEvent( false )
2626 let doneSignal = new AutoResetEvent( false )
27- let mutable queue = ([] : ( unit -> obj) list)
28- let mutable result = ( None : obj option)
29- let setSignal ( signal : AutoResetEvent ) = while not ( signal.Set()) do Thread.Sleep( 1 ); done
30- let waitSignal signal = WaitHandle.WaitAll([| ( signal :> WaitHandle) |]) |> ignore
31- let waitSignal2 signal1 signal2 =
27+ let mutable queue = ([]: ( unit -> obj) list)
28+ let mutable result = ( None: obj option)
29+
30+ let setSignal ( signal : AutoResetEvent ) =
31+ while not ( signal.Set()) do
32+ Thread.Sleep( 1 )
33+
34+ let waitSignal signal =
35+ WaitHandle.WaitAll([| ( signal :> WaitHandle) |]) |> ignore
36+
37+ let waitSignal2 signal1 signal2 =
3238 WaitHandle.WaitAny([| ( signal1 :> WaitHandle); ( signal2 :> WaitHandle) |])
39+
3340 let mutable running = false
3441 let mutable restart = false
35- interface IEventLoop with
36- member x.Run () =
37- running <- true
38- let rec run () =
39- match waitSignal2 runSignal exitSignal with
40- | 0 ->
41- queue |> List.iter ( fun f -> result <- try Some( f()) with _ -> None)
42- setSignal doneSignal
43- run()
44- | 1 ->
45- running <- false
46- restart
47- | _ -> run()
48- run()
49- member x.Invoke ( f : unit -> 'T ) : 'T =
50- queue <- [ f >> box]
51- setSignal runSignal
52- waitSignal doneSignal
53- result |> Option.get |> unbox
54- member x.ScheduleRestart () =
55- // nb. very minor race condition here on running here, but totally
56- // unproblematic as ScheduleRestart and Exit are almost never called.
57- if running then
58- restart <- true
59- setSignal exitSignal
60- interface System.IDisposable with
61- member x.Dispose () =
62- runSignal.Dispose()
63- exitSignal.Dispose()
64- doneSignal.Dispose()
65-
6642
43+ interface IEventLoop with
44+ member x.Run () =
45+ running <- true
46+
47+ let rec run () =
48+ match waitSignal2 runSignal exitSignal with
49+ | 0 ->
50+ queue
51+ |> List.iter ( fun f ->
52+ result <-
53+ try
54+ Some( f ())
55+ with
56+ | _ -> None)
57+
58+ setSignal doneSignal
59+ run ()
60+ | 1 ->
61+ running <- false
62+ restart
63+ | _ -> run ()
64+
65+ run ()
66+
67+ member x.Invoke ( f : unit -> 'T ) : 'T =
68+ queue <- [ f >> box ]
69+ setSignal runSignal
70+ waitSignal doneSignal
71+ result |> Option.get |> unbox
72+
73+ member x.ScheduleRestart () =
74+ // nb. very minor race condition here on running here, but totally
75+ // unproblematic as ScheduleRestart and Exit are almost never called.
76+ if running then
77+ restart <- true
78+ setSignal exitSignal
79+
80+ interface System.IDisposable with
81+ member x.Dispose () =
82+ runSignal.Dispose()
83+ exitSignal.Dispose()
84+ doneSignal.Dispose()
6785
6886[<Sealed>]
69- type InteractiveSession () =
87+ type InteractiveSession () =
7088 let mutable evLoop = ( new SimpleEventLoop() :> IEventLoop)
7189 let mutable showIDictionary = true
7290 let mutable showDeclarationValues = true
73- let mutable args = System.Environment.GetCommandLineArgs()
91+ let mutable args = System.Environment.GetCommandLineArgs()
7492 let mutable fpfmt = " g10"
75- let mutable fp = ( System.Globalization.CultureInfo.InvariantCulture :> System.IFormatProvider)
93+
94+ let mutable fp =
95+ ( System.Globalization.CultureInfo.InvariantCulture :> System.IFormatProvider)
96+
7697 let mutable printWidth = 78
7798 let mutable printDepth = 100
7899 let mutable printLength = 100
@@ -81,59 +102,92 @@ type InteractiveSession() =
81102 let mutable showProperties = true
82103 let mutable addedPrinters = []
83104
84- member self.FloatingPointFormat with get() = fpfmt and set v = fpfmt <- v
85- member self.FormatProvider with get() = fp and set v = fp <- v
86- member self.PrintWidth with get() = printWidth and set v = printWidth <- v
87- member self.PrintDepth with get() = printDepth and set v = printDepth <- v
88- member self.PrintLength with get() = printLength and set v = printLength <- v
89- member self.PrintSize with get() = printSize and set v = printSize <- v
90- member self.ShowDeclarationValues with get() = showDeclarationValues and set v = showDeclarationValues <- v
91- member self.ShowProperties with get() = showProperties and set v = showProperties <- v
92- member self.ShowIEnumerable with get() = showIEnumerable and set v = showIEnumerable <- v
93- member self.ShowIDictionary with get() = showIDictionary and set v = showIDictionary <- v
94- member self.AddedPrinters with get() = addedPrinters and set v = addedPrinters <- v
95-
96- [<CodeAnalysis.SuppressMessage( " Microsoft.Performance" , " CA1819:PropertiesShouldNotReturnArrays" ) >]
97- member self.CommandLineArgs
98- with get() = args
99- and set v = args <- v
100-
101- member self.AddPrinter ( printer : 'T -> string ) =
102- addedPrinters <- Choice1Of2 ( typeof< 'T>, ( fun ( x : obj ) -> ( unbox x))) :: addedPrinters
103-
104- member self.EventLoop
105- with get () = evLoop
106- and set ( x : IEventLoop ) = evLoop.ScheduleRestart(); evLoop <- x
107-
108- member self.AddPrintTransformer ( printer : 'T -> obj ) =
109- addedPrinters <- Choice2Of2 ( typeof< 'T>, ( fun ( x : obj ) -> ( unbox x))) :: addedPrinters
110-
111- member internal self.SetEventLoop ( run : ( unit -> bool ), invoke : (( unit -> obj ) -> obj ), restart : ( unit -> unit )) =
112- evLoop.ScheduleRestart()
113- evLoop <- { new IEventLoop with
114- member _.Run () = run()
115- member _.Invoke ( f ) = invoke(( fun () -> () |> box)) |> unbox
116- member _.ScheduleRestart () = restart() }
117-
118- [<assembly: CodeAnalysis.SuppressMessage( " Microsoft.Design" , " CA1009:DeclareEventHandlersCorrectly" , Scope= " member" , Target= " FSharp.Compiler.Interactive.InteractiveSession.#ThreadException" ) >]
119- do ()
120-
121-
122- module Settings =
105+ member _.FloatingPointFormat
106+ with get () = fpfmt
107+ and set v = fpfmt <- v
108+
109+ member _.FormatProvider
110+ with get () = fp
111+ and set v = fp <- v
112+
113+ member _.PrintWidth
114+ with get () = printWidth
115+ and set v = printWidth <- v
116+
117+ member _.PrintDepth
118+ with get () = printDepth
119+ and set v = printDepth <- v
120+
121+ member _.PrintLength
122+ with get () = printLength
123+ and set v = printLength <- v
124+
125+ member _.PrintSize
126+ with get () = printSize
127+ and set v = printSize <- v
128+
129+ member _.ShowDeclarationValues
130+ with get () = showDeclarationValues
131+ and set v = showDeclarationValues <- v
132+
133+ member _.ShowProperties
134+ with get () = showProperties
135+ and set v = showProperties <- v
136+
137+ member _.ShowIEnumerable
138+ with get () = showIEnumerable
139+ and set v = showIEnumerable <- v
140+
141+ member _.ShowIDictionary
142+ with get () = showIDictionary
143+ and set v = showIDictionary <- v
144+
145+ member _.AddedPrinters
146+ with get () = addedPrinters
147+ and set v = addedPrinters <- v
148+
149+ member _.CommandLineArgs
150+ with get () = args
151+ and set v = args <- v
152+
153+ member _.AddPrinter ( printer : 'T -> string ) =
154+ addedPrinters <- Choice1Of2( typeof< 'T>, ( fun ( x : obj ) -> ( unbox x))) :: addedPrinters
155+
156+ member _.EventLoop
157+ with get () = evLoop
158+ and set ( x : IEventLoop ) =
159+ evLoop.ScheduleRestart()
160+ evLoop <- x
161+
162+ member _.AddPrintTransformer ( printer : 'T -> obj ) =
163+ addedPrinters <- Choice2Of2( typeof< 'T>, ( fun ( x : obj ) -> ( unbox x))) :: addedPrinters
164+
165+ member internal self.SetEventLoop ( run : ( unit -> bool ), invoke : (( unit -> obj ) -> obj ), restart : ( unit -> unit )) =
166+ evLoop.ScheduleRestart()
167+
168+ evLoop <-
169+ { new IEventLoop with
170+ member _.Run () = run ()
171+
172+ member _.Invoke ( f ) =
173+ invoke (( fun () -> () |> box)) |> unbox
174+
175+ member _.ScheduleRestart () = restart ()
176+ }
177+
178+ module Settings =
123179 let fsi = new InteractiveSession()
124-
180+
125181 [<assembly: AutoOpen( " FSharp.Compiler.Interactive.Settings" ) >]
126- do ()
182+ do ()
127183
128184// For legacy compatibility with old naming
129185namespace Microsoft.FSharp.Compiler.Interactive
130186
131- type IEventLoop = FSharp.Compiler.Interactive.IEventLoop
132-
133- type InteractiveSession = FSharp.Compiler.Interactive.InteractiveSession
134-
135- module Settings =
187+ type IEventLoop = FSharp.Compiler.Interactive.IEventLoop
136188
137- let fsi = FSharp.Compiler.Interactive.Settings.fsi
189+ type InteractiveSession = FSharp.Compiler.Interactive.InteractiveSession
138190
191+ module Settings =
139192
193+ let fsi = FSharp.Compiler.Interactive.Settings.fsi
0 commit comments