diff options
author | Adam Chlipala <adam@chlipala.net> | 2012-01-07 11:01:21 -0500 |
---|---|---|
committer | Adam Chlipala <adam@chlipala.net> | 2012-01-07 11:01:21 -0500 |
commit | bd78657f61d3783f9a282bf38ad0cbcb8b8bf5d4 (patch) | |
tree | 8ab456dd2dee70ad84290cc91210acd8fed4fb4c | |
parent | 87cd4f01bb611d65ea6914ce2d588f6c2a924c58 (diff) |
Make wildification a bit smarter about ordering of new wildcard declarations
-rw-r--r-- | demo/more/grid1.ur | 2 | ||||
-rw-r--r-- | src/elaborate.sml | 26 |
2 files changed, 25 insertions, 3 deletions
diff --git a/demo/more/grid1.ur b/demo/more/grid1.ur index 5f568f4d..66fe2f2c 100644 --- a/demo/more/grid1.ur +++ b/demo/more/grid1.ur @@ -13,14 +13,12 @@ fun page (n, s) = return <xml>A = {[n]}, B = {[s]}</xml> 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 = _}, diff --git a/src/elaborate.sml b/src/elaborate.sml index 89c077e5..aa62422b 100644 --- a/src/elaborate.sml +++ b/src/elaborate.sml @@ -3645,6 +3645,30 @@ and wildifyStr env (str, sgn) = 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 @@ and wildifyStr env (str, sgn) = | 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 |