Compare commits
2 Commits
da1406fbcc
...
3c811c6128
Author | SHA1 | Date | |
---|---|---|---|
|
3c811c6128 | ||
|
eb469bc960 |
@ -47,7 +47,6 @@ type t_expression =
|
|||||||
| ETriOp of full_ty * triop * t_expression * t_expression * t_expression
|
| ETriOp of full_ty * triop * t_expression * t_expression * t_expression
|
||||||
| EComp of full_ty * compop * t_expression * t_expression
|
| EComp of full_ty * compop * t_expression * t_expression
|
||||||
| EWhen of full_ty * t_expression * t_expression
|
| EWhen of full_ty * t_expression * t_expression
|
||||||
| EFby of full_ty * t_expression * t_expression
|
|
||||||
| EConst of full_ty * const
|
| EConst of full_ty * const
|
||||||
| ETuple of full_ty * (t_expression list)
|
| ETuple of full_ty * (t_expression list)
|
||||||
| EApp of full_ty * t_node * t_expression
|
| EApp of full_ty * t_node * t_expression
|
||||||
|
202
src/parser.mly
202
src/parser.mly
@ -60,6 +60,53 @@
|
|||||||
| RVar _, (FTList tl, l) -> (FTList (FTBase TReal :: tl), v :: l)
|
| RVar _, (FTList tl, l) -> (FTList (FTBase TReal :: tl), v :: l)
|
||||||
| _ -> raise (MyParsingError ("This exception should not have been raised.",
|
| _ -> raise (MyParsingError ("This exception should not have been raised.",
|
||||||
current_location()))
|
current_location()))
|
||||||
|
|
||||||
|
let monop_condition expr typ_constraint error_msg res =
|
||||||
|
if type_exp expr = typ_constraint
|
||||||
|
then res
|
||||||
|
else raise (MyParsingError (error_msg, current_location()))
|
||||||
|
|
||||||
|
let monop_neg_condition expr typ_constraint error_msg res =
|
||||||
|
if type_exp expr <> typ_constraint
|
||||||
|
then res
|
||||||
|
else raise (MyParsingError (error_msg, current_location()))
|
||||||
|
|
||||||
|
let make_binop_nonbool e1 e2 op error_msg =
|
||||||
|
let t1 = type_exp e1 in let t2 = type_exp e2 in
|
||||||
|
match t1 with
|
||||||
|
| FTBase _ -> (** e1 and e2 should be nunmbers here.*)
|
||||||
|
if t1 = t2 && t1 <> FTBase TBool
|
||||||
|
then EBinOp (t1, op, e1, e2)
|
||||||
|
else raise (MyParsingError (error_msg, current_location()))
|
||||||
|
| _ -> raise (MyParsingError (error_msg, current_location()))
|
||||||
|
|
||||||
|
let make_binop_bool e1 e2 op error_msg =
|
||||||
|
let t1 = type_exp e1 in let t2 = type_exp e2 in
|
||||||
|
if t1 = t2 && t1 = FTBase TBool
|
||||||
|
then EBinOp (t1, op, e1, e2)
|
||||||
|
else raise (MyParsingError (error_msg, current_location()))
|
||||||
|
|
||||||
|
let make_comp e1 e2 op error_msg =
|
||||||
|
let t1 = type_exp e1 in let t2 = type_exp e2 in
|
||||||
|
if t1 = t2
|
||||||
|
then EComp (FTBase TBool, op, e1, e2)
|
||||||
|
else raise (MyParsingError (error_msg, current_location()))
|
||||||
|
|
||||||
|
let make_comp_nonbool e1 e2 op error_msg =
|
||||||
|
let t1 = type_exp e1 in let t2 = type_exp e2 in
|
||||||
|
match t1 with
|
||||||
|
| FTBase _ -> (** e1 and e2 should be numbers here. *)
|
||||||
|
if t1 = t2 && t1 <> FTBase TBool
|
||||||
|
then EComp (FTBase TBool, op, e1, e2)
|
||||||
|
else raise (MyParsingError (error_msg, current_location()))
|
||||||
|
| _ -> raise (MyParsingError (error_msg, current_location()))
|
||||||
|
|
||||||
|
let make_tertiary e1 e2 e3 op error_msg =
|
||||||
|
let t1 = type_exp e1 in let t2 = type_exp e2 in let t3 = type_exp e3 in
|
||||||
|
if t2 = t3 && t1 = FTBase TBool
|
||||||
|
then ETriOp (t2, op, e1, e2, e3)
|
||||||
|
else raise (MyParsingError (error_msg, current_location()))
|
||||||
|
|
||||||
%}
|
%}
|
||||||
|
|
||||||
%token EOF
|
%token EOF
|
||||||
@ -214,84 +261,39 @@ expr:
|
|||||||
| IDENT { let v = fetch_var $1 in EVar (type_var v, v) }
|
| IDENT { let v = fetch_var $1 in EVar (type_var v, v) }
|
||||||
/* Unary operators */
|
/* Unary operators */
|
||||||
| MO_not expr
|
| MO_not expr
|
||||||
{ let t = type_exp $2 in
|
{ monop_condition $2 (FTBase TBool)
|
||||||
if t = FTBase TBool
|
"You cannot negate a non-boolean expression."
|
||||||
then EMonOp (t, MOp_not, $2)
|
(EMonOp (type_exp $2, MOp_not, $2)) }
|
||||||
else raise (MyParsingError ("You cannot negate a non-boolean \
|
|
||||||
expression.",
|
|
||||||
current_location())) }
|
|
||||||
| MO_pre expr { EMonOp (type_exp $2, MOp_pre, $2) }
|
| MO_pre expr { EMonOp (type_exp $2, MOp_pre, $2) }
|
||||||
| MINUS expr
|
| MINUS expr
|
||||||
{ let t = type_exp $2 in
|
{ monop_neg_condition $2 (FTBase TBool)
|
||||||
if t = FTBase TBool
|
"You cannot take the opposite of a boolean expression."
|
||||||
then raise (MyParsingError ("You cannot take the opposite of a \
|
(EMonOp (type_exp $2, MOp_minus, $2)) }
|
||||||
boolean expression.",
|
|
||||||
current_location()))
|
|
||||||
else EMonOp (t, MOp_minus, $2) }
|
|
||||||
| PLUS expr
|
| PLUS expr
|
||||||
{ let t = type_exp $2 in
|
{ monop_neg_condition $2 (FTBase TBool)
|
||||||
if t = FTBase TBool
|
"You cannot take the plus of a boolean expression." $2 }
|
||||||
then raise (MyParsingError ("You cannot take the plus of a boolean \
|
|
||||||
expression.",
|
|
||||||
current_location()))
|
|
||||||
else $2 }
|
|
||||||
/* Binary operators */
|
/* Binary operators */
|
||||||
| expr PLUS expr
|
| expr PLUS expr
|
||||||
{ let e1 = $1 in let t1 = type_exp e1 in
|
{ make_binop_nonbool $1 $3 BOp_add
|
||||||
let e2 = $3 in let t2 = type_exp e2 in
|
"You should know better; addition hates booleans" }
|
||||||
if t1 = t2 && t1 <> FTBase TBool
|
|
||||||
then EBinOp (t1, BOp_add, $1, $3)
|
|
||||||
else raise (MyParsingError ("You should know better; addition hates \
|
|
||||||
booleans",
|
|
||||||
current_location())) }
|
|
||||||
| expr MINUS expr
|
| expr MINUS expr
|
||||||
{ let e1 = $1 in let t1 = type_exp e1 in
|
{ make_binop_nonbool $1 $3 BOp_sub
|
||||||
let e2 = $3 in let t2 = type_exp e2 in
|
"You should know better; subtraction hates booleans" }
|
||||||
if t1 = t2 && t1 <> FTBase TBool
|
|
||||||
then EBinOp (t1, BOp_sub, $1, $3)
|
|
||||||
else raise (MyParsingError ("You should know better; subtraction \
|
|
||||||
hates booleans",
|
|
||||||
current_location())) }
|
|
||||||
| expr BO_mul expr
|
| expr BO_mul expr
|
||||||
{ let e1 = $1 in let t1 = type_exp e1 in
|
{ make_binop_nonbool $1 $3 BOp_mul
|
||||||
let e2 = $3 in let t2 = type_exp e2 in
|
"You should know better; multiplication hates booleans" }
|
||||||
if t1 = t2 && t1 <> FTBase TBool
|
|
||||||
then EBinOp (t1, BOp_mul, $1, $3)
|
|
||||||
else raise (MyParsingError ("You should know better; multiplication \
|
|
||||||
hates booleans",
|
|
||||||
current_location())) }
|
|
||||||
| expr BO_div expr
|
| expr BO_div expr
|
||||||
{ let e1 = $1 in let t1 = type_exp e1 in
|
{ make_binop_nonbool $1 $3 BOp_div
|
||||||
let e2 = $3 in let t2 = type_exp e2 in
|
"You should know better; division hates booleans" }
|
||||||
if t1 = t2 && t1 <> FTBase TBool
|
|
||||||
then EBinOp (t1, BOp_div, $1, $3)
|
|
||||||
else raise (MyParsingError ("You should know better; division hates \
|
|
||||||
booleans",
|
|
||||||
current_location())) }
|
|
||||||
| expr BO_mod expr
|
| expr BO_mod expr
|
||||||
{ let e1 = $1 in let t1 = type_exp e1 in
|
{ make_binop_nonbool $1 $3 BOp_mod
|
||||||
let e2 = $3 in let t2 = type_exp e2 in
|
"You should know better; modulo hates booleans" }
|
||||||
if t1 = t2 && t1 <> FTBase TBool
|
|
||||||
then EBinOp (t1, BOp_mod, $1, $3)
|
|
||||||
else raise (MyParsingError ("You should know better; modulo hates \
|
|
||||||
booleans",
|
|
||||||
current_location())) }
|
|
||||||
| expr BO_and expr
|
| expr BO_and expr
|
||||||
{ let e1 = $1 in let t1 = type_exp e1 in
|
{ make_binop_bool $1 $3 BOp_and
|
||||||
let e2 = $3 in let t2 = type_exp e2 in
|
"You should know better; conjunction hates numbers" }
|
||||||
if t1 = t2 && t1 = FTBase TBool
|
|
||||||
then EBinOp (t1, BOp_and, $1, $3)
|
|
||||||
else raise (MyParsingError ("You should know better; conjunction \
|
|
||||||
hates numbers",
|
|
||||||
current_location())) }
|
|
||||||
| expr BO_or expr
|
| expr BO_or expr
|
||||||
{ let e1 = $1 in let t1 = type_exp e1 in
|
{ make_binop_bool $1 $3 BOp_or
|
||||||
let e2 = $3 in let t2 = type_exp e2 in
|
"You should know better; disjunction hates numbers" }
|
||||||
if t1 = t2 && t1 = FTBase TBool
|
|
||||||
then EBinOp (t1, BOp_or, $1, $3)
|
|
||||||
else raise (MyParsingError ("You should know better; disjunction \
|
|
||||||
hates numbers",
|
|
||||||
current_location())) }
|
|
||||||
| expr BO_arrow expr
|
| expr BO_arrow expr
|
||||||
{ let e1 = $1 in let t1 = type_exp e1 in
|
{ let e1 = $1 in let t1 = type_exp e1 in
|
||||||
let e2 = $3 in let t2 = type_exp e2 in
|
let e2 = $3 in let t2 = type_exp e2 in
|
||||||
@ -302,72 +304,30 @@ expr:
|
|||||||
/* Binary operators, syntactic sugar */
|
/* Binary operators, syntactic sugar */
|
||||||
| expr BO_fby expr
|
| expr BO_fby expr
|
||||||
{ (* e fby e' ==> e -> (pre e') *)
|
{ (* e fby e' ==> e -> (pre e') *)
|
||||||
let e = $1 in let e' = $3 in
|
let e1 = $1 in let t1 = type_exp e1 in
|
||||||
let te = type_exp e in
|
let e2 = $3 in let t2 = type_exp e2 in
|
||||||
if te = type_exp e'
|
if t1 = t2
|
||||||
then EBinOp (te, BOp_arrow, e, (EMonOp (te, MOp_pre, e')))
|
then EBinOp (t1, BOp_arrow, e1, (EMonOp (t1, MOp_pre, e2)))
|
||||||
else raise (MyParsingError ("The fby does not type-check!",
|
else raise (MyParsingError ("The fby does not type-check!",
|
||||||
current_location())) }
|
current_location())) }
|
||||||
/* Comparison operators */
|
/* Comparison operators */
|
||||||
| expr EQUAL expr
|
| expr EQUAL expr
|
||||||
{ let e1 = $1 in let t1 = type_exp e1 in
|
{ make_comp $1 $3 COp_eq "The equality does not type-check!" }
|
||||||
let e2 = $3 in let t2 = type_exp e2 in
|
|
||||||
if t1 = t2
|
|
||||||
then EComp (FTBase TBool, COp_eq, $1, $3)
|
|
||||||
else raise (MyParsingError ("The equality does not type-check!",
|
|
||||||
current_location())) }
|
|
||||||
| expr CMP_neq expr
|
| expr CMP_neq expr
|
||||||
{ let e1 = $1 in let t1 = type_exp e1 in
|
{ make_comp $1 $3 COp_neq "The inquality does not type-check!" }
|
||||||
let e2 = $3 in let t2 = type_exp e2 in
|
|
||||||
if t1 = t2
|
|
||||||
then EComp (FTBase TBool, COp_neq, $1, $3)
|
|
||||||
else raise (MyParsingError ("The inequality does not type-check!",
|
|
||||||
current_location())) }
|
|
||||||
| expr CMP_le expr
|
| expr CMP_le expr
|
||||||
{ let e1 = $1 in let t1 = type_exp e1 in
|
{ make_comp_nonbool $1 $3 COp_le "The comparison <= does not type-check!" }
|
||||||
let e2 = $3 in let t2 = type_exp e2 in
|
|
||||||
if t1 = t2 && t1 <> FTBase TBool
|
|
||||||
then EComp (FTBase TBool, COp_le, $1, $3)
|
|
||||||
else raise (MyParsingError ("The comparison does not type-check!",
|
|
||||||
current_location())) }
|
|
||||||
| expr CMP_lt expr
|
| expr CMP_lt expr
|
||||||
{ let e1 = $1 in let t1 = type_exp e1 in
|
{ make_comp_nonbool $1 $3 COp_lt "The comparison < does not type-check!" }
|
||||||
let e2 = $3 in let t2 = type_exp e2 in
|
|
||||||
if t1 = t2 && t1 <> FTBase TBool
|
|
||||||
then EComp (FTBase TBool, COp_lt, $1, $3)
|
|
||||||
else raise (MyParsingError ("The comparison does not type-check!",
|
|
||||||
current_location())) }
|
|
||||||
| expr CMP_ge expr
|
| expr CMP_ge expr
|
||||||
{ let e1 = $1 in let t1 = type_exp e1 in
|
{ make_comp_nonbool $1 $3 COp_ge "The comparison >= does not type-check!" }
|
||||||
let e2 = $3 in let t2 = type_exp e2 in
|
|
||||||
if t1 = t2 && t1 <> FTBase TBool
|
|
||||||
then EComp (FTBase TBool, COp_ge, $1, $3)
|
|
||||||
else raise (MyParsingError ("The comparison does not type-check!",
|
|
||||||
current_location())) }
|
|
||||||
| expr CMP_gt expr
|
| expr CMP_gt expr
|
||||||
{ let e1 = $1 in let t1 = type_exp e1 in
|
{ make_comp_nonbool $1 $3 COp_gt "The comparison > does not type-check!" }
|
||||||
let e2 = $3 in let t2 = type_exp e2 in
|
|
||||||
if t1 = t2 && t1 <> FTBase TBool
|
|
||||||
then EComp (FTBase TBool, COp_gt, $1, $3)
|
|
||||||
else raise (MyParsingError ("The comparison does not type-check!",
|
|
||||||
current_location())) }
|
|
||||||
/* Tertiary operators */
|
/* Tertiary operators */
|
||||||
| IF expr THEN expr ELSE expr
|
| IF expr THEN expr ELSE expr
|
||||||
{ let e1 = $2 in let t1 = type_exp e1 in
|
{ make_tertiary $2 $4 $6 TOp_if "The if-then-else does not type-check!" }
|
||||||
let e2 = $4 in let t2 = type_exp e2 in
|
|
||||||
let e3 = $6 in let t3 = type_exp e3 in
|
|
||||||
if t2 = t3 && t1 = FTBase TBool
|
|
||||||
then ETriOp (t2, TOp_if, e1, e2, e3)
|
|
||||||
else raise (MyParsingError ("The if-then-else does not type-check!",
|
|
||||||
current_location())) }
|
|
||||||
| TO_merge expr expr expr
|
| TO_merge expr expr expr
|
||||||
{ let e1 = $2 in let t1 = type_exp e1 in
|
{ make_tertiary $2 $3 $4 TOp_merge "The merge does not type-check!" }
|
||||||
let e2 = $3 in let t2 = type_exp e2 in
|
|
||||||
let e3 = $4 in let t3 = type_exp e3 in
|
|
||||||
if t2 = t3 && t1 = FTBase TBool
|
|
||||||
then ETriOp (t2, TOp_merge, e1, e2, e3)
|
|
||||||
else raise (MyParsingError ("The if-then-else does not type-check!",
|
|
||||||
current_location())) }
|
|
||||||
/* When is neither a binop (a * 'a -> 'a) or a comp ('a * 'a -> bool) */
|
/* When is neither a binop (a * 'a -> 'a) or a comp ('a * 'a -> bool) */
|
||||||
| expr WHEN expr
|
| expr WHEN expr
|
||||||
{ let e1 = $1 in let t1 = type_exp e1 in
|
{ let e1 = $1 in let t1 = type_exp e1 in
|
||||||
|
@ -33,13 +33,6 @@ let pp_expression =
|
|||||||
| _ -> raise (MyTypeError "This exception should not have been raised.")
|
| _ -> raise (MyTypeError "This exception should not have been raised.")
|
||||||
in
|
in
|
||||||
match expression with
|
match expression with
|
||||||
| EFby (_, e1, e2) ->
|
|
||||||
begin
|
|
||||||
Format.fprintf fmt "\t\t\t%sFBY\n%a\t\t\tFBY\n%a"
|
|
||||||
prefix
|
|
||||||
(pp_expression_aux (upd_prefix prefix)) e1
|
|
||||||
(pp_expression_aux (upd_prefix prefix)) e2
|
|
||||||
end
|
|
||||||
| EWhen (_, e1, e2) ->
|
| EWhen (_, e1, e2) ->
|
||||||
begin
|
begin
|
||||||
Format.fprintf fmt "\t\t\t%sWHEN\n%a\t\t\tWHEN\n%a"
|
Format.fprintf fmt "\t\t\t%sWHEN\n%a\t\t\tWHEN\n%a"
|
||||||
|
Loading…
Reference in New Issue
Block a user