------------------------------------------------------------------
-- |
-- Module      :  Yhc.Core.BackEnd.Erlang
-- Copyright   :  (c) Dmitry Golubovsky, 2008              
-- License     :  BSD-style
-- 
-- Maintainer  :  golubovsky@gmail.com
-- Stability   :  experimental
-- Portability :  portable
-- 
--
--
-- Converter of Yhc Core to Core Erlang
------------------------------------------------------------------

module Yhc.Core.BackEnd.Erlang (
  writeCoreErlang) 
where

import Control.Monad
import System.IO
import System.FilePath
import Yhc.Core.Extra
import qualified Data.Map as M
import qualified Data.Set as S
import Yhc.Core.BackEnd.Erlang.TT.Ecore
import Yhc.Core.BackEnd.Erlang.TT.Epretty
import Yhc.Core.BackEnd.Erlang.EGMonad
import Yhc.Core.BackEnd.Erlang.TransFunc
import Yhc.Core.BackEnd.Erlang.Maps
import Yhc.Core.BackEnd.Erlang.CorePrep

-- |Given the destination path and Yhc Core in memory, write out a Core Erlang module.

writeCoreErlang :: FilePath        -- ^Destination path where to write a Core Erlang module
                -> String          -- ^Desired name of an Erlang module to be generated
                -> CoreAnnotations -- ^Combined annotations from a driver
                -> [CoreFuncName]  -- ^List of exported functions (aka roots)
                -> Core            -- ^Yhc Core generated by a front-end
                -> IO ()           -- ^This function throws an IO exception if anything goes wrong

writeCoreErlang dest modnm canno roots core = do
  let funcs = filter ((/= "main") . coreFuncName) (coreFuncs core)
      strfunc = coreStrictAnno canno core
      fnames = map coreFuncName funcs
      fstrict = map strfunc fnames
      fnstr = zip fnames fstrict
      strmap = M.fromList fnstr
      core' = strictify (const strfunc) (core {coreFuncs = funcs})
      (emod, newst) = core2EM core' modnm roots strmap canno
  fh <- openFile dest WriteMode
  let hput = hPutStrLn fh
  hput "%% --------------  Strictness Map -------------------------------"
  mapM (hput . ("%% " ++) . show) fnstr
  hput "%% ----------------  Yhc Core  ----------------------------------"
  mapM (hput . ("%% " ++)) $ lines $ show core'
  hput "%% --------------  Functions Renamed  ---------------------------"
  mapM (hput . ("%% " ++) . show) (M.assocs $ funcMap newst)
  hput "%% --------------  Erlang Core  ---------------------------------"
  hput (epMod emod)
  hClose fh
  return ()


-- Generate an Erlang module out of Yhc Core

core2EM :: Core 
        -> String 
        -> [CoreFuncName] 
        -> M.Map CoreFuncName [Bool] 
        -> CoreAnnotations 
        -> (EMod, EG)

core2EM core modnm roots strct canno = 
  let env = EG {stateCnt = 1
               ,currFun = CoreFunc {coreFuncName = ""
                                   ,coreFuncArgs = []
                                   ,coreFuncBody = CoreLit (CoreInt 0)}
               ,funcMap = initFuncMap
               ,caseVars = S.empty
               ,strctMap = strct
               ,expFunc = roots
               ,coreRef = core
               ,coreAnno = canno
               ,emodName = modnm}
  in  flip runState env $ do
        let notSkip (EFdef (EFname ("", _)) _ ) = False
            notSkip _ = True
            tocurry (f, a) = (f ++ "_c", 1)
            def2fn (EFdef (EFname (s, a)) _) = (s, a)
        core <- gets coreRef
        efnms <- mapM func2Fname (coreFuncs core) >>= filterM (return . not . null . fst)
        efdefs1 <- mapM func2EFdef (coreFuncs core) >>= filterM (return . notSkip)
        return $ EMod modnm efnms efdefs1