val dt = (TError, ErrorMsg.dummyLoc)
-fun expNeeded G (e, _) =
+fun expNeeded G (e, loc) =
case e of
EInt _ => ((SS.empty,
if Env.lookupType G "int" then
| SOME t => unionCTE ((typNeeded G t, SS.empty),
expNeeded G' e)
end
+ | EALam (x, p, e) =>
+ let
+ val G' = Env.bindVal G (x, (TAction (p, StringMap.empty, StringMap.empty), loc), NONE)
+ in
+ unionCTE (((predNeeded G p, SS.empty), SS.empty),
+ expNeeded G' e)
+ end
| EVar x =>
(case Env.lookupVal G x of
NONE => ((SS.empty, SS.empty), SS.singleton x)
SM.insert (provide, name, fname)))
m1 m2
-fun order fnames =
+fun order basisOpt fnames =
let
- fun doFile fname =
- let
- val file = Parse.parse fname
- val (provide, require) = fileSig file
- in
- print "\nFile ";
- print fname;
- print "\nPROVIDE:\n";
- printSig provide;
- print "\nREQUIRE:\n";
- printSig require
- end
-
fun doFile (fname, (provideC, provideT, provideV, require)) =
let
val file = Parse.parse fname
val require = SM.mapi (fn (fname, ((rc, rt), rv)) =>
let
- fun consider (kind, provide) =
+ fun consider (kind, provide, lastChance) =
SS.foldl (fn (name, need) =>
case SM.find (provide, name) of
- NONE => (ErrorMsg.error NONE
- ("File "
- ^ fname
- ^ " uses undefined "
- ^ kind
- ^ " "
- ^ name);
- need)
+ NONE =>
+ if lastChance name then
+ need
+ else
+ (ErrorMsg.error NONE
+ ("File "
+ ^ fname
+ ^ " uses undefined "
+ ^ kind
+ ^ " "
+ ^ name);
+ need)
| SOME fname' =>
SS.add (need, fname'))
- val need = consider ("context", provideC)
+ val need = consider ("context", provideC,
+ case basisOpt of
+ NONE => (fn _ => false)
+ | SOME b => Env.lookupContext b)
SS.empty rc
- val need = consider ("type", provideT)
+ val need = consider ("type", provideT,
+ case basisOpt of
+ NONE => (fn _ => false)
+ | SOME b => Env.lookupType b)
need rt
- val need = consider ("value", provideV)
+ val need = consider ("value", provideV,
+ case basisOpt of
+ NONE => (fn _ => false)
+ | SOME b => (fn name => Option.isSome (Env.lookupVal b name)))
need rv
in
need
SS.app (fn fname' => (print " "; print fname')) requires;
print "\n")) require;*)
- loop (ready, waiting, [])
+ ({provideC = provideC,
+ provideT = provideT,
+ provideV = provideV},
+ loop (ready, waiting, []))
end
+type providers = {provideC : string SM.map,
+ provideT : string SM.map,
+ provideV : string SM.map}
+
+fun providesContext (p : providers, s) = SM.find (#provideC p, s)
+fun providesType (p : providers, s) = SM.find (#provideT p, s)
+fun providesValue (p : providers, s) = SM.find (#provideV p, s)
+
end