summaryrefslogtreecommitdiff
path: root/src/mod_db.sml
diff options
context:
space:
mode:
Diffstat (limited to 'src/mod_db.sml')
-rw-r--r--src/mod_db.sml81
1 files changed, 75 insertions, 6 deletions
diff --git a/src/mod_db.sml b/src/mod_db.sml
index 2d6b285b..c821a0bb 100644
--- a/src/mod_db.sml
+++ b/src/mod_db.sml
@@ -42,7 +42,9 @@ structure IM = IntBinaryMap
type oneMod = {Decl : decl,
When : Time.time,
- Deps : SS.set}
+ Deps : SS.set,
+ HasErrors: bool (* We're saving modules with errors so tooling can find them *)
+ }
val byName = ref (SM.empty : oneMod SM.map)
val byId = ref (IM.empty : string IM.map)
@@ -50,7 +52,39 @@ val byId = ref (IM.empty : string IM.map)
fun reset () = (byName := SM.empty;
byId := IM.empty)
-fun insert (d, tm) =
+(* For debug purposes *)
+fun printByName (bn: oneMod SM.map): unit =
+ (TextIO.print ("Contents of ModDb.byName: \n");
+ List.app (fn tup =>
+ let
+ val name = #1 tup
+ val m = #2 tup
+ val renderedDeps =
+ String.concatWith ", " (SS.listItems (#Deps m))
+ val renderedMod =
+ " " ^ name
+ ^ ". Stored at : " ^ Time.toString (#When m)
+ ^", HasErrors: " ^ Bool.toString (#HasErrors m)
+ ^". Deps: " ^ renderedDeps ^"\n"
+ in
+ TextIO.print renderedMod
+ end)
+ (SM.listItemsi bn))
+
+fun dContainsUndeterminedUnif d =
+ ElabUtil.Decl.exists
+ {kind = fn _ => false,
+ con = fn _ => false,
+ exp = fn e => case e of
+ EUnif (ref NONE) => true
+ | _ => false,
+ sgn_item = fn _ => false,
+ sgn = fn _ => false,
+ str = fn _ => false,
+ decl = fn _ => false}
+ d
+
+fun insert (d, tm, hasErrors) =
let
val xn =
case #1 d of
@@ -62,10 +96,16 @@ fun insert (d, tm) =
NONE => ()
| SOME (x, n) =>
let
+ (* Keep module when it's file didn't change and it was OK before *)
val skipIt =
case SM.find (!byName, x) of
NONE => false
| SOME r => #When r = tm
+ andalso not (#HasErrors r)
+ (* We save results of error'd compiler passes *)
+ (* so modules that still have undetermined unif variables *)
+ (* should not be reused since those are unsuccessfully compiled *)
+ andalso not (dContainsUndeterminedUnif (#Decl r))
in
if skipIt then
()
@@ -73,7 +113,19 @@ fun insert (d, tm) =
let
fun doMod (n', deps) =
case IM.find (!byId, n') of
- NONE => deps
+ NONE =>
+ (
+ (* TextIO.print ("MISSED_DEP: " ^ Int.toString n' ^"\n"); *)
+ deps)
+ (* raise Fail ("ModDb: Trying to make dep tree but couldn't find module " ^ Int.toString n') *)
+ (* I feel like this should throw, but the dependency searching algorithm *)
+ (* is not 100% precise. I encountered problems in json.urs: *)
+ (* datatype r = Rec of M.t r *)
+ (* M is the structure passed to the Recursive functor, so this is not an external dependency *)
+ (* I'm just not sure how to filter these out yet *)
+ (* I still think this should throw: *)
+ (* Trying to add a dep for a module but can't find the dep... *)
+ (* That will always cause a hole in the dependency tree and cause problems down the line *)
| SOME x' =>
SS.union (deps,
SS.add (case SM.find (!byName, x') of
@@ -118,8 +170,11 @@ fun insert (d, tm) =
x,
{Decl = d,
When = tm,
- Deps = deps});
+ Deps = deps,
+ HasErrors = hasErrors
+ });
byId := IM.insert (!byId, n, x)
+ (* printByName (!byName) *)
end
end
end
@@ -130,7 +185,7 @@ fun lookup (d : Source.decl) =
(case SM.find (!byName, x) of
NONE => NONE
| SOME r =>
- if tm = #When r then
+ if tm = #When r andalso not (#HasErrors r) andalso not (dContainsUndeterminedUnif (#Decl r)) then
SOME (#Decl r)
else
NONE)
@@ -138,12 +193,26 @@ fun lookup (d : Source.decl) =
(case SM.find (!byName, x) of
NONE => NONE
| SOME r =>
- if tm = #When r then
+ if tm = #When r andalso not (#HasErrors r) andalso not (dContainsUndeterminedUnif (#Decl r)) then
SOME (#Decl r)
else
NONE)
| _ => NONE
+fun lookupModAndDepsIncludingErrored name =
+ case SM.find (!byName, name) of
+ NONE => NONE
+ | SOME m =>
+ let
+ val deps = SS.listItems (#Deps m)
+ (* Clumsy way of adding Basis and Top without adding doubles *)
+ val deps = List.filter (fn x => x <> "Basis" andalso x <> "Top") deps
+ val deps = ["Basis", "Top"] @ deps
+ val foundDepModules = List.mapPartial (fn d => SM.find (!byName, d)) deps
+ in
+ SOME (#Decl m, List.map (fn a => #Decl a) foundDepModules)
+ end
+
val byNameBackup = ref (!byName)
val byIdBackup = ref (!byId)