[make jhci use both new and old typechecker
John Meacham <john@repetae.net>**20051208070828] hunk ./FrontEnd/Tc/Main.hs 1
-module FrontEnd.Tc.Main (tiProgram, makeProgram ) where
+module FrontEnd.Tc.Main (tiExpr, makeProgram ) where
hunk ./FrontEnd/Tc/Main.hs 97
+{-
hunk ./FrontEnd/Tc/Main.hs 111
-
+-}
hunk ./FrontEnd/Tc/Main.hs 128
-tiExpr e typ = error $ "tiExpr: not implemented for: " ++ (show e,show typ)
+tiExpr e typ = error $ "tiExpr: not implemented for: " ++ show (e,typ)
hunk ./FrontEnd/Tc/Main.hs 152
-tiPat (HsPNeg pat) = tiPat pat
+tiPat (HsPNeg pat) typ = tiPat pat typ
hunk ./FrontEnd/Tc/Main.hs 154
+{-
hunk ./FrontEnd/Tc/Main.hs 214
+-}
hunk ./FrontEnd/Tc/Main.hs 936
-tiProgram = undefined
+--tiProgram = undefined
hunk ./FrontEnd/Tc/Monad.hs 15
+    unifyList,
hunk ./FrontEnd/Tc/Monad.hs 37
-import Options(Opt,options)
hunk ./FrontEnd/Tc/Monad.hs 39
+import Options
hunk ./FrontEnd/Tc/Monad.hs 50
-    tcCurrentEnv        :: Map.Map Name Sigma
+    tcCurrentEnv        :: Map.Map Name Sigma,
+    tcOptions           :: Opt  -- module specific options
hunk ./FrontEnd/Tc/Monad.hs 64
-    tcInfoClassHierarchy :: ClassHierarchy,
-    tcInfoOptions :: Opt  -- module specific options
+    tcInfoClassHierarchy :: ClassHierarchy
hunk ./FrontEnd/Tc/Monad.hs 80
-runTc :: TcInfo -> Tc a -> IO a
+runTc :: (MonadIO m,OptionMonad m) => TcInfo -> Tc a -> m a
hunk ./FrontEnd/Tc/Monad.hs 82
+    opt <- getOptions
+    liftIO $ do
hunk ./FrontEnd/Tc/Monad.hs 91
-        tcInfo = tcInfo
+        tcInfo = tcInfo,
+        tcOptions = opt
hunk ./FrontEnd/Tc/Monad.hs 96
+instance OptionMonad Tc where
+    getOptions = asks tcOptions
hunk ./FrontEnd/Tc/Monad.hs 308
-    tcInfoSigEnv = mempty,
-    tcInfoOptions = options
+    tcInfoSigEnv = mempty
hunk ./FrontEnd/Tc/Monad.hs 311
+
+
hunk ./Interactive.hs 3
+import Control.Monad.Reader
+import Control.Monad.Trans
hunk ./Interactive.hs 8
-import Control.Monad.Reader
-import Control.Monad.Trans
hunk ./Interactive.hs 11
+import qualified Text.PrettyPrint.HughesPJ as P
hunk ./Interactive.hs 14
-import qualified Text.PrettyPrint.HughesPJ as P
hunk ./Interactive.hs 25
+import FrontEnd.Tc.Main
+import FrontEnd.Tc.Monad
hunk ./Interactive.hs 37
-import TIMain
+import TIMain(tiProgram)
+import Type(schemeToType,quantify,tv)
hunk ./Interactive.hs 171
-    printStatement stmt'''
+    --printStatement stmt'''
hunk ./Interactive.hs 178
+    tcStatementTc (HsQualifier e)
hunk ./Interactive.hs 198
+
+tcStatementTc :: HsStmt -> In ()
+tcStatementTc HsLetStmt {} = liftIO $ putStrLn "let statements not yet supported"
+tcStatementTc HsGenerator {} = liftIO $ putStrLn "generators not yet supported"
+tcStatementTc (HsQualifier e) = do
+    is@IS { stateHo = ho } <- ask
+    let tcInfo = tcInfoEmpty {
+        tcInfoEnv = Map.map schemeToType (hoAssumps ho),
+        tcInfoSigEnv = mempty,
+        tcInfoModName =  show (stateModule is),
+        tcInfoKindInfo = (hoKinds ho),
+        tcInfoClassHierarchy = (hoClassHierarchy ho)
+
+        }
+    runTc tcInfo $ do
+    (rbox,box) <- newBox
+    ps <- tiExpr e box
+    vv <- rbox
+    qt <- flattenType (ps :=> vv)
+    let vv' = quantify (tv vv) qt
+    liftIO $ putStrLn $ show (text "::" <+> pprint vv' :: P.Doc)
+
+