ChaosBuilder
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| #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