From ae83d3e44959b43c167ba83736055bf94ace3113 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Thu, 17 Sep 2009 16:35:11 -0400
Subject: Basic tail recursion introduction seems to be working

---
 demo/more/dlist.ur  | 18 ++++++++++++++++++
 demo/more/dlist.urs |  2 ++
 demo/more/grid.ur   | 17 +++++++++++------
 3 files changed, 31 insertions(+), 6 deletions(-)

(limited to 'demo')

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