// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.

module FSharp.Compiler.Interactive.Shell

// Prevents warnings of experimental APIs - we are using FSharpLexer

#nowarn "57"

#nowarn "55"

#nowarn "9"

[<assembly: System.Runtime.InteropServices.ComVisible(false)>]

[<assembly: System.CLSCompliant(true)>]

do ()

open System

open System.Collections.Generic

open System.Diagnostics

open System.Globalization

open System.IO

open System.Text

open System.Threading

open System.Reflection

open System.Runtime.CompilerServices

open Internal.Utilities

open Internal.Utilities.Collections

open Internal.Utilities.FSharpEnvironment

open Internal.Utilities.Library

open Internal.Utilities.Library.Extras

open FSharp.Compiler

open FSharp.Compiler.AbstractIL

open FSharp.Compiler.AbstractIL.Diagnostics

open FSharp.Compiler.AbstractIL.IL

open FSharp.Compiler.AbstractIL.ILBinaryReader

open FSharp.Compiler.AbstractIL.ILBinaryWriter

open FSharp.Compiler.AbstractIL.ILDynamicAssemblyWriter

open FSharp.Compiler.AccessibilityLogic

open FSharp.Compiler.CheckDeclarations

open FSharp.Compiler.CheckExpressions

open FSharp.Compiler.CodeAnalysis

open FSharp.Compiler.CompilerOptions

open FSharp.Compiler.CompilerConfig

open FSharp.Compiler.CompilerDiagnostics

open FSharp.Compiler.CompilerImports

open FSharp.Compiler.DependencyManager

open FSharp.Compiler.Diagnostics

open FSharp.Compiler.DiagnosticsLogger

open FSharp.Compiler.Features

open FSharp.Compiler.IlxGen

open FSharp.Compiler.Interactive

open FSharp.Compiler.InfoReader

open FSharp.Compiler.IO

open FSharp.Compiler.Lexhelp

open FSharp.Compiler.NameResolution

open FSharp.Compiler.ParseAndCheckInputs

open FSharp.Compiler.OptimizeInputs

open FSharp.Compiler.ScriptClosure

open FSharp.Compiler.Symbols

open FSharp.Compiler.Syntax

open FSharp.Compiler.SyntaxTrivia

open FSharp.Compiler.Syntax.PrettyNaming

open FSharp.Compiler.SyntaxTreeOps

open FSharp.Compiler.TcGlobals

open FSharp.Compiler.Text

open FSharp.Compiler.Text.Range

open FSharp.Compiler.Text.Layout

open FSharp.Compiler.Xml

open FSharp.Compiler.Tokenization

open FSharp.Compiler.TypedTree

open FSharp.Compiler.TypedTreeOps

open FSharp.Compiler.CheckExpressionsOps

//----------------------------------------------------------------------------

// For the FSI as a service methods...

//----------------------------------------------------------------------------

type FsiValue(reflectionValue: objnull, reflectionType: Type, fsharpType: FSharpType) =

member _.ReflectionValue = reflectionValue

member _.ReflectionType = reflectionType

member _.FSharpType = fsharpType

[<Sealed>]

type FsiBoundValue(name: string, value: FsiValue) =

member _.Name = name

member _.Value = value

[<AutoOpen>]

module internal Utilities =

type IAnyToLayoutCall =

abstract AnyToLayout: FormatOptions * objnull * Type -> Layout

abstract FsiAnyToLayout: FormatOptions * objnull * Type -> Layout

type private AnyToLayoutSpecialization<'T>() =

interface IAnyToLayoutCall with

member _.AnyToLayout(options, o: objnull, ty: Type) =

Display.any_to_layout options ((Unchecked.unbox o: 'T), ty)

member _.FsiAnyToLayout(options, o: objnull, ty: Type) =

Display.fsi_any_to_layout options ((Unchecked.unbox o: 'T), ty)

let getAnyToLayoutCall (ty: Type) =

if ty.IsPointer then

let pointerToNativeInt (o: obj) : nativeint =

Pointer.Unbox o

|> NativeInterop.NativePtr.ofVoidPtr<nativeptr<byte>>

|> NativeInterop.NativePtr.toNativeInt

{ new IAnyToLayoutCall with

member _.AnyToLayout(options, o: objnull, ty: Type) =

match o with

| null -> Display.any_to_layout options (o, ty)

| o ->

let n = pointerToNativeInt o

Display.any_to_layout options (n, n.GetType())

member _.FsiAnyToLayout(options, o: objnull, ty: Type) =

match o with

| null -> Display.any_to_layout options (o, ty)

| o ->

let n = pointerToNativeInt o

Display.any_to_layout options (n, n.GetType())

}

else

let specialized = typedefof<AnyToLayoutSpecialization<_>>.MakeGenericType [| ty |]

!!Activator.CreateInstance(specialized) :?> IAnyToLayoutCall

let callStaticMethod (ty: Type) name args =

ty.InvokeMember(

name,

(BindingFlags.InvokeMethod

||| BindingFlags.Static

||| BindingFlags.Public

||| BindingFlags.NonPublic),

null,

null,

Array.ofList args,

CultureInfo.InvariantCulture

)

let ignoreAllErrors f =

try

f ()

with _ ->

()

let getMember (name: string) (memberType: MemberTypes) (attr: BindingFlags) (declaringType: Type) =

let memberType =

if memberType &&& MemberTypes.NestedType = MemberTypes.NestedType then

memberType ||| MemberTypes.TypeInfo

else

memberType

declaringType.GetMembers(attr)

|> Array.filter (fun m -> 0 <> (int (m.MemberType &&& memberType)) && m.Name = name)

let rec tryFindMember (name: string) (memberType: MemberTypes) (declaringType: Type) =

let bindingFlags =

BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic

match declaringType |> getMember name memberType bindingFlags with

| [||] -> declaringType.GetInterfaces() |> Array.tryPick (tryFindMember name memberType)

| [| m |] -> Some m

| _ -> raise <| AmbiguousMatchException(sprintf "Ambiguous match for member '%s'" name)

let getInstanceProperty (obj: obj) (nm: string) =

let p =

(tryFindMember nm MemberTypes.Property <| obj.GetType()).Value :?> PropertyInfo

p.GetValue(obj, [||]) |> unbox

let setInstanceProperty (obj: obj) (nm: string) (v: obj) =

let p =

(tryFindMember nm MemberTypes.Property <| obj.GetType()).Value :?> PropertyInfo

p.SetValue(obj, v, [||]) |> unbox

let callInstanceMethod0 (obj: obj) (typeArgs: Type[]) (nm: string) =

let m = (tryFindMember nm MemberTypes.Method <| obj.GetType()).Value :?> MethodInfo

let m =

match typeArgs with

| [||] -> m

| _ -> m.MakeGenericMethod(typeArgs)

m.Invoke(obj, [||]) |> unbox

let callInstanceMethod1 (obj: obj) (typeArgs: Type[]) (nm: string) (v: obj) =

let m = (tryFindMember nm MemberTypes.Method <| obj.GetType()).Value :?> MethodInfo

let m =

match typeArgs with

| [||] -> m

| _ -> m.MakeGenericMethod(typeArgs)

m.Invoke(obj, [| v |]) |> unbox

let callInstanceMethod3 (obj: obj) (typeArgs: Type[]) (nm: string) (v1: obj) (v2: obj) (v3: obj) =

let m = (tryFindMember nm MemberTypes.Method <| obj.GetType()).Value :?> MethodInfo

let m =

match typeArgs with

| [||] -> m

| _ -> m.MakeGenericMethod(typeArgs)

m.Invoke(obj, [| v1; v2; v3 |]) |> unbox

let colorPrintL (outWriter: TextWriter) opts layout =

let renderer =

{ new LayoutRenderer<NoResult, NoState> with

member r.Start() = NoState

member r.AddText z s =

let color =

match s.Tag with

| TextTag.Keyword -> ConsoleColor.White

| TextTag.TypeParameter

| TextTag.Alias

| TextTag.Class

| TextTag.Module

| TextTag.Interface

| TextTag.Record

| TextTag.Struct

| TextTag.Union

| TextTag.UnknownType -> ConsoleColor.Cyan

| TextTag.UnionCase

| TextTag.ActivePatternCase -> ConsoleColor.Magenta

| TextTag.StringLiteral -> ConsoleColor.Yellow

| TextTag.NumericLiteral -> ConsoleColor.Green

| _ -> Console.ForegroundColor

DoWithColor color (fun () -> outWriter.Write s.Text)

z

member r.AddBreak z n =

outWriter.WriteLine()

outWriter.Write(String.replicate n " ")

z

member r.AddTag z (tag, attrs, start) = z

member r.Finish z =

outWriter.WriteLine()

NoResult

}

layout |> Display.squash_layout opts |> LayoutRender.renderL renderer |> ignore

outWriter.WriteLine()

let reportError m =

let report errorType err msg =

let error = err, msg

match errorType with

| ErrorReportType.Warning -> warning (Error(error, m))

| ErrorReportType.Error -> errorR (Error(error, m))

ResolvingErrorReport report

let getOutputDir (tcConfigB: TcConfigBuilder) =

tcConfigB.outputDir |> Option.defaultValue ""

/// Timing support

[<AutoSerializable(false)>]

type internal FsiTimeReporter(outWriter: TextWriter) =

let stopwatch = Stopwatch()

let ptime = Process.GetCurrentProcess()

let numGC = GC.MaxGeneration

member tr.TimeOp(f) =

let startTotal = ptime.TotalProcessorTime

let startGC = [| for i in 0..numGC -> GC.CollectionCount(i) |]

stopwatch.Reset()

stopwatch.Start()

let res = f ()

stopwatch.Stop()

let total = ptime.TotalProcessorTime - startTotal

let spanGC = [ for i in 0..numGC -> GC.CollectionCount(i) - startGC[i] ]

let elapsed = stopwatch.Elapsed

fprintfn

outWriter

"%s"

(FSIstrings.SR.fsiTimeInfoMainString (

(sprintf "%02d:%02d:%02d.%03d" (int elapsed.TotalHours) elapsed.Minutes elapsed.Seconds elapsed.Milliseconds),

(sprintf "%02d:%02d:%02d.%03d" (int total.TotalHours) total.Minutes total.Seconds total.Milliseconds),

(String.concat

", "

(List.mapi (sprintf "%s%d: %d" (FSIstrings.SR.fsiTimeInfoGCGenerationLabelSomeShorthandForTheWordGeneration ())) spanGC))

))

res

member tr.TimeOpIf flag f = if flag then tr.TimeOp f else f ()

/// Manages the emit of one logical assembly into multiple assemblies. Gives warnings

/// on cross-fragment internal access.

type ILMultiInMemoryAssemblyEmitEnv

(ilg: ILGlobals, resolveAssemblyRef: ILAssemblyRef -> Choice<string, Assembly> option, dynamicCcuName: string) =

let typeMap = Dictionary<ILTypeRef, Type * ILTypeRef>(HashIdentity.Structural)

let reverseTypeMap = Dictionary<ILTypeRef, ILTypeRef>(HashIdentity.Structural)

let internalTypes = HashSet<ILTypeRef>(HashIdentity.Structural)

let internalMethods = HashSet<ILMethodRef>(HashIdentity.Structural)

let internalFields = HashSet<ILFieldRef>(HashIdentity.Structural)

let dynamicCcuScopeRef = ILScopeRef.Assembly(mkSimpleAssemblyRef dynamicCcuName)

/// Convert an ILAssemblyRef to a dynamic System.Type given the dynamic emit context

let convAssemblyRef (aref: ILAssemblyRef) =

let asmName = AssemblyName()

asmName.Name <- aref.Name

match aref.PublicKey with

| None -> ()

| Some(PublicKey bytes) -> asmName.SetPublicKey bytes

| Some(PublicKeyToken bytes) -> asmName.SetPublicKeyToken bytes

match aref.Version with

| None -> ()

| Some version -> asmName.Version <- Version(int32 version.Major, int32 version.Minor, int32 version.Build, int32 version.Revision)

asmName.CultureInfo <- CultureInfo.InvariantCulture

asmName

/// Convert an ILAssemblyRef to a dynamic System.Type given the dynamic emit context

let convResolveAssemblyRef (asmref: ILAssemblyRef) qualifiedName =

let assembly =

match resolveAssemblyRef asmref with

| Some(Choice1Of2 path) ->

// asmRef is a path but the runtime is smarter with assembly names so make one

let asmName = AssemblyName.GetAssemblyName(path)

asmName.CodeBase <- path

FileSystem.AssemblyLoader.AssemblyLoad asmName

| Some(Choice2Of2 assembly) -> assembly

| None ->

let asmName = convAssemblyRef asmref

FileSystem.AssemblyLoader.AssemblyLoad asmName

let typT = assembly.GetType qualifiedName

match typT with

| null -> error (Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", qualifiedName, asmref.QualifiedName), range0))

| res -> res

/// Convert an Abstract IL type reference to System.Type

let convTypeRefAux (tref: ILTypeRef) =

let qualifiedName =

(String.concat "+" (tref.Enclosing @ [ tref.Name ])).Replace(",", @"\,")

match tref.Scope with

| ILScopeRef.Assembly asmref -> convResolveAssemblyRef asmref qualifiedName

| ILScopeRef.Module _

| ILScopeRef.Local ->

let typT = Type.GetType qualifiedName

match typT with

| null -> error (Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", qualifiedName, "<emitted>"), range0))

| res -> res

| ILScopeRef.PrimaryAssembly -> convResolveAssemblyRef ilg.primaryAssemblyRef qualifiedName

/// Convert an ILTypeRef to a dynamic System.Type given the dynamic emit context

let convTypeRef (tref: ILTypeRef) =

if tref.Scope.IsLocalRef then

assert tref.Scope.IsLocalRef

let typ, _ = typeMap[tref]

typ

else

convTypeRefAux tref

/// Convert an ILTypeSpec to a dynamic System.Type given the dynamic emit context

let rec convTypeSpec (tspec: ILTypeSpec) =

let tref = tspec.TypeRef

let typT = convTypeRef tref

let tyargs = List.map convTypeAux tspec.GenericArgs

let res: Type | null =

match isNil tyargs, typT.IsGenericType with

| _, true -> typT.MakeGenericType(List.toArray tyargs)

| true, false -> typT

| _, false -> null

match res with

| null ->

error (

Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", tspec.TypeRef.QualifiedName, tspec.Scope.QualifiedName), range0)

)

| _ -> res

and convTypeAux ty =

match ty with

| ILType.Void -> !!Type.GetType("System.Void")

| ILType.Array(shape, eltType) ->

let baseT = convTypeAux eltType

if shape.Rank = 1 then

baseT.MakeArrayType()

else

baseT.MakeArrayType shape.Rank

| ILType.Value tspec -> !!(convTypeSpec tspec)

| ILType.Boxed tspec -> !!(convTypeSpec tspec)

| ILType.Ptr eltType ->

let baseT = convTypeAux eltType

baseT.MakePointerType()

| ILType.Byref eltType ->

let baseT = convTypeAux eltType

baseT.MakeByRefType()

| ILType.TypeVar _tv -> failwith "open generic type"

| ILType.Modified(_, _, modifiedTy) -> convTypeAux modifiedTy

| ILType.FunctionPointer _callsig -> failwith "convType: fptr"

/// Map the given ILTypeRef to the appropriate assembly fragment

member _.MapTypeRef(tref: ILTypeRef) =

if tref.Scope.IsLocalRef then

match typeMap.TryGetValue tref with

| true, tmap -> tmap |> snd

| false, _ -> tref

else

tref

/// Map an ILTypeRef built from reflection over loaded assembly fragments back to an ILTypeRef suitable

/// to use on the F# compiler logic.

member _.ReverseMapTypeRef(tref: ILTypeRef) =

match reverseTypeMap.TryGetValue tref with

| true, revtype -> revtype

| false, _ -> tref

/// Convert an ILTypeRef to a dynamic System.Type given the dynamic emit context

member _.LookupTypeRef(tref: ILTypeRef) = convTypeRef tref

/// Convert an ILType to a dynamic System.Type given the dynamic emit context

member _.LookupType(ty: ILType) = convTypeAux ty

/// Record the given ILTypeDef in the dynamic emit context

member emEnv.AddTypeDef (asm: Assembly) ilScopeRef enc (tdef: ILTypeDef) =

let ltref = mkRefForNestedILTypeDef ILScopeRef.Local (enc, tdef)

let tref = mkRefForNestedILTypeDef ilScopeRef (enc, tdef)

let key = tref.BasicQualifiedName

let typ = !!asm.GetType(key)

//printfn "Adding %s --> %s" key typ.FullName

let rtref = rescopeILTypeRef dynamicCcuScopeRef tref

typeMap.Add(ltref, (typ, tref))

reverseTypeMap.Add(tref, rtref)

for ntdef in tdef.NestedTypes.AsArray() do

emEnv.AddTypeDef asm ilScopeRef (enc @ [ tdef ]) ntdef

// Record the internal things to give warnings for internal access across fragment boundaries

for fdef in tdef.Fields.AsList() do

match fdef.Access with

| ILMemberAccess.Public -> ()

| _ ->

let lfref = mkRefForILField ILScopeRef.Local (enc, tdef) fdef

internalFields.Add(lfref) |> ignore

for mdef in tdef.Methods.AsArray() do

match mdef.Access with

| ILMemberAccess.Public -> ()

| _ ->

let lmref = mkRefForILMethod ILScopeRef.Local (enc, tdef) mdef

internalMethods.Add(lmref) |> ignore

match tdef.Access with

| ILTypeDefAccess.Public

| ILTypeDefAccess.Nested ILMemberAccess.Public -> ()

| _ -> internalTypes.Add(ltref) |> ignore

/// Record the given ILModuleDef (i.e. an assembly) in the dynamic emit context

member emEnv.AddModuleDef asm ilScopeRef (mdef: ILModuleDef) =

for tdef in mdef.TypeDefs.AsArray() do

emEnv.AddTypeDef asm ilScopeRef [] tdef

/// Check if an ILTypeRef is a reference to an already-emitted internal type within the dynamic emit context

member _.IsLocalInternalType(tref: ILTypeRef) =

tref.Scope.IsLocalRef && internalTypes.Contains(tref)

/// Check if an ILMethodRef is a reference to an already-emitted internal method within the dynamic emit context

member _.IsLocalInternalMethod(mref: ILMethodRef) =

mref.DeclaringTypeRef.Scope.IsLocalRef && internalMethods.Contains(mref)

/// Check if an ILFieldRef is a reference to an already-emitted internal field within the dynamic emit context

member _.IsLocalInternalField(fref: ILFieldRef) =

fref.DeclaringTypeRef.Scope.IsLocalRef && internalFields.Contains(fref)

type ILAssemblyEmitEnv =

| SingleRefEmitAssembly of cenv * ILDynamicAssemblyEmitEnv

| MultipleInMemoryAssemblies of ILMultiInMemoryAssemblyEmitEnv

type internal FsiValuePrinterMode =

| PrintExpr

| PrintDecl

type EvaluationEventArgs(fsivalue: FsiValue option, symbolUse: FSharpSymbolUse, decl: FSharpImplementationFileDeclaration) =

inherit EventArgs()

member _.Name = symbolUse.Symbol.DisplayName

member _.FsiValue = fsivalue

member _.SymbolUse = symbolUse

member _.Symbol = symbolUse.Symbol

member _.ImplementationDeclaration = decl

/// User-configurable information that changes how F# Interactive operates, stored in the 'fsi' object

/// and accessible via the programming model

[<AbstractClass>]

type FsiEvaluationSessionHostConfig() =

let evaluationEvent = Event<EvaluationEventArgs>()

/// Called by the evaluation session to ask the host for parameters to format text for output

abstract FormatProvider: IFormatProvider

/// Called by the evaluation session to ask the host for parameters to format text for output

abstract FloatingPointFormat: string

/// Called by the evaluation session to ask the host for parameters to format text for output

abstract AddedPrinters: Choice<Type * (objnull -> string), Type * (objnull -> objnull)> list

/// Called by the evaluation session to ask the host for parameters to format text for output

abstract ShowDeclarationValues: bool

/// Called by the evaluation session to ask the host for parameters to format text for output

abstract ShowIEnumerable: bool

/// Called by the evaluation session to ask the host for parameters to format text for output

abstract ShowProperties: bool

/// Called by the evaluation session to ask the host for parameters to format text for output

abstract PrintSize: int

/// Called by the evaluation session to ask the host for parameters to format text for output

abstract PrintDepth: int

/// Called by the evaluation session to ask the host for parameters to format text for output

abstract PrintWidth: int

/// Called by the evaluation session to ask the host for parameters to format text for output

abstract PrintLength: int

/// The evaluation session calls this to report the preferred view of the command line arguments after

/// stripping things like "/use:file.fsx", "-r:Foo.dll" etc.

abstract ReportUserCommandLineArgs: string[] -> unit

/// The evaluation session calls this to ask the host for the special console reader.

/// Returning 'Some' indicates a console is to be used, so some special rules apply.

///

/// A "console" gets used if

/// --readline- is specified (the default on Windows + .NET); and

/// not --fsi-server (which should always be combined with --readline-); and

/// GetOptionalConsoleReadLine() returns a Some

///

/// "Peekahead" occurs if --peekahead- is not specified (i.e. it is the default):

/// - If a console is being used then

/// - a prompt is printed early

/// - a background thread is created

/// - the GetOptionalConsoleReadLine() callback is used to read the first line

/// - Otherwise call inReader.Peek()

///

/// Further lines are read as follows:

/// - If a console is being used then use GetOptionalConsoleReadLine()

/// - Otherwise use inReader.ReadLine()

abstract GetOptionalConsoleReadLine: probeToSeeIfConsoleWorks: bool -> (unit -> string) option

/// The evaluation session calls this at an appropriate point in the startup phase if the --fsi-server parameter was given

abstract StartServer: fsiServerName: string -> unit

/// Called by the evaluation session to ask the host to enter a dispatch loop like Application.Run().

/// Only called if --gui option is used (which is the default).

/// Gets called towards the end of startup and every time a ThreadAbort escaped to the backup driver loop.

/// Return true if a 'restart' is required, which is a bit meaningless.

abstract EventLoopRun: unit -> bool

/// Request that the given operation be run synchronously on the event loop.

abstract EventLoopInvoke: codeToRun: (unit -> 'T) -> 'T

/// Schedule a restart for the event loop.

abstract EventLoopScheduleRestart: unit -> unit

/// Implicitly reference FSharp.Compiler.Interactive.Settings.dll

abstract UseFsiAuxLib: bool

/// Hook for listening for evaluation bindings

member _.OnEvaluation = evaluationEvent.Publish

member internal x.TriggerEvaluation(value, symbolUse, decl) =

evaluationEvent.Trigger(EvaluationEventArgs(value, symbolUse, decl))

/// Used to print value signatures along with their values, according to the current

/// set of pretty printers installed in the system, and default printing rules.

type internal FsiValuePrinter(fsi: FsiEvaluationSessionHostConfig, outWriter: TextWriter) =

/// This printer is used by F# Interactive if no other printers apply.

let DefaultPrintingIntercept (ienv: IEnvironment) (obj: objnull) =

match obj with

| null -> None

| :? System.Collections.IDictionary as ie ->

let it = ie.GetEnumerator()

try

let itemLs =

unfoldL // the function to layout each object in the unfold

ienv.GetLayout

// the function to call at each step of the unfold

(fun () -> if it.MoveNext() then Some((it.Key, it.Value), ()) else None)

()

// the maximum length

(1 + fsi.PrintLength / 3)

let makeListL itemLs =

(leftL (TaggedText.tagText "["))

^^ sepListL (rightL (TaggedText.tagText ";")) itemLs

^^ (rightL (TaggedText.tagText "]"))

Some(wordL (TaggedText.tagText "dict") --- makeListL itemLs)

finally

match it with

| :? IDisposable as d -> d.Dispose()

| _ -> ()

| _ -> None

/// Get the print options used when formatting output using the structured printer.

member _.GetFsiPrintOptions() =

{ FormatOptions.Default with

FormatProvider = fsi.FormatProvider

PrintIntercepts =

// The fsi object supports the addition of two kinds of printers, one which converts to a string

// and one which converts to another object that is recursively formatted.

// The internal AddedPrinters reports these to FSI.EXE and we pick them up here to produce a layout

[

for x in fsi.AddedPrinters do

match x with

| Choice1Of2(aty: Type, printer) ->

yield

(fun _ienv (obj: objnull) ->

match obj with

| null -> None

| obj when aty.IsAssignableFrom(obj.GetType()) ->

let text = printer obj

match box text with

| null -> None

| _ -> Some(wordL (TaggedText.tagText text))

| _ -> None)

| Choice2Of2(aty: Type, converter) ->

yield

(fun ienv (obj: objnull) ->

match obj with

| null -> None

| obj when aty.IsAssignableFrom(obj.GetType()) ->

match converter obj with

| null -> None

| res -> Some(ienv.GetLayout res)

| _ -> None)

yield DefaultPrintingIntercept

]

FloatingPointFormat = fsi.FloatingPointFormat

PrintWidth = fsi.PrintWidth

PrintDepth = fsi.PrintDepth

PrintLength = fsi.PrintLength

PrintSize = fsi.PrintSize

ShowProperties = fsi.ShowProperties

ShowIEnumerable = fsi.ShowIEnumerable

}

/// Get the evaluation context used when inverting the storage mapping of the ILDynamicAssemblyWriter.

member _.GetEvaluationContext(emEnv: ILAssemblyEmitEnv) =

match emEnv with

| SingleRefEmitAssembly(cenv, emEnv) ->

{

LookupTypeRef = LookupTypeRef cenv emEnv

LookupType = LookupType cenv emEnv

}

| MultipleInMemoryAssemblies emEnv ->

{

LookupTypeRef = emEnv.LookupTypeRef

LookupType = emEnv.LookupType

}

/// Generate a layout for an actual F# value, where we know the value has the given static type.

member _.PrintValue(printMode, opts: FormatOptions, x: objnull, ty: Type) =

// We do a dynamic invoke of any_to_layout with the right System.Type parameter for the static type of the saved value.

// In principle this helps any_to_layout do the right thing as it descends through terms. In practice it means

// it at least does the right thing for top level 'null' list and option values (but not for nested ones).

//

// The static type was saved into the location used by RuntimeHelpers.GetSavedItType when RuntimeHelpers.SaveIt was called.

// RuntimeHelpers.SaveIt has type ('a -> unit), and fetches the System.Type for 'a by using a typeof<'a> call.

// The funny thing here is that you might think that the driver (this file) knows more about the static types

// than the compiled code does. But it doesn't! In particular, it's not that easy to get a System.Type value based on the

// static type information we do have: we have no direct way to bind a F# TAST type or even an AbstractIL type to

// a System.Type value (I guess that functionality should be in ilreflect.fs).

//

// This will be more significant when we print values other then 'it'

//

try

let anyToLayoutCall = getAnyToLayoutCall ty

match printMode with

| PrintDecl ->

// When printing rhs of fsi declarations, use "fsi_any_to_layout".

// This will suppress some less informative values, by returning an empty layout. [fix 4343].

anyToLayoutCall.FsiAnyToLayout(opts, x, ty)

| PrintExpr -> anyToLayoutCall.AnyToLayout(opts, x, ty)

with

| :? ThreadAbortException -> wordL (TaggedText.tagText "")

| e ->

#if DEBUG

printf "\n\nPrintValue: x = %+A and ty=%s\n" x ty.FullName

#endif

printf "%s" (FSIstrings.SR.fsiExceptionDuringPrettyPrinting (e.ToString()))

wordL (TaggedText.tagText "")

/// Display the signature of an F# value declaration, along with its actual value.

member valuePrinter.InvokeDeclLayout(emEnv, ilxGenerator: IlxAssemblyGenerator, v: Val) =

// Implemented via a lookup from v to a concrete (System.Object,System.Type).

// This (obj,objTy) pair can then be fed to the fsi value printer.

// Note: The value may be (null:Object).

// Note: A System.Type allows the value printer guide printing of nulls, e.g. as None or [].

//-------

// IlxGen knows what the v:Val was converted to w.r.t. AbsIL data structures.

// Ilreflect knows what the AbsIL was generated to.

// Combining these allows for obtaining the (obj,objTy) by reflection where possible.

// This assumes the v:Val was given appropriate storage, e.g. StaticField.

if fsi.ShowDeclarationValues && not v.LiteralValue.IsSome then

// Adjust "opts" for printing for "declared-values":

// - No sequences, because they may have effects or time cost.

// - No properties, since they may have unexpected effects.

// - Limit strings to roughly one line, since huge strings (e.g. 1 million chars without \n are slow in vfsi).

// - Limit PrintSize which is a count on nodes.

let declaredValueReductionFactor =

10 (* reduce PrintSize for declared values, e.g. see less of large terms *)

let opts = valuePrinter.GetFsiPrintOptions()

let opts =

{ opts with

ShowProperties = false // properties off, motivated by Form props

ShowIEnumerable = false // seq off, motivated by db query concerns

StringLimit = max 0 (opts.PrintWidth - 4) // 4 allows for an indent of 2 and 2 quotes (rough)

PrintSize = opts.PrintSize / declaredValueReductionFactor

} // print less

let res =

try

ilxGenerator.LookupGeneratedValue(valuePrinter.GetEvaluationContext emEnv, v)

with _ ->

None

match res with

| None -> None

| Some(obj, objTy) ->

let lay = valuePrinter.PrintValue(FsiValuePrinterMode.PrintDecl, opts, obj, objTy)

if isEmptyL lay then None else Some lay // suppress empty layout

else

None

/// Format a value

member valuePrinter.FormatValue(obj: obj, objTy) =

let opts = valuePrinter.GetFsiPrintOptions()

let lay = valuePrinter.PrintValue(FsiValuePrinterMode.PrintExpr, opts, obj, objTy)

Display.layout_to_string opts lay

/// Fetch the saved value of an expression out of the 'it' register and show it.

member valuePrinter.InvokeExprPrinter(denv, infoReader, emEnv, ilxGenerator: IlxAssemblyGenerator, vref: ValRef) =

let opts = valuePrinter.GetFsiPrintOptions()

let res =

ilxGenerator.LookupGeneratedValue(valuePrinter.GetEvaluationContext emEnv, vref.Deref)

let rhsL =

match res with

| None -> None

| Some(obj, objTy) ->

let lay = valuePrinter.PrintValue(FsiValuePrinterMode.PrintExpr, opts, obj, objTy)

if isEmptyL lay then None else Some lay // suppress empty layout

let denv =

{ denv with

suppressMutableKeyword = true

} // suppress 'mutable' in 'val mutable it = ...'

let denv =

{ denv with

suppressInlineKeyword = false

} // dont' suppress 'inline' in 'val inline f = ...'

let fullL =

if Option.isNone rhsL || isEmptyL rhsL.Value then

NicePrint.prettyLayoutOfValOrMemberNoInst

denv

infoReader

vref (* the rhs was suppressed by the printer, so no value to print *)

else

(NicePrint.prettyLayoutOfValOrMemberNoInst denv infoReader vref

++ wordL (TaggedText.tagText "="))

--- rhsL.Value

colorPrintL outWriter opts fullL

/// Used to make a copy of input in order to include the input when displaying the error text.

type internal FsiStdinSyphon(errorWriter: TextWriter) =

let syphonText = StringBuilder()

/// Clears the syphon text

member _.Reset() = syphonText.Clear() |> ignore

/// Adds a new line to the syphon text

member _.Add(str: string) = syphonText.Append str |> ignore

/// Gets the indicated line in the syphon text

member _.GetLine fileName i =

if fileName <> stdinMockFileName then

""

else

let text = syphonText.ToString()

// In Visual Studio, when sending a block of text, it prefixes with '# <line> "file name"\n'

// and postfixes with '# 1 "stdin"\n'. To first, get errors file name context,

// and second to get them back into stdin context (no position stack...).

// To find an error line, trim upto the last stdinReset string the syphoned text.

//printf "PrePrune:-->%s<--\n\n" text;

let rec prune (text: string) =

let stdinReset = "# 1 \"stdin\"\n"

let idx = text.IndexOf(stdinReset, StringComparison.Ordinal)

if idx <> -1 then

prune (text.Substring(idx + stdinReset.Length))

else

text

let text = prune text

let lines = text.Split '\n'

if 0 < i && i <= lines.Length then lines[i - 1] else ""

/// Display the given error.

member syphon.PrintDiagnostic(tcConfig: TcConfig, diagnostic: PhasedDiagnostic) =

ignoreAllErrors (fun () ->

let severity = FSharpDiagnosticSeverity.Error

DoWithDiagnosticColor severity (fun () ->

errorWriter.WriteLine()

diagnostic.WriteWithContext(errorWriter, " ", syphon.GetLine, tcConfig, severity)

errorWriter.WriteLine()

errorWriter.WriteLine()

errorWriter.Flush()))

/// Encapsulates functions used to write to outWriter and errorWriter

type internal FsiConsoleOutput(tcConfigB, outWriter: TextWriter, errorWriter: TextWriter) =

let nullOut = TextWriter.Null

let fprintfnn (os: TextWriter) fmt =

Printf.kfprintf

(fun _ ->

os.WriteLine()

os.WriteLine())

os

fmt

/// uprintf to write usual responses to stdout (suppressed by --quiet), with various pre/post newlines

member _.uprintf fmt =

fprintf (if tcConfigB.noFeedback then nullOut else outWriter) fmt

member _.uprintfn fmt =

fprintfn (if tcConfigB.noFeedback then nullOut else outWriter) fmt

member _.uprintfnn fmt =

fprintfnn (if tcConfigB.noFeedback then nullOut else outWriter) fmt

member out.uprintnf fmt =

out.uprintfn ""

out.uprintf fmt

member out.uprintnfn fmt =

out.uprintfn ""

out.uprintfn fmt

member out.uprintnfnn fmt =

out.uprintfn ""

out.uprintfnn fmt

/// clear screen

member _.Clear() = Console.Clear()

member _.Out = outWriter

member _.Error = errorWriter

/// This DiagnosticsLogger reports all warnings, but raises StopProcessing on first error or early exit

type internal DiagnosticsLoggerThatStopsOnFirstError

(tcConfigB: TcConfigBuilder, fsiStdinSyphon: FsiStdinSyphon, fsiConsoleOutput: FsiConsoleOutput) =

inherit DiagnosticsLogger("DiagnosticsLoggerThatStopsOnFirstError")

let mutable errorCount = 0

member _.SetError() = errorCount <- 1

member _.ResetErrorCount() = errorCount <- 0

override _.DiagnosticSink(diagnostic) =

let tcConfig = TcConfig.Create(tcConfigB, validate = false)

match diagnostic.AdjustSeverity(tcConfig.diagnosticsOptions) with

| FSharpDiagnosticSeverity.Error ->

fsiStdinSyphon.PrintDiagnostic(tcConfig, diagnostic)

errorCount <- errorCount + 1

if tcConfigB.abortOnError then

exit 1 (* non-zero exit code *)

// STOP ON FIRST ERROR (AVOIDS PARSER ERROR RECOVERY)

raise StopProcessing

| FSharpDiagnosticSeverity.Warning

| FSharpDiagnosticSeverity.Info as adjustedSeverity ->

DoWithDiagnosticColor adjustedSeverity (fun () ->

fsiConsoleOutput.Error.WriteLine()

diagnostic.WriteWithContext(fsiConsoleOutput.Error, " ", fsiStdinSyphon.GetLine, tcConfig, diagnostic.Severity)

fsiConsoleOutput.Error.WriteLine()

fsiConsoleOutput.Error.WriteLine()

fsiConsoleOutput.Error.Flush())

| FSharpDiagnosticSeverity.Hidden -> ()

override _.ErrorCount = errorCount

type DiagnosticsLogger with

/// A helper function to check if its time to abort

member x.AbortOnError(fsiConsoleOutput: FsiConsoleOutput) =

if x.ErrorCount > 0 then

fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.stoppedDueToError ())

fsiConsoleOutput.Error.Flush()

raise StopProcessing

/// Get the directory name from a string, with some defaults if it doesn't have one

let internal directoryName (s: string) =

if String.IsNullOrEmpty(s) then

"."

else

match Path.GetDirectoryName s with

| Null -> if FileSystem.IsPathRootedShim s then s else "."

| NonNull res -> if String.IsNullOrEmpty(res) then "." else res

//----------------------------------------------------------------------------

// cmd line - state for options

//----------------------------------------------------------------------------

/// Process the command line options

type internal FsiCommandLineOptions(fsi: FsiEvaluationSessionHostConfig, argv: string[], tcConfigB, fsiConsoleOutput: FsiConsoleOutput) =

let mutable enableConsoleKeyProcessing = true

let mutable gui = true // override via "--gui" on by default

#if DEBUG

let mutable showILCode = false // show modul il code

#endif

let mutable showTypes = true // show types after each interaction?

let mutable fsiServerName = ""

let mutable interact = true

let mutable explicitArgs = []

let mutable writeReferencesAndExit = None

let mutable inputFilesAcc = []

let mutable fsiServerInputCodePage = None

let mutable fsiServerOutputCodePage = None

let mutable fsiLCID = None

// internal options

let mutable probeToSeeIfConsoleWorks = true

let mutable peekAheadOnConsoleToPermitTyping = true

let isInteractiveServer () = fsiServerName <> ""

let recordExplicitArg arg = explicitArgs <- explicitArgs @ [ arg ]

let executableFileNameWithoutExtension =

lazy

let getFsiCommandLine () =

let fileNameWithoutExtension (path: string | null) = Path.GetFileNameWithoutExtension(path)

let currentProcess = Process.GetCurrentProcess()

let mainModule = currentProcess.MainModule

let processFileName =

match mainModule with

| null -> null

| m -> fileNameWithoutExtension m.FileName

let commandLineExecutableFileName =

try

fileNameWithoutExtension (Environment.GetCommandLineArgs().[0])

with _ ->

""

let stringComparison =

match Environment.OSVersion.Platform with

| PlatformID.MacOSX

| PlatformID.Unix -> StringComparison.Ordinal

| _ -> StringComparison.OrdinalIgnoreCase

if String.Compare(processFileName, commandLineExecutableFileName, stringComparison) = 0 then

!!processFileName