{-# LANGUAGE FlexibleContexts #-}



module Control.Search.Combinator.For (for, foreach) where



import Control.Search.Language

import Control.Search.GeneratorInfo

import Control.Search.Generator

import Control.Search.Memo

import Control.Search.MemoReader



import Data.Int



import Control.Monatron.Zipper hiding (i,r)

import Control.Monatron.Monatron hiding (Abort, L, state, cont)



forLoop :: (ReaderM Bool m, Evalable m) => Int32 -> Int -> (Eval m) -> Eval m

forLoop n uid (super) = commentEval $

    Eval 

       { 

         structs     = structs super @++@ mystructs 

       , toString    = "for" ++ show uid ++ "(" ++ show n ++ "," ++ toString super ++ ")"

       , treeState_  = treeState_ super

       , initH       = \i -> initE super i @>>>@ return (parent i <== baseTstate i) @>>>@ cachedClone i (cloneBase i)

       , evalState_  = ("counter",Int,const $ return 0) : {- ("cont",Bool,const $ return true) : -} ("ref_count",Int,const $ return 1) : ("parent",THook "TreeState",const $ return Null) : evalState_ super

       , pushLeftH    = push pushLeft

       , pushRightH   = push pushRight

       , nextSameH    = nextSame super

       , nextDiffH    = nextDiff super 

       , bodyH = \i -> dec_ref i >>= \deref -> bodyE super (i `onAbort` deref)

       , addH        = addE super

       , failH       = \i -> failE super i @>>>@ dec_ref i

       , returnH     = \i -> let j deref = i `onCommit` deref

                             in dec_ref i >>= returnE super . j

       , tryH        = \i -> do deref <- dec_ref i

                                tryE super ((i `withField` ("counter", counter)) `onAbort` deref)

       , startTryH   = \i -> do deref <- dec_ref i

                                startTryE super ((i `withField` ("counter", counter)) `onAbort` deref)

       , tryLH       = \i -> tryE_ super i @>>>@ dec_ref i

       , intArraysE  = intArraysE super

       , boolArraysE  = boolArraysE super

       , intVarsE    = intVarsE super

       , deleteH     = error "forLoop.deleteE NOT YET IMPLEMENTED"

       , canBranch   = return True

       , complete    = complete super

       }

  where mystructs = ([],[])

        fs1       = [(field,init) | (field,ty,init) <- evalState_ super]

        parent    = \i -> estate i @=> "parent"

        counter   = \i -> estate i @=> "counter"

        dec_ref    = \i -> let i'     = resetCommit $ i `withBase` ("for_tstate" ++ show uid)

                           in do flag <- ask 

                                 if flag 

                                   then local (const False) $ do

				 	stmt1 <- inits super i'

                                 	stmt2 <- startTryE super (i' `withField` ("counter", counter))

                                        ini <- inite fs1 i'

                                        cc <- cachedClone (cloneBase i) i'

                                        compl <- complete super i

			         	return (dec (ref_count i) 

                                               >>> ifthen (ref_count i @== 0) 

                                                     (   inc (counter i)

                                                     >>> comment ("forLoop: bla 1 (baseTstate i' == \"" ++ rp 0 (baseTstate i') ++ "\", ref_count i' == \"" ++ rp 0 (ref_count i') ++ "\")")

                                                     >>> ifthen (counter i @< IVal n &&& Not compl)

				                           (   SHook ("TreeState for_tstate" ++ show uid ++ ";")

                                                           >>> comment "forLoop: bla 2"

				   			   >>> (baseTstate i' <== parent i)

                                                           >>> comment "forLoop: bla 3"

							   >>> cc

                                                           >>> comment "forLoop: bla 4"

				                           >>> (ref_count i' <== 1)

                                                           >>> comment "forLoop: bla 5"

--				                           >>> (cont i' <== true)

                                                           >>> comment "forLoop: bla 6"

	                                                   >>> ini 

                                                           >>> comment "forLoop: bla 7"

                                                           >>> stmt1 

                                                           >>> comment "forLoop: bla 8"

                                                           >>> stmt2)

						     ))

                                   else return $ dec (ref_count i) >>> ifthen (ref_count i @== 0) (comment "Delete-forLoop-dec_ref" >>> Delete (space $ cloneBase i))

        push dir  = \i -> dir super (i `onCommit` inc (ref_count i))

for

  :: Int32

  -> Search

  -> Search

for n s  = 

  case s of

    Search { mkeval = evals, runsearch = runs } ->

	  Search { mkeval =

	           \super ->

	           do { uid <- get

	              ; put (uid + 1)

	              ; s' <- evals $ mapE (L . L . mmap runL . runL) super

	              ; return $ mapE (L . mmap L . runL) $ forLoop n uid (mapE runL s')

	              }

	         , runsearch   = runs . rReaderT True . runL

	         }



foreach

  :: Int32

  -> ((Info -> Value) -> Search)

  -> Search

foreach n mksearch  = 

        case mksearch (\i -> field i "counter")  of

          Search { mkeval = eval, runsearch = run } ->

           Search { mkeval = 

                    \super ->

                    do { uid <- get

                       ; put (uid + 1)

                       ; s' <- eval $ mapE (L . L . mmap runL . runL) super

                       ; return $ mapE (L . mmap L . runL) $ forLoop n uid (mapE runL s')

                       }

                  , runsearch  = run . rReaderT True . runL

                  }