Mercurial > urweb
changeset 412:df4cbd90a26e
Infering sum rows
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Tue, 21 Oct 2008 19:31:11 -0400 |
| parents | 06fcddcd20d3 |
| children | 6a0e54400805 |
| files | demo/sum.ur lib/top.ur src/elaborate.sml |
| diffstat | 3 files changed, 10 insertions(+), 7 deletions(-) [+] |
line wrap: on
line diff
--- a/demo/sum.ur Tue Oct 21 19:24:39 2008 -0400 +++ b/demo/sum.ur Tue Oct 21 19:31:11 2008 -0400 @@ -1,9 +1,9 @@ -fun sum (fs :: {Unit}) (x : $(mapUT int fs)) = +fun sum (fs ::: {Unit}) (x : $(mapUT int fs)) = foldUR [int] [fn _ => int] (fn (nm :: Name) (rest :: {Unit}) [[nm] ~ rest] n acc => n + acc) 0 [fs] x fun main () = return <xml><body> - {[sum [[A, B]] {A = 0, B = 1}]}<br/> - {[sum [[C, D, E]] {C = 2, D = 3, E = 4}]} + {[sum {A = 0, B = 1}]}<br/> + {[sum {C = 2, D = 3, E = 4}]} </body></xml>
--- a/lib/top.ur Tue Oct 21 19:24:39 2008 -0400 +++ b/lib/top.ur Tue Oct 21 19:31:11 2008 -0400 @@ -31,8 +31,8 @@ tf -> tr rest -> tr ([nm] ++ rest)) (i : tr []) = fold [fn r :: {Unit} => $(mapUT tf r) -> tr r] - (fn (nm :: Name) (t :: Unit) (rest :: {Unit}) (acc : $(mapUT tf rest) -> tr rest) - [[nm] ~ rest] (r : $([nm = tf] ++ mapUT tf rest)) => + (fn (nm :: Name) (t :: Unit) (rest :: {Unit}) acc + [[nm] ~ rest] r => f [nm] [rest] r.nm (acc (r -- nm))) (fn _ => i)
--- a/src/elaborate.sml Tue Oct 21 19:24:39 2008 -0400 +++ b/src/elaborate.sml Tue Oct 21 19:31:11 2008 -0400 @@ -1,4 +1,4 @@ - (* Copyright (c) 2008, Adam Chlipala +(* Copyright (c) 2008, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without @@ -743,7 +743,10 @@ fun unfold (dom, ran, f, i, r, c) = let val nm = cunif (loc, (L'.KName, loc)) - val v = cunif (loc, dom) + val v = + case dom of + (L'.KUnit, _) => (L'.CUnit, loc) + | _ => cunif (loc, dom) val rest = cunif (loc, (L'.KRecord dom, loc)) val acc = (L'.CFold (dom, ran), loc) val acc = (L'.CApp (acc, f), loc)