X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Flambda-delta%2Fbasic_rg%2Fbrg.ml;h=baa83afed3741ca6f94637fec132262d7294a851;hb=f00757144b2cd7e6457fed55dbc1309d11a542dc;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..baa83afed 100644 --- a/helm/software/lambda-delta/basic_rg/brg.ml +++ b/helm/software/lambda-delta/basic_rg/brg.ml @@ -12,40 +12,37 @@ (* 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 of attrs (* attrs *) + | Abst of attrs * term (* attrs, type *) + | Abbr of attrs * term (* attrs, body *) 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 *) + | Bind of bind * term (* 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, binder *) + | Cons of lenv * lenv option * 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 root s = + String.concat "/" ["ld:"; "brg"; root; s ^ ".ld"] (* Currified constructors ***************************************************) -let abst w = Abst w +let abst a w = Abst (a, w) -let abbr v = Abbr v +let abbr a v = Abbr (a, v) let lref a i = LRef (a, i) @@ -53,47 +50,37 @@ let cast a u t = Cast (a, u, t) let appl a u t = Appl (a, u, t) -let bind a b t = Bind (a, b, t) +let bind b t = Bind (b, t) -let bind_abst a u t = Bind (a, Abst u, t) +let bind_abst a u t = Bind (Abst (a, u), t) -let bind_abbr a v t = Bind (a, Abbr v, t) +let bind_abbr a v t = Bind (Abbr (a, v), t) -(* context handling functions ***********************************************) +(* local environment handling functions *************************************) -let empty_context = Null +let empty_lenv = Null -let push f es ?c a b = - let es = Cons (es, c, a, b) in f es +let push f es ?c b = + let es = Cons (es, c, 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 + | Null -> err () + | Cons (tl, None, b) when j = 0 -> f tl b + | Cons (_, Some c, b) when j = 0 -> f c 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 + | Null -> f () + | Cons (tl, None, b) -> + let f _ = map f tl b in rev_iter f map tl + | Cons (tl, Some c, b) -> + let f _ = map f c b in rev_iter f map tl let rec fold_left f map x = function - | Null -> f x - | Cons (tl, _, a, b) -> + | Null -> f x + | Cons (tl, _, 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 + map f x b