X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Flambda-delta%2Fbasic_rg%2Fbrg.ml;h=fd93f397af56bf450ce8ef1452697f004ce7b3e5;hb=a22628e5de37d3ffe9de056d7683f2ebdf7226fb;hp=e42db3319b5739aea2bb9f00218b102f411adf35;hpb=dcdee4ca839dac671924a95f0ada71faf06a8be4;p=helm.git diff --git a/helm/software/lambda-delta/basic_rg/brg.ml b/helm/software/lambda-delta/basic_rg/brg.ml index e42db3319..fd93f397a 100644 --- a/helm/software/lambda-delta/basic_rg/brg.ml +++ b/helm/software/lambda-delta/basic_rg/brg.ml @@ -12,12 +12,13 @@ (* kernel version: basic, relative, global *) (* note : ufficial basic lambda-delta *) -type uri = NUri.uri -type id = Aut.id +type uri = Entity.uri +type id = Entity.id +type attrs = Entity.attrs -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 *) @@ -26,18 +27,16 @@ 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 *) -and attr = Name of bool * id (* real?, name *) - | Entry of int * bind (* age, binder *) +type entity = term Entity.entity (* attrs, uri, binder *) -and attrs = attr list +type lenv = Null +(* Cons: tail, relative local environment, attrs, binder *) + | Cons of lenv * lenv * attrs * bind -type obj = int * uri * bind (* age, uri, binder, contents *) +(* helpers ******************************************************************) -type item = obj option - -type context = (attrs * bind) list (* attrs, binder *) - -type message = (context, term) Log.item list +let mk_uri root s = + String.concat "/" ["ld:"; "brg"; root; s ^ ".ld"] (* Currified constructors ***************************************************) @@ -57,32 +56,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 bind_void a t = Bind (a, Void, t) -let empty_context = [] +(* local environment handling functions *************************************) -let push f es a b = - let c = (a, b) :: es in f c +let empty = Null -let append f es1 es2 = - f (List.append es2 es1) +let push e c a b = Cons (e, c, a, b) -let map f map es = - Cps.list_map f map es +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 contents f es = f es +let get e i = get i e -let get f es i = - let rec aux e i = function - | [] -> f e None - | hd :: tl -> - if i = 0 then f e (Some hd) else - let e = match hd with _, Abst _ -> succ e | _ -> e in - aux e (pred i) tl - in - aux 0 i es +(* 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 -let rec name f = function - | [] -> f None - | Name (r, n) :: _ -> f (Some (r, n)) - | _ :: tl -> name f tl +(* 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