## lustrec / src / init_predef.ml @ 6560bb94

History | View | Annotate | Download (2.62 KB)

1 | 0cbf0839 | ploc | (* ---------------------------------------------------------------------------- |
---|---|---|---|

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