adamc@915: datatype dlist'' t =
adamc@915:          Nil
adamc@915:        | Cons of t * source (dlist'' t)
adamc@915: 
adamc@915: datatype dlist' t =
adamc@915:          Empty
adamc@915:        | Nonempty of { Head : dlist'' t, Tail : source (source (dlist'' t)) }
adamc@915: 
adamc@951: con dlist t = source (dlist' t)
adamc@915: 
adamc@915: type position = transaction unit
adamc@915: 
adamc@915: fun headPos [t] (dl : dlist t) =
adamc@951:     dl' <- get dl;
adamc@915:     case dl' of
adamc@915:         Nonempty { Head = Cons (_, tl), Tail = tl' } =>
adamc@915:         cur <- get tl;
adamc@951:         set dl (case cur of
adamc@951:                     Nil => Empty
adamc@951:                   | _ => Nonempty {Head = cur, Tail = tl'})
adamc@915:       | _ => return ()
adamc@915: 
adamc@915: fun tailPos [t] (cur : source (dlist'' t)) new tail =
adamc@915:     new' <- get new;
adamc@915:     set cur new';
adamc@915: 
adamc@915:     case new' of
adamc@915:         Nil => set tail cur
adamc@915:       | _ => return ()
adamc@915: 
adamc@951: val create [t] = source Empty
adamc@915: 
adamc@951: fun clear [t] (s : dlist t) = set s Empty
adamc@915: 
adamc@915: fun append [t] dl v =
adamc@951:     dl' <- get dl;
adamc@915:     case dl' of
adamc@915:         Empty =>
adamc@915:         tl <- source Nil;
adamc@915:         tl' <- source tl;
adamc@951:         set dl (Nonempty {Head = Cons (v, tl), Tail = tl'});
adamc@915:         return (headPos dl)
adamc@915:                 
adamc@915:       | Nonempty {Tail = tl, ...} =>
adamc@915:         cur <- get tl;
adamc@915:         new <- source Nil;
adamc@915:         set cur (Cons (v, new));
adamc@915:         set tl new;
adamc@915:         return (tailPos cur new tl)
adamc@915: 
adamc@952: fun renderDyn [ctx] [ctx ~ body] [t] (f : t -> position -> xml (ctx ++ body) [] []) filter dl = <xml>
adamc@951:   <dyn signal={dl' <- signal dl;
adamc@915:                return (case dl' of
adamc@915:                            Empty => <xml/>
adamc@915:                          | Nonempty {Head = hd, Tail = tlTop} => 
adamc@915:                            let
adamc@915:                                fun render' prev dl'' =
adamc@915:                                    case dl'' of
adamc@915:                                        Nil => <xml/>
adamc@915:                                      | Cons (v, tl) =>
adamc@915:                                        let
adamc@915:                                            val pos = case prev of
adamc@915:                                                          None => headPos dl
adamc@915:                                                        | Some prev => tailPos prev tl tlTop
adamc@915:                                        in
adamc@951:                                            <xml><dyn signal={b <- filter v;
adamc@944:                                                              return (if b then
adamc@944:                                                                          f v pos
adamc@944:                                                                      else
adamc@944:                                                                          <xml/>)}/>
adamc@944:                                              <dyn signal={tl' <- signal tl;
adamc@944:                                                           return (render' (Some tl) tl')}/></xml>
adamc@915:                                        end
adamc@915:                            in
adamc@915:                                render' None hd
adamc@915:                            end)}/>
adamc@915: </xml>
adamc@915: 
adamc@952: fun renderFlat [ctx] [ctx ~ body] [t] (f : t -> position -> xml (ctx ++ body) [] []) filter ls =
adamc@952:     List.mapX (fn p => f p.1 p.2) ls
adamc@952: 
adamc@953: val split [t] =
adamc@953:     let
adamc@953:         fun split' acc (ls : list t) =
adamc@953:             case ls of
adamc@953:                 [] => acc
adamc@953:               | x1 :: [] => (x1 :: acc.1, acc.2)
adamc@953:               | x1 :: x2 :: ls => split' (x1 :: acc.1, x2 :: acc.2) ls
adamc@953:     in
adamc@953:         split' ([], [])
adamc@953:     end
adamc@953: 
adamc@953: fun merge [t] (cmp : t -> t -> signal bool) =
adamc@953:     let
adamc@953:         fun merge' acc (ls1 : list t) (ls2 : list t) =
adamc@953:             case (ls1, ls2) of
adamc@953:                 ([], _) => return (List.revAppend acc ls2)
adamc@953:               | (_, []) => return (List.revAppend acc ls1)
adamc@953:               | (x1 :: ls1', x2 :: ls2') =>
adamc@953:                 b <- cmp x1 x2;
adamc@953:                 if b then
adamc@953:                     merge' (x1 :: acc) ls1' ls2
adamc@953:                 else
adamc@953:                     merge' (x2 :: acc) ls1 ls2'
adamc@953:     in
adamc@953:         merge' []
adamc@953:     end
adamc@953: 
adamc@953: fun sort [t] (cmp : t -> t -> signal bool) =
adamc@953:     let
adamc@953:         fun sort' (ls : list t) =
adamc@953:             case ls of
adamc@953:                 [] => return ls
adamc@953:               | _ :: [] => return ls
adamc@953:               | _ =>
adamc@953:                 let
adamc@953:                     val (ls1, ls2) = split ls
adamc@953:                 in
adamc@953:                     ls1' <- sort' ls1;
adamc@953:                     ls2' <- sort' ls2;
adamc@953:                     merge cmp ls1' ls2'
adamc@953:                 end
adamc@953:     in
adamc@953:         sort'
adamc@953:     end
adamc@953: 
adamc@953: fun render [ctx] [ctx ~ body] [t] f (r : {Filter : t -> signal bool,
adamc@953:                                           Sort : signal (option (t -> t -> signal bool))}) dl = <xml>
adamc@953:     <dyn signal={cmp <- r.Sort;
adamc@953:                  case cmp of
adamc@952:                      None => return (renderDyn f r.Filter dl)
adamc@953:                    | Some cmp =>
adamc@952:                      dl' <- signal dl;
adamc@952:                      elems <- (case dl' of
adamc@952:                                    Empty => return []
adamc@952:                                  | Nonempty {Head = hd, Tail = tlTop} =>
adamc@952:                                    let
adamc@952:                                        fun listOut prev dl'' acc =
adamc@952:                                            case dl'' of
adamc@952:                                                Nil => return acc
adamc@952:                                              | Cons (v, tl) =>
adamc@952:                                                let
adamc@952:                                                    val pos = case prev of
adamc@952:                                                                  None => headPos dl
adamc@952:                                                                | Some prev => tailPos prev tl tlTop
adamc@952:                                                in
adamc@952:                                                    tl' <- signal tl;
adamc@952:                                                    listOut (Some tl) tl' ((v, pos) :: acc)
adamc@952:                                                end
adamc@952:                                    in
adamc@952:                                        listOut None hd []
adamc@952:                                    end);
adamc@953:                      elems <- sort (fn v1 v2 => cmp v1.1 v2.1) elems;
adamc@952:                      return (renderFlat f r.Filter elems)}/>
adamc@952: </xml>
adamc@952:                              
adamc@952:         
adamc@952: 
adamc@915: fun delete pos = pos
adamc@915: 
adamc@915: fun elements' [t] (dl'' : dlist'' t) =
adamc@915:     case dl'' of
adamc@915:         Nil => return []
adamc@915:       | Cons (x, dl'') =>
adamc@915:         dl'' <- signal dl'';
adamc@915:         tl <- elements' dl'';
adamc@915:         return (x :: tl)
adamc@915: 
adamc@915: fun elements [t] (dl : dlist t) =
adamc@951:     dl' <- signal dl;
adamc@915:     case dl' of
adamc@915:         Empty => return []
adamc@915:       | Nonempty {Head = hd, ...} => elements' hd
adamc@937: 
adamc@937: fun foldl [t] [acc] (f : t -> acc -> signal acc) =
adamc@937:     let
adamc@937:         fun foldl'' (i : acc) (dl : dlist'' t) : signal acc =
adamc@937:             case dl of
adamc@937:                 Nil => return i
adamc@937:               | Cons (v, dl') =>
adamc@937:                 dl' <- signal dl';
adamc@937:                 i' <- f v i;
adamc@937:                 foldl'' i' dl'
adamc@937: 
adamc@937:         fun foldl' (i : acc) (dl : dlist t) : signal acc =
adamc@951:             dl <- signal dl;
adamc@937:             case dl of
adamc@937:                 Empty => return i
adamc@937:               | Nonempty {Head = dl, ...} => foldl'' i dl
adamc@937:     in
adamc@937:         foldl'
adamc@937:     end