-- Translation of Yhc Core expressions to Core Erlang expressions.

module Yhc.Core.BackEnd.Erlang.TransExpr (
  expr2EX)

where

import Yhc.Core.Extra
import Yhc.Core.BackEnd.Erlang.EGMonad
import Yhc.Core.BackEnd.Erlang.CorePrep
import Yhc.Core.BackEnd.Erlang.Maps
import Yhc.Core.BackEnd.Erlang.TransPrim
import Yhc.Core.BackEnd.Erlang.TT.Bkeep
import Yhc.Core.BackEnd.Erlang.TT.Ecore
import Data.List
import Data.Char
import Data.Maybe
import qualified Data.Map as M
import qualified Data.Set as S

-- Convert a Yhc Core expression to Erlang Core expression.

expr2EX :: CoreExpr -> EGM EXpr

-- Position annotation (removed).

expr2EX (CorePos _ x) = expr2EX x

-- Literals.

expr2EX (CoreLit (CoreChr c)) = return $ EXnum $ fromIntegral $ ord c
    
expr2EX (CoreLit (CoreInt i)) = return $ EXnum $ fromIntegral i

expr2EX (CoreLit (CoreInteger j)) = return $ EXnum j

expr2EX (CoreLit (CoreFloat f)) = return $ EXfloat $ realToFrac f

expr2EX (CoreLit (CoreDouble d)) = return $ EXfloat d

expr2EX (CoreLit (CoreStr s)) = return $ erlList $ map (EXnum . fromIntegral . ord) s

-- Case statements. Generally, scrutinee variable should be forced explicitly.
-- There are however exceptions: avariable that is already a case variable (that is,
-- forced), and a variable that is current function's formal argument, and the function
-- is strict on it.

expr2EX (CoreCase (CoreVar cv) ptex) = do
  currf <- gets currFun
  iscv <- checkCVar cv
  let cvidx = elemIndex (cv ++ "_f") (coreFuncArgs currf)
  if iscv || isJust cvidx
    then do
      storeCVar cv
      epats <- mapM pat2EClause ptex
      return $ EXcase ['_':(map sq2d cv)] epats
    else do
      let cv' = cv ++ "_c"
          vmap = M.fromList [(cv, cv')]
          ncase = mapVarsInExpr vmap (CoreCase (CoreVar cv') ptex)
          ncexp = CoreLet [(cv', CoreApp (CoreFun fnforce) [CoreVar cv])] ncase
      storeCVar cv'
      expr2EX ncexp
      

expr2EX (CoreCase e ptex) = do
  cvn <- getCnt
  cvset <- gets caseVars
  let ncv = "e_" ++ show cvn ++ "_c"
      ec = CoreLet [(ncv, CoreApp (CoreFun fnforce) [e])] (CoreCase (CoreVar ncv) ptex)
  storeCVar ncv
  expr2EX ec


-- Just a variable, resolves to its name prefixed with underscore.

expr2EX (CoreVar v) = return $ EXvar ('_':(map sq2d v))

-- Function is passed as a 4-tuple {'@fun'|'@prim', M, F, A}

expr2EX (CoreFun f) = do
  core <- gets coreRef
  xfn <- transFname f
  modnm <- gets emodName
  anno <- gets coreAnno
  case coreFuncMaybe core f of
    Nothing -> return $ EXunknown $ "unknown function " ++ f
    Just cf | isCorePrim cf ->
      case prim2bifAnno cf anno of
        Just (m, f, a) -> 
          return $ EXtuple [EXatom "@prim", EXatom m, EXatom f, EXnum (fromIntegral a)]
        Nothing -> return $ EXunknown $ "unknown primitive " ++ f
    Just cf -> return $ EXtuple [EXatom "@fun", EXatom modnm, EXatom xfn,
                                 EXnum (fromIntegral $ coreFuncArity cf)]

-- Constructor passed as a 4-tuple {'@tag', M, F, A}

expr2EX (CoreCon c) = do
  core <- gets coreRef
  modnm <- gets emodName
  ctn <- transCName c
  case coreCtorMaybe core c of
    Nothing -> return $ EXunknown $ "unknown conctructor " ++ c
    Just ct -> return $ EXtuple [EXatom "@tag", EXatom ctn,
                                 EXnum (fromIntegral $ length $ coreCtorFields ct)]

-- Let expression (not assumed to be a letrec).

expr2EX (CoreLet ls e) = do
  let vs = map (('_':) . (map sq2d) . fst) ls
  es <- mapM (expr2EX . snd) ls
  ee <- expr2EX e
  return $ EXlet vs es ee

-- Special case: force primitive application.

expr2EX (CoreApp (CoreFun fn) [arg]) | fn == fnforce = do
  marg <- expr2EX arg
  return $ EXforce marg

-- Special case: SEL_ELEM (data field selection).

expr2EX (CoreApp (CoreFun "SEL_ELEM") [_, dt, fld]) = do
  mdt <- expr2EX (CoreApp (CoreFun fnforce) [dt])
  mfld <- expr2EX (CoreApp (CoreFun fnforce) [fld])
  return $ EXcall (EXatom "yc2erl") (EXatom "sel_elem") [EXatom ".", mdt, mfld]

-- Saturated call to a function: needs less checks to evaluate.
-- Most general application: constructs a tuple {'@ap', f-expr, [args]}.

expr2EX (CoreApp e args) = do
  me:margs <- mapM expr2EX (e:args)
  case me of
    EXtuple [EXatom fpr, EXatom modnm, EXatom ctn, EXnum arity] 
      | fpr `elem` ["@fun", "@prim"] && arity == fromIntegral (length args) ->
        return $ EXtuple [EXatom "@sat", EXatom fpr, EXatom modnm, EXatom ctn, erlList margs]
    _ -> return $ EXthunk me margs

expr2EX z = return (EXunknown $ "unknown: " ++ showRaw z)

-- Convert a Yhc Core pattern to Erlang Core clause

pat2EClause (PatLit (CoreChr c), ce) = do
  ece <- expr2EX ce
  return $ EClause [EPnum $ fromIntegral $ ord c] [EXatom "true"] [ece]

pat2EClause (PatLit (CoreInt i), ce) = do
  ece <- expr2EX ce
  return $ EClause [EPnum $ fromIntegral i] [EXatom "true"] [ece]

pat2EClause (PatLit (CoreInteger i), ce) = do
  ece <- expr2EX ce
  return $ EClause [EPnum $ fromIntegral i] [EXatom "true"] [ece]

pat2EClause (PatCon cn [], ce) = do
  ece <- expr2EX ce
  at <- transCName cn
  return $ EClause [EPatom at] [EXatom "true"] [ece]

pat2EClause (PatCon cn dvs, ce) = do
  ece <- expr2EX ce
  xcn <- transCName cn
  return $ EClause [EPtuple $ [EPatom xcn, EPtuple $ map (EPvar . ('_':)) dvs]]
                   [EXatom "true"] [ece]

pat2EClause (PatDefault, ce) = do
  ece <- expr2EX ce
  return $ EClause [EPdcare] [EXatom "true"] [ece]

-- Selectively force an expression.

selForce :: EXpr -> EGM EXpr

-- If expression to force is a case variable, don't force it.
-- Nor do force it if it is all of function's strict-on arguments.

selForce z@(EXvar ('_':v)) = do
  cvset <- gets caseVars
  currf <- gets currFun
  iscv <- checkCVar v
  let cfargs = coreFuncArgs currf
  if iscv || (v ++ "_f") `elem` cfargs
    then return z
    else return (EXforce z)

selForce z@(EXnum _) = return z

selForce z@(EXfloat _) = return z

selForce z = return (EXforce z)