diff --git a/src/parser.mly b/src/parser.mly index a7f5c0d..93bfdfb 100644 --- a/src/parser.mly +++ b/src/parser.mly @@ -22,24 +22,6 @@ ("The var "^n^" does not exist.", current_location())) | Some var -> var - let type_var (v: t_var) = - match v with - | IVar _ -> [TInt] - | BVar _ -> [TBool] - | RVar _ -> [TReal] - - let type_exp : t_expression -> full_ty = function - | EVar (full_ty , _) -> full_ty - | EMonOp (full_ty , _ , _) -> full_ty - | EBinOp (full_ty , _ , _ , _) -> full_ty - | ETriOp (full_ty , _ , _ , _ , _) -> full_ty - | EComp (full_ty , _ , _ , _) -> full_ty - | EWhen (full_ty , _ , _) -> full_ty - | EReset (full_ty , _ , _) -> full_ty - | EConst (full_ty , _) -> full_ty - | ETuple (full_ty , _) -> full_ty - | EApp (full_ty , _ , _) -> full_ty - let concat_varlist (t1, e1) (t2, e2) = (t1 @ t2, e1 @ e2) let make_ident (v : t_var) : t_varlist = @@ -107,15 +89,6 @@ then ETriOp (t2, op, e1, e2, e3) else raise (MyParsingError (error_msg, current_location())) - let rec debug_type_pp fmt = function - | [] -> () - | TInt :: t -> Format.fprintf fmt "int %a" debug_type_pp t - | TBool :: t -> Format.fprintf fmt "bool %a" debug_type_pp t - | TReal :: t -> Format.fprintf fmt "real %a" debug_type_pp t - - let debug_type = - Format.printf "Type: %a\n" debug_type_pp - %} %token EOF @@ -255,8 +228,7 @@ equation: let expr = $3 in let texpr = type_exp expr in if t_patt = texpr then ((t_patt, patt), expr) - else (debug_type t_patt; debug_type (type_exp expr); - raise (MyParsingError ("The equation does not type check!", + else (raise (MyParsingError ("The equation does not type check!", current_location()))) }; pattern: diff --git a/src/pp.ml b/src/pp.ml index 34b078f..6ba3e4c 100644 --- a/src/pp.ml +++ b/src/pp.ml @@ -1,5 +1,11 @@ open Ast + let rec debug_type_pp fmt = function + | [] -> () + | TInt :: t -> Format.fprintf fmt "int %a" debug_type_pp t + | TBool :: t -> Format.fprintf fmt "bool %a" debug_type_pp t + | TReal :: t -> Format.fprintf fmt "real %a" debug_type_pp t + let pp_loc fmt (start, stop) = Lexing.( Format.fprintf fmt "%s: -- " @@ -118,7 +124,8 @@ let pp_expression = let rec pp_equations fmt: t_eqlist -> unit = function | [] -> () | (patt, expr) :: eqs -> - Format.fprintf fmt "\t\t∗ left side: %a\n\t\t right side:\n%a\n%a" + Format.fprintf fmt "\t\t∗ Equation of type : %a\n\t\t left side: %a\n\t\t right side:\n%a\n%a" + debug_type_pp (Utils.type_exp expr) pp_varlist patt pp_expression expr pp_equations eqs diff --git a/src/utils.ml b/src/utils.ml index 31f9c33..fa54da9 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -1,3 +1,5 @@ +open Ast + let rec list_repeat n elt = if n = 0 then [] else elt :: (list_repeat (n-1) elt) @@ -6,3 +8,22 @@ let rec list_chk v = function | h :: t -> if h = v then true else list_chk v t exception MyParsingError of (string * Ast.location) + +let type_var (v: t_var) = + match v with + | IVar _ -> [TInt] + | BVar _ -> [TBool] + | RVar _ -> [TReal] + +let type_exp : t_expression -> full_ty = function + | EVar (full_ty , _) -> full_ty + | EMonOp (full_ty , _ , _) -> full_ty + | EBinOp (full_ty , _ , _ , _) -> full_ty + | ETriOp (full_ty , _ , _ , _ , _) -> full_ty + | EComp (full_ty , _ , _ , _) -> full_ty + | EWhen (full_ty , _ , _) -> full_ty + | EReset (full_ty , _ , _) -> full_ty + | EConst (full_ty , _) -> full_ty + | ETuple (full_ty , _) -> full_ty + | EApp (full_ty , _ , _) -> full_ty +