#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