1(*===----------------------------------------------------------------------===
2 * Lexer
3 *===----------------------------------------------------------------------===*)
4
5let rec lex = parser
6  (* Skip any whitespace. *)
7  | [< ' (' ' | '\n' | '\r' | '\t'); stream >] -> lex stream
8
9  (* identifier: [a-zA-Z][a-zA-Z0-9] *)
10  | [< ' ('A' .. 'Z' | 'a' .. 'z' as c); stream >] ->
11      let buffer = Buffer.create 1 in
12      Buffer.add_char buffer c;
13      lex_ident buffer stream
14
15  (* number: [0-9.]+ *)
16  | [< ' ('0' .. '9' as c); stream >] ->
17      let buffer = Buffer.create 1 in
18      Buffer.add_char buffer c;
19      lex_number buffer stream
20
21  (* Comment until end of line. *)
22  | [< ' ('#'); stream >] ->
23      lex_comment stream
24
25  (* Otherwise, just return the character as its ascii value. *)
26  | [< 'c; stream >] ->
27      [< 'Token.Kwd c; lex stream >]
28
29  (* end of stream. *)
30  | [< >] -> [< >]
31
32and lex_number buffer = parser
33  | [< ' ('0' .. '9' | '.' as c); stream >] ->
34      Buffer.add_char buffer c;
35      lex_number buffer stream
36  | [< stream=lex >] ->
37      [< 'Token.Number (float_of_string (Buffer.contents buffer)); stream >]
38
39and lex_ident buffer = parser
40  | [< ' ('A' .. 'Z' | 'a' .. 'z' | '0' .. '9' as c); stream >] ->
41      Buffer.add_char buffer c;
42      lex_ident buffer stream
43  | [< stream=lex >] ->
44      match Buffer.contents buffer with
45      | "def" -> [< 'Token.Def; stream >]
46      | "extern" -> [< 'Token.Extern; stream >]
47      | "if" -> [< 'Token.If; stream >]
48      | "then" -> [< 'Token.Then; stream >]
49      | "else" -> [< 'Token.Else; stream >]
50      | "for" -> [< 'Token.For; stream >]
51      | "in" -> [< 'Token.In; stream >]
52      | "binary" -> [< 'Token.Binary; stream >]
53      | "unary" -> [< 'Token.Unary; stream >]
54      | "var" -> [< 'Token.Var; stream >]
55      | id -> [< 'Token.Ident id; stream >]
56
57and lex_comment = parser
58  | [< ' ('\n'); stream=lex >] -> stream
59  | [< 'c; e=lex_comment >] -> e
60  | [< >] -> [< >]
61