X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_cic_content%2FnTermCicContent.ml;h=c53a4a31c6ad0b7603f4dc8497323889012ea5c8;hb=e607b42a9a469b02ef377210dc34ada14cc603c1;hp=62d69f5d166dd979ac37bf7d99769895ef07efb0;hpb=9e7df95a820cb91d075f1a20d703175da874596c;p=helm.git diff --git a/helm/software/components/ng_cic_content/nTermCicContent.ml b/helm/software/components/ng_cic_content/nTermCicContent.ml index 62d69f5d1..c53a4a31c 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 @@ -93,7 +93,8 @@ let nast_of_cic0 F.fprintf f ")"*) (* CSC: qua siamo grezzi *) | NCic.Implicit `Hole -> idref (Ast.UserInput) - | NCic.Implicit _ -> idref (Ast.Implicit) + | NCic.Implicit `Vector -> idref (Ast.Implicit `Vector) + | NCic.Implicit _ -> idref (Ast.Implicit `JustOne) | NCic.Prod (n,s,t) -> let n = if n.[0] = '_' then "_" else n in let binder_kind = `Forall in @@ -113,7 +114,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 @@ -134,11 +154,11 @@ let nast_of_cic0 let rec eat_branch n ctx ty pat = match (ty, pat) with | NCic.Prod (name, s, t), _ when n > 0 -> - eat_branch (pred n) ((name,NCic.Decl s)::ctx) t pat + eat_branch (pred n) ctx t pat | NCic.Prod (_, _, t), NCic.Lambda (name, s, t') -> let cv, rhs = eat_branch 0 ((name,NCic.Decl s)::ctx) t t' in - (Ast.Ident (name,None), Some (k ~context s)) :: cv, rhs - | _, _ -> [], k ~context pat + (Ast.Ident (name,None), Some (k ~context:ctx s)) :: cv, rhs + | _, _ -> [], k ~context:ctx pat in let j = ref 0 in let patterns = @@ -242,11 +262,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 +286,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 +408,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 +443,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 +519,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