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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
type kind = Keyword of string | Name of string | Number of float | String of string | Punct of string | Regex of string * string | Eof
type token = { kind : kind; line : int; newline_before : bool }
exception Error of int * string
let keywords =
[ "let"; "const"; "var"; "function"; "return"; "if"; "else"; "while"; "for"; "in"; "break"; "continue";
"throw"; "try"; "catch"; "finally"; "new"; "typeof"; "true"; "false"; "null"; "this"; "class"; "delete";
"do"; "switch"; "case"; "default"; "void"; "instanceof" ]
let puncts3 = [ "==="; "!=="; "..."; "**=" ]
let puncts2 =
[ "=="; "!="; "<="; ">="; "&&"; "||"; "=>"; "++"; "--"; "+="; "-="; "*="; "/="; "%="; "**"; "??"; "?." ]
let puncts1 = "{}()[];,.<>+-*/%=!?:&|^~"
let is_digit c = c >= '0' && c <= '9'
let is_name_start c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c = '_' || c = '$'
let is_name_char c = is_name_start c || is_digit c
let utf_8 (cp : int) : string =
let b = Buffer.create 4 in
Buffer.add_utf_8_uchar b (Uchar.of_int cp);
Buffer.contents b
let tokenize (s : string) : token list =
let n = String.length s in
let line = ref 1 and newline = ref false and tokens = ref [] in
let emit kind at_line =
tokens := { kind; line = at_line; newline_before = !newline } :: !tokens;
newline := false
in
let error msg = raise (Error (!line, msg)) in
let sub i j = String.sub s i (j - i) in
let rec go i =
if i >= n then ()
else
match s.[i] with
| '\n' ->
incr line;
newline := true;
go (i + 1)
| ' ' | '\t' | '\r' -> go (i + 1)
| '/' when i + 1 < n && s.[i + 1] = '/' ->
let rec eol j = if j >= n || s.[j] = '\n' then j else eol (j + 1) in
go (eol i)
| '/' when i + 1 < n && s.[i + 1] = '*' ->
let start = !line in
let rec close j =
if j + 1 >= n then raise (Error (start, "a comment /* never closed"))
else if s.[j] = '*' && s.[j + 1] = '/' then j + 2
else (
if s.[j] = '\n' then (
incr line;
newline := true);
close (j + 1))
in
go (close (i + 2))
| '/' when regex_allowed () -> go (regex i)
| c when is_digit c || (c = '.' && i + 1 < n && is_digit s.[i + 1]) -> go (number i)
| c when is_name_start c ->
let j = ref i in
while !j < n && is_name_char s.[!j] do incr j done;
let w = sub i !j in
emit (if List.mem w keywords then Keyword w else Name w) !line;
go !j
| ('"' | '\'') as q -> go (string i q)
| '`' -> error "template literals are not supported here (an exercise: notes_javascript.md)"
| _ -> (
let starts p = i + String.length p <= n && sub i (i + String.length p) = p in
match List.find_opt starts (puncts3 @ puncts2) with
| Some p ->
emit (Punct p) !line;
go (i + String.length p)
| None ->
if String.contains puncts1 s.[i] then (
emit (Punct (String.make 1 s.[i])) !line;
go (i + 1))
else error (Printf.sprintf "unexpected character %C" s.[i]))
and regex_allowed () =
match !tokens with
| [] -> true
| t :: _ -> (
match t.kind with
| Number _ | String _ | Name _ | Regex _ -> false
| Keyword ("this" | "true" | "false" | "null") -> false
| Punct (")" | "]" | "}") -> false
| Keyword _ | Punct _ | Eof -> true)
and regex i =
let rec go j in_set =
if j >= n || s.[j] = '\n' then error "a regular expression never closed on its line"
else
match s.[j] with
| '\\' -> go (j + 2) in_set
| '[' -> go (j + 1) true
| ']' -> go (j + 1) false
| '/' when not in_set -> j
| _ -> go (j + 1) in_set
in
let close = go (i + 1) false in
let k = ref (close + 1) in
while !k < n && is_name_char s.[!k] do incr k done;
emit (Regex (sub (i + 1) close, sub (close + 1) !k)) !line;
!k
and number i =
if i + 1 < n && s.[i] = '0' && (s.[i + 1] = 'x' || s.[i + 1] = 'X') then (
let j = ref (i + 2) in
while !j < n && (is_digit s.[!j] || (Char.lowercase_ascii s.[!j] >= 'a' && Char.lowercase_ascii s.[!j] <= 'f')) do
incr j
done;
emit (Number (float_of_int (int_of_string (sub i !j)))) !line;
!j)
else
let j = ref i in
let digits () = while !j < n && is_digit s.[!j] do incr j done in
digits ();
if !j < n && s.[!j] = '.' then (
incr j;
digits ());
if !j < n && (s.[!j] = 'e' || s.[!j] = 'E') then (
incr j;
if !j < n && (s.[!j] = '+' || s.[!j] = '-') then incr j;
digits ());
if !j < n && is_name_start s.[!j] then error (Printf.sprintf "a number followed by %C" s.[!j]);
emit (Number (float_of_string (sub i !j))) !line;
!j
and string i q =
let b = Buffer.create 16 in
let rec go j =
if j >= n || s.[j] = '\n' then error "a string never closed on its line"
else if s.[j] = q then j + 1
else if s.[j] = '\\' && j + 1 < n then (
match s.[j + 1] with
| 'n' -> Buffer.add_char b '\n'; go (j + 2)
| 't' -> Buffer.add_char b '\t'; go (j + 2)
| 'r' -> Buffer.add_char b '\r'; go (j + 2)
| '0' -> Buffer.add_char b '\000'; go (j + 2)
| 'u' when j + 5 < n -> (
match int_of_string_opt ("0x" ^ sub (j + 2) (j + 6)) with
| Some cp -> Buffer.add_string b (utf_8 cp); go (j + 6)
| None -> error "a \\u escape needs four hexadecimal digits")
| c -> Buffer.add_char b c; go (j + 2))
else (
Buffer.add_char b s.[j];
go (j + 1))
in
let at = !line in
let j = go (i + 1) in
emit (String (Buffer.contents b)) at;
j
in
go 0;
emit Eof !line;
List.rev !tokens
let to_string (k : kind) : string =
match k with
| Keyword w -> "Keyword " ^ w
| Name w -> "Name " ^ w
| Number f -> "Number " ^ if Float.is_integer f && Float.abs f < 1e15 then Printf.sprintf "%.0f" f else Printf.sprintf "%g" f
| String s -> "String " ^ Printf.sprintf "%S" s
| Punct p -> "Punct " ^ p
| Regex (r, f) -> Printf.sprintf "Regex /%s/%s" r f
| Eof -> "Eof"