{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-}
module ShellCheck.CFG (
CFNode (..),
CFEdge (..),
CFEffect (..),
CFStringPart (..),
CFVariableProp (..),
CFGResult (..),
CFValue (..),
CFGraph,
CFGParameters (..),
IdTagged (..),
Scope (..),
buildGraph
, ShellCheck.CFG.runTests
)
where
import GHC.Generics (Generic)
import ShellCheck.AST
import ShellCheck.ASTLib
import ShellCheck.Data
import ShellCheck.Interface
import ShellCheck.Prelude
import ShellCheck.Regex
import Control.DeepSeq
import Control.Monad
import Control.Monad.Identity
import Data.Array.Unboxed
import Data.Array.ST
import Data.List hiding (map)
import Data.Maybe
import qualified Data.Map as M
import qualified Data.Set as S
import Control.Monad.RWS.Lazy
import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.Query.DFS
import Data.Graph.Inductive.Basic
import Data.Graph.Inductive.Query.Dominators
import Data.Graph.Inductive.PatriciaTree as G
import Debug.Trace
import Test.QuickCheck.All (forAllProperties)
import Test.QuickCheck.Test (quickCheckWithResult, stdArgs, maxSuccess)
type CFGraph = G.Gr CFNode CFEdge
data CFNode =
CFStructuralNode
| CFEntryPoint String
| CFDropPrefixAssignments
| CFApplyEffects [IdTagged CFEffect]
| CFExecuteCommand (Maybe String)
| CFExecuteSubshell String Node Node
| CFSetExitCode Id
| CFImpliedExit
| CFResolvedExit
| CFUnresolvedExit
| CFUnreachable
| CFSetBackgroundPid Id
deriving (CFNode -> CFNode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CFNode -> CFNode -> Bool
$c/= :: CFNode -> CFNode -> Bool
== :: CFNode -> CFNode -> Bool
$c== :: CFNode -> CFNode -> Bool
Eq, Eq CFNode
CFNode -> CFNode -> Bool
CFNode -> CFNode -> Ordering
CFNode -> CFNode -> CFNode
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 :: CFNode -> CFNode -> CFNode
$cmin :: CFNode -> CFNode -> CFNode
max :: CFNode -> CFNode -> CFNode
$cmax :: CFNode -> CFNode -> CFNode
>= :: CFNode -> CFNode -> Bool
$c>= :: CFNode -> CFNode -> Bool
> :: CFNode -> CFNode -> Bool
$c> :: CFNode -> CFNode -> Bool
<= :: CFNode -> CFNode -> Bool
$c<= :: CFNode -> CFNode -> Bool
< :: CFNode -> CFNode -> Bool
$c< :: CFNode -> CFNode -> Bool
compare :: CFNode -> CFNode -> Ordering
$ccompare :: CFNode -> CFNode -> Ordering
Ord, Node -> CFNode -> ShowS
[CFNode] -> ShowS
CFNode -> String
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CFNode] -> ShowS
$cshowList :: [CFNode] -> ShowS
show :: CFNode -> String
$cshow :: CFNode -> String
showsPrec :: Node -> CFNode -> ShowS
$cshowsPrec :: Node -> CFNode -> ShowS
Show, forall x. Rep CFNode x -> CFNode
forall x. CFNode -> Rep CFNode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CFNode x -> CFNode
$cfrom :: forall x. CFNode -> Rep CFNode x
Generic, CFNode -> ()
forall a. (a -> ()) -> NFData a
rnf :: CFNode -> ()
$crnf :: CFNode -> ()
NFData)
data CFEdge =
CFEErrExit
| CFEFlow
| CFEFalseFlow
| CFEExit
deriving (CFEdge -> CFEdge -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CFEdge -> CFEdge -> Bool
$c/= :: CFEdge -> CFEdge -> Bool
== :: CFEdge -> CFEdge -> Bool
$c== :: CFEdge -> CFEdge -> Bool
Eq, Eq CFEdge
CFEdge -> CFEdge -> Bool
CFEdge -> CFEdge -> Ordering
CFEdge -> CFEdge -> CFEdge
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 :: CFEdge -> CFEdge -> CFEdge
$cmin :: CFEdge -> CFEdge -> CFEdge
max :: CFEdge -> CFEdge -> CFEdge
$cmax :: CFEdge -> CFEdge -> CFEdge
>= :: CFEdge -> CFEdge -> Bool
$c>= :: CFEdge -> CFEdge -> Bool
> :: CFEdge -> CFEdge -> Bool
$c> :: CFEdge -> CFEdge -> Bool
<= :: CFEdge -> CFEdge -> Bool
$c<= :: CFEdge -> CFEdge -> Bool
< :: CFEdge -> CFEdge -> Bool
$c< :: CFEdge -> CFEdge -> Bool
compare :: CFEdge -> CFEdge -> Ordering
$ccompare :: CFEdge -> CFEdge -> Ordering
Ord, Node -> CFEdge -> ShowS
[CFEdge] -> ShowS
CFEdge -> String
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CFEdge] -> ShowS
$cshowList :: [CFEdge] -> ShowS
show :: CFEdge -> String
$cshow :: CFEdge -> String
showsPrec :: Node -> CFEdge -> ShowS
$cshowsPrec :: Node -> CFEdge -> ShowS
Show, forall x. Rep CFEdge x -> CFEdge
forall x. CFEdge -> Rep CFEdge x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CFEdge x -> CFEdge
$cfrom :: forall x. CFEdge -> Rep CFEdge x
Generic, CFEdge -> ()
forall a. (a -> ()) -> NFData a
rnf :: CFEdge -> ()
$crnf :: CFEdge -> ()
NFData)
data CFEffect =
CFSetProps Scope String (S.Set CFVariableProp)
| CFUnsetProps Scope String (S.Set CFVariableProp)
| CFReadVariable String
| CFWriteVariable String CFValue
| CFWriteGlobal String CFValue
| CFWriteLocal String CFValue
| CFWritePrefix String CFValue
| CFDefineFunction String Id Node Node
| CFUndefine String
| CFUndefineVariable String
| CFUndefineFunction String
| CFUndefineNameref String
| CFHintArray String
| CFHintDefined String
deriving (CFEffect -> CFEffect -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CFEffect -> CFEffect -> Bool
$c/= :: CFEffect -> CFEffect -> Bool
== :: CFEffect -> CFEffect -> Bool
$c== :: CFEffect -> CFEffect -> Bool
Eq, Eq CFEffect
CFEffect -> CFEffect -> Bool
CFEffect -> CFEffect -> Ordering
CFEffect -> CFEffect -> CFEffect
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 :: CFEffect -> CFEffect -> CFEffect
$cmin :: CFEffect -> CFEffect -> CFEffect
max :: CFEffect -> CFEffect -> CFEffect
$cmax :: CFEffect -> CFEffect -> CFEffect
>= :: CFEffect -> CFEffect -> Bool
$c>= :: CFEffect -> CFEffect -> Bool
> :: CFEffect -> CFEffect -> Bool
$c> :: CFEffect -> CFEffect -> Bool
<= :: CFEffect -> CFEffect -> Bool
$c<= :: CFEffect -> CFEffect -> Bool
< :: CFEffect -> CFEffect -> Bool
$c< :: CFEffect -> CFEffect -> Bool
compare :: CFEffect -> CFEffect -> Ordering
$ccompare :: CFEffect -> CFEffect -> Ordering
Ord, Node -> CFEffect -> ShowS
[CFEffect] -> ShowS
CFEffect -> String
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CFEffect] -> ShowS
$cshowList :: [CFEffect] -> ShowS
show :: CFEffect -> String
$cshow :: CFEffect -> String
showsPrec :: Node -> CFEffect -> ShowS
$cshowsPrec :: Node -> CFEffect -> ShowS
Show, forall x. Rep CFEffect x -> CFEffect
forall x. CFEffect -> Rep CFEffect x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CFEffect x -> CFEffect
$cfrom :: forall x. CFEffect -> Rep CFEffect x
Generic, CFEffect -> ()
forall a. (a -> ()) -> NFData a
rnf :: CFEffect -> ()
$crnf :: CFEffect -> ()
NFData)
data IdTagged a = IdTagged Id a
deriving (IdTagged a -> IdTagged a -> Bool
forall a. Eq a => IdTagged a -> IdTagged a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdTagged a -> IdTagged a -> Bool
$c/= :: forall a. Eq a => IdTagged a -> IdTagged a -> Bool
== :: IdTagged a -> IdTagged a -> Bool
$c== :: forall a. Eq a => IdTagged a -> IdTagged a -> Bool
Eq, IdTagged a -> IdTagged a -> Bool
IdTagged a -> IdTagged a -> Ordering
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
forall {a}. Ord a => Eq (IdTagged a)
forall a. Ord a => IdTagged a -> IdTagged a -> Bool
forall a. Ord a => IdTagged a -> IdTagged a -> Ordering
forall a. Ord a => IdTagged a -> IdTagged a -> IdTagged a
min :: IdTagged a -> IdTagged a -> IdTagged a
$cmin :: forall a. Ord a => IdTagged a -> IdTagged a -> IdTagged a
max :: IdTagged a -> IdTagged a -> IdTagged a
$cmax :: forall a. Ord a => IdTagged a -> IdTagged a -> IdTagged a
>= :: IdTagged a -> IdTagged a -> Bool
$c>= :: forall a. Ord a => IdTagged a -> IdTagged a -> Bool
> :: IdTagged a -> IdTagged a -> Bool
$c> :: forall a. Ord a => IdTagged a -> IdTagged a -> Bool
<= :: IdTagged a -> IdTagged a -> Bool
$c<= :: forall a. Ord a => IdTagged a -> IdTagged a -> Bool
< :: IdTagged a -> IdTagged a -> Bool
$c< :: forall a. Ord a => IdTagged a -> IdTagged a -> Bool
compare :: IdTagged a -> IdTagged a -> Ordering
$ccompare :: forall a. Ord a => IdTagged a -> IdTagged a -> Ordering
Ord, Node -> IdTagged a -> ShowS
forall a. Show a => Node -> IdTagged a -> ShowS
forall a. Show a => [IdTagged a] -> ShowS
forall a. Show a => IdTagged a -> String
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdTagged a] -> ShowS
$cshowList :: forall a. Show a => [IdTagged a] -> ShowS
show :: IdTagged a -> String
$cshow :: forall a. Show a => IdTagged a -> String
showsPrec :: Node -> IdTagged a -> ShowS
$cshowsPrec :: forall a. Show a => Node -> IdTagged a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (IdTagged a) x -> IdTagged a
forall a x. IdTagged a -> Rep (IdTagged a) x
$cto :: forall a x. Rep (IdTagged a) x -> IdTagged a
$cfrom :: forall a x. IdTagged a -> Rep (IdTagged a) x
Generic, forall a. NFData a => IdTagged a -> ()
forall a. (a -> ()) -> NFData a
rnf :: IdTagged a -> ()
$crnf :: forall a. NFData a => IdTagged a -> ()
NFData)
data CFValue =
CFValueUninitialized
| CFValueArray
| CFValueString
| CFValueInteger
| CFValueComputed Id [CFStringPart]
deriving (CFValue -> CFValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CFValue -> CFValue -> Bool
$c/= :: CFValue -> CFValue -> Bool
== :: CFValue -> CFValue -> Bool
$c== :: CFValue -> CFValue -> Bool
Eq, Eq CFValue
CFValue -> CFValue -> Bool
CFValue -> CFValue -> Ordering
CFValue -> CFValue -> CFValue
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 :: CFValue -> CFValue -> CFValue
$cmin :: CFValue -> CFValue -> CFValue
max :: CFValue -> CFValue -> CFValue
$cmax :: CFValue -> CFValue -> CFValue
>= :: CFValue -> CFValue -> Bool
$c>= :: CFValue -> CFValue -> Bool
> :: CFValue -> CFValue -> Bool
$c> :: CFValue -> CFValue -> Bool
<= :: CFValue -> CFValue -> Bool
$c<= :: CFValue -> CFValue -> Bool
< :: CFValue -> CFValue -> Bool
$c< :: CFValue -> CFValue -> Bool
compare :: CFValue -> CFValue -> Ordering
$ccompare :: CFValue -> CFValue -> Ordering
Ord, Node -> CFValue -> ShowS
[CFValue] -> ShowS
CFValue -> String
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CFValue] -> ShowS
$cshowList :: [CFValue] -> ShowS
show :: CFValue -> String
$cshow :: CFValue -> String
showsPrec :: Node -> CFValue -> ShowS
$cshowsPrec :: Node -> CFValue -> ShowS
Show, forall x. Rep CFValue x -> CFValue
forall x. CFValue -> Rep CFValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CFValue x -> CFValue
$cfrom :: forall x. CFValue -> Rep CFValue x
Generic, CFValue -> ()
forall a. (a -> ()) -> NFData a
rnf :: CFValue -> ()
$crnf :: CFValue -> ()
NFData)
data CFStringPart =
CFStringLiteral String
| CFStringVariable String
| CFStringInteger
| CFStringUnknown
deriving (CFStringPart -> CFStringPart -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CFStringPart -> CFStringPart -> Bool
$c/= :: CFStringPart -> CFStringPart -> Bool
== :: CFStringPart -> CFStringPart -> Bool
$c== :: CFStringPart -> CFStringPart -> Bool
Eq, Eq CFStringPart
CFStringPart -> CFStringPart -> Bool
CFStringPart -> CFStringPart -> Ordering
CFStringPart -> CFStringPart -> CFStringPart
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 :: CFStringPart -> CFStringPart -> CFStringPart
$cmin :: CFStringPart -> CFStringPart -> CFStringPart
max :: CFStringPart -> CFStringPart -> CFStringPart
$cmax :: CFStringPart -> CFStringPart -> CFStringPart
>= :: CFStringPart -> CFStringPart -> Bool
$c>= :: CFStringPart -> CFStringPart -> Bool
> :: CFStringPart -> CFStringPart -> Bool
$c> :: CFStringPart -> CFStringPart -> Bool
<= :: CFStringPart -> CFStringPart -> Bool
$c<= :: CFStringPart -> CFStringPart -> Bool
< :: CFStringPart -> CFStringPart -> Bool
$c< :: CFStringPart -> CFStringPart -> Bool
compare :: CFStringPart -> CFStringPart -> Ordering
$ccompare :: CFStringPart -> CFStringPart -> Ordering
Ord, Node -> CFStringPart -> ShowS
[CFStringPart] -> ShowS
CFStringPart -> String
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CFStringPart] -> ShowS
$cshowList :: [CFStringPart] -> ShowS
show :: CFStringPart -> String
$cshow :: CFStringPart -> String
showsPrec :: Node -> CFStringPart -> ShowS
$cshowsPrec :: Node -> CFStringPart -> ShowS
Show, forall x. Rep CFStringPart x -> CFStringPart
forall x. CFStringPart -> Rep CFStringPart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CFStringPart x -> CFStringPart
$cfrom :: forall x. CFStringPart -> Rep CFStringPart x
Generic, CFStringPart -> ()
forall a. (a -> ()) -> NFData a
rnf :: CFStringPart -> ()
$crnf :: CFStringPart -> ()
NFData)
data CFVariableProp = CFVPExport | CFVPArray | CFVPAssociative | CFVPInteger
deriving (CFVariableProp -> CFVariableProp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CFVariableProp -> CFVariableProp -> Bool
$c/= :: CFVariableProp -> CFVariableProp -> Bool
== :: CFVariableProp -> CFVariableProp -> Bool
$c== :: CFVariableProp -> CFVariableProp -> Bool
Eq, Eq CFVariableProp
CFVariableProp -> CFVariableProp -> Bool
CFVariableProp -> CFVariableProp -> Ordering
CFVariableProp -> CFVariableProp -> CFVariableProp
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 :: CFVariableProp -> CFVariableProp -> CFVariableProp
$cmin :: CFVariableProp -> CFVariableProp -> CFVariableProp
max :: CFVariableProp -> CFVariableProp -> CFVariableProp
$cmax :: CFVariableProp -> CFVariableProp -> CFVariableProp
>= :: CFVariableProp -> CFVariableProp -> Bool
$c>= :: CFVariableProp -> CFVariableProp -> Bool
> :: CFVariableProp -> CFVariableProp -> Bool
$c> :: CFVariableProp -> CFVariableProp -> Bool
<= :: CFVariableProp -> CFVariableProp -> Bool
$c<= :: CFVariableProp -> CFVariableProp -> Bool
< :: CFVariableProp -> CFVariableProp -> Bool
$c< :: CFVariableProp -> CFVariableProp -> Bool
compare :: CFVariableProp -> CFVariableProp -> Ordering
$ccompare :: CFVariableProp -> CFVariableProp -> Ordering
Ord, Node -> CFVariableProp -> ShowS
[CFVariableProp] -> ShowS
CFVariableProp -> String
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CFVariableProp] -> ShowS
$cshowList :: [CFVariableProp] -> ShowS
show :: CFVariableProp -> String
$cshow :: CFVariableProp -> String
showsPrec :: Node -> CFVariableProp -> ShowS
$cshowsPrec :: Node -> CFVariableProp -> ShowS
Show, forall x. Rep CFVariableProp x -> CFVariableProp
forall x. CFVariableProp -> Rep CFVariableProp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CFVariableProp x -> CFVariableProp
$cfrom :: forall x. CFVariableProp -> Rep CFVariableProp x
Generic, CFVariableProp -> ()
forall a. (a -> ()) -> NFData a
rnf :: CFVariableProp -> ()
$crnf :: CFVariableProp -> ()
NFData)
data CFGParameters = CFGParameters {
CFGParameters -> Bool
cfLastpipe :: Bool,
CFGParameters -> Bool
cfPipefail :: Bool
}
data CFGResult = CFGResult {
CFGResult -> CFGraph
cfGraph :: CFGraph,
CFGResult -> Map Id (Node, Node)
cfIdToRange :: M.Map Id (Node, Node),
CFGResult -> Map Id (Set Node)
cfIdToNodes :: M.Map Id (S.Set Node),
CFGResult -> Array Node [Node]
cfPostDominators :: Array Node [Node]
}
deriving (Node -> CFGResult -> ShowS
[CFGResult] -> ShowS
CFGResult -> String
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CFGResult] -> ShowS
$cshowList :: [CFGResult] -> ShowS
show :: CFGResult -> String
$cshow :: CFGResult -> String
showsPrec :: Node -> CFGResult -> ShowS
$cshowsPrec :: Node -> CFGResult -> ShowS
Show)
buildGraph :: CFGParameters -> Token -> CFGResult
buildGraph :: CFGParameters -> Token -> CFGResult
buildGraph CFGParameters
params Token
root =
let
(Node
nextNode, ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
base) = forall r w s a. RWS r w s a -> r -> s -> (s, w)
execRWS (Token -> CFM Range
buildRoot Token
root) (CFGParameters -> CFContext
newCFContext CFGParameters
params) Node
0
([LNode CFNode]
nodes, [LEdge CFEdge]
edges, [(Id, (Node, Node))]
mapping, [(Id, Node)]
association) =
([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
-> ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
removeUnnecessaryStructuralNodes
([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
base
idToRange :: Map Id (Node, Node)
idToRange = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Id, (Node, Node))]
mapping
isRealEdge :: (a, b, CFEdge) -> Bool
isRealEdge (a
from, b
to, CFEdge
edge) = case CFEdge
edge of CFEdge
CFEFlow -> Bool
True; CFEdge
_ -> Bool
False
onlyRealEdges :: [LEdge CFEdge]
onlyRealEdges = forall a. (a -> Bool) -> [a] -> [a]
filter forall {a} {b}. (a, b, CFEdge) -> Bool
isRealEdge [LEdge CFEdge]
edges
(Node
_, Node
mainExit) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Token -> Id
getId Token
root) Map Id (Node, Node)
idToRange
result :: CFGResult
result = CFGResult {
cfGraph :: CFGraph
cfGraph = forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [LNode CFNode]
nodes [LEdge CFEdge]
edges,
cfIdToRange :: Map Id (Node, Node)
cfIdToRange = Map Id (Node, Node)
idToRange,
cfIdToNodes :: Map Id (Set Node)
cfIdToNodes = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall a. Ord a => Set a -> Set a -> Set a
S.union forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Id
id, Node
n) -> (Id
id, forall a. a -> Set a
S.singleton Node
n)) [(Id, Node)]
association,
cfPostDominators :: Array Node [Node]
cfPostDominators = Node -> CFGraph -> Array Node [Node]
findPostDominators Node
mainExit forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [LNode CFNode]
nodes [LEdge CFEdge]
onlyRealEdges
}
in
CFGResult
result
remapGraph :: M.Map Node Node -> CFW -> CFW
remapGraph :: Map Node Node
-> ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
-> ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
remapGraph Map Node Node
remap ([LNode CFNode]
nodes, [LEdge CFEdge]
edges, [(Id, (Node, Node))]
mapping, [(Id, Node)]
assoc) =
(
forall a b. (a -> b) -> [a] -> [b]
map (Map Node Node -> LNode CFNode -> LNode CFNode
remapNode Map Node Node
remap) [LNode CFNode]
nodes,
forall a b. (a -> b) -> [a] -> [b]
map (Map Node Node -> LEdge CFEdge -> LEdge CFEdge
remapEdge Map Node Node
remap) [LEdge CFEdge]
edges,
forall a b. (a -> b) -> [a] -> [b]
map (\(Id
id, (Node
a,Node
b)) -> (Id
id, (forall {k}. Ord k => Map k k -> k -> k
remapHelper Map Node Node
remap Node
a, forall {k}. Ord k => Map k k -> k -> k
remapHelper Map Node Node
remap Node
b))) [(Id, (Node, Node))]
mapping,
forall a b. (a -> b) -> [a] -> [b]
map (\(Id
id, Node
n) -> (Id
id, forall {k}. Ord k => Map k k -> k -> k
remapHelper Map Node Node
remap Node
n)) [(Id, Node)]
assoc
)
prop_testRenumbering :: Bool
prop_testRenumbering =
let
s :: CFNode
s = CFNode
CFStructuralNode
before :: ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
before = (
[(Node
1,CFNode
s), (Node
3,CFNode
s), (Node
4, CFNode
s), (Node
8,CFNode
s)],
[(Node
1,Node
3,CFEdge
CFEFlow), (Node
3,Node
4, CFEdge
CFEFlow), (Node
4,Node
8,CFEdge
CFEFlow)],
[(Node -> Id
Id Node
0, (Node
3,Node
4))],
[(Node -> Id
Id Node
1, Node
3), (Node -> Id
Id Node
2, Node
4)]
)
after :: ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
after = (
[(Node
0,CFNode
s), (Node
1,CFNode
s), (Node
2,CFNode
s), (Node
3,CFNode
s)],
[(Node
0,Node
1,CFEdge
CFEFlow), (Node
1,Node
2, CFEdge
CFEFlow), (Node
2,Node
3,CFEdge
CFEFlow)],
[(Node -> Id
Id Node
0, (Node
1,Node
2))],
[(Node -> Id
Id Node
1, Node
1), (Node -> Id
Id Node
2, Node
2)]
)
in ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
after forall a. Eq a => a -> a -> Bool
== ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
-> ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
renumberGraph ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
before
renumberGraph :: CFW -> CFW
renumberGraph :: ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
-> ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
renumberGraph g :: ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
g@([LNode CFNode]
nodes, [LEdge CFEdge]
edges, [(Id, (Node, Node))]
mapping, [(Id, Node)]
assoc) =
let renumbering :: Map Node Node
renumbering = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. [a] -> [b] -> [(a, b)]
zip [Node
0..] forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [LNode CFNode]
nodes)
in Map Node Node
-> ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
-> ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
remapGraph Map Node Node
renumbering ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
g
prop_testRenumberTopologically :: Bool
prop_testRenumberTopologically =
let
s :: CFNode
s = CFNode
CFStructuralNode
before :: ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))], [a])
before = (
[(Node
4,CFNode
s), (Node
2,CFNode
s), (Node
3, CFNode
s)],
[(Node
4,Node
2,CFEdge
CFEFlow), (Node
2,Node
3, CFEdge
CFEFlow)],
[(Node -> Id
Id Node
0, (Node
4,Node
2))],
[]
)
after :: ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))], [a])
after = (
[(Node
0,CFNode
s), (Node
1,CFNode
s), (Node
2,CFNode
s)],
[(Node
0,Node
1,CFEdge
CFEFlow), (Node
1,Node
2, CFEdge
CFEFlow)],
[(Node -> Id
Id Node
0, (Node
0,Node
1))],
[]
)
in forall {a}.
([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))], [a])
after forall a. Eq a => a -> a -> Bool
== ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
-> ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
renumberTopologically forall {a}.
([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))], [a])
before
renumberTopologically :: ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
-> ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
renumberTopologically g :: ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
g@([LNode CFNode]
nodes, [LEdge CFEdge]
edges, [(Id, (Node, Node))]
mapping, [(Id, Node)]
assoc) =
let renumbering :: Map Node Node
renumbering = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. [a] -> [b] -> [(a, b)]
zip [Node
0..] forall a b. (a -> b) -> a -> b
$ forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Node]
topsort (forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
mkGraph [LNode CFNode]
nodes [LEdge CFEdge]
edges :: CFGraph))
in Map Node Node
-> ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
-> ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
remapGraph Map Node Node
renumbering ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
g
prop_testRemoveStructural :: Bool
prop_testRemoveStructural =
let
s :: CFNode
s = CFNode
CFStructuralNode
before :: ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
before = (
[(Node
1,CFNode
s), (Node
2,CFNode
s), (Node
3, CFNode
s), (Node
4,CFNode
s)],
[(Node
1,Node
2,CFEdge
CFEFlow), (Node
2,Node
3, CFEdge
CFEFlow), (Node
3,Node
4,CFEdge
CFEFlow)],
[(Node -> Id
Id Node
0, (Node
2,Node
3))],
[(Node -> Id
Id Node
0, Node
3)]
)
after :: ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
after = (
[(Node
1,CFNode
s), (Node
2,CFNode
s), (Node
4,CFNode
s)],
[(Node
1,Node
2,CFEdge
CFEFlow), (Node
2,Node
4,CFEdge
CFEFlow)],
[(Node -> Id
Id Node
0, (Node
2,Node
2))],
[(Node -> Id
Id Node
0, Node
2)]
)
in ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
after forall a. Eq a => a -> a -> Bool
== ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
-> ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
removeUnnecessaryStructuralNodes ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
before
removeUnnecessaryStructuralNodes :: ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
-> ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
removeUnnecessaryStructuralNodes ([LNode CFNode]
nodes, [LEdge CFEdge]
edges, [(Id, (Node, Node))]
mapping, [(Id, Node)]
association) =
Map Node Node
-> ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
-> ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
remapGraph Map Node Node
recursiveRemapping
(
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Node
n, CFNode
_) -> Node
n forall k a. Ord k => k -> Map k a -> Bool
`M.notMember` Map Node Node
recursiveRemapping) [LNode CFNode]
nodes,
forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set (LEdge CFEdge)
edgesToCollapse) [LEdge CFEdge]
edges,
[(Id, (Node, Node))]
mapping,
[(Id, Node)]
association
)
where
regularEdges :: [LEdge CFEdge]
regularEdges = forall a. (a -> Bool) -> [a] -> [a]
filter forall {a} {b}. (a, b, CFEdge) -> Bool
isRegularEdge [LEdge CFEdge]
edges
inDegree :: Map Node Integer
inDegree = [Node] -> Map Node Integer
counter forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Node
from,Node
to,CFEdge
_) -> Node
from) [LEdge CFEdge]
regularEdges
outDegree :: Map Node Integer
outDegree = [Node] -> Map Node Integer
counter forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Node
from,Node
to,CFEdge
_) -> Node
to) [LEdge CFEdge]
regularEdges
structuralNodes :: Set Node
structuralNodes = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall {a}. (a, CFNode) -> Bool
isStructural [LNode CFNode]
nodes
candidateNodes :: Set Node
candidateNodes = forall a. (a -> Bool) -> Set a -> Set a
S.filter Node -> Bool
isLinear Set Node
structuralNodes
edgesToCollapse :: Set (LEdge CFEdge)
edgesToCollapse = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall {c}. (Node, Node, c) -> Bool
filterEdges [LEdge CFEdge]
regularEdges
remapping :: M.Map Node Node
remapping :: Map Node Node
remapping = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map Node Node
m (Node
new, Node
old) -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Node
old Node
new Map Node Node
m) forall k a. Map k a
M.empty forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {b} {c}. Ord b => (b, b, c) -> (b, b)
orderEdge forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList Set (LEdge CFEdge)
edgesToCollapse
recursiveRemapping :: Map Node Node
recursiveRemapping = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Node
c -> (Node
c, Map Node Node -> Node -> Node
recursiveLookup Map Node Node
remapping Node
c)) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
M.keys Map Node Node
remapping
filterEdges :: (Node, Node, c) -> Bool
filterEdges (Node
a,Node
b,c
_) =
Node
a forall a. Ord a => a -> Set a -> Bool
`S.member` Set Node
candidateNodes Bool -> Bool -> Bool
&& Node
b forall a. Ord a => a -> Set a -> Bool
`S.member` Set Node
candidateNodes
orderEdge :: (b, b, c) -> (b, b)
orderEdge (b
a,b
b,c
_) = if b
a forall a. Ord a => a -> a -> Bool
< b
b then (b
a,b
b) else (b
b,b
a)
counter :: [Node] -> Map Node Integer
counter = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map Node Integer
map Node
key -> forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. Num a => a -> a -> a
(+) Node
key Integer
1 Map Node Integer
map) forall k a. Map k a
M.empty
isRegularEdge :: (a, b, CFEdge) -> Bool
isRegularEdge (a
_, b
_, CFEdge
CFEFlow) = Bool
True
isRegularEdge (a, b, CFEdge)
_ = Bool
False
recursiveLookup :: M.Map Node Node -> Node -> Node
recursiveLookup :: Map Node Node -> Node -> Node
recursiveLookup Map Node Node
map Node
node =
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Node
node Map Node Node
map of
Maybe Node
Nothing -> Node
node
Just Node
x -> Map Node Node -> Node -> Node
recursiveLookup Map Node Node
map Node
x
isStructural :: (a, CFNode) -> Bool
isStructural (a
node, CFNode
label) =
case CFNode
label of
CFNode
CFStructuralNode -> Bool
True
CFNode
_ -> Bool
False
isLinear :: Node -> Bool
isLinear Node
node =
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Integer
0 Node
node Map Node Integer
inDegree forall a. Eq a => a -> a -> Bool
== Integer
1
Bool -> Bool -> Bool
&& forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Integer
0 Node
node Map Node Integer
outDegree forall a. Eq a => a -> a -> Bool
== Integer
1
remapNode :: M.Map Node Node -> LNode CFNode -> LNode CFNode
remapNode :: Map Node Node -> LNode CFNode -> LNode CFNode
remapNode Map Node Node
m (Node
node, CFNode
label) =
(forall {k}. Ord k => Map k k -> k -> k
remapHelper Map Node Node
m Node
node, CFNode
newLabel)
where
newLabel :: CFNode
newLabel = case CFNode
label of
CFApplyEffects [IdTagged CFEffect]
effects -> [IdTagged CFEffect] -> CFNode
CFApplyEffects (forall a b. (a -> b) -> [a] -> [b]
map (Map Node Node -> IdTagged CFEffect -> IdTagged CFEffect
remapEffect Map Node Node
m) [IdTagged CFEffect]
effects)
CFExecuteSubshell String
s Node
a Node
b -> String -> Node -> Node -> CFNode
CFExecuteSubshell String
s (forall {k}. Ord k => Map k k -> k -> k
remapHelper Map Node Node
m Node
a) (forall {k}. Ord k => Map k k -> k -> k
remapHelper Map Node Node
m Node
b)
CFNode
_ -> CFNode
label
remapEffect :: Map Node Node -> IdTagged CFEffect -> IdTagged CFEffect
remapEffect Map Node Node
map old :: IdTagged CFEffect
old@(IdTagged Id
id CFEffect
effect) =
case CFEffect
effect of
CFDefineFunction String
name Id
id Node
start Node
end -> forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> Id -> Node -> Node -> CFEffect
CFDefineFunction String
name Id
id (forall {k}. Ord k => Map k k -> k -> k
remapHelper Map Node Node
map Node
start) (forall {k}. Ord k => Map k k -> k -> k
remapHelper Map Node Node
map Node
end)
CFEffect
_ -> IdTagged CFEffect
old
remapEdge :: M.Map Node Node -> LEdge CFEdge -> LEdge CFEdge
remapEdge :: Map Node Node -> LEdge CFEdge -> LEdge CFEdge
remapEdge Map Node Node
map (Node
from, Node
to, CFEdge
label) = (forall {k}. Ord k => Map k k -> k -> k
remapHelper Map Node Node
map Node
from, forall {k}. Ord k => Map k k -> k -> k
remapHelper Map Node Node
map Node
to, CFEdge
label)
remapHelper :: Map k k -> k -> k
remapHelper Map k k
map k
n = forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault k
n k
n Map k k
map
data Range = Range Node Node
deriving (Range -> Range -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c== :: Range -> Range -> Bool
Eq, Node -> Range -> ShowS
[Range] -> ShowS
Range -> String
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Range] -> ShowS
$cshowList :: [Range] -> ShowS
show :: Range -> String
$cshow :: Range -> String
showsPrec :: Node -> Range -> ShowS
$cshowsPrec :: Node -> Range -> ShowS
Show)
data CFContext = CFContext {
CFContext -> Bool
cfIsCondition :: Bool,
CFContext -> Bool
cfIsFunction :: Bool,
CFContext -> [(Node, Node)]
cfLoopStack :: [(Node, Node)],
CFContext -> [Id]
cfTokenStack :: [Id],
CFContext -> Maybe Node
cfExitTarget :: Maybe Node,
CFContext -> Maybe Node
cfReturnTarget :: Maybe Node,
CFContext -> CFGParameters
cfParameters :: CFGParameters
}
newCFContext :: CFGParameters -> CFContext
newCFContext CFGParameters
params = CFContext {
cfIsCondition :: Bool
cfIsCondition = Bool
False,
cfIsFunction :: Bool
cfIsFunction = Bool
False,
cfLoopStack :: [(Node, Node)]
cfLoopStack = [],
cfTokenStack :: [Id]
cfTokenStack = [],
cfExitTarget :: Maybe Node
cfExitTarget = forall a. Maybe a
Nothing,
cfReturnTarget :: Maybe Node
cfReturnTarget = forall a. Maybe a
Nothing,
cfParameters :: CFGParameters
cfParameters = CFGParameters
params
}
type CFM a = RWS CFContext CFW Int a
type CFW = ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))], [(Id, Node)])
newNode :: CFNode -> CFM Node
newNode :: CFNode -> CFM Node
newNode CFNode
label = do
Node
n <- forall s (m :: * -> *). MonadState s m => m s
get
[Id]
stack <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CFContext -> [Id]
cfTokenStack
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Node
nforall a. Num a => a -> a -> a
+Node
1)
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([(Node
n, CFNode
label)], [], [], forall a b. (a -> b) -> [a] -> [b]
map (\Id
c -> (Id
c, Node
n)) [Id]
stack)
forall (m :: * -> *) a. Monad m => a -> m a
return Node
n
newNodeRange :: CFNode -> CFM Range
newNodeRange :: CFNode -> CFM Range
newNodeRange CFNode
label = Node -> Range
nodeToRange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CFNode -> CFM Node
newNode CFNode
label
subshell :: Id -> String -> CFM Range -> CFM Range
subshell :: Id -> String -> CFM Range -> CFM Range
subshell Id
id String
reason CFM Range
p = do
Node
start <- CFNode -> CFM Node
newNode forall a b. (a -> b) -> a -> b
$ String -> CFNode
CFEntryPoint forall a b. (a -> b) -> a -> b
$ String
"Subshell " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Id
id forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
reason
Node
end <- CFNode -> CFM Node
newNode CFNode
CFStructuralNode
Range
middle <- forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\CFContext
c -> CFContext
c { cfExitTarget :: Maybe Node
cfExitTarget = forall a. a -> Maybe a
Just Node
end, cfReturnTarget :: Maybe Node
cfReturnTarget = forall a. a -> Maybe a
Just Node
end}) CFM Range
p
[Range] -> CFM Range
linkRanges [Node -> Range
nodeToRange Node
start, Range
middle, Node -> Range
nodeToRange Node
end]
CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ String -> Node -> Node -> CFNode
CFExecuteSubshell String
reason Node
start Node
end
withFunctionScope :: CFM Range -> CFM Range
withFunctionScope CFM Range
p = do
Node
end <- CFNode -> CFM Node
newNode CFNode
CFStructuralNode
Range
body <- forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\CFContext
c -> CFContext
c { cfReturnTarget :: Maybe Node
cfReturnTarget = forall a. a -> Maybe a
Just Node
end, cfIsFunction :: Bool
cfIsFunction = Bool
True }) CFM Range
p
[Range] -> CFM Range
linkRanges [Range
body, Node -> Range
nodeToRange Node
end]
under :: Id -> CFM a -> CFM a
under :: forall a. Id -> CFM a -> CFM a
under Id
id CFM a
f = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\CFContext
c -> CFContext
c { cfTokenStack :: [Id]
cfTokenStack = Id
idforall a. a -> [a] -> [a]
:(CFContext -> [Id]
cfTokenStack CFContext
c) }) CFM a
f
nodeToRange :: Node -> Range
nodeToRange :: Node -> Range
nodeToRange Node
n = Node -> Node -> Range
Range Node
n Node
n
link :: Node -> Node -> CFEdge -> CFM ()
link :: Node -> Node -> CFEdge -> CFM ()
link Node
from Node
to CFEdge
label = do
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([], [(Node
from, Node
to, CFEdge
label)], [], [])
registerNode :: Id -> Range -> CFM ()
registerNode :: Id -> Range -> CFM ()
registerNode Id
id (Range Node
start Node
end) = forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([], [], [(Id
id, (Node
start, Node
end))], [])
linkRange :: Range -> Range -> CFM Range
linkRange :: Range -> Range -> CFM Range
linkRange = CFEdge -> Range -> Range -> CFM Range
linkRangeAs CFEdge
CFEFlow
linkRangeAs :: CFEdge -> Range -> Range -> CFM Range
linkRangeAs :: CFEdge -> Range -> Range -> CFM Range
linkRangeAs CFEdge
label (Range Node
start Node
mid1) (Range Node
mid2 Node
end) = do
Node -> Node -> CFEdge -> CFM ()
link Node
mid1 Node
mid2 CFEdge
label
forall (m :: * -> *) a. Monad m => a -> m a
return (Node -> Node -> Range
Range Node
start Node
end)
spanRange :: Range -> Range -> Range
spanRange :: Range -> Range -> Range
spanRange (Range Node
start Node
mid1) (Range Node
mid2 Node
end) = Node -> Node -> Range
Range Node
start Node
end
linkRanges :: [Range] -> CFM Range
linkRanges :: [Range] -> CFM Range
linkRanges [] = forall a. HasCallStack => String -> a
error String
"Empty range"
linkRanges (Range
first:[Range]
rest) = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Range -> Range -> CFM Range
linkRange Range
first [Range]
rest
sequentially :: [Token] -> CFM Range
sequentially :: [Token] -> CFM Range
sequentially [Token]
list = do
Range
first <- CFM Range
newStructuralNode
[Range]
rest <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Token -> CFM Range
build [Token]
list
[Range] -> CFM Range
linkRanges (Range
firstforall a. a -> [a] -> [a]
:[Range]
rest)
withContext :: (CFContext -> CFContext) -> CFM a -> CFM a
withContext :: forall a. (CFContext -> CFContext) -> CFM a -> CFM a
withContext = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
withReturn :: Range -> CFM a -> CFM a
withReturn :: forall a. Range -> CFM a -> CFM a
withReturn Range
_ CFM a
p = CFM a
p
asCondition :: CFM Range -> CFM Range
asCondition :: CFM Range -> CFM Range
asCondition = forall a. (CFContext -> CFContext) -> CFM a -> CFM a
withContext (\CFContext
c -> CFContext
c { cfIsCondition :: Bool
cfIsCondition = Bool
True })
newStructuralNode :: CFM Range
newStructuralNode = CFNode -> CFM Range
newNodeRange CFNode
CFStructuralNode
buildRoot :: Token -> CFM Range
buildRoot :: Token -> CFM Range
buildRoot Token
t = forall a. Id -> CFM a -> CFM a
under (Token -> Id
getId Token
t) forall a b. (a -> b) -> a -> b
$ do
Range
entry <- CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ String -> CFNode
CFEntryPoint String
"MAIN"
Node
impliedExit <- CFNode -> CFM Node
newNode CFNode
CFImpliedExit
Node
end <- CFNode -> CFM Node
newNode CFNode
CFStructuralNode
Range
start <- forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\CFContext
c -> CFContext
c { cfExitTarget :: Maybe Node
cfExitTarget = forall a. a -> Maybe a
Just Node
end, cfReturnTarget :: Maybe Node
cfReturnTarget = forall a. a -> Maybe a
Just Node
impliedExit}) forall a b. (a -> b) -> a -> b
$ Token -> CFM Range
build Token
t
Range
range <- [Range] -> CFM Range
linkRanges [Range
entry, Range
start, Node -> Range
nodeToRange Node
impliedExit, Node -> Range
nodeToRange Node
end]
Id -> Range -> CFM ()
registerNode (Token -> Id
getId Token
t) Range
range
forall (m :: * -> *) a. Monad m => a -> m a
return Range
range
applySingle :: IdTagged CFEffect -> CFNode
applySingle IdTagged CFEffect
e = [IdTagged CFEffect] -> CFNode
CFApplyEffects [IdTagged CFEffect
e]
build :: Token -> CFM Range
build :: Token -> CFM Range
build Token
t = do
Range
range <- forall a. Id -> CFM a -> CFM a
under (Token -> Id
getId Token
t) forall a b. (a -> b) -> a -> b
$ Token -> CFM Range
build' Token
t
Id -> Range -> CFM ()
registerNode (Token -> Id
getId Token
t) Range
range
forall (m :: * -> *) a. Monad m => a -> m a
return Range
range
where
build' :: Token -> CFM Range
build' Token
t = case Token
t of
T_Annotation Id
_ [Annotation]
_ Token
list -> Token -> CFM Range
build Token
list
T_Script Id
_ Token
_ [Token]
list -> do
[Token] -> CFM Range
sequentially [Token]
list
TA_Assignment Id
id String
op var :: Token
var@(TA_Variable Id
_ String
name [Token]
indices) Token
rhs -> do
Range
value <- Token -> CFM Range
build Token
rhs
Range
subscript <- [Token] -> CFM Range
sequentially [Token]
indices
Range
read <-
if String
op forall a. Eq a => a -> a -> Bool
== String
"="
then CFM Range
none
else CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ IdTagged CFEffect -> CFNode
applySingle forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> CFEffect
CFReadVariable String
name
Range
write <- CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ IdTagged CFEffect -> CFNode
applySingle forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name forall a b. (a -> b) -> a -> b
$
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
indices
then CFValue
CFValueInteger
else CFValue
CFValueArray
[Range] -> CFM Range
linkRanges [Range
value, Range
subscript, Range
read, Range
write]
TA_Assignment Id
id String
op Token
lhs Token
rhs -> do
[Token] -> CFM Range
sequentially [Token
lhs, Token
rhs]
TA_Binary Id
_ String
_ Token
a Token
b -> [Token] -> CFM Range
sequentially [Token
a,Token
b]
TA_Expansion Id
_ [Token]
list -> [Token] -> CFM Range
sequentially [Token]
list
TA_Sequence Id
_ [Token]
list -> [Token] -> CFM Range
sequentially [Token]
list
TA_Parentesis Id
_ Token
t -> Token -> CFM Range
build Token
t
TA_Trinary Id
_ Token
cond Token
a Token
b -> do
Range
condition <- Token -> CFM Range
build Token
cond
Range
ifthen <- Token -> CFM Range
build Token
a
Range
elsethen <- Token -> CFM Range
build Token
b
Range
end <- CFM Range
newStructuralNode
[Range] -> CFM Range
linkRanges [Range
condition, Range
ifthen, Range
end]
[Range] -> CFM Range
linkRanges [Range
condition, Range
elsethen, Range
end]
TA_Variable Id
id String
name [Token]
indices -> do
Range
subscript <- [Token] -> CFM Range
sequentially [Token]
indices
Range
hint <-
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
indices
then CFM Range
none
else Node -> Range
nodeToRange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CFNode -> CFM Node
newNode (IdTagged CFEffect -> CFNode
applySingle forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> CFEffect
CFHintArray String
name)
Range
read <- Node -> Range
nodeToRange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CFNode -> CFM Node
newNode (IdTagged CFEffect -> CFNode
applySingle forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> CFEffect
CFReadVariable String
name)
[Range] -> CFM Range
linkRanges [Range
subscript, Range
hint, Range
read]
TA_Unary Id
id String
op (TA_Variable Id
_ String
name [Token]
indices) | String
"--" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
op Bool -> Bool -> Bool
|| String
"++" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
op -> do
Range
subscript <- [Token] -> CFM Range
sequentially [Token]
indices
Range
read <- CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ IdTagged CFEffect -> CFNode
applySingle forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> CFEffect
CFReadVariable String
name
Range
write <- CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ IdTagged CFEffect -> CFNode
applySingle forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name forall a b. (a -> b) -> a -> b
$
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
indices
then CFValue
CFValueInteger
else CFValue
CFValueArray
[Range] -> CFM Range
linkRanges [Range
subscript, Range
read, Range
write]
TA_Unary Id
_ String
_ Token
arg -> Token -> CFM Range
build Token
arg
TC_And Id
_ ConditionType
SingleBracket String
_ Token
lhs Token
rhs -> do
[Token] -> CFM Range
sequentially [Token
lhs, Token
rhs]
TC_And Id
_ ConditionType
DoubleBracket String
_ Token
lhs Token
rhs -> do
Range
left <- Token -> CFM Range
build Token
lhs
Range
right <- Token -> CFM Range
build Token
rhs
Range
end <- CFM Range
newStructuralNode
[Range] -> CFM Range
linkRanges [Range
left, Range
right, Range
end]
Range -> Range -> CFM Range
linkRange Range
left Range
end
TC_Binary Id
_ ConditionType
mode String
str Token
lhs Token
rhs -> do
Range
left <- Token -> CFM Range
build Token
lhs
Range
right <- Token -> CFM Range
build Token
rhs
Range -> Range -> CFM Range
linkRange Range
left Range
right
TC_Empty {} -> CFM Range
newStructuralNode
TC_Group Id
_ ConditionType
_ Token
t -> Token -> CFM Range
build Token
t
TC_Nullary Id
_ ConditionType
_ Token
arg -> Token -> CFM Range
build Token
arg
TC_Or Id
_ ConditionType
SingleBracket String
_ Token
lhs Token
rhs -> [Token] -> CFM Range
sequentially [Token
lhs, Token
rhs]
TC_Or Id
_ ConditionType
DoubleBracket String
_ Token
lhs Token
rhs -> do
Range
left <- Token -> CFM Range
build Token
lhs
Range
right <- Token -> CFM Range
build Token
rhs
Range
end <- CFM Range
newStructuralNode
[Range] -> CFM Range
linkRanges [Range
left, Range
right, Range
end]
Range -> Range -> CFM Range
linkRange Range
left Range
end
TC_Unary Id
_ ConditionType
_ String
op Token
arg -> do
Token -> CFM Range
build Token
arg
T_Arithmetic Id
id Token
root -> do
Range
exe <- Token -> CFM Range
build Token
root
Range
status <- CFNode -> CFM Range
newNodeRange (Id -> CFNode
CFSetExitCode Id
id)
Range -> Range -> CFM Range
linkRange Range
exe Range
status
T_AndIf Id
_ Token
lhs Token
rhs -> do
Range
left <- Token -> CFM Range
build Token
lhs
Range
right <- Token -> CFM Range
build Token
rhs
Range
end <- CFM Range
newStructuralNode
Range -> Range -> CFM Range
linkRange Range
left Range
right
Range -> Range -> CFM Range
linkRange Range
right Range
end
Range -> Range -> CFM Range
linkRange Range
left Range
end
T_Array Id
_ [Token]
list -> [Token] -> CFM Range
sequentially [Token]
list
T_Assignment {} -> Scope -> Token -> CFM Range
buildAssignment Scope
DefaultScope Token
t
T_Backgrounded Id
id Token
body -> do
Range
start <- CFM Range
newStructuralNode
Range
fork <- Id -> String -> CFM Range -> CFM Range
subshell Id
id String
"backgrounding '&'" forall a b. (a -> b) -> a -> b
$ Token -> CFM Range
build Token
body
Range
pid <- CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ Id -> CFNode
CFSetBackgroundPid Id
id
Range
status <- CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ Id -> CFNode
CFSetExitCode Id
id
Range -> Range -> CFM Range
linkRange Range
start Range
fork
CFEdge -> Range -> Range -> CFM Range
linkRangeAs CFEdge
CFEFalseFlow Range
fork Range
pid
[Range] -> CFM Range
linkRanges [Range
start, Range
pid, Range
status]
T_Backticked Id
id [Token]
body ->
Id -> String -> CFM Range -> CFM Range
subshell Id
id String
"`..` expansion" forall a b. (a -> b) -> a -> b
$ [Token] -> CFM Range
sequentially [Token]
body
T_Banged Id
id Token
cmd -> do
Range
main <- Token -> CFM Range
build Token
cmd
Range
status <- CFNode -> CFM Range
newNodeRange (Id -> CFNode
CFSetExitCode Id
id)
Range -> Range -> CFM Range
linkRange Range
main Range
status
T_BatsTest Id
id String
_ Token
body -> do
Range
status <- CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ IdTagged CFEffect -> CFNode
applySingle forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
"status" CFValue
CFValueInteger
Range
output <- CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ IdTagged CFEffect -> CFNode
applySingle forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
"output" CFValue
CFValueString
Range
main <- Token -> CFM Range
build Token
body
[Range] -> CFM Range
linkRanges [Range
status, Range
output, Range
main]
T_BraceExpansion Id
_ [Token]
list -> [Token] -> CFM Range
sequentially [Token]
list
T_BraceGroup Id
id [Token]
body ->
[Token] -> CFM Range
sequentially [Token]
body
T_CaseExpression Id
id Token
t [] -> Token -> CFM Range
build Token
t
T_CaseExpression Id
id Token
t [(CaseType, [Token], [Token])]
list -> do
Range
start <- CFM Range
newStructuralNode
Range
token <- Token -> CFM Range
build Token
t
[(CaseType, Range, Range)]
branches <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {a}.
(a, [Token], [Token])
-> RWST
CFContext
([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
Node
Identity
(a, Range, Range)
buildBranch [(CaseType, [Token], [Token])]
list
Range
end <- CFM Range
newStructuralNode
let neighbors :: [((CaseType, Range, Range), (CaseType, Range, Range))]
neighbors = forall a b. [a] -> [b] -> [(a, b)]
zip [(CaseType, Range, Range)]
branches forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail [(CaseType, Range, Range)]
branches
let (CaseType
_, Range
firstCond, Range
_) = forall a. [a] -> a
head [(CaseType, Range, Range)]
branches
let (CaseType
_, Range
lastCond, Range
lastBody) = forall a. [a] -> a
last [(CaseType, Range, Range)]
branches
Range -> Range -> CFM Range
linkRange Range
start Range
token
Range -> Range -> CFM Range
linkRange Range
token Range
firstCond
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ forall {a}.
Range -> (CaseType, Range, Range) -> (a, Range, Range) -> CFM Range
linkBranch Range
end) [((CaseType, Range, Range), (CaseType, Range, Range))]
neighbors
Range -> Range -> CFM Range
linkRange Range
lastBody Range
end
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall {t :: * -> *} {a} {c}. Foldable t => (a, t Token, c) -> Bool
hasCatchAll [(CaseType, [Token], [Token])]
list) forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Range -> Range -> CFM Range
linkRange Range
token Range
end
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Range -> Range -> Range
spanRange Range
start Range
end
where
buildCond :: [Token] -> CFM Range
buildCond [Token]
list = do
Range
start <- CFM Range
newStructuralNode
[Range]
conds <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Token -> CFM Range
build [Token]
list
Range
end <- CFM Range
newStructuralNode
[Range] -> CFM Range
linkRanges (Range
startforall a. a -> [a] -> [a]
:[Range]
conds)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Range -> Range -> CFM Range
`linkRange` Range
end) [Range]
conds
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Range -> Range -> Range
spanRange Range
start Range
end
buildBranch :: (a, [Token], [Token])
-> RWST
CFContext
([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
Node
Identity
(a, Range, Range)
buildBranch (a
typ, [Token]
cond, [Token]
body) = do
Range
c <- [Token] -> CFM Range
buildCond [Token]
cond
Range
b <- [Token] -> CFM Range
sequentially [Token]
body
Range -> Range -> CFM Range
linkRange Range
c Range
b
forall (m :: * -> *) a. Monad m => a -> m a
return (a
typ, Range
c, Range
b)
linkBranch :: Range -> (CaseType, Range, Range) -> (a, Range, Range) -> CFM Range
linkBranch Range
end (CaseType
typ, Range
cond, Range
body) (a
_, Range
nextCond, Range
nextBody) = do
Range -> Range -> CFM Range
linkRange Range
cond Range
nextCond
case CaseType
typ of
CaseType
CaseBreak -> Range -> Range -> CFM Range
linkRange Range
body Range
end
CaseType
CaseFallThrough -> Range -> Range -> CFM Range
linkRange Range
body Range
nextBody
CaseType
CaseContinue -> Range -> Range -> CFM Range
linkRange Range
body Range
nextCond
hasCatchAll :: (a, t Token, c) -> Bool
hasCatchAll (a
_,t Token
cond,c
_) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Token -> Bool
isCatchAll t Token
cond
isCatchAll :: Token -> Bool
isCatchAll Token
c = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ do
[PseudoGlob]
pg <- Token -> Maybe [PseudoGlob]
wordToExactPseudoGlob Token
c
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [PseudoGlob]
pg [PseudoGlob] -> [PseudoGlob] -> Bool
`pseudoGlobIsSuperSetof` [PseudoGlob
PGMany]
T_Condition Id
id ConditionType
_ Token
op -> do
Range
cond <- Token -> CFM Range
build Token
op
Range
status <- CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ Id -> CFNode
CFSetExitCode Id
id
Range -> Range -> CFM Range
linkRange Range
cond Range
status
T_CoProc Id
id Maybe String
maybeName Token
t -> do
let name :: String
name = forall a. a -> Maybe a -> a
fromMaybe String
"COPROC" Maybe String
maybeName
Range
start <- CFM Range
newStructuralNode
Range
parent <- CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ IdTagged CFEffect -> CFNode
applySingle forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name CFValue
CFValueArray
Range
child <- Id -> String -> CFM Range -> CFM Range
subshell Id
id String
"coproc" forall a b. (a -> b) -> a -> b
$ Token -> CFM Range
build Token
t
Range
end <- CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ Id -> CFNode
CFSetExitCode Id
id
Range -> Range -> CFM Range
linkRange Range
start Range
parent
Range -> Range -> CFM Range
linkRange Range
start Range
child
Range -> Range -> CFM Range
linkRange Range
parent Range
end
CFEdge -> Range -> Range -> CFM Range
linkRangeAs CFEdge
CFEFalseFlow Range
child Range
end
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Range -> Range -> Range
spanRange Range
start Range
end
T_CoProcBody Id
_ Token
t -> Token -> CFM Range
build Token
t
T_DollarArithmetic Id
_ Token
arith -> Token -> CFM Range
build Token
arith
T_DollarDoubleQuoted Id
_ [Token]
list -> [Token] -> CFM Range
sequentially [Token]
list
T_DollarSingleQuoted Id
_ String
_ -> CFM Range
none
T_DollarBracket Id
_ Token
t -> Token -> CFM Range
build Token
t
T_DollarBraced Id
id Bool
_ Token
t -> do
let str :: String
str = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ Token -> [String]
oversimplify Token
t
let modifier :: String
modifier = ShowS
getBracedModifier String
str
let reference :: String
reference = ShowS
getBracedReference String
str
let indices :: [String]
indices = String -> [String]
getIndexReferences String
str
let offsets :: [String]
offsets = String -> [String]
getOffsetReferences String
str
Range
vals <- Token -> CFM Range
build Token
t
[Range]
others <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\String
x -> Node -> Range
nodeToRange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CFNode -> CFM Node
newNode (IdTagged CFEffect -> CFNode
applySingle forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> CFEffect
CFReadVariable String
x)) ([String]
indices forall a. [a] -> [a] -> [a]
++ [String]
offsets)
Range
deps <- [Range] -> CFM Range
linkRanges (Range
valsforall a. a -> [a] -> [a]
:[Range]
others)
Range
read <- Node -> Range
nodeToRange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CFNode -> CFM Node
newNode (IdTagged CFEffect -> CFNode
applySingle forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> CFEffect
CFReadVariable String
reference)
Range
totalRead <- Range -> Range -> CFM Range
linkRange Range
deps Range
read
if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
modifier) [String
"=", String
":="]
then do
Range
optionalAssign <- CFNode -> CFM Range
newNodeRange (IdTagged CFEffect -> CFNode
applySingle forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
reference CFValue
CFValueString)
Range
result <- CFM Range
newStructuralNode
Range -> Range -> CFM Range
linkRange Range
optionalAssign Range
result
Range -> Range -> CFM Range
linkRange Range
totalRead Range
result
else forall (m :: * -> *) a. Monad m => a -> m a
return Range
totalRead
T_DoubleQuoted Id
_ [Token]
list -> [Token] -> CFM Range
sequentially [Token]
list
T_DollarExpansion Id
id [Token]
body ->
Id -> String -> CFM Range -> CFM Range
subshell Id
id String
"$(..) expansion" forall a b. (a -> b) -> a -> b
$ [Token] -> CFM Range
sequentially [Token]
body
T_Extglob Id
_ String
_ [Token]
list -> [Token] -> CFM Range
sequentially [Token]
list
T_FdRedirect Id
id (Char
'{':String
identifier) Token
op -> do
let name :: String
name = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'}') String
identifier
Range
expression <- Token -> CFM Range
build Token
op
Range
rw <- CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$
if Token -> Bool
isClosingFileOp Token
op
then IdTagged CFEffect -> CFNode
applySingle forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> CFEffect
CFReadVariable String
name
else IdTagged CFEffect -> CFNode
applySingle forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name CFValue
CFValueInteger
Range -> Range -> CFM Range
linkRange Range
expression Range
rw
T_FdRedirect Id
_ String
name Token
t -> do
Token -> CFM Range
build Token
t
T_ForArithmetic Id
_ Token
initT Token
condT Token
incT [Token]
bodyT -> do
Range
init <- Token -> CFM Range
build Token
initT
Range
cond <- Token -> CFM Range
build Token
condT
Range
body <- [Token] -> CFM Range
sequentially [Token]
bodyT
Range
inc <- Token -> CFM Range
build Token
incT
Range
end <- CFM Range
newStructuralNode
[Range] -> CFM Range
linkRanges [Range
init, Range
cond, Range
body, Range
inc]
Range -> Range -> CFM Range
linkRange Range
cond Range
end
Range -> Range -> CFM Range
linkRange Range
inc Range
cond
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Range -> Range -> Range
spanRange Range
init Range
end
T_ForIn Id
id String
name [Token]
words [Token]
body -> Id -> String -> [Token] -> [Token] -> CFM Range
forInHelper Id
id String
name [Token]
words [Token]
body
T_Function Id
id FunctionKeyword
_ FunctionParentheses
_ String
name Token
body -> do
Range
range <- forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\CFContext
c -> CFContext
c { cfExitTarget :: Maybe Node
cfExitTarget = forall a. Maybe a
Nothing }) forall a b. (a -> b) -> a -> b
$ do
Range
entry <- CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ String -> CFNode
CFEntryPoint forall a b. (a -> b) -> a -> b
$ String
"function " forall a. [a] -> [a] -> [a]
++ String
name
Range
f <- CFM Range -> CFM Range
withFunctionScope forall a b. (a -> b) -> a -> b
$ Token -> CFM Range
build Token
body
Range -> Range -> CFM Range
linkRange Range
entry Range
f
let (Range Node
entry Node
exit) = Range
range
Range
definition <- CFNode -> CFM Range
newNodeRange (IdTagged CFEffect -> CFNode
applySingle forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> Id -> Node -> Node -> CFEffect
CFDefineFunction String
name Id
id Node
entry Node
exit)
Range
exe <- CFNode -> CFM Range
newNodeRange (Id -> CFNode
CFSetExitCode Id
id)
Range -> Range -> CFM Range
linkRange Range
definition Range
exe
T_Glob {} -> CFM Range
none
T_HereString Id
_ Token
t -> Token -> CFM Range
build Token
t
T_HereDoc Id
_ Dashed
_ Quoted
_ String
_ [Token]
list -> [Token] -> CFM Range
sequentially [Token]
list
T_IfExpression Id
id [([Token], [Token])]
ifs [Token]
elses -> do
Range
start <- CFM Range
newStructuralNode
[Range]
branches <- Range
-> [([Token], [Token])]
-> [Token]
-> [Range]
-> RWST
CFContext
([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
Node
Identity
[Range]
doBranches Range
start [([Token], [Token])]
ifs [Token]
elses []
Range
end <- CFM Range
newStructuralNode
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Range -> Range -> CFM Range
`linkRange` Range
end) [Range]
branches
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Range -> Range -> Range
spanRange Range
start Range
end
where
doBranches :: Range
-> [([Token], [Token])]
-> [Token]
-> [Range]
-> RWST
CFContext
([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
Node
Identity
[Range]
doBranches Range
start (([Token]
conds, [Token]
thens):[([Token], [Token])]
rest) [Token]
elses [Range]
result = do
Range
cond <- CFM Range -> CFM Range
asCondition forall a b. (a -> b) -> a -> b
$ [Token] -> CFM Range
sequentially [Token]
conds
Range
action <- [Token] -> CFM Range
sequentially [Token]
thens
Range -> Range -> CFM Range
linkRange Range
start Range
cond
Range -> Range -> CFM Range
linkRange Range
cond Range
action
Range
-> [([Token], [Token])]
-> [Token]
-> [Range]
-> RWST
CFContext
([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
Node
Identity
[Range]
doBranches Range
cond [([Token], [Token])]
rest [Token]
elses (Range
actionforall a. a -> [a] -> [a]
:[Range]
result)
doBranches Range
start [] [Token]
elses [Range]
result = do
Range
rest <-
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
elses
then CFNode -> CFM Range
newNodeRange (Id -> CFNode
CFSetExitCode Id
id)
else [Token] -> CFM Range
sequentially [Token]
elses
Range -> Range -> CFM Range
linkRange Range
start Range
rest
forall (m :: * -> *) a. Monad m => a -> m a
return (Range
restforall a. a -> [a] -> [a]
:[Range]
result)
T_Include Id
_ Token
t -> Token -> CFM Range
build Token
t
T_IndexedElement Id
_ [Token]
indicesT Token
valueT -> do
Range
indices <- [Token] -> CFM Range
sequentially [Token]
indicesT
Range
value <- Token -> CFM Range
build Token
valueT
Range -> Range -> CFM Range
linkRange Range
indices Range
value
T_IoDuplicate Id
_ Token
op String
_ -> Token -> CFM Range
build Token
op
T_IoFile Id
_ Token
op Token
t -> do
Range
exp <- Token -> CFM Range
build Token
t
Range
doesntDoMuch <- Token -> CFM Range
build Token
op
Range -> Range -> CFM Range
linkRange Range
exp Range
doesntDoMuch
T_Literal {} -> CFM Range
none
T_NormalWord Id
_ [Token]
list -> [Token] -> CFM Range
sequentially [Token]
list
T_OrIf Id
_ Token
lhs Token
rhs -> do
Range
left <- Token -> CFM Range
build Token
lhs
Range
right <- Token -> CFM Range
build Token
rhs
Range
end <- CFM Range
newStructuralNode
Range -> Range -> CFM Range
linkRange Range
left Range
right
Range -> Range -> CFM Range
linkRange Range
right Range
end
Range -> Range -> CFM Range
linkRange Range
left Range
end
T_Pipeline Id
_ [Token]
_ [Token
cmd] -> Token -> CFM Range
build Token
cmd
T_Pipeline Id
id [Token]
_ [Token]
cmds -> do
Range
start <- CFM Range
newStructuralNode
Bool
hasLastpipe <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader forall a b. (a -> b) -> a -> b
$ CFGParameters -> Bool
cfLastpipe forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFContext -> CFGParameters
cfParameters
([Range]
leading, [Range]
last) <- Bool
-> [Token]
-> RWST
CFContext
([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
Node
Identity
([Range], [Range])
buildPipe Bool
hasLastpipe [Token]
cmds
Range
end <- CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ Id -> CFNode
CFSetExitCode Id
id
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Range -> Range -> CFM Range
linkRange Range
start) [Range]
leading
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Range
c -> CFEdge -> Range -> Range -> CFM Range
linkRangeAs CFEdge
CFEFalseFlow Range
c Range
end) [Range]
leading
[Range] -> CFM Range
linkRanges forall a b. (a -> b) -> a -> b
$ [Range
start] forall a. [a] -> [a] -> [a]
++ [Range]
last forall a. [a] -> [a] -> [a]
++ [Range
end]
where
buildPipe :: Bool
-> [Token]
-> RWST
CFContext
([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
Node
Identity
([Range], [Range])
buildPipe Bool
True [Token
x] = do
Range
last <- Token -> CFM Range
build Token
x
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Range
last])
buildPipe Bool
lp (Token
first:[Token]
rest) = do
Range
this <- Id -> String -> CFM Range -> CFM Range
subshell Id
id String
"pipeline" forall a b. (a -> b) -> a -> b
$ Token -> CFM Range
build Token
first
([Range]
leading, [Range]
last) <- Bool
-> [Token]
-> RWST
CFContext
([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
[(Id, Node)])
Node
Identity
([Range], [Range])
buildPipe Bool
lp [Token]
rest
forall (m :: * -> *) a. Monad m => a -> m a
return (Range
thisforall a. a -> [a] -> [a]
:[Range]
leading, [Range]
last)
buildPipe Bool
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
T_ProcSub Id
id String
op [Token]
cmds -> do
Range
start <- CFM Range
newStructuralNode
Range
body <- Id -> String -> CFM Range -> CFM Range
subshell Id
id (String
op forall a. [a] -> [a] -> [a]
++ String
"() process substitution") forall a b. (a -> b) -> a -> b
$ [Token] -> CFM Range
sequentially [Token]
cmds
Range
end <- CFM Range
newStructuralNode
Range -> Range -> CFM Range
linkRange Range
start Range
body
CFEdge -> Range -> Range -> CFM Range
linkRangeAs CFEdge
CFEFalseFlow Range
body Range
end
Range -> Range -> CFM Range
linkRange Range
start Range
end
T_Redirecting Id
_ [Token]
redirs Token
cmd -> do
Range
redir <- [Token] -> CFM Range
sequentially [Token]
redirs
Range
body <- Token -> CFM Range
build Token
cmd
Range -> Range -> CFM Range
linkRange Range
redir Range
body
T_SelectIn Id
id String
name [Token]
words [Token]
body -> Id -> String -> [Token] -> [Token] -> CFM Range
forInHelper Id
id String
name [Token]
words [Token]
body
T_SimpleCommand Id
id [Token]
vars [] -> do
Range
assignments <- [Token] -> CFM Range
sequentially [Token]
vars
Range
status <- CFNode -> CFM Range
newNodeRange (Id -> CFNode
CFSetExitCode Id
id)
Range -> Range -> CFM Range
linkRange Range
assignments Range
status
T_SimpleCommand Id
id [Token]
vars list :: [Token]
list@(Token
cmd:[Token]
_) ->
Token -> [Token] -> [Token] -> Maybe String -> CFM Range
handleCommand Token
t [Token]
vars [Token]
list forall a b. (a -> b) -> a -> b
$ Token -> Maybe String
getUnquotedLiteral Token
cmd
T_SingleQuoted Id
_ String
_ -> CFM Range
none
T_SourceCommand Id
_ Token
originalCommand Token
inlinedSource -> do
Range
cmd <- Token -> CFM Range
build Token
originalCommand
Range
end <- CFM Range
newStructuralNode
Range
inline <- forall a. Range -> CFM a -> CFM a
withReturn Range
end forall a b. (a -> b) -> a -> b
$ Token -> CFM Range
build Token
inlinedSource
Range -> Range -> CFM Range
linkRange Range
cmd Range
inline
Range -> Range -> CFM Range
linkRange Range
inline Range
end
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Range -> Range -> Range
spanRange Range
cmd Range
inline
T_Subshell Id
id [Token]
body -> do
Range
main <- Id -> String -> CFM Range -> CFM Range
subshell Id
id String
"explicit (..) subshell" forall a b. (a -> b) -> a -> b
$ [Token] -> CFM Range
sequentially [Token]
body
Range
status <- CFNode -> CFM Range
newNodeRange (Id -> CFNode
CFSetExitCode Id
id)
Range -> Range -> CFM Range
linkRange Range
main Range
status
T_UntilExpression Id
id [Token]
cond [Token]
body -> Id -> [Token] -> [Token] -> CFM Range
whileHelper Id
id [Token]
cond [Token]
body
T_WhileExpression Id
id [Token]
cond [Token]
body -> Id -> [Token] -> [Token] -> CFM Range
whileHelper Id
id [Token]
cond [Token]
body
T_CLOBBER Id
_ -> CFM Range
none
T_GREATAND Id
_ -> CFM Range
none
T_LESSAND Id
_ -> CFM Range
none
T_LESSGREAT Id
_ -> CFM Range
none
T_DGREAT Id
_ -> CFM Range
none
T_Greater Id
_ -> CFM Range
none
T_Less Id
_ -> CFM Range
none
T_ParamSubSpecialChar Id
_ String
_ -> CFM Range
none
Token
x -> forall a. HasCallStack => String -> a
error (String
"Unimplemented: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Token
x)
forInHelper :: Id -> String -> [Token] -> [Token] -> CFM Range
forInHelper Id
id String
name [Token]
words [Token]
body = do
Range
entry <- CFM Range
newStructuralNode
Range
expansion <- [Token] -> CFM Range
sequentially [Token]
words
Range
assignmentChoice <- CFM Range
newStructuralNode
[Range]
assignments <-
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
words Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Token -> Bool
willSplit [Token]
words
then (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ IdTagged CFEffect -> CFNode
applySingle forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name CFValue
CFValueString)
else forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Token
t -> CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ IdTagged CFEffect -> CFNode
applySingle forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name forall a b. (a -> b) -> a -> b
$ Id -> [CFStringPart] -> CFValue
CFValueComputed (Token -> Id
getId Token
t) forall a b. (a -> b) -> a -> b
$ Token -> [CFStringPart]
tokenToParts Token
t) [Token]
words
Range
body <- [Token] -> CFM Range
sequentially [Token]
body
Range
exit <- CFM Range
newStructuralNode
[Range] -> CFM Range
linkRanges [Range
entry, Range
expansion, Range
assignmentChoice]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Range
t -> [Range] -> CFM Range
linkRanges [Range
assignmentChoice, Range
t, Range
body]) [Range]
assignments
Range -> Range -> CFM Range
linkRange Range
body Range
exit
Range -> Range -> CFM Range
linkRange Range
expansion Range
exit
Range -> Range -> CFM Range
linkRange Range
body Range
assignmentChoice
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Range -> Range -> Range
spanRange Range
entry Range
exit
whileHelper :: Id -> [Token] -> [Token] -> CFM Range
whileHelper Id
id [Token]
cond [Token]
body = do
Range
condRange <- CFM Range -> CFM Range
asCondition forall a b. (a -> b) -> a -> b
$ [Token] -> CFM Range
sequentially [Token]
cond
Range
bodyRange <- [Token] -> CFM Range
sequentially [Token]
body
Range
end <- CFNode -> CFM Range
newNodeRange (Id -> CFNode
CFSetExitCode Id
id)
Range -> Range -> CFM Range
linkRange Range
condRange Range
bodyRange
Range -> Range -> CFM Range
linkRange Range
bodyRange Range
condRange
Range -> Range -> CFM Range
linkRange Range
condRange Range
end
handleCommand :: Token -> [Token] -> [Token] -> Maybe String -> CFM Range
handleCommand Token
cmd [Token]
vars [Token]
args Maybe String
literalCmd = do
case Maybe String
literalCmd of
Just String
"exit" -> [Token] -> [Token] -> CFM Range -> CFM Range
regularExpansion [Token]
vars [Token]
args forall a b. (a -> b) -> a -> b
$ CFM Range
handleExit
Just String
"return" -> [Token] -> [Token] -> CFM Range -> CFM Range
regularExpansion [Token]
vars [Token]
args forall a b. (a -> b) -> a -> b
$ CFM Range
handleReturn
Just String
"unset" -> [Token] -> [Token] -> CFM Range -> CFM Range
regularExpansionWithStatus [Token]
vars [Token]
args forall a b. (a -> b) -> a -> b
$ [Token] -> CFM Range
handleUnset [Token]
args
Just String
"declare" -> [Token] -> CFM Range
handleDeclare [Token]
args
Just String
"local" -> [Token] -> CFM Range
handleDeclare [Token]
args
Just String
"typeset" -> [Token] -> CFM Range
handleDeclare [Token]
args
Just String
"printf" -> [Token] -> [Token] -> CFM Range -> CFM Range
regularExpansionWithStatus [Token]
vars [Token]
args forall a b. (a -> b) -> a -> b
$ [Token] -> CFM Range
handlePrintf [Token]
args
Just String
"wait" -> [Token] -> [Token] -> CFM Range -> CFM Range
regularExpansionWithStatus [Token]
vars [Token]
args forall a b. (a -> b) -> a -> b
$ [Token] -> CFM Range
handleWait [Token]
args
Just String
"mapfile" -> [Token] -> [Token] -> CFM Range -> CFM Range
regularExpansionWithStatus [Token]
vars [Token]
args forall a b. (a -> b) -> a -> b
$ [Token] -> CFM Range
handleMapfile [Token]
args
Just String
"readarray" -> [Token] -> [Token] -> CFM Range -> CFM Range
regularExpansionWithStatus [Token]
vars [Token]
args forall a b. (a -> b) -> a -> b
$ [Token] -> CFM Range
handleMapfile [Token]
args
Just String
"read" -> [Token] -> [Token] -> CFM Range -> CFM Range
regularExpansionWithStatus [Token]
vars [Token]
args forall a b. (a -> b) -> a -> b
$ [Token] -> CFM Range
handleRead [Token]
args
Just String
"DEFINE_boolean" -> [Token] -> [Token] -> CFM Range -> CFM Range
regularExpansionWithStatus [Token]
vars [Token]
args forall a b. (a -> b) -> a -> b
$ [Token] -> CFM Range
handleDEFINE [Token]
args
Just String
"DEFINE_float" -> [Token] -> [Token] -> CFM Range -> CFM Range
regularExpansionWithStatus [Token]
vars [Token]
args forall a b. (a -> b) -> a -> b
$ [Token] -> CFM Range
handleDEFINE [Token]
args
Just String
"DEFINE_integer" -> [Token] -> [Token] -> CFM Range -> CFM Range
regularExpansionWithStatus [Token]
vars [Token]
args forall a b. (a -> b) -> a -> b
$ [Token] -> CFM Range
handleDEFINE [Token]
args
Just String
"DEFINE_string" -> [Token] -> [Token] -> CFM Range -> CFM Range
regularExpansionWithStatus [Token]
vars [Token]
args forall a b. (a -> b) -> a -> b
$ [Token] -> CFM Range
handleDEFINE [Token]
args
Just String
"builtin" ->
case [Token]
args of
[Token
_] -> CFM Range
regular
(Token
_:newargs :: [Token]
newargs@(Token
newcmd:[Token]
_)) ->
Token -> [Token] -> [Token] -> Maybe String -> CFM Range
handleCommand Token
newcmd [Token]
vars [Token]
newargs forall a b. (a -> b) -> a -> b
$ Token -> Maybe String
getLiteralString Token
newcmd
Just String
"command" ->
case [Token]
args of
[Token
_] -> CFM Range
regular
(Token
_:newargs :: [Token]
newargs@(Token
newcmd:[Token]
_)) ->
Id -> [Token] -> [Token] -> Maybe String -> CFM Range
handleOthers (Token -> Id
getId Token
newcmd) [Token]
vars [Token]
newargs forall a b. (a -> b) -> a -> b
$ Token -> Maybe String
getLiteralString Token
newcmd
Maybe String
_ -> CFM Range
regular
where
regular :: CFM Range
regular = Id -> [Token] -> [Token] -> Maybe String -> CFM Range
handleOthers (Token -> Id
getId Token
cmd) [Token]
vars [Token]
args Maybe String
literalCmd
handleExit :: CFM Range
handleExit = do
Maybe Node
exitNode <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader CFContext -> Maybe Node
cfExitTarget
case Maybe Node
exitNode of
Just Node
target -> do
Node
exit <- CFNode -> CFM Node
newNode CFNode
CFResolvedExit
Node -> Node -> CFEdge -> CFM ()
link Node
exit Node
target CFEdge
CFEExit
Node
unreachable <- CFNode -> CFM Node
newNode CFNode
CFUnreachable
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Node -> Node -> Range
Range Node
exit Node
unreachable
Maybe Node
Nothing -> do
Node
exit <- CFNode -> CFM Node
newNode CFNode
CFUnresolvedExit
Node
unreachable <- CFNode -> CFM Node
newNode CFNode
CFUnreachable
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Node -> Node -> Range
Range Node
exit Node
unreachable
handleReturn :: CFM Range
handleReturn = do
Maybe Node
returnTarget <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader CFContext -> Maybe Node
cfReturnTarget
case Maybe Node
returnTarget of
Maybe Node
Nothing -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ ShowS
pleaseReport String
"missing return target"
Just Node
target -> do
Node
ret <- CFNode -> CFM Node
newNode CFNode
CFStructuralNode
Node -> Node -> CFEdge -> CFM ()
link Node
ret Node
target CFEdge
CFEFlow
Node
unreachable <- CFNode -> CFM Node
newNode CFNode
CFUnreachable
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Node -> Node -> Range
Range Node
ret Node
unreachable
handleUnset :: [Token] -> CFM Range
handleUnset (Token
cmd:[Token]
args) = do
case () of
()
_ | String
"n" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
flagNames -> (String -> CFEffect) -> CFM Range
unsetWith String -> CFEffect
CFUndefineNameref
()
_ | String
"v" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
flagNames -> (String -> CFEffect) -> CFM Range
unsetWith String -> CFEffect
CFUndefineVariable
()
_ | String
"f" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
flagNames -> (String -> CFEffect) -> CFM Range
unsetWith String -> CFEffect
CFUndefineFunction
()
_ -> (String -> CFEffect) -> CFM Range
unsetWith String -> CFEffect
CFUndefine
where
pairs :: [(String, Token)]
pairs :: [(String, Token)]
pairs = forall a b. (a -> b) -> [a] -> [b]
map (\(String
str, (Token
flag, Token
val)) -> (String
str, Token
flag)) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall a b. (a -> b) -> [a] -> [b]
map (\Token
c -> (String
"", (Token
c,Token
c))) [Token]
args) forall a b. (a -> b) -> a -> b
$ String -> [Token] -> Maybe [(String, (Token, Token))]
getGnuOpts String
"vfn" [Token]
args
([(String, Token)]
names, [(String, Token)]
flags) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, Token)]
pairs
flagNames :: [String]
flagNames = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, Token)]
flags
literalNames :: [(Token, String)]
literalNames :: [(Token, String)]
literalNames = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(String
_, Token
t) -> Token -> Maybe String
getLiteralString Token
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) Token
t)) [(String, Token)]
names
unsetWith :: (String -> CFEffect) -> CFM Range
unsetWith String -> CFEffect
c = CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ [IdTagged CFEffect] -> CFNode
CFApplyEffects forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Token
token, String
name) -> forall a. Id -> a -> IdTagged a
IdTagged (Token -> Id
getId Token
token) forall a b. (a -> b) -> a -> b
$ String -> CFEffect
c String
name) [(Token, String)]
literalNames
variableAssignRegex :: Regex
variableAssignRegex = String -> Regex
mkRegex String
"^([_a-zA-Z][_a-zA-Z0-9]*)="
handleDeclare :: [Token] -> CFM Range
handleDeclare (Token
cmd:[Token]
args) = do
Bool
isFunc <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CFContext -> Bool
cfIsFunction
let ([Token]
evaluated, [IdTagged CFEffect]
assignments, [IdTagged CFEffect]
added, [IdTagged CFEffect]
removed) = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Token
-> ([Token], [IdTagged CFEffect], [IdTagged CFEffect],
[IdTagged CFEffect])
toEffects Bool
isFunc) [Token]
args
Range
before <- [Token] -> CFM Range
sequentially forall a b. (a -> b) -> a -> b
$ [Token]
evaluated
Range
assignments <- CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ [IdTagged CFEffect] -> CFNode
CFApplyEffects [IdTagged CFEffect]
assignments
Range
addedProps <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IdTagged CFEffect]
added then CFM Range
newStructuralNode else CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ [IdTagged CFEffect] -> CFNode
CFApplyEffects [IdTagged CFEffect]
added
Range
removedProps <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IdTagged CFEffect]
removed then CFM Range
newStructuralNode else CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ [IdTagged CFEffect] -> CFNode
CFApplyEffects [IdTagged CFEffect]
removed
Range
result <- CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ Id -> CFNode
CFSetExitCode (Token -> Id
getId Token
cmd)
[Range] -> CFM Range
linkRanges [Range
before, Range
assignments, Range
addedProps, Range
removedProps, Range
result]
where
opts :: [String]
opts = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ [Token] -> [(String, (Token, Token))]
getGenericOpts [Token]
args
array :: Bool
array = String
"a" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
opts Bool -> Bool -> Bool
|| Bool
associative
associative :: Bool
associative = String
"A" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
opts
integer :: Bool
integer = String
"i" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
opts
func :: Bool
func = String
"f" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
opts Bool -> Bool -> Bool
|| String
"F" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
opts
global :: Bool
global = String
"g" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
opts
export :: Bool
export = String
"x" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
opts
writer :: Bool -> String -> CFValue -> CFEffect
writer Bool
isFunc =
case () of
()
_ | Bool
global -> String -> CFValue -> CFEffect
CFWriteGlobal
()
_ | Bool
isFunc -> String -> CFValue -> CFEffect
CFWriteLocal
()
_ -> String -> CFValue -> CFEffect
CFWriteVariable
scope :: Bool -> Scope
scope Bool
isFunc =
case () of
()
_ | Bool
global -> Scope
GlobalScope
()
_ | Bool
isFunc -> Scope
LocalScope
()
_ -> Scope
DefaultScope
addedProps :: Set CFVariableProp
addedProps = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ [
[ CFVariableProp
CFVPArray | Bool
array ],
[ CFVariableProp
CFVPInteger | Bool
integer ],
[ CFVariableProp
CFVPExport | Bool
export ],
[ CFVariableProp
CFVPAssociative | Bool
associative ]
]
removedProps :: Set CFVariableProp
removedProps = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ [
[ CFVariableProp
CFVPInteger | Char
'i' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
unsetOptions ],
[ CFVariableProp
CFVPExport | Char
'e' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
unsetOptions ]
]
toEffects :: Bool
-> Token
-> ([Token], [IdTagged CFEffect], [IdTagged CFEffect],
[IdTagged CFEffect])
toEffects Bool
isFunc (T_Assignment Id
id AssignmentMode
mode String
var [Token]
idx Token
t) =
let
pre :: [Token]
pre = [Token]
idx forall a. [a] -> [a] -> [a]
++ [Token
t]
val :: [IdTagged CFEffect]
val = [ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ (Bool -> String -> CFValue -> CFEffect
writer Bool
isFunc) String
var forall a b. (a -> b) -> a -> b
$ Id -> [CFStringPart] -> CFValue
CFValueComputed (Token -> Id
getId Token
t) forall a b. (a -> b) -> a -> b
$ [ String -> CFStringPart
CFStringVariable String
var | AssignmentMode
mode forall a. Eq a => a -> a -> Bool
== AssignmentMode
Append ] forall a. [a] -> [a] -> [a]
++ Token -> [CFStringPart]
tokenToParts Token
t ]
added :: [IdTagged CFEffect]
added = [ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ Scope -> String -> Set CFVariableProp -> CFEffect
CFSetProps (Bool -> Scope
scope Bool
isFunc) String
var Set CFVariableProp
addedProps | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Set a -> Bool
S.null Set CFVariableProp
addedProps ]
removed :: [IdTagged CFEffect]
removed = [ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ Scope -> String -> Set CFVariableProp -> CFEffect
CFUnsetProps (Bool -> Scope
scope Bool
isFunc) String
var Set CFVariableProp
addedProps | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Set a -> Bool
S.null Set CFVariableProp
removedProps ]
in
([Token]
pre, [IdTagged CFEffect]
val, [IdTagged CFEffect]
added, [IdTagged CFEffect]
removed)
toEffects Bool
isFunc Token
t =
let
id :: Id
id = Token -> Id
getId Token
t
pre :: [Token]
pre = [Token
t]
literal :: String
literal = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
(Token -> m String) -> Token -> m String
getLiteralStringExt (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
"\0") Token
t
isKnown :: Bool
isKnown = Char
'\0' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
literal
match :: Maybe String
match = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ Regex
variableAssignRegex Regex -> String -> Maybe [String]
`matchRegex` String
literal
name :: String
name = forall a. a -> Maybe a -> a
fromMaybe String
literal Maybe String
match
asLiteral :: IdTagged CFEffect
asLiteral =
forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ (Bool -> String -> CFValue -> CFEffect
writer Bool
isFunc) String
name forall a b. (a -> b) -> a -> b
$
Id -> [CFStringPart] -> CFValue
CFValueComputed (Token -> Id
getId Token
t) [ String -> CFStringPart
CFStringLiteral forall a b. (a -> b) -> a -> b
$ forall a. Node -> [a] -> [a]
drop Node
1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'=') forall a b. (a -> b) -> a -> b
$ String
literal ]
asUnknown :: IdTagged CFEffect
asUnknown =
forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ (Bool -> String -> CFValue -> CFEffect
writer Bool
isFunc) String
name forall a b. (a -> b) -> a -> b
$
CFValue
CFValueString
added :: [IdTagged CFEffect]
added = [ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ Scope -> String -> Set CFVariableProp -> CFEffect
CFSetProps (Bool -> Scope
scope Bool
isFunc) String
name Set CFVariableProp
addedProps ]
removed :: [IdTagged CFEffect]
removed = [ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ Scope -> String -> Set CFVariableProp -> CFEffect
CFUnsetProps (Bool -> Scope
scope Bool
isFunc) String
name Set CFVariableProp
removedProps ]
in
case () of
()
_ | Bool -> Bool
not (String -> Bool
isVariableName String
name) -> ([Token]
pre, [], [], [])
()
_ | forall a. Maybe a -> Bool
isJust Maybe String
match Bool -> Bool -> Bool
&& Bool
isKnown -> ([Token]
pre, [IdTagged CFEffect
asLiteral], [IdTagged CFEffect]
added, [IdTagged CFEffect]
removed)
()
_ | forall a. Maybe a -> Bool
isJust Maybe String
match -> ([Token]
pre, [IdTagged CFEffect
asUnknown], [IdTagged CFEffect]
added, [IdTagged CFEffect]
removed)
()
_ -> ([Token]
pre, [], [IdTagged CFEffect]
added, [IdTagged CFEffect]
removed)
unsetOptions :: String
unsetOptions :: String
unsetOptions =
let
strings :: [String]
strings = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Token -> Maybe String
getLiteralString [Token]
args
plusses :: [String]
plusses = forall a. (a -> Bool) -> [a] -> [a]
filter (String
"+" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
strings
in
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Node -> [a] -> [a]
drop Node
1) [String]
plusses
handlePrintf :: [Token] -> CFM Range
handlePrintf (Token
cmd:[Token]
args) =
CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ [IdTagged CFEffect] -> CFNode
CFApplyEffects forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> [a]
maybeToList Maybe (IdTagged CFEffect)
findVar
where
findVar :: Maybe (IdTagged CFEffect)
findVar = do
[(String, (Token, Token))]
flags <- String -> [Token] -> Maybe [(String, (Token, Token))]
getBsdOpts String
"v:" [Token]
args
(Token
flag, Token
arg) <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"v" [(String, (Token, Token))]
flags
String
name <- Token -> Maybe String
getLiteralString Token
arg
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged (Token -> Id
getId Token
arg) forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name CFValue
CFValueString
handleWait :: [Token] -> CFM Range
handleWait (Token
cmd:[Token]
args) =
CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ [IdTagged CFEffect] -> CFNode
CFApplyEffects forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> [a]
maybeToList Maybe (IdTagged CFEffect)
findVar
where
findVar :: Maybe (IdTagged CFEffect)
findVar = do
let flags :: [(String, (Token, Token))]
flags = [Token] -> [(String, (Token, Token))]
getGenericOpts [Token]
args
(Token
flag, Token
arg) <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"p" [(String, (Token, Token))]
flags
String
name <- Token -> Maybe String
getLiteralString Token
arg
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged (Token -> Id
getId Token
arg) forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name CFValue
CFValueInteger
handleMapfile :: [Token] -> CFM Range
handleMapfile (Token
cmd:[Token]
args) =
CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ [IdTagged CFEffect] -> CFNode
CFApplyEffects [IdTagged CFEffect
findVar]
where
findVar :: IdTagged CFEffect
findVar =
let (Id
id, String
name) = forall a. a -> Maybe a -> a
fromMaybe (Token -> Id
getId Token
cmd, String
"MAPFILE") forall a b. (a -> b) -> a -> b
$ Maybe (Id, String)
getFromArg forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe (Id, String)
getFromFallback
in forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name CFValue
CFValueArray
getFromArg :: Maybe (Id, String)
getFromArg = do
[(String, (Token, Token))]
flags <- String -> [Token] -> Maybe [(String, (Token, Token))]
getGnuOpts String
flagsForMapfile [Token]
args
(Token
_, Token
arg) <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"" [(String, (Token, Token))]
flags
String
name <- Token -> Maybe String
getLiteralString Token
arg
forall (m :: * -> *) a. Monad m => a -> m a
return (Token -> Id
getId Token
arg, String
name)
getFromFallback :: Maybe (Id, String)
getFromFallback =
forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Token -> Maybe (Id, String)
getIfVar forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Token]
args
getIfVar :: Token -> Maybe (Id, String)
getIfVar Token
c = do
String
name <- Token -> Maybe String
getLiteralString Token
c
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ String -> Bool
isVariableName String
name
forall (m :: * -> *) a. Monad m => a -> m a
return (Token -> Id
getId Token
c, String
name)
handleRead :: [Token] -> CFM Range
handleRead (Token
cmd:[Token]
args) = CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ [IdTagged CFEffect] -> CFNode
CFApplyEffects [IdTagged CFEffect]
main
where
main :: [IdTagged CFEffect]
main = forall a. a -> Maybe a -> a
fromMaybe [IdTagged CFEffect]
fallback forall a b. (a -> b) -> a -> b
$ do
[(String, (Token, Token))]
flags <- String -> [Token] -> Maybe [(String, (Token, Token))]
getGnuOpts String
flagsForRead [Token]
args
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe ([(String, (Token, Token))] -> [IdTagged CFEffect]
withFields [(String, (Token, Token))]
flags) forall a b. (a -> b) -> a -> b
$ [(String, (Token, Token))] -> Maybe [IdTagged CFEffect]
withArray [(String, (Token, Token))]
flags
withArray :: [(String, (Token, Token))] -> Maybe [IdTagged CFEffect]
withArray :: [(String, (Token, Token))] -> Maybe [IdTagged CFEffect]
withArray [(String, (Token, Token))]
flags = do
(Token
_, Token
token) <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"a" [(String, (Token, Token))]
flags
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ do
String
name <- Token -> Maybe String
getLiteralString Token
token
forall (m :: * -> *) a. Monad m => a -> m a
return [ forall a. Id -> a -> IdTagged a
IdTagged (Token -> Id
getId Token
token) forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name CFValue
CFValueArray ]
withFields :: [(String, (Token, Token))] -> [IdTagged CFEffect]
withFields [(String, (Token, Token))]
flags = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String, (Token, Token)) -> Maybe (IdTagged CFEffect)
getAssignment [(String, (Token, Token))]
flags
getAssignment :: (String, (Token, Token)) -> Maybe (IdTagged CFEffect)
getAssignment :: (String, (Token, Token)) -> Maybe (IdTagged CFEffect)
getAssignment (String, (Token, Token))
f = do
(String
"", (Token
t, Token
_)) <- forall (m :: * -> *) a. Monad m => a -> m a
return (String, (Token, Token))
f
String
name <- Token -> Maybe String
getLiteralString Token
t
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged (Token -> Id
getId Token
t) forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name CFValue
CFValueString
fallback :: [IdTagged CFEffect]
fallback =
let
names :: [(Id, String)]
names = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Token
c -> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Token -> Id
getId Token
c, Token -> Maybe String
getLiteralString Token
c)) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Token]
args
namesOrDefault :: [(Id, String)]
namesOrDefault = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Id, String)]
names then [(Token -> Id
getId Token
cmd, String
"REPLY")] else [(Id, String)]
names
hasDashA :: Bool
hasDashA = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== String
"a") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ [Token] -> [(String, (Token, Token))]
getGenericOpts [Token]
args
value :: CFValue
value = if Bool
hasDashA then CFValue
CFValueArray else CFValue
CFValueString
in
forall a b. (a -> b) -> [a] -> [b]
map (\(Id
id, String
name) -> forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name CFValue
value) [(Id, String)]
namesOrDefault
handleDEFINE :: [Token] -> CFM Range
handleDEFINE (Token
cmd:[Token]
args) =
CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ [IdTagged CFEffect] -> CFNode
CFApplyEffects forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> [a]
maybeToList Maybe (IdTagged CFEffect)
findVar
where
findVar :: Maybe (IdTagged CFEffect)
findVar = do
Token
name <- forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. Node -> [a] -> [a]
drop Node
1 [Token]
args
String
str <- Token -> Maybe String
getLiteralString Token
name
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ String -> Bool
isVariableName String
str
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged (Token -> Id
getId Token
name) forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
str CFValue
CFValueString
handleOthers :: Id -> [Token] -> [Token] -> Maybe String -> CFM Range
handleOthers Id
id [Token]
vars [Token]
args Maybe String
cmd =
[Token] -> [Token] -> CFM Range -> CFM Range
regularExpansion [Token]
vars [Token]
args forall a b. (a -> b) -> a -> b
$ do
Range
exe <- CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ Maybe String -> CFNode
CFExecuteCommand Maybe String
cmd
Range
status <- CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ Id -> CFNode
CFSetExitCode Id
id
Range -> Range -> CFM Range
linkRange Range
exe Range
status
regularExpansion :: [Token] -> [Token] -> CFM Range -> CFM Range
regularExpansion [Token]
vars [Token]
args CFM Range
p = do
Range
args <- [Token] -> CFM Range
sequentially [Token]
args
[Range]
assignments <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Scope -> Token -> CFM Range
buildAssignment Scope
PrefixScope) [Token]
vars
Range
exe <- CFM Range
p
[Range]
dropAssignments <-
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
vars
then
forall (m :: * -> *) a. Monad m => a -> m a
return []
else do
Range
drop <- CFNode -> CFM Range
newNodeRange CFNode
CFDropPrefixAssignments
forall (m :: * -> *) a. Monad m => a -> m a
return [Range
drop]
[Range] -> CFM Range
linkRanges forall a b. (a -> b) -> a -> b
$ [Range
args] forall a. [a] -> [a] -> [a]
++ [Range]
assignments forall a. [a] -> [a] -> [a]
++ [Range
exe] forall a. [a] -> [a] -> [a]
++ [Range]
dropAssignments
regularExpansionWithStatus :: [Token] -> [Token] -> CFM Range -> CFM Range
regularExpansionWithStatus [Token]
vars args :: [Token]
args@(Token
cmd:[Token]
_) CFM Range
p = do
Range
initial <- [Token] -> [Token] -> CFM Range -> CFM Range
regularExpansion [Token]
vars [Token]
args CFM Range
p
Range
status <- CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ Id -> CFNode
CFSetExitCode (Token -> Id
getId Token
cmd)
Range -> Range -> CFM Range
linkRange Range
initial Range
status
none :: CFM Range
none = CFM Range
newStructuralNode
data Scope = DefaultScope | GlobalScope | LocalScope | PrefixScope
deriving (Scope -> Scope -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c== :: Scope -> Scope -> Bool
Eq, Eq Scope
Scope -> Scope -> Bool
Scope -> Scope -> Ordering
Scope -> Scope -> Scope
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 :: Scope -> Scope -> Scope
$cmin :: Scope -> Scope -> Scope
max :: Scope -> Scope -> Scope
$cmax :: Scope -> Scope -> Scope
>= :: Scope -> Scope -> Bool
$c>= :: Scope -> Scope -> Bool
> :: Scope -> Scope -> Bool
$c> :: Scope -> Scope -> Bool
<= :: Scope -> Scope -> Bool
$c<= :: Scope -> Scope -> Bool
< :: Scope -> Scope -> Bool
$c< :: Scope -> Scope -> Bool
compare :: Scope -> Scope -> Ordering
$ccompare :: Scope -> Scope -> Ordering
Ord, Node -> Scope -> ShowS
[Scope] -> ShowS
Scope -> String
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scope] -> ShowS
$cshowList :: [Scope] -> ShowS
show :: Scope -> String
$cshow :: Scope -> String
showsPrec :: Node -> Scope -> ShowS
$cshowsPrec :: Node -> Scope -> ShowS
Show, forall x. Rep Scope x -> Scope
forall x. Scope -> Rep Scope x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Scope x -> Scope
$cfrom :: forall x. Scope -> Rep Scope x
Generic, Scope -> ()
forall a. (a -> ()) -> NFData a
rnf :: Scope -> ()
$crnf :: Scope -> ()
NFData)
buildAssignment :: Scope -> Token -> CFM Range
buildAssignment Scope
scope Token
t = do
Range
op <- case Token
t of
T_Assignment Id
id AssignmentMode
mode String
var [Token]
indices Token
value -> do
Range
expand <- Token -> CFM Range
build Token
value
Range
index <- [Token] -> CFM Range
sequentially [Token]
indices
Range
read <- case AssignmentMode
mode of
AssignmentMode
Append -> CFNode -> CFM Range
newNodeRange (IdTagged CFEffect -> CFNode
applySingle forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> CFEffect
CFReadVariable String
var)
AssignmentMode
Assign -> CFM Range
none
let valueType :: CFValue
valueType = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
indices then Id -> Token -> CFValue
f Id
id Token
value else CFValue
CFValueArray
let scoper :: String -> CFValue -> CFEffect
scoper =
case Scope
scope of
Scope
PrefixScope -> String -> CFValue -> CFEffect
CFWritePrefix
Scope
LocalScope -> String -> CFValue -> CFEffect
CFWriteLocal
Scope
GlobalScope -> String -> CFValue -> CFEffect
CFWriteGlobal
Scope
DefaultScope -> String -> CFValue -> CFEffect
CFWriteVariable
Range
write <- CFNode -> CFM Range
newNodeRange forall a b. (a -> b) -> a -> b
$ IdTagged CFEffect -> CFNode
applySingle forall a b. (a -> b) -> a -> b
$ forall a. Id -> a -> IdTagged a
IdTagged Id
id forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
scoper String
var CFValue
valueType
[Range] -> CFM Range
linkRanges [Range
expand, Range
index, Range
read, Range
write]
where
f :: Id -> Token -> CFValue
f :: Id -> Token -> CFValue
f Id
id t :: Token
t@T_NormalWord {} = Id -> [CFStringPart] -> CFValue
CFValueComputed Id
id forall a b. (a -> b) -> a -> b
$ [String -> CFStringPart
CFStringVariable String
var | AssignmentMode
mode forall a. Eq a => a -> a -> Bool
== AssignmentMode
Append] forall a. [a] -> [a] -> [a]
++ Token -> [CFStringPart]
tokenToParts Token
t
f Id
id t :: Token
t@(T_Literal Id
_ String
str) = Id -> [CFStringPart] -> CFValue
CFValueComputed Id
id forall a b. (a -> b) -> a -> b
$ [String -> CFStringPart
CFStringVariable String
var | AssignmentMode
mode forall a. Eq a => a -> a -> Bool
== AssignmentMode
Append] forall a. [a] -> [a] -> [a]
++ Token -> [CFStringPart]
tokenToParts Token
t
f Id
_ T_Array {} = CFValue
CFValueArray
Id -> Range -> CFM ()
registerNode (Token -> Id
getId Token
t) Range
op
forall (m :: * -> *) a. Monad m => a -> m a
return Range
op
tokenToParts :: Token -> [CFStringPart]
tokenToParts Token
t =
case Token
t of
T_NormalWord Id
_ [Token]
list -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [CFStringPart]
tokenToParts [Token]
list
T_DoubleQuoted Id
_ [Token]
list -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [CFStringPart]
tokenToParts [Token]
list
T_SingleQuoted Id
_ String
str -> [ String -> CFStringPart
CFStringLiteral String
str ]
T_Literal Id
_ String
str -> [ String -> CFStringPart
CFStringLiteral String
str ]
T_DollarArithmetic {} -> [ CFStringPart
CFStringInteger ]
T_DollarBracket {} -> [ CFStringPart
CFStringInteger ]
T_DollarBraced Id
_ Bool
_ Token
list | Token -> Bool
isUnmodifiedParameterExpansion Token
t -> [ String -> CFStringPart
CFStringVariable (ShowS
getBracedReference forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ Token -> [String]
oversimplify Token
list) ]
Token
_ -> [forall b a. b -> (a -> b) -> Maybe a -> b
maybe CFStringPart
CFStringUnknown String -> CFStringPart
CFStringLiteral forall a b. (a -> b) -> a -> b
$ Token -> Maybe String
getLiteralString Token
t]
safeUpdate :: (Adj b, Node, a, Adj b) -> gr a b -> gr a b
safeUpdate ctx :: (Adj b, Node, a, Adj b)
ctx@(Adj b
_,Node
node,a
_,Adj b
_) gr a b
graph = (Adj b, Node, a, Adj b)
ctx forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
& (forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> gr a b
delNode Node
node gr a b
graph)
inlineSubshells :: CFGraph -> CFGraph
inlineSubshells :: CFGraph -> CFGraph
inlineSubshells CFGraph
graph = CFGraph
relinkedGraph
where
subshells :: [(Node, CFNode, Node, Node, Adj CFEdge, Adj CFEdge)]
subshells = forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c -> c) -> c -> gr a b -> c
ufold forall {e} {a} {f}.
(e, a, CFNode, f)
-> [(a, CFNode, Node, Node, e, f)]
-> [(a, CFNode, Node, Node, e, f)]
find [] CFGraph
graph
find :: (e, a, CFNode, f)
-> [(a, CFNode, Node, Node, e, f)]
-> [(a, CFNode, Node, Node, e, f)]
find (e
incoming, a
node, CFNode
label, f
outgoing) [(a, CFNode, Node, Node, e, f)]
acc =
case CFNode
label of
CFExecuteSubshell String
_ Node
start Node
end -> (a
node, CFNode
label, Node
start, Node
end, e
incoming, f
outgoing)forall a. a -> [a] -> [a]
:[(a, CFNode, Node, Node, e, f)]
acc
CFNode
_ -> [(a, CFNode, Node, Node, e, f)]
acc
relinkedGraph :: CFGraph
relinkedGraph = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {gr :: * -> * -> *} {a}.
DynGraph gr =>
gr a CFEdge
-> (Node, a, Node, Node, Adj CFEdge, Adj CFEdge) -> gr a CFEdge
relink CFGraph
graph [(Node, CFNode, Node, Node, Adj CFEdge, Adj CFEdge)]
subshells
relink :: gr a CFEdge
-> (Node, a, Node, Node, Adj CFEdge, Adj CFEdge) -> gr a CFEdge
relink gr a CFEdge
graph (Node
node, a
label, Node
start, Node
end, Adj CFEdge
incoming, Adj CFEdge
outgoing) =
let
subshellToStart :: (Adj CFEdge, Node, a, Adj CFEdge)
subshellToStart = (Adj CFEdge
incoming, Node
node, a
label, [(CFEdge
CFEFlow, Node
start)])
endToNexts :: (Adj CFEdge, Node, a, Adj CFEdge)
endToNexts = (Adj CFEdge
endIncoming, Node
endNode, a
endLabel, Adj CFEdge
outgoing)
(Adj CFEdge
endIncoming, Node
endNode, a
endLabel, Adj CFEdge
_) = forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Node -> Context a b
context gr a CFEdge
graph Node
end
in
(Adj CFEdge, Node, a, Adj CFEdge)
subshellToStart forall {gr :: * -> * -> *} {b} {a}.
DynGraph gr =>
(Adj b, Node, a, Adj b) -> gr a b -> gr a b
`safeUpdate` ((Adj CFEdge, Node, a, Adj CFEdge)
endToNexts forall {gr :: * -> * -> *} {b} {a}.
DynGraph gr =>
(Adj b, Node, a, Adj b) -> gr a b -> gr a b
`safeUpdate` gr a CFEdge
graph)
findEntryNodes :: CFGraph -> [Node]
findEntryNodes :: CFGraph -> [Node]
findEntryNodes CFGraph
graph = forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c -> c) -> c -> gr a b -> c
ufold forall {t :: * -> *} {a} {a} {d}.
Foldable t =>
(t a, a, CFNode, d) -> [a] -> [a]
find [] CFGraph
graph
where
find :: (t a, a, CFNode, d) -> [a] -> [a]
find (t a
incoming, a
node, CFNode
label, d
_) [a]
list =
case CFNode
label of
CFEntryPoint {} | forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
incoming -> a
nodeforall a. a -> [a] -> [a]
:[a]
list
CFNode
_ -> [a]
list
findDominators :: Node -> CFGraph -> Map Node (Set Node)
findDominators Node
main CFGraph
graph = Map Node (Set Node)
asSetMap
where
inlined :: CFGraph
inlined = CFGraph -> CFGraph
inlineSubshells CFGraph
graph
entryNodes :: [Node]
entryNodes = Node
main forall a. a -> [a] -> [a]
: CFGraph -> [Node]
findEntryNodes CFGraph
graph
asLists :: [(Node, [Node])]
asLists = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Node -> [(Node, [Node])]
dom CFGraph
inlined) [Node]
entryNodes
asSetMap :: Map Node (Set Node)
asSetMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Node
node, [Node]
list) -> (Node
node, forall a. Ord a => [a] -> Set a
S.fromList [Node]
list)) [(Node, [Node])]
asLists
findTerminalNodes :: CFGraph -> [Node]
findTerminalNodes :: CFGraph -> [Node]
findTerminalNodes CFGraph
graph = forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c -> c) -> c -> gr a b -> c
ufold forall {a} {d}. (a, Node, CFNode, d) -> [Node] -> [Node]
find [] CFGraph
graph
where
find :: (a, Node, CFNode, d) -> [Node] -> [Node]
find (a
_, Node
node, CFNode
label, d
_) [Node]
list =
case CFNode
label of
CFNode
CFUnresolvedExit -> Node
nodeforall a. a -> [a] -> [a]
:[Node]
list
CFApplyEffects [IdTagged CFEffect]
effects -> [IdTagged CFEffect] -> [Node] -> [Node]
f [IdTagged CFEffect]
effects [Node]
list
CFNode
_ -> [Node]
list
f :: [IdTagged CFEffect] -> [Node] -> [Node]
f [] [Node]
list = [Node]
list
f (IdTagged Id
_ (CFDefineFunction String
_ Id
id Node
start Node
end):[IdTagged CFEffect]
rest) [Node]
list = [IdTagged CFEffect] -> [Node] -> [Node]
f [IdTagged CFEffect]
rest (Node
endforall a. a -> [a] -> [a]
:[Node]
list)
f (IdTagged CFEffect
_:[IdTagged CFEffect]
rest) [Node]
list = [IdTagged CFEffect] -> [Node] -> [Node]
f [IdTagged CFEffect]
rest [Node]
list
findPostDominators :: Node -> CFGraph -> Array Node [Node]
findPostDominators :: Node -> CFGraph -> Array Node [Node]
findPostDominators Node
mainexit CFGraph
graph = Array Node [Node]
asArray
where
inlined :: CFGraph
inlined = CFGraph -> CFGraph
inlineSubshells CFGraph
graph
terminals :: [Node]
terminals = CFGraph -> [Node]
findTerminalNodes CFGraph
inlined
(Adj CFEdge
incoming, Node
_, CFNode
label, Adj CFEdge
outgoing) = forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Node -> Context a b
context CFGraph
graph Node
mainexit
withExitEdges :: CFGraph
withExitEdges = (Adj CFEdge
incoming forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\Node
c -> (CFEdge
CFEFlow, Node
c)) [Node]
terminals, Node
mainexit, CFNode
label, Adj CFEdge
outgoing) forall {gr :: * -> * -> *} {b} {a}.
DynGraph gr =>
(Adj b, Node, a, Adj b) -> gr a b -> gr a b
`safeUpdate` CFGraph
inlined
reversed :: CFGraph
reversed = forall (gr :: * -> * -> *) a b. DynGraph gr => gr a b -> gr a b
grev CFGraph
withExitEdges
postDoms :: [(Node, [Node])]
postDoms = forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Node -> [(Node, [Node])]
dom CFGraph
reversed Node
mainexit
(Node
_, Node
maxNode) = forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> (Node, Node)
nodeRange CFGraph
graph
asArray :: Array Node [Node]
asArray = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array (Node
0, Node
maxNode) [(Node, [Node])]
postDoms
return []
runTests :: IO Bool
runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |])