content: {-# LANGUAGE TemplateHaskell
    , QuasiQuotes
    , OverloadedStrings
    , ViewPatterns
    , FlexibleContexts
    , FlexibleInstances
    , UndecidableInstances
  #-}
  
  {-|
  Module      : Morloc.CodeGenerator.Grammars.Translator.Cpp
  Description : C++ translator
  Copyright   : (c) Zebulun Arendsee, 2016-2025
  License     : GPL-3
  Maintainer  : zbwrnz@gmail.com
  Stability   : experimental
  -}
  
  module Morloc.CodeGenerator.Grammars.Translator.Cpp
    (
      translate
    , preprocess
    ) where
  
  import Morloc.CodeGenerator.Namespace
  import Morloc.CodeGenerator.Serial ( isSerializable
                                     , serialAstToType
                                     , shallowType
                                     , serialAstToMsgpackSchema
                                     )
  import Morloc.CodeGenerator.Grammars.Common
  import Morloc.DataFiles as DF
  import Morloc.Data.Doc
  import Morloc.Quasi
  import Morloc.CodeGenerator.Grammars.Macro (expandMacro)
  import qualified Morloc.Monad as MM
  import qualified Morloc.Data.Map as Map
  import qualified Data.Set as Set
  import qualified Morloc.Module as Mod
  import qualified Morloc.Language as ML
  import qualified Control.Monad.State as CMS
  import qualified Morloc.Data.GMap as GMap
  import qualified Morloc.TypeEval as TE
  import qualified Morloc.Data.Text as MT
  import Control.Monad.Identity (Identity)
  
  data CallSemantics = Copy | Reference | ConstPtr
  
  class HasCppType a where
    cppTypeOf :: a -> CppTranslator MDoc
  
    cppArgOf :: CallSemantics -> Arg a -> CppTranslator MDoc
  
  
  setCallSemantics :: CallSemantics -> MDoc -> MDoc
  setCallSemantics Copy typestr = typestr
  setCallSemantics Reference typestr = "const" <+> typestr <> "&"
  setCallSemantics ConstPtr typestr = "const" <+> typestr
  
  chooseCallSemantics :: TypeM -> CallSemantics
  chooseCallSemantics Passthrough = ConstPtr -- const uint8_t* packet
  chooseCallSemantics (Serial _) = ConstPtr -- const uint8_t* packet
  chooseCallSemantics (Native _) = Reference -- for now, primitives should be pass by copy
  chooseCallSemantics (Function _ _) = Copy -- currently not used
  
  instance HasCppType TypeM where
    cppTypeOf (Serial _) = return serialType
    cppTypeOf (Native c) = cppTypeOf c
    cppTypeOf Passthrough = return serialType
    cppTypeOf (Function ts t) = do
      t' <- cppTypeOf t
      ts' <- mapM cppTypeOf ts
      return $ "std::function<" <> t' <> tupled ts' <> ">"
  
    cppArgOf s (Arg i t) = do
      typeStr <- cppTypeOf t
      let typeStrQualified = setCallSemantics s typeStr
      return $ case t of
          (Serial _) -> typeStrQualified <+> svarNamer i
          (Native _) -> typeStrQualified <+> nvarNamer i
          Passthrough -> typeStrQualified <+> svarNamer i
          (Function _ _) -> typeStrQualified <+> nvarNamer i
  
  instance HasCppType NativeManifold where
    cppTypeOf = cppTypeOf . typeMof
    cppArgOf s r = cppArgOf s $ fmap typeMof r
  
  instance {-# OVERLAPPABLE #-} HasTypeF e => HasCppType e where
    cppTypeOf = f . typeFof where
      f (UnkF (FV _ x)) = return $ pretty x
      f (VarF (FV _ x)) = return $ pretty x
      f (FunF ts t) = do
        t' <- f t
        ts' <- mapM f ts
        return $ "std::function<" <> t' <> tupled ts' <> ">"
      f (AppF t ts) = do
        t' <- f t
        ts' <- mapM f ts
        return . pretty $ expandMacro (render t') (map render ts')
      f t@(NamF _ (FV gc (CV "struct")) _ rs) = do
        recmap <- CMS.gets translatorRecmap
        -- handle autogenerated structs
        case lookup (FV gc (CV "struct"), map fst rs) recmap of
          (Just rec) -> do
            params <- typeParams (zip (map snd (recFields rec)) (map snd rs))
            return $ recName rec <> params
          Nothing -> error $ "Record missing from recmap: " <> show t <> " from map: " <> show recmap
      f (NamF _ (FV _ s) ps _) = do
        ps' <- mapM f ps
        return $ pretty s <> recordTemplate ps'
  
  
    cppArgOf s (Arg i t) = do
      t' <- cppTypeOf (typeFof t)
      return $ setCallSemantics s t' <+> nvarNamer i
  
  
  -- | @RecEntry@ stores the common name, keys, and types of records that are not
  -- imported from C++ source. These records are generated as structs in the C++
  -- pool. @unifyRecords@ takes all such records and "unifies" ones with the same
  -- name and keys. The unified records may have different types, but they will
  -- all be instances of the same generic struct. That is, any fields that differ
  -- between instances will be made generic.
  data RecEntry = RecEntry
    { recName :: MDoc -- ^ the automatically generated name for this anonymous type
    , recFields :: [( Key -- The field key
                    , Maybe TypeF -- The field type if not generic
                    )]
    }
    deriving (Show)
  
  -- | @RecMap@ is used to lookup up the struct name shared by all records that are not imported from C++ source.
  type RecMap = [((FVar, [Key]), RecEntry)]
  
  data CppTranslatorState = CppTranslatorState
    { translatorCounter :: Int
    , translatorRecmap :: RecMap
    , translatorSignatureSet :: Set.Set Int
    , translatorLocalManifoldSet :: Set.Set Int
    , translatorRemoteManifoldSet :: Set.Set Int
    , translatorCurrentManifold :: Int
    }
  
  instance Defaultable CppTranslatorState where
    defaultValue = CppTranslatorState
      { translatorCounter = 0
      , translatorRecmap = []
      , translatorSignatureSet = Set.empty
      , translatorLocalManifoldSet = Set.empty
      , translatorRemoteManifoldSet = Set.empty
      , translatorCurrentManifold = -1 -- -1 indicates we are not inside a manifold
      }
  
  type CppTranslator a = CMS.StateT CppTranslatorState Identity a
  
  getCounter :: CppTranslator Int
  getCounter = do
      s <- CMS.get
      let i = translatorCounter s
      CMS.put $ s {translatorCounter = translatorCounter s + 1}
      return i
  
  resetCounter :: CppTranslator ()
  resetCounter = do
      s <- CMS.get
      CMS.put $ s {translatorCounter = 0}
  
  -- tree rewrites
  preprocess :: SerialManifold -> MorlocMonad SerialManifold
  preprocess = return . invertSerialManifold
  
  translate :: [Source] -> [SerialManifold] -> MorlocMonad Script
  translate srcs es = do
    -- scopeMap :: GMap Int MVar (Map.Map Lang Scope)
    scopeMap <- MM.gets stateConcreteTypedefs
  
    -- universalScopeMap :: GMap Int MVar Scope
    universalScopeMap <- MM.gets stateUniversalConcreteTypedefs
  
    let recmap = unifyRecords . concatMap collectRecords $ es
        translatorState = defaultValue { translatorRecmap = recmap }
        code = CMS.evalState (makeCppCode srcs es universalScopeMap scopeMap) translatorState
  
    maker <- makeTheMaker srcs
  
    return $ Script
      { scriptBase = "pool"
      , scriptLang = CppLang
      , scriptCode = "." :/ File "pool.cpp" (Code . render $ code)
      , scriptMake = maker
      }
  
  makeCppCode
    :: [Source]
    -> [SerialManifold]
    -> Map.Map Lang Scope
    -> GMap Int MVar (Map.Map Lang Scope)
    -> CppTranslator MDoc
  makeCppCode srcs es univeralScopeMap scopeMap = do
    -- ([MDoc], [MDoc])
    (srcDecl, srcSerial) <- generateSourcedSerializers univeralScopeMap scopeMap es
  
    -- write include statements for sources
    let includeDocs = map translateSource (unique . mapMaybe srcPath $ srcs)
  
    let dispatch = makeDispatch es
  
    signatures <- concat <$> mapM makeSignature es
  
    (autoDecl, autoSerial) <- generateAnonymousStructs
    let serializationCode = autoDecl ++ srcDecl ++ autoSerial ++ srcSerial
  
    -- translate each manifold tree, rooted on a call from nexus or another pool
    mDocs <- mapM translateSegment es
  
    -- create and return complete pool script
    return $ makeMain includeDocs signatures serializationCode mDocs dispatch
  
  metaTypedefs
      :: GMap Int MVar (Map.Map Lang Scope)
      -> Int -- manifold index
      -> Scope
  metaTypedefs tmap i =
      case GMap.lookup i tmap of
        (GMapJust langmap) -> case Map.lookup CppLang langmap of
          (Just scope) -> Map.filter (not . null) scope
          Nothing -> Map.empty
        _ -> Map.empty
  
  
  makeTheMaker :: [Source] -> MorlocMonad [SysCommand]
  makeTheMaker srcs = do
    let outfile = pretty $ ML.makeExecutablePoolName CppLang
    let src = pretty (ML.makeSourcePoolName CppLang)
  
    -- this function cleans up source names (if needed) and generates compiler flags and paths to search
    (_, flags, includes) <- Mod.handleFlagsAndPaths CppLang srcs
  
    let incs = [pretty ("-I" <> i) | i <- includes]
    let flags' = map pretty flags
  
    -- TODO: This is garbage - the C++ version should NOT be specified here
    let cmd = SysRun . Code . render $ [idoc|g++ -O3 --std=c++17 -o #{outfile} #{src} #{hsep flags'} #{hsep incs}|]
  
    return [cmd]
  
  serialType :: MDoc
  serialType = pretty $ ML.serialType CppLang
  
  makeSignature :: SerialManifold -> CppTranslator [MDoc]
  makeSignature = foldWithSerialManifoldM fm where
    fm = defaultValue
      { opFoldWithSerialManifoldM = serialManifold
      , opFoldWithNativeManifoldM = nativeManifold
      }
  
    serialManifold (SerialManifold m _ form _ _) _ = manifoldSignature m serialType form
  
    nativeManifold e@(NativeManifold m _ form _) _ = do
      typestr <- cppTypeOf e
      manifoldSignature m typestr form
  
    manifoldSignature :: HasTypeM t => Int -> MDoc -> ManifoldForm (Or TypeS TypeF) t -> CppTranslator [MDoc]
    manifoldSignature i typestr form = do
      s <- CMS.get
      if Set.member i (translatorSignatureSet s)
        then return []
        else do
          let formArgs = typeMofForm form
  
          args <- mapM (\r@(Arg _ t) -> cppArgOf (chooseCallSemantics t) r) formArgs
          CMS.put (s {translatorSignatureSet = Set.insert i (translatorSignatureSet s)})
          return [typestr <+> manNamer i <> tupled args <> ";"]
  
  tupleKey :: Int -> MDoc -> MDoc
  tupleKey i v = [idoc|std::get<#{pretty i}>(#{v})|]
  
  recordAccess :: MDoc -> MDoc -> MDoc
  recordAccess record field = record <> "." <> field
  
  -- TLDR: Use `#include "foo.h"` rather than `#include <foo.h>`
  -- Include statements in C can be either wrapped in angle brackets (e.g.,
  -- `<stdio.h>`) or in quotes (e.g., `"myfile.h"`). The difference between these
  -- is implementation specific. I currently use the GCC compiler. For quoted
  -- strings, it first searches relative to the working directory and then, if
  -- nothing is found, searches system files. For angle brackets, it searches
  -- only system files: <https://gcc.gnu.org/onlinedocs/cpp/Search-Path.html>. So
  -- quoting seems more reasonable, for now. This might change only if I start
  -- loading the morloc libraries into the system directories (which might be
  -- reasonable), though still, quotes would work.
  --
  -- UPDATE: The build system will now read the source paths from the Script
  -- object and write an `-I${MORLOC_HOME}/lib/${MORLOC_PACKAGE}` argument for
  -- g++. This will tell g++ where to look for headers. So now in the generated
  -- source code I can just write the basename. This makes the generated code
  -- neater (no hard-coded local paths), but now the g++ compiler will search
  -- through all the module paths for each file, which introduces the possibility
  -- of name conflicts.
  --
  -- UPDATE: And now those naming conflicts have bitten me. Simply including every
  -- module directory is a wretched idea.
  translateSource
    :: Path -- ^ Path to a header (e.g., `$MORLOC_HOME/src/foo.h`)
    -> MDoc
  translateSource path = "#include" <+> (dquotes . pretty) path
  
  serialize :: MDoc -> SerialAST -> CppTranslator PoolDocs
  serialize nativeExpr s0 = do
    (x, before) <- serialize' nativeExpr s0
  
    let schema_str = serialAstToMsgpackSchema s0
        putCommand = [idoc|_put_value(#{x}, "#{schema_str}")|]
    return $ PoolDocs
        { poolCompleteManifolds = []
        , poolExpr = putCommand
        , poolPriorLines = before
        , poolPriorExprs = []
        }
  
    where
      serialize'
        :: MDoc -- a variable name that stores the data described by the SerialAST object
        -> SerialAST -> CppTranslator (MDoc, [MDoc])
      serialize' v s
        | isSerializable s = return (v, [])
        | otherwise = construct v s
  
      construct :: MDoc -> SerialAST -> CppTranslator (MDoc, [MDoc])
      construct v (SerialPack _ (p, s)) = do
        let unpacker = pretty . srcName . typePackerReverse $ p
        serialize' [idoc|#{unpacker}(#{v})|] s
  
      construct v lst@(SerialList _ s) = do
        idx <- getCounter
        typestr <- cppTypeOf $ serialAstToType lst
        let v' = helperNamer idx
            idxStr = pretty idx
            decl = [idoc|#{typestr} #{v'};|]
        (x, before) <- serialize' [idoc|#{v}[i#{idxStr}]|] s
        let push = [idoc|#{v'}.push_back(#{x});|]
            loop  = block 4 [idoc|for(size_t i#{idxStr} = 0; i#{idxStr} < #{v}.size(); i#{idxStr}++)|]
                           (vsep (before ++ [push]))
        return (v', [decl, loop])
  
      construct v tup@(SerialTuple _ ss) = do
        (ss', befores) <- unzip <$> zipWithM (\i s -> serialize' (tupleKey i v) s) [0..] ss
        idx <- getCounter
        typestr <- cppTypeOf $ serialAstToType tup
        let v' = helperNamer idx
            x = [idoc|#{typestr} #{v'} = std::make_tuple#{tupled ss'};|]
        return (v', concat befores ++ [x]);
  
      construct v (SerialObject NamRecord _ _ rs) = do
        (ss', befores) <- unzip <$> mapM (\(k, s) -> serialize' (recordAccess v (pretty k)) s) rs
        idx <- getCounter
  
        -- This should store the record as a tuple, the tuple will be serialized
        t <- recordToCppTuple (map snd rs)
        let v' = helperNamer idx
            decl = encloseSep "{" "}" "," ss'
            x = [idoc|#{t} #{v'} = #{decl};|]
        return (v', concat befores ++ [x]);
  
      construct _ (SerialObject NamObject _ _ _) = error "C++ object serialization not yet implemented"
      construct _ (SerialObject NamTable _ _ _) = error "C++ table serialization not yet implemented"
  
      construct _ _ = error "Unreachable"
  
  -- reverse of serialize, parameters are the same
  deserialize :: MDoc -> MDoc -> SerialAST -> CppTranslator (MDoc, [MDoc])
  deserialize varname0 typestr0 s0
    | isSerializable s0 = do
        rawtype <- cppTypeOf $ serialAstToType s0
        let schema = serialAstToMsgpackSchema s0
            getCmd = [idoc|_get_value<#{rawtype}>(#{varname0}, "#{schema}")|]
        return (getCmd, [])
    | otherwise = do
        schemaVar <- helperNamer <$> getCounter
        rawtype <- rawTypeOf s0
        rawvar <- helperNamer <$> getCounter
        let schema = serialAstToMsgpackSchema s0
            getCmd = [idoc|#{rawtype} #{rawvar} = _get_value<#{rawtype}>(#{varname0}, "#{schema}");|]
        (x, before) <- construct rawvar s0
        let final = [idoc|#{typestr0} #{schemaVar} = #{x};|]
        return (schemaVar, [getCmd] ++ before ++ [final])
  
    where
  
      rawTypeOf :: SerialAST -> CppTranslator MDoc
      rawTypeOf (SerialObject _ _ _ rs) = recordToCppTuple (map snd rs)
      rawTypeOf t = cppTypeOf . serialAstToType $ t
  
      check :: MDoc -> SerialAST -> CppTranslator (MDoc, [MDoc])
      check v s
        | isSerializable s = return (v, [])
        | otherwise = construct v s
  
      construct :: MDoc -> SerialAST -> CppTranslator (MDoc, [MDoc])
      construct v (SerialPack _ (p, s')) = do
        (x, before) <- check v s'
        let packer = pretty . srcName . typePackerForward $ p
            deserialized = [idoc|#{packer}(#{x})|]
        return (deserialized, before)
  
      construct v lst@(SerialList _ s) = do
        t <- cppTypeOf $ shallowType lst
        idx <- getCounter
        let v' = helperNamer idx
            idxStr = pretty idx
            decl = [idoc|#{t} #{v'};|]
        (x, before) <- check [idoc|#{v}[i#{idxStr}]|] s
        let push = [idoc|#{v'}.push_back(#{x});|]
            loop = block 4 [idoc|for(size_t i#{idxStr} = 0; i#{idxStr} < #{v}.size(); i#{idxStr}++)|]
                           (vsep (before ++ [push]))
        return (v', [decl, loop])
  
      construct v tup@(SerialTuple _ ss) = do
        (ss', befores) <- unzip <$> zipWithM (\i s -> check (tupleKey i v) s) [0..] ss
        typestr <- cppTypeOf $ shallowType tup
        v' <- helperNamer <$> getCounter
        let x = [idoc|#{typestr} #{v'} = std::make_tuple#{tupled ss'};|]
        return (v', concat befores ++ [x]);
  
      construct v rec@(SerialObject NamRecord _ _ rs) = do
        (ss', befores) <- mapAndUnzipM
                          (\(i, (_, s)) -> check ("std::get<" <> pretty i <> ">(" <> v <> ")") s)
                          (zip ([0..] :: [Int]) rs)
        t <- cppTypeOf (shallowType rec)
        v' <- helperNamer <$> getCounter
        let decl = encloseSep "{" "}" "," ss'
            x = [idoc|#{t} #{v'} = #{decl};|]
        return (v', concat befores ++ [x]);
  
      construct _ _ = undefined -- TODO add support for deserialization of remaining types (e.g. other records)
  
  recordToCppTuple :: [SerialAST] -> CppTranslator MDoc
  recordToCppTuple ts = do
      tsDocs <- mapM (cppTypeOf . serialAstToType) ts
      return $ "std::tuple" <> encloseSep "<" ">" "," tsDocs
  
  
  translateSegment :: SerialManifold -> CppTranslator MDoc
  translateSegment m0 = do
    resetCounter
    e <- surroundFoldSerialManifoldM manifoldIndexer foldRules m0
    return $ vsep . punctuate line $ poolPriorExprs e <> poolCompleteManifolds e
    where
  
    foldRules = FoldWithManifoldM
      { opFoldWithSerialManifoldM = makeSerialManifold
      , opFoldWithNativeManifoldM = makeNativeManifold
      , opFoldWithSerialExprM = makeSerialExpr
      , opFoldWithNativeExprM = makeNativeExpr
      , opFoldWithSerialArgM = makeSerialArg
      , opFoldWithNativeArgM = makeNativeArg
      }
  
  
    manifoldIndexer = makeManifoldIndexer (CMS.gets translatorCurrentManifold)
                                          (\i -> CMS.modify (\s -> s { translatorCurrentManifold = i}))
  
    makeSerialManifold :: SerialManifold -> SerialManifold_ PoolDocs -> CppTranslator PoolDocs
    makeSerialManifold sm (SerialManifold_ i _ form headForm e) = makeManifold i form (Just headForm) (typeMof sm) e
  
    makeNativeManifold :: NativeManifold -> NativeManifold_ PoolDocs -> CppTranslator PoolDocs
    makeNativeManifold nm (NativeManifold_ i _ form e) = makeManifold i form Nothing (typeMof nm) e
  
    makeSerialArg :: SerialArg -> SerialArg_ PoolDocs PoolDocs -> CppTranslator (TypeS, PoolDocs)
    makeSerialArg sr (SerialArgManifold_ x) = return (typeSof sr, x)
    makeSerialArg sr (SerialArgExpr_ x) = return (typeSof sr, x)
  
    makeNativeArg :: NativeArg -> NativeArg_ PoolDocs PoolDocs -> CppTranslator (TypeM, PoolDocs)
    makeNativeArg nr (NativeArgManifold_ x) = return (typeMof nr, x)
    makeNativeArg nr (NativeArgExpr_ x) = return (typeMof nr, x)
  
    makeSerialExpr :: SerialExpr -> SerialExpr_ PoolDocs PoolDocs PoolDocs (TypeS, PoolDocs) (TypeM, PoolDocs) -> CppTranslator PoolDocs
    makeSerialExpr _ (ManS_ e) = return e
    makeSerialExpr _ (AppPoolS_ _ (PoolCall mid (Socket _ _ socketFile) ForeignCall args) _) = do
      -- arguments sent to foreign_call:
      --  * basename of socket, e.g., "pipe-python3"
      --  * manifold id
      --  * list of voidstar packets
      --  * NULL sentinel
      let argList = [ dquotes socketFile, pretty mid ] <> map argNamer args <> ["NULL"]
          call = [idoc|foreign_call#{tupled argList}|]
      return $ defaultValue { poolExpr = call }
    makeSerialExpr _ (AppPoolS_ _ (PoolCall mid (Socket _ _ socketFile) (RemoteCall res) args) _) = do
      let resMem = pretty $ remoteResourcesMemory res
          resTime = pretty $ remoteResourcesTime res
          resCPU = pretty $ remoteResourcesThreads res
          resGPU = pretty $ remoteResourcesGpus res
          cacheDir = ".morloc-cache"
          argList = encloseSep "{" "}" "," (map argNamer args)
          setup = [idoc|resources_t resources = {#{resMem}, #{resTime}, #{resCPU}, #{resGPU}};
  const uint8_t* args[] = #{argList};
  char* errmsg = NULL;|]
          call = [idoc|remote_call(
      #{pretty mid},
      #{dquotes socketFile},
      #{dquotes cacheDir},
      &resources,
      args,
      #{pretty (length args)},
      &errmsg
  );
  PROPAGATE_ERROR(errmsg)|]
  
      return $ defaultValue { poolExpr = call, poolPriorLines = [setup] }
  
    makeSerialExpr _ (ReturnS_ e) = return $ e {poolExpr = "return(" <> poolExpr e <> ");"}
    makeSerialExpr _ (SerialLetS_ letIndex sa sb) = return $ makeLet svarNamer letIndex serialType sa sb
    makeSerialExpr (NativeLetS _ (typeFof -> t) _) (NativeLetS_ letIndex na sb) = do
      typestr <- cppTypeOf t
      return $ makeLet nvarNamer letIndex typestr na sb
    makeSerialExpr _ (LetVarS_ _ i) = return $ defaultValue { poolExpr = svarNamer i }
    makeSerialExpr _ (BndVarS_ _ i) = return $ defaultValue { poolExpr = svarNamer i }
    makeSerialExpr _ (SerializeS_ s e) = do
      se <- serialize (poolExpr e) s
      return $ mergePoolDocs (\_ -> poolExpr se) [e, se]
    makeSerialExpr _ _ = error "Unreachable"
  
    makeNativeExpr :: NativeExpr -> NativeExpr_ PoolDocs PoolDocs PoolDocs (TypeS, PoolDocs) (TypeM, PoolDocs) -> CppTranslator PoolDocs
    makeNativeExpr _ (AppSrcN_ _ src qs (map snd -> es)) = do
      templateStr <- templateArguments qs
      return $ mergePoolDocs ((<>) (pretty (srcName src) <> templateStr) . tupled) es
    makeNativeExpr _ (ManN_ call) = return call
    makeNativeExpr _ (ReturnN_ e) =
      return $ e {poolExpr = "return" <> parens (poolExpr e) <> ";"}
    makeNativeExpr _ (SerialLetN_ i sa nb) = return $ makeLet svarNamer i serialType sa nb
    makeNativeExpr (NativeLetN _ (typeFof -> t1) _) (NativeLetN_ i na nb) = makeLet nvarNamer i <$> cppTypeOf t1 <*> pure na <*> pure nb
    makeNativeExpr _ (LetVarN_ _ i) = return $ defaultValue { poolExpr = nvarNamer i }
    makeNativeExpr _ (BndVarN_ _ i) = return $ defaultValue { poolExpr = nvarNamer i }
    makeNativeExpr _ (DeserializeN_ t s e) = do
      typestr <- cppTypeOf t
      (deserialized, assignments) <- deserialize (poolExpr e) typestr s
      return $ e
        { poolExpr = deserialized
        , poolPriorLines = poolPriorLines e <> assignments
        }
  
    makeNativeExpr _ (AccN_ _ _ e k) =
      return (e {poolExpr = poolExpr e <> "." <> pretty k})
  
    makeNativeExpr _ (SrcN_ _ _) = undefined
  
    makeNativeExpr _ (ListN_ _ _ es) =
      return $ mergePoolDocs (encloseSep "{" "}" ",") es
  
    makeNativeExpr _ (TupleN_ _ es) =
      return $ mergePoolDocs ((<>) "std::make_tuple" . tupled) es
  
    makeNativeExpr e (RecordN_ _ _ _ rs) = do
      t <- cppTypeOf e
      idx <- getCounter
      let v' = "a" <> pretty idx
          decl = t <+> v' <+> encloseSep "{" "}" "," (map (poolExpr . snd) rs) <> ";"
      let p = mergePoolDocs (const v') (map snd rs)
      return (p {poolPriorLines = poolPriorLines p <> [decl]})
  
    makeNativeExpr _ (LogN_         _ x) = return $ defaultValue { poolExpr = if x then "true" else "false" }
    makeNativeExpr _ (RealN_        _ x) = return $ defaultValue { poolExpr = viaShow x }
    makeNativeExpr _ (IntN_         _ x) = return $ defaultValue { poolExpr = viaShow x }
    makeNativeExpr _ (StrN_         _ x) = return $ defaultValue { poolExpr = [idoc|std::string("#{pretty x}")|] }
    makeNativeExpr _ (NullN_        _  ) = return $ defaultValue { poolExpr = "null" }
    makeNativeExpr _ _ = error "Unreachable"
  
    templateArguments :: [(MT.Text, TypeF)] -> CppTranslator MDoc
    templateArguments [] = return ""
    templateArguments qs = do
      ts <- mapM (cppTypeOf . snd) qs
      return $ recordTemplate ts
  
  
    makeLet :: (Int -> MDoc) -> Int -> MDoc -> PoolDocs -> PoolDocs -> PoolDocs
    makeLet namer letIndex typestr (PoolDocs ms1 e1 rs1 pes1) (PoolDocs ms2 e2 rs2 pes2) =
      let letAssignment = [idoc|#{typestr} #{namer letIndex} = #{e1};|]
          rs = rs1 <> [ letAssignment ] <> rs2 <> [e2]
      in PoolDocs
        { poolCompleteManifolds = ms1 <> ms2
        , poolExpr = vsep rs
        , poolPriorLines = []
        , poolPriorExprs = pes1 <> pes2
        }
  
  makeManifold
    :: (HasTypeM t)
    => Int -- ^ The index of the manifold that is being created
    -> ManifoldForm (Or TypeS TypeF) t
    -> Maybe HeadManifoldForm
    -> TypeM -- ^ The type of the manifold (usually a function, serialized terms are of general type "Str" and C++ type "std::string"
    -> PoolDocs -- ^ Generated content for the manifold body
    -> CppTranslator PoolDocs
  makeManifold callIndex form headForm manifoldType e = do
    state <- CMS.get
    let alreadyDone = manifoldHasBeenGenerated headForm state
    completeManifold <- case alreadyDone of
      True -> return $ Nothing
      False -> Just <$> makeManifoldBody (poolExpr e)
    call <- makeManifoldCall form
    return $ e { poolExpr = call
               , poolCompleteManifolds = poolCompleteManifolds e <> maybeToList completeManifold
               , poolPriorLines = poolPriorLines e
               }
    where
  
    manifoldHasBeenGenerated :: Maybe HeadManifoldForm -> CppTranslatorState -> Bool
    manifoldHasBeenGenerated (Just HeadManifoldFormRemoteWorker) state = Set.member callIndex (translatorRemoteManifoldSet state)
    manifoldHasBeenGenerated _ state = Set.member callIndex (translatorLocalManifoldSet state)
  
    updateCounts :: Maybe HeadManifoldForm -> CppTranslator ()
    updateCounts (Just HeadManifoldFormRemoteWorker) = do
      state <- CMS.get
      CMS.put $ state {translatorRemoteManifoldSet = Set.insert callIndex (translatorRemoteManifoldSet state)}
    updateCounts _ = do
      state <- CMS.get
      CMS.put $ state {translatorLocalManifoldSet = Set.insert callIndex (translatorLocalManifoldSet state)}
  
    mnameExt (Just HeadManifoldFormRemoteWorker) = "_remote"
    mnameExt _ = ""
  
    mname = manNamer callIndex <> mnameExt headForm
  
    makeManifoldCall :: ManifoldForm (Or TypeS TypeF) t -> CppTranslator MDoc
    makeManifoldCall (ManifoldFull rs) = do
      let args = map argNamer (typeMofRs rs)
      return $ mname <> tupled args
    makeManifoldCall (ManifoldPass _) = return mname
    makeManifoldCall (ManifoldPart rs vs) = do
      let vs' = take
                (length vs)
                (map (\j -> "std::placeholders::_" <> viaShow j) ([1..] :: [Int]))
          rs' = map argNamer (typeMofRs rs)
          bindStr = stdBind $ mname : (rs' ++ vs')
      return bindStr
  
    makeManifoldBody :: MDoc -> CppTranslator MDoc
    makeManifoldBody body = do
      updateCounts headForm
      returnTypeStr <- returnType manifoldType
      let argList = typeMofForm form
      args <- mapM (\r@(Arg _ t) -> cppArgOf (chooseCallSemantics t) r) argList
      let decl = returnTypeStr <+> mname <> tupled args
      let tryBody = block 4 "try" body
          throwStatement = vsep
            [ [idoc|std::string error_message = "Error raised in C++ pool by m#{pretty callIndex}:\n" + std::string(e.what());|]
            , [idoc|throw std::runtime_error(error_message);|]
            ]
          catchBody = block 4 "catch (const std::exception& e)" throwStatement
          tryCatchBody = tryBody <+> catchBody
      return . block 4 decl . vsep $
        [ {- can add diagnostic statements here -}
          tryCatchBody
        ]
  
    returnType :: TypeM -> CppTranslator MDoc
    returnType (Function _ t) = cppTypeOf t
    returnType t = cppTypeOf t
  
  stdBind :: [MDoc] -> MDoc
  stdBind xs = [idoc|std::bind(#{args})|] where
    args = cat (punctuate "," xs)
  
  makeDispatch :: [SerialManifold] -> MDoc
  makeDispatch ms = [idoc|uint8_t* local_dispatch(uint32_t mid, const uint8_t** args){
      switch(mid){
          #{align (vsep localCases)}
          default:
              std::ostringstream oss;
              oss << "Invalid local manifold id: " << mid;
              throw std::runtime_error(oss.str());
      }
  }
  
  uint8_t* remote_dispatch(uint32_t mid, const uint8_t** args){
      switch(mid){
          #{align (vsep remoteCases)}
          default:
              std::ostringstream oss;
              oss << "Invalid remote manifold id: " << mid;
              throw std::runtime_error(oss.str());
      }
  }|]
      where
      localCases = catMaybes $ map localCase ms
  
      localCase :: SerialManifold -> Maybe MDoc
      localCase (SerialManifold _ _ _ HeadManifoldFormRemoteWorker _) = Nothing
      localCase (SerialManifold i _ form _ _) = Just $ makeCase "" (i, getSize form)
  
  
      getSize :: ManifoldForm (Or TypeS TypeF) TypeS -> Int
      getSize = sum . abilist (\_ _ -> 1) (\_ _ -> 1)
  
      remoteCases :: [MDoc]
      remoteCases = map (makeCase  "_remote") . unique . concat $ map getRemotes ms
  
      makeCase :: MDoc -> (Int, Int) -> MDoc
      makeCase suffix (i, n) =
          "case" <+> pretty i <> ":" <+>
          "return" <+> manNamer i <> suffix <> tupled ["args[" <> pretty j <> "]" | j <- take n ([0..]::[Int])] <> ";"
  
      getRemotes :: SerialManifold -> [(Int, Int)]
      getRemotes = MM.runIdentity . foldSerialManifoldM (defaultValue {opSerialExprM = getRemoteSE})
  
      getRemoteSE :: SerialExpr_ [(Int, Int)] [(Int, Int)] [(Int, Int)] [(Int, Int)] [(Int, Int)] -> MM.Identity [(Int, Int)]
      getRemoteSE (AppPoolS_ _ (PoolCall i _ (RemoteCall _) _) xss) = return $ (i, length xss) : concat xss
      getRemoteSE x = return $ foldlSE mappend mempty x
  
  
  typeParams :: [(Maybe TypeF, TypeF)] -> CppTranslator MDoc
  typeParams ts = recordTemplate <$> mapM cppTypeOf [t | (Nothing, t) <- ts]
  
  collectRecords :: SerialManifold -> [(FVar, Int, [(Key, TypeF)])]
  collectRecords e0@(SerialManifold i0 _ _ _ _)
    = unique $ CMS.evalState (surroundFoldSerialManifoldM manifoldIndexer fm e0) i0
    where
      fm = defaultValue { opFoldWithNativeExprM = nativeExpr, opFoldWithSerialExprM = serialExpr }
  
      manifoldIndexer = makeManifoldIndexer CMS.get CMS.put
  
      nativeExpr _ (DeserializeN_ t s xs) = do
        manifoldIndex <- CMS.get
        let tRecs = seekRecs manifoldIndex t
            sRecs = seekRecs manifoldIndex (serialAstToType s)
        return $ xs <> tRecs <> sRecs
      nativeExpr efull e = do
        manifoldIndex <- CMS.get
        let newRecs = seekRecs manifoldIndex (typeFof efull)
        return $ foldlNE (<>) newRecs e
  
      serialExpr _ (SerializeS_ s xs) = do
        manifoldIndex <- CMS.get
        return $ seekRecs manifoldIndex (serialAstToType s) <> xs
      serialExpr _ e = return $ foldlSE (<>) [] e
  
      seekRecs :: Int -> TypeF -> [(FVar, Int, [(Key, TypeF)])]
      seekRecs m (NamF _ v@(FV _ (CV "struct")) _ rs) = [(v, m, rs)] <> concatMap (seekRecs m . snd) rs
      seekRecs m (NamF _ _ _ rs) = concatMap (seekRecs m . snd) rs
      seekRecs m (FunF ts t) = concatMap (seekRecs m) (t:ts)
      seekRecs m (AppF t ts) = concatMap (seekRecs m) (t:ts)
      seekRecs _ (UnkF _) = []
      seekRecs _ (VarF _) = []
  
  
  -- unify records with the same name/keys
  unifyRecords
    :: [(FVar -- The "v" in (NamP _ v@(PV _ _ "struct") _ rs)
       , Int -- general index
       , [(Key, TypeF)]) -- key/type terms for this record
       ] -> RecMap
  unifyRecords xs
    = zipWith (\i ((v,ks),es) -> ((v,ks), RecEntry (structName i v) es)) [1..]
    . map (\((v, ks), rss) -> ((v, ks), map unifyField (transpose (map snd rss))))
    -- associate unique pairs of record name and keys with their edge types
    . groupSort
    . unique
    $ [((v, map fst es), (m, es)) | (v, m, es) <- xs]
  
  structName :: Int -> FVar -> MDoc
  structName i (FV v (CV "struct")) = "mlc_" <> pretty v <> "_" <> pretty i
  structName _ (FV _ v) = pretty v
  
  unifyField :: [(Key, TypeF)] -> (Key, Maybe TypeF)
  unifyField [] = error "Empty field"
  unifyField rs@((v,_):_)
    | not (all ((== v) . fst) rs)
        = error $ "Bad record - unequal fields: " <> show (unique rs)
    | otherwise = case unique (map snd rs) of
        [t] -> (v, Just t)
        _ -> (v, Nothing)
  
  generateAnonymousStructs :: CppTranslator ([MDoc],[MDoc])
  generateAnonymousStructs = do
    recmap <- CMS.gets translatorRecmap
  
    xs <- mapM makeSerializers (reverse . map snd $ recmap)
  
    return (concatMap fst xs, concatMap snd xs)
  
    where
  
    makeSerializers :: RecEntry -> CppTranslator ([MDoc],[MDoc])
    makeSerializers rec = do
  
      let templateTerms = map (("T" <>) . pretty) ([1..] :: [Int])
          rs' = zip templateTerms (recFields rec)
  
      let params = [t | (t, (_, Nothing)) <- rs']
          rname = recName rec
          rtype = rname <> recordTemplate [v | (v, (_, Nothing)) <- rs']
  
      let fieldNames = [k | (_, (k, _)) <- rs']
  
      fieldTypes <- mapM (\(t, v) -> maybeM t cppTypeOf v) [(t', v') | (t', (_, v')) <- rs']
  
      let fields = [(pretty k, v) | (k, v) <- zip fieldNames fieldTypes]
  
      let structDecl = structTypedefTemplate params rname fields
          serializer = serializerTemplate params rtype fields
          deserializer = deserializerTemplate False params rtype fields
  
  
      return ([structDecl], [serializer, deserializer])
  
    -- monadic form of `maybe` function
    maybeM :: Monad m => a -> (b -> m a) -> Maybe b -> m a
    maybeM _ f (Just x) = f x
    maybeM x _ Nothing = return x
  
  generateSourcedSerializers
    :: Map.Map Lang Scope
    -> GMap Int MVar (Map.Map Lang Scope)
    -> [SerialManifold] -- all segments that can be called in this pool
    -> CppTranslator ( [MDoc]
                     , [MDoc]
                     )
  generateSourcedSerializers univeralScopeMap scopeMap es0 = do
  
    -- find the scopes that are used in this manifold
    -- we need to generate (de)serializers for all records
    typedef <- Map.unions <$> mapM (foldSerialManifoldM fm) es0
  
    scope <- case Map.lookup CppLang univeralScopeMap of
      (Just scope) -> return scope
      Nothing -> return Map.empty
  
    foldl groupQuad ([],[]) . concat . Map.elems <$> Map.mapWithKeyM (makeSerials scope) typedef
    where
  
      -- given the universal map of scopes, pull out every one that is used in this subtree
      fm = defaultValue
        { opSerialManifoldM = \(SerialManifold_ i _ _ _ e) -> return $ Map.unionWith mergeScopes (metaTypedefs scopeMap i) e
        , opNativeManifoldM = \(NativeManifold_ i _ _ e) -> return $ Map.unionWith mergeScopes (metaTypedefs scopeMap i) e
        }
  
      -- there are likely to be repeats in the scopes, we only want the unique ones
      mergeScopes xs ys = unique (xs <> ys)
  
      groupQuad :: ([a],[a]) -> (a, a) -> ([a],[a])
      groupQuad (xs,ys) (x, y) = (x:xs, y:ys)
  
      makeSerials :: Scope -> TVar -> [([Either TVar TypeU], TypeU, Bool)] -> CppTranslator [(MDoc, MDoc)]
      makeSerials s v xs = catMaybes <$> mapM (makeSerial s v) xs
  
      makeSerial :: Scope -> TVar -> ([Either TVar TypeU], TypeU, Bool) -> CppTranslator (Maybe (MDoc, MDoc))
      makeSerial _ _ (_, NamU _ (TV "struct") _ _, _) = return Nothing
      makeSerial scope _ (ps, NamU r (TV v) _ rs, _) = do
        params <- mapM (either (\p -> return $ "T" <> pretty p) (\_ -> return "XXX_FIXME")) ps
        let templateTerms = ["T" <> pretty p | Left p <- ps]
            rtype = pretty v <> recordTemplate templateTerms
            rs' = map (second (evaluateTypeU scope)) rs
            fields = [(pretty k, showDefType ps (typeOf t)) | (k, t) <- rs']
            serializer = serializerTemplate params rtype fields
            deserializer = deserializerTemplate (r == NamObject) params rtype fields
        return $ Just (serializer, deserializer)
      makeSerial _ _ _ = return Nothing
  
      evaluateTypeU :: Scope -> TypeU -> TypeU
      evaluateTypeU scope t = case TE.evaluateType scope t of
        (Left e) -> error $ show e
        (Right t') -> t'
  
      showDefType :: [Either TVar TypeU] -> Type -> MDoc
      showDefType ps (UnkT v)
        | (Left v) `elem` ps = "T" <> pretty v
        | otherwise = pretty v
      showDefType ps (VarT v)
        | (Left v) `elem` ps = "T" <> pretty v
        | otherwise = pretty v
      showDefType _ (FunT _ _) = error "Cannot serialize functions"
      showDefType _ (NamT _ v _ _) = pretty v
      showDefType ps (AppT (VarT (TV v)) ts) = pretty $ expandMacro v (map (render . showDefType ps) ts)
      showDefType _ (AppT _ _) = error "AppT is only OK with VarT, for now"
  
  makeTemplateHeader :: [MDoc] -> MDoc
  makeTemplateHeader [] = ""
  makeTemplateHeader ts = "template" <+> encloseSep "<" ">" "," ["class" <+> t | t <- ts]
  
  recordTemplate :: [MDoc] -> MDoc
  recordTemplate [] = ""
  recordTemplate ts = encloseSep "<" ">" "," ts
  
  
  
  -- Example
  -- > template <class T>
  -- > struct Person
  -- > {
  -- >     std::vector<std::string> name;
  -- >     std::vector<T> info;
  -- > };
  structTypedefTemplate
    :: [MDoc] -- template parameters (e.g., ["T"])
    -> MDoc -- the name of the structure (e.g., "Person")
    -> [(MDoc, MDoc)] -- key and type for all fields
    -> MDoc -- structure definition
  structTypedefTemplate params rname fields = vsep [template, struct] where
    template = makeTemplateHeader params
    struct = block 4 ("struct" <+> rname)
                     (vsep [t <+> k <> ";" | (k,t) <- fields]) <> ";"
  
  
  
  serializerTemplate
    :: [MDoc] -- template parameters
    -> MDoc -- type of thing being serialized
    -> [(MDoc, MDoc)] -- key and type for all fields
    -> MDoc -- output serializer function
  serializerTemplate params rtype fields = [idoc|
  #{makeTemplateHeader params}
  void* toAnything(void* dest, void** cursor, const Schema* schema, const #{rtype}& obj)
  {
      return toAnything(dest, cursor, schema, std::make_tuple#{arguments});
  }
  |] where
    arguments = tupled ["obj." <> key | (key, _) <- fields]
  
  
  
  deserializerTemplate
    :: Bool -- build object with constructor -- TODO: isObj, bring this back
    -> [MDoc] -- ^ template parameters
    -> MDoc -- ^ type of thing being deserialized
    -> [(MDoc, MDoc)] -- ^ key and type for all fields
    -> MDoc -- ^ output deserializer function
  deserializerTemplate _ params rtype fields
    =  [idoc|
  #{makeTemplateHeader params}
  #{block 4 header body}
  
  #{makeTemplateHeader params}
  #{block 4 headerGetSize bodyGetSize}
  |] where
    header = [idoc|#{rtype} fromAnything(const Schema* schema, const void * anything, #{rtype}* dummy = nullptr)|]
    body = vsep $ [ [idoc|#{rtype} obj;|] ]
                <> zipWith assignFields [0..] fields
                <> ["return obj;"]
  
    assignFields :: Int -> (MDoc, MDoc) -> MDoc
    assignFields idx (keyName, keyType) = vsep
      [ [idoc|#{keyType}* elemental_dumby_#{keyName} = nullptr;|]
      , [idoc|obj.#{keyName} = fromAnything(schema->parameters[#{pretty idx}], (char*)anything + schema->offsets[#{pretty idx}], elemental_dumby_#{keyName});|]
  
      ]
  
    headerGetSize = [idoc|size_t get_shm_size(const Schema* schema, const #{rtype}& data)|]
    bodyGetSize = vsep $
      [ "size_t size = 0;" ] <>
      [getSize idx key | (idx, (key, _)) <- zip [0..] fields] <>
      ["return size;"]
  
    getSize :: Int -> MDoc -> MDoc
    getSize idx key = [idoc|size += get_shm_size(schema->parameters[#{pretty idx}], data.#{key});|]
  
    -- XXX: here need to add back the isObj handling, if is object, need to call
    -- the constructor rather than directly assigning to fields
  
  makeMain :: [MDoc] -> [MDoc] -> [MDoc] -> [MDoc] -> MDoc -> MDoc
  makeMain includes signatures serialization manifolds dispatch
    = format (DF.embededFileText (DF.poolTemplate CppLang)) "// <<<BREAK>>>"
    [ vsep includes
    , vsep serialization
    , vsep signatures
    , vsep manifolds
    , dispatch
    ]
  