Project

General

Profile

« Previous | Next » 

Revision a7062da6

Added by LĂ©lio Brun over 3 years ago

another step towards refactoring

View differences:

src/backends/Ada/ada_backend_common.ml
1
open Utils
1 2
open Format
2 3
open Machine_code_types
3 4
open Lustre_types
......
73 74

  
74 75
(** Print a type. @param fmt the formater to print on @param type the type **)
75 76
let pp_type fmt typ =
76
  match (Types.repr typ).Types.tdesc with
77
  | Types.Tbasic Types.Basic.Tint ->
77
  let open Types in
78
  let t = repr typ in
79
  if is_bool_type t then
80
    pp_boolean_type fmt
81
  else if is_int_type t then
78 82
    pp_integer_type fmt
79
  | Types.Tbasic Types.Basic.Treal ->
83
  else if is_real_type t then
80 84
    pp_float_type fmt
81
  | Types.Tbasic Types.Basic.Tbool ->
82
    pp_boolean_type fmt
83
  | Types.Tunivar ->
84
    pp_polymorphic_type typ.Types.tid fmt
85
  | Types.Tbasic _ ->
86
    eprintf "Tbasic@.";
87
    assert false (*TODO*)
88
  | Types.Tconst _ ->
89
    eprintf "Tconst@.";
90
    assert false (*TODO*)
91
  | Types.Tclock _ ->
92
    eprintf "Tclock@.";
93
    assert false (*TODO*)
94
  | Types.Tarrow _ ->
95
    eprintf "Tarrow@.";
96
    assert false (*TODO*)
97
  | Types.Ttuple l ->
98
    eprintf "Ttuple %a @." (Utils.fprintf_list ~sep:" " Types.print_ty) l;
99
    assert false (*TODO*)
100
  | Types.Tenum _ ->
101
    eprintf "Tenum@.";
102
    assert false (*TODO*)
103
  | Types.Tstruct _ ->
104
    eprintf "Tstruct@.";
105
    assert false (*TODO*)
106
  | Types.Tarray _ ->
107
    eprintf "Tarray@.";
108
    assert false (*TODO*)
109
  | Types.Tstatic _ ->
110
    eprintf "Tstatic@.";
111
    assert false (*TODO*)
112
  | Types.Tlink _ ->
113
    eprintf "Tlink@.";
114
    assert false (*TODO*)
115
  | Types.Tvar ->
116
    eprintf "Tvar@.";
117
    assert false
85
  else match t.tdesc with
86
    | Tunivar ->
87
      pp_polymorphic_type typ.tid fmt
88
    | Tbasic _ ->
89
      eprintf "Tbasic@.";
90
      assert false (*TODO*)
91
    | Tconst _ ->
92
      eprintf "Tconst@.";
93
      assert false (*TODO*)
94
    | Tclock _ ->
95
      eprintf "Tclock@.";
96
      assert false (*TODO*)
97
    | Tarrow _ ->
98
      eprintf "Tarrow@.";
99
      assert false (*TODO*)
100
    | Ttuple l ->
101
      eprintf "Ttuple %a @." (pp_print_list print_ty) l;
102
      assert false (*TODO*)
103
    | Tenum _ ->
104
      eprintf "Tenum@.";
105
      assert false (*TODO*)
106
    | Tstruct _ ->
107
      eprintf "Tstruct@.";
108
      assert false (*TODO*)
109
    | Tarray _ ->
110
      eprintf "Tarray@.";
111
      assert false (*TODO*)
112
    | Tstatic _ ->
113
      eprintf "Tstatic@.";
114
      assert false (*TODO*)
115
    | Tlink _ ->
116
      eprintf "Tlink@.";
117
      assert false (*TODO*)
118
    | Tvar ->
119
      eprintf "Tvar@.";
120
      assert false
118 121
(*TODO*)
119 122
(*| _ -> eprintf "Type error : %a@." Types.print_ty typ; assert false *)
120 123

  
121 124
(** Return a default ada constant for a given type. @param cst_typ the constant
122 125
    type **)
123
let default_ada_cst cst_typ =
124
  match cst_typ with
125
  | Types.Basic.Tint ->
126
let default_ada_cst t =
127
  let open Types in
128
  if is_bool_type t then
129
    Const_tag tag_false
130
  else if is_int_type t then
126 131
    Const_int 0
127
  | Types.Basic.Treal ->
132
  else if is_real_type t then
128 133
    Const_real Real.zero
129
  | Types.Basic.Tbool ->
130
    Const_tag tag_false
131
  | _ ->
134
  else
132 135
    assert false
133 136

  
134 137
(** Make a default value from a given type. @param typ the type **)
135 138
let mk_default_value typ =
136
  match (Types.repr typ).Types.tdesc with
137
  | Types.Tbasic t ->
139
  let t = Types.repr typ in
140
  match t.Types.tdesc with
141
  | Types.Tbasic _ ->
138 142
    mk_val (Cst (default_ada_cst t)) typ
139 143
  | _ ->
140 144
    assert false
......
156 160
      (fun poly1 (poly2, _) -> poly1 = poly2)
157 161
      polymorphic_types substituion);
158 162
  let instantiated_types = snd (List.split substitution) in
159
  fprintf fmt "%t%t%a" (pp_package_name machine)
160
    (Utils.pp_final_char_if_non_empty "_" instantiated_types)
161
    (Utils.fprintf_list ~sep:"_" pp_type)
163
  fprintf fmt "%t%a"
164
    (pp_package_name machine)
165
    (pp_print_list
166
       ~pp_prologue:(fun fmt () -> pp_print_string fmt "_")
167
       ~pp_sep:(fun fmt () -> pp_print_string fmt "_")
168
       pp_type)
162 169
    instantiated_types
163 170

  
164 171
(** Print the name of a variable. @param fmt the formater to print on @param id

Also available in: Unified diff