Mercurial > urweb
diff src/elaborate.sml @ 1030:6bcc1020d5cd
Start of Decision
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Mon, 02 Nov 2009 15:48:06 -0500 |
parents | 4de35df3d545 |
children | 38411c2cd363 |
line wrap: on
line diff
--- a/src/elaborate.sml Mon Nov 02 14:22:29 2009 -0500 +++ b/src/elaborate.sml Mon Nov 02 15:48:06 2009 -0500 @@ -1996,14 +1996,30 @@ (strerror, sgnerror)) | SOME sgn => ((L'.StrProj (str, m), loc), sgn)) ((L'.StrVar n, loc), sgn) strs - - val cso = E.projectConstraints env {sgn = sgn, str = st} + + fun collect first (st, sgn) = + case E.projectConstraints env {sgn = sgn, str = st} of + NONE => (if first then + strError env (UnboundStr (loc, str)) + else + (); + []) + | SOME cs => + case #1 (hnormSgn env sgn) of + L'.SgnConst sgis => + foldl (fn (sgi, cs) => + case #1 sgi of + L'.SgiStr (x, _, _) => + (case E.projectStr env {sgn = sgn, str = st, field = x} of + NONE => raise Fail "Elaborate: projectStr in collect" + | SOME sgn' => + List.revAppend (collect false ((L'.StrProj (st, x), loc), sgn'), + cs)) + | _ => cs) cs sgis + | _ => cs in - case cso of - NONE => (strError env (UnboundStr (loc, str)); - denv) - | SOME cs => foldl (fn ((c1, c2), denv) => - D.assert env denv (c1, c2)) denv cs + foldl (fn ((c1, c2), denv) => + D.assert env denv (c1, c2)) denv (collect true (st, sgn)) end fun elabSgn_item ((sgi, loc), (env, denv, gs)) = @@ -3445,12 +3461,14 @@ ([], (env, denv, gs))) | SOME (n, sgn) => let - val (_, sgn) = foldl (fn (m, (str, sgn)) => - case E.projectStr env {str = str, sgn = sgn, field = m} of - NONE => (strError env (UnboundStr (loc, m)); - (strerror, sgnerror)) - | SOME sgn => ((L'.StrProj (str, m), loc), sgn)) - ((L'.StrVar n, loc), sgn) ms + val (str, sgn) = foldl (fn (m, (str, sgn)) => + case E.projectStr env {str = str, sgn = sgn, field = m} of + NONE => (strError env (UnboundStr (loc, m)); + (strerror, sgnerror)) + | SOME sgn => ((L'.StrProj (str, m), loc), sgn)) + ((L'.StrVar n, loc), sgn) ms + + val sgn = selfifyAt env {str = str, sgn = sgn} val (ds, env') = dopen env {str = n, strs = ms, sgn = sgn} val denv' = dopenConstraints (loc, env', denv) {str = m, strs = ms}