SS.app (fn s => (print " "; print s; print ";")) vs;
print "\n")
+val allNaughty = ref false
+val naughtyFiles = ref SS.empty
+fun addNaughty fname = naughtyFiles := SS.add (!naughtyFiles, fname)
+
fun mergeProvide kind fname (m1, m2) =
SS.foldl (fn (name, provide) =>
(case SM.find (provide, name) of
NONE => ()
- | SOME fname' => ErrorMsg.error NONE (String.concat ["Files ",
- fname',
- " and ",
- fname,
- " both provide ",
- kind,
- " ",
- name]);
+ | SOME fname' =>
+ (addNaughty fname;
+ addNaughty fname';
+ ErrorMsg.error NONE (String.concat ["Files ",
+ fname',
+ " and ",
+ fname,
+ " both provide ",
+ kind,
+ " ",
+ name]));
SM.insert (provide, name, fname)))
m1 m2
fun order basisOpt fnames =
let
+ val () = allNaughty := false
+ val () = naughtyFiles := SS.empty
+
fun doFile (fname, (provideC, provideT, provideV, require)) =
let
val file = Parse.parse fname
if lastChance name then
need
else
- (ErrorMsg.error NONE
+ (addNaughty fname;
+ ErrorMsg.error NONE
("File "
^ fname
^ " uses undefined "
if SM.numItems waiting = 0 then
rev order
else
- (ErrorMsg.error NONE "Cyclic dependency in source files";
+ (allNaughty := true;
+ ErrorMsg.error NONE "Cyclic dependency in source files";
order)
| SOME next =>
let
(ready,
SM.insert (waiting, fname, requires)))
(SS.empty, SM.empty) require
- in
- (*SM.appi (fn (name, fname) => print ("Context " ^ name ^ " in " ^ fname ^ "\n")) provideC;
- SM.appi (fn (name, fname) => print ("Type " ^ name ^ " in " ^ fname ^ "\n")) provideT;
- SM.appi (fn (name, fname) => print ("Value " ^ name ^ " in " ^ fname ^ "\n")) provideV;*)
- (*SM.appi (fn (fname, requires) =>
- (print fname;
- print " requires:";
- SS.app (fn fname' => (print " "; print fname')) requires;
- print "\n")) require;*)
-
- ({provideC = provideC,
- provideT = provideT,
- provideV = provideV},
- loop (ready, waiting, []))
+ val ordered = loop (ready, waiting, [])
+ val provider = {provideC = provideC,
+ provideT = provideT,
+ provideV = provideV}
+ in
+ if !allNaughty then
+ (provider, [])
+ else if SS.isEmpty (!naughtyFiles) then
+ (provider, ordered)
+ else
+ order basisOpt (List.filter (fn fname => not (SS.member (!naughtyFiles, fname))) fnames)
end
type providers = {provideC : string SM.map,