From f808eeaf3016f828d71b0f87afb89bb79a869035 Mon Sep 17 00:00:00 2001
From: Alex Auvolat <alex.auvolat@ansys.com>
Date: Thu, 3 Jul 2014 17:52:37 +0200
Subject: Changes to parser ; EDD optimisations ; test cases.

---
 frontend/ast_printer.ml | 25 ++++++++++----------
 frontend/parser.mly     | 61 +++++++++++++++----------------------------------
 2 files changed, 32 insertions(+), 54 deletions(-)

(limited to 'frontend')

diff --git a/frontend/ast_printer.ml b/frontend/ast_printer.ml
index 3ca2ff6..8908687 100644
--- a/frontend/ast_printer.ml
+++ b/frontend/ast_printer.ml
@@ -165,12 +165,15 @@ let rec print_expr fmt e =
 
 let indent ind = ind^"  "
 
-let rec print_vars ind fmt = function
-  | [] -> ()
-  | v ->
+let rec print_scope ind fmt = function
+  | [], [a, _] ->
+    print_eqn ind fmt a
+  | [], l -> print_body ind fmt l
+  | v, l ->
     Format.fprintf fmt "%svar" ind;
     List.iter (fun d -> Format.fprintf fmt " %a;" print_var_decl d) v;
     Format.fprintf fmt "@\n";
+    print_body ind fmt l
 
 and print_var_decl fmt (pr, i, ty) =
     Format.fprintf fmt "%s%s: %s"
@@ -182,6 +185,9 @@ and print_body ind fmt body =
   Format.fprintf fmt "%slet@\n%a%stel@\n"
     ind (print_block ind) body ind
 
+and print_block ind fmt b =
+  List.iter (fun (bb,_) -> print_eqn (indent ind) fmt bb) b
+
 and print_eqn ind fmt = function
   | AST_assign (l,(e,_)) ->
       Format.fprintf fmt "%s%a = %a;@\n" 
@@ -207,8 +213,7 @@ and print_activate_if ind fmt = function
     Format.fprintf fmt "%selse@\n" ind;
     print_activate_if (indent ind) fmt e
   | AST_activate_body(b) ->
-    print_vars ind fmt b.act_locals;
-    print_body ind fmt b.body
+    print_scope ind fmt (b.act_locals, b.body)
 
 and print_automaton ind fmt (n, sts, r) =
   Format.fprintf fmt "%sautomaton %s@\n" ind n;
@@ -218,8 +223,8 @@ and print_automaton ind fmt (n, sts, r) =
 and print_state ind fmt (st, _) =
   Format.fprintf fmt "%s%sstate %s@\n"
     ind (if st.initial then "initial " else "") st.st_name;
-  print_vars ind fmt st.st_locals;
-  print_body ind fmt st.body;
+  let ind = indent ind in
+  print_scope ind fmt (st.st_locals, st.body);
   if st.until <> [] then begin
     Format.fprintf fmt "%suntil@\n" ind;
     List.iter (fun ((e, _),(s, _), reset) -> 
@@ -227,9 +232,6 @@ and print_state ind fmt (st, _) =
       st.until
   end
 
-and print_block ind fmt b =
-  List.iter (fun (bb,_) -> print_eqn (indent ind) fmt bb) b
-
 (* declarations *)
 
 
@@ -238,8 +240,7 @@ and print_node_decl fmt (d : node_decl) =
       d.n_name
       (print_list print_var_decl "; ") d.args
       (print_list print_var_decl "; ") d.ret;
-    print_vars "" fmt d.var;
-    print_body "" fmt d.body
+    print_scope "" fmt (d.var, d.body)
 
 let print_const_decl fmt (d : const_decl) =
     Format.fprintf fmt
diff --git a/frontend/parser.mly b/frontend/parser.mly
index 84dcd15..e8a6ecf 100644
--- a/frontend/parser.mly
+++ b/frontend/parser.mly
@@ -117,27 +117,16 @@ automaton:
 state:
 | i=boption(INITIAL) STATE n=IDENT
   unless=trans(UNLESS)
-  v=option(var_decl)
-  b=body
+  vb=scbody
   until=trans(UNTIL)
 { if unless <> [] then failwith "UNLESS transitions not supported.";
+  let v, b = vb in
   { initial = i;
     st_name = n;
-    st_locals = (match v with Some v -> v | None -> []);
+    st_locals = v;
     body = b;
     until = until;
 } }
-| i=boption(INITIAL) STATE n=IDENT
-  unless=trans(UNLESS)
-  b=ext(eqn) SEMICOLON
-  until=trans(UNTIL)
-{ if unless <> [] then failwith "UNLESS transitions not supported.";
-  { initial = i;
-    st_name = n;
-    st_locals = [];
-    body = [b];
-    until = until;
-} }
 
 trans(TT):
 | TT t=nonempty_list(terminated(transition, SEMICOLON))   { t }
@@ -151,11 +140,12 @@ activate:
 | ACTIVATE a=activate_if RETURNS r=separated_list(COMMA, IDENT)  { (a, r) }
 activate_if:
 | IF c=ext(expr) THEN t=activate_if ELSE e=activate_if           { AST_activate_if(c, t, e) }
-| lv=option(var_decl) b=body
-{ AST_activate_body {
+| kb=scbody
+{ let loc, body = kb in
+  AST_activate_body {
       act_id = "act"^uid();
-      act_locals = (match lv with Some v -> v | None -> []);
-      body = b;
+      act_locals = loc;
+      body = body;
 } }
 
 eqn:
@@ -172,13 +162,13 @@ typ:
 | REAL                                          { AST_TREAL }
 
 (* Declarations *)
-dbody:
-| e=ext(eqn) SEMICOLON                          { [e] }
-| l=body                                        { l }
-
-body:
+scbody:
+| e=ext(eqn) SEMICOLON                          { [], [e] }
 | LET l=nonempty_list(terminated(ext(eqn), SEMICOLON)) TEL
-  { l }
+                                                { [], l}
+| VAR v=nonempty_list(terminated(vari, SEMICOLON))
+  LET l=nonempty_list(terminated(ext(eqn), SEMICOLON)) TEL
+    { List.flatten v, l }
 
 var:
 |   p=boption(PROBE) i=IDENT                    { (p, i) }
@@ -199,32 +189,19 @@ const_decl:
         value = e;
     } }
 
-var_decl:
-| VAR l=nonempty_list(terminated(vari, SEMICOLON))
-    { List.flatten l }
-
 node_kw:
 | NODE     {}
 | FUNCTION {}
 node_decl:
 | node_kw id=IDENT LPAREN v=vars RPAREN
     RETURNS LPAREN rv=vars RPAREN
-    e = dbody
-{ { n_name = id;
-    args = v;
-    ret = rv;
-    var = [];
-    body = e;
-} }
-| node_kw id=IDENT LPAREN v=vars RPAREN
-    RETURNS LPAREN rv=vars RPAREN
-    lv=var_decl
-    b=body
-{ { n_name = id;
+  sc=scbody
+{ let vars, body = sc in
+  { n_name = id;
     args = v;
     ret = rv;
-    var = lv;
-    body = b;
+    var = vars;
+    body = body;
 } }
 
 (* Utility : add extent information *)
-- 
cgit v1.2.3