2024-11-13 21:50:44 +01:00
|
|
|
{
|
|
|
|
|
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 = [
|
2024-11-16 15:40:00 +01:00
|
|
|
("as", AS);
|
|
|
|
|
("def", DEF);
|
2024-11-13 21:50:44 +01:00
|
|
|
("do", DO);
|
2024-11-16 15:40:00 +01:00
|
|
|
("else", ELSE);
|
2024-11-13 21:50:44 +01:00
|
|
|
("false", BOOL(false));
|
2024-11-16 15:40:00 +01:00
|
|
|
("for", FOR);
|
|
|
|
|
("if", IF);
|
|
|
|
|
("input", INPUT);
|
|
|
|
|
("main", MAIN);
|
2024-11-13 21:50:44 +01:00
|
|
|
("not", BNOT);
|
2024-11-16 15:40:00 +01:00
|
|
|
("output", OUTPUT);
|
2024-11-13 21:50:44 +01:00
|
|
|
("powmod", POWERMOD);
|
2024-11-16 15:40:00 +01:00
|
|
|
("rand", RAND);
|
|
|
|
|
("skip", SKIP);
|
|
|
|
|
("then", THEN);
|
|
|
|
|
("true", BOOL(true));
|
|
|
|
|
("while", WHILE);
|
|
|
|
|
("with", WITH);
|
2024-11-13 21:50:44 +01:00
|
|
|
]
|
|
|
|
|
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)
|
|
|
|
|
}
|
2024-11-16 15:40:00 +01:00
|
|
|
| "%" {MODULO}
|
|
|
|
|
| "&&" {BAND}
|
2024-11-13 21:50:44 +01:00
|
|
|
| "(" {LEFTPAR}
|
|
|
|
|
| ")" {RIGHTPAR}
|
2024-11-16 15:40:00 +01:00
|
|
|
| "*" {TIMES}
|
2024-11-13 21:50:44 +01:00
|
|
|
| "+" {PLUS}
|
2024-11-16 15:40:00 +01:00
|
|
|
| "," {COMMA}
|
2024-11-13 21:50:44 +01:00
|
|
|
| "-" {MINUS}
|
|
|
|
|
| "/" {DIVISION}
|
|
|
|
|
| ":=" {ASSIGNMENT}
|
2024-11-16 15:40:00 +01:00
|
|
|
| ";" {SEQUENCE}
|
|
|
|
|
| "<" {BCMPLESS}
|
2024-11-13 21:50:44 +01:00
|
|
|
| "<=" {BCMPLESSEQ}
|
2024-11-16 15:40:00 +01:00
|
|
|
| "==" {BCMP}
|
|
|
|
|
| ">" {BCMPGREATER}
|
2024-11-13 21:50:44 +01:00
|
|
|
| ">=" {BCMPGREATEREQ}
|
2024-11-16 15:40:00 +01:00
|
|
|
| "^" {POWER}
|
|
|
|
|
| "||" {BOR}
|
2024-11-13 21:50:44 +01:00
|
|
|
| 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
|
|
|
|
|
}
|