/usr/lib/ocaml/deriving/bounded_class.ml is in libderiving-ocsigen-ocaml-dev 0.7.1-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 | (* Copyright Jeremy Yallop 2007.
This file is free software, distributed under the MIT license.
See the file COPYING for details.
*)
open Pa_deriving_common
open Utils
module Description : Defs.ClassDescription = struct
let classname = "Bounded"
let runtimename = "Deriving_Bounded"
let default_module = None
let alpha = None
let allow_private = false
let predefs = [
["unit"], ["Deriving_Bounded";"unit"];
["bool"], ["Deriving_Bounded";"bool"];
["char"], ["Deriving_Bounded";"char"];
["int"], ["Deriving_Bounded";"int"];
["int32"], ["Deriving_Bounded";"int32"];
["Int32";"t"], ["Deriving_Bounded";"int32"];
["int64"], ["Deriving_Bounded";"int64"];
["Int64";"t"], ["Deriving_Bounded";"int64"];
["nativeint"], ["Deriving_Bounded";"nativeint"];
["open_flag"], ["Deriving_Bounded";"open_flag"];
["fpclass"], ["Deriving_Bounded";"fpclass"];
]
let depends = []
end
module Builder(Generator : Defs.Generator) = struct
open Generator.Loc
open Camlp4.PreCast
open Description
module Helpers = Generator.AstHelpers
let wrap min max =
[ <:str_item< let min_bound = $min$ >>; <:str_item< let max_bound = $max$ >> ]
let generator = (object (self)
inherit Generator.generator
method proxy () =
None, [ <:ident< min_bound >>;
<:ident< max_bound >>; ]
method tuple ctxt ts =
let expr t =
let e = self#expr ctxt t in
<:expr< let module M = $e$ in M.min_bound >>,
<:expr< let module M = $e$ in M.max_bound >> in
let minBounds, maxBounds = List.split (List.map expr ts) in
wrap (Helpers.tuple_expr minBounds) (Helpers.tuple_expr maxBounds)
method sum ?eq ctxt tname params constraints summands =
let extract_name = function
| (name,[]) -> name
| (name,_) ->
raise (Base.Underivable
(classname ^" cannot be derived for the type "
^ tname ^ " because the constructor "
^ name ^ " is not nullary")) in
let names = List.map extract_name summands in
wrap <:expr< $uid:List.hd names$ >> <:expr< $uid:List.last names$ >>
method variant ctxt tname params constraints (_, tags) =
let extract_name = function
| Type.Tag (name, []) -> name
| Type.Tag (name, _) ->
raise (Base.Underivable
(classname^" cannot be derived because "
^ "the tag " ^ name^" is not nullary"))
| _ ->
raise (Base.Underivable
(classname^" cannot be derived for this "
^ "polymorphic variant type")) in
let names = List.map extract_name tags in
wrap <:expr< `$List.hd names$ >> <:expr< `$List.last names$ >>
(* should perhaps implement this one *)
method record ?eq _ tname params constraints =
raise (Base.Underivable
(classname^" cannot be derived for record types (i.e. "
^ tname ^ ")"))
end :> Generator.generator)
let generate = Generator.generate generator
let generate_sigs = Generator.generate_sigs generator
end
include Base.RegisterClass(Description)(Builder)
|