Commits

Yit Phang Khoo  committed 41bec79

Add SAList.mergesort.

  • Participants
  • Parent commits 0522383

Comments (0)

Files changed (3)

File Source/Adapton/SAList.ml

             let quicksort xs = quicksort xs (const `Nil) in
             let update_quicksort m xs = update_quicksort m xs (const `Nil) in
             ( quicksort, update_quicksort )
+
+        (**/**) (* internal type of mergesort *)
+        module RunType = MakeBasic (L)
+        (**/**)
+
+        (** Create memoizing constructor and updater to mergesort a self-adjusting list with a comparator. *)
+        let memo_mergesort cmp =
+            let lift, _ = RunType.memo_map (module L) (fun x -> const (`Cons ( x, const `Nil ))) in
+            let merge, _ = memo2 (module L) (module L) begin fun merge xs ys -> match force xs, force ys with
+                | `Cons ( x', xs' ), `Cons ( y', ys' ) ->
+                    if cmp x' y' < 0 then
+                        `Cons ( x', merge xs' ys )
+                    else
+                        `Cons ( y', merge xs ys' )
+                | xs'', `Nil ->
+                    xs''
+                | `Nil, ys'' ->
+                    ys''
+            end in
+            let mergesort, _ = RunType.memo_tfold merge in
+            memo (module L) begin fun _ xs -> match force xs with
+                | `Cons _ -> force (RunType.SAData.force (mergesort (lift xs)))
+                | `Nil -> `Nil
+            end
     end
 end

File Source/Adapton/Signatures.ml

             : (module Hashtbl.SeededHashedType with type t = 'a) -> ('a -> data -> bool)
                 -> ('a -> t -> PartitionType.t) * (PartitionType.t -> 'a -> t -> unit)
         val memo_quicksort : (data -> data -> int) -> (t -> t) * (t -> t -> unit)
+        val memo_mergesort : (data -> data -> int) -> (t -> t) * (t -> t -> unit)
     end
 end = SAListType
 

File Test/TestAdapton/TestSAList.ml

                 (List.sort compare) quicksort
         end;
 
+        "mergesort" >:: begin fun () ->
+            let mergesort, _ = I.memo_mergesort compare in
+            test_salist_op (List.sort compare) mergesort
+        end;
+
         "filter map" >:: QC.forall QC.int begin fun p ->
             let pred = (<) p in
             let filter_pred, _ = I.memo_filter pred in