module NtoIR where import Spec import Normalization import ASTData import IR import GenSMT import Data.List import Data.Ord import Debug.Trace import System.IO.Unsafe --import Text.Groom myFind p xs = case Data.List.find p xs of Just a -> a; Nothing -> undefined ppp v = unsafePerformIO $ do { putStrLn (show v); return v;} ------------------------------------------------------------------------ dataName phlabel = "data_" ++ phlabel stepName prog = "step_" ++ prog ndataName prog = "NData_" ++ prog phaseName prog = "phase_" ++ prog subphName prog = "subphase_" ++ prog isdataName name = "data_" `Data.List.isPrefixOf` name isstepName name = "step_" `Data.List.isPrefixOf` name retrievePhaseName name | isdataName name = drop 5 name -- remove "data_" | isstepName name = drop 5 name -- remove "step_" | otherwise = trace ("\n cannot retrieve phase name from " ++ name) $ undefined ------------------------------------------------------------------------ -- Kato and Iwasaki: Eliminating communications / Using VoteToHalt -- related constants ------------------------------------------------------------------------ notChgName :: String notChgName = "notchanged" notChgNameAndType :: IRNameAndType notChgNameAndType = (notChgName, IRSimpleType (DTBool ())) irNotChg :: IRVar irNotChg = IRVarVertex notChgNameAndType IRNone [] doAgainName :: String doAgainName = "doagain" irDoAgain :: IRVar irDoAgain = IRVarLocal (doAgainName, IRSimpleType (DTBool ())) ------------------------------------------------------------------------ -- NDPhase : a phases categorized into gmap/gzip, giter, or fregel, with logical steps split into physical steps ------------------------------------------------------------------------ data NDPhase = NDMapZipPhase -- (for gmap/gzip) Int -- Phase ID String -- Label (DExpr DASTData, [[DSmplDef DASTData]]) -- finit | NDIterPhase -- (for giter) Int -- Phase Id String -- Label (DExpr DASTData, [[DSmplDef DASTData]]) -- finit (DExpr DASTData, [[DSmplDef DASTData]]) -- fjudge (DExpr DASTData, [[DSmplDef DASTData]]) -- fstep | NDFregelPhase -- (for fregel) Int -- Phase ID String -- Label (DExpr DASTData, [[DSmplDef DASTData]]) -- finit (DExpr DASTData, [[DSmplDef DASTData]]) -- fjudge (DExpr DASTData, [[DSmplDef DASTData]]) -- fstep deriving (Show, Eq) getPhaseID (NDMapZipPhase phid _ _ ) = phid getPhaseID (NDIterPhase phid _ _ _ _) = phid getPhaseID (NDFregelPhase phid _ _ _ _) = phid getPhaseName (NDMapZipPhase _ phlabel _ ) = phlabel getPhaseName (NDIterPhase _ phlabel _ _ _) = phlabel getPhaseName (NDFregelPhase _ phlabel _ _ _) = phlabel getID_Init (NDMapZipPhase _ _ (fI, pI) ) = 0 getID_Init (NDIterPhase _ _ (fI, pI) (fJ, pJ) (fS, pS)) = 0 getID_Init (NDFregelPhase _ _ (fI, pI) (fJ, pJ) (fS, pS)) = 0 getID_Judge (NDMapZipPhase _ _ (fI, pI) ) = -1 -- dummy getID_Judge (NDIterPhase _ _ (fI, pI) (fJ, pJ) (fS, pS)) = length pI getID_Judge (NDFregelPhase _ _ (fI, pI) (fJ, pJ) (fS, pS)) = length pI getID_Step (NDMapZipPhase _ _ (fI, pI) ) = -1 -- dummy getID_Step (NDIterPhase _ _ (fI, pI) (fJ, pJ) (fS, pS)) = length pI + length pJ getID_Step (NDFregelPhase _ _ (fI, pI) (fJ, pJ) (fS, pS)) = length pI + length pJ getInit (NDMapZipPhase _ _ (fI, pI) ) = (fI, pI) getInit (NDIterPhase _ _ (fI, pI) (fJ, pJ) (fS, pS)) = (fI, pI) getInit (NDFregelPhase _ _ (fI, pI) (fJ, pJ) (fS, pS)) = (fI, pI) getJudge (NDMapZipPhase _ _ (fI, pI) ) = (undefined, undefined) -- dummy getJudge (NDIterPhase _ _ (fI, pI) (fJ, pJ) (fS, pS)) = (fJ, pJ) getJudge (NDFregelPhase _ _ (fI, pI) (fJ, pJ) (fS, pS)) = (fJ, pJ) getStep (NDMapZipPhase _ _ (fI, pI) ) = (undefined, undefined) -- dummy getStep (NDIterPhase _ _ (fI, pI) (fJ, pJ) (fS, pS)) = (fS, pS) getStep (NDFregelPhase _ _ (fI, pI) (fJ, pJ) (fS, pS)) = (fS, pS) isMapZipPhase (NDMapZipPhase _ _ _) = True isMapZipPhase _ = False ------------------------------------------------------------------------ -- NDPhGraph : precomputed phase-transisions ------------------------------------------------------------------------ data PhLinks = PhLinks { phid :: Int, next_in :: (Int, Int), -- next phase/subphase (IN) next_out :: (Int, Int) } -- next phase/subphase (OUT) deriving (Show, Eq) type NDPhGraph = [PhLinks] nextState_in phgraph ph_id = next_in $ myFind ((== ph_id) . phid) phgraph nextState_out phgraph ph_id = next_out $ myFind ((== ph_id) . phid) phgraph ------------------------------------------------------------------------ -- entry point ------------------------------------------------------------------------ -- ecopt == -oec is given and -smt is NOT given -- vhopt == -ovh is given and -smt is NOT given genIR oinfo@(ecopt, vhopt, msgcomb) sfs (DNormalized progname iterinfo user_records ndata phases' phgraph initPhase constVars) = let phs = map (processPhase2 oinfo iterinfo sfs) phases' -- split each phase into steps and add some information fst3 (x,y,z) = x snd3 (x,y,z) = y thd3 (x,y,z) = z phases = map fst3 phs needNotChanged = or (map snd3 phs) -- usefix = or (map thd3 phs) phgraph2 = processPhGraph phgraph iterinfo phases -- datatypes (ndata_record, ps) = ndata typedecl = map convTypeDecl user_records -- constants (constants, methods) = convConstants constVars -- definition of vertex valField = let dvals = findDVal phases in if length dvals > 0 then head dvals else ("val", IRSimpleType (DTInt ())) -- Kato and Iwasaki -- `notchanged' field changedField = if needNotChanged then [notChgNameAndType] else [] interstepVar = findInterstepVars constants phases vertexStruct = convVertexStruct progname phases ndata (changedField ++ [valField] ++ interstepVar) -- definition of message messageExprs = extractMessageExprs phases -- Emoto 2021/1/27: modified to remove duplicates --msgStruct = convMsgStruct messageExprs msgStruct = convMsgStruct (Data.List.nubBy aux $ messageExprs) where aux (DDefVar var1 _ _ _) (DDefVar var2 _ _ _) = var1 == var2 -- definition of aggregator -- aggExprs = extractAggExprs phases -- aggStruct = convAggStruct aggExprs aggExprs = extractAggExprs phases -- Emoto 2021/1/27: modified to remove duplicates -- aggStruct = convAggStruct aggExprs aggStruct = convAggStruct (Data.List.nubBy aux $ aggExprs) where aux (DDefVar var1 _ (DAggr op1 _ _ _ _) _) (DDefVar var2 _ (DAggr op2 _ _ _ _) _) = var1 == var2 && op1 == op2 env = MakePhaseBodyEnv progname iterinfo phgraph2 typedecl vertexStruct constants interstepVar 0 "dummy" (vth, phasebody) = makePhaseBody env phs -- (vth, phasebody) = makePhaseBody env vhopt phs phaseCompute = IRPhaseCompute phasebody -- FIXME: type of edge should be collected edgeStruct = IREdgeStruct ("EdgeData_" ++ progname) [("e", IRSimpleType (DTInt ()))] useOfSendR = isSendRUsed phasebody needTagMsgs = multipleSends phasebody initState = (head initPhase, 0) in IRProg progname typedecl vertexStruct edgeStruct msgStruct aggStruct useOfSendR needTagMsgs (False,vth,msgcomb) constants phaseCompute initState methods ------------------------------------------------------------------------ -- processPhase2 : categorize a phase into gmap/gzip, giter, or fregel, and split its logical steps into physical ones ------------------------------------------------------------------------ processPhase2 :: OptimizeInfo -> [Int] -> [SMTOptimizable] -> DPhase DASTData -> (NDPhase, CanElimComm, Bool) processPhase2 (ecopt, vhopt, _) iterinfo sfs (phid, phlabel, fInit, fStep, fJudge) = let fInit' = processFInit fInit fStep' = processFStep fStep fJudge' = processFJudge fJudge -- Kato and Iwasaki DDefVertComp _ pinit _ _ = fInit usefixinit = or (map hasAggTermG pinit) DDefVertComp _ pstep _ _ = fStep usefixstep = or (map hasAggTermG pstep) DDefVertComp _ pjudge _ _ = fJudge usefixjudge = or (map hasAggTermG pjudge) usefix = usefixjudge || usefixstep || usefixinit ec = if ecopt then idpJudge fStep -- -oec && (not -smt) else if canEcWithSMT sfs fStep then True else False vh = if vhopt then ec && usefix else if canVHWithSMT sfs fStep then True else False in -- ppp phid `seq` -- ppp (phid `elem` iterinfo) `seq` -- ppp isGmapGzipPhase `seq` if phid `elem` iterinfo then (NDIterPhase phid phlabel fInit' fJudge' fStep', False, False) else if isGmapGzipPhase then (NDMapZipPhase phid phlabel fInit', False, False) else -- (putStrLn ("processPhase2: sfs = " ++ show sfs) `seq` -- putStrLn ("processPhase2: ec = " ++ show ec ++ ", vh = " ++ show vh) -- `seq` (NDFregelPhase phid phlabel fInit' fJudge' fStep', ec, vh) -- ) where isGmapGzipPhase = isConstTrueExpression $ getLSSLastExpr fJudge getLSSLastExpr (DDefVertComp _ _ lastexpr _) = lastexpr isConstTrueExpression (DCExp (DCBool True _) _) = True isConstTrueExpression _ = False canEcWithSMT sfs (DDefVertComp (DFun name _) _ _ _) = cews name sfs -- canEcWithSMT sfs (DDefVertComp (DFun name _) _ _ _) = ppp sfs `seq` ppp name `seq` cews name sfs canVHWithSMT sfs (DDefVertComp (DFun name _) _ _ _) = cvws name sfs cews name [] = False cews name ((sfname, b, _):sfs') | isSf name sfname = b | otherwise = cews name sfs' cvws name [] = False cvws name ((sfname, _, b):sfs') | isSf name sfname = b | otherwise = cvws name sfs' isSf name sfname = take (length sfname) name == sfname processFInit (DDefVertComp fun progs consap _) = let (prog1, prog2) = splitBeforeFirst hasAgg progs prog3 = splitBeforeEach hasAggCurr prog2 in (consap, prog1 : prog3) processFJudge (DDefVertComp fun progs judgeExpr _) = let progs' = splitBeforeEach hasAggCurr progs in (judgeExpr, progs') processFStep (DDefVertComp fun progs consap _) = let progs' = splitBeforeEach hasAggCurr progs in (consap, progs') -- splits the given list at the element satisfying p first; the second list contains the element. splitBeforeFirst p xs = let before = takeWhile (not . p) xs after = dropWhile (not . p) xs in (before, after) -- splits the given list at every element satisfying p; the element is located at the head of each split (except for the fist one) splitBeforeEach p [] = [] splitBeforeEach p xs = let before = takeWhile (not . p) xs after = dropWhile (not . p) xs in case after of [] -> [before] [a] -> [before, [a]] (a : as) -> let (as' : ass) = splitBeforeEach p as in before : (a : as') : ass hasAggCurr (DDefVar var [] expr _) = hasAggCurrExp expr hasAggCurrExp (DAggr _ (DFieldAcc (DCurr _ _) _ _) _ _ _) = True -- TOO BAAAD! this fails even for "curr v .^ hoge + 1" -- FIXME: search any curr in the body hasAggCurrExp expr = False hasAgg (DDefVar var [] expr _) = let res = hasAggExp expr in res hasAggExp (DAggr _ _ _ _ _) = True hasAggExp expr = False hasAggTermG (DDefVar var [] expr _) = hasAggTermGExp expr hasAggTermG _ = False hasAggTermGExp (DAggr _ _ (DGenTermG _) _ _) = True hasAggTermGExp _ = False -- Kato and Iwasaki -- judges whether the step function uses an idempotent operator or not idpJudge :: DDefVertComp a -> Bool idpJudge (DDefVertComp (DFun fn _) vs (DConsAp _ as _) _) = -- ppp 9999 `seq` ppp fn `seq` and (map judgefn as) where judgefn (DVExp (DVar v _) _) = idpJudge2 (getLetVal v vs) vs judgefn _ = False {- idpJudge (DDefVertComp (DFun fn _) vs (DConsAp _ [DVExp (DVar v _) _] _) _) = ppp 9999 `seq` ppp fn `seq` idpJudge2 (getLetVal v vs) vs -} idpJudge (DDefVertComp (DFun fn _) vs _ _) = -- ppp 8888 `seq` ppp fn `seq` False idpJudge2 :: DSmplDef a -> [DSmplDef a] -> Bool idpJudge2 a@(DDefVar _ _ (DAggr ag _ _ _ _) _) vs = idpJudgeAgg "" ag idpJudge2 (DDefVar _ _ (DFunAp f [DVExp (DVar a1 _) _, DVExp (DVar a2 _) _] _) _) vs = if op == "" then False else if idpJudgeAgg op ag1 then True else idpJudgeAgg op ag2 where op = getIdpOp (getName f) DDefVar _ _ (DAggr ag1 _ _ _ _) _ = getLetVal a1 vs DDefVar _ _ (DAggr ag2 _ _ _ _) _ = getLetVal a2 vs idpJudge2 (DDefVar _ _ (DFunAp f [DVExp (DVar a1 _) _, _] _) _) vs = if op == "" then False else idpJudgeAgg op ag where op = getIdpOp (getName f) DDefVar _ _ (DAggr ag _ _ _ _) _ = getLetVal a1 vs idpJudge2 (DDefVar _ _ (DFunAp f [_, DVExp (DVar a2 _) _] _) _) vs = if op == "" then False else idpJudgeAgg op ag where op = getIdpOp (getName f) DDefVar _ _ (DAggr ag _ _ _ _) _ = getLetVal a2 vs idpJudge2 _ _ = False getLetVal :: String -> [DSmplDef a] -> DSmplDef a getLetVal v [] = undefined getLetVal v (x:xs) = if v == getName x then x else getLetVal v xs idpJudgeAgg :: String -> DAgg a -> Bool idpJudgeAgg s (DAggMax _) = s == "max" || s == "" idpJudgeAgg s (DAggMin _) = s == "min" || s == "" idpJudgeAgg s (DAggAnd _) = s == "&&" || s == "" idpJudgeAgg s (DAggOr _) = s == "||" || s == "" idpJudgeAgg _ _ = False getIdpOp :: String -> String getIdpOp name = if elem name idpOp then name else "" idpOp :: [String] idpOp = ["min", "max", "&&", "||"] ------------------------------------------------------------------------ -- processPhGraph : rearragnge the phase-transisions ------------------------------------------------------------------------ processPhGraph :: [(Int, [([a], Int)])] -- from, ??, to -> [Int] -- phases from Iters -> [NDPhase] -> NDPhGraph -- source, IN, OUT; if its next is a step function of iter? processPhGraph phgraph iterinfo phases = map (aux . addEndPh) phgraph where addEndPh (phid, [t1]) = (phid, [t1, ([], -1)]) addEndPh (phid, [t1, t2]) = (phid, [t1, t2]) aux (phid, [([], in_phase), ([], out_phase)]) = PhLinks phid (in_phase, in_step) (out_phase, out_step) where in_step = if (phid `elem` iterinfo) then 0 -- giter case else getID_Step $ myFind ((== phid) . getPhaseID) phases out_step = if (out_phase `elem` iterinfo) -- when the next phse is giter then if lastPhaseOfIterLoop out_phase == phid then getID_Step $ myFind ((== out_phase) . getPhaseID) phases else 0 else 0 lastPhaseOfIterLoop iterPhase = let in_phaseIter = getInPhase $ myFind ((== iterPhase) . fst) phgraph in last $ takeWhile (/= iterPhase) $ scanIterLoop in_phaseIter scanIterLoop ph = ph : scanIterLoop (getOutPhase $ myFind ((== ph) . fst) phgraph) getInPhase (_, (([], inp) : _)) = inp getOutPhase (_, (([], inp) : ([], outp) : _)) = outp ------------------------------------------------------------------------ -- convVertexStruct : to build a struct of vertices from a record spec (recSpec) and so on ------------------------------------------------------------------------ -- Emoto 2018/01/16: modified to add the original phase id info. to fields convVertexStruct :: String -> [NDPhase] -> (DRecordSpec DASTData,[DPhaseID]) -> [IRNameAndType]-> IRVertexStruct convVertexStruct progname phases (recSpec, phaseIds) members_n_add' = let DRecordSpec (DConstructor rname _) fs' _ = recSpec fs = zip fs' phaseIds members_n_add = zip members_n_add' (repeat (-1)) -- no corresponding phases -- fields for IRNone: data_??? for gmap/gzip, all step_???Cadditional arguments fields members_n = [convField f | f <- fs, isNoneField (fst f)] ++ members_n_add where isNoneField (DField fn _, _) = if isdataName fn then isMapZipPhase $ myFind ((== retrievePhaseName fn) . getPhaseName) phases else isstepName fn -- fields for IRPrev/IRCurr: data_??? for others members_pc = [convField f | f <- fs, isPrevCurrField (fst f)] where isPrevCurrField (DField fn _, _) = isdataName fn && (not $ isMapZipPhase $ myFind ((== retrievePhaseName fn) . getPhaseName) phases) convField ((DField rn _, DTRecord _ _ ast),pid) = let DTypeTerm "Pair" [_, t] = typeOf ast in ((rn, convType2 t), pid) convField ((DField fn ast, _),pid) = ((fn, convType ast), pid) in IRVertexStruct rname (phaseName progname) (subphName progname) members_pc members_n ------------------------------------------------------------------------ -- convConstants convert constVar in N-DSL to const-vars and methods in IR ------------------------------------------------------------------------ convConstants :: [DSmplDef DASTData] -> ([IRConstant], [IRMethod]) convConstants defs = let vars = [convDefVar d | d <- defs, isDDefVar d] funs = [convDefFun d | d <- defs, isDDefFun d] in (vars, funs) where isDDefVar (DDefVar _ _ _ _) = True isDDefVar _ = False isDDefFun (DDefFun _ _ _ _ _ ) = True isDDefFun _ = False convDefVar (DDefVar var [] expr _) = IRConstant (convVar var) (convExprGlobal undefined (convVar var) expr) convDefFun (DDefFun fun vars [] expr _) = trace ("\n unsupported DDefFun in convConstants") $ undefined ------------------------------------------------------------------------ -- findDVal find accesses to DVal from the whole program ------------------------------------------------------------------------ findDVal :: [NDPhase] -> [IRNameAndType] findDVal phases = concatMap aux1 phases where aux1 (NDMapZipPhase _ _ fI ) = aux2 fI aux1 (NDIterPhase _ _ fI fJ fT) = aux2 fI ++ aux2 fJ ++ aux2 fT aux1 (NDFregelPhase _ _ fI fJ fT) = aux2 fI ++ aux2 fJ ++ aux2 fT aux2 (expr, defss) = aux3 expr ++ concatMap (concatMap aux4) defss aux3 (DIf e1 e2 e3 _) = aux3 e1 ++ aux3 e2 ++ aux3 e3 aux3 (DTuple es _) = concatMap aux3 es aux3 (DFunAp _ es _) = concatMap aux3 es aux3 (DConsAp _ es _) = concatMap aux3 es aux3 (DFieldAcc (DPrev _ _) _ _) = [] aux3 (DFieldAcc (DCurr _ _) _ _) = [] aux3 (DFieldAcc (DVal _ a) _ _) = [("val", convType a)] aux3 (DFieldAccE _ _ _) = [] aux3 (DAggr _ e _ es _) = aux3 e ++ concatMap aux3 es aux3 (DVExp _ _) = [] aux3 (DCExp _ _) = [] aux4 (DDefFun _ _ _ _ _) = [] aux4 (DDefVar _ ss e _) = concatMap aux4 ss ++ aux3 e aux4 (DDefTuple _ _ _ _) = trace "\n: unsupported DDefTuple" $ undefined -- FIXME: is DDefTuple used? ------------------------------------------------------------------------ -- findInterstepVar find variables whose score is over the physical superstep ------------------------------------------------------------------------ findInterstepVars constVars phases = concatMap aux1 phases where constNames = map getIRConstantVar constVars aux1 (NDMapZipPhase _ _ fI ) = aux2 fI aux1 (NDIterPhase _ _ fI fJ fT) = aux2 fI ++ aux2 fJ ++ aux2 fT aux1 (NDFregelPhase _ _ fI fJ fT) = aux2 fI ++ aux2 fJ ++ aux2 fT aux2 (expr, defss) = concatMap f defss where f defs = (Data.List.nub $ concatMap findUsedVar defs) \\ (concatMap findDefVar defs ++ constNames) findUsedVar def = aux1 def where aux1 (DDefVar _ ss e _) = concatMap aux1 ss ++ aux2 e aux1 (DDefFun _ _ _ _ _) = trace ("\n DDefFun unsupported in findUsedVar") $ undefined aux1 (DDefTuple _ _ _ _) = trace ("\n DDefTuple unsupported in findUsedVar") $ undefined aux2 (DIf e1 e2 e3 _) = aux2 e1 ++ aux2 e2 ++ aux2 e3 aux2 (DTuple es _) = concatMap aux2 es aux2 (DFunAp (DFun "vid" _) es _) = [] -- For "vid v", v is not regarded as a variable aux2 (DFunAp _ es _) = concatMap aux2 es aux2 (DConsAp _ es _) = concatMap aux2 es aux2 (DFieldAcc (DPrev _ _) _ _) = [] aux2 (DFieldAcc (DCurr _ _) _ _) = [] aux2 (DFieldAcc (DVal _ _) _ _) = [] aux2 (DFieldAccE _ _ _) = [] aux2 (DAggr _ e _ es _) = aux2 e ++ concatMap aux2 es aux2 (DVExp var _) = [convVar var] aux2 (DCExp _ _) = [] findDefVar def = aux1 def where aux1 (DDefVar var ss _ _) = convVar var : (concatMap aux1 ss) aux1 (DDefFun _ _ _ _ _) = trace ("\n DDefFun unsupported in findDefVar") $ undefined aux1 (DDefTuple _ _ _ _) = trace ("\n DDefTuple unsupported in find DefVar") $ undefined ---------------------------------------------------------------------- -- isSendRUsed look for "IRStatementSendR" (= use of reverse message) ---------------------------------------------------------------------- isSendRUsed :: [IRPhaseComputeProcess] -> Bool isSendRUsed procs = or $ map aux1 procs where aux1 (IRPhaseComputeProcess _ _ _ _ nexts) = or $ map aux2 nexts aux2 (_, _, block) = aux3 block aux3 (IRBlock _ statements) = or $ map aux4 statements aux4 (IRStatementSendR _ _ _) = True aux4 (IRStatementIfThen _ block) = aux3 block aux4 _ = False ---------------------------------------------------------------------- -- multipleSends gathers message names that has to put tags ---------------------------------------------------------------------- multipleSends :: [IRPhaseComputeProcess] -> [String] multipleSends procs = concatMap aux1 procs where aux1 (IRPhaseComputeProcess _ _ _ _ ps) = concatMap aux2 ps aux2 (_, _, block) = let ts = aux3 block in if length ts <= 1 then [] else ts aux3 (IRBlock _ ss) = concatMap aux4 ss aux4 (IRStatementSendN (name, _) _ _) = [name] aux4 (IRStatementSendR (name, _) _ _) = [name] aux4 (IRStatementIfThen _ b) = aux3 b aux4 _ = [] ---------------------------------------------------------------------- -- Processing Vertex.compute ---------------------------------------------------------------------- data MakePhaseBodyEnv = MakePhaseBodyEnv { _progname :: String, _iterinfo :: [DPhaseID], _phgraph :: NDPhGraph, _typedecl :: [IRTypeDecl], _vertexStruct :: IRVertexStruct, _constants :: [IRConstant], _interstepVar :: [IRNameAndType], _phid :: Int, _phlabel :: String } deriving (Show, Eq) -- Kato and Iwasaki assignPh :: MakePhaseBodyEnv -> (String -> String) -> Int -> IRStatement assignPh env namefn n = (IRStatementLocal (IRVarVertex (ph, irInt) IRNone []) (IRCExp irInt (IRCInt n))) where ph = namefn (_progname env) irInt = IRSimpleType (DTInt ()) setPhase env phid phlabel = let MakePhaseBodyEnv progname iterinfo phgraph typedecl vertexStruct constants interstepVar _ _ = env in MakePhaseBodyEnv progname iterinfo phgraph typedecl vertexStruct constants interstepVar phid phlabel data ConvStatementsLabel = CSL_INIT | CSL_JUDGE | CSL_STEP deriving (Eq, Show) -- Kato and Iwasaki: -- The return value of this function is a pair, whose first is a boolean value -- that indicates whether vote-to-halt optimization is applied or not, and -- whose second is a list of IRPhaseComputeProcess. makePhaseBody :: MakePhaseBodyEnv -> [(NDPhase,CanElimComm,Bool)] -> (Bool, [IRPhaseComputeProcess]) makePhaseBody env phs = (vh, irphs) where lp@(_, ec, vh) = last phs irphs = concatMap (makePhaseBodyP env False) (init phs) ++ makePhaseBodyP env vh lp {- makePhaseBody env vh phs = (vh && usefix, irphs) where lp@(_, ec, usefix) = last phs irphs = concatMap (makePhaseBodyP env False) (init phs) ++ makePhaseBodyP env vh lp -} makePhaseBodyP env vh (phase, ec, _) = let env' = setPhase env (getPhaseID phase) (getPhaseName phase) --- zippedI' = markInitLast $ zipStepWithNext (snd $ getInit phase) (getID_Init phase) (getID_Judge phase) (head $ snd $ getJudge phase) zippedJ' = markInitLast $ zipStepWithNext (snd $ getJudge phase) (getID_Judge phase) (getID_Step phase) (head $ snd $ getStep phase) zippedS' = markInitLast $ zipStepWithNext (snd $ getStep phase) (getID_Step phase) (getID_Judge phase) (head $ snd $ getJudge phase) --- -- vth = vh && usefix in -- ppp ("makePhaseBodyP: vh = " ++ show vh) -- `seq` case phase of NDMapZipPhase phid phlabel (cI, _) -> map (makeStep2 env' cI phase ec False CSL_INIT) zippedI' NDFregelPhase phid phlabel (cI, _) (cJ, _) (cS, _) -> let initPart = map (makeStep2 env' cI phase ec vh CSL_INIT) zippedI' judgePart = map (makeStep2 env' cJ phase ec vh CSL_JUDGE) zippedJ' stepPart = map (makeStep2 env' cS phase ec vh CSL_STEP) zippedS' in initPart ++ judgePart ++ stepPart NDIterPhase phid phlabel (cI, _) (cJ, _) (cS, _) -> let initPart = map (makeStep2 env' cI phase ec False CSL_INIT) zippedI' judgePart = map (makeStep2 env' cJ phase ec False CSL_JUDGE) zippedJ' stepPart = map (makeStep2 env' cS phase ec False CSL_STEP) zippedS' in initPart ++ judgePart ++ stepPart --- where zipStepWithNext :: [[DSmplDef DASTData]] -- Original subphases -> Int -- Initial subphase-id -> Int -- Next subphase-id -> [DSmplDef DASTData] -- Next subphase -> [((Int, [DSmplDef DASTData]), (Int, [DSmplDef DASTData]))] zipStepWithNext defss startID nextID nextdefs = let zipped = zip [startID..] defss nextdefss = tail zipped ++ [(nextID, nextdefs)] in zip zipped nextdefss markInitLast :: [a] -> [((Bool, Bool), a)] markInitLast [] = [] markInitLast [a] = [((True, True), a)] markInitLast as = [((True, False), head as)] ++ map (\a->((False, False), a)) (init $ tail as) ++ [((False, True), last as)] makeStep2 env expr phase ec vth sw ((isFirst, isLast), ((stid, curdefs), (ss_next, nextdefs))) = let cs_sw = case sw of CSL_INIT -> True CSL_JUDGE -> False CSL_STEP -> True access = case phase of NDMapZipPhase _ _ _ -> IRNone NDFregelPhase _ _ _ _ _ -> IRCurr NDIterPhase _ _ _ _ _ -> IRCurr (recoverVars, recoverDefs) = if isFirst then ([], []) else getRecoverDefs curdefs (_constants env) localvars = recoverVars ++ extractLocalVars curdefs initcode = if not isFirst then [] else case phase of NDMapZipPhase _ _ _ -> initSetFields NDFregelPhase _ _ _ _ _ -> case sw of CSL_INIT -> [initializeStepVar (_progname env)] ++ initSetFields CSL_STEP -> [incrementStepVar (_progname env)] ++ initSetFields CSL_JUDGE -> [] NDIterPhase _ _ _ _ _ -> case sw of CSL_INIT -> [initializeStepVar (getPhaseName phase)] ++ initSetFields CSL_STEP -> initSetFields CSL_JUDGE -> [] where (DConsAp (DConstructor cname _) es astdata) = expr IRTypeDecl _ typeinfo = if cname == "Pair" then convPairTypeDecl $ typeOf astdata else myFind (\(IRTypeDecl cn _)->cn == cname) (_typedecl env) initSetFields = concatMap aux (zip typeinfo es) where aux (field, (DVExp _ _)) = [] aux (field, e@(DCExp _ _)) = [makeInitSetStatement field e] aux (field, e@(DFieldAcc _ _ _)) = [makeInitSetStatement field e] makeInitSetStatement field e = IRStatementLocal (IRVarVertex (dataName (_phlabel env), IRUserType cname []) access [field]) (convExpr env undefined e) curr2prev = makeCurr2PrevStatement (_vertexStruct env) (getPhaseName phase) afterjudgeprocess = case phase of NDFregelPhase _ _ _ _ _ -> [curr2prev] NDIterPhase _ _ _ _ _ -> [curr2prev, incrementStepVar (getPhaseName phase)] bodydefs = initcode ++ recoverDefs ++ convStatements curdefs env expr access ec vth cs_sw sendmessages = concatMap (extractsSends' env ec vth sw) nextdefs nextstep_out = let nextstate_out = nextState_out (_phgraph env) (_phid env) in (convExpr env undefined expr, nextstate_out, if (fst nextstate_out == _phid env) then IRBlock [] (afterjudgeprocess ++ sendmessages) -- Kato and Iwasaki else if vth then IRBlock [] (afterjudgeprocess ++ [assignPh env phaseName (_phid env), assignPh env subphName ss_next]) else IRBlock [] afterjudgeprocess) nextstep_in = let nextstate_in = nextState_in (_phgraph env) (_phid env) -- Kato and Iwasaki ch = IRFunAp (IRBinOp "==") [IRVExp irNotChg, alwaysFalse] sm = if ec && (not vth) then [IRStatementIfThen ch (IRBlock [] sendmessages)] else sendmessages in (alwaysTrue, nextstate_in, if (fst nextstate_in == _phid env) then IRBlock [] (afterjudgeprocess ++ sm) else IRBlock [] afterjudgeprocess) nextsteps = if not isLast then simplyNextSubph [] -- if not isLast then simplyNextSubphase else case sw of CSL_INIT -> case phase of NDMapZipPhase _ _ _ -> [(alwaysTrue, (nextState_out (_phgraph env) (_phid env)), IRBlock [] [])] -- NDFregelPhase _ _ _ _ _ -> simplyNextSubphase NDFregelPhase _ _ _ _ _ -> simplyNextSubph initNotChg -- NDIterPhase _ _ _ _ _ -> simplyNextSubphase NDIterPhase _ _ _ _ _ -> simplyNextSubph [] CSL_JUDGE -> [nextstep_out, nextstep_in] -- CSL_STEP -> simplyNextSubphase CSL_STEP -> simplyNextSubph setNotChg where simplyNextSubphase = [(alwaysTrue, (_phid env, ss_next), IRBlock [] sendmessages)] -- Kato and Iwasaki: set a value of `notchanged' assignNotChg b = if ec then [IRStatementLocal irNotChg b] else [] initNotChg = assignNotChg alwaysFalse setNotChg = assignNotChg (makePrevEqEqCurrExp (_vertexStruct env) (getPhaseName phase)) simplyNextSubph chg = [(alwaysTrue, (_phid env, ss_next), IRBlock [] (chg ++ sendmessages))] in IRPhaseComputeProcess (_phid env, stid) vth localvars (IRBlock [] bodydefs) nextsteps getRecoverDefs defs constants = let usedVars = Data.List.nub $ concatMap findUsedVar defs defVars = Data.List.nub $ concatMap findDefVar defs undefVars = usedVars \\ (defVars ++ map getIRConstantVar constants) recoverDefs = map recover undefVars where recover (vname, vtype) = IRStatementLocal (IRVarLocal (vname, vtype)) (IRVExp (IRVarVertex (vname, vtype) IRNone [])) in (undefVars, recoverDefs) alwaysTrue = IRCExp (IRSimpleType (DTBool ())) (IRCBool True) alwaysFalse = IRCExp (IRSimpleType (DTBool ())) (IRCBool False) -- Emoto 2018/01/16: modified to deal with the original phase id of a field makeCurr2PrevStatement vertexStruct phlabel = let IRVertexStruct _ _ _ gfields _ = vertexStruct (gfield, pid) = myFind ((== dataName phlabel) . fst . fst) gfields in IRStatementLocal (IRVarVertex gfield IRPrev []) (IRVExp (IRVarVertex gfield IRCurr [])) -- Kato and Iwasaki makePrevEqEqCurrExp vertexStruct phlabel = let IRVertexStruct _ _ _ gfields _ = vertexStruct (gfield, pid) = myFind ((== dataName phlabel) . fst . fst) gfields in IRFunAp (IRBinOp "==") [IRVExp (IRVarVertex gfield IRPrev []), IRVExp (IRVarVertex gfield IRCurr [])] -- extracts DAggr in defs -- FIXME: only consider DDefVar with DAgg?? -- Kato and Iwasaki: This function returns a pair, whose fst indicates -- whether DGenTermG is used, in other words, whether termination condition -- `Fix' is used or not. extractsSends' env ec vth sw (DDefVar var [] (DAggr op expr gen filters _) _) = case gen of DGenI _ -> [IRStatementSendN var' expr'' filters''] DGenO _ -> [IRStatementSendR var' expr'' filters''] DGenG _ -> [IRStatementAggr var' expr'' filters''] DGenTermG _ -> let gg = [IRStatementAggr var' expr' filters'] gs = if vth then [] else gg doagain = if vth then [IRStatementLocal irDoAgain alwaysTrue] else [] in if ec == False then gg else if sw == CSL_STEP then doagain ++ gs else if sw == CSL_INIT then doagain ++ gs else gg where var' = convVar var expr' = convExpr env _v expr expr'' = convExpr env _v (substVertexVar ps expr) filters' = map (convExpr env _v) filters filters'' = map (convExpr env _v . substVertexVar ps) filters ps = [("u", "v"), ("v", "v'")] _v = undefined extractsSends' env ec vth sw _ = [] convStatements defs env consap pcflag ec vth sw_update = concatMap (extractRecvMsg sw_update) aggr_defs ++ concatMap (convStatements' sw_update) defs' where (DConsAp (DConstructor cname _) es astdata) = consap (aggr_defs, defs') = Data.List.partition recvstatement defs where recvstatement (DDefVar _ _ (DAggr _ _ _ _ _) _) = True recvstatement _ = False IRTypeDecl _ typeinfo = if cname == "Pair" then convPairTypeDecl $ typeOf astdata else myFind (\(IRTypeDecl cn _)->cn == cname) (_typedecl env) name_type_rhs = zip typeinfo es initStatements = concatMap aux name_type_rhs where aux ((fn, ft), (DVExp _ _)) = [] aux ((fn, ft), e@(DCExp _ _)) = [IRStatementLocal (IRVarVertex (dataName (_phlabel env), IRUserType cname []) pcflag [(fn, ft)]) (convExpr env undefined e)] aux ((fn, ft), e@(DFieldAcc _ _ _)) = [IRStatementLocal (IRVarVertex (dataName (_phlabel env), IRUserType cname []) pcflag [(fn, ft)]) (convExpr env undefined e)] -- FIXME: DDefVar with no lets only?? extractRecvMsg withupdate (DDefVar var [] aggr _) = let var' = convVar var st_update = if withupdate then updateStatements (fst var') else [] in case aggr of (DAggr agg expr (DGenI _) exprs _) -> IRStatementMsg (IRVarLocal var') (convAggOp agg) (IRMVal var') : st_update (DAggr agg expr (DGenO _) exprs _) -> IRStatementMsg (IRVarLocal var') (convAggOp agg) (IRMVal var') : st_update (DAggr agg expr (DGenG _) exprs _) -> IRStatementLocal (IRVarAggr var') (IRAggr var') : st_update (DAggr agg expr (DGenTermG _) exprs _) -> -- if vth then st_update if vth then IRStatementLocal (IRVarAggr var') (IRVExp irNotChg) : st_update else IRStatementLocal (IRVarAggr var') (IRAggr var') : st_update convStatements' withupdate (DDefVar var [] expr _) = let var' = convVar var st_update = if withupdate then updateStatements (fst var') else [] in IRStatementLocal (IRVarLocal var') (convExpr env var' expr) : st_update updateStatements :: String -> [IRStatement] updateStatements vn = let updated_fields = filter vexp_with_var name_type_rhs where vexp_with_var (nt, DVExp (DVar vname _) _) = vn == vname vexp_with_var (nt, _) = False -- Emoto 2018/01/16: modified to deal with the original phase ids updated_interfields = map fst $ filter interfield_with_var $ getNoPCvars (_vertexStruct env) where interfield_with_var ((vname, _),_) = vn == vname getNoPCvars (IRVertexStruct _ _ _ _ ifs) = ifs ret = map toUpdateStatement updated_fields ++ map toUpdateStatementIF updated_interfields where toUpdateStatement ((fname, ftype), DVExp (DVar vname _) _) = IRStatementLocal (IRVarVertex (dataName (_phlabel env), IRUserType cname []) pcflag [(fname, ftype)]) (IRVExp (IRVarLocal (vname, ftype))) toUpdateStatementIF (vname, vtype) = IRStatementLocal (IRVarVertex (vname, vtype) IRNone []) (IRVExp (IRVarLocal (vname, vtype))) in ret extractLocalVars defs = concatMap aux defs where aux (DDefVar var [] _ _) = [convVar var] -- FIXME: assumed no nested expression here?? aux _ = [] initializeStepVar name = let stepVar = IRVarVertex (stepName name, IRSimpleType (DTInt ())) IRNone [] in IRStatementLocal stepVar (IRCExp (IRSimpleType (DTInt ())) (IRCInt 0)) incrementStepVar name = let stepVar = IRVarVertex (stepName name, IRSimpleType (DTInt ())) IRNone [] in IRStatementLocal stepVar (IRFunAp (IRBinOp "+") [IRVExp stepVar, IRCExp (IRSimpleType (DTInt ())) (IRCInt 1)]) ---------------------------------------------------------------------- -- Convert Type (DType / DTypeTerm) to IRType ---------------------------------------------------------------------- convType :: DASTData -> IRType convType astdata = convType2 $ typeOf astdata convType2 :: DTypeTerm -> IRType -- FIXME: check whether types for Vertex, Graph, Null appear in the generated part. convType2 (DTypeTerm "Int" _) = IRSimpleType (DTInt ()) convType2 (DTypeTerm "Bool" _) = IRSimpleType (DTBool ()) convType2 (DTypeTerm "Double" _) = IRSimpleType (DTDouble ()) convType2 (DTypeTerm "String" _) = IRSimpleType (DTString ()) convType2 (DTypeTerm "(,)" fs) = IRUserType "Tuple" (map convType2 fs) convType2 (DTypeTerm "Vertex" fs) = trace "Not considered type: Vertex" $ undefined convType2 (DTypeTerm "Graph" fs) = trace "Not considered type: Graph" $ undefined convType2 (DTypeTerm "Null" _) = trace "Not considered type: Null" $ undefined convType2 (DTypeTerm other fs) = IRUserType other (map convType2 fs) ---------------------------------------------------------------------- -- processing records ---------------------------------------------------------------------- convTypeDecl :: DRecordSpec DASTData -> IRTypeDecl convTypeDecl (DRecordSpec (DConstructor rname _) fields _) = IRTypeDecl rname (map (convField . fst) fields) convPairTypeDecl :: DTypeTerm -> IRTypeDecl convPairTypeDecl (DTypeTerm "Pair" [a, b]) = IRTypeDecl "Pair" [("_fst", convType2 a), ("_snd", convType2 b)] ---------------------------------------------------------------------- -- Preprocessing Messages ---------------------------------------------------------------------- extractMessageExprs :: [NDPhase] -> [DSmplDef DASTData] extractMessageExprs phases = concatMap aux1 phases where aux1 (NDMapZipPhase _ _ fI ) = aux2 fI aux1 (NDIterPhase _ _ fI fJ fS) = aux2 fI ++ aux2 fJ ++ aux2 fS aux1 (NDFregelPhase _ _ fI fJ fS) = aux2 fI ++ aux2 fJ ++ aux2 fS aux2 (expr, defss) = concatMap (concatMap aux3) defss aux3 e@(DDefVar _ _ (DAggr agg _ (DGenI _) _ _) _) = [e] aux3 e@(DDefVar _ _ (DAggr agg _ (DGenO _) _ _) _) = [e] aux3 _ = [] -- FIXME: Enough? consider only DDefVar + Agg + GenI/GenO convMsgStruct :: [DSmplDef DASTData] -> IRMsgStruct convMsgStruct msgExprs = IRMsgStruct "MsgData" (map aux msgExprs) where aux (DDefVar var _ _ _) = convVar var ---------------------------------------------------------------------- -- Preprocessing Aggregator ---------------------------------------------------------------------- extractAggExprs :: [NDPhase] -> [DSmplDef DASTData] extractAggExprs phases = concatMap aux1 phases where aux1 (NDMapZipPhase _ _ fI ) = aux2 fI aux1 (NDIterPhase _ _ fI fJ fS) = aux2 fI ++ aux2 fJ ++ aux2 fS aux1 (NDFregelPhase _ _ fI fJ fS) = aux2 fI ++ aux2 fJ ++ aux2 fS aux2 (expr, defss) = concatMap (concatMap aux3) defss aux3 e@(DDefVar _ _ (DAggr agg _ (DGenG _) _ _) _) = [e] aux3 e@(DDefVar _ _ (DAggr agg _ (DGenTermG _) _ _) _) = [e] aux3 _ = [] -- FIXME: Enough? consider only DDefVar + Agg + GenG convAggStruct :: [DSmplDef DASTData] -> IRAggStruct convAggStruct aggExprs = IRAggStruct "AggData" (map aux aggExprs) where aux (DDefVar var _ (DAggr op _ _ _ _) _) = (convVar var, convAggOp op) ------------------------------------------------------------------------ -- convExpr : convert an expression to IRExpr -- * eVal (snd parameter) is used as the variable name of aggregator/message ------------------------------------------------------------------------ convExpr :: MakePhaseBodyEnv -> IRNameAndType -> DExpr DASTData -> IRExpr convExpr env eVar expr = aux expr where aux (DConsAp (DConstructor c _) _ _) = trace ("unsupported use of DConsAP for " ++ show c) $ undefined aux (DIf e1 e2 e3 _) = IRIf (aux e1) (aux e2) (aux e3) aux (DFunAp f es astdata) = case f of DFun "vid" _ -> case es of [DVExp (DVar "v" _) _] -> IRVExp (IRVarVertex ("id", convType astdata) IRNone []) [DVExp (DVar "u" _) _] -> IRVExp (IRVarVertex ("id", convType astdata) IRNone []) [DVExp (DVar "v'" _) _] -> IRVExp (IRVarEdge ("vid", convType astdata) []) otherwise -> IRFunAp (convFun f) (map aux es) othewise -> IRFunAp (convFun f) (map aux es) aux (DFieldAcc acc fields astdata) = case acc of DVal var astdata' -> IRVExp (IRVarVertex ("val", convType astdata') IRNone (map convField fields)) DPrev var _ -> auxDF IRPrev var fields astdata DCurr var _ -> auxDF IRCurr var fields astdata where -- procesing "DFieldAcc (DPrev var _) (f1 : f2 : fs) -- (the same for DCurr) -- var's typeOf must be DTypeTerm "Graph"; skipping a _snd -- ==> f1 is the variable name; the type is got from f2's typeOf -- the rest (fs) is stored as fields auxDF pcflagOrg var (f1 : fs) astdata = let pcflag = if isIRNoneField f1 then IRNone -- for variables of gmap/gzip else pcflagOrg in case getTypeId var of "Graph" -> IRVExp (IRVarVertex (getFieldName f1, getFieldType $ head fs) pcflag (map convField $ tail fs)) "Vertex" -> if isstepName (getFieldName f1) then IRVExp (IRVarVertex (getFieldName f1, getFieldType f1) IRNone (map convField fs)) else IRVExp (IRVarVertex (getFieldName f1, convType astdata) pcflag (map convField $ tail fs)) -- skip one otherwise -> trace ("\n unsupported case in convExpr: " ++ show (var, f1 : fs)) $ undefined aux (DFieldAccE (DEdge astdata) fs _) = IRVExp (IRVarEdge ("e", convType astdata) (map convField fs)) aux (DAggr _ _ gen _ _) = case gen of DGenG _ -> IRAggr eVar -- read from aggregator DGenTermG _ -> IRAggr eVar -- read from aggregator otherwise -> IRMVal eVar -- read from message aux (DVExp var _) = IRVExp (IRVarLocal (convVar var)) aux (DCExp con astdata) = IRCExp (convType astdata) (convConst con) aux x = trace ("\ncannot compile expression: " ++ show x ++ "\n") $ undefined -- FIXME: aux (DTuple es _) needed? --- -- Emoto 2018/01/16: modified to deal with the original phase ids isIRNoneField f = let IRVertexStruct _ _ _ _ nonefields = _vertexStruct env in any ((== getFieldName f) . fst . fst) nonefields getTypeId var = let (DVar _ a) = var; (DTypeTerm t _) = typeOf a in t getFieldName (DField fn _) = fn getFieldType (DField _ ft) = convType ft -- FIXME: convert expression for global definitions (== no messages) convExprGlobal = convExpr convField :: DField DASTData -> IRNameAndType convField (DField fname astdata) = (fname, convType astdata) convVar :: DVar DASTData -> IRNameAndType convVar (DVar vname astdata) = (vname, convType astdata) convFun :: DFun a -> IRFun convFun (DFun fname _) = IRFun fname convFun (DBinOp fname _) = IRBinOp fname convAggOp (DAggMin _) = IRAggMin convAggOp (DAggMax _) = IRAggMax convAggOp (DAggSum _) = IRAggSum convAggOp (DAggProd _) = IRAggProd convAggOp (DAggAnd _) = IRAggAnd convAggOp (DAggOr _) = IRAggOr convAggOp (DAggChoice (DCExp c _) _) = IRAggChoice (convConst c) -- FIXME: used? convAggOp (DTupledAgg aggs _) = IRTupledAgg (map convAggOp aggs) -- FIXME: for internal use? convConst :: DConst a -> IRConst convConst (DCInt n _) = IRCInt n convConst (DCBool n _) = IRCBool n convConst (DCString n _) = IRCString n convConst (DCDouble n _) = IRCDouble n -- substVertexVar :: [(String, String)] -> DExpr DASTData -> DExpr DASTData substVertexVar :: [(String, String)] -> DExpr a -> DExpr a substVertexVar ps expr = aux expr where aux (DIf e1 e2 e3 a) = DIf (aux e1) (aux e2) (aux e3) a aux (DTuple es a) = DTuple (map aux es) a aux (DFunAp fn [e] a) = DFunAp fn [aux e] a aux (DFunAp fn [e1,e2] a) = DFunAp fn [aux e1, aux e2] a aux (DFunAp fn es a) = DFunAp fn (map aux es) a aux (DConsAp con es a) = DConsAp con (map aux es) a aux (DFieldAcc texpr fs a) = DFieldAcc (aux2 texpr) fs a aux (DAggr ag e gen es a) = DAggr ag (aux e) gen (map aux es) a aux (DCheckTerm e a) = DCheckTerm (aux e) a aux (DVExp (DVar name a1) a2) = DVExp (DVar (conv name ps) a1) a2 aux e = e aux2 (DPrev (DVar name a1) a2) = DPrev (DVar (conv name ps) a1) a2 aux2 (DCurr (DVar name a1) a2) = DCurr (DVar (conv name ps) a1) a2 aux2 (DVal (DVar name a1) a2) = DVal (DVar (conv name ps) a1) a2 conv name [] = name conv name ((s1,s2):ps) | name == s1 = s2 | otherwise = conv name ps {- -- sample input from "ssspAndMax.fgl" sampleinput = DNormalized "ssspAndMax" [] [DRecordSpec (DConstructor "MVal_X41b" (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = []})) [(DField "mval_X41c" (DASTData {typeOf = DTypeTerm "Int" [], depOf = []}),DTInt (DASTData {typeOf = DTypeTerm "Int" [], depOf = []}))] (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = []}),DRecordSpec (DConstructor "SVal_X419" (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = []})) [(DField "dist_X41a" (DASTData {typeOf = DTypeTerm "Int" [], depOf = []}),DTInt (DASTData {typeOf = DTypeTerm "Int" [], depOf = []}))] (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = []}),DRecordSpec (DConstructor "NData_ssspAndMax" (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = []})) [(DField "phase_ssspAndMax" (DASTData {typeOf = DTypeTerm "Int" [], depOf = []}),DTInt (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})),(DField "step_ssspAndMax" (DASTData {typeOf = DTypeTerm "Int" [], depOf = []}),DTInt (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})),(DField "data_g1_X422" (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = []}), DTRecord (DConstructor "Pair" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "SVal_X419" []], depOf = []})) [DTBool (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []}),DTRecord (DConstructor "SVal_X419" (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = []})) [] (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "SVal_X419" []], depOf = []})),(DField "data_g2_X423" (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = []}),DTRecord (DConstructor "Pair" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "MVal_X41b" []], depOf = []})) [DTBool (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []}),DTRecord (DConstructor "MVal_X41b" (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = []})) [] (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "MVal_X41b" []], depOf = []}))] (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = []})] [(0,"g1_X422",DDefVertComp (DFun "ssspinit_X41e_X436" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []],DTypeTerm "SVal_X419" []], depOf = ["==","vid","SVal_X419"]})) [DDefVar (DVar "var_X438" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["==","vid","v"]})) [] (DIf (DFunAp (DBinOp "==" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "Bool" []]], depOf = ["=="]})) [DFunAp (DFun "vid" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []],DTypeTerm "Int" []], depOf = ["vid"]})) [DVExp (DVar "v" (DASTData {typeOf = DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []], depOf = ["v"]})) (DASTData {typeOf = DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []], depOf = ["v"]})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["vid","v"]}),DCExp (DCInt 1 (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Bool" [], depOf = ["==","vid","v"]})) (DCExp (DCInt 0 (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})) (DCExp (DCInt 100000 (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["==","vid","v"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["==","vid","v"]})] (DConsAp (DConstructor "SVal_X419" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "SVal_X419" []], depOf = ["SVal_X419"]})) [DVExp (DVar "var_X438" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["var_X438"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["var_X438"]})] (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = ["SVal_X419","var_X438"]})) (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []],DTypeTerm "SVal_X419" []], depOf = ["==","vid","SVal_X419"]}),DDefVertComp (DFun "ssspstep_X41f_X437" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "t29",DTypeTerm "Int" []],DTypeTerm "SVal_X419" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "t29",DTypeTerm "Int" []],DTypeTerm "SVal_X419" []],DTypeTerm "SVal_X419" []]]], depOf = ["minimum","+","dist_X41a","min","SVal_X419"]})) [DDefVar (DVar "agg_X432" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","minimum","+","prev","dist_X41a"]})) [] (DAggr (DAggMin (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["minimum"]})) (DFunAp (DBinOp "+" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "Int" []]], depOf = ["+"]})) [DFieldAcc (DPrev (DVar "u" (DASTData {typeOf = DTypeTerm "Graph" [DTypeTerm "Null" [],DTypeTerm "Int" []], depOf = ["u"]})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = ["u","prev"]})) [DField "data_g1_X422" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "SVal_X419" []], depOf = ["u","prev","dist_X41a"]}),DField "_snd" (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = ["u","prev","dist_X41a"]}),DField "dist_X41a" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["dist_X41a"]})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["u","prev","dist_X41a"]}),DFieldAccE (DEdge (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["e"]})) [] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["e"]})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["+","u","prev","dist_X41a","e"]})) (DGenI (DASTData {typeOf = DTypeTerm "(,)" [DTypeTerm "Null" [],DTypeTerm "Int" []], depOf = ["v"]})) [] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","minimum","+","prev","dist_X41a"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","minimum","+","prev","dist_X41a"]}),DDefVar (DVar "newdist_X428" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["min","v","prev","dist_X41a","agg_X432"]})) [] (DFunAp (DFun "min" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "Int" []]], depOf = ["min"]})) [DFieldAcc (DPrev (DVar "v" (DASTData {typeOf = DTypeTerm "Graph" [DTypeTerm "Null" [],DTypeTerm "Int" []], depOf = ["v"]})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = ["v","prev"]})) [DField "data_g1_X422" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "SVal_X419" []], depOf = ["v","prev","dist_X41a"]}),DField "_snd" (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = ["v","prev","dist_X41a"]}),DField "dist_X41a" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["dist_X41a"]})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","prev","dist_X41a"]}),DVExp (DVar "agg_X432" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["agg_X432"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["agg_X432"]})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["min","v","prev","dist_X41a","agg_X432"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["min","v","prev","dist_X41a","agg_X432"]})] (DConsAp (DConstructor "SVal_X419" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "SVal_X419" []], depOf = ["SVal_X419"]})) [DVExp (DVar "newdist_X428" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["newdist_X428"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["newdist_X428"]})] (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = ["SVal_X419","newdist_X428"]})) (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "t29",DTypeTerm "Int" []],DTypeTerm "SVal_X419" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "t29",DTypeTerm "Int" []],DTypeTerm "SVal_X419" []],DTypeTerm "SVal_X419" []]]], depOf = ["minimum","+","dist_X41a","min","SVal_X419"]}),DDefVertComp (DFun "g1_X422_judge" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "tY",DTypeTerm "Int" []],DTypeTerm "SVal_X419" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "tY",DTypeTerm "Int" []],DTypeTerm "SVal_X419" []],DTypeTerm "Bool" []]]], depOf = []})) [DDefVar (DVar "agg_g1_X422" (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) [] (DAggr (DAggAnd (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) (DFunAp (DBinOp "==" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "SVal_X419" [],DTypeTerm "->" [DTypeTerm "SVal_X419" [],DTypeTerm "Bool" []]], depOf = []})) [DFieldAcc (DPrev (DVar "u" (DASTData {typeOf = DTypeTerm "Vertex" [DTypeVar "t43b",DTypeTerm "Int" []], depOf = []})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = []})) [DField "data_g1_X422" (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = []}),DField "_snd" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "SVal_X419" []], depOf = []})] (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = []}),DFieldAcc (DCurr (DVar "u" (DASTData {typeOf = DTypeTerm "Vertex" [DTypeVar "t43b",DTypeTerm "Int" []], depOf = []})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = []})) [DField "data_g1_X422" (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = []}),DField "_snd" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "SVal_X419" []], depOf = []})] (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) (DGenG (DASTData {typeOf = DTypeVar "t43b", depOf = []})) [] (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})] (DFunAp (DBinOp "&&" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Bool" [],DTypeTerm "->" [DTypeTerm "Bool" [],DTypeTerm "Bool" []]], depOf = []})) [DFunAp (DBinOp ">" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "Bool" []]], depOf = []})) [DFieldAcc (DPrev (DVar "v" (DASTData {typeOf = DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []], depOf = []})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = []})) [DField "step_ssspAndMax" (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = []}),DCExp (DCInt 0 (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []}),DVExp (DVar "agg_g1_X422" (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "tY",DTypeTerm "Int" []],DTypeTerm "SVal_X419" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "tY",DTypeTerm "Int" []],DTypeTerm "SVal_X419" []],DTypeTerm "Bool" []]]], depOf = []})),(1,"g2_X423",DDefVertComp (DFun "maxvinit_X420_X434" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "SVal_X419" [],DTypeTerm "Int" []],DTypeTerm "MVal_X41b" []], depOf = ["val","dist_X41a","MVal_X41b"]})) [DDefVar (DVar "var_X439" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","val","dist_X41a"]})) [] (DFieldAcc (DPrev (DVar "v" (DASTData {typeOf = DTypeTerm "Vertex" [DTypeTerm "SVal_X419" [],DTypeTerm "Int" []], depOf = ["v"]})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = ["v","val"]})) [DField "data_g1_X422" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "SVal_X419" []], depOf = ["v","val","dist_X41a"]}),DField "_snd" (DASTData {typeOf = DTypeTerm "SVal_X419" [], depOf = ["v","val","dist_X41a"]}),DField "dist_X41a" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["dist_X41a"]})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","val","dist_X41a"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","val","dist_X41a"]})] (DConsAp (DConstructor "MVal_X41b" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "MVal_X41b" []], depOf = ["MVal_X41b"]})) [DVExp (DVar "var_X439" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["var_X439"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["var_X439"]})] (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = ["MVal_X41b","var_X439"]})) (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "SVal_X419" [],DTypeTerm "Int" []],DTypeTerm "MVal_X41b" []], depOf = ["val","dist_X41a","MVal_X41b"]}),DDefVertComp (DFun "maxvstep_X421_X435" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "SVal_X419" [],DTypeTerm "Int" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "t34",DTypeTerm "Int" []],DTypeTerm "MVal_X41b" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "t34",DTypeTerm "Int" []],DTypeTerm "MVal_X41b" []],DTypeTerm "MVal_X41b" []]]], depOf = ["maximum","mval_X41c","max","MVal_X41b"]})) [DDefVar (DVar "agg_X433" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","maximum","prev","mval_X41c"]})) [] (DAggr (DAggMax (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["maximum"]})) (DFieldAcc (DPrev (DVar "u" (DASTData {typeOf = DTypeTerm "Graph" [DTypeTerm "Null" [],DTypeTerm "Int" []], depOf = ["u"]})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = ["u","prev"]})) [DField "data_g2_X423" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "MVal_X41b" []], depOf = ["u","prev","mval_X41c"]}),DField "_snd" (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = ["u","prev","mval_X41c"]}),DField "mval_X41c" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["mval_X41c"]})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["u","prev","mval_X41c"]})) (DGenI (DASTData {typeOf = DTypeTerm "(,)" [DTypeTerm "SVal_X419" [],DTypeTerm "Int" []], depOf = ["v"]})) [] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","maximum","prev","mval_X41c"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","maximum","prev","mval_X41c"]}),DDefVar (DVar "newmval_X42f" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["max","v","prev","mval_X41c","agg_X433"]})) [] (DFunAp (DFun "max" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "Int" []]], depOf = ["max"]})) [DFieldAcc (DPrev (DVar "v" (DASTData {typeOf = DTypeTerm "Graph" [DTypeTerm "Null" [],DTypeTerm "Int" []], depOf = ["v"]})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = ["v","prev"]})) [DField "data_g2_X423" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "MVal_X41b" []], depOf = ["v","prev","mval_X41c"]}),DField "_snd" (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = ["v","prev","mval_X41c"]}),DField "mval_X41c" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["mval_X41c"]})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["v","prev","mval_X41c"]}),DVExp (DVar "agg_X433" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["agg_X433"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["agg_X433"]})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["max","v","prev","mval_X41c","agg_X433"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["max","v","prev","mval_X41c","agg_X433"]})] (DConsAp (DConstructor "MVal_X41b" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "MVal_X41b" []], depOf = ["MVal_X41b"]})) [DVExp (DVar "newmval_X42f" (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["newmval_X42f"]})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = ["newmval_X42f"]})] (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = ["MVal_X41b","newmval_X42f"]})) (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "SVal_X419" [],DTypeTerm "Int" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "t34",DTypeTerm "Int" []],DTypeTerm "MVal_X41b" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "t34",DTypeTerm "Int" []],DTypeTerm "MVal_X41b" []],DTypeTerm "MVal_X41b" []]]], depOf = ["maximum","mval_X41c","max","MVal_X41b"]}),DDefVertComp (DFun "g2_X423_judge" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "tY",DTypeTerm "Int" []],DTypeTerm "MVal_X41b" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "tY",DTypeTerm "Int" []],DTypeTerm "MVal_X41b" []],DTypeTerm "Bool" []]]], depOf = []})) [DDefVar (DVar "agg_g2_X423" (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) [] (DAggr (DAggAnd (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) (DFunAp (DBinOp "==" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "MVal_X41b" [],DTypeTerm "->" [DTypeTerm "MVal_X41b" [],DTypeTerm "Bool" []]], depOf = []})) [DFieldAcc (DPrev (DVar "u" (DASTData {typeOf = DTypeTerm "Vertex" [DTypeVar "t453",DTypeTerm "Int" []], depOf = []})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = []})) [DField "data_g2_X423" (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = []}),DField "_snd" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "MVal_X41b" []], depOf = []})] (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = []}),DFieldAcc (DCurr (DVar "u" (DASTData {typeOf = DTypeTerm "Vertex" [DTypeVar "t453",DTypeTerm "Int" []], depOf = []})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = []})) [DField "data_g2_X423" (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = []}),DField "_snd" (DASTData {typeOf = DTypeTerm "Pair" [DTypeTerm "Bool" [],DTypeTerm "MVal_X41b" []], depOf = []})] (DASTData {typeOf = DTypeTerm "MVal_X41b" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) (DGenG (DASTData {typeOf = DTypeVar "t453", depOf = []})) [] (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})] (DFunAp (DBinOp "&&" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Bool" [],DTypeTerm "->" [DTypeTerm "Bool" [],DTypeTerm "Bool" []]], depOf = []})) [DFunAp (DBinOp ">" (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "->" [DTypeTerm "Int" [],DTypeTerm "Bool" []]], depOf = []})) [DFieldAcc (DPrev (DVar "v" (DASTData {typeOf = DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []], depOf = []})) (DASTData {typeOf = DTypeTerm "NData_ssspAndMax" [], depOf = []})) [DField "step_ssspAndMax" (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Int" [], depOf = []}),DCExp (DCInt 0 (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})) (DASTData {typeOf = DTypeTerm "Int" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []}),DVExp (DVar "agg_g2_X423" (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})] (DASTData {typeOf = DTypeTerm "Bool" [], depOf = []})) (DASTData {typeOf = DTypeTerm "->" [DTypeTerm "Vertex" [DTypeTerm "Null" [],DTypeTerm "Int" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "tY",DTypeTerm "Int" []],DTypeTerm "MVal_X41b" []],DTypeTerm "->" [DTypeTerm "->" [DTypeTerm "Vertex" [DTypeVar "tY",DTypeTerm "Int" []],DTypeTerm "MVal_X41b" []],DTypeTerm "Bool" []]]], depOf = []}))] [(0,[([],0),([],1)]),(1,[([],1)])] [0] [] -}