X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Flambda-delta%2Fsrc%2Fcommon%2Fentity.ml;h=9915dd3c37b385ef42b6cebf992feebf228ddb34;hb=fa5cd121c672589afc0ac8ddd5d184897a38c7c6;hp=6da0b3aeb23a88506b28399aede5fe685f0f07f0;hpb=39b42ed90bc74c8b6293842f1ac4aca60fc0c37e;p=helm.git diff --git a/helm/software/lambda-delta/src/common/entity.ml b/helm/software/lambda-delta/src/common/entity.ml index 6da0b3aeb..9915dd3c3 100644 --- a/helm/software/lambda-delta/src/common/entity.ml +++ b/helm/software/lambda-delta/src/common/entity.ml @@ -10,7 +10,7 @@ V_______________________________________________________________ *) module U = NUri -module G = Options +module N = Level type uri = U.uri @@ -20,27 +20,25 @@ type name = id * bool (* token, real? *) type names = name list -type attr = Name of name (* name *) - | Apix of int (* additional position index *) - | Mark of int (* node marker *) - | Meta of string (* metaliguistic annotation *) - | Priv (* private global definition *) +type meta = Main (* main object *) + | InProp (* inhabitant of a proposition *) + | Progress (* uncompleted object *) + | Private (* private global definition *) + +type attr = Name of name (* name *) + | Apix of int (* additional position index *) + | Mark of int (* node marker *) + | Meta of meta list (* metaliguistic classification *) + | Info of (string * string) (* metaliguistic annotation: language (defaults to "en-US"), text *) type attrs = attr list (* attributes *) -type 'term bind = Abst of 'term (* declaration: domain *) - | Abbr of 'term (* definition: body *) - | Void (* exclusion *) +type 'term bind = Abst of N.level * 'term (* declaration: level, domain *) + | Abbr of 'term (* definition: body *) + | Void (* exclusion *) type 'term entity = attrs * uri * 'term bind (* attrs, name, binder *) -type status = { - delta: bool; (* global delta-expansion *) - rt: bool; (* reference typing *) - si: bool; (* sort inclusion *) - expand: bool (* always expand global definitions *) -} - (* helpers ******************************************************************) let common f (a, u, _) = f a u @@ -89,15 +87,15 @@ let rec mark err f = function | _ :: tl -> mark err f tl | [] -> err () -let rec priv err f = function - | Priv :: _ -> f () - | _ :: tl -> priv err f tl - | [] -> err () - let rec meta err f = function - | Meta s :: _ -> f s - | _ :: tl -> meta err f tl - | [] -> err () + | Meta ms :: _ -> f ms + | _ :: tl -> meta err f tl + | [] -> err () + +let rec info err f = function + | Info (lg, tx) :: _ -> f lg tx + | _ :: tl -> info err f tl + | [] -> err () let resolve err f name a = let rec aux i = function @@ -113,18 +111,9 @@ let rec rev_append_names ns = function | _ :: tl -> rev_append_names ns tl 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 -> + | a, uri, Abst (n, t) -> + let f t = f (a, uri, Abst (n, t)) in xlate_term f t + | a, uri, Abbr t -> let f t = f (a, uri, Abbr t) in xlate_term f t - | _, _, Void -> + | _, _, Void -> assert false - -let initial_status () = { - delta = false; rt = false; si = !G.si; expand = !G.expand -} - -let refresh_status st = {st with - si = !G.si; expand = !G.expand -} -