Commit 57fd4fa5 authored by Loïc Correnson's avatar Loïc Correnson
Browse files

Merge branch 'fix/server/index' into 'master'

[server] Data: fixes the signature of functors for indexed values.

See merge request frama-c/frama-c!2745
parents a75b4445 22be3079
......@@ -565,6 +565,11 @@ end
(* --- Index --- *)
(* -------------------------------------------------------------------------- *)
module type Info =
sig
val name: string
end
(** Simplified [Map.S] *)
module type Map =
sig
......@@ -578,13 +583,12 @@ end
module type Index =
sig
include S
val kind : string
val get : t -> int
val find : int -> t
val clear : unit -> unit
end
module INDEXER(M : Map)(D : S)(I : Index with type t = D.t) :
module INDEXER(M : Map)(I : Info) :
sig
type index
val create : unit -> index
......@@ -630,15 +634,14 @@ struct
let id = Ju.to_int js in
try find m id
with Not_found ->
failure "[%s] No registered id #%d" I.kind id
failure "[%s] No registered id #%d" I.name id
end
module Static(M : Map)(S : S)(I : Index with type t = S.t)
module Static(M : Map)(I : Info)
: Index with type t = M.key =
struct
module INDEX = INDEXER(M)(S)(I)
let kind = I.kind
module INDEX = INDEXER(M)(I)
let index = INDEX.create ()
let clear () = INDEX.clear index
let get = INDEX.get index
......@@ -646,33 +649,32 @@ struct
include
(struct
type t = M.key
let jtype = Jindex I.kind
let jtype = Jindex I.name
let of_json = INDEX.of_json index
let to_json = INDEX.to_json index
end)
end
module Index(M : Map)(S : S)(I : Index with type t = S.t)
module Index(M : Map)(I : Info)
: Index with type t = M.key =
struct
module INDEX = INDEXER(M)(S)(I)
module INDEX = INDEXER(M)(I)
module TYPE : Datatype.S with type t = INDEX.index =
Datatype.Make
(struct
type t = INDEX.index
include Datatype.Undefined
let reprs = [INDEX.create()]
let name = "Server.Data.Index.Type." ^ I.kind
let name = "Server.Data.Index.Type." ^ I.name
let mem_project = Datatype.never_any_project
end)
module STATE = State_builder.Ref(TYPE)
(struct
let name = "Server.Data.Index.State." ^ I.kind
let name = "Server.Data.Index.State." ^ I.name
let dependencies = []
let default = INDEX.create
end)
let kind = I.kind
let index () = STATE.get ()
let clear () = INDEX.clear (index())
......@@ -682,7 +684,7 @@ struct
include
(struct
type t = M.key
let jtype = Jindex I.kind
let jtype = Jindex I.name
let of_json js = INDEX.of_json (index()) js
let to_json v = INDEX.to_json (index()) v
end)
......@@ -695,27 +697,24 @@ sig
val id : t -> int
end
module Identified(A : IdentifiedType)(S : S)
(I : Index with type t = S.t) : Index with type t = A.t =
module Identified(A : IdentifiedType)(I : Info) : Index with type t = A.t =
struct
type index = (int,A.t) Hashtbl.t
let kind = I.kind
module TYPE : Datatype.S with type t = index =
Datatype.Make
(struct
type t = index
include Datatype.Undefined
let reprs = [Hashtbl.create 0]
let name = "Server.Data.Identified.Type." ^ I.kind
let name = "Server.Data.Identified.Type." ^ I.name
let mem_project = Datatype.never_any_project
end)
module STATE = State_builder.Ref(TYPE)
(struct
let name = "Server.Data.Identified.State." ^ I.kind
let name = "Server.Data.Identified.State." ^ I.name
let dependencies = []
let default () = Hashtbl.create 0
end)
......@@ -729,12 +728,12 @@ struct
include
(struct
type t = A.t
let jtype = Jindex kind
let jtype = Jindex I.name
let to_json a = `Int (get a)
let of_json js =
let k = Ju.to_int js in
try find k
with Not_found -> failure "[%s] No registered id #%d" I.kind k
with Not_found -> failure "[%s] No registered id #%d" I.name k
end)
end
......
......@@ -323,6 +323,12 @@ end
*)
(* -------------------------------------------------------------------------- *)
(** Datatype information. *)
module type Info =
sig
val name: string
end
(** Simplified [Map.S]. *)
module type Map =
sig
......@@ -337,7 +343,6 @@ end
module type Index =
sig
include S
val kind : string
val get : t -> int
val find : int -> t (** @raise Not_found if not registered. *)
val clear : unit -> unit
......@@ -345,12 +350,10 @@ sig
end
(** Builds an indexer that {i does not} depend on current project. *)
module Static(M : Map)(S : S)
(I : Index with type t = S.t) : Index with type t = M.key
module Static(M : Map)(I : Info) : Index with type t = M.key
(** Builds a {i projectified} index. *)
module Index(M : Map)(S : S)
(I : Index with type t = S.t) : Index with type t = M.key
module Index(M : Map)(I : Info) : Index with type t = M.key
(** Datatype already identified by unique integers. *)
module type IdentifiedType =
......@@ -360,8 +363,7 @@ sig
end
(** Builds a {i projectified} index on types with {i unique} identifiers. *)
module Identified(A : IdentifiedType)(S : S)
(I : Index with type t = S.t) : Index with type t = A.t
module Identified(A : IdentifiedType)(I : Info) : Index with type t = A.t
(* -------------------------------------------------------------------------- *)
(** {2 Error handling}
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment