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 =
adamc@951:
adamc@915: | Nonempty {Head = hd, Tail = tlTop} =>
adamc@915: let
adamc@915: fun render' prev dl'' =
adamc@915: case dl'' of
adamc@915: Nil =>
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: )}/>
adamc@944:
adamc@915: end
adamc@915: in
adamc@915: render' None hd
adamc@915: end)}/>
adamc@915:
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@952: fun render [ctx] [ctx ~ body] [t] f r dl =
adamc@952: return (renderDyn f r.Filter dl)
adamc@952: | Some sort =>
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@952: return (renderFlat f r.Filter elems)}/>
adamc@952:
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