+ let status, tgt, arity =
+ let metasenv,subst,status,tgt =
+ GrafiteDisambiguate.disambiguate_nterm
+ None status [] [] [] ("",0,tgt) in
+ let tgt = NCicUntrusted.apply_subst subst [] tgt in
+ (* CHECK che sia unificabile mancante *)
+ let rec count_prod = function
+ | NCic.Prod (_,_,x) -> 1 + count_prod x
+ | _ -> 0
+ in
+ status, tgt, count_prod tgt
+ in
+ status, src, tgt, cpos, arity
+;;
+
+let eval_ncoercion status name t ty (id,src) tgt =
+
+ let metasenv,subst,status,ty =
+ GrafiteDisambiguate.disambiguate_nterm None status [] [] [] ("",0,ty) in
+ assert (metasenv=[]);
+ let ty = NCicUntrusted.apply_subst subst [] ty in
+ let metasenv,subst,status,t =
+ GrafiteDisambiguate.disambiguate_nterm (Some ty) status [] [] [] ("",0,t) in
+ assert (metasenv=[]);
+ let t = NCicUntrusted.apply_subst subst [] t in
+
+ let status, src, tgt, cpos, arity =
+ src_tgt_cpos_arity_of_ty_id_src_tgt status ty id src tgt
+ in
+
+ let status = basic_eval_ncoercion (name,t,src,tgt,cpos,arity) status in
+ let dump = inject_ncoercion (name,t,src,tgt,cpos,arity)::status#dump in
+ let status = status#set_dump dump in
+ status,`New []
+;;
+
+let basic_eval_add_constraint (s,u1,u2) status =
+ NCicLibrary.add_constraint status s u1 u2
+;;
+
+let inject_constraint =
+ let basic_eval_add_constraint (s,u1,u2)
+ ~refresh_uri_in_universe
+ ~refresh_uri_in_term
+ =
+ let u1 = refresh_uri_in_universe u1 in
+ let u2 = refresh_uri_in_universe u2 in
+ basic_eval_add_constraint (s,u1,u2)
+ in
+ NRstatus.Serializer.register "constraints" basic_eval_add_constraint
+;;
+
+let eval_add_constraint status s u1 u2 =
+ let status = basic_eval_add_constraint (s,u1,u2) status in
+ let dump = inject_constraint (s,u1,u2)::status#dump in
+ let status = status#set_dump dump in
+ status,`Old []
+;;
+
+let add_coercions_of_lemmas lemmas status =
+ let moo_content =
+ HExtlib.filter_map
+ (fun uri ->
+ match CoercDb.is_a_coercion (Cic.Const (uri,[])) with
+ | None -> None
+ | Some (_,tgt,_,sat,_) ->
+ let arity = match tgt with CoercDb.Fun n -> n | _ -> 0 in
+ Some (coercion_moo_statement_of (uri,arity,sat,0)))
+ lemmas
+ in
+ let status = GrafiteTypes.add_moo_content moo_content status in
+ status#set_coercions (CoercDb.dump ()),
+ lemmas
+
+let eval_coercion status ~add_composites uri arity saturations =
+ let uri =
+ try CicUtil.uri_of_term uri
+ with Invalid_argument _ ->
+ raise (Invalid_argument "coercion can only be constants/constructors")
+ in
+ let status, lemmas =
+ GrafiteSync.add_coercion ~add_composites
+ ~pack_coercion_obj:CicRefine.pack_coercion_obj
+ status uri arity saturations status#baseuri in
+ let moo_content = coercion_moo_statement_of (uri,arity,saturations,0) in
+ let status = GrafiteTypes.add_moo_content [moo_content] status in
+ add_coercions_of_lemmas lemmas status
+
+let eval_prefer_coercion status c =
+ let uri =
+ try CicUtil.uri_of_term c
+ with Invalid_argument _ ->
+ raise (Invalid_argument "coercion can only be constants/constructors")
+ in
+ let status = GrafiteSync.prefer_coercion status uri in
+ let moo_content = GrafiteAst.PreferCoercion (HExtlib.dummy_floc,c) in
+ let status = GrafiteTypes.add_moo_content [moo_content] status in
+ status, `Old []
+
+module MatitaStatus =
+ struct
+ type input_status = GrafiteTypes.status * ProofEngineTypes.goal
+
+ type output_status =
+ GrafiteTypes.status * ProofEngineTypes.goal list * ProofEngineTypes.goal list
+
+ type tactic = input_status -> output_status
+
+ let mk_tactic tac = tac
+ let apply_tactic tac = tac
+ let goals (_, opened, closed) = opened, closed
+ let get_stack (status, _) = GrafiteTypes.get_stack status
+
+ let set_stack stack (status, opened, closed) =
+ GrafiteTypes.set_stack stack status, opened, closed
+
+ let inject (status, _) = (status, [], [])
+ let focus goal (status, _, _) = (status, goal)
+ end
+
+module MatitaTacticals = Continuationals.Make(MatitaStatus)
+
+let tactic_of_ast' tac =
+ MatitaTacticals.Tactical (MatitaTacticals.Tactic (MatitaStatus.mk_tactic tac))
+
+let punctuation_tactical_of_ast (text,prefix_len,punct) =
+ match punct with
+ | GrafiteAst.Dot _loc -> MatitaTacticals.Dot
+ | GrafiteAst.Semicolon _loc -> MatitaTacticals.Semicolon
+ | GrafiteAst.Branch _loc -> MatitaTacticals.Branch
+ | GrafiteAst.Shift _loc -> MatitaTacticals.Shift
+ | GrafiteAst.Pos (_loc, i) -> MatitaTacticals.Pos i
+ | GrafiteAst.Merge _loc -> MatitaTacticals.Merge
+ | GrafiteAst.Wildcard _loc -> MatitaTacticals.Wildcard
+
+let non_punctuation_tactical_of_ast (text,prefix_len,punct) =
+ match punct with
+ | GrafiteAst.Focus (_loc,goals) -> MatitaTacticals.Focus goals
+ | GrafiteAst.Unfocus _loc -> MatitaTacticals.Unfocus
+ | GrafiteAst.Skip _loc -> MatitaTacticals.Tactical MatitaTacticals.Skip
+
+let eval_tactical status tac =
+ let status, _, _ = MatitaTacticals.eval tac (status, ~-1) in