From 746e16d83aaf284f996bcc6d61f0d9ba99c099b2 Mon Sep 17 00:00:00 2001
From: Alexander Abushkevich <alex@abushkevi.ch>
Date: Tue, 23 Feb 2016 00:49:17 +1300
Subject: Find longest prefix of elements, which satisfy a predicate; Group a
 list

---
 lib/ur/list.ur  | 25 +++++++++++++++++++++++++
 lib/ur/list.urs |  6 ++++++
 2 files changed, 31 insertions(+)

(limited to 'lib')

diff --git a/lib/ur/list.ur b/lib/ur/list.ur
index 11895884..f3bb0587 100644
--- a/lib/ur/list.ur
+++ b/lib/ur/list.ur
@@ -434,6 +434,31 @@ fun drop [a] (n : int) (xs : list a) : list a =
 
 fun splitAt [a] (n : int) (xs : list a) : list a * list a =
     (take n xs, drop n xs)
+    
+fun span [a] (f:(a -> bool)) (ls:list a) : list a * list a  = 
+    let
+        fun span' f acc ls =
+            case ls of
+                []      =>  (acc, [])
+              | x :: xs =>  if (f x) then span' f (x :: acc) xs else (acc, ls)
+    in
+        span' f [] ls
+    end
+    
+fun groupBy [a] (f:(a -> a -> bool)) (ls:list a) : list (list a) = 
+    let
+        fun groupBy' f ls = 
+            case ls of
+                [] => [] :: []
+              | x :: xs => 
+                    let
+                        val (ys, zs) = span (f x) xs
+                    in 
+                        (x :: ys) :: (groupBy' f zs)
+                    end
+    in
+        groupBy' f ls
+    end
 
 fun mapXiM [m ::: Type -> Type] (_ : monad m) [a] [ctx ::: {Unit}] (f : int -> a -> m (xml ctx [] [])) : t a -> m (xml ctx [] []) =
     let
diff --git a/lib/ur/list.urs b/lib/ur/list.urs
index 55068935..ac874d7c 100644
--- a/lib/ur/list.urs
+++ b/lib/ur/list.urs
@@ -105,3 +105,9 @@ val recToList : a ::: Type -> r ::: {Unit} -> folder r -> $(mapU a r) -> t a
 val drop : t ::: Type -> int -> list t -> list t
 val take : t ::: Type -> int -> list t -> list t
 val splitAt : t ::: Type -> int -> list t -> list t * list t
+
+(** Longest prefix of elements, which satisfy a predicate *)
+val span : a ::: Type -> (a -> bool) -> t a -> t a * t a
+
+(** Group a list *)
+val groupBy : a ::: Type -> (a -> a -> bool) -> t a -> t (t a)
-- 
cgit v1.2.3