X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/6bb366c5a60247419dce5cbce4a5c034fa2f1e5c..77a8fca278b561808959fa1aa7d9f02c5cfe7720:/src/order.sml diff --git a/src/order.sml b/src/order.sml index 0d0d363..2923c19 100644 --- a/src/order.sml +++ b/src/order.sml @@ -174,7 +174,7 @@ fun mergeProvide kind fname (m1, m2) = SM.insert (provide, name, fname))) m1 m2 -fun order fnames = +fun order basisOpt fnames = let fun doFile (fname, (provideC, provideT, provideV, require)) = let @@ -193,25 +193,38 @@ fun order fnames = 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