[MLton-commit] r7530

[Matthew F. <fl...@ml...>]

Fixed a bug with the treatment of as-patterns.

An as-pattern should not allow the redefinition of an identifier's
constructor status.
----------------------------------------------------------------------

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

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

Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog	2011-05-03 20:30:21 UTC (rev 7529)
+++ mlton/trunk/doc/changelog	2011-05-03 20:30:24 UTC (rev 7530)
@@ -1,5 +1,9 @@
 Here are the changes from version 2010608 to version YYYYMMDD.
 
+* 2011-05-03
+   - Fixed a bug with the treatment of as-patterns, which should not
+     allow the redefinition of constructor status.
+
 * 2011-02-18
    - Fixed bug with treatment of nan in common subexpression
      elimination SSA optimization.

Modified: mlton/trunk/mlton/elaborate/elaborate-core.fun
===================================================================
--- mlton/trunk/mlton/elaborate/elaborate-core.fun	2011-05-03 20:30:21 UTC (rev 7529)
+++ mlton/trunk/mlton/elaborate/elaborate-core.fun	2011-05-03 20:30:24 UTC (rev 7530)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2009-2010 Matthew Fluet.
+(* Copyright (C) 2009-2011 Matthew Fluet.
  * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-2000 NEC Research Institute.
@@ -556,7 +556,21 @@
                             case constraint of
                                NONE => Type.new ()
                              | SOME t => elaborateType (t, Lookup.fromEnv E)
-                         val x = bindToType (x, t)
+                         val xc = Avid.toCon (Avid.fromVar x)
+                         val x =
+                            case Env.peekLongcon (E, Ast.Longcon.short xc) of
+                               NONE => bindToType (x, t)
+                             | SOME _ =>
+                                  let
+                                     val _ =
+                                        Control.error
+                                        (region,
+                                         seq [str "constructor can not be redefined by as: ",
+                                              Avar.layout x],
+                                         seq [str "in: ", lay ()])
+                                  in
+                                     Var.fromAst x
+                                  end
                          val pat' = loop pat
                          val _ =
                             unifyPatternConstraint (Cpat.ty pat',