Mercurial > urweb

comparison src/elaborate.sml @ 1868:d6b0ee53dc93

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Get -root working properly again
author Adam Chlipala <adam@chlipala.net>
date Thu, 26 Sep 2013 16:22:06 -0400
parents 5144e03ef603
children 5125b1df6045
comparison
equal deleted inserted replaced
1867:216a3a67ebe3 1868:d6b0ee53dc93
3677 foldl (fn ((d, _), nd) => 3677 foldl (fn ((d, _), nd) =>
3678 case d of 3678 case d of
3679 L.DCon (x, _, _) => ndelCon (nd, x) 3679 L.DCon (x, _, _) => ndelCon (nd, x)
3680 | L.DVal (x, _, _) => ndelVal (nd, x) 3680 | L.DVal (x, _, _) => ndelVal (nd, x)
3681 | L.DOpen _ => nempty 3681 | L.DOpen _ => nempty
3682 | L.DStr (x, _, _, (L.StrConst ds', _)) => 3682 | L.DStr (x, _, _, (L.StrConst ds', _), _) =>
3683 (case SM.find (nmods nd, x) of 3683 (case SM.find (nmods nd, x) of
3684 NONE => nd 3684 NONE => nd
3685 | SOME (env, nd') => naddMod (nd, x, (env, removeUsed (nd', ds')))) 3685 | SOME (env, nd') => naddMod (nd, x, (env, removeUsed (nd', ds'))))
3686 | _ => nd) 3686 | _ => nd)
3687 nd ds 3687 nd ds
3746 (L.DCon (x, NONE, cwild), #2 str) 3746 (L.DCon (x, NONE, cwild), #2 str)
3747 end) xs @ ds' 3747 end) xs @ ds'
3748 3748
3749 val ds = ds @ ds' 3749 val ds = ds @ ds'
3750 in 3750 in
3751 map (fn d as (L.DStr (x, s, tm, (L.StrConst ds', loc')), loc) => 3751 map (fn d as (L.DStr (x, s, tm, (L.StrConst ds', loc'), r), loc) =>
3752 (case SM.find (nmods nd, x) of 3752 (case SM.find (nmods nd, x) of
3753 NONE => d 3753 NONE => d
3754 | SOME (env, nd') => 3754 | SOME (env, nd') =>
3755 (L.DStr (x, s, tm, (L.StrConst (extend (env, nd', ds')), loc')), loc)) 3755 (L.DStr (x, s, tm, (L.StrConst (extend (env, nd', ds')), loc'), r), loc))
3756 | d => d) ds 3756 | d => d) ds
3757 end 3757 end
3758 in 3758 in
3759 (L.StrConst (extend (env, nd, rev dPrefix) @ dSuffix), #2 str) 3759 (L.StrConst (extend (env, nd, rev dPrefix) @ dSuffix), #2 str)
3760 end 3760 end
3961 val (env', n) = E.pushSgnNamed env x sgn' 3961 val (env', n) = E.pushSgnNamed env x sgn'
3962 in 3962 in
3963 ([(L'.DSgn (x, n, sgn'), loc)], (env', denv, enD gs' @ gs)) 3963 ([(L'.DSgn (x, n, sgn'), loc)], (env', denv, enD gs' @ gs))
3964 end 3964 end
3965 3965
3966 | L.DStr (x, sgno, tmo, str) => 3966 | L.DStr (x, sgno, tmo, str, _) =>
3967 (case ModDb.lookup dAll of 3967 (case ModDb.lookup dAll of
3968 SOME d => 3968 SOME d =>
3969 let 3969 let
3970 val () = if !verbose then TextIO.print ("REUSE: " ^ x ^ "\n") else () 3970 val () = if !verbose then TextIO.print ("REUSE: " ^ x ^ "\n") else ()
3971 val env' = E.declBinds env d 3971 val env' = E.declBinds env d
4533 val () = discoverC char "char" 4533 val () = discoverC char "char"
4534 val () = discoverC table "sql_table" 4534 val () = discoverC table "sql_table"
4535 4535
4536 val d = (L.DStr ("Top", SOME (L.SgnConst topSgn, ErrorMsg.dummySpan), 4536 val d = (L.DStr ("Top", SOME (L.SgnConst topSgn, ErrorMsg.dummySpan),
4537 SOME (if Time.< (top_tm, basis_tm) then basis_tm else top_tm), 4537 SOME (if Time.< (top_tm, basis_tm) then basis_tm else top_tm),
4538 (L.StrConst topStr, ErrorMsg.dummySpan)), ErrorMsg.dummySpan) 4538 (L.StrConst topStr, ErrorMsg.dummySpan), false), ErrorMsg.dummySpan)
4539 val (top_n, env', topSgn, topStr) = 4539 val (top_n, env', topSgn, topStr) =
4540 case (if !incremental then ModDb.lookup d else NONE) of 4540 case (if !incremental then ModDb.lookup d else NONE) of
4541 NONE => 4541 NONE =>
4542 let 4542 let
4543 val (topSgn, gs) = elabSgn (env', D.empty) (L.SgnConst topSgn, ErrorMsg.dummySpan) 4543 val (topSgn, gs) = elabSgn (env', D.empty) (L.SgnConst topSgn, ErrorMsg.dummySpan)