X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Flambda-delta%2Fcommon%2Fentity.ml;fp=helm%2Fsoftware%2Flambda-delta%2Fcommon%2Fentity.ml;h=292b1e921fc6bc349cc4d28aea170e5de03b228c;hb=cd798346d31b14b8947e5801b87dc4f363607862;hp=cd780601a13c4e9f244d455af903ed4c55a74b87;hpb=40ecc6da8b481b45d6bf0e1cfd2c285e98ed8e35;p=helm.git diff --git a/helm/software/lambda-delta/common/entity.ml b/helm/software/lambda-delta/common/entity.ml index cd780601a..292b1e921 100644 --- a/helm/software/lambda-delta/common/entity.ml +++ b/helm/software/lambda-delta/common/entity.ml @@ -12,8 +12,52 @@ type uri = NUri.uri type id = Aut.id -type 'bind entry = int * uri * 'bind (* age, uri, binder *) +type attr = Name of id * bool (* name, real? *) + | Apix of int (* additional position index *) + | Mark of int (* node marker *) + | Priv (* private global definition *) -type 'bind entity = 'bind entry option +type attrs = attr list (* attributes *) + +type 'term bind = Abst of 'term (* declaration: domain *) + | Abbr of 'term (* definition: body *) + +type 'term entity = attrs * uri * 'term bind (* attrs, name, binder *) type 'a uri_generator = (string -> 'a) -> string -> 'a + +(* helpers ******************************************************************) + +let rec name err f = function + | Name (n, r) :: _ -> f n r + | _ :: tl -> name err f tl + | [] -> err () + +let rec apix err f = function + | Apix i :: _ -> f i + | _ :: tl -> apix err f tl + | [] -> err () + +let rec mark err f = function + | Mark i :: _ -> f i + | _ :: tl -> mark err f tl + | [] -> err () + +let rec priv err f = function + | Priv :: _ -> f () + | _ :: tl -> priv err f tl + | [] -> err () + +let resolve err f name a = + let rec aux i = function + | Name (n, true) :: _ when n = name -> f i + | _ :: tl -> aux (succ i) tl + | [] -> err i + in + aux 0 a + +let xlate f xlate_term = function + | a, uri, Abst t -> + let f t = f (a, uri, Abst t) in xlate_term f t + | a, uri, Abbr t -> + let f t = f (a, uri, Abbr t) in xlate_term f t