Mercurial > urweb
diff demo/more/dlist.ur @ 953:301530da2062
Bad sort functions tested
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 17 Sep 2009 14:57:38 -0400 |
parents | 07569af40069 |
children | 2a50da66ffd8 |
line wrap: on
line diff
--- a/demo/more/dlist.ur Thu Sep 17 14:42:02 2009 -0400 +++ b/demo/more/dlist.ur Thu Sep 17 14:57:38 2009 -0400 @@ -79,11 +79,57 @@ fun renderFlat [ctx] [ctx ~ body] [t] (f : t -> position -> xml (ctx ++ body) [] []) filter ls = List.mapX (fn p => f p.1 p.2) ls -fun render [ctx] [ctx ~ body] [t] f r dl = <xml> - <dyn signal={sort <- r.Sort; - case sort of +val split [t] = + let + fun split' acc (ls : list t) = + case ls of + [] => acc + | x1 :: [] => (x1 :: acc.1, acc.2) + | x1 :: x2 :: ls => split' (x1 :: acc.1, x2 :: acc.2) ls + in + split' ([], []) + end + +fun merge [t] (cmp : t -> t -> signal bool) = + let + fun merge' acc (ls1 : list t) (ls2 : list t) = + case (ls1, ls2) of + ([], _) => return (List.revAppend acc ls2) + | (_, []) => return (List.revAppend acc ls1) + | (x1 :: ls1', x2 :: ls2') => + b <- cmp x1 x2; + if b then + merge' (x1 :: acc) ls1' ls2 + else + merge' (x2 :: acc) ls1 ls2' + in + merge' [] + end + +fun sort [t] (cmp : t -> t -> signal bool) = + let + fun sort' (ls : list t) = + case ls of + [] => return ls + | _ :: [] => return ls + | _ => + let + val (ls1, ls2) = split ls + in + ls1' <- sort' ls1; + ls2' <- sort' ls2; + merge cmp ls1' ls2' + end + in + sort' + end + +fun render [ctx] [ctx ~ body] [t] f (r : {Filter : t -> signal bool, + Sort : signal (option (t -> t -> signal bool))}) dl = <xml> + <dyn signal={cmp <- r.Sort; + case cmp of None => return (renderDyn f r.Filter dl) - | Some sort => + | Some cmp => dl' <- signal dl; elems <- (case dl' of Empty => return [] @@ -104,6 +150,7 @@ in listOut None hd [] end); + elems <- sort (fn v1 v2 => cmp v1.1 v2.1) elems; return (renderFlat f r.Filter elems)}/> </xml>