Strumenti Utente

Strumenti Sito


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.

  • Here you'll find the ocamldoc documentation for the file. Below, the source file is shown.
  • This page hosts the preliminary version of functional semantics given in the lesson of March 23

Source code
(** this file hosts the functions defining the functional semantics
    of typical algorithmic skeletons 
    @author Marco Danelutto
    @version 1.0 *) 
module Skeleton = 
(** 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  
    @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 = 
    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 = 
    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 function 
    @param f the function to be mapped onto the array elements
let map f = 
  function x -> f x
(** alternative definition of the map skeleton, without taking 
    into account the pre-defined 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))
(** 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 
    @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))
(** 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))
(** 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 = 
      [] -> []
    | 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))
(** 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 ( (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 
    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 (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)
(** 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 = 
    CP(x,y,z) -> 
      let n = ((x+y+z)/3) in 
(** 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 = 
    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 (stage invert) (stage average))
    c_to_bw_stage ;; 
magistraleinformaticanetworking/spm/skelfsem.txt · Ultima modifica: 31/03/2011 alle 08:36 (12 anni fa) da Marco Danelutto