lustrec / src / init_predef.ml @ 22fe1c93
History | View | Annotate | Download (2.62 KB)
1 |
(* ---------------------------------------------------------------------------- |
---|---|
2 |
* SchedMCore - A MultiCore Scheduling Framework |
3 |
* Copyright (C) 2009-2011, ONERA, Toulouse, FRANCE - LIFL, Lille, FRANCE |
4 |
* |
5 |
* This file is part of Prelude |
6 |
* |
7 |
* Prelude is free software; you can redistribute it and/or |
8 |
* modify it under the terms of the GNU Lesser General Public License |
9 |
* as published by the Free Software Foundation ; either version 2 of |
10 |
* the License, or (at your option) any later version. |
11 |
* |
12 |
* Prelude is distributed in the hope that it will be useful, but |
13 |
* WITHOUT ANY WARRANTY ; without even the implied warranty of |
14 |
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
15 |
* Lesser General Public License for more details. |
16 |
* |
17 |
* You should have received a copy of the GNU Lesser General Public |
18 |
* License along with this program ; if not, write to the Free Software |
19 |
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 |
20 |
* USA |
21 |
*---------------------------------------------------------------------------- *) |
22 |
|
23 |
(** Base types and predefined operator types. *) |
24 |
open Init |
25 |
|
26 |
let init_zero = new_univar () |
27 |
|
28 |
let init_un = |
29 |
let univ = new_univar () in |
30 |
new_init Isucc(univ) |
31 |
|
32 |
let rec init_omega = |
33 |
{ init_desc = Isucc init_omega ; iid = -1 } |
34 |
|
35 |
let is_omega init = |
36 |
let rec search path init = |
37 |
match init.init_desc with |
38 |
| Isucc init' -> List.mem init path or search (init::path) init' |
39 |
| _ -> false |
40 |
in search [] init |
41 |
|
42 |
let init_unary_poly_op = |
43 |
let univ = new_univar () in |
44 |
new_init (Iarrow (univ, univ)) |
45 |
|
46 |
let init_pre_op = |
47 |
let univ = new_univar () in |
48 |
new_init (Iarrow (univ, new_init (Isucc univ))) |
49 |
|
50 |
let init_arrow_op = |
51 |
let univ = new_univar () in |
52 |
new_init (Iarrow (new_init (Ituple [univ; init_un]), univ)) |
53 |
|
54 |
let init_fby_op_1 = |
55 |
let univ = new_univar () in |
56 |
new_init (Iarrow (init_zero,init_zero)) |
57 |
|
58 |
let init_fby_op_2 = |
59 |
init_pre_op |
60 |
|
61 |
let init_bin_poly_op = |
62 |
let univ = new_univar () in |
63 |
new_init (Iarrow (new_init (Ituple [univ;univ]), univ)) |
64 |
|
65 |
let init_ter_poly_op = |
66 |
let univ = new_univar () in |
67 |
new_init (Iarrow (new_init (Ituple [univ;univ;univ]), univ)) |
68 |
|
69 |
let env = |
70 |
let init_env = Env.initial in |
71 |
let env' = |
72 |
List.fold_right (fun op env -> Env.add_value env op init_unary_poly_op) |
73 |
["uminus"; "not"] init_env in |
74 |
let env' = |
75 |
List.fold_right (fun op env -> Env.add_value env op init_binary_poly_op) |
76 |
["+"; "-"; "*"; "/"; "mod"; "&&"; "||"; "xor"; "impl"; "<"; "<="; ">"; ">="; "!="; "="] env' in |
77 |
let env' = |
78 |
List.fold_right (fun op env -> Env.add_value env op init_ternary_poly_op) |
79 |
["ite"] init_env in |
80 |
env' |
81 |
|
82 |
(* Local Variables: *) |
83 |
(* compile-command:"make -C .." *) |
84 |
(* End: *) |