summaryrefslogtreecommitdiff
path: root/demo/more
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-09-17 16:35:11 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-09-17 16:35:11 -0400
commitae83d3e44959b43c167ba83736055bf94ace3113 (patch)
tree9d7a2e3bc1dff89e7399d555415ffae5c45c8b52 /demo/more
parentbf1a78ce9a5d60f8f4c40d0087f6caf90c10a796 (diff)
Basic tail recursion introduction seems to be working
Diffstat (limited to 'demo/more')
-rw-r--r--demo/more/dlist.ur18
-rw-r--r--demo/more/dlist.urs2
-rw-r--r--demo/more/grid.ur17
3 files changed, 31 insertions, 6 deletions
diff --git a/demo/more/dlist.ur b/demo/more/dlist.ur
index a8c464a6..6e660ab8 100644
--- a/demo/more/dlist.ur
+++ b/demo/more/dlist.ur
@@ -48,6 +48,24 @@ fun append [t] dl v =
set tl new;
return (tailPos cur new tl)
+fun replace [t] dl ls =
+ case ls of
+ [] => set dl Empty
+ | x :: ls =>
+ tl <- source Nil;
+ let
+ fun build ls acc =
+ case ls of
+ [] => return acc
+ | x :: ls =>
+ this <- source (Cons (x, tl));
+ build ls this
+ in
+ hd <- build (List.rev ls) tl;
+ tlS <- source tl;
+ set dl (Nonempty {Head = Cons (x, hd), Tail = tlS})
+ end
+
fun renderDyn [ctx] [ctx ~ body] [t] (f : t -> position -> xml (ctx ++ body) [] []) filter dl = <xml>
<dyn signal={dl' <- signal dl;
return (case dl' of
diff --git a/demo/more/dlist.urs b/demo/more/dlist.urs
index b912139e..b25e41a1 100644
--- a/demo/more/dlist.urs
+++ b/demo/more/dlist.urs
@@ -4,6 +4,8 @@ type position
val create : t ::: Type -> transaction (dlist t)
val clear : t ::: Type -> dlist t -> transaction unit
val append : t ::: Type -> dlist t -> t -> transaction position
+val replace : t ::: Type -> dlist t -> list t -> transaction unit
+
val delete : position -> transaction unit
val elements : t ::: Type -> dlist t -> signal (list t)
val foldl : t ::: Type -> acc ::: Type -> (t -> acc -> signal acc) -> acc -> dlist t -> signal acc
diff --git a/demo/more/grid.ur b/demo/more/grid.ur
index 2b451456..a4157991 100644
--- a/demo/more/grid.ur
+++ b/demo/more/grid.ur
@@ -59,16 +59,20 @@ functor Make(M : sig
Selection : source bool,
Filters : $(map thd3 M.cols)}
- fun addRow cols rows row =
+ fun newRow cols row =
rowS <- source row;
cols <- makeAll cols row;
colsS <- source cols;
ud <- source False;
sd <- source False;
- Monad.ignore (Dlist.append rows {Row = rowS,
- Cols = colsS,
- Updating = ud,
- Selected = sd})
+ return {Row = rowS,
+ Cols = colsS,
+ Updating = ud,
+ Selected = sd}
+
+ fun addRow cols rows row =
+ r <- newRow cols row;
+ Monad.ignore (Dlist.append rows r)
val grid =
cols <- Monad.mapR [colMeta M.row] [fst3]
@@ -91,7 +95,8 @@ functor Make(M : sig
fun sync {Cols = cols, Rows = rows, ...} =
Dlist.clear rows;
init <- rpc M.list;
- List.app (addRow cols rows) init
+ rs <- List.mapM (newRow cols) init;
+ Dlist.replace rows rs
fun render grid = <xml>
<table class={tabl}>