Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : type-nats
http://hackage.haskell.org/trac/ghc/changeset/8ae3861806c5dc27d51334901779c7bcc6dee295 >--------------------------------------------------------------- commit 8ae3861806c5dc27d51334901779c7bcc6dee295 Author: Iavor S. Diatchki <[email protected]> Date: Sun Apr 29 20:18:01 2012 -0700 Add a stub for where the type-nat solver will reside. >--------------------------------------------------------------- compiler/typecheck/TcInteract.lhs | 6 ++++- compiler/typecheck/TcTypeNats.hs | 44 +++++++++++++++++++++++++++++++----- 2 files changed, 43 insertions(+), 7 deletions(-) diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs index c62c778..ebf8f76 100644 --- a/compiler/typecheck/TcInteract.lhs +++ b/compiler/typecheck/TcInteract.lhs @@ -57,6 +57,8 @@ import Pair () import UniqFM import FastString ( sLit ) import DynFlags + +import TcTypeNats \end{code} ********************************************************************** * * @@ -219,7 +221,9 @@ thePipeline = [ ("lookup-in-inerts", lookupInInertsStage) , ("canonicalization", canonicalizationStage) , ("spontaneous solve", spontaneousSolveStage) , ("interact with inerts", interactWithInertsStage) - , ("top-level reactions", topReactionsStage) ] + , ("top-level reactions", topReactionsStage) + , ("type-nat solver", typeNatStage) + ] \end{code} diff --git a/compiler/typecheck/TcTypeNats.hs b/compiler/typecheck/TcTypeNats.hs index 2934ed4..c628ab0 100644 --- a/compiler/typecheck/TcTypeNats.hs +++ b/compiler/typecheck/TcTypeNats.hs @@ -3,19 +3,51 @@ module TcTypeNats where import Data.Maybe(isNothing) import Control.Monad(guard, msum, mzero, liftM2, liftM3) -import TcRnTypes( Xi, Ct(..) ) +import Var(Var) +import TcRnTypes( Xi, Ct(..), isGiven, isWanted ) import PrelNames( typeNatLeqClassName , typeNatAddTyFamName , typeNatMulTyFamName , typeNatExpTyFamName ) -import TyCon(tyConName) -import Class(className) -import Type(getTyVar_maybe, isNumLitTy, mkTyVarTy, mkNumLitTy) +import TyCon( tyConName ) +import Class( className ) +import Type( getTyVar_maybe, isNumLitTy, mkTyVarTy, mkNumLitTy ) +import TcSMonad( TcS, emitFrozenError {-, setEvBind-} ) +import TcCanonical( StopOrContinue(..) ) -import TcTypeNatsEval (minus,divide,logExact,rootExact) +import TcTypeNatsEval ( minus, divide, logExact, rootExact ) import TcTypeNatsRules() -import Var(Var) + + +-------------------------------------------------------------------------------- + +typeNatStage :: Ct -> TcS StopOrContinue +typeNatStage ct + + -- XXX: Probably need to add the 'ct' to somewhere + | impossible ct = + do emitFrozenError flav (cc_depth ct) + return Stop + + | isGiven flav = + case solve ct of + Just _ -> return Stop -- trivial fact + _ -> return $ ContinueWith ct -- XXX: TODO (compute new work) + + | isWanted flav = + case solve ct of + Just _ -> return $ ContinueWith ct --- XXX: setEvBind + Nothing -> return $ ContinueWith ct --- XXX: Try improvement here + + -- XXX: TODO + | otherwise = return $ ContinueWith ct + + + where flav = cc_flavor ct + + + -------------------------------------------------------------------------------- data Term = V Var | N Integer _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
