X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=matita%2Fcomponents%2Fcontent_pres%2FtermContentPres.ml;h=84f4a2f7272bd5636f5fb0663ec071ea128cfad4;hb=4407db5bba0f96916a85648a337648da047fd03d;hp=6846c30b5b9e608fe96af08fbb60b740ccf24b19;hpb=894d518aa760c9f816ddb0dc2b3fa88e1fe20a94;p=helm.git diff --git a/matita/components/content_pres/termContentPres.ml b/matita/components/content_pres/termContentPres.ml index 6846c30b5..84f4a2f72 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 @@ -143,7 +143,7 @@ let pp_ast0 status t k = in let match_box = hvbox false false [ - hvbox false true [ + hvbox false false [ hvbox false true [keyword "match"; space; break; top_pos (k what)]; break; hvbox false true indty_box; @@ -210,10 +210,11 @@ let pp_ast0 status t k = keyword "let"; space; hvbox false true [ aux_var var; space; - builtin_symbol "\\def"; break; top_pos (k s) ]; - break; space; keyword "in"; space ]; + builtin_symbol "\\def"; break; top_pos (k s); space; keyword "in"; space ]; + ]; 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 } @@ -329,13 +331,11 @@ class virtual status = 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