{- |
Module      : Language.Egison.Match
Licence     : MIT

This module defines some data types Egison pattern matching.
-}

module Language.Egison.Match
    ( Match
    , MatchingTree (..)
    , MatchingState (..)
    , PatternBinding
    , LoopPatContext (..)
    , SeqPatContext (..)
    , nullMState
    , MatchM
    , matchFail
    ) where

import           Control.Monad.Trans.Maybe

import           Language.Egison.Data
import           Language.Egison.IExpr

--
-- Pattern Matching
--

type Match = [Binding]

data MatchingState
  = MState { MatchingState -> Env
mStateEnv      :: Env
           , MatchingState -> [LoopPatContext]
loopPatCtx     :: [LoopPatContext]
           , MatchingState -> [SeqPatContext]
seqPatCtx      :: [SeqPatContext]
           , MatchingState -> [Binding]
mStateBindings :: [Binding]
           , MatchingState -> [MatchingTree]
mTrees         :: [MatchingTree]
           }

instance Show MatchingState where
  show :: MatchingState -> String
show MatchingState
ms = String
"(MState " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String
"_", String
"_", String
"_", [Binding] -> String
forall a. Show a => a -> String
show (MatchingState -> [Binding]
mStateBindings MatchingState
ms), [MatchingTree] -> String
forall a. Show a => a -> String
show (MatchingState -> [MatchingTree]
mTrees MatchingState
ms)] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

data MatchingTree
  = MAtom IPattern WHNFData Matcher
  | MNode [PatternBinding] MatchingState
  deriving Int -> MatchingTree -> ShowS
[MatchingTree] -> ShowS
MatchingTree -> String
(Int -> MatchingTree -> ShowS)
-> (MatchingTree -> String)
-> ([MatchingTree] -> ShowS)
-> Show MatchingTree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatchingTree] -> ShowS
$cshowList :: [MatchingTree] -> ShowS
show :: MatchingTree -> String
$cshow :: MatchingTree -> String
showsPrec :: Int -> MatchingTree -> ShowS
$cshowsPrec :: Int -> MatchingTree -> ShowS
Show

type PatternBinding = (String, IPattern)

data LoopPatContext = LoopPatContext (String, ObjectRef) ObjectRef IPattern IPattern IPattern

data SeqPatContext
  = SeqPatContext [MatchingTree] IPattern [Matcher] [WHNFData]
  | ForallPatContext [Matcher] [WHNFData]

nullMState :: MatchingState -> Bool
nullMState :: MatchingState -> Bool
nullMState MState{ mTrees :: MatchingState -> [MatchingTree]
mTrees = [] }                = Bool
True
nullMState MState{ mTrees :: MatchingState -> [MatchingTree]
mTrees = MNode [PatternBinding]
_ MatchingState
state : [MatchingTree]
_ } = MatchingState -> Bool
nullMState MatchingState
state
nullMState MatchingState
_                                    = Bool
False

--
-- Monads
--

type MatchM = MaybeT EvalM

matchFail :: MatchM a
matchFail :: MatchM a
matchFail = EvalM (Maybe a) -> MatchM a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (EvalM (Maybe a) -> MatchM a) -> EvalM (Maybe a) -> MatchM a
forall a b. (a -> b) -> a -> b
$ Maybe a -> EvalM (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing