SCase.hs

module CLaSH.Signal.Enabled.SCase where

import Data.Default
import Language.Haskell.TH

scase e = do
  e' <- e
  case e' of
    CaseE e2 ms -> do
      nm1 <- newName "eb"
      ms' <- mapM (smatch (VarE nm1)) ms
      return (CaseE e2 ms')
    _ -> error "not a case statement"

smatch :: Exp -> Match -> MatchQ
smatch e (Match (TupP [ConP t ps,VarP n]) b ds) = do
  i  <- reify t
  ms <- mkMatcher (return e) i
  error ("correct: " ++ pprint ms)
smatch _ _ = error "not a tuple with a variable"

mkMatcher :: ExpQ -> Info -> ExpQ
mkMatcher e (DataConI nm ty parenName fixity) = do
    appsE [[| fmap |],simpleMatcher,e]
  where
    simpleMatcher = lamCaseE [ match (recP nm []) (normalB [| True |]) []
                             , match wildP (normalB [| False |]) []
                             ]

mkPattern :: Pat -> ExpQ
mkPattern (ConP t ps) = lamCaseE [ ]