[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()))
|
("The var "^n^" does not exist.", current_location()))
|
||||||
| Some var -> var
|
| 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 concat_varlist (t1, e1) (t2, e2) = (t1 @ t2, e1 @ e2)
|
||||||
|
|
||||||
let make_ident (v : t_var) : t_varlist =
|
let make_ident (v : t_var) : t_varlist =
|
||||||
@ -107,15 +89,6 @@
|
|||||||
then ETriOp (t2, op, e1, e2, e3)
|
then ETriOp (t2, op, e1, e2, e3)
|
||||||
else raise (MyParsingError (error_msg, current_location()))
|
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
|
%token EOF
|
||||||
@ -255,8 +228,7 @@ equation:
|
|||||||
let expr = $3 in let texpr = type_exp expr in
|
let expr = $3 in let texpr = type_exp expr in
|
||||||
if t_patt = texpr
|
if t_patt = texpr
|
||||||
then ((t_patt, patt), expr)
|
then ((t_patt, patt), expr)
|
||||||
else (debug_type t_patt; debug_type (type_exp expr);
|
else (raise (MyParsingError ("The equation does not type check!",
|
||||||
raise (MyParsingError ("The equation does not type check!",
|
|
||||||
current_location()))) };
|
current_location()))) };
|
||||||
|
|
||||||
pattern:
|
pattern:
|
||||||
|
@ -1,5 +1,11 @@
|
|||||||
open Ast
|
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) =
|
let pp_loc fmt (start, stop) =
|
||||||
Lexing.(
|
Lexing.(
|
||||||
Format.fprintf fmt "%s: <l: %d, c: %d> -- <l: %d, c: %d>"
|
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
|
let rec pp_equations fmt: t_eqlist -> unit = function
|
||||||
| [] -> ()
|
| [] -> ()
|
||||||
| (patt, expr) :: eqs ->
|
| (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_varlist patt
|
||||||
pp_expression expr
|
pp_expression expr
|
||||||
pp_equations eqs
|
pp_equations eqs
|
||||||
|
21
src/utils.ml
21
src/utils.ml
@ -1,3 +1,5 @@
|
|||||||
|
open Ast
|
||||||
|
|
||||||
let rec list_repeat n elt =
|
let rec list_repeat n elt =
|
||||||
if n = 0 then [] else elt :: (list_repeat (n-1) 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
|
| h :: t -> if h = v then true else list_chk v t
|
||||||
|
|
||||||
exception MyParsingError of (string * Ast.location)
|
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…
Reference in New Issue
Block a user