csharpfftfsharpintegrationinterpolationlinear-algebramathdifferentiationmatrixnumericsrandomregressionstatisticsmathnet
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
1069 lines
52 KiB
1069 lines
52 KiB
//=========================================================================
|
|
// (c) Microsoft Corporation 2005-2009.
|
|
//=========================================================================
|
|
|
|
// This file is compiled 4(!) times in the codebase
|
|
// - as the internal implementation of printf '%A' formatting
|
|
// defines: RUNTIME
|
|
// - as the internal implementation of structured formatting in the FSharp.Compiler-proto.dll
|
|
// defines: INTERNALIZED_POWER_PACK + BUILDING_WITH_LKG
|
|
// - as the internal implementation of structured formatting in FSharp.Compiler.dll
|
|
// defines: INTERNALIZED_POWER_PACK
|
|
// NOTE: this implementation is used by fsi.exe. This is very important.
|
|
// - as the public implementation of structured formatting in the FSharp.PowerPack.dll
|
|
// defines: <none>
|
|
//
|
|
// The one implementation file is used because we very much want to keep the implementations of
|
|
// structured formatting the same for fsi.exe and '%A' printing. However fsi.exe may have
|
|
// a richer feature set.
|
|
//
|
|
// Note no layout objects are ever transferred between the above implementations, and in
|
|
// all 4 cases the layout types are really different types.
|
|
|
|
#nowarn "52" // The value has been copied to ensure the original is not mutated by this operation
|
|
|
|
#if INTERNALIZED_POWER_PACK
|
|
// FSharp.Compiler-proto.dll:
|
|
// FSharp.Compiler.dll:
|
|
namespace Internal.Utilities.StructuredFormat
|
|
#else
|
|
#if RUNTIME
|
|
// FSharp.Core.dll:
|
|
namespace Microsoft.FSharp.Text.StructuredPrintfImpl
|
|
#else
|
|
// Powerpack:
|
|
namespace Microsoft.FSharp.Text.StructuredFormat
|
|
#endif
|
|
#endif
|
|
|
|
// Breakable block layout implementation.
|
|
// This is a fresh implementation of pre-existing ideas.
|
|
|
|
open System
|
|
open System.Diagnostics
|
|
open System.Text
|
|
open System.IO
|
|
open System.Reflection
|
|
open System.Globalization
|
|
open System.Collections.Generic
|
|
open Microsoft.FSharp.Core
|
|
open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators
|
|
open Microsoft.FSharp.Core.Operators
|
|
open Microsoft.FSharp.Reflection
|
|
open Microsoft.FSharp.Collections
|
|
open Microsoft.FSharp.Primitives.Basics
|
|
|
|
/// A joint, between 2 layouts, is either:
|
|
/// - unbreakable, or
|
|
/// - breakable, and if broken the second block has a given indentation.
|
|
type Joint =
|
|
| Unbreakable
|
|
| Breakable of int
|
|
| Broken of int
|
|
|
|
/// Leaf juxt,data,juxt
|
|
/// Node juxt,left,juxt,right,juxt and joint
|
|
///
|
|
/// If either juxt flag is true, then no space between words.
|
|
[<StructuralEquality(false);StructuralComparison(false)>]
|
|
type Layout =
|
|
| Leaf of bool * obj * bool
|
|
| Node of bool * layout * bool * layout * bool * joint
|
|
| Attr of string * (string * string) list * layout
|
|
|
|
and layout = Layout
|
|
and joint = Joint
|
|
|
|
type IEnvironment =
|
|
abstract GetLayout : obj -> layout
|
|
abstract MaxColumns : int
|
|
abstract MaxRows : int
|
|
|
|
module LayoutOps =
|
|
let rec juxtLeft = function
|
|
| Leaf (jl,text,jr) -> jl
|
|
| Node (jl,l,jm,r,jr,joint) -> jl
|
|
| Attr (tag,attrs,l) -> juxtLeft l
|
|
|
|
let rec juxtRight = function
|
|
| Leaf (jl,text,jr) -> jr
|
|
| Node (jl,l,jm,r,jr,joint) -> jr
|
|
| Attr (tag,attrs,l) -> juxtRight l
|
|
|
|
let mkNode l r joint =
|
|
let jl = juxtLeft l
|
|
let jm = juxtRight l || juxtLeft r
|
|
let jr = juxtRight r
|
|
Node(jl,l,jm,r,jr,joint)
|
|
|
|
|
|
// constructors
|
|
|
|
|
|
let objL (obj:obj) = Leaf (false,obj,false)
|
|
let sLeaf (l,(str:string),r) = Leaf (l,(str:>obj),r)
|
|
let wordL str = sLeaf (false,str,false)
|
|
let sepL str = sLeaf (true ,str,true)
|
|
let rightL str = sLeaf (true ,str,false)
|
|
let leftL str = sLeaf (false,str,true)
|
|
let emptyL = sLeaf (true,"",true)
|
|
let isEmptyL = function
|
|
| Leaf(true,s,true) ->
|
|
match s with
|
|
| :? string as s -> s = ""
|
|
| _ -> false
|
|
| _ -> false
|
|
|
|
|
|
let aboveL l r = mkNode l r (Broken 0)
|
|
|
|
let joinN i l r = mkNode l r (Breakable i)
|
|
let join = joinN 0
|
|
let join1 = joinN 1
|
|
let join2 = joinN 2
|
|
let join3 = joinN 3
|
|
|
|
let tagAttrL tag attrs l = Attr(tag,attrs,l)
|
|
|
|
let apply2 f l r = if isEmptyL l then r else
|
|
if isEmptyL r then l else f l r
|
|
|
|
let ($$) l r = mkNode l r (Unbreakable)
|
|
let (++) l r = mkNode l r (Breakable 0)
|
|
let (--) l r = mkNode l r (Breakable 1)
|
|
let (---) l r = mkNode l r (Breakable 2)
|
|
let (@@) l r = apply2 (fun l r -> mkNode l r (Broken 0)) l r
|
|
let (@@-) l r = apply2 (fun l r -> mkNode l r (Broken 1)) l r
|
|
let (@@--) l r = apply2 (fun l r -> mkNode l r (Broken 2)) l r
|
|
let tagListL tagger = function
|
|
| [] -> emptyL
|
|
| [x] -> x
|
|
| x::xs ->
|
|
let rec process' prefixL = function
|
|
[] -> prefixL
|
|
| y::ys -> process' ((tagger prefixL) ++ y) ys
|
|
in process' x xs
|
|
|
|
let commaListL x = tagListL (fun prefixL -> prefixL $$ rightL ",") x
|
|
let semiListL x = tagListL (fun prefixL -> prefixL $$ rightL ";") x
|
|
let spaceListL x = tagListL (fun prefixL -> prefixL) x
|
|
let sepListL x y = tagListL (fun prefixL -> prefixL $$ x) y
|
|
let bracketL l = leftL "(" $$ l $$ rightL ")"
|
|
let tupleL xs = bracketL (sepListL (sepL ",") xs)
|
|
let aboveListL = function
|
|
| [] -> emptyL
|
|
| [x] -> x
|
|
| x::ys -> List.fold (fun pre y -> pre @@ y) x ys
|
|
|
|
let optionL xL = function
|
|
None -> wordL "None"
|
|
| Some x -> wordL "Some" -- (xL x)
|
|
|
|
let listL xL xs = leftL "[" $$ sepListL (sepL ";") (List.map xL xs) $$ rightL "]"
|
|
|
|
let squareBracketL x = leftL "[" $$ x $$ rightL "]"
|
|
|
|
let braceL x = leftL "{" $$ x $$ rightL "}"
|
|
|
|
let boundedUnfoldL
|
|
(itemL : 'a -> layout)
|
|
(project : 'z -> ('a * 'z) option)
|
|
(stopShort : 'z -> bool)
|
|
(z : 'z)
|
|
maxLength =
|
|
let rec consume n z =
|
|
if stopShort z then [wordL "..."] else
|
|
match project z with
|
|
| None -> [] (* exhaused input *)
|
|
| Some (x,z) -> if n<=0 then [wordL "..."] (* hit print_length limit *)
|
|
else itemL x :: consume (n-1) z (* cons recursive... *)
|
|
consume maxLength z
|
|
|
|
let unfoldL itemL project z maxLength = boundedUnfoldL itemL project (fun _ -> false) z maxLength
|
|
|
|
/// These are a typical set of options used to control structured formatting.
|
|
[<StructuralEquality(false);StructuralComparison(false)>]
|
|
type FormatOptions =
|
|
{ FloatingPointFormat: string;
|
|
AttributeProcessor: (string -> (string * string) list -> bool -> unit);
|
|
#if RUNTIME
|
|
#else
|
|
#if INTERNALIZED_POWER_PACK // FSharp.Compiler.dll: This is the PrintIntercepts extensibility point currently revealed by fsi.exe's AddPrinter
|
|
PrintIntercepts: (IEnvironment -> obj -> Layout option) list;
|
|
StringLimit : int;
|
|
#endif
|
|
#endif
|
|
FormatProvider: System.IFormatProvider;
|
|
BindingFlags: System.Reflection.BindingFlags
|
|
PrintWidth : int;
|
|
PrintDepth : int;
|
|
PrintLength : int;
|
|
PrintSize : int;
|
|
ShowProperties : bool;
|
|
ShowIEnumerable: bool; }
|
|
static member Default =
|
|
{ FormatProvider = (System.Globalization.CultureInfo.InvariantCulture :> System.IFormatProvider);
|
|
#if RUNTIME
|
|
#else
|
|
#if INTERNALIZED_POWER_PACK // FSharp.Compiler.dll: This is the PrintIntercepts extensibility point currently revealed by fsi.exe's AddPrinter
|
|
PrintIntercepts = [];
|
|
StringLimit = System.Int32.MaxValue;
|
|
#endif
|
|
#endif
|
|
AttributeProcessor= (fun _ _ _ -> ());
|
|
BindingFlags = System.Reflection.BindingFlags.Public;
|
|
FloatingPointFormat = "g10";
|
|
PrintWidth = 80 ;
|
|
PrintDepth = 100 ;
|
|
PrintLength = 100;
|
|
PrintSize = 10000;
|
|
ShowProperties = false;
|
|
ShowIEnumerable = true; }
|
|
|
|
|
|
|
|
module ReflectUtils =
|
|
open System
|
|
open System.Reflection
|
|
|
|
type TypeInfo =
|
|
| TupleType of Type list
|
|
| FunctionType of Type * Type
|
|
| RecordType of (string * Type) list
|
|
| SumType of (string * (string * Type) list) list
|
|
| UnitType
|
|
| ObjectType of Type
|
|
|
|
|
|
let isNamedType(typ:Type) = not (typ.IsArray || typ.IsByRef || typ.IsPointer)
|
|
let equivHeadTypes (ty1:Type) (ty2:Type) =
|
|
isNamedType(ty1) &&
|
|
if ty1.IsGenericType then
|
|
ty2.IsGenericType && (ty1.GetGenericTypeDefinition()).Equals(ty2.GetGenericTypeDefinition())
|
|
else
|
|
ty1.Equals(ty2)
|
|
|
|
let option = typedefof<obj option>
|
|
let func = typedefof<(obj -> obj)>
|
|
|
|
let isOptionType typ = equivHeadTypes typ (typeof<int option>)
|
|
let isUnitType typ = equivHeadTypes typ (typeof<unit>)
|
|
let isListType typ =
|
|
FSharpType.IsUnion typ &&
|
|
(let cases = FSharpType.GetUnionCases typ
|
|
cases.Length > 0 && equivHeadTypes (typedefof<list<_>>) cases.[0].DeclaringType)
|
|
|
|
module Type =
|
|
|
|
let recdDescOfProps props =
|
|
props |> Array.to_list |> List.map (fun (p:PropertyInfo) -> p.Name, p.PropertyType)
|
|
|
|
let getTypeInfoOfType (bindingFlags:BindingFlags) (typ:Type) =
|
|
if FSharpType.IsTuple(typ) then TypeInfo.TupleType (FSharpType.GetTupleElements(typ) |> Array.to_list)
|
|
elif FSharpType.IsFunction(typ) then let ty1,ty2 = FSharpType.GetFunctionElements typ in TypeInfo.FunctionType( ty1,ty2)
|
|
elif FSharpType.IsUnion(typ,bindingFlags) then
|
|
let cases = FSharpType.GetUnionCases(typ,bindingFlags)
|
|
match cases with
|
|
| [| |] -> TypeInfo.ObjectType(typ)
|
|
| _ ->
|
|
TypeInfo.SumType(cases |> Array.to_list |> List.map (fun case ->
|
|
let flds = case.GetFields()
|
|
case.Name,recdDescOfProps(flds)))
|
|
elif FSharpType.IsRecord(typ,bindingFlags) then
|
|
let flds = FSharpType.GetRecordFields(typ,bindingFlags)
|
|
TypeInfo.RecordType(recdDescOfProps(flds))
|
|
else
|
|
TypeInfo.ObjectType(typ)
|
|
|
|
let IsOptionType (typ:Type) = isOptionType typ
|
|
let IsListType (typ:Type) = isListType typ
|
|
let IsUnitType (typ:Type) = isUnitType typ
|
|
|
|
type ValueInfo =
|
|
| TupleValue of obj list
|
|
| FunctionClosureValue of System.Type * obj
|
|
| RecordValue of (string * obj) list
|
|
| ConstructorValue of string * (string * obj) list
|
|
| ExceptionValue of System.Type * (string * obj) list
|
|
| UnitValue
|
|
| ObjectValue of obj
|
|
|
|
module Value =
|
|
|
|
// Analyze an object to see if it the representation
|
|
// of an F# value.
|
|
let GetValueInfoOfObject (bindingFlags:BindingFlags) (obj : obj) =
|
|
match obj with
|
|
| null -> ObjectValue(obj)
|
|
| _ ->
|
|
let reprty = obj.GetType()
|
|
|
|
// First a bunch of special rules for tuples
|
|
// Because of the way F# currently compiles tuple values
|
|
// of size > 7 we can only reliably reflect on sizes up
|
|
// to 7.
|
|
|
|
if FSharpType.IsTuple reprty then
|
|
TupleValue (FSharpValue.GetTupleFields obj |> Array.to_list)
|
|
elif FSharpType.IsFunction reprty then
|
|
FunctionClosureValue(reprty,obj)
|
|
|
|
// It must be exception, abstract, record or union.
|
|
// Either way we assume the only properties defined on
|
|
// the type are the actual fields of the type. Again,
|
|
// we should be reading attributes here that indicate the
|
|
// true structure of the type, e.g. the order of the fields.
|
|
elif FSharpType.IsUnion(reprty,bindingFlags) then
|
|
let tag,vals = FSharpValue.GetUnionFields (obj,reprty,bindingFlags)
|
|
let props = tag.GetFields()
|
|
let pvals = (props,vals) ||> Array.map2 (fun prop v -> prop.Name,v)
|
|
ConstructorValue(tag.Name, Array.to_list pvals)
|
|
|
|
elif FSharpType.IsExceptionRepresentation(reprty,bindingFlags) then
|
|
let props = FSharpType.GetExceptionFields(reprty,bindingFlags)
|
|
let vals = FSharpValue.GetExceptionFields(obj,bindingFlags)
|
|
let pvals = (props,vals) ||> Array.map2 (fun prop v -> prop.Name,v)
|
|
ExceptionValue(reprty, pvals |> Array.to_list)
|
|
|
|
elif FSharpType.IsRecord(reprty,bindingFlags) then
|
|
let props = FSharpType.GetRecordFields(reprty,bindingFlags)
|
|
RecordValue(props |> Array.map (fun prop -> prop.Name, prop.GetValue(obj,null)) |> Array.to_list)
|
|
else
|
|
ObjectValue(obj)
|
|
|
|
// This one is like the above but can make use of additional
|
|
// statically-known type information to aid in the
|
|
// analysis of null values.
|
|
|
|
let GetValueInfo bindingFlags (x : 'a) (* x could be null *) =
|
|
let obj = (box x)
|
|
match obj with
|
|
| null ->
|
|
let typ = typeof<'a>
|
|
if isOptionType typ then ConstructorValue("None", [])
|
|
elif isUnitType typ then UnitValue
|
|
else ObjectValue(obj)
|
|
| _ ->
|
|
GetValueInfoOfObject bindingFlags (obj)
|
|
|
|
|
|
let GetInfo bindingFlags (v:'a) = GetValueInfo bindingFlags (v:'a)
|
|
|
|
module Display =
|
|
|
|
open ReflectUtils
|
|
open LayoutOps
|
|
let string_of_int (i:int) = i.ToString()
|
|
|
|
let typeUsesSystemObjectToString (typ:System.Type) =
|
|
try let methInfo = typ.GetMethod("ToString",BindingFlags.Public ||| BindingFlags.Instance,null,[| |],null)
|
|
methInfo.DeclaringType = typeof<System.Object>
|
|
with e -> false
|
|
|
|
/// If "str" ends with "ending" then remove it from "str", otherwise no change.
|
|
let trimEnding (ending:string) (str:string) =
|
|
#if FX_NO_CULTURE_INFO_ARGS
|
|
if str.EndsWith(ending) then
|
|
#else
|
|
if str.EndsWith(ending,false,CultureInfo.InvariantCulture) then
|
|
#endif
|
|
str.Substring(0,str.Length - ending.Length)
|
|
else str
|
|
|
|
let catchExn f = try Choice1Of2 (f ()) with e -> Choice2Of2 e
|
|
|
|
// An implementation of break stack.
|
|
// Uses mutable state, relying on linear threading of the state.
|
|
|
|
type breaks =
|
|
Breaks of
|
|
int * // pos of next free slot
|
|
int * // pos of next possible "outer" break - OR - outer=next if none possible
|
|
int array // stack of savings, -ve means it has been broken
|
|
|
|
// next is next slot to push into - aka size of current occupied stack.
|
|
// outer counts up from 0, and is next slot to break if break forced.
|
|
// - if all breaks forced, then outer=next.
|
|
// - popping under these conditions needs to reduce outer and next.
|
|
|
|
|
|
//let dumpBreaks prefix (Breaks(next,outer,stack)) = ()
|
|
// printf "%s: next=%d outer=%d stack.Length=%d\n" prefix next outer stack.Length;
|
|
// stdout.Flush()
|
|
|
|
let chunkN = 400
|
|
let breaks0 () = Breaks(0,0,Array.create chunkN 0)
|
|
|
|
let pushBreak saving (Breaks(next,outer,stack)) =
|
|
//dumpBreaks "pushBreak" (next,outer,stack);
|
|
let stack =
|
|
if next = stack.Length then
|
|
Array.init (next + chunkN) (fun i -> if i < next then stack.[i] else 0) // expand if full
|
|
else
|
|
stack
|
|
|
|
stack.[next] <- saving;
|
|
Breaks(next+1,outer,stack)
|
|
|
|
let popBreak (Breaks(next,outer,stack)) =
|
|
//dumpBreaks "popBreak" (next,outer,stack);
|
|
if next=0 then raise (Failure "popBreak: underflow");
|
|
let topBroke = stack.[next-1] < 0
|
|
let outer = if outer=next then outer-1 else outer // if all broken, unwind
|
|
let next = next - 1
|
|
Breaks(next,outer,stack),topBroke
|
|
|
|
let forceBreak (Breaks(next,outer,stack)) =
|
|
//dumpBreaks "forceBreak" (next,outer,stack);
|
|
if outer=next then
|
|
// all broken
|
|
None
|
|
else
|
|
let saving = stack.[outer]
|
|
stack.[outer] <- -stack.[outer];
|
|
let outer = outer+1
|
|
Some (Breaks(next,outer,stack),saving)
|
|
|
|
// -------------------------------------------------------------------------
|
|
// fitting
|
|
// ------------------------------------------------------------------------
|
|
|
|
let squashTo (maxWidth,leafFormatter) layout =
|
|
if maxWidth <= 0 then layout else
|
|
let rec fit breaks (pos,layout) =
|
|
// breaks = break context, can force to get indentation savings.
|
|
// pos = current position in line
|
|
// layout = to fit
|
|
//------
|
|
// returns:
|
|
// breaks
|
|
// layout - with breaks put in to fit it.
|
|
// pos - current pos in line = rightmost position of last line of block.
|
|
// offset - width of last line of block
|
|
// NOTE: offset <= pos -- depending on tabbing of last block
|
|
|
|
let breaks,layout,pos,offset =
|
|
match layout with
|
|
| Attr (tag,attrs,l) ->
|
|
let breaks,layout,pos,offset = fit breaks (pos,l)
|
|
let layout = Attr (tag,attrs,layout)
|
|
breaks,layout,pos,offset
|
|
| Leaf (jl,obj,jr) ->
|
|
let text:string = leafFormatter obj
|
|
// save the formatted text from the squash
|
|
let layout = Leaf(jl,(text :> obj),jr)
|
|
let textWidth = text.Length
|
|
let rec fitLeaf breaks pos =
|
|
if pos + textWidth <= maxWidth then
|
|
breaks,layout,pos + textWidth,textWidth // great, it fits
|
|
else
|
|
match forceBreak breaks with
|
|
| None ->
|
|
breaks,layout,pos + textWidth,textWidth // tough, no more breaks
|
|
| Some (breaks,saving) ->
|
|
let pos = pos - saving
|
|
fitLeaf breaks pos
|
|
|
|
fitLeaf breaks pos
|
|
| Node (jl,l,jm,r,jr,joint) ->
|
|
let mid = if jm then 0 else 1
|
|
match joint with
|
|
| Unbreakable ->
|
|
let breaks,l,pos,offsetl = fit breaks (pos,l) // fit left
|
|
let pos = pos + mid // fit space if juxt says so
|
|
let breaks,r,pos,offsetr = fit breaks (pos,r) // fit right
|
|
breaks,Node (jl,l,jm,r,jr,Unbreakable),pos,offsetl + mid + offsetr
|
|
| Broken indent ->
|
|
let breaks,l,pos,offsetl = fit breaks (pos,l) // fit left
|
|
let pos = pos - offsetl + indent // broken so - offset left + ident
|
|
let breaks,r,pos,offsetr = fit breaks (pos,r) // fit right
|
|
breaks,Node (jl,l,jm,r,jr,Broken indent),pos,indent + offsetr
|
|
| Breakable indent ->
|
|
let breaks,l,pos,offsetl = fit breaks (pos,l) // fit left
|
|
// have a break possibility, with saving
|
|
let saving = offsetl + mid - indent
|
|
let pos = pos + mid
|
|
if saving>0 then
|
|
let breaks = pushBreak saving breaks
|
|
let breaks,r,pos,offsetr = fit breaks (pos,r)
|
|
let breaks,broken = popBreak breaks
|
|
if broken then
|
|
breaks,Node (jl,l,jm,r,jr,Broken indent) ,pos,indent + offsetr
|
|
else
|
|
breaks,Node (jl,l,jm,r,jr,Breakable indent),pos,offsetl + mid + offsetr
|
|
else
|
|
// actually no saving so no break
|
|
let breaks,r,pos,offsetr = fit breaks (pos,r)
|
|
breaks,Node (jl,l,jm,r,jr,Breakable indent) ,pos,offsetl + mid + offsetr
|
|
|
|
//Printf.printf "\nDone: pos=%d offset=%d" pos offset;
|
|
breaks,layout,pos,offset
|
|
|
|
let breaks = breaks0 ()
|
|
let pos = 0
|
|
let breaks,layout,pos,offset = fit breaks (pos,layout)
|
|
layout
|
|
|
|
// -------------------------------------------------------------------------
|
|
// showL
|
|
// ------------------------------------------------------------------------
|
|
|
|
let combine strs = System.String.Concat(Array.of_list(strs) : string[])
|
|
let showL opts leafFormatter layout =
|
|
let push x rstrs = x::rstrs
|
|
let z0 = [],0
|
|
let addText (rstrs,i) (text:string) = push text rstrs,i + text.Length
|
|
let index (rstrs,i) = i
|
|
let extract rstrs = combine(List.rev rstrs)
|
|
let newLine (rstrs,i) n = // \n then spaces...
|
|
let indent = new System.String(' ', n)
|
|
let rstrs = push "\n" rstrs
|
|
let rstrs = push indent rstrs
|
|
rstrs,n
|
|
|
|
// addL: pos is tab level
|
|
let rec addL z pos layout =
|
|
match layout with
|
|
| Leaf (jl,obj,jr) ->
|
|
let text = leafFormatter obj
|
|
addText z text
|
|
| Node (jl,l,jm,r,jr,Broken indent)
|
|
// Print width = 0 implies 1D layout, no squash
|
|
when not (opts.PrintWidth = 0) ->
|
|
let z = addL z pos l
|
|
let z = newLine z (pos+indent)
|
|
let z = addL z (pos+indent) r
|
|
z
|
|
| Node (jl,l,jm,r,jr,_) ->
|
|
let z = addL z pos l
|
|
let z = if jm then z else addText z " "
|
|
let pos = index z
|
|
let z = addL z pos r
|
|
z
|
|
| Attr (tag,attrs,l) ->
|
|
addL z pos l
|
|
|
|
let rstrs,i = addL z0 0 layout
|
|
extract rstrs
|
|
|
|
|
|
// -------------------------------------------------------------------------
|
|
// outL
|
|
// ------------------------------------------------------------------------
|
|
|
|
let outL outAttribute leafFormatter (chan : TextWriter) layout =
|
|
// write layout to output chan directly
|
|
let write (s:string) = chan.Write(s)
|
|
// z is just current indent
|
|
let z0 = 0
|
|
let index i = i
|
|
let addText z text = write text; (z + text.Length)
|
|
let newLine z n = // \n then spaces...
|
|
let indent = new System.String(' ',n)
|
|
chan.WriteLine();
|
|
write indent;
|
|
n
|
|
|
|
// addL: pos is tab level
|
|
let rec addL z pos layout =
|
|
match layout with
|
|
| Leaf (jl,obj,jr) ->
|
|
let text = leafFormatter obj
|
|
addText z text
|
|
| Node (jl,l,jm,r,jr,Broken indent) ->
|
|
let z = addL z pos l
|
|
let z = newLine z (pos+indent)
|
|
let z = addL z (pos+indent) r
|
|
z
|
|
| Node (jl,l,jm,r,jr,_) ->
|
|
let z = addL z pos l
|
|
let z = if jm then z else addText z " "
|
|
let pos = index z
|
|
let z = addL z pos r
|
|
z
|
|
| Attr (tag,attrs,l) ->
|
|
let _ = outAttribute tag attrs true
|
|
let z = addL z pos l
|
|
let _ = outAttribute tag attrs false
|
|
z
|
|
|
|
let i = addL z0 0 layout
|
|
()
|
|
|
|
// --------------------------------------------------------------------
|
|
// pprinter: using general-purpose reflection...
|
|
// --------------------------------------------------------------------
|
|
|
|
let getValueInfo bindingFlags (x:'a) = Value.GetInfo bindingFlags (x:'a)
|
|
|
|
let unpackCons recd =
|
|
match recd with
|
|
| [(_,h);(_,t)] -> (h,t)
|
|
| _ -> failwith "unpackCons"
|
|
|
|
let getListValueInfo bindingFlags (x:obj) =
|
|
match x with
|
|
| null -> None
|
|
| _ ->
|
|
match getValueInfo bindingFlags x with
|
|
| ConstructorValue ("Cons",recd) -> Some (unpackCons recd)
|
|
| ConstructorValue ("Empty",[]) -> None
|
|
| _ -> failwith "List value had unexpected ValueInfo"
|
|
|
|
let compactCommaListL xs = sepListL (sepL ",") xs // compact, no spaces around ","
|
|
let nullL = wordL "null"
|
|
let measureL = wordL "()"
|
|
|
|
// --------------------------------------------------------------------
|
|
// pprinter: attributes
|
|
// --------------------------------------------------------------------
|
|
|
|
let makeRecordVerticalL nameXs =
|
|
let itemL (name,xL) = let labelL = wordL name in ((labelL $$ wordL "=")) -- (xL $$ (rightL ";"))
|
|
let braceL xs = (leftL "{") $$ xs $$ (rightL "}")
|
|
braceL (aboveListL (List.map itemL nameXs))
|
|
|
|
let makeRecordHorizontalL nameXs = (* This is a more compact rendering of records - and is more like tuples *)
|
|
let itemL (name,xL) = let labelL = wordL name in ((labelL $$ wordL "=")) -- xL
|
|
let braceL xs = (leftL "{") $$ xs $$ (rightL "}")
|
|
braceL (sepListL (rightL ";") (List.map itemL nameXs))
|
|
|
|
let makeRecordL nameXs = makeRecordVerticalL nameXs (* REVIEW: switch to makeRecordHorizontalL ? *)
|
|
|
|
let makePropertiesL nameXs =
|
|
let itemL (name,v) =
|
|
let labelL = wordL name
|
|
(labelL $$ wordL "=")
|
|
$$ (match v with
|
|
| None -> wordL "?"
|
|
| Some xL -> xL)
|
|
$$ (rightL ";")
|
|
let braceL xs = (leftL "{") $$ xs $$ (rightL "}")
|
|
braceL (aboveListL (List.map itemL nameXs))
|
|
|
|
let makeListL itemLs =
|
|
(leftL "[") $$
|
|
sepListL (rightL ";") itemLs $$
|
|
(rightL "]")
|
|
|
|
let makeArrayL xs =
|
|
(leftL "[|") $$
|
|
sepListL (rightL ";") xs $$
|
|
(rightL "|]")
|
|
|
|
let makeArray2L xs = leftL "[" $$ aboveListL xs $$ rightL "]"
|
|
|
|
// --------------------------------------------------------------------
|
|
// pprinter: anyL - support functions
|
|
// --------------------------------------------------------------------
|
|
|
|
let getProperty (obj: obj) name =
|
|
let ty = obj.GetType()
|
|
#if FX_NO_CULTURE_INFO_ARGS
|
|
ty.InvokeMember(name, (BindingFlags.GetProperty ||| BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic), null, obj, Array.of_list [ ])
|
|
#else
|
|
ty.InvokeMember(name, (BindingFlags.GetProperty ||| BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic), null, obj, Array.of_list [ ],CultureInfo.InvariantCulture)
|
|
#endif
|
|
|
|
let formatChar isChar c =
|
|
match c with
|
|
| '\'' when isChar -> "\\\'"
|
|
| '\"' when not isChar -> "\\\""
|
|
//| '\n' -> "\\n"
|
|
//| '\r' -> "\\r"
|
|
//| '\t' -> "\\t"
|
|
| '\\' -> "\\\\"
|
|
| '\b' -> "\\b"
|
|
| _ when System.Char.IsControl(c) ->
|
|
let d1 = (int c / 100) % 10
|
|
let d2 = (int c / 10) % 10
|
|
let d3 = int c % 10
|
|
"\\" + d1.ToString() + d2.ToString() + d3.ToString()
|
|
| _ -> c.ToString()
|
|
|
|
let formatString (s:string) =
|
|
let rec check i = i < s.Length && not (System.Char.IsControl(s,i)) && s.[i] <> '\"' && check (i+1)
|
|
let rec conv i acc = if i = s.Length then combine (List.rev acc) else conv (i+1) (formatChar false s.[i] :: acc)
|
|
"\"" + s + "\""
|
|
// REVIEW: should we check for the common case of no control characters? Reinstate the following?
|
|
//"\"" + (if check 0 then s else conv 0 []) + "\""
|
|
|
|
let formatStringInWidth (width:int) (str:string) =
|
|
// Return a truncated version of the string, e.g.
|
|
// "This is the initial text, which has been truncat"+[12 chars]
|
|
//
|
|
// Note: The layout code forces breaks based on leaf size and possible break points.
|
|
// It does not force leaf size based on width.
|
|
// So long leaf-string width can not depend on their printing context...
|
|
//
|
|
// The suffix like "+[dd chars]" is 11 chars.
|
|
// 12345678901
|
|
let suffixLength = 11 // turning point suffix length
|
|
let prefixMinLength = 12 // arbitrary. If print width is reduced, want to print a minimum of information on strings...
|
|
let prefixLength = max (width - 2 (*quotes*) - suffixLength) prefixMinLength
|
|
"\"" ^ (str.Substring(0,prefixLength)) ^ "\"" ^ "+[" ^ (str.Length - prefixLength).ToString() ^ " chars]"
|
|
|
|
// --------------------------------------------------------------------
|
|
// pprinter: anyL
|
|
// --------------------------------------------------------------------
|
|
|
|
type Precedence =
|
|
| BracketIfTupleOrNotAtomic = 2
|
|
| BracketIfTuple = 3
|
|
| NeverBracket = 4
|
|
|
|
// In fsi.exe, certain objects are not printed for top-level bindings.
|
|
type ShowMode = ShowAll | ShowTopLevelBinding
|
|
|
|
// polymorphic and inner recursion limitations prevent us defining polyL in the recursive loop
|
|
let polyL bindingFlags (objL: ShowMode -> int -> Precedence -> ValueInfo -> obj -> Layout) showMode i prec (x:'a) (* x could be null *) =
|
|
objL showMode i prec (getValueInfo bindingFlags (x:'a)) (box x)
|
|
|
|
let anyL showMode bindingFlags (opts:FormatOptions) (x:'a) =
|
|
// showMode = ShowTopLevelBinding on the outermost expression when called from fsi.exe,
|
|
// This allows certain outputs, e.g. objects that would print as <seq> to be suppressed, etc. See 4343.
|
|
// Calls to layout proper sub-objects should pass showMode = ShowAll.
|
|
|
|
// Precedences to ensure we add brackets in the right places
|
|
|
|
// Keep a record of objects encountered along the way
|
|
let path = Dictionary<obj,int>(10,HashIdentity.Reference)
|
|
|
|
// Roughly count the "nodes" printed, e.g. leaf items and inner nodes, but not every bracket and comma.
|
|
let size = ref opts.PrintSize
|
|
let exceededPrintSize() = !size<=0
|
|
let countNodes n = if !size > 0 then size := !size - n else () (* no need to keep decrementing (and avoid wrap around) *)
|
|
let stopShort _ = exceededPrintSize() // for unfoldL
|
|
|
|
// Recursive descent
|
|
let rec objL depthLim prec (x:obj) = polyL bindingFlags objWithReprL ShowAll depthLim prec x (* showMode for inner expr *)
|
|
and sameObjL depthLim prec (x:obj) = polyL bindingFlags objWithReprL showMode depthLim prec x (* showMode preserved *)
|
|
|
|
and objWithReprL showMode depthLim prec (info:ValueInfo) (x:obj) (* x could be null *) =
|
|
let showModeFilter lay = match showMode with ShowAll -> lay | ShowTopLevelBinding -> emptyL
|
|
try
|
|
if depthLim<=0 || exceededPrintSize() then wordL "..." else
|
|
match x with
|
|
| null ->
|
|
reprL showMode (depthLim-1) prec info x
|
|
| _ ->
|
|
if (path.ContainsKey(x)) then
|
|
wordL "..."
|
|
else
|
|
path.Add(x,0);
|
|
let res =
|
|
|
|
// Try the extensibility attribute
|
|
match x.GetType().GetCustomAttributes (typeof<StructuredFormatDisplayAttribute>, true) with
|
|
| null | [| |] -> None
|
|
| res ->
|
|
let attr = (res.[0] :?> StructuredFormatDisplayAttribute)
|
|
let txt = attr.Value
|
|
if txt = null || txt.Length <= 1 then
|
|
None
|
|
else
|
|
let p1 = txt.IndexOf "{"
|
|
let p2 = txt.LastIndexOf "}"
|
|
if p1 < 0 || p2 < 0 || p1+1 >= p2 then
|
|
None
|
|
else
|
|
let preText = if p1 <= 0 then "" else txt.[0..p1-1]
|
|
let postText = if p2+1 >= txt.Length then "" else txt.[p2+1..]
|
|
let prop = txt.[p1+1..p2-1]
|
|
match catchExn (fun () -> getProperty x prop) with
|
|
| Choice2Of2 e -> Some (wordL ("<StructuredFormatDisplay exception: " + e.Message + ">"))
|
|
| Choice1Of2 alternativeObj ->
|
|
try
|
|
let alternativeObjL =
|
|
match alternativeObj with
|
|
// A particular rule is that if the alternative property
|
|
// returns a string, we turn off auto-quoting and esaping of
|
|
// the string, i.e. just treat the string as display text.
|
|
// This allows simple implementations of
|
|
// such as
|
|
//
|
|
// [<StructuredFormatDisplay("{StructuredDisplayString}I")>]
|
|
// type BigInt(signInt:int, v : BigNat) =
|
|
// member x.StructuredDisplayString = x.ToString()
|
|
//
|
|
| :? string as s -> sepL s
|
|
| _ -> sameObjL (depthLim-1) Precedence.BracketIfTuple alternativeObj
|
|
countNodes 0 (* 0 means we do not count the preText and postText *)
|
|
Some (leftL preText $$ alternativeObjL $$ rightL postText)
|
|
with _ ->
|
|
None
|
|
|
|
#if RUNTIME
|
|
#else
|
|
#if INTERNALIZED_POWER_PACK // FSharp.Compiler.dll: This is the PrintIntercepts extensibility point currently revealed by fsi.exe's AddPrinter
|
|
let res =
|
|
match res with
|
|
| Some _ -> res
|
|
| None ->
|
|
let env = { new IEnvironment with
|
|
member env.GetLayout(y) = objL (depthLim-1) Precedence.BracketIfTuple y
|
|
member env.MaxColumns = opts.PrintLength
|
|
member env.MaxRows = opts.PrintLength }
|
|
opts.PrintIntercepts |> List.tryPick (fun intercept -> intercept env x)
|
|
#endif
|
|
#endif
|
|
let res =
|
|
match res with
|
|
| Some res -> res
|
|
| None -> reprL showMode (depthLim-1) prec info x
|
|
path .Remove(x) |> ignore;
|
|
res
|
|
with
|
|
e ->
|
|
countNodes 1
|
|
wordL ("Error: " + e.Message)
|
|
|
|
and recdAtomicTupleL depthLim recd =
|
|
// tuples up args to UnionConstruction or ExceptionConstructor. no node count.
|
|
match recd with
|
|
| [(_,x)] -> objL depthLim Precedence.BracketIfTupleOrNotAtomic x
|
|
| txs -> leftL "(" $$ compactCommaListL (List.map (snd >> objL depthLim Precedence.BracketIfTuple) txs) $$ rightL ")"
|
|
|
|
and bracketIfL b basicL =
|
|
if b then (leftL "(") $$ basicL $$ (rightL ")") else basicL
|
|
|
|
and reprL showMode depthLim prec repr x (* x could be null *) =
|
|
let showModeFilter lay = match showMode with ShowAll -> lay | ShowTopLevelBinding -> emptyL
|
|
match repr with
|
|
| TupleValue vals ->
|
|
let basicL = sepListL (rightL ",") (List.map (objL depthLim Precedence.BracketIfTuple ) vals)
|
|
bracketIfL (prec <= Precedence.BracketIfTuple) basicL
|
|
|
|
| RecordValue items ->
|
|
let itemL (name,x) =
|
|
countNodes 1 // record labels are counted as nodes. [REVIEW: discussion under 4090].
|
|
(name,objL depthLim Precedence.BracketIfTuple x)
|
|
makeRecordL (List.map itemL items)
|
|
|
|
| ConstructorValue (constr,recd) when (* x is List<T>. Note: "null" is never a valid list value. *)
|
|
x<>null && Type.IsListType (x.GetType()) ->
|
|
match constr with
|
|
| "Cons" ->
|
|
let (x,xs) = unpackCons recd
|
|
let project xs = getListValueInfo bindingFlags xs
|
|
let itemLs = objL depthLim Precedence.BracketIfTuple x :: boundedUnfoldL (objL depthLim Precedence.BracketIfTuple) project stopShort xs (opts.PrintLength - 1)
|
|
makeListL itemLs
|
|
| _ ->
|
|
countNodes 1
|
|
wordL "[]"
|
|
|
|
| ConstructorValue(nm,[]) ->
|
|
countNodes 1
|
|
(wordL nm)
|
|
|
|
| ConstructorValue(nm,recd) ->
|
|
countNodes 1 (* e.g. Some (Some (Some (Some 2))) should count for 5 *)
|
|
(wordL nm --- recdAtomicTupleL depthLim recd) |> bracketIfL (prec <= Precedence.BracketIfTupleOrNotAtomic)
|
|
|
|
| ExceptionValue(ty,recd) ->
|
|
countNodes 1
|
|
// Bug 4045: ty.Name may have form <Name>Exception. We should be using the constructor <Name>.
|
|
let name = ty.Name |> trimEnding "Exception" (* if present, trim trailing "Exception" from type name *)
|
|
match recd with
|
|
| [] -> (wordL name)
|
|
| recd -> (wordL name --- recdAtomicTupleL depthLim recd) |> bracketIfL (prec <= Precedence.BracketIfTupleOrNotAtomic)
|
|
|
|
| FunctionClosureValue(ty,obj) ->
|
|
// Q: should function printing include the ty.Name? It does not convey much useful info to most users, e.g. "clo@0_123".
|
|
countNodes 1
|
|
wordL ("<fun:"+ty.Name+">") |> showModeFilter
|
|
|
|
| ObjectValue(obj) ->
|
|
match obj with
|
|
| null -> (countNodes 1; nullL)
|
|
| _ ->
|
|
let ty = obj.GetType()
|
|
match obj with
|
|
| :? string as s ->
|
|
countNodes 1
|
|
#if INTERNALIZED_POWER_PACK
|
|
if s.Length + 2(*quotes*) <= opts.StringLimit then
|
|
// With the quotes, it fits within the limit.
|
|
wordL (formatString s)
|
|
else
|
|
// When a string is considered too long to print, there is a choice: what to print?
|
|
// a) <string> -- follows <fun:typename>
|
|
// b) <string:length> -- follows <fun:typename> and gives just the length
|
|
// c) "abcdefg"+[n chars] -- gives a prefix and the remaining chars
|
|
wordL (formatStringInWidth opts.StringLimit s)
|
|
#else
|
|
wordL (formatString s)
|
|
#endif
|
|
| :? System.Array as arr ->
|
|
match arr.Rank with
|
|
| 1 ->
|
|
let n = arr.Length
|
|
let b1 = arr.GetLowerBound(0)
|
|
let project depthLim = if depthLim=(b1+n) then None else Some (box (arr.GetValue(depthLim)),depthLim+1)
|
|
let itemLs = boundedUnfoldL (objL depthLim Precedence.BracketIfTuple) project stopShort b1 opts.PrintLength
|
|
makeArrayL (if b1 = 0 then itemLs else wordL("bound1="+string_of_int b1)::itemLs)
|
|
| 2 ->
|
|
let n1 = arr.GetLength(0)
|
|
let n2 = arr.GetLength(1)
|
|
let b1 = arr.GetLowerBound(0)
|
|
let b2 = arr.GetLowerBound(1)
|
|
let project2 x y =
|
|
if x>=(b1+n1) || y>=(b2+n2) then None
|
|
else Some (box (arr.GetValue(x,y)),y+1)
|
|
let rowL x = boundedUnfoldL (objL depthLim Precedence.BracketIfTuple) (project2 x) stopShort b2 opts.PrintLength |> makeListL
|
|
let project1 x = if x>=(b1+n1) then None else Some (x,x+1)
|
|
let rowsL = boundedUnfoldL rowL project1 stopShort b1 opts.PrintLength
|
|
makeArray2L (if b1=0 && b2 = 0 then rowsL else wordL("bound1=" + string_of_int b1)::wordL("bound2=" + string_of_int b2)::rowsL)
|
|
| n ->
|
|
makeArrayL [wordL("rank=" + string_of_int n)]
|
|
|
|
| :? System.Collections.IEnumerable as ie ->
|
|
if opts.ShowIEnumerable then
|
|
let it = ie.GetEnumerator()
|
|
try
|
|
let itemLs = boundedUnfoldL (objL depthLim Precedence.BracketIfTuple) (fun () -> if it.MoveNext() then Some(it.Current,()) else None) stopShort () (1+opts.PrintLength/30)
|
|
(wordL "seq" --- makeListL itemLs) |> bracketIfL (prec <= Precedence.BracketIfTupleOrNotAtomic)
|
|
finally
|
|
match it with
|
|
| :? System.IDisposable as e -> e.Dispose()
|
|
| _ -> ()
|
|
|
|
else
|
|
// Sequence printing is turned off for declared-values, and maybe be disabled to users.
|
|
// There is choice here, what to print? <seq> or ... or ?
|
|
// Also, in the declared values case, if the sequence is actually a known non-lazy type (list, array etc etc) we could print it.
|
|
wordL "<seq>" |> showModeFilter
|
|
| _ ->
|
|
if showMode = ShowTopLevelBinding && typeUsesSystemObjectToString (obj.GetType()) then
|
|
emptyL
|
|
else
|
|
countNodes 1
|
|
let basicL = LayoutOps.objL obj (* This burries an obj in the layout, rendered at squash time via a leafFormatter.
|
|
* If the leafFormatter was directly here, then layout leaves could store strings.
|
|
*)
|
|
match obj with
|
|
| _ when opts.ShowProperties ->
|
|
let props = ty.GetProperties(BindingFlags.GetField ||| BindingFlags.Instance ||| BindingFlags.Public)
|
|
// massively reign in deep printing of properties
|
|
let nDepth = depthLim/10
|
|
System.Array.Sort((props:>System.Array),{ new System.Collections.IComparer with member this.Compare(p1,p2) = compare ((p1 :?> PropertyInfo).Name) ((p2 :?> PropertyInfo).Name) } );
|
|
if props.Length = 0 || (nDepth <= 0) then basicL
|
|
else basicL ---
|
|
(props
|
|
|> Array.to_list
|
|
|> List.map (fun p -> (p.Name,(try Some (objL nDepth Precedence.BracketIfTuple (getProperty obj p.Name))
|
|
with _ -> None)))
|
|
|> makePropertiesL)
|
|
| _ -> basicL
|
|
| UnitValue -> countNodes 1; measureL
|
|
|
|
polyL bindingFlags objWithReprL showMode opts.PrintDepth Precedence.BracketIfTuple x
|
|
|
|
// --------------------------------------------------------------------
|
|
// pprinter: leafFormatter
|
|
// --------------------------------------------------------------------
|
|
|
|
#if Suggestion4299
|
|
// See bug 4299. Suppress FSI_dddd+<etc> from fsi printer.
|
|
let fixupForInteractiveFSharpClassesWithNoToString obj (text:string) =
|
|
// Given obj:T.
|
|
// If T is a nested type inside a parent type called FSI_dddd, then it looks like an F# Interactive type.
|
|
// Further, if the .ToString() text starts with "FSI_dddd+T" then it looks like it's the default ToString.
|
|
// A better test: it is default ToString if the MethodInfo.DeclaringType is System.Object.
|
|
// In this case, replace "FSI_dddd+T" by "T".
|
|
// assert(obj <> null)
|
|
let fullName = obj.GetType().FullName // e.g. "FSI_0123+Name"
|
|
let name = obj.GetType().Name // e.g. "Name"
|
|
let T = obj.GetType()
|
|
if text.StartsWith(fullName) then
|
|
// text could be a default .ToString() since it starts with the FullName of the type. More checks...
|
|
if T.IsNested &&
|
|
T.DeclaringType.Name.StartsWith("FSI_") && // Name has "FSI_" which is
|
|
T.DeclaringType.Name.Substring(4) |> Seq.forall System.Char.IsDigit // followed by digits?
|
|
then
|
|
name ^ text.Substring(fullName.Length) // replace fullName by name at start of text
|
|
else
|
|
text
|
|
else
|
|
text
|
|
#endif
|
|
|
|
let leafFormatter (opts:FormatOptions) (obj :obj) =
|
|
match obj with
|
|
| null -> "null"
|
|
| :? double as d ->
|
|
let s = d.ToString(opts.FloatingPointFormat,opts.FormatProvider)
|
|
if System.Double.IsNaN(d) then "nan"
|
|
elif System.Double.IsNegativeInfinity(d) then "-infinity"
|
|
elif System.Double.IsPositiveInfinity(d) then "infinity"
|
|
elif opts.FloatingPointFormat.[0] = 'g' && String.forall(fun c -> System.Char.IsDigit(c) || c = '-') s
|
|
then s + ".0"
|
|
else s
|
|
| :? single as d ->
|
|
(if System.Single.IsNaN(d) then "nan"
|
|
elif System.Single.IsNegativeInfinity(d) then "-infinity"
|
|
elif System.Single.IsPositiveInfinity(d) then "infinity"
|
|
elif opts.FloatingPointFormat.Length >= 1 && opts.FloatingPointFormat.[0] = 'g'
|
|
&& float32(System.Int32.MinValue) < d && d < float32(System.Int32.MaxValue)
|
|
&& float32(int32(d)) = d
|
|
then (System.Convert.ToInt32 d).ToString(opts.FormatProvider) + ".0"
|
|
else d.ToString(opts.FloatingPointFormat,opts.FormatProvider))
|
|
+ "f"
|
|
| :? System.Decimal as d -> d.ToString("g",opts.FormatProvider) + "M"
|
|
| :? uint64 as d -> d.ToString(opts.FormatProvider) + "UL"
|
|
| :? int64 as d -> d.ToString(opts.FormatProvider) + "L"
|
|
| :? int32 as d -> d.ToString(opts.FormatProvider)
|
|
| :? uint32 as d -> d.ToString(opts.FormatProvider) + "u"
|
|
| :? int16 as d -> d.ToString(opts.FormatProvider) + "s"
|
|
| :? uint16 as d -> d.ToString(opts.FormatProvider) + "us"
|
|
| :? sbyte as d -> d.ToString(opts.FormatProvider) + "y"
|
|
| :? byte as d -> d.ToString(opts.FormatProvider) + "uy"
|
|
| :? nativeint as d -> d.ToString() + "n"
|
|
| :? unativeint as d -> d.ToString() + "un"
|
|
| :? bool as b -> (if b then "true" else "false")
|
|
| :? char as c -> "\'" + formatChar true c + "\'"
|
|
| _ -> try let text = obj.ToString()
|
|
//Suggestion4299. Not yet fixed.
|
|
//#if INTERNALIZED_POWER_PACK
|
|
// let text = fixupForInteractiveFSharpClassesWithNoToString obj text
|
|
//#endif
|
|
text
|
|
with e ->
|
|
// If a .ToString() call throws an exception, catch it and use the message as the result.
|
|
// This may be informative, e.g. division by zero etc...
|
|
"<ToString exception: " + e.Message + ">"
|
|
|
|
let any_to_layout opts x = anyL ShowAll BindingFlags.Public opts x
|
|
|
|
let squash_layout opts l =
|
|
// Print width = 0 implies 1D layout, no squash
|
|
if opts.PrintWidth = 0 then
|
|
l
|
|
else
|
|
l |> squashTo (opts.PrintWidth,leafFormatter opts)
|
|
|
|
let output_layout opts oc l =
|
|
l |> squash_layout opts
|
|
|> outL opts.AttributeProcessor (leafFormatter opts) oc
|
|
|
|
let layout_to_string opts l =
|
|
l |> squash_layout opts
|
|
|> showL opts (leafFormatter opts)
|
|
|
|
let output_any_ex opts oc x = x |> any_to_layout opts |> output_layout opts oc
|
|
|
|
let output_any oc x = output_any_ex FormatOptions.Default oc x
|
|
|
|
let layout_as_string opts x = x |> any_to_layout opts |> layout_to_string opts
|
|
|
|
let any_to_string x = layout_as_string FormatOptions.Default x
|
|
|
|
#if RUNTIME
|
|
let internal printf_any_to_string opts (bindingFlags:BindingFlags) x =
|
|
x |> anyL ShowAll bindingFlags opts |> layout_to_string opts
|
|
#endif
|
|
|
|
#if INTERNALIZED_POWER_PACK
|
|
/// Called
|
|
let fsi_any_to_layout opts x = anyL ShowTopLevelBinding BindingFlags.Public opts x
|
|
#endif
|
|
|