ChaosBuilder
| #r "packages/Unquote/lib/net45/Unquote.dll" | |
| open FSharp.Quotations | |
| open Swensen.Unquote | |
| type IMutationSitePicker = | |
| abstract member PickNextSite: bool | |
| abstract member NotifyIgnoredSite: unit -> unit | |
| abstract member NotifyMutation: unit -> unit | |
| type IExpressionReplacer = | |
| abstract member ReplaceSignedConstant: Expr -> Expr | |
| abstract member ReplaceUnsignedConstant: Expr -> Expr | |
| abstract member ReplaceBinaryArithmeticOperator: Expr * Expr * Expr -> Expr | |
| let rec mutate (mutationSitePicker:IMutationSitePicker) (expressionReplacer:IExpressionReplacer) (expr:Expr) = | |
| match expr with | |
| | DerivedPatterns.Byte _ | |
| | DerivedPatterns.SByte _ | |
| | DerivedPatterns.Single _ | |
| | DerivedPatterns.Double _ | |
| | DerivedPatterns.Decimal _ | |
| | DerivedPatterns.Int16 _ | |
| | DerivedPatterns.UInt16 _ | |
| | DerivedPatterns.Int32 _ | |
| | DerivedPatterns.UInt32 _ | |
| | DerivedPatterns.Int64 _ | |
| | DerivedPatterns.UInt64 _ when not mutationSitePicker.PickNextSite -> | |
| mutationSitePicker.NotifyIgnoredSite() | |
| expr | |
| | DerivedPatterns.SpecificCall <@@ (+) @@> _ | |
| | DerivedPatterns.SpecificCall <@@ (-) @@> _ | |
| | DerivedPatterns.SpecificCall <@@ (*) @@> _ | |
| | DerivedPatterns.SpecificCall <@@ (/) @@> _ when not mutationSitePicker.PickNextSite -> | |
| mutationSitePicker.NotifyIgnoredSite() | |
| expr | |
| | DerivedPatterns.SByte _ | |
| | DerivedPatterns.Single _ | |
| | DerivedPatterns.Double _ | |
| | DerivedPatterns.Decimal _ | |
| | DerivedPatterns.Int16 _ | |
| | DerivedPatterns.Int32 _ | |
| | DerivedPatterns.Int64 _ -> | |
| mutationSitePicker.NotifyMutation() | |
| expressionReplacer.ReplaceSignedConstant(expr) | |
| | DerivedPatterns.Byte _ | |
| | DerivedPatterns.UInt16 _ | |
| | DerivedPatterns.UInt32 _ | |
| | DerivedPatterns.UInt64 _ -> | |
| mutationSitePicker.NotifyMutation() | |
| expressionReplacer.ReplaceUnsignedConstant(expr) | |
| | DerivedPatterns.SpecificCall <@@ (+) @@> (_, _, [e1; e2]) | |
| | DerivedPatterns.SpecificCall <@@ (-) @@> (_, _, [e1; e2]) | |
| | DerivedPatterns.SpecificCall <@@ (*) @@> (_, _, [e1; e2]) | |
| | DerivedPatterns.SpecificCall <@@ (/) @@> (_, _, [e1; e2]) -> | |
| mutationSitePicker.NotifyMutation() | |
| let e1' = mutate mutationSitePicker expressionReplacer e1 | |
| let e2' = mutate mutationSitePicker expressionReplacer e2 | |
| expressionReplacer.ReplaceBinaryArithmeticOperator(expr, e1', e2') | |
| | ExprShape.ShapeVar _ -> expr | |
| | ExprShape.ShapeLambda (var, expression) -> | |
| let expression' = mutate mutationSitePicker expressionReplacer expression | |
| Expr.Lambda(var, expression') | |
| | ExprShape.ShapeCombination(shape, expressions) -> | |
| let expressions' = expressions |> List.map (mutate mutationSitePicker expressionReplacer) | |
| ExprShape.RebuildShapeCombination(shape, expressions') | |
| type ChaosBuilder (mutationSitePicker:IMutationSitePicker, expressionReplacer:IExpressionReplacer) = | |
| member this.Return(x) = x | |
| member this.Quote (expr) = expr | |
| member this.Run (expr:Expr<'T>) = | |
| let choaticExpr = mutate mutationSitePicker expressionReplacer expr | |
| choaticExpr.Eval<'T>() | |
| type MutateOnceEvery(interval) = | |
| let mutable nextMutation = interval | |
| interface IMutationSitePicker with | |
| member this.PickNextSite = nextMutation <= 0 | |
| member this.NotifyIgnoredSite() = nextMutation <- nextMutation - 1 | |
| member this.NotifyMutation() = nextMutation <- nextMutation + interval | |
| type MutateWithProbability(proportion) = | |
| let r = new System.Random() | |
| let mutable lastRandom = r.NextDouble() | |
| interface IMutationSitePicker with | |
| member this.PickNextSite = lastRandom < proportion | |
| member this.NotifyIgnoredSite() = lastRandom <- r.NextDouble() | |
| member this.NotifyMutation() = lastRandom <- r.NextDouble() | |
| [<RequireQualifiedAccess>] | |
| type SignedConstantMutation = | |
| | AbsoluteZero | |
| | AbsolutePlusOne | |
| | RelativePlusOne | |
| | AbsoluteMinusOne | |
| | RelativeMinusOne | |
| [<RequireQualifiedAccess>] | |
| type UnsignedConstantMutation = | |
| | AbsoluteZero | |
| | AbsolutePlusOne | |
| | RelativePlusOne | |
| | RelativeMinusOne | |
| [<RequireQualifiedAccess>] | |
| type BinaryArithmeticOperator = | |
| | Plus | |
| | Minus | |
| | MultipliedBy | |
| | DividedBy | |
| let inline mutateSignedConstant (mutation:SignedConstantMutation) (value:'T) = | |
| match mutation with | |
| | SignedConstantMutation.AbsoluteZero -> LanguagePrimitives.GenericZero<'T> | |
| | SignedConstantMutation.AbsolutePlusOne -> LanguagePrimitives.GenericOne<'T> | |
| | SignedConstantMutation.RelativePlusOne -> value + LanguagePrimitives.GenericOne<'T> | |
| | SignedConstantMutation.AbsoluteMinusOne -> - LanguagePrimitives.GenericOne<'T> | |
| | SignedConstantMutation.RelativeMinusOne -> value - LanguagePrimitives.GenericOne<'T> | |
| let inline mutateUnsignedConstant (mutation:UnsignedConstantMutation) (value:'T) = | |
| match mutation with | |
| | UnsignedConstantMutation.AbsolutePlusOne -> LanguagePrimitives.GenericOne<'T> | |
| | UnsignedConstantMutation.RelativePlusOne -> value + LanguagePrimitives.GenericOne<'T> | |
| | UnsignedConstantMutation.RelativeMinusOne when value > LanguagePrimitives.GenericOne<'T> -> value - LanguagePrimitives.GenericOne<'T> | |
| | _ -> LanguagePrimitives.GenericZero<'T> | |
| let mutateBinaryArithmeticOperatorInInt32Expr (newOperator:BinaryArithmeticOperator) (e1:Expr, e2:Expr) = | |
| match newOperator with | |
| | BinaryArithmeticOperator.Plus -> <@@ (%%e1:int) + (%%e2:int) @@> | |
| | BinaryArithmeticOperator.Minus -> <@@ (%%e1:int) - (%%e2:int) @@> | |
| | BinaryArithmeticOperator.MultipliedBy -> <@@ (%%e1:int) * (%%e2:int) @@> | |
| | BinaryArithmeticOperator.DividedBy -> <@@ (%%e1:int) / (%%e2:int) @@> | |
| let mutateBinaryArithmeticOperatorInDoubleExpr (newOperator:BinaryArithmeticOperator) (e1:Expr, e2:Expr) = | |
| match newOperator with | |
| | BinaryArithmeticOperator.Plus -> <@@ (%%e1:double) + (%%e2:double) @@> | |
| | BinaryArithmeticOperator.Minus -> <@@ (%%e1:double) - (%%e2:double) @@> | |
| | BinaryArithmeticOperator.MultipliedBy -> <@@ (%%e1:double) * (%%e2:double) @@> | |
| | BinaryArithmeticOperator.DividedBy -> <@@ (%%e1:double) / (%%e2:double) @@> | |
| type RandomExpressionReplacer() = | |
| let r = new System.Random() | |
| let getRandomSignedMutation() = | |
| let cases = FSharp.Reflection.FSharpType.GetUnionCases(typeof<SignedConstantMutation>) | |
| let index = r.Next(cases.Length) | |
| FSharp.Reflection.FSharpValue.MakeUnion(cases.[index], [||]) :?> SignedConstantMutation | |
| let getRandomUnsignedMutation() = | |
| let cases = FSharp.Reflection.FSharpType.GetUnionCases(typeof<UnsignedConstantMutation>) | |
| let index = r.Next(cases.Length) | |
| FSharp.Reflection.FSharpValue.MakeUnion(cases.[index], [||]) :?> UnsignedConstantMutation | |
| let getRandomBinaryArithmeticOperatorDifferentFrom operatorToExclude = | |
| let cases = | |
| FSharp.Reflection.FSharpType.GetUnionCases(typeof<BinaryArithmeticOperator>) | |
| |> Array.map (fun uc -> FSharp.Reflection.FSharpValue.MakeUnion(uc, [||]) :?> BinaryArithmeticOperator) | |
| |> Array.filter (fun op -> op <> operatorToExclude) | |
| let index = r.Next(cases.Length) | |
| cases.[index] | |
| interface IExpressionReplacer with | |
| member this.ReplaceSignedConstant expr = | |
| match expr with | |
| | DerivedPatterns.SByte i -> | |
| Expr.Value(mutateSignedConstant (getRandomSignedMutation()) i) | |
| | DerivedPatterns.Single i -> | |
| Expr.Value(mutateSignedConstant (getRandomSignedMutation()) i) | |
| | DerivedPatterns.Double i -> | |
| Expr.Value(mutateSignedConstant (getRandomSignedMutation()) i) | |
| | DerivedPatterns.Decimal i -> | |
| Expr.Value(mutateSignedConstant (getRandomSignedMutation()) i) | |
| | DerivedPatterns.Int16 i -> | |
| Expr.Value(mutateSignedConstant (getRandomSignedMutation()) i) | |
| | DerivedPatterns.Int32 i -> | |
| Expr.Value(mutateSignedConstant (getRandomSignedMutation()) i) | |
| | DerivedPatterns.Int64 i -> | |
| Expr.Value(mutateSignedConstant (getRandomSignedMutation()) i) | |
| | _ -> | |
| invalidArg "expr" "This expression shape is not supported" | |
| member this.ReplaceUnsignedConstant expr = | |
| match expr with | |
| | DerivedPatterns.UInt16 i -> | |
| Expr.Value(mutateUnsignedConstant (getRandomUnsignedMutation()) i) | |
| | DerivedPatterns.UInt32 i -> | |
| Expr.Value(mutateUnsignedConstant (getRandomUnsignedMutation()) i) | |
| | DerivedPatterns.UInt64 i -> | |
| Expr.Value(mutateUnsignedConstant (getRandomUnsignedMutation()) i) | |
| | DerivedPatterns.Byte i -> | |
| Expr.Value(mutateUnsignedConstant (getRandomUnsignedMutation()) i) | |
| | _ -> | |
| invalidArg "expr" "This expression shape is not supported" | |
| member this.ReplaceBinaryArithmeticOperator(expr, e1, e2) = | |
| match expr with | |
| | DerivedPatterns.SpecificCall <@ (+) @> _ when expr.Type = typeof<int> -> | |
| mutateBinaryArithmeticOperatorInInt32Expr (getRandomBinaryArithmeticOperatorDifferentFrom BinaryArithmeticOperator.Plus) (e1, e2) | |
| | DerivedPatterns.SpecificCall <@ (-) @> _ when expr.Type = typeof<int> -> | |
| mutateBinaryArithmeticOperatorInInt32Expr (getRandomBinaryArithmeticOperatorDifferentFrom BinaryArithmeticOperator.Minus) (e1, e2) | |
| | DerivedPatterns.SpecificCall <@ (*) @> _ when expr.Type = typeof<int> -> | |
| mutateBinaryArithmeticOperatorInInt32Expr (getRandomBinaryArithmeticOperatorDifferentFrom BinaryArithmeticOperator.MultipliedBy) (e1, e2) | |
| | DerivedPatterns.SpecificCall <@ (/) @> _ when expr.Type = typeof<int> -> | |
| mutateBinaryArithmeticOperatorInInt32Expr (getRandomBinaryArithmeticOperatorDifferentFrom BinaryArithmeticOperator.DividedBy) (e1, e2) | |
| | DerivedPatterns.SpecificCall <@ (+) @> _ when expr.Type = typeof<double> -> | |
| mutateBinaryArithmeticOperatorInDoubleExpr (getRandomBinaryArithmeticOperatorDifferentFrom BinaryArithmeticOperator.Plus) (e1, e2) | |
| | DerivedPatterns.SpecificCall <@ (-) @> _ when expr.Type = typeof<double> -> | |
| mutateBinaryArithmeticOperatorInDoubleExpr (getRandomBinaryArithmeticOperatorDifferentFrom BinaryArithmeticOperator.Minus) (e1, e2) | |
| | DerivedPatterns.SpecificCall <@ (*) @> _ when expr.Type = typeof<double> -> | |
| mutateBinaryArithmeticOperatorInDoubleExpr (getRandomBinaryArithmeticOperatorDifferentFrom BinaryArithmeticOperator.MultipliedBy) (e1, e2) | |
| | DerivedPatterns.SpecificCall <@ (/) @> _ when expr.Type = typeof<double> -> | |
| mutateBinaryArithmeticOperatorInDoubleExpr (getRandomBinaryArithmeticOperatorDifferentFrom BinaryArithmeticOperator.DividedBy) (e1, e2) | |
| | _ -> | |
| invalidArg "expr" "This expression shape is not supported" | |
| let never = new ChaosBuilder (MutateOnceEvery 0, new RandomExpressionReplacer()) | |
| let usually = new ChaosBuilder (MutateOnceEvery 10, new RandomExpressionReplacer()) | |
| let always = new ChaosBuilder (MutateOnceEvery System.Int32.MaxValue, new RandomExpressionReplacer()) | |
| let mostProbably = new ChaosBuilder (MutateWithProbability 0.05, new RandomExpressionReplacer()) | |
| let theAnswer = usually { return 42 } | |
| let basicArithmetic = mostProbably { return 6 * 7 } | |
| let test = mostProbably { | |
| let x = 2 | |
| let y = 3 | |
| let alpha = System.Math.PI | |
| let w = 4M | |
| return System.Convert.ToDouble(x + y) + sin alpha * System.Convert.ToDouble(w) | |
| } |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment