fregel-1.2.0: compiler/IRtoPregel.hs
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
-}