-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/CoreRun.ag)
module UHC.Light.Compiler.CoreRun(module UHC.Light.Compiler.CoreRun.Prim
, Mod (..), SExp (..), Exp (..), Alt (..), Pat (..)
, CRArray, CRMArray, emptyCRArray, mkCRArray, craLength, craAssocs, craAssocs'
, Bind
, unit
, RRef (..), noRRef
, Ref2Nm
, Nm2RefMp, nm2RefMpInverse, ref2nmEmpty, ref2nmUnion) where

import UHC.Light.Compiler.Base.Common
import UHC.Light.Compiler.Base.Target
import UHC.Util.Utils
import UHC.Light.Compiler.Ty
import qualified Data.Map as Map
import Data.Maybe
import Data.Char
import Data.List
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
import Control.Applicative
import UHC.Light.Compiler.CoreRun.Prim (RunPrim)
import UHC.Light.Compiler.Foreign






















-- | Fast access sequence
type CRArray x = V.Vector x
type CRMArray x = MV.IOVector x

{-
-- | Make array with lowerbound
mkCRArrayLwb :: Int -> [x] -> CRArray x
mkCRArrayLwb lwb xs = listArray (lwb,lwb+l-1) xs
  where l = length xs
-}

mkCRArray :: [x] -> CRArray x
-- mkCRArray = mkCRArrayLwb 0
mkCRArray = V.fromList
{-# INLINE mkCRArray #-}

emptyCRArray :: CRArray x
emptyCRArray = V.empty -- mkCRArray []
{-# INLINE emptyCRArray #-}

craLength :: CRArray x -> Int
craLength = V.length -- a = h + 1 - l
--  where (l,h) = bounds a
{-# INLINE craLength #-}

-- | Content of array as association list, starting index at 'lwb'
craAssocs' :: Int -> CRArray x -> [(Int,x)]
craAssocs' lwb = zip [lwb ..] . V.toList
{-# INLINE craAssocs' #-}

-- | Content of array as association list, starting index at 0
craAssocs :: CRArray x -> [(Int,x)]
craAssocs = craAssocs' 0
{-# INLINE craAssocs #-}



-- | Bind, just an Exp, addressing is left implicit
type Bind = Exp



-- | Equivalent of '()'
unit :: Exp
unit = Exp_Tup CTagRec emptyCRArray



-- | Identifier references for use during running CoreRun
data RRef
  -- | global reference to module and its entry
  = RRef_Glb
      { rrefMod         :: !Int     -- ^ module
      , rrefEntry       :: !Int     -- ^ entry inside module
      }
  -- | local reference to on stack value
  | RRef_Loc
      { rrefLev         :: !Int     -- ^ level
      , rrefEntry       :: !Int     -- ^ entry inside level
      }
  -- | tag of memory/constructor node referred to by other ref (not yet used)
  | RRef_Tag
      { rrefRef         :: !RRef    -- ^ of what this is the tag
      }
  -- | fld of memory/constructor node referred to by other ref
  | RRef_Fld
      { rrefRef         :: !RRef    -- ^ of what this is a field
      , rrefEntry       :: !Int     -- ^ entry inside level
      }
  -- | debug variant, holding original name
  | RRef_Dbg
      { rrefNm          :: !HsName
      }
  deriving (Eq,Ord)

instance Show RRef where
  show _ = "RRef"

noRRef = RRef_Dbg hsnUnknown



-- | RRef to HsName mapping for use during running when a more informative name is required.
-- The representation is lazily via function
type Ref2Nm = RRef -> Maybe HsName



-- | HsName to RRef mapping for resolving references during translation to CoreRun
type Nm2RefMp = Map.Map HsName RRef

-- | Inverse of a `Nm2RefMp`
nm2RefMpInverse :: Nm2RefMp -> Ref2Nm
nm2RefMpInverse m
  | Map.null m = const Nothing
  | otherwise  = flip Map.lookup inv
  where inv = Map.fromList [ (r,n) | (n,r) <- Map.toList m ]

-- | Empty Ref2Nm
ref2nmEmpty :: Ref2Nm
ref2nmEmpty = const Nothing

-- | Union, left-biased
ref2nmUnion :: Ref2Nm -> Ref2Nm -> Ref2Nm
ref2nmUnion m1 m2 = \r -> m1 r <|> m2 r

-- Alt ---------------------------------------------------------
data Alt = Alt_Alt {ref2nm_Alt_Alt :: !(Ref2Nm),pat_Alt_Alt :: !(Pat),expr_Alt_Alt :: !(Exp)}
-- Exp ---------------------------------------------------------
data Exp = Exp_SExp {sexpr_Exp_SExp :: !(SExp)}
         | Exp_Tup {tag_Exp_Tup :: !(CTag),args_Exp_Tup :: !((CRArray Exp))}
         | Exp_Let {lev_Exp_Let :: !(Int),firstOff_Exp_Let :: !(Int),ref2nm_Exp_Let :: !(Ref2Nm),binds_Exp_Let :: !((CRArray Bind)),body_Exp_Let :: !(Exp)}
         | Exp_App {func_Exp_App :: !(Exp),args_Exp_App :: !((CRArray Exp))}
         | Exp_Lam {lev_Exp_Lam :: !(Int),nrArgs_Exp_Lam :: !(Int),nrBinds_Exp_Lam :: !(Int),stkDepth_Exp_Lam :: !(Int),ref2nm_Exp_Lam :: !(Ref2Nm),body_Exp_Lam :: !(Exp)}
         | Exp_Force {expr_Exp_Force :: !(Exp)}
         | Exp_Ret {expr_Exp_Ret :: !(Exp)}
         | Exp_RetCase {nrBinds_Exp_RetCase :: !(Int),expr_Exp_RetCase :: !(Exp)}
         | Exp_Tail {expr_Exp_Tail :: !(Exp)}
         | Exp_Case {expr_Exp_Case :: !(SExp),alts_Exp_Case :: !((CRArray Alt))}
         | Exp_FFI {prim_Exp_FFI :: !(RunPrim),args_Exp_FFI :: !((CRArray Exp))}
         | Exp_Dbg {msg_Exp_Dbg :: !(String)}
-- Mod ---------------------------------------------------------
data Mod = Mod_Mod {ref2nm_Mod_Mod :: !(Ref2Nm),moduleNm_Mod_Mod :: !(HsName),moduleNr_Mod_Mod :: !(Int),stkDepth_Mod_Mod :: !(Int),binds_Mod_Mod :: !((CRArray Bind)),body_Mod_Mod :: !(Exp)}
-- Pat ---------------------------------------------------------
data Pat = Pat_Con {tag_Pat_Con :: !(CTag)}
         | Pat_BoolExpr {expr_Pat_BoolExpr :: !(Exp)}
-- SExp --------------------------------------------------------
data SExp = SExp_Var {ref_SExp_Var :: !(RRef)}
          | SExp_Int {int_SExp_Int :: !(Int)}
          | SExp_Char {char_SExp_Char :: !(Char)}
          | SExp_String {str_SExp_String :: !(String)}
          | SExp_Integer {integer_SExp_Integer :: !(Integer)}