Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / backends / tiny / tiny_backend.ml @ 9b0432bc

History | View | Annotate | Download (3.14 KB)

1
(********************************************************************)
2
(*                                                                  *)
3
(*  The LustreC compiler toolset   /  The LustreC Development Team  *)
4
(*  Copyright 2012 -    --   ONERA - CNRS - INPT - ISAE-SUPAERO     *)
5
(*                                                                  *)
6
(*  LustreC is free software, distributed WITHOUT ANY WARRANTY      *)
7
(*  under the terms of the GNU Lesser General Public License        *)
8
(*  version 2.1.                                                    *)
9
(*                                                                  *)
10
(********************************************************************)
11

    
12
open Format
13
open Lustrec.Machine_code_types
14
open Lustrec
15
open Misc_lustre_function
16
open Ada_printer
17
open Ada_backend_common
18
open Tiny_utils
19

    
20
let indent_size = 2
21

    
22

    
23
(** Main function of the Tiny backend. 
24
   @param basename name of the lustre file
25
   @param prog useless
26
   @param machines list of machines to translate
27
   @param dependencies useless
28
**)
29
let translate_to_tiny basename prog machines dependencies =
30
  
31
  let node_name =
32
    match !Lustrec.Options.main_node with
33
    | "" -> (
34
      Format.eprintf "Tiny backend requires a main node.@.";
35
      Format.eprintf "@[<v 2>Available ones are:@ %a@]@.@?"
36
        (Lustrec.Utils.fprintf_list ~sep:"@ "
37
            (fun fmt m ->
38
              Format.fprintf fmt "%s" m.Lustrec.Machine_code_types.mname.node_id
39
            )
40
        )
41
        machines; 
42
      exit 1
43
    )
44
    | s -> ( (* should have been addessed before *)
45
      match Lustrec.Machine_code_common.get_machine_opt machines s with
46
      | None -> begin
47
          Lustrec.Global.main_node := s;
48
          Format.eprintf "Code generation error: %a@."Lustrec.Error.pp_error_msg Lustrec.Error.Main_not_found;
49
          raise (Error.Error (Lustrec.Location.dummy_loc,Lustrec.Error.Main_not_found))
50
        end
51
      | Some _ -> s
52
    )
53
  in
54
  let m = Lustrec.Machine_code_common.get_machine machines node_name in
55
  let env = (* We add each variables of the node the Tiny env *)
56
    Tiny_utils.machine_to_env m in
57
  let nd = m.mname in
58
  (* Building preamble with some bounds on inputs *)
59
  (* TODO: deal woth contracts, asserts, ... *)
60
  let bounds_inputs = [] in
61
  let ast = (Tiny_utils.machine_to_tiny_encoding bounds_inputs m).ast in
62

    
63
  (* pretty print in lowercase *)  
64
  let pp_lowercase pp fmt =
65
  let str = asprintf "%t" pp in
66
  fprintf fmt "%s" (String. lowercase_ascii str) in 
67

    
68
  (* pretty print a filename with an extension *) 
69
  let pp_filename extension fmt pp_name =
70
    fprintf fmt "%t.%s" (pp_lowercase pp_name) extension in 
71

    
72
  let pp_var_decl env fmt = 
73
  let vars = Tiny_utils.Ast.VarSet.elements env in 
74
  List.iter (fun (var_name, var_type) -> 
75
    fprintf fmt "%a %s;\n" Tiny_utils.Ast.pp_base_type var_type var_name 
76
  ) vars in 
77

    
78

    
79
  let destname = !Lustrec.Options.dest_dir ^ "/" in
80

    
81
  let path = asprintf "%s%a" destname (pp_filename "tiny") (fun fmt -> fprintf fmt "%s" basename) in
82
  let out = open_out path in
83
  let fmt = formatter_of_out_channel out in
84
  pp_var_decl env fmt ;
85
  Tiny.Ast.fprint_stm fmt ast;
86
  pp_print_flush fmt ();
87
  close_out out; 
88
       
89

    
90