[project @ 2001-08-20 10:20:34 by simonmar]

[ghc-hetmet.git] / ghc / compiler / main / HscMain.lhs

diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index d8f4601..2e38352 100644 (file)
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -18,9 +18,10 @@ import ByteCodeGen   ( byteCodeGen )
 import CoreTidy                ( tidyCoreExpr )
 import CorePrep                ( corePrepExpr )
 import Rename          ( renameStmt, renameRdrName )
-import RdrName          ( mkUnqual, mkQual )
+import RdrName          ( rdrNameOcc, setRdrNameOcc )
 import RdrHsSyn                ( RdrNameStmt )
-import OccName          ( varName, dataName, tcClsName )
+import OccName          ( dataName, tcClsName, 
+                         occNameSpace, setOccNameSpace )
 import Type            ( Type )
 import Id              ( Id, idName, setGlobalIdDetails )
 import IdInfo          ( GlobalIdDetails(VanillaGlobal) )
@@ -28,7 +29,7 @@ import HscTypes               ( InteractiveContext(..) )
 import PrelNames       ( iNTERACTIVE )
 import StringBuffer    ( stringToStringBuffer )
 import FastString       ( mkFastString )
-import Char            ( isLower )
+import Char            ( isUpper )
 import DriverUtil      ( split_longest_prefix )
 #endif
 
@@ -202,6 +203,7 @@ hscRecomp ghci_mode dflags have_object
  = do  {
          -- what target are we shooting for?
        ; let toInterp = dopt_HscLang dflags == HscInterpreted
+       ; let toNothing = dopt_HscLang dflags == HscNothing
 
        ; when (verbosity dflags >= 1) $
                hPutStrLn stderr ("Compiling " ++ 
@@ -359,19 +361,23 @@ hscRecomp ghci_mode dflags have_object
                          mkFinalIface ghci_mode dflags location 
                                    maybe_checked_iface new_iface tidy_details
 
-                   ------------------  Code generation ------------------
-                   abstractC <- _scc_ "CodeGen"
-                                 codeGen dflags this_mod imported_modules
-                                        cost_centre_info fe_binders
-                                        local_tycons stg_binds
-                   
-                   ------------------  Code output -----------------------
-                   (stub_h_exists, stub_c_exists)
-                      <- codeOutput dflags this_mod local_tycons
-                            binds stg_binds
-                            c_code h_code abstractC
-                       
-                   return (stub_h_exists, stub_c_exists, Nothing, final_iface)
+                   if toNothing 
+                      then do
+                         return (False, False, Nothing, final_iface)
+                     else do
+                         ------------------  Code generation ------------------
+                         abstractC <- _scc_ "CodeGen"
+                                       codeGen dflags this_mod imported_modules
+                                              cost_centre_info fe_binders
+                                              local_tycons stg_binds
+                         
+                         ------------------  Code output -----------------------
+                         (stub_h_exists, stub_c_exists)
+                            <- codeOutput dflags this_mod local_tycons
+                                  binds stg_binds
+                                  c_code h_code abstractC
+                             
+                         return (stub_h_exists, stub_c_exists, Nothing, final_iface)
 
        ; let final_details = tidy_details {md_binds = []} 
 
@@ -576,7 +582,7 @@ hscParseStmt dflags str
 
       case parseStmt buf PState{ bol = 0#, atbol = 1#,
                                 context = [], glasgow_exts = glaexts,
-                                loc = mkSrcLoc SLIT("<no file>") 0 } of {
+                                loc = mkSrcLoc SLIT("<interactive>") 1 } of {
 
        PFailed err -> do { hPutStrLn stderr (showSDoc err);
 --     Not yet implemented in <4.11    freeStringBuffer buf;
@@ -618,20 +624,23 @@ hscThing dflags hst hit pcs0 icontext str
    = do let 
          InteractiveContext {
             ic_rn_env   = rn_env,
-            ic_type_env = type_env,
             ic_module   = scope_mod } = icontext
 
-         rdr_names
-            | '.' `elem` str 
-               = [ mkQual ns (fmod,fvar) | ns <- namespaces var ]
-            | otherwise
-               = [ mkUnqual ns fstr | ns <- namespaces str ]
-            where (mod,var) = split_longest_prefix str '.'
-                  fmod = mkFastString mod
-                  fvar = mkFastString var
-                  fstr = mkFastString str
-                  namespaces s | isLower (head s) = [ varName ]
-                               | otherwise        = [ tcClsName, dataName ]
+       maybe_rdr_name <- myParseIdentifier dflags str
+       case maybe_rdr_name of {
+         Nothing -> return (pcs0, []);
+         Just rdr_name -> do
+
+       -- if the identifier is a constructor (begins with an
+       -- upper-case letter), then we need to consider both
+       -- constructor and type class identifiers.
+       let rdr_names
+               | occNameSpace occ == dataName = [ rdr_name, tccls_name ]
+               | otherwise                    = [ rdr_name ]
+             where
+               occ        = rdrNameOcc rdr_name
+               tccls_occ  = setOccNameSpace occ tcClsName
+               tccls_name = setRdrNameOcc rdr_name tccls_occ
 
        (pcs, unqual, maybe_rn_result) <- 
           renameRdrName dflags hit hst pcs0 scope_mod scope_mod 
@@ -650,7 +659,25 @@ hscThing dflags hst hit pcs0 icontext str
                let maybe_ty_things = map (lookupType hst (pcs_PTE pcs)) names
                in
                return (pcs, catMaybes maybe_ty_things) }
-        }}
+        }}}
+
+myParseIdentifier dflags str
+  = do buf <- stringToStringBuffer str
+ 
+       let glaexts | dopt Opt_GlasgowExts dflags = 1#
+                  | otherwise                   = 0#
+
+       case parseIdentifier buf 
+               PState{ bol = 0#, atbol = 1#,
+                       context = [], glasgow_exts = glaexts,
+                       loc = mkSrcLoc SLIT("<interactive>") 1 } of
+
+         PFailed err -> do { hPutStrLn stderr (showSDoc err);
+                             freeStringBuffer buf;
+                              return Nothing }
+
+         POk _ rdr_name -> do { --should, but can't: freeStringBuffer buf;
+                                return (Just rdr_name) }
 #endif
 \end{code}