module DCBM where

import Fwif
import Types
import Delay
import DbParallel

{-
  The function "delaya" is used to simulate disk accesses.
  The first argument to the function is the delay (in milliseconds).
  The second argument is the address of the disk.

  Disks are assumed to be distributed one per PE.  The function
  distributes delays evenly based on the value of the address.

    delaya :: Int -> Int -> Int

-}


{-
  The following function checks the returned message from a transaction, returning
  True if the transaction has committed, otherwise False.
-}

isok :: (Msgt, tree) -> Bool
isok (Ok k, t) =     True
isok (Error k, t) =  False

{-
  The following function builds a 2-3 tree. The function takes 4
  arguments. The first argument is the first record-id the tree should
  contain and the second argument is the last record-id that the tree
  should contain, i.e. the tree should contain accound records with
  indices from "lo" to "u". "lev" is the current level in the tree. When
  the buildtree funciton is called lev schould be equal to 1. This
  parameter is used to determine if the sub-trees are to be built in
  parallel. "nrec" is the maximum number of records (account records)
  hat can fit into one leaf node (disk-block/sector). The tree is build
  in parallel in the 5 upper levels. This attempts to well distributed
  (hopefully) data amongst the processors. The creation of the tree is
  done in the following way: 1) if the number of records to process
  ("diff") is less or equal to the number of records one leaf node can
  take then a single tip-node will be created. 2) if the number of
  records to put into the tree can fit into 2 tip nodes then a binary
  tree node will be created and the records distributed equaly amongst
  its sub-trees. 3) if none of 1 or 2 then a B-tree node of order 3 (2
  keys and 3 children) will be created and the records distributed
  equally amongst its children.  In Job/prog.new/bu.tr.15.x.40 it was
  shown that creation of the tree in parallel in the 5 or 6 upper levels
  was most efficient.
-}


buildtree :: Int -> Int -> Int -> Int -> Tree

buildtree lo u  lev nrec =
	if diff <= nrec then
		res_t

	else if diff <= 2*nrec then
		lt_1 `seqt` rt_1 `seqt` res_1

	else if lev <= 5 then
		rt_2 `seqt` res_2

	else
		lt_2 `seqt` mt_2 `seqt` rt_2 `seqt` res_2

	where
		diff	= u - lo + 1

		k_1	= lo + diff `quot` 2 - 1
		lt_1	= buildtree  lo		k_1	(lev+1)	nrec
		rt_1	= buildtree  (k_1+1)	u	(lev+1)	nrec

		k1_2	= lo + diff `quot` 3 - 1
		k2_2	= u  - diff `quot` 3
		lt_2	= buildtree  lo		k1_2	(lev+1)	nrec
		mt_2	= buildtree  (k1_2+1)	k2_2	(lev+1)	nrec
		rt_2	= buildtree  (k2_2+1)	u	(lev+1)	nrec

		res_t	= Tip_Acc lo diff

		res_1	= k_1 `seqi` Node1 lt_1 k_1 rt_1
		res_2	= k1_2 `seqi` k2_2 `seqi` Node2 lt_2 k1_2 mt_2 k2_2 rt_2



{-
  The following function builds a tree containing only teller records. This tree is a	
  simple binary tree and it has only one record in each leaf node. The initial values	
  of the Teller record are a balance=0 and the Branch.ID which is chosen, "randomly",	
  to be the teller_Id modulo the tps. The function takes 3 arguments. The function	
  builds a tree containing record.ids from "lo" to "u" inclusive.
  "tps" is needed to generate a random number as a function of the Branch.Id.
-}


build_tel_tree :: Int -> Int -> Int -> Tree
build_tel_tree lo u tps =
		if lo == u then
			Tip (Teller lo (lo `mod` tps + 1) 0 (Fill_Tel 1 2))
		else
			Node1 lt k rt
		where
			k = (u - lo) `quot` 2 + lo
			lt = build_tel_tree lo k	tps
			rt = build_tel_tree (k+1) u	tps


{-
  The following function builds a tree containing only Branch records. This tree is a
  simple binary tree and it has only one record in each leaf node. The function builds
  a tree from record.ids "lo" to "u" inclusive.
-}


build_bra_tree :: Int -> Int -> Tree
build_bra_tree lo u =
	if lo == u then
		Tip (Branch lo 0 (Fill_Bra 1 2 3))
	else
		Node1 lt k rt
	where
		k = (u - lo) `quot` 2 + lo
		lt = build_bra_tree lo k
		rt = build_bra_tree (k+1) u

{-
  The following function builds the whole database required in the DebitCredit		
  Benchmark. The function takes 2 arguments. The first "tps" is used in the scaling of	
  the relations and "nrec" is how many record that is assumed to fit into one tip	
  node. The latter one is is just passed onto other sub-functions. The function	
  creates one account tree containing key values from 1 to tps*100,000, a branch tree	
  containing key values from 1 to tps, a teller tree containing the key values from 1	
  to tps*10 and an empty hisory list. All these are created in parallel in order to	
  (in theory anyway) distribute the different relations onto different processors.	
-}


builddb :: Int -> Int -> Dbt
builddb tps nrec =
--	par acc (par tel (seq bra (seq tel (seq acc db))))
	acc `par` tel `par` (bra `seqt` db)
	where
		acc = buildtree 1 (tps*100000)	1	nrec
		bra = build_bra_tree 1  tps
		tel = build_tel_tree 1 (tps*10)	tps
		db  = Root acc bra tel []

{-
  The following function attempts to update the balance in a record with an identity	
  'key' in a tree. The funciton takes the "key", a delta (ammount -ve or +ve), and a	
  tree as arguments. If the tree is a account-tree then a disk delay is included. The	
  disk is assumed to be read and then if the transaction commits (is successful) the	
  block is written back to the disk. Since there are pointers to the old version of	
  disk block there is no need to wait until it is known if the whole DebitCredit	
  transaction commits or aborts.							
-}


replace :: Int -> Int -> Tree -> (Msgt, Tree)

replace key d nd@(Tip_Acc aid nrec) =
	if not is_error && key >= aid && key <= aid+nrec then
	     write_disk 14 (read_disk 13 (Ok key, (Tip_Acc aid nrec)))
	else
	     read_disk 13 (Error key, nd)
	where
		read_disk d cont  =  seqi (read_delay d) cont
			where read_delay n =  delaya n key
		write_disk d cont =  seqi (write_delay d) cont
			where write_delay n = delaya n key

		is_error = (key `quot` 10) `mod`  20 == 0

replace key d (Tip e) =
	if key == get_key e then	
		(Ok key, (Tip (new_ent e)))
	else
		(Error key, (Tip e))
	where
		get_key (Teller a b c fll) = 	a
		get_key (Branch a b fll) = 	a

		new_ent (Teller tid bid bal fll) = 	Teller tid bid (bal+d) fll
		new_ent (Branch bid bal fll) =		Branch bid (bal+d) fll
				

replace key d (Node1 lt k rt) =
	if key > k then
	    (msg_r, Node1 lt k new_rt)
	else
	    (msg_l, Node1 new_lt k rt)

	where
	 	(msg_r, new_rt) = replace key d rt
		(msg_l, new_lt) = replace key d lt


replace key d (Node2 lt k1 mt k2 rt) =
	if key > k2 then
	    (msg_r, Node2 lt k1 mt k2 new_rt)

	else if key > k1 then
	    (msg_m, Node2 lt k1 new_mt k2 rt)

	else
	    (msg_l, Node2 new_lt k1 mt k2 rt)

	where
	       (msg_r, new_rt) = replace key d rt
	       (msg_m, new_mt) = replace key d mt
	       (msg_l, new_lt) = replace key d lt


{-
  The following function represents one DebitCredit transacton. It takes an account
  id -- "aid", a branch id -- "bid", a teller id -- tid, a sum of money either negative
  or positive -- "delta" and a database -- "db" as arguments. The function returns a
  message and a new updated database if the transaction commits, otherwise the
  transaction failed and it returns the original database. For each of the committed
  transactions a record is inserted into the history list, where the record contains	
  the 4 first parameters to this function and a time stamp, which is currently only
  set to 0. In the complete version of the program "ret_msg" is returned and in the
  simplified version of the program the transaction is assumed to commit and "Ok aid"	
  is returned. However, in the latter case the database will always be consistent
  whether the transaction failed or not, even if the return message is assumed to be	
  ok. (It's only the message returned that is affected by the simplification assumption.
-}


dctrans :: Int -> Int -> Int -> Int-> Transaction

dctrans aid bid tid delta db =
	par ret_acc (par ret_bra (par ret_tel
--	(Ok aid, Root ret_acc ret_bra ret_tel ret_his )))
--	(Ok (res `seqd` acct a_result), res)))
	(Ok (acct a_result), Root ret_acc ret_bra ret_tel ret_his)))
	where
		(Root acc bra tel his) = db
--		res = ret_acc `seqt` ret_bra `seqt` ret_tel `seqt`
--		      (ret_his `seql` Root ret_acc ret_bra ret_tel ret_his)

		a_result = replace aid delta acc
		b_result = replace bid delta bra
		t_result = replace tid delta tel
		h_result = (Ok 0, His aid bid tid delta 0:his)

		p = isok a_result && isok b_result && isok t_result

		ret_acc = fwifdb p (snd a_result) acc
		ret_bra = fwifdb p (snd b_result) bra
		ret_tel = fwifdb p (snd t_result) tel
		ret_his = if p then snd h_result else his


acct (Ok aid,_) = 	aid
acct (Error aid,_) = 	aid


{-
  The following function attempts to create a list of "n" random
  DebitCredit transactions. The randomly number aid is chosen with
  respect of the size of the database and hence to the scaling factor,
  which is dependent of the "tps". The sub-function 'txs_maker' takes a
  list of random numbers and creates and returns a list of "no" number
  of 'dctrans' transactions. The function randtxs takes also the "tps
  for use in scaling of the parameters to 'dctrans'.
-}

randtxs :: Int -> Int -> [Transaction]

randtxs n tps =
	txs_maker n (my_rnds (tps*100000))
	where
		my_rnds r = f 4364567
		  where
			f a	= abs (((a `quot` m1)*r) `quot` m1) :  f ((mult a b + 1)  `mod`  m)

			b	= 31415821
			m	= 100000000
			m1	= 10000
			b, m, m1 :: Int

			mult :: Int -> Int -> Int
			mult p q =  (((p0*q1+p1*q0)  `mod`  m1)*m1 + p0*q0) `mod` m
			  where
				p1 = p `quot` m1
				p0 = p `mod` m1
				q1 = q `quot` m1
				q0 = q `mod` m1

		txs_maker :: Int -> [Int] -> [Transaction]
		txs_maker 0 a = []
#ifdef PAR
		txs_maker no (w:ws) =  seql rest (this:rest)
#else
		txs_maker no (w:ws) =  this:rest
#endif
		  where this =
			  aid `seqi` bid `seqi` tid `seqi` delta `seqi` dctrans aid bid tid delta
			  where	aid = w `mod` (tps*100000) + 1
				tid = aid `mod` (tps*10) + 1
				bid = tid `mod` tps + 1
				delta = if aid `mod` 2 == 0 then aid `mod` 1000 else -(aid `mod` 1000)
				aid, bid, tid, delta :: Int

			rest = txs_maker (no-1) ws
			rest :: [Transaction]; this :: Transaction

{-

  The following function manages the execution of the transaction
  functions. This function takes a database and a list of transaction
  functions as arguments and returns a stream of output, which is a list
  of messages. This version is a parallel version and has been written
  by KH. There are two version of this function. One that sparks 2 tasks
  to evaluate the current txs function and one to evaluate the rest of
  the txs functions in the list the current task returns the root of the
  database form the current transaction.  However, this version seems to
  not currently work on GRIP and a simplified version has been used.

	--	par ms (par fd (m:ms))	 -- The parallel version.

-}


-- manager :: a -> [a -> (b,a)] -> [b]
manager :: Dbt -> [Transaction] -> [Msgt]

manager d (f:fs) =  par ms ml		 -- The simplified & complete version.	
	where 	fd = f d
		(m,d') = fd
		ms = manager d' fs
		ml = m `seqm` (m:ms)

manager d [] = []


{-
  The following function takes a list of messages and calculates
  something like an average the returned account.id's of the
  processed transactions. This has been done in order to use all
  of the results of the transactions and hence all of the
  transactions have to be evaluated even if lazy evaluation is the
  default.
-}


checksum :: [Msgt] -> Int
checksum (Ok k:xs) =	  (k + checksum xs) `quot` 2
checksum (Error k:xs) =   (k + checksum xs) `quot` 2
checksum [] = 0


{-
  The following function converts a string into an integer.
-}

stoi :: String -> Int
stoi st = stoi' (reverse st)
	where	stoi' [] = 0
		stoi' (x:xs) = fromEnum x - fromEnum '0' + 10 * stoi' xs
