Source file core_primitive_clause.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
open! Base
open! Import

let known_zero_arity_core_primitives =
  Set.of_list
    (module String)
    [ "bool"
    ; "bytes"
    ; "char"
    ; "float"
    ; "int"
    ; "int32"
    ; "int64"
    ; "nativeint"
    ; "string"
    ; "unit"
    ]
;;

let primitive ~core_type =
  match core_type.ptyp_desc with
  | Ptyp_constr (longident_loc, []) ->
    (match longident_loc.txt with
     | Lident lident when Set.mem known_zero_arity_core_primitives lident -> Some lident
     | Lident _ | Ldot (_, _) | Lapply (_, _)                             -> None)
  | _ -> None
;;

let maybe_match type_ (_ : Ctx.t) =
  let%bind core_type = Type_.match_core_type type_ in
  let%map  primitive = primitive ~core_type       in
  ({ children      = []
   ; apply_functor =
       (fun ctx children ->
          assert (List.is_empty children);
          Helpers.apply_streamable_dot
            ctx
            ~functor_name:"Of_atomic"
            ~arguments:
              [ pmod_ident
                  ~loc:ctx.loc
                  (Loc.make
                     ~loc:ctx.loc
                     (Longident.parse [%string "Core.%{String.capitalize primitive}"]))
              ])
   }
   : Clause.Match.t)
;;