[ast2C] initialize states of auxiliary nodes.

src/ast_to_c.ml

@@ -1,20 +1,72 @@
 open Ast
+open Cast
 open C_utils
 open Cprint
 open Utils
 
 
 
+(** [ast_to_cast] translates a [t_nodelist] into a [c_nodelist] *)
+let ast_to_cast (nodes: t_nodelist) (h: node_states): c_nodelist =
+  let c = ref 1 in
+  let ast_to_cast_varlist vl = snd vl in
+  let rec ast_to_cast_expr hloc = function
+    | EVar   (_, v) ->
+        begin
+        match Hashtbl.find_opt hloc (v, false) with
+        | None -> CVar (CVInput (name_of_var v))
+        | Some (s, i) -> CVar (CVStored (s, i))
+        end
+    | EMonOp (_, op, e) -> CMonOp (op, ast_to_cast_expr hloc e)
+    | EBinOp (_, op, e, e') ->
+       CBinOp (op, ast_to_cast_expr hloc e, ast_to_cast_expr hloc e')
+    | ETriOp (_, op, e, e', e'') ->
+        CTriOp
+          (op, ast_to_cast_expr hloc e, ast_to_cast_expr hloc e', ast_to_cast_expr hloc e'')
+    | EComp  (_, op, e, e') ->
+        CComp (op, ast_to_cast_expr hloc e, ast_to_cast_expr hloc e')
+    | EWhen  (_, e, e') ->
+        CWhen (ast_to_cast_expr hloc e, ast_to_cast_expr hloc e')
+    | EReset  (_, e, e') ->
+        CReset (ast_to_cast_expr hloc e, ast_to_cast_expr hloc e')
+    | EConst (_, c) -> CConst c
+    | ETuple (_, l) -> CTuple (List.map (ast_to_cast_expr hloc) l)
+    | EApp   (_, n, e) ->
+      begin
+        let e = ast_to_cast_expr hloc e in
+        let res = CApp (!c, n, e) in
+        let () = incr c in
+        res
+      end
+  in
+  let ast_to_cast_eq hloc (patt, expr) : c_equation =
+    (ast_to_cast_varlist patt, ast_to_cast_expr hloc expr) in
+  List.map
+    begin
+    fun node ->
+      let () = c := 1 in
+      let hloc = (Hashtbl.find h node.n_name).nt_map in
+      {
+        cn_name = node.n_name;
+        cn_inputs = ast_to_cast_varlist node.n_inputs;
+        cn_outputs = ast_to_cast_varlist node.n_outputs;
+        cn_local_vars = ast_to_cast_varlist node.n_local_vars;
+        cn_equations = List.map (ast_to_cast_eq hloc) node.n_equations;
+      }
+    end
+    nodes
+
+
 (** The following function defines the [node_states] for the nodes of a program,
   * and puts them in a hash table. *)
-let make_state_types nodes: (ident, node_state) Hashtbl.t =
+let make_state_types nodes: node_states =
   (* Hash table to fill *)
   let h: (ident, node_state) Hashtbl.t = Hashtbl.create (List.length nodes) in
 
   (** [one_node node pv ty] computes the number of variables of type [ty] in
     * [node] and a mapping from the variables of type ([ty] * bool) to int,
     *   where [pv] is a list of variables used in the pre construct in the
-    *   programm. *)
+    *   program. *)
   let one_node node pv ty =
     (* variables of type [ty] among output and local variables *)
     let vars =
@@ -35,8 +87,8 @@ let make_state_types nodes: (ident, node_state) Hashtbl.t =
 
   (** [find_prevars n] returns the list of variables appearing after a pre in
     * the node [n].
-    * Note that the only occurence of pre are of the form pre (var), due to the
+    * Note that the only occurrence of pre are of the form pre (var), due to
-    * linearization pass.
+    * the linearization pass.
     *)
   let find_prevars node =
     let rec find_prevars_expr = function
@@ -58,6 +110,26 @@ let make_state_types nodes: (ident, node_state) Hashtbl.t =
         [] node.n_equations)
   in
 
+  (** [count_app n] count the number of auxiliary nodes calls in [n] *)
+  let count_app n =
+    let rec count_app_expr = function
+      | EConst _ | EVar _ -> 0
+      | EMonOp (_, _, e) -> count_app_expr e
+      | ETriOp (_, _, e, e', e'') ->
+          (count_app_expr e) + (count_app_expr e') + (count_app_expr e'')
+      | EComp  (_, _, e, e')
+      | EBinOp (_, _, e, e')
+      | EWhen  (_, e, e')
+      | EReset (_, e, e') -> (count_app_expr e) + (count_app_expr e')
+      | ETuple (_, l) ->
+          List.fold_left (fun acc e -> acc + count_app_expr e) 0 l
+      | EApp   (_, _, e) -> 1 + count_app_expr e
+    in
+    List.fold_left
+      (fun i (_, expr) -> i + count_app_expr expr)
+      0 n.n_equations
+  in
+
   (** [aux] iterates over all nodes of the program to build the required hash
     * table *)
   let rec aux nodes =
@@ -109,6 +181,7 @@ let make_state_types nodes: (ident, node_state) Hashtbl.t =
             nt_map = h_map;
             nt_output_map = h_out;
             nt_prevars = pv;
+            nt_count_app = count_app node;
           } in
         h
         end
@@ -117,14 +190,72 @@ let make_state_types nodes: (ident, node_state) Hashtbl.t =
 
 
 
-(*let ast_to_c*)
+(** The following C-printer functions are in this file, as they need to work on
+  * the AST and are not simple printers. *)
+
+
+
+(** The following function prints the code to remember previous values of
+  * variables used with the pre construct. *)
+let cp_prevars fmt (node, h) =
+  Format.fprintf fmt
+    "\n\t/* Remember the values of variables used in the [pre] construct */\n";
+  let node_st = Hashtbl.find h node.cn_name in
+  List.iter
+    (fun v -> (** Note that «dst_array = src_array» should hold. *)
+      let (src_array, src_idx) = Hashtbl.find node_st.nt_map (v, false) in
+      let (dst_array, dst_idx) = Hashtbl.find node_st.nt_map (v, true) in
+      Format.fprintf fmt "\t%s[%d] = %s[%d];\n"
+        dst_array dst_idx src_array src_idx)
+    node_st.nt_prevars
+
+(** The following function defines the behaviour to have at the first
+  * execution of a node, namely:
+  *   - initialize the states of auxiliary nodes
+  * *)
+let cp_init_aux_nodes fmt (node, h) =
+  let rec aux fmt (node, nst, i) =
+    match find_app_opt node.cn_equations i with
+    | None -> () (** All auxiliary nodes have been initialized *)
+    | Some n ->
+      begin
+      Format.fprintf fmt "%a\t\tstate->aux_states[%d] = malloc (sizeof (%s));\n\
+          \t\t(%s*)(state->aux_states[%d])->is_init = true;\n"
+        aux (node, nst, i-1)
+        (i-1) (Format.asprintf "t_state_%s" n.n_name)
+        (Format.asprintf "t_state_%s" n.n_name) (i-1)
+      end
+  in
+  let nst = Hashtbl.find h node.cn_name in
+  if nst.nt_count_app = 0
+    then ()
+    else begin
+      Format.fprintf fmt "\t/* Initialize the auxiliary nodes */\n\
+          \tif (state->is_init) {\n%a\t}\n"
+        aux (node, nst, nst.nt_count_app)
+    end
+
+let rec cp_node fmt (node, h) =
+  Format.fprintf fmt "%a\n{\n%a\t\tTODO...\n\n\tstate->is_init = false;\n%a}\n"
+    cp_prototype (node, h)
+    cp_init_aux_nodes (node, h)
+    cp_prevars (node, h)
+
+let rec cp_nodes fmt (nodes, h) =
+  match nodes with
+  | [] -> ()
+  | node :: nodes ->
+      Format.fprintf fmt "%a\n%a"
+        cp_node (node, h)
+        cp_nodes (nodes, h)
 
 
 
 let ast_to_c prog =
   let prog_st_types = make_state_types prog in
-  Format.printf "%s\n\n%a\n\n/* Node Prototypes: */\n%a\n\n/* Nodes: */\n%a"
+  let prog: c_nodelist = ast_to_cast prog prog_st_types in
-    Config.c_includes
+  Format.printf "%a\n\n%a\n\n/* Node Prototypes: */\n%a\n\n/* Nodes: */\n%a"
+    cp_includes (Config.c_includes)
     cp_state_types prog_st_types
     cp_prototypes (prog, prog_st_types)
     cp_nodes (prog, prog_st_types)

src/c_utils.ml

@@ -1,39 +1,42 @@
-open Ast
+open Cast
-
-(** A node state is translated into a struct. This struct has:
-  *   1. A name (t_state_<name of the node>)
-  *   2. A number of local and output variables of each type (int, real, bool)
-  *   3-5. mappings that maps
-  *     [(variable, is_pre)] to an index of the corresponding array (see below)
-  *     where [variable] is of type [t_var], and [is_pre] indicated whether we
-  *     deal with pre (x) or x.
-  *   6. A mapping mapping any variable to the name of the C table containing it
-  *      and the index at which it is stored (= union of the tables [nt_map_*])
-  *   7. A mapping mapping the output number i to its location (name of the
-  *     table that contains it and index.
-  *
-  * Important Note: if a variable x appears behind a pre, it will count as two
-  * variables in the point 2. above..
-  *
-  * It should be translated as follow in C:
-      typedef struct {
-          int ivars[nt_nb_int];  (or nothing if nt_nb_int = 0)
-          int bvars[nt_nb_bool]; (or nothing if nt_nb_bool = 0)
-          int rvars[nt_nb_real]; (or nothing if nt_nb_real = 0)
-          bool is_init;
-      } t_state_<node name>;
-  *)
-type node_state =
-  {
-    nt_name: string;
-    nt_nb_int : int;
-    nt_nb_real: int;
-    nt_nb_bool: int;
-    nt_map_int: (t_var * bool, int) Hashtbl.t;
-    nt_map_bool: (t_var * bool, int) Hashtbl.t;
-    nt_map_real: (t_var * bool, int) Hashtbl.t;
-    nt_map: (t_var * bool, string * int) Hashtbl.t;
-    nt_output_map: (int, string * int) Hashtbl.t;
-    nt_prevars: t_var list
-  }
 
+let rec find_app_opt eqs i =
+  let rec find_app_expr_opt i = function
+    | CVar _ | CConst _ -> None
+    | CMonOp (_, e) -> find_app_expr_opt i e
+    | CReset (e, e') | CWhen (e, e') | CComp (_, e, e') | CBinOp (_, e, e') ->
+        begin
+        match find_app_expr_opt i e with
+        | None -> find_app_expr_opt i e'
+        | Some n -> Some n
+        end
+    | CTriOp (_, e, e', e'') ->
+        begin
+        match find_app_expr_opt i e with
+        | None ->
+          begin
+          match find_app_expr_opt i e' with
+          | None -> find_app_expr_opt i e''
+          | Some n -> Some n
+          end
+        | Some n -> Some n
+        end
+    | CTuple l ->
+        List.fold_left
+          (fun acc e ->
+            match acc, find_app_expr_opt i e with
+            | Some n, _ -> Some n
+            | None, v -> v)
+          None l
+        (** [CApp] below represents the n-th call to an aux node *)
+    | CApp (j, n, e) ->
+        if i = j
+          then Some n
+          else find_app_expr_opt i e
+  in
+  match eqs with
+  | [] -> None
+  | (_, expr) :: eqs ->
+    match find_app_expr_opt i expr with
+    | None -> find_app_opt eqs i
+    | Some n -> Some n

src/cast.ml

@@ -0,0 +1,78 @@
+open Ast
+
+(** A node state is translated into a struct. This struct has:
+  *   1. A name (t_state_<name of the node>)
+  *   2. A number of local and output variables of each type (int, real, bool)
+  *   3-5. mappings that maps
+  *     [(variable, is_pre)] to an index of the corresponding array (see below)
+  *     where [variable] is of type [t_var], and [is_pre] indicated whether we
+  *     deal with pre (x) or x.
+  *   6. A mapping mapping any variable to the name of the C table containing it
+  *      and the index at which it is stored (= union of the tables [nt_map_*])
+  *   7. A mapping mapping the output number i to its location (name of the
+  *     table that contains it and index.
+  *
+  * Important Note: if a variable x appears behind a pre, it will count as two
+  * variables in the point 2. above..
+  *
+  * It should be translated as follow in C:
+      typedef struct {
+          int ivars[nt_nb_int];  (or nothing if nt_nb_int = 0)
+          int bvars[nt_nb_bool]; (or nothing if nt_nb_bool = 0)
+          int rvars[nt_nb_real]; (or nothing if nt_nb_real = 0)
+          bool is_init;
+      } t_state_<node name>;
+  *)
+type node_state =
+  {
+    nt_name: string;
+    nt_nb_int : int;
+    nt_nb_real: int;
+    nt_nb_bool: int;
+    nt_map_int: (t_var * bool, int) Hashtbl.t;
+    nt_map_bool: (t_var * bool, int) Hashtbl.t;
+    nt_map_real: (t_var * bool, int) Hashtbl.t;
+    nt_map: (t_var * bool, string * int) Hashtbl.t;
+    nt_output_map: (int, string * int) Hashtbl.t;
+    nt_prevars: t_var list;
+    nt_count_app: int;
+  }
+
+
+
+type c_var =
+  | CVStored of string * int
+  | CVInput of ident
+
+type c_expression =
+  | CVar   of c_var
+  | CMonOp of monop * c_expression
+  | CBinOp of binop * c_expression * c_expression
+  | CTriOp of triop * c_expression * c_expression * c_expression
+  | CComp  of compop * c_expression * c_expression
+  | CWhen  of c_expression * c_expression
+  | CReset of c_expression * c_expression
+  | CConst of const
+  | CTuple of (c_expression list)
+      (** [CApp] below represents the n-th call to an aux node *)
+  | CApp   of int * t_node * c_expression
+
+and c_varlist = t_var list
+
+and c_equation = c_varlist * c_expression 
+
+and c_eqlist = c_equation list
+
+and c_node =
+  {
+    cn_name : ident;
+    cn_inputs: c_varlist;
+    cn_outputs: c_varlist;
+    cn_local_vars: c_varlist;
+    cn_equations: c_eqlist;
+  }
+
+type c_nodelist = c_node list
+
+type node_states = (ident, node_state) Hashtbl.t
+

src/config.ml

@@ -3,4 +3,4 @@
     * variables. *)
 let maxvar = 100
 
-let c_includes = "#include <stdbool.h>"
+let c_includes = ["stdbool"; "stdlib"]

src/cprint.ml

@@ -1,17 +1,38 @@
 open C_utils
+open Cast
 open Ast
 
+(** This file contains extrimely simple functions printing C code. *)
+
+let rec cp_includes fmt = function
+  | [] -> ()
+  | h :: t ->
+      Format.fprintf fmt "#include <%s>\n%a" h cp_includes t
+
 let cp_node_state fmt (st: node_state) =
   let maybeprint fmt (ty, nb, name): unit =
     if nb = 0
       then ()
       else Format.fprintf fmt "\n\t%s %s[%d];" ty name nb
   in
-  Format.fprintf fmt "typedef struct {%a%a%a\n\tbool is_init;\n} %s;\n\n"
+  if st.nt_count_app = 0
-    maybeprint ("int", st.nt_nb_int, "ivars")
+    then
-    maybeprint ("bool", st.nt_nb_bool, "bvars")
+      Format.fprintf fmt "typedef struct {%a%a%a\n\
-    maybeprint ("double", st.nt_nb_real, "rvars")
+            \tbool is_init;\n\
-    st.nt_name
+            } %s;\n\n"
+        maybeprint ("int", st.nt_nb_int, "ivars")
+        maybeprint ("bool", st.nt_nb_bool, "bvars")
+        maybeprint ("double", st.nt_nb_real, "rvars")
+        st.nt_name
+    else
+      Format.fprintf fmt "typedef struct {%a%a%a\n\
+            \tbool is_init;\n\
+            \tvoid* aux_states[%d]; /* stores the states of auxiliary nodes */\n\
+            } %s;\n\n"
+        maybeprint ("int", st.nt_nb_int, "ivars")
+        maybeprint ("bool", st.nt_nb_bool, "bvars")
+        maybeprint ("double", st.nt_nb_real, "rvars")
+        st.nt_count_app st.nt_name
 
 let cp_state_types fmt (h: (ident, node_state) Hashtbl.t): unit =
   Hashtbl.iter (fun n nst ->
@@ -37,17 +58,17 @@ let rec cp_varlist fmt vl =
     cp_varlist vl
 
 let cp_prototype fmt (node, h): unit =
-  match Hashtbl.find_opt h node.n_name with
+  match Hashtbl.find_opt h node.cn_name with
   | None -> failwith "This should not happend!"
   | Some nst ->
       begin
-        Format.fprintf fmt "void %s (%s *state, %a)"
+        Format.fprintf fmt "void fn_%s (%s *state, %a)"
-          node.n_name
+          node.cn_name
           nst.nt_name
-          cp_varlist (snd node.n_inputs)
+          cp_varlist node.cn_inputs
       end
 
-let rec cp_prototypes fmt (nodes, h) =
+let rec cp_prototypes fmt ((nodes, h): c_nodelist * node_states) =
   match nodes with
   | [] -> ()
   | node :: nodes ->
@@ -55,29 +76,3 @@ let rec cp_prototypes fmt (nodes, h) =
         cp_prototype (node, h)
         cp_prototypes (nodes, h)
 
-(** The ollowing function prints the code to remember previous values of
-  * variables used with the pre construct. *)
-let cp_prevars fmt (node, h) =
-  Format.fprintf fmt
-    "\n\t/* Remember the values of variables used in the [pre] construct */\n";
-  let node_st = Hashtbl.find h node.n_name in
-  List.iter
-    (fun v -> (** Note that «dst_array = src_array» should hold. *)
-      let (src_array, src_idx) = Hashtbl.find node_st.nt_map (v, false) in
-      let (dst_array, dst_idx) = Hashtbl.find node_st.nt_map (v, true) in
-      Format.fprintf fmt "\t%s[%d] = %s[%d];\n"
-        dst_array dst_idx src_array src_idx)
-    node_st.nt_prevars
-
-let rec cp_node fmt (node, h) =
-  Format.fprintf fmt "%a\n{\n\t\tTODO...\n\n\tstate->is_init = false;\n%a}\n"
-    cp_prototype (node, h)
-    cp_prevars (node, h)
-
-let rec cp_nodes fmt (nodes, h) =
-  match nodes with
-  | [] -> ()
-  | node :: nodes ->
-      Format.fprintf fmt "%a\n%a"
-        cp_node (node, h)
-        cp_nodes (nodes, h)

src/test2.node

@@ -1,5 +1,11 @@
-node main (i: int) returns (o1: int);
+node diagonal_int (i: int) returns (o1, o2 : int);
 let
-    o1 = 10 -> pre (20 -> 30);
+	(o1, o2) = (i, i);
+tel
+
+node main (i: int) returns (o1, o2, o3, o4: int);
+let
+    (o1, o2) = diagonal_int(i);
+    (o3, o4) = diagonal_int(o1);
 tel