Source file `language_extension_kernel.ml`

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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
(*_ This file is manually imported from the Jane Street version of the
   OCaml compiler. Don't make changes directly to this file. *)
[@@@ocaml.warning "-missing-record-field-pattern"]

open! Shadow_compiler_distribution

type maturity =
  | Stable
  | Beta
  | Alpha

(* Remember to update [all] when changing this type. *)
type _ t =
  | Comprehensions : unit t
  | Mode : unit t
  | Unique : unit t
  | Include_functor : unit t
  | Polymorphic_parameters : unit t
  | Immutable_arrays : unit t
  | Module_strengthening : unit t
  | Layouts : maturity t
  | SIMD : unit t
  | Labeled_tuples : unit t
  | Small_numbers : unit t

type 'a language_extension_kernel = 'a t

module Exist = struct
  type t = Pack : _ language_extension_kernel -> t

  let all =
    [ Pack Comprehensions
    ; Pack Mode
    ; Pack Unique
    ; Pack Include_functor
    ; Pack Polymorphic_parameters
    ; Pack Immutable_arrays
    ; Pack Module_strengthening
    ; Pack Layouts
    ; Pack SIMD
    ; Pack Labeled_tuples
    ; Pack Small_numbers
    ]
  ;;
end

module Exist_pair = struct
  type t = Pair : 'a language_extension_kernel * 'a -> t
end

(* When you update this, update [pair_of_string] below too. *)
let to_string : type a. a t -> string = function
  | Comprehensions -> "comprehensions"
  | Mode -> "mode"
  | Unique -> "unique"
  | Include_functor -> "include_functor"
  | Polymorphic_parameters -> "polymorphic_parameters"
  | Immutable_arrays -> "immutable_arrays"
  | Module_strengthening -> "module_strengthening"
  | Layouts -> "layouts"
  | SIMD -> "simd"
  | Labeled_tuples -> "labeled_tuples"
  | Small_numbers -> "small_numbers"
;;

(* converts full extension names, like "layouts_alpha" to a pair of
   an extension and its maturity. For extensions that don't take an
   argument, the conversion is just [Language_extension_kernel.of_string].
*)
let pair_of_string extn_name : Exist_pair.t option =
  match String.lowercase_ascii extn_name with
  | "comprehensions" -> Some (Pair (Comprehensions, ()))
  | "mode" -> Some (Pair (Mode, ()))
  | "unique" -> Some (Pair (Unique, ()))
  | "include_functor" -> Some (Pair (Include_functor, ()))
  | "polymorphic_parameters" -> Some (Pair (Polymorphic_parameters, ()))
  | "immutable_arrays" -> Some (Pair (Immutable_arrays, ()))
  | "module_strengthening" -> Some (Pair (Module_strengthening, ()))
  | "layouts" -> Some (Pair (Layouts, Stable))
  | "layouts_alpha" -> Some (Pair (Layouts, Alpha))
  | "layouts_beta" -> Some (Pair (Layouts, Beta))
  | "simd" -> Some (Pair (SIMD, ()))
  | "labeled_tuples" -> Some (Pair (Labeled_tuples, ()))
  | "small_numbers" -> Some (Pair (Small_numbers, ()))
  | _ -> None
;;

let maturity_to_string = function
  | Alpha -> "alpha"
  | Beta -> "beta"
  | Stable -> "stable"
;;

let of_string extn_name : Exist.t option =
  match pair_of_string extn_name with
  | Some (Pair (ext, _)) -> Some (Pack ext)
  | None -> None
;;

(* We'll do this in a more principled way later. *)
let is_erasable : type a. a t -> bool = function
  | Mode | Unique | Layouts -> true
  | Comprehensions
  | Include_functor
  | Polymorphic_parameters
  | Immutable_arrays
  | Module_strengthening
  | SIMD
  | Labeled_tuples
  | Small_numbers -> false
;;

(* See the mli. *)
module type Language_extension_for_jane_syntax = sig
  type nonrec 'a t = 'a t

  val is_enabled : _ t -> bool
  val is_at_least : 'a t -> 'a -> bool
end