-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Backend machinery for cases.

module Indigo.Backend.Case
  ( caseRec
  , entryCaseRec
  , entryCaseSimpleRec

  , IndigoCaseClauseL
  , IndigoClause (..)
  , CaseCommonF
  ) where

import Data.Vinyl.Core (RMap(..))
import Fmt (pretty)

import Indigo.Backend.Expr.Compilation (compileExpr)
import Indigo.Backend.Prelude
import Indigo.Backend.Scope
import Indigo.Common.Expr (Expr)
import Indigo.Common.SIS (SomeGenCode(SomeGenCode), SomeIndigoState(SomeIndigoState))
import Indigo.Common.State
import Indigo.Common.Var (Var)
import Indigo.Lorentz
import Lorentz.ADT qualified as L
import Lorentz.Entrypoints.Doc qualified as L
import Lorentz.Instr qualified as L
import Morley.Michelson.Typed.Haskell.Instr.Sum
  (CaseClauseParam(..), CaseClauses, CtorField(..), InstrCaseC)
import Morley.Util.Type (type (++))
import Morley.Util.TypeLits (AppendSymbol)

-- | This type is analogous to the 'CaseClauseL' type but instead of wrapping a Lorentz
-- instruction, this wraps an Indigo value with the same input/output types.
data IndigoCaseClauseL ret (param :: CaseClauseParam) where
  OneFieldIndigoCaseClauseL
    :: (forall inp .
         MetaData inp
      -> CaseClauseL inp (RetOutStack ret ++ inp) ('CaseClauseParam ctor ('OneField x)))
    -> IndigoCaseClauseL ret ('CaseClauseParam ctor ('OneField x))

data IndigoClause x ret where
  IndigoClause
    :: ( KnownValue x
       , ScopeCodeGen retBr
       , ret ~ RetExprs retBr
       , RetOutStack ret ~ RetOutStack retBr
       )
    => Var x
    -- ^ Variable for the clause input value (available to its code block)
    -> (forall inp. SomeIndigoState (x : inp))
    -- ^ Clause code block
    -> retBr
    -- ^ Clause return value(s)
    -> IndigoClause x ret

instance
  (name ~ AppendSymbol "c" ctor, KnownValue x)
  =>
    CaseArrow
      name
      (IndigoClause x ret)
      (IndigoCaseClauseL ret ('CaseClauseParam ctor ('OneField x)))
  where
    /-> :: Label name
-> IndigoClause x ret
-> IndigoCaseClauseL ret ('CaseClauseParam ctor ('OneField x))
(/->) Label name
_ (IndigoClause Var x
varCase forall (inp :: [*]). SomeIndigoState (x : inp)
sIndSt (retBr
ret :: retBr)) =
      (forall (inp :: [*]).
 MetaData inp
 -> CaseClauseL
      inp (RetOutStack ret ++ inp) ('CaseClauseParam ctor ('OneField x)))
-> IndigoCaseClauseL ret ('CaseClauseParam ctor ('OneField x))
forall ret (ctor :: Symbol) x.
(forall (inp :: [*]).
 MetaData inp
 -> CaseClauseL
      inp (RetOutStack ret ++ inp) ('CaseClauseParam ctor ('OneField x)))
-> IndigoCaseClauseL ret ('CaseClauseParam ctor ('OneField x))
OneFieldIndigoCaseClauseL ((forall (inp :: [*]).
  MetaData inp
  -> CaseClauseL
       inp (RetOutStack ret ++ inp) ('CaseClauseParam ctor ('OneField x)))
 -> IndigoCaseClauseL ret ('CaseClauseParam ctor ('OneField x)))
-> (forall (inp :: [*]).
    MetaData inp
    -> CaseClauseL
         inp (RetOutStack ret ++ inp) ('CaseClauseParam ctor ('OneField x)))
-> IndigoCaseClauseL ret ('CaseClauseParam ctor ('OneField x))
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md@MetaData{DecomposedObjects
StackVars inp
GenCodeHooks
mdHooks :: forall (inp :: [*]). MetaData inp -> GenCodeHooks
mdObjects :: forall (inp :: [*]). MetaData inp -> DecomposedObjects
mdStack :: forall (inp :: [*]). MetaData inp -> StackVars inp
mdHooks :: GenCodeHooks
mdObjects :: DecomposedObjects
mdStack :: StackVars inp
..} -> case SomeIndigoState (x : inp)
forall (inp :: [*]). SomeIndigoState (x : inp)
sIndSt of
        (SomeIndigoState MetaData (x : inp) -> SomeGenCode (x : inp)
body :: SomeIndigoState (x : inp)) ->
          -- Create a reference to the top of stack
          case MetaData (x : inp) -> SomeGenCode (x : inp)
body (Var x -> MetaData inp -> MetaData (x : inp)
forall a (inp :: [*]).
KnownValue a =>
Var a -> MetaData inp -> MetaData (a : inp)
pushRefMd Var x
varCase MetaData inp
md) of
            SomeGenCode GenCode (x : inp) out
bodyCd ->
              (AppendCtorField ('OneField x) inp :-> (RetOutStack retBr ++ inp))
-> CaseClauseL
     inp
     (RetOutStack retBr ++ inp)
     ('CaseClauseParam ctor ('OneField x))
forall (x :: CtorField) (inp :: [*]) (out :: [*]) (ctor :: Symbol).
(AppendCtorField x inp :-> out)
-> CaseClauseL inp out ('CaseClauseParam ctor x)
CaseClauseL ((AppendCtorField ('OneField x) inp :-> (RetOutStack retBr ++ inp))
 -> CaseClauseL
      inp
      (RetOutStack retBr ++ inp)
      ('CaseClauseParam ctor ('OneField x)))
-> (AppendCtorField ('OneField x) inp
    :-> (RetOutStack retBr ++ inp))
-> CaseClauseL
     inp
     (RetOutStack retBr ++ inp)
     ('CaseClauseParam ctor ('OneField x))
forall a b. (a -> b) -> a -> b
$
                MetaData inp
-> Text
-> ((x : inp) :-> (RetOutStack retBr ++ inp))
-> (x : inp) :-> (RetOutStack retBr ++ inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
auxiliaryHook MetaData inp
md (Text
"case branch against " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Var x -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Var x
varCase) (((x : inp) :-> (RetOutStack retBr ++ inp))
 -> (x : inp) :-> (RetOutStack retBr ++ inp))
-> ((x : inp) :-> (RetOutStack retBr ++ inp))
-> (x : inp) :-> (RetOutStack retBr ++ inp)
forall a b. (a -> b) -> a -> b
$
                  -- Compute returning expressions and clean up everything
                  forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
(StackVars xs -> MetaData xs)
-> GenCode inp xs -> ret -> inp :-> (RetOutStack ret ++ inp)
compileScope @retBr (\StackVars out
stk -> StackVars out -> DecomposedObjects -> GenCodeHooks -> MetaData out
forall (inp :: [*]).
StackVars inp -> DecomposedObjects -> GenCodeHooks -> MetaData inp
MetaData StackVars out
stk DecomposedObjects
mdObjects GenCodeHooks
mdHooks) GenCode (x : inp) out
bodyCd retBr
ret ((x : inp) :-> (RetOutStack retBr ++ (x : inp)))
-> ((RetOutStack retBr ++ (x : inp))
    :-> (RetOutStack retBr ++ inp))
-> (x : inp) :-> (RetOutStack retBr ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
                  -- Remove @x@ from the stack too
                  forall ret (inp :: [*]) (xs :: [*]).
ScopeCodeGen ret =>
(xs :-> inp)
-> (RetOutStack ret ++ xs) :-> (RetOutStack ret ++ inp)
liftClear @retBr @inp @(x : inp) (x : inp) :-> inp
forall a (s :: [*]). (a : s) :-> s
L.drop

-- | This constraint is shared by all @case*@ functions.
-- Including some outside this module.
type CaseCommonF f dt ret clauses =
  ( InstrCaseC dt
  , RMap (CaseClauses dt)
  , clauses ~ Rec (f ret) (CaseClauses dt)
  , ScopeCodeGen ret
  )

-- | This constraint is shared by all backend @case*@ functions.
type CaseCommon dt ret clauses = CaseCommonF IndigoCaseClauseL dt ret clauses

-- | A case statement for indigo. See examples for a sample usage.
caseRec
  :: forall dt inp ret clauses . CaseCommon dt ret clauses
  => Expr dt
  -> clauses
  -> RetVars ret
  -- ^ Variable(s) that will be assigned to the resulting value(s)
  -> IndigoState inp (RetOutStack ret ++ inp)
caseRec :: forall dt (inp :: [*]) ret clauses.
CaseCommon dt ret clauses =>
Expr dt
-> clauses
-> RetVars ret
-> IndigoState inp (RetOutStack ret ++ inp)
caseRec Expr dt
g clauses
cls RetVars ret
vars = (MetaData inp
 -> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp
  -> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
 -> IndigoState
      inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> (MetaData inp
    -> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall a b. (a -> b) -> a -> b
$ \MetaData inp
md ->
  let cdG :: inp :-> (dt : inp)
cdG = GenCode inp (dt : inp) -> inp :-> (dt : inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (GenCode inp (dt : inp) -> inp :-> (dt : inp))
-> GenCode inp (dt : inp) -> inp :-> (dt : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> IndigoState inp (dt : inp) -> GenCode inp (dt : inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md (Expr dt -> IndigoState inp (dt : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr dt
g) in
  forall ret (inp :: [*]).
ScopeCodeGen ret =>
StackVars inp
-> RetVars ret
-> (inp :-> (RetOutStack ret ++ inp))
-> GenCode inp (RetOutStack ret ++ inp)
finalizeStatement @ret (MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack MetaData inp
md) RetVars ret
vars ((inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
 -> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> (inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> Text
-> (inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
stmtHook MetaData inp
md (forall ret x.
ReturnableValue ret =>
RetVars ret -> Text -> Expr x -> Text
condStmtPretty @ret RetVars ret
vars Text
"caseRec" Expr dt
g) ((inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
 -> inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> (inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall a b. (a -> b) -> a -> b
$
    MetaData inp -> Text -> (inp :-> (dt : inp)) -> inp :-> (dt : inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
exprHook MetaData inp
md (Expr dt -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr dt
g) inp :-> (dt : inp)
cdG (inp :-> (dt : inp))
-> ((dt : inp)
    :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
    Rec
  (CaseClauseL
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
  (CaseClauses dt)
-> (dt : inp)
   :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall dt (out :: [*]) (inp :: [*]).
(InstrCaseC dt, RMap (CaseClauses dt)) =>
Rec (CaseClauseL inp out) (CaseClauses dt) -> (dt : inp) :-> out
L.case_ (MetaData inp
-> Rec (IndigoCaseClauseL ret) (CaseClauses dt)
-> Rec
     (CaseClauseL
        inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
     (CaseClauses dt)
forall (inp :: [*]) ret (cs :: [CaseClauseParam]).
MetaData inp
-> Rec (IndigoCaseClauseL ret) cs
-> Rec (CaseClauseL inp (RetOutStack ret ++ inp)) cs
toCaseClauseL MetaData inp
md clauses
Rec (IndigoCaseClauseL ret) (CaseClauses dt)
cls)

-- | 'case_' for pattern-matching on parameter.
entryCaseRec
  :: forall dt entrypointKind inp ret clauses .
  ( CaseCommon dt ret clauses
  , DocumentEntrypoints entrypointKind dt
  )
  => Proxy entrypointKind
  -> Expr dt
  -> clauses
  -> RetVars ret
  -- ^ Variable(s) that will be assigned to the resulting value(s)
  -> IndigoState inp (RetOutStack ret ++ inp)
entryCaseRec :: forall dt entrypointKind (inp :: [*]) ret clauses.
(CaseCommon dt ret clauses,
 DocumentEntrypoints entrypointKind dt) =>
Proxy entrypointKind
-> Expr dt
-> clauses
-> RetVars ret
-> IndigoState inp (RetOutStack ret ++ inp)
entryCaseRec Proxy entrypointKind
proxy Expr dt
g clauses
cls RetVars ret
vars = (MetaData inp
 -> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp
  -> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
 -> IndigoState
      inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> (MetaData inp
    -> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall a b. (a -> b) -> a -> b
$ \MetaData inp
md ->
  let cdG :: inp :-> (dt : inp)
cdG = GenCode inp (dt : inp) -> inp :-> (dt : inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (GenCode inp (dt : inp) -> inp :-> (dt : inp))
-> GenCode inp (dt : inp) -> inp :-> (dt : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> IndigoState inp (dt : inp) -> GenCode inp (dt : inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md (Expr dt -> IndigoState inp (dt : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr dt
g) in
  forall ret (inp :: [*]).
ScopeCodeGen ret =>
StackVars inp
-> RetVars ret
-> (inp :-> (RetOutStack ret ++ inp))
-> GenCode inp (RetOutStack ret ++ inp)
finalizeStatement @ret (MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack MetaData inp
md) RetVars ret
vars ((inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
 -> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> (inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> Text
-> (inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
stmtHook MetaData inp
md (forall ret x.
ReturnableValue ret =>
RetVars ret -> Text -> Expr x -> Text
condStmtPretty @ret RetVars ret
vars Text
"entryCaseRec" Expr dt
g) ((inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
 -> inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> (inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall a b. (a -> b) -> a -> b
$
    MetaData inp -> Text -> (inp :-> (dt : inp)) -> inp :-> (dt : inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
exprHook MetaData inp
md (Expr dt -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr dt
g) inp :-> (dt : inp)
cdG (inp :-> (dt : inp))
-> ((dt : inp)
    :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
    Proxy entrypointKind
-> Rec
     (CaseClauseL
        inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
     (CaseClauses dt)
-> (dt : inp)
   :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall dt entrypointKind (out :: [*]) (inp :: [*]).
(InstrCaseC dt, RMap (CaseClauses dt),
 DocumentEntrypoints entrypointKind dt) =>
Proxy entrypointKind
-> Rec (CaseClauseL inp out) (CaseClauses dt) -> (dt : inp) :-> out
L.entryCase_ Proxy entrypointKind
proxy (MetaData inp
-> Rec (IndigoCaseClauseL ret) (CaseClauses dt)
-> Rec
     (CaseClauseL
        inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
     (CaseClauses dt)
forall (inp :: [*]) ret (cs :: [CaseClauseParam]).
MetaData inp
-> Rec (IndigoCaseClauseL ret) cs
-> Rec (CaseClauseL inp (RetOutStack ret ++ inp)) cs
toCaseClauseL MetaData inp
md clauses
Rec (IndigoCaseClauseL ret) (CaseClauses dt)
cls)

-- | 'entryCase_' for contracts with flat parameter.
entryCaseSimpleRec
  :: forall dt inp ret clauses .
     ( CaseCommon dt ret clauses
     , DocumentEntrypoints PlainEntrypointsKind dt
     , NiceParameterFull dt
     , RequireFlatParamEps dt
     )
  => Expr dt
  -> clauses
  -> RetVars ret
  -- ^ Variable(s) that will be assigned to the resulting value(s)
  -> IndigoState inp (RetOutStack ret ++ inp)
entryCaseSimpleRec :: forall dt (inp :: [*]) ret clauses.
(CaseCommon dt ret clauses,
 DocumentEntrypoints PlainEntrypointsKind dt, NiceParameterFull dt,
 RequireFlatParamEps dt) =>
Expr dt
-> clauses
-> RetVars ret
-> IndigoState inp (RetOutStack ret ++ inp)
entryCaseSimpleRec Expr dt
g clauses
cls RetVars ret
vars = (MetaData inp
 -> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall (inp :: [*]) (out :: [*]).
(MetaData inp -> GenCode inp out) -> IndigoState inp out
IndigoState ((MetaData inp
  -> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
 -> IndigoState
      inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> (MetaData inp
    -> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> IndigoState
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall a b. (a -> b) -> a -> b
$ \MetaData inp
md ->
  let cdG :: inp :-> (dt : inp)
cdG = GenCode inp (dt : inp) -> inp :-> (dt : inp)
forall (inp :: [*]) (out :: [*]). GenCode inp out -> inp :-> out
gcCode (GenCode inp (dt : inp) -> inp :-> (dt : inp))
-> GenCode inp (dt : inp) -> inp :-> (dt : inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> IndigoState inp (dt : inp) -> GenCode inp (dt : inp)
forall (inp :: [*]) (out :: [*]).
MetaData inp -> IndigoState inp out -> GenCode inp out
usingIndigoState MetaData inp
md (Expr dt -> IndigoState inp (dt : inp)
forall a (inp :: [*]). Expr a -> IndigoState inp (a : inp)
compileExpr Expr dt
g) in
  forall ret (inp :: [*]).
ScopeCodeGen ret =>
StackVars inp
-> RetVars ret
-> (inp :-> (RetOutStack ret ++ inp))
-> GenCode inp (RetOutStack ret ++ inp)
finalizeStatement @ret (MetaData inp -> StackVars inp
forall (inp :: [*]). MetaData inp -> StackVars inp
mdStack MetaData inp
md) RetVars ret
vars ((inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
 -> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> (inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> GenCode inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall a b. (a -> b) -> a -> b
$ MetaData inp
-> Text
-> (inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
stmtHook MetaData inp
md (forall ret x.
ReturnableValue ret =>
RetVars ret -> Text -> Expr x -> Text
condStmtPretty @ret RetVars ret
vars Text
"entryCaseSimpleRec" Expr dt
g) ((inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
 -> inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> (inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall a b. (a -> b) -> a -> b
$
    MetaData inp -> Text -> (inp :-> (dt : inp)) -> inp :-> (dt : inp)
forall (inp :: [*]) (out :: [*]) (any :: [*]).
MetaData any -> Text -> (inp :-> out) -> inp :-> out
exprHook MetaData inp
md (Expr dt -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Expr dt
g) inp :-> (dt : inp)
cdG (inp :-> (dt : inp))
-> ((dt : inp)
    :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
-> inp :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
    Rec
  (CaseClauseL
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
  (CaseClauses dt)
-> (dt : inp)
   :-> (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
forall cp (out :: [*]) (inp :: [*]).
(InstrCaseC cp, RMap (CaseClauses cp),
 DocumentEntrypoints PlainEntrypointsKind cp,
 RequireFlatParamEps cp) =>
Rec (CaseClauseL inp out) (CaseClauses cp) -> (cp : inp) :-> out
L.entryCaseSimple_ (MetaData inp
-> Rec (IndigoCaseClauseL ret) (CaseClauses dt)
-> Rec
     (CaseClauseL
        inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
     (CaseClauses dt)
forall (inp :: [*]) ret (cs :: [CaseClauseParam]).
MetaData inp
-> Rec (IndigoCaseClauseL ret) cs
-> Rec (CaseClauseL inp (RetOutStack ret ++ inp)) cs
toCaseClauseL MetaData inp
md clauses
Rec (IndigoCaseClauseL ret) (CaseClauses dt)
cls)

toCaseClauseL
  :: forall inp ret cs .
     MetaData inp
  -> Rec (IndigoCaseClauseL ret) cs
  -> Rec (CaseClauseL inp (RetOutStack ret ++ inp)) cs
toCaseClauseL :: forall (inp :: [*]) ret (cs :: [CaseClauseParam]).
MetaData inp
-> Rec (IndigoCaseClauseL ret) cs
-> Rec (CaseClauseL inp (RetOutStack ret ++ inp)) cs
toCaseClauseL MetaData inp
_ Rec (IndigoCaseClauseL ret) cs
RNil = Rec
  (CaseClauseL
     inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
  cs
forall {u} (a :: u -> *). Rec a '[]
RNil
toCaseClauseL MetaData inp
md (OneFieldIndigoCaseClauseL forall (inp :: [*]).
MetaData inp
-> CaseClauseL
     inp
     (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
     ('CaseClauseParam ctor ('OneField x))
fn :& Rec (IndigoCaseClauseL ret) rs
rest) = MetaData inp
-> CaseClauseL
     inp
     (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
     ('CaseClauseParam ctor ('OneField x))
forall (inp :: [*]).
MetaData inp
-> CaseClauseL
     inp
     (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
     ('CaseClauseParam ctor ('OneField x))
fn MetaData inp
md CaseClauseL
  inp
  (RetOutStack' (ClassifyReturnValue ret) ret ++ inp)
  ('CaseClauseParam ctor ('OneField x))
-> Rec
     (CaseClauseL
        inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
     rs
-> Rec
     (CaseClauseL
        inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
     ('CaseClauseParam ctor ('OneField x) : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& MetaData inp
-> Rec (IndigoCaseClauseL ret) rs
-> Rec
     (CaseClauseL
        inp (RetOutStack' (ClassifyReturnValue ret) ret ++ inp))
     rs
forall (inp :: [*]) ret (cs :: [CaseClauseParam]).
MetaData inp
-> Rec (IndigoCaseClauseL ret) cs
-> Rec (CaseClauseL inp (RetOutStack ret ++ inp)) cs
toCaseClauseL MetaData inp
md Rec (IndigoCaseClauseL ret) rs
rest