We define here the functional semantics for the sample skeleton set presented in SPM lessons by means of Ocaml functions.
(** 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;;
(** 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 ;;