GHC Core questions

[Neil Mitchell]

Hi,

Thanks to all the help I've now managed to get GHC Core converted to
Yhc Core (the source is at the end of this mail, if anyone wants a
look). I have three remaining issues:

1) Data types (i.e. data/newtype) are not represented in [CoreBind] at
all, as far as I can tell. Is Core meant to keep a list of the data
types? If not, could they be added?

2) Dictionaries sometimes seem to generate names with different Var's,
but when show'ing those Vars, they result in the same string. Is show
of a Var meant to be sufficient to get uniqueness back? Unfortunately
I don't have a complete example of this, as currently the machine on
which I did the conversion cannot connect to the internet - I will
provide one in a few days.

3) Is it possible to get the Core out of a file without having the
source present? I suspect the answer is no. If so, is there any way to
get the Core from the Prelude/base libraries without building GHC from
source, since the Windows binary does not ship with Prelude.hs etc.

Thanks

Neil

--- GHC -> Yhc convertor ---
-- note: uses the old interface to generate Core, since that matches
the snapshot on
-- the machine I developed it
--
-- some functions are branches are incomplete, purely because I have not
-- encountered them yet

import GHC
import Outputable
import CoreSyn hiding (CoreExpr)
import Var
import Literal

import Yhc.Core

import Data.List


ghcBaseDir = "D:/ghc/ghc-6.7.20070626"


main = do
    core <- loadCoreFile "D:/ghc/Main.hs" "Main"
    case core of
        Just c -> showQuick c -- print $ transBinds c
        _      -> putStrLn "error compiling to Core"


loadCoreFile :: FilePath -> String -> IO (Maybe [CoreBind])
loadCoreFile file modname = do
    s <- newSession (Just ghcBaseDir)

    -- turn on CPP
    flags <- getSessionDynFlags s
    (flags, _) <- parseDynamicFlags flags ["-cpp"]
    setSessionDynFlags s flags

    -- find the target
    target <- guessTarget file Nothing
    addTarget s target
    sc <- load s LoadAllTargets

    -- set the context
    let mkModname = mkModuleName modname
    mod <- findModule s (mkModuleName modname) Nothing
    setContext s [] [mod]

    -- compile to Core
    compileToCore s mkModname file



transBinds :: [CoreBind] -> Core
transBinds xs = Core "Main" [] [] [CoreFunc a [] b | (a,b) <-
concatMap transBind xs]


transBind :: CoreBind -> [(CoreVarName,CoreExpr)]
transBind (NonRec b x) = [transFunc b x]
transBind (Rec xs) = map (uncurry transFunc) xs


transFunc :: Var -> Expr Var -> (CoreVarName,CoreExpr)
transFunc var expr = (show var, transExpr expr)


transExpr :: Expr Var -> CoreExpr
transExpr (Note _ x) = transExpr x
transExpr (Var x) = CoreVar (show x)
transExpr (App a Type{}) = transExpr a
transExpr (App a b) = CoreApp (transExpr a) [transExpr b]
transExpr (Lam a b) = CoreLam [show a] (transExpr b)
transExpr (Lit x) = transLiteral x
transExpr (Let x y) = coreLet (transBind x) (transExpr y)
transExpr (Case on x _ alts) = CoreLet [(show x, transExpr on)] $
CoreCase (CoreVar (show x)) (transAlts alts)
transExpr (Cast{}) = error "transExpr: Cast"


transAlts alts = map transAlt (other ++ def)
    where (def,other) = partition (\(a,b,c) -> a == DEFAULT) alts


transAlt :: Alt Var -> (CoreExpr,CoreExpr)
transAlt (alt,args,x) = case alt of
    DataAlt c -> (CoreApp (CoreCon $ show c) (map (CoreVar . show)
args), transExpr x)
    LitAlt c -> (transLiteral c, transExpr x)
    DEFAULT -> (CoreVar "_", transExpr x)


transLiteral :: Literal -> CoreExpr
transLiteral (MachStr x) = CoreStr (read $ show x)
transLiteral (MachChar x) = CoreChr x
transLiteral x = error $ "transLiteral: " ++ show x


showQuick x = pprTrace "Core binds: " (ppr x) (error "done")