## lustrec / src / init_predef.ml @ 0bd19a92

History | View | Annotate | Download (2.29 KB)

1 |
(********************************************************************) |
---|---|

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 | |

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