{-# LANGUAGE RecordWildCards, QuasiQuotes, NamedFieldPuns, ScopedTypeVariables, CPP #-}
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
-- OverloadedStrings -- TODO: currently causes ambiguities with toDoc


----------------------------------------------------------------------------------------------------
-- This is the code generator for the original (CnC/C++ 0.1-0.5) "context"-based C++ API.
-- Original Author: Ryan Newton
----------------------------------------------------------------------------------------------------

-- This should eventually be based on some intermediate representation of C code.  For a
-- first cut, however, it is easier to just generate syntax directly.  (Especially with
-- the assistance of the pretty printing libary.)

module Intel.Cnc.Spec.Codegen.CppOld where

import Intel.Cnc.Spec.Codegen.CodegenShared
import Intel.Cnc.Spec.Codegen.Plugins
import Intel.Cnc.Spec.Codegen.Plugins.Depends

import Intel.Cnc.Spec.AST 
import Intel.Cnc.Spec.TagFun
import Intel.Cnc.Spec.CncGraph
--import Intel.Cnc.Spec.GatherGraph
import Intel.Cnc.Spec.Util as U hiding (commacat)

import qualified Intel.Cnc.EasyEmit as EE
import Intel.Cnc.EasyEmit hiding (app, not, (&&), (==), (||))

import Control.Monad.State
import StringTable.Atom

import Text.PrettyPrint.HughesPJClass 
import Text.Printf

-- QuasiQuoting is too expensive in final binary size:
-- import Text.InterpolatedString.QQ

import qualified Data.Map as M
import Data.List
import Data.Maybe
import Data.Graph.Inductive hiding (empty)

import qualified StringTable.AtomMap as AM
import qualified StringTable.AtomSet as AS

----------------------------------------------------------------------------------------------------

-- An annoying feature of our current API [2010.08.03] is that we
-- don't have explicit step_collection objects.  We make sure to only
-- allocate one copy of the user's temporary Step() object and then
-- use its pointer as a key:
step_obj e | e == special_environment_name = e
step_obj str = "m_" ++ str 

--obj_ref a   = t"*" <> (t$ step_obj$ fromAtom a)
obj_ref a   = (t$ step_obj$ fromAtom a)


-- [2010.11.14] TEMPTOGGLE: Disabling the one-argument version of get:
oldstyle_get_method = False

commacat ls = hcat (intersperse (text ", ") $ ls)

s = Syn . text 
doc2Ty = TSym . toAtom . render

instance FromAtom Doc where
  fromAtom = text . fromAtom

-- If a block of text is nonempty, then preface it with a comment:
maybeCommentDoc ls txt = 
  if txt == t""
  then txt
  else vcat (map (\ cmnt -> if cmnt == t"" then cmnt else t"// "<> cmnt) ls) $$ 
            txt

maybeComment ls mnd = 
  -- FIXME FIXME:
  -- FIXME!! THIS EXECUTES IT TWICE!
  let doc = execEasyEmit mnd in
  if doc == t""
  then return ()
--  else putD$ maybeCommentDoc ls doc
  else do forM_ ls $ \ cmnt ->
	    putD$ if cmnt == t"" then cmnt else t"// "<> cmnt
	  mnd

----------------------------------------------------------------------------------------------------

-- Name for a private context:
privcontext stp = textAtom stp <> t"_context"

----------------------------------------------------------------------------------------------------

--emitCpp :: StringBuilder m => CodeGenConfig -> CncSpec -> m ()
emitCpp :: CodeGenConfig -> CncSpec -> EasyEmit ()

emitCpp (config@CodeGenConfig{..}) (spec @ CncSpec{appname, steps, tags, items, reductions, graph, realmap}) = do 
-- HOWTO READ the below code:
-- This code emits a series of strings/docs to build up a file.
-- Some of the more complex looking bits are building up large lists of type [Doc].
--
-- [2010.11.15] NOTE: This will get more complex for a little while
-- because I am IN THE MIDDLE OF switching to use EasyEmit functionality.

   --------------------------------------------------------------------------------
   -- Prelude: set up some bindings for EasyEmit functions and other helpers:
   --------------------------------------------------------------------------------
   let 
       -- Don't include builtins (e.g. the environment):
       stepls = filter (\ x -> not$ x `elem` builtinSteps) $
		AS.toList steps
       stepls_with_types = zip stepls tagtys

       -- Call each plugin's "constructor" so it can analyze the spec.
       initialized_plugins = map (\pg -> pg spec) plugins
       
       -- Then create a map of which plugins apply to which steps:
       plug_map = AM.fromList$
		  filter (not . null . snd) $
		  map (\stpC -> (stpC, 
				 catMaybes$ map (\pg -> pg stpC) 
				                initialized_plugins))
		      (toAtom special_environment_name : stepls)

       -- This predicate determines whether there is any requirement to wrap a particular step collection:
       shouldWrapStep stpname = 
	 wrapall || AM.member stpname plug_map
	 --wrapall || any (\ cgh -> hooksPredicate cgh stpname ) plugins       
	 

       areAnyWrapped = wrapall || any shouldWrapStep stepls

       tractible_depends_steps = AS.fromList (filter (all_tagfuns_tractible graph) stepls)

       prescribers = map (getStepPrescriber spec) stepls
       tagtys = map (\ name -> case tags AM.! name of 
		                  Nothing -> error$ "Tag collection '"++ show name ++"' missing type, needed for C++ codegen!"
		                  Just ty -> ty)
		prescribers  

       privcontext_member stp = t"m_priv_" <> privcontext stp 
       tls_key stp = privcontext stp <> t"_tls_key"


   --------------------------------------------------------------------------------
   -- First we produce the header of the file:
   --------------------------------------------------------------------------------
   -- TODO: Try quasiquoting for multiline-strings here again when they fix the binary bloating problem:
   putS$ "\n//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n"
   putS$ "// This code was GENERATED from a CnC specification, DO NOT MODIFY.\n"
   putS$ "//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n\n"
   putS$ "#ifndef "++appname++"_H_ALREADY_INCLUDED\n"
   putS$ "#define "++appname++"_H_ALREADY_INCLUDED\n\n"

   -- Ideally this would only be included IF tuple types are used... complicated right now.
   -- putS  "#include \"boost/tuple/tuple.hpp\"\n\n"
   putS  "// For now we use C++ TR1 to provide tuples:\n"
   putS  "#include <tr1/tuple>\n"
   putS "#define cnctup std::tr1\n\n"


   putS  "// This tells cnc.h to define certain things.  TODO: should do this ONLY if tuples are needed!\n"
   putS  "#define CNC_ASSUME_TR1 \n\n"

   putS  "#include <cnc/cnc.h>\n"
   putS  "#include <cnc/debug.h>\n"
   when areAnyWrapped$ putS  "#include <cnc/internal/tls.h>\n"

   -- [2010.08.16] This is an INSUFFICIENT forward declaration:

   ------------------------------------------------------------
   -- Emit the step prototypes (two possibilities here):
   ------------------------------------------------------------
   when (genstepdefs)$ 
     putS  "\n// Next this generated file contains prototypes for each step implementation:\n"
   when (not genstepdefs)$ do 
     putS  "// The user's step types should be defined SEPARATELY from this header, and must \n"
     putS  "// be in scope before this header is included.\n"
     putS  "// As a hint, the below are valid example definitions:\n"
     putS  "/*\n"
		
   forM_ stepls_with_types $ \ (stp,ty) ->
     do emitStep appname (fromAtom stp) ty 
        putS "\n\n"
   when (not genstepdefs)$ putS  "*/\n"


   when (not old_05_api) $ do 
     maybeComment [t"", t"", t"Forward declarations for private contexts."] $
	forM_ stepls $ \stp -> 
	   when (shouldWrapStep stp) $
	     putD$ t"class " <> privcontext stp <> semi <> t"\n"
     putS$ "\n"

   ------------------------------------------------------------
   -- Prototype for user step wrappers
   ------------------------------------------------------------   
   let
       usercontext = appname++"_context"             -- The top-level context exposed to the user
       maincontext = if areAnyWrapped                -- The top-level context (internal)
		     then t$ appname++"_context_INTERNAL" 
		     else t usercontext
   let stepwrapper stp = textAtom stp <> t"_step_wrapper"

   when (not old_05_api)$ do
     putS  "// Forward declaration of the context class (representing the CnC graph)\n"
     putD$ t"class " <> maincontext <> t";"
     when areAnyWrapped$ putD$ t"class " <> t usercontext <> t";"

     maybeComment [t"", t"Type definitions for wrappers around steps."]
	(forM_ stepls_with_types $ \ (stp,ty) -> when (shouldWrapStep stp) $ do
	    putD$ struct (stepwrapper stp) $ 
	      textAtom stp <+> t"m_step" <> semi $$
	      --stepwrapper stp <> parens empty <> semi
	      t"int execute(" <+> constRefType ty <+> t "tag," <+> maincontext <> t" & c) const;"
	    putS$ "\n")

   ------------------------------------------------------------
   -- Emit the main context class
   ------------------------------------------------------------   
   putS$ "\n\n// Here is the definition for the main application context:\n" 

--   putD$ cppclass (maincontext <> t " : public CnC::context" <> angles (pad maincontext)) $ 
   cppClass (Syn maincontext) (Syn$ t "public CnC::context" <> angles (pad maincontext)) $ do 

     -- Discarded this API proposal already:
     -- t "\n  private:" : 
     -- t "// Members to store instances of the users Step type:" : 
     -- ((flip map) stepls $ \ stp -> 
     --  textAtom stp <> t"* " <> (t$ step_obj$ fromAtom stp) <> semi) ++

     putS "\n  public:"
     
     when (not old_05_api) $ do
       comm "Step collection members:" 
       forM_ stepls $ \ stp -> 
	 var (doc2Ty$ t "CnC::step_collection" <> angles (if shouldWrapStep stp then stepwrapper stp else textAtom stp))
	     (strToSyn$ step_obj$ fromAtom stp)	 

     comm ""
     comm "Tag collection members:" 
     forM_ (AM.toList tags) $ \ (tg,mty) -> 
       case mty of 
         Nothing -> error$ "CppOld.hs Codegen: tag collection without type: "++ (fromAtom tg)
         Just ty -> var (doc2Ty$ t"CnC::tag_collection" <> angles (cppType ty)) (atomToSyn tg)

     comm ""
     comm "Item collection members:"
     forM_ (AM.toList items) $ \ (itC,mty) -> 
       case mty of 
         Nothing -> error$ "CppOld Codegen: item collection without type: "++ (fromAtom itC)
         Just (ty1,ty2) -> 
	   let extra = 
		case ty1 of  
		  -- In the case where the tag type is dense in all dimensions, turn on CNC_VECTOR:
		  TDense _ -> commspc<> t"CnC::cnc_tag_hash_compare" <> angles (cppType ty1) <>commspc<> t"CnC::CNC_VECTOR"
		  _        -> empty
	   in 
	   var (doc2Ty$ t "CnC::item_collection" <> angles (cppType ty1 <>commspc<> cppType ty2 <> extra)) 
	       (atomToSyn itC)

     comm ""
     comm "Reduction collection members:"
     forM_ (AM.toList reductions) $ \ (rdC, mty) -> 
       case mty of 
         (_, _, Nothing) -> error$ "CppOld.hs Codegen: reduction collection without type: "++ (fromAtom rdC)
         (op, exp, Just (ty1,ty2)) -> var (doc2Ty$ t "CnC::reduction_collection" <> angles (cppType ty1 <> t", " <> cppType ty2))
				          (atomToSyn rdC)

     maybeComment [t"", t" Keys for thread local storage:"] $ 
       forM_ stepls $ \stp -> 
	 when (shouldWrapStep stp) (putD$ t"int "<> tls_key stp <> semi)


     maybeComment [t"",t"Next, global state used/generated by plugins:"] $
       forM_ (AM.toList plug_map) $ \ (stpC,hooks) ->
	 sequence_ $ map (fst . addGlobalState) hooks

     comm ""
     comm "The context class constructor (prototype): "
     constructorPrototype (Syn maincontext) []

     return ()
{-


 ++ 
     
 ++ 

-}

     -- [2010.08.19] Don't need the destructor for now:
     -- [space, t "// The context class destructor: "] ++
     -- [hangbraces 
     --   (t"~" <> maincontext <> parens empty )
     --   indent 
     --   -- Body of the constructor
     --   empty
     --   -- Destroy temporary step objects/collections:
     --   -- (vcat$ (flip map) stepls $ \ stp -> 
     --   -- 	t"delete " <> (t$ step_obj$ fromAtom stp) <> semi)
     -- ]


   ------------------------------------------------------------
   -- Top level bindings (such as tuners):
   ------------------------------------------------------------   

   maybeComment [t"", t"Plugin-generated top-level bindings:"]$
     forM_ (AM.toList plug_map) $ \ (stp, methodtables) -> do
       sequence_ $ 
          map (\fn -> fn (Syn$t usercontext, Syn maincontext) ()) $
          map addTopLevel methodtables

   --------------------------------------------------------------------------------
   -- Emit private contexts for each step.  This means building wrappers.
   --------------------------------------------------------------------------------
   
   -- INVARIANT! Due to error checking above, we can omit some error checking here:
   when (not old_05_api) $ do 
     maybeComment [t"", t"", t"Next we define 'private contexts'.",
                   t"These allow steps to exist in their own little universes with special properties:"] $
      forM_ stepls_with_types $ \ (stp,stpty) -> when (shouldWrapStep stp) $ do
        generate_wrapper_context config spec stp stpty plug_map maincontext usercontext

   when areAnyWrapped $ do
      comm "Also, we generate a wrapper for the main context that is exposed to the user:"
      comm "================================================================================"
      generate_wrapper_context config spec (toAtom special_environment_name) TInt plug_map maincontext usercontext

   ------------------------------------------------------------
   -- Execute wrapper methods 
   ------------------------------------------------------------   

   maybeComment [t"", t"", t"Execute method wrappers for each step that uses a private context:"] $
    forM_ stepls_with_types $ \ (stp,ty) -> when (shouldWrapStep stp) $ do
      putD$ hangbraces 
	(t"int "<> stepwrapper stp <> t"::execute(" <+> constRefType ty <+> t "tag," <+> maincontext <> t" & c) const")
	indent $
	t"// To access the (thread local) state we fetch a pointer to the private context object:"$$
	assignCast (mkPtr$ privcontext stp) (t"ptr") 
		   (U.app "CnC::Internal::CnC_TlsGetValue" [deref (t"c") (tls_key stp)]) $$ 

	hangbraces (t"if " <> parens (t"!ptr")) indent
		   (assign "ptr" (t"new " <> U.app (privcontext stp) ["c"]) $$
		    U.app "CnC::Internal::CnC_TlsSetValue" [deref (t"c") (tls_key stp), t"ptr" ] 
		    <> semi) $$

	t"ptr->tag = &tag;\n" $$
	-- t"printf(\"PTR %p\\n\", ptr);" $$

	(execEasyEmit$ 
	 forM_ (AM.findWithDefault [] stp plug_map) $ \hks -> 
	   beforeStepExecute hks (Syn$ t"ptr", Syn$t"c") (Syn$ t"tag", Syn$ t"ptr", Syn$t"c")) $$
	t"int result = " <+> U.app "m_step.execute" ["tag", "*ptr"] <> semi $$
	(execEasyEmit$ 
	 forM_ (AM.findWithDefault [] stp plug_map) $ \hks -> 
	   afterStepExecute hks (Syn$ t"ptr", Syn$t"c") (Syn$ t"tag", Syn$ t"ptr", Syn$t"c")) $$
	t"return result;"

      -- privcontext stp <> t"* ptr = ("<> privcontext stp 
      --  <> t"*) CnC::Internal::CnC_TlsGetValue" <> parens (t"c." <> tls_key stp) <> semi


   ------------------------------------------------------------
   -- Main Context constructor
   ------------------------------------------------------------
   putS "\n\n"
   putS "// Finally, define the constructor for the main context:\n"
   --when (areAnyWrapped && not old_05_api) $ do 
   when (not old_05_api) $ do 
     putS "// (Note that this occurs AFTER the private contexts are defined.)\n"
     cppConstructor (Syn$ maincontext <> t"::" <> maincontext) [] -- Name, Args
       -- Initializer list:
       ((if old_05_api then [] else  
     	   -- t "// Initialize step collections" :
          ((flip map) stepls $ \ stp -> (Syn$ t$ step_obj$ fromAtom stp, s"this"))) ++

     	  -- t "// Initialize tag collections" :
     	  ((flip map) (AM.toList tags) $ \ (tg,Just ty) -> (atomToSyn tg, s"this, false")) ++ 

      	  -- t "// Initialize item collections" :
     	  ((flip map) (AM.toList items) $ \ (itC,Just (ty1,ty2)) -> (atomToSyn itC, s "this")) ++ 

          -- t "// Initialize reduction collections: "
     	  ((flip map) (AM.toList reductions) $ \ (rdC, (op, exp, Just ty)) -> (atomToSyn rdC, Syn(pPrint exp <> t", & "<> textAtom op <> t", this")))
	  ) $

       -- Body of the constructor
       putD
       (nest 6 $ vcat $ 
         [-- Create objects for all step collections:
     	  -- This was an intermediate step in our API evolution:
     	  -- (vcat$ (flip map) stepls $ \ stp -> 
     	  --  (t$ step_obj$ fromAtom stp) <> t" = new " <> textAtom stp <> parens empty <> semi
     	  -- ),	  

          t"CnC::step_collection< "<> textAtom (head stepls)  <>t" > env(this);\n"
          ]++

	  [t"", 

          -- Generate prescribe relations first [mandatory]:
     	  (vcat $ (flip map) (zip3 stepls prescribers tagtys) $ \ (stp,tg,ty) ->
           t"prescribe" <> parens (pad$ hcat $ punctuate commspc $ 
     				     [ textAtom tg
     				     , if old_05_api 
     				       then textAtom stp <> parens empty
     				       else obj_ref stp] 
				     ++ if gendepends && AS.member stp tractible_depends_steps
				        then [thunkapp (tuner_name stp)]
				        else []
				     -- [2010.08.19] Revamp: don't need tuner/private context here anymore:
				     -- if old_05_api then [] else 
				     -- [t"CnC::default_tuner< " <> cppType ty <>commspc<> privcontext stp <> t" >" <> parens empty
				     --  , t"*" <> privcontext_member stp 
     				     --  --,  privcontext stp <> parens (t"this")
     				     -- ]
				  )
           <> semi),

          -- Next, consume relations:
     	  if old_05_api then empty else 
     	    (let egs = concat $ 
     	           map (\ (a,b,_) -> 
     			      case (lab graph a, lab graph b) of 
     				 (Just (CGItems i), Just (CGSteps s)) -> [(i,s)]
     				 _ -> []) $ 
     		   labEdges graph in 
     	     vcat $ (flip map) egs $ \ (a,b) ->
              t"consume" <> parens (obj_ref b <> commspc <> (t$ fromAtom a)) <> semi),
          -- Finally, produce relations:
     	  if old_05_api then empty else 
     	    (let egs = concat $ 
     	           map (\ (a,b,_) -> 
     			      case (lab graph a, lab graph b) of 
     				 (Just (CGSteps s), Just (CGItems i)) -> [(s,i)]
     			         (Just (CGSteps s), Just (CGTags  t)) -> [(s,t)]
     				 _ -> []) $ 
     		   labEdges graph in 
     	     vcat $ (flip map) egs $ \ (a,b) ->
              t"produce" <> parens (obj_ref a <> commspc <> (t$ fromAtom b)) <> semi), 

          t"", 
          (vcat$ (flip map) stepls $ \ stp -> 
	      if shouldWrapStep stp
	      then assign (tls_key stp) (thunkapp "CnC::Internal::CnC_TlsAlloc")
	      else empty)

        ] ++
	--------------------------------------------------------------------------------
	-- FIXME:
	-- This should be completely obsoleted when the API catches up (e.g. trace_all works properly)
	[hangbraces (t"if " <> parens (if gentracing then t"1" else t"0")) indent (vcat $
	  ((flip map) (zip3 stepls prescribers tagtys) $ \ (stp,tg,ty) ->
	     U.app "CnC::debug::trace" [(text$ step_obj$ fromAtom stp), (dubquotes stp)] <> semi) ++
	  ((flip map) (AM.toList tags) $ \ (tg,_) -> 
	   U.app "CnC::debug::trace" [textAtom tg, dubquotes tg] <> semi) ++
	  ((flip map) (AM.toList items) $ \ (itC,_) -> 
	   U.app "CnC::debug::trace" [textAtom itC, dubquotes itC] <> semi) 
	 )] ++
	--------------------------------------------------------------------------------

        [nest 6$ execEasyEmit$
	 (maybeComment [t"",t"Finally global state added by plugins is initalized:"] $
	   forM_ (AM.toList plug_map) $ \ (stpC,hooks) ->
	     sequence_ $ map (snd . addGlobalState) hooks )]
	)

   ------------------------------------------------------------
   -- Finish up
   ------------------------------------------------------------
   -- This is the "footer" for the document.
   putS$ "\n\n#endif // "++appname++"_H_ALREADY_INCLUDED\n"
   return ()




--------------------------------------------------------------------------------
-- Produce the prototype for a single step.
emitStep appname name ty = putD$ 
  struct (t name)
	 (t ("template < class ctxt > ") $$
	  t "int execute(" <+> constRefType ty <+> t "tag," <+> 
	  t "ctxt & c) const;"
	  --t appname <> t "_context & c) const;"
	 )


-- Make a type both const and a reference.
-- TODO: add some error checking here to see if it is already const or reference...
constRefType ty = t "const" <+> cppType ty <+> t "&"



------------------------------------------------------------------------------------------------------------------------
------------------------------------------------------------------------------------------------------------------------

-- NOTE: This routine is multiplexed so that it can generate a wrapper
-- either for the top-level context (for use by the environment) or for individual step's contexts.
-- To call for the environment, simply call with name (stp) = special_environment_name
-- 
--generate_wrapper_context :: Atom -> Type -> EasyEmit ()
generate_wrapper_context (CodeGenConfig{gendebug})
			 (spec @ CncSpec{appname, steps, tags, items, reductions, graph, realmap}) 
			 stp stpty plug_map maincontext usercontext = 
   let 
       is_top_context = (stp == toAtom special_environment_name)
       classname = if is_top_context then toDoc usercontext else privcontext stp

       fprintf = function$ Syn$t "fprintf"
       stderr  = constant "stderr"
       abort   = function$ Syn$t "abort"		

   in do cppClass (Syn classname) (Syn empty)
	  (do 
           putS "\n  public:\n"

	   comm "First, state for the private context.  Note one private context object is instantiated for EACH thread."
	   when (not is_top_context) $ do
	     comm "Cache the tag for each step instance:" 
	     var (TConst$ TPtr stpty) (s "tag")

             -- Execute plugin hooks:
	     maybeComment [t"",t"Next, collection/thread local state used/generated by plugins:"] $
                sequence_$ map (fst . addLocalState) (AM.findWithDefault [] stp plug_map)

           ------------------------------------------------------------   
	   -- Wrap tag collections:
           ------------------------------------------------------------   
           comm ""
	   comm "Wrappers for tag collections:" 

-- FIXME FIXME TODO TODO: Factor this to merge it with Item collections.
	   forM_ (AM.toList tags) $ \ (tgC, Just ty) -> 
	     --var (TRef TTemplate "CnC::tag_collection" ty) (atomToSyn tgC)

	     -- Unwrapped option, just a reference:
	     --putD$ text "CnC::tag_collection" <> angles (cppType ty) <> t" & " <> textAtom tgC <> semi
             let wrapper = textAtom tgC <> t"_wrapper"
	         member  = t"m_" <> textAtom tgC
	     in
	     cppClass (Syn wrapper) (s"")
		   (do putS "public:"  
		       var (TPtr$ doc2Ty$ classname) (s"m_context")
		       var (TRef$ doc2Ty$ maincontext) (s"parent_context")

		       putD$ t"CnC::tag_collection" <> angles (cppType ty) <> t" & " <> member <> semi $$ t"" 
		       comm "The constructor here needs to grab a reference from the main context:"

		       cppConstructor (Syn wrapper)
			    [(TRef$ litType maincontext, s"p"),
			     (TPtr$ litType classname, s"c")] -- Args.
			    [(Syn$ member, Syn$ t"p." <> textAtom tgC),
			     (s"parent_context", s"p"),
			     (s"m_context", s"c")]  -- Initialization.
			    (do return ()
			        -- set (s"m_context")      (s"c")           -- Body.
			        -- set (s"parent_context") (s"&p")
			        )

		       inlineFunDef voidTy (strToSyn "put") [TConst$ TRef ty] $ \ tagArg -> 
		         do let doplugs project = 
				 forM_ (AM.findWithDefault [] stp plug_map) $ \ hooks ->
				    project hooks (s"m_context", s"parent_context", tgC)
				 	          tagArg
			    doplugs beforeTagPut
			    EE.app (function$ Syn$ t "m_"<> textAtom tgC <> t".put") [tagArg]
			    doplugs afterTagPut
			     
		       return ()
-- FIXME FIXME TODO TODO: Factor this to merge it with Item/Reduction collections.
		       ) 

  	   comm ""
 	   comm "PUBLIC MEMBERS: Tag collections are all wrapped for now:" 
	   forM_ (AM.toList tags) $ \ (tgC, Just ty1) -> 
	     (putD$ textAtom tgC <> t"_wrapper" <+> textAtom tgC <> semi)

           ------------------------------------------------------------   
           comm ""
	   comm "Wrappers for reduction collections:" 
           ------------------------------------------------------------   
           forM_ (AM.toList reductions) $ \ (redC, (op, init, Just (ty1,ty2))) -> do
	     wrap_item_or_reduction_collection "reduction" redC ty1 ty2 classname stp plug_map fprintf stderr abort maincontext realmap gendebug graph
  	   comm ""
 	   comm "PUBLIC MEMBERS: Reduction collections are all wrapped for now:" 
	   forM_ (AM.toList reductions) $ \ (redC, (op, init, Just (ty1,ty2))) -> 
	     (putD$ textAtom redC <> t"_wrapper" <+> textAtom redC <> semi)

           ------------------------------------------------------------   
           comm ""
	   comm "Wrappers for item collections:" 
           ------------------------------------------------------------   
           forM_ (AM.toList items) $ \ (itC,Just (ty1,ty2)) -> do
	     wrap_item_or_reduction_collection "item" itC ty1 ty2 classname stp plug_map fprintf stderr abort maincontext realmap gendebug graph
  	   comm ""
 	   comm "PUBLIC MEMBERS: Item collections are all wrapped for now:" 
	   forM_ (AM.toList items) $ \ (itC, Just (ty1,ty2)) -> 
	     (putD$ textAtom itC <> t"_wrapper" <+> textAtom itC <> semi)

           ------------------------------------------------------------   

           when is_top_context $ do 
	       comm "This member variable holds the *real* context:"
	       var (doc2Ty maincontext) (s"p")
	       comm ""
	       let env_hooks = AM.findWithDefault [] (toAtom special_environment_name) plug_map
		   ctxt_field = s"p"
	       inlineFunDef voidTy (s "wait") [] $ \ () -> do
		  forM_ env_hooks $ \ hooks -> 
		       beforeEnvWait hooks (MainCtxtRef$ ctxt_field)
		  EE.app (function$ ctxt_field `dot` s"wait") []
		  forM_ env_hooks $ \ hooks -> 
		      afterEnvWait hooks (MainCtxtRef$ ctxt_field)
	       return ()

	   comm ""
	   comm "Constructor for the private/custom context: "
	   if False -- is_top_context
	    then do return ()
	    else 
		 cppConstructor (Syn classname)    -- Name.
		     (if is_top_context            -- Args.
		      then []
		      else [(TRef$ litType maincontext, s"p")]) 
		     -- Lots of initializers:
		     ((if is_top_context		      
		       -- In this case we initialize our own copy of the context rather than taking it as argument:
		       then [(s"p", s"")]
		       else []) ++
		      -- Item collections:
		      ((flip map) (AM.toList items) $ \ (itC, Just (ty1,ty2)) -> 
		       (atomToSyn itC, s"p, this")
		      )  ++		

		      ((flip map) (AM.toList reductions) $ \ (redC, _) -> 
		       (atomToSyn redC, s"p, this")
		      ) ++ 

		      ((flip map) (AM.toList tags) $ \ (tgC, Just ty) -> 
		       --(atomToSyn tgC, s"p" `dot` atomToSyn tgC)
		       (atomToSyn tgC, s"p, this") -- This is for the new, WRAPPED, tag collection.
		      ))
		     (maybeComment [t"",t"Next, collection/thread-local state is initalized:"] $
		      sequence_$ map (snd . addLocalState) (AM.findWithDefault [] stp plug_map)
		     )
	   -- Have to wrap tag collections as well just to redirect references to the main context:
	  )
	 putS$ "\n"
	 putS$ "\n"



------------------------------------------------------------------------------------------------------------------------

-- HACK: TEMPORARY: This needs refactoring.
-- It has been factored out here, but clearly the interface is hugely complex:


checkTagFun stp target getnbrs     fprintf stderr abort tagty args realmap graph =  
      -- TODO INSERT CORRECTNESS CHECKING HERE:
      let stpnd  = realmap M.! (CGSteps stp)
	  itemnd = realmap M.! target
	  gctxt  = context graph itemnd
	  lnhbrs = getnbrs gctxt-- lpre' gctxt ++ lsuc' gctxt
	  ls =  filter (\ (nd,lab) -> nd == stpnd) lnhbrs
	  -- [(_,tf)] = filter (\ (nd,lab) -> nd == stpnd)$  lpre' gctxt				            
	  --[(_,tf)] = trace (" LENGTH "++ show (length ls) ++" "++ show stpnd ++" "++ show itemnd++" "++ show lnhbrs) ls
      in 
	 execEasyEmit$
	 case ls of 
	   -- If we have no relationship to that collection its an error to access it:

	   [] -> do let str = printf " [tagfun_check] CnC graph violation: should not access collection '%s' from '%s'" 
				     (graphNodeName target :: String) (show stp) 
		    EE.app fprintf [stderr, stringconst$ str]
		    EE.app abort[]

	   [(_,Nothing)] -> comm " [tagfun_check] No tag function to check..."

	   --((_,Just (TF args exps)) : []) -> 

	   ((_,Just (TF tfargs exps)) : tl) -> -- TEMPTOGGLE ... permissive, ignoring additional tag functions!
	     case (tfargs,exps) of  
	       ([arg], [exp]) -> 
		  do comm (" [tagfun_check] Checking tag function "++ show arg ++" -> "++ show exp)
		     -- TODO: use normal variable decl here:
		     putD$ tagty <+> (fromAtom arg) <+> t"=" <+> t"* m_context->tag" <> semi
		     when (not$ null args)$ assert (head args EE.== Syn (pPrint exp)) -- FIXME -- afer factoring fix this head args
	       _ -> error "internal error: tag function correctness not fully implemented yet.  Finish me."

	   _ -> error$ "internal error: tag function correctness codegen: \n w"++show ls


wrap_item_or_reduction_collection which colName ty1 ty2 classname stp plug_map fprintf stderr abort maincontext realmap gendebug graph = 
           (
	    let 
                isReduction = case which of
                                "reduction" -> True
                                "item"      -> False
                                _ -> error "the helper function wrap_item_or_reduction_collection must take either 'reduction' or 'item'"
                tagty = cppType ty1

	        -- A reused bit of syntax for wrapper get/put methods:
 	        -- (This is one of those things that you don't want to duplicate, 
		--  but it has too many arguments and is poorly abstracted.)
	        wrapGP doret retty nm args isPut = 
		       -- First let's put together the function's arguments:
                       let 
			   doplugs project = execEasyEmit$ 
			       -- FIXME: HACK:
			       when (length args Prelude.>= 2) $
		               forM_ (AM.findWithDefault [] stp plug_map) $ \ hooks ->
				   project hooks (Syn$ t$ snd$ head args, Syn$ t$ snd$ head$ tail args, colName)
					         (Syn$ t$ snd$ head args, Syn$ t$ snd$ head$ tail args)
		       in

		       inlineFunDef retty (s nm) (map (doc2Ty . fst) args) $ \ (args::[Syntax]) -> 
                         do 
#if 1
			    putD$ (if gendebug -- Optionally include debugging assertions.
				   then checkTagFun stp ((if isReduction then CGReductions else CGItems) colName) 
						    (if isPut then lpre' else lsuc') 
						    fprintf stderr abort tagty args realmap graph
				   else empty)
#endif
                            -- Execute plugin hooks:
                            putD$ (if isPut 
				   then doplugs (if isReduction then beforeReducerPut else beforeItemPut)
				   else doplugs (if isReduction then beforeReducerGet else beforeItemGet))
			    --------------------------------------------------------------------------------
			    putD$ (if doret then t"return " else t"") <>
				  t "m_"<> textAtom colName <> t"." <> t nm <> parens (commacat$ map deSyn args) <> semi 
			    --------------------------------------------------------------------------------
			    putD$ (if isPut 
				   then doplugs (if isReduction then afterReducerPut else afterItemPut)
				   else doplugs (if isReduction then afterReducerGet else afterItemGet))

                -- Basic get or put:
		basicGP nm isPut = wrapGP False voidTy nm 
				   [(mkConstRef tagty, "tag"), 
				    ((if isPut then mkConstRef else mkRef) (cppType ty2) , "ref")] isPut

	        wrapper = textAtom colName <> t"_wrapper"
	        member  = t"m_" <> textAtom colName
	    in do 
	    comm$ "The "++ which ++" collection wrapper: A 'NoOp' wrapper class that does nothing: "
	    cppClass (Syn wrapper) (s"")
	          (do putS "public:"  
		      putD$ mkPtr classname <> t" m_context;" 
		      putD$ mkPtr maincontext <> t" parent_context;\n" 

		      putD$ t("CnC::"++ which ++"_collection") <> angles (cppType ty1 <>commspc<> cppType ty2) <> t" & " <> member <> semi $$ t"" 
                      comm "The constructor here needs to grab a reference from the main context:"
	 	      cppConstructor (Syn wrapper)    -- Name.
				     [(TRef$ litType maincontext, s"p"),
				      (TPtr$ litType classname, s"c")]
		                     [(Syn$ member, Syn$ t"p." <> textAtom colName)]
		                     (do set (s"m_context")      (s"c")  
		                         set (s"parent_context") (s"&p"))

		      -- Just three methods: two variants of get and one put.
		      basicGP "get" False 
		      basicGP "put" True 

                      -- Hackish: adding the done and done_all methods:
                      when isReduction $ do 
		         wrapGP False voidTy "done" [(mkConstRef (cppType ty1),"tag")] False
                         wrapGP False voidTy "all_done" [] False
			 return ()

		      if oldstyle_get_method 
		       then do wrapGP True ty2 "get" [(mkConstRef (cppType ty1),"tag")] False
			       return ()
		       else return ()
		      ) 
            putS "")





------------------------------------------------------------------------------------------------------------------------
-- CODING HINTS GENERATION
------------------------------------------------------------------------------------------------------------------------

-- UNFINISHED

codingHints :: StringBuilder m => Bool -> CncSpec -> m ()

codingHints old_05_api (spec @ CncSpec{..}) =
 do putD $ 
     (hangbraces 
       (t"foo") 4 (t"baz")
       )
    

--------------------------------------------------------------------------------
-- EXAMPLE: OLD CODING HINTS:

{-



/****************************************************************************
/* The following code provides an example of what the user code that invokes
/* this graph might look, using the inputs and outputs defined for the 
/* environment (ENV).
/***************************************************************************/
    #include "mandel.h"
    
    // Create an instance of the context class which defines the graph
    mandel_context c;
    
    // Debug trace can be enabled for a collection with the call:
    //     CnC::debug::trace( c.position, "position" );
    
    // For each item from the environment (ENV), put the item using the  
    // proper tag    
    c.data.put( data_Tag, ... );
    c.max_depth.put( max_depth_Tag, ... );
    
    // For each tag value from the environment (ENV), put the tag into
    // the proper tag collection
    c.position.put( position_Tag );
    
    // Wait for all steps to finish
    c.wait();
    
    // For each output to the environment (ENV), get the item using the 
    // proper tag    
    int pixel_ENV;
    pixel.get( pair(...), pixel_ENV );

/*********************************************************************
/* The following code provides an example of what the user Step code 
/* might look like for this Step, using the inputs and outputs defined
/* in the context.
/********************************************************************/
int compute::execute(const pair & t, mandel_context & c ) const
{
     
    // For each input item for this step retrieve the item using the proper tag value
    complex data_instance;
    c.data.get( pair(...), data_instance );
    int max_depth_instance;
    c.max_depth.get( int(...), max_depth_instance );

    // Step implementation logic goes here
    ...

    // For each output item for this step, put the new item using the proper tag value   
    c.pixel.put( pair(...), ... );

    return CnC::CNC_Success;
}

-}