Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / basic_library.ml @ 22fe1c93

History | View | Annotate | Download (6.93 KB)

1
(* ----------------------------------------------------------------------------
2
 * SchedMCore - A MultiCore Scheduling Framework
3
 * Copyright (C) 2009-2013, ONERA, Toulouse, FRANCE - LIFL, Lille, FRANCE
4
 * Copyright (C) 2012-2013, INPT, Toulouse, FRANCE
5
 *
6
 * This file is part of Prelude
7
 *
8
 * Prelude is free software; you can redistribute it and/or
9
 * modify it under the terms of the GNU Lesser General Public License
10
 * as published by the Free Software Foundation ; either version 2 of
11
 * the License, or (at your option) any later version.
12
 *
13
 * Prelude is distributed in the hope that it will be useful, but
14
 * WITHOUT ANY WARRANTY ; without even the implied warranty of
15
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16
 * Lesser General Public License for more details.
17
 *
18
 * You should have received a copy of the GNU Lesser General Public
19
 * License along with this program ; if not, write to the Free Software
20
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
21
 * USA
22
 *---------------------------------------------------------------------------- *)
23

    
24
(* This module is used for the lustre to C compiler *)
25

    
26
open LustreSpec
27
open Type_predef
28
open Clock_predef
29
open Delay_predef
30
open Dimension
31

    
32
module TE = Env
33

    
34
let static_op ty =
35
  type_static (mkdim_var ()) ty
36

    
37
let type_env =
38
  let init_env = TE.initial in
39
  let env' = TE.add_value init_env "+" (static_op type_bin_poly_op) in
40
  let env' = TE.add_value env' "uminus" (static_op type_unary_poly_op) in
41
  let env' = TE.add_value env' "-" (static_op type_bin_poly_op) in
42
  let env' = TE.add_value env' "*" (static_op type_bin_poly_op) in
43
  let env' = TE.add_value env' "/" (static_op type_bin_poly_op) in
44
  let env' = TE.add_value env' "mod" (static_op type_bin_int_op) in
45
  let env' = TE.add_value env' "&&" (static_op type_bin_bool_op) in
46
  let env' = TE.add_value env' "||" (static_op type_bin_bool_op) in
47
  let env' = TE.add_value env' "xor" (static_op type_bin_bool_op) in
48
  let env' = TE.add_value env' "impl" (static_op type_bin_bool_op) in
49
  let env' = TE.add_value env' "<" (static_op type_bin_comp_op) in
50
  let env' = TE.add_value env' "<=" (static_op type_bin_comp_op) in
51
  let env' = TE.add_value env' ">" (static_op type_bin_comp_op) in
52
  let env' = TE.add_value env' ">=" (static_op type_bin_comp_op) in
53
  let env' = TE.add_value env' "!=" (static_op type_bin_comp_op) in
54
  let env' = TE.add_value env' "=" (static_op type_bin_comp_op) in
55
  let env' = TE.add_value env' "not" (static_op type_unary_bool_op) in
56
  env'
57

    
58
module CE = Env
59

    
60
let clock_env =
61
  let init_env = CE.initial in
62
  let env' = 
63
    List.fold_right (fun op env -> CE.add_value env op ck_unary_univ)
64
      ["uminus"; "not"] init_env in
65
  let env' = 
66
    List.fold_right (fun op env -> CE.add_value env op ck_bin_univ)
67
      ["+"; "-"; "*"; "/"; "mod"; "&&"; "||"; "xor"; "impl"; "<"; "<="; ">"; ">="; "!="; "="] env' in
68
  env'
69

    
70
module DE = Env
71

    
72
let delay_env =
73
  let init_env = DE.initial in
74
  let env' = 
75
    List.fold_right (fun op env -> DE.add_value env op delay_unary_poly_op)
76
      ["uminus"; "not"] init_env in
77
  let env' = 
78
    List.fold_right (fun op env -> DE.add_value env op delay_binary_poly_op)
79
      ["+"; "-"; "*"; "/"; "mod"; "&&"; "||"; "xor"; "impl"; "<"; "<="; ">"; ">="; "!="; "="] env' in
80
  let env' = 
81
    List.fold_right (fun op env -> DE.add_value env op delay_ternary_poly_op)
82
      [] env' in
83
  env'
84

    
85
module VE = Env
86

    
87
let eval_env =
88
  let init_env = VE.initial in
89
  let env' = VE.add_value init_env "uminus" (fun [Dint a] -> Dint (-a)) in
90
  let env' = VE.add_value env' "not" (fun [Dbool b] -> Dbool (not b)) in
91
  let env' = VE.add_value env' "+" (fun [Dint a; Dint b] -> Dint (a+b)) in
92
  let env' = VE.add_value env' "-" (fun [Dint a; Dint b] -> Dint (a-b)) in
93
  let env' = VE.add_value env' "*" (fun [Dint a; Dint b] -> Dint (a*b)) in
94
  let env' = VE.add_value env' "/" (fun [Dint a; Dint b] -> Dint (a/b)) in
95
  let env' = VE.add_value env' "mod" (fun [Dint a; Dint b] -> Dint (a mod b)) in
96
  let env' = VE.add_value env' "&&" (fun [Dbool a; Dbool b] -> Dbool (a&&b)) in
97
  let env' = VE.add_value env' "||" (fun [Dbool a; Dbool b] -> Dbool (a||b)) in
98
  let env' = VE.add_value env' "xor" (fun [Dbool a; Dbool b] -> Dbool (a<>b)) in
99
  let env' = VE.add_value env' "impl" (fun [Dbool a; Dbool b] -> Dbool (a<=b)) in
100
  let env' = VE.add_value env' "<" (fun [Dint a; Dint b] -> Dbool (a<b)) in
101
  let env' = VE.add_value env' ">" (fun [Dint a; Dint b] -> Dbool (a>b)) in
102
  let env' = VE.add_value env' "<=" (fun [Dint a; Dint b] -> Dbool (a<=b)) in
103
  let env' = VE.add_value env' ">=" (fun [Dint a; Dint b] -> Dbool (a>=b)) in
104
  let env' = VE.add_value env' "!=" (fun [a; b] -> Dbool (a<>b)) in
105
  let env' = VE.add_value env' "=" (fun [a; b] -> Dbool (a=b)) in
106
  env'
107

    
108
let internal_funs = ["+";"-";"*";"/";"mod";"&&";"||";"xor";"impl";"<";">";"<=";">=";"!=";"=";"uminus";"not"]
109

    
110
let is_internal_fun x =
111
  List.mem x internal_funs
112

    
113
(*
114
let imported_node name inputs outputs sl spec =
115
  mktop_decl Location.dummy_loc
116
    (
117
      ImportedNode
118
	{nodei_id = name;
119
	 nodei_type = Types.new_var ();
120
	 nodei_clock = Clocks.new_var true;
121
	 nodei_inputs = inputs;
122
	 nodei_outputs = outputs;
123
	 nodei_stateless = sl;
124
	nodei_spec = spec})
125
    
126
let mk_new_var id =
127
  let loc = Location.dummy_loc in
128
  mkvar_decl loc (id, mktyp loc Tydec_any, mkclock loc Ckdec_any, false)
129

    
130
let _ = 
131
  let binary_fun id = id, [mk_new_var "x"; mk_new_var "y"], [mk_new_var "z"] in
132
  let unary_fun id = id, [mk_new_var "x"], [mk_new_var "y"] in
133
  (* All following functions are stateless *)
134
  let st = true in
135
  List.iter (fun (n,i,o) -> Hashtbl.add node_table n (imported_node n i o st None))
136
    (
137
(*("ite", [mk_new_var "g"; mk_new_var "x"; mk_new_var "y"], [mk_new_var "z"])::*)
138
    (List.map binary_fun
139
	["+";"-";"*";"/";"mod";"&&";"||";"xor";"impl";"<";">";"<=";">=";"!=";"="])
140
     @(List.map unary_fun ["uminus";"not"]))
141
*)  
142
let pp_c i pp_val fmt vl =
143
  match i, vl with
144
  (*  | "ite", [v1; v2; v3] -> Format.fprintf fmt "(%a?(%a):(%a))" pp_val v1 pp_val v2 pp_val v3 *)
145
    | "uminus", [v] -> Format.fprintf fmt "(- %a)" pp_val v
146
    | "not", [v] -> Format.fprintf fmt "(!%a)" pp_val v 
147
    | "impl", [v1; v2] -> Format.fprintf fmt "(!%a || %a)" pp_val v1 pp_val v2 
148
    | "=", [v1; v2] -> Format.fprintf fmt "(%a == %a)" pp_val v1 pp_val v2 
149
    | "mod", [v1; v2] -> Format.fprintf fmt "(%a %% %a)" pp_val v1 pp_val v2 
150
    | _, [v1; v2] -> Format.fprintf fmt "(%a %s %a)" pp_val v1 i pp_val v2 
151
    | _ -> assert false
152

    
153
let pp_java i pp_val fmt vl =
154
  match i, vl with
155
  (*  | "ite", [v1; v2; v3] -> Format.fprintf fmt "(%a?(%a):(%a))" pp_val v1 pp_val v2 pp_val v3 *)
156
    | "uminus", [v] -> Format.fprintf fmt "(- %a)" pp_val v
157
    | "not", [v] -> Format.fprintf fmt "(!%a)" pp_val v 
158
    | "impl", [v1; v2] -> Format.fprintf fmt "(!%a || %a)" pp_val v1 pp_val v2 
159
    | "=", [v1; v2] -> Format.fprintf fmt "(%a == %a)" pp_val v1 pp_val v2 
160
    | _, [v1; v2] -> Format.fprintf fmt "(%a %s %a)" pp_val v1 i pp_val v2 
161
    | _ -> assert false
162

    
163

    
164
(* Local Variables: *)
165
(* compile-command:"make -C .." *)
166
(* End: *)