Source file atom.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
open Stdune

type t = A of string [@@unboxed]

let equal (A a) (A b) = String.equal a b

let is_valid_dune =
  let rec loop s i len =
    i = len ||
    match String.unsafe_get s i with
    | '%' -> after_percent s (i + 1) len
    | '"' | '(' | ')' | ';' | '\000'..'\032' | '\127'..'\255' -> false
    | _ -> loop s (i + 1) len
  and after_percent s i len =
    i = len ||
    match String.unsafe_get s i with
    | '%' -> after_percent s (i + 1) len
    | '"' | '(' | ')' | ';' | '\000'..'\032' | '\127'..'\255' | '{' -> false
    | _ -> loop s (i + 1) len
  in
  fun s ->
    let len = String.length s in
    len > 0 && loop s 0 len

let is_valid_jbuild str =
  let len = String.length str in
  len > 0 &&
  let rec loop ix =
    match str.[ix] with
    | '"' | '(' | ')' | ';' -> true
    | '|' -> ix > 0 && let next = ix - 1 in str.[next] = '#' || loop next
    | '#' -> ix > 0 && let next = ix - 1 in str.[next] = '|' || loop next
    | ' ' | '\t' | '\n' | '\012' | '\r' -> true
    | _ -> ix > 0 && loop (ix - 1)
  in
  not (loop (len - 1))

let of_string s = A s
let to_string (A s) = s

let is_valid (A t) = function
  | Syntax.Jbuild -> is_valid_jbuild t
  | Dune   -> is_valid_dune t

let print ((A atom) as t) syntax =
  if is_valid t syntax then
    atom
  else
    match syntax with
    | Jbuild ->
      Exn.code_error "atom cannot be printed in jbuild syntax"
        ["atom", Sexp.Atom atom]
    | Dune ->
      Exn.code_error "atom cannot be printed in dune syntax"
        ["atom", Sexp.Atom atom]

let of_int i = of_string (string_of_int i)
let of_float x = of_string (string_of_float x)
let of_bool x = of_string (string_of_bool x)
let of_digest d = of_string (Digest.to_string d)
let of_int64 i = of_string (Int64.to_string i)