Dependency ordering

[hcoop/domtool2.git] / src / tycheck.sml

diff --git a/src/tycheck.sml b/src/tycheck.sml
index ac69a6d..ac9fad5 100644 (file)
--- a/src/tycheck.sml
+++ b/src/tycheck.sml
@@ -296,6 +296,22 @@ fun hasTyp (e, t1, t2) =
     else
        subTyp (t1, t2)
 
+fun checkPred G (p, loc) =
+    let
+       val err = ErrorMsg.error (SOME loc)
+    in
+       case p of
+           CRoot => ()
+         | CConst s =>
+           if lookupContext G s then
+               ()
+           else
+               err ("Unbound context " ^ s)
+         | CPrefix p => checkPred G p
+         | CNot p => checkPred G p
+         | CAnd (p1, p2) => (checkPred G p1; checkPred G p2)
+    end
+
 fun checkTyp G (tAll as (t, loc)) =
     let
        val err = ErrorMsg.error (SOME loc)
@@ -309,9 +325,11 @@ fun checkTyp G (tAll as (t, loc)) =
                 (TError, loc))
          | TList t => (TList (checkTyp G t), loc)
          | TArrow (d, r) => (TArrow (checkTyp G d, checkTyp G r), loc)
-         | TAction (p, d, r) => (TAction (p, SM.map (checkTyp G) d,
-                                          SM.map (checkTyp G) r), loc)
-         | TNested (p, t) => (TNested (p, checkTyp G t), loc)
+         | TAction (p, d, r) => (checkPred G p;
+                                 (TAction (p, SM.map (checkTyp G) d,
+                                           SM.map (checkTyp G) r), loc))
+         | TNested (p, t) => (checkPred G p;
+                              (TNested (p, checkTyp G t), loc))
          | TError => raise Fail "TError in parser-generated type"
          | TUnif _ => raise Fail "TUnif in parser-generated type"
     end
@@ -662,8 +680,9 @@ fun checkDecl G (d, _, loc) =
                                                   SOME ue));
            bindVal G (name, to, SOME e)
        end
+      | DContext name => bindContext G name
 
-fun checkFile G tInit (ds, eo) =
+fun checkFile G tInit (_, ds, eo) =
     let
        val G' = foldl (fn (d, G) => checkDecl G d) G ds
     in