79 lines
1.9 KiB
OCaml
79 lines
1.9 KiB
OCaml
{
|
|
open Parser
|
|
|
|
exception Error of string
|
|
|
|
let fail msg =
|
|
raise (Error msg)
|
|
|
|
let keywords = Hashtbl.create 17
|
|
let _ = begin
|
|
Hashtbl.add keywords "true" Kw_true;
|
|
Hashtbl.add keywords "false" Kw_false;
|
|
Hashtbl.add keywords "nil" Kw_nil;
|
|
Hashtbl.add keywords "val" Kw_val;
|
|
Hashtbl.add keywords "fun" Kw_fun;
|
|
Hashtbl.add keywords "obj" Kw_obj;
|
|
Hashtbl.add keywords "if" Kw_if;
|
|
Hashtbl.add keywords "else" Kw_else;
|
|
end
|
|
|
|
let is_digit ch = ch >= '0' && ch <= '9'
|
|
let is_digit_or_sep ch = ch = '_' || is_digit ch
|
|
|
|
let is_integer str =
|
|
String.exists is_digit str &&
|
|
String.for_all is_digit_or_sep str
|
|
|
|
let parse_integer str =
|
|
let buffer = Buffer.create (String.length str) in
|
|
String.iter (fun ch ->
|
|
if is_digit ch then
|
|
Buffer.add_char buffer ch)
|
|
str;
|
|
if Buffer.length buffer > 18 then
|
|
fail "integer literal is too long";
|
|
Int64.of_string (Buffer.contents buffer)
|
|
|
|
let identifier str =
|
|
match Hashtbl.find keywords str with
|
|
| kw -> kw
|
|
| exception Not_found ->
|
|
if is_integer str then
|
|
Int (parse_integer str)
|
|
else
|
|
Name str
|
|
}
|
|
|
|
let int = ['0'-'9'] ['0'-'9']*
|
|
let white = [' ' '\t']+
|
|
let newline = '\n'
|
|
let id = ['a'-'z' 'A'-'Z' '0'-'9' '_']+
|
|
|
|
rule read =
|
|
parse
|
|
| white { read lexbuf }
|
|
| newline { Lexing.new_line lexbuf; read lexbuf }
|
|
| id { identifier (Lexing.lexeme lexbuf) }
|
|
| "(" { LP }
|
|
| ")" { RP }
|
|
| "{" { LC }
|
|
| "}" { RC }
|
|
| "+" { Binop Add }
|
|
| "-" { Binop Sub }
|
|
| "*" { Binop Mul }
|
|
| "/" { Binop Div }
|
|
| "%" { Binop Mod }
|
|
| "==" { Binop Eql }
|
|
| "=" { Eq }
|
|
| ">" { Binop Grt }
|
|
| "<=" { Binop Lst_eql }
|
|
| "<" { Binop Lst }
|
|
| ">=" { Binop Grt_eql }
|
|
| "!=" { Binop Not_eql }
|
|
| "." { Dot }
|
|
| "," { Com }
|
|
| _ { fail "unrecognized character" }
|
|
| eof { EOF }
|
|
|