# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1219943596 14400
# Node ID 44a1663ad8934469c1ce8080705ef656bbeb8939
# Parent  9182068c9d7cb76688d29590957a01ccbe69e192
Checking for well-formed 'val rec'

diff -r 9182068c9d7c -r 44a1663ad893 src/elaborate.sml
--- a/src/elaborate.sml	Thu Aug 28 12:58:11 2008 -0400
+++ b/src/elaborate.sml	Thu Aug 28 13:13:16 2008 -0400
@@ -1033,6 +1033,7 @@
      | DuplicatePatField of ErrorMsg.span * string
      | Unresolvable of ErrorMsg.span * L'.con
      | OutOfContext of ErrorMsg.span * (L'.exp * L'.con) option
+     | IllegalRec of string * L'.exp
 
 fun expError env err =
     case err of
@@ -1082,6 +1083,10 @@
       | Unresolvable (loc, c) =>
         (ErrorMsg.errorAt loc "Can't resolve type class instance";
          eprefaces' [("Class constraint", p_con env c)])
+      | IllegalRec (x, e) =>
+        (ErrorMsg.errorAt (#2 e) "Illegal 'val rec' righthand side (must be a function abstraction)";
+         eprefaces' [("Variable", PD.string x),
+                     ("Expression", p_exp env e)])
          
 fun checkCon (env, denv) e c1 c2 =
     unifyCons (env, denv) c1 c2
@@ -2826,6 +2831,13 @@
         end
       | L.DValRec vis =>
         let
+            fun allowable (e, _) =
+                case e of
+                    L.EAbs _ => true
+                  | L.ECAbs (_, _, _, e) => allowable e
+                  | L.EDisjoint (_, _, e) => allowable e
+                  | _ => false
+
             val (vis, gs) = ListUtil.foldlMap
                                 (fn ((x, co, e), gs) =>
                                     let
@@ -2849,6 +2861,10 @@
                                                                           
                                                       val gs2 = checkCon (env, denv) e' et c'
                                                   in
+                                                      if allowable e then
+                                                          ()
+                                                      else
+                                                          expError env (IllegalRec (x, e'));
                                                       ((x, n, c', e'), gs1 @ enD gs2 @ gs)
                                                   end) gs vis
         in
diff -r 9182068c9d7c -r 44a1663ad893 tests/recBad.lac
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/recBad.lac	Thu Aug 28 13:13:16 2008 -0400
@@ -0,0 +1,9 @@
+datatype list a = Nil | Cons of a * list a
+
+val rec append : t ::: Type -> list t -> list t -> list t = fn t ::: Type => fn ls1 => fn ls2 =>
+        case ls1 of
+            Nil => ls2
+          | Cons (h, t) => Cons (h, append t ls2)
+
+(*val rec ones : list int = Cons (1, ones)*)
+val rec ones : unit -> list int = fn () => Cons (1, ones ())