Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / init_predef.ml @ cefc3744

History | View | Annotate | Download (2.62 KB)

1 22fe1c93 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: *)