我正在开发一个小项目来使用引用来克隆某些基本记录类型的树,并且我在大多数情况下都使用它,我遇到的最大问题是数组。
module FSharpType =
/// predicate for testing types to see if they are generic option types
let IsOption (stype: System.Type) = stype.Name = "FSharpOption`1"
/// predicate for testing types to see if they are generic F# lists
let IsList (stype: System.Type) = stype.Name = "FSharpList`1"
module RecordCloning =
let inline application prms expr = Expr.Application(expr, prms)
let inline coerse typ expr = Expr.Coerce(expr, typ)
let (|IsMapType|_|) (t: Type) =
if t.IsGenericType && t.GetGenericTypeDefinition() = typedefof<Map<_,_>> then Some t
else None
let rec copyThing (mtype: Type) : Expr =
match mtype with
| _ when FSharpType.IsRecord mtype -> genRecordCopier mtype
| _ when FSharpType.IsUnion mtype -> genUnionCopier mtype
| _ when mtype.IsValueType || mtype = typeof<String> -> <@@ id @@>
| _ when mtype.IsArray -> genArrayCopier mtype
| IsMapType t -> <@@ id @@>
| _ when mtype = typeof<System.Object> -> <@@ id @@>
| _ -> failwithf "Unexpected Type: %s" (mtype.ToString())
and genRecordCopier (rtype: Type) : Expr =
let arg = Var("x", typeof<obj>, false)
let argExpr = Expr.Var(arg)
let useArg = Expr.Coerce(argExpr, rtype)
let fields = FSharpType.GetRecordFields(rtype)
let members = [ for field in fields -> genFieldCopy useArg field ]
let newrec = Expr.Coerce(Expr.NewRecord(rtype, members),typeof<obj>)
Expr.Lambda(arg, newrec)
and genFieldCopy argExpr (field: PropertyInfo) : Expr =
let pval = Expr.PropertyGet(argExpr, field)
let convfun = copyThing field.PropertyType
let applied = Expr.Application (convfun, Expr.Coerce(pval, typeof<obj>))
Expr.Coerce(applied, field.PropertyType)
and castToType (atype : Type) : Expr =
let arg = Var("x", typeof<obj>, false)
let argExpr = Expr.Var(arg)
Expr.Lambda(arg, Expr.Coerce(argExpr, atype))
and coerseLambda (outterType: Type) (lambda: Expr) : Expr =
let arg = Var("x", outterType, false)
let argExpr = Expr.Var(arg)
let wrappedLambda =
lambda
|> application (argExpr |> coerse typeof<obj>)
|> coerse outterType
Expr.Lambda(arg, wrappedLambda)
and genArrayCopier (atype : Type) : Expr =
let etype = atype.GetElementType()
let copyfun = copyThing etype
let arg = Var("arr", typeof<obj>, false)
let argExpr = Expr.Var(arg) |> coerse atype
let wrappedLambda = coerseLambda etype copyfun
let func = <@@ Array.map (%%wrappedLambda) (%%argExpr) @@>
Expr.Lambda(arg, func)
and genOptionCopier (otype: Type) : Expr =
let etype = otype.GetGenericArguments().[0]
let copyfun = copyThing etype
<@@ fun (inobj: obj) ->
let x = inobj :?> Option<'t>
match x with
| Some v -> Some <| (%%copyfun) (box v)
| None -> None
|> box
@@>
and genUnionCopier (utype: Type) : Expr =
let cases = FSharpType.GetUnionCases utype
// if - union case - then - copy each field into new case - else - next case
let arg = Var("x", typeof<obj>, false)
let argExpr = Expr.Var(arg)
let useArg = Expr.Coerce(argExpr, utype)
let genCaseTest case = Expr.UnionCaseTest (useArg, case)
let makeCopyCtor (ci: UnionCaseInfo) =
let copiedMembers = [ for field in ci.GetFields() -> genFieldCopy useArg field ]
Expr.Coerce(Expr.NewUnionCase(ci, copiedMembers), typeof<obj>)
let genIf ifCase thenCase elseCase = Expr.IfThenElse(ifCase, thenCase, elseCase)
let nestedIfs =
cases
|> Array.map (fun case -> genIf (genCaseTest case) (makeCopyCtor case))
|> Array.foldBack (fun iff st -> iff st) <| <@@ failwith "Unexpected Case Condition" @@>
let newunion = Expr.Coerce(nestedIfs,typeof<obj>)
Expr.Lambda(arg, newunion)
let wrapInType<'I,'O> (lambdaExpr: Expr) : Expr<'I -> 'O> =
<@ fun (v : 'I) -> (%%lambdaExpr : obj -> obj) (box v) :?> 'O @>
let toLinq<'I,'O> (expr: Expr<'I -> 'O>) =
let linq = Microsoft.FSharp.Linq.RuntimeHelpers.LeafExpressionConverter.QuotationToExpression expr
let call = linq :?> MethodCallExpression
let lambda = call.Arguments.[0] :?> LambdaExpression
Expression.Lambda<Func<'I,'O>>(lambda.Body, lambda.Parameters)
let genrateRecordDeepCopyFunction<'T> () : ('T -> 'T) =
let expr = genRecordCopier typeof<'T>
let castExpr : Expr<obj -> obj> = expr |> Expr.Cast
let compiledExpr = (castExpr |> toLinq).Compile()
fun (v : 'T) -> compiledExpr.Invoke(box v) :?> 'T
我尝试了几种方法,但我总是抱怨想要(string - &gt;字符串)但得到(obj - &gt; obj)或想要(object [] - &gt; object [])但得到(string [] - &gt; string [])。有什么想法吗?
这是一个简单的测试案例。
type SimpleArrayRecord = { Names: string array }
[<Fact>]
let ``record cloning should be able to clone a record with a simple array`` () =
let sr = { Names = [|"Rick"; "David"; "Mark"; "Paul"; "Pete"|] }
let func = RecordCloning.genrateRecordDeepCopyFunction<SimpleArrayRecord>()
let res = func sr
Assert.Equal(sr, res)
这里的方法让我走得最远。问题似乎是我无法让它输入数组,因此在尝试构建记录时总是会失败。在理解中添加演员阵容并没有帮助。
and genArrayCopier (atype : Type) : Expr =
let etype = atype.GetElementType()
let copyfun = copyThing etype
let arg = Var("arr", typeof<obj>, false)
let argExpr = Expr.Var(arg) |> coerse atype
<@@ fun (inobj: obj) ->
let arr = inobj :?> obj[] in
[| for i = 0 to arr.Length - 1 do yield (%%copyfun) (Array.get arr i) |] |> box @@>
以下的Toyvo解决方案适用于上述示例,但不适用于记录数组:
type SimpleRecord = { Name: string; Age: int }
type LotsOfRecords = { People: SimpleRecord [] }
[<Fact>]
let ``record cloning should be able to clone a record with an array of records`` () =
let sr = { People = [|{Name = "Rick"; Age = 33 }; { Name = "Paul"; Age = 55 }|] }
let func = RecordCloning.genrateRecordDeepCopyFunction<LotsOfRecords>()
let res = func sr
Assert.Equal(sr, res)
对于后来的人来说,这是工作代码。我删除了Option并且没有花时间来清理它,但它还不错。
let inline application prms expr = Expr.Application(expr, prms)
let inline coerse typ expr = Expr.Coerce(expr, typ)
let inline newrec typ args = Expr.NewRecord(typ, args)
let (|IsMapType|_|) (t: Type) =
if t.IsGenericType && t.GetGenericTypeDefinition() = typedefof<Map<_,_>> then Some t
else None
let rec copyThing (mtype: Type) : Expr =
match mtype with
| _ when FSharpType.IsRecord mtype -> genRecordCopier mtype
| _ when FSharpType.IsUnion mtype -> genUnionCopier mtype
| _ when mtype.IsValueType || mtype = typeof<String> -> getIdFunc mtype
| _ when mtype.IsArray -> genArrayCopier mtype
| IsMapType t -> getIdFunc mtype
| _ when mtype = typeof<System.Object> -> getIdFunc mtype
| _ -> failwithf "Unexpected Type: %s" (mtype.ToString())
and X<'T> : 'T = Unchecked.defaultof<'T>
and getMethod =
function
| Patterns.Call (_, m, _) when m.IsGenericMethod -> m.GetGenericMethodDefinition()
| Patterns.Call (_, m, _) -> m
| _ -> failwith "Incorrect getMethod Pattern"
and getIdFunc itype =
let arg = Var("x", itype, false)
let argExpr = Expr.Var(arg)
let func =
let m = (getMethod <@ id X @>).MakeGenericMethod([|itype|])
Expr.Call(m, [argExpr])
Expr.Lambda(arg, func)
and genRecordCopier (rtype: Type) : Expr =
let arg = Var("x", rtype, false)
let argExpr = Expr.Var(arg) //|> coerse rtype
let newrec =
FSharpType.GetRecordFields(rtype) |> Array.toList
|> List.map (fun field -> genFieldCopy argExpr field)
|> newrec rtype
Expr.Lambda(arg, newrec)
and genFieldCopy argExpr (field: PropertyInfo) : Expr =
let pval = Expr.PropertyGet(argExpr, field)
copyThing field.PropertyType |> application pval
and genArrayCopier (atype : Type) : Expr =
let etype = atype.GetElementType()
let copyfun = copyThing etype
let arg = Var("arr", atype, false)
let argExpr = Expr.Var(arg)
let func =
let m = (getMethod <@ Array.map X X @>).MakeGenericMethod([|etype; etype|])
Expr.Call(m, [copyfun; argExpr])
Expr.Lambda(arg, func)
and genUnionCopier (utype: Type) : Expr =
let cases = FSharpType.GetUnionCases utype
// if - union case - then - copy each field into new case - else - next case
let arg = Var("x", utype, false)
let useArg = Expr.Var(arg)
let genCaseTest case = Expr.UnionCaseTest (useArg, case)
let makeCopyCtor (ci: UnionCaseInfo) =
let copiedMembers = [ for field in ci.GetFields() -> genFieldCopy useArg field ]
Expr.NewUnionCase(ci, copiedMembers)
let genIf ifCase thenCase elseCase = Expr.IfThenElse(ifCase, thenCase, elseCase)
let typedFail (str: string) =
let m = (getMethod <@ failwith str @>).MakeGenericMethod([|utype|])
Expr.Call(m, [ <@ str @> ])
let nestedIfs =
cases
|> Array.map (fun case -> genIf (genCaseTest case) (makeCopyCtor case))
|> Array.foldBack (fun iff st -> iff st) <| (typedFail "Unexpected Case in Union")
Expr.Lambda(arg, nestedIfs)
现在它实际上也适用于工会。干杯!
答案 0 :(得分:7)
如果您这样做,请确保您了解泛型以及如何生成它们。你在LISP的土地,类型系统不会帮助你,因为它不能解释自己 - 你正在用F#操纵F#术语。
and getMethod q =
match q with
| Patterns.Call (_, m, _) ->
if m.IsGenericMethod then
m.GetGenericMethodDefinition()
else
m
| _ -> failwith "getMethod"
and X<'T> : 'T =
Unchecked.defaultof<'T>
and genArrayCopier (atype : Type) : Expr =
let etype = atype.GetElementType()
let copyfun = copyThing etype
let arg = Var("arr", typeof<obj>, false)
let argExpr = Expr.Var(arg) |> coerse atype
let wrappedLambda = coerseLambda etype copyfun
let func =
let m = getMethod <@ Array.map X X @> // obtained (forall 'X 'Y, 'X[] -> 'Y[])
let m = m.MakeGenericMethod([| etype; etype |]) // specialized to 'E[] -> 'E[]
Expr.Call(m, [wrappedLambda; argExpr]) // now this type-checks
Expr.Lambda(arg, func)