From: simonmar <unknown>
Date: Tue, 21 Nov 2000 10:48:20 +0000 (+0000)
Subject: [project @ 2000-11-21 10:48:20 by simonmar]
X-Git-Tag: Approximately_9120_patches~3289
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=e5ed694b59d3f4debdf86ab44e656568ecec39c9;p=ghc-hetmet.git

[project @ 2000-11-21 10:48:20 by simonmar]
- add default default settings for typecheckExpr
- bugfixes in the interpreter

print (1+2) now works!!
---

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index e1f5e20..2597192 100644
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.6 2000/11/20 16:51:35 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.7 2000/11/21 10:48:20 simonmar Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -129,8 +129,9 @@ doCommand expr = do
 	Nothing -> throwDyn (OtherError "no module context in which to run the expression")
 	Just mod -> do
              dflags <- io (readIORef v_DynFlags)
-             (st, maybe_hvalue) <- 
+             (new_cmstate, maybe_hvalue) <- 
         	io (cmGetExpr (cmstate st) dflags mod expr)
+	     setGHCiState st{cmstate = new_cmstate}
              case maybe_hvalue of
         	Nothing -> return ()
         	Just hv -> io (cmRunExpr hv)
diff --git a/ghc/compiler/ghci/InterpSyn.lhs b/ghc/compiler/ghci/InterpSyn.lhs
index a458fde..fc77ab9 100644
--- a/ghc/compiler/ghci/InterpSyn.lhs
+++ b/ghc/compiler/ghci/InterpSyn.lhs
@@ -305,6 +305,9 @@ pprIExpr (expr:: IExpr con var)
         NonRecP bind body -> doNonRec 'P' bind body
 	NonRecI bind body -> doNonRec 'I' bind body
 
+	RecP binds body -> doRec 'P' binds body
+	RecI binds body -> doRec 'I' binds body
+
         ConApp    i          -> doConApp "" i ([] :: [IExpr con var])
         ConAppI   i a1       -> doConApp "" i [a1]
         ConAppP   i a1       -> doConApp "" i [a1]
@@ -324,6 +327,10 @@ pprIExpr (expr:: IExpr con var)
         doNonRec repchr bind body
            = vcat [text "let" <> char repchr <+> pprIBind bind, text "in", pprIExpr body]
 
+	doRec repchr binds body
+	   = vcat [text "letrec" <> char repchr <+> vcat (map pprIBind binds),
+		text "in", pprIExpr body]
+
         doCasePrim repchr b sc alts def
            = sep [text "CasePrim" <> char repchr 
                      <+> pprIExpr sc <+> text "of" <+> ppr b <+> char '{',
diff --git a/ghc/compiler/typecheck/TcDefaults.lhs b/ghc/compiler/typecheck/TcDefaults.lhs
index b9b74c3..b28b07d 100644
--- a/ghc/compiler/typecheck/TcDefaults.lhs
+++ b/ghc/compiler/typecheck/TcDefaults.lhs
@@ -4,7 +4,7 @@
 \section[TcDefaults]{Typechecking \tr{default} declarations}
 
 \begin{code}
-module TcDefaults ( tcDefaults ) where
+module TcDefaults ( tcDefaults, defaultDefaultTys ) where
 
 #include "HsVersions.h"
 
@@ -24,7 +24,7 @@ import HscTypes		( TyThing(..) )
 \end{code}
 
 \begin{code}
-default_default = [integerTy, doubleTy]
+defaultDefaultTys = [integerTy, doubleTy]
 
 tcDefaults :: [RenamedHsDecl]
 	   -> TcM [Type] 	    -- defaulting types to heave
@@ -32,7 +32,7 @@ tcDefaults :: [RenamedHsDecl]
 				    -- in Disambig.
 tcDefaults decls = tc_defaults [default_decl | DefD default_decl <- decls]
 
-tc_defaults [] = returnTc default_default
+tc_defaults [] = returnTc defaultDefaultTys
 
 tc_defaults [DefaultDecl [] locn]
   = returnTc []		-- no defaults
diff --git a/ghc/compiler/typecheck/TcModule.lhs b/ghc/compiler/typecheck/TcModule.lhs
index 660fe1c..463964b 100644
--- a/ghc/compiler/typecheck/TcModule.lhs
+++ b/ghc/compiler/typecheck/TcModule.lhs
@@ -27,7 +27,7 @@ import TcType		( newTyVarTy )
 import Inst		( plusLIE )
 import TcBinds		( tcTopBinds )
 import TcClassDcl	( tcClassDecls2 )
-import TcDefaults	( tcDefaults )
+import TcDefaults	( tcDefaults, defaultDefaultTys )
 import TcExpr		( tcMonoExpr )
 import TcEnv		( TcEnv, InstInfo(iDFunId), tcExtendGlobalValEnv, 
 			  isLocalThing, tcSetEnv, tcSetInstEnv, initTcEnv, getTcGEnv
@@ -112,6 +112,8 @@ typecheckExpr :: DynFlags
 typecheckExpr dflags pcs hst unqual this_mod (expr, decls)
   = typecheck dflags pcs hst unqual $
 
+ 	 -- use the default default settings, i.e. [Integer, Double]
+    tcSetDefaultTys defaultDefaultTys $
     tcImports pcs hst get_fixity this_mod decls	`thenTc` \ (env, new_pcs, local_inst_info, deriv_binds, local_rules) ->
     ASSERT( null local_inst_info && nullBinds deriv_binds && null local_rules )