-DIRS = ocaml gTopLevel searchEngine mathql_test
-# hbugs
+DIRS = ocaml hbugs gTopLevel searchEngine mathql_test
DIRS_BYTE = $(patsubst %,%.byte,$(DIRS))
DIRS_OPT = $(patsubst %,%.opt,$(DIRS))
termEditor.cmi: disambiguate.cmi
texTermEditor.cmi: disambiguate.cmi
invokeTactics.cmi: termEditor.cmi termViewer.cmi
+hbugs.cmi: invokeTactics.cmi
proofEngine.cmo: proofEngine.cmi
proofEngine.cmx: proofEngine.cmi
logicalOperations.cmo: proofEngine.cmi logicalOperations.cmi
termViewer.cmi invokeTactics.cmi
invokeTactics.cmx: logicalOperations.cmx proofEngine.cmx termEditor.cmx \
termViewer.cmx invokeTactics.cmi
-gTopLevel.cmo: invokeTactics.cmi logicalOperations.cmi proofEngine.cmi \
- termEditor.cmi termViewer.cmi texTermEditor.cmi
-gTopLevel.cmx: invokeTactics.cmx logicalOperations.cmx proofEngine.cmx \
- termEditor.cmx termViewer.cmx texTermEditor.cmx
+hbugs.cmo: invokeTactics.cmi proofEngine.cmi hbugs.cmi
+hbugs.cmx: invokeTactics.cmx proofEngine.cmx hbugs.cmi
+gTopLevel.cmo: hbugs.cmi invokeTactics.cmi logicalOperations.cmi \
+ proofEngine.cmi termEditor.cmi termViewer.cmi texTermEditor.cmi
+gTopLevel.cmx: hbugs.cmx invokeTactics.cmx logicalOperations.cmx \
+ proofEngine.cmx termEditor.cmx termViewer.cmx texTermEditor.cmx
REQUIRES = lablgtkmathview helm-cic_textual_parser helm-tex_cic_textual_parser \
helm-cic_proof_checking helm-xml gdome2-xslt helm-cic_unification \
helm-mathql helm-mathql_interpreter helm-mathql_generator \
- helm-tactics threads hbugs-client mathml-editor \
+ helm-tactics threads hbugs-client mathml-editor \
helm-cic_transformations
PREDICATES = "gnome,init,glade"
OCAMLOPTIONS = -package "$(REQUIRES)" -predicates "$(PREDICATES)" -pp camlp4o
ifneq ($(MAKECMDGOALS), depend)
include .depend
endif
-
-
-
-
-
-
-
-
end
;;
module InvokeTactics' = InvokeTactics.Make (InvokeTacticsCallbacks);;
-
+(*
(* Just to initialize the Hbugs module *)
module Ignore = Hbugs.Initialize (InvokeTactics');;
Hbugs.set_describe_hint_callback (fun hint ->
check_window outputhtml [term]
| _ -> ())
;;
-
+*)
let dummy_uri = "/dummy.con"
(** load an unfinished proof from filesystem *)
ApplyStylesheets.mml_of_cic_sequent metasenv sequent
in
self#load_doc ~dom:sequent_mml ;
+(*
Misc.domImpl#saveDocumentToFile ~name:"/tmp/pippo" ~doc:sequent_mml () ;
- current_infos <-
+*)
+ current_infos <-
Some (ids_to_terms,ids_to_father_ids,ids_to_hypotheses)
end
;;
Prop
| Set
| Type
+ | CProp
and name =
Name of string
| Anonymous
(*CSC: computed again and again. *)
let string_of_sort t =
match CicReduction.whd context t with
- C.Sort C.Prop -> "Prop"
- | C.Sort C.Set -> "Set"
- | C.Sort C.Type -> "Type"
- | _ -> assert false
+ C.Sort C.Prop -> "Prop"
+ | C.Sort C.Set -> "Set"
+ | C.Sort C.Type -> "Type"
+ | C.Sort C.CProp -> "CProp"
+ | _ -> assert false
in
let ainnertypes,innertype,innersort,expected_available =
(*CSC: Here we need the algorithm for Coscoy's double type-inference *)
let t2' = CicReduction.whd ((Some (name,C.Decl s))::context) t2 in
match (t1', t2') with
(C.Sort s1, C.Sort s2)
- when (s2 = C.Prop or s2 = C.Set) -> (* different from Coq manual!!! *)
+ when (s2 = C.Prop or s2 = C.Set or s2 = C.CProp) -> (* different from Coq manual!!! *)
C.Sort s2
| (C.Sort s1, C.Sort s2) -> C.Sort C.Type (*CSC manca la gestione degli universi!!! *)
| (_,_) ->
"]"
| C.Sort s ->
(match s with
- C.Prop -> "Prop"
- | C.Set -> "Set"
- | C.Type -> "Type"
+ C.Prop -> "Prop"
+ | C.Set -> "Set"
+ | C.Type -> "Type"
+ | C.CProp -> "CProp"
)
| C.Implicit -> "?"
| C.Prod (b,s,t) ->
(C.Appl [CicSubstitution.lift 1 ind ; C.Rel 1]) de1 de2
| (C.Sort C.Prop, C.Sort C.Prop) when need_dummy -> true
| (C.Sort C.Prop, C.Sort C.Set)
+ | (C.Sort C.Prop, C.Sort C.CProp)
| (C.Sort C.Prop, C.Sort C.Type) when need_dummy ->
(*CSC: WRONG. MISSING CONDITIONS ON THE ARGUMENTS OF THE CONSTRUTOR *)
(match CicEnvironment.get_obj uri with
(WrongUriToMutualInductiveDefinitions (U.string_of_uri uri)))
)
| (C.Sort C.Set, C.Sort C.Prop) when need_dummy -> true
+ | (C.Sort C.CProp, C.Sort C.Prop) when need_dummy -> true
| (C.Sort C.Set, C.Sort C.Set) when need_dummy -> true
- | (C.Sort C.Set, C.Sort C.Type) when need_dummy ->
+ | (C.Sort C.Set, C.Sort C.CProp) when need_dummy -> true
+ | (C.Sort C.CProp, C.Sort C.Set) when need_dummy -> true
+ | (C.Sort C.CProp, C.Sort C.CProp) when need_dummy -> true
+ | ((C.Sort C.Set, C.Sort C.Type) | (C.Sort C.CProp, C.Sort C.Type))
+ when need_dummy ->
(match CicEnvironment.get_obj uri with
C.InductiveDefinition (itl,_,paramsno) ->
let tys =
res &&
(match CicReduction.whd ((Some (name,(C.Decl so)))::context) ta with
C.Sort C.Prop -> true
- | C.Sort C.Set ->
+ | (C.Sort C.Set | C.Sort C.CProp) ->
(match CicEnvironment.get_obj uri with
C.InductiveDefinition (itl,_,_) ->
let (_,_,_,cl) = List.nth itl i in
)
| _ -> false
)
- | (C.Sort C.Set, C.Prod (name,so,ta)) when not need_dummy ->
+ | ((C.Sort C.Set, C.Prod (name,so,ta)) | (C.Sort C.CProp, C.Prod (name,so,ta)))
+ when not need_dummy ->
let res = CicReduction.are_convertible context so ind
in
res &&
(match CicReduction.whd ((Some (name,(C.Decl so)))::context) ta with
C.Sort C.Prop
| C.Sort C.Set -> true
+ | C.Sort C.CProp -> true
| C.Sort C.Type ->
(match CicEnvironment.get_obj uri with
C.InductiveDefinition (itl,_,paramsno) ->
let t2' = CicReduction.whd ((Some (name,C.Decl s))::context) t2 in
match (t1', t2') with
(C.Sort s1, C.Sort s2)
- when (s2 = C.Prop or s2 = C.Set) -> (* different from Coq manual!!! *)
+ when (s2 = C.Prop or s2 = C.Set or s2 = C.CProp) -> (* different from Coq manual!!! *)
C.Sort s2
| (C.Sort s1, C.Sort s2) -> C.Sort C.Type (*CSC manca la gestione degli universi!!! *)
| (_,_) ->
C.Prod (n,so,de) ->
(*CSC: [] is an empty metasenv. Is it correct? *)
let s = type_of_aux' [] context so in
- (s = C.Sort C.Prop || s = C.Sort C.Set) &&
+ (s = C.Sort C.Prop || s = C.Sort C.Set || s = C.Sort C.CProp) &&
is_small_aux ((Some (n,(C.Decl so)))::context) de
| _ -> true (*CSC: we trust the type-checker *)
in
| "Set" { SET }
| "Prop" { PROP }
| "Type" { TYPE }
+ | "CProp" { CPROP }
| ident { ID (L.lexeme lexbuf) }
| conuri { CONURI (U.uri_of_string ("cic:" ^ L.lexeme lexbuf)) }
| varuri { VARURI (U.uri_of_string ("cic:" ^ L.lexeme lexbuf)) }
%token <UriManager.uri> VARURI
%token <UriManager.uri * int> INDTYURI
%token <UriManager.uri * int * int> INDCONURI
-%token LPAREN RPAREN PROD LAMBDA COLON DOT SET PROP TYPE CAST IMPLICIT NONE
+%token LPAREN RPAREN PROD LAMBDA COLON DOT SET PROP TYPE CPROP CAST IMPLICIT NONE
%token LETIN FIX COFIX SEMICOLON LCURLY RCURLY CASE ARROW LBRACKET RBRACKET EOF
%right ARROW
%start main
}
| IMPLICIT
{ mk_implicit () }
- | SET { [], function _ -> Sort Set }
- | PROP { [], function _ -> Sort Prop }
- | TYPE { [], function _ -> Sort Type }
+ | SET { [], function _ -> Sort Set }
+ | PROP { [], function _ -> Sort Prop }
+ | TYPE { [], function _ -> Sort Type }
+ | CPROP { [], function _ -> Sort CProp }
| LPAREN expr CAST expr RPAREN
{ let dom1,mk_expr1 = $2 in
let dom2,mk_expr2 = $4 in
| C.ASort (id,s) ->
let string_of_sort =
function
- C.Prop -> "Prop"
- | C.Set -> "Set"
- | C.Type -> "Type"
+ C.Prop -> "Prop"
+ | C.Set -> "Set"
+ | C.Type -> "Type"
+ | C.CProp -> "CProp"
in
X.xml_empty "SORT" [None,"value",(string_of_sort s) ; None,"id",id]
| C.AImplicit _ -> raise NotImplemented
let string_of_sort =
function
- Cic.Prop -> "Prop"
- | Cic.Set -> "Set"
- | Cic.Type -> "Type"
+ Cic.Prop -> "Prop"
+ | Cic.Set -> "Set"
+ | Cic.Type -> "Type"
+ | Cic.CProp -> "Type"
;;
let get_constructors uri i =
let t2'' = CicReduction.whd ((Some (name,C.Decl s))::context) t2' in
match (t1'', t2'') with
(C.Sort s1, C.Sort s2)
- when (s2 = C.Prop or s2 = C.Set) -> (* different from Coq manual!!! *)
+ when (s2 = C.Prop or s2 = C.Set or s2 = C.CProp) -> (* different from Coq manual!!! *)
C.Sort s2,subst',metasenv'
| (C.Sort s1, C.Sort s2) ->
(*CSC manca la gestione degli universi!!! *)
Cic.Prop -> T.Prop
| Cic.Set -> T.Set
| Cic.Type -> T.Type
+ | Cic.CProp -> T.CProp
in
[],[],[!!kind,s']
| _ -> [],[],[])
type sort = Set
| Prop
| Type
+ | CProp
type spec = MustObj of uri list * position list * depth list
| MustSort of sort list * position list * depth list
| T.InBody -> ns ^ "InBody"
let string_of_sort = function
- | T.Set -> "Set"
- | T.Prop -> "Prop"
- | T.Type -> "Type"
+ | T.Set -> "Set"
+ | T.Prop -> "Prop"
+ | T.Type -> "Type"
+ | T.CProp -> "CProp"
let string_of_depth = string_of_int
| T.InBody -> "$IB"
let mathql_of_sort = function
- | T.Set -> "$SET"
- | T.Prop -> "$PROP"
- | T.Type -> "$TYPE"
+ | T.Set -> "$SET"
+ | T.Prop -> "$PROP"
+ | T.Type -> "$TYPE"
+ | T.CProp -> "$CPROP"
let mathql_of_depth = string_of_int
| _ -> raise Parsing.Parse_error
let sort_of_mathql = function
- | "$SET" -> T.Set
- | "$PROP" -> T.Prop
- | "$TYPE" -> T.Type
+ | "$SET" -> T.Set
+ | "$PROP" -> T.Prop
+ | "$TYPE" -> T.Type
+ | "$CPROP" -> T.CProp
| _ -> raise Parsing.Parse_error
let depth_of_mathql s =
| _ -> no_depth_text
let text_of_sort = function
- | T.Set -> "Set"
- | T.Prop -> "Prop"
- | T.Type -> "Type"
+ | T.Set -> "Set"
+ | T.Prop -> "Prop"
+ | T.Type -> "Type"
+ | T.CProp -> "CProp"
let is_main_position = function
| `MainHypothesis _
| SPC { result_token lexbuf }
| "(*" { comm_token lexbuf; result_token lexbuf }
| '"' { STR (qstr string_token lexbuf) }
+ | '/' { out "SL"; SL }
| '{' { LC }
| '}' { RC }
| ',' { CM }
match CicTypeChecker.type_of_aux' metasenv context wty with
C.Sort C.Set -> "cic:/Coq/Init/Logic/eq.ind"
| C.Sort C.Type
+ | C.Sort C.CProp
| C.Sort C.Prop -> "cic:/Coq/Init/Logic_Type/eqT.ind"
| _ -> assert false
in
match T.type_of_aux' metasenv context ty with
C.Sort C.Prop -> "_ind"
| C.Sort C.Set -> "_rec"
+ | C.Sort C.CProp -> "_rec"
| C.Sort C.Type -> "_rect"
| _ -> assert false
in
(try
(match CicTypeChecker.type_of_aux' [] context typ with
C.Sort C.Prop -> "H"
+ | C.Sort C.CProp -> "H"
| C.Sort C.Set -> "x"
| _ -> "H"
)
| "\\Set" { SET }
| "\\Prop" { PROP }
| "\\Type" { TYPE }
+ | "\\CProp" { CPROP }
| ident { ID (unquote (L.lexeme lexbuf)) }
| conuri { CONURI
(U.uri_of_string ("cic:" ^ (unquote (L.lexeme lexbuf)))) }
%token <UriManager.uri> VARURI
%token <UriManager.uri * int> INDTYURI
%token <UriManager.uri * int * int> INDCONURI
-%token LPAREN RPAREN PROD LAMBDA COLON DOT SET PROP TYPE CAST IMPLICIT NONE
+%token LPAREN RPAREN PROD LAMBDA COLON DOT SET PROP TYPE CPROP CAST IMPLICIT NONE
%token LETIN FIX COFIX SEMICOLON LCURLY RCURLY CASE ARROW LBRACKET RBRACKET EOF
%token DOLLAR
%token RPLUS RMINUS RTIMES RDIV
}
| IMPLICIT
{ mk_implicit () }
- | SET { [], function _ -> Sort Set }
- | PROP { [], function _ -> Sort Prop }
- | TYPE { [], function _ -> Sort Type }
+ | SET { [], function _ -> Sort Set }
+ | PROP { [], function _ -> Sort Prop }
+ | TYPE { [], function _ -> Sort Type }
+ | CPROP { [], function _ -> Sort CProp }
| LPAREN expr CAST expr RPAREN
{ let dom1,mk_expr1 = $2 in
let dom2,mk_expr2 = $4 in