changeset 1662:edf86cef0dba

Make wildification a bit smarter about ordering of new wildcard declarations
author Adam Chlipala <adam@chlipala.net>
date Sat, 07 Jan 2012 11:01:21 -0500 (2012-01-07)
parents 28b9b3d9414f
children 0577be31a435
files demo/more/grid1.ur src/elaborate.sml
diffstat 2 files changed, 25 insertions(+), 3 deletions(-) [+]
line wrap: on
line diff
--- a/demo/more/grid1.ur	Fri Jan 06 18:09:50 2012 -0500
+++ b/demo/more/grid1.ur	Sat Jan 07 11:01:21 2012 -0500
@@ -13,14 +13,12 @@
 open Make(struct
               structure F = Direct.Foreign(struct
                                                con nm = #Id
-                                               con t = _
                                                val tab = t1
                                                fun render r = r.A
                                            end)
 
               val tab = t
               con key = [Id = _]
-              con row = _
 
               val raw = {Id = {New = nextval s,
                                Inj = _},
--- a/src/elaborate.sml	Fri Jan 06 18:09:50 2012 -0500
+++ b/src/elaborate.sml	Sat Jan 07 11:01:21 2012 -0500
@@ -3645,6 +3645,30 @@
 
                  val nd = removeUsed (nd, ds)
 
+                 (* Among the declarations present explicitly in the program, find the last constructor or constraint declaration.
+                  * The new constructor/constraint declarations that we add may safely be put after that point. *)
+                 fun findLast (ds, acc) =
+                     case ds of
+                         [] => ([], acc)
+                       | (d : L.decl) :: ds' =>
+                         let
+                             val isCony = case #1 d of
+                                              L.DCon _ => true
+                                            | L.DDatatype _ => true
+                                            | L.DDatatypeImp _ => true
+                                            | L.DStr _ => true
+                                            | L.DConstraint _ => true
+                                            | L.DClass _ => true
+                                            | _ => false
+                         in
+                             if isCony then
+                                 (ds, acc)
+                             else
+                                 findLast (ds', d :: acc)
+                         end
+
+                 val (dPrefix, dSuffix) = findLast (rev ds, [])
+
                  fun extend (env, nd, ds) =
                      let
                          val ds' = List.mapPartial (fn (env', (c1, c2), loc) =>
@@ -3690,7 +3714,7 @@
                                | d => d) ds
                      end
              in
-                 (L.StrConst (extend (env, nd, ds)), #2 str)
+                 (L.StrConst (extend (env, nd, rev dPrefix) @ dSuffix), #2 str)
              end
            | _ => str)
       | _ => str