107 lines
2.5 KiB
OCaml
107 lines
2.5 KiB
OCaml
open Ast.Value
|
|
|
|
exception Invalid_character of char
|
|
exception Expected of char
|
|
|
|
let invalid_char c = raise @@ Invalid_character c
|
|
let expected c = raise @@ Expected c
|
|
|
|
let either f g c =
|
|
f c || g c
|
|
|
|
let is_digit c =
|
|
'0' <= c && c <= '9'
|
|
|
|
let is_num = function
|
|
| 'x' -> true
|
|
| '.' -> true
|
|
| c -> is_digit c
|
|
|
|
let is_whitespace = function
|
|
| ' ' | '\t' | '\n' -> true
|
|
| _ -> false
|
|
|
|
let is_alpha c =
|
|
('A' <= c && c <= 'Z') || ('a' <= c && c <= 'z')
|
|
|
|
let is_ident_start =
|
|
either is_alpha ((=) '_')
|
|
|
|
let is_ident =
|
|
either is_ident_start is_digit
|
|
|
|
let expect_char c seq =
|
|
match seq () with
|
|
| Seq.Nil -> expected c
|
|
| Seq.Cons (x, seq) ->
|
|
if x = c then seq else expected c
|
|
|
|
let expect_token str tok seq =
|
|
let rec aux ts seq =
|
|
match ts (), seq () with
|
|
| Seq.Nil, _ -> Some seq
|
|
| Seq.Cons _, Seq.Nil -> None
|
|
| Seq.Cons (a, ts), Seq.Cons (b, seq) ->
|
|
if a = b then aux ts seq else None
|
|
in
|
|
let str = String.to_seq str in
|
|
aux str seq |> Option.map (fun s -> tok, s)
|
|
|
|
let find_token seq =
|
|
!Token.tokens |> List.find_map
|
|
(fun (s, t) -> expect_token s t seq)
|
|
|
|
(* same as take_while f seq, drop_while f seq *)
|
|
let rec partition_while f seq =
|
|
match seq () with
|
|
| Seq.Nil -> Seq.empty, seq
|
|
| Seq.Cons (x, seq) ->
|
|
if f x then
|
|
let n, s = partition_while f seq in
|
|
Seq.cons x n, s
|
|
else
|
|
Seq.(empty, cons x seq)
|
|
|
|
let tokenize str =
|
|
let seq = String.to_seq str in
|
|
let rec aux seq =
|
|
let open Token in
|
|
let open Seq in
|
|
match seq () with
|
|
| Nil -> empty
|
|
| Cons (x, seq) ->
|
|
(* skip whitespace *)
|
|
if is_whitespace x then
|
|
aux seq
|
|
|
|
(* string *)
|
|
else if x = '"' then
|
|
let str, seq = partition_while ((<>) '"') seq in
|
|
let str = String (String.of_seq str) in
|
|
let seq = expect_char '"' seq in
|
|
cons (Value str) (aux seq)
|
|
|
|
(* number (int, float) *)
|
|
else if is_digit x then
|
|
let n, seq = partition_while is_num seq in
|
|
let n = String.of_seq @@ cons x n in
|
|
let n =
|
|
if String.contains n '.' (* float *)
|
|
then Float (float_of_string n)
|
|
else Int (int_of_string n)
|
|
in
|
|
cons (Value n) (aux seq)
|
|
|
|
(* idents *)
|
|
else if is_ident_start x then
|
|
let id, seq = partition_while is_ident seq in
|
|
let id = String.of_seq @@ cons x id in
|
|
cons (Ident id) (aux seq)
|
|
|
|
(* tokens *)
|
|
else
|
|
match find_token @@ cons x seq with
|
|
| None -> invalid_char x
|
|
| Some (t, seq) -> cons t (aux seq)
|
|
in
|
|
aux seq
|