Benjamin_Loison/Synchronous_reactive_systems
1
0
Fork 0
Code Issues 7 Pull Requests Packages Projects Releases Wiki Activity

Compare commits

base: Benjamin_Loison:53e356ff55f4efa9c7a69a766c063fdaa8eb7797
Branches Tags
Benjamin_Loison:master
Benjamin_Loison:ast2C_proposition
..
compare: Benjamin_Loison:e9dd3fbde4aca1101904e479fc1e62785f782bf3
Branches Tags
Benjamin_Loison:master
Benjamin_Loison:ast2C_proposition

No commits in common. "53e356ff55f4efa9c7a69a766c063fdaa8eb7797" and "e9dd3fbde4aca1101904e479fc1e62785f782bf3" have entirely different histories.
53e356ff55 ... e9dd3fbde4

5 changed files with 39 additions and 190 deletions
Show Stats Expand all files Collapse all files

2
src/lexer.mll
View File

@ -29,10 +29,10 @@
("else", ELSE); ("else", ELSE);
("merge", TO_merge); ("merge", TO_merge);
("when", WHEN); ("when", WHEN);
("fby", FBY);
("pre", MO_pre); ("pre", MO_pre);
("true", CONST_BOOL(true)); ("true", CONST_BOOL(true));
("false", CONST_BOOL(false)); ("false", CONST_BOOL(false));
("fby", BO_fby);
]; ];
fun s -> fun s ->
try Hashtbl.find h s with Not_found -> IDENT s try Hashtbl.find h s with Not_found -> IDENT s

11
src/main.ml
View File

@ -70,15 +70,8 @@ let _ =
let res = Parser.main Lexer.token (Lexing.from_channel inchan) in let res = Parser.main Lexer.token (Lexing.from_channel inchan) in
close_in inchan; res close_in inchan; res
end end
with with Lexer.Lexing_error s ->
| Lexer.Lexing_error s -> exit_error (Format.sprintf "Code d'erreur:\n\t%s\n\n" s); exit 0 in
(exit_error (Format.sprintf "Code d'erreur:\n\t%s\n\n" s); exit 0)
| Utils.MyParsingError (s, l) ->
begin
Format.printf "Syntax error at %a: %s\n\n"
Pp.pp_loc l s;
exit 0
end in
if !ppast then Format.printf "%a" Pp.pp_ast ast if !ppast then Format.printf "%a" Pp.pp_ast ast
else else

212
src/parser.mly
View File

@ -1,6 +1,6 @@
%{ %{
open Ast open Ast
open Utils exception MyParsingError of string
let current_location () = symbol_start_pos (), symbol_end_pos () let current_location () = symbol_start_pos (), symbol_end_pos ()
@ -12,14 +12,14 @@
match Hashtbl.find_opt defined_nodes n with match Hashtbl.find_opt defined_nodes n with
| None -> | None ->
raise (MyParsingError raise (MyParsingError
("The node "^n^" does not exist.", current_location())) ("The node "^n^" does not exist."))
| Some node -> node | Some node -> node
let fetch_var (n: ident) : t_var = let fetch_var (n: ident) : t_var =
match Hashtbl.find_opt defined_vars n with match Hashtbl.find_opt defined_vars n with
| None -> | None ->
raise (MyParsingError raise (MyParsingError
("The var "^n^" does not exist.", current_location())) ("The var "^n^" does not exist."))
| Some var -> var | Some var -> var
let type_var (v: t_var) = let type_var (v: t_var) =
@ -35,6 +35,7 @@
| ETriOp (full_ty , _ , _ , _ , _) -> full_ty | ETriOp (full_ty , _ , _ , _ , _) -> full_ty
| EComp (full_ty , _ , _ , _) -> full_ty | EComp (full_ty , _ , _ , _) -> full_ty
| EWhen (full_ty , _ , _) -> full_ty | EWhen (full_ty , _ , _) -> full_ty
| EFby (full_ty , _ , _) -> full_ty
| EConst (full_ty , _) -> full_ty | EConst (full_ty , _) -> full_ty
| ETuple (full_ty , _) -> full_ty | ETuple (full_ty , _) -> full_ty
| EApp (full_ty , _ , _) -> full_ty | EApp (full_ty , _ , _) -> full_ty
@ -44,8 +45,7 @@
match t1, t2 with match t1, t2 with
| FTList lt1, FTList lt2 -> (FTList (lt1 @ lt2), e1@e2) | FTList lt1, FTList lt2 -> (FTList (lt1 @ lt2), e1@e2)
| _ -> | _ ->
raise (MyParsingError ("This exception should not have been raised.", raise (MyParsingError "This exception should not have been raised."))
current_location())))
let make_ident (v : t_var) : t_varlist = let make_ident (v : t_var) : t_varlist =
match v with match v with
@ -58,8 +58,7 @@
| IVar _, (FTList tl, l) -> (FTList (FTBase TInt :: tl), v :: l) | IVar _, (FTList tl, l) -> (FTList (FTBase TInt :: tl), v :: l)
| BVar _, (FTList tl, l) -> (FTList (FTBase TBool :: tl), v :: l) | BVar _, (FTList tl, l) -> (FTList (FTBase TBool :: tl), v :: l)
| 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()))
%} %}
%token EOF %token EOF
@ -89,7 +88,6 @@
%token BO_div %token BO_div
%token BO_mod %token BO_mod
%token BO_arrow %token BO_arrow
%token BO_fby
%token CMP_le %token CMP_le
%token CMP_lt %token CMP_lt
%token CMP_ge %token CMP_ge
@ -98,6 +96,7 @@
%token TO_merge %token TO_merge
%token WHEN %token WHEN
%token FBY
%token IF %token IF
%token THEN %token THEN
@ -168,7 +167,7 @@ param:
( (
(FTList (FTList
(List.map (List.map
(fun t -> FTBase t) (list_repeat (List.length idents) typ)), (fun t -> FTBase t) (Utils.list_repeat (List.length idents) typ)),
match typ with match typ with
| TBool -> | TBool ->
List.map (fun s -> Hashtbl.add defined_vars s (BVar s); BVar s) idents List.map (fun s -> Hashtbl.add defined_vars s (BVar s); BVar s) idents
@ -194,8 +193,7 @@ equation:
let expr = $3 in let expr = $3 in
if type_exp expr = t_patt if type_exp expr = t_patt
then ((t_patt, patt), expr) then ((t_patt, patt), expr)
else raise (MyParsingError ("The equation does not type check!", else raise (MyParsingError "The equation does not type check!") };
current_location())) };
pattern: pattern:
| IDENT | IDENT
@ -213,169 +211,32 @@ expr:
| LPAREN expr RPAREN { $2 } | LPAREN expr RPAREN { $2 }
| 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 { EMonOp (type_exp $2, MOp_not, $2) }
{ let t = type_exp $2 in
if t = FTBase TBool
then EMonOp (t, 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 { EMonOp (type_exp $2, MOp_minus, $2) }
{ let t = type_exp $2 in | PLUS expr { $2 }
if t = FTBase TBool
then raise (MyParsingError ("You cannot take the opposite of a \
boolean expression.",
current_location()))
else EMonOp (t, MOp_minus, $2) }
| PLUS expr
{ let t = type_exp $2 in
if t = FTBase TBool
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 { EBinOp (type_exp $1, BOp_add, $1, $3) }
{ let e1 = $1 in let t1 = type_exp e1 in | expr MINUS expr { EBinOp (type_exp $1, BOp_sub, $1, $3) }
let e2 = $3 in let t2 = type_exp e2 in | expr BO_mul expr { EBinOp (type_exp $1, BOp_mul, $1, $3) }
if t1 = t2 && t1 <> FTBase TBool | expr BO_div expr { EBinOp (type_exp $1, BOp_div, $1, $3) }
then EBinOp (t1, BOp_add, $1, $3) | expr BO_mod expr { EBinOp (type_exp $1, BOp_mod, $1, $3) }
else raise (MyParsingError ("You should know better; addition hates \ | expr BO_and expr { EBinOp (type_exp $1, BOp_and, $1, $3) }
booleans", | expr BO_or expr { EBinOp (type_exp $1, BOp_or, $1, $3) }
current_location())) } | expr BO_arrow expr { EBinOp (type_exp $1, BOp_arrow, $1, $3) }
| expr MINUS expr
{ let e1 = $1 in let t1 = type_exp e1 in
let e2 = $3 in let t2 = type_exp e2 in
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
{ let e1 = $1 in let t1 = type_exp e1 in
let e2 = $3 in let t2 = type_exp e2 in
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
{ let e1 = $1 in let t1 = type_exp e1 in
let e2 = $3 in let t2 = type_exp e2 in
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
{ let e1 = $1 in let t1 = type_exp e1 in
let e2 = $3 in let t2 = type_exp e2 in
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
{ let e1 = $1 in let t1 = type_exp e1 in
let e2 = $3 in let t2 = type_exp e2 in
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
{ let e1 = $1 in let t1 = type_exp e1 in
let e2 = $3 in let t2 = type_exp e2 in
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
{ let e1 = $1 in let t1 = type_exp e1 in
let e2 = $3 in let t2 = type_exp e2 in
if t1 = t2
then EBinOp (type_exp $1, BOp_arrow, $1, $3)
else raise (MyParsingError ("The -> does not type-check",
current_location())) }
/* Binary operators, syntactic sugar */
| expr BO_fby expr
{ (* e fby e' ==> e -> (pre e') *)
let e = $1 in let e' = $3 in
let te = type_exp e in
if te = type_exp e'
then EBinOp (te, BOp_arrow, e, (EMonOp (te, MOp_pre, e')))
else raise (MyParsingError ("The fby does not type-check!",
current_location())) }
/* Comparison operators */ /* Comparison operators */
| expr EQUAL expr | expr EQUAL expr { EComp (FTBase TBool, COp_eq, $1, $3) }
{ let e1 = $1 in let t1 = type_exp e1 in | expr CMP_neq expr { EComp (FTBase TBool, COp_neq, $1, $3) }
let e2 = $3 in let t2 = type_exp e2 in | expr CMP_le expr { EComp (FTBase TBool, COp_le, $1, $3) }
if t1 = t2 | expr CMP_lt expr { EComp (FTBase TBool, COp_lt, $1, $3) }
then EComp (FTBase TBool, COp_eq, $1, $3) | expr CMP_ge expr { EComp (FTBase TBool, COp_ge, $1, $3) }
else raise (MyParsingError ("The equality does not type-check!", | expr CMP_gt expr { EComp (FTBase TBool, COp_gt, $1, $3) }
current_location())) }
| expr CMP_neq expr
{ let e1 = $1 in let t1 = type_exp e1 in
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
{ let e1 = $1 in let t1 = type_exp e1 in
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
{ let e1 = $1 in let t1 = type_exp e1 in
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
{ let e1 = $1 in let t1 = type_exp e1 in
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
{ let e1 = $1 in let t1 = type_exp e1 in
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 { ETriOp (type_exp $4, TOp_if, $2, $4, $6) }
{ let e1 = $2 in let t1 = type_exp e1 in | TO_merge expr expr expr { ETriOp (type_exp $4, TOp_merge, $2, $3, $4) }
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
{ let e1 = $2 in let t1 = type_exp e1 in
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 { EWhen (type_exp $1, $1, $3) }
{ let e1 = $1 in let t1 = type_exp e1 in | expr FBY expr { EFby (type_exp $1, $1, $3) }
let e2 = $3 in let t2 = type_exp e2 in
if t2 = FTBase TBool
then EWhen (type_exp $1, $1, $3)
else raise (MyParsingError ("The when does not type-check!",
current_location())) }
/* Constants */ /* Constants */
| CONST_INT { EConst (FTBase TInt, CInt $1) } | CONST_INT { EConst (FTBase TInt, CInt $1) }
| CONST_BOOL { EConst (FTBase TBool, CBool $1) } | CONST_BOOL { EConst (FTBase TBool, CBool $1) }
@ -391,11 +252,8 @@ expr:
| FTArr (tin, t) -> | FTArr (tin, t) ->
if tin = type_exp args if tin = type_exp args
then EApp (t, fetch_node name, args) then EApp (t, fetch_node name, args)
else raise (MyParsingError ("The application does not type check!", else raise (MyParsingError "The application does not type check!")
current_location())) | _ -> raise (MyParsingError "This exception should not have been raised from the dead.")
| _ -> raise (MyParsingError ("This exception should not have been \
raised from the dead.",
current_location()))
} }
; ;
@ -411,9 +269,8 @@ expr_comma_list:
match e, le with match e, le with
| ETuple (FTList l1, t), ETuple (FTList l2, t') -> ETuple (FTList (l1@l2), t @ t') | ETuple (FTList l1, t), ETuple (FTList l2, t') -> ETuple (FTList (l1@l2), t @ t')
| _, ETuple (FTList lt, t') -> ETuple (FTList ((type_exp e)::lt), e :: t') | _, ETuple (FTList lt, t') -> ETuple (FTList ((type_exp e)::lt), e :: t')
| _, _ -> raise (MyParsingError ("This exception should not have been \ | _, _ -> raise (MyParsingError "This exception should not have been \
raised.", raised.") }
current_location())) }
; ;
ident_comma_list: ident_comma_list:
@ -421,4 +278,3 @@ ident_comma_list:
| IDENT COMMA ident_comma_list { $1 :: $3 } | IDENT COMMA ident_comma_list { $1 :: $3 }
; ;

2
src/test.node
View File

@ -1,5 +1,7 @@
node diagonal_int (i: int) returns (o1, o2 : int); node diagonal_int (i: int) returns (o1, o2 : int);
let let
o1 = if true then i else 0;
o2 = i;
(o1, o2) = (i, i); (o1, o2) = (i, i);
tel tel

2
src/utils.ml
View File

@ -1,4 +1,2 @@
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)
exception MyParsingError of (string * Ast.location)