From c6e400e69c53607b7c2fcaa11abef4ff354b3f68 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jind=C5=99ich=20Iv=C3=A1nek?= Date: Tue, 9 Jun 2020 23:02:54 +0200 Subject: [PATCH] Perf: optimze Queue data structure (#902) * use Queue.length instead Seq.length * WIP Queue as List of arrays * Queue as List of arrays * fix SkipExists --- src/Fantomas.Tests/QueueTests.fs | 67 +++++++++++++++- src/Fantomas/Context.fs | 5 +- src/Fantomas/Queue.fs | 130 +++++++++++-------------------- 3 files changed, 114 insertions(+), 88 deletions(-) diff --git a/src/Fantomas.Tests/QueueTests.fs b/src/Fantomas.Tests/QueueTests.fs index 6f47368090..697a36d4c9 100644 --- a/src/Fantomas.Tests/QueueTests.fs +++ b/src/Fantomas.Tests/QueueTests.fs @@ -5,12 +5,73 @@ open NUnit.Framework open FsUnit open FsCheck +module Queue = + let ofLists xss = (Queue.empty, xss) ||> List.fold (fun q xs -> Queue.append q xs) + [] let ``Queue.append``() = Check.One (Config.Default, fun xs ys -> let q = Queue.ofList xs let result q = Queue.append q ys |> Queue.toSeq |> Seq.toList - let expected q = (q, ys) ||> List.fold (fun q y -> Queue.conj y q) |> Queue.toSeq |> Seq.toList - result q |> should equivalent (expected q) - result (Queue.rev q) |> should equivalent (expected (Queue.rev q)) + let expected x = x @ ys + result q |> should equivalent (expected xs) + result (Queue.rev q |> Queue.ofSeq) |> should equivalent (expected (List.rev xs)) + ) + +[] +let ``Queue.tryHead``() = + Check.One (Config.Default, fun xs -> + let result = Queue.ofList xs |> Queue.tryHead + let expected = xs |> List.tryHead + result |> should equal expected + ) + +[] +let ``Queue.length``() = + Check.One (Config.Default, fun xs -> + let result = Queue.ofList xs |> Queue.length + let expected = xs |> List.length + result |> should equal expected + ) + +[] +let ``Queue.rev``() = + Check.One (Config.Default, fun xs -> + let result = Queue.ofList xs |> Queue.rev |> Seq.toList + let expected = xs |> List.rev + result |> should equivalent expected + ) + +[] +let ``Queue.toSeq``() = + Check.One (Config.Default, fun xs -> + let result = Queue.ofList xs |> Queue.toSeq |> Seq.toList + let expected = xs + result |> should equivalent expected + ) + +[] +let ``Queue.skipExists``() = + Check.One (Config.Default, fun xss n -> + let f = id + n <= List.sumBy List.length xss ==> + lazy + (let result = Queue.ofLists xss |> Queue.skipExists n f + let expected = xss |> List.collect id |> Seq.skip n |> Seq.exists f + result |> should equal expected) + ) + + +[] +let ``Queue ref transp``() = + Check.One (Config.Default, fun xs ys zs -> + let result1 = Queue.ofList xs + let result2 = Queue.append result1 ys + let result3 = Queue.append result1 zs + let expected1 = xs + let expected2 = xs @ ys + let expected3 = xs @ zs + result1 |> should equivalent expected1 + result2 |> should equivalent expected2 + result3 |> should equivalent expected3 ) diff --git a/src/Fantomas/Context.fs b/src/Fantomas/Context.fs index 9205e3fa7f..c001dd3b96 100644 --- a/src/Fantomas/Context.fs +++ b/src/Fantomas/Context.fs @@ -184,7 +184,7 @@ let internal writerEvent e ctx = let evs = WriterEvents.normalize e let ctx' = { ctx with - WriterEvents = evs |> Seq.fold (fun q x -> Queue.conj x q) ctx.WriterEvents + WriterEvents = Queue.append ctx.WriterEvents evs WriterModel = (ctx.WriterModel, evs) ||> Seq.fold (fun m e -> WriterModel.update ctx.Config.PageWidth e m) } ctx' let internal finalizeWriterModel (ctx: Context) = @@ -578,7 +578,8 @@ let internal leadingExpressionLong threshold leadingExpression continuationExpre let internal leadingExpressionIsMultiline leadingExpression continuationExpression (ctx: Context) = let eventCountBeforeExpression = Queue.length ctx.WriterEvents let contextAfterLeading = leadingExpression ctx - let hasWriteLineEventsAfterExpression = contextAfterLeading.WriterEvents |>Seq.skip eventCountBeforeExpression |> Seq.exists (function | WriteLine _ -> true | _ -> false) + let hasWriteLineEventsAfterExpression = contextAfterLeading.WriterEvents |> Queue.skipExists eventCountBeforeExpression (function | WriteLine _ -> true | _ -> false) + continuationExpression hasWriteLineEventsAfterExpression contextAfterLeading let private expressionExceedsPageWidth beforeShort afterShort beforeLong afterLong expr (ctx: Context) = diff --git a/src/Fantomas/Queue.fs b/src/Fantomas/Queue.fs index 505e873cb9..64a8cd0613 100644 --- a/src/Fantomas/Queue.fs +++ b/src/Fantomas/Queue.fs @@ -1,11 +1,10 @@ namespace Fantomas -/// FIFO queue, from https://github.com/fsprojects/FSharpx.Collections/blob/master/src/FSharpx.Collections/Queue.fs -type Queue<'T> (front : list<'T>, rBack : list<'T>) = +/// append only collection optimized for quick append of block of data and query operations +/// data - list of blocks in reverse order +type Queue<'T> (data : list<'T[]>, length : int) = let mutable hashCode = None - member internal this.Front = front - member internal this.RBack = rBack - + override this.GetHashCode() = match hashCode with | None -> @@ -25,93 +24,63 @@ type Queue<'T> (front : list<'T>, rBack : list<'T>) = else Seq.forall2 (Unchecked.equals) this y | _ -> false - member this.Conj x = - match front, x::rBack with - | [], r -> Queue((List.rev r), []) - | f, r -> Queue(f, r) - member this.Head = - match front with - | hd::_ -> hd - | _ -> raise (System.Exception("Queue is empty")) + if length > 0 then (List.head data).[0] + else raise (System.Exception("Queue is empty")) member this.TryHead = - match front with - | hd::_ -> Some(hd) - | _ -> None + if length > 0 then Some((List.head data).[0]) + else None - member this.IsEmpty = front.IsEmpty + member this.IsEmpty = + length = 0 - member this.Length = front.Length + rBack.Length + member this.Length = + length member this.Rev() = - match rBack, front with - | [], r -> Queue((List.rev r), []) - | f, r -> Queue(f, r) - - member this.Tail = - match front with - | _::tl -> - match tl, rBack with - | [], r -> Queue((List.rev r), []) - | f, r -> Queue(f, r) - | _ -> raise (System.Exception("Queue is empty")) - - member this.TryTail = - match front with - | _::tl -> - match tl, rBack with - | [], r -> Some(Queue((List.rev r), [])) - | f, r -> Some(Queue(f, r)) - | _ -> None - - member this.Uncons = - match front with - | hd::tl -> - hd, (match tl, rBack with - | [], r -> Queue((List.rev r), []) - | f, r -> Queue(f, r)) - | _ -> raise (System.Exception("Queue is empty")) - - member this.TryUncons = - match front with - | hd::tl -> - match tl, rBack with - | [], r -> Some(hd, Queue((List.rev r), [])) - | f, r -> Some(hd, Queue(f, r)) - | _ -> None + data |> Seq.collect (fun arr -> seq{arr.Length-1 .. -1 .. 0} |> Seq.map (fun i -> arr.[i])) member this.Append xs = - match front, rBack with - | f, [] -> Queue(f @ xs, []) - | f, r -> Queue(f, (List.rev xs) @ r) + Queue(Array.ofList xs :: data, length + List.length xs) + + /// Equivalent of q |> Queue.toSeq |> Seq.skip n |> Seq.exists f, optimized for speed + member this.SkipExists n f = + if n >= length then false else + let mutable i = length - n // how nany items at end + let mutable r = false + let rec dataToEnd acc = function + | (hd: _[]) :: tl -> + if i > hd.Length then + i <- i - hd.Length + dataToEnd (hd::acc) tl + else + i <- hd.Length - i // index in first array + hd::acc + | [] -> acc + let rec exists xs = + match xs with + | (arr: _[]) :: tl -> + while r = false && i < arr.Length do + if f arr.[i] then r <- true + i <- i + 1 + i <- 0 + if r then true else exists tl + | [] -> r + let d = dataToEnd [] data + d |> exists interface System.Collections.Generic.IReadOnlyCollection<'T> with member this.Count = this.Length member this.GetEnumerator() = - let e = seq { - yield! front - yield! (List.rev rBack)} + let e = data |> Seq.rev |> Seq.collect id e.GetEnumerator() member this.GetEnumerator() = (this :> _ seq).GetEnumerator() :> System.Collections.IEnumerator [] module Queue = - //pattern discriminators (active pattern) - let (|Cons|Nil|) (q : Queue<'T>) = match q.TryUncons with Some(a,b) -> Cons(a,b) | None -> Nil - - let inline conj (x : 'T) (q : Queue<'T>) = (q.Conj x) - - let empty<'T> : Queue<'T> = Queue<_>([], []) - - let fold (f : ('State -> 'T -> 'State)) (state : 'State) (q : Queue<'T>) = - let s = List.fold f state q.Front - List.fold f s (List.rev q.RBack) - - let foldBack (f : ('T -> 'State -> 'State)) (q : Queue<'T>) (state : 'State) = - let s = List.foldBack f (List.rev q.RBack) state - (List.foldBack f q.Front s) + let empty<'T> : Queue<'T> = Queue<_>([[||]], 0) let inline head (q : Queue<'T>) = q.Head @@ -121,20 +90,15 @@ module Queue = let inline length (q : Queue<'T>) = q.Length - let ofList xs = Queue<'T>(xs, []) + let ofList xs = Queue<'T>([List.toArray xs], List.length xs) - let ofSeq xs = Queue<'T>((List.ofSeq xs), []) + let ofSeq (xs: seq<_>) = Queue<'T>([Seq.toArray xs], Seq.length xs) let inline rev (q : Queue<'T>) = q.Rev() - let inline tail (q : Queue<'T>) = q.Tail - - let inline tryTail (q : Queue<'T>) = q.TryTail - let inline toSeq (q: Queue<'T>) = q :> seq<'T> - let inline uncons (q : Queue<'T>) = q.Uncons - - let inline tryUncons (q : Queue<'T>) = q.TryUncons + let inline append (q : Queue<'T>) xs = q.Append xs - let inline append (q : Queue<'T>) xs = q.Append xs \ No newline at end of file + /// Equivalent of q |> Queue.toSeq |> Seq.skip n |> Seq.exists f + let inline skipExists n f (q : Queue<'T>) = q.SkipExists n f