fork download
  1. open System
  2. open LanguagePrimitives
  3.  
  4. module RoundedCalculation =
  5. [<Measure>]
  6. type rounded
  7. type NotRounded = float
  8. type Rounded = float<rounded>
  9.  
  10. let mutable _sigDigs = 0
  11.  
  12. let inline round x = Math.Round(float x, _sigDigs) |> FloatWithMeasure<rounded>
  13.  
  14. let (+.) (x:Rounded) (y:Rounded) =
  15. x + y |> round
  16. let (-. ) (x:Rounded) (y:Rounded) =
  17. x - y |> round
  18. let (/.) (x:Rounded) (y:Rounded) =
  19. x / y |> round
  20. let ( *. ) (x:Rounded) (y:Rounded) =
  21. x * y |> round
  22.  
  23.  
  24. type RoundingWorkflow() =
  25. /// NotRounded -> (Rounded->NotRounded) -> NotRounded
  26. member this.Bind(result : NotRounded, rest : Rounded -> NotRounded) : NotRounded =
  27. round result
  28. |> rest
  29. /// Rounded -> NotRounded
  30. member this.Return (x:Rounded) : NotRounded = float x
  31.  
  32. let withPrecision sigDigs =
  33. _sigDigs <- sigDigs
  34. new RoundingWorkflow()
  35.  
  36. open RoundedCalculation
  37.  
  38. let rest : float =
  39. withPrecision 3 {
  40. let! x = 1.005
  41. let! y = 2.004
  42. let xPlusY = x +. y
  43. let! a = 1.994
  44. let! b = 0.995
  45. let aMinusB = a -. b
  46. let z = xPlusY *. aMinusB
  47. return z
  48. }
  49.  
  50. printfn "%f" rest
  51. // 3.006000
Success #stdin #stdout 0.11s 12000KB
stdin
Standard input is empty
stdout
3.006000