(** this file hosts the functions defining the functional semantics
    of typical algorithmic skeletons 
    @author Marco Danelutto
    @version 1.0 *) 
module Skeleton = 
struct 

(** definition of stream parallel skeletons come first, the we have 
    data parallel and control parallel skeleton *) 

(** definition of the stream data type. Although Ocaml provides 
    its own stream data type, we define our own in such a way
    functions working on streams can be more easily identified 
    and managed. 
    The type is parametric, in such a way we can define streams of 	
    different types.  *) 
type 'a stream = 
  EmptyStream | Stream of 'a * 'a stream

(** definition of the stream parallel generic construct. 
    It is used to support composition of skeletons that otherwise 
    could not be easily achieved. 
    @param f the function to be mapped onto the stream items
    @param s the stream 
    #return the stream of the results *)
let rec streamer f s = 
  match s with 
   EmptyStream -> EmptyStream
|  Stream(x,y) -> Stream((f x),(streamer f y))

(** stream parallel skeletons: 
   they are defined as second order functions
   operation on streams is managed by a streamer function *)

(** pipeline skeleton: applies stage functions in order. 
    This version just takes 2 functions. Pipeline with more 
    stages may be built out of pipelines of two stages only, 
    E.g. (pipe (pipe f1 f2) (pipe f3 f4)) is a four stage  
    pipeline. 
    @param f the first stage function 
    @param g the second stage function
    @return the function computed by the pipeline, if no input 
       x is given, or the result of applying the pipe to x *) 
let pipe f g = 
  function x -> (g (f x))

(** the n stage pipeline: applies all the function in the list
    to the argument, in order. As functions are represented by 
    a list, they should all have the same type. Therefore
    this is not a true pipeline, as it does not model the pipeline
    with stages computing different types of results.
    @param fl the list of the stage functions 
    @param x input 
    @return the function computed by the pipeline, if no input x given, 
	or the result of applying the pipeline to the input x. *)
let rec pipe_l fl x = 
  match fl with
   [] -> x
|  f::rf -> (pipe_l rf (f x))

(** farm skeleton: applies a function. 
    @param f the function to be applied
    @return the function computed by the farm (i.e. f), if no 
	parameter x is given, otherwise it returns the result of 
	applying the farm onto the input parameter *)
let farm f = function x -> (f x)

(** the farm directly defined on streams.
    Farm f parameter is a function from 'a to 'b. Farm_s parameter f 
    is a function from 'a to 'b as well, this farm processes streams
    and therefore you cannot compose it. As an example: 
    (farm_s (farm_s inc)) is not a correct expression, as it produces
    a farm computing streams of streams, while (farm (farm inc))
    computes correctly and int to int function. 
    @param f the function computed by the farm
    @return the function computed by the farm, if no input data is given,  
    	or the farm computation on the input parameter *) 
let rec farm_s f = 
  function 
    EmptyStream -> EmptyStream
  | Stream (x,y) -> Stream ( (f x),(farm_s f y) )

(** this is the stream version of the pipeline. Same comments as for the
    farm stream version above. *)
let rec pipe_s f g = 
  function 
    EmptyStream -> EmptyStream
  | Stream(x,y) -> Stream((g (f x)), (pipe_s f g y))


(** data parallel skeletons:
   work on arrays (therefore they are implemented
   in terms of array second order functions) 
   In order to operate on streams, they must be
   used as arguments of a streamer call, as for 
   stream parallel skeletons *)

(** the map skeleton, defined using library Array.map function 
    @param f the function to be mapped onto the array elements
    *)
let map f = 
  function x -> 
    Array.map f x

(** alternative definition of the map skeleton, without taking 
    into account the pre-defined Array.map function 
    @param f the function to be applied to the array items *) 
let map1 f x =
  let len = Array.length x in
  let res = Array.create len (f x.(0)) in
    for i=0 to len-1 do
      res.(i) <- (f x.(i))
    done;
  res

(** the reduce skeleton, defined in terms of predefined fold function
    @param f the function to be used to sum up vector elements *)
let reduce f = 
  function x -> 
    let len = Array.length x in 
      Array.fold_right f (Array.sub x 1 (len-1)) x.(0)

(** alternative version of the reduce skeleton, not using pre defined 
    functions. The construction of the result array preserves the correct 
    types. 
    @param f the function to be used to sum up vector elements *) 
let rec reduce1 f x =
  let len = Array.length x in
  let res = ref x.(0) in
    for i=1 to len-1 do
      res := (f !res x.(i))
    done;
  !res

(** parallel prefix skeleton (also known as scan)
    @param f the function to be used to sum up elements in the array
    *) 
let parallel_prefix f x =
  let len = Array.length x in
  let res = Array.create len x.(0) in
    res.(0) <- x.(0);
    for i=1 to len-1 do
      res.(i) <- (f x.(i) res.(i-1))
    done;
  res

(** we define now the stencil data parallel skeleton
    This version only works on vectors. 
    Stencils are defined as lists of indexes to be used 
    to get the stencil items*) 

(** returns an array subitem. Index is taken modulo length of the vector
  @param a the array
  @param i the index 
  @return the (i% array lenght)-th element of the array *)
let item a i = 
  let n = Array.length a in
  a.((i+n) mod n)

(** computes a stencil out of a stencil index set 
   @param f the function to be applied on the stencil
   @param stencil_indexes the definition of the stencil
   @param a the input array
   @return the result of the stencil data parallel skeleton
  *) 
let stencil f stencil_indexes a =
  let n = (Array.length a) in
  let item a i = a.((i+n) mod n) in
  let rec sten a i = 
    function 
      [] -> []
    | j::rj ->  (item a (i+j))::(sten a i rj) in
  let res = Array.create n (f a.(0) (sten a 0 stencil_indexes)) in
  for i=0 to n-1 do
    res.(i) <- (f a.(i) (sten a i stencil_indexes))
  done;
  res

(** the divide and conquer skeleton. 
    @param cs the condition function. If true then split
    @param dc the divide function
    @param bc the base case function
    @param cc the conquer function 
*)
let rec divconq cs dc bc cc x = 
  if(cs x) then (bc x) 
  else (cc (List.map (divconq cs dc bc cc) (dc x)))

 

(** control skeletons: 
   work on single items, to operate on streams they 
   must be passed as arguments in a streamer call  *)

(** the loop_while skeleton. Executes iterations as far as the 
    condition hold true. 
    @param c the condition function
    @param b the loop body function
    @param x the input
    *)
let rec loop_while c b x = 
  match (c x) with 
    true -> (loop_while c b (b x))
  | false -> x

(** the for loop skeleton. Executes iterations a controlled amount
    of times. 
    @param init initial value for the iteration variable
    @param last final value of the iteration variable
    @param inc the increment at each step for the iteration variable 
*) 
let rec loop_for init last inc f x = 
  if(init = last) then (f init x) 
  else (loop_for (init+inc) last inc f (f init x))

(** used to generate a list of indexes
    @param init the initial value
    @param last the final value
    @param inc the increment value
*) 
let rec inds init last inc = 
  if(init=last) then [init]
  else init::(inds (init+inc) last inc)

(** a loop implementation for loops with completely independent 
    iterations. 
    This corresponds to applying a map on the index set. 
    *) 
let loop_forall_indipendent init last inc f x = 
  let iis = (inds init last inc) in 
    let g f x = function i -> (f i x) in 
      List.map (g f x) iis

(** the ifthenelse skeleton. 
    @param c the condition function
    @param t the then function
    @param e the else function
*)
let ifthenelse c t e = 
  function x -> match (c x) with
   true -> (t x) 
  | false -> (e x)

end;;