X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fhelena%2Fsrc%2Fbasic_ag%2FbagType.ml;h=b6f3deb558624b69369345836b0cf539542c2169;hb=9935a5bf5bdc98ad01a2b0234cf4e612a62c939f;hp=aa4b821a8c1942b3f49e3cba927741e2ab5de983;hpb=f72311aa07e71090a24eef9e4fb97cc2e95e6b16;p=helm.git diff --git a/helm/software/helena/src/basic_ag/bagType.ml b/helm/software/helena/src/basic_ag/bagType.ml index aa4b821a8..b6f3deb55 100644 --- a/helm/software/helena/src/basic_ag/bagType.ml +++ b/helm/software/helena/src/basic_ag/bagType.ml @@ -11,12 +11,11 @@ module U = NUri module C = Cps -module W = Share +module S = Share module L = Log +module G = Options module H = Hierarchy module E = Entity -module G = Options -module S = Status module Z = Bag module ZO = BagOutput module ZE = BagEnvironment @@ -24,11 +23,11 @@ module ZR = BagReduction (* Internal functions *******************************************************) -let level = 3 +let level = 4 -let log1 s c t = - let sc, st = s ^ " in the envireonment", "the term" in - L.log ZO.specs level (L.et_items1 sc c st t) +let log1 st s c t = + let s1, s2 = s ^ " in the envireonment", "the term" in + L.log st ZO.specs (pred level) (L.et_items1 s1 c s2 t) let error1 err st c t = let sc = "In the envireonment" in @@ -46,7 +45,7 @@ let mk_gref u l = let rec b_type_of err f st c x = (* L.warn "Entering T.b_type_of"; *) - if !G.trace >= level then log1 "Now checking" c x; + if !G.trace >= level then log1 st "Now checking" c x; match x with | Z.Sort h -> let h = H.apply h in f x (Z.Sort h) @@ -61,15 +60,15 @@ let rec b_type_of err f st c x = Z.get err0 f c i | Z.GRef uri -> let f = function - | _, _, E.Abst (_, w) -> f x w - | _, _, E.Abbr (Z.Cast (w, v)) -> f x w - | _, _, E.Abbr _ -> assert false - | _, _, E.Void -> assert false + | _, _, _, E.Abst w -> f x w + | _, _, _, E.Abbr (Z.Cast (w, v)) -> f x w + | _, _, _, E.Abbr _ -> assert false + | _, _, _, E.Void -> assert false in ZE.get_entity f uri | Z.Bind (a, l, Z.Abbr v, t) -> let f xv xt tt = - f (W.sh2 v xv t xt x (Z.bind_abbr a l)) (Z.bind_abbr a l xv tt) + f (S.sh2 v xv t xt x (Z.bind_abbr a l)) (Z.bind_abbr a l xv tt) in let f xv cc = b_type_of err (f xv) st cc t in let f xv = Z.push "type abbr" (f xv) c a l (Z.Abbr xv) in @@ -80,24 +79,24 @@ let rec b_type_of err f st c x = type_of err f st c v | Z.Bind (a, l, Z.Abst u, t) -> let f xu xt tt = - f (W.sh2 u xu t xt x (Z.bind_abst a l)) (Z.bind_abst a l xu tt) + f (S.sh2 u xu t xt x (Z.bind_abst a l)) (Z.bind_abst a l xu tt) in let f xu cc = b_type_of err (f xu) st cc t in let f xu _ = Z.push "type abst" (f xu) c a l (Z.Abst xu) in type_of err f st c u | Z.Bind (a, l, Z.Void, t) -> let f xt tt = - f (W.sh1 t xt x (Z.bind a l Z.Void)) (Z.bind a l Z.Void tt) + f (S.sh1 t xt x (Z.bind a l Z.Void)) (Z.bind a l Z.Void tt) in let f cc = b_type_of err f st cc t in Z.push "type void" f c a l Z.Void | Z.Appl (v, t) -> let f xv vv xt tt = function | ZR.Abst w -> - if !G.trace > level then L.log ZO.specs (succ level) (L.t_items1 "Just scanned" c w); + if !G.trace > level then L.log st ZO.specs level (L.t_items1 "Just scanned" c w); let f a = (* L.warn (Printf.sprintf "Convertible: %b" a); *) - if a then f (W.sh2 v xv t xt x Z.appl) (Z.appl xv tt) + if a then f (S.sh2 v xv t xt x Z.appl) (Z.appl xv tt) else error3 err c xv vv w in ZR.are_convertible f st c w vv @@ -110,7 +109,7 @@ let rec b_type_of err f st c x = | Z.Cast (u, t) -> let f xu xt tt a = (* L.warn (Printf.sprintf "Convertible: %b" a); *) - if a then f (W.sh2 u xu t xt x Z.cast) xu else error3 err c xt tt xu + if a then f (S.sh2 u xu t xt x Z.cast) xu else error3 err c xt tt xu in let f xu xt tt = ZR.are_convertible (f xu xt tt) st c xu tt in let f xu _ = b_type_of err (f xu) st c t in