X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=matita%2Fcomponents%2Fcontent_pres%2FtermContentPres.ml;h=9fa2bf4e0baf9fdaa881b0a3ac52b47e2c07fb17;hb=20b281858667138b8a2a1469ffae99f21b501695;hp=12fbb07e17b4010b95d16bb809e33220fb60d82c;hpb=ec401f51799a051fe8935b36d589fca5a4728d81;p=helm.git diff --git a/matita/components/content_pres/termContentPres.ml b/matita/components/content_pres/termContentPres.ml index 12fbb07e1..9fa2bf4e0 100644 --- a/matita/components/content_pres/termContentPres.ml +++ b/matita/components/content_pres/termContentPres.ml @@ -44,7 +44,7 @@ let resolve_binder = function let add_level_info prec t = Ast.AttributedTerm (`Level prec, t) -let rec top_pos t = add_level_info ~-1 t +let top_pos t = add_level_info ~-1 t let rec remove_level_info = function @@ -214,6 +214,7 @@ let pp_ast0 status t k = ]; break; k t ]) +(* | Ast.LetRec (rec_kind, funs, where) -> let rec_op = match rec_kind with `Inductive -> "rec" | `CoInductive -> "corec" @@ -261,6 +262,7 @@ let pp_ast0 status t k = ((hvbox false false (fst_row :: List.flatten tl_rows @ [ break; keyword "in"; break; k where ]))) +*) | Ast.Implicit `JustOne -> builtin_symbol "?" | Ast.Implicit `Vector -> builtin_symbol "…" | Ast.Meta (n, l) -> @@ -300,14 +302,14 @@ module IntMap = Map.Make(struct type t = int let compare = compare end);; type db = { level1_patterns21: NotationPt.term IntMap.t; - compiled21: ((NotationPt.term -> (NotationEnv.t * NotationPt.term list * int) option)) Lazy.t option; + compiled21: ((NotationPt.term -> (NotationEnv.t * NotationPt.term list * int) option)) Lazy.t; pattern21_matrix: (NotationPt.term * pattern_id) list; counter: pattern_id } let initial_db = { level1_patterns21 = IntMap.empty; - compiled21 = None; + compiled21 = lazy (Content2presMatcher.Matcher21.compiler []); pattern21_matrix = []; counter = ~-1 } @@ -324,18 +326,16 @@ class virtual status = method content_pres_db = content_pres_db method set_content_pres_db v = {< content_pres_db = v >} method set_content_pres_status - : 'status. #g_status as 'status -> 'self + : 'status. (#g_status as 'status) -> 'self = fun o -> {< content_pres_db = o#content_pres_db >} end let get_compiled21 status = - match status#content_pres_db.compiled21 with - | None -> assert false - | Some f -> Lazy.force f + Lazy.force status#content_pres_db.compiled21 let set_compiled21 status f = status#set_content_pres_db - { status#content_pres_db with compiled21 = Some f } + { status#content_pres_db with compiled21 = f } let add_idrefs = List.fold_right (fun idref t -> Ast.AttributedTerm (`IdRef idref, t)) @@ -347,7 +347,7 @@ let instantiate21 idrefs env l1 = Ast.AttributedTerm (attr, subst_singleton pos env t) | t -> NotationUtil.group (subst pos env t) and subst pos env = function - | Ast.AttributedTerm (attr, t) -> + | Ast.AttributedTerm (_attr, t) -> (* prerr_endline ("loosing attribute " ^ NotationPp.pp_attribute attr); *) subst pos env t | Ast.Variable var -> @@ -378,7 +378,7 @@ let instantiate21 idrefs env l1 = | Ast.Literal l as t -> let t = add_idrefs idrefs t in (match l with - | `Keyword k -> [ add_keyword_attrs t ] + | `Keyword _k -> [ add_keyword_attrs t ] | _ -> [ t ]) | Ast.Layout l -> [ Ast.Layout (subst_layout pos env l) ] | t -> [ NotationUtil.visit_ast (subst_singleton pos env) t ] @@ -587,7 +587,7 @@ let instantiate_level2 status env term = in let rec aux env term = match term with - | Ast.AttributedTerm (a, term) -> (*Ast.AttributedTerm (a, *)aux env term + | Ast.AttributedTerm (_a, term) -> (*Ast.AttributedTerm (a, *)aux env term | Ast.Appl terms -> Ast.Appl (List.map (aux env) terms) | Ast.Binder (binder, var, body) -> Ast.Binder (binder, aux_capture_var env var, aux env body) @@ -596,9 +596,11 @@ let instantiate_level2 status env term = List.map (aux_branch env) patterns) | Ast.LetIn (var, t1, t3) -> Ast.LetIn (aux_capture_var env var, aux env t1, aux env t3) +(* | Ast.LetRec (kind, definitions, body) -> Ast.LetRec (kind, List.map (aux_definition env) definitions, aux env body) +*) | Ast.Uri (name, None) -> Ast.Uri (name, None) | Ast.Uri (name, Some substs) -> Ast.Uri (name, Some (aux_substs env substs)) @@ -630,8 +632,8 @@ let instantiate_level2 status env term = Ast.Pattern (head, hrefs, vars) -> Ast.Pattern (head, hrefs, List.map (aux_capture_var env) vars) | Ast.Wildcard -> Ast.Wildcard - and aux_definition env (params, var, term, i) = - (List.map (aux_capture_var env) params, aux_capture_var env var, aux env term, i) + (*and aux_definition env (params, var, term, i) = + (List.map (aux_capture_var env) params, aux_capture_var env var, aux env term, i)*) and aux_substs env substs = List.map (fun (name, term) -> (name, aux env term)) substs and aux_meta_substs env meta_substs = List.map (aux_opt env) meta_substs @@ -644,7 +646,7 @@ let instantiate_level2 status env term = | Ast.TermVar (name,(Ast.Level l|Ast.Self l)) -> Ast.AttributedTerm (`Level l,Env.lookup_term env name) | Ast.FreshVar name -> Ast.Ident (lookup_fresh_name name, None) - | Ast.Ascription (term, name) -> assert false + | Ast.Ascription (_term, _name) -> assert false and aux_magic env = function | Ast.Default (some_pattern, none_pattern) -> let some_pattern_names = NotationUtil.names_of_term some_pattern in @@ -712,7 +714,7 @@ let instantiate_level2 status env term = | _ -> assert false in instantiate_fold_right env) - | Ast.If (_, p_true, p_false) as t -> + | Ast.If (_, _p_true, _p_false) as t -> aux env (NotationUtil.find_branch (Ast.Magic t)) | Ast.Fail -> assert false | _ -> assert false