## lustrec / src / init_predef.ml @ cefc3744

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: *) |