content: {-# LANGUAGE TupleSections #-}
  {-|
  Module      : Parsley.Internal.Backend.Machine.LetRecBuilder
  Description : Function for building recursive groups.
  License     : BSD-3-Clause
  Maintainer  : Jamie Willis
  Stability   : experimental
  
  Exposes the `letRec` function, used to provide a recursive /group/ of bindings
  for the top level of a parser.
  
  @since 1.0.0.0
  -}
  module Parsley.Internal.Backend.Machine.LetRecBuilder (letRec) where
  
  import Data.Dependent.Sum                           (DSum((:=>)))
  import Data.Functor.Const                           (Const(..))
  import Data.GADT.Compare                            (GCompare)
  import Data.Some                                    (Some(Some))
  import Language.Haskell.TH                          (newName, Name)
  import Language.Haskell.TH.Syntax                   (Exp(VarE, LetE), Dec(FunD), Clause(Clause), Body(NormalB))
  import Parsley.Internal.Backend.Machine.LetBindings (LetBinding(..), Metadata, Binding, Regs)
  import Parsley.Internal.Backend.Machine.Types       (Func)
  import Parsley.Internal.Common.Utils                (Code)
  import Parsley.Internal.Common.THUtils              (unsafeCodeCoerce, unTypeCode)
  
  import Data.Dependent.Map as DMap (DMap, (!), map, toList, traverseWithKey)
  
  {-|
  Given a collection of bindings, generates a recursive binding group where each is allowed to
  refer to every other. These are then in scope for the top-level parser.
  
  @since 1.5.0.0
  -}
  letRec :: forall key binding s o a b. GCompare key
         => {-bindings-}   DMap key (LetBinding o a)   -- ^ The bindings that should form part of the recursive group
        -> {-nameof-}      (forall x. key x -> String) -- ^ A function which can give a name to a key in the map
        -> {-genBinding-}  (forall x rs. key x -> Binding o a x -> Regs rs -> DMap key (binding s o a) -> Metadata -> Code (Func rs s o a x))
        -> {-wrapBinding-} (forall x rs. Code (Func rs s o a x) -> Regs rs -> Metadata -> binding s o a x)
        -- ^ How a binding - and their free registers - should be converted into code
        -> {-expr-}        (DMap key (binding s o a) -> Code b)
        -- ^ How to produce the top-level binding given the compiled bindings, i.e. the @in@ for the @let@
        -> Code b
  letRec bindings nameOf genBinding wrapBinding expr = unsafeCodeCoerce $
    do -- Make a bunch of names
       names <- traverseWithKey (\k (LetBinding _ rs meta) -> Const . (, rs, meta) <$> newName (nameOf k)) bindings
       -- Wrap them up so that they are valid typed template haskell names
       let typedNames = DMap.map makeTypedName names
       -- Generate each binding providing them with the names
       let makeDecl (k :=> LetBinding body (Some frees) _) =
            do let Const (name, _, meta) = names ! k
               func <- unTypeCode (genBinding k body frees typedNames meta)
               return (FunD name [Clause [] (NormalB func) []])
       decls <- traverse makeDecl (toList bindings)
       -- Generate the main expression using the same names
       exp <- unTypeCode (expr typedNames)
       -- Construct the let expression
       return (LetE decls exp)
    where
       makeTypedName :: Const (Name, Some Regs, Metadata) x -> binding s o a x
       makeTypedName (Const (name, Some frees, meta)) = wrapBinding (unsafeCodeCoerce (return (VarE name))) frees meta
  