## lustrec / src / init_predef.ml @ 45c13277

History | View | Annotate | Download (2.29 KB)

1 | a2d97a3e | ploc | (********************************************************************) |
---|---|---|---|

2 | (* *) |
||

3 | (* The LustreC compiler toolset / The LustreC Development Team *) |
||

4 | (* Copyright 2012 - -- ONERA - CNRS - INPT *) |
||

5 | (* *) |
||

6 | (* LustreC is free software, distributed WITHOUT ANY WARRANTY *) |
||

7 | (* under the terms of the GNU Lesser General Public License *) |
||

8 | (* version 2.1. *) |
||

9 | (* *) |
||

10 | (********************************************************************) |
||

11 | |||

12 | 22fe1c93 | ploc | |

13 | (** Base types and predefined operator types. *) |
||

14 | open Init |
||

15 | |||

16 | let init_zero = new_univar () |
||

17 | |||

18 | let init_un = |
||

19 | let univ = new_univar () in |
||

20 | new_init Isucc(univ) |
||

21 | |||

22 | let rec init_omega = |
||

23 | { init_desc = Isucc init_omega ; iid = -1 } |
||

24 | |||

25 | let is_omega init = |
||

26 | let rec search path init = |
||

27 | match init.init_desc with |
||

28 | | Isucc init' -> List.mem init path or search (init::path) init' |
||

29 | | _ -> false |
||

30 | in search [] init |
||

31 | |||

32 | let init_unary_poly_op = |
||

33 | let univ = new_univar () in |
||

34 | new_init (Iarrow (univ, univ)) |
||

35 | |||

36 | let init_pre_op = |
||

37 | let univ = new_univar () in |
||

38 | new_init (Iarrow (univ, new_init (Isucc univ))) |
||

39 | |||

40 | let init_arrow_op = |
||

41 | let univ = new_univar () in |
||

42 | new_init (Iarrow (new_init (Ituple [univ; init_un]), univ)) |
||

43 | |||

44 | let init_fby_op_1 = |
||

45 | let univ = new_univar () in |
||

46 | new_init (Iarrow (init_zero,init_zero)) |
||

47 | |||

48 | let init_fby_op_2 = |
||

49 | init_pre_op |
||

50 | |||

51 | let init_bin_poly_op = |
||

52 | let univ = new_univar () in |
||

53 | new_init (Iarrow (new_init (Ituple [univ;univ]), univ)) |
||

54 | |||

55 | let init_ter_poly_op = |
||

56 | let univ = new_univar () in |
||

57 | new_init (Iarrow (new_init (Ituple [univ;univ;univ]), univ)) |
||

58 | |||

59 | let env = |
||

60 | let init_env = Env.initial in |
||

61 | let env' = |
||

62 | List.fold_right (fun op env -> Env.add_value env op init_unary_poly_op) |
||

63 | ["uminus"; "not"] init_env in |
||

64 | let env' = |
||

65 | List.fold_right (fun op env -> Env.add_value env op init_binary_poly_op) |
||

66 | ["+"; "-"; "*"; "/"; "mod"; "&&"; "||"; "xor"; "impl"; "<"; "<="; ">"; ">="; "!="; "="] env' in |
||

67 | let env' = |
||

68 | List.fold_right (fun op env -> Env.add_value env op init_ternary_poly_op) |
||

69 | ["ite"] init_env in |
||

70 | env' |
||

71 | |||

72 | (* Local Variables: *) |
||

73 | (* compile-command:"make -C .." *) |
||

74 | (* End: *) |