module Control.Search.GeneratorInfo where 



import Control.Search.Language



type TreeState = Value

type EvalState = Value

space i      =  baseTstate i @-> "space"



data Info = Info { baseTstate :: TreeState

                 , path       :: TreeState -> TreeState

                 , abort_     :: [Statement -> Statement] 

	         , commit_    :: [Statement -> Statement]

	         , old        :: Info

                 , clone      :: Info -> Statement

                 , field      :: String -> Value

                 , stackField :: [(String,String)]

                 , treeStateType :: Type

                 , evalStateType :: Type

                 }



(@@) :: Ordering -> Ordering -> Ordering

EQ @@ x = x

x @@ _ = x



instance Ord Info where

  compare a b =    compare (baseTstate a) (baseTstate b) 

                @@ compare (path a $ baseTstate a) (path b $ baseTstate b)

                @@ compare (map ($ Skip) $ abort_ a) (map ($ Skip) $ abort_ b)

                @@ compare (map ($ Skip) $ commit_ a) (map ($ Skip) $ commit_ b)

                @@ compare (clone a (resetClone a)) (clone b (resetClone b))



instance Eq Info where

  a == b = case compare a b of { EQ -> True; _ -> False }



type Field = String



tstate i = path i (baseTstate i)

tstate_type i = treeStateType i



-- VHook ("/* " ++ show (estate_type i) ++ " */ null")

estate i = case estate_type i of

  Pointer (SType (Struct "EvalState" _)) -> Ref (Var $ "st->evalState")

  Pointer (THook "EvalState") -> Ref (Var "st->evalState")

  _ -> (tstate i) @-> "evalState"



estate_type i = evalStateType i



withCommit i f   = i { commit_ = f : commit_ i }

onAbort  i stmt  = i { abort_  = (stmt >>>) : abort_ i  }

onCommit i stmt  = i `withCommit` (stmt >>>)

onCommit' i stmt  = i `withCommit` (>>> stmt)

withPath i p e t = i { path   = p . path i

                     , old    = withPath (old i) p e t

                     , evalStateType = e

                     , treeStateType = t

                     }

withBase i str   = i { baseTstate = Var str, stackField = ("TreeState",str):(stackField i) }



withClone i stmt  = i { clone = \j -> clone i j >>> stmt (i { baseTstate = baseTstate j }) }

withField i (f,g) = i { field = \f' -> if f' == f then g i else field i f' }



resetPath   i     = i { path = id

                      , old  = resetPath $ old i 

                      , treeStateType = Pointer (THook "TreeState")

                      , evalStateType = Pointer (THook "EvalState")

                      }

resetCommit i     = i { commit_ = [const $ comment "Delete-resetCommit" >>> (Delete $ space i)] }

shiftCommit  i     = i { commit_  = tail $ commit_ i }

resetAbort  i     = i { abort_  = [const $ comment "Delete-resetAbort" >>> (Delete $ space i)] }

shiftAbort  i     = i { abort_  = tail $ abort_ i }

resetClone  i     = i { clone = const Skip }



resetInfo i = i { path    = id

                , old     = resetInfo $ old i

                , commit_ = [ const $ comment "Delete-resetInfo-commit_" >>> (Delete $ space i) ]

                , abort_  = [ const $ comment "Delete-resetInfo-abort_" >>> (Delete $ space i), const (comment "reset")]

                , clone   = const Skip

                , treeStateType = Pointer (THook "TreeState")

                , evalStateType = Pointer (THook "EvalState")

	        }



mkInfo name       =

       let i = Info { baseTstate = Var name

                    , path       = id

                    , abort_     = [const $ comment "Delete-mkInfo-abort_" >>> (Delete $ space i)]

                    , commit_    = [const $ comment "Delete-mkInfo-commit_" >>> (Delete $ space i)]

                    , old        = i

                    , clone      = const Skip

                    , field      = \f -> error ("unknown field `" ++ f ++ "'")

                    , stackField = []

                    , treeStateType = Pointer (THook "TreeState")

                    , evalStateType = Pointer (THook "EvalState")

                    }

       in i



info = mkInfo "st->estate"



newinfo i n = 

       Info { baseTstate = Var $ "nstate" ++ n

            , path       = id

            , abort_     = [const Skip]

	    , commit_    = [const Skip]

            , old        = resetPath i

            , clone      = const Skip

            , field      = \f -> error ("unknown field `" ++ f ++ "'")

            , stackField = [("TreeState","nstate" ++ n)]

            , treeStateType = Pointer (THook "TreeState")

            , evalStateType = Pointer (THook "EvalState")

            }



commit i = go $ commit_ i

 where go []     = Skip

       go (f:fs) = f (go fs)

abort i = go $ abort_ i 

 where go []     = Skip

       go (f:fs) = f (go fs)



primClone i = \j -> space j <== Clone (space i)



cloneIt i j = primClone i j >>> clone i j