X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fcontent_pres%2FtermContentPres.ml;h=013e3a872fabcff73824e786fcae9982b52c2a4a;hb=b637879a2b3f2ceda65afb3c950061189c4730b7;hp=89dba29879c05208045c4685cc2e6c3f0e92b319;hpb=8c4659819a1c1f2e450d9a588ecca37d95ae48e9;p=helm.git diff --git a/helm/software/components/content_pres/termContentPres.ml b/helm/software/components/content_pres/termContentPres.ml index 89dba2987..013e3a872 100644 --- a/helm/software/components/content_pres/termContentPres.ml +++ b/helm/software/components/content_pres/termContentPres.ml @@ -98,17 +98,16 @@ let pp_ast0 t k = let rec aux = function | Ast.Appl ts -> - let rec aux_args pos = + let rec aux_args level = function | [] -> [] | [ last ] -> - let last = k last in - [ last ] + [ Ast.AttributedTerm (`Level level,k last) ] | hd :: tl -> - (k hd) :: aux_args `Inner tl + (Ast.AttributedTerm (`Level level, k hd)) :: aux_args 71 tl in add_level_info Ast.apply_prec - (hovbox true true (CicNotationUtil.dress break (aux_args `Left ts))) + (hovbox true true (CicNotationUtil.dress break (aux_args 70 ts))) | Ast.Binder (binder_kind, (id, ty), body) -> add_level_info Ast.binder_prec (hvbox false true @@ -197,7 +196,7 @@ let pp_ast0 t k = hvbox false true [ aux_var var; space; builtin_symbol "\\def"; break; top_pos (k s) ]; - break; space; keyword "in" ]; + break; space; keyword "in"; space ]; break; k t ]) | Ast.LetRec (rec_kind, funs, where) -> @@ -324,8 +323,7 @@ let instantiate21 idrefs env l1 = let value = CicNotationEnv.term_of_value value in let value = match expected_ty with - | Env.TermType (Some l) -> - Ast.AttributedTerm (`Level l,value) + | Env.TermType l -> Ast.AttributedTerm (`Level l,value) | _ -> value in [ value ] @@ -348,7 +346,7 @@ let instantiate21 idrefs env l1 = let sep = match sep_opt with | None -> [] - | Some l -> [ Ast.Literal l ] + | Some l -> [ Ast.Literal l; break; space ] in let rec instantiate_list acc = function | [] -> List.rev acc @@ -361,7 +359,7 @@ let instantiate21 idrefs env l1 = let terms = subst pos env p in instantiate_list (CicNotationUtil.group (terms @ sep) :: acc) tl in - instantiate_list [] values + [hovbox false false (instantiate_list [] values)] | Ast.Opt p -> let opt_decls = CicNotationEnv.declarations_of_term p in let env = @@ -513,6 +511,8 @@ let head_names names env = (match ty, v with | Env.ListType ty, Env.ListValue (v :: _) -> aux ((name, (ty, v)) :: acc) tl + | Env.TermType _, Env.TermValue _ -> + aux ((name, (ty, v)) :: acc) tl | _ -> assert false) | _ :: tl -> aux acc tl (* base pattern may contain only meta names, thus we trash all others *) @@ -526,6 +526,8 @@ let tail_names names env = (match ty, v with | Env.ListType ty, Env.ListValue (_ :: vtl) -> aux ((name, (Env.ListType ty, Env.ListValue vtl)) :: acc) tl + | Env.TermType _, Env.TermValue _ -> + aux ((name, (ty, v)) :: acc) tl | _ -> assert false) | binding :: tl -> aux (binding :: acc) tl | [] -> acc @@ -533,6 +535,7 @@ let tail_names names env = aux [] env let instantiate_level2 env term = +(* prerr_endline ("istanzio: " ^ CicNotationPp.pp_term term); *) let fresh_env = ref [] in let lookup_fresh_name n = try @@ -545,7 +548,7 @@ let instantiate_level2 env term = let rec aux env term = (* prerr_endline ("ENV " ^ CicNotationPp.pp_env env); *) match term with - | Ast.AttributedTerm (_, term) -> 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) @@ -594,9 +597,7 @@ let instantiate_level2 env term = and aux_variable env = function | Ast.NumVar name -> Ast.Num (Env.lookup_num env name, 0) | Ast.IdentVar name -> Ast.Ident (Env.lookup_string env name, None) - | Ast.TermVar (name,None) -> - Env.lookup_term env name - | Ast.TermVar (name,Some l) -> + | 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 @@ -638,7 +639,7 @@ let instantiate_level2 env term = | Env.ListValue (_ :: _) -> instantiate_fold_left (let acc_binding = - acc_name, (Env.TermType None, Env.TermValue acc) + acc_name, (Env.TermType 0, Env.TermValue acc) in aux (acc_binding :: head_names names env') rec_pattern) (tail_names names env') @@ -660,7 +661,7 @@ let instantiate_level2 env term = | Env.ListValue (_ :: _) -> let acc = instantiate_fold_right (tail_names names env') in let acc_binding = - acc_name, (Env.TermType None, Env.TermValue acc) + acc_name, (Env.TermType 0, Env.TermValue acc) in aux (acc_binding :: head_names names env') rec_pattern | Env.ListValue [] -> aux env base_pattern