X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_cic_content%2FnTermCicContent.ml;h=5cfda009c26bb564af3a45205860d931c320befb;hb=5c92c318030a05c766b3f6070dbd23589cbdee04;hp=56a3f35077e97d308427b7283193cecb21936f02;hpb=cf4a3f9226194e0f6dc9572dea1090e2bfa55219;p=helm.git diff --git a/helm/software/components/ng_cic_content/nTermCicContent.ml b/helm/software/components/ng_cic_content/nTermCicContent.ml index 56a3f3507..5cfda009c 100644 --- a/helm/software/components/ng_cic_content/nTermCicContent.ml +++ b/helm/software/components/ng_cic_content/nTermCicContent.ml @@ -58,6 +58,32 @@ let idref register_ref = Ast.AttributedTerm (`IdRef id, t) ;; +let level_of_uri u = + let name = NUri.name_of_uri u in + assert(String.length name > String.length "Type"); + String.sub name 4 (String.length name - 4) +;; + +let destroy_nat = + let is_nat_URI = NUri.eq (NUri.uri_of_string + "cic:/matita/ng/arithmetics/nat/nat.ind") in + let is_zero = function + | NCic.Const (NReference.Ref (uri, NReference.Con (0, 1, 0))) when + is_nat_URI uri -> true + | _ -> false + in + let is_succ = function + | NCic.Const (NReference.Ref (uri, NReference.Con (0, 2, 0))) when + is_nat_URI uri -> true + | _ -> false + in + let rec aux acc = function + | NCic.Appl [he ; tl] when is_succ he -> aux (acc + 1) tl + | t when is_zero t -> Some acc + | _ -> None + in + aux 0 + (* CODICE c&p da NCicPp *) let nast_of_cic0 status ~(idref: @@ -81,17 +107,13 @@ let nast_of_cic0 status idref (Ast.Meta (n, List.map (fun x -> Some (k ~context (NCicSubstitution.lift s x))) l)) | NCic.Sort NCic.Prop -> idref (Ast.Sort `Prop) - | NCic.Sort NCic.Type _ -> idref (Ast.Sort `Set) - (* CSC: | C.Sort (C.Type []) -> F.fprintf f "Type0" - | C.Sort (C.Type [false, u]) -> F.fprintf f "%s" (NUri.name_of_uri u) - | C.Sort (C.Type [true, u]) -> F.fprintf f "S(%s)" (NUri.name_of_uri u) - | C.Sort (C.Type l) -> - F.fprintf f "Max("; - aux ctx (C.Sort (C.Type [List.hd l])); - List.iter (fun x -> F.fprintf f ",";aux ctx (C.Sort (C.Type [x]))) - (List.tl l); - F.fprintf f ")"*) - (* CSC: qua siamo grezzi *) + | NCic.Sort NCic.Type [] -> idref (Ast.Sort `Set) + | NCic.Sort NCic.Type ((`Type,u)::_) -> + idref(Ast.Sort (`NType (level_of_uri u))) + | NCic.Sort NCic.Type ((`CProp,u)::_) -> + idref(Ast.Sort (`NCProp (level_of_uri u))) + | NCic.Sort NCic.Type ((`Succ,u)::_) -> + idref(Ast.Sort (`NType (level_of_uri u ^ "+1"))) | NCic.Implicit `Hole -> idref (Ast.UserInput) | NCic.Implicit `Vector -> idref (Ast.Implicit `Vector) | NCic.Implicit _ -> idref (Ast.Implicit `JustOne) @@ -117,25 +139,29 @@ let nast_of_cic0 status | NCic.Appl l -> NCic.Appl (l@args) | _ -> NCic.Appl (hd :: 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) -> + (match destroy_nat t with + | Some n -> idref (Ast.Num (string_of_int n, -1)) + | None -> + 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))) + 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 @@ -559,15 +585,37 @@ let build_inductive b seed = K.inductive_type = ty; K.inductive_constructors = build_constructors seed cl } +in +let build_fixpoint b seed = + fun (_,n,_,ty,t) -> + let t = nast_of_cic ~context:[] t in + let ty = nast_of_cic ~context:[] ty in + `Definition + { K.def_id = gen_id inductive_prefix seed; + K.def_name = Some n; + K.def_aref = ""; + K.def_type = ty; + K.def_term = t; + } in let res = match kind with - | NCic.Fixpoint (is_rec, ifl, _) -> assert false + | NCic.Fixpoint (is_rec, ifl, _) -> + (gen_id object_prefix seed, [], conjectures, + `Joint + { K.joint_id = gen_id joint_prefix seed; + K.joint_kind = + if is_rec then + `Recursive (List.map (fun (_,_,i,_,_) -> i) ifl) + else `CoRecursive; + K.joint_defs = List.map (build_fixpoint is_rec seed) ifl + }) | NCic.Inductive (is_ind, lno, itl, _) -> (gen_id object_prefix seed, [], conjectures, `Joint { K.joint_id = gen_id joint_prefix seed; - K.joint_kind = `Inductive lno; + K.joint_kind = + if is_ind then `Inductive lno else `CoInductive lno; K.joint_defs = List.map (build_inductive is_ind seed) itl }) | NCic.Constant (_,_,Some bo,ty,_) ->