changeset 412:df4cbd90a26e

Infering sum rows
author Adam Chlipala <adamc@hcoop.net>
date Tue, 21 Oct 2008 19:31:11 -0400 (2008-10-21)
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)