Params.hs

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

module Indigo.Compilation.Params
  ( IndigoWithParams
  , AreIndigoParams
  , fromIndigoWithParams
  ) where

import Data.Singletons (Sing)
import Data.Typeable ((:~:)(..), eqT)

import Indigo.Backend.Prelude
import Indigo.Frontend.Program (IndigoM)
import Indigo.Internal.Object
import Indigo.Internal.State
import Indigo.Lorentz
import Util.Peano

----------------------------------------------------------------------------
-- Utility for compatibility with Lorentz
----------------------------------------------------------------------------

-- | Type of a function with @n@ 'Var' arguments and @IndigoM a@ result.
--
-- Note that the arguments are the first @n@ elements of the @inp@ stack in
-- inverse order, for example:
-- @IndigoWithParams (\'S (\'S \'Z)) \'[a, b, c] x@ is the same as:
-- @Var b -> Var a -> IndigoM x@
type family IndigoWithParams n inp a where
  IndigoWithParams 'Z _ a = IndigoM a
  IndigoWithParams ('S n) inp a = Var (At n inp) -> IndigoWithParams n inp a

-- | Typeable and stack size constraint for the parameters of an 'IndigoWithParams'.
type family AreIndigoParams n stk :: Constraint where
  AreIndigoParams 'Z _ = (() :: Constraint)
  AreIndigoParams ('S n) stk = (KnownValue (At n stk), RequireLongerThan stk n, AreIndigoParams n stk)

-- | Converts an 'IndigoWithParams' to its form without input 'Var's, alongside
-- the 'MetaData' to use it with.
-- If there is an 'Ops' to the bottom of the stack it also assigns a 'Var' to it.
fromIndigoWithParams
  :: forall inp n a . (AreIndigoParams n inp, KnownValue a)
  => IndigoWithParams n inp a
  -> MetaData inp
  -> Sing n
  -> (IndigoM a, MetaData inp)
fromIndigoWithParams code md = \case
  SZ -> (code, assignVarToOps md)
  SS n -> let (md2, var) = withVarAt md n in fromIndigoWithParams @inp (code var) md2 n

-- | Assigns a variable to the 'Ops' list at the bottom of the stack iff there is
-- one and it does not have one already. Otherwise returns the same 'MetaData'.
assignVarToOps :: MetaData inp -> MetaData inp
assignVarToOps md@(MetaData stk vRef) = case stk of
  RNil -> md
  (_ :& RNil) -> assingVarIfOps md
  (x :& xs) -> case assignVarToOps $ MetaData xs vRef of
    MetaData xs' vRef' -> MetaData (x :& xs') vRef'

assingVarIfOps :: forall x. MetaData '[x] -> MetaData '[x]
assingVarIfOps md@(MetaData stk vRef) = case stk of
  (Ref _ :& RNil) -> md
  ((NoRef :: StkEl x) :& RNil) -> case eqT @x @Ops of
    Nothing -> md
    Just Refl -> MetaData (Ref vRef :& RNil) (vRef + 1)