open Ast.Value type tokens = Token.t Seq.t exception Token_not_found exception Unclosed_quote 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_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 : 'a Seq.t * 'a Seq.t = 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 : string) : tokens = let seq = String.to_seq str in let rec aux seq = let open Token in match seq () with | Seq.Nil -> Seq.empty | Seq.Cons (x, seq) -> if is_whitespace x then aux seq (* skip whitespace *) else if x = '"' then let str, seq = partition_while ((<>) '"') seq in let str = String (String.of_seq str) in begin match seq () with | Seq.Nil -> raise Unclosed_quote | Seq.Cons (x, seq) -> if x = '"' then Seq.cons (Value str) (aux seq) else raise Unclosed_quote end else if is_digit x then let n, seq = partition_while is_num seq in let n = String.of_seq @@ 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 Seq.cons (Value n) (aux seq) else if is_ident_start x then let id, seq = partition_while is_ident seq in let id = String.of_seq @@ Seq.cons x id in Seq.cons (Ident id) (aux seq) else match find_token @@ Seq.cons x seq with | None -> raise Token_not_found | Some (t, seq) -> Seq.cons t (aux seq) in aux seq