[parser] adding support for expressions

TODO

@@ -0,0 +1,8 @@
+# Parseur
+
+ - tests divers et variés
+ - support pour un point-virgule optionel en fin de nœud
+ - ajout des flottants (= réels)
+ - ajout de pre, ->, fby, automates
+
+# ...

src/.gitignore

@@ -0,0 +1 @@
+_build

src/ast.ml

@@ -2,12 +2,40 @@ type ident = string
 
 type location = Lexing.position * Lexing.position
 
+type const =
+  | CBool of bool
+  | CInt of int
+
+type monop =
+  | MOp_not
+  | MOp_minus
+
+type binop =
+  | BOp_add | BOp_sub | BOp_mul | BOp_div | BOp_mod
+  | BOp_and | BOp_or | BOp_eq | BOp_neq
+  | BOp_le | BOp_lt | BOp_ge | BOp_gt
+
+type triop =
+  | TOp_if
+
 type base_ty =
   | Tbool
   | Tint
 
-type p_pattern = string
-and p_expression = string
+type p_pattern =
+  | PP_var of ident
+  | PP_tuple of ident list
+
+type p_expression =
+  | PE_Const of const
+  | PE_Var of ident
+  | PE_MonOp of monop * p_expression
+  | PE_BinOp of binop * p_expression * p_expression
+  | PE_TriOp of triop * p_expression * p_expression * p_expression
+  | PE_app of ident * p_expression list
+  | PE_tuple of p_expression list
+  | PE_pre of p_expression
+  | PE_arrow of p_expression * p_expression
 
 type p_equation =
   { peq_patt: p_pattern;

src/lexer.mll

@@ -15,6 +15,24 @@
       ("var", VAR);
       ("int", INT);
       ("bool", BOOL);
+      ("<=", BO_le);
+      (">=", BO_ge);
+      ("not", MO_not);
+      ("mod", BO_mod);
+      ("&&", BO_and);
+      ("and", BO_and);
+      ("||", BO_or);
+      ("or", BO_or);
+      ("<>", BO_neq);
+      ("if", IF);
+      ("then", THEN);
+      ("else", ELSE);
+      ("≤", BO_le);
+      ("≥", BO_ge );
+      ("¬", MO_not);
+      ("pre", PRE);
+      ("true", CONST_BOOL(true));
+      ("false", CONST_BOOL(false));
       ];
     fun s ->
       try Hashtbl.find h s with Not_found -> IDENT s
@@ -27,12 +45,21 @@ let ident = alpha (alpha | digit | '_')*
 rule token = parse
     ['\n' ' ' '\t'] { token lexbuf }     (* skip blanks and newlines *)
   | ident           { id_or_keywork (lexeme lexbuf) }
+  | digit+          { CONST_INT(int_of_string (lexeme lexbuf)) }
   | ','             { COMMA }
   | '='             { EQUAL }
   | '('             { LPAREN }
   | ')'             { RPAREN }
   | ';'             { SEMICOL }
   | ':'             { COLON }
+  | '<'             { BO_lt }
+  | '>'             { BO_gt }
+  | '+'             { PLUS }
+  | '-'             { MINUS }
+  | '*'             { BO_mul }
+  | '/'             { BO_div }
+  | '%'             { BO_mod }
+  | "->"            { ARROW }
   | eof             { EOF }
   | _               { raise (Lexing_error (Format.sprintf "Erruer à la vue de %s" (lexeme lexbuf)))}
 

src/parser.mly

@@ -17,6 +17,30 @@
 %token VAR
 %token EQUAL
 %token COMMA
+%token PRE
+%token ARROW
+
+%token MO_not
+%token BO_le
+%token BO_lt
+%token BO_ge
+%token BO_gt
+%token BO_mod
+%token BO_and
+%token BO_or
+%token BO_mul
+%token BO_neq
+%token BO_div
+
+%token PLUS
+%token MINUS
+
+%token IF
+%token THEN
+%token ELSE
+
+%token<int> CONST_INT
+%token<bool> CONST_BOOL
 
 /* The Entry Point */
 %start main
@@ -80,8 +104,46 @@ equation:
     { { peq_patt = $1; peq_expr = $3; } }
 ;
 
-pattern: IDENT { $1 };
-expr: IDENT { $1 };
+pattern:
+  | IDENT                           { PP_var ($1) }
+  | LPAREN IDENT COMMA indent_comma_list RPAREN { PP_tuple ($2 :: $4) };
+
+indent_comma_list:
+  | IDENT { [$1] }
+  | IDENT COMMA indent_comma_list { $1 :: $3 }
+
+expr:
+  /* Note: PLUS, MINUS and EQUAL do not follow the nomenclature BO_ MO_, ... */
+  | LPAREN expr RPAREN                 { $2 }
+  | IDENT                              { PE_Var $1 }
+  | MO_not expr                        { PE_MonOp(MOp_not, $2) }
+  | PLUS expr                          { $2 } /* +e = e for all e integer expression. */
+  | MINUS expr                         { PE_MonOp(MOp_minus, $2) }
+  | expr PLUS expr                     { PE_BinOp(BOp_add, $1, $3) }
+  | expr MINUS expr                    { PE_BinOp(BOp_sub, $1, $3) }
+  | expr BO_mul expr                   { PE_BinOp(BOp_mul, $1, $3) }
+  | expr BO_div expr                   { PE_BinOp(BOp_div, $1, $3) }
+  | expr BO_mod expr                   { PE_BinOp(BOp_mod, $1, $3) }
+  | expr BO_and expr                   { PE_BinOp(BOp_and, $1, $3) }
+  | expr BO_or expr                    { PE_BinOp(BOp_or, $1, $3) }
+  | expr EQUAL expr                    { PE_BinOp(BOp_eq, $1, $3) }
+  | expr BO_neq expr                   { PE_BinOp(BOp_neq, $1, $3) }
+  | expr BO_le expr                    { PE_BinOp(BOp_le, $1, $3) }
+  | expr BO_lt expr                    { PE_BinOp(BOp_lt, $1, $3) }
+  | expr BO_ge expr                    { PE_BinOp(BOp_ge, $1, $3) }
+  | expr BO_gt expr                    { PE_BinOp(BOp_gt, $1, $3) }
+  | IF expr THEN expr ELSE expr        { PE_TriOp(TOp_if, $2, $4, $6) }
+  | IDENT LPAREN expr_comma_list RPAREN{ PE_app ($1, $3) }
+  | LPAREN expr_comma_list RPAREN      { PE_tuple($2) }
+  | CONST_INT                          { PE_Const(CInt $1 ) }
+  | CONST_BOOL                         { PE_Const(CBool $1 ) }
+  | PRE expr                           { PE_pre $2 }
+  | expr ARROW expr                    { PE_arrow ($1, $3) }
+;
+
+expr_comma_list:
+  | expr                       { [$1] }
+  | expr COMMA expr_comma_list { $1 :: $3 }
 
 typ:
   | BOOL { Tbool }

src/pp.ml

@@ -8,16 +8,88 @@ let pp_loc fmt (start, stop) =
       stop.pos_lnum stop.pos_cnum)
 
 let pp_pattern fmt pat =
-  Format.fprintf fmt "%s" pat
+  let rec pp_pattern_aux fmt l =
+    match l with
+    | [] -> ()
+    | h :: [] -> Format.fprintf fmt  "%s" h
+    | h :: h' :: l -> Format.fprintf fmt  "%s, %a" h pp_pattern_aux (h' :: l)
+    in
+  match pat with
+  | PP_var v -> Format.fprintf fmt "variable %s" v
+  | PP_tuple l -> Format.fprintf fmt "tuple ( %a )" pp_pattern_aux l
 
-let pp_expression fmt expression =
-  Format.fprintf fmt "%s" expression
+let pp_expression =
+  let upd_prefix s = s ^ "    " in
+  let rec pp_expression_aux prefix fmt expression =
+    let rec pp_expression_list prefix fmt exprs =
+      match exprs with
+      | [] -> ()
+      | expr :: exprs ->
+          Format.fprintf fmt "%a%a"
+            (pp_expression_aux (prefix^" |> ")) expr
+            (pp_expression_list prefix) exprs
+    in
+    match expression with
+    | PE_Const c ->
+        begin match c with
+        | CBool true ->  Format.fprintf fmt "\t\t\t%s<true : bool>\n" prefix
+        | CBool false ->  Format.fprintf fmt "\t\t\t%s<false : bool>\n" prefix
+        | CInt i ->      Format.fprintf fmt "\t\t\t%s<%5d: int>\n" prefix i
+        end
+    | PE_Var v -> Format.fprintf fmt "\t\t\t%s<var %s>\n" prefix v
+    | PE_MonOp (mop, arg) ->
+        begin match mop with
+        | MOp_not ->
+            Format.fprintf fmt "\t\t\t%s¬\n%a" prefix
+              (pp_expression_aux (upd_prefix prefix)) arg
+        | MOp_minus ->
+            Format.fprintf fmt "\t\t\t%s—\n%a" prefix
+              (pp_expression_aux (upd_prefix prefix)) arg
+        end
+    | PE_BinOp (bop, arg, arg') ->
+        begin
+        let s = match bop with
+        | BOp_add -> " + " | BOp_sub -> " - "
+        | BOp_mul -> " ∗ " | BOp_div -> " / " | BOp_mod -> "%  "
+        | BOp_and -> "&& " | BOp_or  -> "|| " | BOp_eq  -> "== "
+        | BOp_neq -> " ≠ "
+        | BOp_le  -> " ≤ " | BOp_lt  -> " < "
+        | BOp_ge  -> " ≥ " | BOp_gt  -> " > " in
+        Format.fprintf fmt "\t\t\t%s%s\n%a%a" prefix s 
+          (pp_expression_aux (upd_prefix prefix)) arg
+          (pp_expression_aux (upd_prefix prefix)) arg'
+        end
+    | PE_TriOp (top, arg, arg', arg'') ->
+        begin match top with
+        | TOp_if ->
+            Format.fprintf fmt "\t\t\t%sIF\n%a\t\t\tTHEN\n%a\t\t\tELSE\n%a"
+              prefix
+              (pp_expression_aux (upd_prefix prefix)) arg
+              (pp_expression_aux (upd_prefix prefix)) arg'
+              (pp_expression_aux (upd_prefix prefix)) arg''
+        end
+    | PE_app (f, args)  ->
+        Format.fprintf fmt "\t\t\t%sApp %s\n%a"
+          prefix f
+          (pp_expression_list prefix) args
+    | PE_tuple args ->
+        Format.fprintf fmt "\t\t\t%sTuple\n%a" prefix
+          (pp_expression_list prefix) args;
+    | PE_pre expr ->
+        Format.fprintf fmt "\t\t\t%spre\n%a" prefix
+          (pp_expression_aux (upd_prefix prefix)) expr
+    | PE_arrow (expr, expr') ->
+        Format.fprintf fmt "%a%a"
+          (pp_expression_aux (upd_prefix prefix)) expr
+          (pp_expression_aux (prefix^" -> ")) expr'
+    in
+  pp_expression_aux ""
 
 let rec pp_equations fmt eqs =
   match eqs with
   | [] -> ()
   | eq :: eqs ->
-      Format.fprintf fmt "\t\tPattern: %a\n\t\tExpression: %a\n%a"
+      Format.fprintf fmt "\t\t∗ left side: %a\n\t\t  right side:\n%a\n%a"
         pp_pattern eq.peq_patt
         pp_expression eq.peq_expr
         pp_equations eqs
@@ -26,7 +98,7 @@ let rec pp_node_vars fmt vars =
   match vars with
   | [] -> ()
   | (v, t) :: vars ->
-      Format.fprintf fmt "\t\tVariable name: %s\n\t\tVariable type: %s\n%a"
+      Format.fprintf fmt "\t\tVariable <name: %10s,\ttype: %s>\n%a"
         v
         (match t with
         | Tbool -> "bool"
@@ -34,8 +106,8 @@ let rec pp_node_vars fmt vars =
         pp_node_vars vars
 
 let pp_node fmt node =
-  Format.fprintf fmt "\tNomdu nœud : %s\n\tInputs:\n%a\n\tOutputs:\n%a\n\t\
-    Local variables:\n%a\n\tEquations:\n%a\n\tLocation in the parsed file: %a\n"
+  Format.fprintf fmt "\t∗ Nom du nœud : %s\n\t  Inputs:\n%a\n\t  Outputs:\n%a\n\t\
+    \ \ Local variables:\n%a\n\t  Equations:\n%a\n\t  Location in the parsed file: %a\n"
                  node.pn_name
     pp_node_vars node.pn_input
     pp_node_vars node.pn_output

src/test.node

@@ -1,7 +1,14 @@
-node slfjsdfj (i1: bool; i2, i3: int) returns (o, o_ : int);
-var l1, l3: bool; l2: int;
+node diagonal_int (i: int) returns (o1, o2 : int);
 let
-	pat1 = expr1;
-	pat2 = expr2;
-	pat3 = expr3;
+	o1 = if true then i else 0;
+	o2 = i;
+	(o1, o2) = (i, i);
+tel
+
+node undiag_test (i: int) returns (o : bool);
+var l1, l2: int; l3: int;
+let
+	l3 = 1 -> 0;
+	(l1, l2) = diagonal_int(i);
+	o = (not (not (l1 = l2))) and (l1 = l2) and true;
 tel