fregel-1.2.0: compiler/Spec0.hs

{-# LANGUAGE FlexibleContexts,FlexibleInstances,MultiParamTypeClasses,FunctionalDependencies #-}

-- No distinguish between graph-vars/exps and simple-vars/exps

module Spec0 where
import Spec

data DProgramSpec0 a = DProgramSpec0 [DRecordSpec a] (DSmplDef0 a) a deriving (Show, Eq)

data DSmplDef0 a = DDefFun0 (DVar a) [DVar a] [DSmplDef0 a] (DExpr0 a) a
                 | DDefVar0 (DVar a) [DSmplDef0 a] (DExpr0 a) a
                 | DDefTuple0 [DVar a] [DSmplDef0 a] (DExpr0 a) a
                 | DDefVertComp0 (DVar a) [DSmplDef0 a] (DExpr0 a) a
                   deriving (Show, Eq)

data DExpr0 a = DIf0 (DExpr0 a) (DExpr0 a) (DExpr0 a) a
              | DTuple0 [DExpr0 a] a
              | DFunAp0 (DFun a) [DExpr0 a] a
              | DConsAp0 (DConstructor a) [DExpr0 a] a
              | DFieldAcc0 (DTableExpr a) [DField a] a
              | DFieldAccE0 (DEdge a) [DField a] a
              | DAggr0 (DAgg0 a) (DExpr0 a) (DGen a) [DExpr0 a] a
              | DCheckTerm0 (DExpr0 a) a -- Iwasaki: condition for termination
              | DVExp0 (DVar a) a
              | DCExp0 (DConst a) a
              | DPregel0 (DVar a) (DVar a) (DTermination0 a) (DVar a) a -- (DVar a) a
              | DGMap0 (DVar a) (DVar a) a  -- (DVar a) a
              | DGZip0 (DVar a) (DVar a) a --(DVar a) (DVar a) a
              | DGIter0 (DVar a) (DVar a) (DTermination0 a) (DVar a) a -- (DVar a) a
             deriving (Show, Eq)

data DTermination0 a = DTermF0 a
                     | DTermI0 (DExpr0 a) a
                     | DTermU0 (DExpr0 a) a
                     | DTermV2H0 a           -- for internal use
                      deriving (Show, Eq)

data DAgg0 a = DAggMin0 a
             | DAggMax0 a
             | DAggSum0 a
             | DAggProd0 a
             | DAggAnd0 a
             | DAggOr0 a
             | DAggChoice0 (DExpr0 a) a  -- random choice with default value
             | DTupledAgg0 [DAgg0 a] a   -- for internal use
              deriving (Show, Eq)


instance DAdditionalData (DProgramSpec0 a) a where
    getData (DProgramSpec0 _ _ a) = a
    setData b (DProgramSpec0 rs p _) = DProgramSpec0 rs p b

instance DAdditionalData2 (DProgramSpec0 a) a c (DProgramSpec0 c) where
    mapData f (DProgramSpec0 rs p a) = DProgramSpec0 (mmapData f rs) (mapData f p) (f a)

instance DAdditionalData (DSmplDef0 a) a where
    getData (DDefFun0 _ _ _ _ a) = a
    getData (DDefVar0 _ _ _ a) = a
    getData (DDefTuple0 _ _ _ a) = a
    getData (DDefVertComp0 _ _ _ a) = a
    setData b (DDefFun0 f vs ds e _) = DDefFun0 f vs ds e b
    setData b (DDefVar0 v ds e _) = DDefVar0 v ds e b
    setData b (DDefTuple0 vs ds e _) = DDefTuple0 vs ds e b
    setData b (DDefVertComp0 f ds e _) = DDefVertComp0 f ds e b

instance DAdditionalData2 (DSmplDef0 a) a c (DSmplDef0 c) where
    mapData f (DDefFun0 f' vs ds e a) = DDefFun0 (mapData f f') (mmapData f vs) (mmapData f ds) (mapData f e) (f a)
    mapData f (DDefVar0 v ds e a) = DDefVar0 (mapData f v) (mmapData f ds) (mapData f e) (f a)
    mapData f (DDefTuple0 vs ds e a) = DDefTuple0 (mmapData f vs) (mmapData f ds) (mapData f e) (f a)
    mapData f (DDefVertComp0 f' ds e a) = DDefVertComp0 (mapData f f') (mmapData f ds) (mapData f e) (f a)

instance DAdditionalData (DExpr0 a) a where
    getData (DIf0 _ _ _ a) = a
    getData (DTuple0 _ a) = a
    getData (DFunAp0 _ _ a) = a
    getData (DConsAp0 _ _ a) = a
    getData (DFieldAcc0 _ _ a) = a
    getData (DFieldAccE0 _ _ a) = a
    getData (DAggr0 _ _ _ _ a) = a
    getData (DVExp0 _ a) = a
    getData (DCExp0 _ a) = a
    getData (DPregel0 _ _ _ _ a) = a
    getData (DGMap0 _ _ a) = a
    getData (DGZip0 _ _ a) = a
    getData (DGIter0 _ _ _ _ a) = a
    setData b (DIf0 p t e _) = DIf0 p t e b
    setData b (DTuple0 es _) = DTuple0 es b
    setData b (DFunAp0 f es _) = DFunAp0 f es b
    setData b (DConsAp0 c es _) = DConsAp0 c es b
    setData b (DFieldAcc0 t fs _) = DFieldAcc0 t fs b
    setData b (DFieldAccE0 e fs _) = DFieldAccE0 e fs b
    setData b (DAggr0 a e g es _) = DAggr0 a e g es b
    setData b (DVExp0 v _) = DVExp0 v b
    setData b (DCExp0 v _) = DCExp0 v b
    setData b (DPregel0 f0 ft x g _) = DPregel0 f0 ft x g b
    setData b (DGMap0 f g _) = DGMap0 f g b
    setData b (DGZip0 g1 g2 _) = DGZip0 g1 g2 b
    setData b (DGIter0 f0 ft x g _) = DGIter0 f0 ft x g b

instance DAdditionalData2 (DExpr0 a) a c (DExpr0 c) where
    mapData f (DIf0 p t e a) = DIf0 (mapData f p) (mapData f t) (mapData f e) (f a)
    mapData f (DTuple0 es a) = DTuple0 (mmapData f es) (f a)
    mapData f (DFunAp0 f' es a) = DFunAp0 (mapData f f') (mmapData f es) (f a)
    mapData f (DConsAp0 c es a) = DConsAp0 (mapData f c) (mmapData f es) (f a)
    mapData f (DFieldAcc0 t fs a) = DFieldAcc0 (mapData f t) (mmapData f fs) (f a)
    mapData f (DFieldAccE0 e fs a) = DFieldAccE0 (mapData f e) (mmapData f fs) (f a)
    mapData f (DAggr0 a' e g es a) = DAggr0 (mapData f a') (mapData f e) (mapData f g) (mmapData f es) (f a)
    mapData f (DVExp0 v a) = DVExp0 (mapData f v) (f a)
    mapData f (DCExp0 v a) = DCExp0 (mapData f v) (f a)
    mapData f (DPregel0 f0 ft x g a) = DPregel0 (mapData f f0) (mapData f ft) (mapData f x) (mapData f g) (f a)
    mapData f (DGMap0 f' g a) = DGMap0 (mapData f f') (mapData f g) (f a)
    mapData f (DGZip0 g1 g2 a) = DGZip0 (mapData f g1) (mapData f g2) (f a)
    mapData f (DGIter0 f0 ft x g a) = DGIter0 (mapData f f0) (mapData f ft) (mapData f x) (mapData f g) (f a)

instance DAdditionalData (DTermination0 a) a where
    getData (DTermF0 a) = a
    getData (DTermI0 _ a) = a
    getData (DTermU0 _ a) = a
    getData (DTermV2H0 a) = a
    setData b (DTermF0 _) = DTermF0 b
    setData b (DTermI0 e _) = DTermI0 e b
    setData b (DTermU0 e _) = DTermU0 e b
    setData b (DTermV2H0 _) = DTermV2H0 b

instance DAdditionalData2 (DTermination0 a) a c (DTermination0 c) where
    mapData f (DTermF0 a) = DTermF0 (f a)
    mapData f (DTermI0 e a) = DTermI0 (mapData f e) (f a)
    mapData f (DTermU0 e a) = DTermU0 (mapData f e) (f a)
    mapData f (DTermV2H0 a) = DTermV2H0 (f a)

instance DAdditionalData (DAgg0 a) a where
    getData (DAggMin0 a) = a
    getData (DAggMax0 a) = a
    getData (DAggSum0 a) = a
    getData (DAggProd0 a) = a
    getData (DAggAnd0 a) = a
    getData (DAggOr0 a) = a
    getData (DAggChoice0 x a) = a
    getData (DTupledAgg0 _ a) = a
    setData b (DAggMin0 _) = DAggMin0 b
    setData b (DAggMax0 _) = DAggMax0 b
    setData b (DAggSum0 _) = DAggSum0 b
    setData b (DAggProd0 _) = DAggProd0 b
    setData b (DAggAnd0 _) = DAggAnd0 b
    setData b (DAggOr0 _) = DAggOr0 b
    setData b (DAggChoice0 x _) = DAggChoice0 x b
    setData b (DTupledAgg0 ags _) = DTupledAgg0 ags b

instance DAdditionalData2 (DAgg0 a) a c (DAgg0 c) where
    mapData f (DAggMin0 a) = DAggMin0 (f a)
    mapData f (DAggMax0 a) = DAggMax0 (f a)
    mapData f (DAggSum0 a) = DAggSum0 (f a)
    mapData f (DAggProd0 a) = DAggProd0 (f a)
    mapData f (DAggAnd0 a) = DAggAnd0 (f a)
    mapData f (DAggOr0 a) = DAggOr0 (f a)
    mapData f (DAggChoice0 x a) = DAggChoice0 (mapData f x) (f a)
    mapData f (DTupledAgg0 ags a) = DTupledAgg0 (mmapData f ags) (f a)

ppSmplDef0 :: DSmplDef0 a -> [String]
ppSmplDef0 (DDefFun0 f vs ds e _) =
  if length ds == 0
  then header ++ indent (ppExpr0 e)
  else header ++ indent (let_in (concat $ insList ";" "" $map ppSmplDef0 ds) (ppExpr0 e))
  where header = [ ppVar f ++ " " ++ ppList " " (map ppVar vs) ++ " = " ]
ppSmplDef0 (DDefVar0 v ds e _) = 
  if length ds == 0
  then header ++ indent (ppExpr0 e)
  else header ++ indent (let_in (concat $ insList ";" "" $map ppSmplDef0 ds) (ppExpr0 e))
  where header = [ ppVar v ++ " = "]
ppSmplDef0 (DDefTuple0 vs ds e _) = 
  if length ds == 0
  then header ++ indent (ppExpr0 e)
  else header ++ indent (let_in (concat $ insList ";" "" $map ppSmplDef0 ds) (ppExpr0 e))
  where header = ["(" ++ ppList ", " (map ppVar vs) ++ ") = "]
ppSmplDef0 (DDefVertComp0 f ds e _) =
  if length ds == 0 then indentWith (ppVar f ++ " v prev curr = ") (ppExpr0 e)
  else [ppVar f ++" v prev curr = "] ++ indent (let_in (concat $ insList ";" "" $map ppSmplDef0 ds) (ppExpr0 e))

ppExpr0 :: DExpr0 a-> [String]
ppExpr0 (DIf0 c t e _) = indentWith "if " (ppExpr0 c) ++
                         indentWith "then " (ppExpr0 t) ++
                         indentWith "else " (ppExpr0 e)
ppExpr0 (DTuple0 es _) = indentWith "(" (concat $ insList "," ")" $ map ppExpr0 es)
ppExpr0 (DFunAp0 (DBinOp o _) (e1:e2:[]) _) = [flatE0 e1 ++ " " ++ o ++ " " ++ flatE0 e2]
ppExpr0 (DFunAp0 f es _) = [ppList " " (ppFun f: map flatE0 es)]
ppExpr0 (DConsAp0 c es _) = [ppList " " (ppConstructor c: map flatE0 es)]
ppExpr0 (DFieldAcc0 e fs _) = [ ppTableExpr e ++ (concat $ map ((".^"++).ppField) fs) ]
ppExpr0 (DFieldAccE0 e fs _) = [ ppEdge e ++ (concat $ map ((".^"++).ppField) fs) ]
ppExpr0 (DAggr0 a e g es _) =
  [ppAgg0 a ++ " [ " ++ flatE20 e ++  " | " ++ ppGen g ++ ps ++ " ] "]
  where ps = if length es == 0 then ""
             else "," ++ ppList "," (map flatE0 es)
ppExpr0 (DVExp0 v _) = [ppVar v]
ppExpr0 (DCExp0 c _) = [ppConst c]
ppExpr0 (DPregel0 f0 ft t g _) =
  [ppList " " (["fregel", ppVar f0, ppVar ft, ppTermination0 t] ++ [ppVar g])]
ppExpr0 (DGMap0 f g _) =
  [ppList " " (["gmap", ppVar f] ++ [ppVar g])]
ppExpr0 (DGZip0 g1 g2 _) =
  [ppList " " (["gzip"] ++ [ppVar g1] ++ [ppVar g2])]
ppExpr0 (DGIter0 f0 ft t g _) =
  [ppList " " (["giter", ppVar f0, ppVar ft, ppTermination0 t] ++ [ppVar g])]

ppTermination0 :: DTermination0 a -> String
ppTermination0 (DTermF0 _)= "Fix"
ppTermination0 (DTermI0 e _) = "(Iter (" ++ ppList " " (ppExpr0 e) ++ "))"
ppTermination0 (DTermU0 e _) = "(Until (\\g->" ++ ppList " " (ppExpr0 e) ++ "))"
ppTermination0 (DTermV2H0 _) = "V2H"

ppAgg0 (DAggMin0 _)  = "minimum"
ppAgg0 (DAggMax0 _)  = "maximum"
ppAgg0 (DAggSum0 _)  = "sum"
ppAgg0 (DAggProd0 _) = "prod"
ppAgg0 (DAggAnd0 _)  = "and"
ppAgg0 (DAggOr0 _)   = "or"
ppAgg0 (DAggChoice0 x _) = "random " ++ flatE0 x

flatE0 :: DExpr0 a -> String
flatE0 = enclose . ppList " " . ppExpr0

flatE20 :: DExpr0 a -> String
flatE20 = ppList " " . ppExpr0

ppAST0 :: DProgramSpec0 a -> String
ppAST0 = unlines . ppProgramSpec0

ppProgramSpec0 :: DProgramSpec0 a -> [String]
ppProgramSpec0 (DProgramSpec0 rs p _) =
  (concatMap ppRecordSpec rs) ++ ppSmplDef0 p