X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Flambda-delta%2Fbasic_rg%2Fbrg.ml;h=e42db3319b5739aea2bb9f00218b102f411adf35;hb=4dc87cc7384ba61136bc82a23effe6a52160e720;hp=17532c970f32f234a4f5d5654e852a36834b63a4;hpb=41bf338d7e638ebb5d97e525055bff05b1f0f045;p=helm.git diff --git a/helm/software/lambda-delta/basic_rg/brg.ml b/helm/software/lambda-delta/basic_rg/brg.ml index 17532c970..e42db3319 100644 --- a/helm/software/lambda-delta/basic_rg/brg.ml +++ b/helm/software/lambda-delta/basic_rg/brg.ml @@ -9,6 +9,9 @@ \ / This software is distributed as is, NO WARRANTY. V_______________________________________________________________ *) +(* kernel version: basic, relative, global *) +(* note : ufficial basic lambda-delta *) + type uri = NUri.uri type id = Aut.id @@ -16,54 +19,70 @@ type bind = Void (* exclusion *) | Abst of term (* abstraction *) | Abbr of term (* abbreviation *) -and term = Sort of int (* hierarchy index *) - | LRef of int (* reverse de Bruijn index *) - | GRef of uri (* reference *) - | Cast of term * term (* type, term *) - | Appl of term * term (* argument, function *) - | Bind of id * bind * term (* name, binder, scope *) +and term = Sort of attrs * int (* attrs, hierarchy index *) + | LRef of attrs * int (* attrs, position index *) + | GRef of attrs * uri (* attrs, reference *) + | Cast of attrs * term * term (* attrs, type, term *) + | 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 *) + +and attrs = attr list type obj = int * uri * bind (* age, uri, binder, contents *) type item = obj option -type context = int * (id * bind) list +type context = (attrs * bind) list (* attrs, binder *) type message = (context, term) Log.item list -type hierarchy = int -> int - (* Currified constructors ***************************************************) let abst w = Abst w let abbr v = Abbr v -let cast u t = Cast (u, t) +let lref a i = LRef (a, i) -let appl u t = Appl (u, t) +let cast a u t = Cast (a, u, t) -let bind id b t = Bind (id, b, t) +let appl a u t = Appl (a, u, t) -(* context handling functions ***********************************************) +let bind a b t = Bind (a, b, t) -let empty_context = 0, [] +let bind_abst a u t = Bind (a, Abst u, t) -let push f (l, es) id b = - let c = succ l, (id, b) :: es in - f c +let bind_abbr a v t = Bind (a, Abbr v, t) -let append f (l1, es1) (l2, es2) = - f (l2 + l1, List.append es2 es1) +(* context handling functions ***********************************************) -let map f map (l, es) = - let f es = f (l, es) in - Cps.list_map f map es +let empty_context = [] -let contents f (l, es) = f l es +let push f es a b = + let c = (a, b) :: es in f c -let get f (l, es) i = - if i < 0 || i >= l then f None else - let result = List.nth es (l - succ i) in - f (Some result) +let append f es1 es2 = + f (List.append es2 es1) + +let map f map es = + Cps.list_map f map es +let contents f es = f es + +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 + +let rec name f = function + | [] -> f None + | Name (r, n) :: _ -> f (Some (r, n)) + | _ :: tl -> name f tl