added automaton to ast

src/ast.ml

@@ -48,16 +48,19 @@ type t_expression =
   | EConst of full_ty * const
   | ETuple of full_ty * (t_expression list)
   | EApp   of full_ty * t_node * t_expression
-  | EAuto  of full_ty * t_state * t_state list (* initial state and transitions *)
 
 and t_varlist = full_ty * (t_var list)
 
-and t_equation = t_varlist * t_expression
+and t_equation = t_varlist * t_expression 
 
 and t_eqlist = t_equation list
 
 and t_state = | State of ident * t_eqlist * t_expression * ident
 
+and t_automaton = t_state * t_state list
+
+and t_autolist = t_automaton list
+
 and t_node =
   {
     n_name : ident;
@@ -65,6 +68,7 @@ and t_node =
     n_outputs: t_varlist;
     n_local_vars: t_varlist;
     n_equations: t_eqlist;
+    n_automata: t_autolist;
     n_inputs_type : full_ty;
     n_outputs_type : full_ty;
   }

src/main.ml

@@ -64,6 +64,7 @@ let _ =
     let inchan = open_in !source_file in
     try
       begin
+        let _ = Parsing.set_trace true in
       let res = Parser.main Lexer.token (Lexing.from_channel inchan) in
       close_in inchan; res
       end

src/parser.mly

@@ -7,7 +7,7 @@
 
   let defined_nodes : (ident, t_node) Hashtbl.t = Hashtbl.create Config.maxvar
 
-  let defined_vars : (ident, t_var * bool) Hashtbl.t = Hashtbl.create Config.maxvar
+  let defined_vars : (ident, t_var) Hashtbl.t = Hashtbl.create Config.maxvar
 
   let fetch_node (n: ident) =
     match Hashtbl.find_opt defined_nodes n with
@@ -21,8 +21,9 @@
     | None ->
         raise (MyParsingError
                 ("The var "^n^" does not exist.", current_location()))
-    | Some (var, _) -> var
+    | Some var -> var
 
+  (*
   let fetch_var_def (n: ident) : t_var =
     match Hashtbl.find_opt defined_vars n with
     | None ->
@@ -34,6 +35,7 @@
                 current_location()))
     | Some (var, false) ->
         (Hashtbl.replace defined_vars n (var, true) ; var)
+    *)
 
   let concat_varlist  (t1, e1) (t2, e2) = (t1 @ t2, e1 @ e2)
 
@@ -179,8 +181,9 @@ node_content:
   IDENT LPAREN in_params RPAREN
   RETURNS LPAREN out_params RPAREN OPTIONAL_SEMICOL
   local_params
-  LET equations TEL OPTIONAL_SEMICOL
+  LET node_body TEL OPTIONAL_SEMICOL
     { let node_name = $1 in
+      let (eqs, aut) = $12 in
       let (t_in, e_in) = $3 in
       let (t_out, e_out) = $7 in
       let n: t_node = 
@@ -188,11 +191,17 @@ node_content:
           n_inputs     = (t_in, e_in);
           n_outputs    = (t_out, e_out);
           n_local_vars = $10;
-          n_equations  = $12;
+          n_equations  = eqs;
+          n_automata = aut;
           n_inputs_type = t_in;
           n_outputs_type = t_out; } in
       Hashtbl.add defined_nodes node_name n; n };
 
+node_body:
+  | /* empty */ { ([], []) }
+  | equations node_body { let (eq, aut) = $2 in ($1@eq, aut) }
+  | automaton node_body { let (eq, aut) = $2 in (eq, $1::aut) }
+
 OPTIONAL_SEMICOL:
   | /* empty */ {}
   | SEMICOL {}
@@ -227,13 +236,13 @@ param:
       match typ with
       | TBool ->
         List.map (fun s ->
-          Hashtbl.add defined_vars s (BVar s, false); BVar s) idents
+          Hashtbl.add defined_vars s (BVar s); BVar s) idents
       | TReal ->
         List.map (fun s ->
-          Hashtbl.add defined_vars s (RVar s, false); RVar s) idents
+          Hashtbl.add defined_vars s (RVar s); RVar s) idents
       | TInt  ->
         List.map (fun s ->
-          Hashtbl.add defined_vars s (IVar s, false); IVar s) idents) }
+          Hashtbl.add defined_vars s (IVar s); IVar s) idents) }
 ;
 
 ident_comma_list:
@@ -247,22 +256,25 @@ equations:
 ;
 
 equation:
-  pattern EQUAL expr
+  | pattern EQUAL expr
     { let (t_patt, patt) = $1 in
       let expr = $3 in let texpr = type_exp expr in
       if t_patt = texpr
         then ((t_patt, patt), expr)
         else (raise (MyParsingError ("The equation does not type check!",
                     current_location()))) };
+automaton:
+  | AUTOMAT transition_list { (List.hd $2, $2)}
+;
 
 pattern:
   | IDENT
-    { let v = fetch_var_def $1 in (type_var v, [v]) }
+    { let v = fetch_var $1 in (type_var v, [v]) }
   | LPAREN ident_comma_list_patt RPAREN { $2 };
 
 ident_comma_list_patt:
-  | IDENT { make_ident (fetch_var_def $1) }
-  | IDENT COMMA ident_comma_list_patt { add_ident (fetch_var_def $1) $3 }
+  | IDENT { make_ident (fetch_var $1) }
+  | IDENT COMMA ident_comma_list_patt { add_ident (fetch_var $1) $3 }
 
 expr:
   /* Note: EQUAL does not follow the nomenclature CMP_, ... */
@@ -368,6 +380,8 @@ expr:
           else raise (MyParsingError ("The application does not type check!",
                       current_location()))
          }
+
+  /* Automaton */
 ;
 
 expr_comma_list:
@@ -392,10 +406,6 @@ ident_comma_list:
   | IDENT COMMA ident_comma_list { $1 :: $3 }
 ;
 
-automaton:
-  AUTOMAT transition_list { bloop(); EAuto( [], List.hd $2, $2 ) }
-;
-
 transition:
   | CASE IDENT BO_arrow DO equations DONE { 
       State($2, $5, EConst([TBool], CBool(true)), $2) }
@@ -406,4 +416,5 @@ transition:
 transition_list:
   | transition { [$1] }
   | transition transition_list { $1 :: $2 }
+  | /* empty */ {raise(MyParsingError("Empty automaton", current_location()))}
 ;

src/passes.ml

@@ -19,6 +19,7 @@ let equation_pass f ast: t_nodelist option =
                         n_outputs      = node.n_outputs;
                         n_local_vars   = node.n_local_vars;
                         n_equations    = eqs;
+                        n_automata     = node.n_automata;
                         n_inputs_type  = node.n_inputs_type;
                         n_outputs_type = node.n_outputs_type;
                        }

src/pp.ml

@@ -51,28 +51,6 @@ let pp_expression =
             (pp_expression_list prefix) (ETuple (tt, exprs))
       | _ -> raise (MyTypeError "This exception should not have been raised.")
     in
-    let rec pp_equations prefix fmt equations = 
-      match equations with
-        | [] -> ()
-        | (patt, expr) :: eqs ->
-            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_expression_aux prefix) expr
-              (pp_equations prefix) eqs
-    in
-    let rec pp_state_list prefix fmt states = 
-      match states with
-      | [] -> ()
-      | State(name, actions, condition, next)::q ->
-          Format.fprintf fmt "%s|%s->DO\n%a%sUNTIL\n%aTHEN%s"
-            prefix
-            name
-            (pp_equations prefix) actions
-            prefix
-            (pp_expression_aux (upd_prefix prefix)) condition
-            next
-    in
     match expression with
     | EWhen (_, e1, e2) ->
         begin
@@ -152,9 +130,6 @@ let pp_expression =
     | ETuple _ ->
         Format.fprintf fmt "\t\t\t%sTuple\n%a" prefix
           (pp_expression_list prefix) expression
-    | EAuto (_, _, states) ->
-        Format.fprintf fmt "\t\t\t%sAutomaton\n%a" prefix 
-          (pp_state_list prefix) states;
     in
   pp_expression_aux ""
 

src/test.node

@@ -11,3 +11,10 @@ let
 	o = (not (not (l1 = l2))) and (l1 = l2) and true;
 tel
 
+node auto (i: int) returns (o : int);
+let
+	automaton
+	| Incr -> do o = (pre o) + 1; done
+	| Decr -> do o = (pre o) - 1; done
+tel
+