X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Flambda-delta%2Fbasic_rg%2Fbrg.ml;h=efc5d7556914bc6b8976b0ade53be6a751c042ee;hb=cacd19eb7ce2395301b31ed3932b4cd7c23ca90e;hp=5ad05a72f7da075221bedd10490b63900ddcf438;hpb=f983656c56d37a50536e50a319114dbfa592c9a0;p=helm.git diff --git a/helm/software/lambda-delta/basic_rg/brg.ml b/helm/software/lambda-delta/basic_rg/brg.ml index 5ad05a72f..efc5d7556 100644 --- a/helm/software/lambda-delta/basic_rg/brg.ml +++ b/helm/software/lambda-delta/basic_rg/brg.ml @@ -12,17 +12,13 @@ (* kernel version: basic, relative, global *) (* note : ufficial basic lambda-delta *) -type uri = Item.uri -type id = Item.id +type uri = Entity.uri +type id = Entity.id +type attrs = Entity.attrs -type attr = Name of bool * id (* real?, name *) - | Apix of int (* additional position index *) - -type attrs = attr list - -type bind = Void (* exclusion *) - | Abst of term (* abstraction *) - | Abbr of term (* abbreviation *) +type bind = Void (* *) + | Abst of term (* type *) + | Abbr of term (* body *) and term = Sort of attrs * int (* attrs, hierarchy index *) | LRef of attrs * int (* attrs, position index *) @@ -31,15 +27,17 @@ and term = Sort of attrs * int (* attrs, hierarchy index *) | Appl of attrs * term * term (* attrs, argument, function *) | Bind of attrs * bind * term (* attrs, binder, scope *) -type obj = bind Item.obj (* age, uri, binder *) +type entity = term Entity.entity (* attrs, uri, binder *) -type item = bind Item.item +type lenv = Null +(* Cons: tail, relative local environment, attrs, binder *) + | Cons of lenv * lenv * attrs * bind -type context = Null -(* Cons: tail, relative context, attrs, binder *) - | Cons of context * context option * attrs * bind +(* helpers ******************************************************************) -type message = (context, term) Log.item list +let mk_uri si root s = + let kernel = if si then "brg-si" else "brg" in + String.concat "/" ["ld:"; kernel; root; s ^ ".ld"] (* Currified constructors ***************************************************) @@ -59,41 +57,27 @@ let bind_abst a u t = Bind (a, Abst u, t) let bind_abbr a v t = Bind (a, Abbr v, t) -(* context handling functions ***********************************************) - -let empty_context = Null - -let push f es ?c a b = - let es = Cons (es, c, a, b) in f es - -let get err f es i = - let rec aux j = function - | Null -> err i - | Cons (tl, None, a, b) when j = 0 -> f tl a b - | Cons (_, Some c, a, b) when j = 0 -> f c a b - | Cons (tl, _, _, _) -> aux (pred j) tl - in - aux i es - -let rec rev_iter f map = function - | Null -> f () - | Cons (tl, None, a, b) -> - let f () = map f tl a b in rev_iter f map tl - | Cons (tl, Some c, a, b) -> - let f () = map f c a b in rev_iter f map tl - -let rec fold_left f map x = function - | Null -> f x - | Cons (tl, _, a, b) -> - let f x = fold_left f map x tl in - map f x a b - -let rec name err f = function - | [] -> err () - | Name (r, n) :: _ -> f n r - | _ :: tl -> name err f tl - -let rec apix err f = function - | [] -> err () - | Apix i :: _ -> f i - | _ :: tl -> apix err f tl +let bind_void a t = Bind (a, Void, t) + +(* local environment handling functions *************************************) + +let empty = Null + +let push e c a b = Cons (e, c, a, b) + +let rec get i = function + | Null -> Null, Null, [], Void + | Cons (e, c, a, b) when i = 0 -> e, c, a, b + | Cons (e, _, _, _) -> get (pred i) e + +let get e i = get i e + +(* used in BrgOutput.pp_lenv *) +let rec fold_right f map e x = match e with + | Null -> f x + | Cons (e, c, a, b) -> fold_right (map f e c a b) map e x + +(* used in MetaBrg.unwind_to_xlate_term *) +let rec fold_left map x = function + | Null -> x + | Cons (e, _, a, b) -> fold_left map (map x a b) e