(** 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;;