fregel-1.2.0: compiler/Convert0.hs

module Convert0 where
import Lexer hiding (main)
import Spec
import Spec0
import Control.Monad.State

type Pos = AlexPosn

v2f (DVar n a) = DFun n a
                                     
convert0 :: DProgramSpec0 Pos -> DProgramSpec Pos
convert0 (DProgramSpec0 rs p a) = DProgramSpec rs (toProg p) a

toProg :: DSmplDef0 Pos -> DProg Pos
toProg (DDefFun0 f [DVar "g" _] ds e a) = DProg (v2f f) (toGroundDefs ds) (toGraphExpr e) a
toProg x = error $ "top-level definition must be a function of the form 'prog g = ...' (at" ++ showPosn (getData x) ++ ")"

-- converting some of functions/variables to graph-level's

toGroundDefs :: [DSmplDef0 Pos] -> [DGroundDef Pos]
toGroundDefs = map toGroundDef

toGroundDef :: DSmplDef0 Pos -> DGroundDef Pos
toGroundDef (DDefFun0 f [DVar "v" _] ds e a)   --- 'f v = ...' is regarded as an initialization func.
  = DGDefVI (DDefVertInit (v2f f) (toSmplDefs ds) (toExpr e) a) a
toGroundDef (DDefVertComp0 f ds e a)           --- f v prev curr is a vertex-compute func.
  = DGDefVC (DDefVertComp (v2f f) (toSmplDefs ds) (toExpr e) a) a
toGroundDef (DDefFun0 f [v] ds e a)            --- if the body consists of graph exprs => regerded as a graph func.
  | isGraphExpr e || isGraphVarDefs ds
  = DGDefGF (DDefGraphFun (v2f f) v (toGraphVarDefs ds) (toGraphExpr e) a) a
toGroundDef (DDefVar0 v [] e a)                --- if the body is a graph expr => regarded as a graph var.
  | isGraphExpr e
  = DGDefGV (DDefGraphVar v (toGraphExpr e) a) a
toGroundDef x = DGDefSmpl (toSmplDef x) (getData x)  -- default

isGraphVarDefs :: [DSmplDef0 Pos] -> Bool
isGraphVarDefs = all isGraphVarDef

isGraphVarDef :: DSmplDef0 Pos -> Bool
isGraphVarDef (DDefVar0 v [] e a)
  | isGraphExpr e
  = True
isGraphVarDef _ = False

toGraphVarDefs :: [DSmplDef0 Pos] -> [DDefGraphVar Pos]
toGraphVarDefs = map toGraphVarDef

toGraphVarDef :: DSmplDef0 Pos -> DDefGraphVar Pos
toGraphVarDef (DDefVar0 v [] e a)
  | isGraphExpr e  -- double-check
  = DDefGraphVar v (toGraphExpr e) a

isGraphExpr :: DExpr0 Pos -> Bool
isGraphExpr (DPregel0 _ _ _ _ _) = True
isGraphExpr (DGMap0 _ _ _) = True
isGraphExpr (DGZip0 _ _ _) = True
isGraphExpr (DGIter0 _ _ _ _ _) = True
isGraphExpr (DVExp0 _ _) = True
isGraphExpr _ = False

toGraphExpr :: DExpr0 Pos -> DGraphExpr Pos
toGraphExpr (DPregel0 i s t g a) = DPregel (v2f i) (v2f s) (toTermination t) (toGVar g) a
toGraphExpr (DGMap0 f g a) = DGMap (v2f f) (toGVar g) a
toGraphExpr (DGZip0 g1 g2 a) = DGZip (toGVar g1) (toGVar g2) a
toGraphExpr (DGIter0 i s t g a) = DGIter (v2f i) (v2f s) (toTermination t) (toGVar g) a
toGraphExpr (DVExp0 v a) = DGVar v a

toGVar :: DVar Pos -> DGraphExpr Pos
toGVar v = DGVar v (getData v)

toTermination :: DTermination0 Pos -> DTermination Pos
toTermination (DTermF0 a) = DTermF a
toTermination (DTermI0 e a) = DTermI (toExpr e) a
toTermination (DTermU0 e a) = DTermU (toExpr e) a
toTermination (DTermV2H0 a) = DTermV2H a

---- the rest is not in the graph-level

toSmplDefs :: [DSmplDef0 Pos] -> [DSmplDef Pos]
toSmplDefs = map toSmplDef

toSmplDef :: DSmplDef0 Pos -> DSmplDef Pos
toSmplDef (DDefFun0 f vs ds e a) = DDefFun (v2f f) vs (toSmplDefs ds) (toExpr e) a
toSmplDef (DDefVar0 v ds e a) = DDefVar v (toSmplDefs ds) (toExpr e) a
toSmplDef (DDefTuple0 vs ds e a) = DDefTuple vs (toSmplDefs ds) (toExpr e) a
toSmplDef (DDefVertComp0 _ _ _ a) = error $ "definition of a vertex-func. is not allowed here (at "++ showPosn a ++")"

toExprs :: [DExpr0 Pos] -> [DExpr Pos]
toExprs = map toExpr

toExpr :: DExpr0 Pos -> DExpr Pos
toExpr (DIf0 e1 e2 e3 a) = DIf (toExpr e1) (toExpr e2) (toExpr e3) a
toExpr (DTuple0 es a) = DTuple (toExprs es) a
toExpr (DFunAp0 f es a) = DFunAp f (toExprs es) a
toExpr (DConsAp0 c es a) = DConsAp c (toExprs es) a
toExpr (DFieldAcc0 t fs a) = DFieldAcc t fs a
toExpr (DFieldAccE0 e fs a) = DFieldAccE e fs a
toExpr (DAggr0 ag e g es a) = DAggr (toAgg ag) (toExpr e) g (toExprs es) a
toExpr (DCheckTerm0 e a) = DCheckTerm (toExpr e) a
toExpr (DVExp0 (DVar "e" b) a) = DFieldAccE (DEdge b) [] a   -- "e" is a special variable to access an edge 
toExpr (DVExp0 v a) = DVExp v a
toExpr (DCExp0 c a) = DCExp c a
toExpr (DPregel0 _ _ _ _ a) = error $ "graph expression is not allowed here (at "++ showPosn a ++")"
toExpr (DGMap0 _ _ a)       = error $ "graph expression is not allowed here (at "++ showPosn a ++")"
toExpr (DGZip0 _ _ a)       = error $ "graph expression is not allowed here (at "++ showPosn a ++")"
toExpr (DGIter0 _ _ _ _ a)  = error $ "graph expression is not allowed here (at "++ showPosn a ++")"

toAgg :: DAgg0 Pos -> DAgg Pos
toAgg (DAggMin0 a) = DAggMin a 
toAgg (DAggMax0 a) = DAggMax a
toAgg (DAggSum0 a) = DAggSum a
toAgg (DAggProd0 a) = DAggProd a
toAgg (DAggAnd0 a) = DAggAnd a
toAgg (DAggOr0 a) = DAggOr a
toAgg (DAggChoice0 e a) = DAggChoice (toExpr e) a
toAgg (DTupledAgg0 ags a) = DTupledAgg (map toAgg ags) a