Source file pbrt_options.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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
module E = struct
type error =
| Unexpected_option_type of string * string
| Malformed_variant of string
exception Failure of error
let unexpected_option_type record_name field_name =
raise (Failure (Unexpected_option_type (record_name, field_name)))
let malformed_variant variant_name =
raise (Failure (Malformed_variant variant_name))
let string_of_error = function
| Unexpected_option_type (record_name, field_name) ->
Printf.sprintf "Unexpected option type (record name:%s, field_name:%s)"
record_name field_name
| Malformed_variant variant_name ->
Printf.sprintf "Malformed variant (variant name: %s)" variant_name
let () =
Printexc.register_printer (fun exn ->
match exn with
| Failure e -> Some (string_of_error e)
| _ -> None)
end
type constant =
| Constant_string of string
| Constant_bool of bool
| Constant_int of int
| Constant_float of float
| Constant_literal of string
type message_literal = (string * value) list
and list_literal = value list
and value =
| Scalar_value of constant
| Message_literal of message_literal
| List_literal of list_literal
let unescape_string str =
let buffer = Buffer.create (String.length str) in
let rec aux i =
if i < String.length str then (
match str.[i] with
| '\\' ->
(match str.[i + 1] with
| 'a' ->
Buffer.add_char buffer '\007';
aux (i + 2)
| 'b' ->
Buffer.add_char buffer '\b';
aux (i + 2)
| 'f' ->
Buffer.add_char buffer '\012';
aux (i + 2)
| 'n' ->
Buffer.add_char buffer '\n';
aux (i + 2)
| 'r' ->
Buffer.add_char buffer '\r';
aux (i + 2)
| 't' ->
Buffer.add_char buffer '\t';
aux (i + 2)
| 'v' ->
Buffer.add_char buffer '\011';
aux (i + 2)
| '?' ->
Buffer.add_char buffer '?';
aux (i + 2)
| '\\' ->
Buffer.add_char buffer '\\';
aux (i + 2)
| '\'' ->
Buffer.add_char buffer '\'';
aux (i + 2)
| '"' ->
Buffer.add_char buffer '"';
aux (i + 2)
| 'x' ->
let hex = String.sub str (i + 2) 2 in
Buffer.add_char buffer (Char.chr (int_of_string ("0x" ^ hex)));
aux (i + 4)
| 'u' ->
let unicode = String.sub str (i + 2) 4 in
Buffer.add_char buffer (Char.chr (int_of_string ("0x" ^ unicode)));
aux (i + 6)
| 'U' ->
let unicode = String.sub str (i + 2) 5 in
Buffer.add_char buffer (Char.chr (int_of_string ("0x" ^ unicode)));
aux (i + 7)
| c when c >= '0' && c <= '7' ->
let end_idx = min (i + 4) (String.length str) in
let rec find_octal_end idx =
if idx < end_idx && str.[idx] >= '0' && str.[idx] <= '7' then
find_octal_end (idx + 1)
else
idx
in
let octal_end = find_octal_end (i + 2) in
let octal = String.sub str (i + 1) (octal_end - i - 1) in
Buffer.add_char buffer (Char.chr (int_of_string ("0o" ^ octal)));
aux octal_end
| c -> failwith (Printf.sprintf "Invalid escape sequence: \\%c" c))
| c ->
Buffer.add_char buffer c;
aux (i + 1)
)
in
aux 0;
Buffer.contents buffer
let int32 v record_name field_name =
match v with
| Scalar_value (Constant_float v) -> Int32.of_float v
| Scalar_value (Constant_int v) -> Int32.of_int v
| _ -> E.unexpected_option_type record_name field_name
let float v record_name field_name =
match v with
| Scalar_value (Constant_float v) -> v
| Scalar_value (Constant_int v) -> float_of_int v
| _ -> E.unexpected_option_type record_name field_name
let int64 v record_name field_name =
match v with
| Scalar_value (Constant_float v) -> Int64.of_float v
| Scalar_value (Constant_int v) -> Int64.of_int v
| _ -> E.unexpected_option_type record_name field_name
let int v record_name field_name =
match v with
| Scalar_value (Constant_float v) -> int_of_float v
| Scalar_value (Constant_int v) -> v
| _ -> E.unexpected_option_type record_name field_name
let string v record_name field_name =
match v with
| Scalar_value (Constant_string v) -> unescape_string v
| _ -> E.unexpected_option_type record_name field_name
let bool v record_name field_name =
match v with
| Scalar_value (Constant_bool v) -> v
| _ -> E.unexpected_option_type record_name field_name
let bytes v record_name field_name =
string v record_name field_name |> Bytes.of_string
let unit v record_name field_name =
match v with
| Message_literal [] -> ()
| _ -> E.unexpected_option_type record_name field_name