X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Flambda-delta%2Ftoplevel%2FmetaBrg.ml;h=cde4daa135c1c915111d175acbd478a37d5767a6;hb=a22628e5de37d3ffe9de056d7683f2ebdf7226fb;hp=4088c2982f25115891f09fcc51d3c8f57f86a1b3;hpb=25fba20748a951f7061188cc5fabece8f5ac97b9;p=helm.git diff --git a/helm/software/lambda-delta/toplevel/metaBrg.ml b/helm/software/lambda-delta/toplevel/metaBrg.ml index 4088c2982..cde4daa13 100644 --- a/helm/software/lambda-delta/toplevel/metaBrg.ml +++ b/helm/software/lambda-delta/toplevel/metaBrg.ml @@ -9,56 +9,58 @@ \ / This software is distributed as is, NO WARRANTY. V_______________________________________________________________ *) +module C = Cps +module Y = Entity module B = Brg module M = Meta (* Internal functions *******************************************************) -let map_fold_left f map1 map2 a l = - let f a = Cps.list_fold_left f map2 a l in - map1 f a - -let map_args f t v = f (B.Appl (v, t)) - -let map_pars f t (id, w) = f (B.Bind (id, B.Abst, w, t)) - -let rec xlate_term f = function +let rec xlate_term c f = function | M.Sort s -> - let f h = f (B.Sort h) in + let f h = f (B.Sort ([], h)) in if s then f 0 else f 1 - | M.LRef (l, i) -> - f (B.LRef (l - i)) + | M.LRef (_, i) -> + f (B.LRef ([], i)) | M.GRef (_, uri, vs) -> - let f vs = map_fold_left f Cps.id map_args (B.GRef uri) vs in - Cps.list_rev_map f xlate_term vs + let map f t v = f (B.appl [] v t) in + let f vs = C.list_fold_left f map (B.GRef ([], uri)) vs in + C.list_map f (xlate_term c) vs | M.Appl (v, t) -> - let f v t = f (B.Appl (v, t)) in - let f v = xlate_term (f v) t in - xlate_term f v + let f v t = f (B.Appl ([], v, t)) in + let f v = xlate_term c (f v) t in + xlate_term c f v | M.Abst (id, w, t) -> - let f w t = f (B.Bind (id, B.Abst, w, t)) in - let f w = xlate_term (f w) t in - xlate_term f w + let f w = + let a = [Y.Name (id, true)] in + let f t = f (B.Bind (a, B.Abst w, t)) in + xlate_term (B.push c B.empty a (B.Abst w)) f t + in + xlate_term c f w -let xlate_pars f (id, w) = - let f w = f (id, w) in - xlate_term f w +let xlate_pars f pars = + let map f (id, w) c = + let a = [Y.Name (id, true)] in + let f w = f (B.push c B.empty a (B.Abst w)) in + xlate_term c f w + in + C.list_fold_right f map pars B.empty -let xlate_entry f = function - | e, pars, uri, u, None -> - let f u = f (e, uri, B.Abst, u) in - let f pars = map_fold_left f xlate_term map_pars u pars in - Cps.list_rev_map f xlate_pars pars - | e, pars, uri, u, Some (_, t) -> - let f u t = f (e, uri, B.Abbr, (B.Cast (u, t))) in - let f pars u = map_fold_left (f u) xlate_term map_pars t pars in - let f pars = map_fold_left (f pars) xlate_term map_pars u pars in - Cps.list_rev_map f xlate_pars pars +let unwind_to_xlate_term f c t = + let map t a b = B.bind a b t in + let f t = f (B.fold_left map t c) in + xlate_term c f t -let xlate_item f = function - | None -> f None - | Some e -> let f e = f (Some e) in xlate_entry f e +let xlate_entry f = function + | pars, u, None -> + let f c = unwind_to_xlate_term f c u in + xlate_pars f pars + | pars, u, Some t -> + let f u t = f (B.Cast ([], u, t)) in + let f c u = unwind_to_xlate_term (f u) c t in + let f c = unwind_to_xlate_term (f c) c u in + xlate_pars f pars (* Interface functions ******************************************************) -let brg_of_meta = xlate_item +let brg_of_meta = xlate_entry