X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_cic_content%2FnTermCicContent.ml;h=8984a4829547fc241d94a2ce90487b7565b3cbf8;hb=c83721701dbbd44d3d547fdec6c4a5658322f424;hp=01e6fd48255fc97039a06407a5d03d6088951664;hpb=c3fc204cc02f1031b5d17fb0f2be1fc01e5c452f;p=helm.git diff --git a/helm/software/components/ng_cic_content/nTermCicContent.ml b/helm/software/components/ng_cic_content/nTermCicContent.ml index 01e6fd482..8984a4829 100644 --- a/helm/software/components/ng_cic_content/nTermCicContent.ml +++ b/helm/software/components/ng_cic_content/nTermCicContent.ml @@ -59,10 +59,10 @@ let idref register_ref = ;; (* CODICE c&p da NCicPp *) -let nast_of_cic0 +let nast_of_cic0 status ~(idref: ?reference:NReference.reference -> CicNotationPt.term -> CicNotationPt.term) - ~output_type ~subst k ~context = + ~output_type ~metasenv ~subst k ~context = function | NCic.Rel n -> (try @@ -113,7 +113,26 @@ let nast_of_cic0 (match hd with | NCic.Appl l -> NCic.Appl (l@args) | _ -> NCic.Appl (hd :: args))) - | NCic.Appl args -> idref (Ast.Appl (List.map (k ~context) args)) + | NCic.Appl args as t -> + let args = + if not !Acic2content.hide_coercions then args + else + match + NCicCoercion.match_coercion status ~metasenv ~context ~subst t + with + | None -> args + | Some (_,sats,cpos) -> +(* CSC: sats e' il numero di pi, ma non so cosa farmene! voglio il numero di + argomenti da saltare, come prima! *) + if cpos < List.length args - 1 then + List.nth args (cpos + 1) :: + try snd (HExtlib.split_nth (cpos+sats+2) args) with Failure _->[] + else + args + in + (match args with + [arg] -> idref (k ~context arg) + | _ -> idref (Ast.Appl (List.map (k ~context) args))) | NCic.Match (NReference.Ref (uri,_) as r,outty,te,patterns) -> let name = NUri.name_of_uri uri in (* CSC @@ -242,11 +261,11 @@ let instantiate32 idrefs env symbol args = if args = [] then head else Ast.Appl (head :: List.map instantiate_arg args) -let rec nast_of_cic1 ~idref ~output_type ~subst ~context term = +let rec nast_of_cic1 status ~idref ~output_type ~metasenv ~subst ~context term = match (get_compiled32 ()) term with | None -> - nast_of_cic0 ~idref ~output_type ~subst - (nast_of_cic1 ~idref ~output_type ~subst) ~context term + nast_of_cic0 status ~idref ~output_type ~metasenv ~subst + (nast_of_cic1 status ~idref ~output_type ~metasenv ~subst) ~context term | Some (env, ctors, pid) -> let idrefs = List.map @@ -266,7 +285,8 @@ let rec nast_of_cic1 ~idref ~output_type ~subst ~context term = List.map (fun (name, term) -> name, - nast_of_cic1 ~idref ~output_type ~subst ~context term + nast_of_cic1 status ~idref ~output_type ~subst ~metasenv ~context + term ) env in let _, symbol, args, _ = @@ -387,9 +407,10 @@ let instantiate_appl_pattern aux appl_pattern *) -let nmap_sequent0 ~idref ~subst (i,(n,context,ty):int * NCic.conjecture) = +let nmap_sequent0 status ~idref ~metasenv ~subst (i,(n,context,ty)) = let module K = Content in - let nast_of_cic = nast_of_cic1 ~idref ~output_type:`Term ~subst in + let nast_of_cic = + nast_of_cic1 status ~idref ~output_type:`Term ~metasenv ~subst in let context',_ = List.fold_right (fun item (res,context) -> @@ -421,11 +442,12 @@ let nmap_sequent0 ~idref ~subst (i,(n,context,ty):int * NCic.conjecture) = ("-1",i,context',nast_of_cic ~context ty) ;; -let nmap_sequent ~subst metasenv = +let nmap_sequent status ~metasenv ~subst conjecture = let module K = Content in let ids_to_refs = Hashtbl.create 211 in let register_ref = Hashtbl.add ids_to_refs in - nmap_sequent0 ~idref:(idref register_ref) ~subst metasenv, ids_to_refs + nmap_sequent0 status ~idref:(idref register_ref) ~metasenv ~subst conjecture, + ids_to_refs ;; let object_prefix = "obj:";; @@ -496,20 +518,20 @@ let build_decl_item seed id n s = } ;; -let nmap_obj (uri,_,metasenv,subst,kind) = +let nmap_obj status (uri,_,metasenv,subst,kind) = let module K = Content in let ids_to_refs = Hashtbl.create 211 in let register_ref = Hashtbl.add ids_to_refs in let idref = idref register_ref in let nast_of_cic = - nast_of_cic1 ~idref ~output_type:`Term ~subst in + nast_of_cic1 status ~idref ~output_type:`Term ~metasenv ~subst in let seed = ref 0 in let conjectures = match metasenv with [] -> None | _ -> (*Some (List.map (map_conjectures seed) metasenv)*) (*CSC: used to be the previous line, that uses seed *) - Some (List.map (nmap_sequent0 ~idref ~subst) metasenv) + Some (List.map (nmap_sequent0 status ~idref ~metasenv ~subst) metasenv) in let res = match kind with