Project

General

Profile

Revision 8446bf03 src/plugins/salsa/salsaDatatypes.ml

View differences:

src/plugins/salsa/salsaDatatypes.ml
1
module LT = LustreSpec
1
module LT = Lustre_types
2
module MT = Machine_code_types
2 3
module MC = Machine_code
3 4
module ST = Salsa.Types
4 5
module Float = Salsa.Float
......
137 138
let rec value_t2salsa_expr constEnv vt = 
138 139
  let value_t2salsa_expr = value_t2salsa_expr constEnv in
139 140
  let res = 
140
    match vt.LT.value_desc with
141
    match vt.MT.value_desc with
141 142
    (* | LT.Cst(LT.Const_tag(t) as c)   ->  *)
142 143
    (*   Format.eprintf "v2s: cst tag@."; *)
143 144
    (*   if List.mem_assoc t constEnv then ( *)
......
148 149
    (* 	Format.eprintf "Const tag %s unhandled@.@?" t ; *)
149 150
    (* 	raise (Salsa.Prelude.Error ("Entschuldigung6, constant tag not yet implemented")) *)
150 151
    (*   ) *)
151
    | LT.Cst(cst)                ->        (* Format.eprintf "v2s: cst tag 2: %a@." Printers.pp_const cst;  *)FloatIntSalsa.inject cst
152
    | LT.LocalVar(v)            
153
    | LT.StateVar(v)            ->       (* Format.eprintf "v2s: var %s@." v.LT.var_id; *) 
152
    | MT.Cst(cst)                ->        (* Format.eprintf "v2s: cst tag 2: %a@." Printers.pp_const cst;  *)FloatIntSalsa.inject cst
153
    | MT.LocalVar(v)            
154
    | MT.StateVar(v)            ->       (* Format.eprintf "v2s: var %s@." v.LT.var_id; *) 
154 155
      let sel_fun = (fun (vname, _) -> v.LT.var_id = vname) in
155 156
      if List.exists sel_fun  constEnv then
156 157
	let _, cst = List.find sel_fun constEnv in
......
158 159
      else
159 160
	let id = v.LT.var_id in
160 161
				   Salsa.Builder.mk_id id
161
    | LT.Fun(binop, [x;y])      -> let salsaX = value_t2salsa_expr x in
162
    | MT.Fun(binop, [x;y])      -> let salsaX = value_t2salsa_expr x in
162 163
				   let salsaY = value_t2salsa_expr y in
163 164
				   let op = (
164 165
				     let pred f x y = Salsa.Builder.mk_int_of_bool (f x y) in
......
176 177
				   )
177 178
				   in
178 179
				   op salsaX salsaY 
179
    | LT.Fun(unop, [x])         -> let salsaX = value_t2salsa_expr x in
180
    | MT.Fun(unop, [x])         -> let salsaX = value_t2salsa_expr x in
180 181
				   Salsa.Builder.mk_uminus salsaX
181 182

  
182
    | LT.Fun(f,_)   -> raise (Salsa.Prelude.Error 
183
    | MT.Fun(f,_)   -> raise (Salsa.Prelude.Error 
183 184
				("Unhandled function "^f^" in conversion to salsa expression"))
184 185
    
185
    | LT.Array(_) 
186
    | LT.Access(_)
187
    | LT.Power(_)   -> raise (Salsa.Prelude.Error ("Unhandled construct in conversion to salsa expression"))
186
    | MT.Array(_) 
187
    | MT.Access(_)
188
    | MT.Power(_)   -> raise (Salsa.Prelude.Error ("Unhandled construct in conversion to salsa expression"))
188 189
  in
189 190
  (* if debug then *)
190 191
  (*   Format.eprintf "value_t2salsa_expr: %a -> %a@ " *)
......
227 228
  let binop op e1 e2 t = 
228 229
    let x = salsa_expr2value_t e1 in
229 230
    let y = salsa_expr2value_t e2 in                    
230
    MC.mk_val (LT.Fun (op, [x;y])) t
231
    MC.mk_val (MT.Fun (op, [x;y])) t
231 232
  in
232 233
  match e with
233 234
    ST.Cst((ST.R(c,_),_),_)     -> (* We project ranges into constants. We
......
253 254
	in
254 255
	Parser_lustre.signed_const Lexer_lustre.token (Lexing.from_string s) 
255 256
      in
256
      MC.mk_val (LT.Cst(cst)) Type_predef.type_real
257
      MC.mk_val (MT.Cst(cst)) Type_predef.type_real
257 258
  | ST.Id(id, _)          -> 
258 259
    (* Format.eprintf "Looking for id=%s@.@?" id; *)
259 260
     if List.mem_assoc id cst_env then (
260 261
       let cst = List.assoc id cst_env in
261 262
      (* Format.eprintf "Found cst = %a@.@?" Printers.pp_const cst; *)
262
       MC.mk_val (LT.Cst cst) Type_predef.type_real
263
       MC.mk_val (MT.Cst cst) Type_predef.type_real
263 264
     )
264 265
     else
265 266
      (* if is_const salsa_label then *)
......
267 268
      (* else *) 
268 269
       let var_id = try get_var vars_env id with Not_found -> assert false in
269 270
       if var_id.is_local then
270
	 MC.mk_val (LT.LocalVar(var_id.vdecl)) var_id.vdecl.LT.var_type
271
	 MC.mk_val (MT.LocalVar(var_id.vdecl)) var_id.vdecl.LT.var_type
271 272
       else
272
	 MC.mk_val (LT.StateVar(var_id.vdecl)) var_id.vdecl.LT.var_type
273
	 MC.mk_val (MT.StateVar(var_id.vdecl)) var_id.vdecl.LT.var_type
273 274
  | ST.Plus(x, y, _)               -> binop "+" x y Type_predef.type_real
274 275
  | ST.Minus(x, y, _)              -> binop "-" x y Type_predef.type_real
275 276
  | ST.Times(x, y, _)              -> binop "*" x y Type_predef.type_real
276 277
  | ST.Div(x, y, _)                -> binop "/" x y Type_predef.type_real
277 278
  | ST.Uminus(x,_)                 -> let x = salsa_expr2value_t x in
278
				      MC.mk_val (LT.Fun("uminus",[x])) Type_predef.type_real
279
				      MC.mk_val (MT.Fun("uminus",[x])) Type_predef.type_real
279 280
  | ST.IntOfBool(ST.Eq(x, y, _),_) -> binop "=" x y Type_predef.type_bool
280 281
  | ST.IntOfBool(ST.Lt(x,y,_),_)   -> binop "<" x y Type_predef.type_bool
281 282
  | ST.IntOfBool(ST.Gt(x,y,_),_)   -> binop ">" x y Type_predef.type_bool
......
309 310

  
310 311
module FormalEnv =
311 312
struct
312
  type fe_t = (LT.ident, (int * LT.value_t)) Hashtbl.t
313
  type fe_t = (LT.ident, (int * MT.value_t)) Hashtbl.t
313 314
  let cpt = ref 0
314 315

  
315 316
  exception NoDefinition of LT.var_decl

Also available in: Unified diff