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 +++++++++++++++++++++++++
 1 file changed, 25 insertions(+)

(limited to 'lib/ur/list.ur')

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
-- 
cgit v1.2.3


From 026e50ceaad69147ae05386ea342861d18021cd5 Mon Sep 17 00:00:00 2001
From: Alexander Abushkevich <alex@abushkevi.ch>
Date: Wed, 24 Feb 2016 15:14:13 +1300
Subject: Return lists in their original order in span function

---
 lib/ur/list.ur | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'lib/ur/list.ur')

diff --git a/lib/ur/list.ur b/lib/ur/list.ur
index f3bb0587..eac5ab0c 100644
--- a/lib/ur/list.ur
+++ b/lib/ur/list.ur
@@ -439,8 +439,8 @@ 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)
+                []      =>  (rev acc, [])
+              | x :: xs =>  if (f x) then span' f (x :: acc) xs else (rev acc, ls)
     in
         span' f [] ls
     end
-- 
cgit v1.2.3


From b0368093645dcb7f65e131862d8ae9c81f2844f2 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@csail.mit.edu>
Date: Fri, 26 Feb 2016 10:32:08 -0500
Subject: More consistent formatting for new List functions

---
 lib/ur/list.ur    | 26 +++++++++++++-------------
 lib/ur/list.urs   |  4 ++--
 tests/groupBy.ur  |  3 +++
 tests/groupBy.urp |  4 ++++
 4 files changed, 22 insertions(+), 15 deletions(-)
 create mode 100644 tests/groupBy.ur
 create mode 100644 tests/groupBy.urp

(limited to 'lib/ur/list.ur')

diff --git a/lib/ur/list.ur b/lib/ur/list.ur
index eac5ab0c..50764e46 100644
--- a/lib/ur/list.ur
+++ b/lib/ur/list.ur
@@ -435,29 +435,29 @@ 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  = 
+fun span [a] (f : a -> bool) (ls : list a) : list a * list a  = 
     let
-        fun span' f acc ls =
+        fun span' ls acc =
             case ls of
                 []      =>  (rev acc, [])
-              | x :: xs =>  if (f x) then span' f (x :: acc) xs else (rev acc, ls)
+              | x :: xs =>  if f x then span' xs (x :: acc) else (rev acc, ls)
     in
-        span' f [] ls
+        span' ls []
     end
     
-fun groupBy [a] (f:(a -> a -> bool)) (ls:list a) : list (list a) = 
+fun groupBy [a] (f : a -> a -> bool) (ls : list a) : list (list a) = 
     let
-        fun groupBy' f ls = 
+        fun groupBy' ls acc =
             case ls of
-                [] => [] :: []
+                [] => rev ([] :: acc)
               | x :: xs => 
-                    let
-                        val (ys, zs) = span (f x) xs
-                    in 
-                        (x :: ys) :: (groupBy' f zs)
-                    end
+                let
+                    val (ys, zs) = span (f x) xs
+                in 
+                    groupBy' zs ((x :: ys) :: acc)
+                end
     in
-        groupBy' f ls
+        groupBy' ls []
     end
 
 fun mapXiM [m ::: Type -> Type] (_ : monad m) [a] [ctx ::: {Unit}] (f : int -> a -> m (xml ctx [] [])) : t a -> m (xml ctx [] []) =
diff --git a/lib/ur/list.urs b/lib/ur/list.urs
index ac874d7c..432d8c1a 100644
--- a/lib/ur/list.urs
+++ b/lib/ur/list.urs
@@ -106,8 +106,8 @@ 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 *)
+(** Longest prefix of elements that satisfy a predicate, returned along with the remaining suffix *)
 val span : a ::: Type -> (a -> bool) -> t a -> t a * t a
 
-(** Group a list *)
+(** Group a list into maximal adjacent segments where all elements compare as equal, according to the provided predicate. *)
 val groupBy : a ::: Type -> (a -> a -> bool) -> t a -> t (t a)
diff --git a/tests/groupBy.ur b/tests/groupBy.ur
new file mode 100644
index 00000000..e91e33cc
--- /dev/null
+++ b/tests/groupBy.ur
@@ -0,0 +1,3 @@
+val main : transaction page = return <xml><body>
+  {[List.groupBy eq (1 :: 1 :: 2 :: 2 :: 3 :: 4 :: 4 :: 4 :: 5 :: [])]}
+</body></xml>
diff --git a/tests/groupBy.urp b/tests/groupBy.urp
new file mode 100644
index 00000000..de1db792
--- /dev/null
+++ b/tests/groupBy.urp
@@ -0,0 +1,4 @@
+rewrite all GroupBy/*
+
+$/list
+groupBy
-- 
cgit v1.2.3