/usr/lib/ocaml/deriving/enum_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 97 98 99 | (* 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 = "Enum"
let runtimename = "Deriving_Enum"
let default_module = Some "Defaults"
let alpha = None
let allow_private = false
let predefs = [
["int"], ["Deriving_Enum";"int"];
["bool"], ["Deriving_Enum";"bool"];
["unit"], ["Deriving_Enum";"unit"];
["char"], ["Deriving_Enum";"char"];
]
let depends = []
end
module Builder(Generator : Defs.Generator) = struct
open Generator.Loc
open Camlp4.PreCast
open Description
module Helpers = Generator.AstHelpers
let wrap numbering = [ <:str_item< let numbering = $numbering$ >> ]
let generator = (object(self)
inherit Generator.generator
method proxy () =
None, [ <:ident< succ >>;
<:ident< pred >>;
<:ident< to_enum >>;
<:ident< from_enum >>;
<:ident< enum_from >>;
<:ident< enum_from_then >>;
<:ident< enum_from_to >>;
<:ident< enum_from_then_to >>; ]
method sum ?eq ctxt tname params constraints summands =
let numbering =
List.fold_right2
(fun n ctor rest ->
match ctor with
| (name, []) -> <:expr< ($uid:name$, $`int:n$) :: $rest$ >>
| (name,_) ->
raise (Base.Underivable
(classname ^ " cannot be derived for the type "
^ tname ^" because the constructor "
^ name^" is not nullary")))
(List.range 0 (List.length summands))
summands
<:expr< [] >> in
wrap numbering
method variant ctxt tname params constraints (_, tags) =
let numbering =
List.fold_right2
(fun n tagspec rest ->
match tagspec with
| Type.Tag (name, []) -> <:expr< (`$name$, $`int:n$) :: $rest$ >>
| 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")))
(List.range 0 (List.length tags))
tags
<:expr< [] >> in
wrap numbering
method tuple ctxt tys =
match tys with
| [ty] -> wrap <:expr< $self#call_expr ctxt ty "numbering"$ >>
| _ ->
raise (Base.Underivable (classname ^" cannot be derived for tuple types"))
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)
|