X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Flambda-delta%2Fbasic_ag%2FbagType.ml;h=dbf1bd4ebdc11cea0d652d5ab6fff5e9384f0ec0;hb=f2771b346a41445df23adb6acccd7ee6b1578666;hp=c398e034dfeefb5c2e34328f4b575d63946b381d;hpb=94c6cfe7e6b833190904c6b546668d716978a812;p=helm.git diff --git a/helm/software/lambda-delta/basic_ag/bagType.ml b/helm/software/lambda-delta/basic_ag/bagType.ml index c398e034d..dbf1bd4eb 100644 --- a/helm/software/lambda-delta/basic_ag/bagType.ml +++ b/helm/software/lambda-delta/basic_ag/bagType.ml @@ -13,29 +13,32 @@ module U = NUri module C = Cps module S = Share module L = Log +module Y = Entity module H = Hierarchy module B = Bag module O = BagOutput module E = BagEnvironment module R = BagReduction +exception TypeError of B.message + (* Internal functions *******************************************************) let level = 4 let log1 s c t = - let sc, st = s ^ " in the context", "the term" in - L.log O.specs level (L.ct_items1 sc c st t) + let sc, st = s ^ " in the envireonment", "the term" in + L.log O.specs level (L.et_items1 sc c st t) let error1 st c t = - let sc = "In the context" in - raise (R.TypeError (L.ct_items1 sc c st t)) + let sc = "In the envireonment" in + raise (TypeError (L.et_items1 sc c st t)) let error3 c t1 t2 t3 = let sc, st1, st2, st3 = - "In the context", "the term", "is of type", "but must be of type" + "In the envireonment", "the term", "is of type", "but must be of type" in - raise (R.TypeError (L.ct_items3 sc c st1 t1 st2 t2 st3 t3)) + raise (TypeError (L.et_items3 sc c st1 t1 st2 t2 st3 t3)) let mk_gref u l = let map t v = B.Appl (v, t) in @@ -48,7 +51,7 @@ let rec b_type_of f ~si g c x = log1 "Now checking" c x; match x with | B.Sort h -> - let f h = f x (B.Sort h) in H.apply f g h + let h = H.apply g h in f x (B.Sort h) | B.LRef i -> let f = function | Some (_, B.Abst w) -> f x w @@ -62,13 +65,12 @@ let rec b_type_of f ~si g c x = B.get f c i | B.GRef uri -> let f = function - | _, _, B.Abst w -> f x w - | _, _, B.Abbr (B.Cast (w, v)) -> f x w - | _, _, B.Abbr _ -> assert false - | _, _, B.Void -> - error1 "reference to excluded object" c x + | _, _, Y.Abst w -> f x w + | _, _, Y.Abbr (B.Cast (w, v)) -> f x w + | _, _, Y.Abbr _ -> assert false + | _, _, Y.Void -> assert false in - E.get_obj f uri + E.get_entity f uri | B.Bind (l, id, B.Abbr v, t) -> let f xv xt tt = f (S.sh2 v xv t xt x (B.bind_abbr l id)) (B.bind_abbr l id xv tt)