[pp] add typing information
This commit is contained in:
parent
5551237414
commit
54d806f149
@ -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:
|
||||
|
@ -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: <l: %d, c: %d> -- <l: %d, c: %d>"
|
||||
@ -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
|
||||
|
21
src/utils.ml
21
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
|
||||
|
||||
|
Loading…
x
Reference in New Issue
Block a user