aux
;;
-exception NotImplemented;;
-
let print_object uri ~ids_to_inner_sorts =
let rec aux =
let module C = Cic in
>]
in
xmlty, xmlbo
- | _ -> raise NotImplemented
+ | C.AVariable (id,n,bo,ty,params) ->
+ let params' = param_attribute_of_params params in
+ let xmlbo =
+ match bo with
+ None -> [< >]
+ | Some bo ->
+ X.xml_nempty "body" [] [< print_term ids_to_inner_sorts bo >]
+ in
+ let aobj =
+ [< X.xml_cdata "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n" ;
+ X.xml_cdata ("<!DOCTYPE Variable SYSTEM \"" ^ dtdname ^ "\">\n");
+ X.xml_nempty "Variable"
+ ["name",n ; "params",params' ; "id", id]
+ [< xmlbo ;
+ X.xml_nempty "type" [] (print_term ids_to_inner_sorts ty)
+ >]
+ >]
+ in
+ aobj, None
+ | C.AInductiveDefinition (id,tys,params,nparams) ->
+ let params' = param_attribute_of_params params in
+ [< X.xml_cdata "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n" ;
+ X.xml_cdata ("<!DOCTYPE InductiveDefinition SYSTEM \"" ^
+ dtdname ^ "\">\n") ;
+ X.xml_nempty "InductiveDefinition"
+ ["noParams",string_of_int nparams ;
+ "id",id ;
+ "params",params']
+ [< (List.fold_left
+ (fun i (id,typename,finite,arity,cons) ->
+ [< i ;
+ X.xml_nempty "InductiveType"
+ ["id",id ; "name",typename ;
+ "inductive",(string_of_bool finite)
+ ]
+ [< X.xml_nempty "arity" []
+ (print_term ids_to_inner_sorts arity) ;
+ (List.fold_left
+ (fun i (name,lc) ->
+ [< i ;
+ X.xml_nempty "Constructor"
+ ["name",name]
+ (print_term ids_to_inner_sorts lc)
+ >]) [<>] cons
+ )
+ >]
+ >]
+ ) [< >] tys
+ )
+ >]
+ >], None
in
aux
;;
* http://cs.unibo.it/helm/.
*)
-exception NotImplemented;;
-
type anntypes =
{annsynthesized : Cic.annterm ; annexpected : Cic.annterm option}
;;
let aty = acic_term_of_cic_term' ty None in
C.AConstant
("mettereaposto",Some "mettereaposto2",id,Some abo,aty, params)
- | C.Constant (id,None,ty,params) -> raise NotImplemented
- | C.Variable (id,bo,ty,params) -> raise NotImplemented
+ | C.Constant (id,None,ty,params) ->
+ let aty = acic_term_of_cic_term' ty None in
+ C.AConstant
+ ("mettereaposto",None,id,None,aty, params)
+ | C.Variable (id,bo,ty,params) ->
+ let abo =
+ match bo with
+ None -> None
+ | Some bo -> Some (acic_term_of_cic_term' bo (Some ty))
+ in
+ let aty = acic_term_of_cic_term' ty None in
+ C.AVariable
+ ("mettereaposto",id,abo,aty, params)
| C.CurrentProof (id,conjectures,bo,ty,params) ->
let aconjectures =
List.map
let aty = acic_term_of_cic_term_context' conjectures [] [] ty None in
C.ACurrentProof
("mettereaposto","mettereaposto2",id,aconjectures,abo,aty,params)
- | C.InductiveDefinition (tys,params,paramsno) -> raise NotImplemented
+ | C.InductiveDefinition (tys,params,paramsno) ->
+ let context =
+ List.map
+ (fun (name,_,arity,_) -> Some (C.Name name, C.Decl arity)) tys in
+ let idrefs = List.map (function _ -> gen_id seed) tys in
+ let atys =
+ List.map2
+ (fun id (name,inductive,ty,cons) ->
+ let acons =
+ List.map
+ (function (name,ty) ->
+ (name,
+ acic_term_of_cic_term_context' [] context idrefs ty None)
+ ) cons
+ in
+ (id,name,inductive,acic_term_of_cic_term' ty None,acons)
+ ) (List.rev idrefs) tys
+ in
+ C.AInductiveDefinition ("mettereaposto",atys,params,paramsno)
in
aobj,ids_to_terms,ids_to_father_ids,ids_to_inner_sorts,ids_to_inner_types,
ids_to_conjectures,ids_to_hypotheses