[MLton-commit] r7497

[Matthew Fluet]

Fix uncaught Subscript exception in elaboration of function clauses.

An erroneous function declaration that has different numbers of
arguments in different clauses would raise an unhandled Subscript
exception:

[mtf at fenrir tmp]$ cat z.sml
fun f true false = #"a" | f _ = #"b"

val g = 1 + false

[mtf at fenrir tmp]$ ~/devel/mlton/mlton-20100608/build/bin/mlton z.sml
Error: z.sml 1.1.
  Function defined with different numbers of arguments.
    clause: f true false = #"a"
    clause: f _ = #"b"
unhandled exception: Subscript

This was due to the type checking of arguments that uses the first
clause as the canonical arguments and performs a Vector.sub on each
clause's patterns to select the corresponding argument.  For
subsequent clauses with fewer arguments than the first clause, this
raises the Subscript exception.

The solution is to inspect all clauses to determine the maximum number
of arguments, use fresh unification types as the canonical argument
types, and perform a bounds check to ignore clauses with fewer
arguments.

[mtf at fenrir tmp]$ ~/devel/mlton/mlton.svn.trunk/build/bin/mlton z.sml
Error: z.sml 1.1.
  Function defined with different numbers of arguments.
    clause: f true false = #"a"
    clause: f _ = #"b"
Error: z.sml 3.11.
  Function applied to incorrect argument.
    expects: _ * [int]
    but got: _ * [bool]
    in: + (1, false)
compilation aborted: parseAndElaborate reported errors


----------------------------------------------------------------------

U   mlton/trunk/mlton/elaborate/elaborate-core.fun

----------------------------------------------------------------------

Modified: mlton/trunk/mlton/elaborate/elaborate-core.fun
===================================================================
--- mlton/trunk/mlton/elaborate/elaborate-core.fun	2010-06-17 19:23:18 UTC (rev 7496)
+++ mlton/trunk/mlton/elaborate/elaborate-core.fun	2010-06-22 13:27:35 UTC (rev 7497)
@@ -2097,31 +2097,32 @@
                                       pats = pats}
                                   end))
                              val numArgs =
-                                Vector.length (#pats (Vector.sub (rs, 0)))
+                                Vector.fold
+                                (rs, Vector.length (#pats (Vector.sub (rs, 0))),
+                                 fn (r,numArgs) =>
+                                 Int.max (Vector.length (#pats r), numArgs))
                              val argTypes =
                                 Vector.tabulate
                                 (numArgs, fn i =>
                                  let
-                                    val t =
-                                       Cpat.ty
-                                       (#pat (Vector.sub
-                                              (#pats (Vector.sub (rs, 0)),
-                                               i)))
+                                    val t = Type.new ()
                                     val _ =
                                        Vector.foreach
                                        (rs, fn {pats, ...} =>
-                                        let
-                                           val {pat, region} =
-                                              Vector.sub (pats, i)
-                                        in
-                                           unify
-                                           (t, Cpat.ty pat, fn (l1, l2) =>
-                                            (region,
-                                             str "function with argument of different types",
-                                             align [seq [str "argument: ", l2],
-                                                    seq [str "previous: ", l1],
-                                                    lay ()]))
-                                        end)
+                                        if Vector.length pats > i
+                                           then let
+                                                   val {pat, region} =
+                                                      Vector.sub (pats, i)
+                                                in
+                                                   unify
+                                                   (t, Cpat.ty pat, fn (l1, l2) =>
+                                                    (region,
+                                                     str "function with argument of different types",
+                                                     align [seq [str "argument: ", l2],
+                                                            seq [str "previous: ", l1],
+                                                            lay ()]))
+                                                end
+                                        else ())
                                  in
                                     t
                                  end)