(* $Id: nCic.ml 9058 2008-10-13 17:42:30Z tassi $ *)
-class type ctstatus =
- object ('self)
- inherit LexiconEngine.status
- inherit NRstatus.dumpable_status
- method set_estatus: ctstatus -> 'self
- end
-
-class status : ctstatus =
+class status =
object (self)
inherit LexiconEngine.status
inherit NRstatus.dumpable_status
- method set_estatus o =
- (self#set_lexicon_engine_status (o :> LexiconEngine.status))
- #set_dumpable_status (o :> NRstatus.dumpable_status)
+ method set_estatus
+ : 'status.
+ < coerc_db : NCicCoercion.db;
+ uhint_db : NCicUnifHint.db;
+ timestamp: NCicLibrary.timestamp;
+ dump: NRstatus.Serializer.obj list;
+ lstatus: LexiconEngine.lexicon_status; .. > as 'status -> 'self
+ = fun o -> (self#set_lexicon_engine_status o)#set_dumpable_status o
end
object ('self)
inherit LexiconEngine.status
inherit NRstatus.dumpable_status
- method set_estatus: status -> 'self
+ method set_estatus:
+ < coerc_db : NCicCoercion.db;
+ uhint_db : NCicUnifHint.db;
+ timestamp: NCicLibrary.timestamp;
+ dump: NRstatus.Serializer.obj list;
+ lstatus: LexiconEngine.lexicon_status; .. > -> 'self
end
val lstatus = initial_status
method lstatus = lstatus
method set_lstatus v = {< lstatus = v >}
- method set_lexicon_engine_status (o : status) = {< lstatus = o#lstatus >}
+ method set_lexicon_engine_status
+ : 'status. < lstatus: lexicon_status; .. > as 'status -> 'self
+ = fun o -> {< lstatus = o#lstatus >}
end
let dump_aliases out msg status =
object ('self)
method lstatus: lexicon_status
method set_lstatus: lexicon_status -> 'self
- method set_lexicon_engine_status: status -> 'self
+ method set_lexicon_engine_status: < lstatus: lexicon_status ; .. > -> 'self
end
val eval_command : #status as 'status -> LexiconAst.command -> 'status
val timestamp = (time0 : timestamp)
method timestamp = timestamp
method set_timestamp v = {< timestamp = v >}
- method set_library_status (o : status) = {< timestamp = o#timestamp >}
+ method set_library_status
+ : 'status. < timestamp : timestamp; .. > as 'status -> 'self
+ = fun o -> {< timestamp = o#timestamp >}
end
let time_travel status =
object ('self)
method timestamp: timestamp
method set_timestamp: timestamp -> 'self
- method set_library_status: status -> 'self
+ method set_library_status: <timestamp: timestamp; ..> -> 'self
end
val add_obj: #status as 'status -> NUri.uri -> NCic.obj -> 'status
val db = empty_db
method coerc_db = db
method set_coerc_db v = {< db = v >}
- method set_coercion_status (o : status) = {< db = o#coerc_db >}
+ method set_coercion_status
+ : 'status. < coerc_db : db; .. > as 'status -> 'self
+ = fun o -> {< db = o#coerc_db >}
end
let index_coercion status c src tgt arity arg =
object ('self)
method coerc_db: db
method set_coerc_db: db -> 'self
- method set_coercion_status: status -> 'self
+ method set_coercion_status: <coerc_db: db; ..> -> 'self
end
val empty_db: db
val db = DB.empty
method uhint_db = db
method set_uhint_db v = {< db = v >}
- method set_unifhint_status (o : status) = {< db = o#uhint_db >}
+ method set_unifhint_status
+ : 'status. < uhint_db : db; .. > as 'status -> 'self
+ = fun o -> {< db = o#uhint_db >}
end
let dummy = NCic.Const (NReference.reference_of_string "cic:/dummy_conv.dec");;
object ('self)
method uhint_db: db
method set_uhint_db: db -> 'self
- method set_unifhint_status: status -> 'self
+ method set_unifhint_status: < uhint_db : db; .. > -> 'self
end
val index_hint:
(* $Id: nCicRefiner.ml 9802 2009-05-25 15:39:26Z tassi $ *)
-class type ctstatus =
- object ('self)
- inherit NCicUnifHint.status
- inherit NCicCoercion.status
- inherit NCicLibrary.status
- method set_rstatus : ctstatus -> 'self
- end
-
-class status : ctstatus =
+class status =
object (self)
inherit NCicUnifHint.status
inherit NCicCoercion.status
inherit NCicLibrary.status
- method set_rstatus o =
- ((self#set_unifhint_status (o :> NCicUnifHint.status))
- #set_coercion_status (o :> NCicCoercion.status))
- #set_library_status (o :> NCicLibrary.status)
+ method set_rstatus
+ : 'status.
+ < coerc_db : NCicCoercion.db;
+ uhint_db : NCicUnifHint.db;
+ timestamp: NCicLibrary.timestamp; .. > as 'status -> 'self
+ = fun o ->
+ ((self#set_unifhint_status o)#set_coercion_status o)#set_library_status o
end
type sstatus = status
status
end
-class type ctdumpable_status =
- object ('self)
- inherit status
- method dump: Serializer.obj list
- method set_dump: Serializer.obj list -> 'self
- method set_dumpable_status: ctdumpable_status -> 'self
- end
-
-class dumpable_status : ctdumpable_status =
+class dumpable_status =
object
inherit status
val dump = ([] : Serializer.obj list)
method dump = dump
method set_dump v = {< dump = v >}
- method set_dumpable_status o =
- {< dump = o#dump >}#set_rstatus (o :> status)
+ method set_dumpable_status
+ : 'status.
+ < coerc_db : NCicCoercion.db;
+ uhint_db : NCicUnifHint.db;
+ timestamp: NCicLibrary.timestamp;
+ dump: Serializer.obj list; .. > as 'status -> 'self
+ = fun o -> {< dump = o#dump >}#set_rstatus o
end
inherit NCicUnifHint.status
inherit NCicCoercion.status
inherit NCicLibrary.status
- method set_rstatus: status -> 'self
+ method set_rstatus:
+ < coerc_db : NCicCoercion.db;
+ uhint_db : NCicUnifHint.db;
+ timestamp: NCicLibrary.timestamp; .. > -> 'self
end
module Serializer:
inherit status
method dump: Serializer.obj list
method set_dump: Serializer.obj list -> 'self
- method set_dumpable_status: dumpable_status -> 'self
+ method set_dumpable_status:
+ < coerc_db : NCicCoercion.db;
+ uhint_db : NCicUnifHint.db;
+ timestamp: NCicLibrary.timestamp;
+ dump: Serializer.obj list; .. > -> 'self
end
(e.g. the tactic could perform a global analysis of the set of goals)
*)
-let exec tac low_status g =
+let exec tac (low_status : #lowtac_status) g =
let stack = [ [0,Open g], [], [], `NoTag ] in
let status =
- (new NTacStatus.status low_status#obj stack)#set_estatus
- (low_status :> NEstatus.status)
+ (new NTacStatus.status low_status#obj stack)#set_estatus low_status
in
let status = tac status in
- (low_status#set_estatus (status :> NEstatus.status))#set_obj status#obj
+ (low_status#set_estatus status)#set_obj status#obj
;;
-let distribute_tac tac status =
+let distribute_tac tac (status : #tac_status) =
match status#stack with
| [] -> assert false
| (g, t, k, tag) :: s ->
let stack =
(zero_pos gon, t @~- gcn, k @~- gcn, tag) :: deep_close gcn s
in
- ((status#set_stack stack)#set_obj (sn :> lowtac_status)#obj)#set_estatus (sn :> NEstatus.status)
+ ((status#set_stack stack)#set_obj(sn:>lowtac_status)#obj)#set_estatus sn
;;
let atomic_tac htac = distribute_tac (exec htac) ;;
| Some x -> x
;;
-let exact_tac t = distribute_tac (fun status goal ->
+let exact_tac t : 's tactic = distribute_tac (fun status goal ->
let goalty = get_goalty status goal in
let status, t = disambiguate status t (Some goalty) (ctx_of goalty) in
instantiate status goal t)
projects / helm.git / commitdiff