(*
%use "Distributions/block.fsh";;
*)


(* some auxiliary functions *)

let ones = 
  folddim zerodim f1
  where f1 n = succdim 1     
;;

let zeroes = folddim zerodim f1
  where f1 n = succdim ~0
;;

let add_shapes = 
  folddim  f0 f1
  where f0 x y = zerodim (undim y) 
  and f1 (n:size) h z = succdim (n + (lendim z)) (h (preddim z))
;;

let add_shapes_plus_one = 
	(* add one to the sum of each pair of sizes *)
  folddim  f0 f1
  where f0 x y = zerodim (undim y) 
  and f1 (n:size) h z = succdim (n+1 +(lendim z)) (h (preddim z))
;;



(* unblock converts an array of arrays to an array, by treating the
entries as blocks of the result.  *)


let unblock_sh sh = extendShape 
			(add_shapes sh (zeroShape sh)) 
			(zeroShape (zeroShape sh))
;;

let unblock_pr (y:var b) (x:var a) = 
new z = shape2array (zeroShape #x) in 
let pr1 ndx0 ndx1 a = 
  new ndx = zipop plus_int ndx1 
		  (zipop times_int ndx0 z)
  in 
    entry ndx y := !a
  end 
in
  let pr0 ndx0 = idoall (pr1 ndx0) 
in 
  idoall pr0 x
end
;;
 
 
let unblock = 
proc2fun unblock_pr unblock_sh 
;;

(*

let test = unblock (fill {2,2:2,2:int_shape} with 
		[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]) ;;

*)


(* block : #[a] -> [b] -> [[b]] is the partial converse,. The first
argument is the shape of the result - ignoring the entryshape.  If the
block division is not exact then the remainder will be filled with
rubbish! There is no flag for marking null entries as yet. *)

let block_sh proc x_sh = 
  extendShape proc 
  (extendShape (shape_zipop snd ceiling_divide proc x_sh) 
  (zeroShape x_sh))
where 
  ceiling_divide (n:size) (s:size) = 		
  let p = s div n in 
  if p * n = s 
  then p
  else p + 1 
;;


let block_pr (y:var b) (x:var a) = 
new z = shape2array (zeroShape #y)
in 
  idoall pr0 y
where pr0 ndx0  = idoall (pr1 ndx0) 
and pr1 ndx0 ndx1 a = 
    new ndx = 	zipop plus_int ndx1 (
		  zipop times_int ndx0 z)	
    in 
      a := entry ndx x 
    end 
end
;;
 


let block proc = proc2fun block_pr (block_sh proc) ;;

(*
let test = block {2,2:int_shape} (fill {4,4:int_shape} with
 		[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]) ;;
*)