Toyish gadtization to remove a few assert falses
Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
parent
6159a2909c
commit
2a71439c3e
|
@ -34,11 +34,29 @@ module Env_node = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
module Var = struct
|
module Var = struct
|
||||||
|
module Opt = struct
|
||||||
|
type with_value
|
||||||
|
type no_value
|
||||||
|
|
||||||
|
type (_, _) t =
|
||||||
|
| None0 : (no_value , _) t
|
||||||
|
| Some0 : 'a -> (with_value, 'a) t
|
||||||
|
|
||||||
|
let some
|
||||||
|
: 'a. (with_value, 'a) t -> 'a option
|
||||||
|
= fun (Some0 x) -> Some x
|
||||||
|
|
||||||
|
let discard
|
||||||
|
: (no_value, _) t -> unit
|
||||||
|
= fun None0 -> ()
|
||||||
|
end
|
||||||
|
|
||||||
module Info = struct
|
module Info = struct
|
||||||
type t =
|
type _ t =
|
||||||
| Since of Syntax.Version.t
|
| Nothing : Opt.with_value t
|
||||||
| Renamed_in of Syntax.Version.t * string
|
| Since : Syntax.Version.t -> Opt.with_value t
|
||||||
| Deleted_in of Syntax.Version.t
|
| Deleted_in : Syntax.Version.t -> Opt.with_value t
|
||||||
|
| Renamed_in : Syntax.Version.t * string -> Opt.no_value t
|
||||||
end
|
end
|
||||||
|
|
||||||
module Kind = struct
|
module Kind = struct
|
||||||
|
@ -72,32 +90,34 @@ module Var = struct
|
||||||
| Path_no_dep
|
| Path_no_dep
|
||||||
end
|
end
|
||||||
|
|
||||||
type 'a t =
|
type ('a, 'b) t' =
|
||||||
{ kind: 'a option
|
{ kind: ('a, 'b) Opt.t
|
||||||
; info: Info.t option
|
; info: 'a Info.t
|
||||||
}
|
}
|
||||||
|
|
||||||
|
type _ t = V : ('a, 'b) t' -> 'b t
|
||||||
|
|
||||||
module Map = struct
|
module Map = struct
|
||||||
type nonrec 'a t = 'a t String.Map.t
|
type nonrec 'a t = 'a t String.Map.t
|
||||||
|
|
||||||
let values v =
|
let values v =
|
||||||
{ kind = Some (Kind.Values v)
|
V { kind = Some0 (Kind.Values v)
|
||||||
; info = None
|
; info = Info.Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
let renamed_in ~new_name ~version =
|
let renamed_in ~new_name ~version =
|
||||||
{ kind = None
|
V { kind = None0
|
||||||
; info = Some (Info.Renamed_in (version, new_name))
|
; info = Info.Renamed_in (version, new_name)
|
||||||
}
|
}
|
||||||
|
|
||||||
let deleted_in ~version kind =
|
let deleted_in ~version kind =
|
||||||
{ kind = Some kind
|
V { kind = Some0 kind
|
||||||
; info = Some (Info.Deleted_in version)
|
; info = Info.Deleted_in version
|
||||||
}
|
}
|
||||||
|
|
||||||
let since ~version v =
|
let since ~version v =
|
||||||
{ kind = Some v
|
V { kind = Some0 v
|
||||||
; info = Some (Info.Since version)
|
; info = Info.Since version
|
||||||
}
|
}
|
||||||
|
|
||||||
let static_vars =
|
let static_vars =
|
||||||
|
@ -114,8 +134,8 @@ module Var = struct
|
||||||
|
|
||||||
let forms =
|
let forms =
|
||||||
let form kind =
|
let form kind =
|
||||||
{ info = None
|
V { info = Info.Nothing
|
||||||
; kind = Some kind
|
; kind = Some0 kind
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
let open Form in
|
let open Form in
|
||||||
|
@ -211,12 +231,12 @@ module Var = struct
|
||||||
| Single v -> v
|
| Single v -> v
|
||||||
| Pair (v, _) -> v
|
| Pair (v, _) -> v
|
||||||
in
|
in
|
||||||
Option.bind (String.Map.find t name) ~f:(fun {kind; info} ->
|
let f (V { kind; info}) =
|
||||||
match info, kind with
|
match info with
|
||||||
| None, Some v -> Some v
|
| Info.Nothing -> Opt.some kind
|
||||||
| Some (Since min_version), Some v ->
|
| Info.Since min_version ->
|
||||||
if syntax_version >= min_version then
|
if syntax_version >= min_version then
|
||||||
Some v
|
Opt.some kind
|
||||||
else
|
else
|
||||||
String_with_vars.Var.fail var ~f:(fun var ->
|
String_with_vars.Var.fail var ~f:(fun var ->
|
||||||
sprintf "Variable %s is available in since version %s. \
|
sprintf "Variable %s is available in since version %s. \
|
||||||
|
@ -224,7 +244,8 @@ module Var = struct
|
||||||
var
|
var
|
||||||
(Syntax.Version.to_string min_version)
|
(Syntax.Version.to_string min_version)
|
||||||
(Syntax.Version.to_string syntax_version))
|
(Syntax.Version.to_string syntax_version))
|
||||||
| Some (Renamed_in (in_version, new_name)), None ->
|
| Info.Renamed_in (in_version, new_name) -> begin
|
||||||
|
Opt.discard kind;
|
||||||
if syntax_version >= in_version then
|
if syntax_version >= in_version then
|
||||||
String_with_vars.Var.fail var ~f:(fun old_name ->
|
String_with_vars.Var.fail var ~f:(fun old_name ->
|
||||||
sprintf "Variable %s has been renamed to %s since %s"
|
sprintf "Variable %s has been renamed to %s since %s"
|
||||||
|
@ -234,22 +255,19 @@ module Var = struct
|
||||||
else
|
else
|
||||||
expand t ~syntax_version:in_version
|
expand t ~syntax_version:in_version
|
||||||
~var:(String_with_vars.Var.rename var ~new_name)
|
~var:(String_with_vars.Var.rename var ~new_name)
|
||||||
| Some (Deleted_in in_version), Some v ->
|
end
|
||||||
|
| Info.Deleted_in in_version ->
|
||||||
if syntax_version < in_version then
|
if syntax_version < in_version then
|
||||||
Some v
|
Opt.some kind
|
||||||
else
|
else
|
||||||
String_with_vars.Var.fail var ~f:(fun var ->
|
String_with_vars.Var.fail var ~f:(fun var ->
|
||||||
sprintf "Variable %s has been deleted in version %s. \
|
sprintf "Variable %s has been deleted in version %s. \
|
||||||
Current version is: %s"
|
Current version is: %s"
|
||||||
var
|
var
|
||||||
(Syntax.Version.to_string in_version)
|
(Syntax.Version.to_string in_version)
|
||||||
(Syntax.Version.to_string syntax_version)
|
(Syntax.Version.to_string syntax_version))
|
||||||
)
|
in
|
||||||
| Some (Renamed_in _), Some _
|
Option.bind (String.Map.find t name) ~f
|
||||||
| Some (Since _), None
|
|
||||||
| Some (Deleted_in _), None
|
|
||||||
| None, None -> assert false
|
|
||||||
)
|
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue