96 lines
2.5 KiB
OCaml
96 lines
2.5 KiB
OCaml
{
|
|
open Parser
|
|
exception LexingError of string
|
|
|
|
let create_hashtable size init =
|
|
let tbl = Hashtbl.create size in
|
|
List.iter (fun (key, data) -> Hashtbl.add tbl key data) init;
|
|
tbl
|
|
|
|
let keyword_table =
|
|
let mapping = [
|
|
("bool", TYPEBOOL);
|
|
("else", ELSE);
|
|
("false", BOOL(false));
|
|
("fst", FIRST);
|
|
("snd", SECOND);
|
|
("fun", LAMBDA);
|
|
("if", IF);
|
|
("in", IN);
|
|
("int", TYPEINT);
|
|
("lambda", LAMBDA);
|
|
("let", LET);
|
|
("not", BNOT);
|
|
("powmod", POWERMOD);
|
|
("rand", RAND);
|
|
("rec", REC);
|
|
("then", THEN);
|
|
("true", BOOL(true));
|
|
]
|
|
in create_hashtable (List.length mapping) mapping
|
|
}
|
|
|
|
|
|
let digit = ['0'-'9']
|
|
let alpha = ['a'-'z' 'A'-'Z']
|
|
let white = [' ' '\t']+ | '\r' | '\n' | "\r\n"
|
|
|
|
let integer = ('-')?(digit)(digit*)
|
|
let var = (alpha|'_') (alpha|digit|'_')*
|
|
|
|
let symbols = ['!'-'/' ':'-'?' '[' ']' '^' '{'-'}' '~']
|
|
|
|
(* lexing rules *)
|
|
rule read = parse
|
|
| white {read lexbuf}
|
|
| var as v {
|
|
match Hashtbl.find_opt keyword_table v with
|
|
| Some keyword -> keyword
|
|
| None -> VARIABLE(v)
|
|
}
|
|
| "%" {MODULO}
|
|
| "&&" {BAND}
|
|
| "(" {LEFTPAR}
|
|
| ")" {RIGHTPAR}
|
|
| "*" {TIMES}
|
|
| "+" {PLUS}
|
|
| "," {COMMA}
|
|
| "-" {MINUS}
|
|
| "->" {TYPEFUNCTION}
|
|
| "/" {DIVISION}
|
|
| ":" {COLUMN}
|
|
| "<" {CMPLESS}
|
|
| "<=" {CMPLESSEQ}
|
|
| "=" {ASSIGNMENT}
|
|
| "==" {CMP}
|
|
| "=>" {RESULTS}
|
|
| ">" {CMPGREATER}
|
|
| ">=" {CMPGREATEREQ}
|
|
| "\\" {LAMBDA}
|
|
| "^" {POWER}
|
|
| "||" {BOR}
|
|
| integer as i {INT(int_of_string i)}
|
|
| "(*" {comments 0 lexbuf}
|
|
| eof {EOF}
|
|
| _ {
|
|
raise
|
|
(LexingError
|
|
(Printf.sprintf
|
|
"Error scanning %s on line %d at char %d"
|
|
(Lexing.lexeme lexbuf)
|
|
(lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum)
|
|
(lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum)
|
|
))}
|
|
and comments level = parse
|
|
| "*)" {if level = 0
|
|
then read lexbuf
|
|
else comments (level-1) lexbuf}
|
|
| "(*" {comments (level+1) lexbuf}
|
|
| _ {comments level lexbuf}
|
|
| eof {raise (LexingError ("Comment is not closed"))}
|
|
|
|
|
|
{
|
|
let lex = read
|
|
}
|