Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
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