===== OCAML functional semantics for the sample skeleton set =====

We define here the functional semantics for the sample skeleton set presented in SPM lessons by means of Ocaml functions. 

  * [[http://backus.di.unipi.it/~marcod/SPM1011/SkelDoc/index.html|Here]] you'll find the ocamldoc documentation for the file. Below, the source file is shown. 
  * [[ocamlfs1|This page]] hosts the preliminary version of functional semantics given in the lesson of March 23

==== Source code ====
<code ocaml Skeleton.ml>
(** 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;;
</code>

<code ocaml Img.ml>
(** Sample usage of Skeleton functional semantics
    We use a dummy Image format (array of array of pixels) 
    and we define some functions over images to be used in 
    pipeline stages. 
    Functions are defined as map s *) 

open Skeleton

(** the type of black and white pixels: levels of gray *)
type bw_pixel = BWP of int;;
(** the type of black and white images: 2 dim array of pixels *)
type bw_image = BWImage of bw_pixel array array;;

(** the type of color pixels: RGB *)
type col_pixel = CP of int * int * int;;
(** the type of color images: 2 dim array of pixels *)
type col_image = Image of col_pixel array array;;

(** sample image definition *)
let p1 = CP(127,127,127);;
let p2 = CP(0,0,64);;
let p3 = CP(0,64,0);;
let p4 = CP(64,0,0);;
let a = Image [| [| p1; p1; p1; p2; p2 |] ; 
                 [| p2; p3; p3; p4; p1 |] ; 
	         [| p1; p1; p1; p1; p1 |] ; 
		 [| p1; p2; p2; p2; p1 |] |];;

(** changes color pixels to black and white *)
let col_to_bw x  = 
  match x with
  CP(r,g,b) -> BWP(r+g+b);;

(** kind of smooth pixel *)
let average = 
  function
    CP(x,y,z) -> 
      let n = ((x+y+z)/3) in 
      CP(n,n,n);;

(** invert colors *)
let invert = function
  CP(r,g,b) -> CP(255-r, 255-g, 255-b);;


(** kind of saturation *)
let sq = function
  CP(r,g,b) -> let msq x = ((x*x) mod 256) in 
    CP((msq r), (msq g), (msq b));;

(** generic stage: takes a pixel processing function (Color to Color) and 
    returns the stage working on the whole array of arrays
    @param f the function to be applied *)
let stage f = 
  function
    Image x -> Image ( (map (map f)) x);;

(** sample stage definitions *)
let stage_average = stage average;;
let stage_sq = stage sq;;

(** color to black and white stage: this could not be defined through stage function
    as the type of the output image changes ... *)
let c_to_bw_stage = function
  Image x -> BWImage((map (map col_to_bw)) x);;

(** sample main program *)
let main = 
  pipe 
    (pipe (stage invert) (stage average))
    c_to_bw_stage ;; 
</code>