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

(* compilecommand:"make C .." *)

74

(* End: *)
