{-# LANGUAGE LambdaCase #-}

module Jikka.CPlusPlus.Language.VariableAnalysis where

import qualified Data.Set as S
import Jikka.CPlusPlus.Language.Expr

data ReadWriteList = ReadWriteList
  { ReadWriteList -> Set VarName
readList :: S.Set VarName,
    ReadWriteList -> Set VarName
writeList :: S.Set VarName
  }
  deriving (ReadWriteList -> ReadWriteList -> Bool
(ReadWriteList -> ReadWriteList -> Bool)
-> (ReadWriteList -> ReadWriteList -> Bool) -> Eq ReadWriteList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadWriteList -> ReadWriteList -> Bool
$c/= :: ReadWriteList -> ReadWriteList -> Bool
== :: ReadWriteList -> ReadWriteList -> Bool
$c== :: ReadWriteList -> ReadWriteList -> Bool
Eq, Eq ReadWriteList
Eq ReadWriteList
-> (ReadWriteList -> ReadWriteList -> Ordering)
-> (ReadWriteList -> ReadWriteList -> Bool)
-> (ReadWriteList -> ReadWriteList -> Bool)
-> (ReadWriteList -> ReadWriteList -> Bool)
-> (ReadWriteList -> ReadWriteList -> Bool)
-> (ReadWriteList -> ReadWriteList -> ReadWriteList)
-> (ReadWriteList -> ReadWriteList -> ReadWriteList)
-> Ord ReadWriteList
ReadWriteList -> ReadWriteList -> Bool
ReadWriteList -> ReadWriteList -> Ordering
ReadWriteList -> ReadWriteList -> ReadWriteList
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReadWriteList -> ReadWriteList -> ReadWriteList
$cmin :: ReadWriteList -> ReadWriteList -> ReadWriteList
max :: ReadWriteList -> ReadWriteList -> ReadWriteList
$cmax :: ReadWriteList -> ReadWriteList -> ReadWriteList
>= :: ReadWriteList -> ReadWriteList -> Bool
$c>= :: ReadWriteList -> ReadWriteList -> Bool
> :: ReadWriteList -> ReadWriteList -> Bool
$c> :: ReadWriteList -> ReadWriteList -> Bool
<= :: ReadWriteList -> ReadWriteList -> Bool
$c<= :: ReadWriteList -> ReadWriteList -> Bool
< :: ReadWriteList -> ReadWriteList -> Bool
$c< :: ReadWriteList -> ReadWriteList -> Bool
compare :: ReadWriteList -> ReadWriteList -> Ordering
$ccompare :: ReadWriteList -> ReadWriteList -> Ordering
$cp1Ord :: Eq ReadWriteList
Ord, Int -> ReadWriteList -> ShowS
[ReadWriteList] -> ShowS
ReadWriteList -> String
(Int -> ReadWriteList -> ShowS)
-> (ReadWriteList -> String)
-> ([ReadWriteList] -> ShowS)
-> Show ReadWriteList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadWriteList] -> ShowS
$cshowList :: [ReadWriteList] -> ShowS
show :: ReadWriteList -> String
$cshow :: ReadWriteList -> String
showsPrec :: Int -> ReadWriteList -> ShowS
$cshowsPrec :: Int -> ReadWriteList -> ShowS
Show, ReadPrec [ReadWriteList]
ReadPrec ReadWriteList
Int -> ReadS ReadWriteList
ReadS [ReadWriteList]
(Int -> ReadS ReadWriteList)
-> ReadS [ReadWriteList]
-> ReadPrec ReadWriteList
-> ReadPrec [ReadWriteList]
-> Read ReadWriteList
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReadWriteList]
$creadListPrec :: ReadPrec [ReadWriteList]
readPrec :: ReadPrec ReadWriteList
$creadPrec :: ReadPrec ReadWriteList
readList :: ReadS [ReadWriteList]
$creadList :: ReadS [ReadWriteList]
readsPrec :: Int -> ReadS ReadWriteList
$creadsPrec :: Int -> ReadS ReadWriteList
Read)

instance Semigroup ReadWriteList where
  ReadWriteList Set VarName
rs Set VarName
ws <> :: ReadWriteList -> ReadWriteList -> ReadWriteList
<> ReadWriteList Set VarName
rs' Set VarName
ws' = Set VarName -> Set VarName -> ReadWriteList
ReadWriteList (Set VarName
rs Set VarName -> Set VarName -> Set VarName
forall a. Semigroup a => a -> a -> a
<> Set VarName
rs') (Set VarName
ws Set VarName -> Set VarName -> Set VarName
forall a. Semigroup a => a -> a -> a
<> Set VarName
ws')

instance Monoid ReadWriteList where
  mempty :: ReadWriteList
mempty = Set VarName -> Set VarName -> ReadWriteList
ReadWriteList Set VarName
forall a. Set a
S.empty Set VarName
forall a. Set a
S.empty

readVariable :: VarName -> ReadWriteList
readVariable :: VarName -> ReadWriteList
readVariable VarName
x = Set VarName -> Set VarName -> ReadWriteList
ReadWriteList (VarName -> Set VarName
forall a. a -> Set a
S.singleton VarName
x) Set VarName
forall a. Set a
S.empty

writeVariable :: VarName -> ReadWriteList
writeVariable :: VarName -> ReadWriteList
writeVariable VarName
x = Set VarName -> Set VarName -> ReadWriteList
ReadWriteList Set VarName
forall a. Set a
S.empty (VarName -> Set VarName
forall a. a -> Set a
S.singleton VarName
x)

analyzeExpr :: Expr -> ReadWriteList
analyzeExpr :: Expr -> ReadWriteList
analyzeExpr = \case
  Var VarName
x -> VarName -> ReadWriteList
readVariable VarName
x
  Lit Literal
_ -> ReadWriteList
forall a. Monoid a => a
mempty
  UnOp UnaryOp
_ Expr
e -> Expr -> ReadWriteList
analyzeExpr Expr
e
  BinOp BinaryOp
_ Expr
e1 Expr
e2 -> Expr -> ReadWriteList
analyzeExpr Expr
e1 ReadWriteList -> ReadWriteList -> ReadWriteList
forall a. Semigroup a => a -> a -> a
<> Expr -> ReadWriteList
analyzeExpr Expr
e2
  Cond Expr
e1 Expr
e2 Expr
e3 -> Expr -> ReadWriteList
analyzeExpr Expr
e1 ReadWriteList -> ReadWriteList -> ReadWriteList
forall a. Semigroup a => a -> a -> a
<> Expr -> ReadWriteList
analyzeExpr Expr
e2 ReadWriteList -> ReadWriteList -> ReadWriteList
forall a. Semigroup a => a -> a -> a
<> Expr -> ReadWriteList
analyzeExpr Expr
e3
  Lam [(Type, VarName)]
args Type
_ [Statement]
body ->
    let ReadWriteList Set VarName
rs Set VarName
ws = [Statement] -> ReadWriteList
analyzeStatements [Statement]
body
        args' :: Set VarName
args' = [VarName] -> Set VarName
forall a. Ord a => [a] -> Set a
S.fromList (((Type, VarName) -> VarName) -> [(Type, VarName)] -> [VarName]
forall a b. (a -> b) -> [a] -> [b]
map (Type, VarName) -> VarName
forall a b. (a, b) -> b
snd [(Type, VarName)]
args)
     in Set VarName -> Set VarName -> ReadWriteList
ReadWriteList (Set VarName
rs Set VarName -> Set VarName -> Set VarName
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set VarName
args') (Set VarName
ws Set VarName -> Set VarName -> Set VarName
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set VarName
args')
  Call Function
_ [Expr]
args -> [ReadWriteList] -> ReadWriteList
forall a. Monoid a => [a] -> a
mconcat ((Expr -> ReadWriteList) -> [Expr] -> [ReadWriteList]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> ReadWriteList
analyzeExpr [Expr]
args)
  CallExpr Expr
f [Expr]
args -> [ReadWriteList] -> ReadWriteList
forall a. Monoid a => [a] -> a
mconcat ((Expr -> ReadWriteList) -> [Expr] -> [ReadWriteList]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> ReadWriteList
analyzeExpr (Expr
f Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: [Expr]
args))

analyzeLeftExpr :: LeftExpr -> ReadWriteList
analyzeLeftExpr :: LeftExpr -> ReadWriteList
analyzeLeftExpr = \case
  LeftVar VarName
x -> VarName -> ReadWriteList
writeVariable VarName
x
  LeftAt LeftExpr
e1 Expr
e2 -> LeftExpr -> ReadWriteList
analyzeLeftExpr LeftExpr
e1 ReadWriteList -> ReadWriteList -> ReadWriteList
forall a. Semigroup a => a -> a -> a
<> Expr -> ReadWriteList
analyzeExpr Expr
e2
  LeftGet Integer
_ LeftExpr
e -> LeftExpr -> ReadWriteList
analyzeLeftExpr LeftExpr
e

analyzeAssignExpr :: AssignExpr -> ReadWriteList
analyzeAssignExpr :: AssignExpr -> ReadWriteList
analyzeAssignExpr = \case
  AssignExpr AssignOp
_ LeftExpr
e1 Expr
e2 -> LeftExpr -> ReadWriteList
analyzeLeftExpr LeftExpr
e1 ReadWriteList -> ReadWriteList -> ReadWriteList
forall a. Semigroup a => a -> a -> a
<> Expr -> ReadWriteList
analyzeExpr Expr
e2
  AssignIncr LeftExpr
e -> LeftExpr -> ReadWriteList
analyzeLeftExpr LeftExpr
e
  AssignDecr LeftExpr
e -> LeftExpr -> ReadWriteList
analyzeLeftExpr LeftExpr
e

analyzeStatement :: Statement -> ReadWriteList
analyzeStatement :: Statement -> ReadWriteList
analyzeStatement = \case
  ExprStatement Expr
e -> Expr -> ReadWriteList
analyzeExpr Expr
e
  Block [Statement]
body -> [Statement] -> ReadWriteList
analyzeStatements [Statement]
body
  If Expr
e [Statement]
body1 Maybe [Statement]
body2 -> Expr -> ReadWriteList
analyzeExpr Expr
e ReadWriteList -> ReadWriteList -> ReadWriteList
forall a. Semigroup a => a -> a -> a
<> [Statement] -> ReadWriteList
analyzeStatements [Statement]
body1 ReadWriteList -> ReadWriteList -> ReadWriteList
forall a. Semigroup a => a -> a -> a
<> ReadWriteList
-> ([Statement] -> ReadWriteList)
-> Maybe [Statement]
-> ReadWriteList
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadWriteList
forall a. Monoid a => a
mempty [Statement] -> ReadWriteList
analyzeStatements Maybe [Statement]
body2
  For Type
_ VarName
x Expr
init Expr
pred AssignExpr
incr [Statement]
body -> VarName -> ReadWriteList
writeVariable VarName
x ReadWriteList -> ReadWriteList -> ReadWriteList
forall a. Semigroup a => a -> a -> a
<> Expr -> ReadWriteList
analyzeExpr Expr
init ReadWriteList -> ReadWriteList -> ReadWriteList
forall a. Semigroup a => a -> a -> a
<> Expr -> ReadWriteList
analyzeExpr Expr
pred ReadWriteList -> ReadWriteList -> ReadWriteList
forall a. Semigroup a => a -> a -> a
<> AssignExpr -> ReadWriteList
analyzeAssignExpr AssignExpr
incr ReadWriteList -> ReadWriteList -> ReadWriteList
forall a. Semigroup a => a -> a -> a
<> [Statement] -> ReadWriteList
analyzeStatements [Statement]
body
  ForEach Type
_ VarName
x Expr
e [Statement]
body -> VarName -> ReadWriteList
writeVariable VarName
x ReadWriteList -> ReadWriteList -> ReadWriteList
forall a. Semigroup a => a -> a -> a
<> Expr -> ReadWriteList
analyzeExpr Expr
e ReadWriteList -> ReadWriteList -> ReadWriteList
forall a. Semigroup a => a -> a -> a
<> [Statement] -> ReadWriteList
analyzeStatements [Statement]
body
  While Expr
e [Statement]
body -> Expr -> ReadWriteList
analyzeExpr Expr
e ReadWriteList -> ReadWriteList -> ReadWriteList
forall a. Semigroup a => a -> a -> a
<> [Statement] -> ReadWriteList
analyzeStatements [Statement]
body
  Declare Type
_ VarName
x DeclareRight
init ->
    VarName -> ReadWriteList
writeVariable VarName
x ReadWriteList -> ReadWriteList -> ReadWriteList
forall a. Semigroup a => a -> a -> a
<> case DeclareRight
init of
      DeclareRight
DeclareDefault -> ReadWriteList
forall a. Monoid a => a
mempty
      DeclareCopy Expr
e -> Expr -> ReadWriteList
analyzeExpr Expr
e
      DeclareInitialize [Expr]
es -> [ReadWriteList] -> ReadWriteList
forall a. Monoid a => [a] -> a
mconcat ((Expr -> ReadWriteList) -> [Expr] -> [ReadWriteList]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> ReadWriteList
analyzeExpr [Expr]
es)
  DeclareDestructure [VarName]
xs Expr
e -> [ReadWriteList] -> ReadWriteList
forall a. Monoid a => [a] -> a
mconcat ((VarName -> ReadWriteList) -> [VarName] -> [ReadWriteList]
forall a b. (a -> b) -> [a] -> [b]
map VarName -> ReadWriteList
writeVariable [VarName]
xs) ReadWriteList -> ReadWriteList -> ReadWriteList
forall a. Semigroup a => a -> a -> a
<> Expr -> ReadWriteList
analyzeExpr Expr
e
  Assign AssignExpr
e -> AssignExpr -> ReadWriteList
analyzeAssignExpr AssignExpr
e
  Assert Expr
e -> Expr -> ReadWriteList
analyzeExpr Expr
e
  Return Expr
e -> Expr -> ReadWriteList
analyzeExpr Expr
e

analyzeStatements :: [Statement] -> ReadWriteList
analyzeStatements :: [Statement] -> ReadWriteList
analyzeStatements = [ReadWriteList] -> ReadWriteList
forall a. Monoid a => [a] -> a
mconcat ([ReadWriteList] -> ReadWriteList)
-> ([Statement] -> [ReadWriteList]) -> [Statement] -> ReadWriteList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Statement -> ReadWriteList) -> [Statement] -> [ReadWriteList]
forall a b. (a -> b) -> [a] -> [b]
map Statement -> ReadWriteList
analyzeStatement