fregel-1.2.0: sample-programs/scc.fgl

data MA = MA { minv :: Int, active :: Bool } deriving (Eq, Show) 
data C = C { color :: Int } deriving (Eq, Show)
scc g =
  let f_init v = if val v .^ color < 0 then MA (vid v) True else MA (val v.^color) False               ;
      f_fw v prev curr = 
        let c' = (prev v .^ minv) `min` minimum [ prev u.^minv | (e, u) <- is v, prev u .^ active ]
        in if prev v.^ active then MA c' (prev v.^active) else prev v                                 ;
      f_bw v prev curr = 
        let c' = (prev v .^ minv) `min` minimum [ prev u.^minv | (e, u) <- rs v, prev u .^ active ]
        in if prev v .^ active then MA c' (prev v.^active) else prev v                                 ;
      fix_color v = if val v.^_fst.^minv == val v.^_snd.^minv then C (val v.^_fst.^minv) else C (-1) ;
      f0 v = val v ;
      sccInner g = 
        let 
            ga = gmap f_init g               ;  
            gf = fregel f0 f_fw Fix ga ;
            gb = fregel f0 f_bw Fix ga ;
            gfb = gzip gf gb                 ;
            g' = gmap fix_color gfb          
        in g'                                ;
      sccInner0 v = C (-1)
  in giter sccInner0 sccInner Fix g