[add renaming of statements to jhci, export renaming function from rename, add some more Warning routines
John Meacham <john@repetae.net>**20051208022800] hunk ./FrontEnd/Rename.hs 64
-module FrontEnd.Rename(unRename, collectDefsHsModule, renameModule, FieldMap ) where
+module FrontEnd.Rename(unRename, collectDefsHsModule, renameModule, FieldMap, renameStatement ) where
hunk ./FrontEnd/Rename.hs 217
+renameStatement :: MonadWarn m => FieldMap -> [(Name,[Name])] -> Module -> HsStmt -> m HsStmt
+renameStatement fls ns modName stmt = mapM_ addWarning (errors finalState) >> return renamedStmt where
+    initialGlobalSubTable = listToFM [ (x,y) | ((typ,x),[y]) <- ns', typ == Val || typ == DataConstructor ]
+    initialTypeSubTable = listToFM [ (x,y) | ((typ,x),[y]) <- ns', typ == TypeConstructor || typ == ClassName ]
+    ns' = map fn ns
+    fn (n,ns) = (fromName n, map nameName ns)
+
+    errorTab =  listToFM [ (x,ambig x ys) | ((typ,x),ys@(_:_:_)) <- ns' ]
+
+    startState = ScopeState {
+        typeSubTable   = initialTypeSubTable,
+        errorTable     = errorTab,
+        nameMap        = Map.empty,
+        errors         = [],
+        srcLoc         = mempty,
+        unique         = 1,   -- start the counting at 1
+        globalSubTable = initialGlobalSubTable,
+        fieldLabels    = fls,
+        currentModule  = modName
+        }
+
+    (renamedStmt, finalState) = runScopeSM startState (renameHsStmt stmt initialGlobalSubTable)
+
+
hunk ./FrontEnd/Warning.hs 1
-module Warning(Warning(..), MonadWarn(..), MonadSrcLoc(..), processErrors, warn, warnF, err, addDiag, addWarn, processIOErrors) where
+module Warning(Warning(..), MonadWarn(..), MonadSrcLoc(..), processErrors, warn, warnF, err, addDiag, addWarn, processIOErrors, printIOErrors) where
hunk ./FrontEnd/Warning.hs 52
-    processErrors ws
+    processErrors' True ws
hunk ./FrontEnd/Warning.hs 55
+-- | just show IO errors and return whether it would have died
+printIOErrors :: IO Bool
+printIOErrors = do
+    ws <- readIORef ioWarnings
+    b <- processErrors' False ws
+    writeIORef ioWarnings []
+    return b
+
hunk ./FrontEnd/Warning.hs 64
-processErrors ws = mapM_ s ws' >> when die exitFailure where
+processErrors ws = processErrors' True ws >> return ()
+
+
+processErrors' :: Bool -> [Warning] -> IO Bool
+processErrors' doDie ws = mapM_ s ws' >> when (die && doDie) exitFailure >> return die where
hunk ./Interactive.hs 3
+import Data.Monoid
hunk ./Interactive.hs 7
+import Monad
hunk ./Interactive.hs 20
+import FrontEnd.Rename
hunk ./Interactive.hs 25
+import Warning
hunk ./Interactive.hs 51
+data InteractiveState = IS {
+    stateHo :: Ho,
+    stateInteract :: Interact
+    }
+
hunk ./Interactive.hs 100
-        Right e -> putStrLn (show e) >> return act
+        Right e -> executeStatement IS { stateHo = ho, stateInteract = act } e >> return act
hunk ./Interactive.hs 114
+executeStatement :: InteractiveState -> HsStmt -> IO ()
+executeStatement IS { stateHo = ho } stmt = do
+    defs <- calcImports ho False (Module "Prelude")
+    stmt' <- renameStatement mempty defs (Module "Main") stmt
+    b <- printIOErrors
+    when (not b) $ putStrLn (show stmt')
+executeStatement _ HsLetStmt {} = putStrLn "let statements not yet supported"
+executeStatement _ HsGenerator {} = putStrLn "generators not yet supported"
+executeStatement _ (HsQualifier e) = putStrLn (show e)
+
+
+calcImports :: Monad m => Ho -> Bool -> Module -> m [(Name,[Name])]
+calcImports ho qual mod = case Map.lookup mod (hoExports ho) of
+    Nothing -> fail $ "calcImports: module not known " ++ show mod
+    Just es -> do
+        let ls = sortGroupUnderFG fst snd
+                [ (n,if qual then [setModule mod n] else [setModule mod n,toUnqualified n]) | n <- es]
+            ls' = concat [ zip (concat nns) (repeat [n]) | (n,nns) <- ls ]
+        return $ Map.toList $ Map.map snub $ Map.fromListWith (++) ls'
+