Var.hs

-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

module Indigo.Internal.Var
  ( -- * Variables
    Var (..)
  , RefId
  , StackVars
  , StkEl (..)

  -- * Stack operations
  , emptyStack
  , assignVarAt
  , pushRef
  , pushNoRef
  , popNoRef

  -- * Operations/Storage variables
  , Ops
  , HasSideEffects
  , operationsVar
  , HasStorage
  , storageVar
  ) where

import qualified Data.Kind as Kind
import Data.Reflection (Given(..))
import Data.Singletons (Sing)
import Data.Type.Equality (TestEquality(..))
import Data.Typeable (eqT)

import Indigo.Backend.Prelude
import Indigo.Lorentz
import Util.Peano

----------------------------------------------------------------------------
-- Stack and variable definition
----------------------------------------------------------------------------

-- | Reference id to a stack cell
newtype RefId = RefId Word
  deriving stock (Show, Generic)
  deriving newtype (Eq, Ord, Real, Num, Bounded)

-- | Stack element of the symbolic interpreter.
--
-- It holds either a reference index that refers to this element
-- or just 'NoRef', indicating that there are no references
-- to this element.
data StkEl a where
  NoRef :: KnownValue a => StkEl a
  Ref :: KnownValue a => RefId -> StkEl a

instance TestEquality StkEl where
  testEquality NoRef NoRef = eqT
  testEquality (Ref _) (Ref _) = eqT
  testEquality (Ref _) NoRef = eqT
  testEquality NoRef (Ref _) = eqT

-- | Stack of the symbolic interpreter.
type StackVars (stk :: [Kind.Type]) = Rec StkEl stk

-- | A variable referring to an element in the stack.
data Var a = Var RefId
  deriving stock (Generic, Show)

----------------------------------------------------------------------------
-- Stack operations
----------------------------------------------------------------------------

emptyStack :: StackVars '[]
emptyStack = RNil

instance Default (StackVars '[]) where
  def = emptyStack

instance (KnownValue x, Default (StackVars xs)) => Default (StackVars (x ': xs)) where
  def = NoRef :& def

-- | Given a 'StackVars' and a @Peano@ singleton for a depth, it puts a new 'Var'
-- at that depth (0-indexed) and returns it with the updated 'StackVars'.
--
-- If there is a 'Var' there already it is used and the 'StackVars' not changed.
assignVarAt
  :: (KnownValue a, a ~ At n inp, RequireLongerThan inp n)
  => Var a
  -> StackVars inp
  -> Sing n
  -> StackVars inp
assignVarAt var@(Var varRef) md@(top :& xs) = \case
  SS n -> appendToStack top $ assignVarAt var xs n
  SZ -> case top of
    Ref mdRef | mdRef == varRef -> md
    Ref _ -> error "Tried to assign a Var to an already referenced value"
    NoRef -> Ref varRef :& xs
  where
    appendToStack :: StkEl x -> StackVars inp -> StackVars (x ': inp)
    appendToStack v st = v :& st

-- | Push a new stack element with a reference to it, given the variable.
pushRef :: KnownValue a => Var a -> StackVars inp -> StackVars (a & inp)
pushRef (Var ref) xs = Ref ref :& xs

-- | Push a new stack element without a reference to it.
pushNoRef :: KnownValue a => StackVars inp -> StackVars (a & inp)
pushNoRef xs = NoRef :& xs

-- | Remove the top element of the stack.
-- It's supposed that no variable refers to this element.
popNoRef :: StackVars (a & inp) -> StackVars inp
popNoRef (NoRef :& xs) = xs
popNoRef (Ref refId :& _) =
  error $ "You try to pop stack element, which is referenced by some variable #" <> show refId

----------------------------------------------------------------------------
-- Operations/Storage variables
----------------------------------------------------------------------------

type Ops = [Operation]

-- | Allows to get a variable with operations
type HasSideEffects = Given (Var Ops)

-- | Return a variable which refers to a stack cell with operations
operationsVar :: HasSideEffects => Var Ops
operationsVar = given

-- This storage machinery is here to avoid cyclic deps

-- | Allows to get a variable with storage
type HasStorage st = (Given (Var st), KnownValue st)

-- | Return a variable which refers to a stack cell with storage
storageVar :: HasStorage st => Var st
storageVar = given