diff options
| -rw-r--r-- | demo/sum.ur | 6 | ||||
| -rw-r--r-- | lib/top.ur | 4 | ||||
| -rw-r--r-- | src/elaborate.sml | 7 |
3 files changed, 10 insertions, 7 deletions
diff --git a/demo/sum.ur b/demo/sum.ur index 96a45891..22a21d8b 100644 --- a/demo/sum.ur +++ b/demo/sum.ur @@ -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> @@ -31,8 +31,8 @@ fun foldUR (tf :: Type) (tr :: {Unit} -> Type) 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) diff --git a/src/elaborate.sml b/src/elaborate.sml index 1ea854cd..aa48952c 100644 --- a/src/elaborate.sml +++ b/src/elaborate.sml @@ -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) |