[commit: ghc] type-nats: Add a stub for where the type-nat solver will reside. (8ae3861)

[Iavor Diatchki]

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 <iavor.diatchki at gmail.com>
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