module IRtoPregel where

import Parser
import Spec
import Normalization
import ASTData
import IR
import NtoIR
import GenSMT
import Data.Foldable
import Data.Char
import Text.Groom
import System.Environment
import System.IO
import System.IO.Unsafe

{-
                                Pregel+            Giraph
  -----------------------------------------------------------------------
  gets the current SS number    step_num()         getSuperstep()
  integer value n               n                  new IntWritable(n)
  obtain an integer value       v                  v.get()
    stored in variable v
  id of a vertex                id                 vertex.getId()
  structure data of a vertex    value()            vertex.getValue()
  vote to halt                  vote_to_halt()     vertex.voteToHalt()
  -----------------------------------------------------------------------

-}

{- datatype definitions -}

-- data TargetSystem = Giraph | PregelPlus | NoSystem deriving (Eq, Show)
-- moved to ASTData.hs

data TargetLanguage = Java | CPlusPlus deriving (Eq, Show)

-- indent level
type Depth = Int

-- a single line of a program
type ProgramLine = (Depth, String)

-- list of ProgramLine
type ProgramLines = [ProgramLine]

-- comment
type Comment = String

-- context: tuple of various datatypes and flag
--   dts  :: [IRTypeDecl]    datatype defs of vertex data for each computation
--   vert :: IRVertexStruct  datatypes for vertex (including phase, subphase etc.)
--   edgt :: IREdgeStruct    datatypes for edge
--   msgt :: IRMsgStruct     datatypes for messages
--   aggt :: IRAggStruct     datatypes for aggregator
--   rs   :: Bool            flag whether to use reversed edges
--   ts   :: [(String, Int)] list of pairs of message name and tag value
type IRcxt =
  ([IRTypeDecl], IRVertexStruct, IREdgeStruct, IRMsgStruct, IRAggStruct,
   Bool, [(String, Int)])

-- Type conversion
--   NoTypeConv:       no conversion is necessary
--   WritableTypeConv: conversion such as int -> IntWritable is necessary
data TypeConv = NoTypeConv | WritableTypeConv deriving (Eq, Show)

-- Variable declaration
--   MemberVarDecl: declration of member variables in Class / Struct
--   BlockVarDecl : normal variable declaration in a block
data VarDecl = MemberVarDecl | BlockVarDecl deriving (Eq, Show)

-- place where master class is defined
--   MCOuter: master class is defined at the outermost place.
--   MCInner: master class is defined as an inner class of VertexComputation
--   MCNone:  master class is unnecessary
data MasterClassDef = MCOuter | MCInner | MCNone deriving (Eq, Show)

-- operators that are overloaded when C++ is used
--   LTLT:  <<
--   GTGT:  >>
--   EQEQ:  ==
data OOperator = LtLt | GtGt | EqEq deriving (Eq, Show)

-- IRType definitions
irInt, irBool, irDouble :: IRType
irInt = IRSimpleType (DTInt ())
irBool = IRSimpleType (DTBool ())
irDouble = IRSimpleType (DTDouble ())

-- utility
pow2 :: Int -> Int
pow2 n = product $ take n $ repeat 2

           
-- Moved from IR.hs
-- This datatype is only used in the Pregel+ generator
data IRModifier = IRModVirtual | IRInline | IRNoModifier

{-
   naming convention for functions
     sXxxx returns a String
     gXxxx returns a ProgramLine
     ggXxxx returns a ProgramLines
-}

{- class definiton of PregelGenerator -}
class PregelGenerator g where
  {-- Target --}
  -- target system
  targetSystem :: g -> TargetSystem

  -- target language
  targetLanguage :: g -> TargetLanguage

  {-- Vertex --}
  -- vertex data structure name
  sVertStructName :: g -> String
  sVertStructName g = "VertData"

  -- typename of the vertex id
  sVertexIDType :: g -> String

  -- obtaining the vertex id
  sVertexGetId :: g -> String

  -- obtaining the vertex data structure
  sVertexGetValue :: g -> String

  -- storing the vertex data structure
  -- If it is "", it is not necessary to store the vertex data structure.
  sVertexSetValue :: g -> String
  sVertexSetValue g = ""

  -- flag whether the type of sVertexGetValue has &, i.e., VertData&
  fVertexTypeRef :: g -> Bool
  fVertexTypeRef g = False

  -- flag whether vertex has a member for edges
  fVertexHasEdges :: g -> Bool
  fVertexHasEdges g = False

  -- flag whether vertex has a member for aggregated value or not
  fVertexHasAggr :: g -> Bool
  fVertexHasAggr g = False

  {-- Edge --}
  -- flag whether edge data class is to be generated or not
  fEdgeClass :: g -> Bool
  fEdgeClass g = False

  -- edge data structure name
  sEdgeStructName :: g -> String
  sEdgeStructName g = "EdgeData"

  -- accessor for a mamber of an edge
  sEdgeMember :: g -> String -> [IRNameAndType] -> String
  sEdgeMember g name fs = name

  -- id of the target vertex of an edge
  sEdgeVertexId :: g -> String
  sEdgeVertexId g = "sEdgeVertexId"

  -- judges whether an edge is a forward edge
  sIsForwardEdge :: g -> String
  sIsForwardEdge g = "0"

  -- judges whether an edge is a reverse edge
  sIsReverseEdge :: g -> String
  sIsReverseEdge g = "0"

  {-- Message --}
  -- message data structure name
  sMsgStructName :: g -> String
  sMsgStructName g = "MsgData"

  -- flag whether message struct needs ``from'' field
  fMsgNeedFrom :: g -> Bool
  fMsgNeedFrom g = False

  -- type of the ``from'' field when fMsgNeedFrom is True
  tMsgFromType :: g -> IRType
  tMsgFromType g = irInt

  -- flag whether message struct needs ``tag'' field
  fMsgNeedTag :: g -> Bool
  fMsgNeedTag g = False

  -- type of the ``tag'' field when fMsgNeedTag is True
  tMsgTagType :: g -> IRType
  tMsgTagType g = irInt

  -- iteration string for receiving messages sent to a vertex
  sMsgRecvIter :: g -> String

  -- string for accessing each message sent to a vertex
  sMsgRecvMsg :: g -> String

  -- iteration string for sending messages to adjacent vertices
  sMsgSendIter :: g -> String

  -- variable declaration string that should be put just before sMsgSendIter
  sMsgSendVardecl :: g -> String -> String
  sMsgSendVardecl g mem = ""

  -- string for sending a message
  -- Bool indicates that the message is sent along a forward / reverse edge
  sSendMsg :: g -> Bool -> String

  -- flag whether to use message combiner
  fMsgCombiner :: g -> Bool
  fMsgCombiner g = False

  -- class name for message combiner
  sMsgCombClassName :: g -> String -> String
  sMsgCombClassName g pname = "Combiner_" ++ pname

  -- function that generates message combiner class
  ggMsgCombiner ::
    g -> Depth -> String -> IRMsgStruct -> IRPhaseCompute -> ProgramLines
  ggMsgCombiner g d pname msgt pcomp = []

  {-- Aggregator --}
  -- flag whether aggregator class is to be generated or not
  -- Note that aggregator class is NOT aggregator data structure
  fAggClass :: g -> Bool
  fAggClass g = False

  -- function that generates program lines for aggregator class definition
  ggAggClass :: g -> Depth -> String -> String -> IRcxt -> ProgramLines
  ggAggClass g d aclsnm vclsnm cxt = []

  -- aggregator data structure name
  sAggStructName :: g -> String
  sAggStructName g = "AggData"

  -- string for performing aggregate operation
  sAggregate :: g -> IRNameAndType -> String

  -- string for getting aggregated value
  sAggValue :: g -> IRNameAndType -> String

  {-- Aggregation of messages sent from neighboring vertices --}
  -- flag whether a specified operator's decl part is treated specially or not
  fStatementMsgDecl :: g -> IRAggOp -> Bool
  fStatementMsgDecl g op = False

  ggStatementMsgDecl :: g -> Depth -> IRVar -> IRAggOp -> ProgramLines
  ggStatementMsgDecl = ggStatementMsgStandardDecl

  -- flag whether a specified operator's loop part is treated specially or not
  fStatementMsgLoop :: g -> IRAggOp -> Bool
  fStatementMsgLoop g op = False

  ggStatementMsgLoop ::
    g -> Depth -> IRcxt -> IRVar -> IRAggOp -> IRExpr -> ProgramLines
  ggStatementMsgLoop = ggStatementMsgStandardLoop 

  {-- Class --}
  -- string for defining class
  -- Its type is:
  -- g -> Modifier -> ClassName -> SuperClassName -> [ImplClassName] -> String
  sClassDecl :: g -> String -> String -> String -> [String] -> String

  -- string for defining sturct
  sStructDecl :: g -> String -> String

  -- flag whether struct defines constructors, write and readFields methos
  fStructHasMethods :: g -> Bool
  fStructHasMethods g = False

  -- function that generates method definitions
  ggStructMethods :: g -> Depth -> String -> [IRNameAndType] -> ProgramLines
  ggStructMethods g d name ms = []

  {-- Master --}
  -- how master class is to be defined
  fMasterClass :: g -> MasterClassDef
  fMasterClass g = MCNone

  -- name of the master class
  sMasterClassName :: g -> String -> String
  sMasterClassName g pname = "MasterComputation_" ++ pname

  -- string for the header of vertex computation class
  sMasterClassHeader :: g -> String -> String
  sMasterClassHeader g pname = "class " ++ sMasterClassName g pname

  -- string for declaring master.compute()
  sMasterCompHead :: g -> String
  sMasterCompHead g = ""

  -- function that generates method definitions except compute, e.g.,
  -- initialize
  ggMasterMethods :: g -> Depth -> IRcxt -> ProgramLines
  ggMasterMethods g d cxt = []

  {-- Basic Computation --}
  -- name of the basic vertex computation class
  sVertCompClassName :: g -> String -> String
  sVertCompClassName g pname = "VertexComputation_" ++ pname

  -- string for the header of vertex computation class
  sVertCompClassHeader :: g -> String -> IRcxt -> String
  sVertCompClassHeader g pname cxt = "class " ++ sVertCompClassName g pname

  -- string for declaring vertex.compute()
  sVertCompHead :: g -> String

  -- flag wheter this class contains ``toline'' method
  fToLine :: g -> Bool
  fToLine g = False

  -- function that generates ``toline'' method
  ggToLine :: g -> Depth -> IRcxt -> ProgramLines
  ggToLine g d cxt = []

  {-- Operator --}
  -- flag whether overloaded operators are to be generated or not
  fOperatorOverload :: g -> Bool
  fOperatorOverload g = False

  -- function that generates program lines for operator definition
  ggOperators :: g -> Depth -> [OOperator] -> String ->
                 [IRNameAndType] -> ProgramLines
  ggOperators g d ops strname ms = []

  {-- Types including Writable --}
  -- function that convers DType to a corresponding (primitive) typename
  sDTypeSimple :: g -> DType a -> String
  sDTypeSimple g _ = "primitive type"

  -- function that convers DType to a corresponding typename, which might
  -- be ``writable''
  sDType :: g -> DType a -> String
  sDType g = sDTypeSimple g

  -- flag whether writable datatypes are used or not
  fUseWritable :: g -> Bool
  fUseWritable g = False

  -- function that converts primitive value to writable value
  sMakeWritable :: g -> String -> IRType -> String
  sMakeWritable g s t = s

  -- function that converts writable value to primitive value
  sMakePrimitive :: g -> String -> String
  sMakePrimitive g s = sPutParen s `sClassMember` "get()"

  {-- Misc --}
  -- flag whether structured data types are embedded
  fEmbedStruct :: g -> Bool
  fEmbedStruct g = False
  -- fEmbedStruct g = True

  -- string for getting the current superstep number
  sSSNumber :: g -> String

  -- string for vote to halt
  sVoteToHalt :: g -> String

  -- conversion function of a function name
  sFunName :: g -> String -> String
  sFunName g s = s

  -- initializes random number generator
  sInitRand :: g -> String
  sInitRand g = ""

  -- generates random number within [0,1]
  sGenRand :: g -> String
  sGenRand g = "rand()"

  {-- Prologue and Epilogue code --}
  -- flag whether to generate prologue code
  fGeneratePrologue :: g -> Bool
  fGeneratePrologue g = False

  -- function for generating epilog code
  ggGeneratePrologue ::
    g -> String -> IRcxt -> String -> String -> Option -> ProgramLines
  ggGeneratePrologue g pname cxt vclsnm aclsnm opt = []

  -- flag whether to generate epilogue code, e.g, main function
  fGenerateEpilogue :: g -> Bool
  fGenerateEpilogue g = False

  -- function for generating epilogue code
  ggGenerateEpilogue ::
    g -> String -> IRcxt -> String -> String -> Option -> ProgramLines
  ggGenerateEpilogue g pname cxt vclsnm aclsnm opt = []

  -- Emoto 2018/01/16: added
  -- flag whether to generate I/O code, e.g, input/output formats
  fGenerateIO :: g -> Bool
  fGenerateIO g = False

  -- Emoto 2018/01/16: added
  -- function for generating I/O code
  ggGenerateIO ::
    g -> String -> IRcxt -> IRVertexComputeState -> ProgramLines
  ggGenerateIO g pname cxt ist = []

-- end of class PregelGenerator

{- Pregel+ -}
data PregelPlusGenerator = PregelPlusGenerator deriving (Eq, Show)

instance PregelGenerator PregelPlusGenerator where
  targetSystem PregelPlusGenerator = PregelPlus

  targetLanguage PregelPlusGenerator = CPlusPlus

  -- sVertStructName PregelPlusGenerator = "VertData"

  sVertexIDType PregelPlusGenerator = "VertexID"

  sVertexGetId PregelPlusGenerator = "id"

  sVertexGetValue PregelPlusGenerator = "value()"
  
  fVertexTypeRef PregelPlusGenerator = True

  fVertexHasEdges PregelPlusGenerator = True

  fVertexHasAggr PregelPlusGenerator = True

  fEdgeClass PregelPlusGenerator = True

  sEdgeMember PregelPlusGenerator name fs = "nbs[i]." ++ name

  sEdgeVertexId PregelPlusGenerator = "nbs[i].nb"

  --fMsgNeedFrom PregelPlusGenerator = True

  sMsgRecvIter PregelPlusGenerator =
    "for (int i = 0; i < messages.size(); i++)"

  sMsgRecvMsg PregelPlusGenerator = "messages[i]"

  sMsgSendIter PregelPlusGenerator = "for (int i = 0; i < nbs.size(); i++)"

  sMsgSendVardecl PregelPlusGenerator mem =
    "vector<" ++ sEdgeStructName PregelPlusGenerator ++ ">& nbs = " ++ e ++ ";"
    where e = sVertex `sClassMember` mem

  sSendMsg PregelPlusGenerator dir = "send_message(nbs[i].nb, " ++ sMsg ++ ")"

  fMsgCombiner PregelPlusGenerator = True

  ggMsgCombiner PregelPlusGenerator d pname msgt ph = ws
    where mstr = sMsgStructName PregelPlusGenerator
          ws = [ (0,"class " ++ clazz ++ ": public Combiner<" ++ mstr ++ ">")
               , (0,"{")
               , (0,"public:")
               , (1,"virtual void combine("++ mstr ++"& old, const "++ mstr
                     ++"& neu)")
               , (1,"{")
               ]
               ++
               as
               ++
               [ (1,"}")
               , (0,"};")
               ]
          clazz = sMsgCombClassName PregelPlusGenerator pname
          IRMsgStruct _ members = msgt
          IRPhaseCompute phases = ph
          stmts = concatMap getstmts phases
          getstmts (IRPhaseComputeProcess _ _ _ (IRBlock _ stmts) _) = stmts
          as = map comb members
          comb (memname, _) = putDS 2 (combcond (getAgg stmts))
            where oldmem = "old." ++ memname
                  newmem = "neu." ++ memname
                  ifcomb c s = "if (" ++ c ++ ") " ++ s
                  bin op = oldmem ++ " " ++ op ++ " " ++ newmem
                  combcond IRAggMin = ifcomb (bin ">") (bin "=")
                  combcond IRAggMax = ifcomb (bin "<") (bin "=")
                  combcond IRAggAnd = ifcomb oldmem (bin "=")
                  combcond IRAggOr = ifcomb ("!" ++ oldmem) (bin "=")
                  combcond IRAggSum = bin "+="
                  combcond IRAggProd = bin "*="
                  getAgg [] = undefined
                  getAgg (IRStatementMsg _ agg (IRMVal (v, _)) : xs) =
                    if v == memname then agg else getAgg xs 
                  getAgg (x:xs) = getAgg xs

  fAggClass PregelPlusGenerator = True

  sAggregate PregelPlusGenerator (n, t) =
    sAssignExpr left n
    where left = sAggInVertexMember PregelPlusGenerator sVertex n

  sAggValue PregelPlusGenerator (n,t) =
    "(*(" ++ sAggStructName PregelPlusGenerator ++ " *)(getAgg()))"
    `sClassMember` n

  sClassDecl PregelPlusGenerator mod name super impls =
    mod ++ c ++ name ++ ": public " ++ super
    where c = if mod == "" then "class " else " class "

  sStructDecl PregelPlusGenerator name = "struct " ++ name

  sVertCompClassHeader PregelPlusGenerator pname cxt =
    "class " ++ sVertCompClassName g pname ++ ": public " ++ sup
    where sup = sIRType
                 g
                 NoTypeConv
                 (IRGenericsType "Vertex"
                    (map
                       simpleUserType
                       [sVertexIDType g, sVertStructName g, sMsgStructName g]))
          g = PregelPlusGenerator

  sVertCompHead PregelPlusGenerator =
    "public: virtual void compute(MessageContainer& messages)"

  fToLine PregelPlusGenerator = True

  ggToLine PregelPlusGenerator d (dts,vt,_,_,_,_,_) =
    (d, "public: void toline(char *buf)") : ggPutCBracket d [(d + 1, p)]
    where p = "sprintf(buf, " ++ f ++ ", id, " ++ args ++ ");"
          -- p = "sprintf(buf, " ++ ", id, " ++ args ++ ");"
          IRVertexStruct name phase subphase pcms nopcms = vt
          -- Emoto 2018/01/16: modified to deal with the original phase ids
          mems = if fEmbedStruct PregelPlusGenerator
                 then map f (concatMap (inlineStruct True dts . fst) pcms)
                 else concatMap (g.fst) pcms
                 where f (n,t) = (sCurrName n, t)
                       g m@(n,t) = map (h n) (inlineStruct False dts m)
                       h n (n2,t2) = (sCurrName n `sClassMember` n2, t2)
          args = concat (mapInsert vf ", " False (map fst mems))
                 where vf = ("value()" `sClassMember`)
          f = "\"%d  " ++
              concat (mapInsert per " " False (map snd mems)) ++ "\\n\""
          per t = if t == irInt then "%d"
                  else if t == irBool then "%d"
                  else if t == irDouble then "%f"
                  else "%p"

  fOperatorOverload PregelPlusGenerator = True

  sDTypeSimple PregelPlusGenerator (DTInt _) = "int"
  sDTypeSimple PregelPlusGenerator (DTBool _) = "bool"
  sDTypeSimple PregelPlusGenerator (DTString _) = "char*"
  sDTypeSimple PregelPlusGenerator (DTDouble _) = "double"
  sDTypeSimple PregelPlusGenerator (DTTuple _ _) = "dttuple"
  sDTypeSimple PregelPlusGenerator (DTRecord con ts _) = "dtrecord"

  fEmbedStruct PregelPlusGenerator = True

  sSSNumber PregelPlusGenerator = "step_num()"

  sVoteToHalt PregelPlusGenerator = "vote_to_halt()"

  sFunName PregelPlusGenerator "mod" = sOperator ++ "%"
  sFunName PregelPlusGenerator s = s

  sInitRand PregelPlusGenerator = "srand((unsigned)time(NULL));"

  sGenRand PregelPlusGenerator = "((double)rand() / RAND_MAX)"

  ggAggClass PregelPlusGenerator d aclsnm vclsnm cxt@(_,_,_,_,aggt,_,_) =
    ggClass g d (sClassDecl g "" aclsnm (sIRType g NoTypeConv super) [])
            aclsbody
    where g = PregelPlusGenerator
          IRAggStruct _ apairs = aggt
          astr = sAggStructName g
          super = IRGenericsType "Aggregator"
                    (map simpleUserType [vclsnm, astr, astr])
          d1 = d + 1
          d2 = d + 2
          aclsbody = (d, "private:") :
                     putDS d1 (sIRNameAndType g (aggv, IRUserType astr [])) :
                     -- putDS d1 (sIRNameAndType g (sNeedAgg, irInt)) :
                     (d, "public:") :
                     concat [ minit, mspar, msfin, mfpar, mffin ]
          aggv  = sAgg
          vir   = "virtual "
          minit = (d1, vir ++ sMethodDefHead g IRVoidType "init" []) :
                  --ggPutCBracket d1 (gAssignStmt d2 sNeedAgg "0" ++ map (gAggInit d2 aggv) apairs)
                  ggPutCBracket d1 (map (gAggInit d2 aggv) apairs)
          mspar = (d1, vir ++ sMethodDefHead g IRVoidType "stepPartial"
                                [("v", IRUserType (vclsnm ++ "*") [])]) :
                  ggPutCBracket d1
                    (ggAggIfs d2 aggv lop apairs gAggStepPartial ++
                     []) --[gUpdateWithOrStmt d2 sNeedAgg lop])
                     --[gAssignStmt d2 sNeedAgg lop])
                  where lop = "v->value()" `sClassMember` sNeedAgg
          msfin = (d1, vir ++ sMethodDefHead g IRVoidType "stepFinal"
                         [("p", astrp)]) :
                  ggPutCBracket d1
                      ( map (\p -> gAggStepFinal (d1 + 1) aggv p) apairs )
                    --(ggAggIfs d2 aggv sNeedAgg apairs gAggStepFinal)
          mfpar = (d1, vir ++ sMethodDefHead g astrp "finishPartial" [])
                  : ggPutCBracket d1 [gAggFinishPartial d2 aggv]
          mffin = (d1, "virtual " ++ sMethodDefHead g astrp "finishFinal" []) :
                  ggPutCBracket d1
                    [gAggFinishFinal d2 aggv]
                    --[gAssignStmt d2 sNeedAgg "0", gAggFinishFinal d2 aggv]
          astrp = IRUserType (astr ++ "*") []
          ggAggIfs ::
            Depth -> String -> String -> [(IRNameAndType, IRAggOp)] ->
            (Depth -> String -> (IRNameAndType, IRAggOp) -> ProgramLine) ->
            ProgramLines
          ggAggIfs d aggv lop [] gfn = []
          ggAggIfs d aggv lop (p:ps) gfn =
            ggAggIf d aggv "1" lop p gfn ++ ggAggIfs' 2 ps
            where ggAggIfs' n [] = []
                  ggAggIfs' n (p:ps) = ggAggIf d aggv (show (pow2 (n-1))) lop p gfn ++
                                       ggAggIfs' (n + 1) ps
                  --ggAggIfs' n (p:ps) = ggAggIf d aggv (show (n)) lop p gfn ++
                  --                     ggAggIfs' (n + 1) ps
          ggAggIf ::
            Depth -> String -> String -> String -> (IRNameAndType, IRAggOp) ->
            (Depth -> String -> (IRNameAndType, IRAggOp) -> ProgramLine) ->
            ProgramLines
          ggAggIf d aggv n lop p gfn =
            f d cond (ggPutCBracket d [gfn (d + 1) aggv p])
            where cond = sBinopExpr "&" lop n
                  f = ggIfThenStmt
            --where cond = sBinopExpr "==" lop n
            --      f = if n == "1" then ggIfThenStmt else ggElseIfThenStmt
          gAggInit ::
            Depth -> String -> (IRNameAndType, IRAggOp) -> ProgramLine
          gAggInit d aggv ((n, t), op) =
            gAssignStmt d (aggv `sClassMember` n) (aggOpUnit op)
          gAggStepPartial ::
            Depth -> String -> (IRNameAndType, IRAggOp) -> ProgramLine
          gAggStepPartial d aggv ((n, t), op) =
            gAssignStmt d left
              (sIRExpr g cxt
                       (IRFunAp (aggOp2Fun g op)
                                [IRVExp (IRVarLocal (left, t)),
                                 IRVExp (IRVarLocal (right, t))]))
            where left = aggv `sClassMember` n
                  right = sAggInVertexMember PregelPlusGenerator "v->value()" n
          gAggStepFinal ::
            Depth -> String -> (IRNameAndType, IRAggOp) -> ProgramLine
          gAggStepFinal d aggv ((n, t), op) =
            gAssignStmt d left
              (sIRExpr g cxt
                       (IRFunAp (aggOp2Fun g op)
                                [IRVExp (IRVarLocal (left, t)),
                                 IRVExp (IRVarLocal (right, t))]))
            where left = aggv `sClassMember` n
                  right = "(*p)" `sClassMember` n
          gAggFinishPartial :: Depth -> String -> ProgramLine
          gAggFinishPartial d aggv = gReturnStmt d ("&" ++ aggv)
          gAggFinishFinal :: Depth -> String -> ProgramLine
          gAggFinishFinal d aggv = gReturnStmt d ("&" ++ aggv)

  ggOperators PregelPlusGenerator d ops strname ms =
    concatMap opdef ops
    where opdef LtLt =
            (d, opdefhead "<<") :
            ggPutCBracket d
              (putDSs (d + 1) (map (opdefbody "<<") ms ++ ["return m"]))
          opdef GtGt =
            (d, opdefhead ">>") :
            ggPutCBracket d
              (putDSs (d + 1) (map (opdefbody ">>") ms ++ ["return m"]))
          opdef EqEq =
            (d, opdefheadeqeq) :
            ggPutCBracket d
              [gReturnStmt (d + 1)
                           (if null ms
                            then "true"
                            else concatMapInsert eqcheck "&&" False ms)]
            where eqcheck (m,_) = sBinopExpr "=="
                                             ("t1" `sClassMember` m)
                                             ("t2" `sClassMember` m)
          opdefhead op =
            stream ++ "& operator" ++ op ++ "(" ++ stream ++ "& m, " ++
            cons ++ strname ++ "& v)"
            where stream = if op == "<<" then "ibinstream" else "obinstream"
                  cons = if op == "<<" then "const " else ""
          opdefheadeqeq =
            "inline bool operator==(const " ++ strname ++ "& t1, const " ++
            strname ++ "& t2)"
          opdefbody op (name,_) = "m " ++ op ++ " v." ++ name

  fGeneratePrologue PregelPlusGenerator = True
 
  ggGeneratePrologue PregelPlusGenerator pname cxt vclsnm aclsnm opt =
    [ (0, "#include \"basic/pregel-dev.h\"")
    , (0, "using namespace std;")
    , (0, "inline int stateToCaseval(int p, int s) {")
    , (1, "return p * 10 + s;")
    , (0, "}")
    ]

  fGenerateEpilogue PregelPlusGenerator = True

  ggGenerateEpilogue
    PregelPlusGenerator pname cxt@(_,_,_,_,_,rv,_) vclsnm aclsnm opt =
    ws ++ fs ++ rs ++ us ++ ps ++ ms
    where ag = if aclsnm == "" then "DummyAgg" else aclsnm
          vt = sIRType PregelPlusGenerator NoTypeConv (getValType cxt)
          et = sIRType PregelPlusGenerator NoTypeConv (getEType cxt)
          ws = [ (0, "class Worker_" ++ pname ++ ": public Worker<" ++
                     vclsnm ++ "," ++ ag ++ ">")
               , (0, "{")
               , (1, "char buf[1000];")
               , (0, "public:")
               , (1, "// input line:")
               , (1, "// vid \\t val degree nb1 len1 nb2 len2 ...")
               , (1, "virtual " ++ vclsnm ++ " *toVertex(char *line) {")
               , (2, "char *pch;")
               , (2, "pch = strtok(line, \"\\t\");")
               , (2, vclsnm ++ " *v = new " ++ vclsnm ++ ";")
               , (2, "int id = atoi(pch); // vertex id")
               --, (2, "printf(\"id = %d\\n\", id);")
               , (2, "v->id = id;")
               , (2, "pch = strtok(NULL, \" \");")
               , (2, if vt == "int" then "int val = atoi(pch);"
                     else if vt == "double"
                          then "double val = (double)atof(pch);"
                     else "int val = atoi(pch);")
               , (2, "v->value().val = val;")
               --, (2, "printf(\"val = %d\\n\", val);")
               ]
          readEdges fd = 
               [ (2, "{")
               , (3, "pch = strtok(NULL, \" \");")
               , (3, "int deg = atoi(pch);")
               , (3, "for (int i = 0; i < deg; i++) {")
               , (4, "pch = strtok(NULL, \" \");")
               , (4, "int nb = atoi(pch); // neighbor")
               , (4, "pch = strtok(NULL, \" \");")
               , (4, if et == "int" then "int e = atoi(pch);"
                     else if et == "double"
                          then "double e = (double)atof(pch);"
                     else "int val = atoi(pch);")
               --, (4, "printf(\"nb = %d, e = %d\\n\", nb, e);")
               , (4, sEdgeStructName PregelPlusGenerator ++
                     " edge = { nb, e };")
               , (4, "v->value()." ++ (if fd then "edges" else "redges") ++
                     ".push_back(edge);")
               , (3, "}")
               , (2, "}")
               ]
          fs = readEdges True
          rs = if rv then readEdges False else []
          us = [ (2, "return v;")
               , (1, "}")
               , (1, "// output line")
               , (1, "// vid \\t val")
               , (1, "virtual void toline(" ++ vclsnm ++
                     " *v, BufferedWriter& writer) {")
               , (2, "v->toline(buf);")
               , (2, "writer.write(buf);")
               , (1, "}")
               , (0, "};")
               ]
          ps = [ (0, "void pregel_" ++ pname ++ "(string inp, string outp) {")
               , (1, "WorkerParams param;")
               , (1, "param.input_path = inp;")
               , (1, "param.output_path = outp;")
               , (1, "param.force_write = true;")
               , (1, "param.native_dispatcher = false;")
               , (1, "Worker_" ++ pname ++ " worker;")
               ]
               ++
               ( if aclsnm /= "" then
               [ (1, aclsnm ++ " agg;")
               , (1, "worker.setAggregator(&agg);")
               ] else [])
               ++
               (if fMsgCombiner PregelPlusGenerator && useMsgCombOpt opt then
               [ (1, sMsgCombClassName PregelPlusGenerator pname ++ " comb;")
               , (1, "worker.setCombiner(&comb);")
               ] else [])
               ++
               [ (1, "worker.run(param);")
               , (0, "}")
               ]
          ms = [ (0, "int main(int argc, char *argv[]) {")
               , (1, "init_workers();")
               , (1, "pregel_" ++ pname ++ "(\"/" ++ pname ++ "/input\"" ++
                     ", \"/" ++ pname ++ "/output\");")
               , (1, "worker_finalize();")
               , (1, "return 0;")
               , (0, "}")
               ]

-- end of instance PregelGenerator PregelPlusGenerator

{- Giraph -}
data GiraphGenerator = GiraphGenerator deriving (Eq, Show)

instance PregelGenerator GiraphGenerator where
  targetSystem GiraphGenerator = Giraph

  targetLanguage GiraphGenerator = Java

  -- sVertexIDType GiraphGenerator = "LongWritable"
  sVertexIDType GiraphGenerator = "IntWritable"

  sVertexGetId GiraphGenerator = "vertex.getId()"

  sVertexGetValue GiraphGenerator = "vertex.getValue()"

  sVertexSetValue GiraphGenerator = "vertex.setValue(" ++ sVertex ++ ")"

  sEdgeMember GiraphGenerator name fs = "edge.getValue()"

  sEdgeVertexId GiraphGenerator = "edge.getTargetVertexId()"

  sIsForwardEdge GiraphGenerator =
    sPutParen (sMakePrimitive GiraphGenerator (sEdgeVertexId GiraphGenerator)
               ++ " > 0")

  sIsReverseEdge GiraphGenerator =
    sPutParen (sMakePrimitive GiraphGenerator (sEdgeVertexId GiraphGenerator)
               ++ " < 0")

  -- fMsgNeedTag GiraphGenerator = True

  -- tMsgTagType GiraphGenerator = IRUserType "Text" []

  sMsgRecvIter GiraphGenerator =
    "for (" ++ sMsgStructName GiraphGenerator ++ " msg : messages)"

  sMsgRecvMsg GiraphGenerator = "msg"

  sMsgSendIter GiraphGenerator =  -- TODO: IntWritable -> EdgeData
    "for (Edge<" ++ sVertexIDType GiraphGenerator ++ ", IntWritable> edge : vertex.getEdges())"

  sSendMsg GiraphGenerator True =
    "sendMessage(" ++ sEdgeVertexId GiraphGenerator ++ ", " ++ sMsg ++ ")"
  sSendMsg GiraphGenerator False =
    "sendMessage(new " ++ sVertexIDType GiraphGenerator ++ "(-(" ++ sEdgeVertexId GiraphGenerator ++
    ".get())), " ++ sMsg ++ ")"

  fAggClass GiraphGenerator = False

  sAggregate GiraphGenerator (n, t) =
    "aggregate(\"" ++ n ++ "\", " ++ sMakeWritable GiraphGenerator n t ++ ")"

  sAggValue GiraphGenerator (n,t) =
    "(" ++ sIRType GiraphGenerator WritableTypeConv t ++
    ")(getAggregatedValue(\"" ++ n ++ "\"))"

  sClassDecl GiraphGenerator mod name super impls =
    mod ++ c ++ name ++ sup ++ imp
    where c = if mod == "" then "class " else " class "
          sup = if super == "" then "" else (" extends " ++ super)
          imp = if impls == [] then "" else (" implements " ++ foldl1 f impls)
                where f c1 c2 = c1 ++ ", " ++ c2

  sStructDecl GiraphGenerator name =
    "public static class " ++ name ++ " implements Writable"

  fStructHasMethods GiraphGenerator = True

  ggStructMethods GiraphGenerator d name ms =
    ggConstr ++ ggWrite ++ ggRead
    where ggConstr = ggMethod mhead mbody
                     where mhead = "public " ++ name ++ "()"
                           mbody = map initMem ms
                           initMem :: IRNameAndType -> String
                           initMem (n,t) =
                             sAssignExpr ("this" `sClassMember` n) (initVal t)
                           initVal :: IRType -> String
                           initVal t@(IRSimpleType dt) =
                             sMakeWritable GiraphGenerator "" t
                           initVal (IRUserType s _) = "new " ++ s ++ "()"
                           initVal _ = error "error in initVal"
          ggWrite = ggMethod mhead mbody
                    where mhead = "public void write(DataOutput out) " ++ th
                                  
                          mbody = map wrMem ms
                          wrMem :: IRNameAndType -> String
                          wrMem (n,_) = n `sClassMember` "write(out)"
          ggRead = ggMethod mhead mbody
                   where mhead = "public void readFields(DataInput in) " ++ th
                         mbody = map rdMem ms
                         rdMem :: IRNameAndType -> String
                         rdMem (n,_) = n `sClassMember` "readFields(in)"
          ggMethod h b = (d, h) : ggPutCBracket d (putDSs (d + 1) b)
          th = "throws IOException"

  fMasterClass GiraphGenerator = MCOuter

  sMasterClassHeader GiraphGenerator pname =
    sClassDecl GiraphGenerator "public static"
               (sMasterClassName GiraphGenerator pname)
               "DefaultMasterCompute" []

  sMasterCompHead GiraphGenerator = "public void compute()"

  ggMasterMethods GiraphGenerator d (_, _, _, _, IRAggStruct _ ps, _, _) =
    concat [ [(d, "public void initialize() throws " ++
                  "InstantiationException, IllegalAccessException")]
           , ggPutCBracket d (putDSs (d + 1) (map f ps))
           ]
    where f ((n, t), op) = "registerAggregator(\"" ++ n ++ "\", " ++
                           aggopcls op t ++ ")"
          aggopcls IRAggAnd _ = "BooleanAndAggregator.class"
          aggopcls IRAggOr _ = "BooleanOrAggregator.class"
          aggopcls IRAggMax t = aggtcls t ++ "MaxAggregator.class"
          aggopcls IRAggMin t = aggtcls t ++ "MinAggregator.class"
          aggopcls IRAggProd t = aggtcls t ++ "ProductAggregator.class"
          aggopcls IRAggSum t = aggtcls t ++ "SumAggregator.class"
          aggopcls _ _ = "AAAAA.class"
          aggtcls (IRSimpleType (DTInt ())) = "Int"
          aggtcls (IRSimpleType (DTDouble ())) = "Double"
          aggtcls _ = "XXXX"


  sVertCompClassHeader GiraphGenerator pname (_,_,edgt,_,_,_,_) =
    sClassDecl GiraphGenerator "public static"
               (sVertCompClassName GiraphGenerator pname) super []
    where super =
           sIRType
             g
             NoTypeConv
             (IRGenericsType "BasicComputation"
               (map simpleUserType
                    [sVertexIDType g, sVertStructName g,
                     sDType g t, sMsgStructName g]))

          IREdgeStruct _ [("e", IRSimpleType t)] = edgt
          g = GiraphGenerator

  sVertCompHead GiraphGenerator =
    "public void compute(Vertex<" ++ sVertexIDType GiraphGenerator ++ ", " ++
    sVertStructName GiraphGenerator ++
    ", IntWritable> vertex, Iterable<" ++ -- TODO: IntWritable -> EdgeData
    sMsgStructName GiraphGenerator ++ "> messages)"

  fOperatorOverload GiraphGenerator = False

  sDTypeSimple GiraphGenerator (DTInt _) = "int"
  sDTypeSimple GiraphGenerator (DTBool _) = "boolean"
  sDTypeSimple GiraphGenerator (DTString _) = "String"
  sDTypeSimple GiraphGenerator (DTDouble _) = "double"
  sDTypeSimple GiraphGenerator (DTTuple _ _) = "DTTuple"
  sDTypeSimple GiraphGenerator (DTRecord con ts _) = "DTRecord"

  sDType GiraphGenerator (DTInt _) = "IntWritable"
  sDType GiraphGenerator (DTBool _) = "BooleanWritable"
  sDType GiraphGenerator (DTString _) = "Text"
  sDType GiraphGenerator (DTDouble _) = "DoubleWritable"
  sDType GiraphGenerator (DTTuple _ _) = error "tuple is not supported yet"
  sDType GiraphGenerator (DTRecord con ts _) = error "user record is not supported yet"

  fUseWritable GiraphGenerator = True

  sMakeWritable GiraphGenerator s (IRSimpleType t) =
    "new " ++ sDType GiraphGenerator t ++ "(" ++ s ++ ")"
  sMakeWritable GiraphGenerator s (IRGenericsType t ts) = "new_g " ++ t
  sMakeWritable GiraphGenerator s (IRUserType t ts) = "new_u " ++ t
  sMakeWritable GiraphGenerator s IRVoidType = "new_void"

  fEmbedStruct GiraphGenerator = True

  sSSNumber GiraphGenerator = "getSuperstep() + 1"

  sVoteToHalt GiraphGenerator = "vertex.voteToHalt()"

  sFunName GiraphGenerator "min" = "Math.min"
  sFunName GiraphGenerator "max" = "Math.max"
  sFunName GiraphGenerator "not" = "!"
  sFunName GiraphGenerator "neg" = "-"
  sFunName GiraphGenerator "mod" = sOperator ++ "%"
  sFunName GiraphGenerator s = s  

  sGenRand GiraphGenerator = "Math.random()"

  fGeneratePrologue GiraphGenerator = True
 
  ggGeneratePrologue GiraphGenerator pname cxt vclsnm aclsnm opt =
    putDSs 0 is ++ [(0, cls)] ++ opeM
    where is = ["import com.google.common.collect.Lists"] ++
               map ("import java." ++)
                   [ "io.DataInput"
                   , "io.DataOutput"
                   , "io.IOException"
                   , "util.List"
                   ] ++
               map ("import org.apache.giraph." ++)
                   [ "aggregators.*"
                   , "edge.Edge"
                   , "edge.EdgeFactory"
                   , "graph.BasicComputation"
                   , "graph.Vertex"
                   , "io.formats.*"
                   , "master.DefaultMasterCompute"
                   ] ++
               map ("import org.apache.hadoop.io." ++)
                   [ "BooleanWritable"
                   , "DoubleWritable"
                   , "FloatWritable"
                   , "IntWritable"
                   , "LongWritable"
                   , "NullWritable"
                   , "Text"
                   , "Writable"
                   ] ++
               map ("import org.apache.hadoop.mapreduce." ++)
                   [ "InputSplit"
                   , "TaskAttemptContext"
                   ] ++
               map ("import org.json.JSON" ++)
                   [ "Array"
                   , "Exception"
                   ]
          cls = "class " ++ [toUpper (head pname)] ++ tail pname ++ " {"
          opeM = []
          {-
          -- Emoto 2018/01/11: added for operators mod and choice.
          opeM = [ (1, "static class OperatorMapper {")
                 , (2, "static int mod(int x, int y) { return x % y; }")
                 , (2, "static long mod(long x, long y) { return x % y; }")
                 , (1, "}")
                 , (1, "static class Chooser {")
                 , (2, "int n;")
                 , (2, "Chooser() { n = 0; }")
                 , (2, "int choice(int x, int y) {")
                 , (3, "n++; return Math.random() <= 1.0 / n? y: x;")
                 , (2, "}")
                 , (1, "}")
                 ]
           -}
                
  fGenerateEpilogue GiraphGenerator = True

  ggGenerateEpilogue GiraphGenerator pname cxt vclsnm aclsnm opt = [(0, "}")]

  -- Emoto 2018/01/16: added
  fGenerateIO g = True

  -- Emoto 2018/01/16: added
  ggGenerateIO g pname cxt ist = ifs ++ ofs
    where vsn = sVertStructName g
          -- TODO: use of "sEdgeStructName g" is the correct way, but currently type of e (=Int) is used directly (in many places).... X(
          esn = sIRType g WritableTypeConv (getEType cxt) -- sEdgeStructName g 
          typeParams = sVertexIDType g ++ ", " ++ vsn ++ ", " ++ esn
          ofs :: ProgramLines             
          ofs = [(1,"public static class OutputFormat extends TextVertexOutputFormat<" ++ typeParams ++ "> {"),
                 (2,"@Override public TextVertexWriter createVertexWriter(TaskAttemptContext context) {"),
                 (3, "return new VertexWriter();"),
                 (2, "}"),
                 (2, "private class VertexWriter extends TextVertexWriterToEachLine {"),
                 (3, "@Override public Text convertVertexToLine(Vertex<" ++ typeParams ++ "> vertex) throws IOException {"),
                 (4, "return new Text(\"\" + vertex.getId().get()")]
                ++ ( map (\x -> (5,x)) $ map getFldStr $ flds )
                ++ [(5,");"),
                    (3, "}"),
                    (2, "}"),
                    (1, "}")]
          getFldStr ((nm, ty), pid) = "+ \" \" + vertex.getValue()." ++ nm ++ ".get()"
          -- TODO: want to output only the original final result (before the normalization)
          flds = filter ((>=0).snd) (genVertexUserDataFields g cxt)
          vt = sIRType g WritableTypeConv (getValType cxt)
          edgeTypeParams = sVertexIDType g ++ ", " ++ esn
          ifs:: ProgramLines
          ifs = [(1, "public static class InputFormat extends TextVertexInputFormat<" ++ typeParams ++ "> {"),
                 (2,"@Override public TextVertexReader createVertexReader(InputSplit split, TaskAttemptContext context) {"),
                 (3, "return new VertexReader();"),
                 (2,"}"),
                 (2, "class VertexReader extends TextVertexReaderFromEachLineProcessedHandlingExceptions<JSONArray, JSONException> {"),
                 (3, "@Override protected JSONArray preprocessLine(Text line) throws JSONException {"),
                 (4, "return new JSONArray(line.toString());"),
                 (3, "}"),
                 (3, "@Override protected " ++ sVertexIDType g ++ " getId(JSONArray jsonVertex) throws JSONException, IOException {"),
                 (4, "return new " ++ sVertexIDType g ++ "(jsonVertex." ++ jsonGet (sVertexIDType g) ++ "(0));"),
                 (3, "}"),
                 (3, "@Override protected " ++ vsn ++ " getValue(JSONArray jsonVertex) throws JSONException, IOException {"),
                 (4, vsn ++ " ret = new " ++ vsn ++ "();"),
                 (4, "ret.val = new " ++ vt ++ "(jsonVertex." ++ jsonGet vt ++ "(1));\n"),
                 (4, "return ret;"),
                 (3, "}"),
                 (3, "@Override protected Iterable<Edge<" ++ edgeTypeParams ++ ">> getEdges(JSONArray jsonVertex) throws JSONException, IOException {"),
                 (4, "JSONArray jsonEdgeArray = jsonVertex.getJSONArray(2);"),
                 (4, "List<Edge<" ++ edgeTypeParams ++ ">> edges = Lists.newArrayListWithCapacity(jsonEdgeArray.length());"),
                 (4, "for (int i = 0; i < jsonEdgeArray.length(); ++i) {"), 
                 (5, "JSONArray jsonEdge = jsonEdgeArray.getJSONArray(i);"),
                 (5, "edges.add(EdgeFactory.create(new " ++ sVertexIDType g++ " (jsonEdge." ++ jsonGet (sVertexIDType g)  ++ "(0)), new " ++ esn ++ "(jsonEdge." ++ jsonGet esn ++ "(1))));"),
                 (4, "}"),
                 (4, "return edges;"),
                 (3, "}"),
                 (3, "@Override protected Vertex<" ++ typeParams ++ ">" ++ "handleException(Text line, JSONArray jsonVertex, JSONException e) {"),
                 (4, "throw new IllegalArgumentException(\"Couldn't get vertex from line \" + line, e);"),
                 (3, "}"),
                 (2, "}"),
                 (1, "}")]
          -- FIXME: 20161129 Matsuzaki, 20180116 Emoto
          -- val might be a user-defined record...
          -- I don't know how to define a record reader?
          jsonGet nm = case nm of 
                         "IntWritable" -> "getInt"
                         "LongWritable" -> "getLong"
                         "BooleanWritable" -> "getBoolean"
                         "DoubleWritable" -> "getDouble"
                         "Text" -> "get"                   -- not checked yet
                         _ -> error "the type " ++ nm ++ " is not supported yet in reading json"
  -- Emoto 2018/01/16: simplified (becuase of the use of inner classes)
  sMasterClassName g pname = "MasterComputation"
  sVertCompClassName g pname = "VertexComputation" 

-- end of instance PregelGenerator GiraphGenerator

{- String constants for variable / member names -}

-- local variable name of a vertex value in vertex.compute
sVertex :: String
sVertex = "_v"

-- member names in message structure, if necessary
sFromInMsg, sTagInMsg :: String
sFromInMsg = "from"
sTagInMsg = "tag"

-- member name of an aggregated value in vertex structure, if necessary
sAggInVertex :: String
sAggInVertex = "aggv"

sAggInVertexMember :: (PregelGenerator g) => g -> String -> String -> String
sAggInVertexMember g pre n =
  if fEmbedStruct g then pre `sClassMember` (sAggInVertex ++ "_" ++ n)
  else (pre `sClassMember` sAggInVertex) `sClassMember` n

-- member name of edges (vector of edges) in vertex structure, if necesary
sEdgesInVertex :: String
sEdgesInVertex = "edges"

sREdgesInVertex :: String
sREdgesInVertex = "redges"

sNeedAgg :: String
sNeedAgg = "needAgg"

sMsg :: String
sMsg = "msg"

sAgg :: String
sAgg = "aggvar"

sOperator :: String
sOperator = "operator"

sDoAgain :: String
sDoAgain = "doagain"

{- Utility functions -}

-- mapInsert f s [a0,a1,a2] True   ==> [f a0, s, f a1, s, f a2, s]
-- mapInsert f s [a0,a1,a2] Falsee ==> [f a0, s, f a1, s, f a2]
mapInsert :: (a -> String) -> String -> Bool -> [a] -> [String]
mapInsert f delim lastins xs =
  let fn x = f x ++ delim in
    if null xs then []
    else if lastins then map fn xs
    else map fn ys ++ [f y]
         where ys = init xs
               y = last xs

concatMapInsert :: (a -> String) -> String -> Bool -> [a] -> String
concatMapInsert f delim lastins xs = concat (mapInsert f delim lastins xs)

sMayMakePrimitive :: (PregelGenerator g) => g -> String -> String
sMayMakePrimitive g s = if fUseWritable g then sMakePrimitive g s else s

-- put depth d to a string
putDepth :: Depth -> String -> ProgramLine
putDepth d s = (d,s)

putDepths :: Depth -> [String] -> ProgramLines
putDepths d = map (putDepth d)

-- append a semicolon at the end of a string
sPutSemi :: String -> String
sPutSemi = (++ ";")

-- append a semicolon and put a depth
putDS :: Depth -> String -> ProgramLine
putDS d = putDepth d . sPutSemi

putDSs :: Depth -> [String] -> ProgramLines
putDSs d = map (putDS d)

-- shift the depth by delta
shiftDS :: Depth -> ProgramLine -> ProgramLine
shiftDS delta (d,s) = (d + delta, s)

shiftDSs :: Depth -> [ProgramLine] -> [ProgramLine]
shiftDSs delta = map (shiftDS delta)

ggPutCBracket :: Depth -> ProgramLines -> ProgramLines
ggPutCBracket d bs = (d, "{") : (bs ++ [(d, "}")])

ggPutCBracketSemi :: Depth -> ProgramLines -> ProgramLines
ggPutCBracketSemi d bs = (d, "{") : (bs ++ [(d, "};")])

sPutCBracket :: String -> String
sPutCBracket s = "{" ++ s ++ "}"

sPutParen :: String -> String
sPutParen s = "(" ++ s ++ ")"

sConcatName :: String -> IRNameAndType -> IRNameAndType
sConcatName s (n,t) = (s ++ "_" ++ n, t)

simpleUserType :: String -> IRType
simpleUserType n = IRUserType n []

{- Utility functions for constructs of C++ / Java -}

-- do <body> while <cond>
ggDoWhileStmt :: Depth -> ProgramLines -> String -> ProgramLines
ggDoWhileStmt d body cond =
  (d, "do {") : (body ++ [(d, "} while " ++ sPutParen(cond) ++ ";")])

-- if <cond> then <body>
ggIfThenStmt :: Depth -> String -> ProgramLines -> ProgramLines
ggIfThenStmt d cond body = (d, "if " ++ sPutParen(cond)) : body

-- else if <cond> then <body>
ggElseIfThenStmt :: Depth -> String -> ProgramLines -> ProgramLines
ggElseIfThenStmt d cond body = (d, "else if " ++ sPutParen(cond)) : body

-- if <cond> then <body1> else <body2>
ggIfThenElseStmt ::
  Depth -> String -> ProgramLines -> ProgramLines -> ProgramLines
ggIfThenElseStmt d cond body1 body2 =
  ggIfThenStmt d cond body1 ++ [(d, "else")] ++ body2

-- <cond>? <expr1>: <expr2>
sConditionalExpr :: String -> String -> String -> String
sConditionalExpr cond e1 e2 =
  sPutParen (sPutParen cond ++ "? " ++ sPutParen e1 ++ ": " ++ sPutParen e2)

-- switch <cond>
ggSwitch :: Depth -> String -> ProgramLines -> ProgramLines
ggSwitch d cond bs = (d, "switch " ++ sPutParen(cond)) : bs

-- case <n>:
gCase :: Depth -> Int -> ProgramLine
gCase d n = (d, "case " ++ show n ++ ":")

-- case <sVertCompState state>:
gCaseState :: Depth -> IRVertexComputeState -> ProgramLine
gCaseState d state = (d, "case " ++ sVertCompState state ++ ":")

sStateToCaseval :: (PregelGenerator g) => g -> String -> String -> String
sStateToCaseval g p s =
  "(" ++ sMayMakePrimitive g p ++ ") * 10 + (" ++ sMayMakePrimitive g s ++ ")"
-- sStateToCaseval p s = "stateToCaseval(" ++ p ++ ", " ++ s ++ ")"

-- break
sBreak :: String
sBreak = "break"

-- cast
sCast :: (PregelGenerator g) => g -> IRType -> String -> String
sCast g t e = "(" ++ sIRType g NoTypeConv t ++ ")(" ++ e ++ ")"

-- new
sNew :: String -> [String] -> String
sNew clazz args =
  "new " ++ clazz ++ "(" ++ concatMapInsert id "," False args ++ ")"

-- binary operator expression: <left> binop <right>
sBinopExpr :: String -> String -> String -> String
sBinopExpr op left right = left ++ " " ++ op ++ " " ++ right

-- assignment: <left> = <right>
sAssignExpr :: String -> String -> String
sAssignExpr left right = left ++ " = " ++ right

gAssignStmt :: Depth -> String -> String -> ProgramLine
gAssignStmt d left right = putDS d (sAssignExpr left right)

-- updateWithOr: <left> |= <right>
sUpdateWithOrExpr :: String -> String -> String
sUpdateWithOrExpr left right = left ++ " |= " ++ right

gUpdateWithOrStmt :: Depth -> String -> String -> ProgramLine
gUpdateWithOrStmt d left right = putDS d (sUpdateWithOrExpr left right)

-- return <str>
gReturnStmt :: Depth -> String -> ProgramLine
gReturnStmt d str = putDS d ("return " ++ str)

-- member selection of struct / class
sClassMember :: String -> String -> String
sClassMember s m = s ++ "." ++ m

-- judges whether the program uses an aggregator or not
useAgg :: IRAggStruct -> Bool
useAgg (IRAggStruct _ ms) = ms /= []

-- judges whether to generate an aggregator class or not
needAggClass :: (PregelGenerator g) => g -> IRAggStruct -> Bool
needAggClass g at = fAggClass g && useAgg at

{- Utility functions for debugging -}

-- debug print
dPrint :: Show a => a -> a
dPrint x = unsafePerformIO $ do { putStrLn (show x); return x }

(##) :: Show a => a -> b -> b
x ## y = dPrint x `seq` y

infixr 0 ##

{- 
   ggIRProg   generates a program for the given program
   The argument given to this funciton is the data of type IRProg,
   which consists of the following information.
     pname :: String              name of the program
     dts :: [IRTypeDecl]          datatypes
     vert :: IRVertexStruct       datatype of vertices
     edgt :: IREdgeStruct         datatype of edges
     msgt :: IRMsgStruct          datatype of messsages
     aggt :: IRAggStruct          datatype of aggregator
     rs :: Bool                   whether to use reversed edges
     ts :: [String]               message names to put message tag
     (_,vth,msgcomb) :; Bool      optimization information
     cs :: [IRConstant]           constants
     pcomp :: IRPhaseCompute      phase computation
     ist :: IRVertexComputeState  init state
     ms :: [IRMethod]             other methods
-}

ggIRProg :: (PregelGenerator g) => g -> Depth -> Option -> IRProg -> ProgramLines
ggIRProg g d ops (IRProg pname dts vert edgt msgt aggt rs ts oinfo cs pcomp ist ms) =
  let (_, vth, msgcomb) = oinfo
      dtdef  = if fEmbedStruct g
               then [] else concatMap (ggIRTypeDecl g d) dts
      cxt   = (dts, vert, edgt, msgt, aggt, rs, zip ts [101..])
      vtdef  = ggIRVertexStruct g d cxt
      etdef  = if fEdgeClass g == True then ggIREdgeStruct g d cxt else []
      mtdef  = ggIRMsgStruct g d cxt
      atdef  = if useAgg aggt then ggIRAggStruct g d cxt else []
      cdef   = map (gIRConstant g d cxt) cs
      mclass = if fMasterClass g == MCNone then []
               else ggClass g d (sMasterClassHeader g pname) mcomp
               where mcomp = ggMasterMethods g (d + 1) cxt ++
                             ggIRMasterCompute g (d + 1) cxt pcomp
      vclass = ggClass g d (sVertCompClassHeader g pname cxt) vv
               where vcomp = ggIRVertexCompute g (d + 1) cxt vth pcomp ist
                     toln = if fToLine g then ggToLine g (d + 1) cxt else []
                     vv = if fMasterClass g == MCInner 
                          then (shiftDSs 1 mclass ++ vcomp ++ toln)
                          else (vcomp ++ toln)
      vclsnm = sVertCompClassName g pname
      aclass = if needAggClass g aggt
               then ggAggClass g d aclsnm vclsnm cxt else []
      aclsnm = if needAggClass g aggt then "Aggr_" ++ pname else ""
      -- Kato and Iwasaki: message combiner
      mcclass = if fMsgCombiner g && useMsgCombOpt ops
                then ggMsgCombiner g d pname msgt pcomp
                else []
      pro    = if fGeneratePrologue g
               then ggGeneratePrologue g pname cxt vclsnm aclsnm ops else []
      epi    = if fGenerateEpilogue g
               then ggGenerateEpilogue g pname cxt vclsnm aclsnm ops else []
      -- Emoto 2018/01/16: added for generating Input/Output formats (for Giraph)
      iodef  = if fGenerateIO g
               then ggGenerateIO g pname cxt ist else []
  in concat [ pro
            , etdef
            , atdef
            , mtdef
            , dtdef
            , vtdef
            , cdef
            , if fMasterClass g == MCOuter then mclass else []
            , vclass
            , aclass
            , mcclass  -- Kato and Iwasaki
            , iodef   -- Emoto 2018/01/16: added
            , epi
            ]

{- generation of structured data -}

-- structured data for computation
ggIRTypeDecl :: (PregelGenerator g) => g -> Depth -> IRTypeDecl -> ProgramLines
ggIRTypeDecl g d (IRTypeDecl strname ms) =
  ggStruct g d strname ms ++
  if fOperatorOverload g then ggOperators g d [LtLt, GtGt, EqEq] strname ms
  else []

-- Emoto 2018/01/16: split from gIRVertexStruct to be used in ggGenerateIO, and modified to deal with the original phase ids
-- this generates vertex data's fields about the user data in Fregel program
genVertexUserDataFields :: (PregelGenerator g) =>
  g -> IRcxt -> [IRNameAndTypeWithId]
genVertexUserDataFields g (dts,vt,et,mt,at,rs,ts) =
    concat [nomems, dupCurPrev mems]
  where IRVertexStruct name phase subphase pcms nopcms = vt
        mems = if fEmbedStruct g
               then concatMap inlineStruct' pcms else pcms
        nomems = if fEmbedStruct g
                 then concatMap inlineStruct' nopcms else nopcms
        inlineStruct' x = map (\y->(y, snd x)) $ inlineStruct True dts (fst x)
-- struct for vertex data
-- ggIRVertexStruct defines a struct / class for vertex data structure
ggIRVertexStruct :: (PregelGenerator g) =>
  g -> Depth -> IRcxt -> ProgramLines
ggIRVertexStruct g d (cxt@(dts,vt,et,mt,at,rs,ts)) =
  ggStruct g d strname ms ++
  if fOperatorOverload g then ggOperators g d [LtLt, GtGt] strname ms else []
  where IRVertexStruct name phase subphase pcms nopcms = vt
        IRAggStruct _ ps = at
        irvec = IRGenericsType "vector" [irInt]
        iragg = IRUserType (sAggStructName g) []
        iredg = IRGenericsType "vector" [IRUserType (sEdgeStructName g) []]
        strname = sVertStructName g
        -- Emoto 2018/01/16: split a part of code generation as genVertexUserDataFields
        ms = concat [ [(phase, irInt), (subphase, irInt)]
                    -- , nopcms
                    , map fst (genVertexUserDataFields g cxt)
                    , if fVertexHasAggr g && useAgg at then
                        ((sNeedAgg, irInt) :
                         (if fEmbedStruct g
                          then map (sConcatName sAggInVertex) (map fst ps)
                          else [(sAggInVertex, iragg)]))
                      else []
                    , if fVertexHasEdges g
                      then ((sEdgesInVertex, iredg) :
                            (if rs then [(sREdgesInVertex, iredg)] else []))
                      else []
                    ]

-- inlineStruct True tds ("soko", IRUserType "Bar" [])
--   where tds = [ IRTypeDecl "Foo" [("a", irInt), ("b", irBool)]
--               , IRTypeDecl "Bar" [("p", irInt), ("q", irBool)]
--               ]
--  ==> [("soko_p", irInt), ("soko_q", irBool)]
-- inlineStruct False tds ("soko", IRUserType "Bar" [])
--   where tds = [ IRTypeDecl "Foo" [("a", irInt), ("b", irBool)]
--               , IRTypeDecl "Bar" [("p", irInt), ("q", irBool)]
--               ]
--  ==> [("p", irInt), ("q", irBool)]
--

-- inlineStruct :: Bool -> [IRTypeDecl] -> IRNameAndType -> [IRNameAndType]
-- inlineStruct cflag dts nt@(n, IRUserType "Pair" [tfst, tsnd]) =
--   if cflag then map (sConcatName n) xs else xs
--   where xs = [("_fst", tfst), ("_snd", tsnd)]

-- inlineStruct cflag dts nt@(n, IRUserType "Pair" [_, IRUserType t _]) =
--   if cflag then map (sConcatName n) xs else xs
--   where Just (IRTypeDecl _ xs) = find pred dts
--         pred (IRTypeDecl tname _) = t == tname

-- inlineStruct cflag dts nt@(n, IRUserType t _) =
--   if cflag then map (sConcatName n) xs else xs
--   where Just (IRTypeDecl _ xs) = find pred dts
--         pred (IRTypeDecl tname _) = t == tname

inlineStruct :: Bool -> [IRTypeDecl] -> IRNameAndType -> [IRNameAndType]
inlineStruct cflag dts nt = inlineStruct' nt
 where inlineStruct' :: IRNameAndType -> [IRNameAndType]
       inlineStruct' nt@(n, IRSimpleType _) = [nt]
       inlineStruct' (n, IRUserType "Pair" [tfst, tsnd]) =
         concatMap inlineStruct' (if cflag then map (sConcatName n) xs else xs)
         where xs = [("_fst", tfst), ("_snd", tsnd)]
       inlineStruct' (n, IRUserType t _) =
         concatMap inlineStruct' (if cflag then map (sConcatName n) xs else xs)
         where Just (IRTypeDecl _ xs) = find pred dts
               pred (IRTypeDecl tname _) = t == tname

-- Emoto 2018/01/16: modified to deal with the original phase ids
dupCurPrev :: [IRNameAndTypeWithId] -> [IRNameAndTypeWithId]
dupCurPrev ms = concatMap f ms
                where f ((n, t),i) = [((sPrevName n, t),i), ((sCurrName n, t),-1)]
                                     -- curr values are tentative -> no corresponding phase
getValType :: IRcxt -> IRType
getValType (_, IRVertexStruct _ _ _ _ nopcms, _, _, _, _, _) = t
    -- Emoto 2018/01/16: modified to deal with the original phase ids
  where Just t = lookup "val" (map fst nopcms)

-- struct for edge data

ggIREdgeStruct :: (PregelGenerator g) => g -> Depth -> IRcxt -> ProgramLines
ggIREdgeStruct g d (_, _, IREdgeStruct name members, _, _, _, _) =
  ggStruct g d strname ms ++
  if fOperatorOverload g then ggOperators g d [LtLt, GtGt] strname ms else []
  where strname = sEdgeStructName g
        ms = ("nb", irInt) : members

getEType :: IRcxt -> IRType
getEType (_, _, IREdgeStruct _ ms, _, _, _, _) = t
  where Just t = lookup "e" ms

-- struct for message data
-- ggIRMsgStruct adds ``from'' fields to the message structure.

ggIRMsgStruct :: (PregelGenerator g) => g -> Depth -> IRcxt -> ProgramLines
ggIRMsgStruct g d (_, _, _, IRMsgStruct name members, _, _, ts) =
  ggStruct g d strname ms ++
  if fOperatorOverload g then ggOperators g d [LtLt, GtGt] strname ms else []
  where ms = (if fMsgNeedFrom g then [(sFromInMsg, tMsgFromType g)] else []) ++
             (if needMsgTag g ts then [(sTagInMsg, tMsgTagType g)] else []) ++
             members
        strname = sMsgStructName g
        needMsgTag g ts = fMsgNeedTag g || not (null ts)

-- struct for aggregation data
ggIRAggStruct :: (PregelGenerator g) => g -> Depth -> IRcxt -> ProgramLines
ggIRAggStruct g d (_, _, _, _, IRAggStruct name ps, _, _) =
  ggStruct g d strname ms ++
  if fOperatorOverload g then ggOperators g d [LtLt, GtGt, EqEq] strname ms
  else []
  where ms = map fst ps
        strname = sAggStructName g

{- generation of struct (or class) -}

ggStruct :: (PregelGenerator g) =>
  g -> Depth -> String -> [IRNameAndType] -> ProgramLines
ggStruct g d name members =
  (d, sStructDecl g name) :
  ggPutCBracketSemi d (ggVardecls g d1 MemberVarDecl members ++ ds)
  where ds = if fStructHasMethods g then ggStructMethods g d1 name members
             else []
        d1 = d + 1

ggClass :: (PregelGenerator g) =>
  g -> Depth -> String -> ProgramLines -> ProgramLines
ggClass g d decl cs = (d, decl) : ggPutCBracketSemi d cs
--   g -> Depth -> String -> String -> String -> ProgramLines -> ProgramLines
-- ggClass g d m name super cs =
--   (d, sClassDecl g m name super []) : ggPutCBracketSemi d cs

-- declaration of (member) variables
ggVardecls :: (PregelGenerator g) =>
  g -> Depth -> VarDecl -> [IRNameAndType] -> ProgramLines
ggVardecls g d vd vss = putDepths d (mapInsert (f vd) ";" True vss)
  where f MemberVarDecl = sIRNameAndType2 g
        f BlockVarDecl = sIRNameAndType g

sIRNameAndType :: (PregelGenerator g) => g -> IRNameAndType -> String
sIRNameAndType g (name, t) = sIRType g NoTypeConv t ++ " " ++ name

sIRNameAndType2 :: (PregelGenerator g) => g -> IRNameAndType -> String
sIRNameAndType2 g (name, t) = sIRType g WritableTypeConv t ++ " " ++ name

gIRConstant :: (PregelGenerator g) =>
  g -> Depth -> IRcxt -> IRConstant -> ProgramLine
gIRConstant g d cxt (IRConstant nt expr) =
  gAssignStmt d (sIRNameAndType g nt) (sIRExpr g cxt expr)

{- master.compute -}

ggIRMasterCompute :: (PregelGenerator g) =>
  g -> Depth -> IRcxt -> IRPhaseCompute -> ProgramLines
ggIRMasterCompute g d cxt (IRPhaseCompute bs) =
  (d, sMasterCompHead g) : ggIRBlock g d cxt (IRBlock [] [])

{- vertex.compute -}

ggIRVertexCompute :: (PregelGenerator g) =>
  g -> Depth -> IRcxt -> Bool -> IRPhaseCompute -> IRVertexComputeState ->
  ProgramLines
ggIRVertexCompute g d cxt vth (IRPhaseCompute bs) ist =
  (d, sVertCompHead g) : ggVertCompBody g d cxt vth bs ist

ggVertCompBody :: (PregelGenerator g) =>
  g -> Depth -> IRcxt -> Bool -> [IRPhaseComputeProcess] ->
  IRVertexComputeState -> ProgramLines
ggVertCompBody g d cxt@(dts,vt,et,mt,at,_,ts) vth ps ist =
  ggPutCBracket d bs
  where IRVertexStruct _ ph st _ _ = vt
        pv = sVertex `sClassMember` ph
        sv = sVertex `sClassMember` st
        d' = d + 1
        sname = sVertStructName g
        assign = [gAssignStmt d'
                    (sIRNameAndType g (sVertex, IRUserType t []))
                    (sVertexGetValue g)]
                 ++ if fVertexHasAggr g && useAgg at then
                        [gAssignStmt d' (sVertex `sClassMember` sNeedAgg) "0"]
                      else []
                 where t = if fVertexTypeRef g then (sname ++ "&") else sname
        dowhile = vth && or (map getusefix ps)
                  where getusefix (IRPhaseComputeProcess _ x _ _ _) = x
        doagain = if dowhile then [gAssignStmt d'
                                    (sIRNameAndType g (sDoAgain, irBool))
                                    (sIRConst (IRCBool False))]
                  else []
        dsw = if dowhile then d + 2 else d'
        body = if dowhile then
                 ggDoWhileStmt
                   d'
                   (gAssignStmt dsw sDoAgain (sIRConst (IRCBool False)) : sw)
                   sDoAgain
                else sw
        sw = ggSwitch dsw
               (sStateToCaseval g pv sv)
               (ggPutCBracket
                  dsw (concatMap (ggVertCompProc g dsw ph st cxt) ps))
        vv = sVertexSetValue g
        cu = or (map choiceUsed ps)
        bs = concat [ assign
                    , doagain
                    , ggVertCompSS1 g d' cxt ph st cu ist
                    , body
                    , if vv == "" then [] else [putDS d' vv]
                    ]

ggVertCompProc :: (PregelGenerator g) =>
   g -> Depth -> String -> String -> IRcxt -> IRPhaseComputeProcess ->
   ProgramLines
ggVertCompProc g d pv sv cxt (IRPhaseComputeProcess state _ lvars body conds) =
  [gCaseState d state] ++
  ggPutCBracket d1 (ggVardecls g d2 BlockVarDecl lvars ++
                    ggIRBlock g d2 cxt body ++
                    ggVertCompStateTrans g d2 cxt pv sv conds) ++
  [putDS d1 sBreak]
  where d1 = d + 1
        d2 = d + 2

ggVertCompSS1 :: (PregelGenerator g) =>
  g -> Depth -> IRcxt -> String -> String -> Bool -> IRVertexComputeState ->
  ProgramLines

ggVertCompSS1 g d cxt@(_,_,_,_,at,_,_) p s cu (ip,is) =
-- ggVertCompSS1 g d cxt p s (ip,is) =
  ggIfThenStmt d (sBinopExpr "==" (sSSNumber g) "1") (ggPutCBracket d as)
  where d1 = d + 1
        as = concat [ ggSetPhaseStep g d1 cxt (p,ip) (s,is)
                    , if fVertexHasAggr g && useAgg at then
                        [gAssignStmt d1 (sVertex `sClassMember` sNeedAgg) "0"]
                      else []
                    , let srand = sInitRand g in
                      if cu && srand /= "" then [(d1, srand)] else []
                    ]

ggVertCompStateTrans :: (PregelGenerator g) =>
  g -> Depth -> IRcxt -> String -> String ->
  [(IRExpr, IRVertexComputeState, IRBlock)] -> ProgramLines
ggVertCompStateTrans g d _ _ _ [] = []
ggVertCompStateTrans g d cxt pv sv [(expr, (p,s), b)] =
  ggIfThenStmt d (sIRExpr g cxt expr) (if p == -1 then vth else novth)
  where d1 = d + 1
        novth = ggPutCBracket d (ggSetPhaseStep g d1 cxt (pv,p) (sv,s) ++
                                 ggIRBlock g d1 cxt b ++ [putDS d1 sBreak])
        vth = ggPutCBracket d (putDSs d1 [sVoteToHalt g] ++
                               ggIRBlock g d1 cxt b ++ [putDS d1 sBreak])
--      vth = ggPutCBracket d (putDSs d1 [sVoteToHalt g, sBreak])

ggVertCompStateTrans g d cxt pv sv (st:sts) =
  ggVertCompStateTrans g d cxt pv sv [st] ++
  ggVertCompStateTrans g d cxt pv sv sts

sVertCompState :: IRVertexComputeState -> String
sVertCompState (p,s) = show (10 * p + s)

ggSetPhaseStep :: (PregelGenerator g) =>
  g -> Depth -> IRcxt -> (String, Int) -> (String, Int) -> ProgramLines
ggSetPhaseStep g d cxt (pname, pval) (sname, sval) =
  vf pname pval ++ vf sname sval
  where vf name val = ggIRStatementLocal g d cxt
                        (IRVarVertex (name, irInt) IRNone [])
                        (IRCExp irInt (IRCInt val))

{- generation of method definition -}

ggIRMethod :: (PregelGenerator g) =>
  g -> Depth -> IRcxt -> IRMethod -> ProgramLines
ggIRMethod g d cxt (IRMethod t name formals body) =
  (d, sMethodDefHead g t name formals) : ggIRBlock g d cxt body

sMethodDefHead :: (PregelGenerator g) =>
  g -> IRType -> String -> [IRNameAndType] -> String
sMethodDefHead g t name formals
  = sIRType g NoTypeConv t ++ " " ++
    name ++ sFormalsList g formals

sFormalsList :: (PregelGenerator g) => g -> [IRNameAndType] -> String
sFormalsList g = sPutParen . sFormals g

sFormals :: (PregelGenerator g) => g -> [IRNameAndType] -> String
sFormals g = concatMapInsert (sIRNameAndType g) ", " False

sActuals :: (PregelGenerator g) => g -> IRcxt -> [IRExpr] -> String
sActuals g cxt = concatMapInsert (sIRExpr g cxt) ", " False

{- generation of block and statement -}

ggIRBlock :: (PregelGenerator g) =>
  g -> Depth -> IRcxt -> IRBlock -> ProgramLines
ggIRBlock g d cxt (IRBlock locals body) =
  ggPutCBracket d (ggVardecls g (d + 1) BlockVarDecl locals ++
                   ggBlock g (d + 1) cxt body)

ggBlock :: (PregelGenerator g) =>
  g -> Depth -> IRcxt -> [IRStatement] -> ProgramLines
ggBlock g d cxt = concatMap (ggStatement g d cxt)

ggStatement :: (PregelGenerator g) =>
  g -> Depth -> IRcxt -> IRStatement -> ProgramLines
ggStatement g d cxt (IRStatementLocal v e) = ggIRStatementLocal g d cxt v e
ggStatement g d cxt (IRStatementAggr v e es) =
  ggIRStatementAggr g d cxt v e es
ggStatement g d cxt (IRStatementMsg v op e) = ggIRStatementMsg g d cxt v op e
ggStatement g d cxt (IRStatementReturn e) = [gReturnStmt d (sIRExpr g cxt e)]
ggStatement g d cxt IRStatementVTH = putDSs d [sVoteToHalt g, sBreak]
ggStatement g d cxt (IRStatementSendN nt e es) =
  ggIRStatementSend g d cxt True nt e es
ggStatement g d cxt (IRStatementSendR nt e es) =
  ggIRStatementSend g d cxt False nt e es
ggStatement g d cxt (IRStatementIfThen e blk) =
  ggIfThenStmt d (sIRExpr g cxt e) (ggIRBlock g d cxt blk)

ggIRStatementLocal :: (PregelGenerator g) =>
  g -> Depth -> IRcxt -> IRVar -> IRExpr -> ProgramLines

ggIRStatementLocal g d cxt v@(IRVarLocal (n,t)) e =
  [gAssignStmt d (sIRVar g v) (sIRExpr g cxt e)]

-- we treat the case where `curr' value is assigned to `prev' value specially

ggIRStatementLocal g d cxt@(dts,vert,_,_,_,_,_)
  v@(IRVarVertex (_, IRSimpleType _) _ [])
  e@(IRVExp (IRVarVertex (_, IRSimpleType _) _ [])) =
  [gAssignStmt d (sIRVar g v) r]
  where s = sIRExpr g cxt e
        r = if fUseWritable g then sMakeWritable g s t else s
        t = varType v

--- ggIRStatementLocal g d cxt@(dts,vert,_,_,_,_)
---   v@(IRVarVertex nt1 pc1 [])
---   e@(IRVExp (IRVarVertex nt2 pc2 [])) | fEmbedStruct g =
---   concat (zipWith f ds ss)
---   where ds = inlineStruct True dts nt1
---         ss = inlineStruct True dts nt2
---         f (n1,t1) (n2,t2) = ggIRStatementLocal g d cxt
---                               (IRVarVertex (n1,t1) pc1 [])
---                               (IRVExp (IRVarVertex (n2,t2) pc2 []))

-- ggIRStatementLocal g d cxt@(dts,vert,_,_,_,_)
--   v@(IRVarVertex (n1,t1) IRPrev [])
--   e@(IRVExp (IRVarVertex (n2,t2) IRCurr [])) | fEmbedStruct g =
--  concatMap f (inlineStruct False dts (n1,t1))
--  where f :: IRNameAndType -> ProgramLines
--        f nt = ggIRStatementLocal g d cxt
--                 (IRVarVertex (n1,t1) IRPrev [nt])
--                 (IRVExp (IRVarVertex (n2,t2) IRCurr [nt]))

--- ggIRStatementLocal g d cxt@(dts,vert,_,_,_,_)
---   v@(IRVarVertex (n,_) pc1 [mt])
---   e@(IRVExp (IRVarVertex nt2 pc2 [])) | fEmbedStruct g =
---   concat (zipWith f ds ss)
---   where ds = inlineStruct True dts (sConcatName n mt)
---         ss = inlineStruct True dts nt2
---         f (n1,t1) (n2,t2) = ggIRStatementLocal g d cxt
---                               (IRVarVertex (n1,t1) pc1 [])
---                               (IRVExp (IRVarVertex (n2,t2) pc2 []))

-- We assume that the length of ds and that of ss are the same.
ggIRStatementLocal g d cxt@(dts,vert,_,_,_,_,_)
  v@(IRVarVertex nt1 pc1 nts1)
  e@(IRVExp (IRVarVertex nt2 pc2 nts2)) | fEmbedStruct g =
  concat (zipWith f ds ss)
  where scn (n,_) nt = sConcatName n nt
        ds = inlineStruct True dts (foldl scn nt1 nts1)
        ss = inlineStruct True dts (foldl scn nt2 nts2)
        f (n1,t1) (n2,t2) = ggIRStatementLocal g d cxt
                              (IRVarVertex (n1,t1) pc1 [])
                              (IRVExp (IRVarVertex (n2,t2) pc2 []))

-- ggIRStatementLocal g d cxt v@(IRVarAggr (n1,t1)) e@(IRAggr (n2,t2)) =
--   [gAssignStmt d (sIRVar g v) (sIRExpr g cxt e)]

ggIRStatementLocal g d cxt v@(IRVarAggr (n,t)) e =
  [gAssignStmt d (sIRVar g v) (sIRExpr g cxt e)]
 
ggIRStatementLocal g d cxt v e = [gAssignStmt d (sIRVar g v) r]
  where s = sIRExpr g cxt e
        r = if fUseWritable g then sMakeWritable g s t else s
        t = varType v

ggIRStatementAggr :: (PregelGenerator g) =>
  g -> Depth -> IRcxt -> IRNameAndType -> IRExpr -> [IRExpr] -> ProgramLines
ggIRStatementAggr g d cxt@(_, _, _, _, IRAggStruct _ ps, _, _) nt@(n,t) e es =
  {-
  putDSs d (concat [ [sIRNameAndType g nt]
                   , if fVertexHasAggr g
                     then [sAssignExpr (sVertex `sClassMember` sNeedAgg)
                                       (getNeedAgg n ps)]
                     else []
                   , [sAssignExpr name (sIRExpr g cxt e), sAggregate g nt]
                   ])
  -}
  putDS d (sIRNameAndType g nt) : ag d es
  where name = n
        ag d [] = ggPutCBracket d
                    (putDSs (d + 1)
                            (concat [ if fVertexHasAggr g
                                      then [sUpdateWithOrExpr
                                             (sVertex `sClassMember` sNeedAgg)
                                             (show $ pow2 ((read $ getNeedAgg n ps) - 1))]
                                      --then [sAssignExpr
                                      --       (sVertex `sClassMember` sNeedAgg)
                                      --       (getNeedAgg n ps)]
                                      else []
                                    , [sAssignExpr name (sIRExpr g cxt e),
                                       sAggregate g nt]
                                    ]))
        ag d (e:es) = ggIfThenStmt d (sIRExpr g cxt e) (ag d es)
        as = [sAssignExpr name (sIRExpr g cxt e), sAggregate g nt]

ggIRStatementMsg :: (PregelGenerator g) =>
  g -> Depth -> IRcxt -> IRVar -> IRAggOp -> IRExpr -> ProgramLines

ggIRStatementMsg g d cxt@(_,_,_,_,_,_,ts) v op e =
  ggPutCBracket d (dec ++ [(d1, sMsgRecvIter g)] ++ aux e)
  where d1 = d + 1
        d2 = d + 2
        dec | fStatementMsgDecl g op = ggStatementMsgDecl g d1 v op
            | otherwise = ggStatementMsgStandardDecl g d1 v op
        lop | fStatementMsgLoop g op = ggStatementMsgLoop g d2 cxt v op e
            | otherwise = ggStatementMsgStandardLoop g d2 cxt v op e
        body = ggPutCBracket d1 lop
        aux (IRMVal (name, _)) =
          let n = lookupTagNo name ts in
          if n > 0 then
            ggPutCBracket d1
              (ggIfThenStmt d2
                 (sIRExpr g cxt
                   (IRFunAp (IRBinOp "==")
                     [IRMVal (sTagInMsg, irInt), IRCExp irInt (IRCInt n)]))
                 (ggPutCBracket d2 (shiftDSs 1 lop)))
          else body
        aux _ = body

-- standard functions for generating aggregation loop

-- ggStatementMsgStandardDecl generates a program line that assigns the
-- unit value of a specified operator `op' to `v'.
ggStatementMsgStandardDecl :: (PregelGenerator g) =>
  g -> Depth -> IRVar -> IRAggOp -> ProgramLines
ggStatementMsgStandardDecl g d v op@(IRAggChoice _) =
  [(d, "int n = 0;"), gAssignStmt d (sIRVar g v) (aggOpUnit op)]
ggStatementMsgStandardDecl g d v op =
  [gAssignStmt d (sIRVar g v) (aggOpUnit op)]

-- ggStatementMsgStandardLoop generaets a program line that performs
--   v = v `op` e, or v = choice(v, e).
ggStatementMsgStandardLoop :: (PregelGenerator g) =>
  g -> Depth -> IRcxt -> IRVar -> IRAggOp -> IRExpr -> ProgramLines
ggStatementMsgStandardLoop g d cxt v op@(IRAggChoice _) e =
    [gAssignStmt d
                 sv
                 (sConditionalExpr (sGenRand g ++ " <= 1.0 / ++n") se sv)]
    where sv = sIRVar g v
          se = sIRExpr g cxt e
ggStatementMsgStandardLoop g d cxt v op e =
  [gAssignStmt d
               (sIRVar g v)
               (sIRExpr g cxt (IRFunAp (aggOp2Fun g op) [IRVExp v, e]))]

{-
ggIRStatementMsg g d cxt v op e =
  [gAssignStmt d (sIRVar g v) (aggOpUnit op),
   (d, sMsgRecvIter g),
   gAssignStmt (d + 1)
               (sIRVar g v)
               (sIRExpr g cxt (IRFunAp (aggOp2Fun g op) [IRVExp v, e]))]
-}

mkBlock :: ProgramLines -> ProgramLines
mkBlock [] = []
mkBlock (dxs@((d,x):_)) = (d, "{"): map (\(d,x)->(d+1,x)) dxs ++ [(d, "}")]

ggIRStatementSend :: (PregelGenerator g) =>
  g -> Depth -> IRcxt -> Bool -> IRNameAndType -> IRExpr -> [IRExpr] ->
  ProgramLines
ggIRStatementSend g d cxt@(_,_,_, IRMsgStruct ms _,_,rs,ts) dir (name,t) e es =
  mkBlock $ 
  (d, sMsgSendVardecl g mem) : (d, sMsgSendIter g) :
  if (rs == False) || (fVertexHasEdges g == True)
  then sd (d + 1) es else ggIfThenStmt (d + 1) cnd (sd (d + 2) es)
  where mem = if dir then sEdgesInVertex else sREdgesInVertex
        cnd = if dir then sIsForwardEdge g else sIsReverseEdge g
        sd d [] = ggPutCBracket d
                    (putDSs
                      (d + 1)
                      (concat [ [sIRNameAndType g
                                   (sMsg, IRUserType (sMsgStructName g) [])]
                              , if targetLanguage g == Java
                                then [sAssignExpr
                                        sMsg (sNew (sMsgStructName g) [])]
                                else []
                              , let n = lookupTagNo name ts in
                                if (n > 0)
                                then [sAssignExpr
                                        (sMsg `sClassMember` sTagInMsg)
                                        (sMakeWritable g (show n) irInt)]
                                else []
                              , [sAssignExpr
                                  (sMsg `sClassMember` name)
                                  (sMakeWritable g (sIRExpr g cxt e) t),
                                 sSendMsg g dir]
                              ]))
        sd d (e:es) = ggIfThenStmt d (sIRExpr g cxt e) (sd d es)

lookupTagNo :: String -> [(String, Int)] -> Int
lookupTagNo name [] = 0
lookupTagNo name ((s,n):xs) | name == s = n
                            | otherwise = lookupTagNo name xs

aggOpUnit :: IRAggOp -> String
aggOpUnit IRAggMin = "99999999 /* UNIT_MIN */"
aggOpUnit IRAggMax = "-99999999 /* UNIT_MAX */"
aggOpUnit IRAggSum = "0 /* UNIT_SUM */"
aggOpUnit IRAggProd = "1 /* UNIT_PROD */"
aggOpUnit IRAggAnd = "true /* UNIT_AND */"
aggOpUnit IRAggOr = "false /* UNIT_OR */"
aggOpUnit (IRAggChoice c) = sIRConst c
aggOpUnit (IRTupledAgg _) = "UNIT_TUPLED"

aggOp2Fun :: (PregelGenerator g) => g -> IRAggOp -> IRFun
aggOp2Fun g IRAggMin = IRFun (sFunName g "min")
aggOp2Fun g IRAggMax = IRFun (sFunName g "max")
aggOp2Fun g IRAggSum = IRBinOp "+"
aggOp2Fun g IRAggProd = IRBinOp "*"
aggOp2Fun g IRAggAnd = IRBinOp "&&"
aggOp2Fun g IRAggOr = IRBinOp "||"
aggOp2Fun g (IRAggChoice _) = IRFun (sFunName g "choice")
aggOp2Fun g (IRTupledAgg _) = IRFun "tupled"

{- generation of expression -}

sIRExpr ::  (PregelGenerator g) => g -> IRcxt -> IRExpr -> String
sIRExpr g cxt (IRIf e1 e2 e3) =
  sPutParen (sIRExpr g cxt e1 ++ "? " ++ sIRExpr g cxt e2 ++ ": " ++
             sIRExpr g cxt e3)

sIRExpr g cxt (IRFunAp (IRFun "neg") [arg]) =
  "(-(" ++ sIRExpr g cxt arg ++ "))"

sIRExpr g cxt (IRFunAp (IRFun fn) actuals) =
  if take len fname == sOperator
  then sIRExpr g cxt (IRFunAp (IRBinOp (drop len fname)) actuals)
  else fname ++ "(" ++ sActuals g cxt actuals ++ ")"
  where fname = sFunName g fn
        len = length sOperator

sIRExpr g cxt@(dts,_,_,_,_,_,_)
  (IRFunAp (IRBinOp "==")
            [IRVExp (IRVarVertex nt1 IRPrev []),
             IRVExp (IRVarVertex nt2 IRCurr [])]) | fEmbedStruct g =
  concatMapInsert (sPutParen . f) " && " False (inlineStruct False dts nt1)
  where f :: IRNameAndType -> String
        f nt = sIRExpr g cxt (IRFunAp (IRBinOp "==")
                                       [IRVExp (IRVarVertex nt1 IRPrev [nt]),
                                        IRVExp (IRVarVertex nt2 IRCurr [nt])])

sIRExpr g cxt (IRFunAp (IRBinOp op) [lt,rt]) =
  sPutParen (sIRExpr g cxt lt ++ " " ++ op ++ " " ++ sIRExpr g cxt rt)

sIRExpr g cxt (IRVExp v) = sIRVarRight g v
sIRExpr g cxt (IRMVal (name,_)) =
  sMayMakePrimitive g (sMsgRecvMsg g `sClassMember` name)
sIRExpr g cxt (IRCExp t c) = sIRConst c
sIRExpr g cxt (IRAggr ag) = sIRAggr g ag

sIRConst :: IRConst -> String
sIRConst (IRCInt n) = show n
sIRConst (IRCBool True) = "true"
sIRConst (IRCBool False) = "false"
sIRConst (IRCDouble x) = show x

sIRVar :: (PregelGenerator g) => g -> IRVar -> String
sIRVar g (IRVarLocal (name, _)) = name
sIRVar g (IRVarVertex ("id", _) _ _) = sVertexGetId g
sIRVar g (IRVarVertex (name, _) pc nts) =
  if fEmbedStruct g then sClassMemberPC sVertex ss pc
  else foldl f (sClassMemberPC sVertex name pc) nts
  where post = concatMapInsert fst "_" False nts
        ss = if post == "" then name else (name ++ "_" ++ post)
        f s (n,_) = s `sClassMember` n
sIRVar g (IRVarEdge ("vid", _) _) = sEdgeVertexId g
sIRVar g (IRVarEdge (name, _) fs) = sEdgeMember g name fs
sIRVar g (IRVarAggr (name, _)) = name

sIRVarRight :: (PregelGenerator g) => g -> IRVar -> String
sIRVarRight g (IRVarLocal (name, _)) = name
sIRVarRight g v = sMayMakePrimitive g (sIRVar g v)

sIRType :: (PregelGenerator g) => g -> TypeConv -> IRType -> String
sIRType g NoTypeConv (IRSimpleType dtype) = sDTypeSimple g dtype
sIRType g WritableTypeConv (IRSimpleType dtype) = sDType g dtype
sIRType g c (IRGenericsType name ts) =
  name ++ "<" ++ concatMapInsert (sIRType g c) "," False ts ++ ">"
sIRType g _ (IRUserType name ts) = name   --- TODO: This should be modified
sIRType g _ IRVoidType = "void"

varType :: IRVar -> IRType
varType (IRVarLocal (_,t)) = t
varType (IRVarVertex (_,t) _ []) = t
varType (IRVarVertex (_,_) _ ms) = snd (last ms)
varType (IRVarEdge (_,t) _) = t   -- TODO: This should be modified
varType (IRVarAggr (_,t)) = t

sClassMemberPC :: String -> String -> IRPrevCurr -> String
sClassMemberPC s m IRPrev = sClassMemberPrev s m
sClassMemberPC s m IRCurr = sClassMemberCurr s m
sClassMemberPC s m IRNone = s `sClassMember` m

sClassMemberPrev :: String -> String -> String
sClassMemberPrev s m = s `sClassMember` (sPrevName m)

sClassMemberCurr :: String -> String -> String
sClassMemberCurr s m = s `sClassMember` (sCurrName m)

sIRAggr :: (PregelGenerator g) => g -> IRNameAndType -> String
sIRAggr g nt = sMayMakePrimitive g (sAggValue g nt)

getNeedAgg :: String -> [(IRNameAndType, IRAggOp)] -> String
getNeedAgg str ps = getNeedAgg' 1 ps
                    where
                    getNeedAgg' n [] = show n
                    getNeedAgg' n (((name,_),_):ps) =
                      if str == name then show n else getNeedAgg' (n + 1) ps

sIRModifier :: IRModifier -> String
sIRModifier IRModVirtual = "virtual "
sIRModifier IRInline = "inline"
sIRModifier IRNoModifier = ""

sPrevName :: String -> String
sPrevName = (++ "_prev")

sCurrName :: String -> String
sCurrName = (++ "_curr")

-- Determine whether `choice' is used or not
choiceUsed :: IRPhaseComputeProcess -> Bool
choiceUsed (IRPhaseComputeProcess _ _ _ (IRBlock _ ss) _) =
  or (map choiceUsedStatement ss)

choiceUsedStatement :: IRStatement -> Bool
choiceUsedStatement (IRStatementMsg _ (IRAggChoice _) _) = True
choiceUsedStatement _ = False

-- for use by Main.hs
genCode ast nast ops sfs =
  let ir = genIR (kelimcomm, kusevth, kmsgcomb) sfs nast
      kelimcomm = elimCommOpt ops && (not (useSmt ops))
      kusevth = useV2HOpt ops && (not (useSmt ops))
      kmsgcomb = useMsgCombOpt ops
      str = if mode == IROnly then groom ir
            else if mode == ASTOnly then groom ast
            else if mode == NASTOnly then groom nast
            else unlines $ map makeLn $ gen 0 ops ir
                 where gen = case mode of
                               Giraph -> ggIRProg GiraphGenerator
                               PregelPlus -> ggIRProg PregelPlusGenerator
  in str
  where mode = genMode ops
        makeLn (d,str) | d == 0    = str
                       | otherwise = "  " ++ makeLn (d - 1, str)

-- genCode' :: DASTData -> DNormalized DASTData -> Option -> [SMTOptimizable] ->
--             [(String, String)]
genCode' ast nast ops sfs = [(fname, genCode ast nast ops sfs)] -- single file?
  where fname = case outputFile ops of
                  Just nm -> nm
                  Nothing -> case lang of
                               -- Java -> pname ++ ".java"
                               Java -> let (h:t) = pname in
                                         toUpper h : (t ++ ".java")
                               CPlusPlus -> pname ++ ".cpp"
        lang = case (genMode ops) of
                 Giraph -> targetLanguage GiraphGenerator
                 PregelPlus -> targetLanguage PregelPlusGenerator
        (DNormalized pname _ _ _ _ _ _ _) = nast

{-
genCode' ast nast ops = [(filename, genCode ast nast ops)]  -- single file?
    where filename = case outputFile ops of
                       Just nm -> nm
                       Nothing -> case lang of
                                    Java -> pname ++ ".java"
                                    CPlusPlus -> pname ++ ".cpp"
                           where lang = case (genMode ops) of
                                          Giraph -> targetLanguage GiraphGenerator
                                          PregelPlus -> targetLanguage PregelPlusGenerator
          pname = let (DNormalized progname _ _ _ _ _ _ _) = nast in progname
-}