98 lines
2.4 KiB
OCaml
98 lines
2.4 KiB
OCaml
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.Nil
|
|
| 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, s) -> Seq.Cons (t, aux s)
|
|
in
|
|
aux seq
|