Project

General

Profile

Revision 5c1184ad src/basic_library.ml

View differences:

src/basic_library.ml
35 35
  type_static (mkdim_var ()) ty
36 36

  
37 37
let type_env =
38
  let init_env = TE.initial in
39
  let env' = TE.add_value init_env "+" (static_op type_bin_poly_op) in
40
  let env' = TE.add_value env' "uminus" (static_op type_unary_poly_op) in
41
  let env' = TE.add_value env' "-" (static_op type_bin_poly_op) in
42
  let env' = TE.add_value env' "*" (static_op type_bin_poly_op) in
43
  let env' = TE.add_value env' "/" (static_op type_bin_poly_op) in
44
  let env' = TE.add_value env' "mod" (static_op type_bin_int_op) in
45
  let env' = TE.add_value env' "&&" (static_op type_bin_bool_op) in
46
  let env' = TE.add_value env' "||" (static_op type_bin_bool_op) in
47
  let env' = TE.add_value env' "xor" (static_op type_bin_bool_op) in
48
  let env' = TE.add_value env' "impl" (static_op type_bin_bool_op) in
49
  let env' = TE.add_value env' "<" (static_op type_bin_comp_op) in
50
  let env' = TE.add_value env' "<=" (static_op type_bin_comp_op) in
51
  let env' = TE.add_value env' ">" (static_op type_bin_comp_op) in
52
  let env' = TE.add_value env' ">=" (static_op type_bin_comp_op) in
53
  let env' = TE.add_value env' "!=" (static_op type_bin_comp_op) in
54
  let env' = TE.add_value env' "=" (static_op type_bin_comp_op) in
55
  let env' = TE.add_value env' "not" (static_op type_unary_bool_op) in
56
  env'
57

  
38
  List.fold_left 
39
    (fun env (op, op_type) -> TE.add_value env op op_type)
40
    TE.initial
41
    [
42
       "+", (static_op type_bin_poly_op);
43
      "uminus", (static_op type_unary_poly_op); 
44
      "-", (static_op type_bin_poly_op); 
45
      "*", (static_op type_bin_poly_op);
46
      "/", (static_op type_bin_poly_op);
47
      "mod", (static_op type_bin_int_op);
48
      "&&", (static_op type_bin_bool_op);
49
      "||", (static_op type_bin_bool_op);
50
      "xor", (static_op type_bin_bool_op);
51
      "impl", (static_op type_bin_bool_op);
52
      "<", (static_op type_bin_comp_op);
53
      "<=", (static_op type_bin_comp_op);
54
      ">", (static_op type_bin_comp_op);
55
      ">=", (static_op type_bin_comp_op);
56
      "!=", (static_op type_bin_comp_op);
57
      "=", (static_op type_bin_comp_op);
58
      "not", (static_op type_unary_bool_op)
59
]
60
 
58 61
module CE = Env
59 62

  
60 63
let clock_env =
......
85 88
module VE = Env
86 89

  
87 90
let eval_env =
88
  let init_env = VE.initial in
89
  let env' = VE.add_value init_env "uminus" (fun [Dint a] -> Dint (-a)) in
90
  let env' = VE.add_value env' "not" (fun [Dbool b] -> Dbool (not b)) in
91
  let env' = VE.add_value env' "+" (fun [Dint a; Dint b] -> Dint (a+b)) in
92
  let env' = VE.add_value env' "-" (fun [Dint a; Dint b] -> Dint (a-b)) in
93
  let env' = VE.add_value env' "*" (fun [Dint a; Dint b] -> Dint (a*b)) in
94
  let env' = VE.add_value env' "/" (fun [Dint a; Dint b] -> Dint (a/b)) in
95
  let env' = VE.add_value env' "mod" (fun [Dint a; Dint b] -> Dint (a mod b)) in
96
  let env' = VE.add_value env' "&&" (fun [Dbool a; Dbool b] -> Dbool (a&&b)) in
97
  let env' = VE.add_value env' "||" (fun [Dbool a; Dbool b] -> Dbool (a||b)) in
98
  let env' = VE.add_value env' "xor" (fun [Dbool a; Dbool b] -> Dbool (a<>b)) in
99
  let env' = VE.add_value env' "impl" (fun [Dbool a; Dbool b] -> Dbool (a<=b)) in
100
  let env' = VE.add_value env' "<" (fun [Dint a; Dint b] -> Dbool (a<b)) in
101
  let env' = VE.add_value env' ">" (fun [Dint a; Dint b] -> Dbool (a>b)) in
102
  let env' = VE.add_value env' "<=" (fun [Dint a; Dint b] -> Dbool (a<=b)) in
103
  let env' = VE.add_value env' ">=" (fun [Dint a; Dint b] -> Dbool (a>=b)) in
104
  let env' = VE.add_value env' "!=" (fun [a; b] -> Dbool (a<>b)) in
105
  let env' = VE.add_value env' "=" (fun [a; b] -> Dbool (a=b)) in
106
  env'
91
  let defs = [ 
92
    "uminus", (function [Dint a] -> Dint (-a)           | _ -> assert false);
93
    "not", (function [Dbool b] -> Dbool (not b)         | _ -> assert false);
94
    "+", (function [Dint a; Dint b] -> Dint (a+b)       | _ -> assert false);
95
    "-", (function [Dint a; Dint b] -> Dint (a-b)       | _ -> assert false);
96
    "*", (function [Dint a; Dint b] -> Dint (a*b)       | _ -> assert false);
97
    "/", (function [Dint a; Dint b] -> Dint (a/b)       | _ -> assert false);
98
    "mod", (function [Dint a; Dint b] -> Dint (a mod b) | _ -> assert false);
99
    "&&", (function [Dbool a; Dbool b] -> Dbool (a&&b)  | _ -> assert false);
100
    "||", (function [Dbool a; Dbool b] -> Dbool (a||b)  | _ -> assert false);
101
    "xor", (function [Dbool a; Dbool b] -> Dbool (a<>b) | _ -> assert false);
102
    "impl", (function [Dbool a; Dbool b] -> Dbool (a<=b)| _ -> assert false);
103
    "<", (function [Dint a; Dint b] -> Dbool (a<b)      | _ -> assert false);
104
    ">", (function [Dint a; Dint b] -> Dbool (a>b)      | _ -> assert false);
105
    "<=", (function [Dint a; Dint b] -> Dbool (a<=b)    | _ -> assert false);
106
    ">=", (function [Dint a; Dint b] -> Dbool (a>=b)    | _ -> assert false);
107
    "!=", (function [a; b] -> Dbool (a<>b)              | _ -> assert false);
108
    "=", (function [a; b] -> Dbool (a=b)                | _ -> assert false);
109
  ]
110
  in
111
  List.fold_left 
112
    (fun env (op, op_eval) -> VE.add_value env op op_eval)
113
    VE.initial
114
    defs
107 115

  
108 116
let internal_funs = ["+";"-";"*";"/";"mod";"&&";"||";"xor";"impl";"<";">";"<=";">=";"!=";"=";"uminus";"not"]
109 117

  

Also available in: Unified diff