I am trying to create primitive values given a Type in F#. The code is as given below but it does not work. I would appreciate all the help and thanks in advance.
open System
let getvalue (t: Type) (v: string) : obj =
match box t with
| :? int -> let r = (int) v
box r
| :? byte -> let r = (byte) v
box r
| :? sbyte -> let r = (sbyte) v
box r
| :? int16 -> let r = (int16) v
box r
| :? uint32 -> let r = (uint32) v
box r
| :? int64 -> let r = (int64) v
box r
| :? uint64 -> let r = (uint64) v
box r
| :? double -> let r = (double) v
box r
| :? float32 -> let r = (float32) v
box r
| :? decimal -> let r = (decimal) v
box r
| :? char -> let r = (char) v
box r
| :? string -> v :> obj
| _ ->
let s = sprintf "Error unknown type %A" t
raise (ApplicationException(s))
No need to reinvent the wheel, use Convert.ChangeType.
If you're so inclined, then you can write a wrapper around that to let the compiler determine the types automatically.
let inline getValue<'a> (s:string) = // limit to string only if desired
System.Convert.ChangeType(s, typeof<'a>) :?> 'a
let x = getValue "1" + 1.2 // no need to explicitly state "float" anywhere here
printfn "%A" x // 2.2
Since t is always a Type value, it will never be of the type int, byte, decimal, etc. This is the reason the function always raises an exception; those other matches can never be true.
Instead, you'll have to compare t to typeof<int>, typeof<byte>, etc. However, you can't use a constant pattern for that, because typeof<int>, typeof<byte>, etc. aren't constants.
Instead, you can use an if .. elif .. else expression:
open System
let getValue (t: Type) (v: string) : obj =
if t = typeof<int> then box ((int) v)
elif t = typeof<byte> then box ((byte) v)
elif t = typeof<sbyte> then box ((sbyte) v)
elif t = typeof<int16> then box ((int16) v)
elif t = typeof<uint32> then box ((uint32) v)
elif t = typeof<int64> then box ((int64) v)
elif t = typeof<uint64> then box ((uint64) v)
elif t = typeof<double> then box ((double) v)
elif t = typeof<float32> then box ((float32) v)
elif t = typeof<decimal> then box ((decimal) v)
elif t = typeof<char> then box ((char) v)
elif t = typeof<string> then v :> obj
else
let s = sprintf "Error unknown type %A" t
raise (ApplicationException(s))
If you really want to use pattern matching, you could consider hiding this behind an active pattern, but personally, I don't think it would be worthwhile.
Related
I'm trying to substitute types in a F# Expr, before converting it to an Expression for consumption by a c# lib.
But upon the call to LeafExpressionConverter.QuotationToExpression I receive the error
InvalidOperationException: The variable 't' was not found in the translation context
Basically I'm trying to substitute the equivalent of
<# fun (t: Record) -> t.A = 10 #> to
<# fun (t: Dict) -> t["A"] = 10 #>
Here is the code
type Record = {
A: int
}
type Dict () = //this is the type the c# lib wants (a dictionary representation of a type)
inherit Dictionary<string, obj>()
let substitute<'a> (ex: Expr<'a->bool>) =
let replaceVar (v: Var) = if v.Type = typeof<'a> then Var(v.Name, typeof<Dict>) else v
let tEntityItem = typeof<Dict>.GetProperty("Item")
let isATypeShapeVar = function | ShapeVar var -> var.Type = typeof<'a> | _ -> false
let rec substituteExpr =
function
| PropertyGet(exOpt, propOrValInfo, c) ->
match exOpt with
| None -> Expr.PropertyGet(propOrValInfo)
| Some ex ->
let args = c |> List.map substituteExpr
let newex = substituteExpr ex
match isATypeShapeVar ex with
| true ->
let getter = Expr.PropertyGet(newex, tEntityItem, [Expr.Value(propOrValInfo.Name)] )
Expr.Coerce(getter, propOrValInfo.PropertyType)
| false -> Expr.PropertyGet(newex, propOrValInfo, args)
| ShapeVar var -> Expr.Var (var |> replaceVar)
| ShapeLambda (var, expr) -> Expr.Lambda(var |> replaceVar, substituteExpr expr)
| ShapeCombination(shapeComboObject, exprList) ->
RebuildShapeCombination(shapeComboObject, List.map substituteExpr exprList)
substituteExpr ex |> LeafExpressionConverter.QuotationToExpression
substitute<Record> (<# fun t -> t.A = 10 #>)
I suspect I've missed something in the substitution, but I'm stumped as to what.
The the .ToString() result of the substituted F# Expr is
Lambda (t,
Call (None, op_Equality,
[Coerce (PropertyGet (Some (t), Item, [Value ("A")]), Int32),
Value (10)]))
which looks correct. And other than the coersion, is the equivalent of <# fun (t: Dict) -> t["A"] = 10 #>.ToString()
Why is the QuotationToExpression failing ?
Every time you call replaceVar, you return a different instance of Var. So when you replace the lambda parameter, it's one instance of Var, and later, when you replace newex, that's another instance of Var.
Lambda (t, Call (None, op_Equality, [Coerce (PropertyGet (Some (t), ... ))
^ ^
| |
---------------------------------------------------------
These are different `t`, unrelated, despite the same name
To make this work, you have to make it the same t. The dumbest, most straightforward way would be this:
let substitute<'a> (ex: Expr<'a->bool>) =
let newArg = Var("arg", typeof<Dict>)
let replaceVar (v: Var) = if v.Type = typeof<'a> then newArg else v
...
This will make your particular example work as expected, but it is still unsound, because you're replacing not just specifically the lambda parameter, but any variable of the same type. Which means that if the expression happens to contain any variables of the same type as the parameter, you'd still hit the same problem. For example, try converting this:
<# fun t -> let z = { A = 15 } in z.A = 15 && t.A = 10 #>
You'll get a similar error, but this time complaining about variable z.
A better way would be to maintain a map of variable substitutions as you go, insert new variables as you encounter them for the first time, but get them from the map on subsequent encounters.
An alternative approach would be to fish out specifically the lambda parameter and then replace only it, rather than comparing variable types.
But then there's the next level of weirdness: you're converting any property accessor to an indexer accessor, but in my example above, z.A shouldn't be thus converted. So you have to somehow recognize whether the object of property access is in fact the argument, and that may not be as trivial.
If you're willing to settle for just the case of t.A and fail on more complicated cases like (if true then t else t).A, then you can just match on the lambda argument and pass through any other expression:
let substitute<'a> (ex: Expr<'a->bool>) =
let arg =
match ex with
| ShapeLambda (v, _) -> v
| _ -> failwith "This is not a lambda. Shouldn't happen."
let newArg = Var("arg", typeof<Dict>)
let replaceVar (v: Var) = if v = arg then newArg else v
let tEntityItem = typeof<Dict>.GetProperty("Item")
let isATypeShapeVar = function | ShapeVar var -> var.Type = typeof<'a> | _ -> false
let rec substituteExpr =
function
| PropertyGet(Some (ShapeVar a), propOrValInfo, c) when a = arg ->
let getter = Expr.PropertyGet(Expr.Var newArg, tEntityItem, [Expr.Value(propOrValInfo.Name)] )
Expr.Coerce(getter, propOrValInfo.PropertyType)
| ShapeVar var -> Expr.Var (var |> replaceVar)
| ShapeLambda (var, expr) -> Expr.Lambda(var |> replaceVar, substituteExpr expr)
| ShapeCombination(shapeComboObject, exprList) ->
RebuildShapeCombination(shapeComboObject, List.map substituteExpr exprList)
| ex -> ex
substituteExpr ex |> LeafExpressionConverter.QuotationToExpression
> substituteExpr <# fun t -> let z = { A = 15 } in z.A = 15 && t.A = 10 #>
val it: System.Linq.Expressions.Expression =
ToFSharpFunc(arg => z => ((z.A == 15) AndAlso (Convert(arg.get_Item("A"), Int32) == 10)).Invoke(new Record(15)))
Edit 2021:
Yes you can since F#5.0 see Docs
Original Question:
I would like to use negative indices on Arrays so that i can write myThings.[-2] <- "sth" to set the second last item. Is this possible?
I tried this but it fails to compile with:
Method overrides and interface implementations are not permitted here
type ``[]``<'T> with
/// Allows for negative index too (like python)
override this.Item
with get i = if i<0 then this.[this.Length+i] else this.[i]
and set i v = if i<0 then this.[this.Length+i] <- v else this.[i] <- v
I know, I could use new members like myThings.SetItemNegative(-2,"sth") but this is not as nice as using the index notation:
type ``[]``<'T> with
/// Allows for negative index too (like python)
member this.GetItemNegative (i) =
if i<0 then this.[this.Length+i] else this.[i]
member this.SetItemNegative (i,v) =
if i<0 then this.[this.Length+i] <- v else this.[i] <- v
Unfortunately existing methods in a type have priority over future extension members.
It doesn't make so much sense but that's the way currently is, you can read more about it in this issue: https://github.com/dotnet/fsharp/issues/3692#issuecomment-334297164
That's why if you define such extension it will be ignored, and what's worst: silently ignored !
Anyway there are some proposals to add something similar to negative slices to F#.
Gus explained that existing members of 'T array can not be overwritten.
A workaround is extending 'T seq.
For my F# scripts this is good enough. I am not sure if this is a good idea in general though.
open System
open System.Collections.Generic
open System.Runtime.CompilerServices
//[<assembly:Extension>] do()
/// Converts negative indices to positive ones
/// e.g.: -1 is last item .
let negIdx i len =
let ii = if i<0 then len+i else i
if ii<0 || ii >= len then failwithf "Cannot get index %d of Seq with %d items" i len
ii
let get i (xs:seq<'T>) : 'T =
match xs with
//| :? ('T[]) as xs -> xs.[negIdx i xs.Length] // covered by IList
| :? ('T IList) as xs -> xs.[negIdx i xs.Count]
| :? ('T list) as xs -> List.item (negIdx i (List.length xs)) xs
| _ -> Seq.item (negIdx i (Seq.length xs)) xs
let set i x (xs:seq<_>) :unit =
match xs with
| :? ('T[]) as xs -> xs.[negIdx i xs.Length]<- x // why not covered by IList?
| :? ('T IList) as xs -> xs.[negIdx i xs.Count] <- x
| _ -> failwithf "Cannot set items on this Seq (is it a dict, lazy or immutable ?)"
//[<Extension>]
type Collections.Generic.IEnumerable<'T> with
[<Extension>]
///Allows for negtive indices too (like Python)
member this.Item
with get i = get i this
and set i x = set i x this
///Allows for negative indices too.
///The resulting seq includes the item at slice-ending-index. like F# range expressions include the last integer e.g.: 0..5
[<Extension>]
member this.GetSlice(startIdx,endIdx) : 'T seq = // to use slicing notation e.g. : xs.[ 1 .. -2]
let count = Seq.length this
let st = match startIdx with None -> 0 | Some i -> if i<0 then count+i else i
let len = match endIdx with None -> count-st | Some i -> if i<0 then count+i-st+1 else i-st+1
if st < 0 || st > count-1 then
let err = sprintf "GetSlice: Start index %d is out of range. Allowed values are -%d up to %d for Seq of %d items" startIdx.Value count (count-1) count
raise (IndexOutOfRangeException(err))
if st+len > count then
let err = sprintf "GetSlice: End index %d is out of range. Allowed values are -%d up to %d for Seq of %d items" endIdx.Value count (count-1) count
raise (IndexOutOfRangeException(err))
if len < 0 then
let en = match endIdx with None -> count-1 | Some i -> if i<0 then count+i else i
let err = sprintf "GetSlice: Start index '%A' (= %d) is bigger than end index '%A'(= %d) for Seq of %d items" startIdx st endIdx en count
raise (IndexOutOfRangeException(err))
this |> Seq.skip st |> Seq.take len
// usage :
let modify (xs:seq<_>) =
xs.[-1] <- 0 // set last
xs.[-2] <- 0 // set second last
xs
let slice (xs:seq<_>) =
xs.[-3 .. -1] // last 3 items
modify [|0..9|]
slice [|0..9|]
You cannot extend 'T[], but wouldn't an operator taking _[] as an operand do it?
let (?) (this : _[]) i =
if i<0 then this.[this.Length+i] else this.[i]
// val ( ? ) : this:'a [] -> i:int -> 'a
let (?<-) (this : _[]) i v =
if i<0 then this.[this.Length+i] <- v else this.[i] <- v
// val ( ?<- ) : this:'a [] -> i:int -> v:'a -> unit
[|1..3|]?(-1)
// val it : int = 3
let a = [|1..3|] in a?(-1) <- 0; a
// val it : int [] = [|1; 2; 0|]
Yes you can since F# 5.0 see Docs
Code:
type Result = string option
type Parser<'a> = string -> int -> ('a -> Result) -> ('a -> Result) -> Result
let win r = Some <| "Correct: " + r
let lose _ = None
let parse_a: Parser<char> = fun text i win_cps lose_cps ->
let x = text.[i]
if x = 'a' then win_cps x else lose_cps x
let parse_many: Parser<char> -> Parser<char list> = fun p text i win_cps lose_cps ->
let rec loop: char list -> Parser<char list> = fun l text i _ _ ->
let win = fun (l: char list) (r: char) -> loop (r:l) text i win_cps lose_cps
let lose = fun (l: char list) (r: char) -> win_cps (r:l)
p text (i+1) (win l) (lose l)
loop [] text (i-1) win_cps lose_cps
parse_many parse_a "aaabc" 0 (fun r -> win (r |> System.String.Concat)) lose
The error: cps_parser_v0.fsx(12,59): error FS0039: The type 'l' is not defined
I want to make a functionally pure CPS parser in Haskell and am experimenting in F# first. If I really wanted to do this in F# I would use mutable state, but for now I am just wondering why this is not working? It looks to me that it can't remember partially applied parameters.
You have a typo: (r:l) should be (r::l). The : operator means "is of type", i.e. r:l means that you're telling the compiler that r is of type l. The :: operator means "prepend this to the front of this list": r::l means "prepend r to the front of list l".
You've made this mistake in two places: loop (r:l) should be loop (r::l), and one line further down, win_cps (r:l) should be win_cps (r::l).
I've written an interesting function in F# which can traverse and map any data structure (much like the everywhere function available in Haskell's Scrap Your Boilerplate). Unfortunately it quickly causes a stack overflow on even fairly small data structures. I was wondering how I can convert it to a tail recursive version, continuation passing style version or an imperative equivalent algorithm. I believe F# supports monads, so the continuation monad is an option.
// These are used for a 50% speedup
let mutable tupleReaders : List<System.Type * (obj -> obj[])> = []
let mutable unionTagReaders : List<System.Type * (obj -> int)> = []
let mutable unionReaders : List<(System.Type * int) * (obj -> obj[])> = []
let mutable unionCaseInfos : List<System.Type * Microsoft.FSharp.Reflection.UnionCaseInfo[]> = []
let mutable recordReaders : List<System.Type * (obj -> obj[])> = []
(*
Traverses any data structure in a preorder traversal
Calls f, g, h, i, j which determine the mapping of the current node being considered
WARNING: Not able to handle option types
At runtime, option None values are represented as null and so you cannot determine their runtime type.
See http://stackoverflow.com/questions/21855356/dynamically-determine-type-of-option-when-it-has-value-none
http://stackoverflow.com/questions/13366647/how-to-generalize-f-option
*)
open Microsoft.FSharp.Reflection
let map5<'a,'b,'c,'d,'e,'z> (f:'a->'a) (g:'b->'b) (h:'c->'c) (i:'d->'d) (j:'e->'e) (src:'z) =
let ft = typeof<'a>
let gt = typeof<'b>
let ht = typeof<'c>
let it = typeof<'d>
let jt = typeof<'e>
let rec drill (o:obj) : obj =
if o = null then
o
else
let ot = o.GetType()
if FSharpType.IsUnion(ot) then
let tag = match List.tryFind (fst >> ot.Equals) unionTagReaders with
| Some (_, reader) ->
reader o
| None ->
let newReader = FSharpValue.PreComputeUnionTagReader(ot)
unionTagReaders <- (ot, newReader)::unionTagReaders
newReader o
let info = match List.tryFind (fst >> ot.Equals) unionCaseInfos with
| Some (_, caseInfos) ->
Array.get caseInfos tag
| None ->
let newCaseInfos = FSharpType.GetUnionCases(ot)
unionCaseInfos <- (ot, newCaseInfos)::unionCaseInfos
Array.get newCaseInfos tag
let vals = match List.tryFind (fun ((tau, tag'), _) -> ot.Equals tau && tag = tag') unionReaders with
| Some (_, reader) ->
reader o
| None ->
let newReader = FSharpValue.PreComputeUnionReader info
unionReaders <- ((ot, tag), newReader)::unionReaders
newReader o
FSharpValue.MakeUnion(info, Array.map traverse vals)
elif FSharpType.IsTuple(ot) then
let fields = match List.tryFind (fst >> ot.Equals) tupleReaders with
| Some (_, reader) ->
reader o
| None ->
let newReader = FSharpValue.PreComputeTupleReader(ot)
tupleReaders <- (ot, newReader)::tupleReaders
newReader o
FSharpValue.MakeTuple(Array.map traverse fields, ot)
elif FSharpType.IsRecord(ot) then
let fields = match List.tryFind (fst >> ot.Equals) recordReaders with
| Some (_, reader) ->
reader o
| None ->
let newReader = FSharpValue.PreComputeRecordReader(ot)
recordReaders <- (ot, newReader)::recordReaders
newReader o
FSharpValue.MakeRecord(ot, Array.map traverse fields)
else
o
and traverse (o:obj) =
let parent =
if o = null then
o
else
let ot = o.GetType()
if ft = ot || ot.IsSubclassOf(ft) then
f (o :?> 'a) |> box
elif gt = ot || ot.IsSubclassOf(gt) then
g (o :?> 'b) |> box
elif ht = ot || ot.IsSubclassOf(ht) then
h (o :?> 'c) |> box
elif it = ot || ot.IsSubclassOf(it) then
i (o :?> 'd) |> box
elif jt = ot || ot.IsSubclassOf(jt) then
j (o :?> 'e) |> box
else
o
drill parent
traverse src |> unbox : 'z
Try this (I just used continuation function as parameter):
namespace Solution
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
[<AutoOpen>]
module Solution =
// These are used for a 50% speedup
let mutable tupleReaders : List<System.Type * (obj -> obj[])> = []
let mutable unionTagReaders : List<System.Type * (obj -> int)> = []
let mutable unionReaders : List<(System.Type * int) * (obj -> obj[])> = []
let mutable unionCaseInfos : List<System.Type * Microsoft.FSharp.Reflection.UnionCaseInfo[]> = []
let mutable recordReaders : List<System.Type * (obj -> obj[])> = []
(*
Traverses any data structure in a preorder traversal
Calls f, g, h, i, j which determine the mapping of the current node being considered
WARNING: Not able to handle option types
At runtime, option None values are represented as null and so you cannot determine their runtime type.
See http://stackoverflow.com/questions/21855356/dynamically-determine-type-of-option-when-it-has-value-none
http://stackoverflow.com/questions/13366647/how-to-generalize-f-option
*)
open Microsoft.FSharp.Reflection
let map5<'a,'b,'c,'d,'e,'z> (f:'a->'a) (g:'b->'b) (h:'c->'c) (i:'d->'d) (j:'e->'e) (src:'z) =
let ft = typeof<'a>
let gt = typeof<'b>
let ht = typeof<'c>
let it = typeof<'d>
let jt = typeof<'e>
let rec drill (o:obj) =
if o = null then
(None, fun _ -> o)
else
let ot = o.GetType()
if FSharpType.IsUnion(ot) then
let tag = match List.tryFind (fst >> ot.Equals) unionTagReaders with
| Some (_, reader) ->
reader o
| None ->
let newReader = FSharpValue.PreComputeUnionTagReader(ot)
unionTagReaders <- (ot, newReader)::unionTagReaders
newReader o
let info = match List.tryFind (fst >> ot.Equals) unionCaseInfos with
| Some (_, caseInfos) ->
Array.get caseInfos tag
| None ->
let newCaseInfos = FSharpType.GetUnionCases(ot)
unionCaseInfos <- (ot, newCaseInfos)::unionCaseInfos
Array.get newCaseInfos tag
let vals = match List.tryFind (fun ((tau, tag'), _) -> ot.Equals tau && tag = tag') unionReaders with
| Some (_, reader) ->
reader o
| None ->
let newReader = FSharpValue.PreComputeUnionReader info
unionReaders <- ((ot, tag), newReader)::unionReaders
newReader o
// (Some(vals), FSharpValue.MakeUnion(info, Array.map traverse vals))
(Some(vals), (fun x -> FSharpValue.MakeUnion(info, x)))
elif FSharpType.IsTuple(ot) then
let fields = match List.tryFind (fst >> ot.Equals) tupleReaders with
| Some (_, reader) ->
reader o
| None ->
let newReader = FSharpValue.PreComputeTupleReader(ot)
tupleReaders <- (ot, newReader)::tupleReaders
newReader o
// (FSharpValue.MakeTuple(Array.map traverse fields, ot)
(Some(fields), (fun x -> FSharpValue.MakeTuple(x, ot)))
elif FSharpType.IsRecord(ot) then
let fields = match List.tryFind (fst >> ot.Equals) recordReaders with
| Some (_, reader) ->
reader o
| None ->
let newReader = FSharpValue.PreComputeRecordReader(ot)
recordReaders <- (ot, newReader)::recordReaders
newReader o
// FSharpValue.MakeRecord(ot, Array.map traverse fields)
(Some(fields), (fun x -> FSharpValue.MakeRecord(ot, x)))
else
(None, (fun _ -> o))
and traverse (o:obj) cont =
let parent =
if o = null then
o
else
let ot = o.GetType()
if ft = ot || ot.IsSubclassOf(ft) then
f (o :?> 'a) |> box
elif gt = ot || ot.IsSubclassOf(gt) then
g (o :?> 'b) |> box
elif ht = ot || ot.IsSubclassOf(ht) then
h (o :?> 'c) |> box
elif it = ot || ot.IsSubclassOf(it) then
i (o :?> 'd) |> box
elif jt = ot || ot.IsSubclassOf(jt) then
j (o :?> 'e) |> box
else
o
let child, f = drill parent
match child with
| None ->
f [||] |> cont
| Some(x) ->
match x.Length with
| len when len > 1 ->
let resList = System.Collections.Generic.List<obj>()
let continuation = Array.foldBack (fun t s -> (fun mC -> resList.Add(mC); traverse t s) )
(x.[1..])
(fun mC -> resList.Add(mC); resList.ToArray() |> f |> cont)
traverse (x.[0]) continuation
| _ -> traverse x (fun mC ->
match mC with
| :? (obj[]) as mC -> f mC |> cont
| _ -> f [|mC|] |> cont
)
traverse src (fun x -> x) |> unbox : 'z
You should build this with enabled Generate tail calls option (by default, this option disabled in Debug mode, but enabled in Release).
Example:
type A1 =
| A of A2
| B of int
and A2 =
| A of A1
| B of int
and Root =
| A1 of A1
| A2 of A2
[<EntryPoint>]
let main args =
let rec build (elem: Root) n =
if n = 0 then elem
else
match elem with
| A1(x) -> build (Root.A2(A2.A(x))) (n-1)
| A2(x) -> build (Root.A1(A1.A(x))) (n-1)
let tree = build (Root.A1(A1.B(2))) 100000
let a = map5 (fun x -> x) (fun x -> x) (fun x -> x) (fun x -> x) (fun x -> x) tree
printf "%A" a
0
This code finished without Stack Overflow exception.
I ended up converting the code to an imperative style to avoid the Stack Overflow:
open Microsoft.FSharp.Reflection
let mutable tupleReaders : List<System.Type * (obj -> obj[])> = []
let mutable unionTagReaders : List<System.Type * (obj -> int)> = []
let mutable unionReaders : List<(System.Type * int) * (obj -> obj[])> = []
let mutable unionCaseInfos : List<System.Type * Microsoft.FSharp.Reflection.UnionCaseInfo[]> = []
let mutable recordReaders : List<System.Type * (obj -> obj[])> = []
type StructureInfo = Union of UnionCaseInfo
| Tuple of System.Type
| Record of System.Type
| Leaf
let map5<'a,'b,'c,'d,'e,'z> (f:'a->'a) (g:'b->'b) (h:'c->'c) (i:'d->'d) (j:'e->'e) (src:'z) : 'z =
let ft = typeof<'a>
let gt = typeof<'b>
let ht = typeof<'c>
let it = typeof<'d>
let jt = typeof<'e>
let getStructureInfo (o : obj) =
if o = null then
(Leaf, [||])
else
let ot = o.GetType()
if FSharpType.IsUnion(ot) then
let tag = match List.tryFind (fst >> ot.Equals) unionTagReaders with
| Some (_, reader) ->
reader o
| None ->
let newReader = FSharpValue.PreComputeUnionTagReader(ot)
unionTagReaders <- (ot, newReader)::unionTagReaders
newReader o
let info = match List.tryFind (fst >> ot.Equals) unionCaseInfos with
| Some (_, caseInfos) ->
Array.get caseInfos tag
| None ->
let newCaseInfos = FSharpType.GetUnionCases(ot)
unionCaseInfos <- (ot, newCaseInfos)::unionCaseInfos
Array.get newCaseInfos tag
let children =
match List.tryFind (fun ((tau, tag'), _) -> ot.Equals tau && tag = tag') unionReaders with
| Some (_, reader) ->
reader o
| None ->
let newReader = FSharpValue.PreComputeUnionReader info
unionReaders <- ((ot, tag), newReader)::unionReaders
newReader o
(Union info, children)
elif FSharpType.IsTuple(ot) then
let children =
match List.tryFind (fst >> ot.Equals) tupleReaders with
| Some (_, reader) ->
reader o
| None ->
let newReader = FSharpValue.PreComputeTupleReader(ot)
tupleReaders <- (ot, newReader)::tupleReaders
newReader o
(Tuple ot, children)
elif FSharpType.IsRecord(ot) then
let children =
match List.tryFind (fst >> ot.Equals) recordReaders with
| Some (_, reader) ->
reader o
| None ->
let newReader = FSharpValue.PreComputeRecordReader(ot)
recordReaders <- (ot, newReader)::recordReaders
newReader o
(Record ot, children)
else
(Leaf, [||])
let root = src |> box |> ref
let mutable nodes = [root]
let mutable completedNodes = []
while not (List.isEmpty nodes) do
let node = List.head nodes
nodes <- List.tail nodes
let o = !node
let o' = if o = null then
o
else
let ot = o.GetType()
if ft = ot || ot.IsSubclassOf(ft) then
f (o :?> 'a) |> box
elif gt = ot || ot.IsSubclassOf(gt) then
g (o :?> 'b) |> box
elif ht = ot || ot.IsSubclassOf(ht) then
h (o :?> 'c) |> box
elif it = ot || ot.IsSubclassOf(it) then
i (o :?> 'd) |> box
elif jt = ot || ot.IsSubclassOf(jt) then
j (o :?> 'e) |> box
else
o
node := o'
let (structure, children) = getStructureInfo o'
let childrenContainers = children |> Array.map ref
completedNodes <- (node, structure, childrenContainers)::completedNodes
nodes <- List.append (List.ofArray childrenContainers) nodes
completedNodes |> List.iter
(fun (oContainer, structureInfo, childrenContainers) ->
let children = Array.map (!) childrenContainers
match structureInfo with
| Union info ->
oContainer := FSharpValue.MakeUnion(info, children)
| Tuple ot ->
oContainer := FSharpValue.MakeTuple(children, ot)
| Record ot ->
oContainer := FSharpValue.MakeRecord(ot, children)
| Leaf -> ())
(unbox !root) : 'z
Is there a way to use F#'s sprintf float formating with a decimal comma? It would be nice if this worked:
sprintf "%,1f" 23.456
// expected: "23,456"
Or can I only use String.Format Method (IFormatProvider, String, Object()) ?
EDIT: I would like to have a comma not a point as a decimal separator. Like most non-English speaking countries use it.
It's quite a pain, but you can write your own version of sprintf that does exactly what you want:
open System
open System.Text.RegularExpressions
open System.Linq.Expressions
let printfRegex = Regex(#"^(?<text>[^%]*)((?<placeholder>%(%|((0|-|\+| )?([0-9]+)?(\.[0-9]+)?b|c|s|d|i|u|x|X|o|e|E|f|F|g|G|M|O|A|\+A|a|t)))(?<text>[^%]*))*$", RegexOptions.ExplicitCapture ||| RegexOptions.Compiled)
type PrintfExpr =
| K of Expression
| F of ParameterExpression * Expression
let sprintf' (c:System.Globalization.CultureInfo) (f:Printf.StringFormat<'a>) : 'a =
//'a has form 't1 -> 't2 -> ... -> string
let cultureExpr = Expression.Constant(c) :> Expression
let m = printfRegex.Match(f.Value)
let prefix = m.Groups.["text"].Captures.[0].Value
let inputTypes =
let rec loop t =
if Reflection.FSharpType.IsFunction t then
let dom, rng = Reflection.FSharpType.GetFunctionElements t
dom :: loop rng
else
if t <> typeof<string> then
failwithf "Unexpected return type: %A" t
[]
ref(loop typeof<'a>)
let pop() =
let (t::ts) = !inputTypes
inputTypes := ts
t
let exprs =
K(Expression.Constant(prefix)) ::
[for i in 0 .. m.Groups.["placeholder"].Captures.Count - 1 do
let ph = m.Groups.["placeholder"].Captures.[i].Value
let text = m.Groups.["text"].Captures.[i+1].Value
// TODO: handle flags, width, precision, other placeholder types, etc.
if ph = "%%" then yield K(Expression.Constant("%" + text))
else
match ph with
| "%f" ->
let t = pop()
if t <> typeof<float> && t <> typeof<float32> then
failwithf "Unexpected type for %%f placeholder: %A" t
let e = Expression.Variable t
yield F(e, Expression.Call(e, t.GetMethod("ToString", [| typeof<System.Globalization.CultureInfo> |]), [cultureExpr]))
| "%s" ->
let t = pop()
if t <> typeof<string> then
failwithf "Unexpected type for %%s placeholder: %A" t
let e = Expression.Variable t
yield F(e, e)
| _ ->
failwithf "unhandled placeholder: %s" ph
yield K (Expression.Constant text)]
let innerExpr =
Expression.Call(typeof<string>.GetMethod("Concat", [|typeof<string[]>|]), Expression.NewArrayInit(typeof<string>, exprs |> Seq.map (fun (K e | F(_,e)) -> e)))
:> Expression
let funcConvert =
typeof<FuncConvert>.GetMethods()
|> Seq.find (fun mi -> mi.Name = "ToFSharpFunc" && mi.GetParameters().[0].ParameterType.GetGenericTypeDefinition() = typedefof<Converter<_,_>>)
let body =
List.foldBack (fun pe (e:Expression) ->
match pe with
| K _ -> e
| F(p,_) ->
let m = funcConvert.MakeGenericMethod(p.Type, e.Type)
Expression.Call(m, Expression.Lambda(m.GetParameters().[0].ParameterType, e, p))
:> Expression) exprs innerExpr
Expression.Lambda(body, [||]).Compile().DynamicInvoke() :?> 'a
sprintf' (Globalization.CultureInfo.GetCultureInfo "fr-FR") "%s %f > %f" "It worked!" 1.5f -12.3
Taking a look at source code of Printf module, it uses invariantCulture. I don't think printf-like functions are culture aware.
If you always need a comma, you could use sprintf and string.Replace function. If your code is culture-dependent, using ToString or String.Format is your best bet.