predefEvalClock.ml

(** Time-stamp: <modified the 28/08/2008 (at 15:35) by Erwan Jahier> *)

open Predef

(* exported *)
type clocker = Eff.clock Predef.evaluator

(* exported *)
exception EvalClock_error of string


(** A few useful clock profiles *)

let (constant_profile: clocker) = fun _ -> [UnifyClock.get_constant_clock ()]

let (op_profile: clocker) =
  function
    | clk::_ -> clk
    | [] -> assert false

      
let if_clock_profile lxm sargs = 
  function
    | [clk1; clk2; clk3] -> clk2
    | _ -> assert false



let rec fill x n = if n > 0 then (x::(fill x (n-1))) else []

let fillred_clock_profile lxm sargs clks = 
  let (_, lto) = PredefEvalType.fillred_profile lxm sargs in
  let clks = List.flatten clks in
    fill (List.hd clks) (List.length lto)

let map_clock_profile lxm sargs clks = 
  let (_, lto) = PredefEvalType.map_profile lxm sargs in
  let clks = List.flatten clks in
    fill (List.hd clks) (List.length lto)

let boolred_clock_profile lxm sargs clks = 
  let (_, lto) = PredefEvalType.boolred_profile lxm sargs in
  let clks = List.flatten clks in
    fill (List.hd clks) (List.length lto)


(* This table contains the clock profile of predefined operators *)
let (f: op -> Lxm.t -> Eff.static_arg list -> clocker) = 
  fun op lxm sargs ->  
    match op with
      | TRUE_n | FALSE_n | ICONST_n _ | RCONST_n _ -> constant_profile

      | NOT_n | REAL2INT_n | INT2REAL_n | UMINUS_n | IUMINUS_n | RUMINUS_n
      | IMPL_n | AND_n | OR_n | XOR_n 
      | NEQ_n | EQ_n | LT_n | LTE_n | GT_n | GTE_n
      | MINUS_n  |  PLUS_n |  TIMES_n |  SLASH_n  
      | RMINUS_n | RPLUS_n | RTIMES_n | RSLASH_n  
      | DIV_n | MOD_n | IMINUS_n | IPLUS_n | ISLASH_n | ITIMES_n 
      | NOR_n | DIESE_n  
          -> op_profile

      | IF_n                 -> if_clock_profile lxm sargs
      | Red | Fill | FillRed -> fillred_clock_profile lxm sargs
      | Map                  -> map_clock_profile lxm sargs
      | BoolRed              -> boolred_clock_profile lxm sargs