diff options
author | Adam Chlipala <adamc@hcoop.net> | 2009-09-17 16:35:11 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2009-09-17 16:35:11 -0400 |
commit | ae83d3e44959b43c167ba83736055bf94ace3113 (patch) | |
tree | 9d7a2e3bc1dff89e7399d555415ffae5c45c8b52 /demo/more | |
parent | bf1a78ce9a5d60f8f4c40d0087f6caf90c10a796 (diff) |
Basic tail recursion introduction seems to be working
Diffstat (limited to 'demo/more')
-rw-r--r-- | demo/more/dlist.ur | 18 | ||||
-rw-r--r-- | demo/more/dlist.urs | 2 | ||||
-rw-r--r-- | demo/more/grid.ur | 17 |
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}> |