move all error related stuff to errors.ml file
This commit is contained in:
parent
2d94d85562
commit
be24175a97
4 changed files with 51 additions and 53 deletions
42
errors.ml
Normal file
42
errors.ml
Normal file
|
@ -0,0 +1,42 @@
|
||||||
|
open Ast
|
||||||
|
open Lexing
|
||||||
|
|
||||||
|
exception LexerError of char
|
||||||
|
exception SemanticsError of string * Lexing.position
|
||||||
|
|
||||||
|
let err msg pos =
|
||||||
|
Printf.eprintf
|
||||||
|
"Error on line %d col %d: %s.\n"
|
||||||
|
pos.pos_lnum
|
||||||
|
(pos.pos_cnum - pos.pos_bol)
|
||||||
|
msg;
|
||||||
|
exit 1
|
||||||
|
;;
|
||||||
|
|
||||||
|
let errt expected given pos =
|
||||||
|
let rec string_of_type_t = function
|
||||||
|
| Int_t -> "int"
|
||||||
|
| Bool_t -> "bool"
|
||||||
|
| Func_t (r, a) ->
|
||||||
|
(if List.length a > 1 then "(" else "")
|
||||||
|
^ String.concat ", " (List.map string_of_type_t a)
|
||||||
|
^ (if List.length a > 1 then ")" else "")
|
||||||
|
^ " -> "
|
||||||
|
^ string_of_type_t r
|
||||||
|
in
|
||||||
|
raise
|
||||||
|
(SemanticsError
|
||||||
|
( Printf.sprintf
|
||||||
|
"Expected %s but given %s"
|
||||||
|
(string_of_type_t expected)
|
||||||
|
(string_of_type_t given)
|
||||||
|
, pos ))
|
||||||
|
;;
|
||||||
|
|
||||||
|
let warn msg (pos : Lexing.position) =
|
||||||
|
Printf.eprintf
|
||||||
|
"Warning on line %d col %d: %s.\n"
|
||||||
|
pos.pos_lnum
|
||||||
|
(pos.pos_cnum - pos.pos_bol)
|
||||||
|
msg
|
||||||
|
;;
|
|
@ -1,8 +1,7 @@
|
||||||
{
|
{
|
||||||
|
open Errors
|
||||||
open Lexing
|
open Lexing
|
||||||
open Parser
|
open Parser
|
||||||
|
|
||||||
exception Error of char
|
|
||||||
}
|
}
|
||||||
|
|
||||||
let alpha = ['a'-'z' 'A'-'Z']
|
let alpha = ['a'-'z' 'A'-'Z']
|
||||||
|
@ -27,7 +26,7 @@ rule token = parse
|
||||||
| '/' { Ldiv }
|
| '/' { Ldiv }
|
||||||
| ident as i { Lvar i }
|
| ident as i { Lvar i }
|
||||||
| '#' { comment lexbuf }
|
| '#' { comment lexbuf }
|
||||||
| _ as c { raise (Error c) }
|
| _ as c { raise (LexerError c) }
|
||||||
|
|
||||||
and comment = parse
|
and comment = parse
|
||||||
| eof { Lend }
|
| eof { Lend }
|
||||||
|
|
16
main.ml
16
main.ml
|
@ -1,14 +1,4 @@
|
||||||
open Lexing
|
open Errors
|
||||||
open Ast
|
|
||||||
|
|
||||||
let err msg pos =
|
|
||||||
Printf.eprintf
|
|
||||||
"Error on line %d col %d: %s.\n"
|
|
||||||
pos.pos_lnum
|
|
||||||
(pos.pos_cnum - pos.pos_bol)
|
|
||||||
msg;
|
|
||||||
exit 1
|
|
||||||
;;
|
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
if Array.length Sys.argv != 2
|
if Array.length Sys.argv != 2
|
||||||
|
@ -25,8 +15,8 @@ let () =
|
||||||
let asm = Compiler.compile ast in
|
let asm = Compiler.compile ast in
|
||||||
Mips.emit Stdlib.stdout asm
|
Mips.emit Stdlib.stdout asm
|
||||||
with
|
with
|
||||||
| Lexer.Error c ->
|
| LexerError c ->
|
||||||
err (Printf.sprintf "Unrecognized char \"%c\"" c) (Lexing.lexeme_start_p buf)
|
err (Printf.sprintf "Unrecognized char \"%c\"" c) (Lexing.lexeme_start_p buf)
|
||||||
| Parser.Error -> err "Syntax error" (Lexing.lexeme_start_p buf)
|
| Parser.Error -> err "Syntax error" (Lexing.lexeme_start_p buf)
|
||||||
| Semantics.Error (msg, pos) -> err msg pos
|
| SemanticsError (msg, pos) -> err msg pos
|
||||||
;;
|
;;
|
||||||
|
|
41
semantics.ml
41
semantics.ml
|
@ -1,40 +1,7 @@
|
||||||
open Ast
|
open Ast
|
||||||
open Ast.IR
|
open Ast.IR
|
||||||
open Baselib
|
open Baselib
|
||||||
|
open Errors
|
||||||
(* Erreurs *)
|
|
||||||
|
|
||||||
exception Error of string * Lexing.position
|
|
||||||
|
|
||||||
let errt expected given pos =
|
|
||||||
let rec string_of_type_t = function
|
|
||||||
| Int_t -> "int"
|
|
||||||
| Bool_t -> "bool"
|
|
||||||
| Func_t (r, a) ->
|
|
||||||
(if List.length a > 1 then "(" else "")
|
|
||||||
^ String.concat ", " (List.map string_of_type_t a)
|
|
||||||
^ (if List.length a > 1 then ")" else "")
|
|
||||||
^ " -> "
|
|
||||||
^ string_of_type_t r
|
|
||||||
in
|
|
||||||
raise
|
|
||||||
(Error
|
|
||||||
( Printf.sprintf
|
|
||||||
"Expected %s but given %s"
|
|
||||||
(string_of_type_t expected)
|
|
||||||
(string_of_type_t given)
|
|
||||||
, pos ))
|
|
||||||
;;
|
|
||||||
|
|
||||||
let warn msg (pos : Lexing.position) =
|
|
||||||
Printf.eprintf
|
|
||||||
"Warning on line %d col %d: %s.\n"
|
|
||||||
pos.pos_lnum
|
|
||||||
(pos.pos_cnum - pos.pos_bol)
|
|
||||||
msg
|
|
||||||
;;
|
|
||||||
|
|
||||||
(* Sémantique *)
|
|
||||||
|
|
||||||
let analyze_value = function
|
let analyze_value = function
|
||||||
| Syntax.Int n -> Int n, Int_t
|
| Syntax.Int n -> Int n, Int_t
|
||||||
|
@ -48,7 +15,7 @@ let rec analyze_expr env ua t = function
|
||||||
Val v2, new_t
|
Val v2, new_t
|
||||||
| Syntax.Var v ->
|
| Syntax.Var v ->
|
||||||
if not (Env.mem v.name env)
|
if not (Env.mem v.name env)
|
||||||
then raise (Error ("Unbound variable \"" ^ v.name ^ "\"", v.pos));
|
then raise (SemanticsError ("Unbound variable \"" ^ v.name ^ "\"", v.pos));
|
||||||
if List.mem v.name ua then warn ("Unassigned variable \"" ^ v.name ^ "\"") v.pos;
|
if List.mem v.name ua then warn ("Unassigned variable \"" ^ v.name ^ "\"") v.pos;
|
||||||
let new_t = Env.find v.name env in
|
let new_t = Env.find v.name env in
|
||||||
if new_t != t then errt t new_t v.pos;
|
if new_t != t then errt t new_t v.pos;
|
||||||
|
@ -75,14 +42,14 @@ let rec analyze_expr env ua t = function
|
||||||
tl
|
tl
|
||||||
c.args )
|
c.args )
|
||||||
, ret_t )
|
, ret_t )
|
||||||
| _ -> raise (Error ("\"" ^ c.func ^ "\" isn't a function", c.pos)))
|
| _ -> raise (SemanticsError ("\"" ^ c.func ^ "\" isn't a function", c.pos)))
|
||||||
;;
|
;;
|
||||||
|
|
||||||
let analyze_instr env ua = function
|
let analyze_instr env ua = function
|
||||||
| Syntax.Decl d -> Decl d.name, Env.add d.name d.type_t env, [ d.name ] @ ua
|
| Syntax.Decl d -> Decl d.name, Env.add d.name d.type_t env, [ d.name ] @ ua
|
||||||
| Syntax.Assign a ->
|
| Syntax.Assign a ->
|
||||||
if not (Env.mem a.var env)
|
if not (Env.mem a.var env)
|
||||||
then raise (Error ("Unbound variable \"" ^ a.var ^ "\"", a.pos));
|
then raise (SemanticsError ("Unbound variable \"" ^ a.var ^ "\"", a.pos));
|
||||||
let ae, et = analyze_expr env ua (Env.find a.var env) a.expr in
|
let ae, et = analyze_expr env ua (Env.find a.var env) a.expr in
|
||||||
Assign (a.var, ae), env, List.filter (fun x -> x <> a.var) ua
|
Assign (a.var, ae), env, List.filter (fun x -> x <> a.var) ua
|
||||||
| Syntax.Return r ->
|
| Syntax.Return r ->
|
||||||
|
|
Reference in a new issue